From 3fe903d98bba46bf713e4a47d9bbb2b2dc0c049b Mon Sep 17 00:00:00 2001
From: Quentin Rodier <quentin.rodier@meteo.fr>
Date: Fri, 5 Nov 2021 16:12:31 +0100
Subject: [PATCH] Quentin 05/11/2021: Add parts of turb conv micro MNH 5.5.0
source
---
src/mesonh/conv/convect_chem_transport.f90 | 295 +
src/mesonh/conv/convect_closure.f90 | 755 +++
src/mesonh/conv/convect_closure_adjust.f90 | 183 +
.../conv/convect_closure_adjust_shal.f90 | 134 +
src/mesonh/conv/convect_closure_shal.f90 | 619 ++
src/mesonh/conv/convect_closure_thrvlcl.f90 | 299 +
src/mesonh/conv/convect_condens.f90 | 191 +
src/mesonh/conv/convect_downdraft.f90 | 505 ++
src/mesonh/conv/convect_mixing_funct.f90 | 151 +
src/mesonh/conv/convect_precip_adjust.f90 | 337 +
src/mesonh/conv/convect_satmixratio.f90 | 122 +
src/mesonh/conv/convect_trigger_funct.f90 | 454 ++
src/mesonh/conv/convect_trigger_shal.f90 | 461 ++
src/mesonh/conv/convect_tstep_pref.f90 | 206 +
src/mesonh/conv/convect_updraft.f90 | 641 ++
src/mesonh/conv/convect_updraft_shal.f90 | 598 ++
src/mesonh/conv/deep_convection.f90 | 1393 ++++
src/mesonh/conv/ini_convpar.f90 | 111 +
src/mesonh/conv/ini_convpar_e1.f90 | 111 +
src/mesonh/conv/ini_convpar_shal.f90 | 112 +
src/mesonh/conv/modd_convpar.f90 | 77 +
src/mesonh/conv/modd_convpar_shal.f90 | 79 +
src/mesonh/conv/modd_convparext.f90 | 22 +
src/mesonh/conv/shallow_convection.f90 | 973 +++
src/mesonh/micro/c2r2_adjust.f90 | 440 ++
src/mesonh/micro/cart_compress.f90 | 170 +
src/mesonh/micro/condensation.f90 | 513 ++
src/mesonh/micro/gamma.f90 | 224 +
src/mesonh/micro/gamma_inc.f90 | 148 +
src/mesonh/micro/general_gamma.f90 | 91 +
src/mesonh/micro/hypgeo.f90 | 119 +
src/mesonh/micro/hypser.f90 | 116 +
src/mesonh/micro/ice4_compute_pdf.f90 | 324 +
src/mesonh/micro/ice4_fast_rg.f90 | 582 ++
src/mesonh/micro/ice4_fast_rh.f90 | 593 ++
src/mesonh/micro/ice4_fast_ri.f90 | 129 +
src/mesonh/micro/ice4_fast_rs.f90 | 521 ++
src/mesonh/micro/ice4_nucleation.f90 | 152 +
src/mesonh/micro/ice4_nucleation_wrapper.f90 | 149 +
src/mesonh/micro/ice4_rainfr_vert.f90 | 83 +
src/mesonh/micro/ice4_rimltc.f90 | 105 +
src/mesonh/micro/ice4_rrhong.f90 | 105 +
src/mesonh/micro/ice4_rsrimcg_old.f90 | 144 +
src/mesonh/micro/ice4_sedimentation_split.f90 | 494 ++
.../ice4_sedimentation_split_momentum.f90 | 577 ++
src/mesonh/micro/ice4_sedimentation_stat.f90 | 444 ++
src/mesonh/micro/ice4_slow.f90 | 263 +
src/mesonh/micro/ice4_tendencies.f90 | 620 ++
src/mesonh/micro/ice4_warm.f90 | 316 +
src/mesonh/micro/ice_adjust.f90 | 524 ++
src/mesonh/micro/ini_cst.f90 | 197 +
src/mesonh/micro/ini_lima.f90 | 173 +
src/mesonh/micro/ini_lima_cold_mixed.f90 | 1348 ++++
src/mesonh/micro/ini_lima_warm.f90 | 461 ++
src/mesonh/micro/ini_neb.f90 | 72 +
src/mesonh/micro/ini_rain_c2r2.f90 | 637 ++
src/mesonh/micro/ini_rain_ice.f90 | 1408 ++++
src/mesonh/micro/ini_rain_ice_elec.f90 | 1255 ++++
src/mesonh/micro/init_aerosol_properties.f90 | 436 ++
src/mesonh/micro/lima.f90 | 1803 +++++
src/mesonh/micro/lima_adjust.f90 | 1307 ++++
src/mesonh/micro/lima_adjust_split.f90 | 848 +++
src/mesonh/micro/lima_bergeron.f90 | 121 +
src/mesonh/micro/lima_ccn_activation.f90 | 835 +++
src/mesonh/micro/lima_ccn_hom_freezing.f90 | 397 ++
src/mesonh/micro/lima_cold.f90 | 435 ++
src/mesonh/micro/lima_cold_hom_nucl.f90 | 659 ++
src/mesonh/micro/lima_cold_sedimentation.f90 | 354 +
src/mesonh/micro/lima_cold_slow_processes.f90 | 537 ++
.../micro/lima_compute_cloud_fractions.f90 | 173 +
.../micro/lima_conversion_melting_snow.f90 | 121 +
src/mesonh/micro/lima_droplets_accretion.f90 | 160 +
.../micro/lima_droplets_autoconversion.f90 | 127 +
.../micro/lima_droplets_hom_freezing.f90 | 145 +
.../micro/lima_droplets_riming_snow.f90 | 226 +
.../micro/lima_droplets_self_collection.f90 | 94 +
src/mesonh/micro/lima_drops_break_up.f90 | 100 +
src/mesonh/micro/lima_drops_hom_freezing.f90 | 144 +
.../micro/lima_drops_self_collection.f90 | 123 +
.../micro/lima_drops_to_droplets_conv.f90 | 103 +
src/mesonh/micro/lima_functions.f90 | 307 +
src/mesonh/micro/lima_graupel.f90 | 569 ++
src/mesonh/micro/lima_graupel_deposition.f90 | 97 +
.../micro/lima_ice_aggregation_snow.f90 | 119 +
src/mesonh/micro/lima_ice_deposition.f90 | 175 +
src/mesonh/micro/lima_ice_melting.f90 | 164 +
src/mesonh/micro/lima_ice_snow_deposition.f90 | 230 +
.../lima_init_ccn_activation_spectrum.f90 | 458 ++
src/mesonh/micro/lima_inst_procs.f90 | 197 +
src/mesonh/micro/lima_meyers.f90 | 466 ++
src/mesonh/micro/lima_meyers_nucleation.f90 | 348 +
src/mesonh/micro/lima_mixed.f90 | 643 ++
.../micro/lima_mixed_fast_processes.f90 | 1426 ++++
.../micro/lima_mixed_slow_processes.f90 | 304 +
src/mesonh/micro/lima_mixrat_to_nconc.f90 | 192 +
src/mesonh/micro/lima_notadjust.f90 | 624 ++
src/mesonh/micro/lima_nucleation_procs.f90 | 334 +
src/mesonh/micro/lima_phillips.f90 | 663 ++
.../micro/lima_phillips_ifn_nucleation.f90 | 512 ++
src/mesonh/micro/lima_phillips_integ.f90 | 163 +
.../micro/lima_phillips_ref_spectrum.f90 | 140 +
src/mesonh/micro/lima_precip_scavenging.f90 | 856 +++
src/mesonh/micro/lima_rain_accr_snow.f90 | 299 +
src/mesonh/micro/lima_rain_evaporation.f90 | 149 +
src/mesonh/micro/lima_rain_freezing.f90 | 134 +
src/mesonh/micro/lima_read_xker_gweth.f90 | 1737 +++++
src/mesonh/micro/lima_read_xker_raccs.f90 | 4951 ++++++++++++++
src/mesonh/micro/lima_read_xker_rdryg.f90 | 1736 +++++
src/mesonh/micro/lima_read_xker_sdryg.f90 | 3337 ++++++++++
src/mesonh/micro/lima_read_xker_sweth.f90 | 3337 ++++++++++
src/mesonh/micro/lima_sedimentation.f90 | 244 +
src/mesonh/micro/lima_snow_deposition.f90 | 163 +
src/mesonh/micro/lima_tendencies.f90 | 797 +++
src/mesonh/micro/lima_warm.f90 | 486 ++
src/mesonh/micro/lima_warm_coal.f90 | 460 ++
src/mesonh/micro/lima_warm_evap.f90 | 353 +
src/mesonh/micro/lima_warm_nucl.f90 | 860 +++
src/mesonh/micro/lima_warm_sedimentation.f90 | 396 ++
src/mesonh/micro/modd_blankn.f90 | 173 +
src/mesonh/micro/modd_conf.f90 | 127 +
src/mesonh/micro/modd_cst.f90 | 116 +
src/mesonh/micro/modd_dyn.f90 | 86 +
src/mesonh/micro/modd_elec_descr.f90 | 178 +
src/mesonh/micro/modd_les.f90 | 458 ++
.../micro/modd_lima_precip_scavengingn.f90 | 50 +
src/mesonh/micro/modd_lunit.f90 | 49 +
src/mesonh/micro/modd_neb.f90 | 43 +
src/mesonh/micro/modd_nsv.f90 | 253 +
src/mesonh/micro/modd_param_c1r3.f90 | 65 +
src/mesonh/micro/modd_param_c2r2.f90 | 80 +
src/mesonh/micro/modd_param_ice.f90 | 83 +
src/mesonh/micro/modd_param_lima.f90 | 216 +
src/mesonh/micro/modd_param_lima_cold.f90 | 128 +
src/mesonh/micro/modd_param_lima_mixed.f90 | 169 +
src/mesonh/micro/modd_param_lima_warm.f90 | 125 +
src/mesonh/micro/modd_parameters.f90 | 98 +
src/mesonh/micro/modd_rain_c2r2_descr.f90 | 72 +
.../micro/modd_rain_c2r2_khko_param.f90 | 120 +
src/mesonh/micro/modd_rain_ice_descr.f90 | 87 +
src/mesonh/micro/modd_rain_ice_param.f90 | 185 +
src/mesonh/micro/modn_param_lima.f90 | 36 +
src/mesonh/micro/prognos_lima.f90 | 393 ++
src/mesonh/micro/radar_rain_ice.f90 | 486 ++
src/mesonh/micro/rain_c2r2_khko.f90 | 1957 ++++++
src/mesonh/micro/rain_ice.f90 | 945 +++
src/mesonh/micro/rain_ice_elec.f90 | 5849 +++++++++++++++++
src/mesonh/micro/rain_ice_fast_rg.f90 | 455 ++
src/mesonh/micro/rain_ice_fast_rh.f90 | 403 ++
src/mesonh/micro/rain_ice_fast_ri.f90 | 103 +
src/mesonh/micro/rain_ice_fast_rs.f90 | 375 ++
src/mesonh/micro/rain_ice_nucleation.f90 | 180 +
src/mesonh/micro/rain_ice_red.f90 | 1882 ++++++
.../micro/rain_ice_sedimentation_split.f90 | 617 ++
.../micro/rain_ice_sedimentation_stat.f90 | 582 ++
src/mesonh/micro/rain_ice_slow.f90 | 225 +
src/mesonh/micro/rain_ice_warm.f90 | 235 +
src/mesonh/micro/read_xker_gweth.f90 | 1737 +++++
src/mesonh/micro/read_xker_raccs.f90 | 4950 ++++++++++++++
src/mesonh/micro/read_xker_rdryg.f90 | 1736 +++++
src/mesonh/micro/read_xker_rweth.f90 | 1733 +++++
src/mesonh/micro/read_xker_sdryg.f90 | 3337 ++++++++++
src/mesonh/micro/read_xker_sweth.f90 | 3337 ++++++++++
src/mesonh/micro/rrcolss.f90 | 312 +
src/mesonh/micro/rscolrg.f90 | 312 +
src/mesonh/micro/rzcolx.f90 | 271 +
src/mesonh/micro/set_conc_lima.f90 | 200 +
src/mesonh/turb/bl89.f90 | 396 ++
src/mesonh/turb/bl_depth_diag.f90 | 200 +
src/mesonh/turb/compute_bl89_ml.f90 | 250 +
src/mesonh/turb/compute_entr_detr.f90 | 488 ++
src/mesonh/turb/compute_frac_ice.f90 | 286 +
.../turb/compute_function_thermo_mf.f90 | 238 +
src/mesonh/turb/compute_mf_cloud.f90 | 196 +
src/mesonh/turb/compute_mf_cloud_bigaus.f90 | 209 +
src/mesonh/turb/compute_mf_cloud_direct.f90 | 119 +
src/mesonh/turb/compute_mf_cloud_stat.f90 | 181 +
src/mesonh/turb/compute_updraft.f90 | 647 ++
src/mesonh/turb/compute_updraft_raha.f90 | 666 ++
src/mesonh/turb/compute_updraft_rhcj10.f90 | 625 ++
src/mesonh/turb/emoist.f90 | 185 +
src/mesonh/turb/etheta.f90 | 180 +
src/mesonh/turb/ini_cturb.f90 | 254 +
src/mesonh/turb/mf_turb.f90 | 332 +
src/mesonh/turb/mf_turb_expl.f90 | 227 +
src/mesonh/turb/mf_turb_greyzone.f90 | 340 +
src/mesonh/turb/modd_cturb.f90 | 91 +
src/mesonh/turb/modd_diag_in_run.f90 | 43 +
src/mesonh/turb/modd_turb_cloud.f90 | 58 +
.../turb/modd_turb_flux_aircraft_balloon.f90 | 54 +
src/mesonh/turb/modd_turbn.f90 | 211 +
src/mesonh/turb/mode_prandtl.f90 | 1399 ++++
src/mesonh/turb/mode_sbl.f90 | 457 ++
src/mesonh/turb/modn_turb.f90 | 47 +
src/mesonh/turb/modn_turb_cloud.f90 | 49 +
src/mesonh/turb/modn_turbn.f90 | 167 +
src/mesonh/turb/prandtl.f90 | 609 ++
src/mesonh/turb/rmc01.f90 | 260 +
src/mesonh/turb/sbl_depth.f90 | 145 +
src/mesonh/turb/shallow_mf.f90 | 437 ++
src/mesonh/turb/shuman_mf.f90 | 445 ++
src/mesonh/turb/thl_rt_from_th_r_mf.f90 | 146 +
src/mesonh/turb/tke_eps_sources.f90 | 485 ++
src/mesonh/turb/tm06.f90 | 165 +
src/mesonh/turb/tm06_h.f90 | 124 +
src/mesonh/turb/tridiag.f90 | 261 +
src/mesonh/turb/tridiag_massflux.f90 | 301 +
src/mesonh/turb/tridiag_thermo.f90 | 297 +
src/mesonh/turb/tridiag_tke.f90 | 266 +
src/mesonh/turb/tridiag_wind.f90 | 267 +
src/mesonh/turb/turb.f90 | 1876 ++++++
src/mesonh/turb/turb_cloud_index.f90 | 344 +
src/mesonh/turb/turb_hor.f90 | 469 ++
src/mesonh/turb/turb_hor_dyn_corr.f90 | 625 ++
src/mesonh/turb/turb_hor_splt.f90 | 632 ++
src/mesonh/turb/turb_hor_sv_corr.f90 | 218 +
src/mesonh/turb/turb_hor_sv_flux.f90 | 364 +
src/mesonh/turb/turb_hor_thermo_corr.f90 | 468 ++
src/mesonh/turb/turb_hor_thermo_flux.f90 | 752 +++
src/mesonh/turb/turb_hor_tke.f90 | 246 +
src/mesonh/turb/turb_hor_uv.f90 | 355 +
src/mesonh/turb/turb_hor_uw.f90 | 299 +
src/mesonh/turb/turb_hor_vw.f90 | 307 +
src/mesonh/turb/turb_ver.f90 | 746 +++
src/mesonh/turb/turb_ver_dyn_flux.f90 | 924 +++
src/mesonh/turb/turb_ver_sv_corr.f90 | 223 +
src/mesonh/turb/turb_ver_sv_flux.f90 | 490 ++
src/mesonh/turb/turb_ver_thermo_corr.f90 | 848 +++
src/mesonh/turb/turb_ver_thermo_flux.f90 | 1109 ++++
228 files changed, 119707 insertions(+)
create mode 100644 src/mesonh/conv/convect_chem_transport.f90
create mode 100644 src/mesonh/conv/convect_closure.f90
create mode 100644 src/mesonh/conv/convect_closure_adjust.f90
create mode 100644 src/mesonh/conv/convect_closure_adjust_shal.f90
create mode 100644 src/mesonh/conv/convect_closure_shal.f90
create mode 100644 src/mesonh/conv/convect_closure_thrvlcl.f90
create mode 100644 src/mesonh/conv/convect_condens.f90
create mode 100644 src/mesonh/conv/convect_downdraft.f90
create mode 100644 src/mesonh/conv/convect_mixing_funct.f90
create mode 100644 src/mesonh/conv/convect_precip_adjust.f90
create mode 100644 src/mesonh/conv/convect_satmixratio.f90
create mode 100644 src/mesonh/conv/convect_trigger_funct.f90
create mode 100644 src/mesonh/conv/convect_trigger_shal.f90
create mode 100644 src/mesonh/conv/convect_tstep_pref.f90
create mode 100644 src/mesonh/conv/convect_updraft.f90
create mode 100644 src/mesonh/conv/convect_updraft_shal.f90
create mode 100644 src/mesonh/conv/deep_convection.f90
create mode 100644 src/mesonh/conv/ini_convpar.f90
create mode 100644 src/mesonh/conv/ini_convpar_e1.f90
create mode 100644 src/mesonh/conv/ini_convpar_shal.f90
create mode 100644 src/mesonh/conv/modd_convpar.f90
create mode 100644 src/mesonh/conv/modd_convpar_shal.f90
create mode 100644 src/mesonh/conv/modd_convparext.f90
create mode 100644 src/mesonh/conv/shallow_convection.f90
create mode 100644 src/mesonh/micro/c2r2_adjust.f90
create mode 100644 src/mesonh/micro/cart_compress.f90
create mode 100644 src/mesonh/micro/condensation.f90
create mode 100644 src/mesonh/micro/gamma.f90
create mode 100644 src/mesonh/micro/gamma_inc.f90
create mode 100644 src/mesonh/micro/general_gamma.f90
create mode 100644 src/mesonh/micro/hypgeo.f90
create mode 100644 src/mesonh/micro/hypser.f90
create mode 100644 src/mesonh/micro/ice4_compute_pdf.f90
create mode 100644 src/mesonh/micro/ice4_fast_rg.f90
create mode 100644 src/mesonh/micro/ice4_fast_rh.f90
create mode 100644 src/mesonh/micro/ice4_fast_ri.f90
create mode 100644 src/mesonh/micro/ice4_fast_rs.f90
create mode 100644 src/mesonh/micro/ice4_nucleation.f90
create mode 100644 src/mesonh/micro/ice4_nucleation_wrapper.f90
create mode 100644 src/mesonh/micro/ice4_rainfr_vert.f90
create mode 100644 src/mesonh/micro/ice4_rimltc.f90
create mode 100644 src/mesonh/micro/ice4_rrhong.f90
create mode 100644 src/mesonh/micro/ice4_rsrimcg_old.f90
create mode 100644 src/mesonh/micro/ice4_sedimentation_split.f90
create mode 100644 src/mesonh/micro/ice4_sedimentation_split_momentum.f90
create mode 100644 src/mesonh/micro/ice4_sedimentation_stat.f90
create mode 100644 src/mesonh/micro/ice4_slow.f90
create mode 100644 src/mesonh/micro/ice4_tendencies.f90
create mode 100644 src/mesonh/micro/ice4_warm.f90
create mode 100644 src/mesonh/micro/ice_adjust.f90
create mode 100644 src/mesonh/micro/ini_cst.f90
create mode 100644 src/mesonh/micro/ini_lima.f90
create mode 100644 src/mesonh/micro/ini_lima_cold_mixed.f90
create mode 100644 src/mesonh/micro/ini_lima_warm.f90
create mode 100644 src/mesonh/micro/ini_neb.f90
create mode 100644 src/mesonh/micro/ini_rain_c2r2.f90
create mode 100644 src/mesonh/micro/ini_rain_ice.f90
create mode 100644 src/mesonh/micro/ini_rain_ice_elec.f90
create mode 100644 src/mesonh/micro/init_aerosol_properties.f90
create mode 100644 src/mesonh/micro/lima.f90
create mode 100644 src/mesonh/micro/lima_adjust.f90
create mode 100644 src/mesonh/micro/lima_adjust_split.f90
create mode 100644 src/mesonh/micro/lima_bergeron.f90
create mode 100644 src/mesonh/micro/lima_ccn_activation.f90
create mode 100644 src/mesonh/micro/lima_ccn_hom_freezing.f90
create mode 100644 src/mesonh/micro/lima_cold.f90
create mode 100644 src/mesonh/micro/lima_cold_hom_nucl.f90
create mode 100644 src/mesonh/micro/lima_cold_sedimentation.f90
create mode 100644 src/mesonh/micro/lima_cold_slow_processes.f90
create mode 100644 src/mesonh/micro/lima_compute_cloud_fractions.f90
create mode 100644 src/mesonh/micro/lima_conversion_melting_snow.f90
create mode 100644 src/mesonh/micro/lima_droplets_accretion.f90
create mode 100644 src/mesonh/micro/lima_droplets_autoconversion.f90
create mode 100644 src/mesonh/micro/lima_droplets_hom_freezing.f90
create mode 100644 src/mesonh/micro/lima_droplets_riming_snow.f90
create mode 100644 src/mesonh/micro/lima_droplets_self_collection.f90
create mode 100644 src/mesonh/micro/lima_drops_break_up.f90
create mode 100644 src/mesonh/micro/lima_drops_hom_freezing.f90
create mode 100644 src/mesonh/micro/lima_drops_self_collection.f90
create mode 100644 src/mesonh/micro/lima_drops_to_droplets_conv.f90
create mode 100644 src/mesonh/micro/lima_functions.f90
create mode 100644 src/mesonh/micro/lima_graupel.f90
create mode 100644 src/mesonh/micro/lima_graupel_deposition.f90
create mode 100644 src/mesonh/micro/lima_ice_aggregation_snow.f90
create mode 100644 src/mesonh/micro/lima_ice_deposition.f90
create mode 100644 src/mesonh/micro/lima_ice_melting.f90
create mode 100644 src/mesonh/micro/lima_ice_snow_deposition.f90
create mode 100644 src/mesonh/micro/lima_init_ccn_activation_spectrum.f90
create mode 100644 src/mesonh/micro/lima_inst_procs.f90
create mode 100644 src/mesonh/micro/lima_meyers.f90
create mode 100644 src/mesonh/micro/lima_meyers_nucleation.f90
create mode 100644 src/mesonh/micro/lima_mixed.f90
create mode 100644 src/mesonh/micro/lima_mixed_fast_processes.f90
create mode 100644 src/mesonh/micro/lima_mixed_slow_processes.f90
create mode 100644 src/mesonh/micro/lima_mixrat_to_nconc.f90
create mode 100644 src/mesonh/micro/lima_notadjust.f90
create mode 100644 src/mesonh/micro/lima_nucleation_procs.f90
create mode 100644 src/mesonh/micro/lima_phillips.f90
create mode 100644 src/mesonh/micro/lima_phillips_ifn_nucleation.f90
create mode 100644 src/mesonh/micro/lima_phillips_integ.f90
create mode 100644 src/mesonh/micro/lima_phillips_ref_spectrum.f90
create mode 100644 src/mesonh/micro/lima_precip_scavenging.f90
create mode 100644 src/mesonh/micro/lima_rain_accr_snow.f90
create mode 100644 src/mesonh/micro/lima_rain_evaporation.f90
create mode 100644 src/mesonh/micro/lima_rain_freezing.f90
create mode 100644 src/mesonh/micro/lima_read_xker_gweth.f90
create mode 100644 src/mesonh/micro/lima_read_xker_raccs.f90
create mode 100644 src/mesonh/micro/lima_read_xker_rdryg.f90
create mode 100644 src/mesonh/micro/lima_read_xker_sdryg.f90
create mode 100644 src/mesonh/micro/lima_read_xker_sweth.f90
create mode 100644 src/mesonh/micro/lima_sedimentation.f90
create mode 100644 src/mesonh/micro/lima_snow_deposition.f90
create mode 100644 src/mesonh/micro/lima_tendencies.f90
create mode 100644 src/mesonh/micro/lima_warm.f90
create mode 100644 src/mesonh/micro/lima_warm_coal.f90
create mode 100644 src/mesonh/micro/lima_warm_evap.f90
create mode 100644 src/mesonh/micro/lima_warm_nucl.f90
create mode 100644 src/mesonh/micro/lima_warm_sedimentation.f90
create mode 100644 src/mesonh/micro/modd_blankn.f90
create mode 100644 src/mesonh/micro/modd_conf.f90
create mode 100644 src/mesonh/micro/modd_cst.f90
create mode 100644 src/mesonh/micro/modd_dyn.f90
create mode 100644 src/mesonh/micro/modd_elec_descr.f90
create mode 100644 src/mesonh/micro/modd_les.f90
create mode 100644 src/mesonh/micro/modd_lima_precip_scavengingn.f90
create mode 100644 src/mesonh/micro/modd_lunit.f90
create mode 100644 src/mesonh/micro/modd_neb.f90
create mode 100644 src/mesonh/micro/modd_nsv.f90
create mode 100644 src/mesonh/micro/modd_param_c1r3.f90
create mode 100644 src/mesonh/micro/modd_param_c2r2.f90
create mode 100644 src/mesonh/micro/modd_param_ice.f90
create mode 100644 src/mesonh/micro/modd_param_lima.f90
create mode 100644 src/mesonh/micro/modd_param_lima_cold.f90
create mode 100644 src/mesonh/micro/modd_param_lima_mixed.f90
create mode 100644 src/mesonh/micro/modd_param_lima_warm.f90
create mode 100644 src/mesonh/micro/modd_parameters.f90
create mode 100644 src/mesonh/micro/modd_rain_c2r2_descr.f90
create mode 100644 src/mesonh/micro/modd_rain_c2r2_khko_param.f90
create mode 100644 src/mesonh/micro/modd_rain_ice_descr.f90
create mode 100644 src/mesonh/micro/modd_rain_ice_param.f90
create mode 100644 src/mesonh/micro/modn_param_lima.f90
create mode 100644 src/mesonh/micro/prognos_lima.f90
create mode 100644 src/mesonh/micro/radar_rain_ice.f90
create mode 100644 src/mesonh/micro/rain_c2r2_khko.f90
create mode 100644 src/mesonh/micro/rain_ice.f90
create mode 100644 src/mesonh/micro/rain_ice_elec.f90
create mode 100644 src/mesonh/micro/rain_ice_fast_rg.f90
create mode 100644 src/mesonh/micro/rain_ice_fast_rh.f90
create mode 100644 src/mesonh/micro/rain_ice_fast_ri.f90
create mode 100644 src/mesonh/micro/rain_ice_fast_rs.f90
create mode 100644 src/mesonh/micro/rain_ice_nucleation.f90
create mode 100644 src/mesonh/micro/rain_ice_red.f90
create mode 100644 src/mesonh/micro/rain_ice_sedimentation_split.f90
create mode 100644 src/mesonh/micro/rain_ice_sedimentation_stat.f90
create mode 100644 src/mesonh/micro/rain_ice_slow.f90
create mode 100644 src/mesonh/micro/rain_ice_warm.f90
create mode 100644 src/mesonh/micro/read_xker_gweth.f90
create mode 100644 src/mesonh/micro/read_xker_raccs.f90
create mode 100644 src/mesonh/micro/read_xker_rdryg.f90
create mode 100644 src/mesonh/micro/read_xker_rweth.f90
create mode 100644 src/mesonh/micro/read_xker_sdryg.f90
create mode 100644 src/mesonh/micro/read_xker_sweth.f90
create mode 100644 src/mesonh/micro/rrcolss.f90
create mode 100644 src/mesonh/micro/rscolrg.f90
create mode 100644 src/mesonh/micro/rzcolx.f90
create mode 100644 src/mesonh/micro/set_conc_lima.f90
create mode 100644 src/mesonh/turb/bl89.f90
create mode 100644 src/mesonh/turb/bl_depth_diag.f90
create mode 100644 src/mesonh/turb/compute_bl89_ml.f90
create mode 100644 src/mesonh/turb/compute_entr_detr.f90
create mode 100644 src/mesonh/turb/compute_frac_ice.f90
create mode 100644 src/mesonh/turb/compute_function_thermo_mf.f90
create mode 100644 src/mesonh/turb/compute_mf_cloud.f90
create mode 100644 src/mesonh/turb/compute_mf_cloud_bigaus.f90
create mode 100644 src/mesonh/turb/compute_mf_cloud_direct.f90
create mode 100644 src/mesonh/turb/compute_mf_cloud_stat.f90
create mode 100644 src/mesonh/turb/compute_updraft.f90
create mode 100644 src/mesonh/turb/compute_updraft_raha.f90
create mode 100644 src/mesonh/turb/compute_updraft_rhcj10.f90
create mode 100644 src/mesonh/turb/emoist.f90
create mode 100644 src/mesonh/turb/etheta.f90
create mode 100644 src/mesonh/turb/ini_cturb.f90
create mode 100644 src/mesonh/turb/mf_turb.f90
create mode 100644 src/mesonh/turb/mf_turb_expl.f90
create mode 100644 src/mesonh/turb/mf_turb_greyzone.f90
create mode 100644 src/mesonh/turb/modd_cturb.f90
create mode 100644 src/mesonh/turb/modd_diag_in_run.f90
create mode 100644 src/mesonh/turb/modd_turb_cloud.f90
create mode 100644 src/mesonh/turb/modd_turb_flux_aircraft_balloon.f90
create mode 100644 src/mesonh/turb/modd_turbn.f90
create mode 100644 src/mesonh/turb/mode_prandtl.f90
create mode 100644 src/mesonh/turb/mode_sbl.f90
create mode 100644 src/mesonh/turb/modn_turb.f90
create mode 100644 src/mesonh/turb/modn_turb_cloud.f90
create mode 100644 src/mesonh/turb/modn_turbn.f90
create mode 100644 src/mesonh/turb/prandtl.f90
create mode 100644 src/mesonh/turb/rmc01.f90
create mode 100644 src/mesonh/turb/sbl_depth.f90
create mode 100644 src/mesonh/turb/shallow_mf.f90
create mode 100644 src/mesonh/turb/shuman_mf.f90
create mode 100644 src/mesonh/turb/thl_rt_from_th_r_mf.f90
create mode 100644 src/mesonh/turb/tke_eps_sources.f90
create mode 100644 src/mesonh/turb/tm06.f90
create mode 100644 src/mesonh/turb/tm06_h.f90
create mode 100644 src/mesonh/turb/tridiag.f90
create mode 100644 src/mesonh/turb/tridiag_massflux.f90
create mode 100644 src/mesonh/turb/tridiag_thermo.f90
create mode 100644 src/mesonh/turb/tridiag_tke.f90
create mode 100644 src/mesonh/turb/tridiag_wind.f90
create mode 100644 src/mesonh/turb/turb.f90
create mode 100644 src/mesonh/turb/turb_cloud_index.f90
create mode 100644 src/mesonh/turb/turb_hor.f90
create mode 100644 src/mesonh/turb/turb_hor_dyn_corr.f90
create mode 100644 src/mesonh/turb/turb_hor_splt.f90
create mode 100644 src/mesonh/turb/turb_hor_sv_corr.f90
create mode 100644 src/mesonh/turb/turb_hor_sv_flux.f90
create mode 100644 src/mesonh/turb/turb_hor_thermo_corr.f90
create mode 100644 src/mesonh/turb/turb_hor_thermo_flux.f90
create mode 100644 src/mesonh/turb/turb_hor_tke.f90
create mode 100644 src/mesonh/turb/turb_hor_uv.f90
create mode 100644 src/mesonh/turb/turb_hor_uw.f90
create mode 100644 src/mesonh/turb/turb_hor_vw.f90
create mode 100644 src/mesonh/turb/turb_ver.f90
create mode 100644 src/mesonh/turb/turb_ver_dyn_flux.f90
create mode 100644 src/mesonh/turb/turb_ver_sv_corr.f90
create mode 100644 src/mesonh/turb/turb_ver_sv_flux.f90
create mode 100644 src/mesonh/turb/turb_ver_thermo_corr.f90
create mode 100644 src/mesonh/turb/turb_ver_thermo_flux.f90
diff --git a/src/mesonh/conv/convect_chem_transport.f90 b/src/mesonh/conv/convect_chem_transport.f90
new file mode 100644
index 000000000..c515f25b0
--- /dev/null
+++ b/src/mesonh/conv/convect_chem_transport.f90
@@ -0,0 +1,295 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 conv 2006/05/18 13:07:25
+!-----------------------------------------------------------------
+! #################
+ MODULE MODI_CONVECT_CHEM_TRANSPORT
+! #################
+!
+INTERFACE
+!
+ SUBROUTINE CONVECT_CHEM_TRANSPORT( KLON, KLEV, KCH, PCH1, PCH1C, &
+ KDPL, KPBL, KLCL, KCTL, KLFS, KDBL, &
+ PUMF, PUER, PUDR, PDMF, PDER, PDDR, &
+ PTIMEC, PDXDY, PMIXF, PLMASS, PWSUB,&
+ KFTSTEPS )
+
+!
+INTEGER, INTENT(IN) :: KLON ! horizontal dimension
+INTEGER, INTENT(IN) :: KLEV ! vertical dimension
+INTEGER, INTENT(IN) :: KCH ! number of passive tracers
+!
+REAL,DIMENSION(KLON,KLEV,KCH),INTENT(IN) :: PCH1 ! grid scale tracer concentr.
+REAL,DIMENSION(KLON,KLEV,KCH),INTENT(OUT):: PCH1C! conv adjusted tracer concntr.
+!
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KDPL ! index for departure level
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KPBL ! index for top of source layer
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KLCL ! index lifting condens. level
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KCTL ! index for cloud top level
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KLFS ! index for level of free sink
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KDBL ! index for downdraft base level
+!
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PUMF ! updraft mass flux (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PUER ! updraft entrainment (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PUDR ! updraft detrainment (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PDMF ! downdraft mass flux (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PDER ! downdraft entrainment (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PDDR ! downdraft detrainment (kg/s)
+!
+REAL, DIMENSION(KLON), INTENT(IN) :: PTIMEC! convection time step
+REAL, DIMENSION(KLON), INTENT(IN) :: PDXDY ! grid area (m^2)
+REAL, DIMENSION(KLON), INTENT(IN) :: PMIXF ! mixed fraction at LFS
+REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PLMASS! mass of model layer (kg)
+REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PWSUB ! envir. compensating subsidence(Pa/s)
+INTEGER, INTENT(IN) :: KFTSTEPS ! maximum fractional time steps
+!
+END SUBROUTINE CONVECT_CHEM_TRANSPORT
+!
+END INTERFACE
+!
+END MODULE MODI_CONVECT_CHEM_TRANSPORT
+! ########################################################################
+ SUBROUTINE CONVECT_CHEM_TRANSPORT( KLON, KLEV, KCH, PCH1, PCH1C, &
+ KDPL, KPBL, KLCL, KCTL, KLFS, KDBL, &
+ PUMF, PUER, PUDR, PDMF, PDER, PDDR, &
+ PTIMEC, PDXDY, PMIXF, PLMASS, PWSUB,&
+ KFTSTEPS )
+! ########################################################################
+!
+!!**** Compute modified chemical tracer values due to convective event
+!!
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to determine the final adjusted
+!! environmental values of the chemical tracers
+!! The final convective tendencies can then be evaluated in the main
+!! routine DEEP_CONVECT by (PCH1C-PCH1)/PTIMEC
+!!
+!!
+!!** METHOD
+!! ------
+!! Identical to the computation of the conservative variables in the
+!! main deep convection code
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST
+!! XG ! gravity constant
+!!
+!! Module MODD_CONVPAREXT
+!! JCVEXB, JCVEXT ! extra levels on the vertical boundaries
+!!
+!! AUTHOR
+!! ------
+!! P. BECHTOLD * Laboratoire d'Aerologie *
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!! Original 11/12/97
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_CONVPAREXT
+USE MODD_NSV, ONLY : NSV_LGBEG,NSV_LGEND
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KLON ! horizontal dimension
+INTEGER, INTENT(IN) :: KLEV ! vertical dimension
+INTEGER, INTENT(IN) :: KCH ! number of passive tracers
+!
+REAL,DIMENSION(KLON,KLEV,KCH),INTENT(IN) :: PCH1 ! grid scale tracer concentr.
+REAL,DIMENSION(KLON,KLEV,KCH),INTENT(OUT):: PCH1C! conv adjusted tracer concntr.
+!
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KDPL ! index for departure level
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KPBL ! index for top of source layer
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KLCL ! index lifting condens. level
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KCTL ! index for cloud top level
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KLFS ! index for level of free sink
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KDBL ! index for downdraft base level
+!
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PUMF ! updraft mass flux (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PUER ! updraft entrainment (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PUDR ! updraft detrainment (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PDMF ! downdraft mass flux (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PDER ! downdraft entrainment (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PDDR ! downdraft detrainment (kg/s)
+!
+REAL, DIMENSION(KLON), INTENT(IN) :: PTIMEC! convection time step
+REAL, DIMENSION(KLON), INTENT(IN) :: PDXDY ! grid area (m^2)
+REAL, DIMENSION(KLON), INTENT(IN) :: PMIXF ! mixed fraction at LFS
+REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PLMASS! mass of model layer (kg)
+REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PWSUB ! envir. compensating subsidence(Pa/s)
+INTEGER, INTENT(IN) :: KFTSTEPS ! maximum fractional time steps
+!
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: INCH1 ! number of chemical tracers
+INTEGER :: IIE, IKB, IKE ! horizontal + vertical loop bounds
+INTEGER :: IKS ! vertical dimension
+INTEGER :: JI ! horizontal loop index
+INTEGER :: JK, JKP ! vertical loop index
+INTEGER :: JN ! chemical tracer loop index
+INTEGER :: JSTEP ! fractional time loop index
+INTEGER :: JKLD, JKLP, JKMAX ! loop index for levels
+!
+REAL, DIMENSION(KLON,KLEV) :: ZOMG ! compensat. subsidence (Pa/s)
+REAL, DIMENSION(KLON,KLEV,KCH) :: ZUCH1, ZDCH1 ! updraft/downdraft values
+REAL, DIMENSION(KLON) :: ZTIMEC ! fractional convective time step
+REAL, DIMENSION(KLON,KLEV) :: ZTIMC! 2D work array for ZTIMEC
+REAL, DIMENSION(KLON,KLEV,KCH) :: ZCH1MFIN, ZCH1MFOUT
+ ! work arrays for environm. compensat. mass
+REAL, DIMENSION(KLON,KCH) :: ZWORK1, ZWORK2, ZWORK3
+!
+!-------------------------------------------------------------------------------
+!
+!* 0.3 Compute loop bounds
+! -------------------
+!
+INCH1 = KCH
+IIE = KLON
+IKB = 1 + JCVEXB
+IKS = KLEV
+IKE = KLEV - JCVEXT
+JKMAX = MAXVAL( KCTL(:) )
+!
+!
+!* 2. Updraft computations
+! --------------------
+!
+ZUCH1(:,:,:) = 0.
+!
+!* 2.1 Initialization at LCL
+! ----------------------------------
+!
+DO JI = 1, IIE
+ JKLD = KDPL(JI)
+ JKLP = KPBL(JI)
+ ZWORK1(JI,:) = .5 * ( PCH1(JI,JKLD,:) + PCH1(JI,JKLP,:) )
+END DO
+!
+!* 2.2 Final updraft loop
+! ------------------
+!
+DO JK = MINVAL( KDPL(:) ), JKMAX
+JKP = JK + 1
+!
+ DO JN = 1, INCH1
+ DO JI = 1, IIE
+ IF ( KDPL(JI) <= JK .AND. KLCL(JI) > JK ) &
+ ZUCH1(JI,JK,JN) = ZWORK1(JI,JN)
+!
+ IF ( KLCL(JI) - 1 <= JK .AND. KCTL(JI) > JK ) THEN
+ ZUCH1(JI,JKP,JN) = ZUCH1(JI,JK,JN)
+ !if you have reactive i.e. non-passive tracers
+ ! update their values here and add the corresponding
+ ! sink term in the following equation
+ ZUCH1(JI,JKP,JN) = ( PUMF(JI,JK) * ZUCH1(JI,JK,JN) + &
+ PUER(JI,JKP) * PCH1(JI,JK,JN) ) / &
+ ( PUMF(JI,JKP) + PUDR(JI,JKP) + 1.E-7 )
+ END IF
+ END DO
+ END DO
+!
+END DO
+!
+!* 3. Downdraft computations
+! ----------------------
+!
+ZDCH1(:,:,:) = 0.
+!
+!* 3.1 Initialization at the LFS
+! -------------------------
+!
+ZWORK1(:,:) = SPREAD( PMIXF(:), DIM=2, NCOPIES=INCH1 )
+DO JI = 1, IIE
+ JK = KLFS(JI)
+ ZDCH1(JI,JK,:) = ZWORK1(JI,:) * PCH1(JI,JK,:) + &
+ ( 1. - ZWORK1(JI,:) ) * ZUCH1(JI,JK,:)
+END DO
+!
+!* 3.2 Final downdraft loop
+! --------------------
+!
+DO JK = MAXVAL( KLFS(:) ), IKB + 1, -1
+JKP = JK - 1
+ DO JN = 1, INCH1
+ DO JI = 1, IIE
+ IF ( JK <= KLFS(JI) .AND. JKP >= KDBL(JI) ) THEN
+ ZDCH1(JI,JKP,JN) = ( ZDCH1(JI,JK,JN) * PDMF(JI,JK) - &
+ PCH1(JI,JK,JN) * PDER(JI,JKP) ) / &
+ ( PDMF(JI,JKP) - PDDR(JI,JKP) - 1.E-7 )
+ END IF
+ END DO
+ END DO
+END DO
+!
+!
+!* 4. Final closure (environmental) computations
+! ------------------------------------------
+!
+PCH1C(:,IKB:IKE,:) = PCH1(:,IKB:IKE,:) ! initialize adjusted envir. values
+!
+DO JK = IKB, IKE
+ ZOMG(:,JK) = PWSUB(:,JK) * PDXDY(:) / XG ! environmental subsidence
+END DO
+!
+ZTIMEC(:) = PTIMEC(:) / REAL( KFTSTEPS ) ! adjust fractional time step
+ ! to be an integer multiple of PTIMEC
+WHERE ( PTIMEC(:) < 1. ) ZTIMEC(:) = 0.
+ZTIMC(:,:)= SPREAD( ZTIMEC(:), DIM=2, NCOPIES=IKS )
+!
+ZCH1MFIN(:,:,:) = 0.
+ZCH1MFOUT(:,:,:) = 0.
+!
+DO JSTEP = 1, KFTSTEPS ! Enter the fractional time step loop
+!
+ DO JK = IKB + 1, JKMAX
+ JKP = MAX( IKB + 1, JK - 1 )
+ ZWORK3(:,:) = SPREAD( ZOMG(:,JK), DIM=2, NCOPIES=INCH1 )
+ ZWORK1(:,:) = SIGN( 1., ZWORK3(:,:) )
+ ZWORK2(:,:) = 0.5 * ( 1. + ZWORK1(:,:) )
+ ZWORK1(:,:) = 0.5 * ( 1. - ZWORK1(:,:) )
+ ZCH1MFIN(:,JK,:) = - ZWORK3(:,:) * PCH1C(:,JKP,:) * ZWORK1(:,:)
+ ZCH1MFOUT(:,JK,:) = ZWORK3(:,:) * PCH1C(:,JK,:) * ZWORK2(:,:)
+ ZCH1MFIN(:,JKP,:) = ZCH1MFIN(:,JKP,:) + ZCH1MFOUT(:,JK,:) * ZWORK2(:,:)
+ ZCH1MFOUT(:,JKP,:)= ZCH1MFOUT(:,JKP,:) + ZCH1MFIN(:,JK,:) * ZWORK1(:,:)
+ END DO
+!
+ DO JN = 1, INCH1
+ DO JK = IKB + 1, JKMAX
+ PCH1C(:,JK,JN) = PCH1C(:,JK,JN) + ZTIMC(:,JK) / PLMASS(:,JK) * ( &
+ ZCH1MFIN(:,JK,JN) + PUDR(:,JK) * ZUCH1(:,JK,JN) + &
+ PDDR(:,JK) * ZDCH1(:,JK,JN) - ZCH1MFOUT(:,JK,JN) - &
+ ( PUER(:,JK) + PDER(:,JK) ) * PCH1(:,JK,JN) )
+ IF(JN < NSV_LGBEG .OR. JN>NSV_LGEND-1) THEN
+ PCH1C(:,JK,JN) = MAX( 0., PCH1C(:,JK,JN) )
+ ELSE
+ ! no tendency for horizontal Lagrangian variables
+ PCH1C(:,JK,JN) = PCH1(:,JK,JN)
+ END IF
+ END DO
+ END DO
+!
+END DO ! Exit the fractional time step loop
+!
+!
+END SUBROUTINE CONVECT_CHEM_TRANSPORT
diff --git a/src/mesonh/conv/convect_closure.f90 b/src/mesonh/conv/convect_closure.f90
new file mode 100644
index 000000000..f94e9bf86
--- /dev/null
+++ b/src/mesonh/conv/convect_closure.f90
@@ -0,0 +1,755 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 conv 2006/05/18 13:07:25
+!-----------------------------------------------------------------
+! #################
+ MODULE MODI_CONVECT_CLOSURE
+! #################
+!
+INTERFACE
+!
+ SUBROUTINE CONVECT_CLOSURE( KLON, KLEV, &
+ PPRES, PDPRES, PZ, PDXDY, PLMASS, &
+ PTHL, PTH, PRW, PRC, PRI, OTRIG1, &
+ PTHC, PRWC, PRCC, PRIC, PWSUB, &
+ KLCL, KDPL, KPBL, KLFS, KCTL, KML, &
+ PUMF, PUER, PUDR, PUTHL, PURW, &
+ PURC, PURI, PUPR, &
+ PDMF, PDER, PDDR, PDTHL, PDRW, &
+ PTPR, PSPR, PDTEVR, &
+ PCAPE, PTIMEC, &
+ KFTSTEPS, &
+ PDTEVRF, PPRLFLX, PPRSFLX )
+!
+INTEGER, INTENT(IN) :: KLON ! horizontal dimension
+INTEGER, INTENT(IN) :: KLEV ! vertical dimension
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KLFS ! index for level of free sink
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KLCL ! index lifting condens. level
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KCTL ! index for cloud top level
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KDPL ! index for departure level
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KPBL ! index for top of source layer
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KML ! index for melting level
+REAL, DIMENSION(KLON), INTENT(INOUT) :: PTIMEC ! convection time step
+REAL, DIMENSION(KLON), INTENT(IN) :: PDXDY ! grid area (m^2)
+REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PTHL ! grid scale enthalpy (J/kg)
+REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PTH ! grid scale theta
+REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PRW ! grid scale total water
+ ! mixing ratio
+REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PRC ! grid scale r_c
+REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PRI ! grid scale r_i
+LOGICAL, DIMENSION(KLON), INTENT(IN) :: OTRIG1 ! logical to keep trace of
+ ! convective arrays modified in UPDRAFT
+!
+!
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PPRES ! pressure (P)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PDPRES ! pressure difference between
+ ! bottom and top of layer (Pa)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PLMASS ! mass of model layer (kg)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PZ ! height of model layer (m)
+REAL, DIMENSION(KLON), INTENT(IN) :: PCAPE ! available potent. energy
+INTEGER, INTENT(OUT) :: KFTSTEPS! maximum of fract time steps
+ ! only used for chemical tracers
+!
+!
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PUMF ! updraft mass flux (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PUER ! updraft entrainment (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PUDR ! updraft detrainment (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PUPR ! updraft precipitation in
+ ! flux units (kg water / s)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PUTHL ! updraft enthalpy (J/kg)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PURW ! updraft total water (kg/kg)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PURC ! updraft cloud water (kg/kg)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PURI ! updraft cloud ice (kg/kg)
+!
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PDMF ! downdraft mass flux (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PDER ! downdraft entrainment (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PDDR ! downdraft detrainment (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PDTHL ! downdraft enthalpy (J/kg)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PDRW ! downdraft total water (kg/kg)
+REAL, DIMENSION(KLON), INTENT(INOUT):: PTPR ! total surf precipitation (kg/s)
+REAL, DIMENSION(KLON), INTENT(OUT) :: PSPR ! solid surf precipitation (kg/s)
+REAL, DIMENSION(KLON), INTENT(INOUT):: PDTEVR! donwndraft evapor. (kg/s)
+!
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT) :: PTHC ! conv. adj. grid scale theta
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT) :: PRWC ! conv. adj. grid scale r_w
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT) :: PRCC ! conv. adj. grid scale r_c
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT) :: PRIC ! conv. adj. grid scale r_i
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT) :: PWSUB ! envir. compensating subsidence(Pa/s)
+!
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PDTEVRF! downdraft evaporation rate
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT) :: PPRLFLX! liquid precip flux
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT) :: PPRSFLX! solid precip flux
+!
+END SUBROUTINE CONVECT_CLOSURE
+!
+END INTERFACE
+!
+END MODULE MODI_CONVECT_CLOSURE
+! #########################################################################
+ SUBROUTINE CONVECT_CLOSURE( KLON, KLEV, &
+ PPRES, PDPRES, PZ, PDXDY, PLMASS, &
+ PTHL, PTH, PRW, PRC, PRI, OTRIG1, &
+ PTHC, PRWC, PRCC, PRIC, PWSUB, &
+ KLCL, KDPL, KPBL, KLFS, KCTL, KML, &
+ PUMF, PUER, PUDR, PUTHL, PURW, &
+ PURC, PURI, PUPR, &
+ PDMF, PDER, PDDR, PDTHL, PDRW, &
+ PTPR, PSPR, PDTEVR, &
+ PCAPE, PTIMEC, &
+ KFTSTEPS, &
+ PDTEVRF, PPRLFLX, PPRSFLX )
+! #########################################################################
+!
+!!**** Uses modified Fritsch-Chappell closure
+!!
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to determine the final adjusted
+!! (over a time step PTIMEC) environmental values of THETA_l, R_w, R_c, R_i
+!! The final convective tendencies can then be evaluated in the main
+!! routine DEEP_CONVECT by (PTHC-PTH)/PTIMEC
+!!
+!!
+!!** METHOD
+!! ------
+!! Computations are done at every model level starting from bottom.
+!! The use of masks allows to optimise the inner loops (horizontal loops).
+!!
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!! CONVECT_CLOSURE_THRVLCL
+!! CONVECT_CLOSURE_ADJUST
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST
+!! XG ! gravity constant
+!! XP00 ! reference pressure
+!! XRD, XRV ! gaz constants for dry air and water vapor
+!! XCPD, XCPV ! specific heat for dry air and water vapor
+!! XCL, XCI ! specific heat for liquid water and ice
+!! XTT ! triple point temperature
+!! XLVTT, XLSTT ! vaporization, sublimation heat constant
+!!
+!! Module MODD_CONVPAR
+!! XA25 ! reference grid area
+!! XSTABT ! stability factor in time integration
+!! XSTABC ! stability factor in CAPE adjustment
+!! XMELDPTH ! allow melting over specific pressure depth
+!!
+!! Module MODD_CONVPAREXT
+!! JCVEXB, JCVEXT ! extra levels on the vertical boundaries
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Book1,2 of documentation ( routine CONVECT_CLOSURE)
+!! Fritsch and Chappell, 1980, J. Atmos. Sci.
+!! Kain and Fritsch, 1993, Meteor. Monographs, Vol.
+!!
+!! AUTHOR
+!! ------
+!! P. BECHTOLD * Laboratoire d'Aerologie *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 26/03/96
+!! Peter Bechtold 04/10/97 change for enthalpie, r_c + r_i tendencies
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_CONVPAR
+USE MODD_CONVPAREXT
+!
+USE MODI_CONVECT_SATMIXRATIO
+USE MODI_CONVECT_CLOSURE_THRVLCL
+USE MODI_CONVECT_CLOSURE_ADJUST
+!
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KLON ! horizontal dimension
+INTEGER, INTENT(IN) :: KLEV ! vertical dimension
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KLFS ! index for level of free sink
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KLCL ! index lifting condens. level
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KCTL ! index for cloud top level
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KDPL ! index for departure level
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KPBL ! index for top of source layer
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KML ! index for melting level
+REAL, DIMENSION(KLON), INTENT(INOUT) :: PTIMEC ! convection time step
+REAL, DIMENSION(KLON), INTENT(IN) :: PDXDY ! grid area (m^2)
+REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PTHL ! grid scale enthalpy (J/kg)
+REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PTH ! grid scale theta
+REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PRW ! grid scale total water
+ ! mixing ratio
+REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PRC ! grid scale r_c
+REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PRI ! grid scale r_i
+LOGICAL, DIMENSION(KLON), INTENT(IN) :: OTRIG1 ! logical to keep trace of
+ ! convective arrays modified in UPDRAFT
+!
+!
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PPRES ! pressure (P)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PDPRES ! pressure difference between
+ ! bottom and top of layer (Pa)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PLMASS ! mass of model layer (kg)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PZ ! height of model layer (m)
+REAL, DIMENSION(KLON), INTENT(IN) :: PCAPE ! available potent. energy
+INTEGER, INTENT(OUT) :: KFTSTEPS! maximum of fract time steps
+ ! only used for chemical tracers
+!
+!
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PUMF ! updraft mass flux (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PUER ! updraft entrainment (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PUDR ! updraft detrainment (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PUPR ! updraft precipitation in
+ ! flux units (kg water / s)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PUTHL ! updraft enthalpy (J/kg)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PURW ! updraft total water (kg/kg)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PURC ! updraft cloud water (kg/kg)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PURI ! updraft cloud ice (kg/kg)
+!
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PDMF ! downdraft mass flux (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PDER ! downdraft entrainment (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PDDR ! downdraft detrainment (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PDTHL ! downdraft enthalpy (J/kg)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PDRW ! downdraft total water (kg/kg)
+REAL, DIMENSION(KLON), INTENT(INOUT):: PTPR ! total surf precipitation (kg/s)
+REAL, DIMENSION(KLON), INTENT(OUT) :: PSPR ! solid surf precipitation (kg/s)
+REAL, DIMENSION(KLON), INTENT(INOUT):: PDTEVR! donwndraft evapor. (kg/s)
+!
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT) :: PTHC ! conv. adj. grid scale theta
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT) :: PRWC ! conv. adj. grid scale r_w
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT) :: PRCC ! conv. adj. grid scale r_c
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT) :: PRIC ! conv. adj. grid scale r_i
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT) :: PWSUB ! envir. compensating subsidence(Pa/s)
+!
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PDTEVRF! downdraft evaporation rate
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT) :: PPRLFLX! liquid precip flux
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT) :: PPRSFLX! solid precip flux
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IIE, IKB, IKE ! horizontal + vertical loop bounds
+INTEGER :: IKS ! vertical dimension
+INTEGER :: JK, JKP, JKMAX ! vertical loop index
+INTEGER :: JI ! horizontal loop index
+INTEGER :: JITER ! iteration loop index
+INTEGER :: JSTEP ! fractional time loop index
+REAL :: ZCPORD, ZRDOCP ! C_pd / R_d, R_d / C_pd
+!
+REAL, DIMENSION(KLON,KLEV) :: ZTHLC ! convectively adjusted
+ ! grid scale enthalpy
+REAL, DIMENSION(KLON,KLEV) :: ZOMG ! conv. environm. subsidence (Pa/s)
+REAL, DIMENSION(KLON,KLEV) :: ZUMF ! non-adjusted updraft mass flux
+REAL, DIMENSION(KLON,KLEV) :: ZUER ! " updraft entrainm. rate
+REAL, DIMENSION(KLON,KLEV) :: ZUDR ! " updraft detrainm. rate
+REAL, DIMENSION(KLON,KLEV) :: ZDMF ! " downdraft mass flux
+REAL, DIMENSION(KLON,KLEV) :: ZDER ! " downdraft entrainm. rate
+REAL, DIMENSION(KLON,KLEV) :: ZDDR ! " downdraft detrainm. rate
+REAL, DIMENSION(KLON) :: ZTPR ! " total precipitation
+REAL, DIMENSION(KLON) :: ZDTEVR ! " total downdraft evapor.
+REAL, DIMENSION(KLON,KLEV):: ZPRLFLX ! " liquid precip flux
+REAL, DIMENSION(KLON,KLEV):: ZPRSFLX ! " solid precip flux
+REAL, DIMENSION(KLON) :: ZPRMELT ! melting of precipitation
+REAL, DIMENSION(KLON) :: ZPRMELTO ! non-adjusted "
+REAL, DIMENSION(KLON) :: ZADJ ! mass adjustment factor
+REAL, DIMENSION(KLON) :: ZADJMAX ! limit value for ZADJ
+REAL, DIMENSION(KLON) :: ZCAPE ! new CAPE after adjustment
+REAL, DIMENSION(KLON) :: ZTIMEC ! fractional convective time step
+REAL, DIMENSION(KLON,KLEV):: ZTIMC ! 2D work array for ZTIMEC
+!
+REAL, DIMENSION(KLON) :: ZTHLCL ! new theta at LCL
+REAL, DIMENSION(KLON) :: ZRVLCL ! new r_v at LCL
+REAL, DIMENSION(KLON) :: ZZLCL ! height of LCL
+REAL, DIMENSION(KLON) :: ZTLCL ! temperature at LCL
+REAL, DIMENSION(KLON) :: ZTELCL ! envir. temper. at LCL
+REAL, DIMENSION(KLON) :: ZTHEUL ! theta_e for undilute ascent
+REAL, DIMENSION(KLON) :: ZTHES1, ZTHES2! saturation environm. theta_e
+REAL, DIMENSION(KLON,KLEV) :: ZTHMFIN, ZTHMFOUT, ZRWMFIN, ZRWMFOUT
+REAL, DIMENSION(KLON,KLEV) :: ZRCMFIN, ZRCMFOUT, ZRIMFIN, ZRIMFOUT
+ ! work arrays for environm. compensat. mass flux
+REAL, DIMENSION(KLON) :: ZPI ! (P/P00)**R_d/C_pd
+REAL, DIMENSION(KLON) :: ZLV ! latent heat of vaporisation
+REAL, DIMENSION(KLON) :: ZLS ! latent heat of sublimation
+REAL, DIMENSION(KLON) :: ZLM ! latent heat of melting
+REAL, DIMENSION(KLON) :: ZCPH ! specific heat C_ph
+REAL, DIMENSION(KLON) :: ZMELDPTH ! actual depth of melting layer
+INTEGER, DIMENSION(KLON) :: ITSTEP ! fractional convective time step
+INTEGER, DIMENSION(KLON) :: ICOUNT ! timestep counter
+INTEGER, DIMENSION(KLON) :: ILCL ! index lifting condens. level
+INTEGER, DIMENSION(KLON) :: IWORK1 ! work array
+REAL, DIMENSION(KLON) :: ZWORK1, ZWORK2, ZWORK3, ZWORK4, ZWORK5
+REAL, DIMENSION(KLON,KLEV):: ZWORK6
+LOGICAL, DIMENSION(KLON) :: GWORK1, GWORK3! work arrays
+LOGICAL, DIMENSION(KLON,KLEV) :: GWORK4 ! work array
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 0.2 Initialize local variables
+! ----------------------------
+!
+!
+PSPR(:) = 0.
+ZTIMC(:,:) = 0.
+ZTHES2(:) = 0.
+ZWORK1(:) = 0.
+ZWORK2(:) = 0.
+ZWORK3(:) = 0.
+ZWORK4(:) = 0.
+ZWORK5(:) = 0.
+GWORK1(:) = .FALSE.
+GWORK3(:) = .FALSE.
+GWORK4(:,:) = .FALSE.
+ILCL(:) = KLCL(:)
+!
+ZCPORD = XCPD / XRD
+ZRDOCP = XRD / XCPD
+!
+ZADJ(:) = 1.
+ZWORK5(:) = 1.
+WHERE( .NOT. OTRIG1(:) ) ZWORK5(:) = 0.
+!
+!
+!* 0.3 Compute loop bounds
+! -------------------
+!
+IIE = KLON
+IKB = 1 + JCVEXB
+IKS = KLEV
+IKE = KLEV - JCVEXT
+JKMAX = MAXVAL( KCTL(:) )
+!
+!
+!* 2. Save initial mass flux values to be used in adjustment procedure
+! ---------------------------------------------------------------
+!
+ZUMF(:,:) = PUMF(:,:)
+ZUER(:,:) = PUER(:,:)
+ZUDR(:,:) = PUDR(:,:)
+ZDMF(:,:) = PDMF(:,:)
+ZDER(:,:) = PDER(:,:)
+ZDDR(:,:) = PDDR(:,:)
+ZTPR(:) = PTPR(:)
+ZDTEVR(:) = PDTEVR(:)
+ZOMG(:,:) = 0.
+PWSUB(:,:) = 0.
+ZPRMELT(:) = 0.
+PPRLFLX(:,:) = 0.
+ZPRLFLX(:,:) = 0.
+PPRSFLX(:,:) = 0.
+ZPRSFLX(:,:) = 0.
+!
+!
+!* 2.1 Some preliminar computations for melting of precipitation
+! used later in section 9 and computation of precip fluxes
+! Precipitation fluxes are updated for melting and evaporation
+! ---------------------------------------------------------
+!
+!
+ZWORK1(:) = 0.
+ZMELDPTH(:) = 0.
+ZWORK6(:,:) = 0.
+DO JK = JKMAX + 1, IKB + 1, -1
+ ! Nota: PUPR is total precipitation flux, but the solid, liquid
+ ! precipitation is stored in units kg/kg; therefore we compute here
+ ! the solid fraction of the total precipitation flux.
+ DO JI = 1, IIE
+ ZWORK2(JI) = PUPR(JI,JK) / ( PURC(JI,JK) + PURI(JI,JK) + 1.E-8 )
+ ZPRMELT(JI) = ZPRMELT(JI) + PURI(JI,JK) * ZWORK2(JI)
+ ZWORK1(JI) = ZWORK1(JI) + PURC(JI,JK) * ZWORK2(JI) - PDTEVRF(JI,JK)
+ ZPRLFLX(JI,JK)= MAX( 0., ZWORK1(JI) )
+ ZPRMELT(JI) = ZPRMELT(JI) + MIN( 0., ZWORK1(JI) )
+ ZPRSFLX(JI,JK)= ZPRMELT(JI)
+ IF ( KML(JI) >= JK .AND. ZMELDPTH(JI) <= XMELDPTH ) THEN
+ ZPI(JI) = ( PPRES(JI,JK) / XP00 ) ** ZRDOCP
+ ZWORK3(JI) = PTH(JI,JK) * ZPI(JI) ! temperature estimate
+ ZLM(JI) = XLSTT + ( XCPV - XCI ) * ( ZWORK3(JI) - XTT ) - &
+ ( XLVTT + ( XCPV - XCL ) * ( ZWORK3(JI) - XTT ) ) ! L_s - L_v
+ ZCPH(JI) = XCPD + XCPV * PRW(JI,JK)
+ ZMELDPTH(JI) = ZMELDPTH(JI) + PDPRES(JI,JK)
+ ZWORK6(JI,JK)= ZLM(JI) * PTIMEC(JI) / PLMASS(JI,JK) * PDPRES(JI,JK)
+ ZOMG(JI,JK)= 1. ! at this place only used as work variable
+ END IF
+ END DO
+!
+END DO
+!
+ZWORK2(:) = 0.
+DO JK = JKMAX, IKB + 1, -1
+ ZWORK1(:) = ZPRMELT(:) * PDPRES(:,JK) / MAX( XMELDPTH, ZMELDPTH(:) )
+ ZWORK2(:) = ZWORK2(:) + ZWORK1(:) * ZOMG(:,JK)
+ ZPRLFLX(:,JK) = ZPRLFLX(:,JK) + ZWORK2(:)
+ ZPRSFLX(:,JK) = ZPRSFLX(:,JK) - ZWORK2(:)
+END DO
+WHERE( ZPRSFLX(:,:) < 1. ) ZPRSFLX(:,:)=0.
+ZPRMELTO(:) = ZPRMELT(:)
+!
+!
+!* 3. Compute limits on the closure adjustment factor so that the
+! inflow in convective drafts from a given layer can't be larger
+! than the mass contained in this layer initially.
+! ---------------------------------------------------------------
+!
+ZADJMAX(:) = 1000.
+IWORK1(:) = MAX( ILCL(:), KLFS(:) )
+JKP = MINVAL( KDPL(:) )
+DO JK = JKP, IKE
+ DO JI = 1, IIE
+ IF( JK > KDPL(JI) .AND. JK <= IWORK1(JI) ) THEN
+ ZWORK1(JI) = PLMASS(JI,JK) / &
+ ( ( PUER(JI,JK) + PDER(JI,JK) + 1.E-5 ) * PTIMEC(JI) )
+ ZADJMAX(JI) = MIN( ZADJMAX(JI), ZWORK1(JI) )
+ END IF
+ END DO
+END DO
+!
+!
+GWORK1(:) = OTRIG1(:) ! logical array to limit adjustment to not definitively
+ ! adjusted columns
+!
+DO JK = IKB, IKE
+ ZTHLC(:,JK) = PTHL(:,JK) ! initialize adjusted envir. values
+ PRWC(:,JK) = PRW(:,JK)
+ PRCC(:,JK) = PRC(:,JK)
+ PRIC(:,JK) = PRI(:,JK)
+ PTHC(:,JK) = PTH(:,JK)
+END DO
+!
+!
+!
+DO JITER = 1, 6 ! Enter adjustment loop to assure that all CAPE is
+ ! removed within the advective time interval TIMEC
+!
+ ZTIMEC(:) = PTIMEC(:)
+ GWORK4(:,:) = SPREAD( GWORK1(:), DIM=2, NCOPIES=IKS )
+ WHERE( GWORK4(:,:) ) PWSUB(:,:) = 0.
+ ZOMG(:,:)=0.
+!
+ DO JK = IKB + 1, JKMAX
+ JKP = MAX( IKB + 1, JK - 1 )
+ WHERE ( GWORK1(:) .AND. JK <= KCTL(:) )
+!
+!
+!* 4. Determine vertical velocity at top and bottom of each layer
+! to satisfy mass continuity.
+! ---------------------------------------------------------------
+ ! we compute here Domega/Dp = - g rho Dw/Dz = 1/Dt
+!
+ ZWORK1(:) = - ( PUER(:,JKP) + PDER(:,JKP) - &
+ PUDR(:,JKP) - PDDR(:,JKP) ) / PLMASS(:,JKP)
+!
+ PWSUB(:,JK) = PWSUB(:,JKP) - PDPRES(:,JK-1) * ZWORK1(:)
+ ! we use PDPRES(JK-1) and not JKP in order to have zero subsidence
+ ! at the first layer
+!
+!
+!* 5. Compute fractional time step. For stability or
+! mass conservation reasons one must split full time step PTIMEC)
+! ---------------------------------------------------------------
+!
+ ZWORK1(:) = XSTABT * PDPRES(:,JKP) / ( ABS( PWSUB(:,JK) ) + 1.E-10 )
+ ! the factor XSTABT is used for stability reasons
+ ZTIMEC(:) = MIN( ZTIMEC(:), ZWORK1(:) )
+!
+ ! transform vertical velocity in mass flux units
+ ZOMG(:,JK) = PWSUB(:,JK) * PDXDY(:) / XG
+ END WHERE
+ END DO
+!
+!
+ WHERE( GWORK4(:,:) )
+ ZTHLC(:,:) = PTHL(:,:) ! reinitialize adjusted envir. values
+ PRWC(:,:) = PRW(:,:) ! when iteration criterium not attained
+ PRCC(:,:) = PRC(:,:)
+ PRIC(:,:) = PRI(:,:)
+ PTHC(:,:) = PTH(:,:)
+ END WHERE
+!
+!
+! 6. Check for mass conservation, i.e. ZWORK1 > 1.E-2
+! If mass is not conserved, the convective tendencies
+! automatically become zero.
+! ----------------------------------------------------
+!
+ DO JI = 1, IIE
+ JK=KCTL(JI)
+ ZWORK1(JI) = PUDR(JI,JK) * PDPRES(JI,JK) / ( PLMASS(JI,JK) + .1 ) &
+ - PWSUB(JI,JK)
+ END DO
+ WHERE( GWORK1(:) .AND. ABS( ZWORK1(:) ) - .01 > 0. )
+ GWORK1(:) = .FALSE.
+ PTIMEC(:) = 1.E-1
+ ZTPR(:) = 0.
+ ZWORK5(:) = 0.
+ END WHERE
+ DO JK = IKB, IKE
+ PWSUB(:,JK) = PWSUB(:,JK) * ZWORK5(:)
+ ZPRLFLX(:,JK) = ZPRLFLX(:,JK) * ZWORK5(:)
+ ZPRSFLX(:,JK) = ZPRSFLX(:,JK) * ZWORK5(:)
+ END DO
+ GWORK4(:,1:IKB) = .FALSE.
+ GWORK4(:,IKE:IKS) = .FALSE.
+!
+ ITSTEP(:) = INT( PTIMEC(:) / ZTIMEC(:) ) + 1
+ ZTIMEC(:) = PTIMEC(:) / REAL( ITSTEP(:) ) ! adjust fractional time step
+ ! to be an integer multiple of PTIMEC
+ ZTIMC(:,:)= SPREAD( ZTIMEC(:), DIM=2, NCOPIES=IKS )
+ ICOUNT(:) = 0
+!
+!
+!
+ KFTSTEPS = MAXVAL( ITSTEP(:) )
+ DO JSTEP = 1, KFTSTEPS ! Enter the fractional time step loop here
+!
+ ICOUNT(:) = ICOUNT(:) + 1
+!
+ GWORK3(:) = ITSTEP(:) >= ICOUNT(:) .AND. GWORK1(:)
+!
+!
+!* 7. Assign enthalpy and r_w values at the top and bottom of each
+! layer based on the sign of w
+! ------------------------------------------------------------
+!
+ ZTHMFIN(:,:) = 0.
+ ZRWMFIN(:,:) = 0.
+ ZRCMFIN(:,:) = 0.
+ ZRIMFIN(:,:) = 0.
+ ZTHMFOUT(:,:) = 0.
+ ZRWMFOUT(:,:) = 0.
+ ZRCMFOUT(:,:) = 0.
+ ZRIMFOUT(:,:) = 0.
+!
+ DO JK = IKB + 1, JKMAX
+ DO JI = 1, IIE
+ GWORK4(JI,JK) = GWORK3(JI) .AND. JK <= KCTL(JI)
+ END DO
+ JKP = MAX( IKB + 1, JK - 1 )
+ DO JI = 1, IIE
+ IF ( GWORK3(JI) ) THEN
+!
+ ZWORK1(JI) = SIGN( 1., ZOMG(JI,JK) )
+ ZWORK2(JI) = 0.5 * ( 1. + ZWORK1(JI) )
+ ZWORK1(JI) = 0.5 * ( 1. - ZWORK1(JI) )
+ ZTHMFIN(JI,JK) = - ZOMG(JI,JK) * ZTHLC(JI,JKP) * ZWORK1(JI)
+ ZTHMFOUT(JI,JK) = ZOMG(JI,JK) * ZTHLC(JI,JK) * ZWORK2(JI)
+ ZRWMFIN(JI,JK) = - ZOMG(JI,JK) * PRWC(JI,JKP) * ZWORK1(JI)
+ ZRWMFOUT(JI,JK) = ZOMG(JI,JK) * PRWC(JI,JK) * ZWORK2(JI)
+ ZRCMFIN(JI,JK) = - ZOMG(JI,JK) * PRCC(JI,JKP) * ZWORK1(JI)
+ ZRCMFOUT(JI,JK) = ZOMG(JI,JK) * PRCC(JI,JK) * ZWORK2(JI)
+ ZRIMFIN(JI,JK) = - ZOMG(JI,JK) * PRIC(JI,JKP) * ZWORK1(JI)
+ ZRIMFOUT(JI,JK) = ZOMG(JI,JK) * PRIC(JI,JK) * ZWORK2(JI)
+ END IF
+ END DO
+ DO JI = 1, IIE
+ IF ( GWORK3(JI) ) THEN
+ ZTHMFIN(JI,JKP) = ZTHMFIN(JI,JKP) + ZTHMFOUT(JI,JK) * ZWORK2(JI)
+ ZTHMFOUT(JI,JKP) = ZTHMFOUT(JI,JKP) + ZTHMFIN(JI,JK) * ZWORK1(JI)
+ ZRWMFIN(JI,JKP) = ZRWMFIN(JI,JKP) + ZRWMFOUT(JI,JK) * ZWORK2(JI)
+ ZRWMFOUT(JI,JKP) = ZRWMFOUT(JI,JKP) + ZRWMFIN(JI,JK) * ZWORK1(JI)
+ ZRCMFIN(JI,JKP) = ZRCMFIN(JI,JKP) + ZRCMFOUT(JI,JK) * ZWORK2(JI)
+ ZRCMFOUT(JI,JKP) = ZRCMFOUT(JI,JKP) + ZRCMFIN(JI,JK) * ZWORK1(JI)
+ ZRIMFIN(JI,JKP) = ZRIMFIN(JI,JKP) + ZRIMFOUT(JI,JK) * ZWORK2(JI)
+ ZRIMFOUT(JI,JKP) = ZRIMFOUT(JI,JKP) + ZRIMFIN(JI,JK) * ZWORK1(JI)
+!
+ END IF
+ END DO
+ END DO
+!
+ WHERE ( GWORK4(:,:) )
+!
+!******************************************************************************
+!
+!* 8. Update the environmental values of enthalpy and r_w at each level
+! NOTA: These are the MAIN EQUATIONS of the scheme
+! -----------------------------------------------------------------
+!
+!
+ ZTHLC(:,:) = ZTHLC(:,:) + ZTIMC(:,:) / PLMASS(:,:) * ( &
+ ZTHMFIN(:,:) + PUDR(:,:) * PUTHL(:,:) + &
+ PDDR(:,:) * PDTHL(:,:) - ZTHMFOUT(:,:) - &
+ ( PUER(:,:) + PDER(:,:) ) * PTHL(:,:) )
+ PRWC(:,:) = PRWC(:,:) + ZTIMC(:,:) / PLMASS(:,:) * ( &
+ ZRWMFIN(:,:) + PUDR(:,:) * PURW(:,:) + &
+ PDDR(:,:) * PDRW(:,:) - ZRWMFOUT(:,:) - &
+ ( PUER(:,:) + PDER(:,:) ) * PRW(:,:) )
+ PRCC(:,:) = PRCC(:,:) + ZTIMC(:,:) / PLMASS(:,:) * ( &
+ ZRCMFIN(:,:) + PUDR(:,:) * PURC(:,:) - ZRCMFOUT(:,:) - &
+ ( PUER(:,:) + PDER(:,:) ) * PRC(:,:) )
+ PRIC(:,:) = PRIC(:,:) + ZTIMC(:,:) / PLMASS(:,:) * ( &
+ ZRIMFIN(:,:) + PUDR(:,:) * PURI(:,:) - ZRIMFOUT(:,:) - &
+ ( PUER(:,:) + PDER(:,:) ) * PRI(:,:) )
+!
+!
+!******************************************************************************
+!
+ END WHERE
+!
+ END DO ! Exit the fractional time step loop
+!
+!
+!* 9. Allow frozen precipitation to melt over a 200 mb deep layer
+! -----------------------------------------------------------
+!
+ DO JK = JKMAX, IKB + 1, -1
+ ZTHLC(:,JK) = ZTHLC(:,JK) - &
+ ZPRMELT(:) * ZWORK6(:,JK) / MAX( XMELDPTH, ZMELDPTH(:) )
+ END DO
+!
+!
+!* 10. Compute final linearized value of theta envir.
+! ----------------------------------------------
+!
+ DO JK = IKB + 1, JKMAX
+ DO JI = 1, IIE
+ IF( GWORK1(JI) .AND. JK <= KCTL(JI) ) THEN
+ ZPI(JI) = ( XP00 / PPRES(JI,JK) ) ** ZRDOCP
+ ZCPH(JI) = XCPD + PRWC(JI,JK) * XCPV
+ ZWORK2(JI) = PTH(JI,JK) / ZPI(JI) ! first temperature estimate
+ ZLV(JI) = XLVTT + ( XCPV - XCL ) * ( ZWORK2(JI) - XTT )
+ ZLS(JI) = XLVTT + ( XCPV - XCI ) * ( ZWORK2(JI) - XTT )
+ ! final linearized temperature
+ ZWORK2(JI) = ( ZTHLC(JI,JK) + ZLV(JI) * PRCC(JI,JK) + ZLS(JI) * PRIC(JI,JK) &
+ - (1. + PRWC(JI,JK) ) * XG * PZ(JI,JK) ) / ZCPH(JI)
+ ZWORK2(JI) = MAX( 180., MIN( 340., ZWORK2(JI) ) )
+ PTHC(JI,JK)= ZWORK2(JI) * ZPI(JI) ! final adjusted envir. theta
+ END IF
+ END DO
+ END DO
+!
+!
+!* 11. Compute new cloud ( properties at new LCL )
+! NOTA: The computations are very close to
+! that in routine TRIGGER_FUNCT
+! ---------------------------------------------
+!
+ CALL CONVECT_CLOSURE_THRVLCL( KLON, KLEV, &
+ PPRES, PTHC, PRWC, PZ, GWORK1, &
+ ZTHLCL, ZRVLCL, ZZLCL, ZTLCL, ZTELCL, &
+ ILCL, KDPL, KPBL )
+!
+!
+ ZTLCL(:) = MAX( 230., MIN( 335., ZTLCL(:) ) ) ! set some overflow bounds
+ ZTELCL(:) = MAX( 230., MIN( 335., ZTELCL(:) ) )
+ ZTHLCL(:) = MAX( 230., MIN( 345., ZTHLCL(:) ) )
+ ZRVLCL(:) = MAX( 0., MIN( 1., ZRVLCL(:) ) )
+!
+!
+!* 12. Compute adjusted CAPE
+! ---------------------
+!
+ ZCAPE(:) = 0.
+ ZPI(:) = ZTHLCL(:) / ZTLCL(:)
+ ZPI(:) = MAX( 0.95, MIN( 1.5, ZPI(:) ) )
+ ZWORK1(:) = XP00 / ZPI(:) ** ZCPORD ! pressure at LCL
+!
+ CALL CONVECT_SATMIXRATIO( KLON, ZWORK1, ZTELCL, ZWORK3, ZLV, ZLS, ZCPH )
+ ZWORK3(:) = MIN( .1, MAX( 0., ZWORK3(:) ) )
+!
+ ! compute theta_e updraft undilute
+ ZTHEUL(:) = ZTLCL(:) * ZPI(:) ** ( 1. - 0.28 * ZRVLCL(:) ) &
+ * EXP( ( 3374.6525 / ZTLCL(:) - 2.5403 ) &
+ * ZRVLCL(:) * ( 1. + 0.81 * ZRVLCL(:) ) )
+!
+ ! compute theta_e saturated environment at LCL
+ ZTHES1(:) = ZTELCL(:) * ZPI(:) ** ( 1. - 0.28 * ZWORK3(:) ) &
+ * EXP( ( 3374.6525 / ZTELCL(:) - 2.5403 ) &
+ * ZWORK3(:) * ( 1. + 0.81 * ZWORK3(:) ) )
+!
+ DO JK = MINVAL( ILCL(:) ), JKMAX
+ JKP = JK - 1
+ DO JI = 1, IIE
+ ZWORK4(JI) = 1.
+ IF ( JK == ILCL(JI) ) ZWORK4(JI) = 0.
+!
+ ! compute theta_e saturated environment and adjusted values
+ ! of theta
+!
+ GWORK3(JI) = JK >= ILCL(JI) .AND. JK <= KCTL(JI) .AND. GWORK1(JI)
+!
+ ZPI(JI) = ( XP00 / PPRES(JI,JK) ) ** ZRDOCP
+ ZWORK2(JI) = PTHC(JI,JK) / ZPI(JI)
+ END DO
+!
+ CALL CONVECT_SATMIXRATIO( KLON, PPRES(:,JK), ZWORK2, ZWORK3, ZLV, ZLS, ZCPH )
+!
+!
+ DO JI = 1, IIE
+ IF ( GWORK3(JI) ) THEN
+ ZTHES2(JI) = ZWORK2(JI) * ZPI(JI) ** ( 1. - 0.28 * ZWORK3(JI) ) &
+ * EXP( ( 3374.6525 / ZWORK2(JI) - 2.5403 ) &
+ * ZWORK3(JI) * ( 1. + 0.81 * ZWORK3(JI) ) )
+!
+ ZWORK3(JI) = PZ(JI,JK) - PZ(JI,JKP) * ZWORK4(JI) - &
+ ( 1. - ZWORK4(JI) ) * ZZLCL(JI) ! level thickness
+ ZWORK1(JI) = ( 2. * ZTHEUL(JI) ) / ( ZTHES1(JI) + ZTHES2(JI) ) - 1.
+ ZCAPE(JI) = ZCAPE(JI) + XG * ZWORK3(JI) * MAX( 0., ZWORK1(JI) )
+ ZTHES1(JI) = ZTHES2(JI)
+ END IF
+ END DO
+ END DO
+!
+!
+!* 13. Determine mass adjustment factor knowing how much
+! CAPE has been removed.
+! -------------------------------------------------
+!
+ WHERE ( GWORK1(:) )
+ ZWORK1(:) = MAX( PCAPE(:) - ZCAPE(:), 0.1 * PCAPE(:) )
+ ZWORK2(:) = ZCAPE(:) / ( PCAPE(:) + 1.E-8 )
+!
+ GWORK1(:) = ZWORK2(:) > 0.1 .OR. ZCAPE(:) == 0. ! mask for adjustment
+ END WHERE
+!
+ WHERE ( ZCAPE(:) == 0. .AND. GWORK1(:) ) ZADJ(:) = ZADJ(:) * 0.5
+ WHERE ( ZCAPE(:) /= 0. .AND. GWORK1(:) ) &
+ ZADJ(:) = ZADJ(:) * XSTABC * PCAPE(:) / ( ZWORK1(:) + 1.E-8 )
+ ZADJ(:) = MIN( ZADJ(:), ZADJMAX(:) )
+!
+!
+!* 13. Adjust mass flux by the factor ZADJ to converge to
+! specified degree of stabilization
+! ----------------------------------------------------
+!
+ CALL CONVECT_CLOSURE_ADJUST( KLON, KLEV, ZADJ, &
+ PUMF, ZUMF, PUER, ZUER, PUDR, ZUDR, &
+ PDMF, ZDMF, PDER, ZDER, PDDR, ZDDR, &
+ ZPRMELT, ZPRMELTO, PDTEVR, ZDTEVR, &
+ PTPR, ZTPR, &
+ PPRLFLX, ZPRLFLX, PPRSFLX, ZPRSFLX )
+!
+!
+ IF ( COUNT( GWORK1(:) ) == 0 ) EXIT ! exit big adjustment iteration loop
+ ! when all columns have reached
+ ! desired degree of stabilization.
+!
+END DO ! end of big adjustment iteration loop
+!
+!
+ ! skip adj. total water array to water vapor
+DO JK = IKB, IKE
+ PRWC(:,JK) = MAX( 0., PRWC(:,JK) - PRCC(:,JK) - PRIC(:,JK) )
+END DO
+!
+ ! compute surface solid (ice) precipitation
+PSPR(:) = ZPRMELT(:) * ( 1. - ZMELDPTH(:) / XMELDPTH )
+PSPR(:) = MAX( 0., PSPR(:) )
+!
+!
+END SUBROUTINE CONVECT_CLOSURE
diff --git a/src/mesonh/conv/convect_closure_adjust.f90 b/src/mesonh/conv/convect_closure_adjust.f90
new file mode 100644
index 000000000..177c8844b
--- /dev/null
+++ b/src/mesonh/conv/convect_closure_adjust.f90
@@ -0,0 +1,183 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 conv 2006/05/18 13:07:25
+!-----------------------------------------------------------------
+! #################
+ MODULE MODI_CONVECT_CLOSURE_ADJUST
+! #################
+!
+INTERFACE
+!
+ SUBROUTINE CONVECT_CLOSURE_ADJUST( KLON, KLEV, PADJ, &
+ PUMF, PZUMF, PUER, PZUER, PUDR, PZUDR, &
+ PDMF, PZDMF, PDER, PZDER, PDDR, PZDDR, &
+ PPRMELT, PZPRMELT, PDTEVR, PZDTEVR, &
+ PTPR, PZTPR, &
+ PPRLFLX, PZPRLFL, PPRSFLX, PZPRSFL )
+!
+INTEGER, INTENT(IN) :: KLON ! horizontal dimension
+INTEGER, INTENT(IN) :: KLEV ! vertical dimension
+REAL, DIMENSION(KLON), INTENT(IN) :: PADJ ! mass adjustment factor
+!
+!
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PUMF ! updraft mass flux (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PZUMF ! initial value of "
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PUER ! updraft entrainment (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PZUER ! initial value of "
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PUDR ! updraft detrainment (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PZUDR ! initial value of "
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PDMF ! downdraft mass flux (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PZDMF ! initial value of "
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PDER ! downdraft entrainment (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PZDER ! initial value of "
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PDDR ! downdraft detrainment (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PZDDR ! initial value of "
+REAL, DIMENSION(KLON), INTENT(INOUT):: PTPR ! total precipitation (kg/s)
+REAL, DIMENSION(KLON), INTENT(INOUT):: PZTPR ! initial value of "
+REAL, DIMENSION(KLON), INTENT(INOUT):: PDTEVR ! donwndraft evapor. (kg/s)
+REAL, DIMENSION(KLON), INTENT(INOUT):: PZDTEVR ! initial value of "
+REAL, DIMENSION(KLON), INTENT(INOUT):: PPRMELT ! melting of precipitation
+REAL, DIMENSION(KLON), INTENT(INOUT):: PZPRMELT ! initial value of "
+REAL, DIMENSION(KLON,KLEV),INTENT(INOUT) :: PPRLFLX! liquid precip flux
+REAL, DIMENSION(KLON,KLEV),INTENT(INOUT) :: PZPRLFL! initial value "
+REAL, DIMENSION(KLON,KLEV),INTENT(INOUT) :: PPRSFLX! solid precip flux
+REAL, DIMENSION(KLON,KLEV),INTENT(INOUT) :: PZPRSFL! initial value "
+!
+END SUBROUTINE CONVECT_CLOSURE_ADJUST
+!
+END INTERFACE
+!
+END MODULE MODI_CONVECT_CLOSURE_ADJUST
+! ###########################################################################
+ SUBROUTINE CONVECT_CLOSURE_ADJUST( KLON, KLEV, PADJ, &
+ PUMF, PZUMF, PUER, PZUER, PUDR, PZUDR, &
+ PDMF, PZDMF, PDER, PZDER, PDDR, PZDDR, &
+ PPRMELT, PZPRMELT, PDTEVR, PZDTEVR, &
+ PTPR, PZTPR, &
+ PPRLFLX, PZPRLFL, PPRSFLX, PZPRSFL )
+! ###########################################################################
+!
+!!**** Uses closure adjustment factor to adjust mass flux and to modify
+!! precipitation efficiency when necessary. The computations are
+!! similar to routine CONVECT_PRECIP_ADJUST.
+!!
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to adjust the mass flux using the
+!! factor PADJ computed in CONVECT_CLOSURE
+!!
+!!
+!!** METHOD
+!! ------
+!! Computations are done at every model level starting from bottom.
+!! The use of masks allows to optimise the inner loops (horizontal loops).
+!!
+!!
+!! EXTERNAL
+!! --------
+!! Module MODD_CONVPAREXT
+!! JCVEXB, JCVEXT ! extra levels on the vertical boundaries
+!!
+!! None
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! None
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Book1,2 of documentation ( routine CONVECT_CLOSURE_ADJUST)
+!!
+!! AUTHOR
+!! ------
+!! P. BECHTOLD * Laboratoire d'Aerologie *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 26/03/96
+!! Last modified 04/10/97
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CONVPAREXT
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+!
+INTEGER, INTENT(IN) :: KLON ! horizontal dimension
+INTEGER, INTENT(IN) :: KLEV ! vertical dimension
+REAL, DIMENSION(KLON), INTENT(IN) :: PADJ ! mass adjustment factor
+!
+!
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PUMF ! updraft mass flux (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PZUMF ! initial value of "
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PUER ! updraft entrainment (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PZUER ! initial value of "
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PUDR ! updraft detrainment (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PZUDR ! initial value of "
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PDMF ! downdraft mass flux (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PZDMF ! initial value of "
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PDER ! downdraft entrainment (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PZDER ! initial value of "
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PDDR ! downdraft detrainment (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PZDDR ! initial value of "
+REAL, DIMENSION(KLON), INTENT(INOUT):: PTPR ! total precipitation (kg/s)
+REAL, DIMENSION(KLON), INTENT(INOUT):: PZTPR ! initial value of "
+REAL, DIMENSION(KLON), INTENT(INOUT):: PDTEVR ! donwndraft evapor. (kg/s)
+REAL, DIMENSION(KLON), INTENT(INOUT):: PZDTEVR ! initial value of "
+REAL, DIMENSION(KLON), INTENT(INOUT):: PPRMELT ! melting of precipitation
+REAL, DIMENSION(KLON), INTENT(INOUT):: PZPRMELT ! initial value of "
+REAL, DIMENSION(KLON,KLEV),INTENT(INOUT) :: PPRLFLX! liquid precip flux
+REAL, DIMENSION(KLON,KLEV),INTENT(INOUT) :: PZPRLFL! initial value "
+REAL, DIMENSION(KLON,KLEV),INTENT(INOUT) :: PPRSFLX! solid precip flux
+REAL, DIMENSION(KLON,KLEV),INTENT(INOUT) :: PZPRSFL! initial value "
+!
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IKB, IKE ! vert. loop bounds
+INTEGER :: JK ! vertical loop index
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 0.3 Compute loop bounds
+! -------------------
+!
+IKB = 1 + JCVEXB
+IKE = KLEV - JCVEXT
+!
+!
+!* 1. Adjust mass flux by the factor PADJ to converge to
+! specified degree of stabilization
+! ----------------------------------------------------
+!
+ PPRMELT(:) = PZPRMELT(:) * PADJ(:)
+ PDTEVR(:) = PZDTEVR(:) * PADJ(:)
+ PTPR(:) = PZTPR(:) * PADJ(:)
+!
+ DO JK = IKB + 1, IKE
+ PUMF(:,JK) = PZUMF(:,JK) * PADJ(:)
+ PUER(:,JK) = PZUER(:,JK) * PADJ(:)
+ PUDR(:,JK) = PZUDR(:,JK) * PADJ(:)
+ PDMF(:,JK) = PZDMF(:,JK) * PADJ(:)
+ PDER(:,JK) = PZDER(:,JK) * PADJ(:)
+ PDDR(:,JK) = PZDDR(:,JK) * PADJ(:)
+ PPRLFLX(:,JK) = PZPRLFL(:,JK) * PADJ(:)
+ PPRSFLX(:,JK) = PZPRSFL(:,JK) * PADJ(:)
+ END DO
+!
+END SUBROUTINE CONVECT_CLOSURE_ADJUST
diff --git a/src/mesonh/conv/convect_closure_adjust_shal.f90 b/src/mesonh/conv/convect_closure_adjust_shal.f90
new file mode 100644
index 000000000..91ddb2cbe
--- /dev/null
+++ b/src/mesonh/conv/convect_closure_adjust_shal.f90
@@ -0,0 +1,134 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 conv 2006/05/18 13:07:25
+!-----------------------------------------------------------------
+! #################
+ MODULE MODI_CONVECT_CLOSURE_ADJUST_SHAL
+! #################
+!
+INTERFACE
+!
+ SUBROUTINE CONVECT_CLOSURE_ADJUST_SHAL( KLON, KLEV, PADJ, &
+ PUMF, PZUMF, PUER, PZUER, PUDR, PZUDR )
+!
+INTEGER, INTENT(IN) :: KLON ! horizontal dimension
+INTEGER, INTENT(IN) :: KLEV ! vertical dimension
+REAL, DIMENSION(KLON), INTENT(IN) :: PADJ ! mass adjustment factor
+!
+!
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PUMF ! updraft mass flux (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PZUMF ! initial value of "
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PUER ! updraft entrainment (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PZUER ! initial value of "
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PUDR ! updraft detrainment (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PZUDR ! initial value of "
+!
+END SUBROUTINE CONVECT_CLOSURE_ADJUST_SHAL
+!
+END INTERFACE
+!
+END MODULE MODI_CONVECT_CLOSURE_ADJUST_SHAL
+! ################################################################################
+ SUBROUTINE CONVECT_CLOSURE_ADJUST_SHAL( KLON, KLEV, PADJ, &
+ PUMF, PZUMF, PUER, PZUER, PUDR, PZUDR )
+! ################################################################################
+!
+!!**** Uses closure adjustment factor to adjust mass flux and to modify
+!! precipitation efficiency when necessary. The computations are
+!! similar to routine CONVECT_PRECIP_ADJUST.
+!!
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to adjust the mass flux using the
+!! factor PADJ computed in CONVECT_CLOSURE
+!!
+!!
+!!** METHOD
+!! ------
+!! Computations are done at every model level starting from bottom.
+!! The use of masks allows to optimise the inner loops (horizontal loops).
+!!
+!!
+!! EXTERNAL
+!! --------
+!! Module MODD_CONVPAREXT
+!! JCVEXB, JCVEXT ! extra levels on the vertical boundaries
+!!
+!! None
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! None
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Book1,2 of documentation ( routine CONVECT_CLOSURE_ADJUST)
+!!
+!! AUTHOR
+!! ------
+!! P. BECHTOLD * Laboratoire d'Aerologie *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 26/03/96
+!! Last modified 15/11/96
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CONVPAREXT
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+!
+INTEGER, INTENT(IN) :: KLON ! horizontal dimension
+INTEGER, INTENT(IN) :: KLEV ! vertical dimension
+REAL, DIMENSION(KLON), INTENT(IN) :: PADJ ! mass adjustment factor
+!
+!
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PUMF ! updraft mass flux (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PZUMF ! initial value of "
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PUER ! updraft entrainment (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PZUER ! initial value of "
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PUDR ! updraft detrainment (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PZUDR ! initial value of "
+!
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IKB, IKE ! vert. loop bounds
+INTEGER :: JK ! vertical loop index
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 0.3 Compute loop bounds
+! -------------------
+!
+IKB = 1 + JCVEXB
+IKE = KLEV - JCVEXT
+!
+!
+!* 1. Adjust mass flux by the factor PADJ to converge to
+! specified degree of stabilization
+! ----------------------------------------------------
+!
+ DO JK = IKB + 1, IKE
+ PUMF(:,JK) = PZUMF(:,JK) * PADJ(:)
+ PUER(:,JK) = PZUER(:,JK) * PADJ(:)
+ PUDR(:,JK) = PZUDR(:,JK) * PADJ(:)
+ END DO
+!
+END SUBROUTINE CONVECT_CLOSURE_ADJUST_SHAL
diff --git a/src/mesonh/conv/convect_closure_shal.f90 b/src/mesonh/conv/convect_closure_shal.f90
new file mode 100644
index 000000000..73e59decb
--- /dev/null
+++ b/src/mesonh/conv/convect_closure_shal.f90
@@ -0,0 +1,619 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 conv 2006/05/18 13:07:25
+!-----------------------------------------------------------------
+! #################
+ MODULE MODI_CONVECT_CLOSURE_SHAL
+! #################
+!
+INTERFACE
+!
+ SUBROUTINE CONVECT_CLOSURE_SHAL( KLON, KLEV, &
+ PPRES, PDPRES, PZ, PDXDY, PLMASS, &
+ PTHL, PTH, PRW, PRC, PRI, OTRIG1, &
+ PTHC, PRWC, PRCC, PRIC, PWSUB, &
+ KLCL, KDPL, KPBL, KCTL, &
+ PUMF, PUER, PUDR, PUTHL, PURW, &
+ PURC, PURI, PCAPE, PTIMEC, KFTSTEPS )
+
+!
+INTEGER, INTENT(IN) :: KLON ! horizontal dimension
+INTEGER, INTENT(IN) :: KLEV ! vertical dimension
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KLCL ! index lifting condens. level
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KCTL ! index for cloud top level
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KDPL ! index for departure level
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KPBL ! index for top of source layer
+REAL, DIMENSION(KLON), INTENT(INOUT) :: PTIMEC ! convection time step
+REAL, DIMENSION(KLON), INTENT(IN) :: PDXDY ! grid area (m^2)
+REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PTHL ! grid scale enthalpy (J/kg)
+REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PTH ! grid scale theta
+REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PRW ! grid scale total water
+ ! mixing ratio
+REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PRC ! grid scale r_c
+REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PRI ! grid scale r_i
+LOGICAL, DIMENSION(KLON), INTENT(IN) :: OTRIG1 ! logical to keep trace of
+ ! convective arrays modified in UPDRAFT
+!
+!
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PPRES ! pressure (P)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PDPRES ! pressure difference between
+ ! bottom and top of layer (Pa)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PLMASS ! mass of model layer (kg)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PZ ! height of model layer (m)
+REAL, DIMENSION(KLON), INTENT(IN) :: PCAPE ! available potent. energy
+INTEGER, INTENT(OUT) :: KFTSTEPS! maximum of fract time steps
+ ! only used for chemical tracers
+!
+!
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PUMF ! updraft mass flux (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PUER ! updraft entrainment (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PUDR ! updraft detrainment (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PUTHL ! updraft enthalpy (J/kg)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PURW ! updraft total water (kg/kg)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PURC ! updraft cloud water (kg/kg)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PURI ! updraft cloud ice (kg/kg)
+!
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT) :: PTHC ! conv. adj. grid scale theta
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT) :: PRWC ! conv. adj. grid scale r_w
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT) :: PRCC ! conv. adj. grid scale r_c
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT) :: PRIC ! conv. adj. grid scale r_i
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT) :: PWSUB ! envir. compensating subsidence(Pa/s)
+!
+END SUBROUTINE CONVECT_CLOSURE_SHAL
+!
+END INTERFACE
+!
+END MODULE MODI_CONVECT_CLOSURE_SHAL
+! ##############################################################################
+ SUBROUTINE CONVECT_CLOSURE_SHAL( KLON, KLEV, &
+ PPRES, PDPRES, PZ, PDXDY, PLMASS, &
+ PTHL, PTH, PRW, PRC, PRI, OTRIG1, &
+ PTHC, PRWC, PRCC, PRIC, PWSUB, &
+ KLCL, KDPL, KPBL, KCTL, &
+ PUMF, PUER, PUDR, PUTHL, PURW, &
+ PURC, PURI, PCAPE, PTIMEC, KFTSTEPS )
+! ##############################################################################
+!
+!!**** Uses modified Fritsch-Chappell closure
+!!
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to determine the final adjusted
+!! (over a time step PTIMEC) environmental values of THETA_l, R_w, R_c, R_i
+!! The final convective tendencies can then be evaluated in the main
+!! routine DEEP_CONVECT by (PTHC-PTH)/PTIMEC
+!!
+!!
+!!** METHOD
+!! ------
+!! Computations are done at every model level starting from bottom.
+!! The use of masks allows to optimise the inner loops (horizontal loops).
+!!
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!! CONVECT_CLOSURE_THRVLCL
+!! CONVECT_CLOSURE_ADJUST_SHAL
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST
+!! XG ! gravity constant
+!! XP00 ! reference pressure
+!! XRD, XRV ! gaz constants for dry air and water vapor
+!! XCPD, XCPV ! specific heat for dry air and water vapor
+!! XCL, XCI ! specific heat for liquid water and ice
+!! XTT ! triple point temperature
+!! XLVTT, XLSTT ! vaporization, sublimation heat constant
+!!
+!! Module MODD_CONVPAR_SHAL
+!! XA25 ! reference grid area
+!! XSTABT ! stability factor in time integration
+!! XSTABC ! stability factor in CAPE adjustment
+!!
+!! Module MODD_CONVPAREXT
+!! JCVEXB, JCVEXT ! extra levels on the vertical boundaries
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Book1,2 of documentation ( routine CONVECT_CLOSURE)
+!! Fritsch and Chappell, 1980, J. Atmos. Sci.
+!! Kain and Fritsch, 1993, Meteor. Monographs, Vol.
+!!
+!! AUTHOR
+!! ------
+!! P. BECHTOLD * Laboratoire d'Aerologie *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 26/03/96
+!! Peter Bechtold 15/11/96 change for enthalpie, r_c + r_i tendencies
+!! Tony Dore 14/10/96 Initialise local variables
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_CONVPAR_SHAL
+USE MODD_CONVPAREXT
+!
+USE MODI_CONVECT_CLOSURE_THRVLCL
+USE MODI_CONVECT_SATMIXRATIO
+USE MODI_CONVECT_CLOSURE_ADJUST_SHAL
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KLON ! horizontal dimension
+INTEGER, INTENT(IN) :: KLEV ! vertical dimension
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KLCL ! index lifting condens. level
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KCTL ! index for cloud top level
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KDPL ! index for departure level
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KPBL ! index for top of source layer
+REAL, DIMENSION(KLON), INTENT(INOUT) :: PTIMEC ! convection time step
+REAL, DIMENSION(KLON), INTENT(IN) :: PDXDY ! grid area (m^2)
+REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PTHL ! grid scale enthalpy (J/kg)
+REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PTH ! grid scale theta
+REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PRW ! grid scale total water
+ ! mixing ratio
+REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PRC ! grid scale r_c
+REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PRI ! grid scale r_i
+LOGICAL, DIMENSION(KLON), INTENT(IN) :: OTRIG1 ! logical to keep trace of
+ ! convective arrays modified in UPDRAFT
+!
+!
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PPRES ! pressure (P)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PDPRES ! pressure difference between
+ ! bottom and top of layer (Pa)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PLMASS ! mass of model layer (kg)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PZ ! height of model layer (m)
+REAL, DIMENSION(KLON), INTENT(IN) :: PCAPE ! available potent. energy
+INTEGER, INTENT(OUT) :: KFTSTEPS! maximum of fract time steps
+ ! only used for chemical tracers
+!
+!
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PUMF ! updraft mass flux (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PUER ! updraft entrainment (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PUDR ! updraft detrainment (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PUTHL ! updraft enthalpy (J/kg)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PURW ! updraft total water (kg/kg)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PURC ! updraft cloud water (kg/kg)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PURI ! updraft cloud ice (kg/kg)
+!
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT) :: PTHC ! conv. adj. grid scale theta
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT) :: PRWC ! conv. adj. grid scale r_w
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT) :: PRCC ! conv. adj. grid scale r_c
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT) :: PRIC ! conv. adj. grid scale r_i
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT) :: PWSUB ! envir. compensating subsidence(Pa/s)
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IIE, IKB, IKE ! horizontal + vertical loop bounds
+INTEGER :: IKS ! vertical dimension
+INTEGER :: JK, JKP, JKMAX ! vertical loop index
+INTEGER :: JI ! horizontal loop index
+INTEGER :: JITER ! iteration loop index
+INTEGER :: JSTEP ! fractional time loop index
+REAL :: ZCPORD, ZRDOCP ! C_pd / R_d, R_d / C_pd
+!
+REAL, DIMENSION(KLON,KLEV) :: ZTHLC ! convectively adjusted
+ ! grid scale enthalpy
+REAL, DIMENSION(KLON,KLEV) :: ZOMG ! conv. environm. subsidence (Pa/s)
+REAL, DIMENSION(KLON,KLEV) :: ZUMF ! non-adjusted updraft mass flux
+REAL, DIMENSION(KLON,KLEV) :: ZUER ! " updraft entrainm. rate
+REAL, DIMENSION(KLON,KLEV) :: ZUDR ! " updraft detrainm. rate
+REAL, DIMENSION(KLON) :: ZADJ ! mass adjustment factor
+REAL, DIMENSION(KLON) :: ZADJMAX ! limit value for ZADJ
+REAL, DIMENSION(KLON) :: ZCAPE ! new CAPE after adjustment
+REAL, DIMENSION(KLON) :: ZTIMEC ! fractional convective time step
+REAL, DIMENSION(KLON,KLEV):: ZTIMC ! 2D work array for ZTIMEC
+!
+REAL, DIMENSION(KLON) :: ZTHLCL ! new theta at LCL
+REAL, DIMENSION(KLON) :: ZRVLCL ! new r_v at LCL
+REAL, DIMENSION(KLON) :: ZZLCL ! height of LCL
+REAL, DIMENSION(KLON) :: ZTLCL ! temperature at LCL
+REAL, DIMENSION(KLON) :: ZTELCL ! envir. temper. at LCL
+REAL, DIMENSION(KLON) :: ZTHEUL ! theta_e for undilute ascent
+REAL, DIMENSION(KLON) :: ZTHES1, ZTHES2! saturation environm. theta_e
+REAL, DIMENSION(KLON,KLEV) :: ZTHMFIN, ZTHMFOUT, ZRWMFIN, ZRWMFOUT
+REAL, DIMENSION(KLON,KLEV) :: ZRCMFIN, ZRCMFOUT, ZRIMFIN, ZRIMFOUT
+ ! work arrays for environm. compensat. mass flux
+REAL, DIMENSION(KLON) :: ZPI ! (P/P00)**R_d/C_pd
+REAL, DIMENSION(KLON) :: ZLV ! latent heat of vaporisation
+REAL, DIMENSION(KLON) :: ZLS ! latent heat of sublimation
+REAL, DIMENSION(KLON) :: ZCPH ! specific heat C_ph
+INTEGER, DIMENSION(KLON) :: ITSTEP ! fractional convective time step
+INTEGER, DIMENSION(KLON) :: ICOUNT ! timestep counter
+INTEGER, DIMENSION(KLON) :: ILCL ! index lifting condens. level
+INTEGER, DIMENSION(KLON) :: IWORK1 ! work array
+REAL, DIMENSION(KLON) :: ZWORK1, ZWORK2, ZWORK3, ZWORK4, ZWORK5
+LOGICAL, DIMENSION(KLON) :: GWORK1, GWORK3! work arrays
+LOGICAL, DIMENSION(KLON,KLEV) :: GWORK4 ! work array
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 0.2 Initialize local variables
+! ----------------------------
+!
+!
+ZTIMC(:,:) = 0.
+ZTHES2(:) = 0.
+ZWORK1(:) = 0.
+ZWORK2(:) = 0.
+ZWORK3(:) = 0.
+ZWORK4(:) = 0.
+ZWORK5(:) = 0.
+GWORK1(:) = .FALSE.
+GWORK3(:) = .FALSE.
+GWORK4(:,:) = .FALSE.
+ILCL(:) = KLCL(:)
+!
+ZCPORD = XCPD / XRD
+ZRDOCP = XRD / XCPD
+!
+ZADJ(:) = 1.
+ZWORK5(:) = 1.
+WHERE( .NOT. OTRIG1(:) ) ZWORK5(:) = 0.
+!
+!
+!* 0.3 Compute loop bounds
+! -------------------
+!
+IIE = KLON
+IKB = 1 + JCVEXB
+IKS = KLEV
+IKE = KLEV - JCVEXT
+JKMAX = MAXVAL( KCTL(:) )
+!
+!
+!* 2. Save initial mass flux values to be used in adjustment procedure
+! ---------------------------------------------------------------
+!
+ZUMF(:,:) = PUMF(:,:)
+ZUER(:,:) = PUER(:,:)
+ZUDR(:,:) = PUDR(:,:)
+ZOMG(:,:) = 0.
+PWSUB(:,:) = 0.
+!
+!
+!* 3. Compute limits on the closure adjustment factor so that the
+! inflow in convective drafts from a given layer can't be larger
+! than the mass contained in this layer initially.
+! ---------------------------------------------------------------
+!
+ZADJMAX(:) = 1000.
+IWORK1(:) = ILCL(:)
+JKP = MINVAL( KDPL(:) )
+DO JK = JKP, IKE
+ DO JI = 1, IIE
+ IF( JK > KDPL(JI) .AND. JK <= IWORK1(JI) ) THEN
+ ZWORK1(JI) = PLMASS(JI,JK) / ( ( PUER(JI,JK) + 1.E-5 ) * PTIMEC(JI) )
+ ZADJMAX(JI) = MIN( ZADJMAX(JI), ZWORK1(JI) )
+ END IF
+ END DO
+END DO
+!
+!
+GWORK1(:) = OTRIG1(:) ! logical array to limit adjustment to not definitively
+ ! adjusted columns
+!
+DO JK = IKB, IKE
+ ZTHLC(:,JK) = PTHL(:,JK) ! initialize adjusted envir. values
+ PRWC(:,JK) = PRW(:,JK)
+ PRCC(:,JK) = PRC(:,JK)
+ PRIC(:,JK) = PRI(:,JK)
+ PTHC(:,JK) = PTH(:,JK)
+END DO
+!
+!
+!
+DO JITER = 1, 4 ! Enter adjustment loop to assure that all CAPE is
+ ! removed within the advective time interval TIMEC
+!
+ ZTIMEC(:) = PTIMEC(:)
+ GWORK4(:,:) = SPREAD( GWORK1(:), DIM=2, NCOPIES=IKS )
+ WHERE( GWORK4(:,:) ) PWSUB(:,:) = 0.
+ ZOMG(:,:)=0.
+!
+ DO JK = IKB + 1, JKMAX
+ JKP = MAX( IKB + 1, JK - 1 )
+ WHERE ( GWORK1(:) .AND. JK <= KCTL(:) )
+!
+!
+!* 4. Determine vertical velocity at top and bottom of each layer
+! to satisfy mass continuity.
+! ---------------------------------------------------------------
+ ! we compute here Domega/Dp = - g rho Dw/Dz = 1/Dt
+!
+ ZWORK1(:) = - ( PUER(:,JKP) - PUDR(:,JKP) ) / PLMASS(:,JKP)
+!
+ PWSUB(:,JK) = PWSUB(:,JKP) - PDPRES(:,JK-1) * ZWORK1(:)
+ ! we use PDPRES(JK-1) and not JKP in order to have zero subsidence
+ ! at the first layer
+!
+!
+!* 5. Compute fractional time step. For stability or
+! mass conservation reasons one must split full time step PTIMEC)
+! ---------------------------------------------------------------
+!
+ ZWORK1(:) = XSTABT * PDPRES(:,JKP) / ( ABS( PWSUB(:,JK) ) + 1.E-10 )
+ ! the factor XSTABT is used for stability reasons
+ ZTIMEC(:) = MIN( ZTIMEC(:), ZWORK1(:) )
+!
+ ! transform vertical velocity in mass flux units
+ ZOMG(:,JK) = PWSUB(:,JK) * PDXDY(:) / XG
+ END WHERE
+ END DO
+!
+!
+ WHERE( GWORK4(:,:) )
+ ZTHLC(:,:) = PTHL(:,:) ! reinitialize adjusted envir. values
+ PRWC(:,:) = PRW(:,:) ! when iteration criterium not attained
+ PRCC(:,:) = PRC(:,:)
+ PRIC(:,:) = PRI(:,:)
+ PTHC(:,:) = PTH(:,:)
+ END WHERE
+!
+!
+! 6. Check for mass conservation, i.e. ZWORK1 > 1.E-2
+! If mass is not conserved, the convective tendencies
+! automatically become zero.
+! ----------------------------------------------------
+!
+ DO JI = 1, IIE
+ JK=KCTL(JI)
+ ZWORK1(JI) = PUDR(JI,JK) * PDPRES(JI,JK) / ( PLMASS(JI,JK) + .1 ) &
+ - PWSUB(JI,JK)
+ END DO
+ WHERE( GWORK1(:) .AND. ABS( ZWORK1(:) ) - .01 > 0. )
+ GWORK1(:) = .FALSE.
+ PTIMEC(:) = 1.E-1
+ ZWORK5(:) = 0.
+ END WHERE
+ DO JK = IKB, IKE
+ PWSUB(:,JK) = PWSUB(:,JK) * ZWORK5(:)
+ END DO
+ GWORK4(:,1:IKB) = .FALSE.
+ GWORK4(:,IKE:IKS) = .FALSE.
+!
+ ITSTEP(:) = INT( PTIMEC(:) / ZTIMEC(:) ) + 1
+ ZTIMEC(:) = PTIMEC(:) / REAL( ITSTEP(:) ) ! adjust fractional time step
+ ! to be an integer multiple of PTIMEC
+ ZTIMC(:,:)= SPREAD( ZTIMEC(:), DIM=2, NCOPIES=IKS )
+ ICOUNT(:) = 0
+!
+!
+!
+ KFTSTEPS = MAXVAL( ITSTEP(:) )
+ DO JSTEP = 1, KFTSTEPS ! Enter the fractional time step loop here
+!
+ ICOUNT(:) = ICOUNT(:) + 1
+!
+ GWORK3(:) = ITSTEP(:) >= ICOUNT(:) .AND. GWORK1(:)
+!
+!
+!* 7. Assign enthalpy and r_w values at the top and bottom of each
+! layer based on the sign of w
+! ------------------------------------------------------------
+!
+ ZTHMFIN(:,:) = 0.
+ ZRWMFIN(:,:) = 0.
+ ZRCMFIN(:,:) = 0.
+ ZRIMFIN(:,:) = 0.
+ ZTHMFOUT(:,:) = 0.
+ ZRWMFOUT(:,:) = 0.
+ ZRCMFOUT(:,:) = 0.
+ ZRIMFOUT(:,:) = 0.
+!
+ DO JK = IKB + 1, JKMAX
+ DO JI = 1, IIE
+ GWORK4(JI,JK) = GWORK3(JI) .AND. JK <= KCTL(JI)
+ END DO
+ JKP = MAX( IKB + 1, JK - 1 )
+ DO JI = 1, IIE
+ IF ( GWORK3(JI) ) THEN
+!
+ ZWORK1(JI) = SIGN( 1., ZOMG(JI,JK) )
+ ZWORK2(JI) = 0.5 * ( 1. + ZWORK1(JI) )
+ ZWORK1(JI) = 0.5 * ( 1. - ZWORK1(JI) )
+ ZTHMFIN(JI,JK) = - ZOMG(JI,JK) * ZTHLC(JI,JKP) * ZWORK1(JI)
+ ZTHMFOUT(JI,JK) = ZOMG(JI,JK) * ZTHLC(JI,JK) * ZWORK2(JI)
+ ZRWMFIN(JI,JK) = - ZOMG(JI,JK) * PRWC(JI,JKP) * ZWORK1(JI)
+ ZRWMFOUT(JI,JK) = ZOMG(JI,JK) * PRWC(JI,JK) * ZWORK2(JI)
+ ZRCMFIN(JI,JK) = - ZOMG(JI,JK) * PRCC(JI,JKP) * ZWORK1(JI)
+ ZRCMFOUT(JI,JK) = ZOMG(JI,JK) * PRCC(JI,JK) * ZWORK2(JI)
+ ZRIMFIN(JI,JK) = - ZOMG(JI,JK) * PRIC(JI,JKP) * ZWORK1(JI)
+ ZRIMFOUT(JI,JK) = ZOMG(JI,JK) * PRIC(JI,JK) * ZWORK2(JI)
+ END IF
+ END DO
+ DO JI = 1, IIE
+ IF ( GWORK3(JI) ) THEN
+ ZTHMFIN(JI,JKP) = ZTHMFIN(JI,JKP) + ZTHMFOUT(JI,JK) * ZWORK2(JI)
+ ZTHMFOUT(JI,JKP) = ZTHMFOUT(JI,JKP) + ZTHMFIN(JI,JK) * ZWORK1(JI)
+ ZRWMFIN(JI,JKP) = ZRWMFIN(JI,JKP) + ZRWMFOUT(JI,JK) * ZWORK2(JI)
+ ZRWMFOUT(JI,JKP) = ZRWMFOUT(JI,JKP) + ZRWMFIN(JI,JK) * ZWORK1(JI)
+ ZRCMFIN(JI,JKP) = ZRCMFIN(JI,JKP) + ZRCMFOUT(JI,JK) * ZWORK2(JI)
+ ZRCMFOUT(JI,JKP) = ZRCMFOUT(JI,JKP) + ZRCMFIN(JI,JK) * ZWORK1(JI)
+ ZRIMFIN(JI,JKP) = ZRIMFIN(JI,JKP) + ZRIMFOUT(JI,JK) * ZWORK2(JI)
+ ZRIMFOUT(JI,JKP) = ZRIMFOUT(JI,JKP) + ZRIMFIN(JI,JK) * ZWORK1(JI)
+!
+ END IF
+ END DO
+ END DO
+!
+ WHERE ( GWORK4(:,:) )
+!
+!******************************************************************************
+!
+!* 8. Update the environmental values of enthalpy and r_w at each level
+! NOTA: These are the MAIN EQUATIONS of the scheme
+! -----------------------------------------------------------------
+!
+!
+ ZTHLC(:,:) = ZTHLC(:,:) + ZTIMC(:,:) / PLMASS(:,:) * ( &
+ ZTHMFIN(:,:) + PUDR(:,:) * PUTHL(:,:) &
+ - ZTHMFOUT(:,:) - PUER(:,:) * PTHL(:,:) )
+ PRWC(:,:) = PRWC(:,:) + ZTIMC(:,:) / PLMASS(:,:) * ( &
+ ZRWMFIN(:,:) + PUDR(:,:) * PURW(:,:) &
+ - ZRWMFOUT(:,:) - PUER(:,:) * PRW(:,:) )
+ PRCC(:,:) = PRCC(:,:) + ZTIMC(:,:) / PLMASS(:,:) * ( &
+ ZRCMFIN(:,:) + PUDR(:,:) * PURC(:,:) - ZRCMFOUT(:,:) - &
+ PUER(:,:) * PRC(:,:) )
+ PRIC(:,:) = PRIC(:,:) + ZTIMC(:,:) / PLMASS(:,:) * ( &
+ ZRIMFIN(:,:) + PUDR(:,:) * PURI(:,:) - ZRIMFOUT(:,:) - &
+ PUER(:,:) * PRI(:,:) )
+!
+!
+!******************************************************************************
+!
+ END WHERE
+!
+ END DO ! Exit the fractional time step loop
+!
+!
+!* 10. Compute final linearized value of theta envir.
+! ----------------------------------------------
+!
+ DO JK = IKB + 1, JKMAX
+ DO JI = 1, IIE
+ IF( GWORK1(JI) .AND. JK <= KCTL(JI) ) THEN
+ ZPI(JI) = ( XP00 / PPRES(JI,JK) ) ** ZRDOCP
+ ZCPH(JI) = XCPD + PRWC(JI,JK) * XCPV
+ ZWORK2(JI) = PTH(JI,JK) / ZPI(JI) ! first temperature estimate
+ ZLV(JI) = XLVTT + ( XCPV - XCL ) * ( ZWORK2(JI) - XTT )
+ ZLS(JI) = XLVTT + ( XCPV - XCI ) * ( ZWORK2(JI) - XTT )
+ ! final linearized temperature
+ ZWORK2(JI) = ( ZTHLC(JI,JK) + ZLV(JI) * PRCC(JI,JK) + ZLS(JI) * PRIC(JI,JK) &
+ - (1. + PRWC(JI,JK) ) * XG * PZ(JI,JK) ) / ZCPH(JI)
+ ZWORK2(JI) = MAX( 180., MIN( 340., ZWORK2(JI) ) )
+ PTHC(JI,JK)= ZWORK2(JI) * ZPI(JI) ! final adjusted envir. theta
+ END IF
+ END DO
+ END DO
+!
+!
+!* 11. Compute new cloud ( properties at new LCL )
+! NOTA: The computations are very close to
+! that in routine TRIGGER_FUNCT
+! ---------------------------------------------
+!
+ CALL CONVECT_CLOSURE_THRVLCL( KLON, KLEV, &
+ PPRES, PTHC, PRWC, PZ, GWORK1, &
+ ZTHLCL, ZRVLCL, ZZLCL, ZTLCL, ZTELCL, &
+ ILCL, KDPL, KPBL )
+!
+!
+ ZTLCL(:) = MAX( 230., MIN( 335., ZTLCL(:) ) ) ! set some overflow bounds
+ ZTELCL(:) = MAX( 230., MIN( 335., ZTELCL(:) ) )
+ ZTHLCL(:) = MAX( 230., MIN( 345., ZTHLCL(:) ) )
+ ZRVLCL(:) = MAX( 0., MIN( 1., ZRVLCL(:) ) )
+!
+!
+!* 12. Compute adjusted CAPE
+! ---------------------
+!
+ ZCAPE(:) = 0.
+ ZPI(:) = ZTHLCL(:) / ZTLCL(:)
+ ZPI(:) = MAX( 0.95, MIN( 1.5, ZPI(:) ) )
+ ZWORK1(:) = XP00 / ZPI(:) ** ZCPORD ! pressure at LCL
+!
+ CALL CONVECT_SATMIXRATIO( KLON, ZWORK1, ZTELCL, ZWORK3, ZLV, ZLS, ZCPH )
+ ZWORK3(:) = MIN( .1, MAX( 0., ZWORK3(:) ) )
+!
+ ! compute theta_e updraft undilute
+ ZTHEUL(:) = ZTLCL(:) * ZPI(:) ** ( 1. - 0.28 * ZRVLCL(:) ) &
+ * EXP( ( 3374.6525 / ZTLCL(:) - 2.5403 ) &
+ * ZRVLCL(:) * ( 1. + 0.81 * ZRVLCL(:) ) )
+!
+ ! compute theta_e saturated environment at LCL
+ ZTHES1(:) = ZTELCL(:) * ZPI(:) ** ( 1. - 0.28 * ZWORK3(:) ) &
+ * EXP( ( 3374.6525 / ZTELCL(:) - 2.5403 ) &
+ * ZWORK3(:) * ( 1. + 0.81 * ZWORK3(:) ) )
+!
+ DO JK = MINVAL( ILCL(:) ), JKMAX
+ JKP = JK - 1
+ DO JI = 1, IIE
+ ZWORK4(JI) = 1.
+ IF ( JK == ILCL(JI) ) ZWORK4(JI) = 0.
+!
+ ! compute theta_e saturated environment and adjusted values
+ ! of theta
+!
+ GWORK3(JI) = JK >= ILCL(JI) .AND. JK <= KCTL(JI) .AND. GWORK1(JI)
+!
+ ZPI(JI) = ( XP00 / PPRES(JI,JK) ) ** ZRDOCP
+ ZWORK2(JI) = PTHC(JI,JK) / ZPI(JI)
+ END DO
+!
+ CALL CONVECT_SATMIXRATIO( KLON, PPRES(:,JK), ZWORK2, ZWORK3, ZLV, ZLS, ZCPH )
+!
+!
+ DO JI = 1, IIE
+ IF ( GWORK3(JI) ) THEN
+ ZTHES2(JI) = ZWORK2(JI) * ZPI(JI) ** ( 1. - 0.28 * ZWORK3(JI) ) &
+ * EXP( ( 3374.6525 / ZWORK2(JI) - 2.5403 ) &
+ * ZWORK3(JI) * ( 1. + 0.81 * ZWORK3(JI) ) )
+!
+ ZWORK3(JI) = PZ(JI,JK) - PZ(JI,JKP) * ZWORK4(JI) - &
+ ( 1. - ZWORK4(JI) ) * ZZLCL(JI) ! level thickness
+ ZWORK1(JI) = ( 2. * ZTHEUL(JI) ) / ( ZTHES1(JI) + ZTHES2(JI) ) - 1.
+ ZCAPE(JI) = ZCAPE(JI) + XG * ZWORK3(JI) * MAX( 0., ZWORK1(JI) )
+ ZTHES1(JI) = ZTHES2(JI)
+ END IF
+ END DO
+ END DO
+!
+!
+!* 13. Determine mass adjustment factor knowing how much
+! CAPE has been removed.
+! -------------------------------------------------
+!
+ WHERE ( GWORK1(:) )
+ ZWORK1(:) = MAX( PCAPE(:) - ZCAPE(:), 0.2 * PCAPE(:) )
+ ZWORK2(:) = ZCAPE(:) / ( PCAPE(:) + 1.E-8 )
+!
+ GWORK1(:) = ZWORK2(:) > 0.2 .OR. ZCAPE(:) == 0. ! mask for adjustment
+ END WHERE
+!
+ WHERE ( ZCAPE(:) == 0. .AND. GWORK1(:) ) ZADJ(:) = ZADJ(:) * 0.5
+ WHERE ( ZCAPE(:) /= 0. .AND. GWORK1(:) ) &
+ ZADJ(:) = ZADJ(:) * XSTABC * PCAPE(:) / ( ZWORK1(:) + 1.E-8 )
+ ZADJ(:) = MIN( ZADJ(:), ZADJMAX(:) )
+!
+!
+!* 13. Adjust mass flux by the factor ZADJ to converge to
+! specified degree of stabilization
+! ----------------------------------------------------
+!
+ CALL CONVECT_CLOSURE_ADJUST_SHAL( KLON, KLEV, ZADJ, &
+ PUMF, ZUMF, PUER, ZUER, PUDR, ZUDR )
+!
+!
+ IF ( COUNT( GWORK1(:) ) == 0 ) EXIT ! exit big adjustment iteration loop
+ ! when all columns have reached
+ ! desired degree of stabilization.
+!
+END DO ! end of big adjustment iteration loop
+!
+!
+ ! skip adj. total water array to water vapor
+DO JK = IKB, IKE
+ PRWC(:,JK) = MAX( 0., PRWC(:,JK) - PRCC(:,JK) - PRIC(:,JK) )
+END DO
+!
+!
+END SUBROUTINE CONVECT_CLOSURE_SHAL
diff --git a/src/mesonh/conv/convect_closure_thrvlcl.f90 b/src/mesonh/conv/convect_closure_thrvlcl.f90
new file mode 100644
index 000000000..b83976908
--- /dev/null
+++ b/src/mesonh/conv/convect_closure_thrvlcl.f90
@@ -0,0 +1,299 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 conv 2006/05/18 13:07:25
+!-----------------------------------------------------------------
+! #################
+ MODULE MODI_CONVECT_CLOSURE_THRVLCL
+! #################
+!
+INTERFACE
+!
+ SUBROUTINE CONVECT_CLOSURE_THRVLCL( KLON, KLEV, &
+ PPRES, PTH, PRV, PZ, OWORK1, &
+ PTHLCL, PRVLCL, PZLCL, PTLCL, PTELCL,&
+ KLCL, KDPL, KPBL )
+!
+INTEGER, INTENT(IN) :: KLON ! horizontal dimension
+INTEGER, INTENT(IN) :: KLEV ! vertical dimension
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTH ! theta
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRV ! vapor mixing ratio
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PPRES ! pressure
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PZ ! height of grid point (m)
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KDPL ! contains vert. index of DPL
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KPBL ! " vert. index of source layer top
+LOGICAL, DIMENSION(KLON), INTENT(IN) :: OWORK1! logical mask
+!
+REAL, DIMENSION(KLON), INTENT(OUT):: PTHLCL ! theta at LCL
+REAL, DIMENSION(KLON), INTENT(OUT):: PRVLCL ! vapor mixing ratio at LCL
+REAL, DIMENSION(KLON), INTENT(OUT):: PZLCL ! height at LCL (m)
+REAL, DIMENSION(KLON), INTENT(OUT):: PTLCL ! temperature at LCL (m)
+REAL, DIMENSION(KLON), INTENT(OUT):: PTELCL ! environm. temp. at LCL (K)
+INTEGER, DIMENSION(KLON), INTENT(OUT):: KLCL ! contains vert. index of LCL
+!
+END SUBROUTINE CONVECT_CLOSURE_THRVLCL
+!
+END INTERFACE
+!
+END MODULE MODI_CONVECT_CLOSURE_THRVLCL
+! #########################################################################
+ SUBROUTINE CONVECT_CLOSURE_THRVLCL( KLON, KLEV, &
+ PPRES, PTH, PRV, PZ, OWORK1, &
+ PTHLCL, PRVLCL, PZLCL, PTLCL, PTELCL,&
+ KLCL, KDPL, KPBL )
+! #########################################################################
+!
+!!**** Determine thermodynamic properties at new LCL
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to determine the thermodynamic
+!! properties at the new lifting condensation level LCL
+!!
+!!
+!!
+!!** METHOD
+!! ------
+!! see CONVECT_TRIGGER_FUNCT
+!!
+!!
+!!
+!! EXTERNAL
+!! --------
+!! Routine CONVECT_SATMIXRATIO
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST
+!! XG ! gravity constant
+!! XP00 ! Reference pressure
+!! XRD, XRV ! Gaz constants for dry air and water vapor
+!! XCPD ! Cpd (dry air)
+!! XTT ! triple point temperature
+!! XBETAW, XGAMW ! constants for vapor saturation pressure
+!!
+!! Module MODD_CONVPAR
+!! XA25 ! reference grid area
+!! XZLCL ! lowest allowed pressure difference between
+!! ! surface and LCL
+!! XZPBL ! minimum mixed layer depth to sustain convection
+!! XWTRIG ! constant in vertical velocity trigger
+!!
+!! Module MODD_CONVPAREXT
+!! JCVEXB, JCVEXT ! extra levels on the vertical boundaries
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Book2 of documentation ( routine TRIGGER_FUNCT)
+!! Fritsch and Chappell (1980), J. Atm. Sci., Vol. 37, 1722-1761.
+!!
+!! AUTHOR
+!! ------
+!! P. BECHTOLD * Laboratoire d'Aerologie *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 07/11/95
+!! Last modified 04/10/97
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_CONVPAR
+USE MODD_CONVPAREXT
+USE MODI_CONVECT_SATMIXRATIO
+!
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KLON ! horizontal dimension
+INTEGER, INTENT(IN) :: KLEV ! vertical dimension
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTH ! theta
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRV ! vapor mixing ratio
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PPRES ! pressure
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PZ ! height of grid point (m)
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KDPL ! contains vert. index of DPL
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KPBL ! " vert. index of source layer top
+LOGICAL, DIMENSION(KLON), INTENT(IN) :: OWORK1! logical mask
+!
+REAL, DIMENSION(KLON), INTENT(OUT):: PTHLCL ! theta at LCL
+REAL, DIMENSION(KLON), INTENT(OUT):: PRVLCL ! vapor mixing ratio at LCL
+REAL, DIMENSION(KLON), INTENT(OUT):: PZLCL ! height at LCL (m)
+REAL, DIMENSION(KLON), INTENT(OUT):: PTLCL ! temperature at LCL (m)
+REAL, DIMENSION(KLON), INTENT(OUT):: PTELCL ! environm. temp. at LCL (K)
+INTEGER, DIMENSION(KLON), INTENT(OUT):: KLCL ! contains vert. index of LCL
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: JK, JKM, JKMIN, JKMAX ! vertical loop index
+INTEGER :: JI ! horizontal loop index
+INTEGER :: IIE, IKB, IKE ! horizontal + vertical loop bounds
+REAL :: ZEPS ! R_d / R_v
+REAL :: ZCPORD, ZRDOCP ! C_pd / R_d, R_d / C_pd
+!
+REAL, DIMENSION(KLON) :: ZPLCL ! pressure at LCL
+REAL, DIMENSION(KLON) :: ZTMIX ! mixed layer temperature
+REAL, DIMENSION(KLON) :: ZEVMIX ! mixed layer water vapor pressure
+REAL, DIMENSION(KLON) :: ZDPTHMIX, ZPRESMIX ! mixed layer depth and pressure
+REAL, DIMENSION(KLON) :: ZLV, ZCPH! specific heats of vaporisation, dry air
+REAL, DIMENSION(KLON) :: ZDP ! pressure between LCL and model layer
+REAL, DIMENSION(KLON) :: ZWORK1, ZWORK2 ! work arrays
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 0.3 Compute array bounds
+! --------------------
+!
+IIE = KLON
+IKB = 1 + JCVEXB
+IKE = KLEV - JCVEXT
+!
+!
+!* 1. Initialize local variables
+! --------------------------
+!
+ZEPS = XRD / XRV
+ZCPORD = XCPD / XRD
+ZRDOCP = XRD / XCPD
+!
+ZDPTHMIX(:) = 0.
+ZPRESMIX(:) = 0.
+PTHLCL(:) = 300.
+PTLCL(:) = 300.
+PTELCL(:) = 300.
+PRVLCL(:) = 0.
+PZLCL(:) = PZ(:,IKB)
+ZTMIX(:) = 230.
+ZPLCL(:) = 1.E4
+KLCL(:) = IKB + 1
+!
+!
+!* 2. Construct a mixed layer as in TRIGGER_FUNCT
+! -------------------------------------------
+!
+ JKMAX = MAXVAL( KPBL(:) )
+ JKMIN = MINVAL( KDPL(:) )
+ DO JK = IKB + 1, JKMAX
+ JKM = JK + 1
+ DO JI = 1, IIE
+ IF ( JK >= KDPL(JI) .AND. JK <= KPBL(JI) ) THEN
+!
+ ZWORK1(JI) = PPRES(JI,JK) - PPRES(JI,JKM)
+ ZDPTHMIX(JI) = ZDPTHMIX(JI) + ZWORK1(JI)
+ ZPRESMIX(JI) = ZPRESMIX(JI) + PPRES(JI,JK) * ZWORK1(JI)
+ PTHLCL(JI) = PTHLCL(JI) + PTH(JI,JK) * ZWORK1(JI)
+ PRVLCL(JI) = PRVLCL(JI) + PRV(JI,JK) * ZWORK1(JI)
+!
+ END IF
+ END DO
+ END DO
+!
+!
+WHERE ( OWORK1(:) )
+!
+ ZPRESMIX(:) = ZPRESMIX(:) / ZDPTHMIX(:)
+ PTHLCL(:) = PTHLCL(:) / ZDPTHMIX(:)
+ PRVLCL(:) = PRVLCL(:) / ZDPTHMIX(:)
+!
+!* 3.1 Use an empirical direct solution ( Bolton formula )
+! to determine temperature and pressure at LCL.
+! Nota: the adiabatic saturation temperature is not
+! equal to the dewpoint temperature
+! --------------------------------------------------
+!
+!
+ ZTMIX(:) = PTHLCL(:) * ( ZPRESMIX(:) / XP00 ) ** ZRDOCP
+ ZEVMIX(:) = PRVLCL(:) * ZPRESMIX(:) / ( PRVLCL(:) + ZEPS )
+ ZEVMIX(:) = MAX( 1.E-8, ZEVMIX(:) )
+ ZWORK1(:) = ALOG( ZEVMIX(:) / 613.3 )
+ ! dewpoint temperature
+ ZWORK1(:) = ( 4780.8 - 32.19 * ZWORK1(:) ) / ( 17.502 - ZWORK1(:) )
+ ! adiabatic saturation temperature
+ PTLCL(:) = ZWORK1(:) - ( .212 + 1.571E-3 * ( ZWORK1(:) - XTT ) &
+ - 4.36E-4 * ( ZTMIX(:) - XTT ) ) * ( ZTMIX(:) - ZWORK1(:) )
+ PTLCL(:) = MIN( PTLCL(:), ZTMIX(:) )
+ ZPLCL(:) = XP00 * ( PTLCL(:) / PTHLCL(:) ) ** ZCPORD
+!
+END WHERE
+!
+ ZPLCL(:) = MIN( 2.E5, MAX( 10., ZPLCL(:) ) ) ! bound to avoid overflow
+!
+!
+!* 3.2 Correct PTLCL in order to be completely consistent
+! with MNH saturation formula
+! --------------------------------------------------
+!
+ CALL CONVECT_SATMIXRATIO( KLON, ZPLCL, PTLCL, ZWORK1, ZLV, ZWORK2, ZCPH )
+ WHERE( OWORK1(:) )
+ ZWORK2(:) = ZWORK1(:) / PTLCL(:) * ( XBETAW / PTLCL(:) - XGAMW ) ! dr_sat/dT
+ ZWORK2(:) = ( ZWORK1(:) - PRVLCL(:) ) / &
+ ( 1. + ZLV(:) / ZCPH(:) * ZWORK2(:) )
+ PTLCL(:) = PTLCL(:) - ZLV(:) / ZCPH(:) * ZWORK2(:)
+!
+ END WHERE
+!
+!
+!* 3.3 If PRVLCL is oversaturated set humidity and temperature
+! to saturation values.
+! -------------------------------------------------------
+!
+ CALL CONVECT_SATMIXRATIO( KLON, ZPRESMIX, ZTMIX, ZWORK1, ZLV, ZWORK2, ZCPH )
+ WHERE( OWORK1(:) .AND. PRVLCL(:) > ZWORK1(:) )
+ ZWORK2(:) = ZWORK1(:) / ZTMIX(:) * ( XBETAW / ZTMIX(:) - XGAMW ) ! dr_sat/dT
+ ZWORK2(:) = ( ZWORK1(:) - PRVLCL(:) ) / &
+ ( 1. + ZLV(:) / ZCPH(:) * ZWORK2(:) )
+ PTLCL(:) = ZTMIX(:) + ZLV(:) / ZCPH(:) * ZWORK2(:)
+ PRVLCL(:) = PRVLCL(:) - ZWORK2(:)
+ ZPLCL(:) = ZPRESMIX(:)
+ PTHLCL(:) = PTLCL(:) * ( XP00 / ZPLCL(:) ) ** ZRDOCP
+ END WHERE
+!
+!
+!* 4.1 Determine vertical loop index at the LCL
+! -----------------------------------------
+!
+ DO JK = JKMIN, IKE - 1
+ DO JI = 1, IIE
+ IF ( ZPLCL(JI) <= PPRES(JI,JK) .AND. OWORK1(JI) ) THEN
+ KLCL(JI) = JK + 1
+ PZLCL(JI) = PZ(JI,JK+1)
+ END IF
+ END DO
+ END DO
+!
+!
+!* 4.2 Estimate height and environmental temperature at LCL
+! ----------------------------------------------------
+!
+ DO JI = 1, IIE
+ JK = KLCL(JI)
+ JKM = JK - 1
+ ZDP(JI) = ALOG( ZPLCL(JI) / PPRES(JI,JKM) ) / &
+ ALOG( PPRES(JI,JK) / PPRES(JI,JKM) )
+ ZWORK1(JI) = PTH(JI,JK) * ( PPRES(JI,JK) / XP00 ) ** ZRDOCP
+ ZWORK2(JI) = PTH(JI,JKM) * ( PPRES(JI,JKM) / XP00 ) ** ZRDOCP
+ ZWORK1(JI) = ZWORK2(JI) + ( ZWORK1(JI) - ZWORK2(JI) ) * ZDP(JI)
+ ! we compute the precise value of the LCL
+ ! The precise height is between the levels KLCL and KLCL-1.
+ ZWORK2(JI) = PZ(JI,JKM) + ( PZ(JI,JK) - PZ(JI,JKM) ) * ZDP(JI)
+ END DO
+ WHERE( OWORK1(:) )
+ PTELCL(:) = ZWORK1(:)
+ PZLCL(:) = ZWORK2(:)
+ END WHERE
+!
+!
+!
+END SUBROUTINE CONVECT_CLOSURE_THRVLCL
diff --git a/src/mesonh/conv/convect_condens.f90 b/src/mesonh/conv/convect_condens.f90
new file mode 100644
index 000000000..b74799aa7
--- /dev/null
+++ b/src/mesonh/conv/convect_condens.f90
@@ -0,0 +1,191 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 conv 2006/05/18 13:07:25
+!-----------------------------------------------------------------
+! #############################################################################
+! #################
+ MODULE MODI_CONVECT_CONDENS
+! #################
+!
+INTERFACE
+!
+ SUBROUTINE CONVECT_CONDENS( KLON, &
+ KICE, PPRES, PTHL, PRW, PRCO, PRIO, PZ, OWORK1, &
+ PT, PEW, PRC, PRI, PLV, PLS, PCPH )
+!
+INTEGER, INTENT(IN) :: KLON ! horizontal loop index
+INTEGER, INTENT(IN) :: KICE ! flag for ice ( 1 = yes,
+ ! 0 = no ice )
+REAL, DIMENSION(KLON), INTENT(IN) :: PPRES ! pressure
+REAL, DIMENSION(KLON), INTENT(IN) :: PTHL ! enthalpy (J/kg)
+REAL, DIMENSION(KLON), INTENT(IN) :: PRW ! total water mixing ratio
+REAL, DIMENSION(KLON), INTENT(IN) :: PRCO ! cloud water estimate (kg/kg)
+REAL, DIMENSION(KLON), INTENT(IN) :: PRIO ! cloud ice estimate (kg/kg)
+REAL, DIMENSION(KLON), INTENT(IN) :: PZ ! level height (m)
+LOGICAL, DIMENSION(KLON),INTENT(IN) :: OWORK1 ! logical mask
+!
+!
+REAL, DIMENSION(KLON), INTENT(OUT):: PT ! temperature
+REAL, DIMENSION(KLON), INTENT(OUT):: PRC ! cloud water mixing ratio(kg/kg)
+REAL, DIMENSION(KLON), INTENT(OUT):: PRI ! cloud ice mixing ratio (kg/kg)
+REAL, DIMENSION(KLON), INTENT(OUT):: PLV ! latent heat L_v
+REAL, DIMENSION(KLON), INTENT(OUT):: PLS ! latent heat L_s
+REAL, DIMENSION(KLON), INTENT(OUT):: PCPH ! specific heat C_ph
+REAL, DIMENSION(KLON), INTENT(OUT):: PEW ! water saturation mixing ratio
+!
+END SUBROUTINE CONVECT_CONDENS
+!
+END INTERFACE
+!
+END MODULE MODI_CONVECT_CONDENS
+ SUBROUTINE CONVECT_CONDENS( KLON, &
+ KICE, PPRES, PTHL, PRW, PRCO, PRIO, PZ, OWORK1, &
+ PT, PEW, PRC, PRI, PLV, PLS, PCPH )
+! #############################################################################
+!
+!!**** Compute temperature cloud and ice water content from enthalpy and r_w
+!!
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to determine cloud condensate
+!! and to return values for L_v, L_s and C_ph
+!!
+!!
+!!** METHOD
+!! ------
+!! Condensate is extracted iteratively
+!!
+!!
+!! EXTERNAL
+!! --------
+!! None
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! Module MODD_CST
+!! XG ! gravity constant
+!! XALPW, XBETAW, XGAMW ! constants for water saturation pressure
+!! XALPI, XBETAI, XGAMI ! constants for ice saturation pressure
+!! XP00 ! reference pressure
+!! XRD, XRV ! gaz constants for dry air and water vapor
+!! XCPD, XCPV ! specific heat for dry air and water vapor
+!! XCL, XCI ! specific heat for liquid water and ice
+!! XTT ! triple point temperature
+!! XLVTT, XLSTT ! vaporization, sublimation heat constant
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CONVPAR
+!! XTFRZ1 ! begin of freezing interval
+!! XTFRZ2 ! end of freezing interval
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Book1,2 of documentation ( routine CONVECT_CONDENS)
+!!
+!! AUTHOR
+!! ------
+!! P. BECHTOLD * Laboratoire d'Aerologie *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 07/11/95
+!! Last modified 04/10/97
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_CONVPAR
+!
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KLON ! horizontal loop index
+INTEGER, INTENT(IN) :: KICE ! flag for ice ( 1 = yes,
+ ! 0 = no ice )
+REAL, DIMENSION(KLON), INTENT(IN) :: PPRES ! pressure
+REAL, DIMENSION(KLON), INTENT(IN) :: PTHL ! enthalpy (J/kg)
+REAL, DIMENSION(KLON), INTENT(IN) :: PRW ! total water mixing ratio
+REAL, DIMENSION(KLON), INTENT(IN) :: PRCO ! cloud water estimate (kg/kg)
+REAL, DIMENSION(KLON), INTENT(IN) :: PRIO ! cloud ice estimate (kg/kg)
+REAL, DIMENSION(KLON), INTENT(IN) :: PZ ! level height (m)
+LOGICAL, DIMENSION(KLON),INTENT(IN) :: OWORK1 ! logical mask
+!
+!
+REAL, DIMENSION(KLON), INTENT(OUT):: PT ! temperature
+REAL, DIMENSION(KLON), INTENT(OUT):: PRC ! cloud water mixing ratio(kg/kg)
+REAL, DIMENSION(KLON), INTENT(OUT):: PRI ! cloud ice mixing ratio (kg/kg)
+REAL, DIMENSION(KLON), INTENT(OUT):: PLV ! latent heat L_v
+REAL, DIMENSION(KLON), INTENT(OUT):: PLS ! latent heat L_s
+REAL, DIMENSION(KLON), INTENT(OUT):: PCPH ! specific heat C_ph
+REAL, DIMENSION(KLON), INTENT(OUT):: PEW ! water saturation mixing ratio
+!
+!* 0.2 Declarations of local variables KLON
+!
+INTEGER :: JITER ! iteration index
+REAL :: ZEPS ! R_d / R_v
+!
+REAL, DIMENSION(KLON) :: ZEI ! ice saturation mixing ratio
+REAL, DIMENSION(KLON) :: ZWORK1, ZWORK2, ZWORK3, ZT ! work arrays
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. Initialize temperature and Exner function
+! -----------------------------------------
+!
+ZEPS = XRD / XRV
+!
+!
+ ! Make a first temperature estimate, based e.g. on values of
+ ! r_c and r_i at lower level
+!
+ !! Note that the definition of ZCPH is not the same as used in
+ !! routine CONVECT_SATMIXRATIO
+ PCPH(:) = XCPD + XCPV * PRW(:)
+ ZWORK1(:) = ( 1. + PRW(:) ) * XG * PZ(:)
+ PT(:) = ( PTHL(:) + PRCO(:) * XLVTT + PRIO(:) * XLSTT - ZWORK1(:) ) &
+ / PCPH(:)
+ PT(:) = MAX(180., MIN( 330., PT(:) ) ) ! set overflow bounds in
+ ! case that PTHL=0
+!
+!
+!* 2. Enter the iteration loop
+! ------------------------
+!
+DO JITER = 1,6
+ PEW(:) = EXP( XALPW - XBETAW / PT(:) - XGAMW * ALOG( PT(:) ) )
+ ZEI(:) = EXP( XALPI - XBETAI / PT(:) - XGAMI * ALOG( PT(:) ) )
+ PEW(:) = ZEPS * PEW(:) / ( PPRES(:) - PEW(:) )
+ ZEI(:) = ZEPS * ZEI(:) / ( PPRES(:) - ZEI(:) )
+!
+ PLV(:) = XLVTT + ( XCPV - XCL ) * ( PT(:) - XTT ) ! compute L_v
+ PLS(:) = XLSTT + ( XCPV - XCI ) * ( PT(:) - XTT ) ! compute L_i
+!
+ ZWORK2(:) = ( XTFRZ1 - PT(:) ) / ( XTFRZ1 - XTFRZ2 ) ! freezing interval
+ ZWORK2(:) = MAX( 0., MIN(1., ZWORK2(:) ) ) * REAL( KICE )
+ ZWORK3(:) = ( 1. - ZWORK2(:) ) * PEW(:) + ZWORK2(:) * ZEI(:)
+ PRC(:) = MAX( 0., ( 1. - ZWORK2(:) ) * ( PRW(:) - ZWORK3(:) ) )
+ PRI(:) = MAX( 0., ZWORK2(:) * ( PRW(:) - ZWORK3(:) ) )
+ ZT(:) = ( PTHL(:) + PRC(:) * PLV(:) + PRI(:) * PLS(:) - ZWORK1(:) ) &
+ / PCPH(:)
+ PT(:) = PT(:) + ( ZT(:) - PT(:) ) * 0.4 ! force convergence
+ PT(:) = MAX( 175., MIN( 330., PT(:) ) )
+END DO
+!
+!
+END SUBROUTINE CONVECT_CONDENS
diff --git a/src/mesonh/conv/convect_downdraft.f90 b/src/mesonh/conv/convect_downdraft.f90
new file mode 100644
index 000000000..814455eb9
--- /dev/null
+++ b/src/mesonh/conv/convect_downdraft.f90
@@ -0,0 +1,505 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 conv 2006/05/18 13:07:25
+!-----------------------------------------------------------------
+! #################
+ MODULE MODI_CONVECT_DOWNDRAFT
+! #################
+!
+INTERFACE
+!
+ SUBROUTINE CONVECT_DOWNDRAFT( KLON, KLEV, &
+ KICE, PPRES, PDPRES, PZ, PTH, PTHES, &
+ PRW, PRC, PRI, &
+ PPREF, KLCL, KCTL, KETL, &
+ PUTHL, PURW, PURC, PURI, &
+ PDMF, PDER, PDDR, PDTHL, PDRW, &
+ PMIXF, PDTEVR, KLFS, KDBL, KML, &
+ PDTEVRF )
+!
+INTEGER, INTENT(IN) :: KLON ! horizontal dimension
+INTEGER, INTENT(IN) :: KLEV ! vertical dimension
+INTEGER, INTENT(IN) :: KICE ! flag for ice ( 1 = yes,
+ ! 0 = no ice )
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTH ! grid scale theta
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTHES ! grid scale saturated theta_e
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRW ! grid scale total water
+ ! mixing ratio
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRC ! grid scale r_c (cloud water)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRI ! grid scale r_i (cloud ice)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PPRES ! pressure (Pa)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PDPRES! pressure difference between
+ ! bottom and top of layer (Pa)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PZ ! level height (m)
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KLCL ! contains vert. index of LCL
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KCTL ! contains vert. index of CTL
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KETL ! contains vert. index of
+ ! equilibrium (zero buoyancy) level
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KML ! " vert. index of melting level
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PUTHL ! updraft enthalpy (J/kg)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PURW ! updraft total water (kg/kg)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PURC ! updraft r_c (kg/kg)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PURI ! updraft r_i (kg/kg)
+REAL, DIMENSION(KLON), INTENT(IN) :: PPREF ! precipitation efficiency
+!
+!
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PDMF ! downdraft mass flux (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PDER ! downdraft entrainment (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PDDR ! downdraft detrainment (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PDTHL ! downdraft enthalpy (J/kg)
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PDRW ! downdraft total water (kg/kg)
+REAL, DIMENSION(KLON), INTENT(OUT):: PMIXF ! mixed fraction at LFS
+REAL, DIMENSION(KLON), INTENT(OUT):: PDTEVR ! total downdraft evaporation
+ ! rate at LFS (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PDTEVRF! downdraft evaporation rate
+INTEGER, DIMENSION(KLON), INTENT(OUT):: KLFS ! contains vert. index of LFS
+INTEGER, DIMENSION(KLON), INTENT(OUT):: KDBL ! contains vert. index of DBL
+!
+END SUBROUTINE CONVECT_DOWNDRAFT
+!
+END INTERFACE
+!
+END MODULE MODI_CONVECT_DOWNDRAFT
+! ##########################################################################
+ SUBROUTINE CONVECT_DOWNDRAFT( KLON, KLEV, &
+ KICE, PPRES, PDPRES, PZ, PTH, PTHES, &
+ PRW, PRC, PRI, &
+ PPREF, KLCL, KCTL, KETL, &
+ PUTHL, PURW, PURC, PURI, &
+ PDMF, PDER, PDDR, PDTHL, PDRW, &
+ PMIXF, PDTEVR, KLFS, KDBL, KML, &
+ PDTEVRF )
+! ##########################################################################
+!
+!!**** Compute downdraft properties from LFS to DBL.
+!!
+!!
+!! PDRPOSE
+!! -------
+!! The purpose of this routine is to determine downdraft properties
+!! ( mass flux, thermodynamics )
+!!
+!!
+!!** METHOD
+!! ------
+!! Computations are done at every model level starting from top.
+!! The use of masks allows to optimise the inner loops (horizontal loops).
+!!
+!!
+!!
+!! EXTERNAL
+!! --------
+!! Routine CONVECT_SATMIXRATIO
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! Module MODD_CST
+!! XG ! gravity constant
+!! XPI ! Pi
+!! XP00 ! reference pressure
+!! XRD, XRV ! gaz constants for dry air and water vapor
+!! XCPD ! Cpd (dry air)
+!! XCPV, XCL, XCI ! Cp of water vapor, liquid water and ice
+!! XTT ! triple point temperature
+!! XLVTT, XLSTT ! vaporisation/sublimation heat at XTT
+!!
+!! Module MODD_CONVPAR
+!! XCRAD ! cloud radius
+!! XZPBL ! thickness of downdraft detrainment layer
+!! XENTR ! entrainment constant in pressure coordinates
+!! XRHDBC ! relative humidity in downdraft below cloud
+!!
+!! Module MODD_CONVPAREXT
+!! JCVEXB, JCVEXT ! extra levels on the vertical boundaries
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Book1,2 of documentation ( routine CONVECT_DOWNDRAFT)
+!! Kain and Fritsch, 1993, Meteor. Monographs, Vol.
+!!
+!! AUTHOR
+!! ------
+!! P. BECHTOLD * Laboratoire d'Aerologie *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 07/11/95
+!! Last modified 04/10/97
+!! C.Lac 27/09/10 modification loop index for reproducibility
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_CONVPAR
+USE MODD_CONVPAREXT
+!
+USE MODI_CONVECT_SATMIXRATIO
+!
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+!
+INTEGER, INTENT(IN) :: KLON ! horizontal dimension
+INTEGER, INTENT(IN) :: KLEV ! vertical dimension
+INTEGER, INTENT(IN) :: KICE ! flag for ice ( 1 = yes,
+ ! 0 = no ice )
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTH ! grid scale theta
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTHES ! grid scale saturated theta_e
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRW ! grid scale total water
+ ! mixing ratio
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRC ! grid scale r_c (cloud water)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRI ! grid scale r_i (cloud ice)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PPRES ! pressure (Pa)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PDPRES! pressure difference between
+ ! bottom and top of layer (Pa)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PZ ! level height (m)
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KLCL ! contains vert. index of LCL
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KCTL ! contains vert. index of CTL
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KETL ! contains vert. index of
+ ! equilibrium (zero buoyancy) level
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KML ! " vert. index of melting level
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PUTHL ! updraft enthalpy (J/kg)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PURW ! updraft total water (kg/kg)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PURC ! updraft r_c (kg/kg)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PURI ! updraft r_i (kg/kg)
+REAL, DIMENSION(KLON), INTENT(IN) :: PPREF ! precipitation efficiency
+!
+!
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PDMF ! downdraft mass flux (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PDER ! downdraft entrainment (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PDDR ! downdraft detrainment (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PDTHL ! downdraft enthalpy (J/kg)
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PDRW ! downdraft total water (kg/kg)
+REAL, DIMENSION(KLON), INTENT(OUT):: PMIXF ! mixed fraction at LFS
+REAL, DIMENSION(KLON), INTENT(OUT):: PDTEVR ! total downdraft evaporation
+ ! rate at LFS (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PDTEVRF! downdraft evaporation rate
+INTEGER, DIMENSION(KLON), INTENT(OUT):: KLFS ! contains vert. index of LFS
+INTEGER, DIMENSION(KLON), INTENT(OUT):: KDBL ! contains vert. index of DBL
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IIE, IKB, IKE ! horizontal + vertical loop bounds
+INTEGER :: JK, JKP, JKM, JKT ! vertical loop index
+INTEGER :: JI, JL ! horizontal loop index
+INTEGER :: JITER ! iteration loop index
+REAL :: ZRDOCP ! R_d / C_pd
+REAL :: ZEPS ! R_d / R_v
+!
+INTEGER, DIMENSION(KLON) :: IDDT ! top level of detrainm. layer
+REAL, DIMENSION(KLON) :: ZTHE ! environm. theta_e (K)
+REAL, DIMENSION(KLON) :: ZDT, ZDTP ! downdraft temperature (K)
+REAL, DIMENSION(KLON) :: ZCPH ! specific heat C_ph
+REAL, DIMENSION(KLON) :: ZLV, ZLS ! latent heat of vaporis., sublim.
+REAL, DIMENSION(KLON) :: ZDDT ! thickness (hPa) of detrainm. layer
+REAL, DIMENSION(KLON) :: ZPI ! Pi=(P0/P)**(Rd/Cpd)
+REAL, DIMENSION(KLON) :: ZWORK1, ZWORK2, ZWORK3, ZWORK4 ! work arrays
+LOGICAL, DIMENSION(KLON) :: GWORK1 ! work array
+!
+!
+!-------------------------------------------------------------------------------
+!
+! 0.3 Set loop bounds
+! ---------------
+!
+IIE = KLON
+IKB = 1 + JCVEXB
+IKE = KLEV - JCVEXT
+!
+!
+!* 1. Initialize downdraft properties
+! -------------------------------
+!
+ZRDOCP = XRD / XCPD
+ZEPS = XRD / XRV
+PDMF(:,:) = 0.
+PDER(:,:) = 0.
+PDDR(:,:) = 0.
+PDRW(:,:) = 0.
+PDTHL(:,:) = 0.
+PDTEVR(:) = 0.
+PMIXF(:) = 0.
+ZTHE(:) = 0.
+ZDDT(:) = PDPRES(:,IKB+2)
+KDBL(:) = IKB + 1
+KLFS(:) = IKB + 1
+IDDT(:) = KDBL(:) + 1
+!
+!
+!* 2. Determine the LFS by looking for minimum of environmental
+! saturated theta_e
+! ----------------------------------------------------------
+!
+ZWORK1(:) = 900. ! starting value for search of minimum envir. theta_e
+DO JK = MINVAL( KLCL(:) ) + 2, MAXVAL( KETL(:) )
+ DO JI = 1, IIE
+ GWORK1(JI) = JK >= KLCL(JI) + 2 .AND. JK < KETL(JI)
+ IF ( GWORK1(JI) .AND. ZWORK1(JI) > PTHES(JI,JK) ) THEN
+ KLFS(JI) = JK
+ ZWORK1(JI) = MIN( ZWORK1(JI), PTHES(JI,JK) )
+ END IF
+ END DO
+END DO
+!
+!
+!* 3. Determine the mixed fraction using environmental and updraft
+! values of theta_e at LFS
+! ---------------------------------------------------------
+!
+DO JI = 1, IIE
+ JK = KLFS(JI)
+ ZPI(JI) = ( XP00 / PPRES(JI,JK) ) ** ZRDOCP
+ ! compute updraft theta_e
+ ZWORK3(JI) = PURW(JI,JK) - PURC(JI,JK) - PURI(JI,JK)
+ ZDT(JI) = PTH(JI,JK) / ZPI(JI)
+ ZLV(JI) = XLVTT + ( XCPV - XCL ) * ( ZDT(JI) - XTT )
+ ZLS(JI) = XLSTT + ( XCPV - XCI ) * ( ZDT(JI) - XTT )
+ ZCPH(JI) = XCPD + XCPV * PURW(JI,JK)
+ ZDT(JI) = ( PUTHL(JI,JK) - ( 1. + PURW(JI,JK) ) * XG * PZ(JI,JK) &
+ + ZLV(JI) * PURC(JI,JK) + ZLS(JI) * PURI(JI,JK) ) / ZCPH(JI)
+ ZWORK1(JI) = ZDT(JI) * ZPI(JI) ** ( 1. - 0.28 * ZWORK3(JI) ) &
+ * EXP( ( 3374.6525 / ZDT(JI) - 2.5403 ) &
+ * ZWORK3(JI) * ( 1. + 0.81 * ZWORK3(JI) ) )
+ ! compute environmental theta_e
+ ZDT(JI) = PTH(JI,JK) / ZPI(JI)
+ ZLV(JI) = XLVTT + ( XCPV - XCL ) * ( ZDT(JI) - XTT )
+ ZLS(JI) = XLSTT + ( XCPV - XCI ) * ( ZDT(JI) - XTT )
+ ZWORK3(JI) = PRW(JI,JK) - PRC(JI,JK) - PRI(JI,JK)
+ ZCPH(JI) = XCPD + XCPV * PRW(JI,JK)
+ ZWORK2(JI) = ZDT(JI) * ZPI(JI) ** ( 1. - 0.28 * ZWORK3(JI) ) &
+ * EXP( ( 3374.6525 / ZDT(JI) - 2.5403 ) &
+ * ZWORK3(JI) * ( 1. + 0.81 * ZWORK3(JI) ) )
+ ! compute mixed fraction
+ PMIXF(JI) = MAX( 0., ( ZWORK1(JI) - PTHES(JI,JK) ) ) &
+ / ( ZWORK1(JI) - ZWORK2(JI) + 1.E-10 )
+ PMIXF(JI) = MAX(0., MIN( 1., PMIXF(JI) ) )
+ ZWORK4(JI) = PPRES(JI,JK)
+END DO
+!
+!
+!* 4. Estimate the effect of melting on the downdraft
+! ---------------------------------------------
+!
+ZWORK1(:) = 0.
+ ! use total solid precipitation
+!DO JK = IKB + 1, IKE
+! ZWORK1(:) = ZWORK1(:) + PURS(:,JK) ! total snow/hail content
+!END DO
+!
+DO JI = 1, IIE
+ JK = KLCL(JI)
+ JKP = KCTL(JI)
+ ZWORK1(JI) = 0.5 * ( PURW(JI,JK) - PURW(JI,JKP) )
+END DO
+!
+ ! temperature perturbation due to melting at LFS
+ZWORK3(:) = 0.
+WHERE( KML(:) > IKB + 2 )
+ ZWORK3(:) = ZWORK1(:) * ( ZLS(:) - ZLV(:) ) / ZCPH(:)
+ ZDT(:) = ZDT(:) - ZWORK3(:) * REAL(KICE)
+END WHERE
+!
+!
+!* 5. Initialize humidity at LFS as a saturated mixture of
+! updraft and environmental air
+! -----------------------------------------------------
+!
+DO JI = 1, IIE
+ JK = KLFS(JI)
+ PDRW(JI,JK) = PMIXF(JI) * PRW(JI,JK) + ( 1. - PMIXF(JI) ) * PURW(JI,JK)
+ ZWORK2(JI) = PDRW(JI,JK) - ( 1. - PMIXF(JI) ) &
+ * ( PURC(JI,JK) + PURI(JI,JK) )
+END DO
+!
+!
+!* 6.1 Determine the DBL by looking for level where the envir.
+! theta_es at the LFS corrected by melting effects becomes
+! larger than envir. value
+! ---------------------------------------------------------
+!
+ ! compute satur. mixing ratio for melting corrected temperature
+CALL CONVECT_SATMIXRATIO( KLON, ZWORK4, ZDT, ZWORK3, ZLV, ZLS, ZCPH )
+!
+ ! compute envir. saturated theta_e for melting corrected temperature
+ ZWORK1(:) = MIN( ZWORK2(:), ZWORK3(:) )
+ ZWORK3(:) = ZWORK3(:) * ZWORK4(:) / ( ZWORK3(:) + ZEPS ) ! sat. pressure
+ ZWORK3(:) = ALOG( ZWORK3(:) / 613.3 )
+ ! dewp point temperature
+ ZWORK3(:) = ( 4780.8 - 32.19 * ZWORK3(:) ) / ( 17.502 - ZWORK3(:) )
+ ! adiabatic saturation temperature
+ ZWORK3(:) = ZWORK3(:) - ( .212 + 1.571E-3 * ( ZWORK3(:) - XTT ) &
+ - 4.36E-4 * ( ZDT(:) - XTT ) ) * ( ZDT(:) - ZWORK3(:) )
+ ZWORK4(:) = SIGN(0.5, ZWORK2(:) - ZWORK3(:) )
+ ZDT(:) = ZDT(:) * ( .5 + ZWORK4(:) ) + ( .5 - ZWORK4(:) ) * ZWORK3(:)
+ ZWORK2(:) = ZDT(:) * ZPI(:) ** ( 1. - 0.28 * ZWORK2(:) ) &
+ * EXP( ( 3374.6525 / ZDT(:) - 2.5403 ) &
+ * ZWORK1(:) * ( 1. + 0.81 * ZWORK1(:) ) )
+!
+GWORK1(:) = .TRUE.
+JKM = MAXVAL( KLFS(:) )
+DO JK = JKM - 1, IKB + 1, -1
+ DO JI = 1, IIE
+ IF ( JK < KLFS(JI) .AND. ZWORK2(JI) > PTHES(JI,JK) .AND. GWORK1(JI) ) THEN
+ KDBL(JI) = JK
+ GWORK1(JI) = .FALSE.
+ END IF
+ END DO
+END DO
+!
+!
+!* 7. Define mass flux and entr/detr. rates at LFS
+! -------------------------------------------
+!
+DO JI = 1, IIE
+ JK = KLFS(JI)
+ ZWORK1(JI) = PPRES(JI,JK) / &
+ ( XRD * ZDT(JI) * ( 1. + ZEPS * ZWORK1(JI) ) ) ! density
+ PDMF(JI,JK) = - ( 1. - PPREF(JI) ) * ZWORK1(JI) * XPI * XCRAD * XCRAD
+ PDTHL(JI,JK)= ZWORK2(JI) ! theta_l is here actually theta_e
+ ZWORK2(JI) = PDMF(JI,JK)
+ PDDR(JI,JK) = 0.
+ PDER(JI,JK) = - PMIXF(JI) * PDMF(JI,JK)
+END DO
+!
+!
+! 7.1 Downdraft detrainment is assumed to occur in a layer
+! of 60 hPa, determine top level IDDT of this layer
+! ---------------------------------------------------------
+!
+ZWORK1(:) = 0.
+DO JK = IKB + 2, JKM
+ ZWORK1(:) = ZWORK1(:) + PDPRES(:,JK)
+ !WHERE ( JK > KDBL(:) .AND. ZWORK1(:) <= XZPBL )
+ WHERE ( JK > KDBL(:) .AND. JK <= KLCL(:) )
+ ZDDT(:) = ZWORK1(:)
+ IDDT(:) = JK
+ END WHERE
+END DO
+!
+!
+!* 8. Enter loop for downdraft computations. Make a first guess
+! of initial downdraft mass flux.
+! In the downdraft computations we use theta_es instead of
+! enthalpy as it allows to better take into account evaporation
+! effects. As the downdraft detrainment rate is zero apart
+! from the detrainment layer, we just compute enthalpy
+! downdraft from theta_es in this layer.
+! ----------------------------------------------------------
+!
+!
+!
+DO JK = JKM - 1, IKB + 1, -1
+ JKP = JK + 1
+ DO JI = 1, IIE
+ IF ( JK < KLFS(JI) .AND. JK >= IDDT(JI) ) THEN
+ PDER(JI,JK) = - ZWORK2(JI) * XENTR * PDPRES(JI,JKP) / XCRAD
+ ! DER and DPRES are positive
+ PDMF(JI,JK) = PDMF(JI,JKP) - PDER(JI,JK)
+ ZPI(JI) = ( XP00 / PPRES(JI,JK) ) ** ZRDOCP
+ ZDT(JI) = PTH(JI,JK) / ZPI(JI)
+ ZWORK1(JI) = PRW(JI,JK) - PRC(JI,JK) - PRI(JI,JK)
+ ZTHE(JI) = ZDT(JI) * ZPI(JI) ** ( 1. - 0.28 * ZWORK1(JI) ) &
+ * EXP( ( 3374.6525 / ZDT(JI) - 2.5403 ) &
+ * ZWORK1(JI) * ( 1. + 0.81 * ZWORK1(JI) ) )
+ ! PDTHL is here theta_es, later on in this routine this table is
+ ! reskipped to enthalpy
+ PDTHL(JI,JK) = ( PDTHL(JI,JKP) * PDMF(JI,JKP) - ZTHE(JI) * PDER(JI,JK) &
+ ) / ( PDMF(JI,JK) - 1.E-7 )
+ PDRW(JI,JK) = ( PDRW(JI,JKP) * PDMF(JI,JKP) - PRW(JI,JK) * PDER(JI,JK) &
+ ) / ( PDMF(JI,JK) - 1.E-7 )
+ END IF
+ IF ( JK < IDDT(JI) .AND. JK >= KDBL(JI) ) THEN
+ JL = IDDT(JI)
+ PDDR(JI,JK) = - PDMF(JI,JL) * PDPRES(JI,JKP) / ZDDT(JI)
+ PDMF(JI,JK) = PDMF(JI,JKP) + PDDR(JI,JK)
+ PDTHL(JI,JK) = PDTHL(JI,JKP)
+ PDRW(JI,JK) = PDRW(JI,JKP)
+ END IF
+ END DO
+END DO
+!
+!
+!* 9. Calculate total downdraft evaporation
+! rate for given mass flux (between DBL and IDDT)
+! -----------------------------------------------
+!
+PDTEVRF(:,:) = 0.
+! Reproducibility
+!JKT = MAXVAL( IDDT(:) )
+!DO JK = IKB + 1, JKT
+DO JK = IKB + 1, IKE
+!
+ ZPI(:) = ( XP00 / PPRES(:,JK) ) ** ZRDOCP
+ ZDT(:) = PTH(:,JK) / ZPI(:)
+!
+!* 9.1 Determine wet bulb temperature at DBL from theta_e.
+! The iteration algoritm is similar to that used in
+! routine CONVECT_CONDENS
+! --------------------------------------------------
+!
+ DO JITER = 1, 4
+ CALL CONVECT_SATMIXRATIO( KLON, PPRES(:,JK), ZDT, ZWORK1, ZLV, ZLS, ZCPH )
+ ZDTP(:) = PDTHL(:,JK) / ( ZPI(:) ** ( 1. - 0.28 * ZWORK1(:) ) &
+ * EXP( ( 3374.6525 / ZDT(:) - 2.5403 ) &
+ * ZWORK1(:) * ( 1. + 0.81 * ZWORK1(:) ) ) )
+ ZDT(:) = 0.4 * ZDTP(:) + 0.6 * ZDT(:) ! force convergence
+ END DO
+!
+!
+!* 9.2 Sum total downdraft evaporation rate. No evaporation
+! if actual humidity is larger than specified one.
+! -----------------------------------------------------
+!
+ ZWORK2(:) = ZWORK1(:) / ZDT(:) * ( XBETAW / ZDT(:) - XGAMW ) ! dr_sat/dT
+ ZWORK2(:) = ZLV(:) / ZCPH(:) * ZWORK1(:) * ( 1. - XRHDBC ) / &
+ ( 1. + ZLV(:) / ZCPH(:) * ZWORK2(:) ) ! temperature perturb ! due to evaporation
+ ZDT(:) = ZDT(:) + ZWORK2(:)
+!
+ CALL CONVECT_SATMIXRATIO( KLON, PPRES(:,JK), ZDT, ZWORK3, ZLV, ZLS, ZCPH )
+!
+ ZWORK3(:) = ZWORK3(:) * XRHDBC
+ ZWORK1(:) = MAX( 0., ZWORK3(:) - PDRW(:,JK) )
+ PDTEVR(:) = PDTEVR(:) + ZWORK1(:) * PDDR(:,JK)
+ PDTEVRF(:,JK)= PDTEVRF(:,JK) + ZWORK1(:) * PDDR(:,JK)
+ ! compute enthalpie and humidity in the detrainment layer
+ PDRW(:,JK) = MAX( PDRW(:,JK), ZWORK3(:) )
+ PDTHL(:,JK) = ( ( XCPD + PDRW(:,JK) * XCPV ) * ZDT(:) &
+ + ( 1. + PDRW(:,JK) ) * XG * PZ(:,JK) )
+!
+END DO
+!
+!
+!* 12. If downdraft does not evaporate any water for specified
+! relative humidity, no downdraft is allowed
+! ---------------------------------------------------------
+!
+ZWORK2(:) = 1.
+WHERE ( PDTEVR(:) < 1. .OR. KLFS(:) == IKB + 1 ) ZWORK2(:) = 0.
+DO JK = IKB, JKM
+ KDBL(:) = KDBL(:) * INT( ZWORK2(:) ) + ( 1 - INT( ZWORK2(:) ) ) * IKB
+ KLFS(:) = KLFS(:) * INT( ZWORK2(:) ) + ( 1 - INT( ZWORK2(:) ) ) * IKB
+ PDMF(:,JK) = PDMF(:,JK) * ZWORK2(:)
+ PDER(:,JK) = PDER(:,JK) * ZWORK2(:)
+ PDDR(:,JK) = PDDR(:,JK) * ZWORK2(:)
+ ZWORK1(:) = REAL( KLFS(:) - JK ) ! use this to reset thl_d
+ ZWORK1(:) = MAX( 0.,MIN(1.,ZWORK1(:) ) ) ! and rv_d to zero above LFS
+ PDTHL(:,JK) = PDTHL(:,JK) * ZWORK2(:) * ZWORK1(:)
+ PDRW(:,JK) = PDRW(:,JK) * ZWORK2(:) * ZWORK1(:)
+ PDTEVR(:) = PDTEVR(:) * ZWORK2(:)
+ PDTEVRF(:,JK)= PDTEVRF(:,JK) * ZWORK2(:)
+END DO
+!
+END SUBROUTINE CONVECT_DOWNDRAFT
diff --git a/src/mesonh/conv/convect_mixing_funct.f90 b/src/mesonh/conv/convect_mixing_funct.f90
new file mode 100644
index 000000000..ebf25507e
--- /dev/null
+++ b/src/mesonh/conv/convect_mixing_funct.f90
@@ -0,0 +1,151 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 conv 2006/05/18 13:07:25
+!-----------------------------------------------------------------
+! #################
+ MODULE MODI_CONVECT_MIXING_FUNCT
+! #################
+!
+INTERFACE
+!
+ SUBROUTINE CONVECT_MIXING_FUNCT( KLON, &
+ PMIXC, KMF, PER, PDR )
+!
+INTEGER, INTENT(IN) :: KLON ! horizontal dimension
+INTEGER, INTENT(IN) :: KMF ! switch for dist. function
+REAL, DIMENSION(KLON), INTENT(IN) :: PMIXC ! critical mixed fraction
+!
+REAL, DIMENSION(KLON), INTENT(OUT):: PER ! normalized entrainment rate
+REAL, DIMENSION(KLON), INTENT(OUT):: PDR ! normalized detrainment rate
+!
+END SUBROUTINE CONVECT_MIXING_FUNCT
+!
+END INTERFACE
+!
+END MODULE MODI_CONVECT_MIXING_FUNCT
+! ######spl
+ SUBROUTINE CONVECT_MIXING_FUNCT( KLON, &
+ PMIXC, KMF, PER, PDR )
+! #######################################################
+!
+!!**** Determine the area under the distribution function
+!! KMF = 1 : gaussian KMF = 2 : triangular distribution function
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to determine the entrainment and
+!! detrainment rate by evaluating the are under the distribution
+!! function. The integration interval is limited by the critical
+!! mixed fraction PMIXC
+!!
+!!
+!!
+!!** METHOD
+!! ------
+!! Use handbook of mathemat. functions by Abramowitz and Stegun, 1968
+!!
+!!
+!!
+!! EXTERNAL
+!! --------
+!! None
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Book2 of documentation ( routine MIXING_FUNCT)
+!! Abramovitz and Stegun (1968), handbook of math. functions
+!!
+!! AUTHOR
+!! ------
+!! P. BECHTOLD * Laboratoire d'Aerologie *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 07/11/95
+!! Last modified 04/10/97
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KLON ! horizontal dimension
+INTEGER, INTENT(IN) :: KMF ! switch for dist. function
+REAL, DIMENSION(KLON), INTENT(IN) :: PMIXC ! critical mixed fraction
+!
+REAL, DIMENSION(KLON), INTENT(OUT):: PER ! normalized entrainment rate
+REAL, DIMENSION(KLON), INTENT(OUT):: PDR ! normalized detrainment rate
+!
+!* 0.2 Declarations of local variables :
+!
+REAL :: ZSIGMA = 0.166666667 ! standard deviation
+REAL :: ZFE = 4.931813949 ! integral normalization
+REAL :: ZSQRTP = 2.506628, ZP = 0.33267 ! constants
+REAL :: ZA1 = 0.4361836, ZA2 =-0.1201676 ! constants
+REAL :: ZA3 = 0.9372980, ZT1 = 0.500498 ! constants
+REAL :: ZE45 = 0.01111 ! constant
+!
+REAL, DIMENSION(KLON) :: ZX, ZY, ZW1, ZW2 ! work variables
+REAL :: ZW11
+!
+!
+!-------------------------------------------------------------------------------
+!
+! 1. Use gaussian function for KMF=1
+! -------------------------------
+!
+IF( KMF == 1 ) THEN
+ ! ZX(:) = ( PMIXC(:) - 0.5 ) / ZSIGMA
+ ZX(:) = 6. * PMIXC(:) - 3.
+ ZW1(:) = 1. / ( 1.+ ZP * ABS ( ZX(:) ) )
+ ZY(:) = EXP( -0.5 * ZX(:) * ZX(:) )
+ ZW2(:) = ZA1 * ZW1(:) + ZA2 * ZW1(:) * ZW1(:) + &
+ ZA3 * ZW1(:) * ZW1(:) * ZW1(:)
+ ZW11 = ZA1 * ZT1 + ZA2 * ZT1 * ZT1 + ZA3 * ZT1 * ZT1 * ZT1
+ENDIF
+!
+WHERE ( KMF == 1 .AND. ZX(:) >= 0. )
+ PER(:) = ZSIGMA * ( 0.5 * ( ZSQRTP - ZE45 * ZW11 &
+ - ZY(:) * ZW2(:) ) + ZSIGMA * ( ZE45 - ZY(:) ) ) &
+ - 0.5 * ZE45 * PMIXC(:) * PMIXC(:)
+ PDR(:) = ZSIGMA*( 0.5 * ( ZY(:) * ZW2(:) - ZE45 * ZW11 ) &
+ + ZSIGMA * ( ZE45 - ZY(:) ) ) &
+ - ZE45 * ( 0.5 + 0.5 * PMIXC(:) * PMIXC(:) - PMIXC(:) )
+END WHERE
+WHERE ( KMF == 1 .AND. ZX(:) < 0. )
+ PER(:) = ZSIGMA*( 0.5 * ( ZY(:) * ZW2(:) - ZE45 * ZW11 ) &
+ + ZSIGMA * ( ZE45 - ZY(:) ) ) &
+ - 0.5 * ZE45 * PMIXC(:) * PMIXC(:)
+ PDR(:) = ZSIGMA * ( 0.5 * ( ZSQRTP - ZE45 * ZW11 - ZY(:) &
+ * ZW2(:) ) + ZSIGMA * ( ZE45 - ZY(:) ) ) &
+ - ZE45 * ( 0.5 + 0.5 * PMIXC(:) * PMIXC(:) - PMIXC(:) )
+END WHERE
+!
+ PER(:) = PER(:) * ZFE
+ PDR(:) = PDR(:) * ZFE
+!
+!
+! 2. Use triangular function KMF=2
+! -------------------------------
+!
+! not yet released
+!
+!
+END SUBROUTINE CONVECT_MIXING_FUNCT
diff --git a/src/mesonh/conv/convect_precip_adjust.f90 b/src/mesonh/conv/convect_precip_adjust.f90
new file mode 100644
index 000000000..1c32f4d4d
--- /dev/null
+++ b/src/mesonh/conv/convect_precip_adjust.f90
@@ -0,0 +1,337 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 conv 2006/05/18 13:07:25
+!-----------------------------------------------------------------
+! #################
+ MODULE MODI_CONVECT_PRECIP_ADJUST
+! #################
+!
+INTERFACE
+!
+ SUBROUTINE CONVECT_PRECIP_ADJUST( KLON, KLEV, &
+ PPRES, PUMF, PUER, PUDR, &
+ PUPR, PUTPR, PURW, &
+ PDMF, PDER, PDDR, PDTHL, PDRW, &
+ PPREF, PTPR, PMIXF, PDTEVR, &
+ KLFS, KDBL, KLCL, KCTL, KETL, &
+ PDTEVRF )
+
+!
+INTEGER, INTENT(IN) :: KLON ! horizontal dimension
+INTEGER, INTENT(IN) :: KLEV ! vertical dimension
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PPRES ! pressure (Pa)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PURW ! updraft total water (kg/kg)
+REAL, DIMENSION(KLON), INTENT(IN) :: PUTPR ! updraft total precipit. (kg/s
+REAL, DIMENSION(KLON), INTENT(IN) :: PPREF ! precipitation efficiency
+REAL, DIMENSION(KLON), INTENT(IN) :: PMIXF ! critical mixed fraction at LCL
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KLCL ! contains vert. index of LCL
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KCTL ! contains vert. index of CTL
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KETL ! contains vert. index of equilibrium
+ ! (zero buoyancy) level
+INTEGER, DIMENSION(KLON), INTENT(INOUT) :: KLFS ! contains vert. index of LFS
+INTEGER, DIMENSION(KLON), INTENT(INOUT) :: KDBL ! contains vert. index of DBL
+!
+REAL, DIMENSION(KLON), INTENT(INOUT) :: PDTEVR ! total downdraft evaporation
+ ! rate at LFS
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PDTEVRF! downdraft evaporation rate
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PUMF ! updraft mass flux (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PUER ! updraft entrainment (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PUDR ! updraft detrainment (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PUPR ! updraft precipit. (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PDMF ! downdraft mass flux (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PDER ! downdraft entrainment (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PDDR ! downdraft detrainment (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PDTHL ! downdraft enthalpy (J/kg)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PDRW ! downdraft total water (kg/kg)
+!
+REAL, DIMENSION(KLON), INTENT(OUT) :: PTPR ! total precipitation (kg/s)
+ ! = downdraft precipitation
+!
+END SUBROUTINE CONVECT_PRECIP_ADJUST
+!
+END INTERFACE
+!
+END MODULE MODI_CONVECT_PRECIP_ADJUST
+! ######################################################################
+ SUBROUTINE CONVECT_PRECIP_ADJUST( KLON, KLEV, &
+ PPRES, PUMF, PUER, PUDR, &
+ PUPR, PUTPR, PURW, &
+ PDMF, PDER, PDDR, PDTHL, PDRW, &
+ PPREF, PTPR, PMIXF, PDTEVR, &
+ KLFS, KDBL, KLCL, KCTL, KETL, &
+ PDTEVRF )
+! ######################################################################
+!
+!!**** Adjust up- and downdraft mass fluxes to be consistent with the
+!! mass transport at the LFS given by the precipitation efficiency
+!! relation.
+!!
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to adjust up- and downdraft mass
+!! fluxes below the LFS to be consistent with the precipitation
+!! efficiency relation
+!!
+!!
+!!
+!!** METHOD
+!! ------
+!!
+!!
+!! EXTERNAL
+!! --------
+!! None
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! Module MODD_CONVPAREXT
+!! JCVEXB, JCVEXT ! extra levels on the vertical boundaries
+!!
+!! Module MODD_CONVPAR
+!! XUSRDPTH ! pressure depth to compute updraft humidity
+!! ! supply rate for downdraft
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Book1,2 of documentation ( routine CONVECT_PRECIP_ADJUST)
+!!
+!! AUTHOR
+!! ------
+!! P. BECHTOLD * Laboratoire d'Aerologie *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 07/11/95
+!! Last modified 04/10/97
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CONVPAREXT
+USE MODD_CONVPAR
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+!
+INTEGER, INTENT(IN) :: KLON ! horizontal dimension
+INTEGER, INTENT(IN) :: KLEV ! vertical dimension
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PPRES ! pressure (Pa)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PURW ! updraft total water (kg/kg)
+REAL, DIMENSION(KLON), INTENT(IN) :: PUTPR ! updraft total precipit. (kg/s
+REAL, DIMENSION(KLON), INTENT(IN) :: PPREF ! precipitation efficiency
+REAL, DIMENSION(KLON), INTENT(IN) :: PMIXF ! critical mixed fraction at LCL
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KLCL ! contains vert. index of LCL
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KCTL ! contains vert. index of CTL
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KETL ! contains vert. index of equilibrium
+ ! (zero buoyancy) level
+INTEGER, DIMENSION(KLON), INTENT(INOUT) :: KLFS ! contains vert. index of LFS
+INTEGER, DIMENSION(KLON), INTENT(INOUT) :: KDBL ! contains vert. index of DBL
+!
+REAL, DIMENSION(KLON), INTENT(INOUT) :: PDTEVR ! total downdraft evaporation
+ ! rate at LFS
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PDTEVRF! downdraft evaporation rate
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PUMF ! updraft mass flux (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PUER ! updraft entrainment (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PUDR ! updraft detrainment (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PUPR ! updraft precipit. (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PDMF ! downdraft mass flux (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PDER ! downdraft entrainment (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PDDR ! downdraft detrainment (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PDTHL ! downdraft enthalpy (J/kg)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PDRW ! downdraft total water (kg/kg)
+!
+REAL, DIMENSION(KLON), INTENT(OUT) :: PTPR ! total precipitation (kg/s)
+ ! = downdraft precipitation
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IIE, IKB, IKE ! horizontal + vertical loop bounds
+INTEGER :: JK, JKT1, JKT2, JKT3 ! vertical loop index
+INTEGER :: JI ! horizontal loop index
+!
+INTEGER, DIMENSION(KLON) :: IPRL
+REAL, DIMENSION(KLON) :: ZWORK1, ZWORK2, ZWORK3, &
+ ZWORK4, ZWORK5, ZWORK6 ! work arrays
+!
+!
+!-------------------------------------------------------------------------------
+!
+! 0.3 Set loop bounds
+! ---------------
+!
+IKB = 1 + JCVEXB
+IKE = KLEV - JCVEXT
+IIE = KLON
+JKT1 = MAXVAL( KLFS(:) )
+JKT2 = MAXVAL( KCTL(:) )
+JKT3 = MINVAL( KLCL(:) )
+!
+!
+! 1. Set some output variables for columns where no downdraft
+! exists. Exit if there is no downdraft at all.
+! --------------------------------------------------------
+!
+IPRL(:) = IKB
+PTPR(:) = 0.
+!
+WHERE ( PDTEVR(:) == 0. )
+ PTPR(:) = PUTPR(:) ! no downdraft evaporation => no downdraft, all
+ ! precipitation occurs in updraft
+END WHERE
+IF ( COUNT( PDTEVR(:) > 0. ) == 0 ) THEN ! exit routine if no downdraft exists
+ RETURN
+ENDIF
+!
+!* 2. The total mass transported from the updraft to the down-
+! draft at the LFS must be consistent with the three water
+! budget terms :
+! ---------------------------------------------------------
+!
+!* 2.1 Downdraft evaporation rate at the DBL. The evaporation
+! rate in downdraft must be consistent with precipitation
+! efficiency relation.
+! --------------------------------------------------------
+!
+!
+DO JI = 1, IIE
+ JK = KLFS(JI)
+ ZWORK1(JI) = PDTEVR(JI) / MIN( -1.E-1, PDMF(JI,JK) )
+ ZWORK6(JI) = PDMF(JI,JK)
+END DO
+!
+!* 2.2 Some preliminar computations for downdraft = total
+! precipitation rate. The precipitation is evaluated in
+! a layer thickness DP=XUSRDPTH=165 hPa above the LCL.
+! The difference between updraft precipitation and downdraft
+! precipitation (updraft supply rate) is used to drive the
+! downdraft through evaporational cooling.
+! --------------------------------------------------------
+!
+DO JI = 1, IIE
+ JK = KLCL(JI)
+ ZWORK5(JI) = PPRES(JI,JK)
+END DO
+!
+PTPR(:) = 0.
+DO JK = JKT3, JKT2
+ WHERE ( JK >= KLCL(:) .AND. PPRES(:,JK) >= ZWORK5(:) - XUSRDPTH )
+ PTPR(:) = PTPR(:) + PUPR(:,JK)
+ IPRL(:) = JK
+ END WHERE
+END DO
+IPRL(:) = MIN( KETL(:), IPRL(:) )
+!
+DO JI = 1, IIE
+ JK = IPRL(JI)
+ PTPR(JI) = PUMF(JI,JK+1) * PURW(JI,JK+1) + PTPR(JI)
+END DO
+!
+PTPR(:) = PPREF(:) * MIN( PUTPR(:), PTPR(:) )
+ZWORK4(:) = PUTPR(:) - PTPR(:)
+!
+!
+!* 2.3 Total amount of precipitation that falls out of the up-
+! draft between the LCL and the LFS.
+! Condensate transfer from up to downdraft at LFS
+! ---------------------------------------------------------
+!
+ZWORK5(:) = 0.
+DO JK = JKT3, JKT1
+ WHERE ( JK >= KLCL(:) .AND. JK <= KLFS(:) )
+ ZWORK5(:) = ZWORK5(:) + PUPR(:,JK)
+ END WHERE
+END DO
+!
+DO JI = 1, IIE
+ JK = KLFS(JI)
+ ZWORK2(JI) = ( 1. - PPREF(JI) ) * ZWORK5(JI) * &
+ ( 1. - PMIXF(JI) ) / MAX( 1.E-1, PUMF(JI,JK) )
+END DO
+!
+!
+!* 2.4 Increase the first guess downdraft mass flux to satisfy
+! precipitation efficiency relation.
+! If downdraft does not evaporate any water at the DBL for
+! the specified relative humidity, or if the corrected mass
+! flux at the LFS is positive no downdraft is allowed
+! ---------------------------------------------------------
+!
+!
+!ZWORK1(:) = ZWORK4(:) / ( ZWORK1(:) + ZWORK2(:) + 1.E-8 )
+ZWORK1(:) = -ZWORK4(:) / ( -ZWORK1(:) + ZWORK2(:) + 1.E-8 )
+ZWORK2(:) = ZWORK1(:) / MIN( -1.E-1, ZWORK6(:) ) ! ratio of budget consistent to actual DMF
+!
+ZWORK3(:) = 1.
+ZWORK6(:) = 1.
+WHERE ( ZWORK1(:) > 0. .OR. PDTEVR(:) < 1. )
+ KDBL(:) = IKB
+ KLFS(:) = IKB
+ PDTEVR(:) = 0.
+ ZWORK2(:) = 0.
+ ZWORK3(:) = 0.
+ ZWORK6(:) = 0.
+END WHERE
+!
+DO JK = IKB, JKT1
+ PDMF(:,JK) = PDMF(:,JK) * ZWORK2(:)
+ PDER(:,JK) = PDER(:,JK) * ZWORK2(:)
+ PDDR(:,JK) = PDDR(:,JK) * ZWORK2(:)
+ PDTEVRF(:,JK) = PDTEVRF(:,JK)* ZWORK2(:)
+ PDRW(:,JK) = PDRW(:,JK) * ZWORK3(:)
+ PDTHL(:,JK) = PDTHL(:,JK) * ZWORK3(:)
+END DO
+ZWORK4(:) = ZWORK2(:)
+!
+!
+!* 3. Increase updraft mass flux, mass detrainment rate, and water
+! substance detrainment rates to be consistent with the transfer
+! of the estimated mass from the up- to the downdraft at the LFS
+! --------------------------------------------------------------
+!
+DO JI = 1, IIE
+ JK = KLFS(JI)
+ ZWORK2(JI) = ( 1. - ZWORK6(JI) ) + ZWORK6(JI) * &
+ ( PUMF(JI,JK) - ( 1. - PMIXF(JI) ) * ZWORK1(JI) ) / &
+ MAX( 1.E-1, PUMF(JI,JK) )
+END DO
+!
+!
+JKT1 = MAXVAL( KLFS(:) ) ! value of KLFS might have been reset to IKB above
+DO JK = IKB, JKT1
+ DO JI = 1, IIE
+ IF ( JK <= KLFS(JI) ) THEN
+ PUMF(JI,JK) = PUMF(JI,JK) * ZWORK2(JI)
+ PUER(JI,JK) = PUER(JI,JK) * ZWORK2(JI)
+ PUDR(JI,JK) = PUDR(JI,JK) * ZWORK2(JI)
+ PUPR(JI,JK) = PUPR(JI,JK) * ZWORK2(JI)
+ END IF
+ END DO
+END DO
+!
+!
+!* 4. Increase total = downdraft precipitation and evaporation rate
+! -------------------------------------------------------------
+!
+WHERE ( PDTEVR(:) > 0. )
+ PTPR(:) = PTPR(:) + PPREF(:) * ZWORK5(:) * ( ZWORK2(:) - 1. )
+ PDTEVR(:) = PUTPR(:) - PTPR(:)
+ PDTEVRF(:,IKB+1) = PDTEVR(:)
+ELSEWHERE
+ PTPR(:) = PUTPR(:)
+END WHERE
+!
+!
+END SUBROUTINE CONVECT_PRECIP_ADJUST
diff --git a/src/mesonh/conv/convect_satmixratio.f90 b/src/mesonh/conv/convect_satmixratio.f90
new file mode 100644
index 000000000..c6f4e5475
--- /dev/null
+++ b/src/mesonh/conv/convect_satmixratio.f90
@@ -0,0 +1,122 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 conv 2006/05/18 13:07:25
+!-----------------------------------------------------------------
+! #################
+ MODULE MODI_CONVECT_SATMIXRATIO
+! #################
+!
+INTERFACE
+!
+ SUBROUTINE CONVECT_SATMIXRATIO( KLON, &
+ PPRES, PT, PEW, PLV, PLS, PCPH )
+!
+INTEGER, INTENT(IN) :: KLON ! horizontal loop index
+REAL, DIMENSION(KLON), INTENT(IN) :: PPRES ! pressure
+REAL, DIMENSION(KLON), INTENT(IN) :: PT ! temperature
+!
+REAL, DIMENSION(KLON), INTENT(OUT):: PEW ! vapor saturation mixing ratio
+REAL, DIMENSION(KLON), INTENT(OUT):: PLV ! latent heat L_v
+REAL, DIMENSION(KLON), INTENT(OUT):: PLS ! latent heat L_s
+REAL, DIMENSION(KLON), INTENT(OUT):: PCPH ! specific heat C_ph
+!
+END SUBROUTINE CONVECT_SATMIXRATIO
+!
+END INTERFACE
+!
+END MODULE MODI_CONVECT_SATMIXRATIO
+! ######spl
+ SUBROUTINE CONVECT_SATMIXRATIO( KLON, &
+ PPRES, PT, PEW, PLV, PLS, PCPH )
+! ################################################################
+!
+!!**** Compute vapor saturation mixing ratio over liquid water
+!!
+!!
+!! PDRPOSE
+!! -------
+!! The purpose of this routine is to determine saturation mixing ratio
+!! and to return values for L_v L_s and C_ph
+!!
+!!
+!!** METHOD
+!! ------
+!!
+!!
+!! EXTERNAL
+!! --------
+!! None
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST
+!! XALPW, XBETAW, XGAMW ! constants for water saturation pressure
+!! XRD, XRV ! gaz constants for dry air and water vapor
+!! XCPD, XCPV ! specific heat for dry air and water vapor
+!! XCL, XCI ! specific heat for liquid water and ice
+!! XTT ! triple point temperature
+!! XLVTT, XLSTT ! vaporization, sublimation heat constant
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Book1,2 of documentation ( routine CONVECT_SATMIXRATIO)
+!!
+!! AUTHOR
+!! ------
+!! P. BECHTOLD * Laboratoire d'Aerologie *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 07/11/95
+!! Last modified 04/10/97
+!------------------------- ------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+!
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+!
+INTEGER, INTENT(IN) :: KLON ! horizontal loop index
+REAL, DIMENSION(KLON), INTENT(IN) :: PPRES ! pressure
+REAL, DIMENSION(KLON), INTENT(IN) :: PT ! temperature
+!
+REAL, DIMENSION(KLON), INTENT(OUT):: PEW ! vapor saturation mixing ratio
+REAL, DIMENSION(KLON), INTENT(OUT):: PLV ! latent heat L_v
+REAL, DIMENSION(KLON), INTENT(OUT):: PLS ! latent heat L_s
+REAL, DIMENSION(KLON), INTENT(OUT):: PCPH ! specific heat C_ph
+!
+!* 0.2 Declarations of local variables :
+!
+REAL, DIMENSION(KLON) :: ZT ! temperature
+REAL :: ZEPS ! R_d / R_v
+!
+!
+!-------------------------------------------------------------------------------
+!
+ ZEPS = XRD / XRV
+!
+ ZT(:) = MIN( 400., MAX( PT(:), 10. ) ) ! overflow bound
+ PEW(:) = EXP( XALPW - XBETAW / ZT(:) - XGAMW * ALOG( ZT(:) ) )
+ PEW(:) = ZEPS * PEW(:) / ( PPRES(:) - PEW(:) )
+!
+ PLV(:) = XLVTT + ( XCPV - XCL ) * ( ZT(:) - XTT ) ! compute L_v
+ PLS(:) = XLSTT + ( XCPV - XCI ) * ( ZT(:) - XTT ) ! compute L_i
+!
+ PCPH(:) = XCPD + XCPV * PEW(:) ! compute C_ph
+!
+END SUBROUTINE CONVECT_SATMIXRATIO
diff --git a/src/mesonh/conv/convect_trigger_funct.f90 b/src/mesonh/conv/convect_trigger_funct.f90
new file mode 100644
index 000000000..39ee732ff
--- /dev/null
+++ b/src/mesonh/conv/convect_trigger_funct.f90
@@ -0,0 +1,454 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 conv 2006/05/18 13:07:25
+!-----------------------------------------------------------------
+! #################
+ MODULE MODI_CONVECT_TRIGGER_FUNCT
+! #################
+!
+INTERFACE
+!
+ SUBROUTINE CONVECT_TRIGGER_FUNCT( KLON, KLEV, &
+ PPRES, PTH, PTHV, PTHES, &
+ PRV, PW, PZ, PDXDY, &
+ PTHLCL, PTLCL, PRVLCL, PWLCL, PZLCL, &
+ PTHVELCL, KLCL, KDPL, KPBL, OTRIG, &
+ PCAPE )
+!
+INTEGER, INTENT(IN) :: KLON ! horizontal loop index
+INTEGER, INTENT(IN) :: KLEV ! vertical loop index
+REAL, DIMENSION(KLON), INTENT(IN) :: PDXDY ! grid area
+REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PTH, PTHV ! theta, theta_v
+REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PTHES ! envir. satur. theta_e
+REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PRV ! vapor mixing ratio
+REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PPRES ! pressure
+REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PZ ! height of grid point (m)
+REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PW ! vertical velocity
+!
+REAL, DIMENSION(KLON), INTENT(OUT):: PTHLCL ! theta at LCL
+REAL, DIMENSION(KLON), INTENT(OUT):: PTLCL ! temp. at LCL
+REAL, DIMENSION(KLON), INTENT(OUT):: PRVLCL ! vapor mixing ratio at LCL
+REAL, DIMENSION(KLON), INTENT(OUT):: PWLCL ! parcel velocity at LCL
+REAL, DIMENSION(KLON), INTENT(OUT):: PZLCL ! height at LCL (m)
+REAL, DIMENSION(KLON), INTENT(OUT):: PTHVELCL ! environm. theta_v at LCL (K)
+LOGICAL, DIMENSION(KLON), INTENT(OUT):: OTRIG ! logical mask for convection
+INTEGER, DIMENSION(KLON), INTENT(INOUT):: KLCL ! contains vert. index of LCL
+INTEGER, DIMENSION(KLON), INTENT(INOUT):: KDPL ! contains vert. index of DPL
+INTEGER, DIMENSION(KLON), INTENT(INOUT):: KPBL ! contains index of source layer top
+REAL, DIMENSION(KLON), INTENT(OUT):: PCAPE ! CAPE (J/kg) for diagnostics
+!
+END SUBROUTINE CONVECT_TRIGGER_FUNCT
+!
+END INTERFACE
+!
+END MODULE MODI_CONVECT_TRIGGER_FUNCT
+! #########################################################################
+ SUBROUTINE CONVECT_TRIGGER_FUNCT( KLON, KLEV, &
+ PPRES, PTH, PTHV, PTHES, &
+ PRV, PW, PZ, PDXDY, &
+ PTHLCL, PTLCL, PRVLCL, PWLCL, PZLCL, &
+ PTHVELCL, KLCL, KDPL, KPBL, OTRIG, &
+ PCAPE )
+! #########################################################################
+!
+!!**** Determine convective columns as well as the cloudy values of theta,
+!! and qv at the lifting condensation level (LCL)
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to determine convective columns
+!!
+!!
+!!
+!!** METHOD
+!! ------
+!! Computations are done at every model level starting from bottom.
+!! The use of masks allows to optimise the inner loops (horizontal loops).
+!! What we look for is the undermost unstable level at each grid point.
+!!
+!!
+!!
+!! EXTERNAL
+!! --------
+!! Routine CONVECT_SATMIXRATIO
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST
+!! XG ! gravity constant
+!! XP00 ! Reference pressure
+!! XRD, XRV ! Gaz constants for dry air and water vapor
+!! XCPD ! Cpd (dry air)
+!! XTT ! triple point temperature
+!! XBETAW, XGAMW ! constants for vapor saturation pressure
+!!
+!! Module MODD_CONVPAR
+!! XA25 ! reference grid area
+!! XZLCL ! maximum height difference between
+!! ! the surface and the DPL
+!! XZPBL ! minimum mixed layer depth to sustain convection
+!! XWTRIG ! constant in vertical velocity trigger
+!! XCDEPTH ! minimum necessary cloud depth
+!! XNHGAM ! coefficient for buoyancy term in w eq.
+!! ! accounting for nh-pressure
+!!
+!! Module MODD_CONVPAREXT
+!! JCVEXB, JCVEXT ! extra levels on the vertical boundaries
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Book2 of documentation ( routine TRIGGER_FUNCT)
+!! Fritsch and Chappell (1980), J. Atm. Sci., Vol. 37, 1722-1761.
+!!
+!! AUTHOR
+!! ------
+!! P. BECHTOLD * Laboratoire d'Aerologie *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 07/11/95
+!! Last modified 20/03/97 Select first departure level
+!! that produces a cloud thicker than XCDEPTH
+!! Last modified 12/12/97 add small perturbation
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_CONVPAR
+USE MODD_CONVPAREXT
+USE MODI_CONVECT_SATMIXRATIO
+!
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KLON ! horizontal loop index
+INTEGER, INTENT(IN) :: KLEV ! vertical loop index
+REAL, DIMENSION(KLON), INTENT(IN) :: PDXDY ! grid area
+REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PTH, PTHV ! theta, theta_v
+REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PTHES ! envir. satur. theta_e
+REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PRV ! vapor mixing ratio
+REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PPRES ! pressure
+REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PZ ! height of grid point (m)
+REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PW ! vertical velocity
+!
+REAL, DIMENSION(KLON), INTENT(OUT):: PTHLCL ! theta at LCL
+REAL, DIMENSION(KLON), INTENT(OUT):: PTLCL ! temp. at LCL
+REAL, DIMENSION(KLON), INTENT(OUT):: PRVLCL ! vapor mixing ratio at LCL
+REAL, DIMENSION(KLON), INTENT(OUT):: PWLCL ! parcel velocity at LCL
+REAL, DIMENSION(KLON), INTENT(OUT):: PZLCL ! height at LCL (m)
+REAL, DIMENSION(KLON), INTENT(OUT):: PTHVELCL ! environm. theta_v at LCL (K)
+LOGICAL, DIMENSION(KLON), INTENT(OUT):: OTRIG ! logical mask for convection
+INTEGER, DIMENSION(KLON), INTENT(INOUT):: KLCL ! contains vert. index of LCL
+INTEGER, DIMENSION(KLON), INTENT(INOUT):: KDPL ! contains vert. index of DPL
+INTEGER, DIMENSION(KLON), INTENT(INOUT):: KPBL ! contains index of source layer top
+REAL, DIMENSION(KLON), INTENT(OUT):: PCAPE ! CAPE (J/kg) for diagnostics
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: JKK, JK, JKP, JKM, JKDL, JL, JKT, JT! vertical loop index
+INTEGER :: JI ! horizontal loop index
+INTEGER :: IIE, IKB, IKE ! horizontal + vertical loop bounds
+REAL :: ZEPS, ZEPSA ! R_d / R_v, R_v / R_d
+REAL :: ZCPORD, ZRDOCP ! C_pd / R_d, R_d / C_pd
+!
+REAL, DIMENSION(KLON) :: ZTHLCL, ZTLCL, ZRVLCL, & ! locals for PTHLCL,PTLCL
+ ZWLCL, ZZLCL, ZTHVELCL ! PRVLCL, ....
+INTEGER, DIMENSION(KLON) :: IDPL, IPBL, ILCL ! locals for KDPL, ...
+REAL, DIMENSION(KLON) :: ZPLCL ! pressure at LCL
+REAL, DIMENSION(KLON) :: ZZDPL ! height of DPL
+REAL, DIMENSION(KLON) :: ZTHVLCL ! theta_v at LCL = mixed layer value
+REAL, DIMENSION(KLON) :: ZTMIX ! mixed layer temperature
+REAL, DIMENSION(KLON) :: ZEVMIX ! mixed layer water vapor pressure
+REAL, DIMENSION(KLON) :: ZDPTHMIX, ZPRESMIX ! mixed layer depth and pressure
+REAL, DIMENSION(KLON) :: ZCAPE ! convective available energy (m^2/s^2/g)
+REAL, DIMENSION(KLON) :: ZTHEUL ! updraft equiv. pot. temperature (K)
+REAL, DIMENSION(KLON) :: ZLV, ZCPH! specific heats of vaporisation, dry air
+REAL, DIMENSION(KLON) :: ZDP ! pressure between LCL and model layer
+REAL, DIMENSION(KLON) :: ZTOP ! estimated cloud top (m)
+REAL, DIMENSION(KLON,KLEV):: ZCAP ! CAPE at every level for diagnostics
+REAL, DIMENSION(KLON) :: ZWORK1, ZWORK2, ZWORK3 ! work arrays
+LOGICAL, DIMENSION(KLON) :: GTRIG, GTRIG2 ! local arrays for OTRIG
+LOGICAL, DIMENSION(KLON) :: GWORK1 ! work array
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 0.3 Compute array bounds
+! --------------------
+!
+IIE = KLON
+IKB = 1 + JCVEXB
+IKE = KLEV - JCVEXT
+!
+!
+!* 1. Initialize local variables
+! --------------------------
+!
+ZEPS = XRD / XRV
+ZEPSA = XRV / XRD
+ZCPORD = XCPD / XRD
+ZRDOCP = XRD / XCPD
+OTRIG(:) = .FALSE.
+IDPL(:) = KDPL(:)
+IPBL(:) = KPBL(:)
+ILCL(:) = KLCL(:)
+PWLCL(:) = 0.
+ZWLCL(:) = 0.
+PTHLCL(:) = 1.
+PTHVELCL(:)= 1.
+PTLCL(:) = 1.
+PRVLCL(:) = 0.
+PWLCL(:) = 0.
+PZLCL(:) = PZ(:,IKB)
+ZZDPL(:) = PZ(:,IKB)
+GTRIG2(:) = .TRUE.
+ZCAP(:,:) = 0.
+!
+!
+!
+! 1. Determine highest necessary loop test layer
+! -------------------------------------------
+!
+JT = IKE - 2
+DO JK = IKB + 1, IKE - 2
+ IF ( PZ(1,JK) - PZ(1,IKB) < 12.E3 ) JT = JK
+END DO
+!
+!
+!* 2. Enter loop for convection test
+! ------------------------------
+!
+JKP = MINVAL( IDPL(:) ) + 1
+JKT = JT
+DO JKK = JKP, JKT
+!
+ GWORK1(:) = ZZDPL(:) - PZ(:,IKB) < XZLCL
+ ! we exit the trigger test when the center of the mixed layer is more
+ ! than 3500 m above soil level.
+ WHERE ( GWORK1(:) )
+ ZDPTHMIX(:) = 0.
+ ZPRESMIX(:) = 0.
+ ZTHLCL(:) = 0.
+ ZRVLCL(:) = 0.
+ ZZDPL(:) = PZ(:,JKK)
+ IDPL(:) = JKK
+ END WHERE
+!
+!
+!* 3. Construct a mixed layer of at least 60 hPa (XZPBL)
+! ------------------------------------------
+!
+ DO JK = JKK, IKE - 1
+ JKM = JK + 1
+ DO JI = 1, IIE
+ IF ( GWORK1(JI) .AND. ZDPTHMIX(JI) < XZPBL ) THEN
+ IPBL(JI) = JK
+ ZWORK1(JI) = PPRES(JI,JK) - PPRES(JI,JKM)
+ ZDPTHMIX(JI) = ZDPTHMIX(JI) + ZWORK1(JI)
+ ZPRESMIX(JI) = ZPRESMIX(JI) + PPRES(JI,JK) * ZWORK1(JI)
+ ZTHLCL(JI) = ZTHLCL(JI) + PTH(JI,JK) * ZWORK1(JI)
+ ZRVLCL(JI) = ZRVLCL(JI) + PRV(JI,JK) * ZWORK1(JI)
+ END IF
+ END DO
+ IF ( MINVAL ( ZDPTHMIX(:) ) >= XZPBL ) EXIT
+ END DO
+!
+!
+ WHERE ( GWORK1(:) )
+!
+ ZPRESMIX(:) = ZPRESMIX(:) / ZDPTHMIX(:)
+ ZTHLCL(:) = ZTHLCL(:) / ZDPTHMIX(:) +.3 ! add small perturbation
+ ZRVLCL(:) = ZRVLCL(:) / ZDPTHMIX(:) +1.e-4
+ ZTHVLCL(:) = ZTHLCL(:) * ( 1. + ZEPSA * ZRVLCL(:) ) &
+ / ( 1. + ZRVLCL(:) )
+!
+!* 4.1 Use an empirical direct solution ( Bolton formula )
+! to determine temperature and pressure at LCL.
+! Nota: the adiabatic saturation temperature is not
+! equal to the dewpoint temperature
+! ----------------------------------------------------
+!
+!
+ ZTMIX(:) = ZTHLCL(:) * ( ZPRESMIX(:) / XP00 ) ** ZRDOCP
+ ZEVMIX(:) = ZRVLCL(:) * ZPRESMIX(:) / ( ZRVLCL(:) + ZEPS )
+ ZEVMIX(:) = MAX( 1.E-8, ZEVMIX(:) )
+ ZWORK1(:) = LOG( ZEVMIX(:) / 613.3 )
+ ! dewpoint temperature
+ ZWORK1(:) = ( 4780.8 - 32.19 * ZWORK1(:) ) / ( 17.502 - ZWORK1(:) )
+ ! adiabatic saturation temperature
+ ZTLCL(:) = ZWORK1(:) - ( .212 + 1.571E-3 * ( ZWORK1(:) - XTT ) &
+ - 4.36E-4 * ( ZTMIX(:) - XTT ) ) * ( ZTMIX(:) - ZWORK1(:) )
+ ZTLCL(:) = MIN( ZTLCL(:), ZTMIX(:) )
+ ZPLCL(:) = XP00 * ( ZTLCL(:) / ZTHLCL(:) ) ** ZCPORD
+!
+ END WHERE
+!
+!
+!* 4.2 Correct ZTLCL in order to be completely consistent
+! with MNH saturation formula
+! ---------------------------------------------
+!
+ CALL CONVECT_SATMIXRATIO( KLON, ZPLCL, ZTLCL, ZWORK1, ZLV, ZWORK2, ZCPH )
+ WHERE( GWORK1(:) )
+ ZWORK2(:) = ZWORK1(:) / ZTLCL(:) * ( XBETAW / ZTLCL(:) - XGAMW ) ! dr_sat/dT
+ ZWORK2(:) = ( ZWORK1(:) - ZRVLCL(:) ) / &
+ ( 1. + ZLV(:) / ZCPH(:) * ZWORK2(:) )
+ ZTLCL(:) = ZTLCL(:) - ZLV(:) / ZCPH(:) * ZWORK2(:)
+!
+ END WHERE
+!
+!
+!* 4.3 If ZRVLCL = PRVMIX is oversaturated set humidity
+! and temperature to saturation values.
+! ---------------------------------------------
+!
+ CALL CONVECT_SATMIXRATIO( KLON, ZPRESMIX, ZTMIX, ZWORK1, ZLV, ZWORK2, ZCPH )
+ WHERE( GWORK1(:) .AND. ZRVLCL(:) > ZWORK1(:) )
+ ZWORK2(:) = ZWORK1(:) / ZTMIX(:) * ( XBETAW / ZTMIX(:) - XGAMW ) ! dr_sat/dT
+ ZWORK2(:) = ( ZWORK1(:) - ZRVLCL(:) ) / &
+ ( 1. + ZLV(:) / ZCPH(:) * ZWORK2(:) )
+ ZTLCL(:) = ZTMIX(:) - ZLV(:) / ZCPH(:) * ZWORK2(:)
+ ZRVLCL(:) = ZRVLCL(:) - ZWORK2(:)
+ ZPLCL(:) = ZPRESMIX(:)
+ ZTHLCL(:) = ZTLCL(:) * ( XP00 / ZPLCL(:) ) ** ZRDOCP
+ ZTHVLCL(:)= ZTHLCL(:) * ( 1. + ZEPSA * ZRVLCL(:) ) &
+ / ( 1. + ZRVLCL(:) )
+ END WHERE
+!
+!
+!* 5.1 Determine vertical loop index at the LCL and DPL
+! --------------------------------------------------
+!
+ DO JK = JKK, IKE - 1
+ DO JI = 1, IIE
+ IF ( ZPLCL(JI) <= PPRES(JI,JK) .AND. GWORK1(JI) ) ILCL(JI) = JK + 1
+ END DO
+ END DO
+!
+!
+!* 5.2 Estimate height and environm. theta_v at LCL
+! --------------------------------------------------
+!
+ DO JI = 1, IIE
+ JK = ILCL(JI)
+ JKM = JK - 1
+ ZDP(JI) = LOG( ZPLCL(JI) / PPRES(JI,JKM) ) / &
+ LOG( PPRES(JI,JK) / PPRES(JI,JKM) )
+ ZWORK1(JI) = PTHV(JI,JKM) + ( PTHV(JI,JK) - PTHV(JI,JKM) ) * ZDP(JI)
+ ! we compute the precise value of the LCL
+ ! The precise height is between the levels ILCL and ILCL-1.
+ ZWORK2(JI) = PZ(JI,JKM) + ( PZ(JI,JK) - PZ(JI,JKM) ) * ZDP(JI)
+ END DO
+ WHERE( GWORK1(:) )
+ ZTHVELCL(:) = ZWORK1(:)
+ ZZLCL(:) = ZWORK2(:)
+ END WHERE
+!
+!
+!* 6. Check to see if cloud is bouyant
+! --------------------------------
+!
+!* 6.1 Compute grid scale vertical velocity perturbation term ZWORK1
+! -------------------------------------------------------------
+!
+ ! normalize w grid scale to a 25 km refer. grid
+ DO JI = 1, IIE
+ JK = ILCL(JI)
+ JKM = JK - 1
+ JKDL= IDPL(JI)
+ !ZWORK1(JI) = ( PW(JI,JKM) + ( PW(JI,JK) - PW(JI,JKM) ) * ZDP(JI) ) &
+ ZWORK1(JI) = ( PW(JI,JK) + PW(JI,JKDL)*ZZLCL(JI)/PZ(JI,JKDL) ) * .5 &
+ * SQRT( PDXDY(JI) / XA25 )
+! - 0.02 * ZZLCL(JI) / XZLCL ! avoid spurious convection
+ END DO
+ ! compute sign of normalized grid scale w
+ ZWORK2(:) = SIGN( 1., ZWORK1(:) )
+ ZWORK1(:) = XWTRIG * ZWORK2(:) * ABS( ZWORK1(:) ) ** 0.333 &
+ * ( XP00 / ZPLCL(:) ) ** ZRDOCP
+!
+!* 6.2 Compute parcel vertical velocity at LCL
+! ---------------------------------------
+!
+ DO JI = 1, IIE
+ JKDL = IDPL(JI)
+ ZWORK3(JI) = XG * ZWORK1(JI) * ( ZZLCL(JI) - PZ(JI,JKDL) ) &
+ / ( PTHV(JI,JKDL) + ZTHVELCL(JI) )
+ END DO
+ WHERE( GWORK1(:) )
+ ZWLCL(:) = 1. + .5 * ZWORK2(:) * SQRT( ABS( ZWORK3(:) ) )
+ GTRIG(:) = ZTHVLCL(:) - ZTHVELCL(:) + ZWORK1(:) > 0. .AND. &
+ ZWLCL(:) > 0.
+ END WHERE
+!
+!
+!* 6.3 Look for parcel that produces sufficient cloud depth.
+! The cloud top is estimated as the level where the CAPE
+! is smaller than a given value (based on vertical velocity eq.)
+! --------------------------------------------------------------
+!
+ ZTHEUL(:) = ZTLCL(:) * ( ZTHLCL(:) / ZTLCL(:) ) &
+ ** ( 1. - 0.28 * ZRVLCL(:) ) &
+ * EXP( ( 3374.6525 / ZTLCL(:) - 2.5403 ) * &
+ ZRVLCL(:) * ( 1. + 0.81 * ZRVLCL(:) ) )
+!
+ ZCAPE(:) = 0.
+ ZTOP(:) = 0.
+ ZWORK3(:)= 0.
+ JKM = MINVAL( ILCL(:) )
+ DO JL = JKM, JT
+ JK = JL + 1
+ DO JI = 1, IIE
+ ZWORK1(JI) = ( 2. * ZTHEUL(JI) / &
+ ( PTHES(JI,JK) + PTHES(JI,JL) ) - 1. ) * ( PZ(JI,JK) - PZ(JI,JL) )
+ IF ( JL < ILCL(JI) ) ZWORK1(JI) = 0.
+ ! IF ( JL <= ILCL(JI) ) ZWORK1(JI) = 0.
+ ZCAPE(JI) = ZCAPE(JI) + ZWORK1(JI)
+ ZCAP(JI,JKK) = ZCAP(JI,JKK) + XG * MAX( 0., ZWORK1(JI) ) ! actual CAPE
+ ZWORK2(JI) = XNHGAM * XG * ZCAPE(JI) + 1.05 * ZWLCL(JI) * ZWLCL(JI)
+ ! the factor 1.05 takes entrainment into account
+ ZWORK2(JI) = SIGN( 1., ZWORK2(JI) )
+ ZWORK3(JI) = ZWORK3(JI) + MIN(0., ZWORK2(JI) )
+ ZWORK3(JI) = MAX( -1., ZWORK3(JI) )
+ ! Nota, the factors ZWORK2 and ZWORK3 are only used to avoid
+ ! if and goto statements, the difficulty is to extract only
+ ! the level where the criterium is first fullfilled
+ ZTOP(JI) = PZ(JI,JL) * .5 * ( 1. + ZWORK2(JI) ) * ( 1. + ZWORK3(JI) ) + &
+ ZTOP(JI) * .5 * ( 1. - ZWORK2(JI) )
+ END DO
+ END DO
+!
+!
+ WHERE( ZTOP(:) - ZZLCL(:) .GE. XCDEPTH .AND. GTRIG(:) .AND. GTRIG2(:) )
+ GTRIG2(:) = .FALSE.
+ OTRIG(:) = GTRIG(:) ! we select the first departure level
+ PTHLCL(:) = ZTHLCL(:) ! that gives sufficient cloud depth
+ PRVLCL(:) = ZRVLCL(:)
+ PTLCL(:) = ZTLCL(:)
+ PWLCL(:) = ZWLCL(:)
+ PZLCL(:) = ZZLCL(:)
+ PTHVELCL(:) = ZTHVELCL(:)
+ KDPL(:) = IDPL(:)
+ KPBL(:) = IPBL(:)
+ KLCL(:) = ILCL(:)
+ END WHERE
+!
+END DO
+!
+ DO JI = 1, IIE
+ PCAPE(JI) = MAXVAL( ZCAP(JI,:) ) ! maximum CAPE for diagnostics
+ END DO
+!
+!
+END SUBROUTINE CONVECT_TRIGGER_FUNCT
diff --git a/src/mesonh/conv/convect_trigger_shal.f90 b/src/mesonh/conv/convect_trigger_shal.f90
new file mode 100644
index 000000000..d99b011a2
--- /dev/null
+++ b/src/mesonh/conv/convect_trigger_shal.f90
@@ -0,0 +1,461 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 conv 2006/05/18 13:07:25
+!-----------------------------------------------------------------
+! #################
+ MODULE MODI_CONVECT_TRIGGER_SHAL
+! #################
+!
+INTERFACE
+!
+ SUBROUTINE CONVECT_TRIGGER_SHAL( KLON, KLEV, &
+ PPRES, PTH, PTHV, PTHES, &
+ PRV, PW, PZ, PDXDY,PTKECLS, &
+ PTHLCL, PTLCL, PRVLCL, PWLCL, PZLCL, &
+ PTHVELCL, KLCL, KDPL, KPBL, OTRIG )
+!
+INTEGER, INTENT(IN) :: KLON ! horizontal loop index
+INTEGER, INTENT(IN) :: KLEV ! vertical loop index
+REAL, DIMENSION(KLON), INTENT(IN) :: PDXDY ! grid area
+REAL, DIMENSION(KLON), INTENT(IN) :: PTKECLS ! TKE CLS
+REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PTH, PTHV ! theta, theta_v
+REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PTHES ! envir. satur. theta_e
+REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PRV ! vapor mixing ratio
+REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PPRES ! pressure
+REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PZ ! height of grid point (m)
+REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PW ! vertical velocity
+!
+REAL, DIMENSION(KLON), INTENT(OUT):: PTHLCL ! theta at LCL
+REAL, DIMENSION(KLON), INTENT(OUT):: PTLCL ! temp. at LCL
+REAL, DIMENSION(KLON), INTENT(OUT):: PRVLCL ! vapor mixing ratio at LCL
+REAL, DIMENSION(KLON), INTENT(OUT):: PWLCL ! parcel velocity at LCL
+REAL, DIMENSION(KLON), INTENT(OUT):: PZLCL ! height at LCL (m)
+REAL, DIMENSION(KLON), INTENT(OUT):: PTHVELCL ! environm. theta_v at LCL (K)
+LOGICAL, DIMENSION(KLON), INTENT(OUT):: OTRIG ! logical mask for convection
+INTEGER, DIMENSION(KLON), INTENT(INOUT):: KLCL ! contains vert. index of LCL
+INTEGER, DIMENSION(KLON), INTENT(INOUT):: KDPL ! contains vert. index of DPL
+INTEGER, DIMENSION(KLON), INTENT(INOUT):: KPBL ! contains index of source layer top
+!
+END SUBROUTINE CONVECT_TRIGGER_SHAL
+!
+END INTERFACE
+!
+END MODULE MODI_CONVECT_TRIGGER_SHAL
+! ########################################################################
+ SUBROUTINE CONVECT_TRIGGER_SHAL( KLON, KLEV, &
+ PPRES, PTH, PTHV, PTHES, &
+ PRV, PW, PZ, PDXDY,PTKECLS, &
+ PTHLCL, PTLCL, PRVLCL, PWLCL, PZLCL, &
+ PTHVELCL, KLCL, KDPL, KPBL, OTRIG )
+! ########################################################################
+!
+!!**** Determine convective columns as well as the cloudy values of theta,
+!! and qv at the lifting condensation level (LCL)
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to determine convective columns
+!!
+!!
+!!
+!!** METHOD
+!! ------
+!! Computations are done at every model level starting from bottom.
+!! The use of masks allows to optimise the inner loops (horizontal loops).
+!! What we look for is the undermost unstable level at each grid point.
+!!
+!!
+!!
+!! EXTERNAL
+!! --------
+!! Routine CONVECT_SATMIXRATIO
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST
+!! XG ! gravity constant
+!! XP00 ! Reference pressure
+!! XRD, XRV ! Gaz constants for dry air and water vapor
+!! XCPD ! Cpd (dry air)
+!! XTT ! triple point temperature
+!! XBETAW, XGAMW ! constants for vapor saturation pressure
+!!
+!! Module MODD_CONVPAR
+!! XA25 ! reference grid area
+!! XZLCL ! maximum height difference between
+!! ! the surface and the DPL
+!! XZPBL ! minimum mixed layer depth to sustain convection
+!! XCDEPTH ! minimum necessary cloud depth
+!! XCDEPTH_D ! maximum allowed cloud depth
+!! XDTPERT ! add small Temp peturbation
+!! XNHGAM ! coefficient for buoyancy term in w eq.
+!! ! accounting for nh-pressure
+!! XAW, XBW, XATPERT, XBTPERT
+!!
+!! Module MODD_CONVPAREXT
+!! JCVEXB, JCVEXT ! extra levels on the vertical boundaries
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Book2 of documentation ( routine TRIGGER_FUNCT)
+!! Fritsch and Chappell (1980), J. Atm. Sci., Vol. 37, 1722-1761.
+!!
+!! AUTHOR
+!! ------
+!! P. BECHTOLD * Laboratoire d'Aerologie *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 07/11/95
+!! Last modified 20/03/97 Select first departure level
+!! that produces a cloud thicker than XCDEPTH
+!! F. Bouyssel 05/11/08 Modifications for reproductibility
+!! E. Bazile 05/05/09 Modifications for using really W and the tempe.
+!! perturbation function of the TKE.
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_CONVPAR_SHAL
+USE MODD_CONVPAREXT
+USE MODI_CONVECT_SATMIXRATIO
+!
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KLON ! horizontal loop index
+INTEGER, INTENT(IN) :: KLEV ! vertical loop index
+REAL, DIMENSION(KLON), INTENT(IN) :: PDXDY ! grid area
+REAL, DIMENSION(KLON), INTENT(IN) :: PTKECLS ! TKE CLS
+REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PTH, PTHV ! theta, theta_v
+REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PTHES ! envir. satur. theta_e
+REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PRV ! vapor mixing ratio
+REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PPRES ! pressure
+REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PZ ! height of grid point (m)
+REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PW ! vertical velocity
+!
+REAL, DIMENSION(KLON), INTENT(OUT):: PTHLCL ! theta at LCL
+REAL, DIMENSION(KLON), INTENT(OUT):: PTLCL ! temp. at LCL
+REAL, DIMENSION(KLON), INTENT(OUT):: PRVLCL ! vapor mixing ratio at LCL
+REAL, DIMENSION(KLON), INTENT(OUT):: PWLCL ! parcel velocity at LCL
+REAL, DIMENSION(KLON), INTENT(OUT):: PZLCL ! height at LCL (m)
+REAL, DIMENSION(KLON), INTENT(OUT):: PTHVELCL ! environm. theta_v at LCL (K)
+LOGICAL, DIMENSION(KLON), INTENT(OUT):: OTRIG ! logical mask for convection
+INTEGER, DIMENSION(KLON), INTENT(INOUT):: KLCL ! contains vert. index of LCL
+INTEGER, DIMENSION(KLON), INTENT(INOUT):: KDPL ! contains vert. index of DPL
+INTEGER, DIMENSION(KLON), INTENT(INOUT):: KPBL ! contains index of source layer top
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: JKK, JK, JKP, JKM, JKDL, JL, JKT, JT! vertical loop index
+INTEGER :: JI ! horizontal loop index
+INTEGER :: IIE, IKB, IKE ! horizontal + vertical loop bounds
+REAL :: ZEPS, ZEPSA ! R_d / R_v, R_v / R_d
+REAL :: ZCPORD, ZRDOCP ! C_pd / R_d, R_d / C_pd
+!
+REAL, DIMENSION(KLON) :: ZTHLCL, ZTLCL, ZRVLCL, & ! locals for PTHLCL,PTLCL
+ ZWLCL, ZZLCL, ZTHVELCL ! PRVLCL, ....
+INTEGER, DIMENSION(KLON) :: IDPL, IPBL, ILCL ! locals for KDPL, ...
+REAL, DIMENSION(KLON) :: ZPLCL ! pressure at LCL
+REAL, DIMENSION(KLON) :: ZZDPL ! height of DPL
+REAL, DIMENSION(KLON) :: ZTHVLCL ! theta_v at LCL = mixed layer value
+REAL, DIMENSION(KLON) :: ZTMIX ! mixed layer temperature
+REAL, DIMENSION(KLON) :: ZEVMIX ! mixed layer water vapor pressure
+REAL, DIMENSION(KLON) :: ZDPTHMIX, ZPRESMIX ! mixed layer depth and pressure
+REAL, DIMENSION(KLON) :: ZCAPE ! convective available energy (m^2/s^2/g)
+REAL, DIMENSION(KLON) :: ZCAP ! pseudo fro CAPE
+REAL, DIMENSION(KLON) :: ZTHEUL ! updraft equiv. pot. temperature (K)
+REAL, DIMENSION(KLON) :: ZLV, ZCPH! specific heats of vaporisation, dry air
+REAL, DIMENSION(KLON) :: ZDP ! pressure between LCL and model layer
+REAL, DIMENSION(KLON) :: ZTOP,ZTOPP ! estimated cloud top (m)
+REAL, DIMENSION(KLON) :: ZWORK1, ZWORK2, ZWORK3 ! work arrays
+LOGICAL, DIMENSION(KLON) :: GTRIG, GTRIG2 ! local arrays for OTRIG
+LOGICAL, DIMENSION(KLON) :: GWORK1 ! work array
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 0.3 Compute array bounds
+! --------------------
+!
+IIE = KLON
+IKB = 1 + JCVEXB
+IKE = KLEV - JCVEXT
+!
+!
+!* 1. Initialize local variables
+! --------------------------
+!
+ZEPS = XRD / XRV
+ZEPSA = XRV / XRD
+ZCPORD = XCPD / XRD
+ZRDOCP = XRD / XCPD
+OTRIG(:) = .FALSE.
+IDPL(:) = KDPL(:)
+IPBL(:) = KPBL(:)
+ILCL(:) = KLCL(:)
+PWLCL(:) = 0.
+ZWLCL(:) = 0.
+PTHLCL(:) = 1.
+PTHVELCL(:)= 1.
+PTLCL(:) = 1.
+PRVLCL(:) = 0.
+PWLCL(:) = 0.
+PZLCL(:) = PZ(:,IKB)
+ZZDPL(:) = PZ(:,IKB)
+GTRIG2(:) = .TRUE.
+!
+!
+!
+! 1. Determine highest necessary loop test layer
+! -------------------------------------------
+!
+JT = IKE - 2
+! FBy
+!DO JK = IKB + 1, IKE - 2
+! IF ( PZ(1,JK) - PZ(1,IKB) < 5.E3 ) JT = JK
+!END DO
+!
+!
+!* 2. Enter loop for convection test
+! ------------------------------
+!
+JKP = MINVAL( IDPL(:) ) + 1
+JKT = JT
+JKT = JKP ! do not allow for looping anymore, test only for surface mixed layer
+DO JKK = JKP, JKT
+!
+ GWORK1(:) = ZZDPL(:) - PZ(:,IKB) < XZLCL
+ ! we exit the trigger test when the center of the mixed layer is more
+ ! than 1500 m above soil level.
+ WHERE ( GWORK1(:) )
+ ZDPTHMIX(:) = 0.
+ ZPRESMIX(:) = 0.
+ ZTHLCL(:) = 0.
+ ZRVLCL(:) = 0.
+ ZZDPL(:) = PZ(:,JKK)
+ IDPL(:) = JKK
+ END WHERE
+!
+!
+!* 3. Construct a mixed layer of at least 50 hPa (XZPBL)
+! ------------------------------------------
+!
+ DO JK = JKK, IKE - 1
+ JKM = JK + 1
+ DO JI = 1, IIE
+ IF ( GWORK1(JI) .AND. ZDPTHMIX(JI) < XZPBL ) THEN
+ IPBL(JI) = JK
+ ZWORK1(JI) = PPRES(JI,JK) - PPRES(JI,JKM)
+ ZDPTHMIX(JI) = ZDPTHMIX(JI) + ZWORK1(JI)
+ ZPRESMIX(JI) = ZPRESMIX(JI) + PPRES(JI,JK) * ZWORK1(JI)
+ ZTHLCL(JI) = ZTHLCL(JI) + PTH(JI,JK) * ZWORK1(JI)
+ ZRVLCL(JI) = ZRVLCL(JI) + PRV(JI,JK) * ZWORK1(JI)
+ END IF
+ END DO
+ IF ( MINVAL ( ZDPTHMIX(:) ) >= XZPBL ) EXIT
+ END DO
+!
+!
+ WHERE ( GWORK1(:) )
+!
+ ZPRESMIX(:) = ZPRESMIX(:) / ZDPTHMIX(:)
+ ZTHLCL(:) = ZTHLCL(:) / ZDPTHMIX(:) + &
+ & (XATPERT * MAX(3.,PTKECLS(:))/XCPD +XBTPERT) * XDTPERT ! add small Temp Perturb.
+ ZRVLCL(:) = ZRVLCL(:) / ZDPTHMIX(:)
+ ZTHVLCL(:) = ZTHLCL(:) * ( 1. + ZEPSA * ZRVLCL(:) ) &
+ / ( 1. + ZRVLCL(:) )
+!
+!* 4.1 Use an empirical direct solution ( Bolton formula )
+! to determine temperature and pressure at LCL.
+! Nota: the adiabatic saturation temperature is not
+! equal to the dewpoint temperature
+! ----------------------------------------------------
+!
+!
+ ZTMIX(:) = ZTHLCL(:) * ( ZPRESMIX(:) / XP00 ) ** ZRDOCP
+ ZEVMIX(:) = ZRVLCL(:) * ZPRESMIX(:) / ( ZRVLCL(:) + ZEPS )
+ ZEVMIX(:) = MAX( 1.E-8, ZEVMIX(:) )
+ ZWORK1(:) = LOG( ZEVMIX(:) / 613.3 )
+ ! dewpoint temperature
+ ZWORK1(:) = ( 4780.8 - 32.19 * ZWORK1(:) ) / ( 17.502 - ZWORK1(:) )
+ ! adiabatic saturation temperature
+ ZTLCL(:) = ZWORK1(:) - ( .212 + 1.571E-3 * ( ZWORK1(:) - XTT ) &
+ - 4.36E-4 * ( ZTMIX(:) - XTT ) ) * ( ZTMIX(:) - ZWORK1(:) )
+ ZTLCL(:) = MIN( ZTLCL(:), ZTMIX(:) )
+ ZPLCL(:) = XP00 * ( ZTLCL(:) / ZTHLCL(:) ) ** ZCPORD
+!
+ END WHERE
+!
+!
+!* 4.2 Correct ZTLCL in order to be completely consistent
+! with MNH saturation formula
+! ---------------------------------------------
+!
+ CALL CONVECT_SATMIXRATIO( KLON, ZPLCL, ZTLCL, ZWORK1, ZLV, ZWORK2, ZCPH )
+ WHERE( GWORK1(:) )
+ ZWORK2(:) = ZWORK1(:) / ZTLCL(:) * ( XBETAW / ZTLCL(:) - XGAMW ) ! dr_sat/dT
+ ZWORK2(:) = ( ZWORK1(:) - ZRVLCL(:) ) / &
+ ( 1. + ZLV(:) / ZCPH(:) * ZWORK2(:) )
+ ZTLCL(:) = ZTLCL(:) - ZLV(:) / ZCPH(:) * ZWORK2(:)
+!
+ END WHERE
+!
+!
+!* 4.3 If ZRVLCL = PRVMIX is oversaturated set humidity
+! and temperature to saturation values.
+! ---------------------------------------------
+!
+ CALL CONVECT_SATMIXRATIO( KLON, ZPRESMIX, ZTMIX, ZWORK1, ZLV, ZWORK2, ZCPH )
+ WHERE( GWORK1(:) .AND. ZRVLCL(:) > ZWORK1(:) )
+ ZWORK2(:) = ZWORK1(:) / ZTMIX(:) * ( XBETAW / ZTMIX(:) - XGAMW ) ! dr_sat/dT
+ ZWORK2(:) = ( ZWORK1(:) - ZRVLCL(:) ) / &
+ ( 1. + ZLV(:) / ZCPH(:) * ZWORK2(:) )
+ ZTLCL(:) = ZTMIX(:) - ZLV(:) / ZCPH(:) * ZWORK2(:)
+ ZRVLCL(:) = ZRVLCL(:) - ZWORK2(:)
+ ZPLCL(:) = ZPRESMIX(:)
+ ZTHLCL(:) = ZTLCL(:) * ( XP00 / ZPLCL(:) ) ** ZRDOCP
+ ZTHVLCL(:)= ZTHLCL(:) * ( 1. + ZEPSA * ZRVLCL(:) ) &
+ / ( 1. + ZRVLCL(:) )
+ END WHERE
+!
+!
+!* 5.1 Determine vertical loop index at the LCL and DPL
+! --------------------------------------------------
+!
+ DO JK = JKK, IKE - 1
+ DO JI = 1, IIE
+ IF ( ZPLCL(JI) <= PPRES(JI,JK) .AND. GWORK1(JI) ) ILCL(JI) = JK + 1
+ END DO
+ END DO
+!
+!
+!* 5.2 Estimate height and environm. theta_v at LCL
+! --------------------------------------------------
+!
+ DO JI = 1, IIE
+ JK = ILCL(JI)
+ JKM = JK - 1
+ ZDP(JI) = LOG( ZPLCL(JI) / PPRES(JI,JKM) ) / &
+ LOG( PPRES(JI,JK) / PPRES(JI,JKM) )
+ ZWORK1(JI) = PTHV(JI,JKM) + ( PTHV(JI,JK) - PTHV(JI,JKM) ) * ZDP(JI)
+ ! we compute the precise value of the LCL
+ ! The precise height is between the levels ILCL and ILCL-1.
+ ZWORK2(JI) = PZ(JI,JKM) + ( PZ(JI,JK) - PZ(JI,JKM) ) * ZDP(JI)
+ END DO
+ WHERE( GWORK1(:) )
+ ZTHVELCL(:) = ZWORK1(:)
+ ZZLCL(:) = ZWORK2(:)
+ END WHERE
+!
+!
+!* 6. Check to see if cloud is bouyant
+! --------------------------------
+!
+!* 6.1 Compute grid scale vertical velocity perturbation term ZWORK1
+! -------------------------------------------------------------
+!
+! ! normalize w grid scale to a 25 km refer. grid
+! DO JI = 1, IIE
+! JK = ILCL(JI)
+! JKM = JK - 1
+! ZWORK1(JI) = ( PW(JI,JKM) + ( PW(JI,JK) - PW(JI,JKM) ) * ZDP(JI) ) &
+! * SQRT( PDXDY(JI) / XA25 )
+! - 0.02 * ZZLCL(JI) / XZLCL ! avoid spurious convection
+! END DO
+! ! compute sign of normalized grid scale w
+! ZWORK2(:) = SIGN( 1., ZWORK1(:) )
+! ZWORK1(:) = XWTRIG * ZWORK2(:) * ABS( ZWORK1(:) ) ** 0.333 &
+! * ( XP00 / ZPLCL(:) ) ** ZRDOCP
+!
+!* 6.2 Compute parcel vertical velocity at LCL
+! ---------------------------------------
+!
+! DO JI = 1, IIE
+! JKDL = IDPL(JI)
+! ZWORK3(JI) = XG * ZWORK1(JI) * ( ZZLCL(JI) - PZ(JI,JKDL) ) &
+! / ( PTHV(JI,JKDL) + ZTHVELCL(JI) )
+! END DO
+! WHERE( GWORK1(:) )
+! ZWLCL(:) = 1. + .5 * ZWORK2(:) * SQRT( ABS( ZWORK3(:) ) )
+! GTRIG(:) = ZTHVLCL(:) - ZTHVELCL(:) + ZWORK1(:) > 0. .AND. &
+! ZWLCL(:) > 0.
+! END WHERE
+ ZWLCL(:) = XAW * MAX(0.,PW(:,IKB)) + XBW
+!
+!
+!* 6.3 Look for parcel that produces sufficient cloud depth.
+! The cloud top is estimated as the level where the CAPE
+! is smaller than a given value (based on vertical velocity eq.)
+! --------------------------------------------------------------
+!
+ ZTHEUL(:) = ZTLCL(:) * ( ZTHLCL(:) / ZTLCL(:) ) &
+ ** ( 1. - 0.28 * ZRVLCL(:) ) &
+ * EXP( ( 3374.6525 / ZTLCL(:) - 2.5403 ) * &
+ ZRVLCL(:) * ( 1. + 0.81 * ZRVLCL(:) ) )
+!
+ ZCAPE(:) = 0.
+ ZCAP(:) = 0.
+ ZTOP(:) = 0.
+ ZTOPP(:) = 0.
+ ZWORK3(:)= 0.
+ JKM = MINVAL( ILCL(:) )
+ DO JL = JKM, JT
+ JK = JL + 1
+ DO JI = 1, IIE
+ ZWORK1(JI) = ( 2. * ZTHEUL(JI) / &
+ ( PTHES(JI,JK) + PTHES(JI,JL) ) - 1. ) * ( PZ(JI,JK) - PZ(JI,JL) )
+ IF ( JL < ILCL(JI) ) ZWORK1(JI) = 0.
+ ZCAPE(JI) = ZCAPE(JI) + XG * MAX( 1., ZWORK1(JI) )
+ ZCAP(JI) = ZCAP(JI) + ZWORK1(JI)
+ ZWORK2(JI) = XNHGAM * XG * ZCAP(JI) + 1.05 * ZWLCL(JI) * ZWLCL(JI)
+ ! the factor 1.05 takes entrainment into account
+ ZWORK2(JI) = SIGN( 1., ZWORK2(JI) )
+ ZWORK3(JI) = ZWORK3(JI) + MIN(0., ZWORK2(JI) )
+ ZWORK3(JI) = MAX( -1., ZWORK3(JI) )
+ ! Nota, the factors ZWORK2 and ZWORK3 are only used to avoid
+ ! if and goto statements, the difficulty is to extract only
+ ! the level where the criterium is first fullfilled
+ ZTOPP(JI)=ZTOP(JI)
+ ZTOP(JI) = PZ(JI,JL) * .5 * ( 1. + ZWORK2(JI) ) * ( 1. + ZWORK3(JI) ) + &
+ ZTOP(JI) * .5 * ( 1. - ZWORK2(JI) )
+ ZTOP(JI)=MAX(ZTOP(JI),ZTOPP(JI))
+ ZTOPP(JI)=ZTOP(JI)
+ END DO
+ END DO
+!
+!
+ ZWORK2(:) = ZTOP(:) - ZZLCL(:)
+ ! WHERE( ZWORK2(:) .GE. XCDEPTH .AND. ZWORK2(:) < XCDEPTH_D .AND. GTRIG2(:) &
+ WHERE( ZWORK2(:) .GE. XCDEPTH .AND. GTRIG2(:) &
+ .AND. ZCAPE(:) > 10. )
+ GTRIG2(:) = .FALSE.
+ OTRIG(:) = .TRUE.
+ ! OTRIG(:) = GTRIG(:) ! we select the first departure level
+ PTHLCL(:) = ZTHLCL(:) ! that gives sufficient cloud depth
+ PRVLCL(:) = ZRVLCL(:)
+ PTLCL(:) = ZTLCL(:)
+ PWLCL(:) = ZWLCL(:)
+ PZLCL(:) = ZZLCL(:)
+ PTHVELCL(:) = ZTHVELCL(:)
+ KDPL(:) = IDPL(:)
+ KPBL(:) = IPBL(:)
+ KLCL(:) = ILCL(:)
+ END WHERE
+!
+END DO
+!
+!
+END SUBROUTINE CONVECT_TRIGGER_SHAL
diff --git a/src/mesonh/conv/convect_tstep_pref.f90 b/src/mesonh/conv/convect_tstep_pref.f90
new file mode 100644
index 000000000..718da2b7b
--- /dev/null
+++ b/src/mesonh/conv/convect_tstep_pref.f90
@@ -0,0 +1,206 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 conv 2006/05/18 13:07:25
+!-----------------------------------------------------------------
+! #################
+ MODULE MODI_CONVECT_TSTEP_PREF
+! #################
+!
+INTERFACE
+!
+ SUBROUTINE CONVECT_TSTEP_PREF( KLON, KLEV, &
+ PU, PV, PPRES, PZ, PDXDY, KLCL, KCTL, &
+ PTIMEA, PPREF )
+!
+INTEGER, INTENT(IN) :: KLON ! horizontal dimension
+INTEGER, INTENT(IN) :: KLEV ! vertical dimension
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PPRES ! pressure (Pa)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PU ! grid scale horiz. wind u
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PV ! grid scale horiz. wind v
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PZ ! height of model layer (m)
+REAL, DIMENSION(KLON), INTENT(IN) :: PDXDY ! grid area (m^2)
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KLCL ! lifting condensation level index
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KCTL ! cloud top level index
+!
+REAL, DIMENSION(KLON), INTENT(OUT):: PTIMEA ! advective time period
+REAL, DIMENSION(KLON), INTENT(OUT):: PPREF ! precipitation efficiency
+!
+END SUBROUTINE CONVECT_TSTEP_PREF
+!
+END INTERFACE
+!
+END MODULE MODI_CONVECT_TSTEP_PREF
+! ######################################################################
+ SUBROUTINE CONVECT_TSTEP_PREF( KLON, KLEV, &
+ PU, PV, PPRES, PZ, PDXDY, KLCL, KCTL, &
+ PTIMEA, PPREF )
+! ######################################################################
+!
+!!**** Routine to compute convective advection time step and precipitation
+!! efficiency
+!!
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to determine the convective
+!! advection time step PTIMEC as a function of the mean ambient
+!! wind as well as the precipitation efficiency as a function
+!! of wind shear and cloud base height.
+!!
+!!
+!!** METHOD
+!! ------
+!!
+!!
+!! EXTERNAL
+!! --------
+!! None
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! Module MODD_CONVPAREXT
+!! JCVEXB, JCVEXT ! extra levels on the vertical boundaries
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Book1,2 of documentation
+!! Fritsch and Chappell, 1980, J. Atmos. Sci.
+!! Kain and Fritsch, 1993, Meteor. Monographs, Vol.
+!!
+!! AUTHOR
+!! ------
+!! P. BECHTOLD * Laboratoire d'Aerologie *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 07/11/95
+!! Last modified 04/10/97
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CONVPAREXT
+!
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KLON ! horizontal dimension
+INTEGER, INTENT(IN) :: KLEV ! vertical dimension
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PPRES ! pressure (Pa)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PU ! grid scale horiz. wind u
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PV ! grid scale horiz. wind v
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PZ ! height of model layer (m)
+REAL, DIMENSION(KLON), INTENT(IN) :: PDXDY ! grid area (m^2)
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KLCL ! lifting condensation level index
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KCTL ! cloud top level index
+!
+REAL, DIMENSION(KLON), INTENT(OUT):: PTIMEA ! advective time period
+REAL, DIMENSION(KLON), INTENT(OUT):: PPREF ! precipitation efficiency
+!
+!
+!* 0.2 Declarations of local variables KLON
+!
+INTEGER :: IIE, IKB, IKE ! horizontal + vertical loop bounds
+INTEGER :: JI ! horizontal loop index
+INTEGER :: JK, JKLC, JKP5, JKCT ! vertical loop index
+!
+INTEGER, DIMENSION(KLON) :: IP500 ! index of 500 hPa levels
+REAL, DIMENSION(KLON) :: ZCBH ! cloud base height
+REAL, DIMENSION(KLON) :: ZWORK1, ZWORK2, ZWORK3 ! work arrays
+!
+!
+!-------------------------------------------------------------------------------
+!
+! 0.3 Set loop bounds
+! ---------------
+!
+IIE = KLON
+IKB = 1 + JCVEXB
+IKE = KLEV - JCVEXT
+!
+!
+!* 1. Determine vertical index for 500 hPa levels
+! ------------------------------------------
+!
+!
+IP500(:) = IKB
+DO JK = IKB, IKE
+ WHERE ( PPRES(:,JK) >= 500.E2 ) IP500(:) = JK
+END DO
+!
+!
+!* 2. Compute convective time step
+! ----------------------------
+!
+ ! compute wind speed at LCL, 500 hPa, CTL
+
+DO JI = 1, IIE
+ JKLC = KLCL(JI)
+ JKP5 = IP500(JI)
+ JKCT = KCTL(JI)
+ ZWORK1(JI) = SQRT( PU(JI,JKLC) * PU(JI,JKLC) + &
+ PV(JI,JKLC) * PV(JI,JKLC) )
+ ZWORK2(JI) = SQRT( PU(JI,JKP5) * PU(JI,JKP5) + &
+ PV(JI,JKP5) * PV(JI,JKP5) )
+ ZWORK3(JI) = SQRT( PU(JI,JKCT) * PU(JI,JKCT) + &
+ PV(JI,JKCT) * PV(JI,JKCT) )
+END DO
+!
+ZWORK2(:) = MAX( 0.1, 0.5 * ( ZWORK1(:) + ZWORK2(:) ) )
+!
+PTIMEA(:) = SQRT( PDXDY(:) ) / ZWORK2(:)
+!
+!
+!* 3. Compute precipitation efficiency
+! -----------------------------------
+!
+!* 3.1 Precipitation efficiency as a function of wind shear
+! ----------------------------------------------------
+!
+ZWORK2(:) = SIGN( 1., ZWORK3(:) - ZWORK1(:) )
+DO JI = 1, IIE
+ JKLC = KLCL(JI)
+ JKCT = KCTL(JI)
+ ZWORK1(JI) = ( PU(JI,JKCT) - PU(JI,JKLC) ) * &
+ ( PU(JI,JKCT) - PU(JI,JKLC) ) + &
+ ( PV(JI,JKCT) - PV(JI,JKLC) ) * &
+ ( PV(JI,JKCT) - PV(JI,JKLC) )
+ ZWORK1(JI) = 1.E3 * ZWORK2(JI) * SQRT( ZWORK1(JI) ) / &
+ MAX( 1.E-2, PZ(JI,JKCT) - PZ(JI,JKLC) )
+END DO
+!
+PPREF(:) = 1.591 + ZWORK1(:) * ( -.639 + ZWORK1(:) * ( &
+ 9.53E-2 - ZWORK1(:) * 4.96E-3 ) )
+PPREF(:) = MAX( .4, MIN( PPREF(:), .9 ) )
+!
+!* 3.2 Precipitation efficiency as a function of cloud base height
+! ----------------------------------------------------------
+!
+DO JI = 1, IIE
+ JKLC = KLCL(JI)
+ ZCBH(JI) = MAX( 3., ( PZ(JI,JKLC) - PZ(JI,IKB) ) * 3.281E-3 )
+END DO
+ZWORK1(:) = .9673 + ZCBH(:) * ( -.7003 + ZCBH(:) * ( .1622 + &
+ ZCBH(:) * ( -1.2570E-2 + ZCBH(:) * ( 4.2772E-4 - &
+ ZCBH(:) * 5.44E-6 ) ) ) )
+ZWORK1(:) = MAX( .4, MIN( .9, 1./ ( 1. + ZWORK1(:) ) ) )
+!
+!* 3.3 Mean precipitation efficiency is used to compute rainfall
+! ----------------------------------------------------------
+!
+PPREF(:) = 0.5 * ( PPREF(:) + ZWORK1(:) )
+!
+!
+END SUBROUTINE CONVECT_TSTEP_PREF
diff --git a/src/mesonh/conv/convect_updraft.f90 b/src/mesonh/conv/convect_updraft.f90
new file mode 100644
index 000000000..d860b6240
--- /dev/null
+++ b/src/mesonh/conv/convect_updraft.f90
@@ -0,0 +1,641 @@
+!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! #################
+ MODULE MODI_CONVECT_UPDRAFT
+! #################
+!
+INTERFACE
+!
+ SUBROUTINE CONVECT_UPDRAFT( KLON, KLEV, &
+ KICE, PPRES, PDPRES, PZ, PTHL, PTHV, PTHES, PRW, &
+ PTHLCL, PTLCL, PRVLCL, PWLCL, PZLCL, PTHVELCL, &
+ PMFLCL, OTRIG, KLCL, KDPL, KPBL, &
+ PUMF, PUER, PUDR, PUTHL, PUTHV, PURW, &
+ PURC, PURI, PURR, PURS, PUPR, &
+ PUTPR, PCAPE, KCTL, KETL, PUTT )
+!
+INTEGER, INTENT(IN) :: KLON ! horizontal dimension
+INTEGER, INTENT(IN) :: KLEV ! vertical dimension
+INTEGER, INTENT(IN) :: KICE ! flag for ice ( 1 = yes,
+ ! 0 = no ice )
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTHL ! grid scale enthalpy (J/kg)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTHV ! grid scale theta_v
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTHES ! grid scale saturated theta_e
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRW ! grid scale total water
+ ! mixing ratio
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PPRES ! pressure (P)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PDPRES! pressure difference between
+ ! bottom and top of layer (Pa)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PZ ! height of model layer (m)
+REAL, DIMENSION(KLON), INTENT(IN) :: PTHLCL ! theta at LCL
+REAL, DIMENSION(KLON), INTENT(IN) :: PTLCL ! temp. at LCL
+REAL, DIMENSION(KLON), INTENT(IN) :: PRVLCL ! vapor mixing ratio at LCL
+REAL, DIMENSION(KLON), INTENT(IN) :: PWLCL ! parcel velocity at LCL (m/s)
+REAL, DIMENSION(KLON), INTENT(IN) :: PMFLCL ! cloud base unit mass flux
+ ! (kg/s)
+REAL, DIMENSION(KLON), INTENT(IN) :: PZLCL ! height at LCL (m)
+REAL, DIMENSION(KLON), INTENT(IN) :: PTHVELCL ! environm. theta_v at LCL (K)
+LOGICAL, DIMENSION(KLON), INTENT(INOUT):: OTRIG! logical mask for convection
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KLCL ! contains vert. index of LCL
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KDPL ! contains vert. index of DPL
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KPBL ! " vert. index of source layertop
+!
+!
+INTEGER, DIMENSION(KLON), INTENT(OUT):: KCTL ! contains vert. index of CTL
+INTEGER, DIMENSION(KLON), INTENT(OUT):: KETL ! contains vert. index of &
+ !equilibrium (zero buoyancy) level
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PUMF ! updraft mass flux (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PUER ! updraft entrainment (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PUDR ! updraft detrainment (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PUTHL ! updraft enthalpy (J/kg)
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PUTHV ! updraft theta_v (K)
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PUTT ! updraft temperature(K)
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PURW ! updraft total water (kg/kg)
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PURC ! updraft cloud water (kg/kg)
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PURI ! updraft cloud ice (kg/kg)
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PURR ! liquid precipit. (kg/kg)
+ ! produced in model layer
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT)::PURS ! solid precipit. (kg/kg)
+ ! produced in model layer
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT)::PUPR ! updraft precipitation in
+ ! flux units (kg water / s)
+REAL, DIMENSION(KLON), INTENT(OUT):: PUTPR ! total updraft precipitation
+ ! in flux units (kg water / s)
+REAL, DIMENSION(KLON), INTENT(OUT):: PCAPE ! available potent. energy
+!
+END SUBROUTINE CONVECT_UPDRAFT
+!
+END INTERFACE
+!
+END MODULE MODI_CONVECT_UPDRAFT
+! ##########################################################################
+ SUBROUTINE CONVECT_UPDRAFT( KLON, KLEV, &
+ KICE, PPRES, PDPRES, PZ, PTHL, PTHV, PTHES, PRW, &
+ PTHLCL, PTLCL, PRVLCL, PWLCL, PZLCL, PTHVELCL, &
+ PMFLCL, OTRIG, KLCL, KDPL, KPBL, &
+ PUMF, PUER, PUDR, PUTHL, PUTHV, PURW, &
+ PURC, PURI, PURR, PURS, PUPR, &
+ PUTPR, PCAPE, KCTL, KETL, PUTT )
+! ##########################################################################
+!
+!!**** Compute updraft properties from DPL to CTL.
+!!
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to determine updraft properties
+!! ( mass flux, thermodynamics, precipitation )
+!!
+!!
+!!** METHOD
+!! ------
+!! Computations are done at every model level starting from bottom.
+!! The use of masks allows to optimise the inner loops (horizontal loops).
+!!
+!!
+!!
+!! EXTERNAL
+!! --------
+!! Routine CONVECT_MIXING_FUNCT
+!! Routine CONVECT_CONDENS
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST
+!! XG ! gravity constant
+!! XP00 ! reference pressure
+!! XRD, XRV ! gaz constants for dry air and water vapor
+!! XCPD, XCPV, XCL ! Cp of dry air, water vapor and liquid water
+!! XTT ! triple point temperature
+!! XLVTT ! vaporisation heat at XTT
+!!
+!!
+!! Module MODD_CONVPAR
+!! XA25 ! reference grid area
+!! XCRAD ! cloud radius
+!! XCDEPTH ! minimum necessary cloud depth
+!! XENTR ! entrainment constant
+!! XRCONV ! constant in precipitation conversion
+!! XNHGAM ! coefficient for buoyancy term in w eq.
+!! ! accounting for nh-pressure
+!! XTFRZ1 ! begin of freezing interval
+!! XTFRZ2 ! begin of freezing interval
+!!
+!! Module MODD_CONVPAREXT
+!! JCVEXB, JCVEXT ! extra levels on the vertical boundaries
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Book1,2 of documentation ( routine CONVECT_UPDRAFT)
+!! Kain and Fritsch, 1990, J. Atmos. Sci., Vol.
+!! Kain and Fritsch, 1993, Meteor. Monographs, Vol.
+!!
+!! AUTHOR
+!! ------
+!! P. BECHTOLD * Laboratoire d'Aerologie *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 07/11/95
+!! Last modified 10/12/97
+!! V.Masson, C.Lac, Sept. 2010 : Correction of a loop for reproducibility
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_CONVPAR
+USE MODD_CONVPAREXT
+!
+USE MODI_CONVECT_CONDENS
+USE MODI_CONVECT_MIXING_FUNCT
+!
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KLON ! horizontal dimension
+INTEGER, INTENT(IN) :: KLEV ! vertical dimension
+INTEGER, INTENT(IN) :: KICE ! flag for ice ( 1 = yes,
+ ! 0 = no ice )
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTHL ! grid scale enthalpy (J/kg)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTHV ! grid scale theta_v
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTHES ! grid scale saturated theta_e
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRW ! grid scale total water
+ ! mixing ratio
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PPRES ! pressure (P)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PDPRES! pressure difference between
+ ! bottom and top of layer (Pa)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PZ ! height of model layer (m)
+REAL, DIMENSION(KLON), INTENT(IN) :: PTHLCL ! theta at LCL
+REAL, DIMENSION(KLON), INTENT(IN) :: PTLCL ! temp. at LCL
+REAL, DIMENSION(KLON), INTENT(IN) :: PRVLCL ! vapor mixing ratio at LCL
+REAL, DIMENSION(KLON), INTENT(IN) :: PWLCL ! parcel velocity at LCL (m/s)
+REAL, DIMENSION(KLON), INTENT(IN) :: PMFLCL ! cloud base unit mass flux
+ ! (kg/s)
+REAL, DIMENSION(KLON), INTENT(IN) :: PZLCL ! height at LCL (m)
+REAL, DIMENSION(KLON), INTENT(IN) :: PTHVELCL ! environm. theta_v at LCL (K)
+LOGICAL, DIMENSION(KLON), INTENT(INOUT):: OTRIG! logical mask for convection
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KLCL ! contains vert. index of LCL
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KDPL ! contains vert. index of DPL
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KPBL ! " vert. index of source layertop
+!
+!
+INTEGER, DIMENSION(KLON), INTENT(OUT):: KCTL ! contains vert. index of CTL
+INTEGER, DIMENSION(KLON), INTENT(OUT):: KETL ! contains vert. index of &
+ !equilibrium (zero buoyancy) level
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PUMF ! updraft mass flux (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PUER ! updraft entrainment (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PUDR ! updraft detrainment (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PUTHL ! updraft enthalpy (J/kg)
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PUTHV ! updraft theta_v (K)
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PUTT ! updraft temperature(K)
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PURW ! updraft total water (kg/kg)
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PURC ! updraft cloud water (kg/kg)
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PURI ! updraft cloud ice (kg/kg)
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PURR ! liquid precipit. (kg/kg)
+ ! produced in model layer
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT)::PURS ! solid precipit. (kg/kg)
+ ! produced in model layer
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT)::PUPR ! updraft precipitation in
+ ! flux units (kg water / s)
+REAL, DIMENSION(KLON), INTENT(OUT):: PUTPR ! total updraft precipitation
+ ! in flux units (kg water / s)
+REAL, DIMENSION(KLON), INTENT(OUT):: PCAPE ! available potent. energy
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IIE, IKB, IKE ! horizontal and vertical loop bounds
+INTEGER :: JI ! horizontal loop index
+INTEGER :: JK, JKP, JKM, JK1, JK2, JKMIN ! vertical loop index
+REAL :: ZEPSA ! R_v / R_d, C_pv / C_pd
+REAL :: ZRDOCP ! C_pd / R_d, R_d / C_pd
+!
+REAL, DIMENSION(KLON) :: ZUT ! updraft temperature (K)
+REAL, DIMENSION(KLON) :: ZUW1, ZUW2 ! square of updraft vert.
+ ! velocity at levels k and k+1
+REAL, DIMENSION(KLON) :: ZE1,ZE2,ZD1,ZD2 ! fractional entrainm./detrain
+ ! rates at levels k and k+1
+REAL, DIMENSION(KLON) :: ZMIXF ! critical mixed fraction
+REAL, DIMENSION(KLON) :: ZCPH ! specific heat C_ph
+REAL, DIMENSION(KLON) :: ZLV, ZLS ! latent heat of vaporis., sublim.
+REAL, DIMENSION(KLON) :: ZURV ! updraft water vapor at level k+1
+REAL, DIMENSION(KLON) :: ZPI ! Pi=(P0/P)**(Rd/Cpd)
+REAL, DIMENSION(KLON) :: ZTHEUL ! theta_e for undilute ascent
+REAL, DIMENSION(KLON) :: ZWORK1, ZWORK2, ZWORK3, ZWORK4, ZWORK5, &
+ ZWORK6 ! work arrays
+INTEGER, DIMENSION(KLON) :: IWORK ! wok array
+LOGICAL, DIMENSION(KLON) :: GWORK1, GWORK2, GWORK4
+ ! work arrays
+LOGICAL, DIMENSION(KLON,KLEV) :: GWORK6 ! work array
+!
+!
+!-------------------------------------------------------------------------------
+!
+! 0.3 Set loop bounds
+! ---------------
+!
+IKB = 1 + JCVEXB
+IKE = KLEV - JCVEXT
+IIE = KLON
+!
+!
+!* 1. Initialize updraft properties and local variables
+! -------------------------------------------------
+!
+ZEPSA = XRV / XRD
+ZRDOCP = XRD / XCPD
+!
+PUMF(:,:) = 0.
+PUER(:,:) = 0.
+PUDR(:,:) = 0.
+PUTHL(:,:) = 0.
+PUTHV(:,:) = 0.
+PUTT(:,:) = 0.
+PURW(:,:) = 0.
+PURC(:,:) = 0.
+PURI(:,:) = 0.
+PUPR(:,:) = 0.
+PURR(:,:) = 0.
+PURS(:,:) = 0.
+PUTPR(:) = 0.
+ZUW1(:) = PWLCL(:) * PWLCL(:)
+ZUW2(:) = 0.
+ZE1(:) = 1.
+ZD1(:) = 0.
+PCAPE(:) = 0.
+KCTL(:) = IKB
+KETL(:) = KLCL(:)
+GWORK2(:) = .TRUE.
+ZPI(:) = 1.
+ZWORK3(:) = 0.
+ZWORK4(:) = 0.
+ZWORK5(:) = 0.
+ZWORK6(:) = 0.
+GWORK1(:) = .FALSE.
+GWORK4(:) = .FALSE.
+!
+!
+!* 1.1 Compute undilute updraft theta_e for CAPE computations
+! Bolton (1980) formula.
+! Define accurate enthalpy for updraft
+! -----------------------------------------------------
+!
+ZTHEUL(:) = PTLCL(:) * ( PTHLCL(:) / PTLCL(:) ) ** ( 1. - 0.28 * PRVLCL(:) ) &
+ * EXP( ( 3374.6525 / PTLCL(:) - 2.5403 ) * &
+ PRVLCL(:) * ( 1. + 0.81 * PRVLCL(:) ) )
+!
+!
+ZWORK1(:) = ( XCPD + PRVLCL(:) * XCPV ) * PTLCL(:) &
+ + ( 1. + PRVLCL(:) ) * XG * PZLCL(:)
+!
+!
+!* 2. Set updraft properties between DPL and LCL
+! ------------------------------------------
+!
+JKP = MAXVAL( KLCL(:) )
+JKM = MINVAL( KDPL(:) )
+DO JK = JKM, JKP
+ DO JI = 1, IIE
+ IF ( JK >= KDPL(JI) .AND. JK < KLCL(JI) ) THEN
+ PUMF(JI,JK) = PMFLCL(JI)
+ PUTHL(JI,JK) = ZWORK1(JI)
+ PUTHV(JI,JK) = PTHLCL(JI) * ( 1. + ZEPSA * PRVLCL(JI) ) / &
+ ( 1. + PRVLCL(JI) )
+ PURW(JI,JK) = PRVLCL(JI)
+ END IF
+ END DO
+END DO
+!
+!
+!* 3. Enter loop for updraft computations
+! ------------------------------------
+!
+! Correction for reproduciblity
+!JKMIN = MINVAL( KLCL(:) ) - 1
+JKMIN = MINVAL( KLCL(:) ) - 2
+DO JK = MAX( IKB + 1, JKMIN ), IKE - 1
+ ZWORK6(:) = 1.
+ JKP = JK + 1
+!
+ GWORK4(:) = JK >= KLCL(:) - 1
+ GWORK1(:) = GWORK4(:) .AND. GWORK2(:) ! this mask is used to confine
+ ! updraft computations between the LCL and the CTL
+!
+ WHERE( JK == KLCL(:) - 1 ) ZWORK6(:) = 0. ! factor that is used in buoyancy
+ ! computation at first level above LCL
+!
+!
+!* 4. Estimate condensate, L_v L_i, Cph and theta_v at level k+1
+! ----------------------------------------------------------
+!
+ ZWORK1(:) = PURC(:,JK) + PURR(:,JK)
+ ZWORK2(:) = PURI(:,JK) + PURS(:,JK)
+ CALL CONVECT_CONDENS( KLON, KICE, PPRES(:,JKP), PUTHL(:,JK), PURW(:,JK),&
+ ZWORK1, ZWORK2, PZ(:,JKP), GWORK1, ZUT, ZURV, &
+ PURC(:,JKP), PURI(:,JKP), ZLV, ZLS, ZCPH )
+!
+!
+ ZPI(:) = ( XP00 / PPRES(:,JKP) ) ** ZRDOCP
+ WHERE ( GWORK1(:) )
+!
+ PUTHV(:,JKP) = ZPI(:) * ZUT(:) * ( 1. + ZEPSA * ZURV(:) ) &
+ / ( 1. + PURW(:,JK) )
+ PUTT(:,JKP) = ZUT(:)
+!
+!
+!* 5. Compute square of vertical velocity using entrainment
+! at level k
+! -----------------------------------------------------
+!
+ ZWORK3(:) = PZ(:,JKP) - PZ(:,JK) * ZWORK6(:) - &
+ ( 1. - ZWORK6(:) ) * PZLCL(:) ! level thickness
+ ZWORK4(:) = PTHV(:,JK) * ZWORK6(:) + &
+ ( 1. - ZWORK6(:) ) * PTHVELCL(:)
+ ZWORK5(:) = 2. * ZUW1(:) * PUER(:,JK) / MAX( .1, PUMF(:,JK) )
+ ZUW2(:) = ZUW1(:) + ZWORK3(:) * XNHGAM * XG * &
+ ( ( PUTHV(:,JK) + PUTHV(:,JKP) ) / &
+ ( ZWORK4(:) + PTHV(:,JKP) ) - 1. ) & ! buoyancy term
+ - ZWORK5(:) ! entrainment term
+!
+!
+!* 6. Update total precipitation: dr_r=(r_c+r_i)*exp(-rate*dz)
+! --------------------------------------------------------
+!
+! compute level mean vertical velocity
+ ZWORK2(:) = 0.5 * &
+ ( SQRT( MAX( 1.E-2, ZUW2(:) ) ) + &
+ SQRT( MAX( 1.E-2, ZUW1(:) ) ) )
+ PURR(:,JKP) = 0.5 * ( PURC(:,JK) + PURC(:,JKP) + PURI(:,JK) + PURI(:,JKP) )&
+ * ( 1. - EXP( - XRCONV * ZWORK3(:) / ZWORK2(:) ) )
+ PUPR(:,JKP) = PURR(:,JKP) * PUMF(:,JK) ! precipitation rate ( kg water / s)
+ PUTPR(:) = PUTPR(:) + PUPR(:,JKP) ! total precipitation rate
+ ZWORK2(:) = PURR(:,JKP) / MAX( 1.E-8, PURC(:,JKP) + PURI(:,JKP) )
+ PURR(:,JKP) = ZWORK2(:) * PURC(:,JKP) ! liquid precipitation
+ PURS(:,JKP) = ZWORK2(:) * PURI(:,JKP) ! solid precipitation
+!
+!
+!* 7. Update r_c, r_i, enthalpy, r_w for precipitation
+! -------------------------------------------------------
+!
+ PURW(:,JKP) = PURW(:,JK) - PURR(:,JKP) - PURS(:,JKP)
+ PURC(:,JKP) = PURC(:,JKP) - PURR(:,JKP)
+ PURI(:,JKP) = PURI(:,JKP) - PURS(:,JKP)
+ PUTHL(:,JKP) = ( XCPD + PURW(:,JKP) * XCPV ) * ZUT(:) &
+ + ( 1. + PURW(:,JKP) ) * XG * PZ(:,JKP) &
+ - ZLV(:) * PURC(:,JKP) - ZLS(:) * PURI(:,JKP)
+!
+ ZUW1(:) = ZUW2(:)
+!
+ END WHERE
+!
+!
+!* 8. Compute entrainment and detrainment using conservative
+! variables adjusted for precipitation ( not for entrainment)
+! -----------------------------------------------------------
+!
+!* 8.1 Compute critical mixed fraction by estimating unknown
+! T^mix r_c^mix and r_i^mix from enthalpy^mix and r_w^mix
+! We determine the zero crossing of the linear curve
+! evaluating the derivative using ZMIXF=0.1.
+! -----------------------------------------------------
+!
+ ZMIXF(:) = 0.1 ! starting value for critical mixed fraction
+ ZWORK1(:) = ZMIXF(:) * PTHL(:,JKP) &
+ + ( 1. - ZMIXF(:) ) * PUTHL(:,JKP) ! mixed enthalpy
+ ZWORK2(:) = ZMIXF(:) * PRW(:,JKP) &
+ + ( 1. - ZMIXF(:) ) * PURW(:,JKP) ! mixed r_w
+!
+ CALL CONVECT_CONDENS( KLON, KICE, PPRES(:,JKP), ZWORK1, ZWORK2, &
+ PURC(:,JKP), PURI(:,JKP), PZ(:,JKP), GWORK1, ZUT,&
+ ZWORK3, ZWORK4, ZWORK5, ZLV, ZLS, ZCPH )
+! put in enthalpy and r_w and get T r_c, r_i (ZUT, ZWORK4-5)
+!
+ ! compute theta_v of mixture
+ ZWORK3(:) = ZUT(:) * ZPI(:) * ( 1. + ZEPSA * ( &
+ ZWORK2(:) - ZWORK4(:) - ZWORK5(:) ) ) / ( 1. + ZWORK2(:) )
+ ! compute final value of critical mixed fraction using theta_v
+ ! of mixture, grid-scale and updraft
+ ZMIXF(:) = MAX( 0., PUTHV(:,JKP) - PTHV(:,JKP) ) * ZMIXF(:) / &
+ ( PUTHV(:,JKP) - ZWORK3(:) + 1.E-10 )
+ ZMIXF(:) = MAX( 0., MIN( 1., ZMIXF(:) ) )
+!
+!
+!* 8.2 Compute final midlevel values for entr. and detrainment
+! after call of distribution function
+! -------------------------------------------------------
+!
+!
+ CALL CONVECT_MIXING_FUNCT ( KLON, ZMIXF, 1, ZE2, ZD2 )
+! Note: routine MIXING_FUNCT returns fractional entrainm/detrainm. rates
+!
+! ZWORK1(:) = XENTR * PMFLCL(:) * PDPRES(:,JKP) / XCRAD ! rate of env. inflow
+!*MOD
+ zwork1(:) = xentr * xg / xcrad * pumf(:,jk) * ( pz(:,jkp) - pz(:,jk) )
+! ZWORK1(:) = XENTR * pumf(:,jk) * PDPRES(:,JKP) / XCRAD ! rate of env. inflow
+!*MOD
+ ZWORK2(:) = 0.
+ WHERE ( GWORK1(:) ) ZWORK2(:) = 1.
+ ZE2(:) = .5; ZD2(:) = .6 ! set entrainment=detrainment for better
+ ! mass flux profiles in deep continental convection
+ WHERE ( PUTHV(:,JKP) > PTHV(:,JKP) )
+ PUER(:,JKP) = 0.5 * ZWORK1(:) * ( ZE1(:) + ZE2(:) ) * ZWORK2(:)
+ PUDR(:,JKP) = 0.5 * ZWORK1(:) * ( ZD1(:) + ZD2(:) ) * ZWORK2(:)
+ ELSEWHERE
+ PUER(:,JKP) = 0.
+ PUDR(:,JKP) = ZWORK1(:) * ZWORK2(:)
+ END WHERE
+!
+!* 8.3 Determine equilibrium temperature level
+! --------------------------------------
+!
+ WHERE ( PUTHV(:,JKP) > PTHV(:,JKP) .AND. JK > KLCL(:) + 1 &
+ .AND. GWORK1(:) )
+ KETL(:) = JKP ! equilibrium temperature level
+ END WHERE
+!
+!* 8.4 If the calculated detrained mass flux is greater than
+! the total updraft mass flux, or vertical velocity is
+! negative, all cloud mass detrains at previous model level,
+! exit updraft calculations - CTL is attained
+! -------------------------------------------------------
+!
+ WHERE( GWORK1(:) ) &
+ GWORK2(:) = PUMF(:,JK) - PUDR(:,JKP) > 10. .AND. ZUW2(:) > 0.
+ WHERE ( GWORK2(:) ) KCTL(:) = JKP ! cloud top level
+!!!! Correction Bug C.Lac 30/10/08 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ KCTL(:) = MIN( KCTL(:), IKE-1 )
+ GWORK1(:) = GWORK2(:) .AND. GWORK4(:)
+!
+ IF ( COUNT( GWORK2(:) ) == 0 ) EXIT
+!
+!
+!* 9. Compute CAPE for undilute ascent using theta_e and
+! theta_es instead of theta_v. This estimation produces
+! a significantly larger value for CAPE than the actual one.
+! ----------------------------------------------------------
+!
+ WHERE ( GWORK1(:) )
+!
+ ZWORK3(:) = PZ(:,JKP) - PZ(:,JK) * ZWORK6(:) - &
+ ( 1. - ZWORK6(:) ) * PZLCL(:) ! level thickness
+ ZWORK2(:) = PTHES(:,JK) + ( 1. - ZWORK6(:) ) * &
+ ( PTHES(:,JKP) - PTHES(:,JK) ) / ( PZ(:,JKP) - PZ(:,JK) ) * &
+ ( PZLCL(:) - PZ(:,JK) ) ! linear interpolation for theta_es at LCL
+ ! ( this is only done for model level just above LCL
+!
+ ZWORK1(:) = ( 2. * ZTHEUL(:) ) / ( ZWORK2(:) + PTHES(:,JKP) ) - 1.
+ PCAPE(:) = PCAPE(:) + XG * ZWORK3(:) * MAX( 0., ZWORK1(:) )
+!
+!
+!* 10. Compute final values of updraft mass flux, enthalpy, r_w
+! at level k+1
+! --------------------------------------------------------
+!
+ PUMF(:,JKP) = PUMF(:,JK) - PUDR(:,JKP) + PUER(:,JKP)
+ PUMF(:,JKP) = MAX( PUMF(:,JKP), 0.1 )
+ PUTHL(:,JKP) = ( PUMF(:,JK) * PUTHL(:,JK) + &
+ PUER(:,JKP) * PTHL(:,JK) - PUDR(:,JKP) * PUTHL(:,JK) ) &
+ / PUMF(:,JKP) + PUTHL(:,JKP) - PUTHL(:,JK)
+ PURW(:,JKP) = ( PUMF(:,JK) * PURW(:,JK) + &
+ PUER(:,JKP) * PRW(:,JK) - PUDR(:,JKP) * PURW(:,JK) ) &
+ / PUMF(:,JKP) - PURR(:,JKP) - PURS(:,JKP)
+!
+!
+ ZE1(:) = ZE2(:) ! update fractional entrainment/detrainment
+ ZD1(:) = ZD2(:)
+!
+ END WHERE
+!
+END DO
+!
+!* 12.1 Set OTRIG to False if cloud thickness < XCDEPTH
+! or CAPE < 1
+! ------------------------------------------------
+!
+ DO JI = 1, IIE
+ JK = KCTL(JI)
+ OTRIG(JI) = PZ(JI,JK) - PZLCL(JI) >= XCDEPTH &
+ .AND. PCAPE(JI) > 1.
+ END DO
+ WHERE( .NOT. OTRIG(:) )
+ KCTL(:) = IKB
+ END WHERE
+KETL(:) = MAX( KETL(:), KLCL(:) + 2 )
+KETL(:) = MIN( KETL(:), KCTL(:) )
+!
+!
+!* 12.2 If the ETL and CTL are the same detrain updraft mass
+! flux at this level
+! -------------------------------------------------------
+!
+ZWORK1(:) = 0.
+WHERE ( KETL(:) == KCTL(:) ) ZWORK1(:) = 1.
+!
+DO JI = 1, IIE
+ JK = KETL(JI)
+ PUDR(JI,JK) = PUDR(JI,JK) + &
+ ( PUMF(JI,JK) - PUER(JI,JK) ) * ZWORK1(JI)
+ PUER(JI,JK) = PUER(JI,JK) * ( 1. - ZWORK1(JI) )
+ PUMF(JI,JK) = PUMF(JI,JK) * ( 1. - ZWORK1(JI) )
+ JKP = KCTL(JI) + 1
+ PUER(JI,JKP) = 0. ! entrainm/detr rates have been already computed
+ PUDR(JI,JKP) = 0. ! at level KCTL+1, set them to zero
+ PURW(JI,JKP) = 0.
+ PURC(JI,JKP) = 0.
+ PURI(JI,JKP) = 0.
+ PUTHL(JI,JKP) = 0.
+ PURI(JI,JKP+1)= 0.
+ PURC(JI,JKP+1)= 0.
+END DO
+!
+!* 12.3 Adjust mass flux profiles, detrainment rates, and
+! precipitation fallout rates to reflect linear decrease
+! in mass flux between the ETL and CTL
+! -------------------------------------------------------
+!
+ZWORK1(:) = 0.
+JK1 = MINVAL( KETL(:) )
+JK2 = MAXVAL( KCTL(:) )
+DO JK = JK1, JK2
+ DO JI = 1, IIE
+ IF( JK > KETL(JI) .AND. JK <= KCTL(JI) ) THEN
+ ZWORK1(JI) = ZWORK1(JI) + PDPRES(JI,JK)
+ END IF
+ END DO
+END DO
+!
+DO JI = 1, IIE
+ JK = KETL(JI)
+ ZWORK1(JI) = PUMF(JI,JK) / MAX( 1., ZWORK1(JI) )
+END DO
+!
+DO JK = JK1 + 1, JK2
+ JKP = JK - 1
+ DO JI = 1, IIE
+ IF ( JK > KETL(JI) .AND. JK <= KCTL(JI) ) THEN
+ ! PUTPR(JI) = PUTPR(JI) - ( PURR(JI,JK) + PURS(JI,JK) ) * PUMF(JI,JKP)
+ PUTPR(JI) = PUTPR(JI) - PUPR(JI,JK)
+ PUDR(JI,JK) = PDPRES(JI,JK) * ZWORK1(JI)
+ PUMF(JI,JK) = PUMF(JI,JKP) - PUDR(JI,JK)
+ PUPR(JI,JK) = PUMF(JI,JKP) * ( PURR(JI,JK) + PURS(JI,JK) )
+ PUTPR(JI) = PUTPR(JI) + PUPR(JI,JK)
+ END IF
+ END DO
+END DO
+!
+! 12.4 Set mass flux and entrainment in the source layer.
+! Linear increase throughout the source layer.
+! -------------------------------------------------------
+!
+!IWORK(:) = MIN( KPBL(:), KLCL(:) - 1 )
+IWORK(:) = KPBL(:)
+DO JI = 1, IIE
+ JK = KDPL(JI)
+ JKP = IWORK(JI)
+! mixed layer depth
+ ZWORK2(JI) = PPRES(JI,JK) - PPRES(JI,JKP) + PDPRES(JI,JK)
+END DO
+!
+JKP = MAXVAL( IWORK(:) )
+DO JK = JKM, JKP
+ DO JI = 1, IIE
+ IF ( JK >= KDPL(JI) .AND. JK <= IWORK(JI) ) THEN
+ PUER(JI,JK) = PUER(JI,JK) + PMFLCL(JI) * PDPRES(JI,JK) / ( ZWORK2(JI) + 0.1 )
+ PUMF(JI,JK) = PUMF(JI,JK-1) + PUER(JI,JK)
+ END IF
+ END DO
+END DO
+!
+!
+!* 13. If cloud thickness is smaller than 3 km, no
+! convection is allowed
+! Nota: For technical reasons, we stop the convection
+! computations in this case and do not go back to
+! TRIGGER_FUNCT to look for the next unstable LCL
+! which could produce a thicker cloud.
+! ---------------------------------------------------
+!
+GWORK6(:,:) = SPREAD( OTRIG(:), DIM=2, NCOPIES=KLEV )
+WHERE ( .NOT. OTRIG(:) ) PUTPR(:) = 0.
+WHERE ( .NOT. GWORK6(:,:) )
+ PUMF(:,:) = 0.
+ PUDR(:,:) = 0.
+ PUER(:,:) = 0.
+ PUTHL(:,:) = PTHL(:,:)
+ PURW(:,:) = PRW(:,:)
+ PUPR(:,:) = 0.
+ PURC(:,:) = 0.
+ PURI(:,:) = 0.
+ PURR(:,:) = 0.
+ PURS(:,:) = 0.
+END WHERE
+!
+END SUBROUTINE CONVECT_UPDRAFT
diff --git a/src/mesonh/conv/convect_updraft_shal.f90 b/src/mesonh/conv/convect_updraft_shal.f90
new file mode 100644
index 000000000..c7e53eb86
--- /dev/null
+++ b/src/mesonh/conv/convect_updraft_shal.f90
@@ -0,0 +1,598 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 conv 2006/05/18 13:07:25
+!-----------------------------------------------------------------
+! #################
+ MODULE MODI_CONVECT_UPDRAFT_SHAL
+! #################
+!
+INTERFACE
+!
+ SUBROUTINE CONVECT_UPDRAFT_SHAL( KLON, KLEV, &
+ KICE, PPRES, PDPRES, PZ, PTHL, PTHV, PTHES, PRW,&
+ PTHLCL, PTLCL, PRVLCL, PWLCL, PZLCL, PTHVELCL, &
+ PMFLCL, OTRIG, KLCL, KDPL, KPBL, &
+ PUMF, PUER, PUDR, PUTHL, PUTHV, PURW, &
+ PURC, PURI, PCAPE, KCTL, KETL )
+!
+INTEGER, INTENT(IN) :: KLON ! horizontal dimension
+INTEGER, INTENT(IN) :: KLEV ! vertical dimension
+INTEGER, INTENT(IN) :: KICE ! flag for ice ( 1 = yes,
+ ! 0 = no ice )
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTHL ! grid scale enthalpy (J/kg)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTHV ! grid scale theta_v
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTHES ! grid scale saturated theta_e
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRW ! grid scale total water
+ ! mixing ratio
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PPRES ! pressure (P)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PDPRES! pressure difference between
+ ! bottom and top of layer (Pa)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PZ ! height of model layer (m)
+REAL, DIMENSION(KLON), INTENT(IN) :: PTHLCL ! theta at LCL
+REAL, DIMENSION(KLON), INTENT(IN) :: PTLCL ! temp. at LCL
+REAL, DIMENSION(KLON), INTENT(IN) :: PRVLCL ! vapor mixing ratio at LCL
+REAL, DIMENSION(KLON), INTENT(IN) :: PWLCL ! parcel velocity at LCL (m/s)
+REAL, DIMENSION(KLON), INTENT(IN) :: PMFLCL ! cloud base unit mass flux
+ ! (kg/s)
+REAL, DIMENSION(KLON), INTENT(IN) :: PZLCL ! height at LCL (m)
+REAL, DIMENSION(KLON), INTENT(IN) :: PTHVELCL ! environm. theta_v at LCL (K)
+LOGICAL, DIMENSION(KLON), INTENT(INOUT):: OTRIG! logical mask for convection
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KLCL ! contains vert. index of LCL
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KDPL ! contains vert. index of DPL
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KPBL ! " vert. index of source layertop
+!
+!
+INTEGER, DIMENSION(KLON), INTENT(OUT):: KCTL ! contains vert. index of CTL
+INTEGER, DIMENSION(KLON), INTENT(OUT):: KETL ! contains vert. index of &
+ !equilibrium (zero buoyancy) level
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PUMF ! updraft mass flux (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PUER ! updraft entrainment (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PUDR ! updraft detrainment (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PUTHL ! updraft enthalpy (J/kg)
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PUTHV ! updraft theta_v (K)
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PURW ! updraft total water (kg/kg)
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PURC ! updraft cloud water (kg/kg)
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PURI ! updraft cloud ice (kg/kg)
+REAL, DIMENSION(KLON), INTENT(OUT):: PCAPE ! available potent. energy
+!
+END SUBROUTINE CONVECT_UPDRAFT_SHAL
+!
+END INTERFACE
+!
+END MODULE MODI_CONVECT_UPDRAFT_SHAL
+! ###############################################################################
+ SUBROUTINE CONVECT_UPDRAFT_SHAL( KLON, KLEV, &
+ KICE, PPRES, PDPRES, PZ, PTHL, PTHV, PTHES, PRW,&
+ PTHLCL, PTLCL, PRVLCL, PWLCL, PZLCL, PTHVELCL, &
+ PMFLCL, OTRIG, KLCL, KDPL, KPBL, &
+ PUMF, PUER, PUDR, PUTHL, PUTHV, PURW, &
+ PURC, PURI, PCAPE, KCTL, KETL )
+! ###############################################################################
+!
+!!**** Compute updraft properties from DPL to CTL.
+!!
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to determine updraft properties
+!! ( mass flux, thermodynamics, precipitation )
+!!
+!!
+!!** METHOD
+!! ------
+!! Computations are done at every model level starting from bottom.
+!! The use of masks allows to optimise the inner loops (horizontal loops).
+!!
+!!
+!!
+!! EXTERNAL
+!! --------
+!! Routine CONVECT_MIXING_FUNCT
+!! Routine CONVECT_CONDENS
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST
+!! XG ! gravity constant
+!! XP00 ! reference pressure
+!! XRD, XRV ! gaz constants for dry air and water vapor
+!! XCPD, XCPV, XCL ! Cp of dry air, water vapor and liquid water
+!! XTT ! triple point temperature
+!! XLVTT ! vaporisation heat at XTT
+!!
+!!
+!! Module MODD_CONVPAR_SHAL
+!! XA25 ! reference grid area
+!! XCRAD ! cloud radius
+!! XCDEPTH ! minimum necessary cloud depth
+!! XENTR ! entrainment constant
+!! XNHGAM ! coefficient for buoyancy term in w eq.
+!! ! accounting for nh-pressure
+!! XTFRZ1 ! begin of freezing interval
+!! XTFRZ2 ! begin of freezing interval
+!!
+!! Module MODD_CONVPAREXT
+!! JCVEXB, JCVEXT ! extra levels on the vertical boundaries
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Book1,2 of documentation ( routine CONVECT_UPDRAFT)
+!! Kain and Fritsch, 1990, J. Atmos. Sci., Vol.
+!! Kain and Fritsch, 1993, Meteor. Monographs, Vol.
+!!
+!! AUTHOR
+!! ------
+!! P. BECHTOLD * Laboratoire d'Aerologie *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 07/11/95
+!! Last modified 10/12/97
+!! F. Bouyssel 05/11/08 Modifications for reproductibility
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_CONVPAR_SHAL
+USE MODD_CONVPAREXT
+USE MODI_CONVECT_CONDENS
+USE MODI_CONVECT_MIXING_FUNCT
+!
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KLON ! horizontal dimension
+INTEGER, INTENT(IN) :: KLEV ! vertical dimension
+INTEGER, INTENT(IN) :: KICE ! flag for ice ( 1 = yes,
+ ! 0 = no ice )
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTHL ! grid scale enthalpy (J/kg)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTHV ! grid scale theta_v
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTHES ! grid scale saturated theta_e
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRW ! grid scale total water
+ ! mixing ratio
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PPRES ! pressure (P)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PDPRES! pressure difference between
+ ! bottom and top of layer (Pa)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PZ ! height of model layer (m)
+REAL, DIMENSION(KLON), INTENT(IN) :: PTHLCL ! theta at LCL
+REAL, DIMENSION(KLON), INTENT(IN) :: PTLCL ! temp. at LCL
+REAL, DIMENSION(KLON), INTENT(IN) :: PRVLCL ! vapor mixing ratio at LCL
+REAL, DIMENSION(KLON), INTENT(IN) :: PWLCL ! parcel velocity at LCL (m/s)
+REAL, DIMENSION(KLON), INTENT(IN) :: PMFLCL ! cloud base unit mass flux
+ ! (kg/s)
+REAL, DIMENSION(KLON), INTENT(IN) :: PZLCL ! height at LCL (m)
+REAL, DIMENSION(KLON), INTENT(IN) :: PTHVELCL ! environm. theta_v at LCL (K)
+LOGICAL, DIMENSION(KLON), INTENT(INOUT):: OTRIG! logical mask for convection
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KLCL ! contains vert. index of LCL
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KDPL ! contains vert. index of DPL
+INTEGER, DIMENSION(KLON), INTENT(IN) :: KPBL ! " vert. index of source layertop
+!
+!
+INTEGER, DIMENSION(KLON), INTENT(OUT):: KCTL ! contains vert. index of CTL
+INTEGER, DIMENSION(KLON), INTENT(OUT):: KETL ! contains vert. index of &
+ !equilibrium (zero buoyancy) level
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PUMF ! updraft mass flux (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PUER ! updraft entrainment (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PUDR ! updraft detrainment (kg/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PUTHL ! updraft enthalpy (J/kg)
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PUTHV ! updraft theta_v (K)
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PURW ! updraft total water (kg/kg)
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PURC ! updraft cloud water (kg/kg)
+REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PURI ! updraft cloud ice (kg/kg)
+REAL, DIMENSION(KLON), INTENT(OUT):: PCAPE ! available potent. energy
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IIE, IKB, IKE ! horizontal and vertical loop bounds
+INTEGER :: JI ! horizontal loop index
+INTEGER :: JK, JKP, JKM, JK1, JK2 ! vertical loop index
+REAL :: ZEPSA ! R_v / R_d, C_pv / C_pd
+REAL :: ZRDOCP ! C_pd / R_d, R_d / C_pd
+!
+REAL, DIMENSION(KLON) :: ZUT ! updraft temperature (K)
+REAL, DIMENSION(KLON) :: ZUW1, ZUW2 ! square of updraft vert.
+ ! velocity at levels k and k+1
+REAL, DIMENSION(KLON) :: ZE1,ZE2,ZD1,ZD2 ! fractional entrainm./detrain
+ ! rates at levels k and k+1
+REAL, DIMENSION(KLON) :: ZMIXF ! critical mixed fraction
+REAL, DIMENSION(KLON) :: ZCPH ! specific heat C_ph
+REAL, DIMENSION(KLON) :: ZLV, ZLS ! latent heat of vaporis., sublim.
+REAL, DIMENSION(KLON) :: ZURV ! updraft water vapor at level k+1
+REAL, DIMENSION(KLON) :: ZPI ! Pi=(P0/P)**(Rd/Cpd)
+REAL, DIMENSION(KLON) :: ZTHEUL ! theta_e for undilute ascent
+REAL, DIMENSION(KLON) :: ZWORK1, ZWORK2, ZWORK3, ZWORK4, ZWORK5, &
+ ZWORK6 ! work arrays
+INTEGER, DIMENSION(KLON) :: IWORK ! wok array
+LOGICAL, DIMENSION(KLON) :: GWORK1, GWORK2, GWORK4, GWORK5
+ ! work arrays
+LOGICAL, DIMENSION(KLON,KLEV) :: GWORK6 ! work array
+!
+!
+!-------------------------------------------------------------------------------
+!
+! 0.3 Set loop bounds
+! ---------------
+!
+IKB = 1 + JCVEXB
+IKE = KLEV - JCVEXT
+IIE = KLON
+!
+!
+!* 1. Initialize updraft properties and local variables
+! -------------------------------------------------
+!
+ZEPSA = XRV / XRD
+ZRDOCP = XRD / XCPD
+!
+PUMF(:,:) = 0.
+PUER(:,:) = 0.
+PUDR(:,:) = 0.
+PUTHL(:,:) = 0.
+PUTHV(:,:) = 0.
+PURW(:,:) = 0.
+PURC(:,:) = 0.
+PURI(:,:) = 0.
+ZUW1(:) = PWLCL(:) * PWLCL(:)
+ZUW2(:) = 0.
+ZE1(:) = 0.
+ZD1(:) = 0.
+PCAPE(:) = 0.
+KCTL(:) = IKB
+KETL(:) = KLCL(:)
+GWORK2(:) = .TRUE.
+ZPI(:) = 1.
+ZWORK3(:) = 0.
+ZWORK4(:) = 0.
+ZWORK5(:) = 0.
+ZWORK6(:) = 0.
+GWORK1(:) = .FALSE.
+GWORK4(:) = .FALSE.
+!
+!
+!* 1.1 Compute undilute updraft theta_e for CAPE computations
+! Bolton (1980) formula.
+! Define accurate enthalpy for updraft
+! -----------------------------------------------------
+!
+ZTHEUL(:) = PTLCL(:) * ( PTHLCL(:) / PTLCL(:) ) ** ( 1. - 0.28 * PRVLCL(:) ) &
+ * EXP( ( 3374.6525 / PTLCL(:) - 2.5403 ) * &
+ PRVLCL(:) * ( 1. + 0.81 * PRVLCL(:) ) )
+!
+!
+ZWORK1(:) = ( XCPD + PRVLCL(:) * XCPV ) * PTLCL(:) &
+ + ( 1. + PRVLCL(:) ) * XG * PZLCL(:)
+!
+!
+!* 2. Set updraft properties between DPL and LCL
+! ------------------------------------------
+!
+JKP = MAXVAL( KLCL(:) )
+JKM = MINVAL( KDPL(:) )
+DO JK = JKM, JKP
+ DO JI = 1, IIE
+ IF ( JK >= KDPL(JI) .AND. JK < KLCL(JI) ) THEN
+ PUMF(JI,JK) = PMFLCL(JI)
+ PUTHL(JI,JK) = ZWORK1(JI)
+ PUTHV(JI,JK) = PTHLCL(JI) * ( 1. + ZEPSA * PRVLCL(JI) ) / &
+ ( 1. + PRVLCL(JI) )
+ PURW(JI,JK) = PRVLCL(JI)
+ END IF
+ END DO
+END DO
+!
+!
+!* 3. Enter loop for updraft computations
+! ------------------------------------
+!
+DO JK = IKB + 1, IKE - 1
+ ZWORK6(:) = 1.
+ JKP = JK + 1
+!
+ GWORK4(:) = JK >= KLCL(:) - 1
+ GWORK1(:) = GWORK4(:) .AND. GWORK2(:) ! this mask is used to confine
+ ! updraft computations between the LCL and the CTL
+!
+ WHERE( JK == KLCL(:) - 1 ) ZWORK6(:) = 0. ! factor that is used in buoyancy
+ ! computation at first level above LCL
+!
+!
+!* 4. Estimate condensate, L_v L_i, Cph and theta_v at level k+1
+! ----------------------------------------------------------
+!
+ ZWORK1(:) = PURC(:,JK)
+ ZWORK2(:) = PURI(:,JK)
+ CALL CONVECT_CONDENS( KLON, KICE, PPRES(:,JKP), PUTHL(:,JK), PURW(:,JK),&
+ ZWORK1, ZWORK2, PZ(:,JKP), GWORK1, ZUT, ZURV, &
+ PURC(:,JKP), PURI(:,JKP), ZLV, ZLS, ZCPH )
+!
+!
+ ZPI(:) = ( XP00 / PPRES(:,JKP) ) ** ZRDOCP
+ WHERE ( GWORK1(:) )
+!
+ PUTHV(:,JKP) = ZPI(:) * ZUT(:) * ( 1. + ZEPSA * ZURV(:) ) &
+ / ( 1. + PURW(:,JK) )
+!
+!
+!* 5. Compute square of vertical velocity using entrainment
+! at level k
+! -----------------------------------------------------
+!
+ ZWORK3(:) = PZ(:,JKP) - PZ(:,JK) * ZWORK6(:) - &
+ ( 1. - ZWORK6(:) ) * PZLCL(:) ! level thickness
+ ZWORK4(:) = PTHV(:,JK) * ZWORK6(:) + &
+ ( 1. - ZWORK6(:) ) * PTHVELCL(:)
+ ZWORK5(:) = 2. * ZUW1(:) * PUER(:,JK) / MAX( .1, PUMF(:,JK) )
+ ZUW2(:) = ZUW1(:) + ZWORK3(:) * XNHGAM * XG * &
+ ( ( PUTHV(:,JK) + PUTHV(:,JKP) ) / &
+ ( ZWORK4(:) + PTHV(:,JKP) ) - 1. ) & ! buoyancy term
+ - ZWORK5(:) ! entrainment term
+!
+!
+!* 6. Update total precipitation: dr_r=(r_c+r_i)*exp(-rate*dz)
+! --------------------------------------------------------
+!
+! compute level mean vertical velocity
+ ZWORK2(:) = 0.5 * &
+ ( SQRT( MAX( 1.E-2, ZUW2(:) ) ) + &
+ SQRT( MAX( 1.E-2, ZUW1(:) ) ) )
+!
+!
+!* 7. Update r_c, r_i, enthalpy, r_w for precipitation
+! -------------------------------------------------------
+!
+ PURW(:,JKP) = PURW(:,JK)
+ PURC(:,JKP) = PURC(:,JKP)
+ PURI(:,JKP) = PURI(:,JKP)
+ PUTHL(:,JKP) = PUTHL(:,JK)
+!
+ ZUW1(:) = ZUW2(:)
+!
+ END WHERE
+!
+!
+!* 8. Compute entrainment and detrainment using conservative
+! variables adjusted for precipitation ( not for entrainment)
+! -----------------------------------------------------------
+!
+!* 8.1 Compute critical mixed fraction by estimating unknown
+! T^mix r_c^mix and r_i^mix from enthalpy^mix and r_w^mix
+! We determine the zero crossing of the linear curve
+! evaluating the derivative using ZMIXF=0.1.
+! -----------------------------------------------------
+!
+ ZMIXF(:) = 0.1 ! starting value for critical mixed fraction
+ ZWORK1(:) = ZMIXF(:) * PTHL(:,JKP) &
+ + ( 1. - ZMIXF(:) ) * PUTHL(:,JKP) ! mixed enthalpy
+ ZWORK2(:) = ZMIXF(:) * PRW(:,JKP) &
+ + ( 1. - ZMIXF(:) ) * PURW(:,JKP) ! mixed r_w
+!
+ CALL CONVECT_CONDENS( KLON, KICE, PPRES(:,JKP), ZWORK1, ZWORK2, &
+ PURC(:,JKP), PURI(:,JKP), PZ(:,JKP), GWORK1, ZUT,&
+ ZWORK3, ZWORK4, ZWORK5, ZLV, ZLS, ZCPH )
+! put in enthalpy and r_w and get T r_c, r_i (ZUT, ZWORK4-5)
+!
+ ! compute theta_v of mixture
+ ZWORK3(:) = ZUT(:) * ZPI(:) * ( 1. + ZEPSA * ( &
+ ZWORK2(:) - ZWORK4(:) - ZWORK5(:) ) ) / ( 1. + ZWORK2(:) )
+ ! compute final value of critical mixed fraction using theta_v
+ ! of mixture, grid-scale and updraft
+ ZMIXF(:) = MAX( 0., PUTHV(:,JKP) - PTHV(:,JKP) ) * ZMIXF(:) / &
+ ( PUTHV(:,JKP) - ZWORK3(:) + 1.E-10 )
+ ZMIXF(:) = MAX( 0., MIN( 1., ZMIXF(:) ) )
+!
+!
+!* 8.2 Compute final midlevel values for entr. and detrainment
+! after call of distribution function
+! -------------------------------------------------------
+!
+!
+ CALL CONVECT_MIXING_FUNCT ( KLON, ZMIXF, 1, ZE2, ZD2 )
+! Note: routine MIXING_FUNCT returns fractional entrainm/detrainm. rates
+!
+ ZE2=MIN(ZD2,MAX(.3,ZE2))
+!
+! ZWORK1(:) = XENTR * PMFLCL(:) * PDPRES(:,JKP) / XCRAD ! rate of env. inflow
+!*MOD
+ zwork1(:) = xentr * xg / xcrad * pumf(:,jk) * ( pz(:,jkp) - pz(:,jk) )
+! ZWORK1(:) = XENTR * pumf(:,jk) * PDPRES(:,JKP) / XCRAD ! rate of env. inflow
+!*MOD
+ ZWORK2(:) = 0.
+ WHERE ( GWORK1(:) ) ZWORK2(:) = 1.
+ WHERE ( PUTHV(:,JKP) > PTHV(:,JKP) )
+ PUER(:,JKP) = 0.5 * ZWORK1(:) * ( ZE1(:) + ZE2(:) ) * ZWORK2(:)
+ PUDR(:,JKP) = 0.5 * ZWORK1(:) * ( ZD1(:) + ZD2(:) ) * ZWORK2(:)
+ ELSEWHERE
+ PUER(:,JKP) = 0.
+ PUDR(:,JKP) = ZWORK1(:) * ZWORK2(:)
+ END WHERE
+!
+!* 8.3 Determine equilibrium temperature level
+! --------------------------------------
+!
+ WHERE ( PUTHV(:,JKP) > PTHV(:,JKP) .AND. JK > KLCL(:) + 1 &
+ .AND. GWORK1(:) )
+ KETL(:) = JKP ! equilibrium temperature level
+ END WHERE
+!
+!* 8.4 If the calculated detrained mass flux is greater than
+! the total updraft mass flux, or vertical velocity is
+! negative, all cloud mass detrains at previous model level,
+! exit updraft calculations - CTL is attained
+! -------------------------------------------------------
+!
+ WHERE( GWORK1(:) ) &
+ GWORK2(:) = PUMF(:,JK) - PUDR(:,JKP) > 10. .AND. ZUW2(:) > 0.
+ WHERE ( GWORK2(:) ) KCTL(:) = JKP ! cloud top level
+ GWORK1(:) = GWORK2(:) .AND. GWORK4(:)
+!
+ IF ( COUNT( GWORK2(:) ) == 0 ) EXIT
+!
+!
+!* 9. Compute CAPE for undilute ascent using theta_e and
+! theta_es instead of theta_v. This estimation produces
+! a significantly larger value for CAPE than the actual one.
+! ----------------------------------------------------------
+!
+ WHERE ( GWORK1(:) )
+!
+ ZWORK3(:) = PZ(:,JKP) - PZ(:,JK) * ZWORK6(:) - &
+ ( 1. - ZWORK6(:) ) * PZLCL(:) ! level thickness
+ ZWORK2(:) = PTHES(:,JK) + ( 1. - ZWORK6(:) ) * &
+ ( PTHES(:,JKP) - PTHES(:,JK) ) / ( PZ(:,JKP) - PZ(:,JK) ) * &
+ ( PZLCL(:) - PZ(:,JK) ) ! linear interpolation for theta_es at LCL
+ ! ( this is only done for model level just above LCL
+!
+ ZWORK1(:) = ( 2. * ZTHEUL(:) ) / ( ZWORK2(:) + PTHES(:,JKP) ) - 1.
+ PCAPE(:) = PCAPE(:) + XG * ZWORK3(:) * MAX( 0., ZWORK1(:) )
+!
+!
+!* 10. Compute final values of updraft mass flux, enthalpy, r_w
+! at level k+1
+! --------------------------------------------------------
+!
+ PUMF(:,JKP) = PUMF(:,JK) - PUDR(:,JKP) + PUER(:,JKP)
+ PUMF(:,JKP) = MAX( PUMF(:,JKP), 0.1 )
+ PUTHL(:,JKP) = ( PUMF(:,JK) * PUTHL(:,JK) + &
+ PUER(:,JKP) * PTHL(:,JK) - PUDR(:,JKP) * PUTHL(:,JK) ) &
+ / PUMF(:,JKP)
+ PURW(:,JKP) = ( PUMF(:,JK) * PURW(:,JK) + &
+ PUER(:,JKP) * PRW(:,JK) - PUDR(:,JKP) * PURW(:,JK) ) &
+ / PUMF(:,JKP)
+!
+!
+ ZE1(:) = ZE2(:) ! update fractional entrainment/detrainment
+ ZD1(:) = ZD2(:)
+!
+ END WHERE
+!
+END DO
+!
+!* 12.1 Set OTRIG to False if cloud thickness < 0.5km
+! or > 3km (deep convection) or CAPE < 1
+! ------------------------------------------------
+!
+ DO JI = 1, IIE
+ JK = KCTL(JI)
+ ZWORK1(JI) = PZ(JI,JK) - PZLCL(JI)
+ OTRIG(JI) = ZWORK1(JI) >= XCDEPTH .AND. ZWORK1(JI) < XCDEPTH_D &
+ .AND. PCAPE(JI) > 1.
+ END DO
+ WHERE( .NOT. OTRIG(:) )
+ KCTL(:) = IKB
+ END WHERE
+KETL(:) = MAX( KETL(:), KLCL(:) + 2 )
+KETL(:) = MIN( KETL(:), KCTL(:) )
+!
+!
+!* 12.2 If the ETL and CTL are the same detrain updraft mass
+! flux at this level
+! -------------------------------------------------------
+!
+ZWORK1(:) = 0.
+WHERE ( KETL(:) == KCTL(:) ) ZWORK1(:) = 1.
+!
+DO JI = 1, IIE
+ JK = KETL(JI)
+ PUDR(JI,JK) = PUDR(JI,JK) + &
+ ( PUMF(JI,JK) - PUER(JI,JK) ) * ZWORK1(JI)
+ PUER(JI,JK) = PUER(JI,JK) * ( 1. - ZWORK1(JI) )
+ PUMF(JI,JK) = PUMF(JI,JK) * ( 1. - ZWORK1(JI) )
+ JKP = KCTL(JI) + 1
+ PUER(JI,JKP) = 0. ! entrainm/detr rates have been already computed
+ PUDR(JI,JKP) = 0. ! at level KCTL+1, set them to zero
+ PURW(JI,JKP) = 0.
+ PURC(JI,JKP) = 0.
+ PURI(JI,JKP) = 0.
+ PUTHL(JI,JKP) = 0.
+ PURC(JI,JKP+1)= 0.
+ PURI(JI,JKP+1)= 0.
+END DO
+!
+!* 12.3 Adjust mass flux profiles, detrainment rates, and
+! precipitation fallout rates to reflect linear decrease
+! in mass flux between the ETL and CTL
+! -------------------------------------------------------
+!
+ZWORK1(:) = 0.
+JK1 = MINVAL( KETL(:) )
+JK2 = MAXVAL( KCTL(:) )
+
+DO JK = JK1, JK2
+ DO JI = 1, IIE
+ IF( JK > KETL(JI) .AND. JK <= KCTL(JI) ) THEN
+ ZWORK1(JI) = ZWORK1(JI) + PDPRES(JI,JK)
+ END IF
+ END DO
+END DO
+!
+DO JI = 1, IIE
+ JK = KETL(JI)
+ ZWORK1(JI) = PUMF(JI,JK) / MAX( 1., ZWORK1(JI) )
+END DO
+!
+DO JK = JK1 + 1, JK2
+ JKP = JK - 1
+ DO JI = 1, IIE
+ IF ( JK > KETL(JI) .AND. JK <= KCTL(JI) ) THEN
+ PUDR(JI,JK) = PDPRES(JI,JK) * ZWORK1(JI)
+ PUMF(JI,JK) = PUMF(JI,JKP) - PUDR(JI,JK)
+ END IF
+ END DO
+END DO
+!
+! 12.4 Set mass flux and entrainment in the source layer.
+! Linear increase throughout the source layer.
+! -------------------------------------------------------
+!
+!IWORK(:) = MIN( KPBL(:), KLCL(:) - 1 )
+IWORK(:) = KPBL(:)
+DO JI = 1, IIE
+ JK = KDPL(JI)
+ JKP = IWORK(JI)
+! mixed layer depth
+ ZWORK2(JI) = PPRES(JI,JK) - PPRES(JI,JKP) + PDPRES(JI,JK)
+END DO
+!
+JKP = MAXVAL( IWORK(:) )
+DO JK = JKM, JKP
+ DO JI = 1, IIE
+ IF ( JK >= KDPL(JI) .AND. JK <= IWORK(JI) ) THEN
+ PUER(JI,JK) = PUER(JI,JK) + PMFLCL(JI) * PDPRES(JI,JK) / ( ZWORK2(JI) + 0.1 )
+ PUMF(JI,JK) = PUMF(JI,JK-1) + PUER(JI,JK)
+ END IF
+ END DO
+END DO
+!
+!
+!* 13. If cloud thickness is smaller than .5 km or > 3 km
+! no shallow convection is allowed
+! Nota: For technical reasons, we stop the convection
+! computations in this case and do not go back to
+! TRIGGER_FUNCT to look for the next unstable LCL
+! which could produce a thicker cloud.
+! ---------------------------------------------------
+!
+GWORK6(:,:) = SPREAD( OTRIG(:), DIM=2, NCOPIES=KLEV )
+WHERE ( .NOT. GWORK6(:,:) )
+ PUMF(:,:) = 0.
+ PUDR(:,:) = 0.
+ PUER(:,:) = 0.
+ PUTHL(:,:) = PTHL(:,:)
+ PURW(:,:) = PRW(:,:)
+ PURC(:,:) = 0.
+ PURI(:,:) = 0.
+END WHERE
+!
+END SUBROUTINE CONVECT_UPDRAFT_SHAL
diff --git a/src/mesonh/conv/deep_convection.f90 b/src/mesonh/conv/deep_convection.f90
new file mode 100644
index 000000000..2a6b30b55
--- /dev/null
+++ b/src/mesonh/conv/deep_convection.f90
@@ -0,0 +1,1393 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+! ######################
+ MODULE MODI_DEEP_CONVECTION
+! ######################
+!
+INTERFACE
+!
+ SUBROUTINE DEEP_CONVECTION( KLON, KLEV, KIDIA, KFDIA, KBDIA, KTDIA, &
+ PDTCONV, KICE, OREFRESH, ODOWN, OSETTADJ, &
+ PPABST, PZZ, PDXDY, PTIMEC, &
+ PTT, PRVT, PRCT, PRIT, PUT, PVT, PWT, &
+ KCOUNT, PTTEN, PRVTEN, PRCTEN, PRITEN, &
+ PPRLTEN, PPRSTEN, &
+ KCLTOP, KCLBAS, PPRLFLX, PPRSFLX, &
+ PUMF, PDMF, PCAPE, &
+ OCH1CONV, KCH1, PCH1, PCH1TEN, &
+ OUSECHEM, OCH_CONV_SCAV, OCH_CONV_LINOX, &
+ ODUST, OSALT, PRHODREF, PIC_RATE, PCG_RATE )
+
+INTEGER, INTENT(IN) :: KLON ! horizontal dimension
+INTEGER, INTENT(IN) :: KLEV ! vertical dimension
+INTEGER, INTENT(IN) :: KIDIA ! value of the first point in x
+INTEGER, INTENT(IN) :: KFDIA ! value of the last point in x
+INTEGER, INTENT(IN) :: KBDIA ! vertical computations start at
+! ! KBDIA that is at least 1
+INTEGER, INTENT(IN) :: KTDIA ! vertical computations can be
+ ! limited to KLEV + 1 - KTDIA
+ ! default=1
+REAL, INTENT(IN) :: PDTCONV ! Interval of time between two
+ ! calls of the deep convection
+ ! scheme
+INTEGER, INTENT(IN) :: KICE ! flag for ice ( 1 = yes,
+ ! 0 = no ice )
+LOGICAL, INTENT(IN) :: OREFRESH ! refresh or not tendencies
+ ! at every call
+LOGICAL, INTENT(IN) :: ODOWN ! take or not convective
+ ! downdrafts into account
+LOGICAL, INTENT(IN) :: OSETTADJ ! logical to set convective
+ ! adjustment time by user
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTT ! grid scale temperature at t
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRVT ! grid scale water vapor "
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRCT ! grid scale r_c "
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRIT ! grid scale r_i "
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PUT ! grid scale horiz. wind u "
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PVT ! grid scale horiz. wind v "
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PWT ! grid scale vertical
+ ! velocity (m/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PPABST ! grid scale pressure at t
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PZZ ! height of model layer (m)
+REAL, DIMENSION(KLON), INTENT(IN) :: PDXDY ! horizontal grid area (m -a2)
+REAL, DIMENSION(KLON), INTENT(IN) :: PTIMEC ! value of convective adjustment
+ ! time if OSETTADJ=.TRUE.
+!
+INTEGER, DIMENSION(KLON), INTENT(INOUT):: KCOUNT ! convective counter (recompute
+ ! tendency or keep it)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PTTEN ! convective temperature
+ ! tendency (K/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PRVTEN ! convective r_v tendency (1/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PRCTEN ! convective r_c tendency (1/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PRITEN ! convective r_i tendency (1/s)
+REAL, DIMENSION(KLON), INTENT(INOUT):: PPRLTEN! liquid surf. precipitation
+ ! tendency (m/s)
+REAL, DIMENSION(KLON), INTENT(INOUT):: PPRSTEN! solid surf. precipitation
+ ! tendency (m/s)
+INTEGER, DIMENSION(KLON), INTENT(INOUT):: KCLTOP ! cloud top level
+INTEGER, DIMENSION(KLON), INTENT(INOUT):: KCLBAS ! cloud base level
+ ! they are given a value of
+ ! 0 if no convection
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PPRLFLX! liquid precip flux (m/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PPRSFLX! solid precip flux (m/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PUMF ! updraft mass flux (kg/s m2)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PDMF ! downdraft mass flux (kg/s m2)
+REAL, DIMENSION(KLON), INTENT(INOUT):: PCAPE ! maximum CAPE (J/kg)
+!
+LOGICAL, INTENT(IN) :: OCH1CONV ! include tracer transport
+INTEGER, INTENT(IN) :: KCH1 ! number of species
+REAL, DIMENSION(KLON,KLEV,KCH1), INTENT(IN) :: PCH1! grid scale chemical species
+REAL, DIMENSION(KLON,KLEV,KCH1), INTENT(INOUT):: PCH1TEN! species conv. tendency (1/s)
+LOGICAL, INTENT(IN) :: OUSECHEM ! flag for chemistry
+LOGICAL, INTENT(IN) :: OCH_CONV_SCAV ! & scavenging
+LOGICAL, INTENT(IN) :: OCH_CONV_LINOX ! & LiNOx
+LOGICAL, INTENT(IN) :: ODUST ! flag for dust
+LOGICAL, INTENT(IN) :: OSALT ! flag for sea salt
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRHODREF ! grid scale density
+REAL, DIMENSION(KLON), INTENT(INOUT) :: PIC_RATE ! IC lightning frequency
+REAL, DIMENSION(KLON), INTENT(INOUT) :: PCG_RATE ! CG lightning frequency
+
+!
+END SUBROUTINE DEEP_CONVECTION
+!
+END INTERFACE
+!
+END MODULE MODI_DEEP_CONVECTION
+!
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 conv 2006/09/21 10:55:01
+!-----------------------------------------------------------------
+! ############################################################################
+ SUBROUTINE DEEP_CONVECTION( KLON, KLEV, KIDIA, KFDIA, KBDIA, KTDIA, &
+ PDTCONV, KICE, OREFRESH, ODOWN, OSETTADJ, &
+ PPABST, PZZ, PDXDY, PTIMEC, &
+ PTT, PRVT, PRCT, PRIT, PUT, PVT, PWT, &
+ KCOUNT, PTTEN, PRVTEN, PRCTEN, PRITEN, &
+ PPRLTEN, PPRSTEN, &
+ KCLTOP, KCLBAS, PPRLFLX, PPRSFLX, &
+ PUMF, PDMF, PCAPE, &
+ OCH1CONV, KCH1, PCH1, PCH1TEN, &
+ OUSECHEM, OCH_CONV_SCAV, OCH_CONV_LINOX, &
+ ODUST, OSALT, PRHODREF, PIC_RATE, PCG_RATE )
+! ############################################################################
+!
+!!**** Monitor routine to compute all convective tendencies by calls
+!! of several subroutines.
+!!
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to determine the convective
+!! tendencies. The routine first prepares all necessary grid-scale
+!! variables. The final convective tendencies are then computed by
+!! calls of different subroutines.
+!!
+!!
+!!** METHOD
+!! ------
+!! We start by selecting convective columns in the model domain through
+!! the call of routine TRIGGER_FUNCT. Then, we allocate memory for the
+!! convection updraft and downdraft variables and gather the grid scale
+!! variables in convective arrays.
+!! The updraft and downdraft computations are done level by level starting
+!! at the bottom and top of the domain, respectively.
+!! All computations are done on MNH thermodynamic levels. The depth
+!! of the current model layer k is defined by DP(k)=P(k-1)-P(k)
+!!
+!!
+!!
+!! EXTERNAL
+!! --------
+!! CONVECT_TRIGGER_FUNCT
+!! CONVECT_SATMIXRATIO
+!! CONVECT_UPDRAFT
+!! CONVECT_CONDENS
+!! CONVECT_MIXING_FUNCT
+!! CONVECT_TSTEP_PREF
+!! CONVECT_DOWNDRAFT
+!! CONVECT_PRECIP_ADJUST
+!! CONVECT_CLOSURE
+!! CONVECT_CLOSURE_THRVLCL
+!! CONVECT_CLOSURE_ADJUST
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST
+!! XG ! gravity constant
+!! XPI ! number Pi
+!! XP00 ! reference pressure
+!! XRD, XRV ! gaz constants for dry air and water vapor
+!! XCPD, XCPV ! specific heat for dry air and water vapor
+!! XRHOLW ! density of liquid water
+!! XALPW, XBETAW, XGAMW ! constants for water saturation pressure
+!! XTT ! triple point temperature
+!! XLVTT, XLSTT ! vaporization, sublimation heat constant
+!! XCL, XCI ! specific heat for liquid water and ice
+!!
+!! Module MODD_CONVPAREXT
+!! JCVEXB, JCVEXT ! extra levels on the vertical boundaries
+!!
+!! Module MODD_CONVPAR
+!! XA25 ! reference grid area
+!! XCRAD ! cloud radius
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Bechtold, 1997 : Meso-NH scientific documentation (31 pp)
+!! Bechtold et al., 2001, Quart. J. Roy. Met. Soc.
+!! Kain and Fritsch, 1990, J. Atmos. Sci., Vol. 47, 2784-2801.
+!! Kain and Fritsch, 1993, Meteor. Monographs, Vol. 24, 165-170.
+!!
+!! AUTHOR
+!! ------
+!! P. BECHTOLD * Laboratoire d'Aerologie *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 26/03/96
+!! Peter Bechtold 04/10/97 replace theta_il by enthalpy
+!! " 10/12/98 changes for ARPEGE
+!! " 12/12/00 add conservation correction
+!! C. Mari 13/02/01 add scavenging of chemical species in updraft
+!! P. Jabouille 02/07/01 case of lagragian variables
+!! P. Tulet 02/03/05 update for dust
+!! C.Lac 27/09/10 modification loop index for reproducibility
+!! Juan 24/09/2012: for BUG Pgi rewrite PACK function on mode_pack_pgi
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_CONVPAREXT
+USE MODD_CONVPAR
+USE MODD_NSV, ONLY : NSV_LGBEG,NSV_LGEND, &
+ NSV_CHEMBEG,NSV_CHEMEND, &
+ NSV_LNOXBEG
+USE MODD_CH_M9_n, ONLY : CNAMES
+!
+USE MODI_CH_CONVECT_LINOX
+USE MODI_CONVECT_TRIGGER_FUNCT
+USE MODI_CONVECT_UPDRAFT
+USE MODI_CONVECT_TSTEP_PREF
+USE MODI_CONVECT_DOWNDRAFT
+USE MODI_CONVECT_PRECIP_ADJUST
+USE MODI_CONVECT_CLOSURE
+USE MODI_CH_CONVECT_SCAVENGING
+USE MODI_CONVECT_CHEM_TRANSPORT
+!
+#ifdef MNH_PGI
+USE MODE_PACK_PGI
+#endif
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+!
+INTEGER, INTENT(IN) :: KLON ! horizontal dimension
+INTEGER, INTENT(IN) :: KLEV ! vertical dimension
+INTEGER, INTENT(IN) :: KIDIA ! value of the first point in x
+INTEGER, INTENT(IN) :: KFDIA ! value of the last point in x
+INTEGER, INTENT(IN) :: KBDIA ! vertical computations start at
+! ! KBDIA that is at least 1
+INTEGER, INTENT(IN) :: KTDIA ! vertical computations can be
+ ! limited to KLEV + 1 - KTDIA
+ ! default=1
+REAL, INTENT(IN) :: PDTCONV ! Interval of time between two
+ ! calls of the deep convection
+ ! scheme
+INTEGER, INTENT(IN) :: KICE ! flag for ice ( 1 = yes,
+ ! 0 = no ice )
+LOGICAL, INTENT(IN) :: OREFRESH ! refresh or not tendencies
+ ! at every call
+LOGICAL, INTENT(IN) :: ODOWN ! take or not convective
+ ! downdrafts into account
+LOGICAL, INTENT(IN) :: OSETTADJ ! logical to set convective
+ ! adjustment time by user
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTT ! grid scale temperature at t
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRVT ! grid scale water vapor "
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRCT ! grid scale r_c "
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRIT ! grid scale r_i "
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PUT ! grid scale horiz. wind u "
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PVT ! grid scale horiz. wind v "
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PWT ! grid scale vertical
+ ! velocity (m/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PPABST ! grid scale pressure at t
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PZZ ! height of model layer (m)
+REAL, DIMENSION(KLON), INTENT(IN) :: PDXDY ! horizontal grid area (m -a2)
+REAL, DIMENSION(KLON), INTENT(IN) :: PTIMEC ! value of convective adjustment
+ ! time if OSETTADJ=.TRUE.
+!
+INTEGER, DIMENSION(KLON), INTENT(INOUT):: KCOUNT ! convective counter (recompute
+ ! tendency or keep it)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PTTEN ! convective temperature
+ ! tendency (K/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PRVTEN ! convective r_v tendency (1/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PRCTEN ! convective r_c tendency (1/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PRITEN ! convective r_i tendency (1/s)
+REAL, DIMENSION(KLON), INTENT(INOUT):: PPRLTEN! liquid surf. precipitation
+ ! tendency (m/s)
+REAL, DIMENSION(KLON), INTENT(INOUT):: PPRSTEN! solid surf. precipitation
+ ! tendency (m/s)
+INTEGER, DIMENSION(KLON), INTENT(INOUT):: KCLTOP ! cloud top level
+INTEGER, DIMENSION(KLON), INTENT(INOUT):: KCLBAS ! cloud base level
+ ! they are given a value of
+ ! 0 if no convection
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PPRLFLX! liquid precip flux (m/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PPRSFLX! solid precip flux (m/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PUMF ! updraft mass flux (kg/s m2)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PDMF ! downdraft mass flux (kg/s m2)
+REAL, DIMENSION(KLON), INTENT(INOUT):: PCAPE ! maximum CAPE (J/kg)
+!
+LOGICAL, INTENT(IN) :: OCH1CONV ! include tracer transport
+INTEGER, INTENT(IN) :: KCH1 ! number of species
+REAL, DIMENSION(KLON,KLEV,KCH1), INTENT(IN) :: PCH1! grid scale chemical species
+REAL, DIMENSION(KLON,KLEV,KCH1), INTENT(INOUT):: PCH1TEN! species conv. tendency (1/s)
+LOGICAL, INTENT(IN) :: OUSECHEM ! flag for chemistry
+LOGICAL, INTENT(IN) :: OCH_CONV_SCAV ! & scavenging
+LOGICAL, INTENT(IN) :: OCH_CONV_LINOX ! & LiNOx
+LOGICAL, INTENT(IN) :: ODUST ! flag for dust
+LOGICAL, INTENT(IN) :: OSALT ! flag for sea salt
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRHODREF ! grid scale density
+REAL, DIMENSION(KLON), INTENT(INOUT) :: PIC_RATE ! IC lightning frequency
+REAL, DIMENSION(KLON), INTENT(INOUT) :: PCG_RATE ! CG lightning frequency
+!
+!
+!* 0.2 Declarations of local fixed memory variables :
+!
+INTEGER :: ITEST, ICONV, ICONV1 ! number of convective columns
+INTEGER :: IIB, IIE ! horizontal loop bounds
+INTEGER :: IKB, IKE ! vertical loop bounds
+INTEGER :: IKS ! vertical dimension
+INTEGER :: JI, JL, JJ ! horizontal loop index
+INTEGER :: JN ! number of tracers
+INTEGER :: JK, JKP, JKM ! vertical loop index
+INTEGER :: IFTSTEPS ! only used for chemical tracers
+REAL :: ZEPS, ZEPSA ! R_d / R_v, R_v / R_d
+REAL :: ZRDOCP ! R_d/C_p
+!
+LOGICAL, DIMENSION(KLON, KLEV) :: GTRIG3 ! 3D logical mask for convection
+LOGICAL, DIMENSION(KLON) :: GTRIG ! 2D logical mask for trigger test
+REAL, DIMENSION(KLON,KLEV) :: ZTHT, ZSTHV, ZSTHES ! grid scale theta,
+ ! theta_v, theta_es
+REAL, DIMENSION(KLON) :: ZTIME ! convective time period
+REAL, DIMENSION(KLON) :: ZWORK2, ZWORK2B ! work array
+REAL :: ZW1 ! work variable
+!
+!
+!* 0.2 Declarations of local allocatable variables :
+!
+INTEGER, DIMENSION(:),ALLOCATABLE :: IDPL ! index for parcel departure level
+INTEGER, DIMENSION(:),ALLOCATABLE :: IPBL ! index for source layer top
+INTEGER, DIMENSION(:),ALLOCATABLE :: ILCL ! index for lifting condensation level
+INTEGER, DIMENSION(:),ALLOCATABLE :: IETL ! index for zero buoyancy level
+INTEGER, DIMENSION(:),ALLOCATABLE :: ICTL ! index for cloud top level
+INTEGER, DIMENSION(:),ALLOCATABLE :: ILFS ! index for level of free sink
+INTEGER, DIMENSION(:),ALLOCATABLE :: IDBL ! index for downdraft base level
+INTEGER, DIMENSION(:),ALLOCATABLE :: IML ! melting level
+!
+INTEGER, DIMENSION(:), ALLOCATABLE :: ISDPL ! index for parcel departure level
+INTEGER, DIMENSION(:),ALLOCATABLE :: ISPBL ! index for source layer top
+INTEGER, DIMENSION(:), ALLOCATABLE :: ISLCL ! index for lifting condensation level
+REAL, DIMENSION(:), ALLOCATABLE :: ZSTHLCL ! updraft theta at LCL
+REAL, DIMENSION(:), ALLOCATABLE :: ZSTLCL ! updraft temp. at LCL
+REAL, DIMENSION(:), ALLOCATABLE :: ZSRVLCL ! updraft rv at LCL
+REAL, DIMENSION(:), ALLOCATABLE :: ZSWLCL ! updraft w at LCL
+REAL, DIMENSION(:), ALLOCATABLE :: ZSZLCL ! LCL height
+REAL, DIMENSION(:), ALLOCATABLE :: ZSTHVELCL! envir. theta_v at LCL
+REAL, DIMENSION(:), ALLOCATABLE :: ZSDXDY ! grid area (m^2)
+!
+! grid scale variables
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZZ ! height of model layer (m)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZPRES ! grid scale pressure
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZDPRES ! pressure difference between
+ ! bottom and top of layer (Pa)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZU ! grid scale horiz. u component on theta grid
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZV ! grid scale horiz. v component on theta grid
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZW ! grid scale vertical velocity on theta grid
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZTT ! temperature
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZTH ! grid scale theta
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZTHV ! grid scale theta_v
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZTHL ! grid scale enthalpy (J/kg)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZTHES, ZTHEST ! grid scale saturated theta_e
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZRW ! grid scale total water (kg/kg)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZRV ! grid scale water vapor (kg/kg)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZRC ! grid scale cloud water (kg/kg)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZRI ! grid scale cloud ice (kg/kg)
+REAL, DIMENSION(:), ALLOCATABLE :: ZDXDY ! grid area (m^2)
+!
+! updraft variables
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZUMF ! updraft mass flux (kg/s)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZUER ! updraft entrainment (kg/s)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZUDR ! updraft detrainment (kg/s)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZUPR ! updraft precipitation in
+ ! flux units (kg water / s)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZUTHL ! updraft enthalpy (J/kg)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZUTHV ! updraft theta_v (K)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZUTT ! updraft temperature (K)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZURW ! updraft total water (kg/kg)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZURC ! updraft cloud water (kg/kg)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZURI ! updraft cloud ice (kg/kg)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZURR ! liquid precipit. (kg/kg)
+ ! produced in model layer
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZURS ! solid precipit. (kg/kg)
+ ! produced in model layer
+REAL, DIMENSION(:), ALLOCATABLE :: ZUTPR ! total updraft precipitation (kg/s)
+REAL, DIMENSION(:), ALLOCATABLE :: ZMFLCL ! cloud base unit mass flux(kg/s)
+REAL, DIMENSION(:), ALLOCATABLE :: ZCAPE ! available potent. energy
+REAL, DIMENSION(:), ALLOCATABLE :: ZTHLCL ! updraft theta at LCL
+REAL, DIMENSION(:), ALLOCATABLE :: ZTLCL ! updraft temp. at LCL
+REAL, DIMENSION(:), ALLOCATABLE :: ZRVLCL ! updraft rv at LCL
+REAL, DIMENSION(:), ALLOCATABLE :: ZWLCL ! updraft w at LCL
+REAL, DIMENSION(:), ALLOCATABLE :: ZZLCL ! LCL height
+REAL, DIMENSION(:), ALLOCATABLE :: ZTHVELCL! envir. theta_v at LCL
+!
+! downdraft variables
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZDMF ! downdraft mass flux (kg/s)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZDER ! downdraft entrainment (kg/s)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZDDR ! downdraft detrainment (kg/s)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZDTHL ! downdraft enthalpy (J/kg)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZDRW ! downdraft total water (kg/kg)
+REAL, DIMENSION(:), ALLOCATABLE :: ZMIXF ! mixed fraction at LFS
+REAL, DIMENSION(:), ALLOCATABLE :: ZTPR ! total surf precipitation (kg/s)
+REAL, DIMENSION(:), ALLOCATABLE :: ZSPR ! solid surf precipitation (kg/s)
+REAL, DIMENSION(:), ALLOCATABLE :: ZDTEVR ! donwndraft evapor. (kg/s)
+REAL, DIMENSION(:), ALLOCATABLE :: ZPREF ! precipitation efficiency
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZDTEVRF ! donwndraft evapor. (kg/s)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZPRLFLX ! liquid precip flux
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZPRSFLX ! solid precip flux
+!
+! closure variables
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZLMASS ! mass of model layer (kg)
+REAL, DIMENSION(:), ALLOCATABLE :: ZTIMEA ! advective time period
+REAL, DIMENSION(:), ALLOCATABLE :: ZTIMEC, ZTIMED! time during which convection is
+ ! active at grid point (as ZTIME)
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZTHC ! conv. adj. grid scale theta
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZRVC ! conv. adj. grid scale r_w
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZRCC ! conv. adj. grid scale r_c
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZRIC ! conv. adj. grid scale r_i
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZWSUB ! envir. compensating subsidence (Pa/s)
+!
+LOGICAL, DIMENSION(:),ALLOCATABLE :: GTRIG1 ! logical mask for convection
+LOGICAL, DIMENSION(:),ALLOCATABLE :: GWORK ! logical work array
+INTEGER, DIMENSION(:),ALLOCATABLE :: IINDEX, IJINDEX, IJSINDEX, IJPINDEX!hor.index
+REAL, DIMENSION(:), ALLOCATABLE :: ZCPH ! specific heat C_ph
+REAL, DIMENSION(:), ALLOCATABLE :: ZLV, ZLS! latent heat of vaporis., sublim.
+REAL :: ZES ! saturation vapor mixng ratio
+!
+! Chemical Tracers:
+REAL, DIMENSION(:,:,:), ALLOCATABLE:: ZCH1 ! grid scale chemical specy (kg/kg)
+REAL, DIMENSION(:,:,:), ALLOCATABLE:: ZCH1C ! conv. adjust. chemical specy 1
+REAL, DIMENSION(:,:), ALLOCATABLE:: ZWORK3 ! work array
+LOGICAL, DIMENSION(:,:,:),ALLOCATABLE::GTRIG4 ! logical mask
+INTEGER :: JN_NO ! index of NO compound in PCH1
+REAL, DIMENSION(:,:),ALLOCATABLE :: ZWORK4, ZWORK4C
+ ! LiNOx conc. and tendency
+REAL, DIMENSION(:,:),ALLOCATABLE :: ZZZ, ZRHODREF
+REAL, DIMENSION(:),ALLOCATABLE :: ZIC_RATE,ZCG_RATE
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 0.3 Compute loop bounds
+! -------------------
+!
+IIB = KIDIA
+IIE = KFDIA
+JCVEXB = MAX( 0, KBDIA - 1 )
+IKB = 1 + JCVEXB
+IKS = KLEV
+JCVEXT = MAX( 0, KTDIA - 1 )
+IKE = IKS - JCVEXT
+!
+!
+!* 0.5 Update convective counter ( where KCOUNT > 0
+! convection is still active ).
+! ---------------------------------------------
+!
+KCOUNT(IIB:IIE) = KCOUNT(IIB:IIE) - 1
+!
+IF ( OREFRESH ) THEN
+ KCOUNT(:) = 1
+ KCOUNT(IIB:IIE) = 0 ! refresh or not at every call
+END IF
+!
+GTRIG(:) = KCOUNT(:) <= 0
+ITEST = COUNT( GTRIG(:) )
+IF ( ITEST == 0 ) THEN ! if convection is already active at every grid point
+ RETURN
+ENDIF
+ ! exit DEEP_CONVECTION
+!
+!
+!* 0.7 Reset convective tendencies to zero if convective
+! counter becomes negative
+! -------------------------------------------------
+!
+DO JJ=1,KLEV ; DO JI=1,KLON
+ GTRIG3(JI,JJ)=GTRIG(JI)
+ENDDO ; ENDDO
+WHERE ( GTRIG3(:,:) )
+ PTTEN(:,:) = 0.
+ PRVTEN(:,:) = 0.
+ PRCTEN(:,:) = 0.
+ PRITEN(:,:) = 0.
+ PPRLFLX(:,:)= 0.
+ PPRSFLX(:,:)= 0.
+! PUTEN(:,:) = 0.
+! PVTEN(:,:) = 0.
+ PUMF(:,:) = 0.
+ PDMF(:,:) = 0.
+END WHERE
+WHERE ( GTRIG(:) )
+ PPRLTEN(:) = 0.
+ PPRSTEN(:) = 0.
+ KCLTOP(:) = 0
+ KCLBAS(:) = 0
+ PCAPE(:) = 0.
+END WHERE
+ALLOCATE( GTRIG4(KLON,KLEV,KCH1) )
+DO JK=1,KCH1; DO JJ=1,KLEV ; DO JI=1,KLON
+!GTRIG4(:,:,:) = SPREAD( GTRIG3(:,:), DIM=3, NCOPIES=KCH1 )
+ GTRIG4(JI,JJ,JK) = GTRIG3(JI,JJ)
+ENDDO ; ENDDO ; ENDDO
+WHERE( GTRIG4(:,:,:) ) PCH1TEN(:,:,:) = 0.
+DEALLOCATE( GTRIG4 )
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. Initialize local variables
+! ----------------------------
+!
+ZEPS = XRD / XRV
+ZEPSA = XRV / XRD
+ZRDOCP = XRD / XCPD
+!
+!
+!* 1.1 Set up grid scale theta, theta_v, theta_es
+! ------------------------------------------
+!
+ZTHT(:,:) = 300.
+ZSTHV(:,:)= 300.
+ZSTHES(:,:)=400.
+DO JK = IKB, IKE
+DO JI = IIB, IIE
+ IF ( PPABST(JI,JK) > 40.E2 ) THEN
+ ZTHT(JI,JK) = PTT(JI,JK) * ( XP00 / PPABST(JI,JK) ) ** ZRDOCP
+ ZSTHV(JI,JK) = ZTHT(JI,JK) * ( 1. + ZEPSA * PRVT(JI,JK) ) / &
+ ( 1. + PRVT(JI,JK) + PRCT(JI,JK) + PRIT(JI,JK) )
+!
+ ! use conservative Bolton (1980) formula for theta_e
+ ! it is used to compute CAPE for undilute parcel ascent
+ ! For economical reasons we do not use routine CONVECT_SATMIXRATIO here
+!
+ ZES = EXP( XALPW - XBETAW / PTT(JI,JK) - XGAMW * LOG( PTT(JI,JK) ) )
+ ZES = ZEPS * ZES / ( PPABST(JI,JK) - ZES )
+ ZSTHES(JI,JK) = PTT(JI,JK) * ( ZTHT(JI,JK) / PTT(JI,JK) ) ** &
+ ( 1. - 0.28 * ZES ) * EXP( ( 3374.6525 / PTT(JI,JK) - 2.5403 ) &
+ * ZES * ( 1. + 0.81 * ZES ) )
+ END IF
+END DO
+END DO
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. Test for convective columns and determine properties at the LCL
+! --------------------------------------------------------------
+!
+!* 2.1 Allocate arrays depending on number of model columns that need
+! to be tested for convection (i.e. where no convection is present
+! at the moment.
+! --------------------------------------------------------------
+!
+ALLOCATE( ZPRES(ITEST,IKS) )
+ALLOCATE( ZZ(ITEST,IKS) )
+ALLOCATE( ZW(ITEST,IKS) )
+ALLOCATE( ZTH(ITEST,IKS) )
+ALLOCATE( ZTHV(ITEST,IKS) )
+ALLOCATE( ZTHEST(ITEST,IKS) )
+ALLOCATE( ZRV(ITEST,IKS) )
+ALLOCATE( ZSTHLCL(ITEST) )
+ALLOCATE( ZSTLCL(ITEST) )
+ALLOCATE( ZSRVLCL(ITEST) )
+ALLOCATE( ZSWLCL(ITEST) )
+ALLOCATE( ZSZLCL(ITEST) )
+ALLOCATE( ZSTHVELCL(ITEST) )
+ALLOCATE( ISDPL(ITEST) )
+ALLOCATE( ISPBL(ITEST) )
+ALLOCATE( ISLCL(ITEST) )
+ALLOCATE( ZSDXDY(ITEST) )
+ALLOCATE( GTRIG1(ITEST) )
+ALLOCATE( ZCAPE(ITEST) )
+ALLOCATE( IINDEX(KLON) )
+ALLOCATE( IJSINDEX(ITEST) )
+DO JI = 1, KLON
+ IINDEX(JI) = JI
+END DO
+IJSINDEX(:) = PACK( IINDEX(:), MASK=GTRIG(:) )
+!
+ZPRES = 0.
+ZZ = 0.
+ZTH = 0.
+ZTHV = 0.
+ZTHEST = 0.
+ZRV = 0.
+ZW = 0.
+!
+DO JK = IKB, IKE
+DO JI = 1, ITEST
+ JL = IJSINDEX(JI)
+ ZPRES(JI,JK) = PPABST(JL,JK)
+ ZZ(JI,JK) = PZZ(JL,JK)
+ ZTH(JI,JK) = ZTHT(JL,JK)
+ ZTHV(JI,JK) = ZSTHV(JL,JK)
+ ZTHEST(JI,JK) = ZSTHES(JL,JK)
+ ZRV(JI,JK) = MAX( 0., PRVT(JL,JK) )
+ ZW(JI,JK) = PWT(JL,JK)
+END DO
+END DO
+DO JI = 1, ITEST
+ JL = IJSINDEX(JI)
+ ZSDXDY(JI) = PDXDY(JL)
+END DO
+!
+!* 2.2 Compute environm. enthalpy and total water = r_v + r_i + r_c
+! and envir. saturation theta_e
+! ------------------------------------------------------------
+!
+!
+!* 2.3 Test for convective columns and determine properties at the LCL
+! --------------------------------------------------------------
+!
+ISLCL(:) = MAX( IKB, 2 ) ! initialize DPL PBL and LCL
+ISDPL(:) = IKB
+ISPBL(:) = IKB
+!
+!
+CALL CONVECT_TRIGGER_FUNCT( ITEST, KLEV, &
+ ZPRES, ZTH, ZTHV, ZTHEST, &
+ ZRV, ZW, ZZ, ZSDXDY, &
+ ZSTHLCL, ZSTLCL, ZSRVLCL, ZSWLCL, ZSZLCL, &
+ ZSTHVELCL, ISLCL, ISDPL, ISPBL, GTRIG1, &
+ ZCAPE )
+!
+DO JI = 1, ITEST
+ JL = IJSINDEX(JI)
+ PCAPE(JL) = ZCAPE(JI)
+END DO
+!
+DEALLOCATE( ZPRES )
+DEALLOCATE( ZZ )
+DEALLOCATE( ZTH )
+DEALLOCATE( ZTHV )
+DEALLOCATE( ZTHEST )
+DEALLOCATE( ZRV )
+DEALLOCATE( ZW )
+DEALLOCATE( ZCAPE )
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. After the call of TRIGGER_FUNCT we allocate all the dynamic
+! arrays used in the convection scheme using the mask GTRIG, i.e.
+! we do calculus only in convective columns. This corresponds to
+! a GATHER operation.
+! --------------------------------------------------------------
+!
+ICONV = COUNT( GTRIG1(:) )
+IF ( ICONV == 0 ) THEN
+ DEALLOCATE( ZSTHLCL )
+ DEALLOCATE( ZSTLCL )
+ DEALLOCATE( ZSRVLCL )
+ DEALLOCATE( ZSWLCL )
+ DEALLOCATE( ZSZLCL )
+ DEALLOCATE( ZSTHVELCL )
+ DEALLOCATE( ZSDXDY )
+ DEALLOCATE( ISLCL )
+ DEALLOCATE( ISDPL )
+ DEALLOCATE( ISPBL )
+ DEALLOCATE( GTRIG1 )
+ DEALLOCATE( IINDEX )
+ DEALLOCATE( IJSINDEX )
+ RETURN ! no convective column has been found, exit DEEP_CONVECTION
+ ENDIF
+!
+ ! vertical index variables
+!
+ALLOCATE( IDPL(ICONV) )
+ALLOCATE( IPBL(ICONV) )
+ALLOCATE( ILCL(ICONV) )
+ALLOCATE( ICTL(ICONV) )
+ALLOCATE( IETL(ICONV) )
+!
+ ! grid scale variables
+!
+ALLOCATE( ZZ(ICONV,IKS) ) ; ZZ = 0.0
+ALLOCATE( ZPRES(ICONV,IKS) ) ; ZPRES = 0.0
+ALLOCATE( ZDPRES(ICONV,IKS) ) ; ZDPRES = 0.0
+ALLOCATE( ZU(ICONV,IKS) ) ; ZU = 0.0
+ALLOCATE( ZV(ICONV,IKS) ) ; ZV = 0.0
+ALLOCATE( ZTT(ICONV, IKS) ) ; ZTT = 0.0
+ALLOCATE( ZTH(ICONV,IKS) ) ; ZTH = 0.0
+ALLOCATE( ZTHV(ICONV,IKS) ) ; ZTHV = 0.0
+ALLOCATE( ZTHL(ICONV,IKS) ) ; ZTHL = 0.0
+ALLOCATE( ZTHES(ICONV,IKS) ) ; ZTHES = 0.0
+ALLOCATE( ZRV(ICONV,IKS) ) ; ZRV = 0.0
+ALLOCATE( ZRC(ICONV,IKS) ) ; ZRC = 0.0
+ALLOCATE( ZRI(ICONV,IKS) ) ; ZRI = 0.0
+ALLOCATE( ZRW(ICONV,IKS) ) ; ZRW = 0.0
+ALLOCATE( ZDXDY(ICONV) ) ; ZDXDY = 0.0
+!
+ ! updraft variables
+!
+ALLOCATE( ZUMF(ICONV,IKS) )
+ALLOCATE( ZUER(ICONV,IKS) )
+ALLOCATE( ZUDR(ICONV,IKS) )
+ALLOCATE( ZUPR(ICONV,IKS) )
+ALLOCATE( ZUTHL(ICONV,IKS) )
+ALLOCATE( ZUTHV(ICONV,IKS) )
+ALLOCATE( ZUTT(ICONV,IKS) )
+ALLOCATE( ZURW(ICONV,IKS) )
+ALLOCATE( ZURC(ICONV,IKS) )
+ALLOCATE( ZURI(ICONV,IKS) )
+ALLOCATE( ZURR(ICONV,IKS) )
+ALLOCATE( ZURS(ICONV,IKS) )
+ALLOCATE( ZUTPR(ICONV) )
+ALLOCATE( ZTHLCL(ICONV) )
+ALLOCATE( ZTLCL(ICONV) )
+ALLOCATE( ZRVLCL(ICONV) )
+ALLOCATE( ZWLCL(ICONV) )
+ALLOCATE( ZMFLCL(ICONV) )
+ALLOCATE( ZZLCL(ICONV) )
+ALLOCATE( ZTHVELCL(ICONV) )
+ALLOCATE( ZCAPE(ICONV) )
+!
+! work variables
+!
+ALLOCATE( IJINDEX(ICONV) )
+ALLOCATE( IJPINDEX(ICONV) )
+ALLOCATE( ZCPH(ICONV) )
+ALLOCATE( ZLV(ICONV) )
+ALLOCATE( ZLS(ICONV) )
+!
+!
+!* 3.1 Gather grid scale and updraft base variables in
+! arrays using mask GTRIG
+! ---------------------------------------------------
+!
+GTRIG(:) = UNPACK( GTRIG1(:), MASK=GTRIG, FIELD=.FALSE. )
+IJINDEX(:) = PACK( IINDEX(:), MASK=GTRIG(:) )
+!
+DO JK = IKB, IKE
+DO JI = 1, ICONV
+ JL = IJINDEX(JI)
+ ZZ(JI,JK) = PZZ(JL,JK)
+ ZPRES(JI,JK) = PPABST(JL,JK)
+ ZTT(JI,JK) = PTT(JL,JK)
+ ZTH(JI,JK) = ZTHT(JL,JK)
+ ZTHES(JI,JK) = ZSTHES(JL,JK)
+ ZRV(JI,JK) = MAX( 0., PRVT(JL,JK) )
+ ZRC(JI,JK) = MAX( 0., PRCT(JL,JK) )
+ ZRI(JI,JK) = MAX( 0., PRIT(JL,JK) )
+ ZTHV(JI,JK) = ZSTHV(JL,JK)
+ ZU(JI,JK) = PUT(JL,JK)
+ ZV(JI,JK) = PVT(JL,JK)
+END DO
+END DO
+IF ( OSETTADJ ) THEN
+ ALLOCATE( ZTIMED(ICONV) )
+ DO JI = 1, ICONV
+ JL = IJINDEX(JI)
+ ZTIMED(JI) = PTIMEC(JL)
+ END DO
+END IF
+!
+DO JI = 1, ITEST
+ IJSINDEX(JI) = JI
+END DO
+IJPINDEX(:) = PACK( IJSINDEX(:), MASK=GTRIG1(:) )
+DO JI = 1, ICONV
+ JL = IJPINDEX(JI)
+ IDPL(JI) = ISDPL(JL)
+ IPBL(JI) = ISPBL(JL)
+ ILCL(JI) = ISLCL(JL)
+ ZTHLCL(JI) = ZSTHLCL(JL)
+ ZTLCL(JI) = ZSTLCL(JL)
+ ZRVLCL(JI) = ZSRVLCL(JL)
+ ZWLCL(JI) = ZSWLCL(JL)
+ ZZLCL(JI) = ZSZLCL(JL)
+ ZTHVELCL(JI) = ZSTHVELCL(JL)
+ ZDXDY(JI) = ZSDXDY(JL)
+END DO
+ALLOCATE( GWORK(ICONV) )
+GWORK(:) = PACK( GTRIG1(:), MASK=GTRIG1(:) )
+DEALLOCATE( GTRIG1 )
+ALLOCATE( GTRIG1(ICONV) )
+GTRIG1(:) = GWORK(:)
+!
+DEALLOCATE( GWORK )
+DEALLOCATE( IJPINDEX )
+DEALLOCATE( ISDPL )
+DEALLOCATE( ISPBL )
+DEALLOCATE( ISLCL )
+DEALLOCATE( ZSTHLCL )
+DEALLOCATE( ZSTLCL )
+DEALLOCATE( ZSRVLCL )
+DEALLOCATE( ZSWLCL )
+DEALLOCATE( ZSZLCL )
+DEALLOCATE( ZSTHVELCL )
+DEALLOCATE( ZSDXDY )
+!
+!
+!* 3.2 Compute pressure difference
+! ---------------------------------------------------
+!
+ZDPRES(:,IKB) = 0.
+DO JK = IKB + 1, IKE
+ ZDPRES(:,JK) = ZPRES(:,JK-1) - ZPRES(:,JK)
+END DO
+!
+!* 3.3 Compute environm. enthalpy and total water = r_v + r_i + r_c
+! ----------------------------------------------------------
+!
+DO JK = IKB, IKE, 1
+ ZRW(:,JK) = ZRV(:,JK) + ZRC(:,JK) + ZRI(:,JK)
+ ZCPH(:) = XCPD + XCPV * ZRW(:,JK)
+ ZLV(:) = XLVTT + ( XCPV - XCL ) * ( ZTT(:,JK) - XTT ) ! compute L_v
+ ZLS(:) = XLSTT + ( XCPV - XCI ) * ( ZTT(:,JK) - XTT ) ! compute L_i
+ ZTHL(:,JK) = ZCPH(:) * ZTT(:,JK) + ( 1. + ZRW(:,JK) ) * XG * ZZ(:,JK) &
+ - ZLV(:) * ZRC(:,JK) - ZLS(:) * ZRI(:,JK)
+END DO
+!
+!-------------------------------------------------------------------------------
+!
+!* 4. Compute updraft properties
+! ----------------------------
+!
+!* 4.1 Set mass flux at LCL ( here a unit mass flux with w = 1 m/s )
+! -------------------------------------------------------------
+!
+DO JI = 1, ICONV
+ JK = ILCL(JI) - 1
+ ZMFLCL(JI) = ZPRES(JI,JK) / ( XRD * ZTT(JI,JK) * &
+ ( 1. + ZEPS * ZRVLCL(JI) ) ) * XPI * XCRAD * XCRAD &
+ * MAX ( 1., ZDXDY(JI)/XA25 )
+END DO
+!
+DEALLOCATE( ZCPH )
+DEALLOCATE( ZLV )
+DEALLOCATE( ZLS )
+!
+!
+CALL CONVECT_UPDRAFT( ICONV, KLEV, &
+ KICE, ZPRES, ZDPRES, ZZ, ZTHL, ZTHV, ZTHES, ZRW, &
+ ZTHLCL, ZTLCL, ZRVLCL, ZWLCL, ZZLCL, ZTHVELCL, &
+ ZMFLCL, GTRIG1, ILCL, IDPL, IPBL, &
+ ZUMF, ZUER, ZUDR, ZUTHL, ZUTHV, ZURW, &
+ ZURC, ZURI, ZURR, ZURS, ZUPR, &
+ ZUTPR, ZCAPE, ICTL, IETL, ZUTT )
+!
+!
+!
+!* 4.2 In routine UPDRAFT GTRIG1 has been set to false when cloud
+! thickness is smaller than 3 km
+! -----------------------------------------------------------
+!
+!
+ICONV1 = COUNT(GTRIG1)
+!
+IF ( ICONV1 > 0 ) THEN
+!
+!* 4.3 Allocate memory for downdraft variables
+! ---------------------------------------
+!
+! downdraft variables
+!
+ ALLOCATE( ILFS(ICONV) )
+ ALLOCATE( IDBL(ICONV) )
+ ALLOCATE( IML(ICONV) )
+ ALLOCATE( ZDMF(ICONV,IKS) )
+ ALLOCATE( ZDER(ICONV,IKS) )
+ ALLOCATE( ZDDR(ICONV,IKS) )
+ ALLOCATE( ZDTHL(ICONV,IKS) )
+ ALLOCATE( ZDRW(ICONV,IKS) )
+ ALLOCATE( ZLMASS(ICONV,IKS) ) ; ZLMASS = 0.0
+ DO JK = IKB, IKE
+ ZLMASS(:,JK) = ZDXDY(:) * ZDPRES(:,JK) / XG ! mass of model layer
+ END DO
+ ZLMASS(:,IKB) = ZLMASS(:,IKB+1)
+ ALLOCATE( ZMIXF(ICONV) )
+ ALLOCATE( ZTPR(ICONV) )
+ ALLOCATE( ZSPR(ICONV) )
+ ALLOCATE( ZDTEVR(ICONV) )
+ ALLOCATE( ZPREF(ICONV) )
+ ALLOCATE( ZDTEVRF(ICONV,IKS) )
+ ALLOCATE( ZPRLFLX(ICONV,IKS) )
+ ALLOCATE( ZPRSFLX(ICONV,IKS) )
+!
+! closure variables
+!
+ ALLOCATE( ZTIMEA(ICONV) )
+ ALLOCATE( ZTIMEC(ICONV) )
+ ALLOCATE( ZTHC(ICONV,IKS) )
+ ALLOCATE( ZRVC(ICONV,IKS) )
+ ALLOCATE( ZRCC(ICONV,IKS) )
+ ALLOCATE( ZRIC(ICONV,IKS) )
+ ALLOCATE( ZWSUB(ICONV,IKS) )
+!
+!-------------------------------------------------------------------------------
+!
+!* 5. Compute downdraft properties
+! ----------------------------
+!
+!* 5.1 Compute advective time period and precipitation
+! efficiency as a function of mean ambient wind (shear)
+! --------------------------------------------------------
+!
+ CALL CONVECT_TSTEP_PREF( ICONV, KLEV, &
+ ZU, ZV, ZPRES, ZZ, ZDXDY, ILCL, ICTL, &
+ ZTIMEA, ZPREF )
+!
+ ! exclude convective downdrafts if desired
+ IF ( .NOT. ODOWN ) ZPREF(:) = 1.
+!
+! Compute the period during which convection is active
+ ZTIMEC(:) = MAX( 1800., MIN( 3600., ZTIMEA(:) ) )
+ ZTIMEC(:) = REAL( INT( ZTIMEC(:) / PDTCONV ) ) * PDTCONV
+ ZTIMEC(:) = MAX( PDTCONV, ZTIMEC(:) ) ! necessary if PDTCONV > 1800
+ IF ( OSETTADJ ) THEN
+ ZTIMEC(:) = MAX( PDTCONV, ZTIMED(:) )
+ END IF
+!
+!
+!* 5.2 Compute melting level
+! ----------------------
+!
+ IML(:) = IKB
+ DO JK = IKE, IKB, -1
+ WHERE( ZTT(:,JK) <= XTT ) IML(:) = JK
+ END DO
+!
+ CALL CONVECT_DOWNDRAFT( ICONV, KLEV, &
+ KICE, ZPRES, ZDPRES, ZZ, ZTH, ZTHES, &
+ ZRW, ZRC, ZRI, &
+ ZPREF, ILCL, ICTL, IETL, &
+ ZUTHL, ZURW, ZURC, ZURI, &
+ ZDMF, ZDER, ZDDR, ZDTHL, ZDRW, &
+ ZMIXF, ZDTEVR, ILFS, IDBL, IML, &
+ ZDTEVRF )
+!
+!-------------------------------------------------------------------------------
+!
+!* 6. Adjust up and downdraft mass flux to be consistent
+! with precipitation efficiency relation.
+! ---------------------------------------------------
+!
+ CALL CONVECT_PRECIP_ADJUST( ICONV, KLEV, &
+ ZPRES,ZUMF, ZUER, ZUDR, ZUPR, ZUTPR, ZURW,&
+ ZDMF, ZDER, ZDDR, ZDTHL, ZDRW, &
+ ZPREF, ZTPR, ZMIXF, ZDTEVR, &
+ ILFS, IDBL, ILCL, ICTL, IETL, &
+ ZDTEVRF )
+!
+!-------------------------------------------------------------------------------
+!
+!* 7. Determine adjusted environmental values assuming
+! that all available buoyant energy must be removed
+! within an advective time step ZTIMEC.
+! ---------------------------------------------------
+!
+ CALL CONVECT_CLOSURE( ICONV, KLEV, &
+ ZPRES, ZDPRES, ZZ, ZDXDY, ZLMASS, &
+ ZTHL, ZTH, ZRW, ZRC, ZRI, GTRIG1, &
+ ZTHC, ZRVC, ZRCC, ZRIC, ZWSUB, &
+ ILCL, IDPL, IPBL, ILFS, ICTL, IML, &
+ ZUMF, ZUER, ZUDR, ZUTHL, ZURW, &
+ ZURC, ZURI, ZUPR, &
+ ZDMF, ZDER, ZDDR, ZDTHL, ZDRW, &
+ ZTPR, ZSPR, ZDTEVR, &
+ ZCAPE, ZTIMEC, &
+ IFTSTEPS, &
+ ZDTEVRF, ZPRLFLX, ZPRSFLX )
+!
+!-------------------------------------------------------------------------------
+!
+!* 8. Determine the final grid-scale (environmental) convective
+! tendencies and set convective counter
+! --------------------------------------------------------
+!
+!
+!* 8.1 Grid scale tendencies
+! ---------------------
+!
+! in order to save memory, the tendencies are temporarily stored
+! in the tables for the adjusted grid-scale values
+!
+ DO JK = IKB, IKE
+ ZTHC(:,JK) = ( ZTHC(:,JK) - ZTH(:,JK) ) / ZTIMEC(:) &
+ * ( ZPRES(:,JK) / XP00 ) ** ZRDOCP ! change theta in temperature
+ ZRVC(:,JK) = ( ZRVC(:,JK) - ZRW(:,JK) + ZRC(:,JK) + ZRI(:,JK) )/ ZTIMEC(:)
+ ZRCC(:,JK) = ( ZRCC(:,JK) - ZRC(:,JK) ) / ZTIMEC(:)
+ ZRIC(:,JK) = ( ZRIC(:,JK) - ZRI(:,JK) ) / ZTIMEC(:)
+!
+ ZPRLFLX(:,JK) = ZPRLFLX(:,JK) / ( XRHOLW * ZDXDY(:) )
+ ZPRSFLX(:,JK) = ZPRSFLX(:,JK) / ( XRHOLW * ZDXDY(:) )
+!
+ END DO
+!
+ ZPRLFLX(:,IKB) = ZPRLFLX(:,IKB+1)
+ ZPRSFLX(:,IKB) = ZPRSFLX(:,IKB+1)
+!
+!
+!* 8.2 Apply conservation correction
+! -----------------------------
+!
+ ! Compute vertical integrals
+!
+! Reproducibility
+! JKM = MAXVAL( ICTL(:) )
+ JKM = IKE - 1
+ ZWORK2(:) = 0.
+ ZWORK2B(:) = 0.
+ DO JK = IKB+1, JKM
+ JKP = JK + 1
+ DO JI = 1, ICONV
+ ZW1 = .5 * (ZPRES(JI,JK-1) - ZPRES(JI,JKP)) / XG
+ ZWORK2(JI) = ZWORK2(JI) + ( ZRVC(JI,JK) + ZRCC(JI,JK) + ZRIC(JI,JK) ) * ZW1 ! moisture
+ ZWORK2B(JI) = ZWORK2B(JI) + ( ( XCPD + XCPV * ZRW(JI,JK) )* ZTHC(JI,JK) - &
+ ( XLVTT + ( XCPV - XCL ) * ( ZTT(JI,JK) - XTT ) ) * ZRCC(JI,JK) - &
+ ( XLSTT + ( XCPV - XCL ) * ( ZTT(JI,JK) - XTT ) ) * ZRIC(JI,JK) ) * &
+ ZW1 ! enthalpy
+ END DO
+ END DO
+!
+ ! Budget error (compare integral to surface precip.)
+!
+ DO JI = 1, ICONV
+ IF ( ZTPR(JI) > 0.) THEN
+ ZW1 = XG / ( ZPRES(JI,IKB) - ZPRES(JI,JKP) - .5 * ( &
+ ZDPRES(JI,IKB+1) - ZDPRES(JI,JKP+1) ) )
+ ZWORK2(JI) = ( ZTPR(JI) / ZDXDY(JI) + ZWORK2(JI) ) * ZW1
+ ZWORK2B(JI) = ( ZTPR(JI) / ZDXDY(JI) * &
+ ( XLVTT + ( XCPV - XCL ) * ( ZTT(JI,IKB) - XTT ) ) - ZWORK2B(JI) ) &
+ * ZW1
+ END IF
+ END DO
+!
+ ! Apply uniform correction
+!
+ DO JK = JKM, IKB+1, -1
+ DO JI = 1, ICONV
+ IF ( ZTPR(JI) > 0. .AND. JK <= ICTL(JI) ) THEN
+ ! ZW1 = ABS(ZRVC(JI,JK)) + ABS(ZRCC(JI,JK)) + ABS(ZRIC(JI,JK)) + 1.E-12
+ ! ZRVC(JI,JK) = ZRVC(JI,JK) - ABS(ZRVC(JI,JK))/ZW1*ZWORK2(JI) ! moisture
+ ZRVC(JI,JK) = ZRVC(JI,JK) - ZWORK2(JI) ! moisture
+ ! ZRCC(JI,JK) = ZRCC(JI,JK) - ABS(ZRCC(JI,JK))/ZW1*ZWORK2(JI)
+ ! ZRIC(JI,JK) = ZRIC(JI,JK) - ABS(ZRIC(JI,JK))/ZW1*ZWORK2(JI)
+ ZTHC(JI,JK) = ZTHC(JI,JK) + ZWORK2B(JI) / ( XCPD + XCPV * ZRW(JI,JK) )! energy
+ END IF
+ END DO
+ END DO
+!
+!
+! execute a "scatter"= pack command to store the tendencies in
+! the final 2D tables
+!
+ DO JK = IKB, IKE
+ DO JI = 1, ICONV
+ JL = IJINDEX(JI)
+ PTTEN(JL,JK) = ZTHC(JI,JK)
+ PRVTEN(JL,JK) = ZRVC(JI,JK)
+ PRCTEN(JL,JK) = ZRCC(JI,JK)
+ PRITEN(JL,JK) = ZRIC(JI,JK)
+!
+ PPRLFLX(JL,JK) = ZPRLFLX(JI,JK)
+ PPRSFLX(JL,JK) = ZPRSFLX(JI,JK)
+ END DO
+ END DO
+!
+!
+!* 8.3 Convective rainfall tendency
+! ----------------------------
+!
+ ! liquid and solid surface rainfall tendency in m/s
+ ZTPR(:) = ZTPR(:) / ( XRHOLW * ZDXDY(:) ) ! total surf precip
+ ZSPR(:) = ZSPR(:) / ( XRHOLW * ZDXDY(:) ) ! solid surf precip
+ ZTPR(:) = ZTPR(:) - ZSPR(:) ! compute liquid part
+!
+ DO JI = 1, ICONV
+ JL = IJINDEX(JI)
+ PPRLTEN(JL) = ZTPR(JI)
+ PPRSTEN(JL) = ZSPR(JI)
+ END DO
+!
+!
+! Cloud base and top levels
+! -------------------------
+!
+ ILCL(:) = MIN( ILCL(:), ICTL(:) )
+ DO JI = 1, ICONV
+ JL = IJINDEX(JI)
+ KCLTOP(JL) = ICTL(JI)
+ KCLBAS(JL) = ILCL(JI)
+ END DO
+!
+!
+!* 8.4 Set convective counter
+! ----------------------
+!
+ ! compute convective counter for just activated convective
+ ! grid points
+ ! If the advective time period is less than specified
+ ! minimum for convective period, allow feedback to occur only
+ ! during advective time
+!
+ ZTIME(:) = 1.
+ ZWORK2(:) = 0.
+ DO JI = 1, ICONV
+ JL = IJINDEX(JI)
+ ZTIME(JL) = ZTIMEC(JI)
+ ZWORK2(JL) = ZTIMEA(JI)
+ ZWORK2(JL) = MIN( ZWORK2(JL), ZTIME(JL) )
+ ZWORK2(JL) = MAX( ZWORK2(JL), PDTCONV )
+ IF ( GTRIG(JL) ) KCOUNT(JL) = INT( ZWORK2(JL) / PDTCONV )
+ IF ( GTRIG(JL) .AND. PPRLTEN(JL)<1.E-14 ) KCOUNT(JL) = 0
+ END DO
+!
+!
+!* 8.7 Compute convective tendencies for Tracers
+! ------------------------------------------
+!
+ IF ( OCH1CONV ) THEN
+!
+ ALLOCATE( ZCH1(ICONV,IKS,KCH1) ) ; ZCH1 = 0.0
+ ALLOCATE( ZCH1C(ICONV,IKS,KCH1) ) ; ZCH1C = 0.0
+ ALLOCATE( ZWORK3(ICONV,KCH1) )
+!
+ ALLOCATE( ZRHODREF(ICONV,IKS) )
+ ZRHODREF=0.
+ IF ( OCH_CONV_LINOX ) THEN
+ ALLOCATE( ZZZ(ICONV,IKS) )
+ ALLOCATE( ZIC_RATE(ICONV) )
+ ALLOCATE( ZCG_RATE(ICONV) )
+ ALLOCATE( ZWORK4(ICONV,IKS) )
+ ALLOCATE( ZWORK4C(ICONV,IKS) )
+ ZZZ=0.
+ ZIC_RATE=0.
+ ZCG_RATE=0.
+ ZWORK4=0.
+ ZWORK4C=0.
+ END IF
+!
+ DO JI = 1, ICONV
+ DO JK = IKB, IKE
+ JL = IJINDEX(JI)
+ ZCH1(JI,JK,:) = PCH1(JL,JK,:)
+ ZRHODREF(JI,JK)=PRHODREF(JL,JK)
+ END DO
+ ZRHODREF(JI,1) = PRHODREF(JL,IKB)
+ ZRHODREF(JI,IKS) = PRHODREF(JL,IKE)
+ END DO
+ ZCH1(:,1,:) = ZCH1(:,IKB,:)
+ ZCH1(:,IKS,:) = ZCH1(:,IKE,:)
+!
+ JN_NO = 0
+ IF ( OCH_CONV_LINOX ) THEN
+ DO JK = IKB, IKE
+ DO JI = 1, ICONV
+ JL = IJINDEX(JI)
+ ZZZ(JI,JK)=PZZ(JL,JK)
+ ZIC_RATE(JI)=PIC_RATE(JL)
+ ZCG_RATE(JI)=PCG_RATE(JL)
+ END DO
+ END DO
+ IF (OUSECHEM) THEN
+ DO JN = NSV_CHEMBEG,NSV_CHEMEND
+ IF (CNAMES(JN-NSV_CHEMBEG+1)=='NO') JN_NO = JN
+ END DO
+ ELSE
+ JN_NO = NSV_LNOXBEG
+ ENDIF
+ ZWORK4(:,:) = ZCH1(:,:,JN_NO)
+ CALL CH_CONVECT_LINOX( ICONV, KLEV, ZWORK4, ZWORK4C, &
+ IDPL, IPBL, ILCL, ICTL, ILFS, IDBL, &
+ ZUMF, ZUER, ZUDR, ZDMF, ZDER, ZDDR, &
+ ZTIMEC, ZDXDY, ZMIXF, ZLMASS, ZWSUB, &
+ IFTSTEPS, ZUTT, ZRHODREF, &
+ OUSECHEM, ZZZ, ZIC_RATE, ZCG_RATE )
+ DO JI = 1, ICONV
+ JL = IJINDEX(JI)
+ PIC_RATE(JL)=ZIC_RATE(JI)
+ PCG_RATE(JL)=ZCG_RATE(JI)
+ ENDDO
+ ENDIF
+!
+ IF ((OUSECHEM .AND. OCH_CONV_SCAV).OR.(ODUST .AND. OCH_CONV_SCAV).OR.&
+ (OSALT .AND. OCH_CONV_SCAV) ) THEN
+!
+ CALL CH_CONVECT_SCAVENGING( ICONV, KLEV, KCH1, ZCH1, ZCH1C, &
+ IDPL, IPBL, ILCL, ICTL, ILFS, IDBL, &
+ ZUMF, ZUER, ZUDR, ZDMF, ZDER, ZDDR, &
+ ZTIMEC, ZDXDY, ZMIXF, ZLMASS, ZWSUB, &
+ IFTSTEPS, &
+ ZURC, ZURR, ZURI, ZURS, ZUTT, ZPRES, &
+ ZRHODREF, PPABST, ZTHT )
+!
+ IF (OCH_CONV_LINOX) THEN
+ ZCH1C(:,:,JN_NO) = ZWORK4C(:,:)
+ ENDIF
+! no conservation correction for scavenging
+ DO JI = 1, ICONV
+ JL = IJINDEX(JI)
+ IF ( ZTPR(JI) > 0. ) THEN
+ DO JK = IKB, IKE
+ PCH1TEN(JL,JK,:) = (ZCH1C(JI,JK,:)- ZCH1(JI,JK,:)) /ZTIMEC(JI)
+ END DO
+ ELSE
+ DO JK = IKB, IKE
+ PCH1TEN(JL,JK,:) = 0.
+ END DO
+ ENDIF
+ END DO
+
+!
+ ELSE
+!
+ CALL CONVECT_CHEM_TRANSPORT( ICONV, KLEV, KCH1, ZCH1, ZCH1C, &
+ IDPL, IPBL, ILCL, ICTL, ILFS, IDBL, &
+ ZUMF, ZUER, ZUDR, ZDMF, ZDER, ZDDR, &
+ ZTIMEC, ZDXDY, ZMIXF, ZLMASS, ZWSUB, &
+ IFTSTEPS )
+!
+ IF (OCH_CONV_LINOX) THEN
+ ZCH1C(:,:,JN_NO) = ZWORK4C(:,:)
+ ENDIF
+!
+!* 8.8 Apply conservation correction
+! -----------------------------
+!
+ ! Compute vertical integrals
+!
+! Reproducibility
+! JKM = MAXVAL( ICTL(:) )
+ JKM = IKE - 1
+ DO JN = 1, KCH1
+ IF((JN < NSV_LGBEG .OR. JN>NSV_LGEND-1) .AND. JN .NE. JN_NO ) THEN
+ ! no correction for Lagrangian and LiNOx variables
+ ZWORK3(:,JN) = 0.
+ ZWORK2(:) = 0.
+ DO JK = IKB+1, JKM
+ JKP = JK + 1
+ DO JI = 1, ICONV
+ ZW1 = .5 * (ZPRES(JI,JK-1) - ZPRES(JI,JKP))
+ ZWORK3(JI,JN) = ZWORK3(JI,JN) + (ZCH1C(JI,JK,JN)-ZCH1(JI,JK,JN)) * ZW1
+ ZWORK2(JI) = ZWORK2(JI) + ABS(ZCH1C(JI,JK,JN)) * ZW1
+ END DO
+ END DO
+!
+ ! Apply concentration weighted correction
+!
+ DO JK = JKM, IKB+1, -1
+ DO JI = 1, ICONV
+ IF ( ZTPR(JI) > 0. .AND. JK <= ICTL(JI) ) THEN
+ ZCH1C(JI,JK,JN) = ZCH1C(JI,JK,JN) - &
+ ZWORK3(JI,JN)*ABS(ZCH1C(JI,JK,JN))/MAX(1.E-30,ZWORK2(JI))
+ ! ZCH1C(JI,JK,JN) = MAX( ZCH1C(JI,JK,JN), -ZCH1(JI,JK,JN)/ZTIMEC(JI) )
+ END IF
+ END DO
+ END DO
+ END IF
+!
+ DO JI = 1, ICONV
+ JL = IJINDEX(JI)
+ IF ( ZTPR(JI) > 0. ) THEN
+ DO JK = IKB, IKE
+ PCH1TEN(JL,JK,JN) = (ZCH1C(JI,JK,JN)-ZCH1(JI,JK,JN) ) /ZTIMEC(JI)
+ END DO
+ ELSE
+ DO JK = IKB, IKE
+ PCH1TEN(JL,JK,JN) = 0.
+ END DO
+ ENDIF
+ END DO
+ END DO
+ END IF
+ END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 9. Write up- and downdraft mass fluxes
+! ------------------------------------
+!
+ DO JK = IKB, IKE
+ ZUMF(:,JK) = ZUMF(:,JK) / ZDXDY(:) ! Mass flux per unit area
+ ZDMF(:,JK) = ZDMF(:,JK) / ZDXDY(:)
+ END DO
+ ZWORK2(:) = 1.
+ WHERE ( PPRLTEN(:)<1.E-14 ) ZWORK2(:) = 0.
+ DO JK = IKB, IKE
+ DO JI = 1, ICONV
+ JL = IJINDEX(JI)
+ PUMF(JL,JK) = ZUMF(JI,JK) * ZWORK2(JL)
+ PDMF(JL,JK) = ZDMF(JI,JK) * ZWORK2(JL)
+ END DO
+ END DO
+!
+!-------------------------------------------------------------------------------
+!
+!* 10. Deallocate all local arrays
+! ---------------------------
+!
+! downdraft variables
+!
+ DEALLOCATE( ZDMF )
+ DEALLOCATE( ZDER )
+ DEALLOCATE( ZDDR )
+ DEALLOCATE( ZDTHL )
+ DEALLOCATE( ZDRW )
+ DEALLOCATE( ZLMASS )
+ DEALLOCATE( ZMIXF )
+ DEALLOCATE( ZTPR )
+ DEALLOCATE( ZSPR )
+ DEALLOCATE( ZDTEVR )
+ DEALLOCATE( ZPREF )
+ DEALLOCATE( IML )
+ DEALLOCATE( ILFS )
+ DEALLOCATE( IDBL )
+ DEALLOCATE( ZDTEVRF )
+ DEALLOCATE( ZPRLFLX )
+ DEALLOCATE( ZPRSFLX )
+!
+! closure variables
+!
+ DEALLOCATE( ZTIMEA )
+ DEALLOCATE( ZTIMEC )
+ DEALLOCATE( ZTHC )
+ DEALLOCATE( ZRVC )
+ DEALLOCATE( ZRCC )
+ DEALLOCATE( ZRIC )
+ DEALLOCATE( ZWSUB )
+!
+ IF ( OCH1CONV ) THEN
+ DEALLOCATE( ZCH1 )
+ DEALLOCATE( ZCH1C )
+ DEALLOCATE( ZWORK3 )
+ DEALLOCATE( ZRHODREF )
+ IF ( OCH_CONV_LINOX ) THEN
+ DEALLOCATE( ZZZ )
+ DEALLOCATE( ZIC_RATE )
+ DEALLOCATE( ZCG_RATE )
+ DEALLOCATE( ZWORK4 )
+ DEALLOCATE( ZWORK4C )
+ END IF
+ END IF
+!
+ENDIF
+!
+! vertical index
+!
+DEALLOCATE( IDPL )
+DEALLOCATE( IPBL )
+DEALLOCATE( ILCL )
+DEALLOCATE( ICTL )
+DEALLOCATE( IETL )
+!
+! grid scale variables
+!
+DEALLOCATE( ZZ )
+DEALLOCATE( ZPRES )
+DEALLOCATE( ZDPRES )
+DEALLOCATE( ZU )
+DEALLOCATE( ZV )
+DEALLOCATE( ZTT )
+DEALLOCATE( ZTH )
+DEALLOCATE( ZTHV )
+DEALLOCATE( ZTHL )
+DEALLOCATE( ZTHES )
+DEALLOCATE( ZRW )
+DEALLOCATE( ZRV )
+DEALLOCATE( ZRC )
+DEALLOCATE( ZRI )
+DEALLOCATE( ZDXDY )
+!
+! updraft variables
+!
+DEALLOCATE( ZUMF )
+DEALLOCATE( ZUER )
+DEALLOCATE( ZUDR )
+DEALLOCATE( ZUTHL )
+DEALLOCATE( ZUTHV )
+DEALLOCATE( ZUTT )
+DEALLOCATE( ZURW )
+DEALLOCATE( ZURC )
+DEALLOCATE( ZURI )
+DEALLOCATE( ZURR )
+DEALLOCATE( ZURS )
+DEALLOCATE( ZUPR )
+DEALLOCATE( ZUTPR )
+DEALLOCATE( ZTHLCL )
+DEALLOCATE( ZTLCL )
+DEALLOCATE( ZRVLCL )
+DEALLOCATE( ZWLCL )
+DEALLOCATE( ZZLCL )
+DEALLOCATE( ZTHVELCL )
+DEALLOCATE( ZMFLCL )
+DEALLOCATE( ZCAPE )
+IF ( OSETTADJ ) DEALLOCATE( ZTIMED )
+!
+! work arrays
+!
+DEALLOCATE( IINDEX )
+DEALLOCATE( IJINDEX )
+DEALLOCATE( IJSINDEX )
+DEALLOCATE( GTRIG1 )
+!
+!
+END SUBROUTINE DEEP_CONVECTION
diff --git a/src/mesonh/conv/ini_convpar.f90 b/src/mesonh/conv/ini_convpar.f90
new file mode 100644
index 000000000..954b30c6c
--- /dev/null
+++ b/src/mesonh/conv/ini_convpar.f90
@@ -0,0 +1,111 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 init 2006/05/18 13:07:25
+!-----------------------------------------------------------------
+! #####################
+ MODULE MODI_INI_CONVPAR
+! #####################
+!
+INTERFACE
+!
+SUBROUTINE INI_CONVPAR
+END SUBROUTINE INI_CONVPAR
+!
+END INTERFACE
+!
+END MODULE MODI_INI_CONVPAR
+!
+!
+!
+! ######################
+ SUBROUTINE INI_CONVPAR
+! ######################
+!
+!!**** *INI_CONVPAR * - routine to initialize the constants modules
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to initialize the constants
+! stored in modules MODD_CONVPAR, MODD_CST, MODD_CONVPAREXT.
+!
+!
+!!** METHOD
+!! ------
+!! The deep convection constants are set to their numerical values
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CONVPAR : contains deep convection constants
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of the documentation (module MODD_CONVPAR, routine INI_CONVPAR)
+!!
+!!
+!! AUTHOR
+!! ------
+!! P. BECHTOLD * Laboratoire d'Aerologie *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 26/03/96
+!! Last modified 15/04/98 adapted for ARPEGE
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CONVPAR
+!
+IMPLICIT NONE
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. Set the thermodynamical and numerical constants for
+! the deep convection parameterization
+! ---------------------------------------------------
+!
+!
+XA25 = 625.E6 ! 25 km x 25 km reference grid area
+!
+XCRAD = 1500. ! cloud radius
+XCDEPTH = 2.5E3 ! minimum necessary cloud depth
+XENTR = 0.03 ! entrainment constant (m/Pa) = 0.2 (m)
+!
+XZLCL = 3.5E3 ! maximum allowed allowed height
+ ! difference between the surface and the LCL
+XZPBL = 60.E2 ! minimum mixed layer depth to sustain convection
+XWTRIG = 6.00 ! constant in vertical velocity trigger
+!
+!
+XNHGAM = 1.3333 ! accounts for non-hydrost. pressure
+ ! in buoyancy term of w equation
+ ! = 2 / (1+gamma)
+XTFRZ1 = 268.16 ! begin of freezing interval
+XTFRZ2 = 248.16 ! end of freezing interval
+!
+XRHDBC = 0.9 ! relative humidity below cloud in downdraft
+
+XRCONV = 0.015 ! constant in precipitation conversion
+XSTABT = 0.75 ! factor to assure stability in fractional time
+ ! integration, routine CONVECT_CLOSURE
+XSTABC = 0.95 ! factor to assure stability in CAPE adjustment,
+ ! routine CONVECT_CLOSURE
+XUSRDPTH = 165.E2 ! pressure thickness used to compute updraft
+ ! moisture supply rate for downdraft
+XMELDPTH = 100.E2 ! layer (Pa) through which precipitation melt is
+ ! allowed below downdraft
+XUVDP = 0.7 ! constant for pressure perturb in momentum transport
+!
+!
+END SUBROUTINE INI_CONVPAR
diff --git a/src/mesonh/conv/ini_convpar_e1.f90 b/src/mesonh/conv/ini_convpar_e1.f90
new file mode 100644
index 000000000..c7b93ba29
--- /dev/null
+++ b/src/mesonh/conv/ini_convpar_e1.f90
@@ -0,0 +1,111 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 conv 2006/05/18 13:07:25
+!-----------------------------------------------------------------
+! #####################
+ MODULE MODI_INI_CONVPAR_E1
+! #####################
+!
+INTERFACE
+!
+SUBROUTINE INI_CONVPAR_E1
+END SUBROUTINE INI_CONVPAR_E1
+!
+END INTERFACE
+!
+END MODULE MODI_INI_CONVPAR_E1
+!
+!
+! #########################
+ SUBROUTINE INI_CONVPAR_E1
+! #########################
+!
+!!**** *INI_CONVPAR * - routine to initialize the convective constants modules
+!! with modifications for ensemble run.
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to initialize the constants
+! stored in modules MODD_CONVPAR, MODD_CST, MODD_CONVPAREXT.
+!
+!
+!!** METHOD
+!! ------
+!! The deep convection constants are set to their numerical values
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CONVPAR : contains deep convection constants
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of the documentation (module MODD_CONVPAR, routine INI_CONVPAR)
+!!
+!!
+!! AUTHOR
+!! ------
+!! P. BECHTOLD * Laboratoire d'Aerologie *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 26/03/96
+!! Last modified 15/04/98 adapted for ARPEGE
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CONVPAR
+!
+IMPLICIT NONE
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. Set the thermodynamical and numerical constants for
+! the deep convection parameterization
+! ---------------------------------------------------
+!
+!
+XA25 = 625.E6 ! 25 km x 25 km reference grid area
+!
+XCRAD = 500. ! cloud radius
+XCDEPTH = 3.E3 ! minimum necessary cloud depth
+XENTR = 0.03 ! entrainment constant (m/Pa) = 0.2 (m)
+!
+XZLCL = 3.5E3 ! maximum allowed allowed height
+ ! difference between the surface and the LCL
+XZPBL = 60.E2 ! minimum mixed layer depth to sustain convection
+XWTRIG = 6.00 ! constant in vertical velocity trigger
+!
+!
+XNHGAM = 1.3333 ! accounts for non-hydrost. pressure
+ ! in buoyancy term of w equation
+ ! = 2 / (1+gamma)
+XTFRZ1 = 268.16 ! begin of freezing interval
+XTFRZ2 = 248.16 ! end of freezing interval
+!
+XRHDBC = 0.9 ! relative humidity below cloud in downdraft
+
+XRCONV = 0.015 ! constant in precipitation conversion
+XSTABT = 0.75 ! factor to assure stability in fractional time
+ ! integration, routine CONVECT_CLOSURE
+XSTABC = 0.95 ! factor to assure stability in CAPE adjustment,
+ ! routine CONVECT_CLOSURE
+XUSRDPTH = 165.E2 ! pressure thickness used to compute updraft
+ ! moisture supply rate for downdraft
+XMELDPTH = 200.E2 ! layer (Pa) through which precipitation melt is
+ ! allowed below downdraft
+XUVDP = 0.7 ! constant for pressure perturb in momentum transport
+!
+!
+END SUBROUTINE INI_CONVPAR_E1
diff --git a/src/mesonh/conv/ini_convpar_shal.f90 b/src/mesonh/conv/ini_convpar_shal.f90
new file mode 100644
index 000000000..9914a8d65
--- /dev/null
+++ b/src/mesonh/conv/ini_convpar_shal.f90
@@ -0,0 +1,112 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 init 2006/05/18 13:07:25
+!-----------------------------------------------------------------
+! #####################
+ MODULE MODI_INI_CONVPAR_SHAL
+! #####################
+!
+INTERFACE
+!
+SUBROUTINE INI_CONVPAR_SHAL
+END SUBROUTINE INI_CONVPAR_SHAL
+!
+END INTERFACE
+!
+END MODULE MODI_INI_CONVPAR_SHAL
+!
+!
+! ###########################
+ SUBROUTINE INI_CONVPAR_SHAL
+! ###########################
+!
+!!**** *INI_CONVPAR * - routine to initialize the constants modules
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to initialize the constants
+!! stored in modules MODD_CONVPAR_SHAL
+!!
+!!
+!!** METHOD
+!! ------
+!! The shallow convection constants are set to their numerical values
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CONVPAR_SHAL : contains deep convection constants
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of the documentation (module MODD_CONVPAR_SHAL, routine INI_CONVPAR)
+!!
+!!
+!! AUTHOR
+!! ------
+!! P. BECHTOLD * Laboratoire d'Aerologie *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 26/03/96
+!! Last modified 15/04/98 adapted for ARPEGE
+!! 05/05/09 E. Bazile
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CONVPAR_SHAL
+!
+IMPLICIT NONE
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. Set the thermodynamical and numerical constants for
+! the deep convection parameterization
+! ---------------------------------------------------
+!
+!
+XA25 = 625.E6 ! 25 km x 25 km reference grid area
+!
+XCRAD = 50. ! cloud radius
+XCTIME_SHAL = 10800. ! convective adjustment time
+XCDEPTH = 0.5E3 ! minimum necessary shallow cloud depth
+XCDEPTH_D = 2.5E3 ! maximum allowed shallow cloud depth
+XDTPERT = .2 ! add small Temp perturbation at LCL
+XATPERT = 0. ! 0.=original scheme , recommended = 1000.
+XBTPERT = 1. ! 1.=original scheme , recommended = 0.
+!
+XENTR = 0.02 ! entrainment constant (m/Pa) = 0.2 (m)
+!
+XZLCL = 0.5E3 ! maximum allowed allowed height
+ ! difference between the DPL and the surface
+XZPBL = 40.E2 ! minimum mixed layer depth to sustain convection
+!
+!
+XNHGAM = 1.3333 ! accounts for non-hydrost. pressure
+ ! in buoyancy term of w equation
+ ! = 2 / (1+gamma)
+XTFRZ1 = 268.16 ! begin of freezing interval
+XTFRZ2 = 248.16 ! end of freezing interval
+!
+
+XSTABT = 0.75 ! factor to assure stability in fractional time
+ ! integration, routine CONVECT_CLOSURE
+XSTABC = 0.95 ! factor to assure stability in CAPE adjustment,
+ ! routine CONVECT_CLOSURE
+XAW = 0. ! 0.= Original scheme , 1 = recommended
+XBW = 1. ! 1.= Original scheme , 0 = recommended
+LLSMOOTH = .TRUE.
+!
+!
+END SUBROUTINE INI_CONVPAR_SHAL
diff --git a/src/mesonh/conv/modd_convpar.f90 b/src/mesonh/conv/modd_convpar.f90
new file mode 100644
index 000000000..19cf4725f
--- /dev/null
+++ b/src/mesonh/conv/modd_convpar.f90
@@ -0,0 +1,77 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 modd 2006/05/18 13:07:25
+!-----------------------------------------------------------------
+! ######spl
+ MODULE MODD_CONVPAR
+! ###################
+!
+!!**** *MODD_CONVPAR* - Declaration of convection constants
+!!
+!! PURPOSE
+!! -------
+! The purpose of this declarative module is to declare the
+! constants in the deep convection parameterization.
+!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (MODD_CONVPAR)
+!!
+!! AUTHOR
+!! ------
+!! P. Bechtold *Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 26/03/96
+!! Last modified 15/11/96
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+REAL, SAVE :: XA25 ! 25 km x 25 km reference grid area
+!
+REAL, SAVE :: XCRAD ! cloud radius
+REAL, SAVE :: XCDEPTH ! minimum necessary cloud depth
+REAL, SAVE :: XENTR ! entrainment constant (m/Pa) = 0.2 (m)
+!
+REAL, SAVE :: XZLCL ! maximum allowed allowed height
+ ! difference between departure level and surface
+REAL, SAVE :: XZPBL ! minimum mixed layer depth to sustain convection
+REAL, SAVE :: XWTRIG ! constant in vertical velocity trigger
+!
+!
+REAL, SAVE :: XNHGAM ! accounts for non-hydrost. pressure
+ ! in buoyancy term of w equation
+ ! = 2 / (1+gamma)
+REAL, SAVE :: XTFRZ1 ! begin of freezing interval
+REAL, SAVE :: XTFRZ2 ! end of freezing interval
+!
+REAL, SAVE :: XRHDBC ! relative humidity below cloud in downdraft
+!
+REAL, SAVE :: XRCONV ! constant in precipitation conversion
+REAL, SAVE :: XSTABT ! factor to assure stability in fractional time
+ ! integration, routine CONVECT_CLOSURE
+REAL, SAVE :: XSTABC ! factor to assure stability in CAPE adjustment,
+ ! routine CONVECT_CLOSURE
+REAL, SAVE :: XUSRDPTH ! pressure thickness used to compute updraft
+ ! moisture supply rate for downdraft
+REAL, SAVE :: XMELDPTH ! layer (Pa) through which precipitation melt is
+ ! allowed below melting level
+REAL, SAVE :: XUVDP ! constant for pressure perturb in momentum transport
+!
+END MODULE MODD_CONVPAR
diff --git a/src/mesonh/conv/modd_convpar_shal.f90 b/src/mesonh/conv/modd_convpar_shal.f90
new file mode 100644
index 000000000..56abd00ba
--- /dev/null
+++ b/src/mesonh/conv/modd_convpar_shal.f90
@@ -0,0 +1,79 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 modd 2006/05/18 13:07:25
+!-----------------------------------------------------------------
+! ######spl
+ MODULE MODD_CONVPAR_SHAL
+! ########################
+!
+!!**** *MODD_CONVPAR_SHAL* - Declaration of convection constants
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this declarative module is to declare the
+!! constants in the deep convection parameterization.
+!!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (MODD_CONVPAR_SHAL)
+!!
+!! AUTHOR
+!! ------
+!! P. Bechtold *Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 26/03/96
+!! Last modified 04/10/98
+!! E. Bazile 05/05/09
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+REAL, SAVE :: XA25 ! 25 km x 25 km reference grid area
+!
+REAL, SAVE :: XCRAD ! cloud radius
+REAL, SAVE :: XCTIME_SHAL ! convective adjustment time
+REAL, SAVE :: XCDEPTH ! minimum necessary cloud depth
+REAL, SAVE :: XCDEPTH_D ! maximum allowed cloud thickness
+REAL, SAVE :: XDTPERT ! add small Temp perturb. at LCL
+REAL, SAVE :: XATPERT ! Parameter for temp Perturb
+REAL, SAVE :: XBTPERT ! Parameter for temp Perturb
+ ! (XATPERT* TKE/Cp + XBTPERT) * XDTPERT
+REAL, SAVE :: XENTR ! entrainment constant (m/Pa) = 0.2 (m)
+!
+REAL, SAVE :: XZLCL ! maximum allowed allowed height
+ ! difference between departure level and surface
+REAL, SAVE :: XZPBL ! minimum mixed layer depth to sustain convection
+REAL, SAVE :: XWTRIG ! constant in vertical velocity trigger
+!
+!
+REAL, SAVE :: XNHGAM ! accounts for non-hydrost. pressure
+ ! in buoyancy term of w equation
+ ! = 2 / (1+gamma)
+REAL, SAVE :: XTFRZ1 ! begin of freezing interval
+REAL, SAVE :: XTFRZ2 ! end of freezing interval
+!
+!
+REAL, SAVE :: XSTABT ! factor to assure stability in fractional time
+ ! integration, routine CONVECT_CLOSURE
+REAL, SAVE :: XSTABC ! factor to assure stability in CAPE adjustment,
+ ! routine CONVECT_CLOSURE
+REAL, SAVE :: XAW,XBW ! Parameters for WLCL = XAW * W + XBW
+LOGICAL, SAVE :: LLSMOOTH ! Default=TRUE but not necessary
+!
+END MODULE MODD_CONVPAR_SHAL
diff --git a/src/mesonh/conv/modd_convparext.f90 b/src/mesonh/conv/modd_convparext.f90
new file mode 100644
index 000000000..9d6a4309e
--- /dev/null
+++ b/src/mesonh/conv/modd_convparext.f90
@@ -0,0 +1,22 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 modd 2006/05/18 13:07:25
+!-----------------------------------------------------------------
+! ######spl
+ MODULE MODD_CONVPAREXT
+! ######################
+!
+IMPLICIT NONE
+!
+INTEGER, SAVE :: JCVEXB ! start vertical computations at
+ ! 1 + JCVEXB = 1 + ( KBDIA - 1 )
+INTEGER, SAVE :: JCVEXT ! limit vertical computations to
+ ! KLEV - JCVEXT = KLEV - ( KTDIA - 1 )
+!
+END MODULE MODD_CONVPAREXT
diff --git a/src/mesonh/conv/shallow_convection.f90 b/src/mesonh/conv/shallow_convection.f90
new file mode 100644
index 000000000..548e8bda5
--- /dev/null
+++ b/src/mesonh/conv/shallow_convection.f90
@@ -0,0 +1,973 @@
+!MNH_LIC Copyright 1996-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ######################
+ MODULE MODI_SHALLOW_CONVECTION
+! ######################
+!
+INTERFACE
+!
+ SUBROUTINE SHALLOW_CONVECTION( KLON, KLEV, KIDIA, KFDIA, KBDIA, KTDIA, &
+ PDTCONV, KICE, OSETTADJ, PTADJS, &
+ PPABST, PZZ, PTKECLS, &
+ PTT, PRVT, PRCT, PRIT, PWT, &
+ PTTEN, PRVTEN, PRCTEN, PRITEN, &
+ KCLTOP, KCLBAS, PUMF, &
+ OCH1CONV, KCH1, PCH1, PCH1TEN )
+!
+INTEGER, INTENT(IN) :: KLON ! horizontal dimension
+INTEGER, INTENT(IN) :: KLEV ! vertical dimension
+INTEGER, INTENT(IN) :: KIDIA ! value of the first point in x
+INTEGER, INTENT(IN) :: KFDIA ! value of the last point in x
+INTEGER, INTENT(IN) :: KBDIA ! vertical computations start at
+! ! KBDIA that is at least 1
+INTEGER, INTENT(IN) :: KTDIA ! vertical computations can be
+ ! limited to KLEV + 1 - KTDIA
+ ! default=1
+REAL, INTENT(IN) :: PDTCONV ! Interval of time between two
+ ! calls of the deep convection
+ ! scheme
+INTEGER, INTENT(IN) :: KICE ! flag for ice ( 1 = yes,
+ ! 0 = no ice )
+LOGICAL, INTENT(IN) :: OSETTADJ ! logical to set convective
+ ! adjustment time by user
+REAL, INTENT(IN) :: PTADJS ! user defined adjustment time
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTT ! grid scale temperature at t
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRVT ! grid scale water vapor "
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRCT ! grid scale r_c "
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRIT ! grid scale r_i "
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PWT ! grid scale vertical
+ ! velocity (m/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PPABST ! grid scale pressure at t
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PZZ ! height of model layer (m)
+REAL, DIMENSION(KLON), INTENT(IN) :: PTKECLS ! TKE in the CLS (m2/s2)
+!
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PTTEN ! convective temperature
+ ! tendency (K/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PRVTEN ! convective r_v tendency (1/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PRCTEN ! convective r_c tendency (1/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PRITEN ! convective r_i tendency (1/s)
+INTEGER, DIMENSION(KLON), INTENT(INOUT):: KCLTOP ! cloud top level
+INTEGER, DIMENSION(KLON), INTENT(INOUT):: KCLBAS ! cloud base level
+ ! they are given a value of
+ ! 0 if no convection
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PUMF ! updraft mass flux (kg/s m2)
+!
+LOGICAL, INTENT(IN) :: OCH1CONV ! include tracer transport
+INTEGER, INTENT(IN) :: KCH1 ! number of species
+REAL, DIMENSION(KLON,KLEV,KCH1), INTENT(IN) :: PCH1! grid scale chemical species
+REAL, DIMENSION(KLON,KLEV,KCH1), INTENT(INOUT):: PCH1TEN! species conv. tendency (1/s)
+!
+END SUBROUTINE SHALLOW_CONVECTION
+!
+END INTERFACE
+!
+END MODULE MODI_SHALLOW_CONVECTION
+! ###############################################################################
+ SUBROUTINE SHALLOW_CONVECTION( KLON, KLEV, KIDIA, KFDIA, KBDIA, KTDIA, &
+ PDTCONV, KICE, OSETTADJ, PTADJS, &
+ PPABST, PZZ, PTKECLS, &
+ PTT, PRVT, PRCT, PRIT, PWT, &
+ PTTEN, PRVTEN, PRCTEN, PRITEN, &
+ KCLTOP, KCLBAS, PUMF, &
+ OCH1CONV, KCH1, PCH1, PCH1TEN )
+! ###############################################################################
+!
+!!**** Monitor routine to compute all convective tendencies by calls
+!! of several subroutines.
+!!
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to determine the convective
+!! tendencies. The routine first prepares all necessary grid-scale
+!! variables. The final convective tendencies are then computed by
+!! calls of different subroutines.
+!!
+!!
+!!** METHOD
+!! ------
+!! We start by selecting convective columns in the model domain through
+!! the call of routine TRIGGER_FUNCT. Then, we allocate memory for the
+!! convection updraft and downdraft variables and gather the grid scale
+!! variables in convective arrays.
+!! The updraft and downdraft computations are done level by level starting
+!! at the bottom and top of the domain, respectively.
+!! All computations are done on MNH thermodynamic levels. The depth
+!! of the current model layer k is defined by DP(k)=P(k-1)-P(k)
+!!
+!!
+!!
+!! EXTERNAL
+!! --------
+!! CONVECT_TRIGGER_SHAL
+!! CONVECT_SATMIXRATIO
+!! CONVECT_UPDRAFT_SHAL
+!! CONVECT_CONDENS
+!! CONVECT_MIXING_FUNCT
+!! CONVECT_CLOSURE_SHAL
+!! CONVECT_CLOSURE_THRVLCL
+!! CONVECT_CLOSURE_ADJUST_SHAL
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST
+!! XG ! gravity constant
+!! XPI ! number Pi
+!! XP00 ! reference pressure
+!! XRD, XRV ! gaz constants for dry air and water vapor
+!! XCPD, XCPV ! specific heat for dry air and water vapor
+!! XRHOLW ! density of liquid water
+!! XALPW, XBETAW, XGAMW ! constants for water saturation pressure
+!! XTT ! triple point temperature
+!! XLVTT, XLSTT ! vaporization, sublimation heat constant
+!! XCL, XCI ! specific heat for liquid water and ice
+!!
+!! Module MODD_CONVPAREXT
+!! JCVEXB, JCVEXT ! extra levels on the vertical boundaries
+!!
+!! Module MODD_CONVPAR
+!! XA25 ! reference grid area
+!! XCRAD ! cloud radius
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Bechtold, 1997 : Meso-NH scientific documentation (31 pp)
+!! Fritsch and Chappell, 1980, J. Atmos. Sci., Vol. 37, 1722-1761.
+!! Kain and Fritsch, 1990, J. Atmos. Sci., Vol. 47, 2784-2801.
+!! Kain and Fritsch, 1993, Meteor. Monographs, Vol. 24, 165-170.
+!!
+!! AUTHOR
+!! ------
+!! P. BECHTOLD * Laboratoire d'Aerologie *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 26/03/96
+!! Peter Bechtold 15/11/96 replace theta_il by enthalpy
+!! " 10/12/98 changes for ARPEGE
+!! " 01/01/02 Apply conservation correction
+!! F Bouyssel 05/11/08 Modifications for reproductibility
+!! E. Bazile 20/07/09 Input of TKECLS.
+! P. Wautelet 03/06/2019: simplify code (remove always true masks) + replace PACK intrinsics
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_CONVPAREXT
+USE MODD_CONVPAR_SHAL
+USE MODD_NSV, ONLY : NSV_LGBEG,NSV_LGEND
+!
+USE MODI_CONVECT_TRIGGER_SHAL
+USE MODI_CONVECT_UPDRAFT_SHAL
+USE MODI_CONVECT_CLOSURE_SHAL
+USE MODI_CONVECT_CHEM_TRANSPORT
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+!
+INTEGER, INTENT(IN) :: KLON ! horizontal dimension
+INTEGER, INTENT(IN) :: KLEV ! vertical dimension
+INTEGER, INTENT(IN) :: KIDIA ! value of the first point in x
+INTEGER, INTENT(IN) :: KFDIA ! value of the last point in x
+INTEGER, INTENT(IN) :: KBDIA ! vertical computations start at
+! ! KBDIA that is at least 1
+INTEGER, INTENT(IN) :: KTDIA ! vertical computations can be
+ ! limited to KLEV + 1 - KTDIA
+ ! default=1
+REAL, INTENT(IN) :: PDTCONV ! Interval of time between two
+ ! calls of the deep convection
+ ! scheme
+INTEGER, INTENT(IN) :: KICE ! flag for ice ( 1 = yes,
+ ! 0 = no ice )
+LOGICAL, INTENT(IN) :: OSETTADJ ! logical to set convective
+ ! adjustment time by user
+REAL, INTENT(IN) :: PTADJS ! user defined adjustment time
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTT ! grid scale temperature at t
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRVT ! grid scale water vapor "
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRCT ! grid scale r_c "
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRIT ! grid scale r_i "
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PWT ! grid scale vertical
+ ! velocity (m/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PPABST ! grid scale pressure at t
+REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PZZ ! height of model layer (m)
+REAL, DIMENSION(KLON), INTENT(IN) :: PTKECLS ! TKE in the CLS (m2/s2)
+!
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PTTEN ! convective temperature
+ ! tendency (K/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PRVTEN ! convective r_v tendency (1/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PRCTEN ! convective r_c tendency (1/s)
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PRITEN ! convective r_i tendency (1/s)
+INTEGER, DIMENSION(KLON), INTENT(INOUT):: KCLTOP ! cloud top level
+INTEGER, DIMENSION(KLON), INTENT(INOUT):: KCLBAS ! cloud base level
+ ! they are given a value of
+ ! 0 if no convection
+REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PUMF ! updraft mass flux (kg/s m2)
+!
+LOGICAL, INTENT(IN) :: OCH1CONV ! include tracer transport
+INTEGER, INTENT(IN) :: KCH1 ! number of species
+REAL, DIMENSION(KLON,KLEV,KCH1), INTENT(IN) :: PCH1! grid scale chemical species
+REAL, DIMENSION(KLON,KLEV,KCH1), INTENT(INOUT):: PCH1TEN! species conv. tendency (1/s)
+!
+!
+!* 0.2 Declarations of local fixed memory variables :
+!
+INTEGER :: ICONV ! number of convective columns
+INTEGER :: IIB, IIE ! horizontal loop bounds
+INTEGER :: IKB, IKE ! vertical loop bounds
+INTEGER :: IKS ! vertical dimension
+INTEGER :: JI, JL ! horizontal loop index
+INTEGER :: JN ! number of tracers
+INTEGER :: JK, JKM, JKP ! vertical loop index
+INTEGER :: IFTSTEPS ! only used for chemical tracers
+REAL :: ZEPS, ZEPSA ! R_d / R_v, R_v / R_d
+REAL :: ZRDOCP ! R_d/C_p
+!
+REAL, DIMENSION(KLON,KLEV) :: ZTHT, ZSTHV, ZSTHES ! grid scale theta, theta_v
+REAL, DIMENSION(KLON) :: ZWORK2, ZWORK2B ! work array
+REAL :: ZW1 ! work variable
+!
+!
+!* 0.2 Declarations of local allocatable variables :
+!
+INTEGER, DIMENSION(:),ALLOCATABLE :: IDPL ! index for parcel departure level
+INTEGER, DIMENSION(:),ALLOCATABLE :: IPBL ! index for source layer top
+INTEGER, DIMENSION(:),ALLOCATABLE :: ILCL ! index for lifting condensation level
+INTEGER, DIMENSION(:),ALLOCATABLE :: IETL ! index for zero buoyancy level
+INTEGER, DIMENSION(:),ALLOCATABLE :: ICTL ! index for cloud top level
+INTEGER, DIMENSION(:),ALLOCATABLE :: ILFS ! index for level of free sink
+!
+INTEGER, DIMENSION(:), ALLOCATABLE :: ISDPL ! index for parcel departure level
+INTEGER, DIMENSION(:),ALLOCATABLE :: ISPBL ! index for source layer top
+INTEGER, DIMENSION(:), ALLOCATABLE :: ISLCL ! index for lifting condensation level
+REAL, DIMENSION(:), ALLOCATABLE :: ZSTHLCL ! updraft theta at LCL
+REAL, DIMENSION(:), ALLOCATABLE :: ZSTLCL ! updraft temp. at LCL
+REAL, DIMENSION(:), ALLOCATABLE :: ZSRVLCL ! updraft rv at LCL
+REAL, DIMENSION(:), ALLOCATABLE :: ZSWLCL ! updraft w at LCL
+REAL, DIMENSION(:), ALLOCATABLE :: ZSZLCL ! LCL height
+REAL, DIMENSION(:), ALLOCATABLE :: ZSTHVELCL! envir. theta_v at LCL
+REAL, DIMENSION(:), ALLOCATABLE :: ZSDXDY ! grid area (m^2)
+!
+! grid scale variables
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZZ ! height of model layer (m)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZPRES ! grid scale pressure
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZDPRES ! pressure difference between
+ ! bottom and top of layer (Pa)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZW ! grid scale vertical velocity on theta grid
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZTT ! temperature
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZTH ! grid scale theta
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZTHV ! grid scale theta_v
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZTHL ! grid scale enthalpy (J/kg)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZTHES, ZTHEST ! grid scale saturated theta_e
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZRW ! grid scale total water (kg/kg)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZRV ! grid scale water vapor (kg/kg)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZRC ! grid scale cloud water (kg/kg)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZRI ! grid scale cloud ice (kg/kg)
+REAL, DIMENSION(:), ALLOCATABLE :: ZDXDY ! grid area (m^2)
+!
+! updraft variables
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZUMF ! updraft mass flux (kg/s)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZUER ! updraft entrainment (kg/s)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZUDR ! updraft detrainment (kg/s)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZUTHL ! updraft enthalpy (J/kg)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZUTHV ! updraft theta_v (K)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZURW ! updraft total water (kg/kg)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZURC ! updraft cloud water (kg/kg)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZURI ! updraft cloud ice (kg/kg)
+REAL, DIMENSION(:), ALLOCATABLE :: ZMFLCL ! cloud base unit mass flux(kg/s)
+REAL, DIMENSION(:), ALLOCATABLE :: ZCAPE ! available potent. energy
+REAL, DIMENSION(:), ALLOCATABLE :: ZTHLCL ! updraft theta at LCL
+REAL, DIMENSION(:), ALLOCATABLE :: ZTLCL ! updraft temp. at LCL
+REAL, DIMENSION(:), ALLOCATABLE :: ZRVLCL ! updraft rv at LCL
+REAL, DIMENSION(:), ALLOCATABLE :: ZWLCL ! updraft w at LCL
+REAL, DIMENSION(:), ALLOCATABLE :: ZZLCL ! LCL height
+REAL, DIMENSION(:), ALLOCATABLE :: ZTHVELCL! envir. theta_v at LCL
+!
+! downdraft variables
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZDMF ! downdraft mass flux (kg/s)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZDER ! downdraft entrainment (kg/s)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZDDR ! downdraft detrainment (kg/s)
+!
+! closure variables
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZLMASS ! mass of model layer (kg)
+REAL, DIMENSION(:), ALLOCATABLE :: ZTIMEC ! advective time period
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZTHC ! conv. adj. grid scale theta
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZRVC ! conv. adj. grid scale r_w
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZRCC ! conv. adj. grid scale r_c
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZRIC ! conv. adj. grid scale r_i
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZWSUB ! envir. compensating subsidence (Pa/s)
+!
+LOGICAL, DIMENSION(:),ALLOCATABLE :: GTRIG1 ! logical mask for convection
+INTEGER, DIMENSION(:),ALLOCATABLE :: IJINDEX ! hor.index
+REAL, DIMENSION(:), ALLOCATABLE :: ZCPH ! specific heat C_ph
+REAL, DIMENSION(:), ALLOCATABLE :: ZLV, ZLS! latent heat of vaporis., sublim.
+REAL :: ZES ! saturation vapor mixng ratio
+!
+! Chemical Tracers:
+REAL, DIMENSION(:,:,:), ALLOCATABLE:: ZCH1 ! grid scale chemical specy (kg/kg)
+REAL, DIMENSION(:,:,:), ALLOCATABLE:: ZCH1C ! conv. adjust. chemical specy 1
+REAL, DIMENSION(:,:), ALLOCATABLE:: ZWORK3 ! conv. adjust. chemical specy 1
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 0.3 Compute loop bounds
+! -------------------
+!
+IIB = KIDIA
+IIE = KFDIA
+JCVEXB = MAX( 0, KBDIA - 1 )
+IKB = 1 + JCVEXB
+IKS = KLEV
+JCVEXT = MAX( 0, KTDIA - 1)
+IKE = IKS - JCVEXT
+!
+!
+!* 0.7 Reset convective tendencies to zero if convective
+! counter becomes negative
+! -------------------------------------------------
+!
+PTTEN(:,:) = 0.
+PRVTEN(:,:) = 0.
+PRCTEN(:,:) = 0.
+PRITEN(:,:) = 0.
+! PUTEN(:,:) = 0.
+! PVTEN(:,:) = 0.
+PUMF(:,:) = 0.
+KCLTOP(:) = 0
+KCLBAS(:) = 0
+IF ( OCH1CONV ) THEN
+ PCH1TEN(:,:,:) = 0.
+END IF
+!
+!
+!* 1. Initialize local variables
+! ----------------------------
+!
+ZEPS = XRD / XRV
+ZEPSA = XRV / XRD
+ZRDOCP = XRD / XCPD
+!
+!-------------------------------------------------------------------------------
+!
+!* 1.1 Set up grid scale theta, theta_v, theta_es
+! ------------------------------------------
+!
+ZTHT(:,:) = 300.
+ZSTHV(:,:)= 300.
+ZSTHES(:,:)= 400.
+DO JK = IKB, IKE
+DO JI = IIB, IIE
+ IF ( PPABST(JI,JK) > 40.E2 ) THEN
+ ZTHT(JI,JK) = PTT(JI,JK) * ( XP00 / PPABST(JI,JK) ) ** ZRDOCP
+ ZSTHV(JI,JK) = ZTHT(JI,JK) * ( 1. + ZEPSA * PRVT(JI,JK) ) / &
+ ( 1. + PRVT(JI,JK) + PRCT(JI,JK) + PRIT(JI,JK) )
+!
+ ! use conservative Bolton (1980) formula for theta_e
+ ! it is used to compute CAPE for undilute parcel ascent
+ ! For economical reasons we do not use routine CONVECT_SATMIXRATIO here
+!
+ ZES = EXP( XALPW - XBETAW / PTT(JI,JK) - XGAMW * LOG( PTT(JI,JK) ) )
+ ZES = MIN( 1., ZEPS * ZES / ( PPABST(JI,JK) - ZES ) )
+ ZSTHES(JI,JK) = PTT(JI,JK) * ( ZTHT(JI,JK) / PTT(JI,JK) ) ** &
+ ( 1. - 0.28 * ZES ) * EXP( ( 3374.6525 / PTT(JI,JK) - 2.5403 ) &
+ * ZES * ( 1. + 0.81 * ZES ) )
+ END IF
+END DO
+END DO
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. Test for convective columns and determine properties at the LCL
+! --------------------------------------------------------------
+!
+!* 2.1 Allocate arrays depending on number of model columns that need
+! to be tested for convection (i.e. where no convection is present
+! at the moment.
+! --------------------------------------------------------------
+!
+ALLOCATE( ZPRES(KLON,IKS) )
+ALLOCATE( ZZ(KLON,IKS) )
+ALLOCATE( ZW(KLON,IKS) )
+ALLOCATE( ZTH(KLON,IKS) )
+ALLOCATE( ZTHV(KLON,IKS) )
+ALLOCATE( ZTHEST(KLON,IKS) )
+ALLOCATE( ZRV(KLON,IKS) )
+ALLOCATE( ZSTHLCL(KLON) )
+ALLOCATE( ZSTLCL(KLON) )
+ALLOCATE( ZSRVLCL(KLON) )
+ALLOCATE( ZSWLCL(KLON) )
+ALLOCATE( ZSZLCL(KLON) )
+ALLOCATE( ZSTHVELCL(KLON) )
+ALLOCATE( ISDPL(KLON) )
+ALLOCATE( ISPBL(KLON) )
+ALLOCATE( ISLCL(KLON) )
+ALLOCATE( ZSDXDY(KLON) )
+ALLOCATE( GTRIG1(KLON) )
+!
+DO JK = IKB, IKE
+DO JI = 1, KLON
+ JL = JI
+ ZPRES(JI,JK) = PPABST(JI,JK)
+ ZZ(JI,JK) = PZZ(JI,JK)
+ ZTH(JI,JK) = ZTHT(JI,JK)
+ ZTHV(JI,JK) = ZSTHV(JI,JK)
+ ZTHEST(JI,JK) = ZSTHES(JI,JK)
+ ZRV(JI,JK) = MAX( 0., PRVT(JI,JK) )
+ ZW(JI,JK) = PWT(JI,JK)
+END DO
+END DO
+ZSDXDY(:) = XA25
+!
+!* 2.2 Compute environm. enthalpy and total water = r_v + r_i + r_c
+! and envir. saturation theta_e
+! ------------------------------------------------------------
+!
+!
+!* 2.3 Test for convective columns and determine properties at the LCL
+! --------------------------------------------------------------
+!
+ISLCL(:) = MAX( IKB, 2 ) ! initialize DPL PBL and LCL
+ISDPL(:) = IKB
+ISPBL(:) = IKB
+!
+CALL CONVECT_TRIGGER_SHAL( KLON, KLEV, &
+ ZPRES, ZTH, ZTHV, ZTHEST, &
+ ZRV, ZW, ZZ, ZSDXDY, PTKECLS, &
+ ZSTHLCL, ZSTLCL, ZSRVLCL, ZSWLCL, ZSZLCL, &
+ ZSTHVELCL, ISLCL, ISDPL, ISPBL, GTRIG1 )
+!
+DEALLOCATE( ZPRES )
+DEALLOCATE( ZZ )
+DEALLOCATE( ZTH )
+DEALLOCATE( ZTHV )
+DEALLOCATE( ZTHEST )
+DEALLOCATE( ZRV )
+DEALLOCATE( ZW )
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. After the call of TRIGGER_FUNCT we allocate all the dynamic
+! arrays used in the convection scheme using the mask GTRIG, i.e.
+! we do calculus only in convective columns. This corresponds to
+! a GATHER operation.
+! --------------------------------------------------------------
+!
+ICONV = COUNT( GTRIG1(:) )
+IF ( ICONV == 0 ) THEN
+ DEALLOCATE( ZSTHLCL )
+ DEALLOCATE( ZSTLCL )
+ DEALLOCATE( ZSRVLCL )
+ DEALLOCATE( ZSWLCL )
+ DEALLOCATE( ZSZLCL )
+ DEALLOCATE( ZSTHVELCL )
+ DEALLOCATE( ZSDXDY )
+ DEALLOCATE( ISLCL )
+ DEALLOCATE( ISDPL )
+ DEALLOCATE( ISPBL )
+ DEALLOCATE( GTRIG1 )
+ RETURN ! no convective column has been found, exit DEEP_CONVECTION
+ENDIF
+!
+ ! vertical index variables
+!
+ALLOCATE( IDPL(ICONV) )
+ALLOCATE( IPBL(ICONV) )
+ALLOCATE( ILCL(ICONV) )
+ALLOCATE( ICTL(ICONV) )
+ALLOCATE( IETL(ICONV) )
+!
+ ! grid scale variables
+!
+ALLOCATE( ZZ(ICONV,IKS) ) ; ZZ = 0.0
+ALLOCATE( ZPRES(ICONV,IKS) ); ZPRES = 0.0
+ALLOCATE( ZDPRES(ICONV,IKS) ) ; ZDPRES = 0.0
+ALLOCATE( ZTT(ICONV, IKS) ) ; ZTT = 0.0
+ALLOCATE( ZTH(ICONV,IKS) ) ; ZTH = 0.0
+ALLOCATE( ZTHV(ICONV,IKS) ) ; ZTHV = 0.0
+ALLOCATE( ZTHL(ICONV,IKS) ) ; ZTHL = 0.0
+ALLOCATE( ZTHES(ICONV,IKS) ) ; ZTHES = 0.0
+ALLOCATE( ZRV(ICONV,IKS) ) ; ZRV = 0.0
+ALLOCATE( ZRC(ICONV,IKS) ) ; ZRC = 0.0
+ALLOCATE( ZRI(ICONV,IKS) ) ; ZRI = 0.0
+ALLOCATE( ZRW(ICONV,IKS) ) ; ZRW = 0.0
+ALLOCATE( ZDXDY(ICONV) ) ; ZDXDY = 0.0
+!
+ ! updraft variables
+!
+ALLOCATE( ZUMF(ICONV,IKS) )
+ALLOCATE( ZUER(ICONV,IKS) )
+ALLOCATE( ZUDR(ICONV,IKS) )
+ALLOCATE( ZUTHL(ICONV,IKS) )
+ALLOCATE( ZUTHV(ICONV,IKS) )
+ALLOCATE( ZURW(ICONV,IKS) )
+ALLOCATE( ZURC(ICONV,IKS) )
+ALLOCATE( ZURI(ICONV,IKS) )
+ALLOCATE( ZTHLCL(ICONV) )
+ALLOCATE( ZTLCL(ICONV) )
+ALLOCATE( ZRVLCL(ICONV) )
+ALLOCATE( ZWLCL(ICONV) )
+ALLOCATE( ZMFLCL(ICONV) )
+ALLOCATE( ZZLCL(ICONV) )
+ALLOCATE( ZTHVELCL(ICONV) )
+ALLOCATE( ZCAPE(ICONV) )
+!
+ ! work variables
+!
+ALLOCATE( IJINDEX(ICONV) )
+ALLOCATE( ZCPH(ICONV) )
+ALLOCATE( ZLV(ICONV) )
+ALLOCATE( ZLS(ICONV) )
+!
+!
+!* 3.1 Gather grid scale and updraft base variables in
+! arrays using mask GTRIG
+! ---------------------------------------------------
+!
+JL = 1
+DO JI = 1, KLON
+ IF ( GTRIG1(JI) ) THEN
+ IJINDEX(JL) = JI
+ JL = JL +1
+ END IF
+END DO
+!
+DO JK = IKB, IKE
+DO JI = 1, ICONV
+ JL = IJINDEX(JI)
+ ZZ(JI,JK) = PZZ(JL,JK)
+ ZPRES(JI,JK) = PPABST(JL,JK)
+ ZTT(JI,JK) = PTT(JL,JK)
+ ZTH(JI,JK) = ZTHT(JL,JK)
+ ZTHES(JI,JK) = ZSTHES(JL,JK)
+ ZRV(JI,JK) = MAX( 0., PRVT(JL,JK) )
+ ZRC(JI,JK) = MAX( 0., PRCT(JL,JK) )
+ ZRI(JI,JK) = MAX( 0., PRIT(JL,JK) )
+ ZTHV(JI,JK) = ZSTHV(JL,JK)
+END DO
+END DO
+!
+DO JI = 1, ICONV
+ JL = IJINDEX(JI)
+ IDPL(JI) = ISDPL(JL)
+ IPBL(JI) = ISPBL(JL)
+ ILCL(JI) = ISLCL(JL)
+ ZTHLCL(JI) = ZSTHLCL(JL)
+ ZTLCL(JI) = ZSTLCL(JL)
+ ZRVLCL(JI) = ZSRVLCL(JL)
+ ZWLCL(JI) = ZSWLCL(JL)
+ ZZLCL(JI) = ZSZLCL(JL)
+ ZTHVELCL(JI) = ZSTHVELCL(JL)
+ ZDXDY(JI) = ZSDXDY(JL)
+END DO
+
+DEALLOCATE( GTRIG1 )
+ALLOCATE( GTRIG1(ICONV) )
+GTRIG1(:) = .true.
+
+DEALLOCATE( ISDPL )
+DEALLOCATE( ISPBL )
+DEALLOCATE( ISLCL )
+DEALLOCATE( ZSTHLCL )
+DEALLOCATE( ZSTLCL )
+DEALLOCATE( ZSRVLCL )
+DEALLOCATE( ZSWLCL )
+DEALLOCATE( ZSZLCL )
+DEALLOCATE( ZSTHVELCL )
+DEALLOCATE( ZSDXDY )
+!
+!
+!* 3.2 Compute pressure difference
+! ---------------------------------------------------
+!
+ZDPRES(:,IKB) = 0.
+DO JK = IKB + 1, IKE
+ ZDPRES(:,JK) = ZPRES(:,JK-1) - ZPRES(:,JK)
+END DO
+!
+!* 3.3 Compute environm. enthalpy and total water = r_v + r_i + r_c
+! ----------------------------------------------------------
+!
+DO JK = IKB, IKE, 1
+ ZRW(:,JK) = ZRV(:,JK) + ZRC(:,JK) + ZRI(:,JK)
+ ZCPH(:) = XCPD + XCPV * ZRW(:,JK)
+ ZLV(:) = XLVTT + ( XCPV - XCL ) * ( ZTT(:,JK) - XTT ) ! compute L_v
+ ZLS(:) = XLSTT + ( XCPV - XCI ) * ( ZTT(:,JK) - XTT ) ! compute L_i
+ ZTHL(:,JK) = ZCPH(:) * ZTT(:,JK) + ( 1. + ZRW(:,JK) ) * XG * ZZ(:,JK) &
+ - ZLV(:) * ZRC(:,JK) - ZLS(:) * ZRI(:,JK)
+END DO
+!
+DEALLOCATE( ZCPH )
+DEALLOCATE( ZLV )
+DEALLOCATE( ZLS )
+!
+!-------------------------------------------------------------------------------
+!
+!* 4. Compute updraft properties
+! ----------------------------
+!
+!* 4.1 Set mass flux at LCL ( here a unit mass flux with w = 1 m/s )
+! -------------------------------------------------------------
+!
+ZDXDY(:) = XA25
+ZMFLCL(:) = XA25 * 1.E-3
+!
+!
+!
+CALL CONVECT_UPDRAFT_SHAL( ICONV, KLEV, &
+ KICE, ZPRES, ZDPRES, ZZ, ZTHL, ZTHV, ZTHES, ZRW, &
+ ZTHLCL, ZTLCL, ZRVLCL, ZWLCL, ZZLCL, ZTHVELCL, &
+ ZMFLCL, GTRIG1, ILCL, IDPL, IPBL, &
+ ZUMF, ZUER, ZUDR, ZUTHL, ZUTHV, ZURW, &
+ ZURC, ZURI, ZCAPE, ICTL, IETL )
+!
+!
+!
+!* 4.2 In routine UPDRAFT GTRIG1 has been set to false when cloud
+! thickness is smaller than 3 km
+! -----------------------------------------------------------
+!
+!
+!
+!* 4.3 Allocate memory for downdraft variables
+! ---------------------------------------
+!
+! downdraft variables
+!
+ ALLOCATE( ZDMF(ICONV,IKS) )
+ ALLOCATE( ZDER(ICONV,IKS) )
+ ALLOCATE( ZDDR(ICONV,IKS) )
+ ALLOCATE( ILFS(ICONV) )
+ ALLOCATE( ZLMASS(ICONV,IKS) )
+ ZDMF(:,:) = 0.
+ ZDER(:,:) = 0.
+ ZDDR(:,:) = 0.
+ ILFS(:) = IKB
+ DO JK = IKB, IKE
+ ZLMASS(:,JK) = ZDXDY(:) * ZDPRES(:,JK) / XG ! mass of model layer
+ END DO
+ ZLMASS(:,IKB) = ZLMASS(:,IKB+1)
+!
+! closure variables
+!
+ ALLOCATE( ZTIMEC(ICONV) )
+ ALLOCATE( ZTHC(ICONV,IKS) )
+ ALLOCATE( ZRVC(ICONV,IKS) )
+ ALLOCATE( ZRCC(ICONV,IKS) )
+ ALLOCATE( ZRIC(ICONV,IKS) )
+ ALLOCATE( ZWSUB(ICONV,IKS) )
+!
+!-------------------------------------------------------------------------------
+!
+!* 5. Compute downdraft properties
+! ----------------------------
+!
+ ZTIMEC(:) = XCTIME_SHAL
+ IF ( OSETTADJ ) ZTIMEC(:) = PTADJS
+!
+!* 7. Determine adjusted environmental values assuming
+! that all available buoyant energy must be removed
+! within an advective time step ZTIMEC.
+! ---------------------------------------------------
+!
+ CALL CONVECT_CLOSURE_SHAL( ICONV, KLEV, &
+ ZPRES, ZDPRES, ZZ, ZDXDY, ZLMASS, &
+ ZTHL, ZTH, ZRW, ZRC, ZRI, GTRIG1, &
+ ZTHC, ZRVC, ZRCC, ZRIC, ZWSUB, &
+ ILCL, IDPL, IPBL, ICTL, &
+ ZUMF, ZUER, ZUDR, ZUTHL, ZURW, &
+ ZURC, ZURI, ZCAPE, ZTIMEC, IFTSTEPS )
+!
+!-------------------------------------------------------------------------------
+!
+!* 8. Determine the final grid-scale (environmental) convective
+! tendencies and set convective counter
+! --------------------------------------------------------
+!
+!
+!* 8.1 Grid scale tendencies
+! ---------------------
+!
+ ! in order to save memory, the tendencies are temporarily stored
+ ! in the tables for the adjusted grid-scale values
+!
+ DO JK = IKB, IKE
+ ZTHC(:,JK) = ( ZTHC(:,JK) - ZTH(:,JK) ) / ZTIMEC(:) &
+ * ( ZPRES(:,JK) / XP00 ) ** ZRDOCP ! change theta in temperature
+ ZRVC(:,JK) = ( ZRVC(:,JK) - ZRW(:,JK) + ZRC(:,JK) + ZRI(:,JK) ) &
+ / ZTIMEC(:)
+
+ ZRCC(:,JK) = ( ZRCC(:,JK) - ZRC(:,JK) ) / ZTIMEC(:)
+ ZRIC(:,JK) = ( ZRIC(:,JK) - ZRI(:,JK) ) / ZTIMEC(:)
+!
+ END DO
+!
+!
+!* 8.2 Apply conservation correction
+! -----------------------------
+!
+ ! adjustment at cloud top to smooth possible discontinuous profiles at PBL inversions
+ ! (+ - - tendencies for moisture )
+!
+!
+IF (LLSMOOTH) THEN
+ DO JI = 1, ICONV
+ JK = ICTL(JI)
+ JKM= MAX(2,ICTL(JI)-1)
+ JKP= MAX(2,ICTL(JI)-2)
+ ZRVC(JI,JKM) = ZRVC(JI,JKM) + .5 * ZRVC(JI,JK)
+ ZRCC(JI,JKM) = ZRCC(JI,JKM) + .5 * ZRCC(JI,JK)
+ ZRIC(JI,JKM) = ZRIC(JI,JKM) + .5 * ZRIC(JI,JK)
+ ZTHC(JI,JKM) = ZTHC(JI,JKM) + .5 * ZTHC(JI,JK)
+ ZRVC(JI,JKP) = ZRVC(JI,JKP) + .3 * ZRVC(JI,JK)
+ ZRCC(JI,JKP) = ZRCC(JI,JKP) + .3 * ZRCC(JI,JK)
+ ZRIC(JI,JKP) = ZRIC(JI,JKP) + .3 * ZRIC(JI,JK)
+ ZTHC(JI,JKP) = ZTHC(JI,JKP) + .3 * ZTHC(JI,JK)
+ ZRVC(JI,JK) = .2 * ZRVC(JI,JK)
+ ZRCC(JI,JK) = .2 * ZRCC(JI,JK)
+ ZRIC(JI,JK) = .2 * ZRIC(JI,JK)
+ ZTHC(JI,JK) = .2 * ZTHC(JI,JK)
+ END DO
+ENDIF
+!
+!
+ ! Compute vertical integrals - Fluxes
+!
+ JKM = MAXVAL( ICTL(:) )
+ ZWORK2(:) = 0.
+ ZWORK2B(:) = 0.
+ DO JK = IKB+1, JKM
+ JKP = JK + 1
+ DO JI = 1, ICONV
+ IF ( JK <= ICTL(JI) ) THEN
+ ZW1 = ZRVC(JI,JK) + ZRCC(JI,JK) + ZRIC(JI,JK)
+ ZWORK2(JI) = ZWORK2(JI) + ZW1 * & ! moisture
+ .5 * (ZPRES(JI,JK-1) - ZPRES(JI,JKP)) / XG
+ ZW1 = ( XCPD + XCPV * ZRW(JI,JK) )* ZTHC(JI,JK) - &
+ ( XLVTT + ( XCPV - XCL ) * ( ZTT(JI,JK) - XTT ) ) * ZRCC(JI,JK) - &
+ ( XLSTT + ( XCPV - XCL ) * ( ZTT(JI,JK) - XTT ) ) * ZRIC(JI,JK)
+ ZWORK2B(JI) = ZWORK2B(JI) + ZW1 * & ! energy
+ .5 * (ZPRES(JI,JK-1) - ZPRES(JI,JKP)) / XG
+ END IF
+ END DO
+ END DO
+!
+ ! Budget error (integral must be zero)
+!
+ DO JI = 1, ICONV
+ IF ( ICTL(JI) > IKB+1 ) THEN
+ JKP = ICTL(JI)
+ ZW1 = XG / ( ZPRES(JI,IKB) - ZPRES(JI,JKP) - &
+ .5 * (ZDPRES(JI,IKB+1) - ZDPRES(JI,JKP+1)) )
+ ZWORK2(JI) = ZWORK2(JI) * ZW1
+ ZWORK2B(JI) = ZWORK2B(JI)* ZW1
+ END IF
+ END DO
+!
+ ! Apply uniform correction
+!
+ DO JK = JKM, IKB+1, -1
+ DO JI = 1, ICONV
+ IF ( ICTL(JI) > IKB+1 .AND. JK <= ICTL(JI) ) THEN
+ ! ZW1 = ABS(ZRVC(JI,JK)) + ABS(ZRCC(JI,JK)) + ABS(ZRIC(JI,JK)) + 1.E-12
+ ! ZRVC(JI,JK) = ZRVC(JI,JK) - ABS(ZRVC(JI,JK))/ZW1*ZWORK2(JI) ! moisture
+ ZRVC(JI,JK) = ZRVC(JI,JK) - ZWORK2(JI) ! moisture
+ ! ZRCC(JI,JK) = ZRCC(JI,JK) - ABS(ZRCC(JI,JK))/ZW1*ZWORK2(JI)
+ ! ZRIC(JI,JK) = ZRIC(JI,JK) - ABS(ZRIC(JI,JK))/ZW1*ZWORK2(JI)
+ ZTHC(JI,JK) = ZTHC(JI,JK) - ZWORK2B(JI) / XCPD ! enthalpy
+ END IF
+ END DO
+ END DO
+!
+ ! execute a "scatter"= pack command to store the tendencies in
+ ! the final 2D tables
+!
+ DO JK = IKB, IKE
+ DO JI = 1, ICONV
+ JL = IJINDEX(JI)
+ PTTEN(JL,JK) = ZTHC(JI,JK)
+ PRVTEN(JL,JK) = ZRVC(JI,JK)
+ PRCTEN(JL,JK) = ZRCC(JI,JK)
+ PRITEN(JL,JK) = ZRIC(JI,JK)
+ END DO
+ END DO
+!
+!
+! Cloud base and top levels
+! -------------------------
+!
+ ILCL(:) = MIN( ILCL(:), ICTL(:) )
+ DO JI = 1, ICONV
+ JL = IJINDEX(JI)
+ KCLTOP(JL) = ICTL(JI)
+ KCLBAS(JL) = ILCL(JI)
+ END DO
+!
+!
+!* 8.7 Compute convective tendencies for Tracers
+! ------------------------------------------
+!
+ IF ( OCH1CONV ) THEN
+!
+ ALLOCATE( ZCH1(ICONV,IKS,KCH1) )
+ ALLOCATE( ZCH1C(ICONV,IKS,KCH1) )
+ ALLOCATE( ZWORK3(ICONV,KCH1) )
+!
+ DO JK = IKB, IKE
+ DO JI = 1, ICONV
+ JL = IJINDEX(JI)
+ ZCH1(JI,JK,:) = PCH1(JL,JK,:)
+ END DO
+ END DO
+!
+ CALL CONVECT_CHEM_TRANSPORT( ICONV, KLEV, KCH1, ZCH1, ZCH1C, &
+ IDPL, IPBL, ILCL, ICTL, ILFS, ILFS, &
+ ZUMF, ZUER, ZUDR, ZDMF, ZDER, ZDDR, &
+ ZTIMEC, ZDXDY, ZDMF(:,1), ZLMASS, ZWSUB, &
+ IFTSTEPS )
+!
+!
+!* 8.8 Apply conservation correction
+! -----------------------------
+!
+ ! Compute vertical integrals
+!
+ JKM = MAXVAL( ICTL(:) )
+ DO JN = 1, KCH1
+ IF(JN < NSV_LGBEG .OR. JN>NSV_LGEND-1) THEN ! no correction for xy lagrangian variables
+ ZWORK3(:,JN) = 0.
+ ZWORK2(:) = 0.
+ DO JK = IKB+1, JKM
+ JKP = JK + 1
+ DO JI = 1, ICONV
+ ZW1 = .5 * (ZPRES(JI,JK-1) - ZPRES(JI,JKP))
+ ZWORK3(JI,JN) = ZWORK3(JI,JN) + (ZCH1C(JI,JK,JN)-ZCH1(JI,JK,JN)) * ZW1
+ ZWORK2(JI) = ZWORK2(JI) + ABS(ZCH1C(JI,JK,JN)) * ZW1
+ END DO
+ END DO
+!
+ ! Apply concentration weighted correction
+!
+ DO JK = JKM, IKB+1, -1
+ DO JI = 1, ICONV
+ IF ( ICTL(JI) > IKB+1 .AND. JK <= ICTL(JI) ) THEN
+ ZCH1C(JI,JK,JN) = ZCH1C(JI,JK,JN) - &
+ ZWORK3(JI,JN)*ABS(ZCH1C(JI,JK,JN))/MAX(1.E-30,ZWORK2(JI))
+ END IF
+ END DO
+ END DO
+ END IF
+!
+ DO JK = IKB, IKE
+ DO JI = 1, ICONV
+ JL = IJINDEX(JI)
+ PCH1TEN(JL,JK,JN) = (ZCH1C(JI,JK,JN)-ZCH1(JI,JK,JN) ) / ZTIMEC(JI)
+ END DO
+ END DO
+ END DO
+ END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 9. Write up- and downdraft mass fluxes
+! ------------------------------------
+!
+ DO JK = IKB, IKE
+ ZUMF(:,JK) = ZUMF(:,JK) / ZDXDY(:) ! Mass flux per unit area
+ END DO
+ ZWORK2(:) = 1.
+ DO JK = IKB, IKE
+ DO JI = 1, ICONV
+ JL = IJINDEX(JI)
+ IF ( KCLTOP(JL) <= IKB+1 ) ZWORK2(JL) = 0.
+ PUMF(JL,JK) = ZUMF(JI,JK) * ZWORK2(JL)
+ END DO
+ END DO
+!
+!-------------------------------------------------------------------------------
+!
+!* 10. Deallocate all local arrays
+! ---------------------------
+!
+! downdraft variables
+!
+ DEALLOCATE( ZDMF )
+ DEALLOCATE( ZDER )
+ DEALLOCATE( ZDDR )
+ DEALLOCATE( ILFS )
+ DEALLOCATE( ZLMASS )
+!
+! closure variables
+!
+ DEALLOCATE( ZTIMEC )
+ DEALLOCATE( ZTHC )
+ DEALLOCATE( ZRVC )
+ DEALLOCATE( ZRCC )
+ DEALLOCATE( ZRIC )
+ DEALLOCATE( ZWSUB )
+!
+ IF ( OCH1CONV ) THEN
+ DEALLOCATE( ZCH1 )
+ DEALLOCATE( ZCH1C )
+ DEALLOCATE( ZWORK3 )
+ END IF
+!
+! vertical index
+!
+DEALLOCATE( IDPL )
+DEALLOCATE( IPBL )
+DEALLOCATE( ILCL )
+DEALLOCATE( ICTL )
+DEALLOCATE( IETL )
+!
+! grid scale variables
+!
+DEALLOCATE( ZZ )
+DEALLOCATE( ZPRES )
+DEALLOCATE( ZDPRES )
+DEALLOCATE( ZTT )
+DEALLOCATE( ZTH )
+DEALLOCATE( ZTHV )
+DEALLOCATE( ZTHL )
+DEALLOCATE( ZTHES )
+DEALLOCATE( ZRW )
+DEALLOCATE( ZRV )
+DEALLOCATE( ZRC )
+DEALLOCATE( ZRI )
+DEALLOCATE( ZDXDY )
+!
+! updraft variables
+!
+DEALLOCATE( ZUMF )
+DEALLOCATE( ZUER )
+DEALLOCATE( ZUDR )
+DEALLOCATE( ZUTHL )
+DEALLOCATE( ZUTHV )
+DEALLOCATE( ZURW )
+DEALLOCATE( ZURC )
+DEALLOCATE( ZURI )
+DEALLOCATE( ZTHLCL )
+DEALLOCATE( ZTLCL )
+DEALLOCATE( ZRVLCL )
+DEALLOCATE( ZWLCL )
+DEALLOCATE( ZZLCL )
+DEALLOCATE( ZTHVELCL )
+DEALLOCATE( ZMFLCL )
+DEALLOCATE( ZCAPE )
+!
+! work arrays
+!
+DEALLOCATE( IJINDEX )
+DEALLOCATE( GTRIG1 )
+!
+!
+END SUBROUTINE SHALLOW_CONVECTION
diff --git a/src/mesonh/micro/c2r2_adjust.f90 b/src/mesonh/micro/c2r2_adjust.f90
new file mode 100644
index 000000000..b97914d1a
--- /dev/null
+++ b/src/mesonh/micro/c2r2_adjust.f90
@@ -0,0 +1,440 @@
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! #######################
+ MODULE MODI_C2R2_ADJUST
+! #######################
+!
+INTERFACE
+!
+ SUBROUTINE C2R2_ADJUST(KRR, TPFILE, HRAD, &
+ HTURBDIM, OSUBG_COND, PTSTEP, &
+ PRHODJ, PSIGS, PPABST, &
+ PTHS, PRVS, PRCS, PCNUCS, &
+ PCCS, PSRCS, PCLDFR, PRRS )
+!
+USE MODD_IO, ONLY: TFILEDATA
+!
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! Dimensionality of the turbulence scheme
+CHARACTER(len=4), INTENT(IN) :: HRAD ! Radiation scheme name
+LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid condensation
+REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute Pressure at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCNUCS ! Nucl. aero. conc. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCS ! Cloud water conc. source
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux s'rc'/2Sigma_s2 at time t+1 times Lambda_3
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PCLDFR ! Cloud fraction
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRRS ! Rain water m.r. source
+!
+END SUBROUTINE C2R2_ADJUST
+!
+END INTERFACE
+!
+END MODULE MODI_C2R2_ADJUST
+! ##########################################################################
+ SUBROUTINE C2R2_ADJUST(KRR, TPFILE, HRAD, &
+ HTURBDIM, OSUBG_COND, PTSTEP, &
+ PRHODJ, PSIGS, PPABST, &
+ PTHS, PRVS, PRCS, PCNUCS, &
+ PCCS, PSRCS, PCLDFR, PRRS )
+! ##########################################################################
+!
+!!**** *C2R2_ADJUST* - compute the fast microphysical sources for C2R2 or KHKO scheme
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the fast microphysical sources
+!! through a saturation ajustement procedure.
+!!
+!!
+!!** METHOD
+!! ------
+!! Langlois, Tellus, 1973 for the cloudless version.
+!! When cloud water is taken into account, refer to book 1 of the
+!! documentation.
+!!
+!!
+!!
+!! EXTERNAL
+!! --------
+!! None
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST
+!! XP00 ! Reference pressure
+!! XMD,XMV ! Molar mass of dry air and molar mass of vapor
+!! XRD,XRV ! Gaz constant for dry air, gaz constant for vapor
+!! XCPD,XCPV ! Cpd (dry air), Cpv (vapor)
+!! XCL ! Cl (liquid)
+!! XTT ! Triple point temperature
+!! XLVTT ! Vaporization heat constant
+!! XALPW,XBETAW,XGAMW ! Constants for saturation vapor
+!! ! pressure function
+!! Module MODD_CONF
+!! CCONF
+!! Module MODD_BUDGET:
+!! NBUMOD
+!! CBUTYPE
+!! LBU_RTH
+!! LBU_RRV
+!! LBU_RRC
+!! Module MODD_LES : NCTR_LES,LTURB_LES,NMODNBR_LES
+!! XNA declaration (cloud fraction as global var)
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Book 1 and Book2 of documentation ( routine FAST_TERMS )
+!! Langlois, Tellus, 1973
+!! AUTHOR
+!! ------
+!! E. Richard * Laboratoire d'Aerologie*
+!!
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 20/12/94
+!! Modifications: March 1, 1995 (J.M. Carriere)
+!! Introduction of cloud water with order 1
+!! formulation
+!! Modifications: June 8, 1995 ( J.Stein )
+!! Cleaning
+!! Modifications: August 30, 1995 ( J.Stein )
+!! add Lambda3 for the subgrid condensation
+!!
+!! October 16, 1995 (J. Stein) change the budget calls
+!! March 16, 1996 (J. Stein) store the cloud fraction
+!! April 03, 1996 (J. Stein) displace the nebulosity
+!! computation in the all and nothing case
+!! April 15, 1996 (J. Stein) displace the lambda 3
+!! multiplication and change the nebulosity threshold
+!! September 16, 1996 (J. Stein) bug in the SG cond for
+!! the M computation
+!! October 10, 1996 (J. Stein) reformulate the Subgrid
+!! condensation scheme
+!! October 8, 1996 (Cuxart,Sanchez) Cloud frac. LES diag (XNA)
+!! December 6, 1996 (J.-P. Pinty) correction of Delta_2
+!! November 5, 1996 (J. Stein) remove Rnp<0 values
+!! November 13 1996 (V. Masson) add prints in test above
+!! March 11, 1997 (J.-M. Cohard) C2R2 option
+!! March 2006 (O.Geoffroy) Add KHKO scheme
+!! October 2009 (G. Tanguy) add ILENCH=LEN(YCOMMENT) after
+!! change of YCOMMENT
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+use modd_budget, only: lbudget_th, lbudget_rv, lbudget_rc, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_SV1, &
+ tbudgets
+USE MODD_CONF
+USE MODD_CST
+USE MODD_FIELD, only: tfielddata, TYPEREAL
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_NSV, ONLY: NSV_C2R2BEG
+USE MODD_PARAMETERS
+!
+use mode_budget, only: Budget_store_init, Budget_store_end
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+USE MODE_MSG
+!
+USE MODI_CONDENS
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! Dimensionality of the turbulence scheme
+CHARACTER(len=4), INTENT(IN) :: HRAD ! Radiation scheme name
+LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid condensation
+REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute Pressure at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCNUCS ! Nucl. aero. conc. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCS ! Cloud water conc. source
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux s'rc'/2Sigma_s2 at time t+1 times Lambda_3
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PCLDFR ! Cloud fraction
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRRS ! Rain water m.r. source
+!
+!* 0.2 Declarations of local variables :
+!
+!
+REAL :: ZEPS ! Mv/Md
+REAL, DIMENSION(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3)) &
+ :: ZEXNS,& ! guess of the Exner function at t+1
+ ZT, & ! guess of the temperature at t+1
+ ZCPH, & ! guess of the CPh for the mixing
+ ZLV, & ! guess of the Lv at t+1
+ ZW1,ZW2,ZW3 ! Work arrays for intermediate
+ ! fields
+!
+INTEGER :: IRESP ! Return code of FM routines
+INTEGER :: JITER,ITERMAX ! iterative loop for first order adjustment
+INTEGER :: ILUOUT ! Logical unit of output listing
+TYPE(TFIELDDATA) :: TZFIELD
+!-------------------------------------------------------------------------------
+!
+!* 1. PRELIMINARIES
+! -------------
+!
+if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'COND', prvs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'COND', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'COND', pths(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg ), 'CEVA', pcnucs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'CEVA', pccs (:, :, :) * prhodj(:, :, :) )
+end if
+
+ILUOUT = TLUOUT%NLU
+ZEPS= XMV / XMD
+!
+IF (OSUBG_COND) THEN
+ ITERMAX=2
+ELSE
+ ITERMAX=1
+END IF
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. COMPUTE QUANTITIES WITH THE GUESS OF THE FUTURE INSTANT
+! -------------------------------------------------------
+!
+!* 2.1 remove negative non-precipitating negative water
+! ------------------------------------------------
+!
+IF (ANY(PRCS(:,:,:) < 0. .OR. PCCS(:,:,:) < 0.)) THEN
+ WRITE(ILUOUT,*) 'C2R2_ADJUST beginning: negative values of PRCS or PCCS'
+ WRITE(ILUOUT,*) ' location of minimum of PRCS:', MINLOC(PRCS(:,:,:))
+ WRITE(ILUOUT,*) ' value of minimum :', MINVAL(PRCS(:,:,:))
+ WRITE(ILUOUT,*) ' location of minimum of PCCS:', MINLOC(PCCS(:,:,:))
+ WRITE(ILUOUT,*) ' value of minimum :', MINVAL(PCCS(:,:,:))
+END IF
+!
+IF (ANY(PRCS(:,:,:)+PRVS(:,:,:) < 0.) .AND. NVERB>5) THEN
+ WRITE(ILUOUT,*) 'C2R2_ADJUST: negative values of total water (reset to zero)'
+ WRITE(ILUOUT,*) ' location of minimum:', MINLOC(PRCS(:,:,:)+PRVS(:,:,:))
+ WRITE(ILUOUT,*) ' value of minimum :', MINVAL(PRCS(:,:,:)+PRVS(:,:,:))
+!callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','C2R2_ADJUST','')
+END IF
+!
+WHERE ( PRCS(:,:,:)+PRVS(:,:,:) < 0.)
+ PRVS(:,:,:) = - PRCS(:,:,:)
+END WHERE
+!
+!* 2.2 estimate the Exner function at t+1
+!
+ZEXNS(:,:,:) = ( PPABST(:,:,:) / XP00 ) ** (XRD/XCPD)
+!
+! beginning of the iterative loop
+!
+DO JITER =1,ITERMAX
+!
+!* 2.3 compute the intermediate temperature at t+1, T*
+!
+ ZT(:,:,:) = ( PTHS(:,:,:) * PTSTEP ) * ZEXNS(:,:,:)
+!
+!* 2.4 compute the latent heat of vaporization Lv(T*) at t+1
+!
+ ZLV(:,:,:) = XLVTT + ( XCPV - XCL ) * ( ZT(:,:,:) -XTT )
+!
+!* 2.5 compute the specific heat for moist air (Cph) at t+1
+!
+ IF ( KRR == 3 ) THEN
+ ZCPH(:,:,:) = XCPD + XCPV *PTSTEP* PRVS(:,:,:) &
+ + XCL *PTSTEP* ( PRCS(:,:,:) + PRRS(:,:,:) )
+ ELSE IF( KRR == 2 ) THEN
+ ZCPH(:,:,:) = XCPD + XCPV *PTSTEP* PRVS(:,:,:) &
+ + XCL *PTSTEP* PRCS(:,:,:)
+ END IF
+!
+!* 2.6 compute the saturation vapor pressure at t+1
+!
+ ZW1(:,:,:) = EXP( XALPW - XBETAW/ZT(:,:,:) - XGAMW*ALOG( ZT(:,:,:) ) )
+!
+!* 2.7 compute the saturation mixing ratio at t+1
+!
+ ZW2(:,:,:) = ZW1(:,:,:) * ZEPS / &
+ ( PPABST(:,:,:) - ZW1(:,:,:) )
+!
+!* 2.8 compute the saturation mixing ratio derivative (rvs')
+!
+ ZW1(:,:,:) = ( XBETAW / ZT(:,:,:) - XGAMW ) / ZT(:,:,:) &
+ * ZW2(:,:,:) * ( 1. + ZW2(:,:,:) / ZEPS )
+!
+!* 2.9 compute Cph + Lv * rvs'
+!
+ ZW3(:,:,:) = ZCPH(:,:,:) + ZLV(:,:,:) * ZW1(:,:,:)
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. FIRST ORDER SUBGRID CONDENSATION SCHEME
+! ---------------------------------------
+!
+ IF ( OSUBG_COND ) THEN
+!
+!* 3.1 compute Q1
+!
+ ZW2(:,:,:) = ( ( PRVS(:,:,:)*PTSTEP - ZW2(:,:,:) ) * ZCPH(:,:,:) / ZW3(:,:,:) &
+ + PRCS(:,:,:)*PTSTEP &
+ ) / ( 2. * PSIGS(:,:,:) )
+
+!
+!* 3.2 compute s'rc'/2Sigma_s2, Rc and the nebolisity
+!
+ CALL CONDENS(HTURBDIM, ZW2,ZW1,ZW3,PSRCS) ! ZW1 = Cloud fraction
+ ! PSRC = s'rc'/(2 Sigma_s**2)
+ ! ZW3 = Rc / (2 Sigma_s)
+ ZW3(:,:,:) = 2. * PSIGS(:,:,:) * ZW3(:,:,:) ! Rc
+!
+! multiply PSRCS by the lambda3 coefficient
+!
+ IF ( HTURBDIM == '1DIM'.AND.JITER==ITERMAX ) THEN
+ PSRCS(:,:,:) = PSRCS(:,:,:) * MIN( 3. , MAX(1.,1.-ZW2(:,:,:)) )
+ END IF ! in the 3D case lamda_3 = 1.
+!
+!* 3.3 compute the variation of mixing ratio
+!
+ ! Rc - Rc*
+ ZW3(:,:,:) = (ZW3(:,:,:)/PTSTEP) - PRCS(:,:,:) ! Pcon = ----------
+ ! 2 Delta t
+ ELSE
+!
+!
+!* 4. SECOND ORDER ALL OR NOTHING CONDENSATION SCHEME
+! -----------------------------------------------
+!
+!* 4.1 compute Delta 2
+!
+ ZW1(:,:,:) = (ZW1(:,:,:) * ZLV(:,:,:) / ZW3(:,:,:) ) * &
+ ( ((-2.*XBETAW+XGAMW*ZT(:,:,:)) / (XBETAW-XGAMW*ZT(:,:,:)) &
+ + (XBETAW/ZT(:,:,:)-XGAMW)*(1.0+2.0*ZW2(:,:,:)/ZEPS))/ZT(:,:,:) )
+!
+!* 4.2 compute Delta 1
+!
+ ZW2(:,:,:) = ZLV(:,:,:) / ZW3(:,:,:) * ( ZW2(:,:,:) - PRVS(:,:,:)*PTSTEP )
+!
+!* 4.3 compute the variation of mixing ratio
+!
+ ZW3(:,:,:) = - ZW2(:,:,:) * ( 1 + 0.5 * ZW2(:,:,:) * ZW1(:,:,:) ) &
+ * ZCPH(:,:,:) / ZLV(:,:,:) / PTSTEP
+!
+! end of the IF structure on the all or nothing or statistical condensation
+! scheme
+!
+ END IF
+!
+!
+!* 5. COMPUTE THE SOURCES AND STORES THE CLOUD FRACTION
+! -------------------------------------------------
+!
+!
+!* 5.1 compute the sources
+!
+ ZW3(:,:,:) = MAX ( ZW3(:,:,:), -PRCS(:,:,:) )
+ WHERE (ZW3(:,:,:) > 0.0)
+ ZW3(:,:,:) = MIN ( ZW3(:,:,:), PRVS(:,:,:) )
+ END WHERE
+ WHERE (PCCS(:,:,:) > 0.0)
+ PRCS(:,:,:) = PRCS(:,:,:) + ZW3(:,:,:)
+ PRVS(:,:,:) = PRVS(:,:,:) - ZW3(:,:,:)
+ PTHS(:,:,:) = PTHS(:,:,:) + ZW3(:,:,:) * ZLV(:,:,:) / ZCPH(:,:,:) &
+ / ZEXNS(:,:,:)
+ END WHERE
+!
+! WHERE (PRCS(:,:,:) <= 0.0) ! full evaporation of the cloud droplets
+! PCNUCS(:,:,:) = 0.0
+! PCCS(:,:,:) = 0.0
+! END WHERE
+ WHERE (PRCS(:,:,:) <= 1.E-7/ PTSTEP ) ! full evaporation of the cloud droplets (PRCS >=0)
+ PRVS(:,:,:) = PRVS(:,:,:) + PRCS(:,:,:)
+ PTHS(:,:,:) = PTHS(:,:,:) - PRCS(:,:,:) * ZLV(:,:,:) / ZCPH(:,:,:) &
+ / ZEXNS(:,:,:)
+ PRCS(:,:,:) = 0.0
+ PCNUCS(:,:,:) = 0.0
+ PCCS(:,:,:) = 0.0
+ END WHERE
+! end of the iterative loop
+!
+END DO
+!
+!* 5.2 compute the cloud fraction PCLDFR
+!
+IF ( .NOT. OSUBG_COND ) THEN
+ WHERE (PRCS(:,:,:) > 1.E-12 / PTSTEP)
+ ZW1(:,:,:) = 1.
+ ELSEWHERE
+ ZW1(:,:,:) = 0.
+ ENDWHERE
+ IF ( SIZE(PSRCS,3) /= 0 ) THEN
+ PSRCS(:,:,:) = ZW1(:,:,:)
+ END IF
+END IF
+!
+IF ( HRAD /= 'NONE' ) THEN
+ PCLDFR(:,:,:) = ZW1(:,:,:)
+END IF
+!
+IF ( tpfile%lopened ) THEN
+ TZFIELD%CMNHNAME = 'NEB'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'NEB'
+ TZFIELD%CUNITS = '1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_NEB'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZW1)
+END IF
+!
+!
+! 6. Horizontal mean Cloud fraction (for LES uses)
+! ---------------------------------------------
+!
+!
+!* 7. STORE THE BUDGET TERMS
+! ----------------------
+!
+if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'COND', prvs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'COND', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'COND', pths(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg ), 'CEVA', pcnucs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'CEVA', pccs (:, :, :) * prhodj(:, :, :) )
+end if
+
+!------------------------------------------------------------------------------
+!
+!
+END SUBROUTINE C2R2_ADJUST
diff --git a/src/mesonh/micro/cart_compress.f90 b/src/mesonh/micro/cart_compress.f90
new file mode 100644
index 000000000..d1e922e9b
--- /dev/null
+++ b/src/mesonh/micro/cart_compress.f90
@@ -0,0 +1,170 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! masdev4_7 BUG2 2007/06/29 16:52:14
+!-----------------------------------------------------------------
+!#########################
+ MODULE MODI_CART_COMPRESS
+!#########################
+!
+INTERFACE
+!
+FUNCTION CART_COMPRESS(PVARS) RESULT(PCOMPRESS)
+!
+USE MODD_BUDGET
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PVARS ! Source
+REAL, DIMENSION(NBUIMAX,NBUJMAX,NBUKMAX) :: PCOMPRESS ! result
+!
+END FUNCTION CART_COMPRESS
+!
+END INTERFACE
+!
+END MODULE MODI_CART_COMPRESS
+! ###############################################
+ FUNCTION CART_COMPRESS(PVARS) RESULT(PCOMPRESS)
+! ###############################################
+!
+!!**** *CART_COMPRESS* - function to compress the Source in CART case.
+!!
+!!
+!! PURPOSE
+!! -------
+! This function compresses or not the Source XVARS of the VARiable
+! VAR whose budget is analysed. This compression is controlled by 3
+! logical switches for the budget in I,J and K directions (LBU_ICP,
+! LBU_JCP, LBU_KCP), in the budget box described by the lowest and
+! highest values of the I,J and K indices.
+!
+!!** METHOD
+!! ------
+!! The source PVARS is first transfered in a local array whose
+!! dimensions correspond to the budget box. Then compressions
+!! are or aren't achieved depending on the logical switches.
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_BUDGET
+!! LBU_ICP : switch for compression in I direction
+!! LBU_JCP : switch for compression in J direction
+!! LBU_KCP : switch for compression in K direction
+!! NBUIL : lowest I indice value of the budget box
+!! NBUJL : lowest J indice value of the budget box
+!! NBUKL : lowest K indice value of the budget box
+!! NBUIH : highest I indice value of the budget box
+!! NBUJH : highest J indice value of the budget box
+!! NBUKH : highest K indice value of the budget box
+!! NBUIMAX : dimension along I of the budget tabular
+!! NBUJMAX : dimension along J of the budget tabular
+!! NBUKMAX : dimension along K of the budget tabular
+!!
+!!
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of MESO-NH documentation (function CART_COMPRESS)
+!!
+!!
+!! AUTHOR
+!! ------
+!! J. Nicolau * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 27/02/95
+!! JP Pinty & J Escobar 12/10/98 Enable vectorization and remove
+!! SUM functions
+!! V. Ducrocq 4/06/99 //
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_BUDGET
+USE MODD_PARAMETERS , ONLY : JPVEXT
+!
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 Declarations of arguments and result :
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PVARS ! Source
+REAL, DIMENSION(NBUIMAX,NBUJMAX,NBUKMAX) :: PCOMPRESS ! result
+!
+!* 0.2 Declarations of local variables :
+!
+!
+REAL, DIMENSION (NBUSIH-NBUSIL+1,NBUSJH-NBUSJL+1,NBUKH-NBUKL+1) :: ZVARS ! 3D Work
+ ! array
+REAL, DIMENSION (NBUSIH-NBUSIL+1,NBUKH-NBUKL+1) :: ZWORKIK ! 2D Work array
+REAL, DIMENSION (NBUSJH-NBUSJL+1,NBUKH-NBUKL+1) :: ZWORKJK ! 2D Work array
+REAL, DIMENSION (NBUSIH-NBUSIL+1,NBUSJH-NBUSJL+1) :: ZWORKIJ ! 2D Work array
+!
+INTEGER :: JJ,JK ! loop indexes
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. SOURCE TRANSFERT IN A LOCAL ARRAY
+! ---------------------------------
+!JUAN
+IF (SIZE (PCOMPRESS) .EQ. 0 ) RETURN
+!JUAN
+!
+ZVARS(1:NBUSIH-NBUSIL+1,1:NBUSJH-NBUSJL+1,1:NBUKH-NBUKL+1) = &
+ PVARS(NBUSIL:NBUSIH,NBUSJL:NBUSJH,NBUKL+JPVEXT:NBUKH+JPVEXT)
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. COMPRESSIONS IN I,J AND K DIRECTIONS
+! ------------------------------------
+!
+!
+IF (LBU_ICP.AND.LBU_JCP.AND.LBU_KCP) THEN
+ PCOMPRESS(1,1,1)=SUM(ZVARS)
+!
+ELSE IF (LBU_ICP.AND.LBU_JCP.AND..NOT.LBU_KCP) THEN
+ ZWORKJK(:,:) =SUM(ZVARS,1)
+ PCOMPRESS(1,1,:)=SUM(ZWORKJK,1)
+!
+ELSE IF (LBU_ICP.AND..NOT.LBU_JCP.AND.LBU_KCP) THEN
+ ZWORKIJ(:,:)=0.0
+ DO JK = 1,NBUKH-NBUKL+1
+ ZWORKIJ(:,:) = ZWORKIJ(:,:) + ZVARS(:,:,JK)
+ END DO
+ PCOMPRESS(1,:,1)=SUM(ZWORKIJ,1)
+!
+ELSE IF (.NOT.LBU_ICP.AND.LBU_JCP.AND.LBU_KCP) THEN
+ ZWORKIK(:,:)=0.0
+ DO JJ = 1,NBUSJH-NBUSJL+1
+ ZWORKIK(:,:) = ZWORKIK(:,:) + ZVARS(:,JJ,:)
+ END DO
+ PCOMPRESS(:,1,1)=SUM(ZWORKIK,2)
+!
+ELSE IF (LBU_ICP.AND..NOT.LBU_JCP.AND..NOT.LBU_KCP) THEN
+ PCOMPRESS(1,:,:)=SUM(ZVARS,1)
+!
+ELSE IF (.NOT.LBU_ICP.AND.LBU_JCP.AND..NOT.LBU_KCP) THEN
+ PCOMPRESS(:,1,:)=SUM(ZVARS,2)
+!
+ELSE IF (.NOT.LBU_ICP.AND..NOT.LBU_JCP.AND.LBU_KCP) THEN
+ PCOMPRESS(:,:,1)=SUM(ZVARS,3)
+!
+ELSE
+ PCOMPRESS=ZVARS
+!
+END IF
+!
+!
+END FUNCTION CART_COMPRESS
diff --git a/src/mesonh/micro/condensation.f90 b/src/mesonh/micro/condensation.f90
new file mode 100644
index 000000000..ec60d4067
--- /dev/null
+++ b/src/mesonh/micro/condensation.f90
@@ -0,0 +1,513 @@
+!MNH_LIC Copyright 2002-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ######spl
+ MODULE MODI_CONDENSATION
+! ########################
+!
+INTERFACE
+!
+ SUBROUTINE CONDENSATION( KIU, KJU, KKU, KIB, KIE, KJB, KJE, KKB, KKE, KKL,&
+ HFRAC_ICE, HCONDENS, HLAMBDA3, &
+ PPABS, PZZ, PRHODREF, PT, PRV, PRC, PRI, PRS, PRG, PSIGS, PMFCONV, PCLDFR, PSIGRC, OUSERI,&
+ OSIGMAS, PSIGQSAT, PLV, PLS, PCPH, PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF)
+!
+INTEGER, INTENT(IN) :: KIU ! horizontal dimension in x
+INTEGER, INTENT(IN) :: KJU ! horizontal dimension in y
+INTEGER, INTENT(IN) :: KKU ! vertical dimension
+INTEGER, INTENT(IN) :: KIB ! value of the first point in x
+INTEGER, INTENT(IN) :: KIE ! value of the last point in x
+INTEGER, INTENT(IN) :: KJB ! value of the first point in y
+INTEGER, INTENT(IN) :: KJE ! value of the last point in y
+INTEGER, INTENT(IN) :: KKB ! value of the first point in z
+INTEGER, INTENT(IN) :: KKE ! value of the last point in z
+INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE
+CHARACTER(len=4), INTENT(IN) :: HCONDENS
+CHARACTER(len=*), INTENT(IN) :: HLAMBDA3 ! formulation for lambda3 coeff
+REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PPABS ! pressure (Pa)
+REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PZZ ! height of model levels (m)
+REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PRHODREF
+REAL, DIMENSION(KIU,KJU,KKU), INTENT(INOUT) :: PT ! grid scale T (K)
+REAL, DIMENSION(KIU,KJU,KKU), INTENT(INOUT) :: PRV ! grid scale water vapor mixing ratio (kg/kg)
+REAL, DIMENSION(KIU,KJU,KKU), INTENT(INOUT) :: PRC ! grid scale r_c mixing ratio (kg/kg)
+REAL, DIMENSION(KIU,KJU,KKU), INTENT(INOUT) :: PRI ! grid scale r_i (kg/kg)
+REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PRS ! grid scale mixing ration of snow (kg/kg)
+REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PRG ! grid scale mixing ration of graupel (kg/kg)
+REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PSIGS ! Sigma_s from turbulence scheme
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV! convective mass flux (kg /s m^2)
+REAL, DIMENSION(KIU,KJU,KKU), INTENT(OUT) :: PCLDFR ! cloud fraction
+REAL, DIMENSION(KIU,KJU,KKU), INTENT(OUT) :: PSIGRC ! s r_c / sig_s^2
+LOGICAL, INTENT(IN) :: OUSERI ! logical switch to compute both
+ ! liquid and solid condensate (OUSERI=.TRUE.)
+ ! or only solid condensate (OUSERI=.FALSE.)
+LOGICAL, INTENT(IN) :: OSIGMAS! use present global Sigma_s values
+ ! or that from turbulence scheme
+REAL, INTENT(IN) :: PSIGQSAT ! use an extra "qsat" variance contribution (OSIGMAS case)
+REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(IN) :: PLV
+REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(IN) :: PLS
+REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(IN) :: PCPH
+REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(OUT) :: PHLC_HRC !cloud water content in precipitating part
+REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(OUT) :: PHLC_HCF !precipitating part
+REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(OUT) :: PHLI_HRI !
+REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(OUT) :: PHLI_HCF !
+
+END SUBROUTINE CONDENSATION
+!
+END INTERFACE
+!
+END MODULE MODI_CONDENSATION
+! ######spl
+ SUBROUTINE CONDENSATION( KIU, KJU, KKU, KIB, KIE, KJB, KJE, KKB, KKE, KKL, &
+ HFRAC_ICE, HCONDENS, HLAMBDA3, &
+ PPABS, PZZ, PRHODREF, PT, PRV, PRC, PRI, PRS, PRG, PSIGS, PMFCONV, PCLDFR, PSIGRC, OUSERI,&
+ OSIGMAS, PSIGQSAT, PLV, PLS, PCPH, PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF )
+! ################################################################################
+!
+!!
+!! PURPOSE
+!! -------
+!!** Routine to diagnose cloud fraction, liquid and ice condensate mixing ratios
+!! and s'rl'/sigs^2
+!!
+!!
+!!** METHOD
+!! ------
+!! Based on the large-scale fields of temperature, water vapor, and possibly
+!! liquid and solid condensate, the conserved quantities r_t and h_l are constructed
+!! and then fractional cloudiness, liquid and solid condensate is diagnosed.
+!!
+!! The total variance is parameterized as the sum of stratiform/turbulent variance
+!! and a convective variance.
+!! The turbulent variance is parameterized as a function of first-order moments, and
+!! the convective variance is modelled as a function of the convective mass flux
+!! (units kg/s m^2) as provided by the mass flux convection scheme.
+!!
+!! Nota: if the host model does not use prognostic values for liquid and solid condensate
+!! or does not provide a convective mass flux, put all these values to zero.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! INI_CST
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST : contains physical constants
+!!
+!! REFERENCE
+!! ---------
+!! Chaboureau J.P. and P. Bechtold (J. Atmos. Sci. 2002)
+!!
+!! AUTHOR
+!! ------
+!! P. BECHTOLD * Laboratoire d'Aerologie *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original: 31.1.2002
+!! modified : 21.3.2002
+!! S.Malardel : 05.2006 : Correction sur le calcul de la fonction de
+!! Bougeault F2
+!! W. de Rooy: 06-06-2010: Modification in the statistical cloud scheme
+!! more specifically adding a variance term
+!! following ideas of Lenderink & Siebesma 2002
+!! and adding a height dependence
+!! S. Riette, 18 May 2010 : PSIGQSAT is added
+!! S. Riette, 11 Oct 2011 : MIN function in PDF for continuity
+!! modification of minimum value for Rc+Ri to create cloud and minimum value for sigma
+!! Use of guess point as a starting point instead of liquid point
+!! Better computation of ZCPH and dRsat/dT
+!! Set ZCOND to zero if PCLDFR==0
+!! Safety limitation to .99*Pressure for saturation vapour pressure
+!! 2012-02 Y. Seity, add possibility to run with reversed vertical levels
+!! 2015 C.Lac Change min value of ZSIGMA to be in agreement with AROME
+!! 2016 G.Delautier Restore min value of ZSIGMA (instability)
+!! 2016 S.Riette Change INQ1
+!! 2016-11 S. Riette: use HFRAC_ICE, output adjusted state
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_PARAMETERS
+USE MODD_RAIN_ICE_PARAM, ONLY : XCRIAUTC, XCRIAUTI, XACRIAUTI, XBCRIAUTI
+!
+use mode_msg
+!
+USE MODI_COMPUTE_FRAC_ICE
+!
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+!
+INTEGER, INTENT(IN) :: KIU ! horizontal dimension in x
+INTEGER, INTENT(IN) :: KJU ! horizontal dimension in y
+INTEGER, INTENT(IN) :: KKU ! vertical dimension
+INTEGER, INTENT(IN) :: KIB ! value of the first point in x
+INTEGER, INTENT(IN) :: KIE ! value of the last point in x
+INTEGER, INTENT(IN) :: KJB ! value of the first point in y
+INTEGER, INTENT(IN) :: KJE ! value of the last point in y
+INTEGER, INTENT(IN) :: KKB ! value of the first point in z
+INTEGER, INTENT(IN) :: KKE ! value of the last point in z
+INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE
+CHARACTER(len=4), INTENT(IN) :: HCONDENS
+CHARACTER(len=*), INTENT(IN) :: HLAMBDA3 ! formulation for lambda3 coeff
+REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PPABS ! pressure (Pa)
+REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PZZ ! height of model levels (m)
+REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PRHODREF
+REAL, DIMENSION(KIU,KJU,KKU), INTENT(INOUT) :: PT ! grid scale T (K)
+REAL, DIMENSION(KIU,KJU,KKU), INTENT(INOUT) :: PRV ! grid scale water vapor mixing ratio (kg/kg)
+REAL, DIMENSION(KIU,KJU,KKU), INTENT(INOUT) :: PRC ! grid scale r_c mixing ratio (kg/kg)
+REAL, DIMENSION(KIU,KJU,KKU), INTENT(INOUT) :: PRI ! grid scale r_i (kg/kg)
+REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PRS ! grid scale mixing ration of snow (kg/kg)
+REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PRG ! grid scale mixing ration of graupel (kg/kg)
+REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PSIGS ! Sigma_s from turbulence scheme
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV! convective mass flux (kg /s m^2)
+REAL, DIMENSION(KIU,KJU,KKU), INTENT(OUT) :: PCLDFR ! cloud fraction
+REAL, DIMENSION(KIU,KJU,KKU), INTENT(OUT) :: PSIGRC ! s r_c / sig_s^2
+
+REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(IN) :: PLV ! Latent heat L_v
+REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(IN) :: PLS ! Latent heat L_s
+REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(IN) :: PCPH ! Specific heat C_ph
+REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(OUT) :: PHLC_HRC
+REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(OUT) :: PHLC_HCF ! cloud fraction
+REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(OUT) :: PHLI_HRI
+REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(OUT) :: PHLI_HCF
+LOGICAL, INTENT(IN) :: OUSERI ! logical switch to compute both
+ ! liquid and solid condensate (OUSERI=.TRUE.)
+ ! or only solid condensate (OUSERI=.FALSE.)
+LOGICAL, INTENT(IN) :: OSIGMAS! use present global Sigma_s values
+ ! or that from turbulence scheme
+REAL, INTENT(IN) :: PSIGQSAT ! use an extra "qsat" variance contribution (OSIGMAS case)
+
+!
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: JI, JJ, JK, JKP, JKM, IKTB, IKTE ! loop index
+REAL, DIMENSION(KIU,KJU,KKU) :: ZTLK, ZRT ! work arrays for T_l and total water mixing ratio
+REAL, DIMENSION(KIU,KJU,KKU) :: ZL ! length scale
+REAL, DIMENSION(KIU,KJU,KKU) :: ZFRAC ! Ice fraction
+REAL, DIMENSION(KIU,KJU,KKU) :: ZCRIAUTI !
+INTEGER, DIMENSION(KIU,KJU) :: ITPL ! top levels of troposphere
+REAL, DIMENSION(KIU,KJU) :: ZTMIN ! minimum Temp. related to ITPL
+!
+REAL, DIMENSION(KIU,KJU,KKU) :: ZLV, ZLS, ZCPD
+REAL, DIMENSION(KIU,KJU,KKU) :: ZCOND
+REAL :: ZGCOND, ZSBAR, ZSBARC, ZQ1, ZAUTC, ZAUTI, ZGAUV, ZGAUC, ZGAUI, ZGAUTC, ZGAUTI ! Used for integration in Gaussian Probability Density Function
+REAL :: ZTEMP, ZPV, ZQSL, ZPIV, ZQSI, ZLVS ! thermodynamics
+REAL :: ZLL, DZZ, ZZZ ! used for length scales
+REAL :: ZAH, ZA, ZB, ZSIGMA, ZDRW, ZDTL, ZSIG_CONV ! related to computation of Sig_s
+REAL :: ZRCOLD, ZRIOLD
+INTEGER :: INQ1
+REAL :: ZINC
+!
+!* 0.3 Definition of constants :
+!
+!-------------------------------------------------------------------------------
+!
+REAL,PARAMETER :: ZL0 = 600. ! tropospheric length scale
+REAL,PARAMETER :: ZCSIGMA = 0.2 ! constant in sigma_s parameterization
+REAL,PARAMETER :: ZCSIG_CONV = 0.30E-2 ! scaling factor for ZSIG_CONV as function of mass flux
+!
+
+REAL, DIMENSION(-22:11),PARAMETER :: ZSRC_1D =(/ &
+ 0. , 0. , 2.0094444E-04, 0.316670E-03, &
+ 4.9965648E-04, 0.785956E-03 , 1.2341294E-03, 0.193327E-02, &
+ 3.0190963E-03, 0.470144E-02 , 7.2950651E-03, 0.112759E-01, &
+ 1.7350994E-02, 0.265640E-01 , 4.0427860E-02, 0.610997E-01, &
+ 9.1578111E-02, 0.135888E+00 , 0.1991484 , 0.230756E+00, &
+ 0.2850565 , 0.375050E+00 , 0.5000000 , 0.691489E+00, &
+ 0.8413813 , 0.933222E+00 , 0.9772662 , 0.993797E+00, &
+ 0.9986521 , 0.999768E+00 , 0.9999684 , 0.999997E+00, &
+ 1.0000000 , 1.000000 /)
+!
+!-------------------------------------------------------------------------------
+!
+!
+
+IKTB=1+JPVEXT
+IKTE=KKU-JPVEXT
+
+PCLDFR(:,:,:) = 0. ! Initialize values
+PSIGRC(:,:,:) = 0. ! Initialize values
+!
+!
+!-------------------------------------------------------------------------------
+! store total water mixing ratio
+DO JK=IKTB,IKTE
+ DO JJ=KJB,KJE
+ DO JI=KIB,KIE
+ ZRT(JI,JJ,JK) = PRV(JI,JJ,JK) + PRC(JI,JJ,JK) + PRI(JI,JJ,JK)
+ END DO
+ END DO
+END DO
+!-------------------------------------------------------------------------------
+! Preliminary calculations
+! latent heat of vaporisation/sublimation
+IF(PRESENT(PLV) .AND. PRESENT(PLS)) THEN
+ ZLV(:,:,:)=PLV(:,:,:)
+ ZLS(:,:,:)=PLS(:,:,:)
+ELSE
+ DO JK=IKTB,IKTE
+ DO JJ=KJB,KJE
+ DO JI=KIB,KIE
+ ZTEMP = PT(JI,JJ,JK)
+ ! latent heat of vaporisation/sublimation
+ ZLV(JI,JJ,JK) = XLVTT + ( XCPV - XCL ) * ( ZTEMP - XTT )
+ ZLS(JI,JJ,JK) = XLSTT + ( XCPV - XCI ) * ( ZTEMP - XTT )
+ ENDDO
+ ENDDO
+ ENDDO
+ENDIF
+IF(PRESENT(PCPH)) THEN
+ ZCPD(:,:,:)=PCPH(:,:,:)
+ELSE
+ DO JK=IKTB,IKTE
+ DO JJ=KJB,KJE
+ DO JI=KIB,KIE
+ ZCPD(JI,JJ,JK) = XCPD + XCPV*PRV(JI,JJ,JK) + XCL*PRC(JI,JJ,JK) + XCI*PRI(JI,JJ,JK) + &
+ XCI*(PRS(JI,JJ,JK) + PRG(JI,JJ,JK) )
+ ENDDO
+ ENDDO
+ ENDDO
+ENDIF
+!-------------------------------------------------------------------------------
+! Preliminary calculations needed for computing the "turbulent part" of Sigma_s
+IF ( .NOT. OSIGMAS ) THEN
+ DO JK=IKTB,IKTE
+ DO JJ=KJB,KJE
+ DO JI=KIB,KIE
+ ZTEMP = PT(JI,JJ,JK)
+ ! store temperature at saturation
+ ZTLK(JI,JJ,JK) = ZTEMP - ZLV(JI,JJ,JK)*PRC(JI,JJ,JK)/ZCPD(JI,JJ,JK) &
+ - ZLS(JI,JJ,JK)*PRI(JI,JJ,JK)/ZCPD(JI,JJ,JK)
+ END DO
+ END DO
+ END DO
+ ! Determine tropopause/inversion height from minimum temperature
+ ITPL(:,:) = KIB+1
+ ZTMIN(:,:) = 400.
+ DO JK = IKTB+1,IKTE-1
+ DO JJ=KJB,KJE
+ DO JI=KIB,KIE
+ IF ( PT(JI,JJ,JK) < ZTMIN(JI,JJ) ) THEN
+ ZTMIN(JI,JJ) = PT(JI,JJ,JK)
+ ITPL(JI,JJ) = JK
+ ENDIF
+ END DO
+ END DO
+ END DO
+ ! Set the mixing length scale
+ ZL(:,:,KKB) = 20.
+ DO JK = KKB+KKL,KKE,KKL
+ DO JJ=KJB,KJE
+ DO JI=KIB,KIE
+ ! free troposphere
+ ZL(JI,JJ,JK) = ZL0
+ ZZZ = PZZ(JI,JJ,JK) - PZZ(JI,JJ,KKB)
+ JKP = ITPL(JI,JJ)
+ ! approximate length for boundary-layer
+ IF ( ZL0 > ZZZ ) ZL(JI,JJ,JK) = ZZZ
+ ! gradual decrease of length-scale near and above tropopause
+ IF ( ZZZ > 0.9*(PZZ(JI,JJ,JKP)-PZZ(JI,JJ,KKB)) ) &
+ ZL(JI,JJ,JK) = .6 * ZL(JI,JJ,JK-KKL)
+ END DO
+ END DO
+ END DO
+END IF
+!-------------------------------------------------------------------------------
+!
+!
+!Ice fraction
+ZFRAC(:,:,:) = 0.
+IF (OUSERI) THEN
+ WHERE(PRC(:,:,:)+PRI(:,:,:) > 1.E-20)
+ ZFRAC(:,:,:) = PRI(:,:,:) / (PRC(:,:,:)+PRI(:,:,:))
+ ENDWHERE
+ CALL COMPUTE_FRAC_ICE(HFRAC_ICE, ZFRAC, PT)
+ENDIF
+!
+DO JK=IKTB,IKTE
+ JKP=MAX(MIN(JK+KKL,IKTE),IKTB)
+ JKM=MAX(MIN(JK-KKL,IKTE),IKTB)
+ DO JJ=KJB,KJE
+ DO JI=KIB,KIE
+ ! latent heats
+ ZTEMP = PT(JI,JJ,JK)
+ ! saturated water vapor mixing ratio over liquid water
+ ZPV = MIN(EXP( XALPW - XBETAW / ZTEMP - XGAMW * LOG( ZTEMP ) ), .99*PPABS(JI,JJ,JK))
+ ZQSL = XRD / XRV * ZPV / ( PPABS(JI,JJ,JK) - ZPV )
+
+ ! saturated water vapor mixing ratio over ice
+ ZPIV = MIN(EXP( XALPI - XBETAI / ZTEMP - XGAMI * LOG( ZTEMP ) ), .99*PPABS(JI,JJ,JK))
+ ZQSI = XRD / XRV * ZPIV / ( PPABS(JI,JJ,JK) - ZPIV )
+
+ ! interpolate between liquid and solid as function of temperature
+ ZQSL = (1. - ZFRAC(JI,JJ,JK)) * ZQSL + ZFRAC(JI,JJ,JK) * ZQSI
+ ZLVS = (1. - ZFRAC(JI,JJ,JK)) * ZLV(JI,JJ,JK) + &
+ & ZFRAC(JI,JJ,JK) * ZLS(JI,JJ,JK)
+
+ ! coefficients a and b
+ ZAH = ZLVS * ZQSL / ( XRV * ZTEMP**2 ) * (XRV * ZQSL / XRD + 1.)
+ ZA = 1. / ( 1. + ZLVS/ZCPD(JI,JJ,JK) * ZAH )
+ ZB = ZAH * ZA
+
+ ZSBAR = ZA * ( ZRT(JI,JJ,JK) - ZQSL + &
+ & ZAH * ZLVS * (PRC(JI,JJ,JK)+PRI(JI,JJ,JK)) / ZCPD(JI,JJ,JK))
+
+ ! switch to take either present computed value of SIGMAS
+ ! or that of Meso-NH turbulence scheme
+ IF ( OSIGMAS ) THEN
+ IF (PSIGQSAT/=0.) THEN
+ ZSIGMA = SQRT((2*PSIGS(JI,JJ,JK))**2 + (PSIGQSAT*ZQSL*ZA)**2)
+ ELSE
+ ZSIGMA = 2*PSIGS(JI,JJ,JK)
+ END IF
+ ELSE
+ ! parameterize Sigma_s with first_order closure
+ DZZ = PZZ(JI,JJ,JKP) - PZZ(JI,JJ,JKM)
+ ZDRW = ZRT(JI,JJ,JKP) - ZRT(JI,JJ,JKM)
+ ZDTL = ZTLK(JI,JJ,JKP) - ZTLK(JI,JJ,JKM) + XG/ZCPD(JI,JJ,JK) * DZZ
+ ZLL = ZL(JI,JJ,JK)
+ ! standard deviation due to convection
+ ZSIG_CONV =0.
+ IF( SIZE(PMFCONV) /= 0) &
+ ZSIG_CONV = ZCSIG_CONV * PMFCONV(JI,JJ,JK) / ZA
+ ! zsigma should be of order 4.e-4 in lowest 5 km of atmosphere
+ ZSIGMA = SQRT( MAX( 1.E-25, ZCSIGMA * ZCSIGMA * ZLL*ZLL/(DZZ*DZZ)*(&
+ ZA*ZA*ZDRW*ZDRW - 2.*ZA*ZB*ZDRW*ZDTL + ZB*ZB*ZDTL*ZDTL) + &
+ ZSIG_CONV * ZSIG_CONV ) )
+ END IF
+ ZSIGMA= MAX( 1.E-10, ZSIGMA )
+! ZSIGMA= MAX( 1.E-12, ZSIGMA )
+
+ ! normalized saturation deficit
+ ZQ1 = ZSBAR/ZSIGMA
+
+ IF(HCONDENS == 'GAUS')THEN
+ ! Gaussian Probability Density Function around ZQ1
+ ! Computation of ZG and ZGAM(=erf(ZG))
+ ZGCOND = -ZQ1/SQRT(2.)
+
+ !Approximation of erf function for Gaussian distribution
+ ZGAUV = 1 - SIGN(1., ZGCOND) * SQRT(1-EXP(-4*ZGCOND**2/XPI))
+
+ !Computation Cloud Fraction
+ PCLDFR(JI,JJ,JK) = MAX( 0., MIN(1.,0.5*ZGAUV))
+
+ !Computation of condensate
+ ZCOND(JI,JJ,JK) = (EXP(-ZGCOND**2)-ZGCOND*SQRT(XPI)*ZGAUV)*ZSIGMA/SQRT(2.*XPI)
+ ZCOND(JI,JJ,JK) = MAX(ZCOND(JI,JJ,JK), 0.)
+
+ PSIGRC(JI,JJ,JK) = PCLDFR(JI,JJ,JK)
+
+ !Computation warm/cold Cloud Fraction and content in high water content part
+ IF(PRESENT(PHLC_HCF) .AND. PRESENT(PHLC_HRC))THEN
+ IF(1-ZFRAC(JI,JJ,JK) > 1.E-20)THEN
+ ZAUTC = (ZSBAR - XCRIAUTC/(PRHODREF(JI,JJ,JK)*(1-ZFRAC(JI,JJ,JK))))/ZSIGMA
+ ZGAUTC = -ZAUTC/SQRT(2.)
+ !Approximation of erf function for Gaussian distribution
+ ZGAUC = 1 - SIGN(1., ZGAUTC) * SQRT(1-EXP(-4*ZGAUTC**2/XPI))
+ PHLC_HCF(JI,JJ,JK) = MAX( 0., MIN(1.,0.5*ZGAUC))
+ PHLC_HRC(JI,JJ,JK) = (1-ZFRAC(JI,JJ,JK))*(EXP(-ZGAUTC**2)-ZGAUTC*SQRT(XPI)*ZGAUC)*ZSIGMA/SQRT(2.*XPI)
+ PHLC_HRC(JI,JJ,JK) = PHLC_HRC(JI,JJ,JK) + XCRIAUTC/PRHODREF(JI,JJ,JK) * PHLC_HCF(JI,JJ,JK)
+ PHLC_HRC(JI,JJ,JK) = MAX(PHLC_HRC(JI,JJ,JK), 0.)
+ ELSE
+ PHLC_HCF(JI,JJ,JK)=0.
+ PHLC_HRC(JI,JJ,JK)=0.
+ ENDIF
+ ENDIF
+
+ IF(PRESENT(PHLI_HCF) .AND. PRESENT(PHLI_HRI))THEN
+ IF(ZFRAC(JI,JJ,JK) > 1.E-20)THEN
+ ZCRIAUTI(JI,JJ,JK)=MIN(XCRIAUTI,10**(XACRIAUTI*(PT(JI,JJ,JK)-XTT)+XBCRIAUTI))
+ ZAUTI = (ZSBAR - ZCRIAUTI(JI,JJ,JK)/ZFRAC(JI,JJ,JK))/ZSIGMA
+ ZGAUTI = -ZAUTI/SQRT(2.)
+ !Approximation of erf function for Gaussian distribution
+ ZGAUI = 1 - SIGN(1., ZGAUTI) * SQRT(1-EXP(-4*ZGAUTI**2/XPI))
+ PHLI_HCF(JI,JJ,JK) = MAX( 0., MIN(1.,0.5*ZGAUI))
+ PHLI_HRI(JI,JJ,JK) = ZFRAC(JI,JJ,JK)*(EXP(-ZGAUTI**2)-ZGAUTI*SQRT(XPI)*ZGAUI)*ZSIGMA/SQRT(2.*XPI)
+ PHLI_HRI(JI,JJ,JK) = PHLI_HRI(JI,JJ,JK) + ZCRIAUTI(JI,JJ,JK)*PHLI_HCF(JI,JJ,JK)
+ PHLI_HRI(JI,JJ,JK) = MAX(PHLI_HRI(JI,JJ,JK), 0.)
+ ELSE
+ PHLI_HCF(JI,JJ,JK)=0.
+ PHLI_HRI(JI,JJ,JK)=0.
+ ENDIF
+ ENDIF
+
+ ELSEIF(HCONDENS == 'CB02')THEN
+ !Cloud fraction
+ PCLDFR(JI,JJ,JK) = MAX( 0., MIN(1.,0.5+0.36*ATAN(1.55*ZQ1)) )
+
+ !Total condensate
+ IF (ZQ1 > 0. .AND. ZQ1 <= 2) THEN
+ ZCOND(JI,JJ,JK) = MIN(EXP(-1.)+.66*ZQ1+.086*ZQ1**2, 2.) ! We use the MIN function for continuity
+ ELSE IF (ZQ1 > 2.) THEN
+ ZCOND(JI,JJ,JK) = ZQ1
+ ELSE
+ ZCOND(JI,JJ,JK) = EXP( 1.2*ZQ1-1. )
+ ENDIF
+ ZCOND(JI,JJ,JK) = ZCOND(JI,JJ,JK) * ZSIGMA
+
+ INQ1 = MIN( MAX(-22,FLOOR(MIN(100., MAX(-100., 2*ZQ1))) ), 10) !inner min/max prevents sigfpe when 2*zq1 does not fit into an int
+ ZINC = 2.*ZQ1 - INQ1
+
+ PSIGRC(JI,JJ,JK) = MIN(1.,(1.-ZINC)*ZSRC_1D(INQ1)+ZINC*ZSRC_1D(INQ1+1))
+
+ IF(PRESENT(PHLC_HCF) .AND. PRESENT(PHLC_HRC))THEN
+ PHLC_HCF(JI,JJ,JK)=0.
+ PHLC_HRC(JI,JJ,JK)=0.
+ ENDIF
+ IF(PRESENT(PHLI_HCF) .AND. PRESENT(PHLI_HRI))THEN
+ PHLI_HCF(JI,JJ,JK)=0.
+ PHLI_HRI(JI,JJ,JK)=0.
+ ENDIF
+ ENDIF
+
+ IF ( ZCOND(JI,JJ,JK) < 1.E-12 ) THEN
+ ZCOND(JI,JJ,JK) = 0.
+ PCLDFR(JI,JJ,JK) = 0.
+ ENDIF
+ IF (PCLDFR(JI,JJ,JK)==0.) THEN
+ ZCOND(JI,JJ,JK)=0.
+ ENDIF
+
+ ZRCOLD=PRC(JI,JJ,JK)
+ ZRIOLD=PRI(JI,JJ,JK)
+
+ PRC(JI,JJ,JK) = (1.-ZFRAC(JI,JJ,JK)) * ZCOND(JI,JJ,JK) ! liquid condensate
+ PRI(JI,JJ,JK) = ZFRAC(JI,JJ,JK) * ZCOND(JI,JJ,JK) ! solid condensate
+
+ PT(JI,JJ,JK) = PT(JI,JJ,JK) + ((PRC(JI,JJ,JK)-ZRCOLD)*ZLV(JI,JJ,JK) + &
+ &(PRI(JI,JJ,JK)-ZRIOLD)*ZLS(JI,JJ,JK) ) &
+ & /ZCPD(JI,JJ,JK)
+ PRV(JI,JJ,JK) = ZRT(JI,JJ,JK) - PRC(JI,JJ,JK) - PRI(JI,JJ,JK)
+
+! s r_c/ sig_s^2
+! PSIGRC(JI,JJ,JK) = PCLDFR(JI,JJ,JK) ! use simple Gaussian relation
+!
+! multiply PSRCS by the lambda3 coefficient
+!
+! PSIGRC(JI,JJ,JK) = 2.*PCLDFR(JI,JJ,JK) * MIN( 3. , MAX(1.,1.-ZQ1) )
+! in the 3D case lambda_3 = 1.
+
+ IF(HLAMBDA3=='CB')THEN
+ PSIGRC(JI,JJ,JK) = PSIGRC(JI,JJ,JK)* MIN( 3. , MAX(1.,1.-ZQ1) )
+ ELSEIF(HLAMBDA3=='NONE') THEN
+ ELSE
+ call Print_msg( NVERB_FATAL, 'GEN', 'CONDENSATION', 'invalid value for HLAMBDA3: ' // TRIM( HLAMBDA3 ) )
+ ENDIF
+
+ END DO
+ END DO
+END DO
+!
+END SUBROUTINE CONDENSATION
diff --git a/src/mesonh/micro/gamma.f90 b/src/mesonh/micro/gamma.f90
new file mode 100644
index 000000000..cd7e04fbd
--- /dev/null
+++ b/src/mesonh/micro/gamma.f90
@@ -0,0 +1,224 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!########################
+ MODULE MODI_GAMMA
+!########################
+!
+INTERFACE GAMMA
+!
+FUNCTION GAMMA_X0D(PX) RESULT(PGAMMA)
+REAL, INTENT(IN) :: PX
+REAL :: PGAMMA
+END FUNCTION GAMMA_X0D
+!
+FUNCTION GAMMA_X1D(PX) RESULT(PGAMMA)
+REAL, DIMENSION(:), INTENT(IN) :: PX
+REAL, DIMENSION(SIZE(PX)) :: PGAMMA
+END FUNCTION GAMMA_X1D
+!
+END INTERFACE
+END MODULE MODI_GAMMA
+!
+!--------------------------------------------------------------------------
+!
+!
+!* 1. FUNCTION GAMMA FOR SCALAR VARIABLE
+!
+!
+! ######################################
+ FUNCTION GAMMA_X0D(PX) RESULT(PGAMMA)
+! ######################################
+!
+!
+!!**** *GAMMA * - Gamma function
+!!
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the Generalized gamma
+! function of its argument.
+!
+!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!! Press, Teukolsky, Vetterling and Flannery: Numerical Recipes, 206-207
+!!
+!! AUTHOR
+!! ------
+!! Jean-Pierre Pinty *LA/OMP*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 7/11/95
+!! C. Barthe 9/11/09 add a function for 1D arguments
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments and result
+!
+REAL, INTENT(IN) :: PX
+REAL :: PGAMMA
+!
+!* 0.2 declarations of local variables
+!
+INTEGER :: JJ ! Loop index
+REAL :: ZSER,ZSTP,ZTMP,ZX,ZY,ZCOEF(6)
+REAL :: ZPI
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. SOME CONSTANTS
+! --------------
+!
+ZCOEF(1) = 76.18009172947146
+ZCOEF(2) =-86.50532032941677
+ZCOEF(3) = 24.01409824083091
+ZCOEF(4) = -1.231739572450155
+ZCOEF(5) = 0.1208650973866179E-2
+ZCOEF(6) = -0.5395239384953E-5
+ZSTP = 2.5066282746310005
+!
+ZPI = 3.141592654
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. COMPUTE GAMMA
+! -------------
+!
+IF (PX .LT. 0.) THEN
+ ZX = 1. - PX
+ELSE
+ ZX = PX
+END IF
+ZY = ZX
+ZTMP = ZX + 5.5
+ZTMP = (ZX + 0.5) * ALOG(ZTMP) - ZTMP
+ZSER = 1.000000000190015
+!
+DO JJ = 1, 6
+ ZY = ZY + 1.0
+ ZSER = ZSER + ZCOEF(JJ) / ZY
+END DO
+!
+IF (PX .LT. 0.) THEN
+ PGAMMA = ZPI / SIN(ZPI*PX) / EXP(ZTMP + ALOG(ZSTP*ZSER/ZX))
+ELSE
+ PGAMMA = EXP(ZTMP + ALOG(ZSTP*ZSER/ZX))
+END IF
+RETURN
+!
+END FUNCTION GAMMA_X0D
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 1. FUNCTION GAMMA FOR 1D ARRAY
+!
+!
+! ######################################
+ FUNCTION GAMMA_X1D(PX) RESULT(PGAMMA)
+! ######################################
+!
+!
+!!**** *GAMMA * - Gamma function
+!!
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the Generalized gamma
+! function of its argument.
+!
+!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!! Press, Teukolsky, Vetterling and Flannery: Numerical Recipes, 206-207
+!!
+!! AUTHOR
+!! ------
+!! Jean-Pierre Pinty *LA/OMP*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 7/11/95
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments and result
+!
+REAL, DIMENSION(:), INTENT(IN) :: PX
+REAL, DIMENSION(SIZE(PX)) :: PGAMMA
+!
+!* 0.2 declarations of local variables
+!
+INTEGER :: JJ ! Loop index
+REAL, DIMENSION(SIZE(PX)) :: ZSER,ZSTP,ZTMP,ZX,ZY
+REAL :: ZCOEF(6)
+REAL :: ZPI
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. SOME CONSTANTS
+! --------------
+!
+ZCOEF(1) = 76.18009172947146
+ZCOEF(2) =-86.50532032941677
+ZCOEF(3) = 24.01409824083091
+ZCOEF(4) = -1.231739572450155
+ZCOEF(5) = 0.1208650973866179E-2
+ZCOEF(6) = -0.5395239384953E-5
+ZSTP = 2.5066282746310005
+!
+ZPI = 3.141592654
+ZX(:) = PX(:)
+WHERE ( PX(:)<0.0 )
+ ZX(:) = 1.- PX(:)
+END WHERE
+ZY(:) = ZX(:)
+ZTMP(:) = ZX(:) + 5.5
+ZTMP(:) = (ZX(:) + 0.5)*ALOG(ZTMP(:)) - ZTMP(:)
+ZSER(:) = 1.000000000190015
+!
+DO JJ = 1 , 6
+ ZY(:) = ZY(:) + 1.0
+ ZSER(:) = ZSER(:) + ZCOEF(JJ)/ZY(:)
+END DO
+!
+PGAMMA(:) = EXP( ZTMP(:) + ALOG( ZSTP*ZSER(:)/ZX(:) ) )
+WHERE ( PX(:)<0.0 )
+ PGAMMA(:) = ZPI/SIN(ZPI*PX(:))/PGAMMA(:)
+END WHERE
+RETURN
+!
+END FUNCTION GAMMA_X1D
diff --git a/src/mesonh/micro/gamma_inc.f90 b/src/mesonh/micro/gamma_inc.f90
new file mode 100644
index 000000000..93e6247d0
--- /dev/null
+++ b/src/mesonh/micro/gamma_inc.f90
@@ -0,0 +1,148 @@
+!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!####################
+MODULE MODI_GAMMA_INC
+!####################
+!
+INTERFACE
+!
+FUNCTION GAMMA_INC(PA,PX) RESULT(PGAMMA_INC)
+REAL, INTENT(IN) :: PA
+REAL, INTENT(IN) :: PX
+REAL :: PGAMMA_INC
+END FUNCTION GAMMA_INC
+!
+END INTERFACE
+!
+END MODULE MODI_GAMMA_INC
+! #############################################
+ FUNCTION GAMMA_INC(PA,PX) RESULT(PGAMMA_INC)
+! #############################################
+!
+!
+!!**** *GAMMA_INC * - Generalized gamma function
+!!
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the generalized
+!! incomplete Gamma function of its argument.
+!!
+!! /X
+!! 1 |
+!! GAMMA_INC(A,X)= -------- | Z**(A-1) EXP(-Z) dZ
+!! GAMMA(A) |
+!! /0
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! MODULE MODI_GAMMA : computation of the Gamma function
+!!
+!! REFERENCE
+!! ---------
+!! Press, Teukolsky, Vetterling and Flannery: Numerical Recipes, 209-213
+!!
+!!
+!! AUTHOR
+!! ------
+!! Jean-Pierre Pinty *LA/OMP*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 7/12/95
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+!
+!* 0. DECLARATIONS
+! ------------
+!
+use mode_msg
+!
+USE MODI_GAMMA
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments and result
+!
+REAL, INTENT(IN) :: PA
+REAL, INTENT(IN) :: PX
+REAL :: PGAMMA_INC
+!
+!* 0.2 declarations of local variables
+!
+INTEGER :: JN
+INTEGER :: ITMAX=100
+REAL :: ZEPS=3.E-7
+REAL :: ZFPMIN=1.E-30
+REAL :: ZAP,ZDEL,ZSUM
+REAL :: ZAN,ZB,ZC,ZD,ZH
+!
+IF( PX<0.0 .OR. PA<=0.0 ) call Print_msg(NVERB_FATAL,'GEN','GAMMA_INC','invalid arguments: PX<0.0 .OR. PA<=0.0')
+!
+IF( (PX.LT.PA+1.0) ) THEN
+ ZAP = PA
+ ZSUM = 1.0/PA
+ ZDEL = ZSUM
+ JN = 1
+!
+ LOOP_SERIES: DO
+ ZAP = ZAP +1.0
+ ZDEL = ZDEL*PX/ZAP
+ ZSUM = ZSUM + ZDEL
+ IF( ABS(ZDEL).LT.ABS(ZSUM)*ZEPS ) EXIT LOOP_SERIES
+ JN = JN + 1
+ IF( JN.GT.ITMAX ) THEN
+ call Print_msg(NVERB_FATAL,'GEN','GAMMA_INC','PA argument is too large or ITMAX is too small,'// &
+ ' the incomplete GAMMA_INC function cannot be evaluated correctly'// &
+ ' by the series method')
+ END IF
+ END DO LOOP_SERIES
+ PGAMMA_INC = ZSUM * EXP( -PX+PA*ALOG(PX)-ALOG(GAMMA(PA)) )
+!
+ ELSE
+!
+ ZB = PX + 1.0 - PA
+ ZC = 1.0/TINY(PX)
+ ZD = 1.0/ZB
+ ZH = ZD
+ JN = 1
+!
+ LOOP_FRACTION: DO
+ ZAN = -REAL(JN)*(REAL(JN)-PA)
+ ZB = ZB + 2.0
+ ZD = ZAN*ZD + ZB
+ IF( ABS(ZD).LT.TINY(PX) ) THEN
+ ZD = ZFPMIN
+ END IF
+ ZC = ZB + ZAN/ZC
+ IF( ABS(ZC).LT.TINY(PX) ) THEN
+ ZC = ZFPMIN
+ END IF
+ ZD = 1.0/ZD
+ ZDEL = ZD*ZC
+ ZH = ZH*ZDEL
+ IF( ABS(ZDEL-1.0).LT.ZEPS ) EXIT LOOP_FRACTION
+ JN = JN + 1
+ IF( JN.GT.ITMAX ) THEN
+ call Print_msg(NVERB_FATAL,'GEN','GAMMA_INC','PA argument is too large or ITMAX is too small,'// &
+ ' the incomplete GAMMA_INC function cannot be evaluated correctly'// &
+ ' by the continuous fraction method')
+ END IF
+ END DO LOOP_FRACTION
+ PGAMMA_INC = 1.0 - ZH*EXP( -PX+PA*ALOG(PX)-ALOG(GAMMA(PA)) )
+!
+END IF
+!
+RETURN
+!
+END FUNCTION GAMMA_INC
diff --git a/src/mesonh/micro/general_gamma.f90 b/src/mesonh/micro/general_gamma.f90
new file mode 100644
index 000000000..9aa715a3c
--- /dev/null
+++ b/src/mesonh/micro/general_gamma.f90
@@ -0,0 +1,91 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 operators 2006/05/18 13:07:25
+!-----------------------------------------------------------------
+!########################
+MODULE MODI_GENERAL_GAMMA
+!########################
+!
+INTERFACE
+!
+FUNCTION GENERAL_GAMMA(PALPHA,PNU,PLBDA,PX) RESULT(PGENERAL_GAMMA)
+REAL, INTENT(IN) :: PALPHA
+REAL, INTENT(IN) :: PNU
+REAL, INTENT(IN) :: PLBDA
+REAL, INTENT(IN) :: PX
+REAL :: PGENERAL_GAMMA
+END FUNCTION GENERAL_GAMMA
+!
+END INTERFACE
+!
+END MODULE MODI_GENERAL_GAMMA
+! ###################################################################
+ FUNCTION GENERAL_GAMMA(PALPHA,PNU,PLBDA,PX) RESULT(PGENERAL_GAMMA)
+! ###################################################################
+!
+!
+!!**** *GENERAL_GAMMA * - Generalized gamma function
+!!
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the Generalized gamma
+! function of its argument.
+!
+!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! MODULE MODI_GAMMA : computation of the Gamma function
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation (routine CONDENS)
+!!
+!!
+!! AUTHOR
+!! ------
+!! Jean-Pierre Pinty *LA/OMP*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 7/11/95
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODI_GAMMA
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments and result
+!
+REAL, INTENT(IN) :: PALPHA
+REAL, INTENT(IN) :: PNU
+REAL, INTENT(IN) :: PLBDA
+REAL, INTENT(IN) :: PX
+REAL :: PGENERAL_GAMMA
+!
+!* 0.2 declarations of local variables
+!
+REAL :: ZARG,ZPOWER
+!
+ZARG = PLBDA*PX
+ZPOWER = PALPHA*PNU - 1.0
+!
+PGENERAL_GAMMA = (PALPHA/GAMMA(PNU))*(ZARG**ZPOWER)*PLBDA*EXP(-(ZARG**PALPHA))
+RETURN
+!
+END FUNCTION GENERAL_GAMMA
diff --git a/src/mesonh/micro/hypgeo.f90 b/src/mesonh/micro/hypgeo.f90
new file mode 100644
index 000000000..0d3697f71
--- /dev/null
+++ b/src/mesonh/micro/hypgeo.f90
@@ -0,0 +1,119 @@
+!MNH_LIC Copyright 1996-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!####################
+MODULE MODI_HYPGEO
+!####################
+!
+INTERFACE
+!
+FUNCTION HYPGEO(PA,PB,PC,PF,PX) RESULT(PHYPGEO)
+REAL, INTENT(IN) :: PA,PB,PC,PF
+REAL, INTENT(IN) :: PX
+REAL :: PHYPGEO
+END FUNCTION HYPGEO
+!
+END INTERFACE
+!
+END MODULE MODI_HYPGEO
+! #############################################
+ FUNCTION HYPGEO(PA,PB,PC,PF,PX) RESULT(PHYPGEO)
+! #############################################
+!
+!
+!!**** *HYPGEO* - hypergeometric function
+!!
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the hypergeometric
+!! function of its argument.
+!!
+!!
+!! A*B (A+1)A*(B+1)B X^2
+!! HYPGEO(A,B,C,X)= 1 + ----- * X + ------------- * --- + ... +
+!! C (C+1)C 2
+!!
+!! (A+n)...A*(B+n)...B X^n
+!! --------------------- * ----- + ... ...
+!! (C+n)...C n!
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!! HYPSER
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!! Press, Teukolsky, Vetterling and Flannery: Numerical Recipes, 272
+!!
+!!
+!! AUTHOR
+!! ------
+!! Jean-Martial Cohard *LA/OMP*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 31/12/96
+!
+!------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+!
+USE MODI_GAMMA
+USE MODI_HYPSER
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments and result
+!
+REAL, INTENT(IN) :: PA,PB,PC,PF
+REAL, INTENT(IN) :: PX
+REAL :: PHYPGEO
+!
+!* 0.2 declarations of local variables
+!
+!
+INTEGER :: JN
+INTEGER :: ITMAX=100
+REAL :: ZEPS,ZTEMP
+REAL :: ZFPMIN=1.E-30
+REAL :: ZXH
+REAL :: ZX0,ZX1,ZZA,ZZB,ZZC,ZZD,Y(2)
+!
+!------------------------------------------------------------------------------
+!
+!
+ZEPS = 4.E-2
+ZXH = PF * PX**2.0
+IF (ZXH.LT.(1-ZEPS)) THEN
+ CALL HYPSER(PA,PB,PC,-ZXH,PHYPGEO)
+ELSE IF (ZXH.GT.(1.+ZEPS)) THEN
+ ZXH = 1./ZXH
+ CALL HYPSER(PA,PA-PC+1.,PA-PB+1.,-ZXH,PHYPGEO)
+ PHYPGEO = PHYPGEO*ZXH**(PA)* &
+ (GAMMA(PC)*GAMMA(PB-PA)/(GAMMA(PB)*GAMMA(PC-PA)))
+ CALL HYPSER(PB,PB-PC+1.,PB-PA+1.,-ZXH,ZTEMP)
+ PHYPGEO = PHYPGEO+ZTEMP*ZXH**(PB)* &
+ (GAMMA(PC)*GAMMA(PA-PB)/(GAMMA(PA)*GAMMA(PC-PB)))
+ELSE
+ ZX0 = (1.-ZEPS)
+ ZX1 = 1./(1.+ZEPS)
+ CALL HYPSER(PA,PA-PC+1.,PA-PB+1.,-ZX1,PHYPGEO)
+ PHYPGEO = PHYPGEO*ZX1**(PA)* &
+ (GAMMA(PC)*GAMMA(PB-PA)/(GAMMA(PB)*GAMMA(PC-PA)))
+ CALL HYPSER(PB,PB-PC+1.,PB-PA+1.,-ZX1,ZTEMP)
+ PHYPGEO = PHYPGEO+ZTEMP*ZX1**(PB)* &
+ (GAMMA(PC)*GAMMA(PA-PB)/(GAMMA(PA)*GAMMA(PC-PB)))
+ CALL HYPSER(PA,PB,PC,-ZX0,ZTEMP)
+ PHYPGEO = ZTEMP + (ZXH-ZX0)*(PHYPGEO-ZTEMP)/(2.*ZEPS)
+ENDIF
+END
diff --git a/src/mesonh/micro/hypser.f90 b/src/mesonh/micro/hypser.f90
new file mode 100644
index 000000000..3a8bed13e
--- /dev/null
+++ b/src/mesonh/micro/hypser.f90
@@ -0,0 +1,116 @@
+!MNH_LIC Copyright 1996-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!####################
+MODULE MODI_HYPSER
+!####################
+!
+INTERFACE
+!
+SUBROUTINE HYPSER(PA,PB,PC,PX,PHYP)
+REAL, INTENT(IN) :: PA,PB,PC
+REAL, INTENT(IN) :: PX
+REAL, INTENT(INOUT) :: PHYP
+END SUBROUTINE HYPSER
+!
+END INTERFACE
+!
+END MODULE MODI_HYPSER
+! #############################################
+ SUBROUTINE HYPSER(PA,PB,PC,PX,PHYP)
+! #############################################
+!
+!
+!!**** *HYPSER* - hypergeometric function
+!!
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the hypergeometric
+!! function of its argument.
+!!
+!!
+!! A*B (A+1)A*(B+1)B X^2
+!! HYPSER(A,B,C,X)= 1 + ----- * X + ------------- * --- + ... +
+!! C (C+1)C 2
+!!
+!! (A+n)...A*(B+n)...B X^n
+!! --------------------- * ----- + ... ...
+!! (C+n)...C n!
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!! HYPSER
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!! Press, Teukolsky, Vetterling and Flannery: Numerical Recipes, 272
+!!
+!!
+!! AUTHOR
+!! ------
+!! Jean-Martial Cohard *LA/OMP*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 31/12/96
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+!
+!------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+!
+use mode_msg
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments and result
+!
+REAL, INTENT(IN) :: PA,PB,PC
+REAL, INTENT(IN) :: PX
+REAL, INTENT(INOUT) :: PHYP
+!
+!
+!
+!* 0.2 declarations of local variables
+!
+INTEGER :: JN,JFLAG
+REAL :: ZXH,ZZA,ZZB,ZZC,ZFAC,ZTEMP
+REAL :: ZPREC
+!
+!------------------------------------------------------------------------------
+!
+ZPREC = 1.0E-04
+ZXH = PX
+ZFAC = 1.0
+ZTEMP = ZFAC
+ZZA = PA
+ZZB = PB
+ZZC = PC
+JFLAG = 0
+SERIE: DO JN = 1,5000
+ ZFAC = ZFAC * ZZA * ZZB / ZZC
+ ZFAC = ZFAC * ZXH / REAL(JN)
+ PHYP = ZTEMP + ZFAC
+ IF (ABS(PHYP-ZTEMP).LE.ZPREC) THEN
+ JFLAG = 1
+ EXIT SERIE
+ END IF
+ ZTEMP = PHYP
+ ZZA = ZZA + 1.
+ ZZB = ZZB + 1.
+ ZZC = ZZC + 1.
+END DO SERIE
+IF (JFLAG == 0) call Print_msg(NVERB_FATAL,'GEN','HYPSER','convergence failure')
+!
+END SUBROUTINE HYPSER
diff --git a/src/mesonh/micro/ice4_compute_pdf.f90 b/src/mesonh/micro/ice4_compute_pdf.f90
new file mode 100644
index 000000000..bc465eb65
--- /dev/null
+++ b/src/mesonh/micro/ice4_compute_pdf.f90
@@ -0,0 +1,324 @@
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+MODULE MODI_ICE4_COMPUTE_PDF
+INTERFACE
+SUBROUTINE ICE4_COMPUTE_PDF(KSIZE, HSUBG_AUCV_RC, HSUBG_AUCV_RI, HSUBG_PR_PDF, &
+ PRHODREF, PRCT, PRIT, PCF, PT, PSIGMA_RC,&
+ PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, &
+ PHLI_HCF, PHLI_LCF, PHLI_HRI, PHLI_LRI, PRF)
+IMPLICIT NONE
+INTEGER, INTENT(IN) :: KSIZE
+CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV_RC ! Kind of Subgrid autoconversion method
+CHARACTER(LEN=80), INTENT(IN) :: HSUBG_AUCV_RI ! Kind of Subgrid autoconversion method
+CHARACTER(LEN=80), INTENT(IN) :: HSUBG_PR_PDF ! pdf for subgrid precipitation
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Ice Crystal m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCF ! Cloud fraction
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PSIGMA_RC ! Standard deviation of rc at time t
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_HCF ! HLCLOUDS : fraction of High Cloud Fraction in grid
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_LCF ! HLCLOUDS : fraction of Low Cloud Fraction in grid
+ ! note that PCF = PHLC_HCF + PHLC_LCF
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_HRC ! HLCLOUDS : LWC that is High LWC in grid
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_LRC ! HLCLOUDS : LWC that is Low LWC in grid
+ ! note that PRC = PHLC_HRC + PHLC_LRC
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PHLI_HCF !
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PHLI_LCF
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PHLI_HRI !
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PHLI_LRI !
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRF ! Rain fraction
+END SUBROUTINE ICE4_COMPUTE_PDF
+END INTERFACE
+END MODULE MODI_ICE4_COMPUTE_PDF
+SUBROUTINE ICE4_COMPUTE_PDF(KSIZE, HSUBG_AUCV_RC, HSUBG_AUCV_RI, HSUBG_PR_PDF, &
+ PRHODREF, PRCT, PRIT, PCF, PT, PSIGMA_RC,&
+ PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, &
+ PHLI_HCF, PHLI_LCF, PHLI_HRI, PHLI_LRI, PRF)
+!!
+!!** PURPOSE
+!! -------
+!! Computes the pdf used to split cloud into high and low content parts
+!!
+!! AUTHOR
+!! ------
+!! S. Riette from the plitting of rain_ice source code (nov. 2014)
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!
+USE MODD_RAIN_ICE_DESCR, ONLY: XRTMIN
+USE MODD_RAIN_ICE_PARAM, ONLY: XCRIAUTC,XBCRIAUTI,XACRIAUTI,XCRIAUTI
+USE MODD_CST, ONLY : XTT
+!
+USE MODE_MSG
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KSIZE
+CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV_RC ! Kind of Subgrid autoconversion method for cloud water
+CHARACTER(LEN=80), INTENT(IN) :: HSUBG_AUCV_RI ! Kind of Subgrid autoconversion method for cloud water
+CHARACTER(LEN=80), INTENT(IN) :: HSUBG_PR_PDF ! pdf for subgrid precipitation
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Ice Crystal m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCF ! Cloud fraction
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PSIGMA_RC ! Standard deviation of rc at time t
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_HCF ! HLCLOUDS : fraction of High Cloud Fraction in grid
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_LCF ! HLCLOUDS : fraction of Low Cloud Fraction in grid
+ ! note that PCF = PHLC_HCF + PHLC_LCF
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_HRC ! HLCLOUDS : LWC that is High LWC in grid
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_LRC ! HLCLOUDS : LWC that is Low LWC in grid
+ ! note that PRC = PHLC_HRC + PHLC_LRC
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PHLI_HCF
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PHLI_LCF
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PHLI_HRI
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PHLI_LRI
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRF ! Rain fraction
+!
+!* 0.2 declaration of local variables
+!
+REAL, DIMENSION(KSIZE) :: ZRCRAUTC, & !RC value to begin rain formation =XCRIAUTC/RHODREF
+ ZCRIAUTI, & !RI value to begin snow formation
+ ZHLC_RCMAX, & !HLCLOUDS : maximum value for RC in distribution
+ ZHLC_LRCLOCAL, & !HLCLOUDS : LWC that is Low LWC local in LCF
+ ZHLC_HRCLOCAL, & !HLCLOUDS : LWC that is High LWC local in HCF
+ ! note that ZRC/CF = ZHLC_HRCLOCAL+ ZHLC_LRCLOCAL
+ ! = PHLC_HRC/HCF+ PHLC_LRC/LCF
+ ZSUMRC, ZSUMRI
+REAL :: ZCOEFFRCM
+!-------------------------------------------------------------------------------
+!
+!Cloud water split between high and low content part is done according to autoconversion option
+ZRCRAUTC(:)=XCRIAUTC/PRHODREF(:) ! Autoconversion rc threshold
+IF(HSUBG_AUCV_RC=='NONE') THEN
+ !Cloud water is entirely in low or high part
+ WHERE(PRCT(:)>ZRCRAUTC(:))
+ PHLC_HCF(:)=1.
+ PHLC_LCF(:)=0.
+ PHLC_HRC(:)=PRCT(:)
+ PHLC_LRC(:)=0.
+ ELSEWHERE(PRCT(:)>XRTMIN(2))
+ PHLC_HCF(:)=0.
+ PHLC_LCF(:)=1.
+ PHLC_HRC(:)=0.
+ PHLC_LRC(:)=PRCT(:)
+ ELSEWHERE
+ PHLC_HCF(:)=0.
+ PHLC_LCF(:)=0.
+ PHLC_HRC(:)=0.
+ PHLC_LRC(:)=0.
+ END WHERE
+
+ELSEIF(HSUBG_AUCV_RC=='CLFR') THEN
+ !Cloud water is only in the cloudy part and entirely in low or high part
+ WHERE(PCF(:)>0. .AND. PRCT(:)>ZRCRAUTC(:)*PCF(:))
+ PHLC_HCF(:)=PCF(:)
+ PHLC_LCF(:)=0.
+ PHLC_HRC(:)=PRCT(:)
+ PHLC_LRC(:)=0.
+ ELSEWHERE(PCF(:)>0. .AND. PRCT(:)>XRTMIN(2))
+ PHLC_HCF(:)=0.
+ PHLC_LCF(:)=PCF(:)
+ PHLC_HRC(:)=0.0
+ PHLC_LRC(:)=PRCT(:)
+ ELSEWHERE
+ PHLC_HCF(:)=0.
+ PHLC_LCF(:)=0.
+ PHLC_HRC(:)=0.
+ PHLC_LRC(:)=0.
+ END WHERE
+ELSEIF(HSUBG_AUCV_RC=='ADJU') THEN
+ ZSUMRC(:)=PHLC_LRC(:)+PHLC_HRC(:)
+ WHERE(ZSUMRC .GT. 0.)
+ PHLC_LRC(:)=PHLC_LRC(:)*PRCT(:)/ZSUMRC(:)
+ PHLC_HRC(:)=PHLC_HRC(:)*PRCT(:)/ZSUMRC(:)
+ ELSEWHERE
+ PHLC_LRC(:)=0.
+ PHLC_HRC(:)=0.
+ ENDWHERE
+ELSEIF(HSUBG_AUCV_RC=='PDF ') THEN
+ !Cloud water is split between high and low part according to a PDF
+ ! 'HLCRECTPDF' : rectangular PDF form
+ ! 'HLCTRIANGPDF' : triangular PDF form
+ ! 'HLCQUADRAPDF' : second order quadratic PDF form
+ ! 'HLCISOTRIPDF' : isocele triangular PDF
+ ! 'SIGM' : Redelsperger and Sommeria (1986)
+ IF(HSUBG_PR_PDF=='SIGM') THEN
+ ! Redelsperger and Sommeria (1986) but organised according to Turner (2011, 2012)
+ WHERE (PRCT(:)>ZRCRAUTC(:)+PSIGMA_RC(:))
+ PHLC_HCF(:)=1.
+ PHLC_LCF(:)=0.
+ PHLC_HRC(:)=PRCT(:)
+ PHLC_LRC(:)=0.
+ ELSEWHERE(PRCT(:)> (ZRCRAUTC(:)-PSIGMA_RC(:)) .AND. &
+ & PRCT(:)<=(ZRCRAUTC(:)+PSIGMA_RC(:)) )
+ PHLC_HCF(:)=(PRCT(:)+PSIGMA_RC(:)-ZRCRAUTC(:))/ &
+ &(2.*PSIGMA_RC(:))
+ PHLC_LCF(:)=MAX(0., PCF(:)-PHLC_HCF(:))
+ PHLC_HRC(:)=(PRCT(:)+PSIGMA_RC(:)-ZRCRAUTC(:))* &
+ &(PRCT(:)+PSIGMA_RC(:)+ZRCRAUTC(:))/ &
+ &(4.*PSIGMA_RC(:))
+ PHLC_LRC(:)=MAX(0., PRCT(:)-PHLC_HRC(:))
+ ELSEWHERE(PRCT(:)>XRTMIN(2) .AND. PCF(:)>0.)
+ PHLC_HCF(:)=0.
+ PHLC_LCF(:)=PCF(:)
+ PHLC_HRC(:)=0.
+ PHLC_LRC(:)=PRCT(:)
+ ELSEWHERE
+ PHLC_HCF(:)=0.
+ PHLC_LCF(:)=0.
+ PHLC_HRC(:)=0.
+ PHLC_LRC(:)=0.
+ END WHERE
+ ! Turner (2011, 2012)
+ ELSEIF(HSUBG_PR_PDF=='HLCRECTPDF' .OR. HSUBG_PR_PDF=='HLCISOTRIPDF' .OR. &
+ &HSUBG_PR_PDF=='HLCTRIANGPDF' .OR. HSUBG_PR_PDF=='HLCQUADRAPDF') THEN
+ ! Calculate maximum value r_cM from PDF forms
+ IF(HSUBG_PR_PDF=='HLCRECTPDF' .OR. HSUBG_PR_PDF=='HLCISOTRIPDF') THEN
+ ZCOEFFRCM=2.
+ ELSE IF(HSUBG_PR_PDF=='HLCTRIANGPDF') THEN
+ ZCOEFFRCM=3.
+ ELSE IF(HSUBG_PR_PDF=='HLCQUADRAPDF') THEN
+ ZCOEFFRCM=4.
+ END IF
+ WHERE(PRCT(:).GT.0. .AND. PCF(:).GT.0.)
+ ZHLC_RCMAX(:)=ZCOEFFRCM*PRCT(:)/PCF(:)
+ END WHERE
+ ! Split available water and cloud fraction in two parts
+ ! Calculate local mean values int he low and high parts for the 3 PDF forms:
+ IF(HSUBG_PR_PDF=='HLCRECTPDF') THEN
+ WHERE(PRCT(:).GT.0. .AND. PCF(:).GT.0. .AND. ZHLC_RCMAX(:).GT.ZRCRAUTC(:))
+ ZHLC_LRCLOCAL(:)=0.5*ZRCRAUTC(:)
+ ZHLC_HRCLOCAL(:)=( ZHLC_RCMAX(:) + ZRCRAUTC(:))/2.0
+ END WHERE
+ ELSE IF(HSUBG_PR_PDF=='HLCTRIANGPDF') THEN
+ WHERE(PRCT(:).GT.0. .AND. PCF(:).GT.0. .AND. ZHLC_RCMAX(:).GT.ZRCRAUTC(:))
+ ZHLC_LRCLOCAL(:)=( ZRCRAUTC(:) *(3.0 * ZHLC_RCMAX(:) - 2.0 * ZRCRAUTC(:) ) ) &
+ / (3.0 * (2.0 * ZHLC_RCMAX(:) - ZRCRAUTC(:) ) )
+ ZHLC_HRCLOCAL(:)=(ZHLC_RCMAX(:) + 2.0*ZRCRAUTC(:)) / 3.0
+ END WHERE
+ ELSE IF(HSUBG_PR_PDF=='HLCQUADRAPDF') THEN
+ WHERE(PRCT(:).GT.0. .AND. PCF(:).GT.0. .AND. ZHLC_RCMAX(:).GT.ZRCRAUTC(:))
+ ZHLC_LRCLOCAL(:)=(3.0 *ZRCRAUTC(:)**3 - 8.0 *ZRCRAUTC(:)**2 * ZHLC_RCMAX(:) &
+ + 6.0*ZRCRAUTC(:) *ZHLC_RCMAX(:)**2 ) &
+ / &
+ (4.0* ZRCRAUTC(:)**2 -12.0*ZRCRAUTC(:) *ZHLC_RCMAX(:) &
+ + 12.0 * ZHLC_RCMAX(:)**2 )
+ ZHLC_HRCLOCAL(:)=(ZHLC_RCMAX(:) + 3.0*ZRCRAUTC(:))/4.0
+ END WHERE
+ ELSE IF(HSUBG_PR_PDF=='HLCISOTRIPDF') THEN
+ WHERE(PRCT(:).GT.0. .AND. PCF(:).GT.0. .AND. ZHLC_RCMAX(:).GT.ZRCRAUTC(:))
+ WHERE((PRCT(:) / PCF(:)).LE.ZRCRAUTC(:))
+ ZHLC_LRCLOCAL(:)=( (ZHLC_RCMAX(:))**3 &
+ -(12.0 * (ZHLC_RCMAX(:))*(ZRCRAUTC(:))**2) &
+ +(8.0 * ZRCRAUTC(:)**3) ) &
+ /( (6.0 * (ZHLC_RCMAX(:))**2) &
+ -(24.0 * (ZHLC_RCMAX(:)) * ZRCRAUTC(:)) &
+ +(12.0 * ZRCRAUTC(:)**2) )
+ ZHLC_HRCLOCAL(:)=( ZHLC_RCMAX(:) + 2.0 * ZRCRAUTC(:) )/3.0
+ ELSEWHERE
+ ZHLC_LRCLOCAL(:)=(2.0/3.0) * ZRCRAUTC(:)
+ ZHLC_HRCLOCAL(:)=(3.0*ZHLC_RCMAX(:)**3 - 8.0*ZRCRAUTC(:)**3) &
+ / (6.0 * ZHLC_RCMAX(:)**2 - 12.0*ZRCRAUTC(:)**2)
+ END WHERE
+ END WHERE
+ END IF
+ ! Compare r_cM to r_cR to know if cloud water content is high enough to split in two parts or not
+ WHERE (PRCT(:).GT.0. .AND. PCF(:).GT.0. .AND. ZHLC_RCMAX(:).GT.ZRCRAUTC(:))
+ ! Calculate final values for LCF and HCF:
+ PHLC_LCF(:)=PCF(:) &
+ *(ZHLC_HRCLOCAL- &
+ (PRCT(:) / PCF(:))) &
+ / (ZHLC_HRCLOCAL-ZHLC_LRCLOCAL)
+ PHLC_HCF(:)=MAX(0., PCF(:)-PHLC_LCF(:))
+ !
+ ! Calculate final values for LRC and HRC:
+ PHLC_LRC(:)=ZHLC_LRCLOCAL*PHLC_LCF(:)
+ PHLC_HRC(:)=MAX(0., PRCT(:)-PHLC_LRC(:))
+ ELSEWHERE (PRCT(:).GT.0. .AND. PCF(:).GT.0. .AND. ZHLC_RCMAX(:).LE.ZRCRAUTC(:))
+ ! Put all available cloud water and his fraction in the low part
+ PHLC_LCF(:)=PCF(:)
+ PHLC_HCF(:)=0.
+ PHLC_LRC(:)=PRCT(:)
+ PHLC_HRC(:)=0.
+ ELSEWHERE
+ PHLC_LCF(:)=0.
+ PHLC_HCF(:)=0.
+ PHLC_LRC(:)=0.
+ PHLC_HRC(:)=0.
+ END WHERE
+ ELSE
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','ICE4_COMPUTE_PDF','wrong HSUBG_PR_PDF case')
+ ENDIF
+ELSE
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','ICE4_COMPUTE_PDF','wrong HSUBG_AUCV case')
+ENDIF
+!
+!Ice water split between high and low content part is done according to autoconversion option
+ZCRIAUTI(:)=MIN(XCRIAUTI,10**(XACRIAUTI*(PT(:)-XTT)+XBCRIAUTI)) ! Autoconversion ri threshold
+IF(HSUBG_AUCV_RI=='NONE') THEN
+ !Cloud water is entirely in low or high part
+ WHERE(PRIT(:)>ZCRIAUTI(:))
+ PHLI_HCF(:)=1.
+ PHLI_LCF(:)=0.
+ PHLI_HRI(:)=PRIT(:)
+ PHLI_LRI(:)=0.
+ ELSEWHERE(PRIT(:)>XRTMIN(2))
+ PHLI_HCF(:)=0.
+ PHLI_LCF(:)=1.
+ PHLI_HRI(:)=0.
+ PHLI_LRI(:)=PRIT(:)
+ ELSEWHERE
+ PHLI_HCF(:)=0.
+ PHLI_LCF(:)=0.
+ PHLI_HRI(:)=0.
+ PHLI_LRI(:)=0.
+ END WHERE
+ELSEIF(HSUBG_AUCV_RI=='CLFR') THEN
+ !Cloud water is only in the cloudy part and entirely in low or high part
+ WHERE(PCF(:)>0. .AND. PRIT(:)>ZCRIAUTI(:)*PCF(:))
+ PHLI_HCF(:)=PCF(:)
+ PHLI_LCF(:)=0.
+ PHLI_HRI(:)=PRIT(:)
+ PHLI_LRI(:)=0.
+ ELSEWHERE(PCF(:)>0. .AND. PRIT(:)>XRTMIN(2))
+ PHLI_HCF(:)=0.
+ PHLI_LCF(:)=PCF(:)
+ PHLI_HRI(:)=0.0
+ PHLI_LRI(:)=PRIT(:)
+ ELSEWHERE
+ PHLI_HCF(:)=0.
+ PHLI_LCF(:)=0.
+ PHLI_HRI(:)=0.
+ PHLI_LRI(:)=0.
+ END WHERE
+ELSEIF(HSUBG_AUCV_RI=='ADJU') THEN
+ ZSUMRI(:)=PHLI_LRI(:)+PHLI_HRI(:)
+ WHERE(ZSUMRI .GT. 0.)
+ PHLI_LRI(:)=PHLI_LRI(:)*PRIT(:)/ZSUMRI(:)
+ PHLI_HRI(:)=PHLI_HRI(:)*PRIT(:)/ZSUMRI(:)
+ ELSEWHERE
+ PHLI_LRI(:)=0.
+ PHLI_HRI(:)=0.
+ ENDWHERE
+ELSE
+ !wrong HSUBG_AUCV_RI case
+ CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'ICE4_COMPUTE_PDF', 'wrong HSUBG_AUCV_RI case' )
+ENDIF
+!
+PRF=MAX(PHLC_HCF,PHLI_HCF)
+!
+END SUBROUTINE ICE4_COMPUTE_PDF
diff --git a/src/mesonh/micro/ice4_fast_rg.f90 b/src/mesonh/micro/ice4_fast_rg.f90
new file mode 100644
index 000000000..b84dda857
--- /dev/null
+++ b/src/mesonh/micro/ice4_fast_rg.f90
@@ -0,0 +1,582 @@
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+MODULE MODI_ICE4_FAST_RG
+INTERFACE
+SUBROUTINE ICE4_FAST_RG(KSIZE, LDSOFT, PCOMPUTE, KRR, &
+ &PRHODREF, PLVFACT, PLSFACT, PPRES, &
+ &PDV, PKA, PCJ, PCIT, &
+ &PLBDAR, PLBDAS, PLBDAG, &
+ &PT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ &PRGSI, PRGSI_MR, &
+ &PWETG, &
+ &PRICFRRG, PRRCFRIG, PRICFRR, PRCWETG, PRIWETG, PRRWETG, PRSWETG, &
+ &PRCDRYG, PRIDRYG, PRRDRYG, PRSDRYG, PRWETGH, PRWETGH_MR, PRGMLTR, &
+ &PRG_TEND, &
+ &PA_TH, PA_RC, PA_RR, PA_RI, PA_RS, PA_RG, PA_RH, PB_RG, PB_RH)
+IMPLICIT NONE
+INTEGER, INTENT(IN) :: KSIZE
+LOGICAL, INTENT(IN) :: LDSOFT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
+INTEGER, INTENT(IN) :: KRR ! Number of moist variable
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PPRES ! absolute pressure at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PDV ! Diffusivity of water vapor in the air
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PKA ! Thermal conductivity of the air
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCIT ! Pristine ice conc. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAR ! Slope parameter of the raindrop distribution
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAS ! Slope parameter of the aggregate distribution
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAG ! Slope parameter of the graupel distribution
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGT ! Graupel m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGSI ! Graupel tendency by other processes
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGSI_MR ! Graupel mr change by other processes
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PWETG ! 1. where graupel grows in wet mode, 0. elsewhere
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRICFRRG ! Rain contact freezing
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRCFRIG ! Rain contact freezing
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRICFRR ! Rain contact freezing
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCWETG ! Graupel wet growth
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIWETG ! Graupel wet growth
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRWETG ! Graupel wet growth
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSWETG ! Graupel wet growth
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCDRYG ! Graupel dry growth
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIDRYG ! Graupel dry growth
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRDRYG ! Graupel dry growth
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSDRYG ! Graupel dry growth
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRWETGH ! Conversion of graupel into hail
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRWETGH_MR ! Conversion of graupel into hail, mr change
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRGMLTR ! Melting of the graupel
+REAL, DIMENSION(KSIZE, 8), INTENT(INOUT) :: PRG_TEND ! Individual tendencies
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RR
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RI
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RS
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RG
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RH
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RG
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RH
+END SUBROUTINE ICE4_FAST_RG
+END INTERFACE
+END MODULE MODI_ICE4_FAST_RG
+SUBROUTINE ICE4_FAST_RG(KSIZE, LDSOFT, PCOMPUTE, KRR, &
+ &PRHODREF, PLVFACT, PLSFACT, PPRES, &
+ &PDV, PKA, PCJ, PCIT, &
+ &PLBDAR, PLBDAS, PLBDAG, &
+ &PT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ &PRGSI, PRGSI_MR, &
+ &PWETG, &
+ &PRICFRRG, PRRCFRIG, PRICFRR, PRCWETG, PRIWETG, PRRWETG, PRSWETG, &
+ &PRCDRYG, PRIDRYG, PRRDRYG, PRSDRYG, PRWETGH, PRWETGH_MR, PRGMLTR, &
+ &PRG_TEND, &
+ &PA_TH, PA_RC, PA_RR, PA_RI, PA_RS, PA_RG, PA_RH, PB_RG, PB_RH)
+!!
+!!** PURPOSE
+!! -------
+!! Computes the fast rg processes
+!!
+!! AUTHOR
+!! ------
+!! S. Riette from the splitting of rain_ice source code (nov. 2014)
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 29/05/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY: XALPI,XALPW,XBETAI,XBETAW,XGAMW,XCI,XCL,XCPV,XESTT,XGAMI,XLMTT,XLVTT,XMD,XMV,XRV,XTT, &
+ XEPSILO
+USE MODD_PARAM_ICE, ONLY: LCRFLIMIT,LEVLIMIT,LNULLWETG,LWETGPOST
+USE MODD_RAIN_ICE_DESCR, ONLY: XBS,XCEXVT,XCXG,XCXS,XDG,XRTMIN
+USE MODD_RAIN_ICE_PARAM, ONLY: NDRYLBDAG,NDRYLBDAR,NDRYLBDAS,X0DEPG,X1DEPG,XCOLEXIG,XCOLEXSG,XCOLIG,XCOLSG,XDRYINTP1G, &
+ XDRYINTP1R,XDRYINTP1S,XDRYINTP2G,XDRYINTP2R,XDRYINTP2S,XEX0DEPG,XEX1DEPG,XEXICFRR, &
+ XEXRCFRI,XFCDRYG,XFIDRYG,XFRDRYG,XFSDRYG,XICFRR,XKER_RDRYG,XKER_SDRYG,XLBRDRYG1, &
+ XLBRDRYG2,XLBRDRYG3,XLBSDRYG1,XLBSDRYG2,XLBSDRYG3,XRCFRI
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KSIZE
+LOGICAL, INTENT(IN) :: LDSOFT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
+INTEGER, INTENT(IN) :: KRR ! Number of moist variable
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PPRES ! absolute pressure at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PDV ! Diffusivity of water vapor in the air
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PKA ! Thermal conductivity of the air
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCIT ! Pristine ice conc. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAR ! Slope parameter of the raindrop distribution
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAS ! Slope parameter of the aggregate distribution
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAG ! Slope parameter of the graupel distribution
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGT ! Graupel m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGSI ! Graupel tendency by other processes
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGSI_MR ! Graupel mr change by other processes
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PWETG ! 1. where graupel grows in wet mode, 0. elsewhere
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRICFRRG ! Rain contact freezing
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRCFRIG ! Rain contact freezing
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRICFRR ! Rain contact freezing
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCWETG ! Graupel wet growth
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIWETG ! Graupel wet growth
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRWETG ! Graupel wet growth
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSWETG ! Graupel wet growth
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCDRYG ! Graupel dry growth
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIDRYG ! Graupel dry growth
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRDRYG ! Graupel dry growth
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSDRYG ! Graupel dry growth
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRWETGH ! Conversion of graupel into hail
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRWETGH_MR ! Conversion of graupel into hail, mr change
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRGMLTR ! Melting of the graupel
+REAL, DIMENSION(KSIZE, 8), INTENT(INOUT) :: PRG_TEND ! Individual tendencies
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RR
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RI
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RS
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RG
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RH
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RG
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RH
+!
+!* 0.2 declaration of local variables
+!
+INTEGER, PARAMETER :: IRCDRYG=1, IRIDRYG=2, IRIWETG=3, IRSDRYG=4, IRSWETG=5, IRRDRYG=6, &
+ & IFREEZ1=7, IFREEZ2=8
+!
+LOGICAL, DIMENSION(KSIZE) :: GDRY
+INTEGER, DIMENSION(KSIZE) :: I1
+REAL, DIMENSION(KSIZE) :: ZDRY, ZDRYG, ZMASK
+INTEGER :: IGDRY
+REAL, DIMENSION(KSIZE) :: ZVEC1, ZVEC2, ZVEC3
+INTEGER, DIMENSION(KSIZE) :: IVEC1, IVEC2
+REAL, DIMENSION(KSIZE) :: ZZW, &
+ ZRDRYG_INIT, & !Initial dry growth rate of the graupeln
+ ZRWETG_INIT !Initial wet growth rate of the graupeln
+INTEGER :: JJ, JL
+!
+!-------------------------------------------------------------------------------
+!
+!* 6.1 rain contact freezing
+!
+DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(4)-PRIT(JL))) * & ! WHERE(PRIT(:)>XRTMIN(4))
+ &MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JL))) * & ! WHERE(PRRT(:)>XRTMIN(3))
+ &PCOMPUTE(JL)
+ENDDO
+IF(LDSOFT) THEN
+ DO JL=1, KSIZE
+ PRICFRRG(JL)=ZMASK(JL) * PRICFRRG(JL)
+ PRRCFRIG(JL)=ZMASK(JL) * PRRCFRIG(JL)
+ PRICFRR(JL)=ZMASK(JL) * PRICFRR(JL)
+ ENDDO
+ELSE
+ PRICFRRG(:)=0.
+ PRRCFRIG(:)=0.
+ WHERE(ZMASK(:)==1.)
+ PRICFRRG(:) = XICFRR*PRIT(:) & ! RICFRRG
+ *PLBDAR(:)**XEXICFRR &
+ *PRHODREF(:)**(-XCEXVT)
+ PRRCFRIG(:) = XRCFRI*PCIT(:) & ! RRCFRIG
+ * PLBDAR(:)**XEXRCFRI &
+ * PRHODREF(:)**(-XCEXVT-1.)
+ END WHERE
+
+ IF(LCRFLIMIT) THEN
+ DO JL=1, KSIZE
+ !Comparison between heat to be released (to freeze rain) and heat sink (rain and ice temperature change)
+ !ZZW is the proportion of process that can take place
+ ZZW(JL)=(1.-ZMASK(JL)) + & ! 1. outside of mask
+ ZMASK(JL) * MAX(0., MIN(1., (PRICFRRG(JL)*XCI+PRRCFRIG(JL)*XCL)*(XTT-PT(JL)) / &
+ MAX(1.E-20, XLVTT*PRRCFRIG(JL))))
+ ENDDO
+ ELSE
+ ZZW(:)=1.
+ ENDIF
+ DO JL=1, KSIZE
+ PRRCFRIG(JL) = ZZW(JL) * PRRCFRIG(JL) !Part of rain that can be freezed
+ PRICFRR(JL) = (1.-ZZW(JL)) * PRICFRRG(JL) !Part of collected pristine ice converted to rain
+ PRICFRRG(JL) = ZZW(JL) * PRICFRRG(JL) !Part of collected pristine ice that lead to graupel
+ ENDDO
+ENDIF
+DO JL=1, KSIZE
+ PA_RI(JL) = PA_RI(JL) - PRICFRRG(JL) - PRICFRR(JL)
+ PA_RR(JL) = PA_RR(JL) - PRRCFRIG(JL) + PRICFRR(JL)
+ PA_RG(JL) = PA_RG(JL) + PRICFRRG(JL) + PRRCFRIG(JL)
+ PA_TH(JL) = PA_TH(JL) + (PRRCFRIG(JL) - PRICFRR(JL))*(PLSFACT(JL)-PLVFACT(JL))
+ENDDO
+!
+!
+!* 6.3 compute the graupel growth
+!
+! Wet and dry collection of rc and ri on graupel
+DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JL))) * & ! WHERE(PRGT(:)>XRTMIN(6))
+ &MAX(0., -SIGN(1., XRTMIN(2)-PRCT(JL))) * & ! WHERE(PRCT(:)>XRTMIN(2))
+ &PCOMPUTE(JL)
+ENDDO
+IF(LDSOFT) THEN
+ DO JL=1, KSIZE
+ PRG_TEND(JL, IRCDRYG)=ZMASK(JL)*PRG_TEND(JL, IRCDRYG)
+ ENDDO
+ELSE
+ ZZW(:)=0.
+ WHERE(ZMASK(:)==1.)
+ ZZW(:)=PLBDAG(:)**(XCXG-XDG-2.) * PRHODREF(:)**(-XCEXVT)
+ END WHERE
+ DO JL=1, KSIZE
+ PRG_TEND(JL, IRCDRYG)=ZMASK(JL)*XFCDRYG * PRCT(JL) * ZZW(JL)
+ ENDDO
+ENDIF
+
+DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JL))) * & ! WHERE(PRGT(:)>XRTMIN(6))
+ &MAX(0., -SIGN(1., XRTMIN(4)-PRIT(JL))) * & ! WHERE(PRIT(:)>XRTMIN(4))
+ &PCOMPUTE(JL)
+ENDDO
+IF(LDSOFT) THEN
+ DO JL=1, KSIZE
+ PRG_TEND(JL, IRIDRYG)=ZMASK(JL) * PRG_TEND(JL, IRIDRYG)
+ PRG_TEND(JL, IRIWETG)=ZMASK(JL) * PRG_TEND(JL, IRIWETG)
+ ENDDO
+ELSE
+ PRG_TEND(:, IRIDRYG)=0.
+ PRG_TEND(:, IRIWETG)=0.
+ WHERE(ZMASK(:)==1.)
+ ZZW(:)=PLBDAG(:)**(XCXG-XDG-2.) * PRHODREF(:)**(-XCEXVT)
+ PRG_TEND(:, IRIDRYG)=XFIDRYG*EXP(XCOLEXIG*(PT(:)-XTT))*PRIT(:)*ZZW(:)
+ PRG_TEND(:, IRIWETG)=PRG_TEND(:, IRIDRYG) / (XCOLIG*EXP(XCOLEXIG*(PT(:)-XTT)))
+ END WHERE
+ENDIF
+
+! Wet and dry collection of rs on graupel (6.2.1)
+IGDRY = 0
+DO JJ = 1, SIZE(GDRY)
+ ZDRY(JJ)=MAX(0., -SIGN(1., XRTMIN(5)-PRST(JJ))) * & ! WHERE(PRST(:)>XRTMIN(5))
+ &MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JJ))) * & ! WHERE(PRGT(:)>XRTMIN(6))
+ &PCOMPUTE(JJ)
+ IF (ZDRY(JJ)>0) THEN
+ IGDRY = IGDRY + 1
+ I1(IGDRY) = JJ
+ GDRY(JJ) = .TRUE.
+ ELSE
+ GDRY(JJ) = .FALSE.
+ END IF
+END DO
+
+IF(LDSOFT) THEN
+ DO JL=1, KSIZE
+ PRG_TEND(JL, IRSDRYG)=ZDRY(JL) * PRG_TEND(JL, IRSDRYG)
+ PRG_TEND(JL, IRSWETG)=ZDRY(JL) * PRG_TEND(JL, IRSWETG)
+ ENDDO
+ELSE
+ PRG_TEND(:, IRSDRYG)=0.
+ PRG_TEND(:, IRSWETG)=0.
+ IF(IGDRY>0)THEN
+ !
+ !* 6.2.3 select the (PLBDAG,PLBDAS) couplet
+ !
+ DO JJ = 1, IGDRY
+ ZVEC1(JJ) = PLBDAG(I1(JJ))
+ ZVEC2(JJ) = PLBDAS(I1(JJ))
+ END DO
+ !
+ !* 6.2.4 find the next lower indice for the PLBDAG and for the PLBDAS
+ ! in the geometrical set of (Lbda_g,Lbda_s) couplet use to
+ ! tabulate the SDRYG-kernel
+ !
+ ZVEC1(1:IGDRY)=MAX(1.00001, MIN(REAL(NDRYLBDAG)-0.00001, &
+ XDRYINTP1G*LOG(ZVEC1(1:IGDRY))+XDRYINTP2G))
+ IVEC1(1:IGDRY)=INT(ZVEC1(1:IGDRY) )
+ ZVEC1(1:IGDRY)=ZVEC1(1:IGDRY)-REAL(IVEC1(1:IGDRY))
+ !
+ ZVEC2(1:IGDRY)=MAX(1.00001, MIN( REAL(NDRYLBDAS)-0.00001, &
+ XDRYINTP1S*LOG(ZVEC2(1:IGDRY))+XDRYINTP2S))
+ IVEC2(1:IGDRY)=INT(ZVEC2(1:IGDRY))
+ ZVEC2(1:IGDRY)=ZVEC2(1:IGDRY)-REAL(IVEC2(1:IGDRY))
+ !
+ !* 6.2.5 perform the bilinear interpolation of the normalized
+ ! SDRYG-kernel
+ !
+ DO JJ=1, IGDRY
+ ZVEC3(JJ) = ( XKER_SDRYG(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_SDRYG(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * ZVEC1(JJ) &
+ - ( XKER_SDRYG(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_SDRYG(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ *(ZVEC1(JJ) - 1.0)
+ END DO
+ ZZW(:) = 0.
+ DO JJ = 1, IGDRY
+ ZZW(I1(JJ)) = ZVEC3(JJ)
+ END DO
+ !
+ WHERE(GDRY(:))
+ PRG_TEND(:, IRSWETG)=XFSDRYG*ZZW(:) & ! RSDRYG
+ / XCOLSG &
+ *(PLBDAS(:)**(XCXS-XBS))*( PLBDAG(:)**XCXG ) &
+ *(PRHODREF(:)**(-XCEXVT-1.)) &
+ *( XLBSDRYG1/( PLBDAG(:)**2 ) + &
+ XLBSDRYG2/( PLBDAG(:) * PLBDAS(:) ) + &
+ XLBSDRYG3/( PLBDAS(:)**2))
+ PRG_TEND(:, IRSDRYG)=PRG_TEND(:, IRSWETG)*XCOLSG*EXP(XCOLEXSG*(PT(:)-XTT))
+ END WHERE
+ ENDIF
+ENDIF
+!
+!* 6.2.6 accretion of raindrops on the graupeln
+!
+IGDRY = 0
+DO JJ = 1, SIZE(GDRY)
+ ZDRY(JJ)=MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JJ))) * & ! WHERE(PRRT(:)>XRTMIN(3))
+ &MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JJ))) * & ! WHERE(PRGT(:)>XRTMIN(6))
+ &PCOMPUTE(JJ)
+ IF (ZDRY(JJ)>0) THEN
+ IGDRY = IGDRY + 1
+ I1(IGDRY) = JJ
+ GDRY(JJ) = .TRUE.
+ ELSE
+ GDRY(JJ) = .FALSE.
+ END IF
+END DO
+
+IF(LDSOFT) THEN
+ DO JL=1, KSIZE
+ PRG_TEND(JL, IRRDRYG)=ZDRY(JL) * PRG_TEND(JL, IRRDRYG)
+ ENDDO
+ELSE
+ PRG_TEND(:, IRRDRYG)=0.
+ !
+ IF(IGDRY>0) THEN
+ !
+ !* 6.2.8 select the (PLBDAG,PLBDAR) couplet
+ !
+ DO JJ = 1, IGDRY
+ ZVEC1(JJ) = PLBDAG(I1(JJ))
+ ZVEC2(JJ) = PLBDAR(I1(JJ))
+ END DO
+ !
+ !* 6.2.9 find the next lower indice for the PLBDAG and for the PLBDAR
+ ! in the geometrical set of (Lbda_g,Lbda_r) couplet use to
+ ! tabulate the RDRYG-kernel
+ !
+ ZVEC1(1:IGDRY)=MAX(1.00001, MIN( REAL(NDRYLBDAG)-0.00001, &
+ XDRYINTP1G*LOG(ZVEC1(1:IGDRY))+XDRYINTP2G))
+ IVEC1(1:IGDRY)=INT(ZVEC1(1:IGDRY))
+ ZVEC1(1:IGDRY)=ZVEC1(1:IGDRY)-REAL(IVEC1(1:IGDRY))
+ !
+ ZVEC2(1:IGDRY)=MAX(1.00001, MIN( REAL(NDRYLBDAR)-0.00001, &
+ XDRYINTP1R*LOG(ZVEC2(1:IGDRY))+XDRYINTP2R))
+ IVEC2(1:IGDRY)=INT(ZVEC2(1:IGDRY))
+ ZVEC2(1:IGDRY)=ZVEC2(1:IGDRY)-REAL(IVEC2(1:IGDRY))
+ !
+ !* 6.2.10 perform the bilinear interpolation of the normalized
+ ! RDRYG-kernel
+ !
+ DO JJ=1, IGDRY
+ ZVEC3(JJ)= ( XKER_RDRYG(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_RDRYG(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * ZVEC1(JJ) &
+ - ( XKER_RDRYG(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_RDRYG(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ *(ZVEC1(JJ) - 1.0)
+ END DO
+ ZZW(:) = 0.
+ DO JJ = 1, IGDRY
+ ZZW(I1(JJ)) = ZVEC3(JJ)
+ END DO
+ !
+ WHERE(GDRY(:))
+ PRG_TEND(:, IRRDRYG) = XFRDRYG*ZZW(:) & ! RRDRYG
+ *( PLBDAR(:)**(-4) )*( PLBDAG(:)**XCXG ) &
+ *( PRHODREF(:)**(-XCEXVT-1.) ) &
+ *( XLBRDRYG1/( PLBDAG(:)**2 ) + &
+ XLBRDRYG2/( PLBDAG(:) * PLBDAR(:) ) + &
+ XLBRDRYG3/( PLBDAR(:)**2) )
+ END WHERE
+ ENDIF
+ENDIF
+
+DO JL=1, KSIZE
+ ZRDRYG_INIT(JL)=PRG_TEND(JL, IRCDRYG)+PRG_TEND(JL, IRIDRYG)+ &
+ &PRG_TEND(JL, IRSDRYG)+PRG_TEND(JL, IRRDRYG)
+ENDDO
+
+!Freezing rate
+DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JL))) * & ! WHERE(PRGT(:)>XRTMIN(6))
+ &PCOMPUTE(JL)
+ENDDO
+IF(LDSOFT) THEN
+ DO JL=1, KSIZE
+ PRG_TEND(JL, IFREEZ1)=ZMASK(JL) * PRG_TEND(JL, IFREEZ1)
+ PRG_TEND(JL, IFREEZ2)=ZMASK(JL) * PRG_TEND(JL, IFREEZ2)
+ ENDDO
+ELSE
+ DO JL=1, KSIZE
+ PRG_TEND(JL, IFREEZ1)=ZMASK(JL) * PRVT(JL)*PPRES(JL)/(XEPSILO+PRVT(JL)) ! Vapor pressure
+ ENDDO
+ IF(LEVLIMIT) THEN
+ WHERE(ZMASK(:)==1.)
+ PRG_TEND(:, IFREEZ1)=MIN(PRG_TEND(:, IFREEZ1), EXP(XALPI-XBETAI/PT(:)-XGAMI*ALOG(PT(:)))) ! min(ev, es_i(T))
+ END WHERE
+ ENDIF
+ PRG_TEND(:, IFREEZ2)=0.
+ WHERE(ZMASK(:)==1.)
+ PRG_TEND(:, IFREEZ1)=PKA(:)*(XTT-PT(:)) + &
+ (PDV(:)*(XLVTT+(XCPV-XCL)*(PT(:)-XTT)) &
+ *(XESTT-PRG_TEND(:, IFREEZ1))/(XRV*PT(:)) )
+ PRG_TEND(:, IFREEZ1)=PRG_TEND(:, IFREEZ1)* ( X0DEPG* PLBDAG(:)**XEX0DEPG + &
+ X1DEPG*PCJ(:)*PLBDAG(:)**XEX1DEPG )/ &
+ ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) )
+ PRG_TEND(:, IFREEZ2)=(PRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-PT(:))) ) / &
+ ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) )
+ END WHERE
+ENDIF
+DO JL=1, KSIZE
+ !We must agregate, at least, the cold species
+ ZRWETG_INIT(JL)=ZMASK(JL) * MAX(PRG_TEND(JL, IRIWETG)+PRG_TEND(JL, IRSWETG), &
+ &MAX(0., PRG_TEND(JL, IFREEZ1) + &
+ &PRG_TEND(JL, IFREEZ2) * ( &
+ &PRG_TEND(JL, IRIWETG)+PRG_TEND(JL, IRSWETG) )))
+ENDDO
+
+!Growth mode
+DO JL=1, KSIZE
+ PWETG(JL) = ZMASK(JL) * & !
+ & MAX(0., SIGN(1., MAX(0., ZRDRYG_INIT(JL)-PRG_TEND(JL, IRIDRYG)-PRG_TEND(JL, IRSDRYG)) - &
+ &MAX(0., ZRWETG_INIT(JL)-PRG_TEND(JL, IRIWETG)-PRG_TEND(JL, IRSWETG))))
+ENDDO
+IF(LNULLWETG) THEN
+ DO JL=1, KSIZE
+ PWETG(JL) = PWETG(JL) * MAX(0., -SIGN(1., -ZRDRYG_INIT(JL)))
+ ENDDO
+ELSE
+ DO JL=1, KSIZE
+ PWETG(JL) = PWETG(JL) * MAX(0., -SIGN(1., -ZRWETG_INIT(JL)))
+ ENDDO
+ENDIF
+IF(.NOT. LWETGPOST) THEN
+ DO JL=1, KSIZE
+ PWETG(JL) = PWETG(JL) * MAX(0., -SIGN(1., PT(JL)-XTT))
+ ENDDO
+ENDIF
+DO JL=1, KSIZE
+ ZDRYG(JL) = ZMASK(JL) * & !
+ & MAX(0., -SIGN(1., PT(JL)-XTT)) * & ! WHERE(PT(:)<XTT)
+ & MAX(0., -SIGN(1., 1.E-20-ZRDRYG_INIT(JL))) * & ! WHERE(ZRDRYG_INIT(:)>0.)
+ & MAX(0., -SIGN(1., MAX(0., ZRDRYG_INIT(JL)-PRG_TEND(JL, IRIDRYG)-PRG_TEND(JL, IRSDRYG)) - &
+ &MAX(0., ZRWETG_INIT(JL)-PRG_TEND(JL, IRIWETG)-PRG_TEND(JL, IRSWETG))))
+ENDDO
+
+! Part of ZRWETG to be converted into hail
+! Graupel can be produced by other processes instantaneously (inducing a mixing ratio change, PRGSI_MR) or
+! as a tendency (PRWETGH)
+PRWETGH(:)=0.
+PRWETGH_MR(:)=0.
+IF(KRR==7) THEN
+ WHERE(PWETG(:)==1.)
+ !assume a linear percent of conversion of produced graupel into hail
+ PRWETGH(:)=(MAX(0., PRGSI(:)+PRICFRRG(:)+PRRCFRIG(:))+ZRWETG_INIT(:))*ZRDRYG_INIT(:)/(ZRWETG_INIT(:)+ZRDRYG_INIT(:))
+ PRWETGH_MR(:)=MAX(0., PRGSI_MR(:))*ZRDRYG_INIT(:)/(ZRWETG_INIT(:)+ZRDRYG_INIT(:))
+ END WHERE
+ENDIF
+
+DO JL=1, KSIZE
+ !Aggregated minus collected
+ PRRWETG(JL)=-PWETG(JL) * (PRG_TEND(JL, IRIWETG)+PRG_TEND(JL, IRSWETG)+&
+ &PRG_TEND(JL, IRCDRYG)-ZRWETG_INIT(JL))
+ PRCWETG(JL)=PWETG(JL) * PRG_TEND(JL, IRCDRYG)
+ PRIWETG(JL)=PWETG(JL) * PRG_TEND(JL, IRIWETG)
+ PRSWETG(JL)=PWETG(JL) * PRG_TEND(JL, IRSWETG)
+
+ PRCDRYG(JL)=ZDRYG(JL) * PRG_TEND(JL, IRCDRYG)
+ PRRDRYG(JL)=ZDRYG(JL) * PRG_TEND(JL, IRRDRYG)
+ PRIDRYG(JL)=ZDRYG(JL) * PRG_TEND(JL, IRIDRYG)
+ PRSDRYG(JL)=ZDRYG(JL) * PRG_TEND(JL, IRSDRYG)
+
+ PA_RC(JL) = PA_RC(JL) - PRCWETG(JL)
+ PA_RI(JL) = PA_RI(JL) - PRIWETG(JL)
+ PA_RS(JL) = PA_RS(JL) - PRSWETG(JL)
+ PA_RG(JL) = PA_RG(JL) + PRCWETG(JL) + PRIWETG(JL) + PRSWETG(JL) + PRRWETG(JL)
+ PA_RR(JL) = PA_RR(JL) - PRRWETG(JL)
+ PA_TH(JL) = PA_TH(JL) + (PRCWETG(JL) + PRRWETG(JL))*(PLSFACT(JL)-PLVFACT(JL))
+ PA_RG(JL) = PA_RG(JL) - PRWETGH(JL)
+ PA_RH(JL) = PA_RH(JL) + PRWETGH(JL)
+ PB_RG(JL) = PB_RG(JL) - PRWETGH_MR(JL)
+ PB_RH(JL) = PB_RH(JL) + PRWETGH_MR(JL)
+ PA_RC(JL) = PA_RC(JL) - PRCDRYG(JL)
+ PA_RI(JL) = PA_RI(JL) - PRIDRYG(JL)
+ PA_RS(JL) = PA_RS(JL) - PRSDRYG(JL)
+ PA_RR(JL) = PA_RR(JL) - PRRDRYG(JL)
+ PA_RG(JL) = PA_RG(JL) + PRCDRYG(JL) + PRIDRYG(JL) + PRSDRYG(JL) + PRRDRYG(JL)
+ PA_TH(JL) = PA_TH(JL) + (PRCDRYG(JL)+PRRDRYG(JL))*(PLSFACT(JL)-PLVFACT(JL))
+ENDDO
+!
+!* 6.5 Melting of the graupeln
+!
+DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JL))) * & ! WHERE(PRGT(:)>XRTMIN(6))
+ &MAX(0., -SIGN(1., XTT-PT(JL))) * & ! WHERE(PT(:)>XTT)
+ &PCOMPUTE(JL)
+ENDDO
+IF(LDSOFT) THEN
+ DO JL=1, KSIZE
+ PRGMLTR(JL)=ZMASK(JL) * PRGMLTR(JL)
+ ENDDO
+ELSE
+ DO JL=1, KSIZE
+ PRGMLTR(JL)=ZMASK(JL) * PRVT(JL)*PPRES(JL)/(XEPSILO+PRVT(JL)) ! Vapor pressure
+ ENDDO
+ IF(LEVLIMIT) THEN
+ WHERE(ZMASK(:)==1.)
+ PRGMLTR(:)=MIN(PRGMLTR(:), EXP(XALPW-XBETAW/PT(:)-XGAMW*ALOG(PT(:)))) ! min(ev, es_w(T))
+ END WHERE
+ ENDIF
+ DO JL=1, KSIZE
+ PRGMLTR(JL)=ZMASK(JL) * (PKA(JL)*(XTT-PT(JL)) + &
+ ( PDV(JL)*(XLVTT + ( XCPV - XCL ) * ( PT(JL) - XTT )) &
+ *(XESTT-PRGMLTR(JL))/(XRV*PT(JL)) ))
+ ENDDO
+ WHERE(ZMASK(:)==1.)
+ !
+ ! compute RGMLTR
+ !
+ PRGMLTR(:) = MAX( 0.0,( -PRGMLTR(:) * &
+ ( X0DEPG* PLBDAG(:)**XEX0DEPG + &
+ X1DEPG*PCJ(:)*PLBDAG(:)**XEX1DEPG ) - &
+ ( PRG_TEND(:, IRCDRYG)+PRG_TEND(:, IRRDRYG) ) * &
+ ( PRHODREF(:)*XCL*(XTT-PT(:))) ) / &
+ ( PRHODREF(:)*XLMTT ) )
+ END WHERE
+ENDIF
+DO JL=1, KSIZE
+ PA_RR(JL) = PA_RR(JL) + PRGMLTR(JL)
+ PA_RG(JL) = PA_RG(JL) - PRGMLTR(JL)
+ PA_TH(JL) = PA_TH(JL) - PRGMLTR(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ENDDO
+!
+END SUBROUTINE ICE4_FAST_RG
diff --git a/src/mesonh/micro/ice4_fast_rh.f90 b/src/mesonh/micro/ice4_fast_rh.f90
new file mode 100644
index 000000000..fcac93748
--- /dev/null
+++ b/src/mesonh/micro/ice4_fast_rh.f90
@@ -0,0 +1,593 @@
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+MODULE MODI_ICE4_FAST_RH
+INTERFACE
+SUBROUTINE ICE4_FAST_RH(KSIZE, LDSOFT, PCOMPUTE, PWETG, &
+ &PRHODREF, PLVFACT, PLSFACT, PPRES, &
+ &PDV, PKA, PCJ, &
+ &PLBDAS, PLBDAG, PLBDAR, PLBDAH, &
+ &PT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, &
+ &PRCWETH, PRIWETH, PRSWETH, PRGWETH, PRRWETH, &
+ &PRCDRYH, PRIDRYH, PRSDRYH, PRRDRYH, PRGDRYH, PRDRYHG, PRHMLTR, &
+ &PRH_TEND, &
+ &PA_TH, PA_RC, PA_RR, PA_RI, PA_RS, PA_RG, PA_RH)
+IMPLICIT NONE
+INTEGER, INTENT(IN) :: KSIZE
+LOGICAL, INTENT(IN) :: LDSOFT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PWETG ! 1. where graupel grows in wet mode, 0. elsewhere
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PPRES ! absolute pressure at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PDV ! Diffusivity of water vapor in the air
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PKA ! Thermal conductivity of the air
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAS ! Slope parameter of the aggregate distribution
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAG ! Slope parameter of the graupel distribution
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAR ! Slope parameter of the rain distribution
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAH ! Slope parameter of the hail distribution
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRRT ! Rain m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGT ! Graupel m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHT ! Hail m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCWETH ! Dry growth of hailstone
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIWETH ! Dry growth of hailstone
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSWETH ! Dry growth of hailstone
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRGWETH ! Dry growth of hailstone
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRWETH ! Dry growth of hailstone
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCDRYH ! Wet growth of hailstone
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIDRYH ! Wet growth of hailstone
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSDRYH ! Wet growth of hailstone
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRDRYH ! Wet growth of hailstone
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRGDRYH ! Wet growth of hailstone
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRDRYHG ! Conversion of hailstone into graupel
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRHMLTR ! Melting of the hailstones
+REAL, DIMENSION(KSIZE, 10), INTENT(INOUT) :: PRH_TEND ! Individual tendencies
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RR
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RI
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RS
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RG
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RH
+END SUBROUTINE ICE4_FAST_RH
+END INTERFACE
+END MODULE MODI_ICE4_FAST_RH
+SUBROUTINE ICE4_FAST_RH(KSIZE, LDSOFT, PCOMPUTE, PWETG, &
+ &PRHODREF, PLVFACT, PLSFACT, PPRES, &
+ &PDV, PKA, PCJ, &
+ &PLBDAS, PLBDAG, PLBDAR, PLBDAH, &
+ &PT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, &
+ &PRCWETH, PRIWETH, PRSWETH, PRGWETH, PRRWETH, &
+ &PRCDRYH, PRIDRYH, PRSDRYH, PRRDRYH, PRGDRYH, PRDRYHG, PRHMLTR, &
+ &PRH_TEND, &
+ &PA_TH, PA_RC, PA_RR, PA_RI, PA_RS, PA_RG, PA_RH)
+!!
+!!** PURPOSE
+!! -------
+!! Computes the fast rh process
+!!
+!! AUTHOR
+!! ------
+!! S. Riette from the splitting of rain_ice source code (nov. 2014)
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 29/05/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY: XALPI,XALPW,XBETAI,XBETAW,XGAMW,XCI,XCL,XCPV,XESTT,XGAMI,XLMTT,XLVTT,XMD,XMV,XRV,XTT,XEPSILO
+USE MODD_PARAM_ICE, ONLY: LCONVHG,LEVLIMIT,LNULLWETH,LWETHPOST
+USE MODD_RAIN_ICE_DESCR, ONLY: XBG,XBS,XCEXVT,XCXG,XCXH,XCXS,XDH,XRTMIN
+USE MODD_RAIN_ICE_PARAM, ONLY: NWETLBDAG,NWETLBDAH,NWETLBDAR,NWETLBDAS,X0DEPH,X1DEPH,XCOLEXGH,XCOLEXIH,XCOLGH,XCOLIH,XCOLEXSH, &
+ XCOLSH,XEX0DEPH,XEX1DEPH,XFGWETH,XFRWETH,XFSWETH,XFWETH,XKER_GWETH,XKER_RWETH,XKER_SWETH, &
+ XLBGWETH1,XLBGWETH2,XLBGWETH3,XLBRWETH1,XLBRWETH2,XLBRWETH3,XLBSWETH1,XLBSWETH2,XLBSWETH3, &
+ XWETINTP1G,XWETINTP1H,XWETINTP1R,XWETINTP1S,XWETINTP2G,XWETINTP2H,XWETINTP2R,XWETINTP2S
+!
+USE MODE_MPPDB
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KSIZE
+LOGICAL, INTENT(IN) :: LDSOFT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PWETG ! 1. where graupel grows in wet mode, 0. elsewhere
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PPRES ! absolute pressure at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PDV ! Diffusivity of water vapor in the air
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PKA ! Thermal conductivity of the air
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAS ! Slope parameter of the aggregate distribution
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAG ! Slope parameter of the graupel distribution
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAR ! Slope parameter of the rain distribution
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAH ! Slope parameter of the hail distribution
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRRT ! Rain m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGT ! Graupel m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHT ! Hail m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCWETH ! Dry growth of hailstone
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIWETH ! Dry growth of hailstone
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSWETH ! Dry growth of hailstone
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRGWETH ! Dry growth of hailstone
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRWETH ! Dry growth of hailstone
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCDRYH ! Wet growth of hailstone
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIDRYH ! Wet growth of hailstone
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSDRYH ! Wet growth of hailstone
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRDRYH ! Wet growth of hailstone
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRGDRYH ! Wet growth of hailstone
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRDRYHG ! Conversion of hailstone into graupel
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRHMLTR ! Melting of the hailstones
+REAL, DIMENSION(KSIZE, 10), INTENT(INOUT) :: PRH_TEND ! Individual tendencies
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RR
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RI
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RS
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RG
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RH
+!
+!* 0.2 declaration of local variables
+!
+INTEGER, PARAMETER :: IRCWETH=1, IRRWETH=2, IRIDRYH=3, IRIWETH=4, IRSDRYH=5, IRSWETH=6, IRGDRYH=7, IRGWETH=8, &
+ & IFREEZ1=9, IFREEZ2=10
+!
+LOGICAL, DIMENSION(KSIZE) :: GWET
+REAL, DIMENSION(KSIZE) :: ZHAIL, ZWET, ZMASK, ZWETH, ZDRYH
+INTEGER :: IHAIL, IGWET
+INTEGER, DIMENSION(KSIZE) :: I1
+REAL, DIMENSION(KSIZE) :: ZVEC1, ZVEC2, ZVEC3
+INTEGER, DIMENSION(KSIZE) :: IVEC1, IVEC2
+REAL, DIMENSION(KSIZE) :: ZZW, &
+ ZRDRYH_INIT, ZRWETH_INIT, &
+ ZRDRYHG
+INTEGER :: JJ, JL
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 7.2 compute the Wet and Dry growth of hail
+!
+DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JL))) * & ! WHERE(PRHT(:)>XRTMIN(7))
+ &MAX(0., -SIGN(1., XRTMIN(2)-PRCT(JL))) * & ! WHERE(PRCT(:)>XRTMIN(2))
+ &PCOMPUTE(JL)
+ENDDO
+IF(LDSOFT) THEN
+ DO JL=1, KSIZE
+ PRH_TEND(JL, IRCWETH)=ZMASK(JL) * PRH_TEND(JL, IRCWETH)
+ ENDDO
+ELSE
+ PRH_TEND(:, IRCWETH)=0.
+ WHERE(ZMASK(:)==1.)
+ ZZW(:) = PLBDAH(:)**(XCXH-XDH-2.0) * PRHODREF(:)**(-XCEXVT)
+ PRH_TEND(:, IRCWETH)=XFWETH * PRCT(:) * ZZW(:) ! RCWETH
+ END WHERE
+ENDIF
+DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JL))) * & ! WHERE(PRHT(:)>XRTMIN(7))
+ &MAX(0., -SIGN(1., XRTMIN(4)-PRIT(JL))) * & ! WHERE(PRIT(:)>XRTMIN(4))
+ &PCOMPUTE(JL)
+ENDDO
+IF(LDSOFT) THEN
+ DO JL=1, KSIZE
+ PRH_TEND(JL, IRIWETH)=ZMASK(JL) * PRH_TEND(JL, IRIWETH)
+ PRH_TEND(JL, IRIDRYH)=ZMASK(JL) * PRH_TEND(JL, IRIDRYH)
+ ENDDO
+ELSE
+ PRH_TEND(:, IRIWETH)=0.
+ PRH_TEND(:, IRIDRYH)=0.
+ WHERE(ZMASK(:)==1.)
+ ZZW(:) = PLBDAH(:)**(XCXH-XDH-2.0) * PRHODREF(:)**(-XCEXVT)
+ PRH_TEND(:, IRIWETH)=XFWETH * PRIT(:) * ZZW(:) ! RIWETH
+ PRH_TEND(:, IRIDRYH)=PRH_TEND(:, IRIWETH)*(XCOLIH*EXP(XCOLEXIH*(PT(:)-XTT))) ! RIDRYH
+ END WHERE
+ENDIF
+
+!
+!* 7.2.1 accretion of aggregates on the hailstones
+!
+IGWET = 0
+DO JJ = 1, SIZE(GWET)
+ ZWET(JJ) = MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JJ))) * & ! WHERE(PRHT(:)>XRTMIN(7))
+ &MAX(0., -SIGN(1., XRTMIN(5)-PRST(JJ))) * & ! WHERE(PRST(:)>XRTMIN(5))
+ &PCOMPUTE(JJ)
+ IF (ZWET(JJ)>0) THEN
+ IGWET = IGWET + 1
+ I1(IGWET) = JJ
+ GWET(JJ) = .TRUE.
+ ELSE
+ GWET(JJ) = .FALSE.
+ END IF
+END DO
+
+IF(LDSOFT) THEN
+ DO JL=1, KSIZE
+ PRH_TEND(JL, IRSWETH)=ZWET(JL) * PRH_TEND(JL, IRSWETH)
+ PRH_TEND(JL, IRSDRYH)=ZWET(JL) * PRH_TEND(JL, IRSDRYH)
+ ENDDO
+ELSE
+ PRH_TEND(:, IRSWETH)=0.
+ PRH_TEND(:, IRSDRYH)=0.
+ IF(IGWET>0)THEN
+ !
+ !* 7.2.3 select the (PLBDAH,PLBDAS) couplet
+ !
+ DO JJ = 1, IGWET
+ ZVEC1(JJ) = PLBDAH(I1(JJ))
+ ZVEC2(JJ) = PLBDAS(I1(JJ))
+ END DO
+ !
+ !* 7.2.4 find the next lower indice for the PLBDAG and for the PLBDAS
+ ! in the geometrical set of (Lbda_h,Lbda_s) couplet use to
+ ! tabulate the SWETH-kernel
+ !
+ ZVEC1(1:IGWET) = MAX( 1.00001, MIN( REAL(NWETLBDAH)-0.00001, &
+ XWETINTP1H * LOG( ZVEC1(1:IGWET) ) + XWETINTP2H ) )
+ IVEC1(1:IGWET) = INT( ZVEC1(1:IGWET) )
+ ZVEC1(1:IGWET) = ZVEC1(1:IGWET) - REAL( IVEC1(1:IGWET) )
+ !
+ ZVEC2(1:IGWET) = MAX( 1.00001, MIN( REAL(NWETLBDAS)-0.00001, &
+ XWETINTP1S * LOG( ZVEC2(1:IGWET) ) + XWETINTP2S ) )
+ IVEC2(1:IGWET) = INT( ZVEC2(1:IGWET) )
+ ZVEC2(1:IGWET) = ZVEC2(1:IGWET) - REAL( IVEC2(1:IGWET) )
+ !
+ !* 7.2.5 perform the bilinear interpolation of the normalized
+ ! SWETH-kernel
+ !
+ DO JJ = 1,IGWET
+ ZVEC3(JJ) = ( XKER_SWETH(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_SWETH(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * ZVEC1(JJ) &
+ - ( XKER_SWETH(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_SWETH(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * (ZVEC1(JJ) - 1.0)
+ END DO
+ ZZW(:) = 0.
+ DO JJ = 1, IGWET
+ ZZW(I1(JJ)) = ZVEC3(JJ)
+ END DO
+ !
+ WHERE(GWET(:))
+ PRH_TEND(:, IRSWETH)=XFSWETH*ZZW(:) & ! RSWETH
+ *( PLBDAS(:)**(XCXS-XBS) )*( PLBDAH(:)**XCXH ) &
+ *( PRHODREF(:)**(-XCEXVT-1.) ) &
+ *( XLBSWETH1/( PLBDAH(:)**2 ) + &
+ XLBSWETH2/( PLBDAH(:) * PLBDAS(:) ) + &
+ XLBSWETH3/( PLBDAS(:)**2) )
+ PRH_TEND(:, IRSDRYH)=PRH_TEND(:, IRSWETH)*(XCOLSH*EXP(XCOLEXSH*(PT(:)-XTT)))
+ END WHERE
+ ENDIF
+ENDIF
+!
+!* 7.2.6 accretion of graupeln on the hailstones
+!
+IGWET = 0
+DO JJ = 1, SIZE(GWET)
+ ZWET(JJ)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JJ))) * & ! WHERE(PRHT(:)>XRTMIN(7))
+ &MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JJ))) * & ! WHERE(PRGT(:)>XRTMIN(6))
+ &PCOMPUTE(JJ)
+ IF (ZWET(JJ)>0) THEN
+ IGWET = IGWET + 1
+ I1(IGWET) = JJ
+ GWET(JJ) = .TRUE.
+ ELSE
+ GWET(JJ) = .FALSE.
+ END IF
+END DO
+
+IF(LDSOFT) THEN
+ DO JL=1, KSIZE
+ PRH_TEND(JL, IRGWETH)=ZWET(JL) * PRH_TEND(JL, IRGWETH)
+ PRH_TEND(JL, IRGDRYH)=ZWET(JL) * PRH_TEND(JL, IRGDRYH)
+ ENDDO
+ELSE
+ PRH_TEND(:, IRGWETH)=0.
+ PRH_TEND(:, IRGDRYH)=0.
+ IF(IGWET>0)THEN
+ !
+ !* 7.2.8 select the (PLBDAH,PLBDAG) couplet
+ !
+ DO JJ = 1, IGWET
+ ZVEC1(JJ) = PLBDAH(I1(JJ))
+ ZVEC2(JJ) = PLBDAG(I1(JJ))
+ END DO
+ !
+ !* 7.2.9 find the next lower indice for the PLBDAH and for the PLBDAG
+ ! in the geometrical set of (Lbda_h,Lbda_g) couplet use to
+ ! tabulate the GWETH-kernel
+ !
+ ZVEC1(1:IGWET) = MAX( 1.00001, MIN( REAL(NWETLBDAG)-0.00001, &
+ XWETINTP1H * LOG( ZVEC1(1:IGWET) ) + XWETINTP2H ) )
+ IVEC1(1:IGWET) = INT( ZVEC1(1:IGWET) )
+ ZVEC1(1:IGWET) = ZVEC1(1:IGWET) - REAL( IVEC1(1:IGWET) )
+ !
+ ZVEC2(1:IGWET) = MAX( 1.00001, MIN( REAL(NWETLBDAG)-0.00001, &
+ XWETINTP1G * LOG( ZVEC2(1:IGWET) ) + XWETINTP2G ) )
+ IVEC2(1:IGWET) = INT( ZVEC2(1:IGWET) )
+ ZVEC2(1:IGWET) = ZVEC2(1:IGWET) - REAL( IVEC2(1:IGWET) )
+ !
+ !* 7.2.10 perform the bilinear interpolation of the normalized
+ ! GWETH-kernel
+ !
+ DO JJ = 1,IGWET
+ ZVEC3(JJ) = ( XKER_GWETH(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_GWETH(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * ZVEC1(JJ) &
+ - ( XKER_GWETH(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_GWETH(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * (ZVEC1(JJ) - 1.0)
+ END DO
+ ZZW(:) = 0.
+ DO JJ = 1, IGWET
+ ZZW(I1(JJ)) = ZVEC3(JJ)
+ END DO
+ !
+ WHERE(GWET(:))
+ PRH_TEND(:, IRGWETH)=XFGWETH*ZZW(:) & ! RGWETH
+ *( PLBDAG(:)**(XCXG-XBG) )*( PLBDAH(:)**XCXH ) &
+ *( PRHODREF(:)**(-XCEXVT-1.) ) &
+ *( XLBGWETH1/( PLBDAH(:)**2 ) + &
+ XLBGWETH2/( PLBDAH(:) * PLBDAG(:) ) + &
+ XLBGWETH3/( PLBDAG(:)**2) )
+ PRH_TEND(:, IRGDRYH)=PRH_TEND(:, IRGWETH)
+ END WHERE
+ !When graupel grows in wet mode, graupel is wet (!) and collection efficiency must remain the same
+ WHERE(GWET(:) .AND. .NOT. PWETG(:)==1.)
+ PRH_TEND(:, IRGDRYH)=PRH_TEND(:, IRGDRYH)*(XCOLGH*EXP(XCOLEXGH*(PT(:)-XTT)))
+ END WHERE
+ END IF
+ENDIF
+!
+!* 7.2.11 accretion of raindrops on the hailstones
+!
+IGWET = 0
+DO JJ = 1, SIZE(GWET)
+ ZWET(JJ)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JJ))) * & ! WHERE(PRHT(:)>XRTMIN(7))
+ &MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JJ))) * & ! WHERE(PRRT(:)>XRTMIN(3))
+ &PCOMPUTE(JJ)
+ IF (ZWET(JJ)>0) THEN
+ IGWET = IGWET + 1
+ I1(IGWET) = JJ
+ GWET(JJ) = .TRUE.
+ ELSE
+ GWET(JJ) = .FALSE.
+ END IF
+END DO
+
+IF(LDSOFT) THEN
+ DO JL=1, KSIZE
+ PRH_TEND(JL, IRRWETH)=ZWET(JL) * PRH_TEND(JL, IRRWETH)
+ ENDDO
+ELSE
+ PRH_TEND(:, IRRWETH)=0.
+ IF(IGWET>0)THEN
+ !
+ !* 7.2.12 select the (PLBDAH,PLBDAR) couplet
+ !
+ DO JJ = 1, IGWET
+ ZVEC1(JJ) = PLBDAH(I1(JJ))
+ ZVEC2(JJ) = PLBDAR(I1(JJ))
+ END DO
+ !
+ !* 7.2.13 find the next lower indice for the PLBDAH and for the PLBDAR
+ ! in the geometrical set of (Lbda_h,Lbda_r) couplet use to
+ ! tabulate the RWETH-kernel
+ !
+ ZVEC1(1:IGWET)=MAX(1.00001, MIN( REAL(NWETLBDAH)-0.00001, &
+ XWETINTP1H*LOG(ZVEC1(1:IGWET))+XWETINTP2H))
+ IVEC1(1:IGWET)=INT(ZVEC1(1:IGWET))
+ ZVEC1(1:IGWET)=ZVEC1(1:IGWET)-REAL(IVEC1(1:IGWET))
+ !
+ ZVEC2(1:IGWET)=MAX(1.00001, MIN( REAL(NWETLBDAR)-0.00001, &
+ XWETINTP1R*LOG(ZVEC2(1:IGWET))+XWETINTP2R))
+ IVEC2(1:IGWET)=INT(ZVEC2(1:IGWET))
+ ZVEC2(1:IGWET)=ZVEC2(1:IGWET)-REAL(IVEC2(1:IGWET))
+ !
+ !* 7.2.14 perform the bilinear interpolation of the normalized
+ ! RWETH-kernel
+ !
+ DO JJ=1, IGWET
+ ZVEC3(JJ)= ( XKER_RWETH(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_RWETH(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * ZVEC1(JJ) &
+ - ( XKER_RWETH(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_RWETH(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ *(ZVEC1(JJ) - 1.0)
+ END DO
+ ZZW(:) = 0.
+ DO JJ = 1, IGWET
+ ZZW(I1(JJ)) = ZVEC3(JJ)
+ END DO
+ !
+ WHERE(GWET(:))
+ PRH_TEND(:, IRRWETH) = XFRWETH*ZZW(:) & ! RRWETH
+ *( PLBDAR(:)**(-4) )*( PLBDAH(:)**XCXH ) &
+ *( PRHODREF(:)**(-XCEXVT-1.) ) &
+ *( XLBRWETH1/( PLBDAH(:)**2 ) + &
+ XLBRWETH2/( PLBDAH(:) * PLBDAR(:) ) + &
+ XLBRWETH3/( PLBDAR(:)**2) )
+ END WHERE
+ ENDIF
+ENDIF
+!
+DO JL=1, KSIZE
+ ZRDRYH_INIT(JL)=PRH_TEND(JL, IRCWETH)+PRH_TEND(JL, IRIDRYH)+ &
+ &PRH_TEND(JL, IRSDRYH)+PRH_TEND(JL, IRRWETH)+PRH_TEND(JL, IRGDRYH)
+ENDDO
+!
+!* 7.3 compute the Wet growth of hail
+!
+DO JL=1, KSIZE
+ ZHAIL(JL)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JL))) * & ! WHERE(PRHT(:)>XRTMIN(7))
+ &PCOMPUTE(JL)
+ENDDO
+IF(LDSOFT) THEN
+ DO JL=1, KSIZE
+ PRH_TEND(JL, IFREEZ1)=ZHAIL(JL) * PRH_TEND(JL, IFREEZ1)
+ PRH_TEND(JL, IFREEZ2)=ZHAIL(JL) * PRH_TEND(JL, IFREEZ2)
+ ENDDO
+ELSE
+ DO JL=1, KSIZE
+ PRH_TEND(JL, IFREEZ1)=PRVT(JL)*PPRES(JL)/(XEPSILO+PRVT(JL)) ! Vapor pressure
+ ENDDO
+ IF(LEVLIMIT) THEN
+ WHERE(ZHAIL(:)==1.)
+ PRH_TEND(:, IFREEZ1)=MIN(PRH_TEND(:, IFREEZ1), EXP(XALPI-XBETAI/PT(:)-XGAMI*ALOG(PT(:)))) ! min(ev, es_i(T))
+ END WHERE
+ ENDIF
+ PRH_TEND(:, IFREEZ2)=0.
+ WHERE(ZHAIL(:)==1.)
+ PRH_TEND(:, IFREEZ1)=PKA(:)*(XTT-PT(:)) + &
+ (PDV(:)*(XLVTT+(XCPV-XCL)*(PT(:)-XTT)) &
+ *(XESTT-PRH_TEND(:, IFREEZ1))/(XRV*PT(:)) )
+ PRH_TEND(:, IFREEZ1)=PRH_TEND(:, IFREEZ1)* ( X0DEPH* PLBDAH(:)**XEX0DEPH + &
+ X1DEPH*PCJ(:)*PLBDAH(:)**XEX1DEPH )/ &
+ ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) )
+ PRH_TEND(:, IFREEZ2)=(PRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-PT(:))) ) / &
+ ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) )
+ END WHERE
+ENDIF
+DO JL=1, KSIZE
+ !We must agregate, at least, the cold species
+ ZRWETH_INIT(JL)=ZHAIL(JL) * MAX(PRH_TEND(JL, IRIWETH)+PRH_TEND(JL, IRSWETH)+PRH_TEND(JL, IRGWETH), &
+ &MAX(0., PRH_TEND(JL, IFREEZ1) + &
+ &PRH_TEND(JL, IFREEZ2) * ( &
+ &PRH_TEND(JL, IRIWETH)+PRH_TEND(JL, IRSWETH)+PRH_TEND(JL, IRGWETH) )))
+ENDDO
+!
+!* 7.4 Select Wet or Dry case
+!
+!Wet case
+DO JL=1, KSIZE
+ ZWETH(JL) = ZHAIL(JL) * &
+ & MAX(0., SIGN(1., MAX(0., ZRDRYH_INIT(JL)-PRH_TEND(JL, IRIDRYH)-PRH_TEND(JL, IRSDRYH)-PRH_TEND(JL, IRGDRYH)) - &
+ &MAX(0., ZRWETH_INIT(JL)-PRH_TEND(JL, IRIWETH)-PRH_TEND(JL, IRSWETH)-PRH_TEND(JL, IRGWETH))))
+ENDDO
+IF(LNULLWETH) THEN
+ DO JL=1, KSIZE
+ ZWETH(JL) = ZWETH(JL) * MAX(0., -SIGN(1., -ZRDRYH_INIT(JL))) ! WHERE(ZRDRYH_INIT(:)>0.)
+ ENDDO
+ELSE
+ DO JL=1, KSIZE
+ ZWETH(JL) = ZWETH(JL) * MAX(0., -SIGN(1., -ZRWETH_INIT(JL))) ! WHERE(ZRWETH_INIT(:)>0.)
+ ENDDO
+ENDIF
+IF(.NOT. LWETHPOST) THEN
+ DO JL=1, KSIZE
+ ZWETH(JL) = ZWETH(JL) * MAX(0., -SIGN(1., PT(JL)-XTT)) ! WHERE(PT(:)<XTT)
+ ENDDO
+ENDIF
+DO JL=1, KSIZE
+ ZDRYH(JL) = ZHAIL(JL) * &
+ & MAX(0., -SIGN(1., PT(JL)-XTT)) * & ! WHERE(PT(:)<XTT)
+ & MAX(0., -SIGN(1., 1.E-20-ZRDRYH_INIT(JL))) * & !WHERE(ZRDRYH_INIT(:)>0.)
+ & MAX(0., -SIGN(1., MAX(0., ZRDRYH_INIT(JL)-PRH_TEND(JL, IRIDRYH)-PRH_TEND(JL, IRSDRYH)) - &
+ &MAX(0., ZRWETH_INIT(JL)-PRH_TEND(JL, IRIWETH)-PRH_TEND(JL, IRSWETH))))
+ENDDO
+!
+ZRDRYHG(:)=0.
+IF(LCONVHG)THEN
+ WHERE(ZDRYH(:)==1.)
+ ZRDRYHG(:)=ZRDRYH_INIT(:)*ZRWETH_INIT(:)/(ZRDRYH_INIT(:)+ZRWETH_INIT(:))
+ END WHERE
+ENDIF
+DO JL=1, KSIZE
+ PRCWETH(JL) = ZWETH(JL) * PRH_TEND(JL, IRCWETH)
+ PRIWETH(JL) = ZWETH(JL) * PRH_TEND(JL, IRIWETH)
+ PRSWETH(JL) = ZWETH(JL) * PRH_TEND(JL, IRSWETH)
+ PRGWETH(JL) = ZWETH(JL) * PRH_TEND(JL, IRGWETH)
+ !Collected minus aggregated
+ PRRWETH(JL) = ZWETH(JL) * (ZRWETH_INIT(JL) - PRH_TEND(JL, IRIWETH) - &
+ PRH_TEND(JL, IRSWETH) - PRH_TEND(JL, IRGWETH) - &
+ PRH_TEND(JL, IRCWETH))
+
+ PRCDRYH(JL) = ZDRYH(JL) * PRH_TEND(JL, IRCWETH)
+ PRIDRYH(JL) = ZDRYH(JL) * PRH_TEND(JL, IRIDRYH)
+ PRSDRYH(JL) = ZDRYH(JL) * PRH_TEND(JL, IRSDRYH)
+ PRRDRYH(JL) = ZDRYH(JL) * PRH_TEND(JL, IRRWETH)
+ PRGDRYH(JL) = ZDRYH(JL) * PRH_TEND(JL, IRGDRYH)
+ PRDRYHG(JL) = ZDRYH(JL) * ZRDRYHG(JL)
+
+ PA_RC(JL) = PA_RC(JL) - PRCWETH(JL)
+ PA_RI(JL) = PA_RI(JL) - PRIWETH(JL)
+ PA_RS(JL) = PA_RS(JL) - PRSWETH(JL)
+ PA_RG(JL) = PA_RG(JL) - PRGWETH(JL)
+ PA_RH(JL) = PA_RH(JL) + PRCWETH(JL)+PRIWETH(JL)+PRSWETH(JL)+PRGWETH(JL)+PRRWETH(JL)
+ PA_RR(JL) = PA_RR(JL) - PRRWETH(JL)
+ PA_TH(JL) = PA_TH(JL) + (PRRWETH(JL)+PRCWETH(JL))*(PLSFACT(JL)-PLVFACT(JL))
+ PA_RC(JL) = PA_RC(JL) - PRCDRYH(JL)
+ PA_RI(JL) = PA_RI(JL) - PRIDRYH(JL)
+ PA_RS(JL) = PA_RS(JL) - PRSDRYH(JL)
+ PA_RR(JL) = PA_RR(JL) - PRRDRYH(JL)
+ PA_RG(JL) = PA_RG(JL) - PRGDRYH(JL) + PRDRYHG(JL)
+ PA_RH(JL) = PA_RH(JL) + PRCDRYH(JL)+PRIDRYH(JL)+PRSDRYH(JL)+&
+ &PRRDRYH(JL)+PRGDRYH(JL) - PRDRYHG(JL)
+ PA_TH(JL) = PA_TH(JL) + (PRCDRYH(JL)+PRRDRYH(JL))*(PLSFACT(JL)-PLVFACT(JL))
+ENDDO
+!
+!* 7.5 Melting of the hailstones
+!
+DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JL))) * & ! WHERE(PRHT(:)>XRTMIN(7))
+ &MAX(0., -SIGN(1., XTT-PT(JL))) * & ! WHERE(PT(:)>XTT)
+ &PCOMPUTE(JL)
+ENDDO
+IF(LDSOFT) THEN
+ DO JL=1, KSIZE
+ PRHMLTR(JL)=ZMASK(JL)*PRHMLTR(JL)
+ ENDDO
+ELSE
+ DO JL=1, KSIZE
+ PRHMLTR(JL) = ZMASK(JL)* PRVT(JL)*PPRES(JL)/(XEPSILO+PRVT(JL)) ! Vapor pressure
+ ENDDO
+ IF(LEVLIMIT) THEN
+ WHERE(ZMASK(:)==1.)
+ PRHMLTR(:)=MIN(PRHMLTR(:), EXP(XALPW-XBETAW/PT(:)-XGAMW*ALOG(PT(:)))) ! min(ev, es_w(T))
+ END WHERE
+ ENDIF
+ DO JL=1, KSIZE
+ PRHMLTR(JL) = ZMASK(JL)* (PKA(JL)*(XTT-PT(JL)) + &
+ ( PDV(JL)*(XLVTT + ( XCPV - XCL ) * ( PT(JL) - XTT )) &
+ *(XESTT-PRHMLTR(JL))/(XRV*PT(JL)) ))
+ ENDDO
+ WHERE(ZMASK(:)==1.)
+ !
+ ! compute RHMLTR
+ !
+ PRHMLTR(:) = MAX( 0.0,( -PRHMLTR(:) * &
+ ( X0DEPH* PLBDAH(:)**XEX0DEPH + &
+ X1DEPH*PCJ(:)*PLBDAH(:)**XEX1DEPH ) - &
+ ( PRH_TEND(:, IRCWETH)+PRH_TEND(:, IRRWETH) )* &
+ ( PRHODREF(:)*XCL*(XTT-PT(:))) ) / &
+ ( PRHODREF(:)*XLMTT ) )
+ END WHERE
+END IF
+DO JL=1, KSIZE
+ PA_RR(JL) = PA_RR(JL) + PRHMLTR(JL)
+ PA_RH(JL) = PA_RH(JL) - PRHMLTR(JL)
+ PA_TH(JL) = PA_TH(JL) - PRHMLTR(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ENDDO
+!
+!
+END SUBROUTINE ICE4_FAST_RH
diff --git a/src/mesonh/micro/ice4_fast_ri.f90 b/src/mesonh/micro/ice4_fast_ri.f90
new file mode 100644
index 000000000..bbe45f579
--- /dev/null
+++ b/src/mesonh/micro/ice4_fast_ri.f90
@@ -0,0 +1,129 @@
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-------------------------------------------------------------------------------
+MODULE MODI_ICE4_FAST_RI
+INTERFACE
+SUBROUTINE ICE4_FAST_RI(KSIZE, LDSOFT, PCOMPUTE, &
+ &PRHODREF, PLVFACT, PLSFACT, &
+ &PAI, PCJ, PCIT, &
+ &PSSI, &
+ &PRCT, PRIT, &
+ &PRCBERI, PA_TH, PA_RC, PA_RI)
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_RAIN_ICE_PARAM
+USE MODD_RAIN_ICE_DESCR
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KSIZE
+LOGICAL, INTENT(IN) :: LDSOFT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PAI ! Thermodynamical function
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCIT ! Pristine ice conc. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PSSI ! Supersaturation over ice
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCBERI ! Bergeron-Findeisen effect
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RI
+END SUBROUTINE ICE4_FAST_RI
+END INTERFACE
+END MODULE MODI_ICE4_FAST_RI
+SUBROUTINE ICE4_FAST_RI(KSIZE, LDSOFT, PCOMPUTE, &
+ &PRHODREF, PLVFACT, PLSFACT, &
+ &PAI, PCJ, PCIT, &
+ &PSSI, &
+ &PRCT, PRIT, &
+ &PRCBERI, PA_TH, PA_RC, PA_RI)
+!!
+!!** PURPOSE
+!! -------
+!! Computes the fast ri process
+!!
+!! AUTHOR
+!! ------
+!! S. Riette from the splitting of rain_ice source code (nov. 2014)
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_RAIN_ICE_DESCR, ONLY: XDI,XLBEXI,XLBI,XRTMIN
+USE MODD_RAIN_ICE_PARAM, ONLY: X0DEPI,X2DEPI
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KSIZE
+LOGICAL, INTENT(IN) :: LDSOFT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PAI ! Thermodynamical function
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCIT ! Pristine ice conc. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PSSI ! Supersaturation over ice
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCBERI ! Bergeron-Findeisen effect
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RI
+!
+!* 0.2 declaration of local variables
+!
+REAL, DIMENSION(KSIZE) :: ZMASK
+INTEGER :: JL
+!
+!-------------------------------------------------------------------------------
+!
+!-------------------------------------------------------------------------------
+!
+!* 7.2 Bergeron-Findeisen effect: RCBERI
+!
+DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., -PSSI(JL))) * & ! PSSI(:)>0.
+ &MAX(0., -SIGN(1., XRTMIN(2)-PRCT(JL))) * & ! PRCT(:)>XRTMIN(2)
+ &MAX(0., -SIGN(1., XRTMIN(4)-PRIT(JL))) * & ! PRIT(:)>XRTMIN(4)
+ &MAX(0., -SIGN(1., 1.E-20-PCIT(JL))) * & ! PCIT(:)>0.
+ &PCOMPUTE(JL)
+ENDDO
+IF(LDSOFT) THEN
+ DO JL=1, KSIZE
+ PRCBERI(JL) = PRCBERI(JL) * ZMASK(JL)
+ ENDDO
+ELSE
+ PRCBERI(:) = 0.
+ WHERE(ZMASK(:)==1.)
+ PRCBERI(:) = MIN(1.E8, XLBI*(PRHODREF(:)*PRIT(:)/PCIT(:))**XLBEXI) ! Lbda_i
+ PRCBERI(:) = ( PSSI(:) / (PRHODREF(:)*PAI(:)) ) * PCIT(:) * &
+ ( X0DEPI/PRCBERI(:) + X2DEPI*PCJ(:)*PCJ(:)/PRCBERI(:)**(XDI+2.0) )
+ END WHERE
+ENDIF
+DO JL=1, KSIZE
+ PA_RC(JL) = PA_RC(JL) - PRCBERI(JL)
+ PA_RI(JL) = PA_RI(JL) + PRCBERI(JL)
+ PA_TH(JL) = PA_TH(JL) + PRCBERI(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ENDDO
+!
+!
+END SUBROUTINE ICE4_FAST_RI
diff --git a/src/mesonh/micro/ice4_fast_rs.f90 b/src/mesonh/micro/ice4_fast_rs.f90
new file mode 100644
index 000000000..6d71c7b61
--- /dev/null
+++ b/src/mesonh/micro/ice4_fast_rs.f90
@@ -0,0 +1,521 @@
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+MODULE MODI_ICE4_FAST_RS
+INTERFACE
+SUBROUTINE ICE4_FAST_RS(KSIZE, LDSOFT, PCOMPUTE, &
+ &PRHODREF, PLVFACT, PLSFACT, PPRES, &
+ &PDV, PKA, PCJ, &
+ &PLBDAR, PLBDAS, &
+ &PT, PRVT, PRCT, PRRT, PRST, &
+ &PRIAGGS, &
+ &PRCRIMSS, PRCRIMSG, PRSRIMCG, &
+ &PRRACCSS, PRRACCSG, PRSACCRG, PRSMLTG, &
+ &PRCMLTSR, &
+ &PRS_TEND, &
+ &PA_TH, PA_RC, PA_RR, PA_RS, PA_RG)
+IMPLICIT NONE
+INTEGER, INTENT(IN) :: KSIZE
+LOGICAL, INTENT(IN) :: LDSOFT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PPRES ! absolute pressure at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PDV ! Diffusivity of water vapor in the air
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PKA ! Thermal conductivity of the air
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAR ! Slope parameter of the raindrop distribution
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAS ! Slope parameter of the aggregate distribution
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIAGGS ! r_i aggregation on r_s
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCRIMSS ! Cloud droplet riming of the aggregates
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCRIMSG ! Cloud droplet riming of the aggregates
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSRIMCG ! Cloud droplet riming of the aggregates
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRACCSS ! Rain accretion onto the aggregates
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRACCSG ! Rain accretion onto the aggregates
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSACCRG ! Rain accretion onto the aggregates
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSMLTG ! Conversion-Melting of the aggregates
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCMLTSR ! Cloud droplet collection onto aggregates by positive temperature
+REAL, DIMENSION(KSIZE, 8), INTENT(INOUT) :: PRS_TEND ! Individual tendencies
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RR
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RS
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RG
+END SUBROUTINE ICE4_FAST_RS
+END INTERFACE
+END MODULE MODI_ICE4_FAST_RS
+SUBROUTINE ICE4_FAST_RS(KSIZE, LDSOFT, PCOMPUTE, &
+ &PRHODREF, PLVFACT, PLSFACT, PPRES, &
+ &PDV, PKA, PCJ, &
+ &PLBDAR, PLBDAS, &
+ &PT, PRVT, PRCT, PRRT, PRST, &
+ &PRIAGGS, &
+ &PRCRIMSS, PRCRIMSG, PRSRIMCG, &
+ &PRRACCSS, PRRACCSG, PRSACCRG, PRSMLTG, &
+ &PRCMLTSR, &
+ &PRS_TEND, &
+ &PA_TH, PA_RC, PA_RR, PA_RS, PA_RG)
+!!
+!!** PURPOSE
+!! -------
+!! Computes the fast rs processes
+!!
+!! AUTHOR
+!! ------
+!! S. Riette from the splitting of rain_ice source code (nov. 2014)
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 29/05/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY: XALPI,XALPW,XBETAI,XBETAW,XCI,XCL,XCPV,XESTT,XGAMI,XGAMW,XLMTT,XLVTT,XMD,XMV,XRV,XTT, &
+ XEPSILO
+USE MODD_PARAM_ICE, ONLY: LEVLIMIT, CSNOWRIMING
+USE MODD_RAIN_ICE_DESCR, ONLY: XBS,XCEXVT,XCXS,XRTMIN
+USE MODD_RAIN_ICE_PARAM, ONLY: NACCLBDAR,NACCLBDAS,NGAMINC,X0DEPS,X1DEPS,XACCINTP1R,XACCINTP1S,XACCINTP2R,XACCINTP2S, &
+ XCRIMSG,XCRIMSS,XEX0DEPS,XEX1DEPS,XEXCRIMSG,XEXCRIMSS,XEXSRIMCG,XEXSRIMCG2,XFRACCSS, &
+ XFSACCRG,XFSCVMG,XGAMINC_RIM1,XGAMINC_RIM1,XGAMINC_RIM2,XGAMINC_RIM4,XKER_RACCS, &
+ XKER_RACCSS,XKER_SACCRG,XLBRACCS1,XLBRACCS2,XLBRACCS3,XLBSACCR1,XLBSACCR2,XLBSACCR3, &
+ XRIMINTP1,XRIMINTP2,XSRIMCG,XSRIMCG2,XSRIMCG3
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KSIZE
+LOGICAL, INTENT(IN) :: LDSOFT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PPRES ! absolute pressure at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PDV ! Diffusivity of water vapor in the air
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PKA ! Thermal conductivity of the air
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAR ! Slope parameter of the raindrop distribution
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAS ! Slope parameter of the aggregate distribution
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIAGGS ! r_i aggregation on r_s
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCRIMSS ! Cloud droplet riming of the aggregates
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCRIMSG ! Cloud droplet riming of the aggregates
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSRIMCG ! Cloud droplet riming of the aggregates
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRACCSS ! Rain accretion onto the aggregates
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRACCSG ! Rain accretion onto the aggregates
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSACCRG ! Rain accretion onto the aggregates
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSMLTG ! Conversion-Melting of the aggregates
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCMLTSR ! Cloud droplet collection onto aggregates by positive temperature
+REAL, DIMENSION(KSIZE, 8), INTENT(INOUT) :: PRS_TEND ! Individual tendencies
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RR
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RS
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RG
+!
+!* 0.2 declaration of local variables
+!
+INTEGER, PARAMETER :: IRCRIMS=1, IRCRIMSS=2, IRSRIMCG=3, IRRACCS=4, IRRACCSS=5, IRSACCRG=6, &
+ & IFREEZ1=7, IFREEZ2=8
+!
+REAL, DIMENSION(KSIZE) :: ZRIM, ZACC, ZMASK
+LOGICAL, DIMENSION(KSIZE) :: GRIM, GACC
+INTEGER :: IGRIM, IGACC
+INTEGER, DIMENSION(KSIZE) :: I1
+REAL, DIMENSION(KSIZE) :: ZVEC1, ZVEC2, ZVEC3
+INTEGER, DIMENSION(KSIZE) :: IVEC1, IVEC2
+REAL, DIMENSION(KSIZE) :: ZZW, ZZW2, ZZW6, ZFREEZ_RATE
+INTEGER :: JJ, JL
+!-------------------------------------------------------------------------------
+!
+!
+!* 5.0 maximum freezing rate
+!
+DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(5)-PRST(JL))) * & ! WHERE(PRST(:)>XRTMIN(5))
+ &PCOMPUTE(JL)
+ENDDO
+IF(LDSOFT) THEN
+ DO JL=1, KSIZE
+ PRS_TEND(JL, IFREEZ1)=ZMASK(JL) * PRS_TEND(JL, IFREEZ1)
+ PRS_TEND(JL, IFREEZ2)=ZMASK(JL) * PRS_TEND(JL, IFREEZ2)
+ ENDDO
+ELSE
+ DO JL=1, KSIZE
+ PRS_TEND(JL, IFREEZ1)=ZMASK(JL) * PRVT(JL)*PPRES(JL)/(XEPSILO+PRVT(JL)) ! Vapor pressure
+ ENDDO
+ IF(LEVLIMIT) THEN
+ WHERE(ZMASK(:)==1.)
+ PRS_TEND(:, IFREEZ1)=MIN(PRS_TEND(:, IFREEZ1), EXP(XALPI-XBETAI/PT(:)-XGAMI*ALOG(PT(:)))) ! min(ev, es_i(T))
+ END WHERE
+ ENDIF
+ PRS_TEND(:, IFREEZ2)=0.
+ WHERE(ZMASK(:)==1.)
+ PRS_TEND(:, IFREEZ1)=PKA(:)*(XTT-PT(:)) + &
+ (PDV(:)*(XLVTT+(XCPV-XCL)*(PT(:)-XTT)) &
+ *(XESTT-PRS_TEND(:, IFREEZ1))/(XRV*PT(:)) )
+ PRS_TEND(:, IFREEZ1)=PRS_TEND(:, IFREEZ1)* ( X0DEPS* PLBDAS(:)**XEX0DEPS + &
+ X1DEPS*PCJ(:)*PLBDAS(:)**XEX1DEPS )/ &
+ ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) )
+ PRS_TEND(:, IFREEZ2)=(PRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-PT(:))) ) / &
+ ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) )
+ END WHERE
+ENDIF
+DO JL=1, KSIZE
+ !We must agregate, at least, the cold species
+ !And we are only interested by the freezing rate of liquid species
+ ZFREEZ_RATE(JL)=ZMASK(JL) * MAX(0., MAX(0., PRS_TEND(JL, IFREEZ1) + &
+ &PRS_TEND(JL, IFREEZ2) * PRIAGGS(JL)) - &
+ PRIAGGS(JL))
+ENDDO
+!
+!* 5.1 cloud droplet riming of the aggregates
+!
+IGRIM = 0
+DO JJ = 1, SIZE(GRIM)
+ ZRIM(JJ)=MAX(0., -SIGN(1., XRTMIN(2)-PRCT(JJ))) * & !WHERE(PRCT(:)>XRTMIN(2))
+ &MAX(0., -SIGN(1., XRTMIN(5)-PRST(JJ))) * & !WHERE(PRST(:)>XRTMIN(5))
+ &PCOMPUTE(JJ)
+ IF (ZRIM(JJ)>0) THEN
+ IGRIM = IGRIM + 1
+ I1(IGRIM) = JJ
+ GRIM(JJ) = .TRUE.
+ ELSE
+ GRIM(JJ) = .FALSE.
+ END IF
+END DO
+!
+! Collection of cloud droplets by snow: this rate is used for riming (T<0) and for conversion/melting (T>0)
+IF(LDSOFT) THEN
+ DO JL=1, KSIZE
+ PRS_TEND(JL, IRCRIMS)=ZRIM(JL) * PRS_TEND(JL, IRCRIMS)
+ PRS_TEND(JL, IRCRIMSS)=ZRIM(JL) * PRS_TEND(JL, IRCRIMSS)
+ PRS_TEND(JL, IRSRIMCG)=ZRIM(JL) * PRS_TEND(JL, IRSRIMCG)
+ ENDDO
+ELSE
+ PRS_TEND(:, IRCRIMS)=0.
+ PRS_TEND(:, IRCRIMSS)=0.
+ PRS_TEND(:, IRSRIMCG)=0.
+ !
+ IF(IGRIM>0) THEN
+ !
+ ! 5.1.1 select the PLBDAS
+ !
+ DO JJ = 1, IGRIM
+ ZVEC1(JJ) = PLBDAS(I1(JJ))
+ END DO
+ !
+ ! 5.1.2 find the next lower indice for the PLBDAS in the geometrical
+ ! set of Lbda_s used to tabulate some moments of the incomplete
+ ! gamma function
+ !
+ ZVEC2(1:IGRIM) = MAX( 1.00001, MIN( REAL(NGAMINC)-0.00001, &
+ XRIMINTP1 * LOG( ZVEC1(1:IGRIM) ) + XRIMINTP2 ) )
+ IVEC2(1:IGRIM) = INT( ZVEC2(1:IGRIM) )
+ ZVEC2(1:IGRIM) = ZVEC2(1:IGRIM) - REAL( IVEC2(1:IGRIM) )
+ !
+ ! 5.1.3 perform the linear interpolation of the normalized
+ ! "2+XDS"-moment of the incomplete gamma function
+ !
+ ZVEC1(1:IGRIM) = XGAMINC_RIM1( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) &
+ - XGAMINC_RIM1( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0)
+ ZZW(:) = 0.
+ DO JJ = 1, IGRIM
+ ZZW(I1(JJ)) = ZVEC1(JJ)
+ END DO
+ !
+ ! 5.1.4 riming of the small sized aggregates
+ !
+ WHERE (GRIM(:))
+ PRS_TEND(:, IRCRIMSS) = XCRIMSS * ZZW(:) * PRCT(:) & ! RCRIMSS
+ * PLBDAS(:)**XEXCRIMSS &
+ * PRHODREF(:)**(-XCEXVT)
+ END WHERE
+ !
+ ! 5.1.5 perform the linear interpolation of the normalized
+ ! "XBS"-moment of the incomplete gamma function (XGAMINC_RIM2) and
+ ! "XBG"-moment of the incomplete gamma function (XGAMINC_RIM4)
+ !
+ ZVEC1(1:IGRIM) = XGAMINC_RIM2( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) &
+ - XGAMINC_RIM2( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0)
+ ZZW(:) = 0.
+ DO JJ = 1, IGRIM
+ ZZW(I1(JJ)) = ZVEC1(JJ)
+ END DO
+
+ ZVEC1(1:IGRIM) = XGAMINC_RIM4( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) &
+ - XGAMINC_RIM4( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0)
+ ZZW2(:) = 0.
+ DO JJ = 1, IGRIM
+ ZZW2(I1(JJ)) = ZVEC1(JJ)
+ END DO
+ !
+ ! 5.1.6 riming-conversion of the large sized aggregates into graupeln
+ !
+ !
+ WHERE(GRIM(:))
+ PRS_TEND(:, IRCRIMS)=XCRIMSG * PRCT(:) & ! RCRIMS
+ * PLBDAS(:)**XEXCRIMSG &
+ * PRHODREF(:)**(-XCEXVT)
+ ZZW6(:) = PRS_TEND(:, IRCRIMS) - PRS_TEND(:, IRCRIMSS) ! RCRIMSG
+ END WHERE
+
+ IF(CSNOWRIMING=='M90 ')THEN
+ !Murakami 1990
+ WHERE(GRIM(:))
+ PRS_TEND(:, IRSRIMCG)=XSRIMCG * PLBDAS(:)**XEXSRIMCG*(1.0-ZZW(:))
+ PRS_TEND(:, IRSRIMCG)=ZZW6(:)*PRS_TEND(:, IRSRIMCG)/ &
+ MAX(1.E-20, &
+ XSRIMCG3*XSRIMCG2*PLBDAS(:)**XEXSRIMCG2*(1.-ZZW2(:)) - &
+ XSRIMCG3*PRS_TEND(:, IRSRIMCG))
+ END WHERE
+ ELSE
+ PRS_TEND(:, IRSRIMCG)=0.
+ END IF
+ ENDIF
+ENDIF
+!
+DO JL=1, KSIZE
+ ! More restrictive RIM mask to be used for riming by negative temperature only
+ ZRIM(JL)=ZRIM(JL) * &
+ &MAX(0., -SIGN(1., PT(JL)-XTT)) ! WHERE(PT(:)<XTT)
+ PRCRIMSS(JL)=ZRIM(JL)*MIN(ZFREEZ_RATE(JL), PRS_TEND(JL, IRCRIMSS))
+ ZFREEZ_RATE(JL)=MAX(0., ZFREEZ_RATE(JL)-PRCRIMSS(JL))
+ ZZW(JL) = MIN(1., ZFREEZ_RATE(JL) / MAX(1.E-20, PRS_TEND(JL, IRCRIMS) - PRCRIMSS(JL))) ! proportion we are able to freeze
+ PRCRIMSG(JL) = ZRIM(JL) * ZZW(JL) * MAX(0., PRS_TEND(JL, IRCRIMS) - PRCRIMSS(JL)) ! RCRIMSG
+ ZFREEZ_RATE(JL)=MAX(0., ZFREEZ_RATE(JL)-PRCRIMSG(JL))
+ PRSRIMCG(JL) = ZRIM(JL) * ZZW(JL) * PRS_TEND(JL, IRSRIMCG)
+
+ PRSRIMCG(JL) = PRSRIMCG(JL) * MAX(0., -SIGN(1., -PRCRIMSG(JL)))
+ PRCRIMSG(JL)=MAX(0., PRCRIMSG(JL))
+
+ PA_RC(JL) = PA_RC(JL) - PRCRIMSS(JL)
+ PA_RS(JL) = PA_RS(JL) + PRCRIMSS(JL)
+ PA_TH(JL) = PA_TH(JL) + PRCRIMSS(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ PA_RC(JL) = PA_RC(JL) - PRCRIMSG(JL)
+ PA_RS(JL) = PA_RS(JL) - PRSRIMCG(JL)
+ PA_RG(JL) = PA_RG(JL) + PRCRIMSG(JL)+PRSRIMCG(JL)
+ PA_TH(JL) = PA_TH(JL) + PRCRIMSG(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ENDDO
+!
+!* 5.2 rain accretion onto the aggregates
+!
+IGACC = 0
+DO JJ = 1, SIZE(GACC)
+ ZACC(JJ)=MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JJ))) * & !WHERE(PRRT(:)>XRTMIN(3))
+ &MAX(0., -SIGN(1., XRTMIN(5)-PRST(JJ))) * & !WHERE(PRST(:)>XRTMIN(5))
+ &PCOMPUTE(JJ)
+ IF (ZACC(JJ)>0) THEN
+ IGACC = IGACC + 1
+ I1(IGACC) = JJ
+ GACC(JJ) = .TRUE.
+ ELSE
+ GACC(JJ) = .FALSE.
+ END IF
+END DO
+
+IF(LDSOFT) THEN
+ DO JL=1, KSIZE
+ PRS_TEND(JL, IRRACCS)=ZACC(JL) * PRS_TEND(JL, IRRACCS)
+ PRS_TEND(JL, IRRACCSS)=ZACC(JL) * PRS_TEND(JL, IRRACCSS)
+ PRS_TEND(JL, IRSACCRG)=ZACC(JL) * PRS_TEND(JL, IRSACCRG)
+ ENDDO
+ELSE
+ PRS_TEND(:, IRRACCS)=0.
+ PRS_TEND(:, IRRACCSS)=0.
+ PRS_TEND(:, IRSACCRG)=0.
+ IF(IGACC>0)THEN
+ !
+ !
+ ! 5.2.1 select the (PLBDAS,PLBDAR) couplet
+ !
+ DO JJ = 1, IGACC
+ ZVEC1(JJ) = PLBDAS(I1(JJ))
+ ZVEC2(JJ) = PLBDAR(I1(JJ))
+ END DO
+ !
+ ! 5.2.2 find the next lower indice for the PLBDAS and for the PLBDAR
+ ! in the geometrical set of (Lbda_s,Lbda_r) couplet use to
+ ! tabulate the RACCSS-kernel
+ !
+ ZVEC1(1:IGACC) = MAX( 1.00001, MIN( REAL(NACCLBDAS)-0.00001, &
+ XACCINTP1S * LOG( ZVEC1(1:IGACC) ) + XACCINTP2S ) )
+ IVEC1(1:IGACC) = INT( ZVEC1(1:IGACC) )
+ ZVEC1(1:IGACC) = ZVEC1(1:IGACC) - REAL( IVEC1(1:IGACC) )
+ !
+ ZVEC2(1:IGACC) = MAX( 1.00001, MIN( REAL(NACCLBDAR)-0.00001, &
+ XACCINTP1R * LOG( ZVEC2(1:IGACC) ) + XACCINTP2R ) )
+ IVEC2(1:IGACC) = INT( ZVEC2(1:IGACC) )
+ ZVEC2(1:IGACC) = ZVEC2(1:IGACC) - REAL( IVEC2(1:IGACC) )
+ !
+ ! 5.2.3 perform the bilinear interpolation of the normalized
+ ! RACCSS-kernel
+ !
+ DO JJ = 1, IGACC
+ ZVEC3(JJ) = ( XKER_RACCSS(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_RACCSS(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * ZVEC1(JJ) &
+ - ( XKER_RACCSS(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_RACCSS(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * (ZVEC1(JJ) - 1.0)
+ END DO
+ ZZW(:) = 0.
+ DO JJ = 1, IGACC
+ ZZW(I1(JJ)) = ZVEC3(JJ)
+ END DO
+ !
+ ! 5.2.4 raindrop accretion on the small sized aggregates
+ !
+ WHERE(GACC(:))
+ ZZW6(:) = & !! coef of RRACCS
+ XFRACCSS*( PLBDAS(:)**XCXS )*( PRHODREF(:)**(-XCEXVT-1.) ) &
+ *( XLBRACCS1/((PLBDAS(:)**2) ) + &
+ XLBRACCS2/( PLBDAS(:) * PLBDAR(:) ) + &
+ XLBRACCS3/( (PLBDAR(:)**2)) )/PLBDAR(:)**4
+ PRS_TEND(:, IRRACCSS) =ZZW(:)*ZZW6(:)
+ END WHERE
+ !
+ ! 5.2.4b perform the bilinear interpolation of the normalized
+ ! RACCS-kernel
+ !
+ DO JJ = 1, IGACC
+ ZVEC3(JJ) = ( XKER_RACCS(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_RACCS(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * ZVEC1(JJ) &
+ - ( XKER_RACCS(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_RACCS(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * (ZVEC1(JJ) - 1.0)
+ END DO
+ ZZW(:) = 0.
+ DO JJ = 1, IGACC
+ ZZW(I1(JJ)) = ZVEC3(JJ)
+ END DO
+ WHERE(GACC(:))
+ PRS_TEND(:, IRRACCS) = ZZW(:)*ZZW6(:)
+ END WHERE
+ ! 5.2.5 perform the bilinear interpolation of the normalized
+ ! SACCRG-kernel
+ !
+ DO JJ = 1, IGACC
+ ZVEC3(JJ) = ( XKER_SACCRG(IVEC2(JJ)+1,IVEC1(JJ)+1)* ZVEC1(JJ) &
+ - XKER_SACCRG(IVEC2(JJ)+1,IVEC1(JJ) )*(ZVEC1(JJ) - 1.0) ) &
+ * ZVEC2(JJ) &
+ - ( XKER_SACCRG(IVEC2(JJ) ,IVEC1(JJ)+1)* ZVEC1(JJ) &
+ - XKER_SACCRG(IVEC2(JJ) ,IVEC1(JJ) )*(ZVEC1(JJ) - 1.0) ) &
+ * (ZVEC2(JJ) - 1.0)
+ END DO
+ ZZW(:) = 0.
+ DO JJ = 1, IGACC
+ ZZW(I1(JJ)) = ZVEC3(JJ)
+ END DO
+ !
+ ! 5.2.6 raindrop accretion-conversion of the large sized aggregates
+ ! into graupeln
+ !
+ WHERE(GACC(:))
+ PRS_TEND(:, IRSACCRG) = XFSACCRG*ZZW(:)* & ! RSACCRG
+ ( PLBDAS(:)**(XCXS-XBS) )*( PRHODREF(:)**(-XCEXVT-1.) ) &
+ *( XLBSACCR1/((PLBDAR(:)**2) ) + &
+ XLBSACCR2/( PLBDAR(:) * PLBDAS(:) ) + &
+ XLBSACCR3/( (PLBDAS(:)**2)) )/PLBDAR(:)
+ END WHERE
+ ENDIF
+ENDIF
+!
+DO JL=1, KSIZE
+ ! More restrictive ACC mask to be used for accretion by negative temperature only
+ ZACC(JL) = ZACC(JL) * &
+ &MAX(0., -SIGN(1., PT(JL)-XTT)) ! WHERE(PT(:)<XTT)
+ PRRACCSS(JL)=ZACC(JL)*MIN(ZFREEZ_RATE(JL), PRS_TEND(JL, IRRACCSS))
+ ZFREEZ_RATE(JL)=MAX(0., ZFREEZ_RATE(JL)-PRRACCSS(JL))
+ ZZW(JL) = MIN(1., ZFREEZ_RATE(JL) / MAX(1.E-20, PRS_TEND(JL, IRRACCS)-PRRACCSS(JL))) ! proportion we are able to freeze
+ PRRACCSG(JL)=ZACC(JL)*ZZW(JL) * MAX(0., PRS_TEND(JL, IRRACCS)-PRRACCSS(JL))
+ ZFREEZ_RATE(JL) = MAX(0., ZFREEZ_RATE(JL)-PRRACCSG(JL))
+ PRSACCRG(JL)=ZACC(JL)*ZZW(JL) * PRS_TEND(JL, IRSACCRG)
+
+ PRSACCRG(JL) = PRSACCRG(JL) * MAX(0., -SIGN(1., -PRRACCSG(JL)))
+ PRRACCSG(JL)=MAX(0., PRRACCSG(JL))
+
+ PA_RR(JL) = PA_RR(JL) - PRRACCSS(JL)
+ PA_RS(JL) = PA_RS(JL) + PRRACCSS(JL)
+ PA_TH(JL) = PA_TH(JL) + PRRACCSS(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ PA_RR(JL) = PA_RR(JL) - PRRACCSG(JL)
+ PA_RS(JL) = PA_RS(JL) - PRSACCRG(JL)
+ PA_RG(JL) = PA_RG(JL) + PRRACCSG(JL)+PRSACCRG(JL)
+ PA_TH(JL) = PA_TH(JL) + PRRACCSG(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ENDDO
+!
+!
+!* 5.3 Conversion-Melting of the aggregates
+!
+DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(5)-PRST(JL))) * & ! WHERE(PRST(:)>XRTMIN(5))
+ &MAX(0., -SIGN(1., XTT-PT(JL))) * & ! WHERE(PT(:)>XTT)
+ &PCOMPUTE(JL)
+ENDDO
+IF(LDSOFT) THEN
+ DO JL=1, KSIZE
+ PRSMLTG(JL)=ZMASK(JL)*PRSMLTG(JL)
+ PRCMLTSR(JL)=ZMASK(JL)*PRCMLTSR(JL)
+ ENDDO
+ELSE
+ DO JL=1, KSIZE
+ PRSMLTG(JL)=ZMASK(JL)*PRVT(JL)*PPRES(JL)/(XEPSILO+PRVT(JL)) ! Vapor pressure
+ ENDDO
+ IF(LEVLIMIT) THEN
+ WHERE(ZMASK(:)==1.)
+ PRSMLTG(:)=MIN(PRSMLTG(:), EXP(XALPW-XBETAW/PT(:)-XGAMW*ALOG(PT(:)))) ! min(ev, es_w(T))
+ END WHERE
+ ENDIF
+ DO JL=1, KSIZE
+ PRSMLTG(JL)=ZMASK(JL)*( &
+ & PKA(JL)*(XTT-PT(JL)) + &
+ & ( PDV(JL)*(XLVTT + ( XCPV - XCL ) * ( PT(JL) - XTT )) &
+ & *(XESTT-PRSMLTG(JL))/(XRV*PT(JL)) ) &
+ &)
+ ENDDO
+ PRCMLTSR(:) = 0.
+ WHERE(ZMASK(:)==1.)
+ !
+ ! compute RSMLT
+ !
+ PRSMLTG(:) = XFSCVMG*MAX( 0.0,( -PRSMLTG(:) * &
+ ( X0DEPS* PLBDAS(:)**XEX0DEPS + &
+ X1DEPS*PCJ(:)*PLBDAS(:)**XEX1DEPS ) - &
+ ( PRS_TEND(:, IRCRIMS) + PRS_TEND(:, IRRACCS) ) * &
+ ( PRHODREF(:)*XCL*(XTT-PT(:))) ) / &
+ ( PRHODREF(:)*XLMTT ) )
+ ! When T < XTT, rc is collected by snow (riming) to produce snow and graupel
+ ! When T > XTT, if riming was still enabled, rc would produce snow and graupel with snow becomming graupel (conversion/melting) and graupel becomming rain (melting)
+ ! To insure consistency when crossing T=XTT, rc collected with T>XTT must be transformed in rain.
+ ! rc cannot produce iced species with a positive temperature but is still collected with a good efficiency by snow
+ PRCMLTSR(:) = PRS_TEND(:, IRCRIMS) ! both species are liquid, no heat is exchanged
+ END WHERE
+ENDIF
+DO JL=1, KSIZE
+ ! note that RSCVMG = RSMLT*XFSCVMG but no heat is exchanged (at the rate RSMLT)
+ ! because the graupeln produced by this process are still icy!!!
+ PA_RS(JL) = PA_RS(JL) - PRSMLTG(JL)
+ PA_RG(JL) = PA_RG(JL) + PRSMLTG(JL)
+ PA_RC(JL) = PA_RC(JL) - PRCMLTSR(JL)
+ PA_RR(JL) = PA_RR(JL) + PRCMLTSR(JL)
+ENDDO
+
+!
+END SUBROUTINE ICE4_FAST_RS
diff --git a/src/mesonh/micro/ice4_nucleation.f90 b/src/mesonh/micro/ice4_nucleation.f90
new file mode 100644
index 000000000..98459b317
--- /dev/null
+++ b/src/mesonh/micro/ice4_nucleation.f90
@@ -0,0 +1,152 @@
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+MODULE MODI_ICE4_NUCLEATION
+INTERFACE
+SUBROUTINE ICE4_NUCLEATION(KSIZE, ODSOFT, ODCOMPUTE, &
+ PTHT, PPABST, PRHODREF, PEXN, PLSFACT, PT, &
+ PRVT, &
+ PCIT, PRVHENI_MR, PB_TH, PB_RV, PB_RI)
+IMPLICIT NONE
+INTEGER, INTENT(IN) :: KSIZE
+LOGICAL, INTENT(IN) :: ODSOFT
+LOGICAL, DIMENSION(KSIZE),INTENT(IN) :: ODCOMPUTE
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PTHT ! Theta at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PPABST ! absolute pressure at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PEXN ! Exner function
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature at time t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRVHENI_MR ! Mixing ratio change due to the heterogeneous nucleation
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_TH
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RV
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RI
+END SUBROUTINE ICE4_NUCLEATION
+END INTERFACE
+END MODULE MODI_ICE4_NUCLEATION
+SUBROUTINE ICE4_NUCLEATION(KSIZE, ODSOFT, ODCOMPUTE, &
+ PTHT, PPABST, PRHODREF, PEXN, PLSFACT, PT, &
+ PRVT, &
+ PCIT, PRVHENI_MR, PB_TH, PB_RV, PB_RI)
+!!
+!!** PURPOSE
+!! -------
+!! Computes the nucleation
+!!
+!! AUTHOR
+!! ------
+!! S. Riette from the splitting of rain_ice source code (nov. 2014)
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY: XALPI,XALPW,XBETAI,XBETAW,XGAMI,XGAMW,XMD,XMV,XTT,XEPSILO
+USE MODD_PARAM_ICE, ONLY: LFEEDBACKT
+USE MODD_RAIN_ICE_PARAM, ONLY: XALPHA1,XALPHA2,XBETA1,XBETA2,XMNU0,XNU10,XNU20
+USE MODD_RAIN_ICE_DESCR, ONLY: XRTMIN
+!
+USE MODE_MPPDB
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KSIZE
+LOGICAL, INTENT(IN) :: ODSOFT
+LOGICAL, DIMENSION(KSIZE),INTENT(IN) :: ODCOMPUTE
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PTHT ! Theta at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PPABST ! absolute pressure at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PEXN ! Exner function
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature at time t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRVHENI_MR ! Mixing ratio change due to the heterogeneous nucleation
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_TH
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RV
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RI
+!
+!* 0.2 declaration of local variables
+!
+REAL, DIMENSION(KSIZE) :: ZW ! work array
+LOGICAL, DIMENSION(KSIZE) :: GNEGT ! Test where to compute the HEN process
+REAL, DIMENSION(KSIZE) :: ZZW, & ! Work array
+ ZUSW, & ! Undersaturation over water
+ ZSSI ! Supersaturation over ice
+!-------------------------------------------------------------------------------
+!
+!
+PRVHENI_MR(:)=0.
+IF(.NOT. ODSOFT) THEN
+ GNEGT(:)=PT(:)<XTT .AND. PRVT>XRTMIN(1) .AND. ODCOMPUTE(:)
+ PRVHENI_MR(:)=0.
+ ZSSI(:)=0.
+ ZUSW(:)=0.
+ ZZW(:)=0.
+ WHERE(GNEGT(:))
+ ZZW(:)=ALOG(PT(:))
+ ZUSW(:)=EXP(XALPW - XBETAW/PT(:) - XGAMW*ZZW(:)) ! es_w
+ ZZW(:)=EXP(XALPI - XBETAI/PT(:) - XGAMI*ZZW(:)) ! es_i
+ END WHERE
+ WHERE(GNEGT(:))
+ ZZW(:)=MIN(PPABST(:)/2., ZZW(:)) ! safety limitation
+ ZSSI(:)=PRVT(:)*(PPABST(:)-ZZW(:)) / (XEPSILO*ZZW(:)) - 1.0
+ ! Supersaturation over ice
+ ZUSW(:)=MIN(PPABST(:)/2., ZUSW(:)) ! safety limitation
+ ZUSW(:)=(ZUSW(:)/ZZW(:))*((PPABST(:)-ZZW(:))/(PPABST(:)-ZUSW(:))) - 1.0
+ ! Supersaturation of saturated water vapor over ice
+ !
+ !* 3.1 compute the heterogeneous nucleation source RVHENI
+ !
+ !* 3.1.1 compute the cloud ice concentration
+ !
+ ZSSI(:)=MIN(ZSSI(:), ZUSW(:)) ! limitation of SSi according to SSw=0
+ END WHERE
+ ZZW(:)=0.
+ WHERE(GNEGT(:) .AND. PT(:)<XTT-5.0 .AND. ZSSI(:)>0.0 )
+ ZZW(:)=XNU20*EXP(XALPHA2*ZSSI(:)-XBETA2)
+ ELSEWHERE(GNEGT(:) .AND. PT(:)<=XTT-2.0 .AND. PT(:)>=XTT-5.0 .AND. ZSSI(:)>0.0)
+ ZZW(:)=MAX(XNU20*EXP(-XBETA2 ), &
+ XNU10*EXP(-XBETA1*(PT(:)-XTT))*(ZSSI(:)/ZUSW(:))**XALPHA1)
+ END WHERE
+ WHERE(GNEGT(:))
+ ZZW(:)=ZZW(:)-PCIT(:)
+ ZZW(:)=MIN(ZZW(:), 50.E3) ! limitation provisoire a 50 l^-1
+ END WHERE
+ WHERE(GNEGT(:))
+ !
+ !* 3.1.2 update the r_i and r_v mixing ratios
+ !
+ PRVHENI_MR(:)=MAX(ZZW(:), 0.0)*XMNU0/PRHODREF(:)
+ PRVHENI_MR(:)=MIN(PRVT(:), PRVHENI_MR(:))
+ END WHERE
+ !Limitation due to 0 crossing of temperature
+ IF(LFEEDBACKT) THEN
+ ZW(:)=0.
+ WHERE(GNEGT(:))
+ ZW(:)=MIN(PRVHENI_MR(:), &
+ MAX(0., (XTT/PEXN(:)-PTHT(:))/PLSFACT(:))) / &
+ MAX(PRVHENI_MR(:), 1.E-20)
+ END WHERE
+ ELSE
+ ZW(:)=1.
+ ENDIF
+ PRVHENI_MR(:)=PRVHENI_MR(:)*ZW(:)
+ PCIT(:)=MAX(ZZW(:)*ZW(:)+PCIT(:), PCIT(:))
+ !
+ PB_RI(:)=PB_RI(:) + PRVHENI_MR(:)
+ PB_RV(:)=PB_RV(:) - PRVHENI_MR(:)
+ PB_TH(:)=PB_TH(:) + PRVHENI_MR(:)*PLSFACT(:)
+ENDIF
+!
+END SUBROUTINE ICE4_NUCLEATION
diff --git a/src/mesonh/micro/ice4_nucleation_wrapper.f90 b/src/mesonh/micro/ice4_nucleation_wrapper.f90
new file mode 100644
index 000000000..2e08a2cd7
--- /dev/null
+++ b/src/mesonh/micro/ice4_nucleation_wrapper.f90
@@ -0,0 +1,149 @@
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+MODULE MODI_ICE4_NUCLEATION_WRAPPER
+INTERFACE
+SUBROUTINE ICE4_NUCLEATION_WRAPPER(KIT, KJT,KKT, LDMASK, &
+ PTHT, PPABST, PRHODREF, PEXN, PLSFACT, PT, &
+ PRVT, &
+ PCIT, PRVHENI_MR)
+IMPLICIT NONE
+INTEGER, INTENT(IN) :: KIT, KJT, KKT
+LOGICAL, DIMENSION(KIT,KJT,KKT),INTENT(IN) :: LDMASK
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PEXN ! Exner function
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PLSFACT
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PT ! Temperature at time t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PRVHENI_MR ! Mixing ratio change due to the heterogeneous nucleation
+END SUBROUTINE ICE4_NUCLEATION_WRAPPER
+END INTERFACE
+END MODULE MODI_ICE4_NUCLEATION_WRAPPER
+SUBROUTINE ICE4_NUCLEATION_WRAPPER(KIT, KJT, KKT, LDMASK, &
+ PTHT, PPABST, PRHODREF, PEXN, PLSFACT, PT, &
+ PRVT, &
+ PCIT, PRVHENI_MR)
+!!
+!!** PURPOSE
+!! -------
+!! Computes the nucleation
+!!
+!! AUTHOR
+!! ------
+!! S. Riette from the splitting of rain_ice source code (nov. 2014)
+!!
+!! MODIFICATIONS
+!! -------------
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+! P. Wautelet 29/05/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
+!
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY: XTT
+
+use mode_tools, only: Countjv
+
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KIT, KJT, KKT
+LOGICAL, DIMENSION(KIT,KJT,KKT),INTENT(IN) :: LDMASK
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PEXN ! Exner function
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PLSFACT
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PT ! Temperature at time t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PRVHENI_MR ! Mixing ratio change due to the heterogeneous nucleation
+!
+!* 0.2 declaration of local variables
+!
+INTEGER :: IDX, JI, JJ, JK
+INTEGER :: JL
+INTEGER :: INEGT, INEGT_TMP
+INTEGER, DIMENSION(:), ALLOCATABLE :: I1,I2,I3
+LOGICAL :: GDSOFT
+LOGICAL, DIMENSION(:), ALLOCATABLE :: GLDCOMPUTE
+LOGICAL, DIMENSION(KIT,KJT,KKT) :: GNEGT ! Test where to compute the HEN process
+REAL, DIMENSION(:), ALLOCATABLE :: ZZT, & ! Temperature
+ ZPRES, & ! Pressure
+ ZRVT, & ! Water vapor m.r. at t
+ ZCIT, & ! Pristine ice conc. at t
+ ZTHT, & ! Theta at t
+ ZRHODREF, &
+ ZEXN, &
+ ZLSFACT, &
+ ZRVHENI_MR, &
+ ZB_TH, ZB_RV, ZB_RI
+!
+!-------------------------------------------------------------------------------
+!
+!
+!
+! optimization by looking for locations where
+! the temperature is negative only !!!
+!
+GNEGT(:,:,:)=PT(:,:,:)<XTT .AND. LDMASK
+INEGT = COUNT(GNEGT(:,:,:))
+!
+ALLOCATE(GLDCOMPUTE(INEGT))
+ALLOCATE(I1(INEGT),I2(INEGT),I3(INEGT))
+ALLOCATE(ZZT(INEGT))
+ALLOCATE(ZPRES(INEGT))
+ALLOCATE(ZRVT(INEGT))
+ALLOCATE(ZCIT(INEGT))
+ALLOCATE(ZTHT(INEGT))
+ALLOCATE(ZRHODREF(INEGT))
+ALLOCATE(ZEXN(INEGT))
+ALLOCATE(ZLSFACT(INEGT))
+ALLOCATE(ZRVHENI_MR(INEGT))
+ALLOCATE(ZB_TH(INEGT))
+ALLOCATE(ZB_RV(INEGT))
+ALLOCATE(ZB_RI(INEGT))
+!
+IF(INEGT>0) INEGT_TMP=COUNTJV(GNEGT(:,:,:), I1(:), I2(:), I3(:))
+!
+PRVHENI_MR(:,:,:)=0.
+IF(INEGT>0) THEN
+ DO JL=1, INEGT
+ ZRVT(JL)=PRVT(I1(JL), I2(JL), I3(JL))
+ ZCIT(JL)=PCIT(I1(JL), I2(JL), I3(JL))
+ ZZT(JL)=PT(I1(JL), I2(JL), I3(JL))
+ ZPRES(JL)=PPABST(I1(JL), I2(JL), I3(JL))
+ ZTHT(JL)=PTHT(I1(JL), I2(JL), I3(JL))
+ ZRHODREF(JL)=PRHODREF(I1(JL), I2(JL), I3(JL))
+ ZEXN(JL)=PEXN(I1(JL), I2(JL), I3(JL))
+ ZLSFACT(JL)=PLSFACT(I1(JL), I2(JL), I3(JL))
+ ENDDO
+ GDSOFT = .FALSE.
+ GLDCOMPUTE(:) = ZZT(:)<XTT
+ ZB_TH(:) = 0.
+ ZB_RV(:) = 0.
+ ZB_RI(:) = 0.
+ CALL ICE4_NUCLEATION(INEGT, GDSOFT, GLDCOMPUTE, &
+ ZTHT, ZPRES, ZRHODREF, ZEXN, ZLSFACT, ZZT, &
+ ZRVT, &
+ ZCIT, ZRVHENI_MR, ZB_TH, ZB_RV, ZB_RI)
+ PRVHENI_MR(:,:,:)= 0.0
+ DO JL=1, INEGT
+ PRVHENI_MR(I1(JL), I2(JL), I3(JL)) = ZRVHENI_MR(JL)
+ PCIT (I1(JL), I2(JL), I3(JL)) = ZCIT (JL)
+ END DO
+END IF
+!
+DEALLOCATE(GLDCOMPUTE)
+DEALLOCATE(I1,I2,I3)
+DEALLOCATE(ZZT,ZPRES,ZRVT,ZCIT,ZTHT,ZRHODREF,ZEXN,ZLSFACT,ZRVHENI_MR,ZB_TH,ZB_RV,ZB_RI)
+!
+END SUBROUTINE ICE4_NUCLEATION_WRAPPER
diff --git a/src/mesonh/micro/ice4_rainfr_vert.f90 b/src/mesonh/micro/ice4_rainfr_vert.f90
new file mode 100644
index 000000000..6e817fe76
--- /dev/null
+++ b/src/mesonh/micro/ice4_rainfr_vert.f90
@@ -0,0 +1,83 @@
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+MODULE MODI_ICE4_RAINFR_VERT
+INTERFACE
+SUBROUTINE ICE4_RAINFR_VERT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, PPRFR, PRR, PRS, PRG, PRH)
+IMPLICIT NONE
+INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PPRFR !Precipitation fraction
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRR !Rain field
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRS !Snow field
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRG !Graupel field
+REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL,INTENT(IN) :: PRH !Hail field
+END SUBROUTINE ICE4_RAINFR_VERT
+END INTERFACE
+END MODULE MODI_ICE4_RAINFR_VERT
+SUBROUTINE ICE4_RAINFR_VERT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, PPRFR, PRR, PRS, PRG, PRH)
+!!
+!!** PURPOSE
+!! -------
+!! Computes the rain fraction
+!!
+!! AUTHOR
+!! ------
+!! S. Riette from the plitting of rain_ice source code (nov. 2014)
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+! P. Wautelet 13/02/2019: bugfix: intent of PPRFR OUT->INOUT
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_RAIN_ICE_DESCR, ONLY : XRTMIN
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PPRFR !Precipitation fraction
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRR !Rain field
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRS !Snow field
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRG !Graupel field
+REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(IN) :: PRH !Hail field
+!
+!* 0.2 declaration of local variables
+!
+INTEGER :: JI, JJ, JK
+LOGICAL :: MASK
+!
+!-------------------------------------------------------------------------------
+!
+!-------------------------------------------------------------------------------
+DO JI = KIB,KIE
+ DO JJ = KJB, KJE
+ PPRFR(JI,JJ,KKE)=0.
+ DO JK=KKE-KKL, KKB, -KKL
+ IF(PRESENT(PRH)) THEN
+ MASK=PRR(JI,JJ,JK) .GT. XRTMIN(3) .OR. PRS(JI,JJ,JK) .GT. XRTMIN(5) &
+ .OR. PRG(JI,JJ,JK) .GT. XRTMIN(6) .OR. PRH(JI,JJ,JK) .GT. XRTMIN(7)
+ ELSE
+ MASK=PRR(JI,JJ,JK) .GT. XRTMIN(3) .OR. PRS(JI,JJ,JK) .GT. XRTMIN(5) &
+ .OR. PRG(JI,JJ,JK) .GT. XRTMIN(6)
+ END IF
+ IF (MASK) THEN
+ PPRFR(JI,JJ,JK)=MAX(PPRFR(JI,JJ,JK),PPRFR(JI,JJ,JK+KKL))
+ IF (PPRFR(JI,JJ,JK)==0) THEN
+ PPRFR(JI,JJ,JK)=1.
+ END IF
+ ELSE
+ PPRFR(JI,JJ,JK)=0.
+ END IF
+ END DO
+ END DO
+END DO
+!
+!
+END SUBROUTINE ICE4_RAINFR_VERT
diff --git a/src/mesonh/micro/ice4_rimltc.f90 b/src/mesonh/micro/ice4_rimltc.f90
new file mode 100644
index 000000000..fc4e12986
--- /dev/null
+++ b/src/mesonh/micro/ice4_rimltc.f90
@@ -0,0 +1,105 @@
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+MODULE MODI_ICE4_RIMLTC
+INTERFACE
+SUBROUTINE ICE4_RIMLTC(KSIZE, LDSOFT, PCOMPUTE, &
+ &PEXN, PLVFACT, PLSFACT, &
+ &PT, &
+ &PTHT, PRIT, &
+ &PRIMLTC_MR, PB_TH, PB_RC, PB_RI)
+IMPLICIT NONE
+INTEGER, INTENT(IN) :: KSIZE
+LOGICAL, INTENT(IN) :: LDSOFT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PEXN ! Exner function
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT ! L_v/(Pi_ref*C_ph)
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT ! L_s/(Pi_ref*C_ph)
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PTHT ! Theta at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Cloud ice at t
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIMLTC_MR ! Mixing ratio change due to cloud ice melting
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_TH
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RC
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RI
+END SUBROUTINE ICE4_RIMLTC
+END INTERFACE
+END MODULE MODI_ICE4_RIMLTC
+SUBROUTINE ICE4_RIMLTC(KSIZE, LDSOFT, PCOMPUTE, &
+ &PEXN, PLVFACT, PLSFACT, &
+ &PT, &
+ &PTHT, PRIT, &
+ &PRIMLTC_MR, PB_TH, PB_RC, PB_RI)
+!!
+!!** PURPOSE
+!! -------
+!! Computes the RIMLTC process
+!!
+!! AUTHOR
+!! ------
+!! S. Riette from the splitting of rain_ice source code (nov. 2014)
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY: XTT
+USE MODD_PARAM_ICE, ONLY: LFEEDBACKT
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KSIZE
+LOGICAL, INTENT(IN) :: LDSOFT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PEXN ! Exner function
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT ! L_v/(Pi_ref*C_ph)
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT ! L_s/(Pi_ref*C_ph)
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PTHT ! Theta at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Cloud ice at t
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIMLTC_MR ! Mixing ratio change due to cloud ice melting
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_TH
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RC
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RI
+!
+!* 0.2 declaration of local variables
+!
+REAL, DIMENSION(KSIZE) :: ZMASK
+INTEGER :: JL
+!
+!-------------------------------------------------------------------------------
+!
+!* 7.1 cloud ice melting
+!
+PRIMLTC_MR(:)=0.
+IF(.NOT. LDSOFT) THEN
+ DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., -PRIT(JL))) * & ! PRIT(:)>0.
+ &MAX(0., -SIGN(1., XTT-PT(JL))) * & ! PT(:)>XTT
+ &PCOMPUTE(JL)
+ PRIMLTC_MR(JL)=PRIT(JL) * ZMASK(JL)
+ ENDDO
+
+ IF(LFEEDBACKT) THEN
+ !Limitation due to 0 crossing of temperature
+ DO JL=1, KSIZE
+ PRIMLTC_MR(JL)=MIN(PRIMLTC_MR(JL), MAX(0., (PTHT(JL)-XTT/PEXN(JL)) / (PLSFACT(JL)-PLVFACT(JL))))
+ ENDDO
+ ENDIF
+ENDIF
+DO JL=1, KSIZE
+ PB_RC(JL) = PB_RC(JL) + PRIMLTC_MR(JL)
+ PB_RI(JL) = PB_RI(JL) - PRIMLTC_MR(JL)
+ PB_TH(JL) = PB_TH(JL) - PRIMLTC_MR(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ENDDO
+!
+!
+END SUBROUTINE ICE4_RIMLTC
diff --git a/src/mesonh/micro/ice4_rrhong.f90 b/src/mesonh/micro/ice4_rrhong.f90
new file mode 100644
index 000000000..da2648947
--- /dev/null
+++ b/src/mesonh/micro/ice4_rrhong.f90
@@ -0,0 +1,105 @@
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+MODULE MODI_ICE4_RRHONG
+INTERFACE
+SUBROUTINE ICE4_RRHONG(KSIZE, LDSOFT, PCOMPUTE, &
+ &PEXN, PLVFACT, PLSFACT, &
+ &PT, PRRT, &
+ &PTHT, &
+ &PRRHONG_MR, PB_TH, PB_RR, PB_RG)
+IMPLICIT NONE
+INTEGER, INTENT(IN) :: KSIZE
+LOGICAL, INTENT(IN) :: LDSOFT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PEXN ! Exner function
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT ! L_v/(Pi_ref*C_ph)
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT ! L_s/(Pi_ref*C_ph)
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PTHT ! Theta at t
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRHONG_MR ! Mixing ratio change due to spontaneous freezing
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_TH
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RR
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RG
+END SUBROUTINE ICE4_RRHONG
+END INTERFACE
+END MODULE MODI_ICE4_RRHONG
+SUBROUTINE ICE4_RRHONG(KSIZE, LDSOFT, PCOMPUTE, &
+ &PEXN, PLVFACT, PLSFACT, &
+ &PT, PRRT, &
+ &PTHT, &
+ &PRRHONG_MR, PB_TH, PB_RR, PB_RG)
+!!
+!!** PURPOSE
+!! -------
+!! Computes the RRHONG process
+!!
+!! AUTHOR
+!! ------
+!! S. Riette from the splitting of rain_ice source code (nov. 2014)
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY: XTT
+USE MODD_RAIN_ICE_DESCR, ONLY: XRTMIN
+USE MODD_PARAM_ICE, ONLY: LFEEDBACKT
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KSIZE
+LOGICAL, INTENT(IN) :: LDSOFT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PEXN ! Exner function
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT ! L_v/(Pi_ref*C_ph)
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT ! L_s/(Pi_ref*C_ph)
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PTHT ! Theta at t
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRHONG_MR ! Mixing ratio change due to spontaneous freezing
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_TH
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RR
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RG
+!
+!* 0.2 declaration of local variables
+!
+REAL, DIMENSION(KSIZE) :: ZMASK
+INTEGER :: JL
+!
+!-------------------------------------------------------------------------------
+!
+!* 3.3 compute the spontaneous freezing source: RRHONG
+!
+PRRHONG_MR(:) = 0.
+IF(.NOT. LDSOFT) THEN
+ DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., PT(JL)-(XTT-35.0))) * & ! PT(:)<XTT-35.0
+ &MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JL))) * & ! PRRT(:)>XRTMIN(3)
+ &PCOMPUTE(JL)
+ PRRHONG_MR(JL)=PRRT(JL) * ZMASK(JL)
+ ENDDO
+ IF(LFEEDBACKT) THEN
+ !Limitation due to -35 crossing of temperature
+ DO JL=1, KSIZE
+ PRRHONG_MR(JL)=MIN(PRRHONG_MR(JL), MAX(0., ((XTT-35.)/PEXN(JL)-PTHT(JL))/(PLSFACT(JL)-PLVFACT(JL))))
+ ENDDO
+ ENDIF
+ENDIF
+DO JL=1, KSIZE
+ PB_RG(JL) = PB_RG(JL) + PRRHONG_MR(JL)
+ PB_RR(JL) = PB_RR(JL) - PRRHONG_MR(JL)
+ PB_TH(JL) = PB_TH(JL) + PRRHONG_MR(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ENDDO
+!
+!
+END SUBROUTINE ICE4_RRHONG
diff --git a/src/mesonh/micro/ice4_rsrimcg_old.f90 b/src/mesonh/micro/ice4_rsrimcg_old.f90
new file mode 100644
index 000000000..cf88792b1
--- /dev/null
+++ b/src/mesonh/micro/ice4_rsrimcg_old.f90
@@ -0,0 +1,144 @@
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+MODULE MODI_ICE4_RSRIMCG_OLD
+INTERFACE
+SUBROUTINE ICE4_RSRIMCG_OLD(KSIZE, ODSOFT, ODCOMPUTE, &
+ &PRHODREF, &
+ &PLBDAS, &
+ &PT, PRCT, PRST, &
+ &PRSRIMCG_MR, PB_RS, PB_RG)
+IMPLICIT NONE
+INTEGER, INTENT(IN) :: KSIZE
+LOGICAL, INTENT(IN) :: ODSOFT
+LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: ODCOMPUTE
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAS ! Slope parameter of the aggregate distribution
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSRIMCG_MR ! Mr change due to cloud droplet riming of the aggregates
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RS
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RG
+END SUBROUTINE ICE4_RSRIMCG_OLD
+END INTERFACE
+END MODULE MODI_ICE4_RSRIMCG_OLD
+SUBROUTINE ICE4_RSRIMCG_OLD(KSIZE, ODSOFT, ODCOMPUTE, &
+ &PRHODREF, &
+ &PLBDAS, &
+ &PT, PRCT, PRST, &
+ &PRSRIMCG_MR, PB_RS, PB_RG)
+!!
+!!** PURPOSE
+!! -------
+!! Computes the riming-conversion of the large sized aggregates into graupel
+!!
+!! AUTHOR
+!! ------
+!! S. Riette from the splitting of rain_ice source code (nov. 2014)
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 29/05/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY: XTT
+USE MODD_PARAM_ICE, ONLY: CSNOWRIMING
+USE MODD_RAIN_ICE_DESCR, ONLY: XRTMIN
+USE MODD_RAIN_ICE_PARAM, ONLY: NGAMINC,XEXSRIMCG,XGAMINC_RIM2,XRIMINTP1,XRIMINTP2,XSRIMCG
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KSIZE
+LOGICAL, INTENT(IN) :: ODSOFT
+LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: ODCOMPUTE
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAS ! Slope parameter of the aggregate distribution
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSRIMCG_MR ! Mr change due to cloud droplet riming of the aggregates
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RS
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RG
+!
+!* 0.2 declaration of local variables
+!
+LOGICAL, DIMENSION(KSIZE) :: GRIM
+INTEGER :: IGRIM
+REAL, DIMENSION(KSIZE) :: ZVEC1, ZVEC2
+INTEGER, DIMENSION(KSIZE) :: IVEC2, IVEC1
+REAL, DIMENSION(KSIZE) :: ZZW
+INTEGER :: JL
+!-------------------------------------------------------------------------------
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 5.1 cloud droplet riming of the aggregates
+!
+PRSRIMCG_MR(:)=0.
+!
+IF(.NOT. ODSOFT) THEN
+ IGRIM = 0
+ GRIM(:) = .FALSE.
+ DO JL = 1, SIZE(GRIM)
+ IF ( PRCT(JL)>XRTMIN(2) .AND. PRST(JL)>XRTMIN(5) .AND. ODCOMPUTE(JL) .AND. PT(JL)<XTT ) THEN
+ IGRIM = IGRIM + 1
+ IVEC1(IGRIM) = Jl
+ GRIM(JL) = .TRUE.
+ END IF
+ END DO
+ !
+ IF(IGRIM>0) THEN
+ !
+ ! 5.1.1 select the PLBDAS
+ !
+ DO JL = 1, IGRIM
+ ZVEC1(JL) = PLBDAS(IVEC1(JL))
+ END DO
+ !
+ ! 5.1.2 find the next lower indice for the PLBDAS in the geometrical
+ ! set of Lbda_s used to tabulate some moments of the incomplete
+ ! gamma function
+ !
+ ZVEC2(1:IGRIM) = MAX( 1.00001, MIN( REAL(NGAMINC)-0.00001, &
+ XRIMINTP1 * LOG( ZVEC1(1:IGRIM) ) + XRIMINTP2 ) )
+ IVEC2(1:IGRIM) = INT( ZVEC2(1:IGRIM) )
+ ZVEC2(1:IGRIM) = ZVEC2(1:IGRIM) - REAL( IVEC2(1:IGRIM) )
+
+ !
+ ! 5.1.5 perform the linear interpolation of the normalized
+ ! "XBS"-moment of the incomplete gamma function (XGAMINC_RIM2)
+ !
+ ZVEC1(1:IGRIM) = XGAMINC_RIM2( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) &
+ - XGAMINC_RIM2( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0)
+ ZZW(:) = 0.
+ DO JL = 1, IGRIM
+ ZZW(IVEC1(JL)) = ZVEC1(JL)
+ END DO
+
+ !
+ ! 5.1.6 riming-conversion of the large sized aggregates into graupeln
+ !
+ !
+ WHERE(GRIM(:))
+ PRSRIMCG_MR(:) = XSRIMCG * PLBDAS(:)**XEXSRIMCG & ! RSRIMCG
+ * (1.0 - ZZW(:) )/PRHODREF(:)
+ PRSRIMCG_MR(:)=MIN(PRST(:), PRSRIMCG_MR(:))
+ END WHERE
+ END IF
+ENDIF
+PB_RS(:) = PB_RS(:) - PRSRIMCG_MR(:)
+PB_RG(:) = PB_RG(:) + PRSRIMCG_MR(:)
+!
+!
+END SUBROUTINE ICE4_RSRIMCG_OLD
diff --git a/src/mesonh/micro/ice4_sedimentation_split.f90 b/src/mesonh/micro/ice4_sedimentation_split.f90
new file mode 100644
index 000000000..cb0a147d0
--- /dev/null
+++ b/src/mesonh/micro/ice4_sedimentation_split.f90
@@ -0,0 +1,494 @@
+!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+MODULE MODI_ICE4_SEDIMENTATION_SPLIT
+INTERFACE
+SUBROUTINE ICE4_SEDIMENTATION_SPLIT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL, &
+ &PTSTEP, KRR, OSEDIC, ODEPOSC, PVDEPOSC, PDZZ, &
+ &PRHODREF, PPABST, PTHT, PRHODJ, &
+ &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
+ &PINPRC, PINDEP, PINPRR, PINPRI, PINPRS, PINPRG, &
+ &PSEA, PTOWN, &
+ &PINPRH, PRHT, PRHS, PFPR)
+IMPLICIT NONE
+INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT
+INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
+REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
+INTEGER, INTENT(IN) :: KRR ! Number of moist variable
+LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
+LOGICAL, INTENT(IN) :: ODEPOSC ! Switch for droplet depos.
+REAL, INTENT(IN) :: PVDEPOSC! Droplet deposition velocity
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRC ! Cloud instant precip
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINDEP ! Cloud instant deposition
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRR ! Rain instant precip
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRI ! Pristine ice instant precip
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRS ! Snow instant precip
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRG ! Graupel instant precip
+REAL, DIMENSION(KIT,KJT), OPTIONAL,INTENT(IN) :: PSEA ! Sea Mask
+REAL, DIMENSION(KIT,KJT), OPTIONAL,INTENT(IN) :: PTOWN ! Fraction that is town
+REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(OUT) :: PINPRH ! Hail instant precip
+REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
+REAL, DIMENSION(KIT,KJT,KKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
+END SUBROUTINE ICE4_SEDIMENTATION_SPLIT
+END INTERFACE
+END MODULE MODI_ICE4_SEDIMENTATION_SPLIT
+SUBROUTINE ICE4_SEDIMENTATION_SPLIT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL, &
+ &PTSTEP, KRR, OSEDIC, ODEPOSC, PVDEPOSC, PDZZ, &
+ &PRHODREF, PPABST, PTHT, PRHODJ, &
+ &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
+ &PINPRC, PINDEP, PINPRR, PINPRI, PINPRS, PINPRG, &
+ &PSEA, PTOWN, &
+ &PINPRH, PRHT, PRHS, PFPR)
+!!
+!!** PURPOSE
+!! -------
+!! Computes the sedimentation
+!!
+!! AUTHOR
+!! ------
+!! S. Riette from the plitting of rain_ice source code (nov. 2014)
+!! and modified for optimisation
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+! P. Wautelet 11/02/2019: dimensions of PINPRC and PINDEP not necessarily KIT,KJT
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY: XRHOLW
+USE MODD_PARAM_ICE, ONLY: XSPLIT_MAXCFL
+USE MODD_RAIN_ICE_DESCR, ONLY: XALPHAC,XALPHAC2,XCONC_LAND,XCONC_SEA,XCONC_URBAN,XLBC,XNUC,XNUC2
+USE MODD_RAIN_ICE_PARAM, ONLY: XFSEDC
+!
+USE MODE_MSG
+!
+USE MODI_GAMMA
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT
+INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
+REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
+INTEGER, INTENT(IN) :: KRR ! Number of moist variable
+LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
+LOGICAL, INTENT(IN) :: ODEPOSC ! Switch for droplet depos.
+REAL, INTENT(IN) :: PVDEPOSC! Droplet deposition velocity
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRC ! Cloud instant precip
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINDEP ! Cloud instant deposition
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRR ! Rain instant precip
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRI ! Pristine ice instant precip
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRS ! Snow instant precip
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRG ! Graupel instant precip
+REAL, DIMENSION(KIT,KJT), OPTIONAL,INTENT(IN) :: PSEA ! Sea Mask
+REAL, DIMENSION(KIT,KJT), OPTIONAL,INTENT(IN) :: PTOWN ! Fraction that is town
+REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(OUT) :: PINPRH ! Hail instant precip
+REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
+REAL, DIMENSION(KIT,KJT,KKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
+!
+!* 0.2 declaration of local variables
+!
+!
+INTEGER :: JI,JJ,JK
+INTEGER :: IRR !Workaround of PGI bug with OpenACC (at least up to 18.10 version)
+LOGICAL :: GDEPOSC, GSEDIC !Workaround of PGI bug with OpenACC (at least up to 18.10 version)
+LOGICAL :: GPRESENT_PFPR, GPRESENT_PSEA
+REAL :: ZINVTSTEP
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2)) :: ZCONC_TMP ! Weighted concentration
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),KKTB:KKTE) :: ZW ! work array
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: ZCONC3D, & ! droplet condensation
+ & ZRAY, & ! Cloud Mean radius
+ & ZLBC, & ! XLBC weighted by sea fraction
+ & ZFSEDC, &
+ & ZPRCS,ZPRRS,ZPRIS,ZPRSS,ZPRGS,ZPRHS, & ! Mixing ratios created during the time step
+ & ZRCT, &
+ & ZRRT, &
+ & ZRIT, &
+ & ZRST, &
+ & ZRGT, &
+ & ZRHT
+!
+!-------------------------------------------------------------------------------
+!
+!-------------------------------------------------------------------------------
+!
+!
+GDEPOSC = ODEPOSC
+GSEDIC = OSEDIC
+IRR = KRR
+!
+IF (PRESENT(PFPR)) THEN
+ GPRESENT_PFPR = .TRUE.
+ELSE
+ GPRESENT_PFPR = .FALSE.
+END IF
+!
+IF (PRESENT(PSEA)) THEN
+ GPRESENT_PSEA = .TRUE.
+ELSE
+ GPRESENT_PSEA = .FALSE.
+END IF
+!
+! O. Initialization of for sedimentation
+!
+ZINVTSTEP=1./PTSTEP
+IF (GPRESENT_PFPR) THEN
+ PFPR(:,:,:,:) = 0.
+END IF
+!
+!* 1. Parameters for cloud sedimentation
+!
+IF (GSEDIC) THEN
+ ZRAY(:,:,:) = 0.
+ ZLBC(:,:,:) = XLBC(1)
+ ZFSEDC(:,:,:) = XFSEDC(1)
+ ZCONC3D(:,:,:)= XCONC_LAND
+ ZCONC_TMP(:,:)= XCONC_LAND
+ IF (GPRESENT_PSEA) THEN
+ ZCONC_TMP(:,:)=PSEA(:,:)*XCONC_SEA+(1.-PSEA(:,:))*XCONC_LAND
+ DO JK=KKTB, KKTE
+ ZLBC(:,:,JK) = PSEA(:,:)*XLBC(2)+(1.-PSEA(:,:))*XLBC(1)
+ ZFSEDC(:,:,JK) = (PSEA(:,:)*XFSEDC(2)+(1.-PSEA(:,:))*XFSEDC(1))
+ ZFSEDC(:,:,JK) = MAX(MIN(XFSEDC(1),XFSEDC(2)),ZFSEDC(:,:,JK))
+ ZCONC3D(:,:,JK)= (1.-PTOWN(:,:))*ZCONC_TMP(:,:)+PTOWN(:,:)*XCONC_URBAN
+ ZRAY(:,:,JK) = 0.5*((1.-PSEA(:,:))*GAMMA(XNUC+1.0/XALPHAC)/(GAMMA(XNUC)) + &
+ PSEA(:,:)*GAMMA(XNUC2+1.0/XALPHAC2)/(GAMMA(XNUC2)))
+ END DO
+ ELSE
+ ZCONC3D(:,:,:) = XCONC_LAND
+ ZRAY(:,:,:) = 0.5*(GAMMA(XNUC+1.0/XALPHAC)/(GAMMA(XNUC)))
+ END IF
+ ZRAY(:,:,:) = MAX(1.,ZRAY(:,:,:))
+ ZLBC(:,:,:) = MAX(MIN(XLBC(1),XLBC(2)),ZLBC(:,:,:))
+ENDIF
+!
+!* 2. compute the fluxes
+!
+! optimization by looking for locations where
+! the precipitating fields are larger than a minimal value only !!!
+! For optimization we consider each variable separately
+!
+! External tendecies
+IF (GSEDIC) THEN
+ ZPRCS(:,:,:) = PRCS(:,:,:)-PRCT(:,:,:)*ZINVTSTEP
+ENDIF
+ZPRRS(:,:,:) = PRRS(:,:,:)-PRRT(:,:,:)*ZINVTSTEP
+ZPRIS(:,:,:) = PRIS(:,:,:)-PRIT(:,:,:)*ZINVTSTEP
+ZPRSS(:,:,:) = PRSS(:,:,:)-PRST(:,:,:)*ZINVTSTEP
+ZPRGS(:,:,:) = PRGS(:,:,:)-PRGT(:,:,:)*ZINVTSTEP
+IF ( IRR == 7 ) THEN
+ ZPRHS(:,:,:) = PRHS(:,:,:)-PRHT(:,:,:)*ZINVTSTEP
+END IF
+!
+! mr values inside the time-splitting loop
+ZRCT(:,:,:) = PRCT(:,:,:)
+ZRRT(:,:,:) = PRRT(:,:,:)
+ZRIT(:,:,:) = PRIT(:,:,:)
+ZRST(:,:,:) = PRST(:,:,:)
+ZRGT(:,:,:) = PRGT(:,:,:)
+IF (IRR==7) THEN
+ ZRHT(:,:,:) = PRHT(:,:,:)
+END IF
+!
+ZW(:,:,KKTB:KKTE) =1./(PRHODREF(:,:,KKTB:KKTE)* PDZZ(:,:,KKTB:KKTE))
+!
+!
+!* 2.1 for cloud
+!
+IF (GSEDIC) THEN
+ CALL INTERNAL_SEDIM_SPLI(KIB,KIE,KIT,KJB,KJE,KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
+ &XSPLIT_MAXCFL, &
+ &PRHODREF, ZW, PDZZ, PPABST, PTHT, PTSTEP, &
+ &2, &
+ &ZRCT, PRCS, PINPRC, ZPRCS, &
+ &ZRAY, ZLBC, ZFSEDC, ZCONC3D, PFPR=PFPR)
+ENDIF
+!
+!
+!* 2.1bis DROPLET DEPOSITION AT THE 1ST LEVEL ABOVE GROUND
+!
+IF (GDEPOSC) THEN
+ PINDEP (:,:) = 0.
+ DO JJ=KJB,KJE
+ DO JI=KIB,KIE
+ IF (PRCS(JI,JJ,KKB)>0.) THEN
+ PRCS(JI,JJ,KKB) = PRCS(JI,JJ,KKB) - PVDEPOSC * PRCT(JI,JJ,KKB) / PDZZ(JI,JJ,KKB)
+ PINPRC(JI,JJ) = PINPRC(JI,JJ) + PVDEPOSC * PRCT(JI,JJ,KKB) * PRHODREF(JI,JJ,KKB) /XRHOLW
+ PINDEP(JI,JJ) = PVDEPOSC * PRCT(JI,JJ,KKB) * PRHODREF(JI,JJ,KKB) /XRHOLW
+ END IF
+ END DO
+ END DO
+END IF
+!
+!* 2.2 for rain
+!
+ CALL INTERNAL_SEDIM_SPLI(KIB,KIE,KIT,KJB,KJE,KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
+ &XSPLIT_MAXCFL, &
+ &PRHODREF, ZW, PDZZ, PPABST, PTHT, PTSTEP, &
+ &3, &
+ &ZRRT, PRRS, PINPRR, ZPRRS, &
+ PFPR=PFPR)
+!
+!* 2.3 for pristine ice
+!
+ CALL INTERNAL_SEDIM_SPLI(KIB,KIE,KIT,KJB,KJE,KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
+ &XSPLIT_MAXCFL, &
+ &PRHODREF, ZW, PDZZ, PPABST, PTHT, PTSTEP, &
+ &4, &
+ &ZRIT, PRIS, PINPRI, ZPRIS, &
+ PFPR=PFPR)
+!
+!* 2.4 for aggregates/snow
+!
+ CALL INTERNAL_SEDIM_SPLI(KIB,KIE,KIT,KJB,KJE,KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
+ &XSPLIT_MAXCFL, &
+ &PRHODREF, ZW, PDZZ, PPABST, PTHT, PTSTEP, &
+ &5, &
+ &ZRST, PRSS, PINPRS, ZPRSS, &
+ PFPR=PFPR)
+!
+!* 2.5 for graupeln
+!
+ CALL INTERNAL_SEDIM_SPLI(KIB,KIE,KIT,KJB,KJE,KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
+ &XSPLIT_MAXCFL, &
+ &PRHODREF, ZW, PDZZ, PPABST, PTHT, PTSTEP, &
+ &6, &
+ &ZRGT, PRGS, PINPRG, ZPRGS, &
+ PFPR=PFPR)
+!
+!* 2.6 for hail
+!
+IF (IRR==7) THEN
+ CALL INTERNAL_SEDIM_SPLI(KIB,KIE,KIT,KJB,KJE,KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
+ &XSPLIT_MAXCFL, &
+ &PRHODREF, ZW, PDZZ, PPABST, PTHT, PTSTEP, &
+ &7, &
+ &ZRHT, PRHS, PINPRH, ZPRHS, &
+ PFPR=PFPR)
+ENDIF
+!
+!
+CONTAINS
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+SUBROUTINE INTERNAL_SEDIM_SPLI(KIB,KIE,KIT,KJB,KJE,KJT,KKB,KKTB,KKTE,KKT,KKL,KRR, &
+ &PMAXCFL,PRHODREF,POORHODZ,PDZZ,PPABST,PTHT,PTSTEP, &
+ &KSPE,PRXT,PRXS,PINPRX,PPRXS, &
+ &PRAY,PLBC,PFSEDC,PCONC3D,PFPR)
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY: XCPD,XP00,XRD
+USE MODD_RAIN_ICE_DESCR, ONLY: XCC,XCEXVT,XDC,XLBEXC,XRTMIN
+USE MODD_RAIN_ICE_PARAM, ONLY: XEXCSEDI,XEXSEDG,XEXSEDH,XEXSEDR,XEXSEDS,XFSEDG,XFSEDH,XFSEDI,XFSEDR,XFSEDS
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KIB,KIE,KIT, KJB,KJE,KJT, KKB, KKTB, KKTE, KKT, KKL, KRR
+REAL, INTENT(IN) :: PMAXCFL ! maximum CFL allowed
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(KIT,KJT,KKTB:KKTE), INTENT(IN) :: POORHODZ ! One Over (Rhodref times delta Z)
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! layer thikness (m)
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT
+REAL, INTENT(IN) :: PTSTEP ! total timestep
+INTEGER, INTENT(IN) :: KSPE ! 1 for rc, 2 for rr...
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRXT ! mr of specy X
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRXS !Tendency of the specy KSPE
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRX ! instant precip
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPRXS ! external tendencie
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN), OPTIONAL :: PRAY, PLBC, PFSEDC, PCONC3D
+REAL, DIMENSION(KIT,KJT,KKT,KRR), INTENT(INOUT), OPTIONAL :: PFPR ! upper-air precipitation fluxes
+!
+!* 0.2 declaration of local variables
+!
+character(len=10) :: yspe ! String for error message
+INTEGER :: IDX, ISEDIM
+INTEGER :: JI, JJ, JK, JL
+INTEGER, DIMENSION(KIT*KJT*KKT) :: I1,I2,I3 ! Used to replace the COUNT
+LOGICAL :: GPRESENT_PFPR
+REAL :: ZINVTSTEP
+REAL :: ZZWLBDC, ZRAY, ZZT, ZZWLBDA, ZZCC
+REAL :: ZFSED, ZEXSED
+REAL, DIMENSION(KIT, KJT) :: ZMRCHANGE
+REAL, DIMENSION(KIT, KJT) :: ZMAX_TSTEP ! Maximum CFL in column
+REAL, DIMENSION(SIZE(XRTMIN)) :: ZRSMIN
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2)) :: ZREMAINT ! Remaining time until the timestep end
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),0:SIZE(PRHODREF,3)+1) :: ZWSED ! Sedimentation fluxes
+!
+!-------------------------------------------------------------------------------
+IF (KSPE<2 .OR. KSPE>7) CALL PRINT_MSG(NVERB_FATAL,'GEN','INTERNAL_SEDIM_SPLIT','invalid species (KSPE variable)')
+!
+IF (PRESENT(PFPR)) THEN
+ GPRESENT_PFPR = .TRUE.
+ELSE
+ GPRESENT_PFPR = .FALSE.
+END IF
+!
+PINPRX(:,:) = 0.
+ZINVTSTEP=1./PTSTEP
+ZRSMIN(:) = XRTMIN(:) * ZINVTSTEP
+ZREMAINT(:,:) = PTSTEP
+!
+DO WHILE (ANY(ZREMAINT>0.))
+ ISEDIM = 0
+ DO JK = KKTB,KKTE
+ DO JJ = KJB,KJE
+ DO JI = KIB,KIE
+ IF( (PRXT (JI,JJ,JK)>XRTMIN(KSPE) .OR. &
+ PPRXS(JI,JJ,JK)>ZRSMIN(KSPE)) .AND. &
+ ZREMAINT(JI,JJ)>0. ) THEN
+ ISEDIM = ISEDIM + 1
+ IDX = ISEDIM
+ I1(IDX) = JI
+ I2(IDX) = JJ
+ I3(IDX) = JK
+ END IF
+ END DO
+ END DO
+ END DO
+ !
+ !
+ !* 1. Parameters for cloud sedimentation
+ !
+ !
+ !* 2. compute the fluxes
+ !
+ !
+ IF(KSPE==2) THEN
+ !******* for cloud
+ ZWSED(:,:,:) = 0.
+ DO JL=1, ISEDIM
+ JI=I1(JL)
+ JJ=I2(JL)
+ JK=I3(JL)
+ IF(PRXT(JI,JJ,JK)>XRTMIN(KSPE)) THEN
+ ZZWLBDC = PLBC(JI,JJ,JK) * PCONC3D(JI,JJ,JK) / &
+ (PRHODREF(JI,JJ,JK) * PRXT(JI,JJ,JK))
+ ZZWLBDC = ZZWLBDC**XLBEXC
+ ZRAY = PRAY(JI,JJ,JK) / ZZWLBDC
+ ZZT = PTHT(JI,JJ,JK) * (PPABST(JI,JJ,JK)/XP00)**(XRD/XCPD)
+ ZZWLBDA = 6.6E-8*(101325./PPABST(JI,JJ,JK))*(ZZT/293.15)
+ ZZCC = XCC*(1.+1.26*ZZWLBDA/ZRAY)
+ ZWSED(JI, JJ, JK) = PRHODREF(JI,JJ,JK)**(-XCEXVT +1 ) * &
+ ZZWLBDC**(-XDC)*ZZCC*PFSEDC(JI,JJ,JK) * PRXT(JI,JJ,JK)
+ ENDIF
+ ENDDO
+ ELSEIF(KSPE==4) THEN
+ ! ******* for pristine ice
+ ZWSED(:,:,:) = 0.
+ DO JL=1, ISEDIM
+ JI=I1(JL)
+ JJ=I2(JL)
+ JK=I3(JL)
+ IF(PRXT(JI, JJ, JK) .GT. MAX(XRTMIN(4), 1.0E-7)) THEN
+ ZWSED(JI, JJ, JK) = XFSEDI * PRXT(JI, JJ, JK) * &
+ & PRHODREF(JI,JJ,JK)**(1.-XCEXVT) * & ! McF&H
+ & MAX( 0.05E6,-0.15319E6-0.021454E6* &
+ & ALOG(PRHODREF(JI,JJ,JK)*PRXT(JI,JJ,JK)) )**XEXCSEDI
+ ENDIF
+ ENDDO
+ ELSE
+ ! ******* for other species
+ SELECT CASE(KSPE)
+ CASE(3)
+ ZFSED=XFSEDR
+ ZEXSED=XEXSEDR
+ CASE(5)
+ ZFSED=XFSEDS
+ ZEXSED=XEXSEDS
+ CASE(6)
+ ZFSED=XFSEDG
+ ZEXSED=XEXSEDG
+ CASE(7)
+ ZFSED=XFSEDH
+ ZEXSED=XEXSEDH
+ CASE DEFAULT
+ write( yspe, '( I10 )' ) kspe
+ call Print_msg( NVERB_FATAL, 'GEN', 'ICE4_SEDIMENTATION_SPLIT', 'no sedimentation parameter for KSPE='//trim(yspe) )
+ END SELECT
+ !
+ ZWSED(:,:,:) = 0.
+ DO JL=1, ISEDIM
+ JI=I1(JL)
+ JJ=I2(JL)
+ JK=I3(JL)
+ IF(PRXT(JI,JJ,JK)>XRTMIN(KSPE)) THEN
+ ZWSED(JI, JJ, JK) = ZFSED * PRXT(JI, JJ, JK)**ZEXSED &
+ * PRHODREF(JI, JJ, JK)**(ZEXSED-XCEXVT)
+ ENDIF
+ ENDDO
+ ENDIF
+ ZMAX_TSTEP(:,:) = ZREMAINT(:,:)
+ DO JL=1, ISEDIM
+ JI=I1(JL)
+ JJ=I2(JL)
+ JK=I3(JL)
+ IF(PRXT(JI,JJ,JK)>XRTMIN(KSPE) .AND. ZWSED(JI, JJ, JK)>1.E-20) THEN
+ ZMAX_TSTEP(JI, JJ) = MIN(ZMAX_TSTEP(JI, JJ), PMAXCFL * PRHODREF(JI, JJ, JK) * &
+ PRXT(JI, JJ, JK) * PDZZ(JI, JJ, JK) / ZWSED(JI, JJ, JK))
+ ENDIF
+ ENDDO
+ ZREMAINT(:,:) = ZREMAINT(:,:) - ZMAX_TSTEP(:,:)
+ DO JK = KKTB , KKTE
+ ZMRCHANGE(:,:) = ZMAX_TSTEP(:,:) * POORHODZ(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
+ PRXT(:,:,JK) = PRXT(:,:,JK) + ZMRCHANGE(:,:) + PPRXS(:,:,JK) * ZMAX_TSTEP(:,:)
+ PRXS(:,:,JK) = PRXS(:,:,JK) + ZMRCHANGE(:,:) * ZINVTSTEP
+ ENDDO
+ PINPRX(:,:) = PINPRX(:,:) + ZWSED(:,:,KKB) / XRHOLW * (ZMAX_TSTEP(:,:) * ZINVTSTEP)
+ IF (GPRESENT_PFPR) THEN
+ DO JK = KKTB , KKTE
+ PFPR(:,:,JK,KSPE) = PFPR(:,:,JK,KSPE) + ZWSED(:,:,JK) * (ZMAX_TSTEP(:,:) * ZINVTSTEP)
+ ENDDO
+ ENDIF
+!
+END DO
+!
+END SUBROUTINE INTERNAL_SEDIM_SPLI
+!
+END SUBROUTINE ICE4_SEDIMENTATION_SPLIT
diff --git a/src/mesonh/micro/ice4_sedimentation_split_momentum.f90 b/src/mesonh/micro/ice4_sedimentation_split_momentum.f90
new file mode 100644
index 000000000..927eb8ba5
--- /dev/null
+++ b/src/mesonh/micro/ice4_sedimentation_split_momentum.f90
@@ -0,0 +1,577 @@
+!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+MODULE MODI_ICE4_SEDIMENTATION_SPLIT_MOMENTUM
+INTERFACE
+SUBROUTINE ICE4_SEDIMENTATION_SPLIT_MOMENTUM(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL, &
+ &PTSTEP, KRR, OSEDIC, OMOMENTUM, &
+ &PSEA, PTOWN, PDZZ, &
+ &PRHODREF, PPABST, PTHT, PRHODJ, &
+ &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
+ &PINPRC, PINPRR, PINPRI, PINPRS, PINPRG, &
+ &PINPRH, PRHT, PRHS, PFPR)
+IMPLICIT NONE
+INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT
+INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
+REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
+INTEGER, INTENT(IN) :: KRR ! Number of moist variable
+LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
+LOGICAL, INTENT(IN) :: OMOMENTUM ! Switch to use momentum flux
+REAL, DIMENSION(KIT,KJT), INTENT(IN) :: PSEA ! Sea Mask
+REAL, DIMENSION(KIT,KJT), INTENT(IN) :: PTOWN ! Fraction that is town
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRC ! Cloud instant precip
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRR ! Rain instant precip
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRI ! Pristine ice instant precip
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRS ! Snow instant precip
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRG ! Graupel instant precip
+REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(OUT) :: PINPRH ! Hail instant precip
+REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
+REAL, DIMENSION(KIT,KJT,KKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
+END SUBROUTINE ICE4_SEDIMENTATION_SPLIT_MOMENTUM
+END INTERFACE
+END MODULE MODI_ICE4_SEDIMENTATION_SPLIT_MOMENTUM
+SUBROUTINE ICE4_SEDIMENTATION_SPLIT_MOMENTUM(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL, &
+ &PTSTEP, KRR, OSEDIC, OMOMENTUM, &
+ &PSEA, PTOWN, PDZZ, &
+ &PRHODREF, PPABST, PTHT, PRHODJ, &
+ &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
+ &PINPRC, PINPRR, PINPRI, PINPRS, PINPRG, &
+ &PINPRH, PRHT, PRHS, PFPR)
+!!
+!!** PURPOSE
+!! -------
+!! Computes the sedimentation
+!!
+!! AUTHOR
+!! ------
+!! S. Riette from the plitting of rain_ice source code (nov. 2014)
+!! and modified to use momentum
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_PARAM_ICE
+USE MODD_RAIN_ICE_DESCR
+USE MODD_RAIN_ICE_PARAM
+
+USE MODE_MSG
+use mode_tools, only: Countjv
+
+USE MODI_GAMMA
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT
+INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
+REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
+INTEGER, INTENT(IN) :: KRR ! Number of moist variable
+LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
+LOGICAL, INTENT(IN) :: OMOMENTUM ! Switch to use momentum flux
+REAL, DIMENSION(KIT,KJT), INTENT(IN) :: PSEA ! Sea Mask
+REAL, DIMENSION(KIT,KJT), INTENT(IN) :: PTOWN ! Fraction that is town
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRC ! Cloud instant precip
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRR ! Rain instant precip
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRI ! Pristine ice instant precip
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRS ! Snow instant precip
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRG ! Graupel instant precip
+REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(OUT) :: PINPRH ! Hail instant precip
+REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
+REAL, DIMENSION(KIT,KJT,KKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
+!
+!* 0.2 declaration of local variables
+!
+!
+LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: GSEDIM ! Test where to compute the SED processes
+INTEGER , DIMENSION(SIZE(GSEDIM)) :: I1,I2,I3 ! Used to replace the COUNT
+
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: ZCONC3D, & ! droplet condensation
+ & ZRAY, & ! Cloud Mean radius
+ & ZLBC, & ! XLBC weighted by sea fraction
+ & ZFSEDC, &
+ & ZPRCS,ZPRRS,ZPRIS,ZPRSS,ZPRGS,ZPRHS, & ! Mixing ratios created during the time step
+ & ZW, & ! work array
+ & ZRCT, &
+ & ZRRT, &
+ & ZRIT, &
+ & ZRST, &
+ & ZRGT, &
+ & ZRHT
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: ZMOMC, ZMOMR, ZMOMI, ZMOMS, ZMOMG, ZMOMH ! momentum
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: ZMOMC_EXT, ZMOMR_EXT, ZMOMI_EXT, &
+ ZMOMS_EXT, ZMOMG_EXT, ZMOMH_EXT ! momentum tendencies
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),0:SIZE(PRHODREF,3)+1) :: ZWSED ! sedimentation fluxes
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2)) :: ZCONC_TMP ! Weighted concentration
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2)) :: ZREMAINT ! Remaining time until the timestep end
+REAL :: ZINVTSTEP
+INTEGER :: ISEDIM ! ! Case number of sedimentation
+INTEGER :: JK
+LOGICAL :: FIRST
+REAL, DIMENSION(SIZE(XRTMIN)) :: ZRSMIN
+!-------------------------------------------------------------------------------
+!
+!-------------------------------------------------------------------------------
+!
+!
+! O. Initialization of for sedimentation
+!
+ZINVTSTEP=1./PTSTEP
+ZRSMIN(:) = XRTMIN(:) * ZINVTSTEP
+IF (OSEDIC) PINPRC (:,:) = 0.
+PINPRR (:,:) = 0.
+PINPRI (:,:) = 0.
+PINPRS (:,:) = 0.
+PINPRG (:,:) = 0.
+IF ( KRR == 7 ) PINPRH (:,:) = 0.
+IF (PRESENT(PFPR)) PFPR(:,:,:,:) = 0.
+!
+!* 1. Parameters for cloud sedimentation
+!
+IF (OSEDIC) THEN
+ ZRAY(:,:,:) = 0.
+ ZCONC_TMP(:,:)=PSEA(:,:)*XCONC_SEA+(1.-PSEA(:,:))*XCONC_LAND
+
+ DO JK=KKTB, KKTE
+ ZLBC(:,:,JK) = PSEA(:,:)*XLBC(2)+(1.-PSEA(:,:))*XLBC(1)
+ ZFSEDC(:,:,JK) = (PSEA(:,:)*XFSEDC(2)+(1.-PSEA(:,:))*XFSEDC(1))
+ ZFSEDC(:,:,JK) = MAX(MIN(XFSEDC(1),XFSEDC(2)),ZFSEDC(:,:,JK))
+ ZCONC3D(:,:,JK)= (1.-PTOWN(:,:))*ZCONC_TMP(:,:)+PTOWN(:,:)*XCONC_URBAN
+ ZRAY(:,:,JK) = 0.5*((1.-PSEA(:,:))*GAMMA(XNUC+1.0/XALPHAC)/(GAMMA(XNUC)) + &
+ PSEA(:,:)*GAMMA(XNUC2+1.0/XALPHAC2)/(GAMMA(XNUC2)))
+ END DO
+ ZRAY(:,:,:) = MAX(1.,ZRAY(:,:,:))
+ ZLBC(:,:,:) = MAX(MIN(XLBC(1),XLBC(2)),ZLBC(:,:,:))
+ENDIF
+!
+!* 2. compute the fluxes
+!
+! optimization by looking for locations where
+! the precipitating fields are larger than a minimal value only !!!
+! For optimization we consider each variable separately
+!
+! External tendecies
+IF (OSEDIC) ZPRCS(:,:,:) = PRCS(:,:,:)-PRCT(:,:,:)*ZINVTSTEP
+ZPRRS(:,:,:) = PRRS(:,:,:)-PRRT(:,:,:)*ZINVTSTEP
+ZPRIS(:,:,:) = PRIS(:,:,:)-PRIT(:,:,:)*ZINVTSTEP
+ZPRSS(:,:,:) = PRSS(:,:,:)-PRST(:,:,:)*ZINVTSTEP
+ZPRGS(:,:,:) = PRGS(:,:,:)-PRGT(:,:,:)*ZINVTSTEP
+IF ( KRR == 7 ) ZPRHS(:,:,:) = PRHS(:,:,:)-PRHT(:,:,:)*ZINVTSTEP
+!
+! mr values inside the time-splitting loop
+ZRCT(:,:,:) = PRCT(:,:,:)
+ZRRT(:,:,:) = PRRT(:,:,:)
+ZRIT(:,:,:) = PRIT(:,:,:)
+ZRST(:,:,:) = PRST(:,:,:)
+ZRGT(:,:,:) = PRGT(:,:,:)
+IF (KRR==7) ZRHT(:,:,:) = PRHT(:,:,:)
+!
+DO JK = KKTB , KKTE
+ ZW(:,:,JK) =1./(PRHODREF(:,:,JK)* PDZZ(:,:,JK))
+END DO
+!
+!
+!* 2.1 for cloud
+!
+IF (OSEDIC) THEN
+ ZREMAINT(:,:) = PTSTEP
+ FIRST = .TRUE.
+ DO WHILE (ANY(ZREMAINT>0.))
+ GSEDIM(:,:,:)=.FALSE.
+ DO JK = KKTB , KKTE
+ GSEDIM(KIB:KIE,KJB:KJE,JK) = &
+ (ZRCT(KIB:KIE,KJB:KJE,JK)>XRTMIN(2) .OR. &
+ ZPRCS(KIB:KIE,KJB:KJE,JK)>ZRSMIN(2)) .AND. &
+ ZREMAINT(KIB:KIE,KJB:KJE)>0.
+ ENDDO
+ ISEDIM = COUNTJV(GSEDIM(:,:,:),I1(:),I2(:),I3(:))
+ CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
+ &OMOMENTUM, FIRST .AND. OMOMENTUM, &
+ &ISEDIM, GSEDIM, I1, I2, I3, XSPLIT_MAXCFL, ZREMAINT, &
+ &PRHODREF, ZW, PDZZ, PPABST, PTHT, PSEA, PTOWN, PTSTEP, &
+ &2, &
+ &ZRCT, PRCS, ZWSED, PINPRC, ZPRCS, ZMOMC, ZMOMC_EXT, &
+ &ZRAY, ZLBC, ZFSEDC, ZCONC3D, PFPR=PFPR)
+ FIRST = .FALSE.
+ ENDDO
+ENDIF
+!
+!* 2.2 for rain
+!
+ZREMAINT(:,:) = PTSTEP
+FIRST = .TRUE.
+DO WHILE (ANY(ZREMAINT>0.))
+ GSEDIM(:,:,:)=.FALSE.
+ DO JK = KKTB , KKTE
+ GSEDIM(KIB:KIE,KJB:KJE,JK) = &
+ (ZRRT(KIB:KIE,KJB:KJE,JK)>XRTMIN(3) .OR. &
+ ZPRRS(KIB:KIE,KJB:KJE,JK)>ZRSMIN(3)) .AND. &
+ ZREMAINT(KIB:KIE,KJB:KJE)>0.
+ ENDDO
+ ISEDIM = COUNTJV(GSEDIM(:,:,:),I1(:),I2(:),I3(:))
+ CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
+ &OMOMENTUM, FIRST .AND. OMOMENTUM, &
+ &ISEDIM, GSEDIM, I1, I2, I3, XSPLIT_MAXCFL, ZREMAINT, &
+ &PRHODREF, ZW, PDZZ, PPABST, PTHT, PSEA, PTOWN, PTSTEP, &
+ &3, &
+ &ZRRT, PRRS, ZWSED, PINPRR, ZPRRS, ZMOMR, ZMOMR_EXT, &
+ &PFPR=PFPR)
+ FIRST = .FALSE.
+ENDDO
+!
+!* 2.3 for pristine ice
+!
+ZREMAINT(:,:) = PTSTEP
+FIRST = .TRUE.
+DO WHILE (ANY(ZREMAINT>0.))
+ GSEDIM(:,:,:)=.FALSE.
+ DO JK = KKTB , KKTE
+ GSEDIM(KIB:KIE,KJB:KJE,JK) = &
+ (ZRIT(KIB:KIE,KJB:KJE,JK)>XRTMIN(4) .OR. &
+ ZPRIS(KIB:KIE,KJB:KJE,JK)>ZRSMIN(4)) .AND. &
+ ZREMAINT(KIB:KIE,KJB:KJE)>0.
+ ENDDO
+ ISEDIM = COUNTJV(GSEDIM(:,:,:),I1(:),I2(:),I3(:))
+ CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
+ &OMOMENTUM, FIRST .AND. OMOMENTUM, &
+ &ISEDIM, GSEDIM, I1, I2, I3, XSPLIT_MAXCFL, ZREMAINT, &
+ &PRHODREF, ZW, PDZZ, PPABST, PTHT, PSEA, PTOWN, PTSTEP, &
+ &4, &
+ &ZRIT, PRIS, ZWSED, PINPRI, ZPRIS, ZMOMI, ZMOMI_EXT, PFPR=PFPR)
+ FIRST = .FALSE.
+ENDDO
+!
+!* 2.4 for aggregates/snow
+!
+ZREMAINT(:,:) = PTSTEP
+FIRST = .TRUE.
+DO WHILE (ANY(ZREMAINT>0.))
+ GSEDIM(:,:,:)=.FALSE.
+ DO JK = KKTB , KKTE
+ GSEDIM(KIB:KIE,KJB:KJE,JK) = &
+ (ZRST(KIB:KIE,KJB:KJE,JK)>XRTMIN(5) .OR. &
+ ZPRSS(KIB:KIE,KJB:KJE,JK)>ZRSMIN(5)) .AND. &
+ ZREMAINT(KIB:KIE,KJB:KJE)>0.
+ ENDDO
+ ISEDIM = COUNTJV(GSEDIM(:,:,:),I1(:),I2(:),I3(:))
+ CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
+ &OMOMENTUM, FIRST .AND. OMOMENTUM, &
+ &ISEDIM, GSEDIM, I1, I2, I3, XSPLIT_MAXCFL, ZREMAINT, &
+ &PRHODREF, ZW, PDZZ, PPABST, PTHT, PSEA, PTOWN, PTSTEP, &
+ &5, &
+ &ZRST, PRSS, ZWSED, PINPRS, ZPRSS, ZMOMS, ZMOMS_EXT, PFPR=PFPR)
+ FIRST = .FALSE.
+ENDDO
+!
+!* 2.5 for graupeln
+!
+ZREMAINT(:,:) = PTSTEP
+FIRST = .TRUE.
+DO WHILE (ANY(ZREMAINT>0.))
+ GSEDIM(:,:,:)=.FALSE.
+ DO JK = KKTB , KKTE
+ GSEDIM(KIB:KIE,KJB:KJE,JK) = &
+ (ZRGT(KIB:KIE,KJB:KJE,JK)>XRTMIN(6) .OR. &
+ ZPRGS(KIB:KIE,KJB:KJE,JK)>ZRSMIN(6)) .AND. &
+ ZREMAINT(KIB:KIE,KJB:KJE)>0.
+ ENDDO
+ ISEDIM = COUNTJV(GSEDIM(:,:,:),I1(:),I2(:),I3(:))
+ CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
+ &OMOMENTUM, FIRST .AND. OMOMENTUM, &
+ &ISEDIM, GSEDIM, I1, I2, I3, XSPLIT_MAXCFL, ZREMAINT, &
+ &PRHODREF, ZW, PDZZ, PPABST, PTHT, PSEA, PTOWN, PTSTEP, &
+ &6, &
+ &ZRGT, PRGS, ZWSED, PINPRG, ZPRGS, ZMOMG, ZMOMG_EXT, PFPR=PFPR)
+ FIRST = .FALSE.
+ENDDO
+!
+!* 2.6 for hail
+!
+IF (KRR==7) THEN
+ ZREMAINT(:,:) = PTSTEP
+ FIRST = .TRUE.
+ DO WHILE (ANY(ZREMAINT>0.))
+ GSEDIM(:,:,:)=.FALSE.
+ DO JK = KKTB , KKTE
+ GSEDIM(KIB:KIE,KJB:KJE,JK) = &
+ (ZRHT(KIB:KIE,KJB:KJE,JK)>XRTMIN(7) .OR. &
+ ZPRHS(KIB:KIE,KJB:KJE,JK)>ZRSMIN(7)) .AND. &
+ ZREMAINT(KIB:KIE,KJB:KJE)>0.
+ ENDDO
+ ISEDIM = COUNTJV(GSEDIM(:,:,:),I1(:),I2(:),I3(:))
+ CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
+ &OMOMENTUM, FIRST .AND. OMOMENTUM, &
+ &ISEDIM, GSEDIM, I1, I2, I3, XSPLIT_MAXCFL, ZREMAINT, &
+ &PRHODREF, ZW, PDZZ, PPABST, PTHT, PSEA, PTOWN, PTSTEP, &
+ &7, &
+ &ZRHT, PRHS, ZWSED, PINPRH, ZPRHS, ZMOMH, ZMOMH_EXT, PFPR=PFPR)
+ FIRST = .FALSE.
+ END DO
+ENDIF
+!
+!
+CONTAINS
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+ SUBROUTINE INTERNAL_SEDIM_SPLI(KIT, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
+ &OMOMENTUM, OCOMPUTE_MOM, &
+ &KSEDIM, LDSEDIM, I1, I2, I3, PMAXCFL, PREMAINT, &
+ &PRHODREF, POORHODZ, PDZZ, PPABST, PTHT, PSEA, PTOWN, PTSTEP, &
+ &KSPE, &
+ &PRXT, PRXS, PWSED, PINPRX, PPRXS, PMOM, PMOM_EXT, &
+ &PRAY, PLBC, PFSEDC, PCONC3D, PFPR)
+ !
+ !* 0. DECLARATIONS
+ ! ------------
+ !
+ USE MODD_RAIN_ICE_DESCR
+ USE MODD_RAIN_ICE_PARAM
+ !
+ IMPLICIT NONE
+ !
+ !* 0.1 Declarations of dummy arguments :
+ !
+ INTEGER, INTENT(IN) :: KIT, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR
+ LOGICAL, INTENT(IN) :: OMOMENTUM, OCOMPUTE_MOM
+ INTEGER, INTENT(IN) :: KSEDIM
+ LOGICAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: LDSEDIM
+ INTEGER, DIMENSION(KSEDIM), INTENT(IN) :: I1, I2, I3
+ REAL, INTENT(IN) :: PMAXCFL ! maximum CFL allowed
+ REAL, DIMENSION(KIT,KJT), INTENT(INOUT) :: PREMAINT ! Time remaining until the end of the timestep
+ REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF ! Reference density
+ REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: POORHODZ ! One Over (Rhodref times delta Z)
+ REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! layer thikness (m)
+ REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST
+ REAL, DIMENSION(KIT,KJT), INTENT(IN) :: PSEA ! Sea Mask
+ REAL, DIMENSION(KIT,KJT), INTENT(IN) :: PTOWN ! Fraction that is town
+ REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT
+ REAL, INTENT(IN) :: PTSTEP ! total timestep
+ INTEGER, INTENT(IN) :: KSPE ! 1 for rc, 2 for rr...
+ REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRXT ! mr of specy X
+ REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRXS !Tendency of the specy KSPE
+ REAL, DIMENSION(KIT,KJT,0:KKT+1), INTENT(OUT) :: PWSED ! sedimentation flux
+ REAL, DIMENSION(KIT,KJT), INTENT(INOUT) :: PINPRX ! instant precip
+ REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPRXS ! external tendencie
+ REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PMOM ! momentum associated to PRXT
+ REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PMOM_EXT ! momentum tendency associated to PPRXS
+ REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN), OPTIONAL :: PRAY, PLBC, PFSEDC, PCONC3D
+ REAL, DIMENSION(KIT,KJT,KKT,KRR), OPTIONAL, INTENT(INOUT) :: PFPR ! upper-air precipitation fluxes
+ !
+ !* 0.2 declaration of local variables
+ !
+ !
+ character(len=10) :: yspe ! String for error message
+ INTEGER :: JK, JL, JI, JJ
+ REAL :: ZINVTSTEP
+ REAL :: ZZWLBDC, ZRAY, ZZT, ZZWLBDA, ZZCC
+ REAL :: ZFSED, ZEXSED
+ REAL, DIMENSION(KIT, KJT) :: ZMRCHANGE
+ REAL, DIMENSION(KIT, KJT) :: ZMAX_TSTEP ! Maximum CFL in column
+ REAL, DIMENSION(KIT,KJT,0:KKT+1) :: ZWSED_MOM ! Momentum flux
+ REAL, DIMENSION(SIZE(XRTMIN)) :: ZRSMIN
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !
+ !* 1. Parameters for cloud sedimentation
+ !
+ !
+ IF(OCOMPUTE_MOM .AND. .NOT. OMOMENTUM) THEN
+ call Print_msg( NVERB_FATAL, 'GEN', 'ICE4_SEDIMENTATION_SPLIT_MOMENTUM', &
+ 'OCOMPUTE_MOM cannot be .TRUE. if we do not use momentum' )
+ ENDIF
+ !* 2. compute the fluxes
+ !
+ !
+ ZINVTSTEP = 1./PTSTEP
+ ZRSMIN(:) = XRTMIN(:) * ZINVTSTEP
+ IF(KSPE==2) THEN
+ !******* for cloud
+ IF(OCOMPUTE_MOM .OR. .NOT. OMOMENTUM) THEN
+ PWSED(:,:,:) = 0.
+ PMOM_EXT(:,:,:) = 0.
+ DO JL=1, KSEDIM
+ JI=I1(JL)
+ JJ=I2(JL)
+ JK=I3(JL)
+ IF(PRXT(JI,JJ,JK)>XRTMIN(KSPE)) THEN
+ ZZWLBDC = PLBC(JI,JJ,JK) * PCONC3D(JI,JJ,JK) / &
+ (PRHODREF(JI,JJ,JK) * PRXT(JI,JJ,JK))
+ ZZWLBDC = ZZWLBDC**XLBEXC
+ ZRAY = PRAY(JI,JJ,JK) / ZZWLBDC
+ ZZT = PTHT(JI,JJ,JK) * (PPABST(JI,JJ,JK)/XP00)**(XRD/XCPD)
+ ZZWLBDA = 6.6E-8*(101325./PPABST(JI,JJ,JK))*(ZZT/293.15)
+ ZZCC = XCC*(1.+1.26*ZZWLBDA/ZRAY)
+ PWSED(JI, JJ, JK) = PRHODREF(JI,JJ,JK)**(-XCEXVT +1 ) * &
+ ZZWLBDC**(-XDC)*ZZCC*PFSEDC(JI,JJ,JK) * PRXT(JI,JJ,JK)
+ ENDIF
+ IF(PPRXS(JI,JJ,JK)>ZRSMIN(KSPE) .AND. OCOMPUTE_MOM) THEN
+ ZZWLBDC = PLBC(JI,JJ,JK) * PCONC3D(JI,JJ,JK) / &
+ (PRHODREF(JI,JJ,JK) * PPRXS(JI,JJ,JK) * PTSTEP)
+ ZZWLBDC = ZZWLBDC**XLBEXC
+ ZRAY = PRAY(JI,JJ,JK) / ZZWLBDC
+ ZZT = PTHT(JI,JJ,JK) * (PPABST(JI,JJ,JK)/XP00)**(XRD/XCPD)
+ ZZWLBDA = 6.6E-8*(101325./PPABST(JI,JJ,JK))*(ZZT/293.15)
+ ZZCC = XCC*(1.+1.26*ZZWLBDA/ZRAY)
+ PMOM_EXT(JI, JJ, JK) = PRHODREF(JI,JJ,JK)**(-XCEXVT +1 -1) * &
+ ZZWLBDC**(-XDC)*ZZCC*PFSEDC(JI,JJ,JK) * PPRXS(JI,JJ,JK)
+ ENDIF
+ ENDDO
+ IF(OCOMPUTE_MOM) PMOM(:, :, :)=PWSED(:, :, 1:KKT)
+ ENDIF
+ ELSEIF(KSPE==4) THEN
+ ! ******* for pristine ice
+ IF(OCOMPUTE_MOM .OR. .NOT. OMOMENTUM) THEN
+ PWSED(:,:,:) = 0.
+ PMOM_EXT(:,:,:) = 0.
+ DO JL=1, KSEDIM
+ JI=I1(JL)
+ JJ=I2(JL)
+ JK=I3(JL)
+ IF(PRXT(JI, JJ, JK) .GT. MAX(XRTMIN(4), 1.0E-7)) THEN
+ PWSED(JI, JJ, JK) = XFSEDI * PRXT(JI, JJ, JK) * &
+ & PRHODREF(JI,JJ,JK)**(1.-XCEXVT) * & ! McF&H
+ & MAX( 0.05E6,-0.15319E6-0.021454E6* &
+ & ALOG(PRHODREF(JI,JJ,JK)*PRXT(JI,JJ,JK)) )**XEXCSEDI
+ ENDIF
+ IF(PPRXS(JI,JJ,JK)>MAX(ZRSMIN(4), 1.0E-7/PTSTEP) .AND. OCOMPUTE_MOM) THEN
+ PMOM_EXT(JI, JJ, JK) = XFSEDI * PPRXS(JI, JJ, JK) * &
+ & PRHODREF(JI,JJ,JK)**(1.-XCEXVT-1) * & ! McF&H
+ & MAX( 0.05E6,-0.15319E6-0.021454E6* &
+ & ALOG(PRHODREF(JI,JJ,JK)*PPRXS(JI,JJ,JK)*PTSTEP) )**XEXCSEDI
+ ENDIF
+ ENDDO
+ IF(OCOMPUTE_MOM) PMOM(:, :, :)=PWSED(:, :, 1:KKT)
+ ENDIF
+ ELSE
+ ! ******* for other species
+ IF(KSPE==3) THEN
+ ZFSED=XFSEDR
+ ZEXSED=XEXSEDR
+ ELSEIF(KSPE==5) THEN
+ ZFSED=XFSEDS
+ ZEXSED=XEXSEDS
+ ELSEIF(KSPE==6) THEN
+ ZFSED=XFSEDG
+ ZEXSED=XEXSEDG
+ ELSEIF(KSPE==7) THEN
+ ZFSED=XFSEDH
+ ZEXSED=XEXSEDH
+ ELSE
+ write( yspe, '( I10 )' ) kspe
+ call Print_msg( NVERB_FATAL, 'GEN', 'ICE4_SEDIMENTATION_SPLIT_MOMENTUM', &
+ 'no sedimentation parameter for KSPE='//trim(yspe) )
+ ENDIF
+ IF(OCOMPUTE_MOM .OR. .NOT. OMOMENTUM) THEN
+ !Momentum (per m3) and mass flux are given by the same formulae
+ PWSED(:,:,:) = 0.
+ PMOM_EXT(:,:,:) = 0.
+ DO JL=1, KSEDIM
+ JI=I1(JL)
+ JJ=I2(JL)
+ JK=I3(JL)
+ IF(PRXT(JI,JJ,JK)>XRTMIN(KSPE)) THEN
+ PWSED(JI, JJ, JK) = ZFSED * PRXT(JI, JJ, JK)**ZEXSED * &
+ PRHODREF(JI, JJ, JK)**(ZEXSED-XCEXVT)
+ ENDIF
+ IF(PPRXS(JI,JJ,JK)>ZRSMIN(KSPE) .AND. OCOMPUTE_MOM) THEN
+ PMOM_EXT(JI, JJ, JK) = ZFSED * (PPRXS(JI, JJ, JK)*PTSTEP)**ZEXSED * &
+ PRHODREF(JI, JJ, JK)**(ZEXSED-XCEXVT-1) * ZINVTSTEP
+ ENDIF
+ ENDDO
+ IF(OCOMPUTE_MOM) PMOM(:, :, :)=PWSED(:, :, 1:KKT) / PRHODREF(:, :, :) ! momentum per kg of dry air
+ ENDIF
+ ENDIF
+ IF(OMOMENTUM) THEN
+ PWSED(:,:,:) = 0.
+ ZWSED_MOM(:,:,:) = 0.
+ DO JL=1, KSEDIM
+ JI=I1(JL)
+ JJ=I2(JL)
+ JK=I3(JL)
+ IF(PRXT(JI,JJ,JK)>XRTMIN(KSPE)) THEN
+ ZWSED_MOM(JI, JJ, JK) = PMOM(JI, JJ, JK)**2 / PRXT(JI, JJ, JK) * PRHODREF(JI, JJ, JK) ! (kg*m/s)/(s*m**2)
+ ENDIF
+ ENDDO
+ PWSED(:, :, 1:KKT) = PMOM(:, :, :)*PRHODREF(:, :, :) !PMOM divided by r to get speed and multiply by rho*r to get flux
+ ENDIF
+ ZMAX_TSTEP(:,:) = PREMAINT(:,:)
+ DO JL=1, KSEDIM
+ JI=I1(JL)
+ JJ=I2(JL)
+ JK=I3(JL)
+ IF(PRXT(JI,JJ,JK)>XRTMIN(KSPE)) THEN
+ ZMAX_TSTEP(JI, JJ) = MIN(ZMAX_TSTEP(JI, JJ), PMAXCFL * PRHODREF(JI, JJ, JK) * &
+ PRXT(JI, JJ, JK) * PDZZ(JI, JJ, JK) / PWSED(JI, JJ, JK))
+ ENDIF
+ ENDDO
+ ZMRCHANGE(:,:) = 0.
+ PREMAINT(:,:) = PREMAINT(:,:) - ZMAX_TSTEP(:,:)
+ DO JK = KKTB , KKTE
+ ZMRCHANGE(:,:) = ZMAX_TSTEP(:,:) * POORHODZ(:,:,JK)*(PWSED(:,:,JK+KKL)-PWSED(:,:,JK))
+ PRXT(:,:,JK) = PRXT(:,:,JK) + ZMRCHANGE(:,:) + PPRXS(:,:,JK) * ZMAX_TSTEP(:,:)
+ PRXS(:,:,JK) = PRXS(:,:,JK) + ZMRCHANGE(:,:) * ZINVTSTEP
+ ENDDO
+ IF(OMOMENTUM) THEN
+ DO JK = KKTB , KKTE
+ PMOM(:,:,JK) = PMOM(:,:,JK) + ZMAX_TSTEP(:,:) * POORHODZ(:,:,JK) * (ZWSED_MOM(:,:,JK+KKL)-ZWSED_MOM(:,:,JK))
+ PMOM(:,:,JK) = PMOM(:,:,JK) + ZMAX_TSTEP(:,:) * PMOM_EXT(:,:,JK)
+ PMOM(:,:,JK) = MAX(0., PMOM(:,:,JK))
+ ENDDO
+ ENDIF
+ PINPRX(:,:) = PINPRX(:,:) + ZWSED(:,:,KKB) / XRHOLW * (ZMAX_TSTEP(:,:) * ZINVTSTEP)
+ IF (PRESENT(PFPR)) THEN
+ DO JK = KKTB , KKTE
+ PFPR(:,:,JK,KSPE) = PFPR(:,:,JK,KSPE) + ZWSED(:,:,JK) * (ZMAX_TSTEP(:,:) * ZINVTSTEP)
+ ENDDO
+ ENDIF
+ !
+ END SUBROUTINE INTERNAL_SEDIM_SPLI
+ !
+END SUBROUTINE ICE4_SEDIMENTATION_SPLIT_MOMENTUM
diff --git a/src/mesonh/micro/ice4_sedimentation_stat.f90 b/src/mesonh/micro/ice4_sedimentation_stat.f90
new file mode 100644
index 000000000..3cbb31493
--- /dev/null
+++ b/src/mesonh/micro/ice4_sedimentation_stat.f90
@@ -0,0 +1,444 @@
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+MODULE MODI_ICE4_SEDIMENTATION_STAT
+INTERFACE
+SUBROUTINE ICE4_SEDIMENTATION_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL, &
+ &PTSTEP, KRR, OSEDIC, ODEPOSC, PVDEPOSC, PDZZ, &
+ &PRHODREF, PPABST, PTHT, PRHODJ, &
+ &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT,&
+ &PRSS, PRST, PRGS, PRGT,&
+ &PINPRC, PINDEP, PINPRR, PINPRI, PINPRS, PINPRG, &
+ &PSEA, PTOWN, &
+ &PINPRH, PRHT, PRHS, PFPR)
+IMPLICIT NONE
+INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT
+INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
+REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
+INTEGER, INTENT(IN) :: KRR ! Number of moist variable
+LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
+LOGICAL, INTENT(IN) :: ODEPOSC ! Switch for droplet depos.
+REAL, INTENT(IN) :: PVDEPOSC! Droplet deposition velocity
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRC ! Cloud instant precip
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINDEP ! Cloud instant deposition
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRR ! Rain instant precip
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRI ! Pristine ice instant precip
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRS ! Snow instant precip
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRG ! Graupel instant precip
+REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
+REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PTOWN ! Fraction that is town
+REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(OUT) :: PINPRH ! Hail instant precip
+REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
+REAL, DIMENSION(KIT,KJT,KKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
+END SUBROUTINE ICE4_SEDIMENTATION_STAT
+END INTERFACE
+END MODULE MODI_ICE4_SEDIMENTATION_STAT
+SUBROUTINE ICE4_SEDIMENTATION_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL, &
+ &PTSTEP, KRR, OSEDIC, ODEPOSC, PVDEPOSC, PDZZ, &
+ &PRHODREF, PPABST, PTHT, PRHODJ, &
+ &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, &
+ &PRSS, PRST, PRGS, PRGT,&
+ &PINPRC, PINDEP, PINPRR, PINPRI, PINPRS, PINPRG, &
+ &PSEA, PTOWN, &
+ &PINPRH, PRHT, PRHS, PFPR)
+
+!!
+!!** PURPOSE
+!! -------
+!! Computes the sedimentation
+!!
+!! AUTHOR
+!! ------
+!! S. Riette from the plitting of rain_ice source code (nov. 2014)
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+! P. Wautelet 21/01/2021: initialize untouched part of PFPR
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+
+USE MODE_MSG
+
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT
+INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
+REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
+INTEGER, INTENT(IN) :: KRR ! Number of moist variable
+LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
+LOGICAL, INTENT(IN) :: ODEPOSC ! Switch for droplet depos.
+REAL, INTENT(IN) :: PVDEPOSC! Droplet deposition velocity
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRC ! Cloud instant precip
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINDEP ! Cloud instant deposition
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRR ! Rain instant precip
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRI ! Pristine ice instant precip
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRS ! Snow instant precip
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRG ! Graupel instant precip
+REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
+REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PTOWN ! Fraction that is town
+REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(OUT) :: PINPRH ! Hail instant precip
+REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
+REAL, DIMENSION(KIT,KJT,KKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
+!
+!* 0.2 declaration of local variables
+!
+!
+INTEGER :: JK
+!
+REAL :: ZINVTSTEP
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: ZW ! work array
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),0:SIZE(PRHODREF,3)+1) &
+ :: ZWSED ! sedimentation fluxes
+LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2)):: GDEP
+!
+!
+!-------------------------------------------------------------------------------
+!
+ZINVTSTEP=1./PTSTEP
+
+IF ( PRESENT( PFPR ) ) THEN
+ !Set to 0. to avoid undefined values (in files)
+ PFPR(:, :, : KKTB - 1, :) = 0.
+ PFPR(:, :, KKTE + 1 :, :) = 0.
+END IF
+!-------------------------------------------------------------------------------
+!
+!* 1. compute the fluxes
+!
+!
+DO JK = KKTB , KKTE
+ ZW(:,:,JK) =PTSTEP/(PRHODREF(:,:,JK)* PDZZ(:,:,JK) )
+END DO
+!
+!* 2.1 for cloud
+!
+IF (OSEDIC) THEN
+ CALL INTERNAL_SEDIM_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKTB, KKTE, KKL, &
+ &PRHODREF, PDZZ, ZW, PPABST, PTHT, PTSTEP, &
+ &2, &
+ &PRCT, PRCS, ZWSED, PSEA, PTOWN)
+ IF (PRESENT(PFPR)) THEN
+ DO JK = KKTB , KKTE
+ PFPR(:,:,JK,2)=ZWSED(:,:,JK)
+ ENDDO
+ ENDIF
+ PINPRC(:,:) = ZWSED(:,:,KKB)/XRHOLW ! in m/s
+ENDIF
+!
+!
+!* 2.1bis DROPLET DEPOSITION AT THE 1ST LEVEL ABOVE GROUND
+!
+IF (ODEPOSC) THEN
+ GDEP(:,:) = .FALSE.
+ GDEP(KIB:KIE,KJB:KJE) = PRCS(KIB:KIE,KJB:KJE,KKB) >0
+ WHERE (GDEP)
+ PRCS(:,:,KKB) = PRCS(:,:,KKB) - PVDEPOSC * PRCT(:,:,KKB) / PDZZ(:,:,KKB)
+ PINPRC(:,:) = PINPRC(:,:) + PVDEPOSC * PRCT(:,:,KKB) * PRHODREF(:,:,KKB) /XRHOLW
+ PINDEP(:,:) = PVDEPOSC * PRCT(:,:,KKB) * PRHODREF(:,:,KKB) /XRHOLW
+ END WHERE
+END IF
+!
+!* 2.2 for rain
+!
+CALL INTERNAL_SEDIM_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKTB, KKTE, KKL, &
+ &PRHODREF, PDZZ, ZW, PPABST, PTHT, PTSTEP, &
+ &3, &
+ &PRRT, PRRS, ZWSED)
+IF (PRESENT(PFPR)) THEN
+ DO JK = KKTB , KKTE
+ PFPR(:,:,JK,3)=ZWSED(:,:,JK)
+ ENDDO
+ENDIF
+PINPRR(:,:) = ZWSED(:,:,KKB)/XRHOLW ! in m/s
+!
+!* 2.3 for pristine ice
+!
+CALL INTERNAL_SEDIM_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKTB, KKTE, KKL, &
+ &PRHODREF, PDZZ, ZW, PPABST, PTHT, PTSTEP, &
+ &4, &
+ &PRIT, PRIS, ZWSED)
+IF (PRESENT(PFPR)) THEN
+ DO JK = KKTB , KKTE
+ PFPR(:,:,JK,4)=ZWSED(:,:,JK)
+ ENDDO
+ENDIF
+PINPRI(:,:) = ZWSED(:,:,KKB)/XRHOLW ! in m/s
+!
+!* 2.4 for aggregates/snow
+!
+CALL INTERNAL_SEDIM_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKTB, KKTE, KKL, &
+ &PRHODREF, PDZZ, ZW, PPABST, PTHT, PTSTEP, &
+ &5, &
+ &PRST, PRSS, ZWSED)
+IF (PRESENT(PFPR)) THEN
+ DO JK = KKTB , KKTE
+ PFPR(:,:,JK,5)=ZWSED(:,:,JK)
+ ENDDO
+ENDIF
+PINPRS(:,:) = ZWSED(:,:,KKB)/XRHOLW ! in m/s
+!
+!* 2.5 for graupeln
+!
+CALL INTERNAL_SEDIM_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKTB, KKTE, KKL, &
+ &PRHODREF, PDZZ, ZW, PPABST, PTHT, PTSTEP, &
+ &6, &
+ &PRGT, PRGS, ZWSED)
+IF (PRESENT(PFPR)) THEN
+ DO JK = KKTB , KKTE
+ PFPR(:,:,JK,6)=ZWSED(:,:,JK)
+ ENDDO
+ENDIF
+PINPRG(:,:) = ZWSED(:,:,KKB)/XRHOLW ! in m/s
+!
+!* 2.6 for hail
+!
+IF ( KRR == 7 ) THEN
+ CALL INTERNAL_SEDIM_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKTB, KKTE, KKL, &
+ &PRHODREF, PDZZ, ZW, PPABST, PTHT, PTSTEP, &
+ &7, &
+ &PRHT, PRHS, ZWSED)
+ IF (PRESENT(PFPR)) THEN
+ DO JK = KKTB , KKTE
+ PFPR(:,:,JK,7)=ZWSED(:,:,JK)
+ ENDDO
+ ENDIF
+ PINPRH(:,:) = ZWSED(:,:,KKB)/XRHOLW ! in m/s
+ENDIF
+!
+!
+CONTAINS
+ SUBROUTINE INTERNAL_SEDIM_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKTB, KKTE, KKL, &
+ &PRHODREF, PDZZ, PTSORHODZ, PPABST, PTHT, PTSTEP, &
+ &KSPE, &
+ &PRXT, PRXS, PWSED, PSEA, PTOWN)
+ !
+ !* 0. DECLARATIONS
+ ! ------------
+ !
+ use mode_tools, only: Countjv
+
+ USE MODD_RAIN_ICE_DESCR
+ USE MODD_RAIN_ICE_PARAM
+
+ USE MODI_GAMMA
+
+ IMPLICIT NONE
+ !
+ !* 0.1 Declarations of dummy arguments :
+ !
+ INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKT, KKE, KKTB, KKTE, KKL
+ REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF ! Reference density
+ REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
+ REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTSORHODZ ! TimeStep Over (Rhodref times delta Z)
+ REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST
+ REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT
+ REAL, INTENT(IN) :: PTSTEP
+ INTEGER, INTENT(IN) :: KSPE ! 1 for rc, 2 for rr...
+ REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRXT ! mr of specy X
+ REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRXS !Tendency of the specy KSPE
+ REAL, DIMENSION(KIT,KJT,0:KKT+1), INTENT(OUT) :: PWSED ! sedimentation flux
+ REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
+ REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PTOWN ! Fraction that is town
+ !
+ !* 0.2 declaration of local variables
+ !
+ !
+ character(len=10) :: yspe ! String for error message
+ INTEGER :: JK, JCOUNT, JL, JI, JJ
+ INTEGER, DIMENSION(SIZE(PRHODREF,1)*SIZE(PRHODREF,2)) :: I1, I2
+ REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),0:SIZE(PRHODREF,3)+1) &
+ :: ZWSEDW1, ZWSEDW2 ! sedimentation speed
+ REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2)) :: ZQP
+ REAL :: ZINVTSTEP, ZH, ZP1, ZP2, ZZWLBDA, ZZWLBDC, ZZCC
+ REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: ZCONC3D ! droplet condensation
+ REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: &
+ ZRAY, & ! Cloud Mean radius
+ ZLBC, & ! XLBC weighted by sea fraction
+ ZFSEDC
+ REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2)) &
+ :: ZCONC_TMP ! Weighted concentration
+ REAL :: ZFSED, ZEXSED
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !
+ !* 1. Parameters for cloud sedimentation
+ !
+ IF(KSPE==2) THEN
+ ZRAY(:,:,:) = 0.
+ ZLBC(:,:,:) = XLBC(1)
+ ZFSEDC(:,:,:) = XFSEDC(1)
+ ZCONC3D(:,:,:)= XCONC_LAND
+ ZCONC_TMP(:,:)= XCONC_LAND
+ IF (PRESENT(PSEA)) THEN
+ ZCONC_TMP(:,:)=PSEA(:,:)*XCONC_SEA+(1.-PSEA(:,:))*XCONC_LAND
+ DO JK=KKTB,KKTE
+ ZLBC(:,:,JK) = PSEA(:,:)*XLBC(2)+(1.-PSEA(:,:))*XLBC(1)
+ ZFSEDC(:,:,JK) = (PSEA(:,:)*XFSEDC(2)+(1.-PSEA(:,:))*XFSEDC(1))
+ ZFSEDC(:,:,JK) = MAX(MIN(XFSEDC(1),XFSEDC(2)),ZFSEDC(:,:,JK))
+ ZCONC3D(:,:,JK)= (1.-PTOWN(:,:))*ZCONC_TMP(:,:)+PTOWN(:,:)*XCONC_URBAN
+ ZRAY(:,:,JK) = 0.5*((1.-PSEA(:,:))*GAMMA(XNUC+1.0/XALPHAC)/(GAMMA(XNUC)) + &
+ PSEA(:,:)*GAMMA(XNUC2+1.0/XALPHAC2)/(GAMMA(XNUC2)))
+ END DO
+ ELSE
+ ZCONC3D(:,:,:) = XCONC_LAND
+ ZRAY(:,:,:) = 0.5*(GAMMA(XNUC+1.0/XALPHAC)/(GAMMA(XNUC)))
+ END IF
+ ZRAY(:,:,:) = MAX(1.,ZRAY(:,:,:))
+ ZLBC(:,:,:) = MAX(MIN(XLBC(1),XLBC(2)),ZLBC(:,:,:))
+ ENDIF
+ !
+ !* 2. compute the fluxes
+ !
+ !
+ ZINVTSTEP = 1./PTSTEP
+ PWSED(:,:,:) = 0.
+ ZWSEDW1(:,:,:) = 0.
+ ZWSEDW2(:,:,:) = 0.
+ ! calculation of ZP1, ZP2 and sedimentation flux
+ DO JK = KKE , KKB, -1*KKL
+ !estimation of q' taking into account incomming PWSED
+ ZQP(:,:)=PWSED(:,:,JK+KKL)*PTSORHODZ(:,:,JK)
+ JCOUNT=COUNTJV( (PRXT(:,:,JK) > XRTMIN(KSPE)) .OR. (ZQP(:,:) > XRTMIN(KSPE)) ,I1(:),I2(:))
+ IF(KSPE==2) THEN
+ !******* for cloud
+ DO JL=1, JCOUNT
+ JI=I1(JL)
+ JJ=I2(JL)
+ !calculation of w
+ IF(PRXT(JI,JJ,JK) > XRTMIN(KSPE)) THEN
+ ZZWLBDA=6.6E-8*(101325./PPABST(JI,JJ,JK))*(PTHT(JI,JJ,JK)/293.15)
+ ZZWLBDC=(ZLBC(JI,JJ,JK)*ZCONC3D(JI,JJ,JK) &
+ &/(PRHODREF(JI,JJ,JK)*PRXT(JI,JJ,JK)))**XLBEXC
+ ZZCC=XCC*(1.+1.26*ZZWLBDA*ZZWLBDC/ZRAY(JI,JJ,JK)) !! ZCC : Fall speed
+ ZWSEDW1 (JI,JJ,JK)=PRHODREF(JI,JJ,JK)**(-XCEXVT ) * &
+ & ZZWLBDC**(-XDC)*ZZCC*ZFSEDC(JI,JJ,JK)
+ ENDIF
+ IF ( ZQP(JI,JJ) > XRTMIN(KSPE) ) THEN
+ ZZWLBDA=6.6E-8*(101325./PPABST(JI,JJ,JK))*(PTHT(JI,JJ,JK)/293.15)
+ ZZWLBDC=(ZLBC(JI,JJ,JK)*ZCONC3D(JI,JJ,JK) &
+ &/(PRHODREF(JI,JJ,JK)*ZQP(JI,JJ)))**XLBEXC
+ ZZCC=XCC*(1.+1.26*ZZWLBDA*ZZWLBDC/ZRAY(JI,JJ,JK)) !! ZCC : Fall speed
+ ZWSEDW2 (JI,JJ,JK)=PRHODREF(JI,JJ,JK)**(-XCEXVT ) * &
+ & ZZWLBDC**(-XDC)*ZZCC*ZFSEDC(JI,JJ,JK)
+ ENDIF
+ ENDDO
+ ELSEIF(KSPE==4) THEN
+ ! ******* for pristine ice
+ DO JL=1, JCOUNT
+ JI=I1(JL)
+ JJ=I2(JL)
+ !calculation of w
+ IF ( PRXT(JI,JJ,JK) > MAX(XRTMIN(KSPE),1.0E-7 ) ) THEN
+ ZWSEDW1 (JI,JJ,JK)= XFSEDI * &
+ & PRHODREF(JI,JJ,JK)**(-XCEXVT) * & ! McF&H
+ & MAX( 0.05E6,-0.15319E6-0.021454E6* &
+ & ALOG(PRHODREF(JI,JJ,JK)*PRXT(JI,JJ,JK)) )**XEXCSEDI
+ ENDIF
+ IF ( ZQP(JI,JJ) > MAX(XRTMIN(KSPE),1.0E-7 ) ) THEN
+ ZWSEDW2 (JI,JJ,JK)= XFSEDI * &
+ & PRHODREF(JI,JJ,JK)**(-XCEXVT) * & ! McF&H
+ & MAX( 0.05E6,-0.15319E6-0.021454E6* &
+ & ALOG(PRHODREF(JI,JJ,JK)*ZQP(JI,JJ)) )**XEXCSEDI
+ ENDIF
+ ENDDO
+ ELSE
+ ! ******* for other species
+ IF(KSPE==3) THEN
+ ZFSED=XFSEDR
+ ZEXSED=XEXSEDR
+ ELSEIF(KSPE==5) THEN
+ ZFSED=XFSEDS
+ ZEXSED=XEXSEDS
+ ELSEIF(KSPE==6) THEN
+ ZFSED=XFSEDG
+ ZEXSED=XEXSEDG
+ ELSEIF(KSPE==7) THEN
+ ZFSED=XFSEDH
+ ZEXSED=XEXSEDH
+ ELSE
+ write( yspe, '( I10 )' ) kspe
+ call Print_msg( NVERB_FATAL, 'GEN', 'ICE4_SEDIMENTATION_STAT', &
+ 'no sedimentation parameter for KSPE='//trim(yspe) )
+ ENDIF
+ DO JL=1, JCOUNT
+ JI=I1(JL)
+ JJ=I2(JL)
+ !calculation of w
+ IF ( PRXT(JI,JJ,JK) > XRTMIN(KSPE) ) THEN
+ ZWSEDW1 (JI,JJ,JK)= ZFSED *PRXT(JI,JJ,JK)**(ZEXSED-1)* &
+ PRHODREF(JI,JJ,JK)**(ZEXSED-XCEXVT-1)
+ ENDIF
+ IF ( ZQP(JI,JJ) > XRTMIN(KSPE) ) THEN
+ ZWSEDW2 (JI,JJ,JK)= ZFSED *ZQP(JI,JJ)**(ZEXSED-1)* &
+ PRHODREF(JI,JJ,JK)**(ZEXSED-XCEXVT-1)
+ ENDIF
+ ENDDO
+ ENDIF
+ DO JJ = KJB, KJE
+ DO JI = KIB, KIE
+ ZH=PDZZ(JI,JJ,JK)
+ ZP1 = MIN(1., ZWSEDW1(JI,JJ,JK) * PTSTEP / ZH )
+ IF (ZWSEDW2(JI,JJ,JK) /= 0.) THEN
+ ZP2 = MAX(0.,1 - ZH &
+ & / (PTSTEP*ZWSEDW2(JI,JJ,JK)) )
+ ELSE
+ ZP2 = 0.
+ ENDIF
+ PWSED (JI,JJ,JK)=ZP1*PRHODREF(JI,JJ,JK)*&
+ &ZH*PRXT(JI,JJ,JK)&
+ &* ZINVTSTEP+ ZP2 * PWSED (JI,JJ,JK+KKL)
+ ENDDO
+ ENDDO
+ ENDDO
+ DO JK = KKTB , KKTE
+ PRXS(:,:,JK) = PRXS(:,:,JK) + &
+ & PTSORHODZ(:,:,JK)*(PWSED(:,:,JK+KKL)-PWSED(:,:,JK))*ZINVTSTEP
+ ENDDO
+ END SUBROUTINE INTERNAL_SEDIM_STAT
+ !
+END SUBROUTINE ICE4_SEDIMENTATION_STAT
diff --git a/src/mesonh/micro/ice4_slow.f90 b/src/mesonh/micro/ice4_slow.f90
new file mode 100644
index 000000000..15d0cd78e
--- /dev/null
+++ b/src/mesonh/micro/ice4_slow.f90
@@ -0,0 +1,263 @@
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+MODULE MODI_ICE4_SLOW
+INTERFACE
+SUBROUTINE ICE4_SLOW(KSIZE, LDSOFT, PCOMPUTE, PRHODREF, PT,&
+ &PSSI, PLVFACT, PLSFACT, &
+ &PRVT, PRCT, PRIT, PRST, PRGT,&
+ &PLBDAS, PLBDAG,&
+ &PAI, PCJ, PHLI_HCF, PHLI_HRI,&
+ &PRCHONI, PRVDEPS, PRIAGGS, PRIAUTS, PRVDEPG, &
+ &PA_TH, PA_RV, PA_RC, PA_RI, PA_RS, PA_RG)
+IMPLICIT NONE
+INTEGER, INTENT(IN) :: KSIZE
+LOGICAL, INTENT(IN) :: LDSOFT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PSSI ! Supersaturation over ice
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAS ! Slope parameter of the aggregate distribution
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAG ! Slope parameter of the graupel distribution
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PAI ! Thermodynamical function
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLI_HCF !
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLI_HRI !
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCHONI ! Homogeneous nucleation
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRVDEPS ! Deposition on r_s
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIAGGS ! Aggregation on r_s
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIAUTS ! Autoconversion of r_i for r_s production
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRVDEPG ! Deposition on r_g
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RV
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RI
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RS
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RG
+END SUBROUTINE ICE4_SLOW
+END INTERFACE
+END MODULE MODI_ICE4_SLOW
+SUBROUTINE ICE4_SLOW(KSIZE, LDSOFT, PCOMPUTE, PRHODREF, PT, &
+ &PSSI, PLVFACT, PLSFACT, &
+ &PRVT, PRCT, PRIT, PRST, PRGT, &
+ &PLBDAS, PLBDAG, &
+ &PAI, PCJ, PHLI_HCF, PHLI_HRI,&
+ &PRCHONI, PRVDEPS, PRIAGGS, PRIAUTS, PRVDEPG, &
+ &PA_TH, PA_RV, PA_RC, PA_RI, PA_RS, PA_RG)
+!!
+!!** PURPOSE
+!! -------
+!! Computes the slow process
+!!
+!! AUTHOR
+!! ------
+!! S. Riette from the splitting of rain_ice source code (nov. 2014)
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY: XTT
+USE MODD_RAIN_ICE_DESCR, ONLY: XCEXVT,XRTMIN
+USE MODD_RAIN_ICE_PARAM, ONLY: X0DEPG,X0DEPS,X1DEPG,X1DEPS,XACRIAUTI,XALPHA3,XBCRIAUTI,XBETA3,XCOLEXIS,XCRIAUTI, &
+ XEX0DEPG,XEX0DEPS,XEX1DEPG,XEX1DEPS,XEXIAGGS,XFIAGGS,XHON,XTEXAUTI,XTIMAUTI
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KSIZE
+LOGICAL, INTENT(IN) :: LDSOFT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PSSI ! Supersaturation over ice
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAS ! Slope parameter of the aggregate distribution
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAG ! Slope parameter of the graupel distribution
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PAI ! Thermodynamical function
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLI_HCF !
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLI_HRI !
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCHONI ! Homogeneous nucleation
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRVDEPS ! Deposition on r_s
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIAGGS ! Aggregation on r_s
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIAUTS ! Autoconversion of r_i for r_s production
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRVDEPG ! Deposition on r_g
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RV
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RI
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RS
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RG
+!
+!* 0.2 declaration of local variables
+!
+REAL, DIMENSION(KSIZE) :: ZCRIAUTI, ZMASK
+REAL :: ZTIMAUTIC
+INTEGER :: JL
+!-------------------------------------------------------------------------------
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 3.2 compute the homogeneous nucleation source: RCHONI
+!
+DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., PT(JL)-(XTT-35.0))) * & ! PT(:)<XTT-35.0
+ &MAX(0., -SIGN(1., XRTMIN(2)-PRCT(JL))) * & ! PRCT(:)>XRTMIN(2)
+ &PCOMPUTE(JL)
+ENDDO
+IF(LDSOFT) THEN
+ DO JL=1, KSIZE
+ PRCHONI(JL) = PRCHONI(JL) * ZMASK(JL)
+ ENDDO
+ELSE
+ PRCHONI(:) = 0.
+ WHERE(ZMASK(:)==1.)
+ PRCHONI(:) = MIN(1000.,XHON*PRHODREF(:)*PRCT(:) &
+ *EXP( XALPHA3*(PT(:)-XTT)-XBETA3 ))
+ ENDWHERE
+ENDIF
+DO JL=1, KSIZE
+ PA_RI(JL) = PA_RI(JL) + PRCHONI(JL)
+ PA_RC(JL) = PA_RC(JL) - PRCHONI(JL)
+ PA_TH(JL) = PA_TH(JL) + PRCHONI(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ENDDO
+!
+!* 3.4 compute the deposition, aggregation and autoconversion sources
+!
+!
+!* 3.4.2 compute the riming-conversion of r_c for r_i production: RCAUTI
+!
+! ZZW(:) = 0.0
+! ZTIMAUTIC = SQRT( XTIMAUTI*XTIMAUTC )
+! WHERE ( (PRCT(:)>0.0) .AND. (PRIT(:)>0.0) .AND. (PRCS(:)>0.0) )
+! ZZW(:) = MIN( PRCS(:),ZTIMAUTIC * MAX( SQRT( PRIT(:)*PRCT(:) ),0.0 ) )
+! PRIS(:) = PRIS(:) + ZZW(:)
+! PRCS(:) = PRCS(:) - ZZW(:)
+! PTHS(:) = PTHS(:) + ZZW(:)*(PLSFACT(:)-PLVFACT(:)) ! f(L_f*(RCAUTI))
+! END WHERE
+!
+!* 3.4.3 compute the deposition on r_s: RVDEPS
+!
+DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(1)-PRVT(JL))) * & !PRVT(:)>XRTMIN(1)
+ &MAX(0., -SIGN(1., XRTMIN(5)-PRST(JL))) * & !PRST(:)>XRTMIN(5)
+ &PCOMPUTE(JL)
+ENDDO
+IF(LDSOFT) THEN
+ DO JL=1, KSIZE
+ PRVDEPS(JL)=PRVDEPS(JL)*ZMASK(JL)
+ ENDDO
+ELSE
+ PRVDEPS(:) = 0.
+ WHERE(ZMASK(:)==1.)
+ PRVDEPS(:) = ( PSSI(:)/(PRHODREF(:)*PAI(:)) ) * &
+ ( X0DEPS*PLBDAS(:)**XEX0DEPS + X1DEPS*PCJ(:)*PLBDAS(:)**XEX1DEPS )
+ END WHERE
+ENDIF
+DO JL=1, KSIZE
+ PA_RS(JL) = PA_RS(JL) + PRVDEPS(JL)
+ PA_RV(JL) = PA_RV(JL) - PRVDEPS(JL)
+ PA_TH(JL) = PA_TH(JL) + PRVDEPS(JL)*PLSFACT(JL)
+ENDDO
+!
+!* 3.4.4 compute the aggregation on r_s: RIAGGS
+!
+DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(4)-PRIT(JL))) * & ! PRIT(:)>XRTMIN(4)
+ &MAX(0., -SIGN(1., XRTMIN(5)-PRST(JL))) * & ! PRST(:)>XRTMIN(5)
+ &PCOMPUTE(JL)
+ENDDO
+IF(LDSOFT) THEN
+ DO JL=1, KSIZE
+ PRIAGGS(JL)=PRIAGGS(JL) * ZMASK(JL)
+ ENDDO
+ELSE
+ PRIAGGS(:) = 0.
+ WHERE(ZMASK(:)==1)
+ PRIAGGS(:) = XFIAGGS * EXP( XCOLEXIS*(PT(:)-XTT) ) &
+ * PRIT(:) &
+ * PLBDAS(:)**XEXIAGGS &
+ * PRHODREF(:)**(-XCEXVT)
+ END WHERE
+ENDIF
+DO JL=1, KSIZE
+ PA_RS(JL) = PA_RS(JL) + PRIAGGS(JL)
+ PA_RI(JL) = PA_RI(JL) - PRIAGGS(JL)
+ENDDO
+!
+!* 3.4.5 compute the autoconversion of r_i for r_s production: RIAUTS
+!
+DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(4)-PHLI_HRI(JL))) * & ! PHLI_HRI(:)>XRTMIN(4)
+ &MAX(0., -SIGN(1., 1.E-20-PHLI_HCF(JL))) * & ! PHLI_HCF(:) .GT. 0.
+ &PCOMPUTE(JL)
+ENDDO
+IF(LDSOFT) THEN
+ DO JL=1, KSIZE
+ PRIAUTS(JL) = PRIAUTS(JL) * ZMASK(JL)
+ ENDDO
+ELSE
+ PRIAUTS(:) = 0.
+ !ZCRIAUTI(:)=MIN(XCRIAUTI,10**(0.06*(PT(:)-XTT)-3.5))
+ ZCRIAUTI(:)=MIN(XCRIAUTI,10**(XACRIAUTI*(PT(:)-XTT)+XBCRIAUTI))
+ WHERE(ZMASK(:)==1.)
+ PRIAUTS(:) = XTIMAUTI * EXP( XTEXAUTI*(PT(:)-XTT) ) &
+ * MAX( PHLI_HRI(:)/PHLI_HCF(:)-ZCRIAUTI(:),0.0 )
+ PRIAUTS(:) = PHLI_HCF(:)*PRIAUTS(:)
+ END WHERE
+ENDIF
+DO JL=1, KSIZE
+ PA_RS(JL) = PA_RS(JL) + PRIAUTS(JL)
+ PA_RI(JL) = PA_RI(JL) - PRIAUTS(JL)
+ENDDO
+!
+!* 3.4.6 compute the deposition on r_g: RVDEPG
+!
+!
+DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(1)-PRVT(JL))) * & ! PRVT(:)>XRTMIN(1)
+ &MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JL))) * & ! PRGT(:)>XRTMIN(6)
+ &PCOMPUTE(JL)
+ENDDO
+IF(LDSOFT) THEN
+ DO JL=1, KSIZE
+ PRVDEPG(JL) = PRVDEPG(JL) * ZMASK(JL)
+ ENDDO
+ELSE
+ PRVDEPG(:) = 0.
+ WHERE(ZMASK(:)==1.)
+ PRVDEPG(:) = ( PSSI(:)/(PRHODREF(:)*PAI(:)) ) * &
+ ( X0DEPG*PLBDAG(:)**XEX0DEPG + X1DEPG*PCJ(:)*PLBDAG(:)**XEX1DEPG )
+ END WHERE
+ENDIF
+DO JL=1, KSIZE
+ PA_RG(JL) = PA_RG(JL) + PRVDEPG(JL)
+ PA_RV(JL) = PA_RV(JL) - PRVDEPG(JL)
+ PA_TH(JL) = PA_TH(JL) + PRVDEPG(JL)*PLSFACT(JL)
+ENDDO
+!
+!
+END SUBROUTINE ICE4_SLOW
diff --git a/src/mesonh/micro/ice4_tendencies.f90 b/src/mesonh/micro/ice4_tendencies.f90
new file mode 100644
index 000000000..49cd59923
--- /dev/null
+++ b/src/mesonh/micro/ice4_tendencies.f90
@@ -0,0 +1,620 @@
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+MODULE MODI_ICE4_TENDENCIES
+INTERFACE
+SUBROUTINE ICE4_TENDENCIES(KSIZE, KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, &
+ &KRR, ODSOFT, PCOMPUTE, &
+ &OWARM, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, &
+ &HSUBG_AUCV_RC, HSUBG_AUCV_RI, HSUBG_PR_PDF, &
+ &PEXN, PRHODREF, PLVFACT, PLSFACT, K1, K2, K3, &
+ &PPRES, PCF, PSIGMA_RC, &
+ &PCIT, &
+ &PT, PTHT, &
+ &PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, &
+ &PRVHENI_MR, PRRHONG_MR, PRIMLTC_MR, PRSRIMCG_MR, &
+ &PRCHONI, PRVDEPS, PRIAGGS, PRIAUTS, PRVDEPG, &
+ &PRCAUTR, PRCACCR, PRREVAV, &
+ &PRCRIMSS, PRCRIMSG, PRSRIMCG, PRRACCSS, PRRACCSG, PRSACCRG, PRSMLTG, PRCMLTSR, &
+ &PRICFRRG, PRRCFRIG, PRICFRR, PRCWETG, PRIWETG, PRRWETG, PRSWETG, &
+ &PRCDRYG, PRIDRYG, PRRDRYG, PRSDRYG, PRWETGH, PRWETGH_MR, PRGMLTR, &
+ &PRCWETH, PRIWETH, PRSWETH, PRGWETH, PRRWETH, &
+ &PRCDRYH, PRIDRYH, PRSDRYH, PRRDRYH, PRGDRYH, PRDRYHG, PRHMLTR, &
+ &PRCBERI, &
+ &PRS_TEND, PRG_TEND, PRH_TEND, PSSI, &
+ &PA_TH, PA_RV, PA_RC, PA_RR, PA_RI, PA_RS, PA_RG, PA_RH, &
+ &PB_TH, PB_RV, PB_RC, PB_RR, PB_RI, PB_RS, PB_RG, PB_RH, &
+ &PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, &
+ &PHLI_HCF, PHLI_LCF, PHLI_HRI, PHLI_LRI, PRAINFR)
+IMPLICIT NONE
+INTEGER, INTENT(IN) :: KSIZE, KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL
+INTEGER, INTENT(IN) :: KRR
+LOGICAL, INTENT(IN) :: ODSOFT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
+LOGICAL, INTENT(IN) :: OWARM
+CHARACTER(len=80), INTENT(IN) :: HSUBG_RC_RR_ACCR
+CHARACTER(len=80), INTENT(IN) :: HSUBG_RR_EVAP
+CHARACTER(len=4), INTENT(IN) :: HSUBG_AUCV_RC
+CHARACTER(len=80), INTENT(IN) :: HSUBG_AUCV_RI
+CHARACTER(len=80), INTENT(IN) :: HSUBG_PR_PDF ! pdf for subgrid precipitation
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PEXN
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
+INTEGER, DIMENSION(KSIZE), INTENT(IN) :: K1
+INTEGER, DIMENSION(KSIZE), INTENT(IN) :: K2
+INTEGER, DIMENSION(KSIZE), INTENT(IN) :: K3
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PPRES
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCF
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PSIGMA_RC
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PCIT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PTHT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRRT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHT
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRVHENI_MR
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRHONG_MR
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIMLTC_MR
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSRIMCG_MR
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCHONI
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRVDEPS
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIAGGS
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIAUTS
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRVDEPG
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCAUTR
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCACCR
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRREVAV
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCRIMSS
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCRIMSG
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSRIMCG
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRACCSS
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRACCSG
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSACCRG
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSMLTG
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCMLTSR
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRICFRRG
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRCFRIG
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRICFRR
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCWETG
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIWETG
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRWETG
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSWETG
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCDRYG
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIDRYG
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRDRYG
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSDRYG
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRWETGH
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRWETGH_MR
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRGMLTR
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCWETH
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIWETH
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSWETH
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRGWETH
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRWETH
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCDRYH
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIDRYH
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSDRYH
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRDRYH
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRGDRYH
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRDRYHG
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRHMLTR
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCBERI
+REAL, DIMENSION(KSIZE, 8), INTENT(INOUT) :: PRS_TEND
+REAL, DIMENSION(KSIZE, 8), INTENT(INOUT) :: PRG_TEND
+REAL, DIMENSION(KSIZE, 10), INTENT(INOUT) :: PRH_TEND
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PSSI
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_TH
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_RV
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_RC
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_RR
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_RI
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_RS
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_RG
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_RH
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PB_TH
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PB_RV
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PB_RC
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PB_RR
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PB_RI
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PB_RS
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PB_RG
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PB_RH
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_HCF
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_LCF
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_HRC
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_LRC
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLI_HCF
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLI_LCF
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLI_HRI
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLI_LRI
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PRAINFR ! Rain fraction
+END SUBROUTINE ICE4_TENDENCIES
+END INTERFACE
+END MODULE MODI_ICE4_TENDENCIES
+SUBROUTINE ICE4_TENDENCIES(KSIZE, KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, &
+ &KRR, ODSOFT, PCOMPUTE, &
+ &OWARM, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, &
+ &HSUBG_AUCV_RC, HSUBG_AUCV_RI, HSUBG_PR_PDF, &
+ &PEXN, PRHODREF, PLVFACT, PLSFACT, K1, K2, K3, &
+ &PPRES, PCF, PSIGMA_RC, &
+ &PCIT, &
+ &PT, PTHT, &
+ &PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, &
+ &PRVHENI_MR, PRRHONG_MR, PRIMLTC_MR, PRSRIMCG_MR, &
+ &PRCHONI, PRVDEPS, PRIAGGS, PRIAUTS, PRVDEPG, &
+ &PRCAUTR, PRCACCR, PRREVAV, &
+ &PRCRIMSS, PRCRIMSG, PRSRIMCG, PRRACCSS, PRRACCSG, PRSACCRG, PRSMLTG, PRCMLTSR, &
+ &PRICFRRG, PRRCFRIG, PRICFRR, PRCWETG, PRIWETG, PRRWETG, PRSWETG, &
+ &PRCDRYG, PRIDRYG, PRRDRYG, PRSDRYG, PRWETGH, PRWETGH_MR, PRGMLTR, &
+ &PRCWETH, PRIWETH, PRSWETH, PRGWETH, PRRWETH, &
+ &PRCDRYH, PRIDRYH, PRSDRYH, PRRDRYH, PRGDRYH, PRDRYHG, PRHMLTR, &
+ &PRCBERI, &
+ &PRS_TEND, PRG_TEND, PRH_TEND, PSSI, &
+ &PA_TH, PA_RV, PA_RC, PA_RR, PA_RI, PA_RS, PA_RG, PA_RH, &
+ &PB_TH, PB_RV, PB_RC, PB_RR, PB_RI, PB_RS, PB_RG, PB_RH, &
+ &PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, &
+ &PHLI_HCF, PHLI_LCF, PHLI_HRI, PHLI_LRI, PRAINFR)
+!!
+!!** PURPOSE
+!! -------
+!! Computes the tendencies
+!!
+!! AUTHOR
+!! ------
+!! S. Riette from the splitting of rain_ice source code (nov. 2014)
+!!
+!! MODIFICATIONS
+!! -------------
+!
+! P. Wautelet 29/05/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY: XALPI,XBETAI,XCI,XCPV,XEPSILO,XGAMI,XLSTT,XMD,XMV,XP00,XRV,XTT
+USE MODD_PARAM_ICE, ONLY: CSNOWRIMING
+USE MODD_RAIN_ICE_DESCR, ONLY: XLBDAS_MAX,XLBEXG,XLBEXH,XLBEXR,XLBEXS,XLBG,XLBH,XLBR,XLBS,XRTMIN
+USE MODD_RAIN_ICE_PARAM, ONLY: XSCFAC
+!
+USE MODI_ICE4_COMPUTE_PDF
+USE MODI_ICE4_FAST_RG
+USE MODI_ICE4_FAST_RH
+USE MODI_ICE4_FAST_RI
+USE MODI_ICE4_FAST_RS
+USE MODI_ICE4_NUCLEATION
+USE MODI_ICE4_RAINFR_VERT
+USE MODI_ICE4_RIMLTC
+USE MODI_ICE4_RRHONG
+USE MODI_ICE4_RSRIMCG_OLD
+USE MODI_ICE4_SLOW
+USE MODI_ICE4_WARM
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KSIZE, KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL
+INTEGER, INTENT(IN) :: KRR
+LOGICAL, INTENT(IN) :: ODSOFT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
+LOGICAL, INTENT(IN) :: OWARM
+CHARACTER(len=80), INTENT(IN) :: HSUBG_RC_RR_ACCR
+CHARACTER(len=80), INTENT(IN) :: HSUBG_RR_EVAP
+CHARACTER(len=4), INTENT(IN) :: HSUBG_AUCV_RC
+CHARACTER(len=80), INTENT(IN) :: HSUBG_AUCV_RI
+CHARACTER(len=80), INTENT(IN) :: HSUBG_PR_PDF ! pdf for subgrid precipitation
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PEXN
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
+INTEGER, DIMENSION(KSIZE), INTENT(IN) :: K1
+INTEGER, DIMENSION(KSIZE), INTENT(IN) :: K2
+INTEGER, DIMENSION(KSIZE), INTENT(IN) :: K3
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PPRES
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCF
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PSIGMA_RC
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PCIT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PTHT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRRT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHT
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRVHENI_MR
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRHONG_MR
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIMLTC_MR
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSRIMCG_MR
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCHONI
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRVDEPS
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIAGGS
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIAUTS
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRVDEPG
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCAUTR
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCACCR
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRREVAV
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCRIMSS
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCRIMSG
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSRIMCG
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRACCSS
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRACCSG
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSACCRG
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSMLTG
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCMLTSR
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRICFRRG
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRCFRIG
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRICFRR
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCWETG
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIWETG
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRWETG
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSWETG
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCDRYG
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIDRYG
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRDRYG
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSDRYG
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRWETGH
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRWETGH_MR
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRGMLTR
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCWETH
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIWETH
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSWETH
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRGWETH
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRWETH
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCDRYH
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIDRYH
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSDRYH
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRDRYH
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRGDRYH
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRDRYHG
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRHMLTR
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCBERI
+REAL, DIMENSION(KSIZE, 8), INTENT(INOUT) :: PRS_TEND
+REAL, DIMENSION(KSIZE, 8), INTENT(INOUT) :: PRG_TEND
+REAL, DIMENSION(KSIZE, 10), INTENT(INOUT) :: PRH_TEND
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PSSI
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_TH
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_RV
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_RC
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_RR
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_RI
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_RS
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_RG
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_RH
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PB_TH
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PB_RV
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PB_RC
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PB_RR
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PB_RI
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PB_RS
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PB_RG
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PB_RH
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_HCF
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_LCF
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_HRC
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_LRC
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLI_HCF
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLI_LCF
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLI_HRI
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLI_LRI
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PRAINFR ! Rain fraction
+!
+!* 0.2 declaration of local variables
+!
+REAL, DIMENSION(KSIZE) :: ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, &
+ & ZT, ZTHT, ZRHT, &
+ & ZZW, &
+ & ZKA, ZDV, ZAI, ZCJ, &
+ & ZRF, &
+ & ZLBDAR, ZLBDAS, ZLBDAG, ZLBDAH, ZLBDAR_RF, &
+ & ZRGSI, ZRGSI_MR
+REAL, DIMENSION(KIT,KJT,KKT) :: ZRRT3D, ZRST3D, ZRGT3D, ZRHT3D
+INTEGER :: JL
+REAL, DIMENSION(KSIZE) :: ZWETG ! 1. if graupel growths in wet mode, 0. otherwise
+
+PA_TH(:)=0.
+PA_RV(:)=0.
+PA_RC(:)=0.
+PA_RR(:)=0.
+PA_RI(:)=0.
+PA_RS(:)=0.
+PA_RG(:)=0.
+PA_RH(:)=0.
+PB_TH(:)=0.
+PB_RV(:)=0.
+PB_RC(:)=0.
+PB_RR(:)=0.
+PB_RI(:)=0.
+PB_RS(:)=0.
+PB_RG(:)=0.
+PB_RH(:)=0.
+!
+DO JL=1, KSIZE
+ ZRVT(JL)=PRVT(JL)
+ ZRCT(JL)=PRCT(JL)
+ ZRRT(JL)=PRRT(JL)
+ ZRIT(JL)=PRIT(JL)
+ ZRST(JL)=PRST(JL)
+ ZRGT(JL)=PRGT(JL)
+ ZTHT(JL)=PTHT(JL)
+ ZRHT(JL)=PRHT(JL)
+ ZT(JL)=PT(JL)
+ENDDO
+IF(ODSOFT) THEN
+ PRVHENI_MR(:)=0.
+ PRRHONG_MR(:)=0.
+ PRIMLTC_MR(:)=0.
+ PRSRIMCG_MR(:)=0.
+ELSE
+ !
+ !* 2. COMPUTES THE SLOW COLD PROCESS SOURCES
+ ! --------------------------------------
+ CALL ICE4_NUCLEATION(KSIZE, ODSOFT, PCOMPUTE==1., &
+ ZTHT, PPRES, PRHODREF, PEXN, PLSFACT, ZT, &
+ ZRVT, &
+ PCIT, PRVHENI_MR, PB_TH, PB_RV, PB_RI)
+ DO JL=1, KSIZE
+ ZRIT(JL)=ZRIT(JL) + PRVHENI_MR(JL)
+ ZRVT(JL)=ZRVT(JL) - PRVHENI_MR(JL)
+ ZTHT(JL)=ZTHT(JL) + PRVHENI_MR(JL)*PLSFACT(JL)
+ ZT(JL) = ZTHT(JL) * PEXN(JL)
+ ENDDO
+ !
+ !* 3.3 compute the spontaneous freezing source: RRHONG
+ !
+ CALL ICE4_RRHONG(KSIZE, ODSOFT, PCOMPUTE, &
+ &PEXN, PLVFACT, PLSFACT, &
+ &ZT, ZRRT, &
+ &ZTHT, &
+ &PRRHONG_MR, PB_TH, PB_RR, PB_RG)
+ DO JL=1, KSIZE
+ ZRGT(JL) = ZRGT(JL) + PRRHONG_MR(JL)
+ ZRRT(JL) = ZRRT(JL) - PRRHONG_MR(JL)
+ ZTHT(JL) = ZTHT(JL) + PRRHONG_MR(JL)*(PLSFACT(JL)-PLVFACT(JL)) ! f(L_f*(RRHONG))
+ ZT(JL) = ZTHT(JL) * PEXN(JL)
+ ENDDO
+ !
+ !* 7.1 cloud ice melting
+ !
+ CALL ICE4_RIMLTC(KSIZE, ODSOFT, PCOMPUTE, &
+ &PEXN, PLVFACT, PLSFACT, &
+ &ZT, &
+ &ZTHT, ZRIT, &
+ &PRIMLTC_MR, PB_TH, PB_RC, PB_RI)
+ DO JL=1, KSIZE
+ ZRCT(JL) = ZRCT(JL) + PRIMLTC_MR(JL)
+ ZRIT(JL) = ZRIT(JL) - PRIMLTC_MR(JL)
+ ZTHT(JL) = ZTHT(JL) - PRIMLTC_MR(JL)*(PLSFACT(JL)-PLVFACT(JL)) ! f(L_f*(-RIMLTC))
+ ZT(JL) = ZTHT(JL) * PEXN(JL)
+ ENDDO
+ !
+ ! 5.1.6 riming-conversion of the large sized aggregates into graupel (old parametrisation)
+ !
+ IF(CSNOWRIMING=='OLD ') THEN
+ ZLBDAS(:)=0.
+ WHERE(ZRST(:)>0.)
+ ZLBDAS(:) = MIN(XLBDAS_MAX, XLBS*(PRHODREF(:)*MAX(ZRST(:), XRTMIN(5)))**XLBEXS)
+ END WHERE
+ CALL ICE4_RSRIMCG_OLD(KSIZE, ODSOFT, PCOMPUTE==1., &
+ &PRHODREF, &
+ &ZLBDAS, &
+ &ZT, ZRCT, ZRST, &
+ &PRSRIMCG_MR, PB_RS, PB_RG)
+ DO JL=1, KSIZE
+ ZRST(JL) = ZRST(JL) - PRSRIMCG_MR(JL)
+ ZRGT(JL) = ZRGT(JL) + PRSRIMCG_MR(JL)
+ ENDDO
+ ELSE
+ PRSRIMCG_MR(:) = 0.
+ ENDIF
+ENDIF
+!
+!* Derived fields
+!
+IF(KSIZE>0) THEN
+ IF(.NOT. ODSOFT) THEN
+ ZZW(:) = EXP(XALPI-XBETAI/ZT(:)-XGAMI*ALOG(ZT(:)))
+ DO JL=1, KSIZE
+ PSSI(JL) = ZRVT(JL)*( PPRES(JL)-ZZW(JL) ) / ( XEPSILO * ZZW(JL) ) - 1.0
+ ! Supersaturation over ice
+ ZKA(JL) = 2.38E-2 + 0.0071E-2*(ZT(JL)-XTT) ! k_a
+ ZDV(JL) = 0.211E-4*(ZT(JL)/XTT)**1.94 * (XP00/PPRES(JL)) ! D_v
+ ZAI(JL) = (XLSTT+(XCPV-XCI)*(ZT(JL)-XTT))**2 / (ZKA(JL)*XRV*ZT(JL)**2) &
+ + ( XRV*ZT(JL) ) / (ZDV(JL)*ZZW(JL))
+ ZCJ(JL) = XSCFAC*PRHODREF(JL)**0.3 / SQRT(1.718E-5+0.0049E-5*(ZT(JL)-XTT))
+ ENDDO
+ ENDIF
+ !
+ !Cloud water split between high and low content part is done here
+ CALL ICE4_COMPUTE_PDF(KSIZE, HSUBG_AUCV_RC, HSUBG_AUCV_RI, HSUBG_PR_PDF,&
+ PRHODREF, ZRCT, ZRIT, PCF, ZT, PSIGMA_RC,&
+ PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC,&
+ PHLI_HCF, PHLI_LCF, PHLI_HRI, PHLI_LRI, ZRF)
+ IF(HSUBG_RC_RR_ACCR=='PRFR' .OR. HSUBG_RR_EVAP=='PRFR') THEN
+ !Diagnostic of precipitation fraction
+ PRAINFR(:,:,:) = 0.
+ ZRRT3D (:,:,:) = 0.
+ ZRST3D (:,:,:) = 0.
+ ZRGT3D (:,:,:) = 0.
+ ZRHT3D (:,:,:) = 0.
+ DO JL=1,KSIZE
+ PRAINFR(K1(JL), K2(JL), K3(JL)) = ZRF(JL)
+ ZRRT3D (K1(JL), K2(JL), K3(JL)) = ZRRT(JL)
+ ZRST3D (K1(JL), K2(JL), K3(JL)) = ZRST(JL)
+ ZRGT3D (K1(JL), K2(JL), K3(JL)) = ZRGT(JL)
+ END DO
+ IF (KRR==7) THEN
+ DO JL=1,KSIZE
+ ZRHT3D (K1(JL), K2(JL), K3(JL)) = ZRHT(JL)
+ ENDDO
+ ENDIF
+ CALL ICE4_RAINFR_VERT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, PRAINFR(:,:,:), ZRRT3D(:,:,:), &
+ &ZRST3D(:,:,:), ZRGT3D(:,:,:), ZRHT3D(:,:,:))
+ DO JL=1,KSIZE
+ ZRF(JL)=PRAINFR(K1(JL), K2(JL), K3(JL))
+ END DO
+ ELSE
+ PRAINFR(:,:,:)=1.
+ ZRF(:)=1.
+ ENDIF
+ !
+ !* compute the slope parameters
+ !
+ ZLBDAS(:)=0.
+ WHERE(ZRST(:)>0.)
+ ZLBDAS(:) = MIN(XLBDAS_MAX, XLBS*(PRHODREF(:)*MAX(ZRST(:), XRTMIN(5)))**XLBEXS)
+ END WHERE
+ ZLBDAG(:)=0.
+ WHERE(ZRGT(:)>0.)
+ ZLBDAG(:) = XLBG*(PRHODREF(:)*MAX(ZRGT(:), XRTMIN(6)))**XLBEXG
+ END WHERE
+ !ZLBDAR will be used when we consider rain diluted over the grid box
+ ZLBDAR(:)=0.
+ WHERE(ZRRT(:)>0.)
+ ZLBDAR(:) = XLBR*( PRHODREF(:)*MAX( ZRRT(:), XRTMIN(3)))**XLBEXR
+ END WHERE
+ !ZLBDAR_RF is used when we consider rain concentrated in its fraction
+ IF (HSUBG_RC_RR_ACCR=='PRFR' .OR. HSUBG_RR_EVAP=='PRFR') THEN
+ ZLBDAR_RF(:)=0.
+ WHERE(ZRRT(:)>0. .AND. ZRF(:)>0.)
+ ZLBDAR_RF(:) = XLBR*( PRHODREF(:) *MAX( ZRRT(:)/ZRF(:) , XRTMIN(3)))**XLBEXR
+ END WHERE
+ ELSE
+ ZLBDAR_RF(:) = ZLBDAR(:)
+ ENDIF
+ IF(KRR==7) THEN
+ ZLBDAH(:)=0.
+ WHERE(PRHT(:)>0.)
+ ZLBDAH(:) = XLBH*(PRHODREF(:)*MAX(PRHT(:), XRTMIN(7)))**XLBEXH
+ END WHERE
+ ENDIF
+ENDIF
+!
+!
+CALL ICE4_SLOW(KSIZE, ODSOFT, PCOMPUTE, PRHODREF, ZT, &
+ &PSSI, PLVFACT, PLSFACT, &
+ &ZRVT, ZRCT, ZRIT, ZRST, ZRGT, &
+ &ZLBDAS, ZLBDAG, &
+ &ZAI, ZCJ, PHLI_HCF, PHLI_HRI, &
+ &PRCHONI, PRVDEPS, PRIAGGS, PRIAUTS, PRVDEPG, &
+ &PA_TH, PA_RV, PA_RC, PA_RI, PA_RS, PA_RG)
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 3. COMPUTES THE SLOW WARM PROCESS SOURCES
+! --------------------------------------
+!
+!
+IF(OWARM) THEN ! Check if the formation of the raindrops by the slow
+ ! warm processes is allowed
+ CALL ICE4_WARM(KSIZE, ODSOFT, PCOMPUTE, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, &
+ &PRHODREF, PLVFACT, ZT, PPRES, ZTHT,&
+ &ZLBDAR, ZLBDAR_RF, ZKA, ZDV, ZCJ, &
+ &PHLC_LCF, PHLC_HCF, PHLC_LRC, PHLC_HRC, &
+ &PCF, ZRF, &
+ &ZRVT, ZRCT, ZRRT, &
+ &PRCAUTR, PRCACCR, PRREVAV, &
+ &PA_TH, PA_RV, PA_RC, PA_RR)
+ELSE
+ PRCAUTR(:)=0.
+ PRCACCR(:)=0.
+ PRREVAV(:)=0.
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 4. COMPUTES THE FAST COLD PROCESS SOURCES FOR r_s
+! ----------------------------------------------
+!
+CALL ICE4_FAST_RS(KSIZE, ODSOFT, PCOMPUTE, &
+ &PRHODREF, PLVFACT, PLSFACT, PPRES, &
+ &ZDV, ZKA, ZCJ, &
+ &ZLBDAR, ZLBDAS, &
+ &ZT, ZRVT, ZRCT, ZRRT, ZRST, &
+ &PRIAGGS, &
+ &PRCRIMSS, PRCRIMSG, PRSRIMCG, &
+ &PRRACCSS, PRRACCSG, PRSACCRG, PRSMLTG, &
+ &PRCMLTSR, &
+ &PRS_TEND, &
+ &PA_TH, PA_RC, PA_RR, PA_RS, PA_RG)
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 5. COMPUTES THE FAST COLD PROCESS SOURCES FOR r_g
+! ------------------------------------------------------
+!
+DO JL=1, KSIZE
+ ZRGSI(JL) = PRVDEPG(JL) + PRSMLTG(JL) + PRRACCSG(JL) + &
+ & PRSACCRG(JL) + PRCRIMSG(JL) + PRSRIMCG(JL)
+ ZRGSI_MR(JL) = PRRHONG_MR(JL) + PRSRIMCG_MR(JL)
+ENDDO
+CALL ICE4_FAST_RG(KSIZE, ODSOFT, PCOMPUTE, KRR, &
+ &PRHODREF, PLVFACT, PLSFACT, PPRES, &
+ &ZDV, ZKA, ZCJ, PCIT, &
+ &ZLBDAR, ZLBDAS, ZLBDAG, &
+ &ZT, ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, &
+ &ZRGSI, ZRGSI_MR(:), &
+ &ZWETG, &
+ &PRICFRRG, PRRCFRIG, PRICFRR, PRCWETG, PRIWETG, PRRWETG, PRSWETG, &
+ &PRCDRYG, PRIDRYG, PRRDRYG, PRSDRYG, PRWETGH, PRWETGH_MR, PRGMLTR, &
+ &PRG_TEND, &
+ &PA_TH, PA_RC, PA_RR, PA_RI, PA_RS, PA_RG, PA_RH, PB_RG, PB_RH)
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 6. COMPUTES THE FAST COLD PROCESS SOURCES FOR r_h
+! ----------------------------------------------
+!
+IF (KRR==7) THEN
+ CALL ICE4_FAST_RH(KSIZE, ODSOFT, PCOMPUTE, ZWETG, &
+ &PRHODREF, PLVFACT, PLSFACT, PPRES, &
+ &ZDV, ZKA, ZCJ, &
+ &ZLBDAS, ZLBDAG, ZLBDAR, ZLBDAH, &
+ &ZT, ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, PRHT, &
+ &PRCWETH, PRIWETH, PRSWETH, PRGWETH, PRRWETH, &
+ &PRCDRYH, PRIDRYH, PRSDRYH, PRRDRYH, PRGDRYH, PRDRYHG, PRHMLTR, &
+ &PRH_TEND, &
+ &PA_TH, PA_RC, PA_RR, PA_RI, PA_RS, PA_RG, PA_RH)
+ELSE
+ PRCWETH(:)=0.
+ PRIWETH(:)=0.
+ PRSWETH(:)=0.
+ PRGWETH(:)=0.
+ PRRWETH(:)=0.
+ PRCDRYH(:)=0.
+ PRIDRYH(:)=0.
+ PRSDRYH(:)=0.
+ PRRDRYH(:)=0.
+ PRGDRYH(:)=0.
+ PRDRYHG(:)=0.
+ PRHMLTR(:)=0.
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 7. COMPUTES SPECIFIC SOURCES OF THE WARM AND COLD CLOUDY SPECIES
+! -------------------------------------------------------------
+!
+CALL ICE4_FAST_RI(KSIZE, ODSOFT, PCOMPUTE, &
+ &PRHODREF, PLVFACT, PLSFACT, &
+ &ZAI, ZCJ, PCIT, &
+ &PSSI, &
+ &ZRCT, ZRIT, &
+ &PRCBERI, PA_TH, PA_RC, PA_RI)
+!
+!
+END SUBROUTINE ICE4_TENDENCIES
diff --git a/src/mesonh/micro/ice4_warm.f90 b/src/mesonh/micro/ice4_warm.f90
new file mode 100644
index 000000000..aa61b1dac
--- /dev/null
+++ b/src/mesonh/micro/ice4_warm.f90
@@ -0,0 +1,316 @@
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+MODULE MODI_ICE4_WARM
+INTERFACE
+SUBROUTINE ICE4_WARM(KSIZE, LDSOFT, PCOMPUTE, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, &
+ PRHODREF, PLVFACT, PT, PPRES, PTHT, &
+ PLBDAR, PLBDAR_RF, PKA, PDV, PCJ, &
+ PHLC_LCF, PHLC_HCF, PHLC_LRC, PHLC_HRC, &
+ PCF, PRF, &
+ PRVT, PRCT, PRRT, &
+ PRCAUTR, PRCACCR, PRREVAV, &
+ PA_TH, PA_RV, PA_RC, PA_RR)
+IMPLICIT NONE
+INTEGER, INTENT(IN) :: KSIZE
+LOGICAL, INTENT(IN) :: LDSOFT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
+CHARACTER(len=80), INTENT(IN) :: HSUBG_RC_RR_ACCR ! subgrid rc-rr accretion
+CHARACTER(len=80), INTENT(IN) :: HSUBG_RR_EVAP ! subgrid rr evaporation
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PPRES ! absolute pressure at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAR ! Slope parameter of the raindrop distribution
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAR_RF!like PLBDAR but for the Rain Fraction part
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PKA ! Thermal conductivity of the air
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PDV ! Diffusivity of water vapor in the air
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLC_HCF ! HLCLOUDS : fraction of High Cloud Fraction in grid
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLC_LCF ! HLCLOUDS : fraction of Low Cloud Fraction in grid
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLC_HRC ! HLCLOUDS : LWC that is High LWC in grid
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLC_LRC ! HLCLOUDS : LWC that is Low LWC in grid
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCF ! Cloud fraction
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRF ! Rain fraction
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCAUTR ! Autoconversion of r_c for r_r production
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCACCR ! Accretion of r_c for r_r production
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRREVAV ! Evaporation of r_r
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RV
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RR
+END SUBROUTINE ICE4_WARM
+END INTERFACE
+END MODULE MODI_ICE4_WARM
+SUBROUTINE ICE4_WARM(KSIZE, LDSOFT, PCOMPUTE, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, &
+ PRHODREF, PLVFACT, PT, PPRES, PTHT, &
+ PLBDAR, PLBDAR_RF, PKA, PDV, PCJ, &
+ PHLC_LCF, PHLC_HCF, PHLC_LRC, PHLC_HRC, &
+ PCF, PRF, &
+ PRVT, PRCT, PRRT, &
+ PRCAUTR, PRCACCR, PRREVAV, &
+ PA_TH, PA_RV, PA_RC, PA_RR)
+!!
+!!** PURPOSE
+!! -------
+!! Computes the warm process
+!!
+!! AUTHOR
+!! ------
+!! S. Riette from the plitting of rain_ice source code (nov. 2014)
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY: XALPW,XBETAW,XCL,XCPD,XCPV,XGAMW,XLVTT,XMD,XMV,XRV,XTT,XEPSILO
+USE MODD_RAIN_ICE_DESCR, ONLY: XCEXVT,XRTMIN
+USE MODD_RAIN_ICE_PARAM, ONLY: X0EVAR,X1EVAR,XCRIAUTC,XEX0EVAR,XEX1EVAR,XEXCACCR,XFCACCR,XTIMAUTC
+!
+USE MODE_MSG
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KSIZE
+LOGICAL, INTENT(IN) :: LDSOFT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
+CHARACTER(len=80), INTENT(IN) :: HSUBG_RC_RR_ACCR ! subgrid rc-rr accretion
+CHARACTER(len=80), INTENT(IN) :: HSUBG_RR_EVAP ! subgrid rr evaporation
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PPRES ! absolute pressure at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAR ! Slope parameter of the raindrop distribution
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAR_RF!like PLBDAR but for the Rain Fraction part
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PKA ! Thermal conductivity of the air
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PDV ! Diffusivity of water vapor in the air
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLC_HCF ! HLCLOUDS : fraction of High Cloud Fraction in grid
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLC_LCF ! HLCLOUDS : fraction of Low Cloud Fraction in grid
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLC_HRC ! HLCLOUDS : LWC that is High LWC in grid
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLC_LRC ! HLCLOUDS : LWC that is Low LWC in grid
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCF ! Cloud fraction
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRF ! Rain fraction
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCAUTR ! Autoconversion of r_c for r_r production
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCACCR ! Accretion of r_c for r_r production
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRREVAV ! Evaporation of r_r
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RV
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RR
+!
+!* 0.2 declaration of local variables
+!
+REAL, DIMENSION(KSIZE) :: ZZW2, ZZW3, ZZW4
+REAL, DIMENSION(KSIZE) :: ZUSW ! Undersaturation over water
+REAL, DIMENSION(KSIZE) :: ZTHLT ! Liquid potential temperature
+REAL, DIMENSION(KSIZE) :: ZMASK, ZMASK1, ZMASK2
+INTEGER :: JL
+!-------------------------------------------------------------------------------
+!
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 4.2 compute the autoconversion of r_c for r_r production: RCAUTR
+!
+DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(2)-PHLC_HRC(JL))) * & ! PHLC_HRC(:)>XRTMIN(2)
+ &MAX(0., -SIGN(1., 1.E-20-PHLC_HCF(JL))) * & ! PHLC_HCF(:) .GT. 0.
+ &PCOMPUTE(JL)
+ENDDO
+IF(LDSOFT) THEN
+ DO JL=1, KSIZE
+ PRCAUTR(JL)=PRCAUTR(JL)*ZMASK(JL)
+ ENDDO
+ELSE
+ PRCAUTR(:) = 0.
+ WHERE(ZMASK(:)==1.)
+ PRCAUTR(:) = XTIMAUTC*MAX(PHLC_HRC(:)/PHLC_HCF(:) - XCRIAUTC/PRHODREF(:), 0.0)
+ PRCAUTR(:) = PHLC_HCF(:)*PRCAUTR(:)
+ END WHERE
+ENDIF
+DO JL=1, KSIZE
+ PA_RC(JL) = PA_RC(JL) - PRCAUTR(JL)
+ PA_RR(JL) = PA_RR(JL) + PRCAUTR(JL)
+ENDDO
+!
+!
+!* 4.3 compute the accretion of r_c for r_r production: RCACCR
+!
+IF (HSUBG_RC_RR_ACCR=='NONE') THEN
+ !CLoud water and rain are diluted over the grid box
+ DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(2)-PRCT(JL))) * & ! PRCT(:)>XRTMIN(2)
+ &MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JL))) * & ! PRRT(:)>XRTMIN(3)
+ &PCOMPUTE(JL)
+ ENDDO
+ IF(LDSOFT) THEN
+ DO JL=1, KSIZE
+ PRCACCR(JL)=PRCACCR(JL) * ZMASK(JL)
+ ENDDO
+ ELSE
+ PRCACCR(:) = 0.
+ WHERE(ZMASK(:)==1.)
+ PRCACCR(:) = XFCACCR * PRCT(:) &
+ * PLBDAR(:)**XEXCACCR &
+ * PRHODREF(:)**(-XCEXVT)
+ END WHERE
+ ENDIF
+
+ELSEIF (HSUBG_RC_RR_ACCR=='PRFR') THEN
+ !Cloud water is concentrated over its fraction with possibly to parts with high and low content as set for autoconversion
+ !Rain is concnetrated over its fraction
+ !Rain in high content area fraction: PHLC_HCF
+ !Rain in low content area fraction:
+ ! if PRF<PCF (rain is entirely falling in cloud): PRF-PHLC_HCF
+ ! if PRF>PCF (rain is falling in cloud and in clear sky): PCF-PHLC_HCF
+ ! => min(PCF, PRF)-PHLC_HCF
+ DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(2)-PRCT(JL))) * & ! PRCT(:)>XRTMIN(2)
+ &MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JL))) * & ! PRRT(:)>XRTMIN(3)
+ &PCOMPUTE(JL)
+ ZMASK1(JL)=ZMASK(JL) * &
+ &MAX(0., -SIGN(1., XRTMIN(2)-PHLC_HRC(JL))) * & ! PHLC_HRC(:)>XRTMIN(2)
+ &MAX(0., -SIGN(1., 1.E-20-PHLC_HCF(JL))) ! PHLC_HCF(:)>0.
+ ZMASK2(JL)=ZMASK(JL) * &
+ &MAX(0., -SIGN(1., XRTMIN(2)-PHLC_LRC(JL))) * & ! PHLC_LRC(:)>XRTMIN(2)
+ &MAX(0., -SIGN(1., 1.E-20-PHLC_LCF(JL))) ! PHLC_LCF(:)>0.
+ ENDDO
+ IF(LDSOFT) THEN
+ DO JL=1, KSIZE
+ PRCACCR(JL)=PRCACCR(JL) * MIN(1., ZMASK1(JL)+ZMASK2(JL))
+ ENDDO
+ ELSE
+ PRCACCR(:)=0.
+ WHERE(ZMASK1(:)==1.)
+ !Accretion due to rain falling in high cloud content
+ PRCACCR(:) = XFCACCR * ( PHLC_HRC(:)/PHLC_HCF(:) ) &
+ * PLBDAR_RF(:)**XEXCACCR &
+ * PRHODREF(:)**(-XCEXVT) &
+ * PHLC_HCF
+ END WHERE
+ WHERE(ZMASK2(:)==1.)
+ !We add acrretion due to rain falling in low cloud content
+ PRCACCR(:) = PRCACCR(:) + XFCACCR * ( PHLC_LRC(:)/PHLC_LCF(:) ) &
+ * PLBDAR_RF(:)**XEXCACCR &
+ * PRHODREF(:)**(-XCEXVT) &
+ * (MIN(PCF(:), PRF(:))-PHLC_HCF(:))
+ END WHERE
+ ENDIF
+ELSE
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','ICE4_WARM','wrong HSUBG_RC_RR_ACCR case')
+ENDIF
+DO JL=1, KSIZE
+ PA_RC(JL) = PA_RC(JL) - PRCACCR(JL)
+ PA_RR(JL) = PA_RR(JL) + PRCACCR(JL)
+ENDDO
+!
+!* 4.4 compute the evaporation of r_r: RREVAV
+!
+IF (HSUBG_RR_EVAP=='NONE') THEN
+ DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JL))) * & ! PRRT(:)>XRTMIN(3)
+ &MAX(0., SIGN(1., XRTMIN(2)-PRCT(JL))) * & ! PRCT(:)<=XRTMIN(2)
+ &PCOMPUTE(JL)
+ ENDDO
+ IF(LDSOFT) THEN
+ DO JL=1, KSIZE
+ PRREVAV(JL)=PRREVAV(JL)*ZMASK(JL)
+ ENDDO
+ ELSE
+ PRREVAV(:) = 0.
+ !Evaporation only when there's no cloud (RC must be 0)
+ WHERE(ZMASK(:)==1.)
+ PRREVAV(:) = EXP( XALPW - XBETAW/PT(:) - XGAMW*ALOG(PT(:) ) ) ! es_w
+ ZUSW(:) = 1.0 - PRVT(:)*( PPRES(:)-PRREVAV(:) ) / ( XEPSILO * PRREVAV(:) )
+ ! Undersaturation over water
+ PRREVAV(:) = ( XLVTT+(XCPV-XCL)*(PT(:)-XTT) )**2 / ( PKA(:)*XRV*PT(:)**2 ) &
+ + ( XRV*PT(:) ) / ( PDV(:)*PRREVAV(:) )
+ PRREVAV(:) = ( MAX( 0.0,ZUSW(:) )/(PRHODREF(:)*PRREVAV(:)) ) * &
+ ( X0EVAR*PLBDAR(:)**XEX0EVAR+X1EVAR*PCJ(:)*PLBDAR(:)**XEX1EVAR )
+ END WHERE
+ ENDIF
+
+ELSEIF (HSUBG_RR_EVAP=='CLFR' .OR. HSUBG_RR_EVAP=='PRFR') THEN
+ !Evaporation in clear sky part
+ !With CLFR, rain is diluted over the grid box
+ !With PRFR, rain is concentrated in its fraction
+ !Use temperature and humidity in clear sky part like Bechtold et al. (1993)
+ IF (HSUBG_RR_EVAP=='CLFR') THEN
+ ZZW4(:)=1. !Precipitation fraction
+ ZZW3(:)=PLBDAR(:)
+ ELSE
+ ZZW4(:)=PRF(:) !Precipitation fraction
+ ZZW3(:)=PLBDAR_RF(:)
+ ENDIF
+
+ !ATTENTION
+ !Il faudrait recalculer les variables PKA, PDV, PCJ en tenant compte de la température T^u
+ !Ces variables devraient être sorties de rain_ice_slow et on mettrait le calcul de T^u, T^s
+ !et plusieurs versions (comme actuellement, en ciel clair, en ciel nuageux) de PKA, PDV, PCJ dans rain_ice
+ !On utiliserait la bonne version suivant l'option NONE, CLFR... dans l'évaporation et ailleurs
+ DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JL))) * & ! PRRT(:)>XRTMIN(3)
+ &MAX(0., -SIGN(1., PCF(JL)-ZZW4(JL))) * & ! ZZW4(:) > PCF(:)
+ &PCOMPUTE(JL)
+ ENDDO
+ IF(LDSOFT) THEN
+ DO JL=1, KSIZE
+ PRREVAV(JL)=PRREVAV(JL)*ZMASK(JL)
+ ENDDO
+ ELSE
+ PRREVAV(:) = 0.
+ WHERE(ZMASK(:)==1)
+ ! outside the cloud (environment) the use of T^u (unsaturated) instead of T
+ ! Bechtold et al. 1993
+ !
+ ! T_l
+ ZTHLT(:) = PTHT(:) - XLVTT*PTHT(:)/XCPD/PT(:)*PRCT(:)
+ !
+ ! T^u = T_l = theta_l * (T/theta)
+ ZZW2(:) = ZTHLT(:) * PT(:) / PTHT(:)
+ !
+ ! es_w with new T^u
+ PRREVAV(:) = EXP( XALPW - XBETAW/ZZW2(:) - XGAMW*ALOG(ZZW2(:) ) )
+ !
+ ! S, Undersaturation over water (with new theta^u)
+ ZUSW(:) = 1.0 - PRVT(:)*( PPRES(:)-PRREVAV(:) ) / ( XEPSILO * PRREVAV(:) )
+ !
+ PRREVAV(:) = ( XLVTT+(XCPV-XCL)*(ZZW2(:)-XTT) )**2 / ( PKA(:)*XRV*ZZW2(:)**2 ) &
+ + ( XRV*ZZW2(:) ) / ( PDV(:)*PRREVAV(:) )
+ !
+ PRREVAV(:) = MAX( 0.0,ZUSW(:) )/(PRHODREF(:)*PRREVAV(:)) * &
+ ( X0EVAR*ZZW3(:)**XEX0EVAR+X1EVAR*PCJ(:)*ZZW3(:)**XEX1EVAR )
+ !
+ PRREVAV(:) = PRREVAV(:)*(ZZW4(:)-PCF(:))
+ END WHERE
+ ENDIF
+
+ELSE
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','ICE4_WARM','wrong HSUBG_RR_EVAP case')
+END IF
+DO JL=1, KSIZE
+ PA_RR(JL) = PA_RR(JL) - PRREVAV(JL)
+ PA_RV(JL) = PA_RV(JL) + PRREVAV(JL)
+ PA_TH(JL) = PA_TH(JL) - PRREVAV(JL)*PLVFACT(JL)
+ENDDO
+!
+!
+END SUBROUTINE ICE4_WARM
diff --git a/src/mesonh/micro/ice_adjust.f90 b/src/mesonh/micro/ice_adjust.f90
new file mode 100644
index 000000000..8f5a8b35e
--- /dev/null
+++ b/src/mesonh/micro/ice_adjust.f90
@@ -0,0 +1,524 @@
+!MNH_LIC Copyright 1996-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ######################
+ MODULE MODI_ICE_ADJUST
+! ######################
+!
+INTERFACE
+!
+ SUBROUTINE ICE_ADJUST (KKA, KKU, KKL, KRR, HFRAC_ICE, HCONDENS, HLAMBDA3,&
+ HBUNAME, OSUBG_COND, OSIGMAS, HSUBG_MF_PDF, &
+ PTSTEP, PSIGQSAT, &
+ PRHODJ, PEXNREF, PRHODREF, PSIGS, PMFCONV, &
+ PPABST, PZZ, &
+ PEXN, PCF_MF, PRC_MF, PRI_MF, &
+ PRV, PRC, PRVS, PRCS, PTH, PTHS, PSRCS, PCLDFR, &
+ PRR, PRI, PRIS, PRS, PRG, PRH, &
+ POUT_RV, POUT_RC, POUT_RI, POUT_TH, &
+ PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF )
+!
+INTEGER, INTENT(IN) :: KKA !near ground array index
+INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE
+CHARACTER(len=80), INTENT(IN) :: HCONDENS
+CHARACTER(len=4), INTENT(IN) :: HLAMBDA3 ! formulation for lambda3 coeff
+CHARACTER(len=*), INTENT(IN) :: HBUNAME ! Name of the budget
+LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid
+ ! Condensation
+LOGICAL :: OSIGMAS ! Switch for Sigma_s:
+ ! use values computed in CONDENSATION
+ ! or that from turbulence scheme
+CHARACTER(len=*), INTENT(IN) :: HSUBG_MF_PDF
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
+ ! (single if cold start)
+REAL, INTENT(IN) :: PSIGQSAT ! coeff applied to qsat variance contribution
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV ! convective mass flux
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute Pressure at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! height of model layer
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXN ! Exner function
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCF_MF! Convective Mass Flux Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRI_MF! Convective Mass Flux ice mixing ratio
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRC_MF! Convective Mass Flux liquid mixing ratio
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRV ! Water vapor m.r. to adjust
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRC ! Cloud water m.r. to adjust
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTH ! Theta to adjust
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux
+ ! s'rc'/2Sigma_s2 at time t+1
+ ! multiplied by Lambda_3
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PCLDFR ! Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Cloud ice m.r. at t+1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRR ! Rain water m.r. to adjust
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRI ! Cloud ice m.r. to adjust
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRS ! Aggregate m.r. to adjust
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRG ! Graupel m.r. to adjust
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRH ! Hail m.r. to adjust
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: POUT_RV ! Adjusted value
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: POUT_RC ! Adjusted value
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: POUT_RI ! Adjusted value
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: POUT_TH ! Adjusted value
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PHLC_HRC
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PHLC_HCF
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PHLI_HRI
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PHLI_HCF
+!
+!
+END SUBROUTINE ICE_ADJUST
+!
+END INTERFACE
+!
+END MODULE MODI_ICE_ADJUST
+
+! ##########################################################################
+ SUBROUTINE ICE_ADJUST (KKA, KKU, KKL, KRR, HFRAC_ICE, HCONDENS, HLAMBDA3,&
+ HBUNAME, OSUBG_COND, OSIGMAS, HSUBG_MF_PDF, &
+ PTSTEP, PSIGQSAT, &
+ PRHODJ, PEXNREF, PRHODREF, PSIGS, PMFCONV, &
+ PPABST, PZZ, &
+ PEXN, PCF_MF, PRC_MF, PRI_MF, &
+ PRV, PRC, PRVS, PRCS, PTH, PTHS, PSRCS, PCLDFR, &
+ PRR, PRI, PRIS, PRS, PRG, PRH, &
+ POUT_RV, POUT_RC, POUT_RI, POUT_TH, &
+ PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF )
+! #########################################################################
+!
+!!**** *ICE_ADJUST* - compute the ajustment of water vapor in mixed-phase
+!! clouds
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the fast microphysical sources
+!! through a saturation ajustement procedure in case of mixed-phase clouds.
+!!
+!!
+!!** METHOD
+!! ------
+!! Langlois, Tellus, 1973 for the cloudless version.
+!! When cloud water is taken into account, refer to book 1 of the
+!! documentation.
+!!
+!!
+!!
+!! EXTERNAL
+!! --------
+!! None
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST
+!! XP00 ! Reference pressure
+!! XMD,XMV ! Molar mass of dry air and molar mass of vapor
+!! XRD,XRV ! Gaz constant for dry air, gaz constant for vapor
+!! XCPD,XCPV ! Cpd (dry air), Cpv (vapor)
+!! XCL ! Cl (liquid)
+!! XCI ! Ci (ice)
+!! XTT ! Triple point temperature
+!! XLVTT ! Vaporization heat constant
+!! XLSTT ! Sublimation heat constant
+!! XALPW,XBETAW,XGAMW ! Constants for saturation vapor over liquid
+!! ! pressure function
+!! XALPI,XBETAI,XGAMI ! Constants for saturation vapor over ice
+!! ! pressure function
+!! Module MODD_CONF
+!! CCONF
+!! Module MODD_BUDGET:
+!! NBUMOD
+!! CBUTYPE
+!! LBU_RTH
+!! LBU_RRV
+!! LBU_RRC
+!! LBU_RRI
+!!
+!!
+!! REFERENCE
+!! ---------
+!! Book 1 and Book2 of documentation ( routine ICE_ADJUST )
+!! Langlois, Tellus, 1973
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!!
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 06/12/96
+!! M. Tomasini 27/11/00 Change CND and DEP fct of the T instead of rc and ri
+!! Avoid the sub- and super-saturation before the ajustment
+!! Avoid rc>0 if T<T00 before the ajustment
+!! P Bechtold 12/02/02 change subgrid condensation
+!! JP Pinty 29/11/02 add ICE2 and IC4 cases
+!! (P. Jabouille) 27/05/04 safety test for case where esw/i(T)> pabs (~Z>40km)
+!! J.Pergaud and S.Malardel Add EDKF case
+!! S. Riette ice for EDKF
+!! 2012-02 Y. Seity, add possibility to run with reversed vertical levels
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! 2016-07 S. Riette: adjustement is now realized on state variables (PRV, PRC, PRI, PTH)
+!! whereas tendencies are still applied on S variables.
+!! This modification allows to call ice_adjust on T variable
+!! or to call it on S variables
+!! 2016-11 S. Riette: all-or-nothing adjustment now uses condensation
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+use modd_budget, only: lbudget_th, lbudget_rv, lbudget_rc, lbudget_ri, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RI, &
+ tbudgets
+USE MODD_CONF
+USE MODD_CST
+USE MODD_PARAMETERS
+
+use mode_budget, only: Budget_store_init, Budget_store_end
+USE MODD_RAIN_ICE_PARAM, ONLY : XCRIAUTC, XCRIAUTI, XACRIAUTI, XBCRIAUTI
+use mode_tools_ll, only: GET_INDICE_ll
+
+USE MODI_CONDENSATION
+USE MODI_GET_HALO
+
+IMPLICIT NONE
+!
+!
+!* 0.1 Declarations of dummy arguments :
+!
+!
+INTEGER, INTENT(IN) :: KKA !near ground array index
+INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE
+CHARACTER(len=80), INTENT(IN) :: HCONDENS
+CHARACTER(len=4), INTENT(IN) :: HLAMBDA3 ! formulation for lambda3 coeff
+CHARACTER(len=*), INTENT(IN) :: HBUNAME ! Name of the budget
+LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid
+ ! Condensation
+LOGICAL :: OSIGMAS ! Switch for Sigma_s:
+ ! use values computed in CONDENSATION
+ ! or that from turbulence scheme
+CHARACTER(len=*), INTENT(IN) :: HSUBG_MF_PDF
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
+ ! (single if cold start)
+REAL, INTENT(IN) :: PSIGQSAT ! coeff applied to qsat variance contribution
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV ! convective mass flux
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute Pressure at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! height of model layer
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXN ! Exner function
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCF_MF! Convective Mass Flux Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRC_MF! Convective Mass Flux liquid mixing ratio
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRI_MF! Convective Mass Flux ice mixing ratio
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRV ! Water vapor m.r. to adjust
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRC ! Cloud water m.r. to adjust
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTH ! Theta to adjust
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux
+ ! s'rc'/2Sigma_s2 at time t+1
+ ! multiplied by Lambda_3
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PCLDFR ! Cloud fraction
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT):: PRIS ! Cloud ice m.r. at t+1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRR ! Rain water m.r. to adjust
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRI ! Cloud ice m.r. to adjust
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRS ! Aggregate m.r. to adjust
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRG ! Graupel m.r. to adjust
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRH ! Hail m.r. to adjust
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: POUT_RV ! Adjusted value
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: POUT_RC ! Adjusted value
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: POUT_RI ! Adjusted value
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: POUT_TH ! Adjusted value
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PHLC_HRC
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PHLC_HCF
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PHLI_HRI
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PHLI_HCF
+!
+!* 0.2 Declarations of local variables :
+!
+!
+REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
+ :: ZT, & ! adjusted temperature
+ ZRV, ZRC, ZRI, & ! adjusted state
+ ZCPH, & ! guess of the CPh for the mixing
+ ZLV, & ! guess of the Lv at t+1
+ ZLS, & ! guess of the Ls at t+1
+ ZW1,ZW2, & ! Work arrays for intermediate fields
+ ZCRIAUT, & ! Autoconversion thresholds
+ ZHCF, ZHR
+!
+INTEGER :: IIU,IJU,IKU! dimensions of dummy arrays
+INTEGER :: IIB,IJB ! Horz index values of the first inner mass points
+INTEGER :: IIE,IJE ! Horz index values of the last inner mass points
+INTEGER :: IKB ! K index value of the first inner mass point
+INTEGER :: IKE ! K index value of the last inner mass point
+INTEGER :: JITER,ITERMAX ! iterative loop for first order adjustment
+!
+REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) :: ZSIGS,ZSRCS
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. PRELIMINARIES
+! -------------
+!
+if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), trim( hbuname ), pths(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), trim( hbuname ), prvs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), trim( hbuname ), prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), trim( hbuname ), pris(:, :, :) * prhodj(:, :, :) )
+
+IIU = SIZE(PEXNREF,1)
+IJU = SIZE(PEXNREF,2)
+IKU = SIZE(PEXNREF,3)
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+IKB=KKA+JPVEXT*KKL
+IKE=KKU-JPVEXT*KKL
+!
+ITERMAX=1
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. COMPUTE QUANTITIES WITH THE GUESS OF THE FUTURE INSTANT
+! -------------------------------------------------------
+!
+!
+! beginning of the iterative loop (to compute the adjusted state)
+ZRV(:,:,:)=PRV(:,:,:)
+ZRC(:,:,:)=PRC(:,:,:)
+ZRI(:,:,:)=PRI(:,:,:)
+ZT(:,:,:)=PTH(:,:,:) * PEXN(:,:,:)
+!
+DO JITER =1,ITERMAX
+ !
+ !* 2.3 compute the latent heat of vaporization Lv(T*) at t+1
+ ! and the latent heat of sublimation Ls(T*) at t+1
+ !
+ ZLV(:,:,:) = XLVTT + ( XCPV - XCL ) * ( ZT(:,:,:) -XTT )
+ ZLS(:,:,:) = XLSTT + ( XCPV - XCI ) * ( ZT(:,:,:) -XTT )
+ !
+ !* 2.4 compute the specific heat for moist air (Cph) at t+1
+ !
+ IF ( KRR == 7 ) THEN
+ ZCPH(:,:,:) = XCPD + XCPV * ZRV(:,:,:) &
+ + XCL * (ZRC(:,:,:) + PRR(:,:,:)) &
+ + XCI * (ZRI(:,:,:) + PRS(:,:,:) + PRG(:,:,:) + PRH(:,:,:))
+ ELSE IF( KRR == 6 ) THEN
+ ZCPH(:,:,:) = XCPD + XCPV * ZRV(:,:,:) &
+ + XCL * (ZRC(:,:,:) + PRR(:,:,:)) &
+ + XCI * (ZRI(:,:,:) + PRS(:,:,:) + PRG(:,:,:))
+ ELSE IF( KRR == 5 ) THEN
+ ZCPH(:,:,:) = XCPD + XCPV * ZRV(:,:,:) &
+ + XCL * (ZRC(:,:,:) + PRR(:,:,:)) &
+ + XCI * (ZRI(:,:,:) + PRS(:,:,:))
+ ELSE IF( KRR == 3 ) THEN
+ ZCPH(:,:,:) = XCPD + XCPV * ZRV(:,:,:) &
+ + XCL * (ZRC(:,:,:) + PRR(:,:,:))
+ ELSE IF( KRR == 2 ) THEN
+ ZCPH(:,:,:) = XCPD + XCPV * ZRV(:,:,:) &
+ + XCL * ZRC(:,:,:)
+ END IF
+ !
+ IF ( OSUBG_COND ) THEN
+ !
+ !* 3. SUBGRID CONDENSATION SCHEME
+ ! ---------------------------
+ !
+ ! PSRC= s'rci'/Sigma_s^2
+ ! ZT, ZRV, ZRC and ZRI are INOUT
+ CALL CONDENSATION(IIU, IJU, IKU, IIB, IIE, IJB, IJE, IKB, IKE, KKL, &
+ HFRAC_ICE, HCONDENS, HLAMBDA3, &
+ PPABST, PZZ, PRHODREF, ZT, ZRV, ZRC, ZRI, PRS, PRG, PSIGS, PMFCONV, PCLDFR, &
+ PSRCS, .TRUE., OSIGMAS, &
+ PSIGQSAT, PLV=ZLV, PLS=ZLS, PCPH=ZCPH, PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF)
+ ELSE
+ !
+ !* 4. ALL OR NOTHING CONDENSATION SCHEME
+ ! FOR MIXED-PHASE CLOUD
+ ! -----------------------------------------------
+ !
+ !
+ ! ZT, ZRV, ZRC and ZRI are INOUT
+ !
+ !CALL ADJUST_LANGLOIS(IIU, IJU, IKU, IIB, IIE, IJB, IJE, IKB, IKE, KKL, &
+ ! PPABST, ZT, ZRV, ZRC, ZRI, ZLV, ZLS, ZCPH) HFRAC_ICE must be implemented in Langlois before using it again
+ ZSIGS=0.
+ CALL CONDENSATION(IIU, IJU, IKU, IIB, IIE, IJB, IJE, IKB, IKE, KKL, &
+ HFRAC_ICE, HCONDENS, HLAMBDA3, &
+ PPABST, PZZ, PRHODREF, ZT, ZRV, ZRC, ZRI, PRS, PRG, ZSIGS, PMFCONV, PCLDFR, &
+ ZSRCS, .TRUE., OSIGMAS=.TRUE., &
+ PSIGQSAT=0., PLV=ZLV, PLS=ZLS, PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF)
+ ENDIF
+ENDDO ! end of the iterative loop
+!
+!* 5. COMPUTE THE SOURCES AND STORES THE CLOUD FRACTION
+! -------------------------------------------------
+!
+!
+!* 5.0 compute the variation of mixing ratio
+!
+ ! Rc - Rc*
+ZW1(:,:,:) = (ZRC(:,:,:) - PRC(:,:,:)) / PTSTEP ! Pcon = ----------
+ ! 2 Delta t
+
+ZW2(:,:,:) = (ZRI(:,:,:) - PRI(:,:,:)) / PTSTEP ! idem ZW1 but for Ri
+!
+!* 5.1 compute the sources
+!
+WHERE( ZW1(:,:,:) < 0.0 )
+ ZW1(:,:,:) = MAX ( ZW1(:,:,:), -PRCS(:,:,:) )
+ELSEWHERE
+ ZW1(:,:,:) = MIN ( ZW1(:,:,:), PRVS(:,:,:) )
+END WHERE
+PRVS(:,:,:) = PRVS(:,:,:) - ZW1(:,:,:)
+PRCS(:,:,:) = PRCS(:,:,:) + ZW1(:,:,:)
+PTHS(:,:,:) = PTHS(:,:,:) + &
+ ZW1(:,:,:) * ZLV(:,:,:) / (ZCPH(:,:,:) * PEXNREF(:,:,:))
+!
+WHERE( ZW2(:,:,:) < 0.0 )
+ ZW2(:,:,:) = MAX ( ZW2(:,:,:), -PRIS(:,:,:) )
+ELSEWHERE
+ ZW2(:,:,:) = MIN ( ZW2(:,:,:), PRVS(:,:,:) )
+END WHERE
+PRVS(:,:,:) = PRVS(:,:,:) - ZW2(:,:,:)
+PRIS(:,:,:) = PRIS(:,:,:) + ZW2(:,:,:)
+PTHS(:,:,:) = PTHS(:,:,:) + &
+ ZW2(:,:,:) * ZLS(:,:,:) / (ZCPH(:,:,:) * PEXNREF(:,:,:))
+!
+!
+!* 5.2 compute the cloud fraction PCLDFR
+!
+IF ( .NOT. OSUBG_COND ) THEN
+ WHERE (PRCS(:,:,:) + PRIS(:,:,:) > 1.E-12 / PTSTEP)
+ PCLDFR(:,:,:) = 1.
+ ELSEWHERE
+ PCLDFR(:,:,:) = 0.
+ ENDWHERE
+ IF ( SIZE(PSRCS,3) /= 0 ) THEN
+ PSRCS(:,:,:) = PCLDFR(:,:,:)
+ END IF
+ELSE
+ !We limit PRC_MF+PRI_MF to PRVS*PTSTEP to avoid negative humidity
+ ZW1(:,:,:)=PRC_MF(:,:,:)/PTSTEP
+ ZW2(:,:,:)=PRI_MF(:,:,:)/PTSTEP
+ WHERE(ZW1(:,:,:)+ZW2(:,:,:)>PRVS(:,:,:))
+ ZW1(:,:,:)=ZW1(:,:,:)*PRVS(:,:,:)/(ZW1(:,:,:)+ZW2(:,:,:))
+ ZW2(:,:,:)=PRVS(:,:,:)-ZW1(:,:,:)
+ ENDWHERE
+ IF(PRESENT(PHLC_HRC) .AND. PRESENT(PHLC_HCF)) THEN
+ ZCRIAUT(:,:,:)=XCRIAUTC/PRHODREF
+ IF(HSUBG_MF_PDF=='NONE')THEN
+ WHERE(ZW1(:,:,:)*PTSTEP>PCF_MF * ZCRIAUT)
+ PHLC_HRC(:,:,:)=PHLC_HRC(:,:,:)+ZW1(:,:,:)*PTSTEP
+ PHLC_HCF(:,:,:)=MIN(1.,PHLC_HCF(:,:,:)+PCF_MF(:,:,:))
+ ENDWHERE
+ ELSEIF(HSUBG_MF_PDF=='TRIANGLE')THEN
+ !ZHCF is the precipitating part of the *cloud* and not of the grid cell
+ WHERE(ZW1(:,:,:)*PTSTEP>PCF_MF*ZCRIAUT(:,:,:))
+ ZHCF(:,:,:)=1.-.5*(ZCRIAUT(:,:,:)*PCF_MF(:,:,:) / MAX(1.E-20, ZW1(:,:,:)*PTSTEP))**2
+ ZHR(:,:,:)=ZW1(:,:,:)*PTSTEP-(ZCRIAUT(:,:,:)*PCF_MF(:,:,:))**3 / &
+ &(3*MAX(1.E-20, ZW1(:,:,:)*PTSTEP)**2)
+ ELSEWHERE(2.*ZW1(:,:,:)*PTSTEP<=PCF_MF * ZCRIAUT(:,:,:))
+ ZHCF(:,:,:)=0.
+ ZHR(:,:,:)=0.
+ ELSEWHERE
+ ZHCF(:,:,:)=(2.*ZW1(:,:,:)*PTSTEP-ZCRIAUT(:,:,:)*PCF_MF(:,:,:))**2 / &
+ &(2.*MAX(1.E-20, ZW1(:,:,:)*PTSTEP)**2)
+ ZHR(:,:,:)=(4.*(ZW1(:,:,:)*PTSTEP)**3-3.*ZW1(:,:,:)*PTSTEP*(ZCRIAUT(:,:,:)*PCF_MF(:,:,:))**2+&
+ (ZCRIAUT(:,:,:)*PCF_MF(:,:,:))**3) / &
+ &(3*MAX(1.E-20, ZW1(:,:,:)*PTSTEP)**2)
+ ENDWHERE
+ ZHCF(:,:,:)=ZHCF(:,:,:)*PCF_MF(:,:,:) !to retrieve the part of the grid cell
+ PHLC_HCF(:,:,:)=MIN(1.,PHLC_HCF(:,:,:)+ZHCF(:,:,:)) !total part of the grid cell that is precipitating
+ PHLC_HRC(:,:,:)=PHLC_HRC(:,:,:)+ZHR(:,:,:)
+ ENDIF
+ ENDIF
+ IF(PRESENT(PHLI_HRI) .AND. PRESENT(PHLI_HCF)) THEN
+ ZCRIAUT(:,:,:)=MIN(XCRIAUTI,10**(XACRIAUTI*(ZT(:,:,:)-XTT)+XBCRIAUTI))
+ IF(HSUBG_MF_PDF=='NONE')THEN
+ WHERE(ZW2(:,:,:)*PTSTEP>PCF_MF * ZCRIAUT(:,:,:))
+ PHLI_HRI(:,:,:)=PHLI_HRI(:,:,:)+ZW2(:,:,:)*PTSTEP
+ PHLI_HCF(:,:,:)=MIN(1.,PHLI_HCF(:,:,:)+PCF_MF(:,:,:))
+ ENDWHERE
+ ELSEIF(HSUBG_MF_PDF=='TRIANGLE')THEN
+ !ZHCF is the precipitating part of the *cloud* and not of the grid cell
+ WHERE(ZW2(:,:,:)*PTSTEP>PCF_MF*ZCRIAUT)
+ ZHCF(:,:,:)=1.-.5*(ZCRIAUT*PCF_MF(:,:,:) / (ZW2(:,:,:)*PTSTEP))**2
+ ZHR(:,:,:)=ZW2(:,:,:)*PTSTEP-(ZCRIAUT*PCF_MF(:,:,:))**3/(3*(ZW2(:,:,:)*PTSTEP)**2)
+ ELSEWHERE(2.*ZW2(:,:,:)*PTSTEP<=PCF_MF * ZCRIAUT)
+ ZHCF(:,:,:)=0.
+ ZHR(:,:,:)=0.
+ ELSEWHERE
+ ZHCF(:,:,:)=(2.*ZW2(:,:,:)*PTSTEP-ZCRIAUT*PCF_MF(:,:,:))**2 / (2.*(ZW2(:,:,:)*PTSTEP)**2)
+ ZHR(:,:,:)=(4.*(ZW2(:,:,:)*PTSTEP)**3-3.*ZW2(:,:,:)*PTSTEP*(ZCRIAUT*PCF_MF(:,:,:))**2+&
+ (ZCRIAUT*PCF_MF(:,:,:))**3)/(3*(ZW2(:,:,:)*PTSTEP)**2)
+ ENDWHERE
+ ZHCF(:,:,:)=ZHCF(:,:,:)*PCF_MF(:,:,:) !to retrieve the part of the grid cell
+ PHLI_HCF(:,:,:)=MIN(1.,PHLI_HCF(:,:,:)+ZHCF(:,:,:)) !total part of the grid cell that is precipitating
+ PHLI_HRI(:,:,:)=PHLI_HRI(:,:,:)+ZHR(:,:,:)
+ ENDIF
+ ENDIF
+ PCLDFR(:,:,:)=MIN(1.,PCLDFR(:,:,:)+PCF_MF(:,:,:))
+ PRCS(:,:,:)=PRCS(:,:,:)+ZW1(:,:,:)
+ PRIS(:,:,:)=PRIS(:,:,:)+ZW2(:,:,:)
+ PRVS(:,:,:)=PRVS(:,:,:)-(ZW1(:,:,:)+ZW2(:,:,:))
+ PTHS(:,:,:) = PTHS(:,:,:) + &
+ (ZW1 * ZLV(:,:,:) + ZW2 * ZLS(:,:,:)) / ZCPH(:,:,:) &
+ / PEXNREF(:,:,:)
+ IF(PRESENT(POUT_RV) .OR. PRESENT(POUT_RC) .OR. &
+ &PRESENT(POUT_RI) .OR. PRESENT(POUT_TH)) THEN
+ ZW1(:,:,:)=PRC_MF(:,:,:)
+ ZW2(:,:,:)=PRI_MF(:,:,:)
+ WHERE(ZW1(:,:,:)+ZW2(:,:,:)>ZRV(:,:,:))
+ ZW1(:,:,:)=ZW1(:,:,:)*ZRV(:,:,:)/(ZW1(:,:,:)+ZW2(:,:,:))
+ ZW2(:,:,:)=ZRV(:,:,:)-ZW1(:,:,:)
+ ENDWHERE
+ ZRC(:,:,:)=ZRC(:,:,:)+ZW1(:,:,:)
+ ZRI(:,:,:)=ZRI(:,:,:)+ZW2(:,:,:)
+ ZRV(:,:,:)=ZRV(:,:,:)-(ZW1(:,:,:)+ZW2(:,:,:))
+ ZT(:,:,:) = ZT(:,:,:) + &
+ (ZW1 * ZLV(:,:,:) + ZW2 * ZLS(:,:,:)) / ZCPH(:,:,:)
+ ENDIF
+ENDIF
+!
+IF(PRESENT(POUT_RV)) POUT_RV=ZRV
+IF(PRESENT(POUT_RC)) POUT_RC=ZRC
+IF(PRESENT(POUT_RI)) POUT_RI=ZRI
+IF(PRESENT(POUT_TH)) POUT_TH=ZT / PEXN(:,:,:)
+!
+!
+!* 6. STORE THE BUDGET TERMS
+! ----------------------
+!
+if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), trim( hbuname ), pths(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), trim( hbuname ), prvs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), trim( hbuname ), prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), trim( hbuname ), pris(:, :, :) * prhodj(:, :, :) )
+
+!------------------------------------------------------------------------------
+!
+!
+END SUBROUTINE ICE_ADJUST
diff --git a/src/mesonh/micro/ini_cst.f90 b/src/mesonh/micro/ini_cst.f90
new file mode 100644
index 000000000..7c3170c4c
--- /dev/null
+++ b/src/mesonh/micro/ini_cst.f90
@@ -0,0 +1,197 @@
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ###################
+ MODULE MODI_INI_CST
+! ###################
+!
+INTERFACE
+!
+SUBROUTINE INI_CST
+END SUBROUTINE INI_CST
+!
+END INTERFACE
+!
+END MODULE MODI_INI_CST
+!
+!
+!
+! ##################
+ SUBROUTINE INI_CST
+! ##################
+!
+!!**** *INI_CST * - routine to initialize the module MODD_CST
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to initialize the physical constants
+! stored in module MODD_CST.
+!
+!
+!!** METHOD
+!! ------
+!! The physical constants are set to their numerical values
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST : contains physical constants
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of the documentation (module MODD_CST, routine INI_CST)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 18/05/94
+!! J. Stein 02/01/95 add the volumic mass of liquid water
+!! J.-P. Pinty 13/12/95 add the water vapor pressure over solid ice
+!! J. Stein 29/06/97 add XTH00
+!! V. Masson 05/10/98 add XRHOLI
+!! C. Mari 31/10/00 add NDAYSEC
+!! V. Masson 01/03/03 add XCONDI
+!! J. Escobar 28/03/2014 for pb with emissivity/aerosol reset XMNH_TINY=1.0e-80 in real8 case
+!! J.Escobar : 10/2017 : for real*4 , add XMNH_HUGE_12_LOG
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! J.Escobar : 5/10/2018 : for real*4 ,higher value for XEPS_DT = 1.5e-4
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+use modd_precision, only: MNHREAL
+!
+IMPLICIT NONE
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. FUNDAMENTAL CONSTANTS
+! ---------------------
+!
+XPI = 2.*ASIN(1.)
+XKARMAN = 0.4
+XLIGHTSPEED = 299792458.
+XPLANCK = 6.6260755E-34
+XBOLTZ = 1.380658E-23
+XAVOGADRO = 6.0221367E+23
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. ASTRONOMICAL CONSTANTS
+! ----------------------
+!
+XDAY = 86400.
+XSIYEA = 365.25*XDAY*2.*XPI/ 6.283076
+XSIDAY = XDAY/(1.+XDAY/XSIYEA)
+XOMEGA = 2.*XPI/XSIDAY
+NDAYSEC = 24*3600 ! Number of seconds in a day
+!
+!-------------------------------------------------------------------------------!
+!
+!
+!* 3. TERRESTRIAL GEOIDE CONSTANTS
+! ----------------------------
+!
+XRADIUS = 6371229.
+XG = 9.80665
+!
+!-------------------------------------------------------------------------------
+!
+!* 4. REFERENCE PRESSURE
+! -------------------
+!
+! Ocean model cst same as in 1D/CMO SURFEX
+! values used in ini_cst to overwrite XP00 and XTH00
+XRH00OCEAN =1024.
+XTH00OCEAN = 286.65
+XSA00OCEAN= 32.6
+XP00OCEAN = 201.E5
+!Atmospheric model
+XP00 = 1.E5
+XTH00 = 300.
+!-------------------------------------------------------------------------------
+!
+!* 5. RADIATION CONSTANTS
+! -------------------
+!
+!JUAN OVERFLOW XSTEFAN = 2.* XPI**5 * XBOLTZ**4 / (15.* XLIGHTSPEED**2 * XPLANCK**3)
+XSTEFAN = ( 2.* XPI**5 / 15. ) * ( (XBOLTZ / XPLANCK) * XBOLTZ ) * (XBOLTZ/(XLIGHTSPEED*XPLANCK))**2
+XI0 = 1370.
+!
+!-------------------------------------------------------------------------------
+!
+!* 6. THERMODYNAMIC CONSTANTS
+! -----------------------
+!
+XMD = 28.9644E-3
+XMV = 18.0153E-3
+XRD = XAVOGADRO * XBOLTZ / XMD
+XRV = XAVOGADRO * XBOLTZ / XMV
+XEPSILO= XMV/XMD
+XCPD = 7.* XRD /2.
+XCPV = 4.* XRV
+XRHOLW = 1000.
+XRHOLI = 900.
+XCONDI = 2.22
+XCL = 4.218E+3
+XCI = 2.106E+3
+XTT = 273.16
+XLVTT = 2.5008E+6
+XLSTT = 2.8345E+6
+XLMTT = XLSTT - XLVTT
+XESTT = 611.14
+XGAMW = (XCL - XCPV) / XRV
+XBETAW = (XLVTT/XRV) + (XGAMW * XTT)
+XALPW = LOG(XESTT) + (XBETAW /XTT) + (XGAMW *LOG(XTT))
+XGAMI = (XCI - XCPV) / XRV
+XBETAI = (XLSTT/XRV) + (XGAMI * XTT)
+XALPI = LOG(XESTT) + (XBETAI /XTT) + (XGAMI *LOG(XTT))
+! Values identical to ones used in CMO1D in SURFEX /could be modified
+! Coefficient of thermal expansion of water (K-1)
+XALPHAOC = 1.9E-4
+! Coeff of Haline contraction coeff (S-1)
+XBETAOC= 7.7475E-4
+!
+! Some machine precision value depending of real4/8 use
+!
+
+
+XMNH_EPSILON = EPSILON (XMNH_EPSILON )
+XMNH_HUGE = HUGE (XMNH_HUGE )
+XMNH_HUGE_12_LOG = LOG ( SQRT(XMNH_HUGE) )
+
+#if (MNH_REAL == 8)
+XMNH_TINY = 1.0e-80_MNHREAL
+XEPS_DT = 1.0e-5_MNHREAL
+XRES_FLAT_CART = 1.0e-12_MNHREAL
+XRES_OTHER = 1.0e-9_MNHREAL
+XRES_PREP = 1.0e-8_MNHREAL
+#elif (MNH_REAL == 4)
+XMNH_TINY = TINY (XMNH_TINY )
+XEPS_DT = 1.5e-4_MNHREAL
+XRES_FLAT_CART = 1.0e-12_MNHREAL
+XRES_OTHER = 1.0e-7_MNHREAL
+XRES_PREP = 1.0e-4_MNHREAL
+#else
+#error "Invalid MNH_REAL"
+#endif
+XMNH_TINY_12 = SQRT (XMNH_TINY )
+
+
+
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE INI_CST
diff --git a/src/mesonh/micro/ini_lima.f90 b/src/mesonh/micro/ini_lima.f90
new file mode 100644
index 000000000..d90f1e160
--- /dev/null
+++ b/src/mesonh/micro/ini_lima.f90
@@ -0,0 +1,173 @@
+!MNH_LIC Copyright 2013-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ####################
+ MODULE MODI_INI_LIMA
+! ####################
+!
+INTERFACE
+ SUBROUTINE INI_LIMA (PTSTEP, PDZMIN, KSPLITR, KSPLITG)
+!
+INTEGER, INTENT(OUT):: KSPLITR ! Number of small time step
+ ! integration for rain
+ ! sedimendation
+INTEGER, INTENT(OUT):: KSPLITG ! Number of small time step
+ ! integration for graupel
+ ! sedimendation
+REAL, INTENT(IN) :: PTSTEP ! Effective Time step
+REAL, INTENT(IN) :: PDZMIN ! minimun vertical mesh size
+!
+END SUBROUTINE INI_LIMA
+!
+END INTERFACE
+!
+END MODULE MODI_INI_LIMA
+! ######################################################
+ SUBROUTINE INI_LIMA (PTSTEP, PDZMIN, KSPLITR, KSPLITG)
+! ######################################################
+!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to initialize the constants used in the
+!! microphysical scheme LIMA.
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_REF
+USE MODD_PARAM_LIMA
+USE MODD_PARAMETERS
+USE MODD_LUNIT, ONLY : TLUOUT0
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+!
+INTEGER, INTENT(OUT):: KSPLITR ! Number of small time step
+ ! integration for rain
+ ! sedimendation
+INTEGER, INTENT(OUT):: KSPLITG ! Number of small time step
+ ! integration for graupel or hail
+ ! sedimendation
+REAL, INTENT(IN) :: PTSTEP ! Effective Time step
+REAL, INTENT(IN) :: PDZMIN ! minimun vertical mesh size
+!
+!* 0.2 Declarations of local variables :
+!
+REAL :: ZT ! Work variable
+REAL, DIMENSION(7) :: ZVTRMAX
+!
+INTEGER :: JI
+INTEGER :: ILUOUT0 ! Logical unit number for output-listing
+INTEGER :: IRESP ! Return code of FM-routines
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 1. INIT OUTPUT LISTING, COMPUTE KSPLITR AND KSPLITG
+! ------------------------------------------------
+!
+!
+! Init output listing
+ILUOUT0 = TLUOUT0%NLU
+!
+!
+ZVTRMAX(2) = 0.3 ! Maximum cloud droplet fall speed
+ZVTRMAX(3) = 15. ! Maximum rain drop fall speed
+ZVTRMAX(4) = 1.5 ! Maximum ice crystal fall speed
+ZVTRMAX(5) = 3.0 ! Maximum snow fall speed
+ZVTRMAX(6) = 15. ! Maximum graupel fall speed
+ZVTRMAX(7) = 30. ! Maximum hail fall speed
+!
+! NSPLITSED
+!
+DO JI=2,7
+ NSPLITSED(JI) = 1
+ SPLIT : DO
+ ZT = PTSTEP / REAL(NSPLITSED(JI))
+ IF ( ZT * ZVTRMAX(JI) / PDZMIN < 1.0) EXIT SPLIT
+ NSPLITSED(JI) = NSPLITSED(JI) + 1
+ END DO SPLIT
+END DO
+!
+! KSPLITR
+!
+KSPLITR = 1
+SPLITR : DO
+ ZT = PTSTEP / REAL(KSPLITR)
+ IF ( ZT * ZVTRMAX(7) / PDZMIN < 1.0) EXIT SPLITR
+ KSPLITR = KSPLITR + 1
+END DO SPLITR
+!
+!
+! KSPLITG
+!
+KSPLITG = 1
+SPLITG : DO
+ ZT = 2.* PTSTEP / REAL(KSPLITG)
+ IF ( ZT * ZVTRMAX(7) / PDZMIN .LT. 1.) EXIT SPLITG
+ KSPLITG = KSPLITG + 1
+END DO SPLITG
+!
+!
+!
+IF (ALLOCATED(XRTMIN)) RETURN ! In case of nesting microphysics, constants of
+ ! MODD_RAIN_C2R2_PARAM are computed only once.
+!
+!
+! Set bounds for mixing ratios and concentrations
+ALLOCATE( XRTMIN(7) )
+XRTMIN(1) = 1.0E-10 ! rv
+XRTMIN(2) = 1.0E-10 ! rc
+XRTMIN(3) = 1.0E-10 ! rr
+XRTMIN(4) = 1.0E-10 ! ri
+XRTMIN(5) = 1.0E-10 ! rs
+XRTMIN(6) = 1.0E-10 ! rg
+XRTMIN(7) = 1.0E-10 ! rh
+ALLOCATE( XCTMIN(7) )
+XCTMIN(1) = 1.0 ! Not used
+XCTMIN(2) = 1.0E-3 ! Nc
+XCTMIN(3) = 1.0E-3 ! Nr
+XCTMIN(4) = 1.0E-3 ! Ni
+XCTMIN(5) = 1.0E-3 ! Not used
+XCTMIN(6) = 1.0E-3 ! Not used
+XCTMIN(7) = 1.0E-3 ! Not used
+!
+!
+! Air density fall speed correction
+XCEXVT = 0.4
+!
+!------------------------------------------------------------------------------
+!
+!
+!
+!* 2. DEFINE SPECIES CHARACTERISTICS AND PROCESSES CONSTANTS
+! ------------------------------------------------------
+!
+!
+CALL INI_LIMA_WARM(PTSTEP, PDZMIN)
+!
+CALL INI_LIMA_COLD_MIXED(PTSTEP, PDZMIN)
+!
+!------------------------------------------------------------------------------
+!
+END SUBROUTINE INI_LIMA
diff --git a/src/mesonh/micro/ini_lima_cold_mixed.f90 b/src/mesonh/micro/ini_lima_cold_mixed.f90
new file mode 100644
index 000000000..cb427cdb4
--- /dev/null
+++ b/src/mesonh/micro/ini_lima_cold_mixed.f90
@@ -0,0 +1,1348 @@
+!MNH_LIC Copyright 2013-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ###############################
+ MODULE MODI_INI_LIMA_COLD_MIXED
+! ###############################
+!
+INTERFACE
+ SUBROUTINE INI_LIMA_COLD_MIXED (PTSTEP, PDZMIN)
+!
+REAL, INTENT(IN) :: PTSTEP ! Effective Time step
+REAL, INTENT(IN) :: PDZMIN ! minimun vertical mesh size
+!
+END SUBROUTINE INI_LIMA_COLD_MIXED
+!
+END INTERFACE
+!
+END MODULE MODI_INI_LIMA_COLD_MIXED
+! ###############################################
+ SUBROUTINE INI_LIMA_COLD_MIXED (PTSTEP, PDZMIN)
+! ###############################################
+!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to initialize the constants used in the
+!! microphysical scheme LIMA for the cold and mixed phase variables
+!! and processes.
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_LUNIT, ONLY: TLUOUT0
+USE MODD_PARAMETERS
+USE MODD_PARAM_LIMA
+USE MODD_PARAM_LIMA_WARM
+USE MODD_PARAM_LIMA_COLD
+USE MODD_PARAM_LIMA_MIXED
+USE MODD_REF
+!
+use mode_msg
+!
+USE MODI_LIMA_FUNCTIONS
+USE MODI_GAMMA
+USE MODI_GAMMA_INC
+USE MODI_RRCOLSS
+USE MODI_RZCOLX
+USE MODI_RSCOLRG
+USE MODI_LIMA_READ_XKER_RACCS
+USE MODI_LIMA_READ_XKER_SDRYG
+USE MODI_LIMA_READ_XKER_RDRYG
+USE MODI_LIMA_READ_XKER_SWETH
+USE MODI_LIMA_READ_XKER_GWETH
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, INTENT(IN) :: PTSTEP ! Effective Time step
+REAL, INTENT(IN) :: PDZMIN ! minimun vertical mesh size
+!
+!* 0.2 Declarations of local variables :
+!
+character(len=13) :: yval ! String for error message
+INTEGER :: IKB ! Coordinates of the first physical
+ ! points along z
+INTEGER :: J1,J2 ! Internal loop indexes
+!
+REAL, DIMENSION(8) :: ZGAMI ! parameters involving various moments
+REAL, DIMENSION(2) :: ZGAMS ! of the generalized gamma law
+!
+REAL :: ZT ! Work variable
+REAL :: ZVTRMAX ! Raindrop maximal fall velocity
+REAL :: ZRHO00 ! Surface reference air density
+REAL :: ZRATE ! Geometrical growth of Lbda in the tabulated
+ ! functions and kernels
+REAL :: ZBOUND ! XDCSLIM*Lbda_s: upper bound for the partial
+ ! integration of the riming rate of the aggregates
+REAL :: ZEGS, ZEGR, ZEHS, ZEHG! Bulk collection efficiencies
+!
+INTEGER :: IND ! Number of interval to integrate the kernels
+REAL :: ZESR ! Mean efficiency of rain-aggregate collection
+REAL :: ZFDINFTY ! Factor used to define the "infinite" diameter
+!
+!
+INTEGER :: ILUOUT0 ! Logical unit number for output-listing
+LOGICAL :: GFLAG ! Logical flag for printing the constatnts on the output
+ ! listing
+REAL :: ZCONC_MAX ! Maximal concentration for snow
+REAL :: ZFACT_NUCL! Amplification factor for the minimal ice concentration
+!
+INTEGER :: KND
+INTEGER :: KACCLBDAS,KACCLBDAR,KDRYLBDAG,KDRYLBDAS,KDRYLBDAR
+REAL :: PALPHAR,PALPHAS,PALPHAG,PALPHAH
+REAL :: PNUR,PNUS,PNUG,PNUH
+REAL :: PBR,PBS,PBG,PBH
+REAL :: PCR,PCS,PCG,PCH
+REAL :: PDR,PDS,PDG,PDH
+REAL :: PESR,PEGS,PEGR,PEHS,PEHG
+REAL :: PFDINFTY
+REAL :: PACCLBDAS_MAX,PACCLBDAR_MAX,PACCLBDAS_MIN,PACCLBDAR_MIN
+REAL :: PDRYLBDAG_MAX,PDRYLBDAS_MAX,PDRYLBDAG_MIN,PDRYLBDAS_MIN
+REAL :: PDRYLBDAR_MAX,PDRYLBDAR_MIN
+REAL :: PWETLBDAS_MAX,PWETLBDAG_MAX,PWETLBDAS_MIN,PWETLBDAG_MIN
+REAL :: PWETLBDAH_MAX,PWETLBDAH_MIN
+INTEGER :: KWETLBDAS,KWETLBDAG,KWETLBDAH
+!
+REAL :: ZFAC_ZRNIC ! Zrnic factor used to decrease Long Kernels
+!
+!-------------------------------------------------------------------------------
+!
+!
+ILUOUT0 = TLUOUT0%NLU
+!
+!
+!* 1. CHARACTERISTICS OF THE SPECIES
+! ------------------------------
+!
+!
+!* 1.2 Ice crystal characteristics
+!
+SELECT CASE (CPRISTINE_ICE_LIMA)
+ CASE('PLAT')
+ XAI = 0.82 ! Plates
+ XBI = 2.5 ! Plates
+ XC_I = 747. ! Plates
+ XDI = 1.0 ! Plates
+ XC1I = 1./XPI ! Plates
+ CASE('COLU')
+ XAI = 2.14E-3 ! Columns
+ XBI = 1.7 ! Columns
+ XC_I = 1.96E5 ! Columns
+ XDI = 1.585 ! Columns
+ XC1I = 0.8 ! Columns
+ CASE('BURO')
+ XAI = 44.0 ! Bullet rosettes
+ XBI = 3.0 ! Bullet rosettes
+ XC_I = 4.E5 ! Bullet rosettes
+ XDI = 1.663 ! Bullet rosettes
+ XC1I = 0.5 ! Bullet rosettes
+END SELECT
+!
+! Note that XCCI=N_i (a locally predicted value) and XCXI=0.0, implicitly
+!
+XF0I = 1.00
+! Correction BVIE XF2I from Pruppacher 1997 eq 13-88
+!XF2I = 0.103
+XF2I = 0.14
+XF0IS = 0.86
+XF1IS = 0.28
+!
+!* 1.3 Snowflakes/aggregates characteristics
+!
+XAS = 0.02
+XBS = 1.9
+XCS = 5.
+XDS = 0.27
+!
+XCCS = 5.0
+XCXS = 1.0
+!
+XF0S = 0.86
+XF1S = 0.28
+!
+XC1S = 1./XPI
+!
+!* 1.4 Graupel characteristics
+!
+XAG = 19.6 ! Lump graupel case
+XBG = 2.8 ! Lump graupel case
+XCG = 122. ! Lump graupel case
+XDG = 0.66 ! Lump graupel case
+!
+XCCG = 5.E5
+XCXG = -0.5
+! XCCG = 4.E4 ! Test of Ziegler (1988)
+! XCXG = -1.0 ! Test of Ziegler (1988)
+!
+XF0G = 0.86
+XF1G = 0.28
+!
+XC1G = 1./2.
+!
+!* 2.5 Hailstone characteristics
+!
+!
+XAH = 470.
+XBH = 3.0
+XCH = 201.
+XDH = 0.64
+!
+!XCCH = 5.E-4
+!XCXH = 2.0
+!!!!!!!!!!!!
+ XCCH = 4.E4 ! Test of Ziegler (1988)
+ XCXH = -1.0 ! Test of Ziegler (1988)
+!!! XCCH = 5.E5 ! Graupel_like
+!!! XCXH = -0.5 ! Graupel_like
+!!!!!!!!!!!!
+!
+XF0H = 0.86
+XF1H = 0.28
+!
+XC1H = 1./2.
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 2. DIMENSIONAL DISTRIBUTIONS OF THE SPECIES
+! ----------------------------------------
+!
+!
+!* 2.1 Ice, snow, graupel and hail distribution
+!
+!
+XALPHAI = 3.0 ! Gamma law for the ice crystal volume
+XNUI = 3.0 ! Gamma law with little dispersion
+!
+XALPHAS = 1.0 ! Exponential law
+XNUS = 1.0 ! Exponential law
+!
+XALPHAG = 1.0 ! Exponential law
+XNUG = 1.0 ! Exponential law
+!
+XALPHAH = 1.0 ! Gamma law
+XNUH = 8.0 ! Gamma law with little dispersion
+!
+!* 2.2 Constants for shape parameter
+!
+XLBEXI = 1.0/XBI
+XLBI = XAI*MOMG(XALPHAI,XNUI,XBI)
+!
+XLBEXS = 1.0/(XCXS-XBS)
+XLBS = ( XAS*XCCS*MOMG(XALPHAS,XNUS,XBS) )**(-XLBEXS)
+!
+XLBEXG = 1.0/(XCXG-XBG)
+XLBG = ( XAG*XCCG*MOMG(XALPHAG,XNUG,XBG))**(-XLBEXG)
+!
+XLBEXH = 1.0/(XCXH-XBH)
+XLBH = ( XAH*XCCH*MOMG(XALPHAH,XNUH,XBH) )**(-XLBEXH)
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=ILUOUT0,FMT='(" Shape Parameters")')
+ WRITE(UNIT=ILUOUT0,FMT='(" XLBEXI =",E13.6," XLBI =",E13.6)') XLBEXI,XLBI
+ WRITE(UNIT=ILUOUT0,FMT='(" XLBEXS =",E13.6," XLBS =",E13.6)') XLBEXS,XLBS
+ WRITE(UNIT=ILUOUT0,FMT='(" XLBEXG =",E13.6," XLBG =",E13.6)') XLBEXG,XLBG
+ WRITE(UNIT=ILUOUT0,FMT='(" XLBEXH =",E13.6," XLBH =",E13.6)') XLBEXH,XLBH
+END IF
+!
+XLBDAS_MAX = 500000
+XLBDAG_MAX = 100000.0
+!
+ZCONC_MAX = 1.E6 ! Maximal concentration for falling particules set to 1 per cc
+!XLBDAS_MAX = ( ZCONC_MAX/XCCS )**(1./XCXS)
+!XLBDAG_MAX = ( ZCONC_MAX/XCCG )**(1./XCXG)
+!XLBDAH_MAX = ( ZCONC_MAX/XCCH )**(1./XCXH)
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 3. CONSTANTS FOR THE SEDIMENTATION
+! -------------------------------
+!
+!
+!* 3.1 Exponent of the fall-speed air density correction
+!
+IKB = 1 + JPVEXT
+! Correction
+! ZRHO00 = XP00/(XRD*XTHVREFZ(IKB))
+ZRHO00 = 1.2041 ! at P=1013.25hPa and T=20°C
+!
+!* 3.2 Constants for sedimentation
+!
+!! XEXRSEDI = (XBI+XDI)/XBI
+!! XEXCSEDI = 1.0-XEXRSEDI
+!! XFSEDI = (4.*XPI*900.)**(-XEXCSEDI) * &
+!! XC_I*XAI*MOMG(XALPHAI,XNUI,XBI+XDI) * &
+!! ((XAI*MOMG(XALPHAI,XNUI,XBI)))**(-XEXRSEDI) * &
+!! (ZRHO00)**XCEXVT
+!! !
+!! ! Computations made for Columns
+!! !
+!! XEXRSEDI = 1.9324
+!! XEXCSEDI =-0.9324
+!! XFSEDI = 3.89745E11*MOMG(XALPHAI,XNUI,3.285)* &
+!! MOMG(XALPHAI,XNUI,1.7)**(-XEXRSEDI)*(ZRHO00)**XCEXVT
+!! XEXCSEDI =-0.9324*3.0
+!! WRITE (ILUOUT0,FMT=*)' PRISTINE ICE SEDIMENTATION for columns XFSEDI=',XFSEDI
+!
+!
+XFSEDRI = XC_I*GAMMA_X0D(XNUI+(XDI+XBI)/XALPHAI)/GAMMA_X0D(XNUI+XBI/XALPHAI)* &
+ (ZRHO00)**XCEXVT
+XFSEDCI = XC_I*GAMMA_X0D(XNUI+XDI/XALPHAI)/GAMMA_X0D(XNUI)* &
+ (ZRHO00)**XCEXVT
+!
+XEXSEDS = (XBS+XDS-XCXS)/(XBS-XCXS)
+XFSEDS = XCS*XAS*XCCS*MOMG(XALPHAS,XNUS,XBS+XDS)* &
+ (XAS*XCCS*MOMG(XALPHAS,XNUS,XBS))**(-XEXSEDS)*(ZRHO00)**XCEXVT
+!
+XEXSEDG = (XBG+XDG-XCXG)/(XBG-XCXG)
+XFSEDG = XCG*XAG*XCCG*MOMG(XALPHAG,XNUG,XBG+XDG)* &
+ (XAG*XCCG*MOMG(XALPHAG,XNUG,XBG))**(-XEXSEDG)*(ZRHO00)**XCEXVT
+!
+XEXSEDH = (XBH+XDH-XCXH)/(XBH-XCXH)
+XFSEDH = XCH*XAH*XCCH*MOMG(XALPHAH,XNUH,XBH+XDH)* &
+ (XAH*XCCH*MOMG(XALPHAH,XNUH,XBH))**(-XEXSEDH)*(ZRHO00)**XCEXVT
+!
+!
+!
+XLB(4) = XLBI
+XLBEX(4) = XLBEXI
+XD(4) = XDI
+XFSEDR(4) = XFSEDRI
+XFSEDC(4) = XFSEDCI
+!
+XLB(5) = XLBS
+XLBEX(5) = XLBEXS
+XD(5) = XDS
+XFSEDR(5) = XCS*GAMMA_X0D(XNUS+(XDS+XBS)/XALPHAS)/GAMMA_X0D(XNUS+XBS/XALPHAS)* &
+ (ZRHO00)**XCEXVT
+!
+XLB(6) = XLBG
+XLBEX(6) = XLBEXG
+XD(6) = XDG
+XFSEDR(6) = XCG*GAMMA_X0D(XNUG+(XDG+XBG)/XALPHAG)/GAMMA_X0D(XNUG+XBG/XALPHAG)* &
+ (ZRHO00)**XCEXVT
+!
+XLB(7) = XLBH
+XLBEX(7) = XLBEXH
+XD(7) = XDH
+XFSEDR(7) = XCH*GAMMA_X0D(XNUH+(XDH+XBH)/XALPHAH)/GAMMA_X0D(XNUH+XBH/XALPHAH)* &
+ (ZRHO00)**XCEXVT
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 4. CONSTANTS FOR HETEROGENEOUS NUCLEATION
+! --------------------------------------
+!
+!
+! ***************
+!* 4.1 LIMA_NUCLEATION
+! ***************
+!* 4.1.1 Constants for the computation of the number concentration
+! of active IN
+!
+XRHO_CFDC = 0.76
+!
+XGAMMA = 2.
+!
+IF (NPHILLIPS == 13) THEN
+ XAREA1(1) = 2.0E-6 !DM1
+ XAREA1(2) = XAREA1(1) !DM2
+ XAREA1(3) = 1.0E-7 !BC
+ XAREA1(4) = 8.9E-7 !BIO
+ELSE IF (NPHILLIPS == 8) THEN
+ XAREA1(1) = 2.0E-6 !DM1
+ XAREA1(2) = XAREA1(1) !DM2
+ XAREA1(3) = 2.7E-7 !BC
+ XAREA1(4) = 9.1E-7 !BIO
+ELSE
+ call Print_msg( NVERB_FATAL, 'GEN', 'INI_LIMA_COLD_MIXED', 'NPHILLIPS should be equal to 8 or 13' )
+END IF
+!
+!* 4.1.2 Constants for the computation of H_X (the fraction-redu-
+! cing IN activity at low S_i and warm T) for X={DM1,DM2,BC,BIO}
+!
+!
+IF (NPHILLIPS == 13) THEN
+ XDT0(1) = 5. +273.15 !DM1
+ XDT0(2) = 5. +273.15 !DM2
+ XDT0(3) = 10. +273.15 !BC
+ XDT0(4) = 5. +273.15 !BIOO
+!
+ XT0(1) = -40. +273.15 !DM1
+ XT0(2) = XT0(1) !DM2
+ XT0(3) = -50. +273.15 !BC
+ XT0(4) = -20. +273.15 !BIO
+!
+ XSW0 = 0.97
+!
+ XDSI0(1) = 0.1 !DM1
+ XDSI0(2) = 0.1 !DM2
+ XDSI0(3) = 0.1 !BC
+ XDSI0(4) = 0.2 !BIO
+!
+ XH(1) = 0.15 !DM1
+ XH(2) = 0.15 !DM2
+ XH(3) = 0. !BC
+ XH(4) = 0. !O
+!
+ XTX1(1) = -30. +273.15 !DM1
+ XTX1(2) = XTX1(1) !DM2
+ XTX1(3) = -25. +273.15 !BC
+ XTX1(4) = -5. +273.15 !BIO
+!
+ XTX2(1) = -10. +273.15 !DM1
+ XTX2(2) = XTX2(1) !DM2
+ XTX2(3) = -15. +273.15 !BC
+ XTX2(4) = -2. +273.15 !BIO
+ELSE IF (NPHILLIPS == 8) THEN
+ XDT0(1) = 5. +273.15 !DM1
+ XDT0(2) = 5. +273.15 !DM2
+ XDT0(3) = 5. +273.15 !BC
+ XDT0(4) = 5. +273.15 !O
+!
+ XT0(1) = -40. +273.15 !DM1
+ XT0(2) = XT0(1) !DM2
+ XT0(3) = -50. +273.15 !BC
+ XT0(4) = -50. +273.15 !BIO
+!
+ XSW0 = 0.97
+!
+ XDSI0(1) = 0.1 !DM1
+ XDSI0(2) = 0.1 !DM2
+ XDSI0(3) = 0.1 !BC
+ XDSI0(4) = 0.1 !BIO
+!
+ XH(1) = 0.15 !DM1
+ XH(2) = 0.15 !DM2
+ XH(3) = 0. !BC
+ XH(4) = 0. !O
+!
+ XTX1(1) = -5. +273.15 !DM1
+ XTX1(2) = XTX1(1) !DM2
+ XTX1(3) = -5. +273.15 !BC
+ XTX1(4) = -5. +273.15 !BIO
+!
+ XTX2(1) = -2. +273.15 !DM1
+ XTX2(2) = XTX2(1) !DM2
+ XTX2(3) = -2. +273.15 !BC
+ XTX2(4) = -2. +273.15 !BIO
+END IF
+!
+!* 4.1.3 Constants for the computation of the Gauss Hermitte
+! quadrature method used for the integration of the total
+! crystal number over T>-35°C
+!
+NDIAM = 70
+!
+ALLOCATE(XABSCISS(NDIAM))
+ALLOCATE(XWEIGHT (NDIAM))
+!
+CALL GAUHER(XABSCISS, XWEIGHT, NDIAM)
+!
+! *****************
+!* 4.2 MEYERS NUCLEATION
+! *****************
+!
+ZFACT_NUCL = 1.0 ! Plates, Columns and Bullet rosettes
+!
+!* 5.2.1 Constants for nucleation from ice nuclei
+!
+XNUC_DEP = XFACTNUC_DEP*1000.*ZFACT_NUCL
+XEXSI_DEP = 12.96E-2
+XEX_DEP = -0.639
+!
+XNUC_CON = XFACTNUC_CON*1000.*ZFACT_NUCL
+XEXTT_CON = -0.262
+XEX_CON = -2.8
+!
+XMNU0 = 6.88E-13
+!
+IF (LMEYERS) THEN
+ WRITE(UNIT=ILUOUT0,FMT='(" Heterogeneous nucleation")')
+ WRITE(UNIT=ILUOUT0,FMT='(" XNUC_DEP=",E13.6," XEXSI=",E13.6," XEX=",E13.6)') &
+ XNUC_DEP,XEXSI_DEP,XEX_DEP
+ WRITE(UNIT=ILUOUT0,FMT='(" XNUC_CON=",E13.6," XEXTT=",E13.6," XEX=",E13.6)') &
+ XNUC_CON,XEXTT_CON,XEX_CON
+ WRITE(UNIT=ILUOUT0,FMT='(" mass of embryo XMNU0=",E13.6)') XMNU0
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 5. CONSTANTS FOR THE SLOW COLD PROCESSES
+! -------------------------------------
+!
+!
+!* 5.1.2 Constants for homogeneous nucleation from haze particules
+!
+XRHOI_HONH = 925.0
+XCEXP_DIFVAP_HONH = 1.94
+XCOEF_DIFVAP_HONH = (2.0*XPI)*0.211E-4*XP00/XTT**XCEXP_DIFVAP_HONH
+XCRITSAT1_HONH = 2.583
+XCRITSAT2_HONH = 207.83
+XTMIN_HONH = 180.0
+XTMAX_HONH = 240.0
+XDLNJODT1_HONH = 4.37
+XDLNJODT2_HONH = 0.03
+XC1_HONH = 100.0
+XC2_HONH = 22.6
+XC3_HONH = 0.1
+XRCOEF_HONH = (XPI/6.0)*XRHOI_HONH
+!
+!
+!* 5.1.3 Constants for homogeneous nucleation from cloud droplets
+!
+XTEXP1_HONC = -606.3952*LOG(10.0)
+XTEXP2_HONC = -52.6611*LOG(10.0)
+XTEXP3_HONC = -1.7439*LOG(10.0)
+XTEXP4_HONC = -0.0265*LOG(10.0)
+XTEXP5_HONC = -1.536E-4*LOG(10.0)
+IF (XALPHAC == 3.0) THEN
+ XC_HONC = XPI/6.0
+ XR_HONC = XPI/6.0
+ELSE
+ write ( yval, '( E13.6 )' ) xalphac
+ call Print_msg( NVERB_FATAL, 'GEN', 'INI_LIMA_COLD_MIXED', 'homogeneous nucleation: XALPHAC='//trim(yval)// &
+ '/= 3. No algorithm developed for this case' )
+END IF
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=ILUOUT0,FMT='(" Homogeneous nucleation")')
+ WRITE(UNIT=ILUOUT0,FMT='(" XTEXP1_HONC=",E13.6)') XTEXP1_HONC
+ WRITE(UNIT=ILUOUT0,FMT='(" XTEXP2_HONC=",E13.6)') XTEXP2_HONC
+ WRITE(UNIT=ILUOUT0,FMT='(" XTEXP3_HONC=",E13.6)') XTEXP3_HONC
+ WRITE(UNIT=ILUOUT0,FMT='(" XTEXP4_HONC=",E13.6)') XTEXP4_HONC
+ WRITE(UNIT=ILUOUT0,FMT='(" XTEXP5_HONC=",E13.6)') XTEXP5_HONC
+ WRITE(UNIT=ILUOUT0,FMT='("XC_HONC=",E13.6," XR_HONC=",E13.6)') XC_HONC,XR_HONC
+END IF
+!
+!
+!* 5.2 Constants for vapor deposition on ice
+!
+XSCFAC = (0.63**(1./3.))*SQRT((ZRHO00)**XCEXVT) ! One assumes Sc=0.63
+!
+X0DEPI = (4.0*XPI)*XC1I*XF0I*MOMG(XALPHAI,XNUI,1.)
+X2DEPI = (4.0*XPI)*XC1I*XF2I*XC_I*MOMG(XALPHAI,XNUI,XDI+2.0)
+!
+! Harrington parameterization for ice to snow conversion
+!
+XDICNVS_LIM = 125.E-6 ! size in microns
+XLBDAICNVS_LIM = (50.0**(1.0/(XALPHAI)))/XDICNVS_LIM ! ZLBDAI Limitation
+XC0DEPIS = ((4.0*XPI)/(XAI*XBI))*XC1I*XF0IS* &
+ (XALPHAI/GAMMA_X0D(XNUI))*XDICNVS_LIM**(1.0-XBI)
+XC1DEPIS = ((4.0*XPI)/(XAI*XBI))*XC1I*XF1IS*SQRT(XC_I)* &
+ (XALPHAI/GAMMA_X0D(XNUI))*XDICNVS_LIM**(1.0-XBI+(XDI+1.0)/2.0)
+XR0DEPIS = XC0DEPIS *(XAI*XDICNVS_LIM**XBI)
+XR1DEPIS = XC1DEPIS *(XAI*XDICNVS_LIM**XBI)
+!
+! Harrington parameterization for snow to ice conversion
+!
+XLBDASCNVI_MAX = 6000. ! lbdas max after Field (1999)
+!
+XDSCNVI_LIM = 125.E-6 ! size in microns
+XLBDASCNVI_LIM = (50.0**(1.0/(XALPHAS)))/XDSCNVI_LIM ! ZLBDAS Limitation
+XC0DEPSI = ((4.0*XPI)/(XAS*XBS))*XC1S*XF0IS* &
+ (XALPHAS/GAMMA_X0D(XNUS))*XDSCNVI_LIM**(1.0-XBS)
+XC1DEPSI = ((4.0*XPI)/(XAS*XBS))*XC1S*XF1IS*SQRT(XCS)* &
+ (XALPHAS/GAMMA_X0D(XNUS))*XDSCNVI_LIM**(1.0-XBS+(XDS+1.0)/2.0)
+XR0DEPSI = XC0DEPSI *(XAS*XDSCNVI_LIM**XBS)
+XR1DEPSI = XC1DEPSI *(XAS*XDSCNVI_LIM**XBS)
+!
+! Vapor deposition on snow and graupel and hail
+!
+X0DEPS = (4.0*XPI)*XCCS*XC1S*XF0S*MOMG(XALPHAS,XNUS,1.)
+X1DEPS = (4.0*XPI)*XCCS*XC1S*XF1S*SQRT(XCS)*MOMG(XALPHAS,XNUS,0.5*XDS+1.5)
+XEX0DEPS = XCXS-1.0
+XEX1DEPS = XCXS-0.5*(XDS+3.0)
+!
+X0DEPG = (4.0*XPI)*XCCG*XC1G*XF0G*MOMG(XALPHAG,XNUG,1.)
+X1DEPG = (4.0*XPI)*XCCG*XC1G*XF1G*SQRT(XCG)*MOMG(XALPHAG,XNUG,0.5*XDG+1.5)
+XEX0DEPG = XCXG-1.0
+XEX1DEPG = XCXG-0.5*(XDG+3.0)
+!
+X0DEPH = (4.0*XPI)*XCCH*XC1H*XF0H*MOMG(XALPHAH,XNUH,1.)
+X1DEPH = (4.0*XPI)*XCCH*XC1H*XF1H*SQRT(XCH)*MOMG(XALPHAH,XNUH,0.5*XDH+1.5)
+XEX0DEPH = XCXH-1.0
+XEX1DEPH = XCXH-0.5*(XDH+3.0)
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 6. CONSTANTS FOR THE COALESCENCE PROCESSES
+! ---------------------------------------
+!
+!
+!* 6.0 Precalculation of the gamma function momentum
+!
+ZGAMI(1) = GAMMA_X0D(XNUI)
+ZGAMI(2) = MOMG(XALPHAI,XNUI,3.)
+ZGAMI(3) = MOMG(XALPHAI,XNUI,6.)
+ZGAMI(4) = ZGAMI(3)-ZGAMI(2)**2 ! useful for Sig_I
+ZGAMI(5) = MOMG(XALPHAI,XNUI,9.)
+ZGAMI(6) = MOMG(XALPHAI,XNUI,3.+XBI)
+ZGAMI(7) = MOMG(XALPHAI,XNUI,XBI)
+ZGAMI(8) = MOMG(XALPHAI,XNUI,3.)/MOMG(XALPHAI,XNUI,2.)
+!
+ZGAMS(1) = GAMMA_X0D(XNUS)
+ZGAMS(2) = MOMG(XALPHAS,XNUS,3.)
+!
+!
+!* 6.1 Csts for the coalescence processes
+!
+ZFAC_ZRNIC = 0.1
+XKER_ZRNIC_A1 = 2.59E15*ZFAC_ZRNIC**2! From Long a1=9.44E9 cm-3
+ ! so XKERA1= 9.44E9*1E6*(PI/6)**2
+XKER_ZRNIC_A2 = 3.03E3*ZFAC_ZRNIC ! From Long a2=5.78E3
+ ! so XKERA2= 5.78E3* (PI/6)
+!
+!
+!* 6.2 Csts for the pristine ice selfcollection process
+!
+XSELFI = XKER_ZRNIC_A1*ZGAMI(3)
+XCOLEXII = 0.025 ! Temperature factor of the I+I collection efficiency
+!
+!
+!* 6.3 Constants for pristine ice autoconversion
+!
+XTEXAUTI = 0.025 ! Temperature factor of the I+I collection efficiency
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=ILUOUT0,FMT='(" pristine ice autoconversion")')
+ WRITE(UNIT=ILUOUT0,FMT='(" Temp. factor XTEXAUTI=",E13.6)') XTEXAUTI
+END IF
+!
+XAUTO3 = 6.25E18*(ZGAMI(2))**(1./3.)*SQRT(ZGAMI(4))
+XAUTO4 = 0.5E6*(ZGAMI(4))**(1./6.)
+XLAUTS = 2.7E-2
+XLAUTS_THRESHOLD = 0.4
+XITAUTS= 0.27 ! (Notice that T2 of BR74 is uncorrect and that 0.27=1./3.7
+XITAUTS_THRESHOLD = 7.5
+!
+!
+!* 6.4 Constants for snow aggregation
+!
+XCOLEXIS = 0.05 ! Temperature factor of the I+S collection efficiency
+XAGGS_CLARGE1 = XKER_ZRNIC_A2*ZGAMI(2)
+XAGGS_CLARGE2 = XKER_ZRNIC_A2*ZGAMS(2)
+XAGGS_RLARGE1 = XKER_ZRNIC_A2*ZGAMI(6)*XAI
+XAGGS_RLARGE2 = XKER_ZRNIC_A2*ZGAMI(7)*ZGAMS(2)*XAI
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=ILUOUT0,FMT='(" snow aggregation")')
+ WRITE(UNIT=ILUOUT0,FMT='(" Temp. factor XCOLEXIS=",E13.6)') XCOLEXIS
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 7. CONSTANTS FOR THE FAST COLD PROCESSES FOR THE AGGREGATES
+! --------------------------------------------------------
+!
+!
+!* 7.1 Constants for the riming of the aggregates
+!
+XDCSLIM = 0.007 ! D_cs^lim = 7 mm as suggested by Farley et al. (1989)
+XCOLCS = 1.0
+XEXCRIMSS= XCXS-XDS-2.0
+XCRIMSS = (XPI/4.0)*XCOLCS*XCCS*XCS*(ZRHO00**XCEXVT)*MOMG(XALPHAS,XNUS,XDS+2.0)
+XEXCRIMSG= XEXCRIMSS
+XCRIMSG = XCRIMSS
+XSRIMCG = XCCS*XAS*MOMG(XALPHAS,XNUS,XBS)
+XEXSRIMCG= XCXS-XBS
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=ILUOUT0,FMT='(" riming of the aggregates")')
+ WRITE(UNIT=ILUOUT0,FMT='(" D_cs^lim (Farley et al.) XDCSLIM=",E13.6)') XDCSLIM
+ WRITE(UNIT=ILUOUT0,FMT='(" Coll. efficiency XCOLCS=",E13.6)') XCOLCS
+END IF
+!
+NGAMINC = 80
+XGAMINC_BOUND_MIN = 1.0E-1 ! Minimal value of (Lbda * D_cs^lim)**alpha
+XGAMINC_BOUND_MAX = 1.0E7 ! Maximal value of (Lbda * D_cs^lim)**alpha
+ZRATE = EXP(LOG(XGAMINC_BOUND_MAX/XGAMINC_BOUND_MIN)/REAL(NGAMINC-1))
+!
+ALLOCATE( XGAMINC_RIM1(NGAMINC) )
+ALLOCATE( XGAMINC_RIM2(NGAMINC) )
+!
+DO J1=1,NGAMINC
+ ZBOUND = XGAMINC_BOUND_MIN*ZRATE**(J1-1)
+ XGAMINC_RIM1(J1) = GAMMA_INC(XNUS+(2.0+XDS)/XALPHAS,ZBOUND)
+ XGAMINC_RIM2(J1) = GAMMA_INC(XNUS+XBS/XALPHAS ,ZBOUND)
+END DO
+!
+XRIMINTP1 = XALPHAS / LOG(ZRATE)
+XRIMINTP2 = 1.0 + XRIMINTP1*LOG( XDCSLIM/(XGAMINC_BOUND_MIN)**(1.0/XALPHAS) )
+!
+!* 7.1.1 Defining the constants for the Hallett-Mossop
+! secondary ice nucleation process
+!
+XHMTMIN = XTT - 8.0
+XHMTMAX = XTT - 3.0
+XHM1 = 9.3E-3 ! Obsolete parameterization
+XHM2 = 1.5E-3/LOG(10.0) ! from Ferrier (1995)
+XHM_YIELD = 5.E-3 ! A splinter is produced after the riming of 200 droplets
+XHM_COLLCS= 1.0 ! Collision efficiency snow/droplet (with Dc>25 microns)
+XHM_FACTS = XHM_YIELD*(XHM_COLLCS/XCOLCS)
+!
+! Notice: One magnitude of lambda discretized over 10 points for the droplets
+!
+XGAMINC_HMC_BOUND_MIN = 1.0E-3 ! Min value of (Lbda * (12,25) microns)**alpha
+XGAMINC_HMC_BOUND_MAX = 1.0E5 ! Max value of (Lbda * (12,25) microns)**alpha
+ZRATE = EXP(LOG(XGAMINC_HMC_BOUND_MAX/XGAMINC_HMC_BOUND_MIN)/REAL(NGAMINC-1))
+!
+ALLOCATE( XGAMINC_HMC(NGAMINC) )
+!
+DO J1=1,NGAMINC
+ ZBOUND = XGAMINC_HMC_BOUND_MIN*ZRATE**(J1-1)
+ XGAMINC_HMC(J1) = GAMMA_INC(XNUC,ZBOUND)
+END DO
+!
+XHMSINTP1 = XALPHAC / LOG(ZRATE)
+XHMSINTP2 = 1.0 + XHMSINTP1*LOG( 12.E-6/(XGAMINC_HMC_BOUND_MIN)**(1.0/XALPHAC) )
+XHMLINTP1 = XALPHAC / LOG(ZRATE)
+XHMLINTP2 = 1.0 + XHMLINTP1*LOG( 25.E-6/(XGAMINC_HMC_BOUND_MIN)**(1.0/XALPHAC) )
+!
+!
+!* 7.2 Constants for the accretion of raindrops onto aggregates
+!
+XFRACCSS = ((XPI**2)/24.0)*XCCS*XRHOLW*(ZRHO00**XCEXVT)
+!
+XLBRACCS1 = MOMG(XALPHAS,XNUS,2.)*MOMG(XALPHAR,XNUR,3.)
+XLBRACCS2 = 2.*MOMG(XALPHAS,XNUS,1.)*MOMG(XALPHAR,XNUR,4.)
+XLBRACCS3 = MOMG(XALPHAR,XNUR,5.)
+!
+XFSACCRG = (XPI/4.0)*XAS*XCCS*(ZRHO00**XCEXVT)
+!
+XLBSACCR1 = MOMG(XALPHAR,XNUR,2.)*MOMG(XALPHAS,XNUS,XBS)
+XLBSACCR2 = 2.*MOMG(XALPHAR,XNUR,1.)*MOMG(XALPHAS,XNUS,XBS+1.)
+XLBSACCR3 = MOMG(XALPHAS,XNUS,XBS+2.)
+!
+!* 7.2.1 Defining the ranges for the computation of the kernels
+!
+! Notice: One magnitude of lambda discretized over 10 points for rain
+! Notice: One magnitude of lambda discretized over 10 points for snow
+!
+NACCLBDAS = 40
+XACCLBDAS_MIN = 5.0E1 ! Minimal value of Lbda_s to tabulate XKER_RACCS
+XACCLBDAS_MAX = 5.0E5 ! Maximal value of Lbda_s to tabulate XKER_RACCS
+ZRATE = LOG(XACCLBDAS_MAX/XACCLBDAS_MIN)/REAL(NACCLBDAS-1)
+XACCINTP1S = 1.0 / ZRATE
+XACCINTP2S = 1.0 - LOG( XACCLBDAS_MIN ) / ZRATE
+NACCLBDAR = 40
+XACCLBDAR_MIN = 1.0E3 ! Minimal value of Lbda_r to tabulate XKER_RACCS
+XACCLBDAR_MAX = 1.0E7 ! Maximal value of Lbda_r to tabulate XKER_RACCS
+ZRATE = LOG(XACCLBDAR_MAX/XACCLBDAR_MIN)/REAL(NACCLBDAR-1)
+XACCINTP1R = 1.0 / ZRATE
+XACCINTP2R = 1.0 - LOG( XACCLBDAR_MIN ) / ZRATE
+!
+!* 7.2.2 Computations of the tabulated normalized kernels
+!
+IND = 50 ! Interval number, collection efficiency and infinite diameter
+ZESR = 1.0 ! factor used to integrate the dimensional distributions when
+ZFDINFTY = 20.0 ! computing the kernels XKER_RACCSS, XKER_RACCS and XKER_SACCRG
+!
+ALLOCATE( XKER_RACCSS(NACCLBDAS,NACCLBDAR) )
+ALLOCATE( XKER_RACCS (NACCLBDAS,NACCLBDAR) )
+ALLOCATE( XKER_SACCRG(NACCLBDAR,NACCLBDAS) )
+!
+CALL LIMA_READ_XKER_RACCS (KACCLBDAS,KACCLBDAR,KND, &
+ PALPHAS,PNUS,PALPHAR,PNUR,PESR,PBS,PBR,PCS,PDS,PCR,PDR, &
+ PACCLBDAS_MAX,PACCLBDAR_MAX,PACCLBDAS_MIN,PACCLBDAR_MIN,&
+ PFDINFTY )
+IF( (KACCLBDAS/=NACCLBDAS) .OR. (KACCLBDAR/=NACCLBDAR) .OR. (KND/=IND) .OR. &
+ (PALPHAS/=XALPHAS) .OR. (PNUS/=XNUS) .OR. &
+ (PALPHAR/=XALPHAR) .OR. (PNUR/=XNUR) .OR. &
+ (PESR/=ZESR) .OR. (PBS/=XBS) .OR. (PBR/=XBR) .OR. &
+ (PCS/=XCS) .OR. (PDS/=XDS) .OR. (PCR/=XCR) .OR. (PDR/=XDR) .OR. &
+ (PACCLBDAS_MAX/=XACCLBDAS_MAX) .OR. (PACCLBDAR_MAX/=XACCLBDAR_MAX) .OR. &
+ (PACCLBDAS_MIN/=XACCLBDAS_MIN) .OR. (PACCLBDAR_MIN/=XACCLBDAR_MIN) .OR. &
+ (PFDINFTY/=ZFDINFTY) ) THEN
+ CALL RRCOLSS ( IND, XALPHAS, XNUS, XALPHAR, XNUR, &
+ ZESR, XBR, XCS, XDS, XCR, XDR, &
+ XACCLBDAS_MAX, XACCLBDAR_MAX, XACCLBDAS_MIN, XACCLBDAR_MIN, &
+ ZFDINFTY, XKER_RACCSS, XAG, XBS, XAS )
+ CALL RZCOLX ( IND, XALPHAS, XNUS, XALPHAR, XNUR, &
+ ZESR, XBR, XCS, XDS, XCR, XDR, &
+ XACCLBDAS_MAX, XACCLBDAR_MAX, XACCLBDAS_MIN, XACCLBDAR_MIN, &
+ ZFDINFTY, XKER_RACCS )
+ CALL RSCOLRG ( IND, XALPHAS, XNUS, XALPHAR, XNUR, &
+ ZESR, XBS, XCS, XDS, XCR, XDR, &
+ XACCLBDAS_MAX, XACCLBDAR_MAX, XACCLBDAS_MIN, XACCLBDAR_MIN, &
+ ZFDINFTY, XKER_SACCRG,XAG, XBS, XAS )
+ WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
+ WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF RACSS KERNELS ****")')
+ WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF RACS KERNELS ****")')
+ WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF SACRG KERNELS ****")')
+ WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
+ WRITE(UNIT=ILUOUT0,FMT='("!")')
+ WRITE(UNIT=ILUOUT0,FMT='("KND=",I3)') IND
+ WRITE(UNIT=ILUOUT0,FMT='("KACCLBDAS=",I3)') NACCLBDAS
+ WRITE(UNIT=ILUOUT0,FMT='("KACCLBDAR=",I3)') NACCLBDAR
+ WRITE(UNIT=ILUOUT0,FMT='("PALPHAS=",E13.6)') XALPHAS
+ WRITE(UNIT=ILUOUT0,FMT='("PNUS=",E13.6)') XNUS
+ WRITE(UNIT=ILUOUT0,FMT='("PALPHAR=",E13.6)') XALPHAR
+ WRITE(UNIT=ILUOUT0,FMT='("PNUR=",E13.6)') XNUR
+ WRITE(UNIT=ILUOUT0,FMT='("PESR=",E13.6)') ZESR
+ WRITE(UNIT=ILUOUT0,FMT='("PBS=",E13.6)') XBS
+ WRITE(UNIT=ILUOUT0,FMT='("PBR=",E13.6)') XBR
+ WRITE(UNIT=ILUOUT0,FMT='("PCS=",E13.6)') XCS
+ WRITE(UNIT=ILUOUT0,FMT='("PDS=",E13.6)') XDS
+ WRITE(UNIT=ILUOUT0,FMT='("PCR=",E13.6)') XCR
+ WRITE(UNIT=ILUOUT0,FMT='("PDR=",E13.6)') XDR
+ WRITE(UNIT=ILUOUT0,FMT='("PACCLBDAS_MAX=",E13.6)') &
+ XACCLBDAS_MAX
+ WRITE(UNIT=ILUOUT0,FMT='("PACCLBDAR_MAX=",E13.6)') &
+ XACCLBDAR_MAX
+ WRITE(UNIT=ILUOUT0,FMT='("PACCLBDAS_MIN=",E13.6)') &
+ XACCLBDAS_MIN
+ WRITE(UNIT=ILUOUT0,FMT='("PACCLBDAR_MIN=",E13.6)') &
+ XACCLBDAR_MIN
+ WRITE(UNIT=ILUOUT0,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
+ WRITE(UNIT=ILUOUT0,FMT='("!")')
+ WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_RACCSS) ) THEN")')
+ DO J1 = 1 , NACCLBDAS
+ DO J2 = 1 , NACCLBDAR
+ WRITE(UNIT=ILUOUT0,FMT='(" PKER_RACCSS(",I3,",",I3,") = ",E13.6)') &
+ J1,J2,XKER_RACCSS(J1,J2)
+ END DO
+ END DO
+ WRITE(UNIT=ILUOUT0,FMT='("END IF")')
+ WRITE(UNIT=ILUOUT0,FMT='("!")')
+ WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_RACCS ) ) THEN")')
+ DO J1 = 1 , NACCLBDAS
+ DO J2 = 1 , NACCLBDAR
+ WRITE(UNIT=ILUOUT0,FMT='(" PKER_RACCS (",I3,",",I3,") = ",E13.6)') &
+ J1,J2,XKER_RACCS (J1,J2)
+ END DO
+ END DO
+ WRITE(UNIT=ILUOUT0,FMT='("END IF")')
+ WRITE(UNIT=ILUOUT0,FMT='("!")')
+ WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_SACCRG) ) THEN")')
+ DO J1 = 1 , NACCLBDAR
+ DO J2 = 1 , NACCLBDAS
+ WRITE(UNIT=ILUOUT0,FMT='(" PKER_SACCRG(",I3,",",I3,") = ",E13.6)') &
+ J1,J2,XKER_SACCRG(J1,J2)
+ END DO
+ END DO
+ WRITE(UNIT=ILUOUT0,FMT='("END IF")')
+ ELSE
+ CALL LIMA_READ_XKER_RACCS (KACCLBDAS,KACCLBDAR,KND, &
+ PALPHAS,PNUS,PALPHAR,PNUR,PESR,PBS,PBR,PCS,PDS,PCR,PDR, &
+ PACCLBDAS_MAX,PACCLBDAR_MAX,PACCLBDAS_MIN,PACCLBDAR_MIN,&
+ PFDINFTY,XKER_RACCSS,XKER_RACCS,XKER_SACCRG )
+ WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_RACCSS")')
+ WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_RACCS ")')
+ WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_SACCRG")')
+END IF
+!
+!
+!* 7.3 Constant for the conversion-melting rate
+!
+XFSCVMG = 2.0
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=ILUOUT0,FMT='(" conversion-melting of the aggregates")')
+ WRITE(UNIT=ILUOUT0,FMT='(" Conv. factor XFSCVMG=",E13.6)') XFSCVMG
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 8. CONSTANTS FOR THE FAST COLD PROCESSES FOR THE GRAUPELN
+! --------------------------------------------------------
+!
+!
+!* 8.1 Constants for the rain contact freezing
+!
+XCOLIR = 1.0
+!
+! values of these coeficients differ from the single-momemt rain_ice case
+!
+XEXRCFRI = -XDR-5.0
+XRCFRI = ((XPI**2)/24.0)*XRHOLW*XCOLIR*XCR*(ZRHO00**XCEXVT) &
+ *MOMG(XALPHAR,XNUR,XDR+5.0)
+XEXICFRR = -XDR-2.0
+XICFRR = (XPI/4.0)*XCOLIR*XCR*(ZRHO00**XCEXVT) &
+ *MOMG(XALPHAR,XNUR,XDR+2.0)
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=ILUOUT0,FMT='(" rain contact freezing")')
+ WRITE(UNIT=ILUOUT0,FMT='(" Coll. efficiency XCOLIR=",E13.6)') XCOLIR
+END IF
+!
+!
+!* 8.2 Constants for the dry growth of the graupeln
+!
+!* 8.2.1 Constants for the cloud droplet collection by the graupeln
+! and for the Hallett-Mossop process
+!
+XCOLCG = 0.6 ! Estimated from Cober and List (1993)
+XFCDRYG = (XPI/4.0)*XCOLCG*XCCG*XCG*(ZRHO00**XCEXVT)*MOMG(XALPHAG,XNUG,XDG+2.0)
+!
+XHM_COLLCG= 0.9 ! Collision efficiency graupel/droplet (with Dc>25 microns)
+XHM_FACTG = XHM_YIELD*(XHM_COLLCG/XCOLCG)
+!
+!* 8.2.2 Constants for the cloud ice collection by the graupeln
+!
+XCOLIG = 0.25 ! Collection efficiency of I+G
+XCOLEXIG = 0.05 ! Temperature factor of the I+G collection efficiency
+XCOLIG = 0.01 ! Collection efficiency of I+G
+XCOLEXIG = 0.1 ! Temperature factor of the I+G collection efficiency
+WRITE (ILUOUT0, FMT=*) ' NEW Constants for the cloud ice collection by the graupeln'
+WRITE (ILUOUT0, FMT=*) ' XCOLIG, XCOLEXIG = ',XCOLIG,XCOLEXIG
+XFIDRYG = (XPI/4.0)*XCOLIG*XCCG*XCG*(ZRHO00**XCEXVT)*MOMG(XALPHAG,XNUG,XDG+2.0)
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=ILUOUT0,FMT='(" cloud ice collection by the graupeln")')
+ WRITE(UNIT=ILUOUT0,FMT='(" Coll. efficiency XCOLIG=",E13.6)') XCOLIG
+ WRITE(UNIT=ILUOUT0,FMT='(" Temp. factor XCOLEXIG=",E13.6)') XCOLEXIG
+END IF
+!
+!* 8.2.3 Constants for the aggregate collection by the graupeln
+!
+XCOLSG = 0.25 ! Collection efficiency of S+G
+XCOLEXSG = 0.05 ! Temperature factor of the S+G collection efficiency
+XCOLSG = 0.01 ! Collection efficiency of S+G
+XCOLEXSG = 0.1 ! Temperature factor of the S+G collection efficiency
+WRITE (ILUOUT0, FMT=*) ' NEW Constants for the aggregate collection by the graupeln'
+WRITE (ILUOUT0, FMT=*) ' XCOLSG, XCOLEXSG = ',XCOLSG,XCOLEXSG
+XFSDRYG = (XPI/4.0)*XCOLSG*XCCG*XCCS*XAS*(ZRHO00**XCEXVT)
+!
+XLBSDRYG1 = MOMG(XALPHAG,XNUG,2.)*MOMG(XALPHAS,XNUS,XBS)
+XLBSDRYG2 = 2.*MOMG(XALPHAG,XNUG,1.)*MOMG(XALPHAS,XNUS,XBS+1.)
+XLBSDRYG3 = MOMG(XALPHAS,XNUS,XBS+2.)
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=ILUOUT0,FMT='(" aggregate collection by the graupeln")')
+ WRITE(UNIT=ILUOUT0,FMT='(" Coll. efficiency XCOLSG=",E13.6)') XCOLSG
+ WRITE(UNIT=ILUOUT0,FMT='(" Temp. factor XCOLEXSG=",E13.6)') XCOLEXSG
+END IF
+!
+!* 8.2.4 Constants for the raindrop collection by the graupeln
+!
+XFRDRYG = ((XPI**2)/24.0)*XCCG*XRHOLW*(ZRHO00**XCEXVT)
+!
+XLBRDRYG1 = MOMG(XALPHAG,XNUG,2.)*MOMG(XALPHAR,XNUR,3.)
+XLBRDRYG2 = 2.*MOMG(XALPHAG,XNUG,1.)*MOMG(XALPHAR,XNUR,4.)
+XLBRDRYG3 = MOMG(XALPHAR,XNUR,5.)
+!
+! Notice: One magnitude of lambda discretized over 10 points
+!
+NDRYLBDAR = 40
+XDRYLBDAR_MIN = 1.0E3 ! Minimal value of Lbda_r to tabulate XKER_RDRYG
+XDRYLBDAR_MAX = 1.0E7 ! Maximal value of Lbda_r to tabulate XKER_RDRYG
+ZRATE = LOG(XDRYLBDAR_MAX/XDRYLBDAR_MIN)/REAL(NDRYLBDAR-1)
+XDRYINTP1R = 1.0 / ZRATE
+XDRYINTP2R = 1.0 - LOG( XDRYLBDAR_MIN ) / ZRATE
+NDRYLBDAS = 80
+XDRYLBDAS_MIN = 2.5E1 ! Minimal value of Lbda_s to tabulate XKER_SDRYG
+XDRYLBDAS_MAX = 2.5E9 ! Maximal value of Lbda_s to tabulate XKER_SDRYG
+ZRATE = LOG(XDRYLBDAS_MAX/XDRYLBDAS_MIN)/REAL(NDRYLBDAS-1)
+XDRYINTP1S = 1.0 / ZRATE
+XDRYINTP2S = 1.0 - LOG( XDRYLBDAS_MIN ) / ZRATE
+NDRYLBDAG = 40
+XDRYLBDAG_MIN = 1.0E3 ! Min value of Lbda_g to tabulate XKER_SDRYG,XKER_RDRYG
+XDRYLBDAG_MAX = 1.0E7 ! Max value of Lbda_g to tabulate XKER_SDRYG,XKER_RDRYG
+ZRATE = LOG(XDRYLBDAG_MAX/XDRYLBDAG_MIN)/REAL(NDRYLBDAG-1)
+XDRYINTP1G = 1.0 / ZRATE
+XDRYINTP2G = 1.0 - LOG( XDRYLBDAG_MIN ) / ZRATE
+!
+!* 8.2.5 Computations of the tabulated normalized kernels
+!
+IND = 50 ! Interval number, collection efficiency and infinite diameter
+ZEGS = 1.0 ! factor used to integrate the dimensional distributions when
+ZFDINFTY = 20.0 ! computing the kernels XKER_SDRYG
+!
+ALLOCATE( XKER_SDRYG(NDRYLBDAG,NDRYLBDAS) )
+!
+CALL LIMA_READ_XKER_SDRYG (KDRYLBDAG,KDRYLBDAS,KND, &
+ PALPHAG,PNUG,PALPHAS,PNUS,PEGS,PBS,PCG,PDG,PCS,PDS, &
+ PDRYLBDAG_MAX,PDRYLBDAS_MAX,PDRYLBDAG_MIN,PDRYLBDAS_MIN, &
+ PFDINFTY )
+IF( (KDRYLBDAG/=NDRYLBDAG) .OR. (KDRYLBDAS/=NDRYLBDAS) .OR. (KND/=IND) .OR. &
+ (PALPHAG/=XALPHAG) .OR. (PNUG/=XNUG) .OR. &
+ (PALPHAS/=XALPHAS) .OR. (PNUS/=XNUS) .OR. &
+ (PEGS/=ZEGS) .OR. (PBS/=XBS) .OR. &
+ (PCG/=XCG) .OR. (PDG/=XDG) .OR. (PCS/=XCS) .OR. (PDS/=XDS) .OR. &
+ (PDRYLBDAG_MAX/=XDRYLBDAG_MAX) .OR. (PDRYLBDAS_MAX/=XDRYLBDAS_MAX) .OR. &
+ (PDRYLBDAG_MIN/=XDRYLBDAG_MIN) .OR. (PDRYLBDAS_MIN/=XDRYLBDAS_MIN) .OR. &
+ (PFDINFTY/=ZFDINFTY) ) THEN
+ CALL RZCOLX ( IND, XALPHAG, XNUG, XALPHAS, XNUS, &
+ ZEGS, XBS, XCG, XDG, XCS, XDS, &
+ XDRYLBDAG_MAX, XDRYLBDAS_MAX, XDRYLBDAG_MIN, XDRYLBDAS_MIN, &
+ ZFDINFTY, XKER_SDRYG )
+ WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
+ WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF SDRYG KERNELS ****")')
+ WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
+ WRITE(UNIT=ILUOUT0,FMT='("!")')
+ WRITE(UNIT=ILUOUT0,FMT='("KND=",I3)') IND
+ WRITE(UNIT=ILUOUT0,FMT='("KDRYLBDAG=",I3)') NDRYLBDAG
+ WRITE(UNIT=ILUOUT0,FMT='("KDRYLBDAS=",I3)') NDRYLBDAS
+ WRITE(UNIT=ILUOUT0,FMT='("PALPHAG=",E13.6)') XALPHAG
+ WRITE(UNIT=ILUOUT0,FMT='("PNUG=",E13.6)') XNUG
+ WRITE(UNIT=ILUOUT0,FMT='("PALPHAS=",E13.6)') XALPHAS
+ WRITE(UNIT=ILUOUT0,FMT='("PNUS=",E13.6)') XNUS
+ WRITE(UNIT=ILUOUT0,FMT='("PEGS=",E13.6)') ZEGS
+ WRITE(UNIT=ILUOUT0,FMT='("PBS=",E13.6)') XBS
+ WRITE(UNIT=ILUOUT0,FMT='("PCG=",E13.6)') XCG
+ WRITE(UNIT=ILUOUT0,FMT='("PDG=",E13.6)') XDG
+ WRITE(UNIT=ILUOUT0,FMT='("PCS=",E13.6)') XCS
+ WRITE(UNIT=ILUOUT0,FMT='("PDS=",E13.6)') XDS
+ WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAG_MAX=",E13.6)') &
+ XDRYLBDAG_MAX
+ WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAS_MAX=",E13.6)') &
+ XDRYLBDAS_MAX
+ WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAG_MIN=",E13.6)') &
+ XDRYLBDAG_MIN
+ WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAS_MIN=",E13.6)') &
+ XDRYLBDAS_MIN
+ WRITE(UNIT=ILUOUT0,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
+ WRITE(UNIT=ILUOUT0,FMT='("!")')
+ WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_SDRYG) ) THEN")')
+ DO J1 = 1 , NDRYLBDAG
+ DO J2 = 1 , NDRYLBDAS
+ WRITE(UNIT=ILUOUT0,FMT='("PKER_SDRYG(",I3,",",I3,") = ",E13.6)') &
+ J1,J2,XKER_SDRYG(J1,J2)
+ END DO
+ END DO
+ WRITE(UNIT=ILUOUT0,FMT='("END IF")')
+ ELSE
+ CALL LIMA_READ_XKER_SDRYG (KDRYLBDAG,KDRYLBDAS,KND, &
+ PALPHAG,PNUG,PALPHAS,PNUS,PEGS,PBS,PCG,PDG,PCS,PDS, &
+ PDRYLBDAG_MAX,PDRYLBDAS_MAX,PDRYLBDAG_MIN,PDRYLBDAS_MIN, &
+ PFDINFTY,XKER_SDRYG )
+ WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_SDRYG")')
+END IF
+!
+!
+IND = 50 ! Number of interval used to integrate the dimensional
+ZEGR = 1.0 ! distributions when computing the kernel XKER_RDRYG
+ZFDINFTY = 20.0
+!
+ALLOCATE( XKER_RDRYG(NDRYLBDAG,NDRYLBDAR) )
+!
+CALL LIMA_READ_XKER_RDRYG (KDRYLBDAG,KDRYLBDAR,KND, &
+ PALPHAG,PNUG,PALPHAR,PNUR,PEGR,PBR,PCG,PDG,PCR,PDR, &
+ PDRYLBDAG_MAX,PDRYLBDAR_MAX,PDRYLBDAG_MIN,PDRYLBDAR_MIN, &
+ PFDINFTY )
+IF( (KDRYLBDAG/=NDRYLBDAG) .OR. (KDRYLBDAR/=NDRYLBDAR) .OR. (KND/=IND) .OR. &
+ (PALPHAG/=XALPHAG) .OR. (PNUG/=XNUG) .OR. &
+ (PALPHAR/=XALPHAR) .OR. (PNUR/=XNUR) .OR. &
+ (PEGR/=ZEGR) .OR. (PBR/=XBR) .OR. &
+ (PCG/=XCG) .OR. (PDG/=XDG) .OR. (PCR/=XCR) .OR. (PDR/=XDR) .OR. &
+ (PDRYLBDAG_MAX/=XDRYLBDAG_MAX) .OR. (PDRYLBDAR_MAX/=XDRYLBDAR_MAX) .OR. &
+ (PDRYLBDAG_MIN/=XDRYLBDAG_MIN) .OR. (PDRYLBDAR_MIN/=XDRYLBDAR_MIN) .OR. &
+ (PFDINFTY/=ZFDINFTY) ) THEN
+ CALL RZCOLX ( IND, XALPHAG, XNUG, XALPHAR, XNUR, &
+ ZEGR, XBR, XCG, XDG, XCR, XDR, &
+ XDRYLBDAG_MAX, XDRYLBDAR_MAX, XDRYLBDAG_MIN, XDRYLBDAR_MIN, &
+ ZFDINFTY, XKER_RDRYG )
+ WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
+ WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF RDRYG KERNELS ****")')
+ WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
+ WRITE(UNIT=ILUOUT0,FMT='("!")')
+ WRITE(UNIT=ILUOUT0,FMT='("KND=",I3)') IND
+ WRITE(UNIT=ILUOUT0,FMT='("KDRYLBDAG=",I3)') NDRYLBDAG
+ WRITE(UNIT=ILUOUT0,FMT='("KDRYLBDAR=",I3)') NDRYLBDAR
+ WRITE(UNIT=ILUOUT0,FMT='("PALPHAG=",E13.6)') XALPHAG
+ WRITE(UNIT=ILUOUT0,FMT='("PNUG=",E13.6)') XNUG
+ WRITE(UNIT=ILUOUT0,FMT='("PALPHAR=",E13.6)') XALPHAR
+ WRITE(UNIT=ILUOUT0,FMT='("PNUR=",E13.6)') XNUR
+ WRITE(UNIT=ILUOUT0,FMT='("PEGR=",E13.6)') ZEGR
+ WRITE(UNIT=ILUOUT0,FMT='("PBR=",E13.6)') XBR
+ WRITE(UNIT=ILUOUT0,FMT='("PCG=",E13.6)') XCG
+ WRITE(UNIT=ILUOUT0,FMT='("PDG=",E13.6)') XDG
+ WRITE(UNIT=ILUOUT0,FMT='("PCR=",E13.6)') XCR
+ WRITE(UNIT=ILUOUT0,FMT='("PDR=",E13.6)') XDR
+ WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAG_MAX=",E13.6)') &
+ XDRYLBDAG_MAX
+ WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAR_MAX=",E13.6)') &
+ XDRYLBDAR_MAX
+ WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAG_MIN=",E13.6)') &
+ XDRYLBDAG_MIN
+ WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAR_MIN=",E13.6)') &
+ XDRYLBDAR_MIN
+ WRITE(UNIT=ILUOUT0,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
+ WRITE(UNIT=ILUOUT0,FMT='("!")')
+ WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_RDRYG) ) THEN")')
+ DO J1 = 1 , NDRYLBDAG
+ DO J2 = 1 , NDRYLBDAR
+ WRITE(UNIT=ILUOUT0,FMT='("PKER_RDRYG(",I3,",",I3,") = ",E13.6)') &
+ J1,J2,XKER_RDRYG(J1,J2)
+ END DO
+ END DO
+ WRITE(UNIT=ILUOUT0,FMT='("END IF")')
+ ELSE
+ CALL LIMA_READ_XKER_RDRYG (KDRYLBDAG,KDRYLBDAR,KND, &
+ PALPHAG,PNUG,PALPHAR,PNUR,PEGR,PBR,PCG,PDG,PCR,PDR, &
+ PDRYLBDAG_MAX,PDRYLBDAR_MAX,PDRYLBDAG_MIN,PDRYLBDAR_MIN, &
+ PFDINFTY,XKER_RDRYG )
+ WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_RDRYG")')
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 9. CONSTANTS FOR THE FAST COLD PROCESSES FOR THE HAILSTONES
+! --------------------------------------------------------
+!
+!* 9.2 Constants for the wet growth of the hailstones
+!
+!
+!* 9.2.1 Constant for the cloud droplet and cloud ice collection
+! by the hailstones
+!
+XFWETH = (XPI/4.0)*XCCH*XCH*(ZRHO00**XCEXVT)*MOMG(XALPHAH,XNUH,XDH+2.0)
+!
+!* 9.2.2 Constants for the aggregate collection by the hailstones
+!
+XFSWETH = (XPI/4.0)*XCCH*XCCS*XAS*(ZRHO00**XCEXVT)
+!
+XLBSWETH1 = MOMG(XALPHAH,XNUH,2.)*MOMG(XALPHAS,XNUS,XBS)
+XLBSWETH2 = 2.*MOMG(XALPHAH,XNUH,1.)*MOMG(XALPHAS,XNUS,XBS+1.)
+XLBSWETH3 = MOMG(XALPHAS,XNUS,XBS+2.)
+!
+!* 9.2.3 Constants for the graupel collection by the hailstones
+!
+XFGWETH = (XPI/4.0)*XCCH*XCCG*XAG*(ZRHO00**XCEXVT)
+!
+XLBGWETH1 = MOMG(XALPHAH,XNUH,2.)*MOMG(XALPHAG,XNUG,XBG)
+XLBGWETH2 = 2.*MOMG(XALPHAH,XNUH,1.)*MOMG(XALPHAG,XNUG,XBG+1.)
+XLBGWETH3 = MOMG(XALPHAG,XNUG,XBG+2.)
+!
+! Notice: One magnitude of lambda discretized over 10 points
+!
+NWETLBDAS = 80
+XWETLBDAS_MIN = 2.5E1 ! Minimal value of Lbda_s to tabulate XKER_SWETH
+XWETLBDAS_MAX = 2.5E9 ! Maximal value of Lbda_s to tabulate XKER_SWETH
+ZRATE = LOG(XWETLBDAS_MAX/XWETLBDAS_MIN)/REAL(NWETLBDAS-1)
+XWETINTP1S = 1.0 / ZRATE
+XWETINTP2S = 1.0 - LOG( XWETLBDAS_MIN ) / ZRATE
+NWETLBDAG = 40
+XWETLBDAG_MIN = 1.0E3 ! Min value of Lbda_g to tabulate XKER_GWETH
+XWETLBDAG_MAX = 1.0E7 ! Max value of Lbda_g to tabulate XKER_GWETH
+ZRATE = LOG(XWETLBDAG_MAX/XWETLBDAG_MIN)/REAL(NWETLBDAG-1)
+XWETINTP1G = 1.0 / ZRATE
+XWETINTP2G = 1.0 - LOG( XWETLBDAG_MIN ) / ZRATE
+NWETLBDAH = 40
+XWETLBDAH_MIN = 1.0E3 ! Min value of Lbda_h to tabulate XKER_SWETH,XKER_GWETH
+XWETLBDAH_MAX = 1.0E7 ! Max value of Lbda_h to tabulate XKER_SWETH,XKER_GWETH
+ZRATE = LOG(XWETLBDAH_MAX/XWETLBDAH_MIN)/REAL(NWETLBDAH-1)
+XWETINTP1H = 1.0 / ZRATE
+XWETINTP2H = 1.0 - LOG( XWETLBDAH_MIN ) / ZRATE
+!
+!* 9.2.4 Computations of the tabulated normalized kernels
+!
+IND = 50 ! Interval number, collection efficiency and infinite diameter
+ZEHS = 1.0 ! factor used to integrate the dimensional distributions when
+ZFDINFTY = 20.0 ! computing the kernels XKER_SWETH
+!
+IF( .NOT.ALLOCATED(XKER_SWETH) ) ALLOCATE( XKER_SWETH(NWETLBDAH,NWETLBDAS) )
+!
+CALL LIMA_READ_XKER_SWETH (KWETLBDAH,KWETLBDAS,KND, &
+ PALPHAH,PNUH,PALPHAS,PNUS,PEHS,PBS,PCH,PDH,PCS,PDS, &
+ PWETLBDAH_MAX,PWETLBDAS_MAX,PWETLBDAH_MIN,PWETLBDAS_MIN, &
+ PFDINFTY )
+IF( (KWETLBDAH/=NWETLBDAH) .OR. (KWETLBDAS/=NWETLBDAS) .OR. (KND/=IND) .OR. &
+ (PALPHAH/=XALPHAH) .OR. (PNUH/=XNUH) .OR. &
+ (PALPHAS/=XALPHAS) .OR. (PNUS/=XNUS) .OR. &
+ (PEHS/=ZEHS) .OR. (PBS/=XBS) .OR. &
+ (PCH/=XCH) .OR. (PDH/=XDH) .OR. (PCS/=XCS) .OR. (PDS/=XDS) .OR. &
+ (PWETLBDAH_MAX/=XWETLBDAH_MAX) .OR. (PWETLBDAS_MAX/=XWETLBDAS_MAX) .OR. &
+ (PWETLBDAH_MIN/=XWETLBDAH_MIN) .OR. (PWETLBDAS_MIN/=XWETLBDAS_MIN) .OR. &
+ (PFDINFTY/=ZFDINFTY) ) THEN
+ CALL RZCOLX ( IND, XALPHAH, XNUH, XALPHAS, XNUS, &
+ ZEHS, XBS, XCH, XDH, XCS, XDS, &
+ XWETLBDAH_MAX, XWETLBDAS_MAX, XWETLBDAH_MIN, XWETLBDAS_MIN, &
+ ZFDINFTY, XKER_SWETH )
+ WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
+ WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF SWETH KERNELS ****")')
+ WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
+ WRITE(UNIT=ILUOUT0,FMT='("!")')
+ WRITE(UNIT=ILUOUT0,FMT='("KND=",I3)') IND
+ WRITE(UNIT=ILUOUT0,FMT='("KWETLBDAH=",I3)') NWETLBDAH
+ WRITE(UNIT=ILUOUT0,FMT='("KWETLBDAS=",I3)') NWETLBDAS
+ WRITE(UNIT=ILUOUT0,FMT='("PALPHAH=",E13.6)') XALPHAH
+ WRITE(UNIT=ILUOUT0,FMT='("PNUH=",E13.6)') XNUH
+ WRITE(UNIT=ILUOUT0,FMT='("PALPHAS=",E13.6)') XALPHAS
+ WRITE(UNIT=ILUOUT0,FMT='("PNUS=",E13.6)') XNUS
+ WRITE(UNIT=ILUOUT0,FMT='("PEHS=",E13.6)') ZEHS
+ WRITE(UNIT=ILUOUT0,FMT='("PBS=",E13.6)') XBS
+ WRITE(UNIT=ILUOUT0,FMT='("PCH=",E13.6)') XCH
+ WRITE(UNIT=ILUOUT0,FMT='("PDH=",E13.6)') XDH
+ WRITE(UNIT=ILUOUT0,FMT='("PCS=",E13.6)') XCS
+ WRITE(UNIT=ILUOUT0,FMT='("PDS=",E13.6)') XDS
+ WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAH_MAX=",E13.6)') &
+ XWETLBDAH_MAX
+ WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAS_MAX=",E13.6)') &
+ XWETLBDAS_MAX
+ WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAH_MIN=",E13.6)') &
+ XWETLBDAH_MIN
+ WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAS_MIN=",E13.6)') &
+ XWETLBDAS_MIN
+ WRITE(UNIT=ILUOUT0,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
+ WRITE(UNIT=ILUOUT0,FMT='("!")')
+ WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_SWETH) ) THEN")')
+ DO J1 = 1 , NWETLBDAH
+ DO J2 = 1 , NWETLBDAS
+ WRITE(UNIT=ILUOUT0,FMT='("PKER_SWETH(",I3,",",I3,") = ",E13.6)') &
+ J1,J2,XKER_SWETH(J1,J2)
+ END DO
+ END DO
+ WRITE(UNIT=ILUOUT0,FMT='("END IF")')
+ ELSE
+ CALL LIMA_READ_XKER_SWETH (KWETLBDAH,KWETLBDAS,KND, &
+ PALPHAH,PNUH,PALPHAS,PNUS,PEHS,PBS,PCH,PDH,PCS,PDS, &
+ PWETLBDAH_MAX,PWETLBDAS_MAX,PWETLBDAH_MIN,PWETLBDAS_MIN, &
+ PFDINFTY,XKER_SWETH )
+ WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_SWETH")')
+END IF
+!
+!
+IND = 50 ! Number of interval used to integrate the dimensional
+ZEHG = 1.0 ! distributions when computing the kernel XKER_GWETH
+ZFDINFTY = 20.0
+!
+IF( .NOT.ALLOCATED(XKER_GWETH) ) ALLOCATE( XKER_GWETH(NWETLBDAH,NWETLBDAG) )
+!
+CALL LIMA_READ_XKER_GWETH (KWETLBDAH,KWETLBDAG,KND, &
+ PALPHAH,PNUH,PALPHAG,PNUG,PEHG,PBG,PCH,PDH,PCG,PDG, &
+ PWETLBDAH_MAX,PWETLBDAG_MAX,PWETLBDAH_MIN,PWETLBDAG_MIN, &
+ PFDINFTY )
+IF( (KWETLBDAH/=NWETLBDAH) .OR. (KWETLBDAG/=NWETLBDAG) .OR. (KND/=IND) .OR. &
+ (PALPHAH/=XALPHAH) .OR. (PNUH/=XNUH) .OR. &
+ (PALPHAG/=XALPHAG) .OR. (PNUG/=XNUG) .OR. &
+ (PEHG/=ZEHG) .OR. (PBG/=XBG) .OR. &
+ (PCH/=XCH) .OR. (PDH/=XDH) .OR. (PCG/=XCG) .OR. (PDG/=XDG) .OR. &
+ (PWETLBDAH_MAX/=XWETLBDAH_MAX) .OR. (PWETLBDAG_MAX/=XWETLBDAG_MAX) .OR. &
+ (PWETLBDAH_MIN/=XWETLBDAH_MIN) .OR. (PWETLBDAG_MIN/=XWETLBDAG_MIN) .OR. &
+ (PFDINFTY/=ZFDINFTY) ) THEN
+ CALL RZCOLX ( IND, XALPHAH, XNUH, XALPHAG, XNUG, &
+ ZEHG, XBG, XCH, XDH, XCG, XDG, &
+ XWETLBDAH_MAX, XWETLBDAG_MAX, XWETLBDAH_MIN, XWETLBDAG_MIN, &
+ ZFDINFTY, XKER_GWETH )
+ WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
+ WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF GWETH KERNELS ****")')
+ WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
+ WRITE(UNIT=ILUOUT0,FMT='("!")')
+ WRITE(UNIT=ILUOUT0,FMT='("KND=",I3)') IND
+ WRITE(UNIT=ILUOUT0,FMT='("KWETLBDAH=",I3)') NWETLBDAH
+ WRITE(UNIT=ILUOUT0,FMT='("KWETLBDAG=",I3)') NWETLBDAG
+ WRITE(UNIT=ILUOUT0,FMT='("PALPHAH=",E13.6)') XALPHAH
+ WRITE(UNIT=ILUOUT0,FMT='("PNUH=",E13.6)') XNUH
+ WRITE(UNIT=ILUOUT0,FMT='("PALPHAG=",E13.6)') XALPHAG
+ WRITE(UNIT=ILUOUT0,FMT='("PNUG=",E13.6)') XNUG
+ WRITE(UNIT=ILUOUT0,FMT='("PEHG=",E13.6)') ZEHG
+ WRITE(UNIT=ILUOUT0,FMT='("PBG=",E13.6)') XBG
+ WRITE(UNIT=ILUOUT0,FMT='("PCH=",E13.6)') XCH
+ WRITE(UNIT=ILUOUT0,FMT='("PDH=",E13.6)') XDH
+ WRITE(UNIT=ILUOUT0,FMT='("PCG=",E13.6)') XCG
+ WRITE(UNIT=ILUOUT0,FMT='("PDG=",E13.6)') XDG
+ WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAH_MAX=",E13.6)') &
+ XWETLBDAH_MAX
+ WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAG_MAX=",E13.6)') &
+ XWETLBDAG_MAX
+ WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAH_MIN=",E13.6)') &
+ XWETLBDAH_MIN
+ WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAG_MIN=",E13.6)') &
+ XWETLBDAG_MIN
+ WRITE(UNIT=ILUOUT0,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
+ WRITE(UNIT=ILUOUT0,FMT='("!")')
+ WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_GWETH) ) THEN")')
+ DO J1 = 1 , NWETLBDAH
+ DO J2 = 1 , NWETLBDAG
+ WRITE(UNIT=ILUOUT0,FMT='("PKER_GWETH(",I3,",",I3,") = ",E13.6)') &
+ J1,J2,XKER_GWETH(J1,J2)
+ END DO
+ END DO
+ WRITE(UNIT=ILUOUT0,FMT='("END IF")')
+ ELSE
+ CALL LIMA_READ_XKER_GWETH (KWETLBDAH,KWETLBDAG,KND, &
+ PALPHAH,PNUH,PALPHAG,PNUG,PEHG,PBG,PCH,PDH,PCG,PDG, &
+ PWETLBDAH_MAX,PWETLBDAG_MAX,PWETLBDAH_MIN,PWETLBDAG_MIN, &
+ PFDINFTY,XKER_GWETH )
+ WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_GWETH")')
+END IF
+!
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 10. SET-UP RADIATIVE PARAMETERS
+! ---------------------------
+!
+!
+! R_eff_i = XFREFFI * (rho*r_i/N_i)**(1/3)
+!
+XFREFFI = 0.5 * ZGAMI(8) * (1.0/XLBI)**XLBEXI
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 11. SOME PRINTS FOR CONTROL
+! -----------------------
+!
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=ILUOUT0,FMT='(" Summary of the ice particule characteristics")')
+ WRITE(UNIT=ILUOUT0,FMT='(" PRISTINE ICE")')
+ WRITE(UNIT=ILUOUT0,FMT='(" masse: A=",E13.6," B=",E13.6)') &
+ XAI,XBI
+ WRITE(UNIT=ILUOUT0,FMT='(" vitesse: C=",E13.6," D=",E13.6)') &
+ XC_I,XDI
+ WRITE(UNIT=ILUOUT0,FMT='(" distribution:AL=",E13.6,"NU=",E13.6)') &
+ XALPHAI,XNUI
+ WRITE(UNIT=ILUOUT0,FMT='(" SNOW")')
+ WRITE(UNIT=ILUOUT0,FMT='(" masse: A=",E13.6," B=",E13.6)') &
+ XAS,XBS
+ WRITE(UNIT=ILUOUT0,FMT='(" vitesse: C=",E13.6," D=",E13.6)') &
+ XCS,XDS
+ WRITE(UNIT=ILUOUT0,FMT='(" concentration:CC=",E13.6," x=",E13.6)') &
+ XCCS,XCXS
+ WRITE(UNIT=ILUOUT0,FMT='(" distribution:AL=",E13.6,"NU=",E13.6)') &
+ XALPHAS,XNUS
+ WRITE(UNIT=ILUOUT0,FMT='(" GRAUPEL")')
+ WRITE(UNIT=ILUOUT0,FMT='(" masse: A=",E13.6," B=",E13.6)') &
+ XAG,XBG
+ WRITE(UNIT=ILUOUT0,FMT='(" vitesse: C=",E13.6," D=",E13.6)') &
+ XCG,XDG
+ WRITE(UNIT=ILUOUT0,FMT='(" concentration:CC=",E13.6," x=",E13.6)') &
+ XCCG,XCXG
+ WRITE(UNIT=ILUOUT0,FMT='(" distribution:AL=",E13.6,"NU=",E13.6)') &
+ XALPHAG,XNUG
+END IF
+!
+!------------------------------------------------------------------------------
+!
+END SUBROUTINE INI_LIMA_COLD_MIXED
diff --git a/src/mesonh/micro/ini_lima_warm.f90 b/src/mesonh/micro/ini_lima_warm.f90
new file mode 100644
index 000000000..3fac15aae
--- /dev/null
+++ b/src/mesonh/micro/ini_lima_warm.f90
@@ -0,0 +1,461 @@
+!MNH_LIC Copyright 2013-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! #########################
+ MODULE MODI_INI_LIMA_WARM
+! #########################
+!
+INTERFACE
+ SUBROUTINE INI_LIMA_WARM (PTSTEP, PDZMIN)
+!
+REAL, INTENT(IN) :: PTSTEP ! Effective Time step
+REAL, INTENT(IN) :: PDZMIN ! minimun vertical mesh size
+!
+END SUBROUTINE INI_LIMA_WARM
+!
+END INTERFACE
+!
+END MODULE MODI_INI_LIMA_WARM
+! #########################################
+ SUBROUTINE INI_LIMA_WARM (PTSTEP, PDZMIN)
+! #########################################
+!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to initialize the constants used in the
+!! microphysical scheme LIMA for the warm phase species and processes.
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_REF
+USE MODD_PARAM_LIMA
+USE MODD_PARAM_LIMA_WARM
+USE MODD_PARAMETERS
+USE MODD_LUNIT, ONLY : TLUOUT0
+!
+USE MODI_LIMA_FUNCTIONS
+USE MODI_HYPGEO
+USE MODI_GAMMA
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, INTENT(IN) :: PTSTEP ! Effective Time step
+REAL, INTENT(IN) :: PDZMIN ! minimun vertical mesh size
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IKB ! Coordinates of the first and last physical
+ ! points along z
+INTEGER :: J1 ! Internal loop indexes
+INTEGER :: JMOD ! Internal loop to index the CCN modes
+!
+REAL, DIMENSION(6) :: ZGAMC, ZGAMR ! parameters involving various moments of
+ ! the generalized gamma law
+!
+REAL :: ZTT ! Temperature in Celsius
+REAL :: ZLV ! Latent heat of vaporization
+REAL :: ZSS ! Supersaturation
+REAL :: ZPSI1, ZG ! Psi1 and G functions
+REAL :: ZAHENR ! r_star (FH92)
+REAL :: ZVTRMAX ! Raindrop maximal fall velocity
+REAL :: ZRHO00 ! Surface reference air density
+REAL :: ZSURF_TEN ! Water drop surface tension
+REAL :: ZSMIN, ZSMAX ! Minimal and maximal supersaturation used to
+ ! discretize the HYP functions
+!
+!
+INTEGER :: ILUOUT0 ! Logical unit number for output-listing
+INTEGER :: IRESP ! Return code of FM-routines
+LOGICAL :: GFLAG ! Logical flag for printing the constatnts on the output
+ ! listing
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 1. CHARACTERISTICS OF THE SPECIES
+! ------------------------------
+!
+!
+!* 1.1 Cloud droplet characteristics
+!
+XAC = (XPI/6.0)*XRHOLW
+XBC = 3.0
+XCC = XRHOLW*XG/(18.0*1.816E-5) ! Stokes flow (Pruppacher eq. 10-138 for T=293K)
+!XCC = XRHOLW*XG/(18.0*1.7E-5) ! Stokes flow (Pruppacher eq. 10-138 for T=273K)
+XDC = 2.0
+!
+XF0C = 1.00
+XF2C = 0.108
+!
+XC1C = 1./2.
+!
+!* 1.2 Raindrops characteristics
+!
+XAR = (XPI/6.0)*XRHOLW
+XBR = 3.0
+XCR = 842.
+XDR = 0.8
+!
+XF0R = 0.780
+!Correction BVIE Pruppacher 1997 eq. 13-61
+!XF1R = 0.265
+XF1R = 0.308
+!
+!
+!------------------------------------------------------------------------------
+!
+!
+!* 2. DIMENSIONAL DISTRIBUTIONS OF THE SPECIES
+! ----------------------------------------
+!
+!
+!* 2.1 Cloud droplet distribution
+!
+!XALPHAC = 3.0 ! Gamma law of the Cloud droplet (here volume-like distribution)
+!XNUC = 3.0 ! Gamma law with little dispersion
+!
+!* 2.2 Raindrop distribution
+!
+!XALPHAR = 3.0 ! Gamma law of the raindrops (here volume-like distribution)
+!XNUR = 3.0 ! Gamma law for the raindrops
+!XNUR = 0.1
+!
+!* 2.3 Precalculation of the gamma function momentum
+!
+!
+ZGAMC(1) = GAMMA_X0D(XNUC)
+ZGAMC(2) = MOMG(XALPHAC,XNUC,3.)
+ZGAMC(3) = MOMG(XALPHAC,XNUC,6.)
+ZGAMC(4) = ZGAMC(3)-ZGAMC(2)**2 ! useful for Sig_c
+ZGAMC(5) = MOMG(XALPHAC,XNUC,9.)
+ZGAMC(6) = MOMG(XALPHAC,XNUC,3.)**(2./3.)/MOMG(XALPHAC,XNUC,2.)
+!
+ZGAMR(1) = GAMMA_X0D(XNUR)
+ZGAMR(2) = MOMG(XALPHAR,XNUR,3.)
+ZGAMR(3) = MOMG(XALPHAR,XNUR,6.)
+ZGAMR(4) = MOMG(XALPHAR,XNUR,6.)
+ZGAMR(5) = MOMG(XALPHAR,XNUR,9.)
+ZGAMR(6) = MOMG(XALPHAR,XNUR,3.)**(2./3.)/MOMG(XALPHAR,XNUR,2.)
+!
+!* 2.4 Csts for the shape parameter
+!
+XLBC = XAR*ZGAMC(2)
+XLBEXC = 1.0/XBC
+XLBR = XAR*ZGAMR(2)
+XLBEXR = 1.0/XBR
+!
+!
+!------------------------------------------------------------------------------
+!
+!
+!* 3. CONSTANTS FOR THE SEDIMENTATION
+! -------------------------------
+!
+!
+!* 4.1 Exponent of the fall-speed air density correction
+!
+IKB = 1 + JPVEXT
+! Correction
+!ZRHO00 = XP00/(XRD*XTHVREFZ(IKB))
+ZRHO00 = 1.2041 ! at P=1013.25hPa and T=20°C
+!
+!* 4.2 Constants for sedimentation
+!
+XFSEDRR = XCR*GAMMA_X0D(XNUR+(XDR+3.)/XALPHAR)/GAMMA_X0D(XNUR+3./XALPHAR)* &
+ (ZRHO00)**XCEXVT
+XFSEDCR = XCR*GAMMA_X0D(XNUR+XDR/XALPHAR)/GAMMA_X0D(XNUR)* &
+ (ZRHO00)**XCEXVT
+XFSEDRC = XCC*GAMMA_X0D(XNUC+(XDC+3.)/XALPHAC)/GAMMA_X0D(XNUC+3./XALPHAC)* &
+ (ZRHO00)**XCEXVT
+XFSEDCC = XCC*GAMMA_X0D(XNUC+XDC/XALPHAC)/GAMMA_X0D(XNUC)* &
+ (ZRHO00)**XCEXVT
+
+!
+XLB(2) = XLBC
+XLBEX(2) = XLBEXC
+XD(2) = XDC
+XFSEDR(2) = XFSEDRC
+XFSEDC(2) = XFSEDCC
+!
+XLB(3) = XLBR
+XLBEX(3) = XLBEXR
+XD(3) = XDR
+XFSEDR(3) = XFSEDRR
+XFSEDC(3) = XFSEDCR
+!
+!------------------------------------------------------------------------------
+!
+!
+!* 4. CONSTANTS FOR THE NUCLEATION PROCESS
+! ------------------------------------
+!
+!
+XWMIN = 0.01 ! Minimal positive vertical velocity required
+ ! for the activation process in Twomey and CPB scheme
+XTMIN = -0.000278 ! Minimal cooling required 1K/h
+!
+XDIVA = 226.E-7 ! Diffusivity of water vapor in the air
+XTHCO = 24.3E-3 ! Air thermal conductivity
+!
+! ( 8 Mw (Sigma)sw )3 Pi*Rho_l
+! XCSTDCRIT = ( -------------- ) * --------
+! ( 3 Ra Rhow ) 6
+!
+ZSURF_TEN = 76.1E-3 ! Surface tension of a water drop at T=0 C
+XCSTDCRIT = (XPI/6.)*XRHOLW*( (8.0*ZSURF_TEN )/( 3.0*XRV*XRHOLW ) )**3
+!
+!
+!
+! 4.1 Tabulation of the hypergeometric functions in 'no units'
+! --------------------------------------------------------
+!
+! In LIMA's nucleation parameterization,
+! supersaturation is not in % : Smax=0.01 for a 1% supersaturation.
+! This is accounted for in the modified Beta and C values.
+!
+! Here, we tabulate the
+! F(mu,k/2, k/2+1 ,-Beta S**2) -> XHYPF12
+! F(mu,k/2,(k+3)/2,-Beta S**2) -> XHYPF32 functions
+! using a logarithmic scale for S
+!
+NHYP = 500 ! Number of points for the tabulation
+ALLOCATE (XHYPF12( NHYP, NMOD_CCN ))
+ALLOCATE (XHYPF32( NHYP, NMOD_CCN ))
+!
+ZSMIN = 1.0E-5 ! Minimum supersaturation set at 0.001 %
+ZSMAX = 5.0E-2 ! Maximum supersaturation set at 5 %
+XHYPINTP1 = REAL(NHYP-1)/LOG(ZSMAX/ZSMIN)
+XHYPINTP2 = REAL(NHYP)-XHYPINTP1*LOG(ZSMAX)
+!
+DO JMOD = 1,NMOD_CCN
+ DO J1 = 1,NHYP
+ ZSS =ZSMAX*(ZSMIN/ZSMAX)**(REAL(NHYP-J1)/REAL(NHYP-1))
+ XHYPF12(J1,JMOD) = HYPGEO(XMUHEN_MULTI(JMOD),0.5*XKHEN_MULTI(JMOD),&
+ 0.5*XKHEN_MULTI(JMOD)+1.0,XBETAHEN_MULTI(JMOD),ZSS)
+ XHYPF32(J1,JMOD) = HYPGEO(XMUHEN_MULTI(JMOD),0.5*XKHEN_MULTI(JMOD),&
+ 0.5*XKHEN_MULTI(JMOD)+1.5,XBETAHEN_MULTI(JMOD),ZSS)
+ END DO
+ENDDO
+!
+NAHEN = 81 ! Tabulation for each Kelvin degree in the range XTT-40 to XTT+40
+XAHENINTP1 = 1.0
+XAHENINTP2 = 0.5*REAL(NAHEN-1) - XTT
+!
+! Compute the tabulation of function of T :
+!
+! 1
+! XAHENG = -----------------------
+! XCSTHEN * G**(3/2)
+!
+! Compute constants for the calculation of Smax.
+! XCSTHEN = 1/(rho_l 2 pi)
+! PSI1
+! PSI3
+! T
+! Lv
+! G
+!
+ALLOCATE (XAHENG(NAHEN))
+ALLOCATE (XAHENG2(NAHEN))
+ALLOCATE (XAHENG3(NAHEN))
+ALLOCATE (XPSI1(NAHEN))
+ALLOCATE (XPSI3(NAHEN))
+XCSTHEN = 1.0 / ( XRHOLW*2.0*XPI )
+DO J1 = 1,NAHEN
+ ZTT = XTT + REAL(J1-(NAHEN-1)/2) ! T
+ ZLV = XLVTT+(XCPV-XCL)*(ZTT-XTT) ! Lv
+ XPSI1(J1) = (XG/(XRD*ZTT))*(XMV*ZLV/(XMD*XCPD*ZTT)-1.) ! Psi1
+ XPSI3(J1) = -1*XMV*ZLV/(XMD*XRD*(ZTT**2)) ! Psi3
+ ZG = 1./( XRHOLW*( (XRV*ZTT)/ & ! G
+ (XDIVA*EXP(XALPW-(XBETAW/ZTT)-(XGAMW*ALOG(ZTT)))) &
+ + (ZLV/ZTT)**2/(XTHCO*XRV) ) )
+ XAHENG(J1) = XCSTHEN/(ZG)**(3./2.)
+ XAHENG2(J1) = 1/(ZG)**(1./2.) * GAMMA_X0D(XNUC+1./XALPHAC)/GAMMA_X0D(XNUC)
+ XAHENG3(J1) = (ZG) * GAMMA_X0D(XNUC+1./XALPHAC)/GAMMA_X0D(XNUC)
+END DO
+!-------------------------------------------------------------------------------
+!
+! Parameters used to initialise the droplet and drop concentration
+! from the respective mixing ratios (used in RESTART_RAIN_C2R2)
+!
+! Droplet case
+!
+!!ALLOCATE(XCONCC_INI(SIZE(PNFS,1),SIZE(PNFS,2),SIZE(PNFS,3),SIZE(PNFS,4))) !NMOD_CCN))
+!! XCONCC_INI(:,:,:,:) = 0.8 * PNFS(:,:,:,:) ! 80% of the maximum CCN conc. is assumed
+!
+! Raindrop case
+!
+XCONCR_PARAM_INI = (1.E7)**3/(XPI*XRHOLW) ! MP law with N_O=1.E7 m-1 is assumed
+!
+!
+!------------------------------------------------------------------------------
+!
+!
+!* 5. CONSTANTS FOR THE COALESCENCE PROCESSES
+! ---------------------------------------
+!
+!
+!* 6.1 Csts for the coalescence processes
+!
+XKERA1 = 2.59E15 ! From Long a1=9.44E9 cm-3 so XKERA1= 9.44E9*1E6*(PI/6)**2
+XKERA2 = 3.03E3 ! From Long a2=5.78E3 so XKERA2= 5.78E3* (PI/6)
+!
+! Cst for the cloud droplet selfcollection process
+!
+XSELFC = XKERA1*ZGAMC(3)
+!
+! Cst for the autoconversion process
+!
+XAUTO1 = 6.25E18*(ZGAMC(2))**(1./3.)*SQRT(ZGAMC(4))
+XAUTO2 = 0.5E6*(ZGAMC(4))**(1./6.)
+XLAUTR = 2.7E-2
+XLAUTR_THRESHOLD = 0.4
+XITAUTR= 0.27 ! (Notice that T2 of BR74 is uncorrect and that 0.27=1./3.7
+XITAUTR_THRESHOLD = 7.5
+XCAUTR = 3.5E9
+!
+! Cst for the accretion process
+!
+XACCR1 = ZGAMR(2)**(1./3.)
+XACCR2 = 5.0E-6
+XACCR3 = 12.6E-4
+XACCR4 = XAUTO2
+XACCR5 = 3.5
+XACCR6 = 1.2*XCAUTR
+XACCR_CLARGE1 = XKERA2*ZGAMC(2)
+XACCR_CLARGE2 = XKERA2*ZGAMR(2)
+XACCR_RLARGE1 = XKERA2*ZGAMC(3)*XRHOLW*(XPI/6.0)
+XACCR_RLARGE2 = XKERA2*ZGAMC(2)*ZGAMR(2)*XRHOLW*(XPI/6.0)
+XACCR_CSMALL1 = XKERA1*ZGAMC(3)
+XACCR_CSMALL2 = XKERA1*ZGAMR(3)
+XACCR_RSMALL1 = XKERA1*ZGAMC(5)*XRHOLW*(XPI/6.0)
+XACCR_RSMALL2 = XKERA1*ZGAMC(2)*ZGAMR(3)*XRHOLW*(XPI/6.0)
+!
+! Cst for the raindrop self-collection/breakup process
+!
+XSCBU2 = XKERA2*ZGAMR(2)
+XSCBU3 = XKERA1*ZGAMR(3)
+XSCBU_EFF1 = 0.6E-3
+XSCBU_EFF2 = 2.0E-3
+XSCBUEXP1 = -2500.0
+!
+!
+!------------------------------------------------------------------------------
+!
+!
+!* 6. CONSTANTS FOR THE "SONTANEOUS" BREAK-UP
+! ---------------------------------------
+!
+!
+XSPONBUD1 = 3.0E-3
+XSPONBUD2 = 4.0E-3
+XSPONBUD3 = 5.0E-3
+XSPONCOEF2 = ((XSPONBUD3/XSPONBUD2)**3 - 1.0)/(XSPONBUD3-XSPONBUD1)**2
+!
+!
+!------------------------------------------------------------------------------
+!
+!
+!* 7. CONSTANTS FOR EVAPORATION PROCESS
+! ---------------------------------------
+!
+!
+X0CNDC = (4.0*XPI)*XC1C*XF0C*MOMG(XALPHAC,XNUC,1.)
+X2CNDC = (4.0*XPI)*XC1C*XF2C*XCC*MOMG(XALPHAC,XNUC,XDC+2.0)
+!
+! Valeurs utiles pour le calcul de l'évaporation en fonction de N_r
+!
+!XEX0EVAR = -1.0
+!XEX1EVAR = -1.0 - (XDR+1.0)*0.5
+!XEX2EVAR = -0.5*XCEXVT
+!
+!X0EVAR = (2.0*XPI)*XF0R*GAMMA_X0D(XNUR+1./XALPHAR)/GAMMA_X0D(XNUR)
+!X1EVAR = (2.0*XPI)*XF1R*((ZRHO00)**(XCEXVT)*(XCR/0.15E-4))**0.5* &
+! GAMMA_X0D(XNUR+(XDR+3.0)/(2.0*XALPHAR))/GAMMA_X0D(XNUR)
+!
+!
+! Valeurs utiles pour le calcul de l'évaporation en fonction de r_r
+!
+XEX0EVAR = 2.0
+XEX1EVAR = 2.0 - (XDR+1.0)*0.5
+XEX2EVAR = -0.5*XCEXVT
+!
+X0EVAR = (12.0)*XF0R*GAMMA_X0D(XNUR+1./XALPHAR)/GAMMA_X0D(XNUR+3./XALPHAR)
+X1EVAR = (12.0)*XF1R*((ZRHO00)**(XCEXVT)*(XCR/0.15E-4))**0.5* &
+ GAMMA_X0D(XNUR+(XDR+3.0)/(2.0*XALPHAR))/GAMMA_X0D(XNUR+3./XALPHAR)
+!
+!
+!------------------------------------------------------------------------------
+!
+!
+!* 8. SET-UP RADIATIVE PARAMETERS
+! ---------------------------
+!
+!
+! R_eff_c = XFREFFC * (rho*r_c/N_c)**(1/3)
+!
+!
+XFREFFC = 0.5 * ZGAMC(6) * (1.0/XAC)**(1.0/3.0)
+XFREFFR = 0.5 * ZGAMR(6) * (1.0/XAR)**(1.0/3.0)
+!
+! Coefficients used to compute reff when both cloud and rain are present
+!
+XCREC = 1.0/ (ZGAMC(6) * XAC**(2.0/3.0))
+XCRER = 1.0/ (ZGAMR(6) * XAR**(2.0/3.0))
+!
+!
+!------------------------------------------------------------------------------
+!
+!
+!* 9. SOME PRINTS FOR CONTROL
+! -----------------------
+!
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ ILUOUT0 = TLUOUT0%NLU
+ WRITE(UNIT=ILUOUT0,FMT='(" Summary of the cloud particule characteristics")')
+ WRITE(UNIT=ILUOUT0,FMT='(" CLOUD")')
+ WRITE(UNIT=ILUOUT0,FMT='(" masse: A=",E13.6," B=",E13.6)') &
+ XAR,XBR
+ WRITE(UNIT=ILUOUT0,FMT='(" vitesse: C=",E13.6," D=",E13.6)') &
+ XCC,XDC
+ WRITE(UNIT=ILUOUT0,FMT='(" distribution:AL=",E13.6,"NU=",E13.6)') &
+ XALPHAC,XNUC
+ WRITE(UNIT=ILUOUT0,FMT='(" RAIN")')
+ WRITE(UNIT=ILUOUT0,FMT='(" masse: A=",E13.6," B=",E13.6)') &
+ XAR,XBR
+ WRITE(UNIT=ILUOUT0,FMT='(" vitesse: C=",E13.6," D=",E13.6)') &
+ XCR,XDR
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" distribution:AL=",E13.6,"NU=",E13.6)') &
+!!$ XALPHAR,XNUR
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" Description of the nucleation spectrum")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" C=",E13.6," k=",E13.6)') XCHEN, XKHEN
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" Beta=",E13.6," MU=",E13.6)') XBETAHEN, XMUHEN
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" CCN max=",E13.6)') XCONC_CCN
+END IF
+!
+!------------------------------------------------------------------------------
+!
+END SUBROUTINE INI_LIMA_WARM
diff --git a/src/mesonh/micro/ini_neb.f90 b/src/mesonh/micro/ini_neb.f90
new file mode 100644
index 000000000..6cb0efab6
--- /dev/null
+++ b/src/mesonh/micro/ini_neb.f90
@@ -0,0 +1,72 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+! ######spl
+ MODULE MODI_INI_NEB
+! #####################
+!
+INTERFACE
+!
+SUBROUTINE INI_NEB
+END SUBROUTINE INI_NEB
+!
+END INTERFACE
+!
+END MODULE MODI_INI_NEB
+! ######spl
+ SUBROUTINE INI_NEB
+! #######################
+!
+!!**** *INI_NEB* - routine to initialize the nebulosity computation
+!! constants.
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to initialize
+! constants used for nebulosity computation
+!
+!! METHOD
+!! ------
+!! The constants are set to their numerical values
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_NEB
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! S. Riette (Meteo France)
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 24 Aug 2011
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_NEB
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+!
+IMPLICIT NONE
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+! ---------------------------------------------------------------------------
+!
+! 1. SETTING THE NUMERICAL VALUES
+!
+IF (LHOOK) CALL DR_HOOK('INI_NEB',0,ZHOOK_HANDLE)
+!Freezing between 0 and -20. Other possibilities are 0/-40 or -5/-25
+XTMAXMIX = 273.16
+XTMINMIX = 253.16
+IF (LHOOK) CALL DR_HOOK('INI_NEB',1,ZHOOK_HANDLE)
+END SUBROUTINE INI_NEB
diff --git a/src/mesonh/micro/ini_rain_c2r2.f90 b/src/mesonh/micro/ini_rain_c2r2.f90
new file mode 100644
index 000000000..b436b832d
--- /dev/null
+++ b/src/mesonh/micro/ini_rain_c2r2.f90
@@ -0,0 +1,637 @@
+!MNH_LIC Copyright 1996-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! #########################
+ MODULE MODI_INI_RAIN_C2R2
+! #########################
+!
+INTERFACE
+ SUBROUTINE INI_RAIN_C2R2 ( PTSTEP, PDZMIN, KSPLITR, HCLOUD )
+!
+INTEGER, INTENT(OUT):: KSPLITR ! Number of small time step
+ ! integration for rain
+ ! sedimendation
+!
+REAL, INTENT(IN) :: PTSTEP ! Effective Time step
+!
+REAL, INTENT(IN) :: PDZMIN ! minimun vertical mesh size
+!
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Indicator of the cloud scheme
+!
+!
+END SUBROUTINE INI_RAIN_C2R2
+!
+END INTERFACE
+!
+END MODULE MODI_INI_RAIN_C2R2
+! ####################################################
+ SUBROUTINE INI_RAIN_C2R2 ( PTSTEP, PDZMIN, KSPLITR, HCLOUD )
+! ####################################################
+!
+!!**** *INI_RAIN_C2R2 * - initialize the constants for the two-moment scheme
+!!
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to initialize the constants used in the
+!! warm microphysical scheme C2R2. The routine allows for the choice of
+!! several activation schemes CPB, TFH and TWO. The CPB scheme can be
+!! initialized either with a CCN shape function or directly from the
+!! specification of aerosol properties.
+!! The cloud droplets and rain drops are assumed to follow a generalized
+!! gamma law.
+!!
+!!** METHOD
+!! ------
+!! The constants are initialized to their numerical values and the number
+!! of small time step in the sedimentation scheme is computed by dividing
+!! the 2* Deltat time interval of the leap-frog scheme so that the stability
+!! criterion for the rain sedimentation is fulfilled for a raindrop maximal
+!! fall velocity equal VTRMAX.
+!!
+!! EXTERNAL
+!! --------
+!! GAMMA : gamma function
+!! HYPGEO : hypergeometric function
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST
+!! XPI !
+!! XP00 ! Reference pressure
+!! XRD ! Gaz constant for dry air
+!! XRHOLW ! Liquid water density
+!! Module MODD_REF
+!! XTHVREFZ ! Reference virtual pot.temp. without orography
+!! Module MODD_PARAMETERS
+!! JPVEXT !
+!! Module MODD_RAIN_C2R2_DESCR
+!! Module MODD_RAIN_C2R2_KHKO_PARAM
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation ( routine INI_RAIN_C2R2 )
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 31/12/96
+!! J.-P. Pinty 07/07/00 In revised form
+!! J.-P. Pinty 05/04/02 Add computation of the effective radius
+!! J.-P. Pinty 29/11/02 Add cloud doplet fall speed parameters
+!! O.Geoffroy 03/2006 Add KHKO scheme
+!! G.Delautier 09/2014 fusion MODD_RAIN_C2R2_PARAM et MODD_RAIN_KHKO_PARAM
+!! M.Mazoyer 10/2016 Constants for Droplet sedimentation adapted to fog for KHKO
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_LUNIT, ONLY: TLUOUT0
+USE MODD_PARAM_C2R2
+USE MODD_PARAMETERS
+USE MODD_RAIN_C2R2_DESCR
+USE MODD_RAIN_C2R2_KHKO_PARAM
+USE MODD_REF
+!
+USE MODI_GAMMA
+USE MODI_HYPGEO
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+!
+INTEGER, INTENT(OUT):: KSPLITR ! Number of small time step
+ ! integration for rain
+ ! sedimendation
+!
+REAL, INTENT(IN) :: PTSTEP ! Effective Time step
+!
+REAL, INTENT(IN) :: PDZMIN ! minimun vertical mesh size
+!
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Indicator of the cloud scheme
+!
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IKB ! Coordinates of the first and last physical
+ ! points along z
+INTEGER :: J1 ! Internal loop indexes
+!
+REAL, DIMENSION(6) :: ZGAMC, ZGAMR ! parameters involving various moments of
+ ! the generalized gamma law
+!
+REAL :: ZT ! Work variable
+REAL :: ZTT ! Temperature in Celsius
+REAL :: ZLV ! Latent heat of vaporization
+REAL :: ZSS ! Supersaturation
+REAL :: ZPSI1, ZG ! Psi1 and G functions
+REAL :: ZAHENR ! r_star (FH92)
+REAL :: ZVTRMAX ! Raindrop maximal fall velocity
+REAL :: ZRHO00 ! Surface reference air density
+REAL :: ZSURF_TEN ! Water drop surface tension
+REAL :: ZSMIN, ZSMAX ! Minimal and maximal supersaturation used to
+ ! discretize the HYP functions
+!
+!
+INTEGER :: ILUOUT0 ! Logical unit number for output-listing
+LOGICAL :: GFLAG ! Logical flag for printing the constatnts on the output
+ ! listing
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 0. FUNCTION STATEMENTS
+! -------------------
+!
+!
+!* 0.1 G(p) for p_moment of the Generalized GAMMA function
+!
+!
+! recall that MOMG(ZALPHA,ZNU,ZP)=GAMMA(ZNU+ZP/ZALPHA)/GAMMA(ZNU)
+!
+!
+! 1. INTIALIZE OUTPUT LISTING AND COMPUTE KSPLITR FOR EACH MODEL
+! -----------------------------------------------------------
+!
+ILUOUT0 = TLUOUT0%NLU
+!
+!* 1.1 Set the raindrop maximum fall velocity
+!
+ZVTRMAX = 30.
+!
+!* 1.2 Compute the number of small time step integration
+!
+KSPLITR = 1
+SPLIT : DO
+ ZT = PTSTEP / REAL(KSPLITR)
+ IF ( ZT * ZVTRMAX / PDZMIN < 1.0) EXIT SPLIT
+ KSPLITR = KSPLITR + 1
+END DO SPLIT
+!
+IF (ALLOCATED(XRTMIN)) RETURN ! In case of nesting microphysics constants of
+! ! MODD_RAIN_C2R2_KHKO_PARAM are computed only once.
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. CHARACTERISTICS OF THE SPECIES
+! ------------------------------
+!
+!
+!* 2.1 Cloud droplet characteristics
+!
+XAC = (XPI/6.0)*XRHOLW
+XBC = 3.0
+IF (HCLOUD=='KHKO') THEN
+ XCC = XRHOLW*XG/(18.0*1.816E-5) ! Stokes flow (Pruppacher p 322 for T=293K)
+ELSE
+ XCC = XRHOLW*XG/(18.0*1.7E-5) ! Stokes flow (Pruppacher p 322 for T=273K)
+ENDIF
+XDC = 2.0
+!
+XF0C = 1.00
+XF2C = 0.08
+!
+XC1C = 1./2.
+!
+!* 2.2 Raindrops characteristics
+!
+XAR = (XPI/6.0)*XRHOLW
+XBR = 3.0
+XCR = 842.
+XDR = 0.8
+!
+XF0R = 0.780
+XF1R = 0.265
+!
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. DIMENSIONAL DISTRIBUTIONS OF THE SPECIES
+! ----------------------------------------
+!
+!* 3.1 Cloud droplet distribution
+!
+!XALPHAC = 3.0 ! Gamma law of the Cloud droplet (here volume-like distribution)
+!XNUC = 3.0 ! Gamma law with little dispersion
+!
+!* 3.2 Raindrop distribution
+!
+!XALPHAR = 3.0 ! Gamma law of the raindrops (here volume-like distribution)
+!XNUR = 3.0 ! Gamma law for the raindrops
+!XNUR = 0.1
+!
+!* 3.3 Precalculation of the gamma function momentum
+!
+!
+ ZGAMC(1) = GAMMA(XNUC)
+ ZGAMC(2) = MOMG(XALPHAC,XNUC,3.)
+ ZGAMC(3) = MOMG(XALPHAC,XNUC,6.)
+ ZGAMC(4) = ZGAMC(3)-ZGAMC(2)**2 ! useful for Sig_c
+ ZGAMC(5) = MOMG(XALPHAC,XNUC,9.)
+ ZGAMC(6) = MOMG(XALPHAC,XNUC,3.)**(2./3.)/MOMG(XALPHAC,XNUC,2.)
+!
+ ZGAMR(1) = GAMMA(XNUR)
+ ZGAMR(2) = MOMG(XALPHAR,XNUR,3.)
+ ZGAMR(3) = MOMG(XALPHAR,XNUR,6.)
+ ZGAMR(4) = MOMG(XALPHAR,XNUR,6.)
+ ZGAMR(5) = MOMG(XALPHAR,XNUR,9.)
+ ZGAMR(6) = MOMG(XALPHAR,XNUR,3.)**(2./3.)/MOMG(XALPHAR,XNUR,2.)
+!
+!
+!* 3.4 Set bounds
+!
+ALLOCATE( XRTMIN(3) )
+ALLOCATE( XCTMIN(3) )
+IF (HCLOUD == 'C2R2') THEN
+XRTMIN(1) = 1.0E-20
+XRTMIN(2) = 1.0E-20
+XRTMIN(3) = 1.0E-17
+ELSE
+XRTMIN(1) = 1.0E-20
+XRTMIN(2) = 1.E-7
+XRTMIN(3) = 1.E-8
+ENDIF
+!
+XCTMIN(1) = 1.0
+XCTMIN(2) = 1.0
+XCTMIN(3) = 1.0E-3
+!
+!* 3.4 Csts for the shape parameter
+!
+XLBC = XAR*ZGAMC(2)
+XLBEXC = 1.0/XBC
+XLBR = XAR*ZGAMR(2)
+XLBEXR = 1.0/XBR
+!
+!-------------------------------------------------------------------------------
+!
+!* 4. CONSTANTS FOR THE SEDIMENTATION
+! -------------------------------
+!
+!* 4.1 Exponent of the fall-speed air density correction
+!
+XCEXVT = 0.4
+!
+IKB = 1 + JPVEXT
+ZRHO00 = XP00/(XRD*XTHVREFZ(IKB))
+!
+!* 4.2 Constants for sedimentation
+!
+XFSEDRR = XCR*GAMMA(XNUR+(XDR+3.)/XALPHAR)/GAMMA(XNUR+3./XALPHAR)* &
+ (ZRHO00)**XCEXVT
+XFSEDCR = XCR*GAMMA(XNUR+XDR/XALPHAR)/GAMMA(XNUR)* &
+ (ZRHO00)**XCEXVT
+XFSEDRC = XCC*GAMMA(XNUC+(XDC+3.)/XALPHAC)/GAMMA(XNUC+3./XALPHAC)* &
+ (ZRHO00)**XCEXVT
+XFSEDCC = XCC*GAMMA(XNUC+XDC/XALPHAC)/GAMMA(XNUC)* &
+ (ZRHO00)**XCEXVT
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 5. CONSTANTS FOR THE NUCLEATION PROCESS
+! -------------------------------------
+!
+!
+! Compute CCN spectra parameters from CCN characteristics
+!
+IF (HPARAM_CCN == 'CPB' .AND. HINI_CCN == 'AER') THEN
+ SELECT CASE (HTYPE_CCN)
+ CASE('M') ! NaCl maritime case
+ XKHEN = 3.251*(XLOGSIG_CCN/0.4835)**(-1.297)
+ XMUHEN = 2.589*(XLOGSIG_CCN/0.4835)**(-1.511)
+ XBETAHEN = 621.689*(XR_MEAN_CCN/0.133E-6)**(3.002) &
+ *EXP(1.081*((XLOGSIG_CCN/0.4835)-1.)) &
+ *XFSOLUB_CCN &
+ *(XACTEMP_CCN/290.16)**(2.995)
+ CASE('C') ! (NH4)2SO4 continental case
+ XKHEN = 1.403*(XLOGSIG_CCN/1.16)**(-1.172)
+ XMUHEN = 0.834*(XLOGSIG_CCN/1.16)**(-1.350)
+ XBETAHEN = 25.499*(XR_MEAN_CCN/0.0218E-6)**(3.057) &
+ *EXP(4.092*((XLOGSIG_CCN/1.16)-1.)) &
+ *XFSOLUB_CCN**(1.011) &
+ *(XACTEMP_CCN/290.16)**(3.076)
+ END SELECT
+ XCHEN = XCONC_CCN*(XBETAHEN**(0.5*XKHEN)*GAMMA(XMUHEN)) &
+ /(GAMMA(0.5*XKHEN+1.)*GAMMA(XMUHEN-0.5*XKHEN))
+END IF
+!
+XWMIN = 0.01 ! Minimal positive vertical velocity required
+ ! for the activation process in Twomey and CPB scheme
+XTMIN = -0.000278 ! Minimal cooling required 1K/h
+
+!
+XDIVA = 226.E-7 ! Diffusivity of water vapor in the air
+XTHCO = 24.3E-3 ! Air thermal conductivity
+!
+! ( 8 Mw (Sigma)sw )3 Pi*Rho_l
+! XCSTDCRIT = ( -------------- ) * --------
+! ( 3 Ra Rhow ) 6
+!
+ZSURF_TEN = 76.1E-3 ! Surface tension of a water drop at T=0 C
+XCSTDCRIT = (XPI/6.)*XRHOLW*( (8.0*ZSURF_TEN )/( 3.0*XRV*XRHOLW ) )**3
+!
+! Tabulation of the hypergeometric functions
+!
+! F(mu,k/2, k/2+1 ,-Beta s**2) and
+! F(mu,k/2,(k+3)/2,-Beta s**2) as a function of s
+!
+NHYP = 200
+ALLOCATE (XHYPF12(NHYP))
+ALLOCATE (XHYPF32(NHYP))
+!
+ZSMIN = 1.0E-5 ! soit Smin=0.001 %
+ZSMAX = 1.0E-1 ! soit Smax= 10 %
+XHYPINTP1 = REAL(NHYP-1)/LOG(ZSMAX/ZSMIN)
+XHYPINTP2 = REAL(NHYP)-XHYPINTP1*LOG(ZSMAX)
+IF (HPARAM_CCN == 'CPB') THEN ! CPB98's case
+ TAB_HYP : DO J1 = 1,NHYP ! tabulation using a logarithmic scale for the
+ ! supersaturations (0.00001<S<0.1 in "no unit")
+ ZSS =ZSMAX*(ZSMIN/ZSMAX)**(REAL(NHYP-J1)/REAL(NHYP-1))
+ XHYPF12(J1) = HYPGEO(XMUHEN,XKHEN/2.0,(XKHEN+2.0)/2.0,XBETAHEN, &
+ 100.*ZSS)
+ XHYPF32(J1) = HYPGEO(XMUHEN,XKHEN/2.0,(XKHEN+3.0)/2.0,XBETAHEN*100**2, &
+ ZSS)
+ END DO TAB_HYP
+ IF (HINI_CCN == 'CCN') THEN
+ XCONC_CCN = XCHEN*(GAMMA(0.5*XKHEN+1.)*GAMMA(XMUHEN-0.5*XKHEN)) &
+ /(XBETAHEN**(0.5*XKHEN)*GAMMA(XMUHEN))
+ END IF
+ELSE ! other cases (but not used)
+ XHYPF12(:) = 1.0
+ XHYPF32(:) = 1.0
+! XCONC_CCN = -1.0 ! Negative value to recall that CCN spectra, other than those
+ ! defined by CPB98, are unbounded
+END IF
+!
+! Compute the tabulation of function of T :
+!
+! (Psi1)**(3/2)
+! XAHENG = -----------------------
+! G**(3/2)
+!
+! XAHENY = a2 C**p k**q as given by Feingold
+!
+NAHEN = 81 ! Tabulation for each Kelvin degree in the range XTT-40 to XTT+40
+XAHENINTP1 = 1.0
+XAHENINTP2 = 0.5*REAL(NAHEN-1) - XTT
+IF (HPARAM_CCN == 'TFH') THEN
+ ALLOCATE (XAHENY(NAHEN))
+ ALLOCATE (XAHENF(NAHEN))
+!
+! Compute constants for the calculation of Smax.
+! XCSTHEN = 1/(rho_l 4 pi C (100)^k
+!
+ XCSTHEN = 1.0 / ( XRHOLW*4.0*XPI*XCHEN*(100.0)**XKHEN )
+ DO J1 = 1,NAHEN
+ ZTT = XTT + REAL(J1-(NAHEN-1)/2) ! T
+ ZLV = XLVTT+(XCPV-XCL)*(ZTT-XTT) ! Lv
+ ZPSI1 = (XG/(XRD*ZTT))*(XMV*ZLV/(XMD*XCPD*ZTT)-1.) ! Psi1
+ ZG = 1.E-4*(6.224E-7 + 0.281E-7 * ZTT + 2.320E-10 * ZTT**2) * & ! G
+ XCHEN**(-0.127 + 2.668E-3 * ZTT + 7.583E-7 * ZTT**2) * &
+ XKHEN**(-0.214 + 9.416E-3 * ZTT - 1.173E-4 * ZTT**2)
+ ZAHENR = 1.E-2*(2.124E-3 + 3.373E-5 * ZTT + 9.632E-8 * ZTT**2) * & ! r_star
+ XCHEN**(-0.321 - 3.333E-4 * ZTT - 9.972E-6 * ZTT**2) * &
+ XKHEN**(-0.464 + 9.253E-3 * ZTT - 2.066E-5 * ZTT**2)
+ XAHENF(J1) = XCSTHEN*(ZPSI1/(ZG*ZAHENR))
+!
+ XAHENY(J1) = (7.128E-5 + 1.094E-6 * ZTT + 4.314E-9 * ZTT**2) * & ! y_bar
+ XCHEN**( 0.230 - 1.200E-4 * ZTT + 1.607E-5 * ZTT**2) * &
+ XKHEN**( 1.132 - 9.083E-3 * ZTT - 1.482E-5 * ZTT**2)
+ END DO
+!
+! Additional coefficients for the dependence on W
+!
+ XWCOEF_F1 =-0.149
+ XWCOEF_F2 = 1.514E-3
+ XWCOEF_F3 = 4.375E-6
+ XWCOEF_Y1 = 0.132
+ XWCOEF_Y2 =-2.191E-3
+ XWCOEF_Y3 = 3.934E-5
+ELSE
+ ALLOCATE (XAHENG(NAHEN))
+ ALLOCATE (XPSI1(NAHEN))
+ ALLOCATE (XPSI3(NAHEN))
+!
+! Compute constants for the calculation of Smax.
+! XCSTHEN = 1/(rho_l 2 pi k C B(k/2,3/2))
+!
+ XCSTHEN = 1.0 / ( XRHOLW*2.0*XPI*XKHEN*XCHEN*(100.0)**XKHEN * &
+ GAMMA(XKHEN/2.0)*GAMMA(3.0/2.0)/GAMMA((XKHEN+3.0)/2.0) )
+ DO J1 = 1,NAHEN
+ ZTT = XTT + REAL(J1-(NAHEN-1)/2) ! T
+ ZLV = XLVTT+(XCPV-XCL)*(ZTT-XTT) ! Lv
+ XPSI1(J1) = (XG/(XRD*ZTT))*(XMV*ZLV/(XMD*XCPD*ZTT)-1.) ! Psi1
+ XPSI3(J1) = -1*XMV*ZLV/(XMD*XRD*(ZTT**2)) ! Psi3
+ ZG = 1./( XRHOLW*( (XRV*ZTT)/ & !G
+ (XDIVA*EXP(XALPW-(XBETAW/ZTT)-(XGAMW*ALOG(ZTT)))) &
+ + (ZLV/ZTT)**2/(XTHCO*XRV) ) )
+ XAHENG(J1) = XCSTHEN/(ZG)**(3./2.)
+ END DO
+END IF
+!
+!
+!-------------------------------------------------------------------------------
+!
+! Parameters used to initialise the droplet and drop concentration
+! from the respective mixing ratios (used in RESTART_RAIN_C2R2)
+!
+! Droplet case
+!
+IF( HPARAM_CCN=='CPB' ) THEN
+ XCONCC_INI = 0.8 * XCONC_CCN ! 80% of the maximum CCN conc. is assumed
+ELSE
+ XCONCC_INI = XCHEN * (0.1)**XKHEN ! 0.1% supersaturation is assumed
+END IF
+!
+! Raindrop case
+!
+XCONCR_PARAM_INI = (1.E7)**3/(XPI*XRHOLW) ! MP law with N_O=1.E7 m-1 is assumed
+!
+!-------------------------------------------------------------------------------
+!
+!* 6. CONSTANTS FOR THE COALESCENCE PROCESSES
+! --------------------------------------
+!
+!
+!* 6.1 Csts for the coalescence processes
+!
+XKERA1 = 2.59E15 ! From Long a1=9.44E9 cm-3 so XKERA1= 9.44E9*1E6*(PI/6)**2
+XKERA2 = 3.03E3 ! From Long a2=5.78E3 so XKERA2= 5.78E3* (PI/6)
+!
+! Cst for the cloud droplet selfcollection process
+!
+XSELFC = XKERA1*ZGAMC(3)
+!
+! Cst for the autoconversion process
+!
+XAUTO1 = 6.25E18*(ZGAMC(2))**(1./3.)*SQRT(ZGAMC(4))
+XAUTO2 = 0.5E6*(ZGAMC(4))**(1./6.)
+XLAUTR = 2.7E-2
+XLAUTR_THRESHOLD = 0.4
+XITAUTR= 0.27 ! (Notice that T2 of BR74 is uncorrect and that 0.27=1./3.7
+XITAUTR_THRESHOLD = 7.5
+XCAUTR = 3.5E9
+!
+! Cst for the accretion process
+!
+XACCR1 = ZGAMR(2)**(1./3.)
+XACCR2 = 5.0E-6
+XACCR3 = 12.6E-4
+XACCR4 = XAUTO2
+XACCR5 = 3.5
+XACCR6 = 1.2*XCAUTR
+XACCR_CLARGE1 = XKERA2*ZGAMC(2)
+XACCR_CLARGE2 = XKERA2*ZGAMR(2)
+XACCR_RLARGE1 = XKERA2*ZGAMC(3)*XRHOLW*(XPI/6.0)
+XACCR_RLARGE2 = XKERA2*ZGAMC(2)*ZGAMR(2)*XRHOLW*(XPI/6.0)
+XACCR_CSMALL1 = XKERA1*ZGAMC(3)
+XACCR_CSMALL2 = XKERA1*ZGAMR(3)
+XACCR_RSMALL1 = XKERA1*ZGAMC(5)*XRHOLW*(XPI/6.0)
+XACCR_RSMALL2 = XKERA1*ZGAMC(2)*ZGAMR(3)*XRHOLW*(XPI/6.0)
+!
+! Cst for the raindrop self-collection/breakup process
+!
+XSCBU2 = XKERA2*ZGAMR(2)
+XSCBU3 = XKERA1*ZGAMR(3)
+XSCBU_EFF1 = 0.6E-3
+XSCBU_EFF2 = 2.0E-3
+XSCBUEXP1 = -2500.0
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 7. CONSTANTS FOR THE "SONTANEOUS" BREAK-UP
+! ---------------------------------------
+!
+XSPONBUD1 = 3.0E-3
+XSPONBUD2 = 4.0E-3
+XSPONBUD3 = 5.0E-3
+XSPONCOEF2 = ((XSPONBUD3/XSPONBUD2)**3 - 1.0)/(XSPONBUD3-XSPONBUD1)**2
+!
+!
+!------------------------------------------------------------------------------
+!
+!* 8. CONSTANTS FOR EVAPORATION PROCESS
+! ---------------------------------
+!
+X0CNDC = (4.0*XPI)*XC1C*XF0C*MOMG(XALPHAC,XNUC,1.)
+X2CNDC = (4.0*XPI)*XC1C*XF2C*XCC*MOMG(XALPHAC,XNUC,XDC+2.0)
+!
+XEX0EVAR = -1.0
+XEX1EVAR = -1.0 - (XDR+1.0)*0.5
+XEX2EVAR = -0.5*XCEXVT
+!
+X0EVAR = (2.0*XPI)*XF0R*GAMMA(XNUR+1./XALPHAR)/GAMMA(XNUR)
+X1EVAR = (2.0*XPI)*XF1R*((ZRHO00)**(XCEXVT)*(XCR/0.15E-4))**0.5* &
+ GAMMA(XNUR+(XDR+3.0)/(2.0*XALPHAR))/GAMMA(XNUR)
+!
+XEX0EVAR = 2.0
+XEX1EVAR = 2.0 - (XDR+1.0)*0.5
+XEX2EVAR = -0.5*XCEXVT
+!
+X0EVAR = (12.0)*XF0R*GAMMA(XNUR+1./XALPHAR)/GAMMA(XNUR+3./XALPHAR)
+X1EVAR = (12.0)*XF1R*((ZRHO00)**(XCEXVT)*(XCR/0.15E-4))**0.5* &
+ GAMMA(XNUR+(XDR+3.0)/(2.0*XALPHAR))/GAMMA(XNUR+3./XALPHAR)
+!
+!-------------------------------------------------------------------------------
+!
+!* 9. SET-UP RADIATIVE PARAMETERS
+! ---------------------------
+!
+! R_eff_c = XFREFFC * (rho*r_c/N_c)**(1/3)
+!
+!
+XFREFFC = 0.5 * ZGAMC(6) * (1.0/XAC)**(1.0/3.0)
+XFREFFR = 0.5 * ZGAMR(6) * (1.0/XAR)**(1.0/3.0)
+!
+! Coefficients used to compute reff when both cloud and rain are present
+!
+XCREC = 1.0/ (ZGAMC(6) * XAC**(2.0/3.0))
+XCRER = 1.0/ (ZGAMR(6) * XAR**(2.0/3.0))
+!
+!-------------------------------------------------------------------------------
+!
+!* 10. SOME PRINTS FOR CONTROL
+! -----------------------
+!
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=ILUOUT0,FMT='(" Summary of the cloud particule characteristics")')
+ WRITE(UNIT=ILUOUT0,FMT='(" CLOUD")')
+ WRITE(UNIT=ILUOUT0,FMT='(" masse: A=",E13.6," B=",E13.6)') &
+ XAR,XBR
+ WRITE(UNIT=ILUOUT0,FMT='(" vitesse: C=",E13.6," D=",E13.6)') &
+ XCC,XDC
+ WRITE(UNIT=ILUOUT0,FMT='(" distribution:AL=",E13.6,"NU=",E13.6)') &
+ XALPHAC,XNUC
+ WRITE(UNIT=ILUOUT0,FMT='(" RAIN")')
+ WRITE(UNIT=ILUOUT0,FMT='(" masse: A=",E13.6," B=",E13.6)') &
+ XAR,XBR
+ WRITE(UNIT=ILUOUT0,FMT='(" vitesse: C=",E13.6," D=",E13.6)') &
+ XCR,XDR
+ WRITE(UNIT=ILUOUT0,FMT='(" distribution:AL=",E13.6,"NU=",E13.6)') &
+ XALPHAR,XNUR
+ WRITE(UNIT=ILUOUT0,FMT='(" Description of the nucleation spectrum")')
+ WRITE(UNIT=ILUOUT0,FMT='(" C=",E13.6," k=",E13.6)') XCHEN, XKHEN
+ WRITE(UNIT=ILUOUT0,FMT='(" Beta=",E13.6," MU=",E13.6)') XBETAHEN, XMUHEN
+ WRITE(UNIT=ILUOUT0,FMT='(" CCN max=",E13.6)') XCONC_CCN
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 11. Constants only for KHKO scheme
+! ---------------------------
+!
+!* 11.1 Cst for the coalescence processes
+!
+XR0 = 25.0E-6
+!
+!* 11.2 Cst for evaporation processes
+!
+XCEVAP = 0.86
+!
+!-------------------------------------------------------------------------------
+!
+CONTAINS
+!
+!------------------------------------------------------------------------------
+!
+ FUNCTION MOMG (PALPHA,PNU,PP) RESULT (PMOMG)
+!
+! auxiliary routine used to compute the Pth moment order of the generalized
+! gamma law
+!
+ USE MODI_GAMMA
+!
+ IMPLICIT NONE
+!
+ REAL :: PALPHA ! first shape parameter of the dimensionnal distribution
+ REAL :: PNU ! second shape parameter of the dimensionnal distribution
+ REAL :: PP ! order of the moment
+ REAL :: PMOMG ! result: moment of order ZP
+!
+!------------------------------------------------------------------------------
+!
+!
+ PMOMG = GAMMA(PNU+PP/PALPHA)/GAMMA(PNU)
+!
+ END FUNCTION MOMG
+!
+!------------------------------------------------------------------------------
+!
+!
+END SUBROUTINE INI_RAIN_C2R2
diff --git a/src/mesonh/micro/ini_rain_ice.f90 b/src/mesonh/micro/ini_rain_ice.f90
new file mode 100644
index 000000000..62cabad5b
--- /dev/null
+++ b/src/mesonh/micro/ini_rain_ice.f90
@@ -0,0 +1,1408 @@
+!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ######spl
+ MODULE MODI_INI_RAIN_ICE
+! ########################
+!
+INTERFACE
+ SUBROUTINE INI_RAIN_ICE ( KLUOUT, PTSTEP, PDZMIN, KSPLITR, HCLOUD )
+!
+INTEGER, INTENT(IN) :: KLUOUT ! Logical unit number for prints
+INTEGER, INTENT(OUT):: KSPLITR ! Number of small time step
+ ! integration for rain
+ ! sedimendation
+!
+REAL, INTENT(IN) :: PTSTEP ! Effective Time step
+!
+REAL, INTENT(IN) :: PDZMIN ! minimun vertical mesh size
+!
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Indicator of the cloud scheme
+!
+END SUBROUTINE INI_RAIN_ICE
+!
+END INTERFACE
+!
+END MODULE MODI_INI_RAIN_ICE
+! ######spl
+ SUBROUTINE INI_RAIN_ICE ( KLUOUT, PTSTEP, PDZMIN, KSPLITR, HCLOUD )
+! ###########################################################
+!
+!!**** *INI_RAIN_ICE * - initialize the constants necessary for the warm and
+!! cold microphysical schemes.
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to initialize the constants used to
+!! resolve the mixed phase microphysical scheme. The collection kernels of
+!! the precipitating particles are recomputed if necessary if some parameters
+!! defining the ice categories have been modified. The number of small
+!! time steps leading to stable scheme for the rain, ice, snow and ggraupeln
+!! sedimentation is also computed (time-splitting technique).
+!!
+!!** METHOD
+!! ------
+!! The constants are initialized to their numerical values and the number
+!! of small time step is computed by dividing the 2* Deltat time interval of
+!! the Leap-frog scheme so that the stability criterion for the rain
+!! sedimentation is fulfilled for a Raindrop maximal fall velocity equal
+!! VTRMAX. The parameters defining the collection kernels are read and are
+!! checked against the new ones. If any change occurs, these kernels are
+!! recomputed and their numerical values are written in the output listing.
+!!
+!! EXTERNAL
+!! --------
+!! GAMMA : gamma function
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST
+!! XPI !
+!! XP00 ! Reference pressure
+!! XRD ! Gaz constant for dry air
+!! XRHOLW ! Liquid water density
+!! Module MODD_REF
+!! XTHVREFZ ! Reference virtual pot.temp. without orography
+!! Module MODD_PARAMETERS
+!! JPVEXT !
+!! Module MODD_RAIN_ICE_DESCR
+!! Module MODD_RAIN_ICE_PARAM
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation ( routine INI_RAIN_ICE )
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 04/12/95
+!! J.-P. Pinty 05/04/96 Add automatic control and regeneration of the
+!! collection kernels
+!! J.-P. Pinty 10/05/96 Correction of ZRATE and computations of RIM
+!! J.-P. Pinty 24/11/97 Sedimentation of ice made for Columns and bug for XAG
+!! J.-P. Lafore 23/11/98 Back to Lin et al. 83 formulation for RIAUTS
+!! with a Critical ice content set to .5 g/Kg
+!! N. Asencio 13/08/98 parallel code: PDZMIN is computed outside in ini_modeln
+!! J.-P. Lafore 12/8/98 In case of nesting microphysics constants of
+!! MODD_RAIN_ICE_PARAM are computed only once.
+!! Only KSPLTR is computed for each model.
+!! J. Stein 20/04/99 remove 2 unused local variables
+!! G Molinie 21/05/99 Bug in XEXRCFRI and XRCFRI
+!! J.-P. Pinty 24/06/00 Bug in RCRIMS
+!! J.-P. Pinty 24/12/00 Update hail case
+!! J.-P. Chaboureau & J.-P. Pinty
+!! 24/03/01 Update XCRIAUTI for cirrus cases
+!! J.-P. Pinty 24/11/01 Update ICE3/ICE4 options
+!! S. Riette 2016-11: new ICE3/ICE4 options
+!! P. Wautelet 22/01/2019 bug correction: incorrect write
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_LUNIT
+USE MODD_PARAMETERS
+USE MODD_PARAM_ICE
+USE MODD_RAIN_ICE_DESCR
+USE MODD_RAIN_ICE_PARAM
+USE MODD_REF
+!
+USE MODI_GAMMA
+USE MODI_GAMMA_INC
+USE MODI_RRCOLSS
+USE MODI_RZCOLX
+USE MODI_RSCOLRG
+USE MODI_READ_XKER_RACCS
+USE MODI_READ_XKER_SDRYG
+USE MODI_READ_XKER_RDRYG
+USE MODI_READ_XKER_SWETH
+USE MODI_READ_XKER_GWETH
+USE MODI_READ_XKER_RWETH
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+!
+INTEGER, INTENT(IN) :: KLUOUT ! Logical unit number for prints
+INTEGER, INTENT(OUT):: KSPLITR ! Number of small time step
+ ! integration for rain
+ ! sedimendation
+!
+REAL, INTENT(IN) :: PTSTEP ! Effective Time step
+!
+REAL, INTENT(IN) :: PDZMIN ! minimun vertical mesh size
+!
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Indicator of the cloud scheme
+!
+!
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IKB ! Coordinates of the first physical
+ ! points along z
+INTEGER :: J1,J2 ! Internal loop indexes
+REAL :: ZT ! Work variable
+REAL :: ZVTRMAX ! Raindrop maximal fall velocity
+REAL :: ZRHO00 ! Surface reference air density
+REAL :: ZE, ZRV ! Work array for ZRHO00 computation
+REAL :: ZRATE ! Geometrical growth of Lbda in the tabulated
+ ! functions and kernels
+REAL :: ZBOUND ! XDCSLIM*Lbda_s: upper bound for the partial
+ ! integration of the riming rate of the aggregates
+REAL :: ZEGS, ZEGR, ZEHS, & ! Bulk collection efficiencies
+ & ZEHG, ZEHR
+!
+INTEGER :: IND ! Number of interval to integrate the kernels
+REAL :: ZESR ! Mean efficiency of rain-aggregate collection
+REAL :: ZFDINFTY ! Factor used to define the "infinite" diameter
+!
+!
+!
+LOGICAL :: GFLAG ! Logical flag for printing the constatnts on the output
+ ! listing
+REAL :: ZCONC_MAX ! Maximal concentration for snow
+REAL :: ZGAMC,ZGAMC2 ! parameters
+ ! involving various moments of the generalized gamma law
+REAL :: ZFACT_NUCL! Amplification factor for the minimal ice concentration
+REAL :: ZXR ! Value of x_r in N_r = C_r lambda_r ** x_r
+!
+INTEGER :: KND
+INTEGER :: KACCLBDAS,KACCLBDAR,KDRYLBDAG,KDRYLBDAS,KDRYLBDAR
+INTEGER :: KWETLBDAS,KWETLBDAG,KWETLBDAR,KWETLBDAH
+REAL :: PALPHAR,PALPHAS,PALPHAG,PALPHAH
+REAL :: PNUR,PNUS,PNUG,PNUH
+REAL :: PBR,PBS,PBG
+REAL :: PCR,PCS,PCG,PCH
+REAL :: PDR,PDS,PDG,PDH
+REAL :: PESR,PEGS,PEGR,PEHS,PEHG,PEHR
+REAL :: PFDINFTY
+REAL :: PACCLBDAS_MAX,PACCLBDAR_MAX,PACCLBDAS_MIN,PACCLBDAR_MIN
+REAL :: PDRYLBDAG_MAX,PDRYLBDAS_MAX,PDRYLBDAG_MIN,PDRYLBDAS_MIN
+REAL :: PDRYLBDAR_MAX,PDRYLBDAR_MIN
+REAL :: PWETLBDAS_MAX,PWETLBDAG_MAX,PWETLBDAS_MIN,PWETLBDAG_MIN
+REAL :: PWETLBDAR_MAX,PWETLBDAH_MAX,PWETLBDAR_MIN,PWETLBDAH_MIN
+!-------------------------------------------------------------------------------
+!
+!
+!* 0. FUNCTION STATEMENTS
+! -------------------
+!
+!
+!* 0.1 p_moment of the Generalized GAMMA function
+!
+!
+!
+! 1. COMPUTE KSPLTR FOR EACH MODEL
+! ---------------------------------------------------------
+!
+!* 1.1 Set the hailstones maximum fall velocity
+!
+IF (CSEDIM == 'SPLI' .AND. .NOT. LRED ) THEN
+ IF (HCLOUD == 'ICE4') THEN
+ ZVTRMAX = 40.
+ ELSE IF (HCLOUD == 'ICE3') THEN
+ ZVTRMAX = 10.
+ END IF
+END IF
+!
+!* 1.2 Compute the number of small time step integration
+!
+KSPLITR = 1
+IF (CSEDIM == 'SPLI' .AND. .NOT. LRED ) THEN
+ SPLIT : DO
+ ZT = PTSTEP / REAL(KSPLITR)
+ IF ( ZT * ZVTRMAX / PDZMIN .LT. 1.) EXIT SPLIT
+ KSPLITR = KSPLITR + 1
+ END DO SPLIT
+END IF
+!
+IF (ALLOCATED(XRTMIN)) THEN ! In case of nesting microphysics constants of
+ ! MODD_RAIN_ICE_PARAM are computed only once,
+ ! but if INI_RAIN_ICE has been called already
+ ! one must change the XRTMIN size.
+ DEALLOCATE(XRTMIN)
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. CHARACTERISTICS OF THE SPECIES
+! ------------------------------
+!
+!
+!* 2.1 Cloud droplet and Raindrop characteristics
+!
+XAC = (XPI/6.0)*XRHOLW
+XBC = 3.0
+XCC = XRHOLW*XG/(18.0*1.7E-5) ! Stokes flow (Pruppacher p 322 for T=273K)
+XDC = 2.0
+!
+!
+XAR = (XPI/6.0)*XRHOLW
+XBR = 3.0
+XCR = 842.
+XDR = 0.8
+!
+!XCCR = 1.E7 ! N0_r = XCXR * lambda_r ** ZXR
+XCCR = 8.E6 ! N0_r = XCXR * lambda_r ** ZXR
+ZXR = -1. !
+!
+XF0R = 1.00
+XF1R = 0.26
+!
+XC1R = 1./2.
+!
+!
+!* 2.2 Ice crystal characteristics
+!
+!
+SELECT CASE (CPRISTINE_ICE)
+ CASE('PLAT')
+ XAI = 0.82 ! Plates
+ XBI = 2.5 ! Plates
+ XC_I = 800. ! Plates
+ XDI = 1.0 ! Plates
+ XC1I = 1./XPI ! Plates
+ CASE('COLU')
+ XAI = 2.14E-3 ! Columns
+ XBI = 1.7 ! Columns
+ XC_I = 2.1E5 ! Columns
+ XDI = 1.585 ! Columns
+ XC1I = 0.8 ! Columns
+ CASE('BURO')
+ XAI = 44.0 ! Bullet rosettes
+ XBI = 3.0 ! Bullet rosettes
+ XC_I = 4.3E5 ! Bullet rosettes
+ XDI = 1.663 ! Bullet rosettes
+ XC1I = 0.5 ! Bullet rosettes
+END SELECT
+!
+! Note that XCCI=N_i (a locally predicted value) and XCXI=0.0, implicitly
+!
+XF0I = 1.00
+XF2I = 0.14
+!
+!
+!* 2.3 Snowflakes/aggregates characteristics
+!
+!
+XAS = 0.02
+XBS = 1.9
+XCS = 5.1
+XDS = 0.27
+!
+XCCS = 5.0
+XCXS = 1.0
+!
+XF0S = 0.86
+XF1S = 0.28
+!
+XC1S = 1./XPI
+!
+!
+!* 2.4 Graupel/Frozen drop characteristics
+!
+!
+XAG = 19.6 ! Lump graupel case
+XBG = 2.8 ! Lump graupel case
+XCG = 124. ! Lump graupel case
+XDG = 0.66 ! Lump graupel case
+!
+XCCG = 5.E5
+XCXG = -0.5
+! XCCG = 4.E4 ! Test of Ziegler (1988)
+! XCXG = -1.0 ! Test of Ziegler (1988)
+!
+XF0G = 0.86
+XF1G = 0.28
+!
+XC1G = 1./2.
+!
+!
+!* 2.5 Hailstone characteristics
+!
+!
+XAH = 470.
+XBH = 3.0
+XCH = 207.
+XDH = 0.64
+!
+!XCCH = 5.E-4
+!XCXH = 2.0
+!!!!!!!!!!!!
+ XCCH = 4.E4 ! Test of Ziegler (1988)
+ XCXH = -1.0 ! Test of Ziegler (1988)
+!!! XCCH = 5.E5 ! Graupel_like
+!!! XCXH = -0.5 ! Graupel_like
+!!!!!!!!!!!!
+!
+XF0H = 0.86
+XF1H = 0.28
+!
+XC1H = 1./2.
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. DIMENSIONAL DISTRIBUTIONS OF THE SPECIES
+! ----------------------------------------
+!
+!
+! 3.1 Cloud droplet distribution
+!
+! Over land
+XALPHAC = 1.0 ! Gamma law of the Cloud droplet (here volume-like distribution)
+XNUC = 3.0 ! Gamma law with little dispersion
+!
+!
+! Over sea
+XALPHAC2 = 3.0 ! Gamma law of the Cloud droplet (here volume-like distribution)
+XNUC2 = 1.0 ! Gamma law with little dispersion
+!
+!* 3.2 Raindrops distribution
+!
+XALPHAR = 1.0 ! Exponential law
+XNUR = 1.0 ! Exponential law
+!
+!* 3.3 Ice crystal distribution
+!
+XALPHAI = 3.0 ! Gamma law for the ice crystal volume
+XNUI = 3.0 ! Gamma law with little dispersion
+!
+XALPHAS = 1.0 ! Exponential law
+XNUS = 1.0 ! Exponential law
+!
+XALPHAG = 1.0 ! Exponential law
+XNUG = 1.0 ! Exponential law
+!
+XALPHAH = 1.0 ! Gamma law
+XNUH = 8.0 ! Gamma law with little dispersion
+!
+!* 3.4 Constants for shape parameter
+!
+ZGAMC = MOMG(XALPHAC,XNUC,3.)
+ZGAMC2 = MOMG(XALPHAC2,XNUC2,3.)
+XLBC(1) = XAR*ZGAMC
+XLBC(2) = XAR*ZGAMC2
+XLBEXC = 1.0/XBC
+!
+XLBEXR = 1.0/(-1.0-XBR)
+XLBR = ( XAR*XCCR*MOMG(XALPHAR,XNUR,XBR) )**(-XLBEXR)
+!
+XLBEXI = 1.0/(-XBI)
+XLBI = ( XAI*MOMG(XALPHAI,XNUI,XBI) )**(-XLBEXI)
+!
+XLBEXS = 1.0/(XCXS-XBS)
+XLBS = ( XAS*XCCS*MOMG(XALPHAS,XNUS,XBS) )**(-XLBEXS)
+!
+XLBEXG = 1.0/(XCXG-XBG)
+XLBG = ( XAG*XCCG*MOMG(XALPHAG,XNUG,XBG) )**(-XLBEXG)
+!
+XLBEXH = 1.0/(XCXH-XBH)
+XLBH = ( XAH*XCCH*MOMG(XALPHAH,XNUH,XBH) )**(-XLBEXH)
+!
+!* 3.5 Minimal values allowed for the mixing ratios
+!
+XLBDAS_MAX = 100000.0
+!
+ZCONC_MAX = 1.E6 ! Maximal concentration for falling particules set to 1 per cc
+XLBDAS_MAX = ( ZCONC_MAX/XCCS )**(1./XCXS)
+!
+IF (HCLOUD == 'ICE4') THEN
+ ALLOCATE( XRTMIN(7) )
+ELSE IF (HCLOUD == 'ICE3') THEN
+ ALLOCATE( XRTMIN(6) )
+END IF
+!
+XRTMIN(1) = 1.0E-20
+XRTMIN(2) = 1.0E-20
+XRTMIN(3) = 1.0E-20
+XRTMIN(4) = 1.0E-20
+XRTMIN(5) = 1.0E-15
+XRTMIN(6) = 1.0E-15
+IF (HCLOUD == 'ICE4') XRTMIN(7) = 1.0E-15
+!
+XCONC_SEA=1E8 ! 100/cm3
+XCONC_LAND=3E8 ! 300/cm3
+XCONC_URBAN=5E8 ! 500/cm3
+!
+!-------------------------------------------------------------------------------
+!
+!* 4. CONSTANTS FOR THE SEDIMENTATION
+! -------------------------------
+!
+!
+!* 4.1 Exponent of the fall-speed air density correction
+!
+XCEXVT = 0.4
+!
+IKB = 1 + JPVEXT
+!ZRHO00 = XP00/(XRD*XTHVREFZ(IKB))
+!According to Foote and Du Toit (1969) and List (1958), ZRHO00 must be computed for Hu=50%, P=101325Pa and T=293.15K
+ZE = (50./100.) * EXP(XALPW-XBETAW/293.15-XGAMW*LOG(293.15))
+ZRV = (XRD/XRV) * ZE / (101325.-ZE)
+ZRHO00 = 101325.*(1.+ZRV)/(XRD+ZRV*XRV)/293.15
+!
+!* 4.2 Constants for sedimentation
+!
+XFSEDC(1) = GAMMA(XNUC+(XDC+3.)/XALPHAC)/GAMMA(XNUC+3./XALPHAC)* &
+ (ZRHO00)**XCEXVT
+XFSEDC(2) = GAMMA(XNUC2+(XDC+3.)/XALPHAC2)/GAMMA(XNUC2+3./XALPHAC2)* &
+ (ZRHO00)**XCEXVT
+!
+XEXSEDR = (XBR+XDR+1.0)/(XBR+1.0)
+XFSEDR = XCR*XAR*XCCR*MOMG(XALPHAR,XNUR,XBR+XDR)* &
+ (XAR*XCCR*MOMG(XALPHAR,XNUR,XBR))**(-XEXSEDR)*(ZRHO00)**XCEXVT
+!
+XEXRSEDI = (XBI+XDI)/XBI
+XEXCSEDI = 1.0-XEXRSEDI
+XFSEDI = (4.*XPI*900.)**(-XEXCSEDI) * &
+ XC_I*XAI*MOMG(XALPHAI,XNUI,XBI+XDI) * &
+ ((XAI*MOMG(XALPHAI,XNUI,XBI)))**(-XEXRSEDI) * &
+ (ZRHO00)**XCEXVT
+!When we do not use computations for columns, I think we must uncomment line just below
+!XEXCSEDI = XEXCSEDI * 3. to be checked
+!
+! Computations made for Columns
+!
+XEXRSEDI = 1.9324
+XEXCSEDI =-0.9324
+XFSEDI = 3.89745E11*MOMG(XALPHAI,XNUI,3.285)* &
+ MOMG(XALPHAI,XNUI,1.7)**(-XEXRSEDI)*(ZRHO00)**XCEXVT
+XEXCSEDI =-0.9324*3.0
+WRITE (KLUOUT,FMT=*)' PRISTINE ICE SEDIMENTATION for columns XFSEDI =',XFSEDI
+!
+!
+XEXSEDS = (XBS+XDS-XCXS)/(XBS-XCXS)
+XFSEDS = XCS*XAS*XCCS*MOMG(XALPHAS,XNUS,XBS+XDS)* &
+ (XAS*XCCS*MOMG(XALPHAS,XNUS,XBS))**(-XEXSEDS)*(ZRHO00)**XCEXVT
+!
+XEXSEDG = (XBG+XDG-XCXG)/(XBG-XCXG)
+XFSEDG = XCG*XAG*XCCG*MOMG(XALPHAG,XNUG,XBG+XDG)* &
+ (XAG*XCCG*MOMG(XALPHAG,XNUG,XBG))**(-XEXSEDG)*(ZRHO00)**XCEXVT
+!
+XEXSEDH = (XBH+XDH-XCXH)/(XBH-XCXH)
+XFSEDH = XCH*XAH*XCCH*MOMG(XALPHAH,XNUH,XBH+XDH)* &
+ (XAH*XCCH*MOMG(XALPHAH,XNUH,XBH))**(-XEXSEDH)*(ZRHO00)**XCEXVT
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 5. CONSTANTS FOR THE SLOW COLD PROCESSES
+! -------------------------------------
+!
+!
+!* 5.1 Constants for ice nucleation
+!
+SELECT CASE (CPRISTINE_ICE)
+ CASE('PLAT')
+ ZFACT_NUCL = 1.0 ! Plates
+ CASE('COLU')
+ ZFACT_NUCL = 25.0 ! Columns
+ CASE('BURO')
+ ZFACT_NUCL = 17.0 ! Bullet rosettes
+END SELECT
+!
+XNU10 = 50.*ZFACT_NUCL
+XALPHA1 = 4.5
+XBETA1 = 0.6
+!
+XNU20 = 1000.*ZFACT_NUCL
+XALPHA2 = 12.96
+XBETA2 = 0.639
+!
+XMNU0 = 6.88E-13
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=KLUOUT,FMT='(" Heterogeneous nucleation")')
+ WRITE(UNIT=KLUOUT,FMT='(" NU10=",E13.6," ALPHA1=",E13.6," BETA1=",E13.6)') &
+ XNU10,XALPHA1,XBETA1
+ WRITE(UNIT=KLUOUT,FMT='(" NU20=",E13.6," ALPHA2=",E13.6," BETA2=",E13.6)') &
+ XNU20,XALPHA2,XBETA2
+ WRITE(UNIT=KLUOUT,FMT='(" mass of embryo XMNU0=",E13.6)') XMNU0
+END IF
+!
+XALPHA3 = -3.075
+XBETA3 = 81.00356
+XHON = (XPI/6.)*((2.0*3.0*4.0*5.0*6.0)/(2.0*3.0))*(1.1E5)**(-3.0) !
+ ! Pi/6 * (G_c(6)/G_c(3)) * (1/Lbda_c**3)
+ ! avec Lbda_c=1.1E5 m^-1
+ ! the formula is equivalent to
+ ! rho_dref * r_c G(6)
+ ! Pi/6 * -------------- * ---------
+ ! rho_lw * N_c G(3)*G(3)
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=KLUOUT,FMT='(" Homogeneous nucleation")')
+ WRITE(UNIT=KLUOUT,FMT='(" ALPHA3=",E13.6," BETA3=",E13.6)') XALPHA3,XBETA3
+ WRITE(UNIT=KLUOUT,FMT='(" constant XHON=",E13.6)') XHON
+END IF
+!
+!
+!* 5.2 Constants for vapor deposition on ice
+!
+XSCFAC = (0.63**(1./3.))*SQRT((ZRHO00)**XCEXVT) ! One assumes Sc=0.63
+!
+X0DEPI = (4.0*XPI)*XC1I*XF0I*MOMG(XALPHAI,XNUI,1.)
+X2DEPI = (4.0*XPI)*XC1I*XF2I*XC_I*MOMG(XALPHAI,XNUI,XDI+2.0)
+!
+X0DEPS = (4.0*XPI)*XCCS*XC1S*XF0S*MOMG(XALPHAS,XNUS,1.)
+X1DEPS = (4.0*XPI)*XCCS*XC1S*XF1S*SQRT(XCS)*MOMG(XALPHAS,XNUS,0.5*XDS+1.5)
+XEX0DEPS = XCXS-1.0
+XEX1DEPS = XCXS-0.5*(XDS+3.0)
+!
+X0DEPG = (4.0*XPI)*XCCG*XC1G*XF0G*MOMG(XALPHAG,XNUG,1.)
+X1DEPG = (4.0*XPI)*XCCG*XC1G*XF1G*SQRT(XCG)*MOMG(XALPHAG,XNUG,0.5*XDG+1.5)
+XEX0DEPG = XCXG-1.0
+XEX1DEPG = XCXG-0.5*(XDG+3.0)
+!
+X0DEPH = (4.0*XPI)*XCCH*XC1H*XF0H*MOMG(XALPHAH,XNUH,1.)
+X1DEPH = (4.0*XPI)*XCCH*XC1H*XF1H*SQRT(XCH)*MOMG(XALPHAH,XNUH,0.5*XDH+1.5)
+XEX0DEPH = XCXH-1.0
+XEX1DEPH = XCXH-0.5*(XDH+3.0)
+!
+!* 5.3 Constants for pristine ice autoconversion
+!
+XTIMAUTI = 1.E-3 ! Time constant at T=T_t
+XTEXAUTI = 0.015 ! Temperature factor of the I+I collection efficiency
+!!XCRIAUTI = 0.25E-3 ! Critical ice content for the autoconversion to occur
+XCRIAUTI = 0.2E-4 ! Critical ice content for the autoconversion to occur
+ ! Revised value by Chaboureau et al. (2001)
+XACRIAUTI=0.06
+XBCRIAUTI=-3.5
+XT0CRIAUTI=(LOG10(XCRIAUTI)-XBCRIAUTI)/0.06
+
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=KLUOUT,FMT='(" pristine ice autoconversion")')
+ WRITE(UNIT=KLUOUT,FMT='(" Time constant XTIMAUTI=",E13.6)') XTIMAUTI
+ WRITE(UNIT=KLUOUT,FMT='(" Temp. factor XTEXAUTI=",E13.6)') XTEXAUTI
+ WRITE(UNIT=KLUOUT,FMT='(" Crit. ice cont. XCRIAUTI=",E13.6)') XCRIAUTI
+ WRITE(UNIT=KLUOUT,FMT='(" A Coef. for cirrus law XACRIAUTI=",E13.6)')XACRIAUTI
+ WRITE(UNIT=KLUOUT,FMT='(" B Coef. for cirrus law XBCRIAUTI=",E13.6)')XBCRIAUTI
+ WRITE(UNIT=KLUOUT,FMT='(" Temp degC at which cirrus law starts to be used=",E13.6)') XT0CRIAUTI
+END IF
+!
+!
+!* 5.4 Constants for snow aggregation
+!
+XCOLIS = 0.25 ! Collection efficiency of I+S
+XCOLEXIS = 0.05 ! Temperature factor of the I+S collection efficiency
+XFIAGGS = (XPI/4.0)*XCOLIS*XCCS*XCS*(ZRHO00**XCEXVT)*MOMG(XALPHAS,XNUS,XDS+2.0)
+XEXIAGGS = XCXS-XDS-2.0
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=KLUOUT,FMT='(" snow aggregation")')
+ WRITE(UNIT=KLUOUT,FMT='(" Coll. efficiency XCOLIS=",E13.6)') XCOLIS
+ WRITE(UNIT=KLUOUT,FMT='(" Temp. factor XCOLEXIS=",E13.6)') XCOLEXIS
+END IF
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 6. CONSTANTS FOR THE SLOW WARM PROCESSES
+! -------------------------------------
+!
+!
+!* 6.1 Constants for the cloud droplets autoconversion
+!
+XTIMAUTC = 1.E-3
+XCRIAUTC = 0.5E-3
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=KLUOUT,FMT='(" cloud droplets autoconversion")')
+ WRITE(UNIT=KLUOUT,FMT='(" Time constant XTIMAUTC=",E13.6)') XTIMAUTC
+ WRITE(UNIT=KLUOUT,FMT='(" Crit. ice cont. XCRIAUTC=",E13.6)') XCRIAUTC
+END IF
+!
+!* 6.2 Constants for the accretion of cloud droplets by raindrops
+!
+XFCACCR = (XPI/4.0)*XCCR*XCR*(ZRHO00**XCEXVT)*MOMG(XALPHAR,XNUR,XDR+2.0)
+XEXCACCR = -XDR-3.0
+!
+!* 6.3 Constants for the evaporation of the raindrops
+!
+X0EVAR = (4.0*XPI)*XCCR*XC1R*XF0R*MOMG(XALPHAR,XNUR,1.)
+X1EVAR = (4.0*XPI)*XCCR*XC1R*XF1R*SQRT(XCR)*MOMG(XALPHAR,XNUR,0.5*XDR+1.5)
+XEX0EVAR = -2.0
+XEX1EVAR = -1.0-0.5*(XDR+3.0)
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 7. CONSTANTS FOR THE FAST COLD PROCESSES FOR THE AGGREGATES
+! --------------------------------------------------------
+!
+!
+!* 7.1 Constants for the riming of the aggregates
+!
+XDCSLIM = 0.007 ! D_cs^lim = 7 mm as suggested by Farley et al. (1989)
+XCOLCS = 1.0
+XEXCRIMSS= XCXS-XDS-2.0
+XCRIMSS = (XPI/4.0)*XCOLCS*XCCS*XCS*(ZRHO00**XCEXVT)*MOMG(XALPHAS,XNUS,XDS+2.0)
+XEXCRIMSG= XEXCRIMSS
+XCRIMSG = XCRIMSS
+XSRIMCG = XCCS*XAS*MOMG(XALPHAS,XNUS,XBS)
+XEXSRIMCG= XCXS-XBS
+XSRIMCG2 = XCCS*XAG*MOMG(XALPHAS,XNUS,XBG)
+XSRIMCG3 = XFRACM90
+XEXSRIMCG2=XCXS-XBG
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=KLUOUT,FMT='(" riming of the aggregates")')
+ WRITE(UNIT=KLUOUT,FMT='(" D_cs^lim (Farley et al.) XDCSLIM=",E13.6)') XDCSLIM
+ WRITE(UNIT=KLUOUT,FMT='(" Coll. efficiency XCOLCS=",E13.6)') XCOLCS
+END IF
+!
+NGAMINC = 80
+XGAMINC_BOUND_MIN = 1.0E-1 ! Minimal value of (Lbda * D_cs^lim)**alpha
+XGAMINC_BOUND_MAX = 1.0E7 ! Maximal value of (Lbda * D_cs^lim)**alpha
+ZRATE = EXP(LOG(XGAMINC_BOUND_MAX/XGAMINC_BOUND_MIN)/REAL(NGAMINC-1))
+!
+IF( .NOT.ALLOCATED(XGAMINC_RIM1) ) ALLOCATE( XGAMINC_RIM1(NGAMINC) )
+IF( .NOT.ALLOCATED(XGAMINC_RIM2) ) ALLOCATE( XGAMINC_RIM2(NGAMINC) )
+IF( .NOT.ALLOCATED(XGAMINC_RIM4) ) ALLOCATE( XGAMINC_RIM4(NGAMINC) )
+!
+DO J1=1,NGAMINC
+ ZBOUND = XGAMINC_BOUND_MIN*ZRATE**(J1-1)
+ XGAMINC_RIM1(J1) = GAMMA_INC(XNUS+(2.0+XDS)/XALPHAS,ZBOUND)
+ XGAMINC_RIM2(J1) = GAMMA_INC(XNUS+XBS/XALPHAS ,ZBOUND)
+ XGAMINC_RIM4(J1) = GAMMA_INC(XNUS+XBG/XALPHAS ,ZBOUND)
+END DO
+!
+XRIMINTP1 = XALPHAS / LOG(ZRATE)
+XRIMINTP2 = 1.0 + XRIMINTP1*LOG( XDCSLIM/(XGAMINC_BOUND_MIN)**(1.0/XALPHAS) )
+!
+!* 7.2 Constants for the accretion of raindrops onto aggregates
+!
+XFRACCSS = ((XPI**2)/24.0)*XCCS*XCCR*XRHOLW*(ZRHO00**XCEXVT)
+!
+XLBRACCS1 = MOMG(XALPHAS,XNUS,2.)*MOMG(XALPHAR,XNUR,3.)
+XLBRACCS2 = 2.*MOMG(XALPHAS,XNUS,1.)*MOMG(XALPHAR,XNUR,4.)
+XLBRACCS3 = MOMG(XALPHAR,XNUR,5.)
+!
+XFSACCRG = (XPI/4.0)*XAS*XCCS*XCCR*(ZRHO00**XCEXVT)
+!
+XLBSACCR1 = MOMG(XALPHAR,XNUR,2.)*MOMG(XALPHAS,XNUS,XBS)
+XLBSACCR2 = 2.*MOMG(XALPHAR,XNUR,1.)*MOMG(XALPHAS,XNUS,XBS+1.)
+XLBSACCR3 = MOMG(XALPHAS,XNUS,XBS+2.)
+!
+!* 7.2.1 Defining the ranges for the computation of the kernels
+!
+! Notice: One magnitude of lambda discretized over 10 points for rain
+! Notice: One magnitude of lambda discretized over 10 points for snow
+!
+NACCLBDAS = 40
+XACCLBDAS_MIN = 5.0E1 ! Minimal value of Lbda_s to tabulate XKER_RACCS
+XACCLBDAS_MAX = 5.0E5 ! Maximal value of Lbda_s to tabulate XKER_RACCS
+ZRATE = LOG(XACCLBDAS_MAX/XACCLBDAS_MIN)/REAL(NACCLBDAS-1)
+XACCINTP1S = 1.0 / ZRATE
+XACCINTP2S = 1.0 - LOG( XACCLBDAS_MIN ) / ZRATE
+NACCLBDAR = 40
+XACCLBDAR_MIN = 1.0E3 ! Minimal value of Lbda_r to tabulate XKER_RACCS
+XACCLBDAR_MAX = 1.0E7 ! Maximal value of Lbda_r to tabulate XKER_RACCS
+ZRATE = LOG(XACCLBDAR_MAX/XACCLBDAR_MIN)/REAL(NACCLBDAR-1)
+XACCINTP1R = 1.0 / ZRATE
+XACCINTP2R = 1.0 - LOG( XACCLBDAR_MIN ) / ZRATE
+!
+!* 7.2.2 Computations of the tabulated normalized kernels
+!
+IND = 50 ! Interval number, collection efficiency and infinite diameter
+ZESR = 1.0 ! factor used to integrate the dimensional distributions when
+ZFDINFTY = 20.0 ! computing the kernels XKER_RACCSS, XKER_RACCS and XKER_SACCRG
+!
+IF( .NOT.ALLOCATED(XKER_RACCSS) ) ALLOCATE( XKER_RACCSS(NACCLBDAS,NACCLBDAR) )
+IF( .NOT.ALLOCATED(XKER_RACCS ) ) ALLOCATE( XKER_RACCS (NACCLBDAS,NACCLBDAR) )
+IF( .NOT.ALLOCATED(XKER_SACCRG) ) ALLOCATE( XKER_SACCRG(NACCLBDAR,NACCLBDAS) )
+!
+CALL READ_XKER_RACCS (KACCLBDAS,KACCLBDAR,KND, &
+ PALPHAS,PNUS,PALPHAR,PNUR,PESR,PBS,PBR,PCS,PDS,PCR,PDR, &
+ PACCLBDAS_MAX,PACCLBDAR_MAX,PACCLBDAS_MIN,PACCLBDAR_MIN,&
+ PFDINFTY )
+IF( (KACCLBDAS/=NACCLBDAS) .OR. (KACCLBDAR/=NACCLBDAR) .OR. (KND/=IND) .OR. &
+ (PALPHAS/=XALPHAS) .OR. (PNUS/=XNUS) .OR. &
+ (PALPHAR/=XALPHAR) .OR. (PNUR/=XNUR) .OR. &
+ (PESR/=ZESR) .OR. (PBS/=XBS) .OR. (PBR/=XBR) .OR. &
+ (PCS/=XCS) .OR. (PDS/=XDS) .OR. (PCR/=XCR) .OR. (PDR/=XDR) .OR. &
+ (PACCLBDAS_MAX/=XACCLBDAS_MAX) .OR. (PACCLBDAR_MAX/=XACCLBDAR_MAX) .OR. &
+ (PACCLBDAS_MIN/=XACCLBDAS_MIN) .OR. (PACCLBDAR_MIN/=XACCLBDAR_MIN) .OR. &
+ (PFDINFTY/=ZFDINFTY) ) THEN
+ CALL RRCOLSS ( IND, XALPHAS, XNUS, XALPHAR, XNUR, &
+ ZESR, XBR, XCS, XDS, XCR, XDR, &
+ XACCLBDAS_MAX, XACCLBDAR_MAX, XACCLBDAS_MIN, XACCLBDAR_MIN, &
+ ZFDINFTY, XKER_RACCSS, XAG, XBS, XAS )
+ CALL RZCOLX ( IND, XALPHAS, XNUS, XALPHAR, XNUR, &
+ ZESR, XBR, XCS, XDS, XCR, XDR, &
+ XACCLBDAS_MAX, XACCLBDAR_MAX, XACCLBDAS_MIN, XACCLBDAR_MIN, &
+ ZFDINFTY, XKER_RACCS )
+ CALL RSCOLRG ( IND, XALPHAS, XNUS, XALPHAR, XNUR, &
+ ZESR, XBS, XCS, XDS, XCR, XDR, &
+ XACCLBDAS_MAX, XACCLBDAR_MAX, XACCLBDAS_MIN, XACCLBDAR_MIN, &
+ ZFDINFTY, XKER_SACCRG, XAG, XBS, XAS )
+ WRITE(UNIT=KLUOUT,FMT='("*****************************************")')
+ WRITE(UNIT=KLUOUT,FMT='("**** UPDATE NEW SET OF RACSS KERNELS ****")')
+ WRITE(UNIT=KLUOUT,FMT='("**** UPDATE NEW SET OF RACS KERNELS ****")')
+ WRITE(UNIT=KLUOUT,FMT='("**** UPDATE NEW SET OF SACRG KERNELS ****")')
+ WRITE(UNIT=KLUOUT,FMT='("*****************************************")')
+ WRITE(UNIT=KLUOUT,FMT='("!")')
+ WRITE(UNIT=KLUOUT,FMT='("KND=",I3)') IND
+ WRITE(UNIT=KLUOUT,FMT='("KACCLBDAS=",I3)') NACCLBDAS
+ WRITE(UNIT=KLUOUT,FMT='("KACCLBDAR=",I3)') NACCLBDAR
+ WRITE(UNIT=KLUOUT,FMT='("PALPHAS=",E13.6)') XALPHAS
+ WRITE(UNIT=KLUOUT,FMT='("PNUS=",E13.6)') XNUS
+ WRITE(UNIT=KLUOUT,FMT='("PALPHAR=",E13.6)') XALPHAR
+ WRITE(UNIT=KLUOUT,FMT='("PNUR=",E13.6)') XNUR
+ WRITE(UNIT=KLUOUT,FMT='("PESR=",E13.6)') ZESR
+ WRITE(UNIT=KLUOUT,FMT='("PBS=",E13.6)') XBS
+ WRITE(UNIT=KLUOUT,FMT='("PBR=",E13.6)') XBR
+ WRITE(UNIT=KLUOUT,FMT='("PCS=",E13.6)') XCS
+ WRITE(UNIT=KLUOUT,FMT='("PDS=",E13.6)') XDS
+ WRITE(UNIT=KLUOUT,FMT='("PCR=",E13.6)') XCR
+ WRITE(UNIT=KLUOUT,FMT='("PDR=",E13.6)') XDR
+ WRITE(UNIT=KLUOUT,FMT='("PACCLBDAS_MAX=",E13.6)') &
+ XACCLBDAS_MAX
+ WRITE(UNIT=KLUOUT,FMT='("PACCLBDAR_MAX=",E13.6)') &
+ XACCLBDAR_MAX
+ WRITE(UNIT=KLUOUT,FMT='("PACCLBDAS_MIN=",E13.6)') &
+ XACCLBDAS_MIN
+ WRITE(UNIT=KLUOUT,FMT='("PACCLBDAR_MIN=",E13.6)') &
+ XACCLBDAR_MIN
+ WRITE(UNIT=KLUOUT,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
+ WRITE(UNIT=KLUOUT,FMT='("!")')
+ WRITE(UNIT=KLUOUT,FMT='("IF( PRESENT(PKER_RACCSS) ) THEN")')
+ DO J1 = 1 , NACCLBDAS
+ DO J2 = 1 , NACCLBDAR
+ WRITE(UNIT=KLUOUT,FMT='(" PKER_RACCSS(",I3,",",I3,") = ",E13.6)') &
+ J1,J2,XKER_RACCSS(J1,J2)
+ END DO
+ END DO
+ WRITE(UNIT=KLUOUT,FMT='("END IF")')
+ WRITE(UNIT=KLUOUT,FMT='("!")')
+ WRITE(UNIT=KLUOUT,FMT='("IF( PRESENT(PKER_RACCS ) ) THEN")')
+ DO J1 = 1 , NACCLBDAS
+ DO J2 = 1 , NACCLBDAR
+ WRITE(UNIT=KLUOUT,FMT='(" PKER_RACCS (",I3,",",I3,") = ",E13.6)') &
+ J1,J2,XKER_RACCS (J1,J2)
+ END DO
+ END DO
+ WRITE(UNIT=KLUOUT,FMT='("END IF")')
+ WRITE(UNIT=KLUOUT,FMT='("!")')
+ WRITE(UNIT=KLUOUT,FMT='("IF( PRESENT(PKER_SACCRG) ) THEN")')
+ DO J1 = 1 , NACCLBDAR
+ DO J2 = 1 , NACCLBDAS
+ WRITE(UNIT=KLUOUT,FMT='(" PKER_SACCRG(",I3,",",I3,") = ",E13.6)') &
+ J1,J2,XKER_SACCRG(J1,J2)
+ END DO
+ END DO
+ WRITE(UNIT=KLUOUT,FMT='("END IF")')
+ ELSE
+ CALL READ_XKER_RACCS (KACCLBDAS,KACCLBDAR,KND, &
+ PALPHAS,PNUS,PALPHAR,PNUR,PESR,PBS,PBR,PCS,PDS,PCR,PDR, &
+ PACCLBDAS_MAX,PACCLBDAR_MAX,PACCLBDAS_MIN,PACCLBDAR_MIN,&
+ PFDINFTY,XKER_RACCSS,XKER_RACCS,XKER_SACCRG )
+ WRITE(UNIT=KLUOUT,FMT='(" Read XKER_RACCSS")')
+ WRITE(UNIT=KLUOUT,FMT='(" Read XKER_RACCS ")')
+ WRITE(UNIT=KLUOUT,FMT='(" Read XKER_SACCRG")')
+END IF
+!
+!* 7.3 Constant for the conversion-melting rate
+!
+XFSCVMG = 2.0
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=KLUOUT,FMT='(" conversion-melting of the aggregates")')
+ WRITE(UNIT=KLUOUT,FMT='(" Conv. factor XFSCVMG=",E13.6)') XFSCVMG
+END IF
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 8. CONSTANTS FOR THE FAST COLD PROCESSES FOR THE GRAUPELN
+! ------------------------------------------------------
+!
+!
+!* 8.1 Constants for the rain contact freezing
+!
+XCOLIR = 1.0
+!
+XEXRCFRI = -XDR-5.0+ZXR
+XRCFRI = ((XPI**2)/24.0)*XCCR*XRHOLW*XCOLIR*XCR*(ZRHO00**XCEXVT) &
+ *MOMG(XALPHAR,XNUR,XDR+5.0)
+XEXICFRR = -XDR-2.0+ZXR
+XICFRR = (XPI/4.0)*XCOLIR*XCR*(ZRHO00**XCEXVT) &
+ *XCCR*MOMG(XALPHAR,XNUR,XDR+2.0)
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=KLUOUT,FMT='(" rain contact freezing")')
+ WRITE(UNIT=KLUOUT,FMT='(" Coll. efficiency XCOLIR=",E13.6)') XCOLIR
+END IF
+!
+!
+!* 8.2 Constants for the dry growth of the graupeln
+!
+!* 8.2.1 Constants for the cloud droplet collection by the graupeln
+!
+XFCDRYG = (XPI/4.0)*XCCG*XCG*(ZRHO00**XCEXVT)*MOMG(XALPHAG,XNUG,XDG+2.0)
+!
+!* 8.2.2 Constants for the cloud ice collection by the graupeln
+!
+XCOLIG = 0.25 ! Collection efficiency of I+G
+XCOLEXIG = 0.05 ! Temperature factor of the I+G collection efficiency
+XCOLIG = 0.01 ! Collection efficiency of I+G
+XCOLEXIG = 0.1 ! Temperature factor of the I+G collection efficiency
+WRITE (KLUOUT, FMT=*) ' NEW Constants for the cloud ice collection by the graupeln'
+WRITE (KLUOUT, FMT=*) ' XCOLIG, XCOLEXIG = ',XCOLIG,XCOLEXIG
+XFIDRYG = (XPI/4.0)*XCOLIG*XCCG*XCG*(ZRHO00**XCEXVT)*MOMG(XALPHAG,XNUG,XDG+2.0)
+XEXFIDRYG=(XCXG-XDG-2.)/(XCXG-XBG)
+XFIDRYG2=XFIDRYG/XCOLIG*(XAG*XCCG*MOMG(XALPHAG,XNUG,XBG))**(-XEXFIDRYG)
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=KLUOUT,FMT='(" cloud ice collection by the graupeln")')
+ WRITE(UNIT=KLUOUT,FMT='(" Coll. efficiency XCOLIG=",E13.6)') XCOLIG
+ WRITE(UNIT=KLUOUT,FMT='(" Temp. factor XCOLEXIG=",E13.6)') XCOLEXIG
+END IF
+!
+!* 8.2.3 Constants for the aggregate collection by the graupeln
+!
+XCOLSG = 0.25 ! Collection efficiency of S+G
+XCOLEXSG = 0.05 ! Temperature factor of the S+G collection efficiency
+XCOLSG = 0.01 ! Collection efficiency of S+G
+XCOLEXSG = 0.1 ! Temperature factor of the S+G collection efficiency
+WRITE (KLUOUT, FMT=*) ' NEW Constants for the aggregate collection by the graupeln'
+WRITE (KLUOUT, FMT=*) ' XCOLSG, XCOLEXSG = ',XCOLSG,XCOLEXSG
+XFSDRYG = (XPI/4.0)*XCOLSG*XCCG*XCCS*XAS*(ZRHO00**XCEXVT)
+!
+XLBSDRYG1 = MOMG(XALPHAG,XNUG,2.)*MOMG(XALPHAS,XNUS,XBS)
+XLBSDRYG2 = 2.*MOMG(XALPHAG,XNUG,1.)*MOMG(XALPHAS,XNUS,XBS+1.)
+XLBSDRYG3 = MOMG(XALPHAS,XNUS,XBS+2.)
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=KLUOUT,FMT='(" aggregate collection by the graupeln")')
+ WRITE(UNIT=KLUOUT,FMT='(" Coll. efficiency XCOLSG=",E13.6)') XCOLSG
+ WRITE(UNIT=KLUOUT,FMT='(" Temp. factor XCOLEXSG=",E13.6)') XCOLEXSG
+END IF
+!
+!* 8.2.4 Constants for the raindrop collection by the graupeln
+!
+XFRDRYG = ((XPI**2)/24.0)*XCCG*XCCR*XRHOLW*(ZRHO00**XCEXVT)
+!
+XLBRDRYG1 = MOMG(XALPHAG,XNUG,2.)*MOMG(XALPHAR,XNUR,3.)
+XLBRDRYG2 = 2.*MOMG(XALPHAG,XNUG,1.)*MOMG(XALPHAR,XNUR,4.)
+XLBRDRYG3 = MOMG(XALPHAR,XNUR,5.)
+!
+! Notice: One magnitude of lambda discretized over 10 points
+!
+NDRYLBDAR = 40
+XDRYLBDAR_MIN = 1.0E3 ! Minimal value of Lbda_r to tabulate XKER_RDRYG
+XDRYLBDAR_MAX = 1.0E7 ! Maximal value of Lbda_r to tabulate XKER_RDRYG
+ZRATE = LOG(XDRYLBDAR_MAX/XDRYLBDAR_MIN)/REAL(NDRYLBDAR-1)
+XDRYINTP1R = 1.0 / ZRATE
+XDRYINTP2R = 1.0 - LOG( XDRYLBDAR_MIN ) / ZRATE
+NDRYLBDAS = 80
+XDRYLBDAS_MIN = 2.5E1 ! Minimal value of Lbda_s to tabulate XKER_SDRYG
+XDRYLBDAS_MAX = 2.5E9 ! Maximal value of Lbda_s to tabulate XKER_SDRYG
+ZRATE = LOG(XDRYLBDAS_MAX/XDRYLBDAS_MIN)/REAL(NDRYLBDAS-1)
+XDRYINTP1S = 1.0 / ZRATE
+XDRYINTP2S = 1.0 - LOG( XDRYLBDAS_MIN ) / ZRATE
+NDRYLBDAG = 40
+XDRYLBDAG_MIN = 1.0E3 ! Min value of Lbda_g to tabulate XKER_SDRYG,XKER_RDRYG
+XDRYLBDAG_MAX = 1.0E7 ! Max value of Lbda_g to tabulate XKER_SDRYG,XKER_RDRYG
+ZRATE = LOG(XDRYLBDAG_MAX/XDRYLBDAG_MIN)/REAL(NDRYLBDAG-1)
+XDRYINTP1G = 1.0 / ZRATE
+XDRYINTP2G = 1.0 - LOG( XDRYLBDAG_MIN ) / ZRATE
+!
+!* 8.2.5 Computations of the tabulated normalized kernels
+!
+IND = 50 ! Interval number, collection efficiency and infinite diameter
+ZEGS = 1.0 ! factor used to integrate the dimensional distributions when
+ZFDINFTY = 20.0 ! computing the kernels XKER_SDRYG
+!
+IF( .NOT.ALLOCATED(XKER_SDRYG) ) ALLOCATE( XKER_SDRYG(NDRYLBDAG,NDRYLBDAS) )
+!
+CALL READ_XKER_SDRYG (KDRYLBDAG,KDRYLBDAS,KND, &
+ PALPHAG,PNUG,PALPHAS,PNUS,PEGS,PBS,PCG,PDG,PCS,PDS, &
+ PDRYLBDAG_MAX,PDRYLBDAS_MAX,PDRYLBDAG_MIN,PDRYLBDAS_MIN, &
+ PFDINFTY )
+IF( (KDRYLBDAG/=NDRYLBDAG) .OR. (KDRYLBDAS/=NDRYLBDAS) .OR. (KND/=IND) .OR. &
+ (PALPHAG/=XALPHAG) .OR. (PNUG/=XNUG) .OR. &
+ (PALPHAS/=XALPHAS) .OR. (PNUS/=XNUS) .OR. &
+ (PEGS/=ZEGS) .OR. (PBS/=XBS) .OR. &
+ (PCG/=XCG) .OR. (PDG/=XDG) .OR. (PCS/=XCS) .OR. (PDS/=XDS) .OR. &
+ (PDRYLBDAG_MAX/=XDRYLBDAG_MAX) .OR. (PDRYLBDAS_MAX/=XDRYLBDAS_MAX) .OR. &
+ (PDRYLBDAG_MIN/=XDRYLBDAG_MIN) .OR. (PDRYLBDAS_MIN/=XDRYLBDAS_MIN) .OR. &
+ (PFDINFTY/=ZFDINFTY) ) THEN
+ CALL RZCOLX ( IND, XALPHAG, XNUG, XALPHAS, XNUS, &
+ ZEGS, XBS, XCG, XDG, XCS, XDS, &
+ XDRYLBDAG_MAX, XDRYLBDAS_MAX, XDRYLBDAG_MIN, XDRYLBDAS_MIN, &
+ ZFDINFTY, XKER_SDRYG )
+ WRITE(UNIT=KLUOUT,FMT='("*****************************************")')
+ WRITE(UNIT=KLUOUT,FMT='("**** UPDATE NEW SET OF SDRYG KERNELS ****")')
+ WRITE(UNIT=KLUOUT,FMT='("*****************************************")')
+ WRITE(UNIT=KLUOUT,FMT='("!")')
+ WRITE(UNIT=KLUOUT,FMT='("KND=",I3)') IND
+ WRITE(UNIT=KLUOUT,FMT='("KDRYLBDAG=",I3)') NDRYLBDAG
+ WRITE(UNIT=KLUOUT,FMT='("KDRYLBDAS=",I3)') NDRYLBDAS
+ WRITE(UNIT=KLUOUT,FMT='("PALPHAG=",E13.6)') XALPHAG
+ WRITE(UNIT=KLUOUT,FMT='("PNUG=",E13.6)') XNUG
+ WRITE(UNIT=KLUOUT,FMT='("PALPHAS=",E13.6)') XALPHAS
+ WRITE(UNIT=KLUOUT,FMT='("PNUS=",E13.6)') XNUS
+ WRITE(UNIT=KLUOUT,FMT='("PEGS=",E13.6)') ZEGS
+ WRITE(UNIT=KLUOUT,FMT='("PBS=",E13.6)') XBS
+ WRITE(UNIT=KLUOUT,FMT='("PCG=",E13.6)') XCG
+ WRITE(UNIT=KLUOUT,FMT='("PDG=",E13.6)') XDG
+ WRITE(UNIT=KLUOUT,FMT='("PCS=",E13.6)') XCS
+ WRITE(UNIT=KLUOUT,FMT='("PDS=",E13.6)') XDS
+ WRITE(UNIT=KLUOUT,FMT='("PDRYLBDAG_MAX=",E13.6)') &
+ XDRYLBDAG_MAX
+ WRITE(UNIT=KLUOUT,FMT='("PDRYLBDAS_MAX=",E13.6)') &
+ XDRYLBDAS_MAX
+ WRITE(UNIT=KLUOUT,FMT='("PDRYLBDAG_MIN=",E13.6)') &
+ XDRYLBDAG_MIN
+ WRITE(UNIT=KLUOUT,FMT='("PDRYLBDAS_MIN=",E13.6)') &
+ XDRYLBDAS_MIN
+ WRITE(UNIT=KLUOUT,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
+ WRITE(UNIT=KLUOUT,FMT='("!")')
+ WRITE(UNIT=KLUOUT,FMT='("IF( PRESENT(PKER_SDRYG) ) THEN")')
+ DO J1 = 1 , NDRYLBDAG
+ DO J2 = 1 , NDRYLBDAS
+ WRITE(UNIT=KLUOUT,FMT='("PKER_SDRYG(",I3,",",I3,") = ",E13.6)') &
+ J1,J2,XKER_SDRYG(J1,J2)
+ END DO
+ END DO
+ WRITE(UNIT=KLUOUT,FMT='("END IF")')
+ ELSE
+ CALL READ_XKER_SDRYG (KDRYLBDAG,KDRYLBDAS,KND, &
+ PALPHAG,PNUG,PALPHAS,PNUS,PEGS,PBS,PCG,PDG,PCS,PDS, &
+ PDRYLBDAG_MAX,PDRYLBDAS_MAX,PDRYLBDAG_MIN,PDRYLBDAS_MIN, &
+ PFDINFTY,XKER_SDRYG )
+ WRITE(UNIT=KLUOUT,FMT='(" Read XKER_SDRYG")')
+END IF
+!
+!
+IND = 50 ! Number of interval used to integrate the dimensional
+ZEGR = 1.0 ! distributions when computing the kernel XKER_RDRYG
+ZFDINFTY = 20.0
+!
+IF( .NOT.ALLOCATED(XKER_RDRYG) ) ALLOCATE( XKER_RDRYG(NDRYLBDAG,NDRYLBDAR) )
+!
+CALL READ_XKER_RDRYG (KDRYLBDAG,KDRYLBDAR,KND, &
+ PALPHAG,PNUG,PALPHAR,PNUR,PEGR,PBR,PCG,PDG,PCR,PDR, &
+ PDRYLBDAG_MAX,PDRYLBDAR_MAX,PDRYLBDAG_MIN,PDRYLBDAR_MIN, &
+ PFDINFTY )
+IF( (KDRYLBDAG/=NDRYLBDAG) .OR. (KDRYLBDAR/=NDRYLBDAR) .OR. (KND/=IND) .OR. &
+ (PALPHAG/=XALPHAG) .OR. (PNUG/=XNUG) .OR. &
+ (PALPHAR/=XALPHAR) .OR. (PNUR/=XNUR) .OR. &
+ (PEGR/=ZEGR) .OR. (PBR/=XBR) .OR. &
+ (PCG/=XCG) .OR. (PDG/=XDG) .OR. (PCR/=XCR) .OR. (PDR/=XDR) .OR. &
+ (PDRYLBDAG_MAX/=XDRYLBDAG_MAX) .OR. (PDRYLBDAR_MAX/=XDRYLBDAR_MAX) .OR. &
+ (PDRYLBDAG_MIN/=XDRYLBDAG_MIN) .OR. (PDRYLBDAR_MIN/=XDRYLBDAR_MIN) .OR. &
+ (PFDINFTY/=ZFDINFTY) ) THEN
+ CALL RZCOLX ( IND, XALPHAG, XNUG, XALPHAR, XNUR, &
+ ZEGR, XBR, XCG, XDG, XCR, XDR, &
+ XDRYLBDAG_MAX, XDRYLBDAR_MAX, XDRYLBDAG_MIN, XDRYLBDAR_MIN, &
+ ZFDINFTY, XKER_RDRYG )
+ WRITE(UNIT=KLUOUT,FMT='("*****************************************")')
+ WRITE(UNIT=KLUOUT,FMT='("**** UPDATE NEW SET OF RDRYG KERNELS ****")')
+ WRITE(UNIT=KLUOUT,FMT='("*****************************************")')
+ WRITE(UNIT=KLUOUT,FMT='("!")')
+ WRITE(UNIT=KLUOUT,FMT='("KND=",I3)') IND
+ WRITE(UNIT=KLUOUT,FMT='("KDRYLBDAG=",I3)') NDRYLBDAG
+ WRITE(UNIT=KLUOUT,FMT='("KDRYLBDAR=",I3)') NDRYLBDAR
+ WRITE(UNIT=KLUOUT,FMT='("PALPHAG=",E13.6)') XALPHAG
+ WRITE(UNIT=KLUOUT,FMT='("PNUG=",E13.6)') XNUG
+ WRITE(UNIT=KLUOUT,FMT='("PALPHAR=",E13.6)') XALPHAR
+ WRITE(UNIT=KLUOUT,FMT='("PNUR=",E13.6)') XNUR
+ WRITE(UNIT=KLUOUT,FMT='("PEGR=",E13.6)') ZEGR
+ WRITE(UNIT=KLUOUT,FMT='("PBR=",E13.6)') XBR
+ WRITE(UNIT=KLUOUT,FMT='("PCG=",E13.6)') XCG
+ WRITE(UNIT=KLUOUT,FMT='("PDG=",E13.6)') XDG
+ WRITE(UNIT=KLUOUT,FMT='("PCR=",E13.6)') XCR
+ WRITE(UNIT=KLUOUT,FMT='("PDR=",E13.6)') XDR
+ WRITE(UNIT=KLUOUT,FMT='("PDRYLBDAG_MAX=",E13.6)') &
+ XDRYLBDAG_MAX
+ WRITE(UNIT=KLUOUT,FMT='("PDRYLBDAR_MAX=",E13.6)') &
+ XDRYLBDAR_MAX
+ WRITE(UNIT=KLUOUT,FMT='("PDRYLBDAG_MIN=",E13.6)') &
+ XDRYLBDAG_MIN
+ WRITE(UNIT=KLUOUT,FMT='("PDRYLBDAR_MIN=",E13.6)') &
+ XDRYLBDAR_MIN
+ WRITE(UNIT=KLUOUT,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
+ WRITE(UNIT=KLUOUT,FMT='("!")')
+ WRITE(UNIT=KLUOUT,FMT='("IF( PRESENT(PKER_RDRYG) ) THEN")')
+ DO J1 = 1 , NDRYLBDAG
+ DO J2 = 1 , NDRYLBDAR
+ WRITE(UNIT=KLUOUT,FMT='("PKER_RDRYG(",I3,",",I3,") = ",E13.6)') &
+ J1,J2,XKER_RDRYG(J1,J2)
+ END DO
+ END DO
+ WRITE(UNIT=KLUOUT,FMT='("END IF")')
+ ELSE
+ CALL READ_XKER_RDRYG (KDRYLBDAG,KDRYLBDAR,KND, &
+ PALPHAG,PNUG,PALPHAR,PNUR,PEGR,PBR,PCG,PDG,PCR,PDR, &
+ PDRYLBDAG_MAX,PDRYLBDAR_MAX,PDRYLBDAG_MIN,PDRYLBDAR_MIN, &
+ PFDINFTY,XKER_RDRYG )
+ WRITE(UNIT=KLUOUT,FMT='(" Read XKER_RDRYG")')
+END IF
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 9. CONSTANTS FOR THE FAST COLD PROCESSES FOR THE HAILSTONES
+! --------------------------------------------------------
+!
+!* 9.2 Constants for the wet growth of the hailstones
+!
+!
+!* 9.2.1 Constant for the cloud droplet and cloud ice collection
+! by the hailstones
+!
+XCOLIH = 0.01 ! Collection efficiency of I+H
+XCOLEXIH = 0.1 ! Temperature factor of the I+H collection efficiency
+XFWETH = (XPI/4.0)*XCCH*XCH*(ZRHO00**XCEXVT)*MOMG(XALPHAH,XNUH,XDH+2.0)
+!
+!* 9.2.2 Constants for the aggregate collection by the hailstones
+!
+XCOLSH = 0.01 ! Collection efficiency of S+H
+XCOLEXSH = 0.1 ! Temperature factor of the S+H collection efficiency
+XFSWETH = (XPI/4.0)*XCCH*XCCS*XAS*(ZRHO00**XCEXVT)
+!
+XLBSWETH1 = MOMG(XALPHAH,XNUH,2.)*MOMG(XALPHAS,XNUS,XBS)
+XLBSWETH2 = 2.*MOMG(XALPHAH,XNUH,1.)*MOMG(XALPHAS,XNUS,XBS+1.)
+XLBSWETH3 = MOMG(XALPHAS,XNUS,XBS+2.)
+!
+!* 9.2.3 Constants for the graupel collection by the hailstones
+!
+XCOLGH = 0.01 ! Collection efficiency of G+H
+XCOLEXGH = 0.1 ! Temperature factor of the G+H collection efficiency
+XFGWETH = (XPI/4.0)*XCCH*XCCG*XAG*(ZRHO00**XCEXVT)
+!
+XLBGWETH1 = MOMG(XALPHAH,XNUH,2.)*MOMG(XALPHAG,XNUG,XBG)
+XLBGWETH2 = 2.*MOMG(XALPHAH,XNUH,1.)*MOMG(XALPHAG,XNUG,XBG+1.)
+XLBGWETH3 = MOMG(XALPHAG,XNUG,XBG+2.)
+!
+!* 9.2.3 bis Constants for the rain collection by the hailstones
+!
+XFRWETH = (XPI/4.0)*XCCH*XCCR*XAR*(ZRHO00**XCEXVT)
+!
+XLBRWETH1 = MOMG(XALPHAH,XNUH,2.)*MOMG(XALPHAR,XNUR,XBR)
+XLBRWETH2 = 2.*MOMG(XALPHAH,XNUH,1.)*MOMG(XALPHAR,XNUR,XBR+1.)
+XLBRWETH3 = MOMG(XALPHAR,XNUR,XBR+2.)
+!
+! Notice: One magnitude of lambda discretized over 10 points
+!
+NWETLBDAS = 80
+XWETLBDAS_MIN = 2.5E1 ! Minimal value of Lbda_s to tabulate XKER_SWETH
+XWETLBDAS_MAX = 2.5E9 ! Maximal value of Lbda_s to tabulate XKER_SWETH
+ZRATE = LOG(XWETLBDAS_MAX/XWETLBDAS_MIN)/REAL(NWETLBDAS-1)
+XWETINTP1S = 1.0 / ZRATE
+XWETINTP2S = 1.0 - LOG( XWETLBDAS_MIN ) / ZRATE
+NWETLBDAG = 40
+XWETLBDAG_MIN = 1.0E3 ! Min value of Lbda_g to tabulate XKER_GWETH
+XWETLBDAG_MAX = 1.0E7 ! Max value of Lbda_g to tabulate XKER_GWETH
+ZRATE = LOG(XWETLBDAG_MAX/XWETLBDAG_MIN)/REAL(NWETLBDAG-1)
+XWETINTP1G = 1.0 / ZRATE
+XWETINTP2G = 1.0 - LOG( XWETLBDAG_MIN ) / ZRATE
+NWETLBDAR = 40
+XWETLBDAR_MIN = 1.0E3 ! Minimal value of Lbda_r to tabulate XKER_RWETH
+XWETLBDAR_MAX = 1.0E7 ! Maximal value of Lbda_r to tabulate XKER_RWETH
+ZRATE = LOG(XWETLBDAR_MAX/XWETLBDAR_MIN)/REAL(NWETLBDAR-1)
+XWETINTP1R = 1.0 / ZRATE
+XWETINTP2R = 1.0 - LOG( XWETLBDAR_MIN ) / ZRATE
+NWETLBDAH = 40
+XWETLBDAH_MIN = 1.0E3 ! Min value of Lbda_h to tabulate XKER_SWETH,XKER_GWETH,XKER_RWETH
+XWETLBDAH_MAX = 1.0E7 ! Max value of Lbda_h to tabulate XKER_SWETH,XKER_GWETH,XKER_RWETH
+ZRATE = LOG(XWETLBDAH_MAX/XWETLBDAH_MIN)/REAL(NWETLBDAH-1)
+XWETINTP1H = 1.0 / ZRATE
+XWETINTP2H = 1.0 - LOG( XWETLBDAH_MIN ) / ZRATE
+!
+!* 9.2.4 Computations of the tabulated normalized kernels
+!
+IND = 50 ! Interval number, collection efficiency and infinite diameter
+ZEHS = 1.0 ! factor used to integrate the dimensional distributions when
+ZFDINFTY = 20.0 ! computing the kernels XKER_SWETH
+!
+IF( .NOT.ALLOCATED(XKER_SWETH) ) ALLOCATE( XKER_SWETH(NWETLBDAH,NWETLBDAS) )
+!
+CALL READ_XKER_SWETH (KWETLBDAH,KWETLBDAS,KND, &
+ PALPHAH,PNUH,PALPHAS,PNUS,PEHS,PBS,PCH,PDH,PCS,PDS, &
+ PWETLBDAH_MAX,PWETLBDAS_MAX,PWETLBDAH_MIN,PWETLBDAS_MIN, &
+ PFDINFTY )
+IF( (KWETLBDAH/=NWETLBDAH) .OR. (KWETLBDAS/=NWETLBDAS) .OR. (KND/=IND) .OR. &
+ (PALPHAH/=XALPHAH) .OR. (PNUH/=XNUH) .OR. &
+ (PALPHAS/=XALPHAS) .OR. (PNUS/=XNUS) .OR. &
+ (PEHS/=ZEHS) .OR. (PBS/=XBS) .OR. &
+ (PCH/=XCH) .OR. (PDH/=XDH) .OR. (PCS/=XCS) .OR. (PDS/=XDS) .OR. &
+ (PWETLBDAH_MAX/=XWETLBDAH_MAX) .OR. (PWETLBDAS_MAX/=XWETLBDAS_MAX) .OR. &
+ (PWETLBDAH_MIN/=XWETLBDAH_MIN) .OR. (PWETLBDAS_MIN/=XWETLBDAS_MIN) .OR. &
+ (PFDINFTY/=ZFDINFTY) ) THEN
+ CALL RZCOLX ( IND, XALPHAH, XNUH, XALPHAS, XNUS, &
+ ZEHS, XBS, XCH, XDH, XCS, XDS, &
+ XWETLBDAH_MAX, XWETLBDAS_MAX, XWETLBDAH_MIN, XWETLBDAS_MIN, &
+ ZFDINFTY, XKER_SWETH )
+ WRITE(UNIT=KLUOUT,FMT='("*****************************************")')
+ WRITE(UNIT=KLUOUT,FMT='("**** UPDATE NEW SET OF SWETH KERNELS ****")')
+ WRITE(UNIT=KLUOUT,FMT='("*****************************************")')
+ WRITE(UNIT=KLUOUT,FMT='("!")')
+ WRITE(UNIT=KLUOUT,FMT='("KND=",I3)') IND
+ WRITE(UNIT=KLUOUT,FMT='("KWETLBDAH=",I3)') NWETLBDAH
+ WRITE(UNIT=KLUOUT,FMT='("KWETLBDAS=",I3)') NWETLBDAS
+ WRITE(UNIT=KLUOUT,FMT='("PALPHAH=",E13.6)') XALPHAH
+ WRITE(UNIT=KLUOUT,FMT='("PNUH=",E13.6)') XNUH
+ WRITE(UNIT=KLUOUT,FMT='("PALPHAS=",E13.6)') XALPHAS
+ WRITE(UNIT=KLUOUT,FMT='("PNUS=",E13.6)') XNUS
+ WRITE(UNIT=KLUOUT,FMT='("PEHS=",E13.6)') ZEHS
+ WRITE(UNIT=KLUOUT,FMT='("PBS=",E13.6)') XBS
+ WRITE(UNIT=KLUOUT,FMT='("PCH=",E13.6)') XCH
+ WRITE(UNIT=KLUOUT,FMT='("PDH=",E13.6)') XDH
+ WRITE(UNIT=KLUOUT,FMT='("PCS=",E13.6)') XCS
+ WRITE(UNIT=KLUOUT,FMT='("PDS=",E13.6)') XDS
+ WRITE(UNIT=KLUOUT,FMT='("PWETLBDAH_MAX=",E13.6)') &
+ XWETLBDAH_MAX
+ WRITE(UNIT=KLUOUT,FMT='("PWETLBDAS_MAX=",E13.6)') &
+ XWETLBDAS_MAX
+ WRITE(UNIT=KLUOUT,FMT='("PWETLBDAH_MIN=",E13.6)') &
+ XWETLBDAH_MIN
+ WRITE(UNIT=KLUOUT,FMT='("PWETLBDAS_MIN=",E13.6)') &
+ XWETLBDAS_MIN
+ WRITE(UNIT=KLUOUT,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
+ WRITE(UNIT=KLUOUT,FMT='("!")')
+ WRITE(UNIT=KLUOUT,FMT='("IF( PRESENT(PKER_SWETH) ) THEN")')
+ DO J1 = 1 , NWETLBDAH
+ DO J2 = 1 , NWETLBDAS
+ WRITE(UNIT=KLUOUT,FMT='("PKER_SWETH(",I3,",",I3,") = ",E13.6)') &
+ J1,J2,XKER_SWETH(J1,J2)
+ END DO
+ END DO
+ WRITE(UNIT=KLUOUT,FMT='("END IF")')
+ ELSE
+ CALL READ_XKER_SWETH (KWETLBDAH,KWETLBDAS,KND, &
+ PALPHAH,PNUH,PALPHAS,PNUS,PEHS,PBS,PCH,PDH,PCS,PDS, &
+ PWETLBDAH_MAX,PWETLBDAS_MAX,PWETLBDAH_MIN,PWETLBDAS_MIN, &
+ PFDINFTY,XKER_SWETH )
+ WRITE(UNIT=KLUOUT,FMT='(" Read XKER_SWETH")')
+END IF
+!
+!
+IND = 50 ! Number of interval used to integrate the dimensional
+ZEHG = 1.0 ! distributions when computing the kernel XKER_GWETH
+ZFDINFTY = 20.0
+!
+IF( .NOT.ALLOCATED(XKER_GWETH) ) ALLOCATE( XKER_GWETH(NWETLBDAH,NWETLBDAG) )
+!
+CALL READ_XKER_GWETH (KWETLBDAH,KWETLBDAG,KND, &
+ PALPHAH,PNUH,PALPHAG,PNUG,PEHG,PBG,PCH,PDH,PCG,PDG, &
+ PWETLBDAH_MAX,PWETLBDAG_MAX,PWETLBDAH_MIN,PWETLBDAG_MIN, &
+ PFDINFTY )
+IF( (KWETLBDAH/=NWETLBDAH) .OR. (KWETLBDAG/=NWETLBDAG) .OR. (KND/=IND) .OR. &
+ (PALPHAH/=XALPHAH) .OR. (PNUH/=XNUH) .OR. &
+ (PALPHAG/=XALPHAG) .OR. (PNUG/=XNUG) .OR. &
+ (PEHG/=ZEHG) .OR. (PBG/=XBG) .OR. &
+ (PCH/=XCH) .OR. (PDH/=XDH) .OR. (PCG/=XCG) .OR. (PDG/=XDG) .OR. &
+ (PWETLBDAH_MAX/=XWETLBDAH_MAX) .OR. (PWETLBDAG_MAX/=XWETLBDAG_MAX) .OR. &
+ (PWETLBDAH_MIN/=XWETLBDAH_MIN) .OR. (PWETLBDAG_MIN/=XWETLBDAG_MIN) .OR. &
+ (PFDINFTY/=ZFDINFTY) ) THEN
+ CALL RZCOLX ( IND, XALPHAH, XNUH, XALPHAG, XNUG, &
+ ZEHG, XBG, XCH, XDH, XCG, XDG, &
+ XWETLBDAH_MAX, XWETLBDAG_MAX, XWETLBDAH_MIN, XWETLBDAG_MIN, &
+ ZFDINFTY, XKER_GWETH )
+ WRITE(UNIT=KLUOUT,FMT='("*****************************************")')
+ WRITE(UNIT=KLUOUT,FMT='("**** UPDATE NEW SET OF GWETH KERNELS ****")')
+ WRITE(UNIT=KLUOUT,FMT='("*****************************************")')
+ WRITE(UNIT=KLUOUT,FMT='("!")')
+ WRITE(UNIT=KLUOUT,FMT='("KND=",I3)') IND
+ WRITE(UNIT=KLUOUT,FMT='("KWETLBDAH=",I3)') NWETLBDAH
+ WRITE(UNIT=KLUOUT,FMT='("KWETLBDAG=",I3)') NWETLBDAG
+ WRITE(UNIT=KLUOUT,FMT='("PALPHAH=",E13.6)') XALPHAH
+ WRITE(UNIT=KLUOUT,FMT='("PNUH=",E13.6)') XNUH
+ WRITE(UNIT=KLUOUT,FMT='("PALPHAG=",E13.6)') XALPHAG
+ WRITE(UNIT=KLUOUT,FMT='("PNUG=",E13.6)') XNUG
+ WRITE(UNIT=KLUOUT,FMT='("PEHG=",E13.6)') ZEHG
+ WRITE(UNIT=KLUOUT,FMT='("PBG=",E13.6)') XBG
+ WRITE(UNIT=KLUOUT,FMT='("PCH=",E13.6)') XCH
+ WRITE(UNIT=KLUOUT,FMT='("PDH=",E13.6)') XDH
+ WRITE(UNIT=KLUOUT,FMT='("PCG=",E13.6)') XCG
+ WRITE(UNIT=KLUOUT,FMT='("PDG=",E13.6)') XDG
+ WRITE(UNIT=KLUOUT,FMT='("PWETLBDAH_MAX=",E13.6)') &
+ XWETLBDAH_MAX
+ WRITE(UNIT=KLUOUT,FMT='("PWETLBDAG_MAX=",E13.6)') &
+ XWETLBDAG_MAX
+ WRITE(UNIT=KLUOUT,FMT='("PWETLBDAH_MIN=",E13.6)') &
+ XWETLBDAH_MIN
+ WRITE(UNIT=KLUOUT,FMT='("PWETLBDAG_MIN=",E13.6)') &
+ XWETLBDAG_MIN
+ WRITE(UNIT=KLUOUT,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
+ WRITE(UNIT=KLUOUT,FMT='("!")')
+ WRITE(UNIT=KLUOUT,FMT='("IF( PRESENT(PKER_GWETH) ) THEN")')
+ DO J1 = 1 , NWETLBDAH
+ DO J2 = 1 , NWETLBDAG
+ WRITE(UNIT=KLUOUT,FMT='("PKER_GWETH(",I3,",",I3,") = ",E13.6)') &
+ J1,J2,XKER_GWETH(J1,J2)
+ END DO
+ END DO
+ WRITE(UNIT=KLUOUT,FMT='("END IF")')
+ ELSE
+ CALL READ_XKER_GWETH (KWETLBDAH,KWETLBDAG,KND, &
+ PALPHAH,PNUH,PALPHAG,PNUG,PEHG,PBG,PCH,PDH,PCG,PDG, &
+ PWETLBDAH_MAX,PWETLBDAG_MAX,PWETLBDAH_MIN,PWETLBDAG_MIN, &
+ PFDINFTY,XKER_GWETH )
+ WRITE(UNIT=KLUOUT,FMT='(" Read XKER_GWETH")')
+END IF
+!
+!
+IND = 50 ! Number of interval used to integrate the dimensional
+ZEHR = 1.0 ! distributions when computing the kernel XKER_RWETH
+ZFDINFTY = 20.0
+!
+IF( .NOT.ALLOCATED(XKER_RWETH) ) ALLOCATE( XKER_RWETH(NWETLBDAH,NWETLBDAR) )
+!
+CALL READ_XKER_RWETH (KWETLBDAH,KWETLBDAR,KND, &
+ PALPHAH,PNUH,PALPHAR,PNUR,PEHR,PBR,PCH,PDH,PCR,PDR, &
+ PWETLBDAH_MAX,PWETLBDAR_MAX,PWETLBDAH_MIN,PWETLBDAR_MIN, &
+ PFDINFTY )
+IF( (KWETLBDAH/=NWETLBDAH) .OR. (KWETLBDAR/=NWETLBDAR) .OR. (KND/=IND) .OR. &
+ (PALPHAH/=XALPHAH) .OR. (PNUH/=XNUH) .OR. &
+ (PALPHAR/=XALPHAR) .OR. (PNUR/=XNUR) .OR. &
+ (PEHR/=ZEHR) .OR. (PBR/=XBR) .OR. &
+ (PCH/=XCH) .OR. (PDH/=XDH) .OR. (PCR/=XCR) .OR. (PDR/=XDR) .OR. &
+ (PWETLBDAH_MAX/=XWETLBDAH_MAX) .OR. (PWETLBDAR_MAX/=XWETLBDAR_MAX) .OR. &
+ (PWETLBDAH_MIN/=XWETLBDAH_MIN) .OR. (PWETLBDAR_MIN/=XWETLBDAR_MIN) .OR. &
+ (PFDINFTY/=ZFDINFTY) ) THEN
+ CALL RZCOLX ( IND, XALPHAH, XNUH, XALPHAR, XNUR, &
+ ZEHR, XBR, XCH, XDH, XCR, XDR, &
+ XWETLBDAH_MAX, XWETLBDAR_MAX, XWETLBDAH_MIN, XWETLBDAR_MIN, &
+ ZFDINFTY, XKER_RWETH )
+ WRITE(UNIT=KLUOUT,FMT='("*****************************************")')
+ WRITE(UNIT=KLUOUT,FMT='("**** UPDATE NEW SET OF RWETH KERNELS ****")')
+ WRITE(UNIT=KLUOUT,FMT='("*****************************************")')
+ WRITE(UNIT=KLUOUT,FMT='("!")')
+ WRITE(UNIT=KLUOUT,FMT='("KND=",I3)') IND
+ WRITE(UNIT=KLUOUT,FMT='("KWETLBDAH=",I3)') NWETLBDAH
+ WRITE(UNIT=KLUOUT,FMT='("KWETLBDAR=",I3)') NWETLBDAR
+ WRITE(UNIT=KLUOUT,FMT='("PALPHAH=",E13.6)') XALPHAH
+ WRITE(UNIT=KLUOUT,FMT='("PNUH=",E13.6)') XNUH
+ WRITE(UNIT=KLUOUT,FMT='("PALPHAR=",E13.6)') XALPHAR
+ WRITE(UNIT=KLUOUT,FMT='("PNUR=",E13.6)') XNUR
+ WRITE(UNIT=KLUOUT,FMT='("PEHR=",E13.6)') ZEHR
+ WRITE(UNIT=KLUOUT,FMT='("PBR=",E13.6)') XBR
+ WRITE(UNIT=KLUOUT,FMT='("PCH=",E13.6)') XCH
+ WRITE(UNIT=KLUOUT,FMT='("PDH=",E13.6)') XDH
+ WRITE(UNIT=KLUOUT,FMT='("PCR=",E13.6)') XCR
+ WRITE(UNIT=KLUOUT,FMT='("PDR=",E13.6)') XDR
+ WRITE(UNIT=KLUOUT,FMT='("PWETLBDAH_MAX=",E13.6)') &
+ XWETLBDAH_MAX
+ WRITE(UNIT=KLUOUT,FMT='("PWETLBDAR_MAX=",E13.6)') &
+ XWETLBDAR_MAX
+ WRITE(UNIT=KLUOUT,FMT='("PWETLBDAH_MIN=",E13.6)') &
+ XWETLBDAH_MIN
+ WRITE(UNIT=KLUOUT,FMT='("PWETLBDAR_MIN=",E13.6)') &
+ XWETLBDAR_MIN
+ WRITE(UNIT=KLUOUT,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
+ WRITE(UNIT=KLUOUT,FMT='("!")')
+ WRITE(UNIT=KLUOUT,FMT='("IF( PRESENT(PKER_RWETH) ) THEN")')
+ DO J1 = 1 , NWETLBDAH
+ DO J2 = 1 , NWETLBDAR
+ WRITE(UNIT=KLUOUT,FMT='("PKER_RWETH(",I3,",",I3,") = ",E13.6)') &
+ J1,J2,XKER_RWETH(J1,J2)
+ END DO
+ END DO
+ WRITE(UNIT=KLUOUT,FMT='("END IF")')
+ ELSE
+ CALL READ_XKER_RWETH (KWETLBDAH,KWETLBDAR,KND, &
+ PALPHAH,PNUH,PALPHAR,PNUR,PEHR,PBR,PCH,PDH,PCR,PDR, &
+ PWETLBDAH_MAX,PWETLBDAR_MAX,PWETLBDAH_MIN,PWETLBDAR_MIN, &
+ PFDINFTY,XKER_RWETH )
+ WRITE(UNIT=KLUOUT,FMT='(" Read XKER_RWETH")')
+END IF
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 10. SOME PRINTS FOR CONTROL
+! -----------------------
+!
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=KLUOUT,FMT='(" Summary of the ice particule characteristics")')
+ WRITE(UNIT=KLUOUT,FMT='(" PRISTINE ICE")')
+ WRITE(UNIT=KLUOUT,FMT='(" masse: A=",E13.6," B=",E13.6)') &
+ XAI,XBI
+ WRITE(UNIT=KLUOUT,FMT='(" vitesse: C=",E13.6," D=",E13.6)') &
+ XC_I,XDI
+ WRITE(UNIT=KLUOUT,FMT='(" distribution:AL=",E13.6,"NU=",E13.6)') &
+ XALPHAI,XNUI
+ WRITE(UNIT=KLUOUT,FMT='(" SNOW")')
+ WRITE(UNIT=KLUOUT,FMT='(" masse: A=",E13.6," B=",E13.6)') &
+ XAS,XBS
+ WRITE(UNIT=KLUOUT,FMT='(" vitesse: C=",E13.6," D=",E13.6)') &
+ XCS,XDS
+ WRITE(UNIT=KLUOUT,FMT='(" concentration:CC=",E13.6," x=",E13.6)') &
+ XCCS,XCXS
+ WRITE(UNIT=KLUOUT,FMT='(" distribution:AL=",E13.6,"NU=",E13.6)') &
+ XALPHAS,XNUS
+ WRITE(UNIT=KLUOUT,FMT='(" GRAUPEL")')
+ WRITE(UNIT=KLUOUT,FMT='(" masse: A=",E13.6," B=",E13.6)') &
+ XAG,XBG
+ WRITE(UNIT=KLUOUT,FMT='(" vitesse: C=",E13.6," D=",E13.6)') &
+ XCG,XDG
+ WRITE(UNIT=KLUOUT,FMT='(" concentration:CC=",E13.6," x=",E13.6)') &
+ XCCG,XCXG
+ WRITE(UNIT=KLUOUT,FMT='(" distribution:AL=",E13.6,"NU=",E13.6)') &
+ XALPHAG,XNUG
+ WRITE(UNIT=KLUOUT,FMT='(" HAIL")')
+ WRITE(UNIT=KLUOUT,FMT='(" masse: A=",E13.6," B=",E13.6)') &
+ XAH,XBH
+ WRITE(UNIT=KLUOUT,FMT='(" vitesse: C=",E13.6," D=",E13.6)') &
+ XCH,XDH
+ WRITE(UNIT=KLUOUT,FMT='(" concentration:CC=",E13.6," x=",E13.6)') &
+ XCCH,XCXH
+ WRITE(UNIT=KLUOUT,FMT='(" distribution:AL=",E13.6,"NU=",E13.6)') &
+ XALPHAH,XNUH
+END IF
+CONTAINS
+!
+!------------------------------------------------------------------------------
+!
+ FUNCTION MOMG(PALPHA,PNU,PP) RESULT (PMOMG)
+!
+! auxiliary routine used to compute the Pth moment order of the generalized
+! gamma law
+!
+ USE MODI_GAMMA
+!
+ IMPLICIT NONE
+!
+ REAL :: PALPHA ! first shape parameter of the dimensionnal distribution
+ REAL :: PNU ! second shape parameter of the dimensionnal distribution
+ REAL :: PP ! order of the moment
+ REAL :: PMOMG ! result: moment of order ZP
+!
+!------------------------------------------------------------------------------
+!
+!
+ PMOMG = GAMMA(PNU+PP/PALPHA)/GAMMA(PNU)
+!
+ END FUNCTION MOMG
+!
+!-------------------------------------------------------------------------------
+!
+!
+END SUBROUTINE INI_RAIN_ICE
diff --git a/src/mesonh/micro/ini_rain_ice_elec.f90 b/src/mesonh/micro/ini_rain_ice_elec.f90
new file mode 100644
index 000000000..940caeaee
--- /dev/null
+++ b/src/mesonh/micro/ini_rain_ice_elec.f90
@@ -0,0 +1,1255 @@
+!MNH_LIC Copyright 2002-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! #############################
+ MODULE MODI_INI_RAIN_ICE_ELEC
+! #############################
+!
+INTERFACE
+ SUBROUTINE INI_RAIN_ICE_ELEC (KLUOUT, PTSTEP, PDZMIN, KSPLITR, HCLOUD, &
+ KINTVL, PFDINFTY )
+!
+INTEGER, INTENT(IN) :: KLUOUT ! Logical unit number for prints
+INTEGER, INTENT(OUT):: KSPLITR ! Number of small time step
+ ! integration for rain
+ ! sedimendation
+REAL, INTENT(IN) :: PTSTEP ! Effective Time step
+REAL, INTENT(IN) :: PDZMIN ! minimun vertical mesh size
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Indicator of the cloud scheme
+INTEGER, INTENT(INOUT) :: KINTVL ! Number of interval to integrate the kernels
+REAL, INTENT(INOUT) :: PFDINFTY ! Factor used to define the "infinite" diameter
+!
+END SUBROUTINE INI_RAIN_ICE_ELEC
+END INTERFACE
+END MODULE MODI_INI_RAIN_ICE_ELEC
+!
+! ########################################################################
+ SUBROUTINE INI_RAIN_ICE_ELEC (KLUOUT, PTSTEP, PDZMIN, KSPLITR, HCLOUD, &
+ KINTVL, PFDINFTY )
+! ########################################################################
+!
+!!**** *INI_RAIN_ICE_ELEC * - initialize the constants necessary for the warm and
+!! cold microphysical schemes,
+!! and for the electrical scheme
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to initialize the constants used to
+!! resolve the mixed phase microphysical scheme. The collection kernels of
+!! the precipitating particles are recomputed if necessary if some parameters
+!! defining the ice categories have been modified. The number of small
+!! time steps leading to stable scheme for the rain, ice, snow and ggraupeln
+!! sedimentation is also computed (time-splitting technique).
+!!
+!!** METHOD
+!! ------
+!! The constants are initialized to their numerical values and the number
+!! of small time step is computed by dividing the 2* Deltat time interval of
+!! the Leap-frog scheme so that the stability criterion for the rain
+!! sedimentation is fulfilled for a Raindrop maximal fall velocity equal
+!! VTRMAX. The parameters defining the collection kernels are read and are
+!! checked against the new ones. If any change occurs, these kernels are
+!! recomputed and their numerical values are written in the output listiing.
+!!
+!! EXTERNAL
+!! --------
+!! GAMMA : gamma function
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST
+!! XPI !
+!! XP00 ! Reference pressure
+!! XRD ! Gaz constant for dry air
+!! XRHOLW ! Liquid water density
+!! Module MODD_REF
+!! XTHVREFZ ! Reference virtual pot.temp. without orography
+!! Module MODD_PARAMETERS
+!! JPVEXT !
+!! Module MODD_RAIN_ICE_DESCR
+!! Module MODD_RAIN_ICE_PARAM
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation ( routine INI_RAIN_ICE )
+!!
+!! AUTHOR
+!! ------
+!!
+!! * Laboratoire d'Aerologie *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original: 2002
+!! Modifications:
+!! C. Barthe 20/11/09 update to version 4.8.1
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_LUNIT
+USE MODD_PARAMETERS
+USE MODD_PARAM_ICE
+USE MODD_RAIN_ICE_DESCR
+USE MODD_RAIN_ICE_PARAM
+USE MODD_REF
+USE MODD_ELEC_PARAM, ONLY : XGAMINC_RIM3, XFCI
+USE MODD_ELEC_DESCR, ONLY : XFS
+!
+USE MODI_MOMG
+USE MODI_GAMMA
+USE MODI_GAMMA_INC
+USE MODI_RRCOLSS
+USE MODI_RZCOLX
+USE MODI_RSCOLRG
+USE MODI_READ_XKER_RACCS
+USE MODI_READ_XKER_SDRYG
+USE MODI_READ_XKER_RDRYG
+USE MODI_READ_XKER_SWETH
+USE MODI_READ_XKER_GWETH
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KLUOUT ! Logical unit number for prints
+INTEGER, INTENT(OUT):: KSPLITR ! Number of small time step
+ ! integration for rain
+ ! sedimendation
+REAL, INTENT(IN) :: PTSTEP ! Effective Time step
+REAL, INTENT(IN) :: PDZMIN ! minimun vertical mesh size
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Indicator of the cloud scheme
+INTEGER, INTENT(INOUT) :: KINTVL ! Number of interval to integrate the kernels
+REAL, INTENT(INOUT) :: PFDINFTY ! Factor used to define the "infinite" diameter
+!
+!
+!* 0.2 Declarations of local variables :
+!
+REAL :: ZT ! Work variable
+REAL :: ZVTRMAX ! Raindrop maximal fall velocity
+REAL :: ZRHO00 ! Surface reference air density
+REAL :: ZRATE ! Geometrical growth of Lbda in the tabulated
+ ! functions and kernels
+REAL :: ZBOUND ! XDCSLIM*Lbda_s: upper bound for the partial
+ ! integration of the riming rate of the aggregates
+REAL :: ZEGS, ZEGR, ZEHS, ZEHG! Bulk collection efficiencies
+REAL :: ZALPHA, & ! Parameters to compute
+ ZNU, & ! the value of the p_moment
+ ZP ! of the generalized Gamma function
+REAL :: ZESR ! Mean efficiency of rain-aggregate collection
+REAL :: ZFDINFTY ! Factor used to define the "infinite" diameter
+REAL :: ZCONC_MAX ! Maximal concentration for snow
+REAL :: ZGAMC, ZGAMC2 ! parameters involving various moments of the generalized gamma law
+REAL :: ZFACT_NUCL ! Amplification factor for the minimal ice concentration
+REAL :: ZXR ! Value of x_r in N_r = C_r lambda_r ** x_r
+!
+INTEGER :: IKB ! Coordinates of the first physical points along z
+INTEGER :: J1, J2 ! Internal loop indexes
+INTEGER :: IND ! Number of interval to integrate the kernels
+!
+LOGICAL :: GFLAG ! Logical flag for printing the constatnts on the output
+ ! listing
+!
+INTEGER :: KND
+INTEGER :: KACCLBDAS, KACCLBDAR, KDRYLBDAG, KDRYLBDAS, KDRYLBDAR
+INTEGER :: KWETLBDAS, KWETLBDAG, KWETLBDAH
+REAL :: PALPHAR, PALPHAS, PALPHAG, PALPHAH
+REAL :: PNUR, PNUS, PNUG, PNUH
+REAL :: PBR, PBS, PBG, PBH
+REAL :: PCR, PCS, PCG, PCH
+REAL :: PDR, PDS, PDG, PDH
+REAL :: PESR, PEGS, PEGR, PEHS, PEHG
+REAL :: PACCLBDAS_MAX, PACCLBDAR_MAX, PACCLBDAS_MIN, PACCLBDAR_MIN
+REAL :: PDRYLBDAG_MAX, PDRYLBDAS_MAX, PDRYLBDAG_MIN, PDRYLBDAS_MIN
+REAL :: PDRYLBDAR_MAX, PDRYLBDAR_MIN
+REAL :: PWETLBDAS_MAX, PWETLBDAG_MAX, PWETLBDAS_MIN, PWETLBDAG_MIN
+REAL :: PWETLBDAH_MAX, PWETLBDAH_MIN
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. FUNCTION STATEMENTS
+! -------------------
+!
+!* 0.1 p_moment of the Generalized GAMMA function
+!
+!
+!
+! 1. COMPUTE KSPLTR FOR EACH MODEL
+! -----------------------------
+!
+!* 1.1 Set the hailstones maximum fall velocity
+!
+IF (CSEDIM == 'SPLI') THEN
+ IF (HCLOUD == 'ICE4') THEN
+ ZVTRMAX = 40.
+ ELSE IF (HCLOUD == 'ICE3') THEN
+ ZVTRMAX = 10.
+ END IF
+END IF
+!
+!* 1.2 Compute the number of small time step integration
+!
+KSPLITR = 1
+IF (CSEDIM == 'SPLI') THEN
+ SPLIT : DO
+ ZT = PTSTEP / REAL(KSPLITR)
+ IF (ZT * ZVTRMAX / PDZMIN .LT. 1.) EXIT SPLIT
+ KSPLITR = KSPLITR + 1
+ END DO SPLIT
+END IF
+!
+IF (ALLOCATED(XRTMIN)) THEN ! In case of nesting microphysics constants of
+ ! MODD_RAIN_ICE_PARAM are computed only once,
+ ! but if INI_RAIN_ICE has been called already
+ ! one must change the XRTMIN size.
+ DEALLOCATE(XRTMIN)
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. CHARACTERISTICS OF THE SPECIES
+! ------------------------------
+!
+!* 2.1 Cloud droplet and Raindrop characteristics
+!
+XAC = (XPI / 6.0) * XRHOLW
+XBC = 3.0
+XCC = XRHOLW * XG / (18.0 * 1.7E-5) ! Stokes flow (Pruppacher p 322 for T=273K)
+XDC = 2.0
+!
+XAR = (XPI / 6.0) * XRHOLW
+XBR = 3.0
+XCR = 842.
+XDR = 0.8
+!
+XCCR = 8.E6 ! N0_r = XCXR * lambda_r ** ZXR
+ZXR = -1. !
+!
+XF0R = 1.00
+XF1R = 0.26
+!
+XC1R = 1. / 2.
+!
+!
+!* 2.2 Ice crystal characteristics
+!
+SELECT CASE (CPRISTINE_ICE)
+ CASE('PLAT')
+ XAI = 0.82 ! Plates
+ XBI = 2.5 ! Plates
+ XC_I = 800. ! Plates
+ XDI = 1.0 ! Plates
+ XC1I = 1./XPI ! Plates
+ CASE('COLU')
+ XAI = 2.14E-3 ! Columns
+ XBI = 1.7 ! Columns
+ XC_I = 2.1E5 ! Columns
+ XDI = 1.585 ! Columns
+ XC1I = 0.8 ! Columns
+ CASE('BURO')
+ XAI = 44.0 ! Bullet rosettes
+ XBI = 3.0 ! Bullet rosettes
+ XC_I = 4.3E5 ! Bullet rosettes
+ XDI = 1.663 ! Bullet rosettes
+ XC1I = 0.5 ! Bullet rosettes
+END SELECT
+!
+! Note that XCCI=N_i (a locally predicted value) and XCXI=0.0, implicitly
+!
+XF0I = 1.00
+XF2I = 0.14
+!
+!
+!* 2.3 Snowflakes/aggregates characteristics
+!
+XAS = 0.02
+XBS = 1.9
+XCS = 5.1
+XDS = 0.27
+!
+XCCS = 5.0
+XCXS = 1.0
+!
+XF0S = 0.86
+XF1S = 0.28
+!
+XC1S = 1. / XPI
+!
+!
+!* 2.4 Graupel/Frozen drop characteristics
+!
+XAG = 19.6 ! Lump graupel case
+XBG = 2.8 ! Lump graupel case
+XCG = 124. ! Lump graupel case
+XDG = 0.66 ! Lump graupel case
+!
+XCCG = 5.E5
+XCXG = -0.5
+! XCCG = 4.E4 ! Test of Ziegler (1988)
+! XCXG = -1.0 ! Test of Ziegler (1988)
+!
+XF0G = 0.86
+XF1G = 0.28
+!
+XC1G = 1. / 2.
+!
+!
+!* 2.5 Hailstone characteristics
+!
+XAH = 470.
+XBH = 3.0
+XCH = 207.
+XDH = 0.64
+!
+XCCH = 4.E4 ! Test of Ziegler (1988)
+XCXH = -1.0 ! Test of Ziegler (1988)
+!
+XF0H = 0.86
+XF1H = 0.28
+!
+XC1H = 1./2.
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. DIMENSIONAL DISTRIBUTIONS OF THE SPECIES
+! ----------------------------------------
+!
+! 3.1 Cloud droplet distribution
+!
+! Over land
+XALPHAC = 1.0 ! Gamma law of the Cloud droplet (here volume-like distribution)
+XNUC = 3.0 ! Gamma law with little dispersion
+!
+!
+! Over sea
+XALPHAC2 = 3.0 ! Gamma law of the Cloud droplet (here volume-like distribution)
+XNUC2 = 1.0 ! Gamma law with little dispersion
+!
+!* 3.2 Raindrops distribution
+!
+XALPHAR = 1.0 ! Exponential law
+XNUR = 1.0 ! Exponential law
+!
+!* 3.3 Ice crystal distribution
+!
+XALPHAI = 3.0 ! Gamma law for the ice crystal volume
+XNUI = 3.0 ! Gamma law with little dispersion
+!
+XALPHAS = 1.0 ! Exponential law
+XNUS = 1.0 ! Exponential law
+!
+XALPHAG = 1.0 ! Exponential law
+XNUG = 1.0 ! Exponential law
+!
+XALPHAH = 1.0 ! Gamma law
+XNUH = 8.0 ! Gamma law with little dispersion
+!
+!* 3.4 Constants for shape parameter
+!
+ZGAMC = MOMG(XALPHAC,XNUC,3.)
+ZGAMC2 = MOMG(XALPHAC2,XNUC2,3.)
+XLBC(1) = XAR * ZGAMC
+XLBC(2) = XAR * ZGAMC2
+XLBEXC = 1.0 / XBC
+!
+XLBEXR = 1.0 / (-1.0 - XBR)
+XLBR = (XAR * XCCR * MOMG(XALPHAR,XNUR,XBR))**(-XLBEXR)
+!
+XLBEXI = 1.0 / (-XBI)
+XLBI = (XAI * MOMG(XALPHAI,XNUI,XBI))**(-XLBEXI)
+!
+XLBEXS = 1.0 / (XCXS - XBS)
+XLBS = (XAS * XCCS * MOMG(XALPHAS,XNUS,XBS))**(-XLBEXS)
+!
+XLBEXG = 1.0 / (XCXG - XBG)
+XLBG = (XAG * XCCG * MOMG(XALPHAG,XNUG,XBG))**(-XLBEXG)
+!
+XLBEXH = 1.0/(XCXH-XBH)
+XLBH = (XAH * XCCH * MOMG(XALPHAH,XNUH,XBH))**(-XLBEXH)
+!
+!* 3.5 Minimal values allowed for the mixing ratios
+!
+XLBDAR_MAX = 100000.0
+XLBDAS_MAX = 100000.0
+XLBDAG_MAX = 100000.0
+!
+ZCONC_MAX = 1.E6 ! Maximal concentration for falling particules set to 1 per cc
+XLBDAS_MAX = (ZCONC_MAX / XCCS)**(1./XCXS)
+!
+IF (HCLOUD == 'ICE4') THEN
+ ALLOCATE( XRTMIN(7) )
+ELSE IF (HCLOUD == 'ICE3') THEN
+ ALLOCATE( XRTMIN(6) )
+END IF
+!
+XRTMIN(1) = 1.0E-20
+XRTMIN(2) = 1.0E-20
+XRTMIN(3) = 1.0E-20
+XRTMIN(4) = 1.0E-20
+XRTMIN(5) = 1.0E-15
+XRTMIN(6) = 1.0E-15
+IF (HCLOUD == 'ICE4') XRTMIN(7) = 1.0E-15
+!
+XCONC_SEA = 1.E8 ! 100/cm3
+XCONC_LAND = 3.E8 ! 300/cm3
+XCONC_URBAN = 5.E8 ! 500/cm3
+!
+!-------------------------------------------------------------------------------
+!
+!* 4. CONSTANTS FOR THE SEDIMENTATION
+! -------------------------------
+!
+!* 4.1 Exponent of the fall-speed air density correction
+!
+XCEXVT = 0.4
+!
+IKB = 1 + JPVEXT
+ZRHO00 = XP00 / (XRD * XTHVREFZ(IKB))
+!
+!* 4.2 Constants for sedimentation
+!
+XFSEDC(1) = GAMMA(XNUC+(XDC+3.)/XALPHAC) / GAMMA(XNUC+3./XALPHAC) * &
+ (ZRHO00)**XCEXVT
+XFSEDC(2) = GAMMA(XNUC2+(XDC+3.)/XALPHAC2) / GAMMA(XNUC2+3./XALPHAC2)* &
+ (ZRHO00)**XCEXVT
+!
+XEXSEDR = (XBR + XDR + 1.0) / (XBR + 1.0)
+XFSEDR = XCR * XAR * XCCR * MOMG(XALPHAR,XNUR,XBR+XDR) * &
+ (XAR * XCCR * MOMG(XALPHAR,XNUR,XBR))**(-XEXSEDR) * (ZRHO00)**XCEXVT
+!
+XEXRSEDI = (XBI + XDI) / XBI
+XEXCSEDI = 1.0 - XEXRSEDI
+XFSEDI = (4. * XPI * 900.)**(-XEXCSEDI) * &
+ XC_I * XAI * MOMG(XALPHAI,XNUI,XBI+XDI) * &
+ ((XAI * MOMG(XALPHAI,XNUI,XBI)))**(-XEXRSEDI) * &
+ (ZRHO00)**XCEXVT
+XFCI = (4. * XPI * 900.)**(-1)
+!
+! Computations made for Columns
+!
+XEXRSEDI = 1.9324
+XEXCSEDI =-0.9324
+XFSEDI = 3.89745E11 * MOMG(XALPHAI,XNUI,3.285) * &
+ MOMG(XALPHAI,XNUI,1.7)**(-XEXRSEDI)*(ZRHO00)**XCEXVT
+XEXCSEDI =-0.9324 * 3.0
+WRITE (KLUOUT,FMT=*)' PRISTINE ICE SEDIMENTATION for columns XFSEDI =',XFSEDI
+!
+XEXSEDS = (XBS + XDS - XCXS) / (XBS - XCXS)
+XFSEDS = XCS * XAS * XCCS * MOMG(XALPHAS,XNUS,XBS+XDS) * &
+ (XAS * XCCS * MOMG(XALPHAS,XNUS,XBS))**(-XEXSEDS) * (ZRHO00)**XCEXVT
+!
+XEXSEDG = (XBG + XDG - XCXG) / (XBG - XCXG)
+XFSEDG = XCG * XAG * XCCG * MOMG(XALPHAG,XNUG,XBG+XDG) * &
+ (XAG * XCCG * MOMG(XALPHAG,XNUG,XBG))**(-XEXSEDG) * (ZRHO00)**XCEXVT
+!
+XEXSEDH = (XBH + XDH - XCXH) / (XBH - XCXH)
+XFSEDH = XCH * XAH * XCCH * MOMG(XALPHAH,XNUH,XBH+XDH) * &
+ (XAH * XCCH * MOMG(XALPHAH,XNUH,XBH))**(-XEXSEDH) * (ZRHO00)**XCEXVT
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 5. CONSTANTS FOR THE SLOW COLD PROCESSES
+! -------------------------------------
+!
+!* 5.1 Constants for ice nucleation
+!
+SELECT CASE (CPRISTINE_ICE)
+ CASE('PLAT')
+ ZFACT_NUCL = 1.0 ! Plates
+ CASE('COLU')
+ ZFACT_NUCL = 25.0 ! Columns
+ CASE('BURO')
+ ZFACT_NUCL = 17.0 ! Bullet rosettes
+END SELECT
+!
+XNU10 = 50. * ZFACT_NUCL
+XALPHA1 = 4.5
+XBETA1 = 0.6
+!
+XNU20 = 1000. * ZFACT_NUCL
+XALPHA2 = 12.96
+XBETA2 = 0.639
+!
+XMNU0 = 6.88E-13
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=KLUOUT,FMT='(" Heterogeneous nucleation")')
+ WRITE(UNIT=KLUOUT,FMT='(" NU10=",E13.6," ALPHA1=",E13.6," BETA1=",E13.6)') &
+ XNU10,XALPHA1,XBETA1
+ WRITE(UNIT=KLUOUT,FMT='(" NU20=",E13.6," ALPHA2=",E13.6," BETA2=",E13.6)') &
+ XNU20,XALPHA2,XBETA2
+ WRITE(UNIT=KLUOUT,FMT='(" mass of embryo XMNU0=",E13.6)') XMNU0
+END IF
+!
+XALPHA3 = -3.075
+XBETA3 = 81.00356
+XHON = (XPI / 6.) * ((2.0 * 3.0 * 4.0 * 5.0 * 6.0) / &
+ (2.0 * 3.0)) * (1.1E5)**(-3.0)
+ ! Pi/6 * (G_c(6)/G_c(3)) * (1/Lbda_c**3)
+ ! avec Lbda_c=1.1E5 m^-1
+ ! the formula is equivalent to
+ ! rho_dref * r_c G(6)
+ ! Pi/6 * -------------- * ---------
+ ! rho_lw * N_c G(3)*G(3)
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=KLUOUT,FMT='(" Homogeneous nucleation")')
+ WRITE(UNIT=KLUOUT,FMT='(" ALPHA3=",E13.6," BETA3=",E13.6)') XALPHA3,XBETA3
+ WRITE(UNIT=KLUOUT,FMT='(" constant XHON=",E13.6)') XHON
+END IF
+!
+!
+!* 5.2 Constants for vapor deposition on ice
+!
+XSCFAC = (0.63**(1./3.)) * SQRT((ZRHO00)**XCEXVT) ! One assumes Sc=0.63
+!
+X0DEPI = (4.0 * XPI) * XC1I * XF0I * MOMG(XALPHAI,XNUI,1.)
+X2DEPI = (4.0 * XPI) * XC1I * XF2I * XC_I * MOMG(XALPHAI,XNUI,XDI+2.0)
+!
+X0DEPS = (4.0 * XPI) * XCCS * XC1S * XF0S * MOMG(XALPHAS,XNUS,1.)
+X1DEPS = (4.0 * XPI) * XCCS * XC1S * XF1S * SQRT(XCS) * MOMG(XALPHAS,XNUS,0.5*XDS+1.5)
+XEX0DEPS = XCXS - 1.0
+XEX1DEPS = XCXS - 0.5 * (XDS + 3.0)
+!
+X0DEPG = (4.0 * XPI) * XCCG * XC1G * XF0G * MOMG(XALPHAG,XNUG,1.)
+X1DEPG = (4.0 * XPI) * XCCG * XC1G * XF1G * SQRT(XCG) * MOMG(XALPHAG,XNUG,0.5*XDG+1.5)
+XEX0DEPG = XCXG - 1.0
+XEX1DEPG = XCXG - 0.5 * (XDG + 3.0)
+!
+X0DEPH = (4.0 * XPI) * XCCH * XC1H * XF0H * MOMG(XALPHAH,XNUH,1.)
+X1DEPH = (4.0 * XPI) * XCCH * XC1H * XF1H * SQRT(XCH) * MOMG(XALPHAH,XNUH,0.5*XDH+1.5)
+XEX0DEPH = XCXH - 1.0
+XEX1DEPH = XCXH - 0.5 * (XDH + 3.0)
+!
+!
+!* 5.3 Constants for pristine ice autoconversion
+!
+XTIMAUTI = 1.E-3 ! Time constant at T=T_t
+XTEXAUTI = 0.015 ! Temperature factor of the I+I collection efficiency
+XCRIAUTI = 0.2E-4 ! Critical ice content for the autoconversion to occur
+ ! Revised value by Chaboureau et al. (2001)
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=KLUOUT,FMT='(" pristine ice autoconversion")')
+ WRITE(UNIT=KLUOUT,FMT='(" Time constant XTIMAUTI=",E13.6)') XTIMAUTI
+ WRITE(UNIT=KLUOUT,FMT='(" Temp. factor XTEXAUTI=",E13.6)') XTEXAUTI
+ WRITE(UNIT=KLUOUT,FMT='(" Crit. ice cont. XCRIAUTI=",E13.6)') XCRIAUTI
+END IF
+!
+!
+!* 5.4 Constants for snow aggregation
+!
+XCOLIS = 0.25 ! Collection efficiency of I+S
+XCOLEXIS = 0.05 ! Temperature factor of the I+S collection efficiency
+XFIAGGS = (XPI / 4.0) * XCOLIS * XCCS * XCS * (ZRHO00**XCEXVT) * &
+ MOMG(XALPHAS,XNUS,XDS+2.0)
+XEXIAGGS = XCXS - XDS - 2.0
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=KLUOUT,FMT='(" snow aggregation")')
+ WRITE(UNIT=KLUOUT,FMT='(" Coll. efficiency XCOLIS=",E13.6)') XCOLIS
+ WRITE(UNIT=KLUOUT,FMT='(" Temp. factor XCOLEXIS=",E13.6)') XCOLEXIS
+END IF
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 6. CONSTANTS FOR THE SLOW WARM PROCESSES
+! -------------------------------------
+!
+!* 6.1 Constants for the cloud droplets autoconversion
+!
+XTIMAUTC = 1.E-3
+XCRIAUTC = 0.5E-3
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=KLUOUT,FMT='(" cloud droplets autoconversion")')
+ WRITE(UNIT=KLUOUT,FMT='(" Time constant XTIMAUTC=",E13.6)') XTIMAUTC
+ WRITE(UNIT=KLUOUT,FMT='(" Crit. ice cont. XCRIAUTC=",E13.6)') XCRIAUTC
+END IF
+!
+!* 6.2 Constants for the accretion of cloud droplets by raindrops
+!
+XFCACCR = (XPI / 4.0) * XCCR * XCR * (ZRHO00**XCEXVT) * MOMG(XALPHAR,XNUR,XDR+2.0)
+XEXCACCR = -XDR - 3.0
+!
+!* 6.3 Constants for the evaporation of the raindrops
+!
+X0EVAR = (4.0 * XPI) * XCCR * XC1R * XF0R * MOMG(XALPHAR,XNUR,1.)
+X1EVAR = (4.0 * XPI) * XCCR * XC1R * XF1R * SQRT(XCR)*MOMG(XALPHAR,XNUR,0.5*XDR+1.5)
+XEX0EVAR = -2.0
+XEX1EVAR = -1.0 - 0.5 * (XDR + 3.0)
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 7. CONSTANTS FOR THE FAST COLD PROCESSES FOR THE AGGREGATES
+! --------------------------------------------------------
+!
+!
+!* 7.1 Constants for the riming of the aggregates
+!
+XDCSLIM = 0.007 ! D_cs^lim = 7 mm as suggested by Farley et al. (1989)
+XCOLCS = 1.0
+XEXCRIMSS= XCXS - XDS - 2.0
+XCRIMSS = (XPI / 4.0) * XCOLCS * XCCS * XCS * (ZRHO00**XCEXVT) * MOMG(XALPHAS,XNUS,XDS+2.0)
+XEXCRIMSG= XEXCRIMSS
+XCRIMSG = XCRIMSS
+XSRIMCG = XCCS * XAS * MOMG(XALPHAS,XNUS,XBS)
+XEXSRIMCG= XCXS - XBS
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=KLUOUT,FMT='(" riming of the aggregates")')
+ WRITE(UNIT=KLUOUT,FMT='(" D_cs^lim (Farley et al.) XDCSLIM=",E13.6)') XDCSLIM
+ WRITE(UNIT=KLUOUT,FMT='(" Coll. efficiency XCOLCS=",E13.6)') XCOLCS
+END IF
+!
+NGAMINC = 80
+XGAMINC_BOUND_MIN = 1.0E-1 ! Minimal value of (Lbda * D_cs^lim)**alpha
+XGAMINC_BOUND_MAX = 1.0E7 ! Maximal value of (Lbda * D_cs^lim)**alpha
+ZRATE = EXP(LOG(XGAMINC_BOUND_MAX/XGAMINC_BOUND_MIN)/REAL(NGAMINC-1))
+!
+IF( .NOT.ALLOCATED(XGAMINC_RIM1) ) ALLOCATE( XGAMINC_RIM1(NGAMINC) )
+IF( .NOT.ALLOCATED(XGAMINC_RIM2) ) ALLOCATE( XGAMINC_RIM2(NGAMINC) )
+IF( .NOT.ALLOCATED(XGAMINC_RIM3) ) ALLOCATE( XGAMINC_RIM3(NGAMINC) )
+!
+DO J1 = 1, NGAMINC
+ ZBOUND = XGAMINC_BOUND_MIN * ZRATE**(J1-1)
+ XGAMINC_RIM1(J1) = GAMMA_INC(XNUS+(2.0+XDS)/XALPHAS,ZBOUND)
+ XGAMINC_RIM2(J1) = GAMMA_INC(XNUS+XBS/XALPHAS ,ZBOUND)
+ XFS = 1.3 ! cf values initiated in ini_param_elec
+ XGAMINC_RIM3(J1) = GAMMA_INC(XNUS+XFS/XALPHAS ,ZBOUND)
+END DO
+!
+XRIMINTP1 = XALPHAS / LOG(ZRATE)
+XRIMINTP2 = 1.0 + XRIMINTP1 * LOG(XDCSLIM/(XGAMINC_BOUND_MIN)**(1.0/XALPHAS))
+!
+!* 7.2 Constants for the accretion of raindrops onto aggregates
+!
+XFRACCSS = ((XPI**2) / 24.0) * XCCS * XCCR * XRHOLW * (ZRHO00**XCEXVT)
+!
+XLBRACCS1 = MOMG(XALPHAS,XNUS,2.) * MOMG(XALPHAR,XNUR,3.)
+XLBRACCS2 = 2. * MOMG(XALPHAS,XNUS,1.) * MOMG(XALPHAR,XNUR,4.)
+XLBRACCS3 = MOMG(XALPHAR,XNUR,5.)
+!
+XFSACCRG = (XPI / 4.0) * XAS * XCCS * XCCR * (ZRHO00**XCEXVT)
+!
+XLBSACCR1 = MOMG(XALPHAR,XNUR,2.) * MOMG(XALPHAS,XNUS,XBS)
+XLBSACCR2 = 2. * MOMG(XALPHAR,XNUR,1.) * MOMG(XALPHAS,XNUS,XBS+1.)
+XLBSACCR3 = MOMG(XALPHAS,XNUS,XBS+2.)
+!
+!* 7.2.1 Defining the ranges for the computation of the kernels
+!
+! Notice: One magnitude of lambda discretized over 10 points for rain
+! Notice: One magnitude of lambda discretized over 10 points for snow
+!
+NACCLBDAS = 40
+XACCLBDAS_MIN = 5.0E1 ! Minimal value of Lbda_s to tabulate XKER_RACCS
+XACCLBDAS_MAX = 5.0E5 ! Maximal value of Lbda_s to tabulate XKER_RACCS
+ZRATE = LOG(XACCLBDAS_MAX/XACCLBDAS_MIN)/REAL(NACCLBDAS-1)
+XACCINTP1S = 1.0 / ZRATE
+XACCINTP2S = 1.0 - LOG( XACCLBDAS_MIN ) / ZRATE
+!
+NACCLBDAR = 40
+XACCLBDAR_MIN = 1.0E3 ! Minimal value of Lbda_r to tabulate XKER_RACCS
+XACCLBDAR_MAX = 1.0E7 ! Maximal value of Lbda_r to tabulate XKER_RACCS
+ZRATE = LOG(XACCLBDAR_MAX/XACCLBDAR_MIN)/REAL(NACCLBDAR-1)
+XACCINTP1R = 1.0 / ZRATE
+XACCINTP2R = 1.0 - LOG( XACCLBDAR_MIN ) / ZRATE
+!
+!* 7.2.2 Computations of the tabulated normalized kernels
+!
+IND = 50 ! Interval number, collection efficiency and infinite diameter
+ZESR = 1.0 ! factor used to integrate the dimensional distributions when
+ZFDINFTY = 20.0 ! computing the kernels XKER_RACCSS, XKER_RACCS and XKER_SACCRG
+!
+IF( .NOT.ALLOCATED(XKER_RACCSS) ) ALLOCATE( XKER_RACCSS(NACCLBDAS,NACCLBDAR) )
+IF( .NOT.ALLOCATED(XKER_RACCS ) ) ALLOCATE( XKER_RACCS (NACCLBDAS,NACCLBDAR) )
+IF( .NOT.ALLOCATED(XKER_SACCRG) ) ALLOCATE( XKER_SACCRG(NACCLBDAR,NACCLBDAS) )
+!
+CALL READ_XKER_RACCS (KACCLBDAS,KACCLBDAR,KND, &
+ PALPHAS,PNUS,PALPHAR,PNUR,PESR,PBS,PBR,PCS,PDS,PCR,PDR, &
+ PACCLBDAS_MAX,PACCLBDAR_MAX,PACCLBDAS_MIN,PACCLBDAR_MIN,&
+ PFDINFTY )
+IF( (KACCLBDAS/=NACCLBDAS) .OR. (KACCLBDAR/=NACCLBDAR) .OR. (KND/=IND) .OR. &
+ (PALPHAS/=XALPHAS) .OR. (PNUS/=XNUS) .OR. &
+ (PALPHAR/=XALPHAR) .OR. (PNUR/=XNUR) .OR. &
+ (PESR/=ZESR) .OR. (PBS/=XBS) .OR. (PBR/=XBR) .OR. &
+ (PCS/=XCS) .OR. (PDS/=XDS) .OR. (PCR/=XCR) .OR. (PDR/=XDR) .OR. &
+ (PACCLBDAS_MAX/=XACCLBDAS_MAX) .OR. (PACCLBDAR_MAX/=XACCLBDAR_MAX) .OR. &
+ (PACCLBDAS_MIN/=XACCLBDAS_MIN) .OR. (PACCLBDAR_MIN/=XACCLBDAR_MIN) .OR. &
+ (PFDINFTY/=ZFDINFTY) ) THEN
+ CALL RRCOLSS ( IND, XALPHAS, XNUS, XALPHAR, XNUR, &
+ ZESR, XBR, XCS, XDS, XCR, XDR, &
+ XACCLBDAS_MAX, XACCLBDAR_MAX, XACCLBDAS_MIN, XACCLBDAR_MIN, &
+ ZFDINFTY, XKER_RACCSS, XAG, XBS, XAS )
+ CALL RZCOLX ( IND, XALPHAS, XNUS, XALPHAR, XNUR, &
+ ZESR, XBR, XCS, XDS, XCR, XDR, &
+ XACCLBDAS_MAX, XACCLBDAR_MAX, XACCLBDAS_MIN, XACCLBDAR_MIN, &
+ ZFDINFTY, XKER_RACCS )
+ CALL RSCOLRG ( IND, XALPHAS, XNUS, XALPHAR, XNUR, &
+ ZESR, XBS, XCS, XDS, XCR, XDR, &
+ XACCLBDAS_MAX, XACCLBDAR_MAX, XACCLBDAS_MIN, XACCLBDAR_MIN, &
+ ZFDINFTY, XKER_SACCRG, XAG, XBS, XAS )
+ WRITE(UNIT=KLUOUT,FMT='("*****************************************")')
+ WRITE(UNIT=KLUOUT,FMT='("**** UPDATE NEW SET OF RACSS KERNELS ****")')
+ WRITE(UNIT=KLUOUT,FMT='("**** UPDATE NEW SET OF RACS KERNELS ****")')
+ WRITE(UNIT=KLUOUT,FMT='("**** UPDATE NEW SET OF SACRG KERNELS ****")')
+ WRITE(UNIT=KLUOUT,FMT='("*****************************************")')
+ WRITE(UNIT=KLUOUT,FMT='("!")')
+ WRITE(UNIT=KLUOUT,FMT='("KND=",I3)') IND
+ WRITE(UNIT=KLUOUT,FMT='("KACCLBDAS=",I3)') NACCLBDAS
+ WRITE(UNIT=KLUOUT,FMT='("KACCLBDAR=",I3)') NACCLBDAR
+ WRITE(UNIT=KLUOUT,FMT='("PALPHAS=",E13.6)') XALPHAS
+ WRITE(UNIT=KLUOUT,FMT='("PNUS=",E13.6)') XNUS
+ WRITE(UNIT=KLUOUT,FMT='("PALPHAR=",E13.6)') XALPHAR
+ WRITE(UNIT=KLUOUT,FMT='("PNUR=",E13.6)') XNUR
+ WRITE(UNIT=KLUOUT,FMT='("PESR=",E13.6)') ZESR
+ WRITE(UNIT=KLUOUT,FMT='("PBS=",E13.6)') XBS
+ WRITE(UNIT=KLUOUT,FMT='("PBR=",E13.6)') XBR
+ WRITE(UNIT=KLUOUT,FMT='("PCS=",E13.6)') XCS
+ WRITE(UNIT=KLUOUT,FMT='("PDS=",E13.6)') XDS
+ WRITE(UNIT=KLUOUT,FMT='("PCR=",E13.6)') XCR
+ WRITE(UNIT=KLUOUT,FMT='("PDR=",E13.6)') XDR
+ WRITE(UNIT=KLUOUT,FMT='("PACCLBDAS_MAX=",E13.6)') &
+ XACCLBDAS_MAX
+ WRITE(UNIT=KLUOUT,FMT='("PACCLBDAR_MAX=",E13.6)') &
+ XACCLBDAR_MAX
+ WRITE(UNIT=KLUOUT,FMT='("PACCLBDAS_MIN=",E13.6)') &
+ XACCLBDAS_MIN
+ WRITE(UNIT=KLUOUT,FMT='("PACCLBDAR_MIN=",E13.6)') &
+ XACCLBDAR_MIN
+ WRITE(UNIT=KLUOUT,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
+ WRITE(UNIT=KLUOUT,FMT='("!")')
+ WRITE(UNIT=KLUOUT,FMT='("IF( PRESENT(PKER_RACCSS) ) THEN")')
+ DO J1 = 1 , NACCLBDAS
+ DO J2 = 1 , NACCLBDAR
+ WRITE(UNIT=KLUOUT,FMT='(" PKER_RACCSS(",I3,",",I3,") = ",E13.6)') &
+ J1,J2,XKER_RACCSS(J1,J2)
+ END DO
+ END DO
+ WRITE(UNIT=KLUOUT,FMT='("END IF")')
+ WRITE(UNIT=KLUOUT,FMT='("!")')
+ WRITE(UNIT=KLUOUT,FMT='("IF( PRESENT(PKER_RACCS ) ) THEN")')
+ DO J1 = 1 , NACCLBDAS
+ DO J2 = 1 , NACCLBDAR
+ WRITE(UNIT=KLUOUT,FMT='(" PKER_RACCS (",I3,",",I3,") = ",E13.6)') &
+ J1,J2,XKER_RACCS (J1,J2)
+ END DO
+ END DO
+ WRITE(UNIT=KLUOUT,FMT='("END IF")')
+ WRITE(UNIT=KLUOUT,FMT='("!")')
+ WRITE(UNIT=KLUOUT,FMT='("IF( PRESENT(PKER_SACCRG) ) THEN")')
+ DO J1 = 1 , NACCLBDAR
+ DO J2 = 1 , NACCLBDAS
+ WRITE(UNIT=KLUOUT,FMT='(" PKER_SACCRG(",I3,",",I3,") = ",E13.6)') &
+ J1,J2,XKER_SACCRG(J1,J2)
+ END DO
+ END DO
+ WRITE(UNIT=KLUOUT,FMT='("END IF")')
+ ELSE
+ CALL READ_XKER_RACCS (KACCLBDAS,KACCLBDAR,KND, &
+ PALPHAS,PNUS,PALPHAR,PNUR,PESR,PBS,PBR,PCS,PDS,PCR,PDR, &
+ PACCLBDAS_MAX,PACCLBDAR_MAX,PACCLBDAS_MIN,PACCLBDAR_MIN,&
+ PFDINFTY,XKER_RACCSS,XKER_RACCS,XKER_SACCRG )
+ WRITE(UNIT=KLUOUT,FMT='(" Read XKER_RACCSS")')
+ WRITE(UNIT=KLUOUT,FMT='(" Read XKER_RACCS ")')
+ WRITE(UNIT=KLUOUT,FMT='(" Read XKER_SACCRG")')
+END IF
+!
+!* 7.3 Constant for the conversion-melting rate
+!
+XFSCVMG = 2.0
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=KLUOUT,FMT='(" conversion-melting of the aggregates")')
+ WRITE(UNIT=KLUOUT,FMT='(" Conv. factor XFSCVMG=",E13.6)') XFSCVMG
+END IF
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 8. CONSTANTS FOR THE FAST COLD PROCESSES FOR THE GRAUPELN
+! ------------------------------------------------------
+!
+!
+!* 8.1 Constants for the rain contact freezing
+!
+XCOLIR = 1.0
+!
+XEXRCFRI = -XDR - 5.0 + ZXR
+XRCFRI = ((XPI**2) / 24.0) * XCCR * XRHOLW * XCOLIR * XCR * &
+ (ZRHO00**XCEXVT) * MOMG(XALPHAR,XNUR,XDR+5.0)
+XEXICFRR = -XDR - 2.0 + ZXR
+XICFRR = (XPI / 4.0) * XCOLIR * XCR * (ZRHO00**XCEXVT) * &
+ XCCR * MOMG(XALPHAR,XNUR,XDR+2.0)
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=KLUOUT,FMT='(" rain contact freezing")')
+ WRITE(UNIT=KLUOUT,FMT='(" Coll. efficiency XCOLIR=",E13.6)') XCOLIR
+END IF
+!
+!
+!* 8.2 Constants for the dry growth of the graupeln
+!
+!* 8.2.1 Constants for the cloud droplet collection by the graupeln
+!
+XFCDRYG = (XPI / 4.0) * XCCG * XCG * (ZRHO00**XCEXVT) * MOMG(XALPHAG,XNUG,XDG+2.0)
+!
+!* 8.2.2 Constants for the cloud ice collection by the graupeln
+!
+XCOLIG = 0.25 ! Collection efficiency of I+G
+XCOLEXIG = 0.05 ! Temperature factor of the I+G collection efficiency
+XCOLIG = 0.01 ! Collection efficiency of I+G
+XCOLEXIG = 0.1 ! Temperature factor of the I+G collection efficiency
+WRITE (KLUOUT, FMT=*) ' NEW Constants for the cloud ice collection by the graupeln'
+WRITE (KLUOUT, FMT=*) ' XCOLIG, XCOLEXIG = ',XCOLIG,XCOLEXIG
+!
+XFIDRYG = (XPI / 4.0) * XCOLIG * XCCG * XCG * (ZRHO00**XCEXVT) * &
+ MOMG(XALPHAG,XNUG,XDG+2.0)
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=KLUOUT,FMT='(" cloud ice collection by the graupeln")')
+ WRITE(UNIT=KLUOUT,FMT='(" Coll. efficiency XCOLIG=",E13.6)') XCOLIG
+ WRITE(UNIT=KLUOUT,FMT='(" Temp. factor XCOLEXIG=",E13.6)') XCOLEXIG
+END IF
+!
+!* 8.2.3 Constants for the aggregate collection by the graupeln
+!
+XCOLSG = 0.25 ! Collection efficiency of S+G
+XCOLEXSG = 0.05 ! Temperature factor of the S+G collection efficiency
+XCOLSG = 0.01 ! Collection efficiency of S+G
+XCOLEXSG = 0.1 ! Temperature factor of the S+G collection efficiency
+WRITE (KLUOUT, FMT=*) ' NEW Constants for the aggregate collection by the graupeln'
+WRITE (KLUOUT, FMT=*) ' XCOLSG, XCOLEXSG = ',XCOLSG,XCOLEXSG
+!
+XFSDRYG = (XPI / 4.0) * XCOLSG * XCCG * XCCS * XAS * (ZRHO00**XCEXVT)
+!
+XLBSDRYG1 = MOMG(XALPHAG,XNUG,2.) * MOMG(XALPHAS,XNUS,XBS)
+XLBSDRYG2 = 2. * MOMG(XALPHAG,XNUG,1.) * MOMG(XALPHAS,XNUS,XBS+1.)
+XLBSDRYG3 = MOMG(XALPHAS,XNUS,XBS+2.)
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=KLUOUT,FMT='(" aggregate collection by the graupeln")')
+ WRITE(UNIT=KLUOUT,FMT='(" Coll. efficiency XCOLSG=",E13.6)') XCOLSG
+ WRITE(UNIT=KLUOUT,FMT='(" Temp. factor XCOLEXSG=",E13.6)') XCOLEXSG
+END IF
+!
+!* 8.2.4 Constants for the raindrop collection by the graupeln
+!
+XFRDRYG = ((XPI**2) / 24.0) * XCCG * XCCR * XRHOLW * (ZRHO00**XCEXVT)
+!
+XLBRDRYG1 = MOMG(XALPHAG,XNUG,2.) * MOMG(XALPHAR,XNUR,3.)
+XLBRDRYG2 = 2. * MOMG(XALPHAG,XNUG,1.) * MOMG(XALPHAR,XNUR,4.)
+XLBRDRYG3 = MOMG(XALPHAR,XNUR,5.)
+!
+! Notice: One magnitude of lambda discretized over 10 points
+!
+NDRYLBDAR = 40
+XDRYLBDAR_MIN = 1.0E3 ! Minimal value of Lbda_r to tabulate XKER_RDRYG
+XDRYLBDAR_MAX = 1.0E7 ! Maximal value of Lbda_r to tabulate XKER_RDRYG
+ZRATE = LOG(XDRYLBDAR_MAX/XDRYLBDAR_MIN) / REAL(NDRYLBDAR-1)
+XDRYINTP1R = 1.0 / ZRATE
+XDRYINTP2R = 1.0 - LOG( XDRYLBDAR_MIN ) / ZRATE
+!
+NDRYLBDAS = 80
+XDRYLBDAS_MIN = 2.5E1 ! Minimal value of Lbda_s to tabulate XKER_SDRYG
+XDRYLBDAS_MAX = 2.5E9 ! Maximal value of Lbda_s to tabulate XKER_SDRYG
+ZRATE = LOG(XDRYLBDAS_MAX/XDRYLBDAS_MIN) / REAL(NDRYLBDAS-1)
+XDRYINTP1S = 1.0 / ZRATE
+XDRYINTP2S = 1.0 - LOG( XDRYLBDAS_MIN ) / ZRATE
+!
+NDRYLBDAG = 40
+XDRYLBDAG_MIN = 1.0E3 ! Min value of Lbda_g to tabulate XKER_SDRYG,XKER_RDRYG
+XDRYLBDAG_MAX = 1.0E7 ! Max value of Lbda_g to tabulate XKER_SDRYG,XKER_RDRYG
+ZRATE = LOG(XDRYLBDAG_MAX/XDRYLBDAG_MIN) / REAL(NDRYLBDAG-1)
+XDRYINTP1G = 1.0 / ZRATE
+XDRYINTP2G = 1.0 - LOG( XDRYLBDAG_MIN ) / ZRATE
+!
+!* 8.2.5 Computations of the tabulated normalized kernels
+!
+IND = 50 ! Interval number, collection efficiency and infinite diameter
+ZEGS = 1.0 ! factor used to integrate the dimensional distributions when
+ZFDINFTY = 20.0 ! computing the kernels XKER_SDRYG
+!
+IF( .NOT.ALLOCATED(XKER_SDRYG) ) ALLOCATE( XKER_SDRYG(NDRYLBDAG,NDRYLBDAS) )
+!
+CALL READ_XKER_SDRYG (KDRYLBDAG,KDRYLBDAS,KND, &
+ PALPHAG,PNUG,PALPHAS,PNUS,PEGS,PBS,PCG,PDG,PCS,PDS, &
+ PDRYLBDAG_MAX,PDRYLBDAS_MAX,PDRYLBDAG_MIN,PDRYLBDAS_MIN, &
+ PFDINFTY )
+IF( (KDRYLBDAG/=NDRYLBDAG) .OR. (KDRYLBDAS/=NDRYLBDAS) .OR. (KND/=IND) .OR. &
+ (PALPHAG/=XALPHAG) .OR. (PNUG/=XNUG) .OR. &
+ (PALPHAS/=XALPHAS) .OR. (PNUS/=XNUS) .OR. &
+ (PEGS/=ZEGS) .OR. (PBS/=XBS) .OR. &
+ (PCG/=XCG) .OR. (PDG/=XDG) .OR. (PCS/=XCS) .OR. (PDS/=XDS) .OR. &
+ (PDRYLBDAG_MAX/=XDRYLBDAG_MAX) .OR. (PDRYLBDAS_MAX/=XDRYLBDAS_MAX) .OR. &
+ (PDRYLBDAG_MIN/=XDRYLBDAG_MIN) .OR. (PDRYLBDAS_MIN/=XDRYLBDAS_MIN) .OR. &
+ (PFDINFTY/=ZFDINFTY) ) THEN
+ CALL RZCOLX ( IND, XALPHAG, XNUG, XALPHAS, XNUS, &
+ ZEGS, XBS, XCG, XDG, XCS, XDS, &
+ XDRYLBDAG_MAX, XDRYLBDAS_MAX, XDRYLBDAG_MIN, XDRYLBDAS_MIN, &
+ ZFDINFTY, XKER_SDRYG )
+ WRITE(UNIT=KLUOUT,FMT='("*****************************************")')
+ WRITE(UNIT=KLUOUT,FMT='("**** UPDATE NEW SET OF SDRYG KERNELS ****")')
+ WRITE(UNIT=KLUOUT,FMT='("*****************************************")')
+ WRITE(UNIT=KLUOUT,FMT='("!")')
+ WRITE(UNIT=KLUOUT,FMT='("KND=",I3)') IND
+ WRITE(UNIT=KLUOUT,FMT='("KDRYLBDAG=",I3)') NDRYLBDAG
+ WRITE(UNIT=KLUOUT,FMT='("KDRYLBDAS=",I3)') NDRYLBDAS
+ WRITE(UNIT=KLUOUT,FMT='("PALPHAG=",E13.6)') XALPHAG
+ WRITE(UNIT=KLUOUT,FMT='("PNUG=",E13.6)') XNUG
+ WRITE(UNIT=KLUOUT,FMT='("PALPHAS=",E13.6)') XALPHAS
+ WRITE(UNIT=KLUOUT,FMT='("PNUS=",E13.6)') XNUS
+ WRITE(UNIT=KLUOUT,FMT='("PEGS=",E13.6)') ZEGS
+ WRITE(UNIT=KLUOUT,FMT='("PBS=",E13.6)') XBS
+ WRITE(UNIT=KLUOUT,FMT='("PCG=",E13.6)') XCG
+ WRITE(UNIT=KLUOUT,FMT='("PDG=",E13.6)') XDG
+ WRITE(UNIT=KLUOUT,FMT='("PCS=",E13.6)') XCS
+ WRITE(UNIT=KLUOUT,FMT='("PDS=",E13.6)') XDS
+ WRITE(UNIT=KLUOUT,FMT='("PDRYLBDAG_MAX=",E13.6)') &
+ XDRYLBDAG_MAX
+ WRITE(UNIT=KLUOUT,FMT='("PDRYLBDAS_MAX=",E13.6)') &
+ XDRYLBDAS_MAX
+ WRITE(UNIT=KLUOUT,FMT='("PDRYLBDAG_MIN=",E13.6)') &
+ XDRYLBDAG_MIN
+ WRITE(UNIT=KLUOUT,FMT='("PDRYLBDAS_MIN=",E13.6)') &
+ XDRYLBDAS_MIN
+ WRITE(UNIT=KLUOUT,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
+ WRITE(UNIT=KLUOUT,FMT='("!")')
+ WRITE(UNIT=KLUOUT,FMT='("IF( PRESENT(PKER_SDRYG) ) THEN")')
+ DO J1 = 1 , NDRYLBDAG
+ DO J2 = 1 , NDRYLBDAS
+ WRITE(UNIT=KLUOUT,FMT='("PKER_SDRYG(",I3,",",I3,") = ",E13.6)') &
+ J1,J2,XKER_SDRYG(J1,J2)
+ END DO
+ END DO
+ WRITE(UNIT=KLUOUT,FMT='("END IF")')
+ ELSE
+ CALL READ_XKER_SDRYG (KDRYLBDAG,KDRYLBDAS,KND, &
+ PALPHAG,PNUG,PALPHAS,PNUS,PEGS,PBS,PCG,PDG,PCS,PDS, &
+ PDRYLBDAG_MAX,PDRYLBDAS_MAX,PDRYLBDAG_MIN,PDRYLBDAS_MIN, &
+ PFDINFTY,XKER_SDRYG )
+ WRITE(UNIT=KLUOUT,FMT='(" Read XKER_SDRYG")')
+END IF
+!
+!
+IND = 50 ! Number of interval used to integrate the dimensional
+ZEGR = 1.0 ! distributions when computing the kernel XKER_RDRYG
+ZFDINFTY = 20.0
+!
+IF( .NOT.ALLOCATED(XKER_RDRYG) ) ALLOCATE( XKER_RDRYG(NDRYLBDAG,NDRYLBDAR) )
+!
+CALL READ_XKER_RDRYG (KDRYLBDAG,KDRYLBDAR,KND, &
+ PALPHAG,PNUG,PALPHAR,PNUR,PEGR,PBR,PCG,PDG,PCR,PDR, &
+ PDRYLBDAG_MAX,PDRYLBDAR_MAX,PDRYLBDAG_MIN,PDRYLBDAR_MIN, &
+ PFDINFTY )
+IF( (KDRYLBDAG/=NDRYLBDAG) .OR. (KDRYLBDAR/=NDRYLBDAR) .OR. (KND/=IND) .OR. &
+ (PALPHAG/=XALPHAG) .OR. (PNUG/=XNUG) .OR. &
+ (PALPHAR/=XALPHAR) .OR. (PNUR/=XNUR) .OR. &
+ (PEGR/=ZEGR) .OR. (PBR/=XBR) .OR. &
+ (PCG/=XCG) .OR. (PDG/=XDG) .OR. (PCR/=XCR) .OR. (PDR/=XDR) .OR. &
+ (PDRYLBDAG_MAX/=XDRYLBDAG_MAX) .OR. (PDRYLBDAR_MAX/=XDRYLBDAR_MAX) .OR. &
+ (PDRYLBDAG_MIN/=XDRYLBDAG_MIN) .OR. (PDRYLBDAR_MIN/=XDRYLBDAR_MIN) .OR. &
+ (PFDINFTY/=ZFDINFTY) ) THEN
+ CALL RZCOLX ( IND, XALPHAG, XNUG, XALPHAR, XNUR, &
+ ZEGR, XBR, XCG, XDG, XCR, XDR, &
+ XDRYLBDAG_MAX, XDRYLBDAR_MAX, XDRYLBDAG_MIN, XDRYLBDAR_MIN, &
+ ZFDINFTY, XKER_RDRYG )
+ WRITE(UNIT=KLUOUT,FMT='("*****************************************")')
+ WRITE(UNIT=KLUOUT,FMT='("**** UPDATE NEW SET OF RDRYG KERNELS ****")')
+ WRITE(UNIT=KLUOUT,FMT='("*****************************************")')
+ WRITE(UNIT=KLUOUT,FMT='("!")')
+ WRITE(UNIT=KLUOUT,FMT='("KND=",I3)') IND
+ WRITE(UNIT=KLUOUT,FMT='("KDRYLBDAG=",I3)') NDRYLBDAG
+ WRITE(UNIT=KLUOUT,FMT='("KDRYLBDAR=",I3)') NDRYLBDAR
+ WRITE(UNIT=KLUOUT,FMT='("PALPHAG=",E13.6)') XALPHAG
+ WRITE(UNIT=KLUOUT,FMT='("PNUG=",E13.6)') XNUG
+ WRITE(UNIT=KLUOUT,FMT='("PALPHAR=",E13.6)') XALPHAR
+ WRITE(UNIT=KLUOUT,FMT='("PNUR=",E13.6)') XNUR
+ WRITE(UNIT=KLUOUT,FMT='("PEGR=",E13.6)') ZEGR
+ WRITE(UNIT=KLUOUT,FMT='("PBR=",E13.6)') XBR
+ WRITE(UNIT=KLUOUT,FMT='("PCG=",E13.6)') XCG
+ WRITE(UNIT=KLUOUT,FMT='("PDG=",E13.6)') XDG
+ WRITE(UNIT=KLUOUT,FMT='("PCR=",E13.6)') XCR
+ WRITE(UNIT=KLUOUT,FMT='("PDR=",E13.6)') XDR
+ WRITE(UNIT=KLUOUT,FMT='("PDRYLBDAG_MAX=",E13.6)') &
+ XDRYLBDAG_MAX
+ WRITE(UNIT=KLUOUT,FMT='("PDRYLBDAR_MAX=",E13.6)') &
+ XDRYLBDAR_MAX
+ WRITE(UNIT=KLUOUT,FMT='("PDRYLBDAG_MIN=",E13.6)') &
+ XDRYLBDAG_MIN
+ WRITE(UNIT=KLUOUT,FMT='("PDRYLBDAR_MIN=",E13.6)') &
+ XDRYLBDAR_MIN
+ WRITE(UNIT=KLUOUT,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
+ WRITE(UNIT=KLUOUT,FMT='("!")')
+ WRITE(UNIT=KLUOUT,FMT='("IF( PRESENT(PKER_RDRYG) ) THEN")')
+ DO J1 = 1 , NDRYLBDAG
+ DO J2 = 1 , NDRYLBDAR
+ WRITE(UNIT=KLUOUT,FMT='("PKER_RDRYG(",I3,",",I3,") = ",E13.6)') &
+ J1,J2,XKER_RDRYG(J1,J2)
+ END DO
+ END DO
+ WRITE(UNIT=KLUOUT,FMT='("END IF")')
+ ELSE
+ CALL READ_XKER_RDRYG (KDRYLBDAG,KDRYLBDAR,KND, &
+ PALPHAG,PNUG,PALPHAR,PNUR,PEGR,PBR,PCG,PDG,PCR,PDR, &
+ PDRYLBDAG_MAX,PDRYLBDAR_MAX,PDRYLBDAG_MIN,PDRYLBDAR_MIN, &
+ PFDINFTY,XKER_RDRYG )
+ WRITE(UNIT=KLUOUT,FMT='(" Read XKER_RDRYG")')
+END IF
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 9. CONSTANTS FOR THE FAST COLD PROCESSES FOR THE HAILSTONES
+! --------------------------------------------------------
+!
+!* 9.2 Constants for the wet growth of the hailstones
+!
+!
+!* 9.2.1 Constant for the cloud droplet and cloud ice collection
+! by the hailstones
+!
+XFWETH = (XPI / 4.0) * XCCH * XCH * (ZRHO00**XCEXVT) * MOMG(XALPHAH,XNUH,XDH+2.0)
+!
+!* 9.2.2 Constants for the aggregate collection by the hailstones
+!
+XFSWETH = (XPI/4.0) * XCCH * XCCS * XAS * (ZRHO00**XCEXVT)
+!
+XLBSWETH1 = MOMG(XALPHAH,XNUH,2.) * MOMG(XALPHAS,XNUS,XBS)
+XLBSWETH2 = 2. * MOMG(XALPHAH,XNUH,1.) * MOMG(XALPHAS,XNUS,XBS+1.)
+XLBSWETH3 = MOMG(XALPHAS,XNUS,XBS+2.)
+!
+!* 9.2.3 Constants for the graupel collection by the hailstones
+!
+XFGWETH = (XPI / 4.0) * XCCH * XCCG * XAG * (ZRHO00**XCEXVT)
+!
+XLBGWETH1 = MOMG(XALPHAH,XNUH,2.) * MOMG(XALPHAG,XNUG,XBG)
+XLBGWETH2 = 2. * MOMG(XALPHAH,XNUH,1.) * MOMG(XALPHAG,XNUG,XBG+1.)
+XLBGWETH3 = MOMG(XALPHAG,XNUG,XBG+2.)
+!
+! Notice: One magnitude of lambda discretized over 10 points
+!
+NWETLBDAS = 80
+XWETLBDAS_MIN = 2.5E1 ! Minimal value of Lbda_s to tabulate XKER_SWETH
+XWETLBDAS_MAX = 2.5E9 ! Maximal value of Lbda_s to tabulate XKER_SWETH
+ZRATE = LOG(XWETLBDAS_MAX/XWETLBDAS_MIN) / REAL(NWETLBDAS-1)
+XWETINTP1S = 1.0 / ZRATE
+XWETINTP2S = 1.0 - LOG( XWETLBDAS_MIN ) / ZRATE
+NWETLBDAG = 40
+XWETLBDAG_MIN = 1.0E3 ! Min value of Lbda_g to tabulate XKER_GWETH
+XWETLBDAG_MAX = 1.0E7 ! Max value of Lbda_g to tabulate XKER_GWETH
+ZRATE = LOG(XWETLBDAG_MAX/XWETLBDAG_MIN) / REAL(NWETLBDAG-1)
+XWETINTP1G = 1.0 / ZRATE
+XWETINTP2G = 1.0 - LOG( XWETLBDAG_MIN ) / ZRATE
+NWETLBDAH = 40
+XWETLBDAH_MIN = 1.0E3 ! Min value of Lbda_h to tabulate XKER_SWETH,XKER_GWETH
+XWETLBDAH_MAX = 1.0E7 ! Max value of Lbda_h to tabulate XKER_SWETH,XKER_GWETH
+ZRATE = LOG(XWETLBDAH_MAX/XWETLBDAH_MIN) / REAL(NWETLBDAH-1)
+XWETINTP1H = 1.0 / ZRATE
+XWETINTP2H = 1.0 - LOG( XWETLBDAH_MIN ) / ZRATE
+!
+!* 9.2.4 Computations of the tabulated normalized kernels
+!
+IND = 50 ! Interval number, collection efficiency and infinite diameter
+ZEHS = 1.0 ! factor used to integrate the dimensional distributions when
+ZFDINFTY = 20.0 ! computing the kernels XKER_SWETH
+!
+IF( .NOT.ALLOCATED(XKER_SWETH) ) ALLOCATE( XKER_SWETH(NWETLBDAH,NWETLBDAS) )
+!
+CALL READ_XKER_SWETH (KWETLBDAH,KWETLBDAS,KND, &
+ PALPHAH,PNUH,PALPHAS,PNUS,PEHS,PBS,PCH,PDH,PCS,PDS, &
+ PWETLBDAH_MAX,PWETLBDAS_MAX,PWETLBDAH_MIN,PWETLBDAS_MIN, &
+ PFDINFTY )
+IF( (KWETLBDAH/=NWETLBDAH) .OR. (KWETLBDAS/=NWETLBDAS) .OR. (KND/=IND) .OR. &
+ (PALPHAH/=XALPHAH) .OR. (PNUH/=XNUH) .OR. &
+ (PALPHAS/=XALPHAS) .OR. (PNUS/=XNUS) .OR. &
+ (PEHS/=ZEHS) .OR. (PBS/=XBS) .OR. &
+ (PCH/=XCH) .OR. (PDH/=XDH) .OR. (PCS/=XCS) .OR. (PDS/=XDS) .OR. &
+ (PWETLBDAH_MAX/=XWETLBDAH_MAX) .OR. (PWETLBDAS_MAX/=XWETLBDAS_MAX) .OR. &
+ (PWETLBDAH_MIN/=XWETLBDAH_MIN) .OR. (PWETLBDAS_MIN/=XWETLBDAS_MIN) .OR. &
+ (PFDINFTY/=ZFDINFTY) ) THEN
+ CALL RZCOLX ( IND, XALPHAH, XNUH, XALPHAS, XNUS, &
+ ZEHS, XBS, XCH, XDH, XCS, XDS, &
+ XWETLBDAH_MAX, XWETLBDAS_MAX, XWETLBDAH_MIN, XWETLBDAS_MIN, &
+ ZFDINFTY, XKER_SWETH )
+ WRITE(UNIT=KLUOUT,FMT='("*****************************************")')
+ WRITE(UNIT=KLUOUT,FMT='("**** UPDATE NEW SET OF SWETH KERNELS ****")')
+ WRITE(UNIT=KLUOUT,FMT='("*****************************************")')
+ WRITE(UNIT=KLUOUT,FMT='("!")')
+ WRITE(UNIT=KLUOUT,FMT='("KND=",I3)') IND
+ WRITE(UNIT=KLUOUT,FMT='("KWETLBDAH=",I3)') NWETLBDAH
+ WRITE(UNIT=KLUOUT,FMT='("KWETLBDAS=",I3)') NWETLBDAS
+ WRITE(UNIT=KLUOUT,FMT='("PALPHAH=",E13.6)') XALPHAH
+ WRITE(UNIT=KLUOUT,FMT='("PNUH=",E13.6)') XNUH
+ WRITE(UNIT=KLUOUT,FMT='("PALPHAS=",E13.6)') XALPHAS
+ WRITE(UNIT=KLUOUT,FMT='("PNUS=",E13.6)') XNUS
+ WRITE(UNIT=KLUOUT,FMT='("PEHS=",E13.6)') ZEHS
+ WRITE(UNIT=KLUOUT,FMT='("PBS=",E13.6)') XBS
+ WRITE(UNIT=KLUOUT,FMT='("PCH=",E13.6)') XCH
+ WRITE(UNIT=KLUOUT,FMT='("PDH=",E13.6)') XDH
+ WRITE(UNIT=KLUOUT,FMT='("PCS=",E13.6)') XCS
+ WRITE(UNIT=KLUOUT,FMT='("PDS=",E13.6)') XDS
+ WRITE(UNIT=KLUOUT,FMT='("PWETLBDAH_MAX=",E13.6)') &
+ XWETLBDAH_MAX
+ WRITE(UNIT=KLUOUT,FMT='("PWETLBDAS_MAX=",E13.6)') &
+ XWETLBDAS_MAX
+ WRITE(UNIT=KLUOUT,FMT='("PWETLBDAH_MIN=",E13.6)') &
+ XWETLBDAH_MIN
+ WRITE(UNIT=KLUOUT,FMT='("PWETLBDAS_MIN=",E13.6)') &
+ XWETLBDAS_MIN
+ WRITE(UNIT=KLUOUT,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
+ WRITE(UNIT=KLUOUT,FMT='("!")')
+ WRITE(UNIT=KLUOUT,FMT='("IF( PRESENT(PKER_SWETH) ) THEN")')
+ DO J1 = 1 , NWETLBDAH
+ DO J2 = 1 , NWETLBDAS
+ WRITE(UNIT=KLUOUT,FMT='("PKER_SWETH(",I3,",",I3,") = ",E13.6)') &
+ J1,J2,XKER_SWETH(J1,J2)
+ END DO
+ END DO
+ WRITE(UNIT=KLUOUT,FMT='("END IF")')
+ ELSE
+ CALL READ_XKER_SWETH (KWETLBDAH,KWETLBDAS,KND, &
+ PALPHAH,PNUH,PALPHAS,PNUS,PEHS,PBS,PCH,PDH,PCS,PDS, &
+ PWETLBDAH_MAX,PWETLBDAS_MAX,PWETLBDAH_MIN,PWETLBDAS_MIN, &
+ PFDINFTY,XKER_SWETH )
+ WRITE(UNIT=KLUOUT,FMT='(" Read XKER_SWETH")')
+END IF
+!
+!
+IND = 50 ! Number of interval used to integrate the dimensional
+ZEHG = 1.0 ! distributions when computing the kernel XKER_GWETH
+ZFDINFTY = 20.0
+!
+IF( .NOT.ALLOCATED(XKER_GWETH) ) ALLOCATE( XKER_GWETH(NWETLBDAH,NWETLBDAG) )
+!
+CALL READ_XKER_GWETH (KWETLBDAH,KWETLBDAG,KND, &
+ PALPHAH,PNUH,PALPHAG,PNUG,PEHG,PBG,PCH,PDH,PCG,PDG, &
+ PWETLBDAH_MAX,PWETLBDAG_MAX,PWETLBDAH_MIN,PWETLBDAG_MIN, &
+ PFDINFTY )
+IF( (KWETLBDAH/=NWETLBDAH) .OR. (KWETLBDAG/=NWETLBDAG) .OR. (KND/=IND) .OR. &
+ (PALPHAH/=XALPHAH) .OR. (PNUH/=XNUH) .OR. &
+ (PALPHAG/=XALPHAG) .OR. (PNUG/=XNUG) .OR. &
+ (PEHG/=ZEHG) .OR. (PBG/=XBG) .OR. &
+ (PCH/=XCH) .OR. (PDH/=XDH) .OR. (PCG/=XCG) .OR. (PDG/=XDG) .OR. &
+ (PWETLBDAH_MAX/=XWETLBDAH_MAX) .OR. (PWETLBDAG_MAX/=XWETLBDAG_MAX) .OR. &
+ (PWETLBDAH_MIN/=XWETLBDAH_MIN) .OR. (PWETLBDAG_MIN/=XWETLBDAG_MIN) .OR. &
+ (PFDINFTY/=ZFDINFTY) ) THEN
+ CALL RZCOLX ( IND, XALPHAH, XNUH, XALPHAG, XNUG, &
+ ZEHG, XBG, XCH, XDH, XCG, XDG, &
+ XWETLBDAH_MAX, XWETLBDAG_MAX, XWETLBDAH_MIN, XWETLBDAG_MIN, &
+ ZFDINFTY, XKER_GWETH )
+ WRITE(UNIT=KLUOUT,FMT='("*****************************************")')
+ WRITE(UNIT=KLUOUT,FMT='("**** UPDATE NEW SET OF GWETH KERNELS ****")')
+ WRITE(UNIT=KLUOUT,FMT='("*****************************************")')
+ WRITE(UNIT=KLUOUT,FMT='("!")')
+ WRITE(UNIT=KLUOUT,FMT='("KND=",I3)') IND
+ WRITE(UNIT=KLUOUT,FMT='("KWETLBDAH=",I3)') NWETLBDAH
+ WRITE(UNIT=KLUOUT,FMT='("KWETLBDAG=",I3)') NWETLBDAG
+ WRITE(UNIT=KLUOUT,FMT='("PALPHAH=",E13.6)') XALPHAH
+ WRITE(UNIT=KLUOUT,FMT='("PNUH=",E13.6)') XNUH
+ WRITE(UNIT=KLUOUT,FMT='("PALPHAG=",E13.6)') XALPHAG
+ WRITE(UNIT=KLUOUT,FMT='("PNUG=",E13.6)') XNUG
+ WRITE(UNIT=KLUOUT,FMT='("PEHG=",E13.6)') ZEHG
+ WRITE(UNIT=KLUOUT,FMT='("PBG=",E13.6)') XBG
+ WRITE(UNIT=KLUOUT,FMT='("PCH=",E13.6)') XCH
+ WRITE(UNIT=KLUOUT,FMT='("PDH=",E13.6)') XDH
+ WRITE(UNIT=KLUOUT,FMT='("PCG=",E13.6)') XCG
+ WRITE(UNIT=KLUOUT,FMT='("PDG=",E13.6)') XDG
+ WRITE(UNIT=KLUOUT,FMT='("PWETLBDAH_MAX=",E13.6)') &
+ XWETLBDAH_MAX
+ WRITE(UNIT=KLUOUT,FMT='("PWETLBDAG_MAX=",E13.6)') &
+ XWETLBDAG_MAX
+ WRITE(UNIT=KLUOUT,FMT='("PWETLBDAH_MIN=",E13.6)') &
+ XWETLBDAH_MIN
+ WRITE(UNIT=KLUOUT,FMT='("PWETLBDAG_MIN=",E13.6)') &
+ XWETLBDAG_MIN
+ WRITE(UNIT=KLUOUT,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
+ WRITE(UNIT=KLUOUT,FMT='("!")')
+ WRITE(UNIT=KLUOUT,FMT='("IF( PRESENT(PKER_GWETH) ) THEN")')
+ DO J1 = 1 , NWETLBDAH
+ DO J2 = 1 , NWETLBDAG
+ WRITE(UNIT=KLUOUT,FMT='("PKER_GWETH(",I3,",",I3,") = ",E13.6)') &
+ J1,J2,XKER_GWETH(J1,J2)
+ END DO
+ END DO
+ WRITE(UNIT=KLUOUT,FMT='("END IF")')
+ ELSE
+ CALL READ_XKER_GWETH (KWETLBDAH,KWETLBDAG,KND, &
+ PALPHAH,PNUH,PALPHAG,PNUG,PEHG,PBG,PCH,PDH,PCG,PDG, &
+ PWETLBDAH_MAX,PWETLBDAG_MAX,PWETLBDAH_MIN,PWETLBDAG_MIN, &
+ PFDINFTY,XKER_GWETH )
+ WRITE(UNIT=KLUOUT,FMT='(" Read XKER_GWETH")')
+END IF
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 10. SOME PRINTS FOR CONTROL
+! -----------------------
+!
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=KLUOUT,FMT='(" Summary of the ice particule characteristics")')
+ WRITE(UNIT=KLUOUT,FMT='(" PRISTINE ICE")')
+ WRITE(UNIT=KLUOUT,FMT='(" masse: A=",E13.6," B=",E13.6)') &
+ XAI,XBI
+ WRITE(UNIT=KLUOUT,FMT='(" vitesse: C=",E13.6," D=",E13.6)') &
+ XC_I,XDI
+ WRITE(UNIT=KLUOUT,FMT='(" distribution:AL=",E13.6,"NU=",E13.6)') &
+ XALPHAI,XNUI
+ WRITE(UNIT=KLUOUT,FMT='(" SNOW")')
+ WRITE(UNIT=KLUOUT,FMT='(" masse: A=",E13.6," B=",E13.6)') &
+ XAS,XBS
+ WRITE(UNIT=KLUOUT,FMT='(" vitesse: C=",E13.6," D=",E13.6)') &
+ XCS,XDS
+ WRITE(UNIT=KLUOUT,FMT='(" concentration:CC=",E13.6," x=",E13.6)') &
+ XCCS,XCXS
+ WRITE(UNIT=KLUOUT,FMT='(" distribution:AL=",E13.6,"NU=",E13.6)') &
+ XALPHAS,XNUS
+ WRITE(UNIT=KLUOUT,FMT='(" GRAUPEL")')
+ WRITE(UNIT=KLUOUT,FMT='(" masse: A=",E13.6," B=",E13.6)') &
+ XAG,XBG
+ WRITE(UNIT=KLUOUT,FMT='(" vitesse: C=",E13.6," D=",E13.6)') &
+ XCG,XDG
+ WRITE(UNIT=KLUOUT,FMT='(" concentration:CC=",E13.6," x=",E13.6)') &
+ XCCG,XCXG
+ WRITE(UNIT=KLUOUT,FMT='(" distribution:AL=",E13.6,"NU=",E13.6)') &
+ XALPHAG,XNUG
+ WRITE(UNIT=KLUOUT,FMT='(" HAIL")')
+ WRITE(UNIT=KLUOUT,FMT='(" masse: A=",E13.6," B=",E13.6)') &
+ XAH,XBH
+ WRITE(UNIT=KLUOUT,FMT='(" vitesse: C=",E13.6," D=",E13.6)') &
+ XCH,XDH
+ WRITE(UNIT=KLUOUT,FMT='(" concentration:CC=",E13.6," x=",E13.6)') &
+ XCCH,XCXH
+ WRITE(UNIT=KLUOUT,FMT='(" distribution:AL=",E13.6,"NU=",E13.6)') &
+ XALPHAH,XNUH
+END IF
+!
+KINTVL = IND
+PFDINFTY = ZFDINFTY
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE INI_RAIN_ICE_ELEC
diff --git a/src/mesonh/micro/init_aerosol_properties.f90 b/src/mesonh/micro/init_aerosol_properties.f90
new file mode 100644
index 000000000..52f7ddc88
--- /dev/null
+++ b/src/mesonh/micro/init_aerosol_properties.f90
@@ -0,0 +1,436 @@
+!MNH_LIC Copyright 2013-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ####################
+ MODULE MODI_INIT_AEROSOL_PROPERTIES
+INTERFACE
+ SUBROUTINE INIT_AEROSOL_PROPERTIES
+ END SUBROUTINE INIT_AEROSOL_PROPERTIES
+END INTERFACE
+END MODULE MODI_INIT_AEROSOL_PROPERTIES
+! ####################
+!
+! #############################################################
+ SUBROUTINE INIT_AEROSOL_PROPERTIES
+! #############################################################
+
+!!
+!!
+!! PURPOSE
+!! -------
+!!
+!! Define the aerosol properties
+!!
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! Philippe Wautelet: 22/01/2019: bugs correction: incorrect writes + unauthorized goto
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+! P. Wautelet 30/03/2021: move NINDICE_CCN_IMM and NIMM initializations from init_aerosol_properties to ini_nsv
+! B. Vié 06/2021: kappa-kohler CCN activation parameters
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_LUNIT, ONLY : TLUOUT0
+USE MODD_PARAM_LIMA, ONLY : NMOD_CCN, HINI_CCN, HTYPE_CCN, &
+ XR_MEAN_CCN, XLOGSIG_CCN, XRHO_CCN, &
+ XKHEN_MULTI, XMUHEN_MULTI, XBETAHEN_MULTI, &
+ XLIMIT_FACTOR, CCCN_MODES, LSCAV, &
+ XACTEMP_CCN, XFSOLUB_CCN, &
+ NMOD_IFN, NSPECIE, CIFN_SPECIES, &
+ XMDIAM_IFN, XSIGMA_IFN, XRHO_IFN, XFRAC, XFRAC_REF, &
+ CINT_MIXING, NPHILLIPS
+!
+use mode_msg
+!
+USE MODI_GAMMA
+USE MODI_LIMA_INIT_CCN_ACTIVATION_SPECTRUM
+!
+IMPLICIT NONE
+!
+REAL :: XKHEN0
+REAL :: XLOGSIG0
+REAL :: XALPHA1
+REAL :: XMUHEN0
+REAL :: XALPHA2
+REAL :: XBETAHEN0
+REAL :: XR_MEAN0
+REAL :: XALPHA3
+REAL :: XALPHA4
+REAL :: XALPHA5
+REAL :: XACTEMP0
+REAL :: XALPHA6
+!
+REAL, DIMENSION(6) :: XKHEN_TMP = (/1.56, 1.56, 1.56, 1.56, 1.56, 1.56 /)
+REAL, DIMENSION(6) :: XMUHEN_TMP = (/0.80, 0.80, 0.80, 0.80, 0.80, 0.80 /)
+REAL, DIMENSION(6) :: XBETAHEN_TMP= (/136., 136., 136., 136., 136., 136. /)
+!
+REAL, DIMENSION(3) :: RCCN
+REAL, DIMENSION(3) :: LOGSIGCCN
+REAL, DIMENSION(3) :: RHOCCN
+!
+INTEGER :: I,J,JMOD
+!
+INTEGER :: ILUOUT0 ! Logical unit number for output-listing
+INTEGER :: IRESP ! Return code of FM-routines
+!
+REAL :: X1, X2, X3, X4, X5
+! REAL, DIMENSION(7) :: diameters=(/ 0.01E-6, 0.05E-6, 0.1E-6, 0.2E-6, 0.5E-6, 1.E-6, 2.E-6 /)
+! REAL, DIMENSION(3) :: sigma=(/ 2., 2.5, 3. /)
+! CHARACTER(LEN=7), DIMENSION(3) :: types=(/ 'NH42SO4', 'NaCl ', ' ' /)
+!REAL, DIMENSION(1) :: diameters=(/ 0.25E-6 /)
+!CHARACTER(LEN=7), DIMENSION(1) :: types=(/ ' ' /)
+INTEGER :: II, IJ, IK
+!
+!-------------------------------------------------------------------------------
+!
+ILUOUT0 = TLUOUT0%NLU
+!
+!!!!!!!!!!!!!!!!
+! CCN properties
+!!!!!!!!!!!!!!!!
+!
+IF ( NMOD_CCN .GE. 1 ) THEN
+!
+ IF (.NOT.(ALLOCATED(XR_MEAN_CCN))) ALLOCATE(XR_MEAN_CCN(NMOD_CCN))
+ IF (.NOT.(ALLOCATED(XLOGSIG_CCN))) ALLOCATE(XLOGSIG_CCN(NMOD_CCN))
+ IF (.NOT.(ALLOCATED(XRHO_CCN))) ALLOCATE(XRHO_CCN(NMOD_CCN))
+!
+ SELECT CASE (CCCN_MODES)
+ CASE ('JUNGFRAU')
+ RCCN(:) = (/ 0.02E-6 , 0.058E-6 , 0.763E-6 /)
+ LOGSIGCCN(:) = (/ 0.28 , 0.57 , 0.34 /)
+ RHOCCN(:) = (/ 1500. , 1500. , 1500. /)
+ CASE ('COPT')
+ RCCN(:) = (/ 0.125E-6 , 0.4E-6 , 1.0E-6 /)
+ LOGSIGCCN(:) = (/ 0.69 , 0.41 , 0.47 /)
+ RHOCCN(:) = (/ 1000. , 1000. , 1000. /)
+ CASE ('CAMS')
+ RCCN(:) = (/ 0.4E-6 , 0.25E-6 , 0.1E-6 /)
+ LOGSIGCCN(:) = (/ 0.64 , 0.47 , 0.47 /)
+ RHOCCN(:) = (/ 2160. , 2000. , 1750. /)
+ CASE ('CAMS_JPP')
+! sea-salt, sulfate, hydrophilic (GADS data)
+ RCCN(:) = (/ 0.209E-6 , 0.0695E-6 , 0.0212E-6 /)
+ LOGSIGCCN(:) = (/ 0.708 , 0.708 , 0.806 /)
+ RHOCCN(:) = (/ 2200. , 1700. , 1800. /)
+ CASE ('CAMS_ACC')
+! sea-salt, sulfate, hydrophilic (GADS data)
+ RCCN(:) = (/ 0.2E-6 , 0.5E-6 , 0.4E-6 /)
+ LOGSIGCCN(:) = (/ 0.693 , 0.476 , 0.788 /)
+ RHOCCN(:) = (/ 2200. , 1700. , 1800. /)
+ CASE ('CAMS_AIT')
+! sea-salt, sulfate, hydrophilic (GADS data)
+ RCCN(:) = (/ 0.2E-6 , 0.05E-6 , 0.02E-6 /)
+ LOGSIGCCN(:) = (/ 0.693 , 0.693 , 0.788 /)
+ RHOCCN(:) = (/ 2200. , 1700. , 1800. /)
+ CASE ('SIRTA')
+ RCCN(:) = (/ 0.153E-6 , 0.058E-6 , 0.763E-6 /)
+ LOGSIGCCN(:) = (/ 0.846 , 0.57 , 0.34 /)
+ RHOCCN(:) = (/ 1500. , 1500. , 1500. /)
+ CASE ('CPS00')
+ RCCN(:) = (/ 0.0218E-6 , 0.058E-6 , 0.763E-6 /)
+ LOGSIGCCN(:) = (/ 1.16 , 0.57 , 0.34 /)
+ RHOCCN(:) = (/ 1500. , 1500. , 1500. /)
+ CASE ('MOCAGE') ! ordre : sulfates, sels marins, BC+O
+ RCCN(:) = (/ 0.01E-6 , 0.05E-6 , 0.008E-6 /)
+ LOGSIGCCN(:) = (/ 0.788 , 0.993 , 0.916 /)
+ RHOCCN(:) = (/ 1000. , 2200. , 1000. /)
+ CASE ('FREETROP') ! d'après Jaenicke 1993, aerosols troposphere libre, masse volumique typique
+ RCCN(:) = (/ 0.0035E-6 , 0.125E-6 , 0.26E-6 /)
+ LOGSIGCCN(:) = (/ 0.645 , 0.253 , 0.425 /)
+ RHOCCN(:) = (/ 1000. , 1000. , 1000. /)
+ CASE DEFAULT
+ call Print_msg(NVERB_FATAL,'GEN','INIT_AEROSOL_PROPERTIES','CCN_MODES must be JUNGFRAU, COPT, CAMS, CAMS_JPP,'// &
+ 'CAMS_ACC, CAMS_AIT, SIRTA, CPS00, MOCAGE or FREETROP')
+ ENDSELECT
+!
+ DO I=1, MIN(NMOD_CCN,3)
+ XR_MEAN_CCN(I) = RCCN(I)
+ XLOGSIG_CCN(I) = LOGSIGCCN(I)
+ XRHO_CCN(I) = RHOCCN(I)
+ END DO
+!
+ IF (NMOD_CCN .EQ. 4) THEN
+! default values as coarse sea salt mode
+ XR_MEAN_CCN(4) = 1.75E-6
+ XLOGSIG_CCN(4) = 0.708
+ XRHO_CCN(4) = 2200.
+ END IF
+!
+!
+! Compute CCN spectra parameters from CCN characteristics
+!
+!* INPUT : XBETAHEN_TEST is in 'percent' and XBETAHEN_MULTI in 'no units',
+! XK... and XMU... are invariant
+!
+ IF (.NOT.(ALLOCATED(XKHEN_MULTI))) ALLOCATE(XKHEN_MULTI(NMOD_CCN))
+ IF (.NOT.(ALLOCATED(XMUHEN_MULTI))) ALLOCATE(XMUHEN_MULTI(NMOD_CCN))
+ IF (.NOT.(ALLOCATED(XBETAHEN_MULTI))) ALLOCATE(XBETAHEN_MULTI(NMOD_CCN))
+ IF (.NOT.(ALLOCATED(XLIMIT_FACTOR))) ALLOCATE(XLIMIT_FACTOR(NMOD_CCN))
+!
+ IF (HINI_CCN == 'CCN') THEN
+ IF (LSCAV) THEN
+! Attention !
+ WRITE(UNIT=ILUOUT0,FMT='("You are using a numerical initialization &
+ ¬ depending on the aerosol properties, however you need it for &
+ &scavenging. &
+ &With LSCAV = true, HINI_CCN should be set to AER for consistency")')
+ END IF
+! Numerical initialization without dependence on AP physical properties
+ DO JMOD = 1, NMOD_CCN
+ XKHEN_MULTI(JMOD) = XKHEN_TMP(JMOD)
+ XMUHEN_MULTI(JMOD) = XMUHEN_TMP(JMOD)
+ XBETAHEN_MULTI(JMOD) = XBETAHEN_TMP(JMOD)*(100.)**2
+! no units relative to smax
+ XLIMIT_FACTOR(JMOD) = ( GAMMA_X0D(0.5*XKHEN_MULTI(JMOD)+1.)&
+ *GAMMA_X0D(XMUHEN_MULTI(JMOD)-0.5*XKHEN_MULTI(JMOD)) ) &
+ /( XBETAHEN_MULTI(JMOD)**(0.5*XKHEN_MULTI(JMOD)) &
+ *GAMMA_X0D(XMUHEN_MULTI(JMOD)) ) ! N/C
+ END DO
+ ELSE IF (HINI_CCN == 'AER') THEN
+!
+! Initialisation depending on aerosol physical properties
+!
+! First, computing k, mu, beta, and XLIMIT_FACTOR as in CPS2000 (eqs 9a-9c)
+!
+! XLIMIT_FACTOR replaces C, because C depends on the CCN number concentration
+! which is therefore determined at each grid point and time step as
+! Nccn / XLIMIT_FACTOR
+!
+ DO JMOD = 1, NMOD_CCN
+!
+!!$ SELECT CASE (HTYPE_CCN(JMOD))
+!!$ CASE ('M') ! CCN marins
+!!$ XKHEN0 = 3.251
+!!$ XLOGSIG0 = 0.4835
+!!$ XALPHA1 = -1.297
+!!$ XMUHEN0 = 2.589
+!!$ XALPHA2 = -1.511
+!!$ XBETAHEN0 = 621.689
+!!$ XR_MEAN0 = 0.133E-6
+!!$ XALPHA3 = 3.002
+!!$ XALPHA4 = 1.081
+!!$ XALPHA5 = 1.0
+!!$ XACTEMP0 = 290.16
+!!$ XALPHA6 = 2.995
+!!$ CASE ('C') ! CCN continentaux
+!!$ XKHEN0 = 1.403
+!!$ XLOGSIG0 = 1.16
+!!$ XALPHA1 = -1.172
+!!$ XMUHEN0 = 0.834
+!!$ XALPHA2 = -1.350
+!!$ XBETAHEN0 = 25.499
+!!$ XR_MEAN0 = 0.0218E-6
+!!$ XALPHA3 = 3.057
+!!$ XALPHA4 = 4.092
+!!$ XALPHA5 = 1.011
+!!$ XACTEMP0 = 290.16
+!!$ XALPHA6 = 3.076
+!!$ CASE DEFAULT
+!!$ call Print_msg(NVERB_FATAL,'GEN','INIT_AEROSOL_PROPERTIES','HTYPE_CNN(JMOD)=C or M must be specified'// &
+!!$ ' in EXSEG1.nam for each CCN mode')
+!!$ ENDSELECT
+!!$!
+!!$ XKHEN_MULTI(JMOD) = XKHEN0*(XLOGSIG_CCN(JMOD)/XLOGSIG0)**XALPHA1
+!!$ XMUHEN_MULTI(JMOD) = XMUHEN0*(XLOGSIG_CCN(JMOD)/XLOGSIG0)**XALPHA2
+!!$ XBETAHEN_MULTI(JMOD)=XBETAHEN0*(XR_MEAN_CCN(JMOD)/XR_MEAN0)**XALPHA3 &
+!!$ * EXP( XALPHA4*((XLOGSIG_CCN(JMOD)/XLOGSIG0)-1.) ) &
+!!$ * XFSOLUB_CCN**XALPHA5 &
+!!$ * (XACTEMP_CCN/XACTEMP0)**XALPHA6
+!!$ XLIMIT_FACTOR(JMOD) = ( GAMMA_X0D(0.5*XKHEN_MULTI(JMOD)+1.) &
+!!$ *GAMMA_X0D(XMUHEN_MULTI(JMOD)-0.5*XKHEN_MULTI(JMOD)) ) &
+!!$ /( XBETAHEN_MULTI(JMOD)**(0.5*XKHEN_MULTI(JMOD)) &
+!!$ *GAMMA_X0D(XMUHEN_MULTI(JMOD)) )
+!!$
+!!$
+ CALL LIMA_INIT_CCN_ACTIVATION_SPECTRUM (HTYPE_CCN(JMOD),XR_MEAN_CCN(JMOD)*2.,EXP(XLOGSIG_CCN(JMOD)),X1,X2,X3,X4,X5)
+ !
+ ! LIMA_INIT_CCN_ACTIVATION_SPECTRUM returns X1=C/Nccn (instead of XLIMIT_FACTOR), X2=k, X3=mu, X4=beta, X5=kappa
+ ! So XLIMIT_FACTOR = 1/X1
+ ! Nc = Nccn/XLIMIT_FACTOR * S^k *F() = Nccn * X1 * S^k *F()
+ !
+ XLIMIT_FACTOR(JMOD) = 1./X1
+ XKHEN_MULTI(JMOD) = X2
+ XMUHEN_MULTI(JMOD) = X3
+ XBETAHEN_MULTI(JMOD)= X4
+ ENDDO
+!
+! These parameters are correct for a nucleation spectra
+! Nccn(Smax) = C Smax^k F(mu,k/2,1+k/2,-beta Smax^2)
+! with Smax expressed in % (Smax=1 for a supersaturation of 1%).
+!
+! All the computations in LIMA are done for an adimensional Smax (Smax=0.01 for
+! a 1% supersaturation). So beta and C (XLIMIT_FACTOR) are changed :
+! new_beta = beta * 100^2
+! new_C = C * 100^k (ie XLIMIT_FACTOR = XLIMIT_FACTOR / 100^k)
+!
+ XBETAHEN_MULTI(:) = XBETAHEN_MULTI(:) * 10000
+ XLIMIT_FACTOR(:) = XLIMIT_FACTOR(:) / (100**XKHEN_MULTI(:))
+ END IF
+END IF ! NMOD_CCN > 0
+!
+!!!!!!!!!!!!!!!!
+! IFN properties
+!!!!!!!!!!!!!!!!
+!
+IF ( NMOD_IFN .GE. 1 ) THEN
+ SELECT CASE (CIFN_SPECIES)
+ CASE ('MOCAGE')
+ NSPECIE = 4
+ IF (.NOT.(ALLOCATED(XMDIAM_IFN))) ALLOCATE(XMDIAM_IFN(NSPECIE))
+ IF (.NOT.(ALLOCATED(XSIGMA_IFN))) ALLOCATE(XSIGMA_IFN(NSPECIE))
+ IF (.NOT.(ALLOCATED(XRHO_IFN))) ALLOCATE(XRHO_IFN(NSPECIE))
+ XMDIAM_IFN = (/ 0.05E-6 , 3.E-6 , 0.016E-6 , 0.016E-6 /)
+ XSIGMA_IFN = (/ 2.4 , 1.6 , 2.5 , 2.5 /)
+ XRHO_IFN = (/ 2650. , 2650. , 1000. , 1000. /)
+ CASE ('CAMS_JPP')
+! sea-salt, sulfate, hydrophilic (GADS data)
+! 2 species, dust-metallic and hydrophobic (as BC)
+! (Phillips et al. 2013 and GADS data)
+ NSPECIE = 4 ! DM1, DM2, BC, BIO+(O)
+ IF (.NOT.(ALLOCATED(XMDIAM_IFN))) ALLOCATE(XMDIAM_IFN(NSPECIE))
+ IF (.NOT.(ALLOCATED(XSIGMA_IFN))) ALLOCATE(XSIGMA_IFN(NSPECIE))
+ IF (.NOT.(ALLOCATED(XRHO_IFN))) ALLOCATE(XRHO_IFN(NSPECIE))
+ XMDIAM_IFN = (/0.8E-6, 3.0E-6, 0.025E-6, 0.2E-6/)
+ XSIGMA_IFN = (/2.0, 2.15, 2.0, 1.6 /)
+ XRHO_IFN = (/2600., 2600., 1000., 1500./)
+ CASE ('CAMS_ACC')
+! sea-salt, sulfate, hydrophilic (GADS data)
+! 2 species, dust-metallic and hydrophobic (as BC)
+! (Phillips et al. 2013 and GADS data)
+ NSPECIE = 4 ! DM1, DM2, BC, BIO+(O)
+ IF (.NOT.(ALLOCATED(XMDIAM_IFN))) ALLOCATE(XMDIAM_IFN(NSPECIE))
+ IF (.NOT.(ALLOCATED(XSIGMA_IFN))) ALLOCATE(XSIGMA_IFN(NSPECIE))
+ IF (.NOT.(ALLOCATED(XRHO_IFN))) ALLOCATE(XRHO_IFN(NSPECIE))
+ XMDIAM_IFN = (/0.8E-6, 3.0E-6, 0.04E-6, 0.8E-6 /)
+ XSIGMA_IFN = (/2.0, 2.15, 2.0, 2.2 /)
+ XRHO_IFN = (/2600., 2600., 1000., 2000. /)
+ CASE ('CAMS_AIT')
+! sea-salt, sulfate, hydrophilic (GADS data)
+! 2 species, dust-metallic and hydrophobic (as BC)
+! (Phillips et al. 2013 and GADS data)
+ NSPECIE = 4 ! DM1, DM2, BC, BIO+(O)
+ IF (.NOT.(ALLOCATED(XMDIAM_IFN))) ALLOCATE(XMDIAM_IFN(NSPECIE))
+ IF (.NOT.(ALLOCATED(XSIGMA_IFN))) ALLOCATE(XSIGMA_IFN(NSPECIE))
+ IF (.NOT.(ALLOCATED(XRHO_IFN))) ALLOCATE(XRHO_IFN(NSPECIE))
+ XMDIAM_IFN = (/0.8E-6, 3.0E-6, 0.04E-6, 0.04E-6/)
+ XSIGMA_IFN = (/2.0, 2.15, 2.0, 2.2 /)
+ XRHO_IFN = (/2600., 2600., 1000., 1800./)
+ CASE DEFAULT
+ IF (NPHILLIPS == 8) THEN
+! 4 species, according to Phillips et al. 2008
+ NSPECIE = 4
+ IF (.NOT.(ALLOCATED(XMDIAM_IFN))) ALLOCATE(XMDIAM_IFN(NSPECIE))
+ IF (.NOT.(ALLOCATED(XSIGMA_IFN))) ALLOCATE(XSIGMA_IFN(NSPECIE))
+ IF (.NOT.(ALLOCATED(XRHO_IFN))) ALLOCATE(XRHO_IFN(NSPECIE))
+ XMDIAM_IFN = (/0.8E-6, 3.0E-6, 0.2E-6, 0.2E-6/)
+ XSIGMA_IFN = (/1.9, 1.6, 1.6, 1.6 /)
+ XRHO_IFN = (/2300., 2300., 1860., 1500./)
+ ELSE IF (NPHILLIPS == 13) THEN
+! 4 species, according to Phillips et al. 2013
+ NSPECIE = 4
+ IF (.NOT.(ALLOCATED(XMDIAM_IFN))) ALLOCATE(XMDIAM_IFN(NSPECIE))
+ IF (.NOT.(ALLOCATED(XSIGMA_IFN))) ALLOCATE(XSIGMA_IFN(NSPECIE))
+ IF (.NOT.(ALLOCATED(XRHO_IFN))) ALLOCATE(XRHO_IFN(NSPECIE))
+ XMDIAM_IFN = (/0.8E-6, 3.0E-6, 90.E-9, 0.163E-6/)
+ XSIGMA_IFN = (/1.9, 1.6, 1.6, 2.54 /)
+ XRHO_IFN = (/2300., 2300., 1860., 1000./)
+ END IF
+ ENDSELECT
+!
+! internal mixing
+!
+ IF (.NOT.(ALLOCATED(XFRAC))) ALLOCATE(XFRAC(NSPECIE,NMOD_IFN))
+ XFRAC(:,:)=0.
+ SELECT CASE (CINT_MIXING)
+ CASE ('DM1')
+ XFRAC(1,:)=1.
+ CASE ('DM2')
+ XFRAC(2,:)=1.
+ CASE ('BC')
+ XFRAC(3,:)=1.
+ CASE ('O')
+ XFRAC(4,:)=1.
+ CASE ('CAMS')
+ XFRAC(1,1)=0.99
+ XFRAC(2,1)=0.01
+ XFRAC(3,1)=0.
+ XFRAC(4,1)=0.
+ XFRAC(1,2)=0.
+ XFRAC(2,2)=0.
+ XFRAC(3,2)=0.5
+ XFRAC(4,2)=0.5
+ CASE ('CAMS_JPP')
+ XFRAC(1,1)=1.0
+ XFRAC(2,1)=0.0
+ XFRAC(3,1)=0.0
+ XFRAC(4,1)=0.0
+ XFRAC(1,2)=0.0
+ XFRAC(2,2)=0.0
+ XFRAC(3,2)=0.5
+ XFRAC(4,2)=0.5
+ CASE ('CAMS_ACC')
+ XFRAC(1,1)=1.0
+ XFRAC(2,1)=0.0
+ XFRAC(3,1)=0.0
+ XFRAC(4,1)=0.0
+ XFRAC(1,2)=0.0
+ XFRAC(2,2)=0.0
+ XFRAC(3,2)=0.0
+ XFRAC(4,2)=1.0
+ CASE ('CAMS_AIT')
+ XFRAC(1,1)=1.0
+ XFRAC(2,1)=0.0
+ XFRAC(3,1)=0.0
+ XFRAC(4,1)=0.0
+ XFRAC(1,2)=0.0
+ XFRAC(2,2)=0.0
+ XFRAC(3,2)=0.0
+ XFRAC(4,2)=1.0
+ CASE ('MOCAGE')
+ XFRAC(1,1)=1.
+ XFRAC(2,1)=0.
+ XFRAC(3,1)=0.
+ XFRAC(4,1)=0.
+ XFRAC(1,2)=0.
+ XFRAC(2,2)=0.
+ XFRAC(3,2)=0.7
+ XFRAC(4,2)=0.3
+ CASE DEFAULT
+ XFRAC(1,:)=0.6
+ XFRAC(2,:)=0.009
+ XFRAC(3,:)=0.33
+ XFRAC(4,:)=0.06
+ ENDSELECT
+!
+! Phillips 08 alpha (table 1)
+ IF (.NOT.(ALLOCATED(XFRAC_REF))) ALLOCATE(XFRAC_REF(4))
+ IF (NPHILLIPS == 13) THEN
+ XFRAC_REF(1)=0.66
+ XFRAC_REF(2)=0.66
+ XFRAC_REF(3)=0.31
+ XFRAC_REF(4)=0.03
+ ELSE IF (NPHILLIPS == 8) THEN
+ XFRAC_REF(1)=0.66
+ XFRAC_REF(2)=0.66
+ XFRAC_REF(3)=0.28
+ XFRAC_REF(4)=0.06
+ END IF
+!
+END IF ! NMOD_IFN > 0
+!
+END SUBROUTINE INIT_AEROSOL_PROPERTIES
diff --git a/src/mesonh/micro/lima.f90 b/src/mesonh/micro/lima.f90
new file mode 100644
index 000000000..c248f1acf
--- /dev/null
+++ b/src/mesonh/micro/lima.f90
@@ -0,0 +1,1803 @@
+!MNH_LIC Copyright 2013-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ######spl
+MODULE MODI_LIMA
+! ####################
+!
+INTERFACE
+!
+ SUBROUTINE LIMA ( KKA, KKU, KKL, &
+ PTSTEP, TPFILE, &
+ PRHODREF, PEXNREF, PDZZ, &
+ PRHODJ, PPABSM, PPABST, &
+ NCCN, NIFN, NIMM, &
+ PDTHRAD, PTHT, PRT, PSVT, PW_NU, &
+ PTHS, PRS, PSVS, &
+ PINPRC, PINDEP, PINPRR, PINPRI, PINPRS, PINPRG, PINPRH, &
+ PEVAP3D, PCLDFR, PICEFR, PPRCFR )
+!
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_NSV, only: NSV_LIMA_BEG
+!
+INTEGER, INTENT(IN) :: KKA !near ground array index
+INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
+!
+REAL, INTENT(IN) :: PTSTEP ! Time step
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Layer thikness (m)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! absolute pressure at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! absolute pressure at t
+!
+INTEGER, INTENT(IN) :: NCCN ! for array size declarations
+INTEGER, INTENT(IN) :: NIFN ! for array size declarations
+INTEGER, INTENT(IN) :: NIMM ! for array size declarations
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD ! dT/dt due to radiation
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! Mixing ratios at time t
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(IN) :: PSVT ! Concentrations at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! w for CCN activation
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! Mixing ratios sources
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(INOUT) :: PSVS ! Concentration sources
+!
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRC ! Cloud instant precip
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINDEP ! Cloud droplets deposition
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRR ! Rain instant precip
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRI ! Rain instant precip
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRS ! Snow instant precip
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRG ! Graupel instant precip
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRH ! Rain instant precip
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PEVAP3D ! Rain evap profile
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR ! Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR ! Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PPRCFR ! Cloud fraction
+!
+END SUBROUTINE LIMA
+END INTERFACE
+END MODULE MODI_LIMA
+!
+!
+! ######spl
+ SUBROUTINE LIMA ( KKA, KKU, KKL, &
+ PTSTEP, TPFILE, &
+ PRHODREF, PEXNREF, PDZZ, &
+ PRHODJ, PPABSM, PPABST, &
+ NCCN, NIFN, NIMM, &
+ PDTHRAD, PTHT, PRT, PSVT, PW_NU, &
+ PTHS, PRS, PSVS, &
+ PINPRC, PINDEP, PINPRR, PINPRI, PINPRS, PINPRG, PINPRH, &
+ PEVAP3D, PCLDFR, PICEFR, PPRCFR )
+! ######################################################################
+!
+!! PURPOSE
+!! -------
+!! Compute explicit microphysical sources using the 2-moment scheme LIMA
+!! using the time-splitting method
+!!
+!! REFERENCE
+!! ---------
+!! Vié et al. (GMD, 2016)
+!! Meso-NH scientific documentation
+!!
+!! AUTHOR
+!! ------
+!! S. Riette * CNRM *
+!! B. Vié * CNRM *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 15/03/2018
+!!
+! B. Vie 02/2019: minor correction on budget
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets (no more budget calls in this subroutine)
+! P. Wautelet 26/02/2020: bugfix: corrected condition to write budget CORR_BU_RRS
+! B. Vie 03/03/2020: use DTHRAD instead of dT/dt in Smax diagnostic computation
+! P. Wautelet 28/05/2020: bugfix: correct array start for PSVT and PSVS
+! P. Wautelet 03/02/2021: budgets: add new source if LIMA splitting: CORR2
+! B. Vie 06/2021: add subgrid condensation with LIMA
+!-----------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+use modd_budget, only: lbu_enable, &
+ lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, lbudget_ri, &
+ lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, &
+ NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1, &
+ tbudgets
+USE MODD_CST, ONLY: XCI, XCL, XCPD, XCPV, XLSTT, XLVTT, XTT, XRHOLW, XP00, XRD
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_NSV, ONLY: NSV_LIMA_BEG, &
+ NSV_LIMA_NC, NSV_LIMA_NR, NSV_LIMA_CCN_FREE, NSV_LIMA_CCN_ACTI, &
+ NSV_LIMA_NI, NSV_LIMA_IFN_FREE, &
+ NSV_LIMA_IFN_NUCL, NSV_LIMA_IMM_NUCL, NSV_LIMA_HOM_HAZE
+USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
+USE MODD_PARAM_LIMA, ONLY: LCOLD, LRAIN, LWARM, NMOD_CCN, NMOD_IFN, NMOD_IMM, LHHONI, &
+ LACTIT, LFEEDBACKT, NMAXITER, XMRSTEP, XTSTEP_TS, &
+ LSEDC, LSEDI, XRTMIN, XCTMIN, LDEPOC, XVDEPOC, &
+ LHAIL, LSNOW
+USE MODD_PARAM_LIMA_COLD, ONLY: XAI, XBI
+USE MODD_PARAM_LIMA_WARM, ONLY: XLBC, XLBEXC, XAC, XBC, XAR, XBR
+USE MODD_TURB_n, ONLY: LSUBG_COND
+
+use mode_budget, only: Budget_store_add, Budget_store_init, Budget_store_end
+use mode_tools, only: Countjv
+
+USE MODI_LIMA_COMPUTE_CLOUD_FRACTIONS
+USE MODI_LIMA_DROPS_TO_DROPLETS_CONV
+USE MODI_LIMA_INST_PROCS
+USE MODI_LIMA_NUCLEATION_PROCS
+USE MODI_LIMA_SEDIMENTATION
+USE MODI_LIMA_TENDENCIES
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KKA !near ground array index
+INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
+!
+REAL, INTENT(IN) :: PTSTEP ! Time step
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Layer thikness (m)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! absolute pressure at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! absolute pressure at t
+!
+INTEGER, INTENT(IN) :: NCCN ! for array size declarations
+INTEGER, INTENT(IN) :: NIFN ! for array size declarations
+INTEGER, INTENT(IN) :: NIMM ! for array size declarations
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD ! dT/dt due to radiation
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! Mixing ratios at time t
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(IN) :: PSVT ! Concentrations at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! w for CCN activation
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! Mixing ratios sources
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(INOUT) :: PSVS ! Concentration sources
+!
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRC ! Cloud instant precip
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINDEP ! Cloud droplets deposition
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRR ! Rain instant precip
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRI ! Rain instant precip
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRS ! Snow instant precip
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRG ! Graupel instant precip
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRH ! Rain instant precip
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PEVAP3D ! Rain evap profile
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR ! Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR ! Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PPRCFR ! Cloud fraction
+!
+!* 0.2 Declarations of local variables :
+!
+!
+! Prognostic variables and sources
+REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: ZTHT, ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, ZRHT
+REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: ZCCT, ZCRT, ZCIT
+REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: ZTHS, ZRVS, ZRCS, ZRRS, ZRIS, ZRSS, ZRGS, ZRHS
+REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: ZCCS, ZCRS, ZCIS
+REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),NCCN) :: ZCCNFT, ZCCNAT
+REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),NCCN) :: ZCCNFS, ZCCNAS
+REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),NIFN) :: ZIFNFT, ZIFNNT
+REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),NIFN) :: ZIFNFS, ZIFNNS
+REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),NIMM) :: ZIMMNT
+REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),NIMM) :: ZIMMNS
+REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: ZHOMFT
+REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: ZHOMFS
+
+!
+! Other 3D thermodynamical variables
+REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: ZEXN, ZT
+
+!
+! Packed prognostic & thermo variables
+REAL, DIMENSION(:), ALLOCATABLE :: &
+ ZP1D, ZRHODREF1D, ZEXNREF1D, ZEXN1D, &
+ ZTHT1D, &
+ ZRVT1D, ZRCT1D, ZRRT1D, ZRIT1D, ZRST1D, ZRGT1D, ZRHT1D, &
+ ZCCT1D, ZCRT1D, ZCIT1D, &
+ ZEVAP1D
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZIFNN1D
+
+!
+! for each process & species inside the loop, we need 1D packed variables to store instant tendencies for hydrometeors
+REAL, DIMENSION(:), ALLOCATABLE :: &
+! mixing ratio & concentration changes by instantaneous processes (kg/kg and #/kg) :
+ Z_CR_BRKU, & ! spontaneous break up of drops (BRKU) : Nr
+ Z_TH_HONR, Z_RR_HONR, Z_CR_HONR, & ! rain drops homogeneous freezing (HONR) : rr, Nr, rg=-rr, th
+ Z_TH_IMLT, Z_RC_IMLT, Z_CC_IMLT, & ! ice melting (IMLT) : rc, Nc, ri=-rc, Ni=-Nc, th, IFNF, IFNA
+! mixing ratio & concentration tendencies by continuous processes (kg/kg/s and #/kg/s) :
+ Z_TH_HONC, Z_RC_HONC, Z_CC_HONC, & ! droplets homogeneous freezing (HONC) : rc, Nc, ri=-rc, Ni=-Nc, th
+ Z_CC_SELF, & ! self collection of droplets (SELF) : Nc
+ Z_RC_AUTO, Z_CC_AUTO, Z_CR_AUTO, & ! autoconversion of cloud droplets (AUTO) : rc, Nc, rr=-rc, Nr
+ Z_RC_ACCR, Z_CC_ACCR, & ! accretion of droplets by rain drops (ACCR) : rc, Nc, rr=-rr
+ Z_CR_SCBU, & ! self collectio break up of drops (SCBU) : Nr
+! Z_TH_EVAP, Z_RC_EVAP, Z_CC_EVAP, Z_RR_EVAP, Z_CR_EVAP, & ! evaporation of rain drops (EVAP) : rv=-rr-rc, rc, Nc, rr, Nr, th
+ Z_TH_EVAP, Z_RR_EVAP, & ! evaporation of rain drops (EVAP) : rv=-rr-rc, rc, Nc, rr, Nr, th
+ Z_RI_CNVI, Z_CI_CNVI, & ! conversion snow -> ice (CNVI) : ri, Ni, rs=-ri
+ Z_TH_DEPS, Z_RS_DEPS, & ! deposition of vapor on snow (DEPS) : rv=-rs, rs, th
+ Z_TH_DEPI, Z_RI_DEPI, & ! deposition of vapor on ice (DEPI) : rv=-ri, ri, th
+ Z_RI_CNVS, Z_CI_CNVS, & ! conversion ice -> snow (CNVS) : ri, Ni, rs=-ri
+ Z_RI_AGGS, Z_CI_AGGS, & ! aggregation of ice on snow (AGGS) : ri, Ni, rs=-ri
+ Z_TH_DEPG, Z_RG_DEPG, & ! deposition of vapor on graupel (DEPG) : rv=-rg, rg, th
+ Z_TH_BERFI, Z_RC_BERFI, & ! Bergeron (BERFI) : rc, ri=-rc, th
+ Z_TH_RIM, Z_RC_RIM, Z_CC_RIM, Z_RS_RIM, Z_RG_RIM, & ! cloud droplet riming (RIM) : rc, Nc, rs, rg, th
+ Z_RI_HMS, Z_CI_HMS, Z_RS_HMS, & ! hallett mossop snow (HMS) : ri, Ni, rs
+ Z_TH_ACC, Z_RR_ACC, Z_CR_ACC, Z_RS_ACC, Z_RG_ACC, & ! rain accretion on aggregates (ACC) : rr, Nr, rs, rg, th
+ Z_RS_CMEL, & ! conversion-melting (CMEL) : rs, rg=-rs
+ Z_TH_CFRZ, Z_RR_CFRZ, Z_CR_CFRZ, Z_RI_CFRZ, Z_CI_CFRZ, & ! rain freezing (CFRZ) : rr, Nr, ri, Ni, rg=-rr-ri, th
+ Z_TH_WETG, Z_RC_WETG, Z_CC_WETG, Z_RR_WETG, Z_CR_WETG, & ! wet growth of graupel (WETG) : rc, NC, rr, Nr, ri, Ni, rs, rg, rh, th
+ Z_RI_WETG, Z_CI_WETG, Z_RS_WETG, Z_RG_WETG, Z_RH_WETG, & ! wet growth of graupel (WETG) : rc, NC, rr, Nr, ri, Ni, rs, rg, rh, th
+ Z_TH_DRYG, Z_RC_DRYG, Z_CC_DRYG, Z_RR_DRYG, Z_CR_DRYG, & ! dry growth of graupel (DRYG) : rc, Nc, rr, Nr, ri, Ni, rs, rg, th
+ Z_RI_DRYG, Z_CI_DRYG, Z_RS_DRYG, Z_RG_DRYG, & ! dry growth of graupel (DRYG) : rc, Nc, rr, Nr, ri, Ni, rs, rg, th
+ Z_RI_HMG, Z_CI_HMG, Z_RG_HMG, & ! hallett mossop graupel (HMG) : ri, Ni, rg
+ Z_TH_GMLT, Z_RR_GMLT, Z_CR_GMLT, & ! graupel melting (GMLT) : rr, Nr, rg=-rr, th
+! Z_RC_WETH, Z_CC_WETH, Z_RR_WETH, Z_CR_WETH, & ! wet growth of hail (WETH) : rc, Nc, rr, Nr, ri, Ni, rs, rg, rh, th
+! Z_RI_WETH, Z_CI_WETH, Z_RS_WETH, Z_RG_WETH, Z_RH_WETH, & ! wet growth of hail (WETH) : rc, Nc, rr, Nr, ri, Ni, rs, rg, rh, th
+! Z_RG_COHG, & ! conversion of hail into graupel (COHG) : rg, rh
+! Z_RR_HMLT, Z_CR_HMLT ! hail melting (HMLT) : rr, Nr, rh=-rr, th
+ Z_RV_CORR2, Z_RC_CORR2, Z_RR_CORR2, Z_RI_CORR2, &
+ Z_CC_CORR2, Z_CR_CORR2, Z_CI_CORR2
+!
+! for the conversion from rain to cloud, we need a 3D variable instead of a 1D packed variable
+REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: &
+ Z_RR_CVRC, Z_CR_CVRC ! conversion of rain into cloud droplets (CVRC)
+
+!
+! Packed variables for total tendencies
+REAL, DIMENSION(:), ALLOCATABLE :: &
+ ZA_TH, ZA_RV, ZA_RC, ZA_CC, ZA_RR, ZA_CR, ZA_RI, ZA_CI, ZA_RS, ZA_RG, ZA_RH, & ! ZA = continuous tendencies (kg/kg/s = S variable)
+ ZB_TH, ZB_RV, ZB_RC, ZB_CC, ZB_RR, ZB_CR, ZB_RI, ZB_CI, ZB_RS, ZB_RG, ZB_RH ! ZB = instant mixing ratio change (kg/kg = T variable)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZB_IFNN
+
+!
+! for each process & species, we need 3D variables to store total mmr and conc change (kg/kg and #/kg and theta)
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: &
+! instantaneous processes :
+ ZTOT_CR_BRKU, & ! spontaneous break up of drops (BRKU)
+ ZTOT_TH_HONR, ZTOT_RR_HONR, ZTOT_CR_HONR, & ! rain drops homogeneous freezing (HONR)
+ ZTOT_TH_IMLT, ZTOT_RC_IMLT, ZTOT_CC_IMLT, & ! ice melting (IMLT)
+! continuous processes :
+ ZTOT_TH_HONC, ZTOT_RC_HONC, ZTOT_CC_HONC, & ! droplets homogeneous freezing (HONC)
+ ZTOT_CC_SELF, & ! self collection of droplets (SELF)
+ ZTOT_RC_AUTO, ZTOT_CC_AUTO, ZTOT_CR_AUTO, & ! autoconversion of cloud droplets (AUTO)
+ ZTOT_RC_ACCR, ZTOT_CC_ACCR, & ! accretion of droplets by rain drops (ACCR)
+ ZTOT_CR_SCBU, & ! self collectio break up of drops (SCBU)
+! ZTOT_TH_EVAP, ZTOT_RC_EVAP, ZTOT_CC_EVAP, ZTOT_RR_EVAP, ZTOT_CR_EVAP, & ! evaporation of rain drops (EVAP)
+ ZTOT_TH_EVAP, ZTOT_RR_EVAP, & ! evaporation of rain drops (EVAP)
+ ZTOT_RI_CNVI, ZTOT_CI_CNVI, & ! conversion snow -> ice (CNVI)
+ ZTOT_TH_DEPS, ZTOT_RS_DEPS, & ! deposition of vapor on snow (DEPS)
+ ZTOT_TH_DEPI, ZTOT_RI_DEPI, & ! deposition of vapor on ice (DEPI)
+ ZTOT_RI_CNVS, ZTOT_CI_CNVS, & ! conversion ice -> snow (CNVS)
+ ZTOT_RI_AGGS, ZTOT_CI_AGGS, & ! aggregation of ice on snow (AGGS)
+ ZTOT_TH_DEPG, ZTOT_RG_DEPG, & ! deposition of vapor on graupel (DEPG)
+ ZTOT_TH_BERFI, ZTOT_RC_BERFI, & ! Bergeron (BERFI)
+ ZTOT_TH_RIM, ZTOT_RC_RIM, ZTOT_CC_RIM, ZTOT_RS_RIM, ZTOT_RG_RIM, & ! cloud droplet riming (RIM)
+ ZTOT_RI_HMS, ZTOT_CI_HMS, ZTOT_RS_HMS, & ! hallett mossop snow (HMS)
+ ZTOT_TH_ACC, ZTOT_RR_ACC, ZTOT_CR_ACC, ZTOT_RS_ACC, ZTOT_RG_ACC, & ! rain accretion on aggregates (ACC)
+ ZTOT_RS_CMEL, & ! conversion-melting (CMEL)
+ ZTOT_TH_CFRZ, ZTOT_RR_CFRZ, ZTOT_CR_CFRZ, ZTOT_RI_CFRZ, ZTOT_CI_CFRZ, & ! rain freezing (CFRZ)
+ ZTOT_TH_WETG, ZTOT_RC_WETG, ZTOT_CC_WETG, ZTOT_RR_WETG, ZTOT_CR_WETG, & ! wet growth of graupel (WETG)
+ ZTOT_RI_WETG, ZTOT_CI_WETG, ZTOT_RS_WETG, ZTOT_RG_WETG, ZTOT_RH_WETG, & ! wet growth of graupel (WETG)
+ ZTOT_TH_DRYG, ZTOT_RC_DRYG, ZTOT_CC_DRYG, ZTOT_RR_DRYG, ZTOT_CR_DRYG, & ! dry growth of graupel (DRYG)
+ ZTOT_RI_DRYG, ZTOT_CI_DRYG, ZTOT_RS_DRYG, ZTOT_RG_DRYG, & ! dry growth of graupel (DRYG)
+ ZTOT_RI_HMG, ZTOT_CI_HMG, ZTOT_RG_HMG, & ! hallett mossop graupel (HMG)
+ ZTOT_TH_GMLT, ZTOT_RR_GMLT, ZTOT_CR_GMLT, & ! graupel melting (GMLT)
+! ZTOT_RC_WETH, ZTOT_CC_WETH, ZTOT_RR_WETH, ZTOT_CR_WETH, & ! wet growth of hail (WETH)
+! ZTOT_RI_WETH, ZTOT_CI_WETH, ZTOT_RS_WETH, ZTOT_RG_WETH, ZTOT_RH_WETH, & ! wet growth of hail (WETH)
+! ZTOT_RG_COHG, & ! conversion of hail into graupel (COHG)
+! ZTOT_RR_HMLT, ZTOT_CR_HMLT, & ! hail melting (HMLT)
+ ZTOT_RR_CVRC, ZTOT_CR_CVRC, & ! conversion of rain into cloud droplets if diameter too small
+ ZTOT_RV_CORR2, ZTOT_RC_CORR2, ZTOT_RR_CORR2, ZTOT_RI_CORR2, &
+ ZTOT_CC_CORR2, ZTOT_CR_CORR2, ZTOT_CI_CORR2
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZTOT_IFNN_IMLT
+
+!
+!For mixing-ratio splitting
+REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: Z0RVT, Z0RCT, Z0RRT, Z0RIT, Z0RST, Z0RGT, Z0RHT
+REAL, DIMENSION(:), ALLOCATABLE :: Z0RVT1D, Z0RCT1D, Z0RRT1D, Z0RIT1D, Z0RST1D, Z0RGT1D, Z0RHT1D
+
+!
+! Loop control variables
+REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: ZTIME, ZTIME_LASTCALL, IITER
+REAL, DIMENSION(:), ALLOCATABLE :: ZTIME1D, ZTIME_LASTCALL1D, IITER1D, ZMAXTIME, ZTIME_THRESHOLD
+LOGICAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: LLCOMPUTE
+LOGICAL, DIMENSION(:), ALLOCATABLE :: LLCOMPUTE1D
+REAL :: ZTSTEP
+INTEGER :: INB_ITER_MAX
+!
+!For subgrid clouds
+REAL, DIMENSION(:), ALLOCATABLE :: ZCF1D, ZIF1D, ZPF1D ! 1D packed cloud, ice and precip. frac.
+
+!
+! Various parameters
+! domain size and levels (AROME compatibility)
+INTEGER :: KRR
+INTEGER :: IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKT, IKTB, IKTE
+! loops and packing
+INTEGER :: II, IPACK, JI, JJ, JK
+integer :: idx
+INTEGER, DIMENSION(:), ALLOCATABLE :: I1, I2, I3
+! Inverse ov PTSTEP
+REAL :: ZINV_TSTEP
+! Work arrays
+REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: ZW3D
+REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2)) :: ZW2D
+REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: ZRT_SUM ! Total condensed water mr
+REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: ZCPT ! Total condensed water mr
+LOGICAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2)) :: GDEP
+real, dimension(:,:,:), allocatable :: zrhodjontstep
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. Init
+! ----
+!
+!
+IIB=1+JPHEXT ! first physical point in i
+IIT=SIZE(PDZZ,1) ! total number of points in i
+IIE=IIT - JPHEXT ! last physical point in i
+!
+IJB=1+JPHEXT ! first physical point in j
+IJT=SIZE(PDZZ,2) ! total number of points in j
+IJE=IJT - JPHEXT ! last physical point in j
+!
+IKB=KKA+JPVEXT*KKL ! near ground physical point
+IKE=KKU-JPVEXT*KKL ! near TOA physical point
+IKT=SIZE(PDZZ,3) ! total number of points in k
+!
+IKTB=1+JPVEXT ! first index for a physical point in k
+IKTE=IKT-JPVEXT ! last index for a physical point in k
+!
+ZTHS(:,:,:) = PTHS(:,:,:)
+ZTHT(:,:,:) = PTHS(:,:,:) * PTSTEP
+ZRVT(:,:,:) = 0.
+ZRVS(:,:,:) = 0.
+ZRCT(:,:,:) = 0.
+ZRCS(:,:,:) = 0.
+ZRRT(:,:,:) = 0.
+ZRRS(:,:,:) = 0.
+ZRIT(:,:,:) = 0.
+ZRIS(:,:,:) = 0.
+ZRST(:,:,:) = 0.
+ZRSS(:,:,:) = 0.
+ZRGT(:,:,:) = 0.
+ZRGS(:,:,:) = 0.
+ZRHT(:,:,:) = 0.
+ZRHS(:,:,:) = 0.
+ZRT_SUM(:,:,:) = 0.
+ZCCT(:,:,:) = 0.
+ZCCS(:,:,:) = 0.
+ZCRT(:,:,:) = 0.
+ZCRS(:,:,:) = 0.
+ZCIT(:,:,:) = 0.
+ZCIS(:,:,:) = 0.
+ZCCNFT(:,:,:,:) = 0.
+ZCCNAT(:,:,:,:) = 0.
+ZCCNFS(:,:,:,:) = 0.
+ZCCNAS(:,:,:,:) = 0.
+ZIFNFT(:,:,:,:) = 0.
+ZIFNNT(:,:,:,:) = 0.
+ZIFNFS(:,:,:,:) = 0.
+ZIFNNS(:,:,:,:) = 0.
+ZIMMNT(:,:,:,:) = 0.
+ZIMMNS(:,:,:,:) = 0.
+ZHOMFT(:,:,:) = 0.
+ZHOMFS(:,:,:) = 0.
+
+if ( lbu_enable ) then
+ allocate( ZTOT_CR_BRKU (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CR_BRKU(:,:,:) = 0.
+ allocate( ZTOT_TH_HONR (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_TH_HONR(:,:,:) = 0.
+ allocate( ZTOT_RR_HONR (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RR_HONR(:,:,:) = 0.
+ allocate( ZTOT_CR_HONR (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CR_HONR(:,:,:) = 0.
+ allocate( ZTOT_TH_IMLT (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_TH_IMLT(:,:,:) = 0.
+ allocate( ZTOT_RC_IMLT (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RC_IMLT(:,:,:) = 0.
+ allocate( ZTOT_CC_IMLT (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CC_IMLT(:,:,:) = 0.
+ allocate( ZTOT_IFNN_IMLT (size( ptht, 1), size( ptht, 2), size( ptht, 3), nmod_ifn ) ); ZTOT_IFNN_IMLT(:,:,:,:) = 0.
+ allocate( ZTOT_TH_HONC (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_TH_HONC(:,:,:) = 0.
+ allocate( ZTOT_RC_HONC (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RC_HONC(:,:,:) = 0.
+ allocate( ZTOT_CC_HONC (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CC_HONC(:,:,:) = 0.
+ allocate( ZTOT_CC_SELF (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CC_SELF(:,:,:) = 0.
+ allocate( ZTOT_RC_AUTO (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RC_AUTO(:,:,:) = 0.
+ allocate( ZTOT_CC_AUTO (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CC_AUTO(:,:,:) = 0.
+ allocate( ZTOT_CR_AUTO (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CR_AUTO(:,:,:) = 0.
+ allocate( ZTOT_RC_ACCR (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RC_ACCR(:,:,:) = 0.
+ allocate( ZTOT_CC_ACCR (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CC_ACCR(:,:,:) = 0.
+ allocate( ZTOT_CR_SCBU (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CR_SCBU(:,:,:) = 0.
+ allocate( ZTOT_TH_EVAP (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_TH_EVAP(:,:,:) = 0.
+! allocate( ZTOT_RC_EVAP (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RC_EVAP(:,:,:) = 0.
+! allocate( ZTOT_CC_EVAP (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CC_EVAP(:,:,:) = 0.
+ allocate( ZTOT_RR_EVAP (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RR_EVAP(:,:,:) = 0.
+! allocate( ZTOT_CR_EVAP (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CR_EVAP(:,:,:) = 0.
+ allocate( ZTOT_RI_CNVI (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RI_CNVI(:,:,:) = 0.
+ allocate( ZTOT_CI_CNVI (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CI_CNVI(:,:,:) = 0.
+ allocate( ZTOT_TH_DEPS (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_TH_DEPS(:,:,:) = 0.
+ allocate( ZTOT_RS_DEPS (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RS_DEPS(:,:,:) = 0.
+ allocate( ZTOT_TH_DEPI (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_TH_DEPI(:,:,:) = 0.
+ allocate( ZTOT_RI_DEPI (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RI_DEPI(:,:,:) = 0.
+ allocate( ZTOT_RI_CNVS (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RI_CNVS(:,:,:) = 0.
+ allocate( ZTOT_CI_CNVS (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CI_CNVS(:,:,:) = 0.
+ allocate( ZTOT_RI_AGGS (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RI_AGGS(:,:,:) = 0.
+ allocate( ZTOT_CI_AGGS (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CI_AGGS(:,:,:) = 0.
+ allocate( ZTOT_TH_DEPG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_TH_DEPG(:,:,:) = 0.
+ allocate( ZTOT_RG_DEPG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RG_DEPG(:,:,:) = 0.
+ allocate( ZTOT_TH_BERFI(size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_TH_BERFI(:,:,:) = 0.
+ allocate( ZTOT_RC_BERFI(size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RC_BERFI(:,:,:) = 0.
+ allocate( ZTOT_TH_RIM (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_TH_RIM(:,:,:) = 0.
+ allocate( ZTOT_RC_RIM (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RC_RIM(:,:,:) = 0.
+ allocate( ZTOT_CC_RIM (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CC_RIM(:,:,:) = 0.
+ allocate( ZTOT_RS_RIM (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RS_RIM(:,:,:) = 0.
+ allocate( ZTOT_RG_RIM (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RG_RIM(:,:,:) = 0.
+ allocate( ZTOT_RI_HMS (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RI_HMS(:,:,:) = 0.
+ allocate( ZTOT_CI_HMS (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CI_HMS(:,:,:) = 0.
+ allocate( ZTOT_RS_HMS (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RS_HMS(:,:,:) = 0.
+ allocate( ZTOT_TH_ACC (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_TH_ACC(:,:,:) = 0.
+ allocate( ZTOT_RR_ACC (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RR_ACC(:,:,:) = 0.
+ allocate( ZTOT_CR_ACC (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CR_ACC(:,:,:) = 0.
+ allocate( ZTOT_RS_ACC (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RS_ACC(:,:,:) = 0.
+ allocate( ZTOT_RG_ACC (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RG_ACC(:,:,:) = 0.
+ allocate( ZTOT_RS_CMEL (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RS_CMEL(:,:,:) = 0.
+ allocate( ZTOT_TH_CFRZ (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_TH_CFRZ(:,:,:) = 0.
+ allocate( ZTOT_RR_CFRZ (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RR_CFRZ(:,:,:) = 0.
+ allocate( ZTOT_CR_CFRZ (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CR_CFRZ(:,:,:) = 0.
+ allocate( ZTOT_RI_CFRZ (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RI_CFRZ(:,:,:) = 0.
+ allocate( ZTOT_CI_CFRZ (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CI_CFRZ(:,:,:) = 0.
+ allocate( ZTOT_TH_WETG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_TH_WETG(:,:,:) = 0.
+ allocate( ZTOT_RC_WETG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RC_WETG(:,:,:) = 0.
+ allocate( ZTOT_CC_WETG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CC_WETG(:,:,:) = 0.
+ allocate( ZTOT_RR_WETG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RR_WETG(:,:,:) = 0.
+ allocate( ZTOT_CR_WETG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CR_WETG(:,:,:) = 0.
+ allocate( ZTOT_RI_WETG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RI_WETG(:,:,:) = 0.
+ allocate( ZTOT_CI_WETG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CI_WETG(:,:,:) = 0.
+ allocate( ZTOT_RS_WETG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RS_WETG(:,:,:) = 0.
+ allocate( ZTOT_RG_WETG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RG_WETG(:,:,:) = 0.
+ allocate( ZTOT_RH_WETG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RH_WETG(:,:,:) = 0.
+ allocate( ZTOT_TH_DRYG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_TH_DRYG(:,:,:) = 0.
+ allocate( ZTOT_RC_DRYG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RC_DRYG(:,:,:) = 0.
+ allocate( ZTOT_CC_DRYG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CC_DRYG(:,:,:) = 0.
+ allocate( ZTOT_RR_DRYG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RR_DRYG(:,:,:) = 0.
+ allocate( ZTOT_CR_DRYG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CR_DRYG(:,:,:) = 0.
+ allocate( ZTOT_RI_DRYG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RI_DRYG(:,:,:) = 0.
+ allocate( ZTOT_CI_DRYG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CI_DRYG(:,:,:) = 0.
+ allocate( ZTOT_RS_DRYG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RS_DRYG(:,:,:) = 0.
+ allocate( ZTOT_RG_DRYG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RG_DRYG(:,:,:) = 0.
+ allocate( ZTOT_RI_HMG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RI_HMG(:,:,:) = 0.
+ allocate( ZTOT_CI_HMG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CI_HMG(:,:,:) = 0.
+ allocate( ZTOT_RG_HMG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RG_HMG(:,:,:) = 0.
+ allocate( ZTOT_TH_GMLT (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_TH_GMLT(:,:,:) = 0.
+ allocate( ZTOT_RR_GMLT (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RR_GMLT(:,:,:) = 0.
+ allocate( ZTOT_CR_GMLT (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CR_GMLT(:,:,:) = 0.
+! allocate( ZTOT_RC_WETH (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RC_WETH(:,:,:) = 0.
+! allocate( ZTOT_CC_WETH (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CC_WETH(:,:,:) = 0.
+! allocate( ZTOT_RR_WETH (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RR_WETH(:,:,:) = 0.
+! allocate( ZTOT_CR_WETH (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CR_WETH(:,:,:) = 0.
+! allocate( ZTOT_RI_WETH (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RI_WETH(:,:,:) = 0.
+! allocate( ZTOT_CI_WETH (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CI_WETH(:,:,:) = 0.
+! allocate( ZTOT_RS_WETH (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RS_WETH(:,:,:) = 0.
+! allocate( ZTOT_RG_WETH (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RG_WETH(:,:,:) = 0.
+! allocate( ZTOT_RH_WETH (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RH_WETH(:,:,:) = 0.
+! allocate( ZTOT_RG_COHG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RG_COHG(:,:,:) = 0.
+! allocate( ZTOT_RR_HMLT (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RR_HMLT(:,:,:) = 0.
+! allocate( ZTOT_CR_HMLT (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CR_HMLT(:,:,:) = 0.
+ allocate( ZTOT_RR_CVRC (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RR_CVRC(:,:,:) = 0.
+ allocate( ZTOT_CR_CVRC (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CR_CVRC(:,:,:) = 0.
+
+ allocate( ZTOT_RV_CORR2 (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RV_CORR2(:,:,:) = 0.
+ allocate( ZTOT_RC_CORR2 (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RC_CORR2(:,:,:) = 0.
+ allocate( ZTOT_RR_CORR2 (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RR_CORR2(:,:,:) = 0.
+ allocate( ZTOT_RI_CORR2 (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RI_CORR2(:,:,:) = 0.
+ allocate( ZTOT_CC_CORR2 (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CC_CORR2(:,:,:) = 0.
+ allocate( ZTOT_CR_CORR2 (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CR_CORR2(:,:,:) = 0.
+ allocate( ZTOT_CI_CORR2 (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CI_CORR2(:,:,:) = 0.
+END IF
+!
+! Initial values computed as source * PTSTEP
+!
+! Mixing ratios
+!
+KRR=SIZE(PRT,4)
+ZRVT(:,:,:) = PRS(:,:,:,1) * PTSTEP
+ZRVS(:,:,:) = PRS(:,:,:,1)
+IF ( KRR .GE. 2 ) ZRCT(:,:,:) = PRS(:,:,:,2) * PTSTEP
+IF ( KRR .GE. 2 ) ZRCS(:,:,:) = PRS(:,:,:,2)
+IF ( KRR .GE. 3 ) ZRRT(:,:,:) = PRS(:,:,:,3) * PTSTEP
+IF ( KRR .GE. 3 ) ZRRS(:,:,:) = PRS(:,:,:,3)
+IF ( KRR .GE. 4 ) ZRIT(:,:,:) = PRS(:,:,:,4) * PTSTEP
+IF ( KRR .GE. 4 ) ZRIS(:,:,:) = PRS(:,:,:,4)
+IF ( KRR .GE. 5 ) ZRST(:,:,:) = PRS(:,:,:,5) * PTSTEP
+IF ( KRR .GE. 5 ) ZRSS(:,:,:) = PRS(:,:,:,5)
+IF ( KRR .GE. 6 ) ZRGT(:,:,:) = PRS(:,:,:,6) * PTSTEP
+IF ( KRR .GE. 6 ) ZRGS(:,:,:) = PRS(:,:,:,6)
+IF ( KRR .GE. 7 ) ZRHT(:,:,:) = PRS(:,:,:,7) * PTSTEP
+IF ( KRR .GE. 7 ) ZRHS(:,:,:) = PRS(:,:,:,7)
+!
+! Concentrations
+!
+IF ( LWARM ) ZCCT(:,:,:) = PSVS(:,:,:,NSV_LIMA_NC) * PTSTEP
+IF ( LWARM ) ZCCS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NC)
+IF ( LWARM .AND. LRAIN ) ZCRT(:,:,:) = PSVS(:,:,:,NSV_LIMA_NR) * PTSTEP
+IF ( LWARM .AND. LRAIN ) ZCRS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NR)
+IF ( LCOLD ) ZCIT(:,:,:) = PSVS(:,:,:,NSV_LIMA_NI) * PTSTEP
+IF ( LCOLD ) ZCIS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NI)
+!
+IF ( NMOD_CCN .GE. 1 ) ZCCNFT(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1) * PTSTEP
+IF ( NMOD_CCN .GE. 1 ) ZCCNAT(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1) * PTSTEP
+IF ( NMOD_CCN .GE. 1 ) ZCCNFS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1)
+IF ( NMOD_CCN .GE. 1 ) ZCCNAS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1)
+!
+IF ( NMOD_IFN .GE. 1 ) ZIFNFT(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IFN_FREE:NSV_LIMA_IFN_FREE+NMOD_IFN-1) * PTSTEP
+IF ( NMOD_IFN .GE. 1 ) ZIFNNT(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IFN_NUCL:NSV_LIMA_IFN_NUCL+NMOD_IFN-1) * PTSTEP
+IF ( NMOD_IFN .GE. 1 ) ZIFNFS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IFN_FREE:NSV_LIMA_IFN_FREE+NMOD_IFN-1)
+IF ( NMOD_IFN .GE. 1 ) ZIFNNS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IFN_NUCL:NSV_LIMA_IFN_NUCL+NMOD_IFN-1)
+!
+IF ( NMOD_IMM .GE. 1 ) ZIMMNT(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IMM_NUCL:NSV_LIMA_IMM_NUCL+NMOD_IMM-1) * PTSTEP
+IF ( NMOD_IMM .GE. 1 ) ZIMMNS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IMM_NUCL:NSV_LIMA_IMM_NUCL+NMOD_IMM-1)
+!
+IF ( LCOLD .AND. LHHONI ) ZHOMFT(:,:,:) = PSVS(:,:,:,NSV_LIMA_HOM_HAZE) * PTSTEP
+IF ( LCOLD .AND. LHHONI ) ZHOMFS(:,:,:) = PSVS(:,:,:,NSV_LIMA_HOM_HAZE)
+!
+ZINV_TSTEP = 1./PTSTEP
+ZEXN(:,:,:) = (PPABST(:,:,:)/XP00)**(XRD/XCPD)
+ZT(:,:,:) = ZTHT(:,:,:) * ZEXN(:,:,:)
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. Check mean diameter for cloud, rain and ice
+! --------------------------------------------
+! if ( lbu_enable ) then
+! if ( lbudget_rc .and. lwarm .and. lrain ) call Budget_store_init( tbudgets(NBUDGET_RC), 'CORR', zrcs(:, :, :) * prhodj(:, :, :) )
+! if ( lbudget_rr .and. lwarm .and. lrain ) call Budget_store_init( tbudgets(NBUDGET_RR), 'CORR', zrrs(:, :, :) * prhodj(:, :, :) )
+! if ( lbudget_ri .and. lcold .and. lsnow ) call Budget_store_init( tbudgets(NBUDGET_RI), 'CORR', zris(:, :, :) * prhodj(:, :, :) )
+! if ( lbudget_rs .and. lcold .and. lsnow ) call Budget_store_init( tbudgets(NBUDGET_RS), 'CORR', zrss(:, :, :) * prhodj(:, :, :) )
+! if ( lbudget_sv ) then
+! if ( lwarm .and. lrain ) &
+! call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'CORR', zccs(:, :, :) * prhodj(:, :, :) )
+! if ( lwarm .and. lrain ) &
+! call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'CORR', zcrs(:, :, :) * prhodj(:, :, :) )
+! if ( lcold .and. lsnow ) &
+! call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CORR', zcis(:, :, :) * prhodj(:, :, :) )
+! end if
+! end if
+!!$IF (LWARM .AND. LRAIN) THEN
+!!$ WHERE( ZRCT>XRTMIN(2) .AND. ZCCT>XCTMIN(2) .AND. ZRCT>XAC*ZCCT*(100.E-6)**XBC )
+!!$ ZRRT=ZRRT+ZRCT
+!!$ ZRRS=ZRRS+ZRCS
+!!$ ZCRT=ZCRT+ZCCT
+!!$ ZCRS=ZCRS+ZCCS
+!!$ ZRCT=0.
+!!$ ZCCT=0.
+!!$ ZRCS=0.
+!!$ ZCCS=0.
+!!$ END WHERE
+!!$END IF
+!!$!
+!!$IF (LWARM .AND. LRAIN) THEN
+!!$ WHERE( ZRRT>XRTMIN(3) .AND. ZCRT>XCTMIN(3) .AND. ZRRT<XAR*ZCRT*(60.E-6)**XBR )
+!!$ ZRCT=ZRCT+ZRRT
+!!$ ZRCS=ZRCS+ZRRS
+!!$ ZCCT=ZCCT+ZCRT
+!!$ ZCCS=ZCCS+ZCRS
+!!$ ZRRT=0.
+!!$ ZCRT=0.
+!!$ ZRRS=0.
+!!$ ZCRS=0.
+!!$ END WHERE
+!!$END IF
+!!$!
+!!$IF (LCOLD .AND. LSNOW) THEN
+!!$ WHERE( ZRIT>XRTMIN(4) .AND. ZCIT>XCTMIN(4) .AND. ZRIT>XAI*ZCIT*(250.E-6)**XBI )
+!!$ ZRST=ZRST+ZRIT
+!!$ ZRSS=ZRSS+ZRIS
+!!$ ZRIT=0.
+!!$ ZCIT=0.
+!!$ ZRIS=0.
+!!$ ZCIS=0.
+!!$ END WHERE
+!!$END IF
+!
+! if ( lbu_enable ) then
+! if ( lbudget_rc .and. lwarm .and. lrain ) call Budget_store_end( tbudgets(NBUDGET_RC), 'CORR', zrcs(:, :, :) * prhodj(:, :, :) )
+! if ( lbudget_rr .and. lwarm .and. lrain ) call Budget_store_end( tbudgets(NBUDGET_RR), 'CORR', zrrs(:, :, :) * prhodj(:, :, :) )
+! if ( lbudget_ri .and. lcold .and. lsnow ) call Budget_store_end( tbudgets(NBUDGET_RI), 'CORR', zris(:, :, :) * prhodj(:, :, :) )
+! if ( lbudget_rs .and. lcold .and. lsnow ) call Budget_store_end( tbudgets(NBUDGET_RS), 'CORR', zrss(:, :, :) * prhodj(:, :, :) )
+! if ( lbudget_sv ) then
+! if ( lwarm .and. lrain ) &
+! call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'CORR', zccs(:, :, :) * prhodj(:, :, :) )
+! if ( lwarm .and. lrain ) &
+! call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'CORR', zcrs(:, :, :) * prhodj(:, :, :) )
+! if ( lcold .and. lsnow ) &
+! call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CORR', zcis(:, :, :) * prhodj(:, :, :) )
+! end if
+! end if
+!-------------------------------------------------------------------------------
+!
+!* 1. Sedimentation
+! -------------
+!
+!
+if ( lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'SEDI', zths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc .and. lwarm .and. lsedc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'SEDI', zrcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr .and. lwarm .and. lrain ) call Budget_store_init( tbudgets(NBUDGET_RR), 'SEDI', zrrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri .and. lcold .and. lsedi ) call Budget_store_init( tbudgets(NBUDGET_RI), 'SEDI', zris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs .and. lcold .and. lsnow ) call Budget_store_init( tbudgets(NBUDGET_RS), 'SEDI', zrss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg .and. lcold .and. lsnow ) call Budget_store_init( tbudgets(NBUDGET_RG), 'SEDI', zrgs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh .and. lcold .and. lhail ) call Budget_store_init( tbudgets(NBUDGET_RH), 'SEDI', zrhs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ if ( lwarm .and. lsedc ) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'SEDI', zccs(:, :, :) * prhodj(:, :, :) )
+ if ( lwarm .and. lrain ) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'SEDI', zcrs(:, :, :) * prhodj(:, :, :) )
+ if ( lcold .and. lsedi ) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'SEDI', zcis(:, :, :) * prhodj(:, :, :) )
+ end if
+end if
+
+ZRT_SUM = (ZRVS + ZRCS + ZRRS + ZRIS + ZRSS + ZRGS + ZRHS)*PTSTEP
+ZCPT = XCPD + (XCPV * ZRVS + XCL * (ZRCS + ZRRS) + XCI * (ZRIS + ZRSS + ZRGS + ZRHS))*PTSTEP
+IF (LWARM .AND. LSEDC) CALL LIMA_SEDIMENTATION(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, KKL, &
+ 'L', 2, 2, 1, PTSTEP, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, ZRCS, ZCCS, PINPRC)
+ZRT_SUM = (ZRVS + ZRCS + ZRRS + ZRIS + ZRSS + ZRGS + ZRHS)*PTSTEP
+ZCPT = XCPD + (XCPV * ZRVS + XCL * (ZRCS + ZRRS) + XCI * (ZRIS + ZRSS + ZRGS + ZRHS))*PTSTEP
+IF (LWARM .AND. LRAIN) CALL LIMA_SEDIMENTATION(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, KKL, &
+ 'L', 2, 3, 1, PTSTEP, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, ZRRS, ZCRS, PINPRR)
+ZRT_SUM = (ZRVS + ZRCS + ZRRS + ZRIS + ZRSS + ZRGS + ZRHS)*PTSTEP
+ZCPT = XCPD + (XCPV * ZRVS + XCL * (ZRCS + ZRRS) + XCI * (ZRIS + ZRSS + ZRGS + ZRHS))*PTSTEP
+IF (LCOLD .AND. LSEDI) CALL LIMA_SEDIMENTATION(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, KKL, &
+ 'I', 2, 4, 1, PTSTEP, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, ZRIS, ZCIS, ZW2D)
+ZRT_SUM = (ZRVS + ZRCS + ZRRS + ZRIS + ZRSS + ZRGS + ZRHS)*PTSTEP
+ZCPT = XCPD + (XCPV * ZRVS + XCL * (ZRCS + ZRRS) + XCI * (ZRIS + ZRSS + ZRGS + ZRHS))*PTSTEP
+IF (LCOLD .AND. LSNOW) CALL LIMA_SEDIMENTATION(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, KKL, &
+ 'I', 1, 5, 1, PTSTEP, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, ZRSS, ZW3D, PINPRS)
+ZRT_SUM = (ZRVS + ZRCS + ZRRS + ZRIS + ZRSS + ZRGS + ZRHS)*PTSTEP
+ZCPT = XCPD + (XCPV * ZRVS + XCL * (ZRCS + ZRRS) + XCI * (ZRIS + ZRSS + ZRGS + ZRHS))*PTSTEP
+IF (LCOLD .AND. LSNOW) CALL LIMA_SEDIMENTATION(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, KKL, &
+ 'I', 1, 6, 1, PTSTEP, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, ZRGS, ZW3D, PINPRG)
+ZRT_SUM = (ZRVS + ZRCS + ZRRS + ZRIS + ZRSS + ZRGS + ZRHS)*PTSTEP
+ZCPT = XCPD + (XCPV * ZRVS + XCL * (ZRCS + ZRRS) + XCI * (ZRIS + ZRSS + ZRGS + ZRHS))*PTSTEP
+IF (LCOLD .AND. LHAIL) CALL LIMA_SEDIMENTATION(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, KKL, &
+ 'I', 1, 7, 1, PTSTEP, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, ZRHS, ZW3D, PINPRH)
+!
+ZTHS(:,:,:) = ZT(:,:,:) / ZEXN(:,:,:) * ZINV_TSTEP
+!
+! Call budgets
+!
+if ( lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'SEDI', zths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc .and. lwarm .and. lsedc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'SEDI', zrcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr .and. lwarm .and. lrain ) call Budget_store_end( tbudgets(NBUDGET_RR), 'SEDI', zrrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri .and. lcold .and. lsedi ) call Budget_store_end( tbudgets(NBUDGET_RI), 'SEDI', zris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs .and. lcold .and. lsnow ) call Budget_store_end( tbudgets(NBUDGET_RS), 'SEDI', zrss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg .and. lcold .and. lsnow ) call Budget_store_end( tbudgets(NBUDGET_RG), 'SEDI', zrgs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh .and. lcold .and. lhail ) call Budget_store_end( tbudgets(NBUDGET_RH), 'SEDI', zrhs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ if ( lwarm .and. lsedc ) &
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'SEDI', zccs(:, :, :) * prhodj(:, :, :) )
+ if ( lwarm .and. lrain ) &
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'SEDI', zcrs(:, :, :) * prhodj(:, :, :) )
+ if ( lcold .and. lsedi ) &
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'SEDI', zcis(:, :, :) * prhodj(:, :, :) )
+ end if
+end if
+!
+! 1.bis Deposition at 1st level above ground
+!
+IF (LWARM .AND. LDEPOC) THEN
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'DEPO', zrcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'DEPO', zccs(:, :, :) * prhodj(:, :, :) )
+
+ PINDEP(:,:)=0.
+ GDEP(:,:) = .FALSE.
+ GDEP(:,:) = ZRCS(:,:,IKB) >0 .AND. ZCCS(:,:,IKB) >0 .AND. ZRCT(:,:,IKB) >0 .AND. ZCCT(:,:,IKB) >0
+ WHERE (GDEP)
+ ZRCS(:,:,IKB) = ZRCS(:,:,IKB) - XVDEPOC * ZRCT(:,:,IKB) / PDZZ(:,:,IKB)
+ ZCCS(:,:,IKB) = ZCCS(:,:,IKB) - XVDEPOC * ZCCT(:,:,IKB) / PDZZ(:,:,IKB)
+ PINPRC(:,:) = PINPRC(:,:) + XVDEPOC * ZRCT(:,:,IKB) * PRHODREF(:,:,IKB) /XRHOLW
+ PINDEP(:,:) = XVDEPOC * ZRCT(:,:,IKB) * PRHODREF(:,:,IKB) /XRHOLW
+ END WHERE
+
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'DEPO', zrcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'DEPO', zccs(:, :, :) * prhodj(:, :, :) )
+END IF
+!
+!
+Z_RR_CVRC(:,:,:) = 0.
+Z_CR_CVRC(:,:,:) = 0.
+IF (LWARM .AND. LRAIN) THEN
+ if( lbu_enable ) then
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'R2C1', zrcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'R2C1', zrrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'R2C1', zccs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'R2C1', zcrs(:, :, :) * prhodj(:, :, :) )
+ end if
+
+ CALL LIMA_DROPS_TO_DROPLETS_CONV(PRHODREF, ZRCS*PTSTEP, ZRRS*PTSTEP, ZCCS*PTSTEP, ZCRS*PTSTEP, &
+ Z_RR_CVRC, Z_CR_CVRC)
+ !
+ ZRCS(:,:,:) = ZRCS(:,:,:) - Z_RR_CVRC(:,:,:)/PTSTEP
+ ZRRS(:,:,:) = ZRRS(:,:,:) + Z_RR_CVRC(:,:,:)/PTSTEP
+ ZCCS(:,:,:) = ZCCS(:,:,:) - Z_CR_CVRC(:,:,:)/PTSTEP
+ ZCRS(:,:,:) = ZCRS(:,:,:) + Z_CR_CVRC(:,:,:)/PTSTEP
+
+ if( lbu_enable ) then
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'R2C1', zrcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'R2C1', zrrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'R2C1', zccs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'R2C1', zcrs(:, :, :) * prhodj(:, :, :) )
+ end if
+END IF
+!
+! Update variables
+!
+ZTHT(:,:,:) = ZTHS(:,:,:) * PTSTEP
+ZT(:,:,:) = ZTHT(:,:,:) * ZEXN(:,:,:)
+!
+IF ( KRR .GE. 2 ) ZRCT(:,:,:) = ZRCS(:,:,:) * PTSTEP
+IF ( KRR .GE. 3 ) ZRRT(:,:,:) = ZRRS(:,:,:) * PTSTEP
+IF ( KRR .GE. 4 ) ZRIT(:,:,:) = ZRIS(:,:,:) * PTSTEP
+IF ( KRR .GE. 5 ) ZRST(:,:,:) = ZRSS(:,:,:) * PTSTEP
+IF ( KRR .GE. 6 ) ZRGT(:,:,:) = ZRGS(:,:,:) * PTSTEP
+IF ( KRR .GE. 7 ) ZRHT(:,:,:) = ZRHS(:,:,:) * PTSTEP
+!
+IF ( LWARM ) ZCCT(:,:,:) = ZCCS(:,:,:) * PTSTEP
+IF ( LWARM .AND. LRAIN ) ZCRT(:,:,:) = ZCRS(:,:,:) * PTSTEP
+IF ( LCOLD ) ZCIT(:,:,:) = ZCIS(:,:,:) * PTSTEP
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. Compute cloud, ice and precipitation fractions
+! ----------------------------------------------
+!
+IF (LSUBG_COND) THEN
+ CALL LIMA_COMPUTE_CLOUD_FRACTIONS (IIB, IIE, IJB, IJE, IKB, IKE, KKL, &
+ ZCCT, ZRCT, &
+ ZCRT, ZRRT, &
+ ZCIT, ZRIT, &
+ ZRST, ZRGT, ZRHT, &
+ PCLDFR, PICEFR, PPRCFR )
+ELSE
+ PCLDFR(:,:,:)=1.
+ PICEFR(:,:,:)=1.
+ PPRCFR(:,:,:)=1.
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. Nucleation processes
+! --------------------
+!
+CALL LIMA_NUCLEATION_PROCS (PTSTEP, TPFILE, PRHODJ, &
+ PRHODREF, ZEXN, PPABST, ZT, PDTHRAD, PW_NU, &
+ ZTHT, ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, &
+ ZCCT, ZCRT, ZCIT, &
+ ZCCNFT, ZCCNAT, ZIFNFT, ZIFNNT, ZIMMNT, ZHOMFT, &
+ PCLDFR, PICEFR, PPRCFR )
+!
+! Saving sources before microphysics time-splitting loop
+!
+ZRVS(:,:,:) = ZRVT(:,:,:) *ZINV_TSTEP
+ZRCS(:,:,:) = ZRCT(:,:,:) *ZINV_TSTEP
+ZRRS(:,:,:) = ZRRT(:,:,:) *ZINV_TSTEP
+ZRIS(:,:,:) = ZRIT(:,:,:) *ZINV_TSTEP
+ZRSS(:,:,:) = ZRST(:,:,:) *ZINV_TSTEP
+ZRGS(:,:,:) = ZRGT(:,:,:) *ZINV_TSTEP
+ZRHS(:,:,:) = ZRHT(:,:,:) *ZINV_TSTEP
+!
+ZCCS(:,:,:) = ZCCT(:,:,:) *ZINV_TSTEP
+ZCRS(:,:,:) = ZCRT(:,:,:) *ZINV_TSTEP
+ZCIS(:,:,:) = ZCIT(:,:,:) *ZINV_TSTEP
+!
+ZCCNFS(:,:,:,:) = ZCCNFT(:,:,:,:) *ZINV_TSTEP
+ZCCNAS(:,:,:,:) = ZCCNAT(:,:,:,:) *ZINV_TSTEP
+ZIFNFS(:,:,:,:) = ZIFNFT(:,:,:,:) *ZINV_TSTEP
+ZIFNNS(:,:,:,:) = ZIFNNT(:,:,:,:) *ZINV_TSTEP
+ZIMMNS(:,:,:,:) = ZIMMNT(:,:,:,:) *ZINV_TSTEP
+ZHOMFS(:,:,:) = ZHOMFT(:,:,:) *ZINV_TSTEP
+!
+ZTHS(:,:,:) = ZTHT(:,:,:) *ZINV_TSTEP
+ZT(:,:,:) = ZTHT(:,:,:) * ZEXN(:,:,:)
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. LOOP
+! ----
+!
+!
+! Maximum number of iterations
+INB_ITER_MAX=NMAXITER
+IF(XTSTEP_TS/=0.)THEN
+ INB_ITER_MAX=MAX(1, INT(PTSTEP/XTSTEP_TS)) !At least the number of iterations needed for the time-splitting
+ ZTSTEP=PTSTEP/INB_ITER_MAX
+ INB_ITER_MAX=MAX(NMAXITER, INB_ITER_MAX) !Fot the case XMRSTEP/=0. at the same time
+ENDIF
+IITER(:,:,:)=0
+ZTIME(:,:,:)=0. ! Current integration time (all points may have a different integration time)
+!
+! Begin the huge time splitting loop
+!
+ZRT_SUM(:,:,:) = ZRCT(:,:,:) + ZRRT(:,:,:) + ZRIT(:,:,:) + ZRST(:,:,:) + ZRGT(:,:,:) + ZRHT(:,:,:)
+WHERE (ZRT_SUM(:,:,:)<XRTMIN(2)) ZTIME(:,:,:)=PTSTEP ! no need to treat hydrometeor-free point
+!
+DO WHILE(ANY(ZTIME(IIB:IIE,IJB:IJE,IKTB:IKTE)<PTSTEP))
+ !
+ IF(XMRSTEP/=0.) THEN
+ ! In this case we need to remember the mixing ratios used to compute the tendencies
+ ! because when mixing ratio has evolved more than a threshold, we must re-compute tendecies
+ Z0RVT(:,:,:)=ZRVT(:,:,:)
+ Z0RCT(:,:,:)=ZRCT(:,:,:)
+ Z0RRT(:,:,:)=ZRRT(:,:,:)
+ Z0RIT(:,:,:)=ZRIT(:,:,:)
+ Z0RST(:,:,:)=ZRST(:,:,:)
+ Z0RGT(:,:,:)=ZRGT(:,:,:)
+ Z0RHT(:,:,:)=ZRHT(:,:,:)
+ ENDIF
+ !
+ IF(XTSTEP_TS/=0.) THEN
+ ! In this case we need to remember the time when tendencies were computed
+ ! because when time has evolved more than a limit, we must re-compute tendecies
+ ZTIME_LASTCALL(:,:,:)=ZTIME(:,:,:)
+ ENDIF
+ !
+ LLCOMPUTE(:,:,:)=.FALSE.
+ LLCOMPUTE(IIB:IIE,IJB:IJE,IKTB:IKTE) = ZTIME(IIB:IIE,IJB:IJE,IKTB:IKTE)<PTSTEP ! Compuation only for points for which integration time has not reached the timestep
+ WHERE(LLCOMPUTE(:,:,:))
+ IITER(:,:,:)=IITER(:,:,:)+1
+ END WHERE
+ !
+ DO WHILE(ANY(LLCOMPUTE(:,:,:))) ! Loop to adjust tendencies when we cross the 0°C or when a species disappears
+
+ !
+ ! Packing variables to run computations only where necessary
+ !
+ IPACK = COUNT(LLCOMPUTE)
+ ALLOCATE(I1(IPACK))
+ ALLOCATE(I2(IPACK))
+ ALLOCATE(I3(IPACK))
+ ALLOCATE(ZRHODREF1D(IPACK))
+ ALLOCATE(ZEXNREF1D(IPACK))
+ ALLOCATE(ZEXN1D(IPACK))
+ ALLOCATE(ZP1D(IPACK))
+ ALLOCATE(ZTHT1D(IPACK))
+ ALLOCATE(ZRVT1D(IPACK))
+ ALLOCATE(ZRCT1D(IPACK))
+ ALLOCATE(ZRRT1D(IPACK))
+ ALLOCATE(ZRIT1D(IPACK))
+ ALLOCATE(ZRST1D(IPACK))
+ ALLOCATE(ZRGT1D(IPACK))
+ ALLOCATE(ZRHT1D(IPACK))
+ ALLOCATE(ZCCT1D(IPACK))
+ ALLOCATE(ZCRT1D(IPACK))
+ ALLOCATE(ZCIT1D(IPACK))
+ ALLOCATE(ZIFNN1D(IPACK,NMOD_IFN))
+ ALLOCATE(ZEVAP1D(IPACK))
+ ALLOCATE(ZTIME1D(IPACK))
+ ALLOCATE(LLCOMPUTE1D(IPACK))
+ ALLOCATE(IITER1D(IPACK))
+ ALLOCATE(ZTIME_LASTCALL1D(IPACK))
+ ALLOCATE(Z0RVT1D(IPACK))
+ ALLOCATE(Z0RCT1D(IPACK))
+ ALLOCATE(Z0RRT1D(IPACK))
+ ALLOCATE(Z0RIT1D(IPACK))
+ ALLOCATE(Z0RST1D(IPACK))
+ ALLOCATE(Z0RGT1D(IPACK))
+ ALLOCATE(Z0RHT1D(IPACK))
+ ALLOCATE(ZCF1D(IPACK))
+ ALLOCATE(ZIF1D(IPACK))
+ ALLOCATE(ZPF1D(IPACK))
+ IPACK = COUNTJV(LLCOMPUTE,I1,I2,I3)
+ DO II=1,IPACK
+ ZRHODREF1D(II) = PRHODREF(I1(II),I2(II),I3(II))
+ ZEXNREF1D(II) = PEXNREF(I1(II),I2(II),I3(II))
+ ZEXN1D(II) = ZEXN(I1(II),I2(II),I3(II))
+ ZP1D(II) = PPABST(I1(II),I2(II),I3(II))
+ ZTHT1D(II) = ZTHT(I1(II),I2(II),I3(II))
+ ZRVT1D(II) = ZRVT(I1(II),I2(II),I3(II))
+ ZRCT1D(II) = ZRCT(I1(II),I2(II),I3(II))
+ ZRRT1D(II) = ZRRT(I1(II),I2(II),I3(II))
+ ZRIT1D(II) = ZRIT(I1(II),I2(II),I3(II))
+ ZRST1D(II) = ZRST(I1(II),I2(II),I3(II))
+ ZRGT1D(II) = ZRGT(I1(II),I2(II),I3(II))
+ ZRHT1D(II) = ZRHT(I1(II),I2(II),I3(II))
+ ZCCT1D(II) = ZCCT(I1(II),I2(II),I3(II))
+ ZCRT1D(II) = ZCRT(I1(II),I2(II),I3(II))
+ ZCIT1D(II) = ZCIT(I1(II),I2(II),I3(II))
+ ZIFNN1D(II,:) = ZIFNNT(I1(II),I2(II),I3(II),:)
+ ZEVAP1D(II) = PEVAP3D(I1(II),I2(II),I3(II))
+ ZTIME1D(II) = ZTIME(I1(II),I2(II),I3(II))
+ LLCOMPUTE1D(II) = LLCOMPUTE(I1(II),I2(II),I3(II))
+ IITER1D(II) = IITER(I1(II),I2(II),I3(II))
+ ZTIME_LASTCALL1D(II) = ZTIME_LASTCALL(I1(II),I2(II),I3(II))
+ Z0RVT1D(II) = Z0RVT(I1(II),I2(II),I3(II))
+ Z0RCT1D(II) = Z0RCT(I1(II),I2(II),I3(II))
+ Z0RRT1D(II) = Z0RRT(I1(II),I2(II),I3(II))
+ Z0RIT1D(II) = Z0RIT(I1(II),I2(II),I3(II))
+ Z0RST1D(II) = Z0RST(I1(II),I2(II),I3(II))
+ Z0RGT1D(II) = Z0RGT(I1(II),I2(II),I3(II))
+ Z0RHT1D(II) = Z0RHT(I1(II),I2(II),I3(II))
+ ZCF1D(II) = PCLDFR(I1(II),I2(II),I3(II))
+ ZIF1D(II) = PICEFR(I1(II),I2(II),I3(II))
+ ZPF1D(II) = PPRCFR(I1(II),I2(II),I3(II))
+ END DO
+ !
+ WHERE(ZCF1D(:)<1.E-10 .AND. ZRCT1D(:)>XRTMIN(2) .AND. ZCCT1D(:)>XCTMIN(2)) ZCF1D(:)=1.
+ WHERE(ZIF1D(:)<1.E-10 .AND. ZRIT1D(:)>XRTMIN(4) .AND. ZCIT1D(:)>XCTMIN(4)) ZIF1D(:)=1.
+ WHERE(ZPF1D(:)<1.E-10 .AND. (ZRRT1D(:)>XRTMIN(3) .OR. ZRST1D(:)>XRTMIN(5) &
+ .OR. ZRGT1D(:)>XRTMIN(6) .OR. ZRHT1D(:)>XRTMIN(7) ) ) ZPF1D(:)=1.
+ !
+ ! Allocating 1D variables
+ !
+ ALLOCATE(ZMAXTIME(IPACK)) ; ZMAXTIME(:) = 0.
+ ALLOCATE(ZTIME_THRESHOLD(IPACK)) ; ZTIME_THRESHOLD(:) = 0.
+ !
+ ALLOCATE(ZA_TH(IPACK)) ; ZA_TH(:) = 0.
+ ALLOCATE(ZA_RV(IPACK)) ; ZA_RV(:) = 0.
+ ALLOCATE(ZA_RC(IPACK)) ; ZA_RC(:) = 0.
+ ALLOCATE(ZA_RR(IPACK)) ; ZA_RR(:) = 0.
+ ALLOCATE(ZA_RI(IPACK)) ; ZA_RI(:) = 0.
+ ALLOCATE(ZA_RS(IPACK)) ; ZA_RS(:) = 0.
+ ALLOCATE(ZA_RG(IPACK)) ; ZA_RG(:) = 0.
+ ALLOCATE(ZA_RH(IPACK)) ; ZA_RH(:) = 0.
+ ALLOCATE(ZA_CC(IPACK)) ; ZA_CC(:) = 0.
+ ALLOCATE(ZA_CR(IPACK)) ; ZA_CR(:) = 0.
+ ALLOCATE(ZA_CI(IPACK)) ; ZA_CI(:) = 0.
+ !
+ ALLOCATE(ZB_TH(IPACK)) ; ZB_TH(:) = 0.
+ ALLOCATE(ZB_RV(IPACK)) ; ZB_RV(:) = 0.
+ ALLOCATE(ZB_RC(IPACK)) ; ZB_RC(:) = 0.
+ ALLOCATE(ZB_RR(IPACK)) ; ZB_RR(:) = 0.
+ ALLOCATE(ZB_RI(IPACK)) ; ZB_RI(:) = 0.
+ ALLOCATE(ZB_RS(IPACK)) ; ZB_RS(:) = 0.
+ ALLOCATE(ZB_RG(IPACK)) ; ZB_RG(:) = 0.
+ ALLOCATE(ZB_RH(IPACK)) ; ZB_RH(:) = 0.
+ ALLOCATE(ZB_CC(IPACK)) ; ZB_CC(:) = 0.
+ ALLOCATE(ZB_CR(IPACK)) ; ZB_CR(:) = 0.
+ ALLOCATE(ZB_CI(IPACK)) ; ZB_CI(:) = 0.
+ ALLOCATE(ZB_IFNN(IPACK,NMOD_IFN)) ; ZB_IFNN(:,:) = 0.
+ !
+ ALLOCATE(Z_CR_BRKU(IPACK)) ; Z_CR_BRKU(:) = 0.
+ ALLOCATE(Z_TH_HONR(IPACK)) ; Z_TH_HONR(:) = 0.
+ ALLOCATE(Z_RR_HONR(IPACK)) ; Z_RR_HONR(:) = 0.
+ ALLOCATE(Z_CR_HONR(IPACK)) ; Z_CR_HONR(:) = 0.
+ ALLOCATE(Z_TH_IMLT(IPACK)) ; Z_TH_IMLT(:) = 0.
+ ALLOCATE(Z_RC_IMLT(IPACK)) ; Z_RC_IMLT(:) = 0.
+ ALLOCATE(Z_CC_IMLT(IPACK)) ; Z_CC_IMLT(:) = 0.
+ ALLOCATE(Z_TH_HONC(IPACK)) ; Z_TH_HONC(:) = 0.
+ ALLOCATE(Z_RC_HONC(IPACK)) ; Z_RC_HONC(:) = 0.
+ ALLOCATE(Z_CC_HONC(IPACK)) ; Z_CC_HONC(:) = 0.
+ ALLOCATE(Z_CC_SELF(IPACK)) ; Z_CC_SELF(:) = 0.
+ ALLOCATE(Z_RC_AUTO(IPACK)) ; Z_RC_AUTO(:) = 0.
+ ALLOCATE(Z_CC_AUTO(IPACK)) ; Z_CC_AUTO(:) = 0.
+ ALLOCATE(Z_CR_AUTO(IPACK)) ; Z_CR_AUTO(:) = 0.
+ ALLOCATE(Z_RC_ACCR(IPACK)) ; Z_RC_ACCR(:) = 0.
+ ALLOCATE(Z_CC_ACCR(IPACK)) ; Z_CC_ACCR(:) = 0.
+ ALLOCATE(Z_CR_SCBU(IPACK)) ; Z_CR_SCBU(:) = 0.
+ ALLOCATE(Z_TH_EVAP(IPACK)) ; Z_TH_EVAP(:) = 0.
+ ALLOCATE(Z_RR_EVAP(IPACK)) ; Z_RR_EVAP(:) = 0.
+ ALLOCATE(Z_RI_CNVI(IPACK)) ; Z_RI_CNVI(:) = 0.
+ ALLOCATE(Z_CI_CNVI(IPACK)) ; Z_CI_CNVI(:) = 0.
+ ALLOCATE(Z_TH_DEPS(IPACK)) ; Z_TH_DEPS(:) = 0.
+ ALLOCATE(Z_RS_DEPS(IPACK)) ; Z_RS_DEPS(:) = 0.
+ ALLOCATE(Z_TH_DEPI(IPACK)) ; Z_TH_DEPI(:) = 0.
+ ALLOCATE(Z_RI_DEPI(IPACK)) ; Z_RI_DEPI(:) = 0.
+ ALLOCATE(Z_RI_CNVS(IPACK)) ; Z_RI_CNVS(:) = 0.
+ ALLOCATE(Z_CI_CNVS(IPACK)) ; Z_CI_CNVS(:) = 0.
+ ALLOCATE(Z_RI_AGGS(IPACK)) ; Z_RI_AGGS(:) = 0.
+ ALLOCATE(Z_CI_AGGS(IPACK)) ; Z_CI_AGGS(:) = 0.
+ ALLOCATE(Z_TH_DEPG(IPACK)) ; Z_TH_DEPG(:) = 0.
+ ALLOCATE(Z_RG_DEPG(IPACK)) ; Z_RG_DEPG(:) = 0.
+ ALLOCATE(Z_TH_BERFI(IPACK)) ; Z_TH_BERFI(:) = 0.
+ ALLOCATE(Z_RC_BERFI(IPACK)) ; Z_RC_BERFI(:) = 0.
+ ALLOCATE(Z_TH_RIM(IPACK)) ; Z_TH_RIM = 0.
+ ALLOCATE(Z_RC_RIM(IPACK)) ; Z_RC_RIM = 0.
+ ALLOCATE(Z_CC_RIM(IPACK)) ; Z_CC_RIM = 0.
+ ALLOCATE(Z_RS_RIM(IPACK)) ; Z_RS_RIM = 0.
+ ALLOCATE(Z_RG_RIM(IPACK)) ; Z_RG_RIM = 0.
+ ALLOCATE(Z_RI_HMS(IPACK)) ; Z_RI_HMS = 0.
+ ALLOCATE(Z_CI_HMS(IPACK)) ; Z_CI_HMS = 0.
+ ALLOCATE(Z_RS_HMS(IPACK)) ; Z_RS_HMS = 0.
+ ALLOCATE(Z_TH_ACC(IPACK)) ; Z_TH_ACC = 0.
+ ALLOCATE(Z_RR_ACC(IPACK)) ; Z_RR_ACC = 0.
+ ALLOCATE(Z_CR_ACC(IPACK)) ; Z_CR_ACC = 0.
+ ALLOCATE(Z_RS_ACC(IPACK)) ; Z_RS_ACC = 0.
+ ALLOCATE(Z_RG_ACC(IPACK)) ; Z_RG_ACC = 0.
+ ALLOCATE(Z_RS_CMEL(IPACK)) ; Z_RS_CMEL = 0.
+ ALLOCATE(Z_TH_CFRZ(IPACK)) ; Z_TH_CFRZ = 0.
+ ALLOCATE(Z_RR_CFRZ(IPACK)) ; Z_RR_CFRZ = 0.
+ ALLOCATE(Z_CR_CFRZ(IPACK)) ; Z_CR_CFRZ = 0.
+ ALLOCATE(Z_RI_CFRZ(IPACK)) ; Z_RI_CFRZ = 0.
+ ALLOCATE(Z_CI_CFRZ(IPACK)) ; Z_CI_CFRZ = 0.
+ ALLOCATE(Z_TH_WETG(IPACK)) ; Z_TH_WETG = 0.
+ ALLOCATE(Z_RC_WETG(IPACK)) ; Z_RC_WETG = 0.
+ ALLOCATE(Z_CC_WETG(IPACK)) ; Z_CC_WETG = 0.
+ ALLOCATE(Z_RR_WETG(IPACK)) ; Z_RR_WETG = 0.
+ ALLOCATE(Z_CR_WETG(IPACK)) ; Z_CR_WETG = 0.
+ ALLOCATE(Z_RI_WETG(IPACK)) ; Z_RI_WETG = 0.
+ ALLOCATE(Z_CI_WETG(IPACK)) ; Z_CI_WETG = 0.
+ ALLOCATE(Z_RS_WETG(IPACK)) ; Z_RS_WETG = 0.
+ ALLOCATE(Z_RG_WETG(IPACK)) ; Z_RG_WETG = 0.
+ ALLOCATE(Z_RH_WETG(IPACK)) ; Z_RH_WETG = 0.
+ ALLOCATE(Z_TH_DRYG(IPACK)) ; Z_TH_DRYG = 0.
+ ALLOCATE(Z_RC_DRYG(IPACK)) ; Z_RC_DRYG = 0.
+ ALLOCATE(Z_CC_DRYG(IPACK)) ; Z_CC_DRYG = 0.
+ ALLOCATE(Z_RR_DRYG(IPACK)) ; Z_RR_DRYG = 0.
+ ALLOCATE(Z_CR_DRYG(IPACK)) ; Z_CR_DRYG = 0.
+ ALLOCATE(Z_RI_DRYG(IPACK)) ; Z_RI_DRYG = 0.
+ ALLOCATE(Z_CI_DRYG(IPACK)) ; Z_CI_DRYG = 0.
+ ALLOCATE(Z_RS_DRYG(IPACK)) ; Z_RS_DRYG = 0.
+ ALLOCATE(Z_RG_DRYG(IPACK)) ; Z_RG_DRYG = 0.
+ ALLOCATE(Z_RI_HMG(IPACK)) ; Z_RI_HMG = 0.
+ ALLOCATE(Z_CI_HMG(IPACK)) ; Z_CI_HMG = 0.
+ ALLOCATE(Z_RG_HMG(IPACK)) ; Z_RG_HMG = 0.
+ ALLOCATE(Z_TH_GMLT(IPACK)) ; Z_TH_GMLT = 0.
+ ALLOCATE(Z_RR_GMLT(IPACK)) ; Z_RR_GMLT = 0.
+ ALLOCATE(Z_CR_GMLT(IPACK)) ; Z_CR_GMLT = 0.
+
+ ALLOCATE(Z_RV_CORR2(IPACK)) ; Z_RV_CORR2 = 0.
+ ALLOCATE(Z_RC_CORR2(IPACK)) ; Z_RC_CORR2 = 0.
+ ALLOCATE(Z_RR_CORR2(IPACK)) ; Z_RR_CORR2 = 0.
+ ALLOCATE(Z_RI_CORR2(IPACK)) ; Z_RI_CORR2 = 0.
+ ALLOCATE(Z_CC_CORR2(IPACK)) ; Z_CC_CORR2 = 0.
+ ALLOCATE(Z_CR_CORR2(IPACK)) ; Z_CR_CORR2 = 0.
+ ALLOCATE(Z_CI_CORR2(IPACK)) ; Z_CI_CORR2 = 0.
+ !
+ !*** 4.1 Tendecies computation
+ !
+
+ CALL LIMA_INST_PROCS (PTSTEP, LLCOMPUTE1D, &
+ ZEXNREF1D, ZP1D, &
+ ZTHT1D, ZRVT1D, ZRCT1D, ZRRT1D, ZRIT1D, ZRST1D, ZRGT1D, &
+ ZCCT1D, ZCRT1D, ZCIT1D, &
+ ZIFNN1D, &
+ Z_CR_BRKU, & ! spontaneous break up of drops (BRKU) : Nr
+ Z_TH_HONR, Z_RR_HONR, Z_CR_HONR, & ! rain drops homogeneous freezing (HONR) : rr, Nr, rg=-rr, th
+ Z_TH_IMLT, Z_RC_IMLT, Z_CC_IMLT, & ! ice melting (IMLT) : rc, Nc, ri=-rc, Ni=-Nc, th, IFNF, IFNA
+ ZB_TH, ZB_RV, ZB_RC, ZB_RR, ZB_RI, ZB_RG, &
+ ZB_CC, ZB_CR, ZB_CI, &
+ ZB_IFNN, &
+ ZCF1D, ZIF1D, ZPF1D )
+
+ CALL LIMA_TENDENCIES (PTSTEP, LLCOMPUTE1D, &
+ ZEXNREF1D, ZRHODREF1D, ZP1D, ZTHT1D, &
+ ZRVT1D, ZRCT1D, ZRRT1D, ZRIT1D, ZRST1D, ZRGT1D, ZRHT1D,&
+ ZCCT1D, ZCRT1D, ZCIT1D, &
+ Z_TH_HONC, Z_RC_HONC, Z_CC_HONC, &
+ Z_CC_SELF, &
+ Z_RC_AUTO, Z_CC_AUTO, Z_CR_AUTO, &
+ Z_RC_ACCR, Z_CC_ACCR, &
+ Z_CR_SCBU, &
+ Z_TH_EVAP, Z_RR_EVAP, &
+ Z_RI_CNVI, Z_CI_CNVI, &
+ Z_TH_DEPS, Z_RS_DEPS, &
+ Z_TH_DEPI, Z_RI_DEPI, &
+ Z_RI_CNVS, Z_CI_CNVS, &
+ Z_RI_AGGS, Z_CI_AGGS, &
+ Z_TH_DEPG, Z_RG_DEPG, &
+ Z_TH_BERFI, Z_RC_BERFI, &
+ Z_TH_RIM, Z_RC_RIM, Z_CC_RIM, Z_RS_RIM, Z_RG_RIM, &
+ Z_RI_HMS, Z_CI_HMS, Z_RS_HMS, &
+ Z_TH_ACC, Z_RR_ACC, Z_CR_ACC, Z_RS_ACC, Z_RG_ACC, &
+ Z_RS_CMEL, &
+ Z_TH_CFRZ, Z_RR_CFRZ, Z_CR_CFRZ, Z_RI_CFRZ, Z_CI_CFRZ, &
+ Z_TH_WETG, Z_RC_WETG, Z_CC_WETG, Z_RR_WETG, Z_CR_WETG, &
+ Z_RI_WETG, Z_CI_WETG, Z_RS_WETG, Z_RG_WETG, Z_RH_WETG, &
+ Z_TH_DRYG, Z_RC_DRYG, Z_CC_DRYG, Z_RR_DRYG, Z_CR_DRYG, &
+ Z_RI_DRYG, Z_CI_DRYG, Z_RS_DRYG, Z_RG_DRYG, &
+ Z_RI_HMG, Z_CI_HMG, Z_RG_HMG, &
+ Z_TH_GMLT, Z_RR_GMLT, Z_CR_GMLT, &
+!!! Z_RC_WETH, Z_CC_WETH, Z_RR_WETH, Z_CR_WETH, & ! wet growth of hail (WETH) : rc, Nc, rr, Nr, ri, Ni, rs, rg, rh, th
+!!! Z_RI_WETH, Z_CI_WETH, Z_RS_WETH, Z_RG_WETH, Z_RH_WETH, & ! wet growth of hail (WETH) : rc, Nc, rr, Nr, ri, Ni, rs, rg, rh, th
+!!! Z_RG_COHG, & ! conversion of hail into graupel (COHG) : rg, rh
+!!! Z_RR_HMLT, Z_CR_HMLT ! hail melting (HMLT) : rr, Nr, rh=-rr, th
+ ZA_TH, ZA_RV, ZA_RC, ZA_CC, ZA_RR, ZA_CR, &
+ ZA_RI, ZA_CI, ZA_RS, ZA_RG, ZA_RH, &
+ ZEVAP1D, &
+ ZCF1D, ZIF1D, ZPF1D )
+
+ !
+ !*** 4.2 Integration time
+ !
+ ! If we can, we will use these tendecies until the end of the timestep
+ ZMAXTIME(:)=PTSTEP-ZTIME1D(:) ! Remaining time until the end of the timestep
+
+ ! We need to adjust tendencies when temperature reaches 0
+ IF(LFEEDBACKT) THEN
+ !Is ZB_TH enough to change temperature sign?
+ WHERE( ((ZTHT1D(:) - XTT/ZEXN1D(:)) * (ZTHT1D(:) + ZB_TH(:) - XTT/ZEXN1D(:))) < 0. )
+ ZMAXTIME(:)=0.
+ ENDWHERE
+ !Can ZA_TH make temperature change of sign?
+ ZTIME_THRESHOLD(:)=-1.
+ WHERE(ABS(ZA_TH(:))>1.E-20)
+ ZTIME_THRESHOLD(:)=(XTT/ZEXN1D(:) - ZB_TH(:) - ZTHT1D(:))/ZA_TH(:)
+ ENDWHERE
+ WHERE(ZTIME_THRESHOLD(:)>0.)
+ ZMAXTIME(:)=MIN(ZMAXTIME(:), ZTIME_THRESHOLD(:))
+ ENDWHERE
+ ENDIF
+
+ ! We need to adjust tendencies when a species disappears
+ ! When a species is missing, only the external tendencies can be negative (and we must keep track of it)
+ WHERE(ZA_RV(:)<-1.E-20 .AND. ZRVT1D(:)>XRTMIN(1))
+ ZMAXTIME(:)=MIN(ZMAXTIME(:), -(ZB_RV(:)+ZRVT1D(:))/ZA_RV(:))
+ END WHERE
+ WHERE(ZA_RC(:)<-1.E-20 .AND. ZRCT1D(:)>XRTMIN(2))
+ ZMAXTIME(:)=MIN(ZMAXTIME(:), -(ZB_RC(:)+ZRCT1D(:))/ZA_RC(:))
+ END WHERE
+ WHERE(ZA_RR(:)<-1.E-20 .AND. ZRRT1D(:)>XRTMIN(3))
+ ZMAXTIME(:)=MIN(ZMAXTIME(:), -(ZB_RR(:)+ZRRT1D(:))/ZA_RR(:))
+ END WHERE
+ WHERE(ZA_RI(:)<-1.E-20 .AND. ZRIT1D(:)>XRTMIN(4))
+ ZMAXTIME(:)=MIN(ZMAXTIME(:), -(ZB_RI(:)+ZRIT1D(:))/ZA_RI(:))
+ END WHERE
+ WHERE(ZA_RS(:)<-1.E-20 .AND. ZRST1D(:)>XRTMIN(5))
+ ZMAXTIME(:)=MIN(ZMAXTIME(:), -(ZB_RS(:)+ZRST1D(:))/ZA_RS(:))
+ END WHERE
+ WHERE(ZA_RG(:)<-1.E-20 .AND. ZRGT1D(:)>XRTMIN(6))
+ ZMAXTIME(:)=MIN(ZMAXTIME(:), -(ZB_RG(:)+ZRGT1D(:))/ZA_RG(:))
+ END WHERE
+ WHERE(ZA_RH(:)<-1.E-20 .AND. ZRHT1D(:)>XRTMIN(7))
+ ZMAXTIME(:)=MIN(ZMAXTIME(:), -(ZB_RH(:)+ZRHT1D(:))/ZA_RH(:))
+ END WHERE
+
+ ! We stop when the end of the timestep is reached
+ WHERE(PTSTEP-ZTIME1D(:)-ZMAXTIME(:)<=0.)
+ LLCOMPUTE1D(:)=.FALSE.
+ ENDWHERE
+
+ ! We must recompute tendencies when the end of the sub-timestep is reached
+ IF(XTSTEP_TS/=0.) THEN
+ WHERE(IITER1D(:)<INB_ITER_MAX .AND. ZTIME1D(:)+ZMAXTIME(:)>ZTIME_LASTCALL1D(:)+ZTSTEP)
+ ZMAXTIME(:)=ZTIME_LASTCALL1D(:)-ZTIME1D(:)+ZTSTEP
+ LLCOMPUTE1D(:)=.FALSE.
+ ENDWHERE
+ ENDIF
+
+ ! We must recompute tendencies when the maximum allowed change is reached
+ ! When a species is missing, only the external tendencies can be active and we do not want to recompute
+ ! the microphysical tendencies when external tendencies are negative (results won't change because species was already missing)
+ IF(XMRSTEP/=0.) THEN
+ ZTIME_THRESHOLD(:)=-1.
+ WHERE(IITER1D(:)<INB_ITER_MAX .AND. ABS(ZA_RV(:))>1.E-20)
+ ZTIME_THRESHOLD(:)=(SIGN(1., ZA_RV(:))*XMRSTEP+Z0RVT1D(:)-ZRVT1D(:)-ZB_RV(:))/ZA_RV(:)
+ ENDWHERE
+ WHERE(ZTIME_THRESHOLD(:)>=0. .AND. ZTIME_THRESHOLD(:)<ZMAXTIME(:) .AND. &
+ &(ZRVT1D(:)>XRTMIN(1) .OR. ZA_RV(:)>0.))
+ ZMAXTIME(:)=MIN(ZMAXTIME(:), ZTIME_THRESHOLD(:))
+ LLCOMPUTE1D(:)=.FALSE.
+ ENDWHERE
+
+ ZTIME_THRESHOLD(:)=-1.
+ WHERE(IITER1D(:)<INB_ITER_MAX .AND. ABS(ZA_RC(:))>1.E-20)
+ ZTIME_THRESHOLD(:)=(SIGN(1., ZA_RC(:))*XMRSTEP+Z0RCT1D(:)-ZRCT1D(:)-ZB_RC(:))/ZA_RC(:)
+ ENDWHERE
+ WHERE(ZTIME_THRESHOLD(:)>=0. .AND. ZTIME_THRESHOLD(:)<ZMAXTIME(:) .AND. &
+ &(ZRCT1D(:)>XRTMIN(2) .OR. ZA_RC(:)>0.))
+ ZMAXTIME(:)=MIN(ZMAXTIME(:), ZTIME_THRESHOLD(:))
+ LLCOMPUTE1D(:)=.FALSE.
+ ENDWHERE
+
+ ZTIME_THRESHOLD(:)=-1.
+ WHERE(IITER1D(:)<INB_ITER_MAX .AND. ABS(ZA_RR(:))>1.E-20)
+ ZTIME_THRESHOLD(:)=(SIGN(1., ZA_RR(:))*XMRSTEP+Z0RRT1D(:)-ZRRT1D(:)-ZB_RR(:))/ZA_RR(:)
+ ENDWHERE
+ WHERE(ZTIME_THRESHOLD(:)>=0. .AND. ZTIME_THRESHOLD(:)<ZMAXTIME(:) .AND. &
+ &(ZRRT1D(:)>XRTMIN(3) .OR. ZA_RR(:)>0.))
+ ZMAXTIME(:)=MIN(ZMAXTIME(:), ZTIME_THRESHOLD(:))
+ LLCOMPUTE1D(:)=.FALSE.
+ ENDWHERE
+
+ ZTIME_THRESHOLD(:)=-1.
+ WHERE(IITER1D(:)<INB_ITER_MAX .AND. ABS(ZA_RI(:))>1.E-20)
+ ZTIME_THRESHOLD(:)=(SIGN(1., ZA_RI(:))*XMRSTEP+Z0RIT1D(:)-ZRIT1D(:)-ZB_RI(:))/ZA_RI(:)
+ ENDWHERE
+ WHERE(ZTIME_THRESHOLD(:)>=0. .AND. ZTIME_THRESHOLD(:)<ZMAXTIME(:) .AND. &
+ &(ZRIT1D(:)>XRTMIN(4) .OR. ZA_RI(:)>0.))
+ ZMAXTIME(:)=MIN(ZMAXTIME(:), ZTIME_THRESHOLD(:))
+ LLCOMPUTE1D(:)=.FALSE.
+ ENDWHERE
+
+ ZTIME_THRESHOLD(:)=-1.
+ WHERE(IITER1D(:)<INB_ITER_MAX .AND. ABS(ZA_RS(:))>1.E-20)
+ ZTIME_THRESHOLD(:)=(SIGN(1., ZA_RS(:))*XMRSTEP+Z0RST1D(:)-ZRST1D(:)-ZB_RS(:))/ZA_RS(:)
+ ENDWHERE
+ WHERE(ZTIME_THRESHOLD(:)>=0. .AND. ZTIME_THRESHOLD(:)<ZMAXTIME(:) .AND. &
+ &(ZRST1D(:)>XRTMIN(5) .OR. ZA_RS(:)>0.))
+ ZMAXTIME(:)=MIN(ZMAXTIME(:), ZTIME_THRESHOLD(:))
+ LLCOMPUTE1D(:)=.FALSE.
+ ENDWHERE
+
+ ZTIME_THRESHOLD(:)=-1.
+ WHERE(IITER1D(:)<INB_ITER_MAX .AND. ABS(ZA_RG(:))>1.E-20)
+ ZTIME_THRESHOLD(:)=(SIGN(1., ZA_RG(:))*XMRSTEP+Z0RGT1D(:)-ZRGT1D(:)-ZB_RG(:))/ZA_RG(:)
+ ENDWHERE
+ WHERE(ZTIME_THRESHOLD(:)>=0. .AND. ZTIME_THRESHOLD(:)<ZMAXTIME(:) .AND. &
+ &(ZRGT1D(:)>XRTMIN(6) .OR. ZA_RG(:)>0.))
+ ZMAXTIME(:)=MIN(ZMAXTIME(:), ZTIME_THRESHOLD(:))
+ LLCOMPUTE1D(:)=.FALSE.
+ ENDWHERE
+
+ ZTIME_THRESHOLD(:)=-1.
+ WHERE(IITER1D(:)<INB_ITER_MAX .AND. ABS(ZA_RH(:))>1.E-20)
+ ZTIME_THRESHOLD(:)=(SIGN(1., ZA_RH(:))*XMRSTEP+Z0RHT1D(:)-ZRHT1D(:)-ZB_RH(:))/ZA_RH(:)
+ ENDWHERE
+ WHERE(ZTIME_THRESHOLD(:)>=0. .AND. ZTIME_THRESHOLD(:)<ZMAXTIME(:) .AND. &
+ &(ZRHT1D(:)>XRTMIN(7) .OR. ZA_RH(:)>0.))
+ ZMAXTIME(:)=MIN(ZMAXTIME(:), ZTIME_THRESHOLD(:))
+ LLCOMPUTE1D(:)=.FALSE.
+ ENDWHERE
+
+ WHERE(IITER1D(:)<INB_ITER_MAX .AND. MAX(ABS(ZB_RV(:)), &
+ ABS(ZB_RC(:)), ABS(ZB_RR(:)), ABS(ZB_RI(:)), &
+ ABS(ZB_RS(:)), ABS(ZB_RG(:)), ABS(ZB_RH(:)))>XMRSTEP)
+ ZMAXTIME(:)=0.
+ LLCOMPUTE1D(:)=.FALSE.
+ ENDWHERE
+ ENDIF
+ !
+ !*** 4.3 New values of variables for next iteration
+ !
+ ZTHT1D = ZTHT1D + ZA_TH(:) * ZMAXTIME(:) + ZB_TH(:)
+ ZRVT1D = ZRVT1D + ZA_RV(:) * ZMAXTIME(:) + ZB_RV(:)
+ ZRCT1D = ZRCT1D + ZA_RC(:) * ZMAXTIME(:) + ZB_RC(:)
+ ZCCT1D = ZCCT1D + ZA_CC(:) * ZMAXTIME(:) + ZB_CC(:)
+ ZRRT1D = ZRRT1D + ZA_RR(:) * ZMAXTIME(:) + ZB_RR(:)
+ ZCRT1D = ZCRT1D + ZA_CR(:) * ZMAXTIME(:) + ZB_CR(:)
+ ZRIT1D = ZRIT1D + ZA_RI(:) * ZMAXTIME(:) + ZB_RI(:)
+ ZCIT1D = ZCIT1D + ZA_CI(:) * ZMAXTIME(:) + ZB_CI(:)
+ ZRST1D = ZRST1D + ZA_RS(:) * ZMAXTIME(:) + ZB_RS(:)
+ ZRGT1D = ZRGT1D + ZA_RG(:) * ZMAXTIME(:) + ZB_RG(:)
+ ZRHT1D = ZRHT1D + ZA_RH(:) * ZMAXTIME(:) + ZB_RH(:)
+ !
+ DO II=1,NMOD_IFN
+ ZIFNN1D(:,II) = ZIFNN1D(:,II) + ZB_IFNN(:,II)
+ END DO
+ !
+ !*** 4.5
+ !
+ WHERE (ZRCT1D .LE. XRTMIN(2))
+ Z_RV_CORR2(:) = ZRCT1D(:)
+ Z_RC_CORR2(:) = -ZRCT1D(:)
+ Z_CC_CORR2(:) = -ZCCT1D(:)
+
+ ZRVT1D = ZRVT1D + ZRCT1D
+ ZRCT1D = 0.
+ ZCCT1D = 0.
+ END WHERE
+ WHERE (ZRRT1D .LE. XRTMIN(3))
+ Z_RV_CORR2(:) = Z_RV_CORR2(:) + ZRRT1D(:)
+ Z_RR_CORR2(:) = -ZRRT1D(:)
+ Z_CR_CORR2(:) = -ZCRT1D(:)
+
+ ZRVT1D = ZRVT1D + ZRRT1D
+ ZRRT1D = 0.
+ ZCRT1D = 0.
+ END WHERE
+ WHERE (ZRIT1D .LE. XRTMIN(4))
+ Z_RV_CORR2(:) = Z_RV_CORR2(:) + ZRIT1D(:)
+ Z_RI_CORR2(:) = -ZRIT1D(:)
+ Z_CI_CORR2(:) = -ZCIT1D(:)
+
+ ZRVT1D = ZRVT1D + ZRIT1D
+ ZRIT1D = 0.
+ ZCIT1D = 0.
+ END WHERE
+
+ !
+ !*** 4.5 Next loop
+ !
+ ZTIME1D(:)=ZTIME1D(:)+ZMAXTIME(:)
+ !
+ !*** 4.4 Unpacking
+ !
+ DO II=1,IPACK
+ ZTHT(I1(II),I2(II),I3(II)) = ZTHT1D(II)
+ ZRVT(I1(II),I2(II),I3(II)) = ZRVT1D(II)
+ ZRCT(I1(II),I2(II),I3(II)) = ZRCT1D(II)
+ ZRRT(I1(II),I2(II),I3(II)) = ZRRT1D(II)
+ ZRIT(I1(II),I2(II),I3(II)) = ZRIT1D(II)
+ ZRST(I1(II),I2(II),I3(II)) = ZRST1D(II)
+ ZRGT(I1(II),I2(II),I3(II)) = ZRGT1D(II)
+ ZRHT(I1(II),I2(II),I3(II)) = ZRHT1D(II)
+ ZCCT(I1(II),I2(II),I3(II)) = ZCCT1D(II)
+ ZCRT(I1(II),I2(II),I3(II)) = ZCRT1D(II)
+ ZCIT(I1(II),I2(II),I3(II)) = ZCIT1D(II)
+ ZIFNNT(I1(II),I2(II),I3(II),:) = ZIFNN1D(II,:)
+ PEVAP3D(I1(II),I2(II),I3(II)) = ZEVAP1D(II)
+ ZTIME(I1(II),I2(II),I3(II)) = ZTIME1D(II)
+ LLCOMPUTE(I1(II),I2(II),I3(II)) = LLCOMPUTE1D(II)
+ IITER(I1(II),I2(II),I3(II)) = IITER1D(II)
+ END DO
+ !
+ CALL LIMA_DROPS_TO_DROPLETS_CONV(PRHODREF, ZRCT, ZRRT, ZCCT, ZCRT, &
+ Z_RR_CVRC, Z_CR_CVRC )
+ ZRCT(:,:,:) = ZRCT(:,:,:) - Z_RR_CVRC(:,:,:)
+ ZRRT(:,:,:) = ZRRT(:,:,:) + Z_RR_CVRC(:,:,:)
+ ZCCT(:,:,:) = ZCCT(:,:,:) - Z_CR_CVRC(:,:,:)
+ ZCRT(:,:,:) = ZCRT(:,:,:) + Z_CR_CVRC(:,:,:)
+ !
+ !*** 4.4 Unpacking for budgets
+ !
+ IF(LBU_ENABLE) THEN
+ ZTOT_RR_CVRC(:,:,:) = ZTOT_RR_CVRC(:,:,:) + Z_RR_CVRC(:,:,:)
+ ZTOT_CR_CVRC(:,:,:) = ZTOT_CR_CVRC(:,:,:) + Z_CR_CVRC(:,:,:)
+
+ DO II=1,IPACK
+ ! Instantaneous processes
+ ZTOT_CR_BRKU(I1(II),I2(II),I3(II)) = ZTOT_CR_BRKU(I1(II),I2(II),I3(II)) + Z_CR_BRKU(II)
+ ZTOT_TH_HONR(I1(II),I2(II),I3(II)) = ZTOT_TH_HONR(I1(II),I2(II),I3(II)) + Z_TH_HONR(II)
+ ZTOT_RR_HONR(I1(II),I2(II),I3(II)) = ZTOT_RR_HONR(I1(II),I2(II),I3(II)) + Z_RR_HONR(II)
+ ZTOT_CR_HONR(I1(II),I2(II),I3(II)) = ZTOT_CR_HONR(I1(II),I2(II),I3(II)) + Z_CR_HONR(II)
+ ZTOT_TH_IMLT(I1(II),I2(II),I3(II)) = ZTOT_TH_IMLT(I1(II),I2(II),I3(II)) + Z_TH_IMLT(II)
+ ZTOT_RC_IMLT(I1(II),I2(II),I3(II)) = ZTOT_RC_IMLT(I1(II),I2(II),I3(II)) + Z_RC_IMLT(II)
+ ZTOT_CC_IMLT(I1(II),I2(II),I3(II)) = ZTOT_CC_IMLT(I1(II),I2(II),I3(II)) + Z_CC_IMLT(II)
+ DO JI = 1, NMOD_IFN
+ ZTOT_IFNN_IMLT(I1(II),I2(II),I3(II),JI) = ZTOT_IFNN_IMLT(I1(II),I2(II),I3(II),JI) + ZB_IFNN(II,JI)
+ END DO
+
+ ! Tendencies
+ ZTOT_TH_HONC(I1(II),I2(II),I3(II)) = ZTOT_TH_HONC(I1(II),I2(II),I3(II)) + Z_TH_HONC(II) * ZMAXTIME(II)
+ ZTOT_RC_HONC(I1(II),I2(II),I3(II)) = ZTOT_RC_HONC(I1(II),I2(II),I3(II)) + Z_RC_HONC(II) * ZMAXTIME(II)
+ ZTOT_CC_HONC(I1(II),I2(II),I3(II)) = ZTOT_CC_HONC(I1(II),I2(II),I3(II)) + Z_CC_HONC(II) * ZMAXTIME(II)
+ ZTOT_CC_SELF(I1(II),I2(II),I3(II)) = ZTOT_CC_SELF(I1(II),I2(II),I3(II)) + Z_CC_SELF(II) * ZMAXTIME(II)
+ ZTOT_RC_AUTO(I1(II),I2(II),I3(II)) = ZTOT_RC_AUTO(I1(II),I2(II),I3(II)) + Z_RC_AUTO(II) * ZMAXTIME(II)
+ ZTOT_CC_AUTO(I1(II),I2(II),I3(II)) = ZTOT_CC_AUTO(I1(II),I2(II),I3(II)) + Z_CC_AUTO(II) * ZMAXTIME(II)
+ ZTOT_CR_AUTO(I1(II),I2(II),I3(II)) = ZTOT_CR_AUTO(I1(II),I2(II),I3(II)) + Z_CR_AUTO(II) * ZMAXTIME(II)
+ ZTOT_RC_ACCR(I1(II),I2(II),I3(II)) = ZTOT_RC_ACCR(I1(II),I2(II),I3(II)) + Z_RC_ACCR(II) * ZMAXTIME(II)
+ ZTOT_CC_ACCR(I1(II),I2(II),I3(II)) = ZTOT_CC_ACCR(I1(II),I2(II),I3(II)) + Z_CC_ACCR(II) * ZMAXTIME(II)
+ ZTOT_CR_SCBU(I1(II),I2(II),I3(II)) = ZTOT_CR_SCBU(I1(II),I2(II),I3(II)) + Z_CR_SCBU(II) * ZMAXTIME(II)
+ ZTOT_TH_EVAP(I1(II),I2(II),I3(II)) = ZTOT_TH_EVAP(I1(II),I2(II),I3(II)) + Z_TH_EVAP(II) * ZMAXTIME(II)
+!!$ ZTOT_RC_EVAP(I1(II),I2(II),I3(II)) = ZTOT_RC_EVAP(I1(II),I2(II),I3(II)) + Z_RC_EVAP(II) * ZMAXTIME(II)
+!!$ ZTOT_CC_EVAP(I1(II),I2(II),I3(II)) = ZTOT_CC_EVAP(I1(II),I2(II),I3(II)) + Z_CC_EVAP(II) * ZMAXTIME(II)
+ ZTOT_RR_EVAP(I1(II),I2(II),I3(II)) = ZTOT_RR_EVAP(I1(II),I2(II),I3(II)) + Z_RR_EVAP(II) * ZMAXTIME(II)
+!!$ ZTOT_CR_EVAP(I1(II),I2(II),I3(II)) = ZTOT_CR_EVAP(I1(II),I2(II),I3(II)) + Z_CR_EVAP(II) * ZMAXTIME(II)
+ ZTOT_RI_CNVI(I1(II),I2(II),I3(II)) = ZTOT_RI_CNVI(I1(II),I2(II),I3(II)) + Z_RI_CNVI(II) * ZMAXTIME(II)
+ ZTOT_CI_CNVI(I1(II),I2(II),I3(II)) = ZTOT_CI_CNVI(I1(II),I2(II),I3(II)) + Z_CI_CNVI(II) * ZMAXTIME(II)
+ ZTOT_TH_DEPS(I1(II),I2(II),I3(II)) = ZTOT_TH_DEPS(I1(II),I2(II),I3(II)) + Z_TH_DEPS(II) * ZMAXTIME(II)
+ ZTOT_RS_DEPS(I1(II),I2(II),I3(II)) = ZTOT_RS_DEPS(I1(II),I2(II),I3(II)) + Z_RS_DEPS(II) * ZMAXTIME(II)
+ ZTOT_TH_DEPI(I1(II),I2(II),I3(II)) = ZTOT_TH_DEPI(I1(II),I2(II),I3(II)) + Z_TH_DEPI(II) * ZMAXTIME(II)
+ ZTOT_RI_DEPI(I1(II),I2(II),I3(II)) = ZTOT_RI_DEPI(I1(II),I2(II),I3(II)) + Z_RI_DEPI(II) * ZMAXTIME(II)
+ ZTOT_RI_CNVS(I1(II),I2(II),I3(II)) = ZTOT_RI_CNVS(I1(II),I2(II),I3(II)) + Z_RI_CNVS(II) * ZMAXTIME(II)
+ ZTOT_CI_CNVS(I1(II),I2(II),I3(II)) = ZTOT_CI_CNVS(I1(II),I2(II),I3(II)) + Z_CI_CNVS(II) * ZMAXTIME(II)
+ ZTOT_RI_AGGS(I1(II),I2(II),I3(II)) = ZTOT_RI_AGGS(I1(II),I2(II),I3(II)) + Z_RI_AGGS(II) * ZMAXTIME(II)
+ ZTOT_CI_AGGS(I1(II),I2(II),I3(II)) = ZTOT_CI_AGGS(I1(II),I2(II),I3(II)) + Z_CI_AGGS(II) * ZMAXTIME(II)
+ ZTOT_TH_DEPG(I1(II),I2(II),I3(II)) = ZTOT_TH_DEPG(I1(II),I2(II),I3(II)) + Z_TH_DEPG(II) * ZMAXTIME(II)
+ ZTOT_RG_DEPG(I1(II),I2(II),I3(II)) = ZTOT_RG_DEPG(I1(II),I2(II),I3(II)) + Z_RG_DEPG(II) * ZMAXTIME(II)
+ ZTOT_TH_BERFI(I1(II),I2(II),I3(II))= ZTOT_TH_BERFI(I1(II),I2(II),I3(II)) + Z_TH_BERFI(II) * ZMAXTIME(II)
+ ZTOT_RC_BERFI(I1(II),I2(II),I3(II))= ZTOT_RC_BERFI(I1(II),I2(II),I3(II)) + Z_RC_BERFI(II) * ZMAXTIME(II)
+ ZTOT_TH_RIM(I1(II),I2(II),I3(II)) = ZTOT_TH_RIM(I1(II),I2(II),I3(II)) + Z_TH_RIM(II) * ZMAXTIME(II)
+ ZTOT_RC_RIM(I1(II),I2(II),I3(II)) = ZTOT_RC_RIM(I1(II),I2(II),I3(II)) + Z_RC_RIM(II) * ZMAXTIME(II)
+ ZTOT_CC_RIM(I1(II),I2(II),I3(II)) = ZTOT_CC_RIM(I1(II),I2(II),I3(II)) + Z_CC_RIM(II) * ZMAXTIME(II)
+ ZTOT_RS_RIM(I1(II),I2(II),I3(II)) = ZTOT_RS_RIM(I1(II),I2(II),I3(II)) + Z_RS_RIM(II) * ZMAXTIME(II)
+ ZTOT_RG_RIM(I1(II),I2(II),I3(II)) = ZTOT_RG_RIM(I1(II),I2(II),I3(II)) + Z_RG_RIM(II) * ZMAXTIME(II)
+ ZTOT_RI_HMS(I1(II),I2(II),I3(II)) = ZTOT_RI_HMS(I1(II),I2(II),I3(II)) + Z_RI_HMS(II) * ZMAXTIME(II)
+ ZTOT_CI_HMS(I1(II),I2(II),I3(II)) = ZTOT_CI_HMS(I1(II),I2(II),I3(II)) + Z_CI_HMS(II) * ZMAXTIME(II)
+ ZTOT_RS_HMS(I1(II),I2(II),I3(II)) = ZTOT_RS_HMS(I1(II),I2(II),I3(II)) + Z_RS_HMS(II) * ZMAXTIME(II)
+ ZTOT_TH_ACC(I1(II),I2(II),I3(II)) = ZTOT_TH_ACC(I1(II),I2(II),I3(II)) + Z_TH_ACC(II) * ZMAXTIME(II)
+ ZTOT_RR_ACC(I1(II),I2(II),I3(II)) = ZTOT_RR_ACC(I1(II),I2(II),I3(II)) + Z_RR_ACC(II) * ZMAXTIME(II)
+ ZTOT_CR_ACC(I1(II),I2(II),I3(II)) = ZTOT_CR_ACC(I1(II),I2(II),I3(II)) + Z_CR_ACC(II) * ZMAXTIME(II)
+ ZTOT_RS_ACC(I1(II),I2(II),I3(II)) = ZTOT_RS_ACC(I1(II),I2(II),I3(II)) + Z_RS_ACC(II) * ZMAXTIME(II)
+ ZTOT_RG_ACC(I1(II),I2(II),I3(II)) = ZTOT_RG_ACC(I1(II),I2(II),I3(II)) + Z_RG_ACC(II) * ZMAXTIME(II)
+ ZTOT_RS_CMEL(I1(II),I2(II),I3(II)) = ZTOT_RS_CMEL(I1(II),I2(II),I3(II)) + Z_RS_CMEL(II) * ZMAXTIME(II)
+ ZTOT_TH_CFRZ(I1(II),I2(II),I3(II)) = ZTOT_TH_CFRZ(I1(II),I2(II),I3(II)) + Z_TH_CFRZ(II) * ZMAXTIME(II)
+ ZTOT_RR_CFRZ(I1(II),I2(II),I3(II)) = ZTOT_RR_CFRZ(I1(II),I2(II),I3(II)) + Z_RR_CFRZ(II) * ZMAXTIME(II)
+ ZTOT_CR_CFRZ(I1(II),I2(II),I3(II)) = ZTOT_CR_CFRZ(I1(II),I2(II),I3(II)) + Z_CR_CFRZ(II) * ZMAXTIME(II)
+ ZTOT_RI_CFRZ(I1(II),I2(II),I3(II)) = ZTOT_RI_CFRZ(I1(II),I2(II),I3(II)) + Z_RI_CFRZ(II) * ZMAXTIME(II)
+ ZTOT_CI_CFRZ(I1(II),I2(II),I3(II)) = ZTOT_CI_CFRZ(I1(II),I2(II),I3(II)) + Z_CI_CFRZ(II) * ZMAXTIME(II)
+ ZTOT_TH_WETG(I1(II),I2(II),I3(II)) = ZTOT_TH_WETG(I1(II),I2(II),I3(II)) + Z_TH_WETG(II) * ZMAXTIME(II)
+ ZTOT_RC_WETG(I1(II),I2(II),I3(II)) = ZTOT_RC_WETG(I1(II),I2(II),I3(II)) + Z_RC_WETG(II) * ZMAXTIME(II)
+ ZTOT_CC_WETG(I1(II),I2(II),I3(II)) = ZTOT_CC_WETG(I1(II),I2(II),I3(II)) + Z_CC_WETG(II) * ZMAXTIME(II)
+ ZTOT_RR_WETG(I1(II),I2(II),I3(II)) = ZTOT_RR_WETG(I1(II),I2(II),I3(II)) + Z_RR_WETG(II) * ZMAXTIME(II)
+ ZTOT_CR_WETG(I1(II),I2(II),I3(II)) = ZTOT_CR_WETG(I1(II),I2(II),I3(II)) + Z_CR_WETG(II) * ZMAXTIME(II)
+ ZTOT_RI_WETG(I1(II),I2(II),I3(II)) = ZTOT_RI_WETG(I1(II),I2(II),I3(II)) + Z_RI_WETG(II) * ZMAXTIME(II)
+ ZTOT_CI_WETG(I1(II),I2(II),I3(II)) = ZTOT_CI_WETG(I1(II),I2(II),I3(II)) + Z_CI_WETG(II) * ZMAXTIME(II)
+ ZTOT_RS_WETG(I1(II),I2(II),I3(II)) = ZTOT_RS_WETG(I1(II),I2(II),I3(II)) + Z_RS_WETG(II) * ZMAXTIME(II)
+ ZTOT_RG_WETG(I1(II),I2(II),I3(II)) = ZTOT_RG_WETG(I1(II),I2(II),I3(II)) + Z_RG_WETG(II) * ZMAXTIME(II)
+ ZTOT_RH_WETG(I1(II),I2(II),I3(II)) = ZTOT_RH_WETG(I1(II),I2(II),I3(II)) + Z_RH_WETG(II) * ZMAXTIME(II)
+ ZTOT_TH_DRYG(I1(II),I2(II),I3(II)) = ZTOT_TH_DRYG(I1(II),I2(II),I3(II)) + Z_TH_DRYG(II) * ZMAXTIME(II)
+ ZTOT_RC_DRYG(I1(II),I2(II),I3(II)) = ZTOT_RC_DRYG(I1(II),I2(II),I3(II)) + Z_RC_DRYG(II) * ZMAXTIME(II)
+ ZTOT_CC_DRYG(I1(II),I2(II),I3(II)) = ZTOT_CC_DRYG(I1(II),I2(II),I3(II)) + Z_CC_DRYG(II) * ZMAXTIME(II)
+ ZTOT_RR_DRYG(I1(II),I2(II),I3(II)) = ZTOT_RR_DRYG(I1(II),I2(II),I3(II)) + Z_RR_DRYG(II) * ZMAXTIME(II)
+ ZTOT_CR_DRYG(I1(II),I2(II),I3(II)) = ZTOT_CR_DRYG(I1(II),I2(II),I3(II)) + Z_CR_DRYG(II) * ZMAXTIME(II)
+ ZTOT_RI_DRYG(I1(II),I2(II),I3(II)) = ZTOT_RI_DRYG(I1(II),I2(II),I3(II)) + Z_RI_DRYG(II) * ZMAXTIME(II)
+ ZTOT_CI_DRYG(I1(II),I2(II),I3(II)) = ZTOT_CI_DRYG(I1(II),I2(II),I3(II)) + Z_CI_DRYG(II) * ZMAXTIME(II)
+ ZTOT_RS_DRYG(I1(II),I2(II),I3(II)) = ZTOT_RS_DRYG(I1(II),I2(II),I3(II)) + Z_RS_DRYG(II) * ZMAXTIME(II)
+ ZTOT_RG_DRYG(I1(II),I2(II),I3(II)) = ZTOT_RG_DRYG(I1(II),I2(II),I3(II)) + Z_RG_DRYG(II) * ZMAXTIME(II)
+ ZTOT_RI_HMG(I1(II),I2(II),I3(II)) = ZTOT_RI_HMG(I1(II),I2(II),I3(II)) + Z_RI_HMG(II) * ZMAXTIME(II)
+ ZTOT_CI_HMG(I1(II),I2(II),I3(II)) = ZTOT_CI_HMG(I1(II),I2(II),I3(II)) + Z_CI_HMG(II) * ZMAXTIME(II)
+ ZTOT_RG_HMG(I1(II),I2(II),I3(II)) = ZTOT_RG_HMG(I1(II),I2(II),I3(II)) + Z_RG_HMG(II) * ZMAXTIME(II)
+ ZTOT_TH_GMLT(I1(II),I2(II),I3(II)) = ZTOT_TH_GMLT(I1(II),I2(II),I3(II)) + Z_TH_GMLT(II) * ZMAXTIME(II)
+ ZTOT_RR_GMLT(I1(II),I2(II),I3(II)) = ZTOT_RR_GMLT(I1(II),I2(II),I3(II)) + Z_RR_GMLT(II) * ZMAXTIME(II)
+ ZTOT_CR_GMLT(I1(II),I2(II),I3(II)) = ZTOT_CR_GMLT(I1(II),I2(II),I3(II)) + Z_CR_GMLT(II) * ZMAXTIME(II)
+!!$ ZTOT_RC_WETH(I1(II),I2(II),I3(II)) = ZTOT_RC_WETH(I1(II),I2(II),I3(II)) + Z_RC_WETH(II) * ZMAXTIME(II)
+!!$ ZTOT_CC_WETH(I1(II),I2(II),I3(II)) = ZTOT_CC_WETH(I1(II),I2(II),I3(II)) + Z_CC_WETH(II) * ZMAXTIME(II)
+!!$ ZTOT_RR_WETH(I1(II),I2(II),I3(II)) = ZTOT_RR_WETH(I1(II),I2(II),I3(II)) + Z_RR_WETH(II) * ZMAXTIME(II)
+!!$ ZTOT_CR_WETH(I1(II),I2(II),I3(II)) = ZTOT_CR_WETH(I1(II),I2(II),I3(II)) + Z_CR_WETH(II) * ZMAXTIME(II)
+!!$ ZTOT_RI_WETH(I1(II),I2(II),I3(II)) = ZTOT_RI_WETH(I1(II),I2(II),I3(II)) + Z_RI_WETH(II) * ZMAXTIME(II)
+!!$ ZTOT_CI_WETH(I1(II),I2(II),I3(II)) = ZTOT_CI_WETH(I1(II),I2(II),I3(II)) + Z_CI_WETH(II) * ZMAXTIME(II)
+!!$ ZTOT_RS_WETH(I1(II),I2(II),I3(II)) = ZTOT_RS_WETH(I1(II),I2(II),I3(II)) + Z_RS_WETH(II) * ZMAXTIME(II)
+!!$ ZTOT_RG_WETH(I1(II),I2(II),I3(II)) = ZTOT_RG_WETH(I1(II),I2(II),I3(II)) + Z_RG_WETH(II) * ZMAXTIME(II)
+!!$ ZTOT_RH_WETH(I1(II),I2(II),I3(II)) = ZTOT_RH_WETH(I1(II),I2(II),I3(II)) + Z_RH_WETH(II) * ZMAXTIME(II)
+!!$ ZTOT_RG_COHG(I1(II),I2(II),I3(II)) = ZTOT_RG_COHG(I1(II),I2(II),I3(II)) + Z_RG_COHG(II) * ZMAXTIME(II)
+!!$ ZTOT_RR_HMLT(I1(II),I2(II),I3(II)) = ZTOT_RR_HMLT(I1(II),I2(II),I3(II)) + Z_RR_HMLT(II) * ZMAXTIME(II)
+!!$ ZTOT_CR_HMLT(I1(II),I2(II),I3(II)) = ZTOT_CR_HMLT(I1(II),I2(II),I3(II)) + Z_CR_HMLT(II) * ZMAXTIME(II)
+
+ !Correction term
+ ZTOT_RV_CORR2(I1(II),I2(II),I3(II)) = ZTOT_RV_CORR2(I1(II),I2(II),I3(II)) + Z_RV_CORR2(II)
+ ZTOT_RC_CORR2(I1(II),I2(II),I3(II)) = ZTOT_RC_CORR2(I1(II),I2(II),I3(II)) + Z_RC_CORR2(II)
+ ZTOT_RR_CORR2(I1(II),I2(II),I3(II)) = ZTOT_RR_CORR2(I1(II),I2(II),I3(II)) + Z_RR_CORR2(II)
+ ZTOT_RI_CORR2(I1(II),I2(II),I3(II)) = ZTOT_RI_CORR2(I1(II),I2(II),I3(II)) + Z_RI_CORR2(II)
+ ZTOT_CC_CORR2(I1(II),I2(II),I3(II)) = ZTOT_CC_CORR2(I1(II),I2(II),I3(II)) + Z_CC_CORR2(II)
+ ZTOT_CR_CORR2(I1(II),I2(II),I3(II)) = ZTOT_CR_CORR2(I1(II),I2(II),I3(II)) + Z_CR_CORR2(II)
+ ZTOT_CI_CORR2(I1(II),I2(II),I3(II)) = ZTOT_CI_CORR2(I1(II),I2(II),I3(II)) + Z_CI_CORR2(II)
+ END DO
+ ENDIF
+ !
+ ! Deallocating variables
+ !
+ DEALLOCATE(I1)
+ DEALLOCATE(I2)
+ DEALLOCATE(I3)
+ DEALLOCATE(ZRHODREF1D)
+ DEALLOCATE(ZEXNREF1D)
+ DEALLOCATE(ZEXN1D)
+ DEALLOCATE(ZP1D)
+ DEALLOCATE(ZTHT1D)
+ DEALLOCATE(ZRVT1D)
+ DEALLOCATE(ZRCT1D)
+ DEALLOCATE(ZRRT1D)
+ DEALLOCATE(ZRIT1D)
+ DEALLOCATE(ZRST1D)
+ DEALLOCATE(ZRGT1D)
+ DEALLOCATE(ZRHT1D)
+ DEALLOCATE(ZCCT1D)
+ DEALLOCATE(ZCRT1D)
+ DEALLOCATE(ZCIT1D)
+ DEALLOCATE(ZIFNN1D)
+ DEALLOCATE(ZEVAP1D)
+ DEALLOCATE(ZTIME1D)
+ DEALLOCATE(LLCOMPUTE1D)
+ DEALLOCATE(IITER1D)
+ DEALLOCATE(ZTIME_LASTCALL1D)
+ DEALLOCATE(Z0RVT1D)
+ DEALLOCATE(Z0RCT1D)
+ DEALLOCATE(Z0RRT1D)
+ DEALLOCATE(Z0RIT1D)
+ DEALLOCATE(Z0RST1D)
+ DEALLOCATE(Z0RGT1D)
+ DEALLOCATE(Z0RHT1D)
+ DEALLOCATE(ZCF1D)
+ DEALLOCATE(ZIF1D)
+ DEALLOCATE(ZPF1D)
+ !
+ DEALLOCATE(ZMAXTIME)
+ DEALLOCATE(ZTIME_THRESHOLD)
+ !
+ DEALLOCATE(ZA_TH)
+ DEALLOCATE(ZA_RV)
+ DEALLOCATE(ZA_RC)
+ DEALLOCATE(ZA_RR)
+ DEALLOCATE(ZA_RI)
+ DEALLOCATE(ZA_RS)
+ DEALLOCATE(ZA_RG)
+ DEALLOCATE(ZA_RH)
+ DEALLOCATE(ZA_CC)
+ DEALLOCATE(ZA_CR)
+ DEALLOCATE(ZA_CI)
+ !
+ DEALLOCATE(ZB_TH)
+ DEALLOCATE(ZB_RV)
+ DEALLOCATE(ZB_RC)
+ DEALLOCATE(ZB_RR)
+ DEALLOCATE(ZB_RI)
+ DEALLOCATE(ZB_RS)
+ DEALLOCATE(ZB_RG)
+ DEALLOCATE(ZB_RH)
+ DEALLOCATE(ZB_CC)
+ DEALLOCATE(ZB_CR)
+ DEALLOCATE(ZB_CI)
+ DEALLOCATE(ZB_IFNN)
+ !
+ DEALLOCATE(Z_CR_BRKU)
+ DEALLOCATE(Z_TH_HONR)
+ DEALLOCATE(Z_RR_HONR)
+ DEALLOCATE(Z_CR_HONR)
+ DEALLOCATE(Z_TH_IMLT)
+ DEALLOCATE(Z_RC_IMLT)
+ DEALLOCATE(Z_CC_IMLT)
+ DEALLOCATE(Z_TH_HONC)
+ DEALLOCATE(Z_RC_HONC)
+ DEALLOCATE(Z_CC_HONC)
+ DEALLOCATE(Z_CC_SELF)
+ DEALLOCATE(Z_RC_AUTO)
+ DEALLOCATE(Z_CC_AUTO)
+ DEALLOCATE(Z_CR_AUTO)
+ DEALLOCATE(Z_RC_ACCR)
+ DEALLOCATE(Z_CC_ACCR)
+ DEALLOCATE(Z_CR_SCBU)
+ DEALLOCATE(Z_TH_EVAP)
+ DEALLOCATE(Z_RR_EVAP)
+ DEALLOCATE(Z_RI_CNVI)
+ DEALLOCATE(Z_CI_CNVI)
+ DEALLOCATE(Z_TH_DEPS)
+ DEALLOCATE(Z_RS_DEPS)
+ DEALLOCATE(Z_TH_DEPI)
+ DEALLOCATE(Z_RI_DEPI)
+ DEALLOCATE(Z_RI_CNVS)
+ DEALLOCATE(Z_CI_CNVS)
+ DEALLOCATE(Z_RI_AGGS)
+ DEALLOCATE(Z_CI_AGGS)
+ DEALLOCATE(Z_TH_DEPG)
+ DEALLOCATE(Z_RG_DEPG)
+ DEALLOCATE(Z_TH_BERFI)
+ DEALLOCATE(Z_RC_BERFI)
+ DEALLOCATE(Z_TH_RIM)
+ DEALLOCATE(Z_RC_RIM)
+ DEALLOCATE(Z_CC_RIM)
+ DEALLOCATE(Z_RS_RIM)
+ DEALLOCATE(Z_RG_RIM)
+ DEALLOCATE(Z_RI_HMS)
+ DEALLOCATE(Z_CI_HMS)
+ DEALLOCATE(Z_RS_HMS)
+ DEALLOCATE(Z_TH_ACC)
+ DEALLOCATE(Z_RR_ACC)
+ DEALLOCATE(Z_CR_ACC)
+ DEALLOCATE(Z_RS_ACC)
+ DEALLOCATE(Z_RG_ACC)
+ DEALLOCATE(Z_RS_CMEL)
+ DEALLOCATE(Z_TH_CFRZ)
+ DEALLOCATE(Z_RR_CFRZ)
+ DEALLOCATE(Z_CR_CFRZ)
+ DEALLOCATE(Z_RI_CFRZ)
+ DEALLOCATE(Z_CI_CFRZ)
+ DEALLOCATE(Z_TH_WETG)
+ DEALLOCATE(Z_RC_WETG)
+ DEALLOCATE(Z_CC_WETG)
+ DEALLOCATE(Z_RR_WETG)
+ DEALLOCATE(Z_CR_WETG)
+ DEALLOCATE(Z_RI_WETG)
+ DEALLOCATE(Z_CI_WETG)
+ DEALLOCATE(Z_RS_WETG)
+ DEALLOCATE(Z_RG_WETG)
+ DEALLOCATE(Z_RH_WETG)
+ DEALLOCATE(Z_TH_DRYG)
+ DEALLOCATE(Z_RC_DRYG)
+ DEALLOCATE(Z_CC_DRYG)
+ DEALLOCATE(Z_RR_DRYG)
+ DEALLOCATE(Z_CR_DRYG)
+ DEALLOCATE(Z_RI_DRYG)
+ DEALLOCATE(Z_CI_DRYG)
+ DEALLOCATE(Z_RS_DRYG)
+ DEALLOCATE(Z_RG_DRYG)
+ DEALLOCATE(Z_RI_HMG)
+ DEALLOCATE(Z_CI_HMG)
+ DEALLOCATE(Z_RG_HMG)
+ DEALLOCATE(Z_TH_GMLT)
+ DEALLOCATE(Z_RR_GMLT)
+ DEALLOCATE(Z_CR_GMLT)
+
+ DEALLOCATE(Z_RV_CORR2)
+ DEALLOCATE(Z_RC_CORR2)
+ DEALLOCATE(Z_RR_CORR2)
+ DEALLOCATE(Z_RI_CORR2)
+ DEALLOCATE(Z_CC_CORR2)
+ DEALLOCATE(Z_CR_CORR2)
+ DEALLOCATE(Z_CI_CORR2)
+ !
+ ENDDO
+ENDDO
+!
+!-------------------------------------------------------------------------------
+!
+!* 7. TOTAL TENDENCIES
+! ----------------
+!
+! Source at the end of microphysics = new state / PTSTEP
+!
+PTHS(:,:,:) = ZTHT(:,:,:) * ZINV_TSTEP
+!
+PRS(:,:,:,1) = ZRVT(:,:,:) *ZINV_TSTEP
+IF ( KRR .GE. 2 ) PRS(:,:,:,2) = ZRCT(:,:,:) *ZINV_TSTEP
+IF ( KRR .GE. 3 ) PRS(:,:,:,3) = ZRRT(:,:,:) *ZINV_TSTEP
+IF ( KRR .GE. 4 ) PRS(:,:,:,4) = ZRIT(:,:,:) *ZINV_TSTEP
+IF ( KRR .GE. 5 ) PRS(:,:,:,5) = ZRST(:,:,:) *ZINV_TSTEP
+IF ( KRR .GE. 6 ) PRS(:,:,:,6) = ZRGT(:,:,:) *ZINV_TSTEP
+IF ( KRR .GE. 7 ) PRS(:,:,:,7) = ZRHT(:,:,:) *ZINV_TSTEP
+!
+IF ( LWARM ) PSVS(:,:,:,NSV_LIMA_NC) = ZCCT(:,:,:) *ZINV_TSTEP
+IF ( LWARM .AND. LRAIN ) PSVS(:,:,:,NSV_LIMA_NR) = ZCRT(:,:,:) *ZINV_TSTEP
+IF ( LCOLD ) PSVS(:,:,:,NSV_LIMA_NI) = ZCIT(:,:,:) *ZINV_TSTEP
+!
+IF ( NMOD_CCN .GE. 1 ) PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1) = ZCCNFT(:,:,:,:) *ZINV_TSTEP
+IF ( NMOD_CCN .GE. 1 ) PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1) = ZCCNAT(:,:,:,:) *ZINV_TSTEP
+IF ( NMOD_IFN .GE. 1 ) PSVS(:,:,:,NSV_LIMA_IFN_FREE:NSV_LIMA_IFN_FREE+NMOD_IFN-1) = ZIFNFT(:,:,:,:) *ZINV_TSTEP
+IF ( NMOD_IFN .GE. 1 ) PSVS(:,:,:,NSV_LIMA_IFN_NUCL:NSV_LIMA_IFN_NUCL+NMOD_IFN-1) = ZIFNNT(:,:,:,:) *ZINV_TSTEP
+IF ( NMOD_IMM .GE. 1 ) PSVS(:,:,:,NSV_LIMA_IMM_NUCL:NSV_LIMA_IMM_NUCL+NMOD_IMM-1) = ZIMMNT(:,:,:,:) *ZINV_TSTEP
+IF ( LCOLD .AND. LHHONI) PSVS(:,:,:,NSV_LIMA_HOM_HAZE) = ZHOMFT(:,:,:) *ZINV_TSTEP
+!
+!
+!
+! Call budgets
+!
+if ( lbu_enable ) then
+ allocate( zrhodjontstep(size( prhodj, 1), size( prhodj, 2), size( prhodj, 3) ) )
+ zrhodjontstep(:, :, :) = zinv_tstep * prhodj(:, :, :)
+
+ if ( lbudget_th ) then
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'REVA', ztot_th_evap (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'HONC', ztot_th_honc (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'HONR', ztot_th_honr (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'DEPS', ztot_th_deps (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'DEPI', ztot_th_depi (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'DEPG', ztot_th_depg (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'IMLT', ztot_th_imlt (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'BERFI', ztot_th_berfi(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'RIM', ztot_th_rim (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'ACC', ztot_th_acc (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'CFRZ', ztot_th_cfrz (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'WETG', ztot_th_wetg (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'DRYG', ztot_th_dryg (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'GMLT', ztot_th_gmlt (:, :, :) * zrhodjontstep(:, :, :) )
+ end if
+
+ if ( lbudget_rv ) then
+ call Budget_store_add( tbudgets(NBUDGET_RV), 'REVA', -ztot_rr_evap (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RV), 'DEPS', -ztot_rs_deps (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RV), 'DEPI', -ztot_ri_depi (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RV), 'DEPG', -ztot_rg_depg (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RV), 'CORR2', ztot_rv_corr2(:, :, :) * zrhodjontstep(:, :, :) )
+ end if
+
+ if ( lbudget_rc ) then
+ call Budget_store_add( tbudgets(NBUDGET_RC), 'AUTO', ztot_rc_auto (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RC), 'ACCR', ztot_rc_accr (:, :, :) * zrhodjontstep(:, :, :) )
+ !call Budget_store_add( tbudgets(NBUDGET_RC), 'REVA', 0. )
+ call Budget_store_add( tbudgets(NBUDGET_RC), 'HONC', ztot_rc_honc (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RC), 'IMLT', ztot_rc_imlt (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RC), 'BERFI', ztot_rc_berfi(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RC), 'RIM', ztot_rc_rim (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RC), 'WETG', ztot_rc_wetg (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RC), 'DRYG', ztot_rc_dryg (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RC), 'CVRC', -ztot_rr_cvrc (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RC), 'CORR2', ztot_rc_corr2(:, :, :) * zrhodjontstep(:, :, :) )
+ end if
+
+ if ( lbudget_rr ) then
+ call Budget_store_add( tbudgets(NBUDGET_RR), 'AUTO', -ztot_rc_auto(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RR), 'ACCR', -ztot_rc_accr(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RR), 'REVA', ztot_rr_evap(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RR), 'HONR', ztot_rr_honr(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RR), 'ACC', ztot_rr_acc (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RR), 'CFRZ', ztot_rr_cfrz(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RR), 'WETG', ztot_rr_wetg(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RR), 'DRYG', ztot_rr_dryg(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RR), 'GMLT', ztot_rr_gmlt(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RR), 'CVRC', ztot_rr_cvrc(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RR), 'CORR2', ztot_rr_corr2(:, :, :) * zrhodjontstep(:, :, :) )
+ end if
+
+ if ( lbudget_ri ) then
+ call Budget_store_add( tbudgets(NBUDGET_RI), 'HONC', -ztot_rc_honc (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RI), 'CNVI', ztot_ri_cnvi (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RI), 'CNVS', ztot_ri_cnvs (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RI), 'AGGS', ztot_ri_aggs (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RI), 'IMLT', -ztot_rc_imlt (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RI), 'BERFI', -ztot_rc_berfi(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RI), 'HMS', ztot_ri_hms (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RI), 'CFRZ', ztot_ri_cfrz (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RI), 'DEPI', ztot_ri_depi (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RI), 'WETG', ztot_ri_wetg (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RI), 'DRYG', ztot_ri_dryg (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RI), 'HMG', ztot_ri_hmg (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RI), 'CORR2', ztot_ri_corr2(:, :, :) * zrhodjontstep(:, :, :) )
+ end if
+
+ if ( lbudget_rs ) then
+ call Budget_store_add( tbudgets(NBUDGET_RS), 'CNVI', -ztot_ri_cnvi(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RS), 'DEPS', ztot_rs_deps(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RS), 'CNVS', -ztot_ri_cnvs(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RS), 'AGGS', -ztot_ri_aggs(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RS), 'RIM', ztot_rs_rim (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RS), 'HMS', ztot_rs_hms (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RS), 'ACC', ztot_rs_acc (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RS), 'CMEL', ztot_rs_cmel(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RS), 'WETG', ztot_rs_wetg(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RS), 'DRYG', ztot_rs_dryg(:, :, :) * zrhodjontstep(:, :, :) )
+ end if
+
+ if ( lbudget_rg ) then
+ call Budget_store_add( tbudgets(NBUDGET_RG), 'HONR', -ztot_rr_honr(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RG), 'DEPG', ztot_rg_depg(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RG), 'RIM', ztot_rg_rim (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RG), 'ACC', ztot_rg_acc (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RG), 'CMEL', -ztot_rs_cmel(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RG), 'CFRZ', ( -ztot_rr_cfrz(:, :, :) - ztot_ri_cfrz(:, :, :) ) &
+ * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RG), 'WETG', ztot_rg_wetg(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RG), 'DRYG', ztot_rg_dryg(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RG), 'HMG', ztot_rg_hmg (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RG), 'GMLT', -ztot_rr_gmlt(:, :, :) * zrhodjontstep(:, :, :) )
+ end if
+
+ if ( lbudget_rh ) then
+ call Budget_store_add( tbudgets(NBUDGET_RH), 'WETG', ztot_rh_wetg(:, :, :) * zrhodjontstep(:, :, :) )
+ end if
+
+ if ( lbudget_sv ) then
+ !
+ ! Cloud droplets
+ !
+ idx = NBUDGET_SV1 - 1 + nsv_lima_nc
+ call Budget_store_add( tbudgets(idx), 'SELF', ztot_cc_self (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'AUTO', ztot_cc_auto (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'ACCR', ztot_cc_accr (:, :, :) * zrhodjontstep(:, :, :) )
+ !call Budget_store_add( tbudgets(idx), 'REVA', 0. )
+ call Budget_store_add( tbudgets(idx), 'HONC', ztot_cc_honc (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'IMLT', ztot_cc_imlt (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'RIM', ztot_cc_rim (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'WETG', ztot_cc_wetg (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'DRYG', ztot_cc_dryg (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'CVRC', -ztot_cr_cvrc (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'CORR2', ztot_cc_corr2(:, :, :) * zrhodjontstep(:, :, :) )
+ !
+ ! Rain drops
+ !
+ idx = NBUDGET_SV1 - 1 + nsv_lima_nr
+ call Budget_store_add( tbudgets(idx), 'AUTO', ztot_cr_auto(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'SCBU', ztot_cr_scbu(:, :, :) * zrhodjontstep(:, :, :) )
+ !call Budget_store_add( tbudgets(idx), 'REVA', 0. )
+ call Budget_store_add( tbudgets(idx), 'BRKU', ztot_cr_brku(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'HONR', ztot_cr_honr(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'ACC', ztot_cr_acc (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'CFRZ', ztot_cr_cfrz(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'WETG', ztot_cr_wetg(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'DRYG', ztot_cr_dryg(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'GMLT', ztot_cr_gmlt(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'CVRC', ztot_cr_cvrc(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'CORR2', ztot_cr_corr2(:, :, :) * zrhodjontstep(:, :, :) )
+ !
+ ! Ice crystals
+ !
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ni
+ call Budget_store_add( tbudgets(idx), 'HONC', -ztot_cc_honc (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'CNVI', ztot_ci_cnvi (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'CNVS', ztot_ci_cnvs (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'AGGS', ztot_ci_aggs (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'IMLT', -ztot_cc_imlt (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'HMS', ztot_ci_hms (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'CFRZ', ztot_ci_cfrz (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'WETG', ztot_ci_wetg (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'DRYG', ztot_ci_dryg (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'HMG', ztot_ci_hmg (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'CORR2', ztot_ci_corr2(:, :, :) * zrhodjontstep(:, :, :) )
+
+ do ii = 1, nmod_ifn
+ idx = nsv_lima_ifn_nucl + ii - 1
+ call Budget_store_add( tbudgets(idx), 'IMLT', ztot_ifnn_imlt(:, :, :, ii) * zrhodjontstep(:, :, :) )
+ end do
+ end if
+
+ deallocate( zrhodjontstep )
+end if
+!
+END SUBROUTINE LIMA
diff --git a/src/mesonh/micro/lima_adjust.f90 b/src/mesonh/micro/lima_adjust.f90
new file mode 100644
index 000000000..949fabf42
--- /dev/null
+++ b/src/mesonh/micro/lima_adjust.f90
@@ -0,0 +1,1307 @@
+!MNH_LIC Copyright 2013-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! #######################
+ MODULE MODI_LIMA_ADJUST
+! #######################
+!
+INTERFACE
+!
+ SUBROUTINE LIMA_ADJUST(KRR, KMI, TPFILE, &
+ OSUBG_COND, PTSTEP, &
+ PRHODREF, PRHODJ, PEXNREF, PPABSM, &
+ PPABST, &
+ PRT, PRS, PSVT, PSVS, &
+ PTHS, PSRCS, PCLDFR )
+!
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_NSV, only: NSV_LIMA_BEG
+!
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+INTEGER, INTENT(IN) :: KMI ! Model index
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid
+ ! Condensation
+REAL, INTENT(IN) :: PTSTEP ! Time step
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Dry density of the
+ ! reference state
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Absolute Pressure at t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute Pressure at t
+!
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! m.r. at t
+!
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! m.r. source
+!
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(IN) :: PSVT ! Concentrations at time t
+!
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(INOUT) :: PSVS ! Concentration sources
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux
+ ! s'rc'/2Sigma_s2 at time t+1
+ ! multiplied by Lambda_3
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR ! Cloud fraction
+!
+END SUBROUTINE LIMA_ADJUST
+!
+END INTERFACE
+!
+END MODULE MODI_LIMA_ADJUST
+!
+! ###########################################################
+ SUBROUTINE LIMA_ADJUST(KRR, KMI, TPFILE, &
+ OSUBG_COND, PTSTEP, &
+ PRHODREF, PRHODJ, PEXNREF, PPABSM, &
+ PPABST, &
+ PRT, PRS, PSVT, PSVS, &
+ PTHS, PSRCS, PCLDFR )
+! ###########################################################
+!
+!!**** *MIMA_ADJUST* - compute the fast microphysical sources
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the fast microphysical sources
+!! through an explict scheme and a saturation ajustement procedure.
+!!
+!!
+!!** METHOD
+!! ------
+!! Reisin et al., 1996 for the explicit scheme when ice is present
+!! Langlois, Tellus, 1973 for the implict adjustment for the cloud water
+!! (refer also to book 1 of the documentation).
+!!
+!! Computations are done separately for three cases :
+!! - ri>0 and rc=0
+!! - rc>0 and ri=0
+!! - ri>0 and rc>0
+!!
+!!
+!! EXTERNAL
+!! --------
+!! None
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST
+!! XP00 ! Reference pressure
+!! XMD,XMV ! Molar mass of dry air and molar mass of vapor
+!! XRD,XRV ! Gaz constant for dry air, gaz constant for vapor
+!! XCPD,XCPV ! Cpd (dry air), Cpv (vapor)
+!! XCL ! Cl (liquid)
+!! XTT ! Triple point temperature
+!! XLVTT ! Vaporization heat constant
+!! XALPW,XBETAW,XGAMW ! Constants for saturation vapor
+!! ! pressure function
+!! Module MODD_CONF
+!! CCONF
+!! Module MODD_BUDGET:
+!! NBUMOD
+!! CBUTYPE
+!! LBU_RTH
+!! LBU_RRV
+!! LBU_RRC
+!! Module MODD_LES : NCTR_LES,LTURB_LES,NMODNBR_LES
+!! XNA declaration (cloud fraction as global var)
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Book 1 and Book2 of documentation ( routine FAST_TERMS )
+!! Langlois, Tellus, 1973
+!!
+!! AUTHOR
+!! ------
+!! E. Richard * Laboratoire d'Aerologie*
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!! C. Barthe * LACy* jan. 2014 add budgets
+!! JP Chaboureau *LA* March 2014 fix the calculation of icy cloud fraction
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 03/2020: use the new data structures and subroutines for budgets
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+! P. Wautelet 28/05/2020: bugfix: correct array start for PSVT and PSVS
+! P. Wautelet 01/02/2021: bugfix: add missing CEDS source terms for SV budgets
+! B. Vie 06/2020: fix PSRCS
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+use modd_budget, only: lbu_enable, nbumod, &
+ lbudget_th, lbudget_rv, lbudget_rc, lbudget_ri, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RI, NBUDGET_SV1, &
+ tbudgets
+USE MODD_CONF
+USE MODD_CST
+use modd_field, only: TFIELDDATA, TYPEREAL
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_NSV
+USE MODD_PARAMETERS
+USE MODD_PARAM_LIMA
+USE MODD_PARAM_LIMA_COLD
+USE MODD_PARAM_LIMA_MIXED
+USE MODD_PARAM_LIMA_WARM
+!
+use mode_budget, only: Budget_store_init, Budget_store_end
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+use mode_msg
+use mode_tools, only: Countjv
+!
+USE MODI_CONDENS
+USE MODI_CONDENSATION
+USE MODI_LIMA_FUNCTIONS
+USE MODI_LIMA_CCN_ACTIVATION
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+!
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+INTEGER, INTENT(IN) :: KMI ! Model index
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid
+ ! Condensation
+REAL, INTENT(IN) :: PTSTEP ! Time step
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Dry density of the
+ ! reference state
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Absolute Pressure at t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute Pressure at t
+!
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! m.r. at t
+!
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! m.r. source
+!
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(IN) :: PSVT ! Concentrations at time t
+!
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(INOUT) :: PSVS ! Concentration sources
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux
+ ! s'rc'/2Sigma_s2 at time t+1
+ ! multiplied by Lambda_3
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR ! Cloud fraction
+!
+!
+!* 0.2 Declarations of local variables :
+!
+! 3D Microphysical variables
+REAL, DIMENSION(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3)) &
+ :: PRVT, & ! Water vapor m.r. at t
+ PRCT, & ! Cloud water m.r. at t
+ PRRT, & ! Rain water m.r. at t
+ PRIT, & ! Cloud ice m.r. at t
+ PRST, & ! Aggregate m.r. at t
+ PRGT, & ! Graupel m.r. at t
+!
+ PRVS, & ! Water vapor m.r. source
+ PRCS, & ! Cloud water m.r. source
+ PRRS, & ! Rain water m.r. source
+ PRIS, & ! Cloud ice m.r. source
+ PRSS, & ! Aggregate m.r. source
+ PRGS, & ! Graupel m.r. source
+!
+ PCCT, & ! Cloud water conc. at t
+ PCIT, & ! Cloud ice conc. at t
+!
+ PCCS, & ! Cloud water C. source
+ PMAS, & ! Mass of scavenged AP
+ PCIS ! Ice crystal C. source
+!
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE &
+ :: PNFS, & ! Free CCN C. source
+ PNAS, & ! Activated CCN C. source
+ PIFS, & ! Free IFN C. source
+ PINS, & ! Nucleated IFN C. source
+ PNIS ! Acti. IMM. nuclei C. source
+!
+!
+!
+REAL :: ZEPS ! Mv/Md
+REAL :: ZDT ! Time increment (2*Delta t or Delta t if cold start)
+REAL, DIMENSION(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3)) &
+ :: ZEXNS,& ! guess of the Exner function at t+1
+ ZT, & ! guess of the temperature at t+1
+ ZCPH, & ! guess of the CPh for the mixing
+ ZW, &
+ ZW1, &
+ ZW2, &
+ ZLV, & ! guess of the Lv at t+1
+ ZLS, & ! guess of the Ls at t+1
+ ZMASK
+LOGICAL, DIMENSION(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3)) &
+ :: GMICRO, GMICRO_RI, GMICRO_RC ! Test where to compute cond/dep proc.
+INTEGER :: IMICRO
+REAL, DIMENSION(:), ALLOCATABLE &
+ :: ZRVT, ZRCT, ZRIT, ZRVS, ZRCS, ZRIS, ZTHS, &
+ ZCCT, ZCIT, ZCCS, ZCIS, &
+ ZRHODREF, ZZT, ZPRES, ZEXNREF, ZZCPH, &
+ ZZW, ZLVFACT, ZLSFACT, &
+ ZRVSATW, ZRVSATI, ZRVSATW_PRIME, ZRVSATI_PRIME, &
+ ZAW, ZAI, ZCJ, ZKA, ZDV, ZITW, ZITI, ZAWW, ZAIW, &
+ ZAWI, ZAII, ZFACT, ZDELTW, &
+ ZDELTI, ZDELT1, ZDELT2, ZCND, ZDEP, ZS, ZVEC1, ZZW2
+!
+INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC1
+!
+INTEGER :: IRESP ! Return code of FM routines
+INTEGER :: IIU,IJU,IKU! dimensions of dummy arrays
+INTEGER :: IKB ! K index value of the first inner mass point
+INTEGER :: IKE ! K index value of the last inner mass point
+INTEGER :: IIB,IJB ! Horz index values of the first inner mass points
+INTEGER :: IIE,IJE ! Horz index values of the last inner mass points
+INTEGER :: JITER,ITERMAX ! iterative loop for first order adjustment
+INTEGER :: ILUOUT ! Logical unit of output listing
+!
+INTEGER :: ISIZE
+REAL, DIMENSION(:), ALLOCATABLE :: ZRTMIN
+REAL, DIMENSION(:), ALLOCATABLE :: ZCTMIN
+!
+integer :: idx
+INTEGER , DIMENSION(SIZE(GMICRO)) :: I1,I2,I3 ! Used to replace the COUNT
+INTEGER :: JL ! and PACK intrinsics
+INTEGER :: JMOD, JMOD_IFN, JMOD_IMM
+!
+INTEGER , DIMENSION(3) :: BV
+TYPE(TFIELDDATA) :: TZFIELD
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. PRELIMINARIES
+! -------------
+!
+ILUOUT = TLUOUT%NLU
+!
+IIU = SIZE(PEXNREF,1)
+IJU = SIZE(PEXNREF,2)
+IKU = SIZE(PEXNREF,3)
+IIB = 1 + JPHEXT
+IIE = SIZE(PRHODJ,1) - JPHEXT
+IJB = 1 + JPHEXT
+IJE = SIZE(PRHODJ,2) - JPHEXT
+IKB = 1 + JPVEXT
+IKE = SIZE(PRHODJ,3) - JPVEXT
+!
+ZEPS= XMV / XMD
+!
+IF (OSUBG_COND) THEN
+ ITERMAX=2
+ELSE
+ ITERMAX=1
+END IF
+!
+ZDT = PTSTEP
+!
+ISIZE = SIZE(XRTMIN)
+ALLOCATE(ZRTMIN(ISIZE))
+ZRTMIN(:) = XRTMIN(:) / ZDT
+ISIZE = SIZE(XCTMIN)
+ALLOCATE(ZCTMIN(ISIZE))
+ZCTMIN(:) = XCTMIN(:) / ZDT
+!
+! Prepare 3D water mixing ratios
+!
+PRVT(:,:,:) = PRT(:,:,:,1)
+PRVS(:,:,:) = PRS(:,:,:,1)
+!
+PRCT(:,:,:) = 0.
+PRCS(:,:,:) = 0.
+PRRT(:,:,:) = 0.
+PRRS(:,:,:) = 0.
+PRIT(:,:,:) = 0.
+PRIS(:,:,:) = 0.
+PRST(:,:,:) = 0.
+PRSS(:,:,:) = 0.
+PRGT(:,:,:) = 0.
+PRGS(:,:,:) = 0.
+!
+IF ( KRR .GE. 2 ) PRCT(:,:,:) = PRT(:,:,:,2)
+IF ( KRR .GE. 2 ) PRCS(:,:,:) = PRS(:,:,:,2)
+IF ( KRR .GE. 3 ) PRRT(:,:,:) = PRT(:,:,:,3)
+IF ( KRR .GE. 3 ) PRRS(:,:,:) = PRS(:,:,:,3)
+IF ( KRR .GE. 4 ) PRIT(:,:,:) = PRT(:,:,:,4)
+IF ( KRR .GE. 4 ) PRIS(:,:,:) = PRS(:,:,:,4)
+IF ( KRR .GE. 5 ) PRST(:,:,:) = PRT(:,:,:,5)
+IF ( KRR .GE. 5 ) PRSS(:,:,:) = PRS(:,:,:,5)
+IF ( KRR .GE. 6 ) PRGT(:,:,:) = PRT(:,:,:,6)
+IF ( KRR .GE. 6 ) PRGS(:,:,:) = PRS(:,:,:,6)
+!
+! Prepare 3D number concentrations
+PCCT(:,:,:) = 0.
+PCIT(:,:,:) = 0.
+PCCS(:,:,:) = 0.
+PCIS(:,:,:) = 0.
+!
+IF ( LWARM ) PCCT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NC)
+IF ( LCOLD ) PCIT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NI)
+!
+IF ( LWARM ) PCCS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NC)
+IF ( LCOLD ) PCIS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NI)
+!
+IF ( LSCAV .AND. LAERO_MASS ) PMAS(:,:,:) = PSVS(:,:,:,NSV_LIMA_SCAVMASS)
+!
+IF ( LWARM .AND. NMOD_CCN.GE.1 ) THEN
+ ALLOCATE( PNFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_CCN) )
+ ALLOCATE( PNAS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_CCN) )
+ PNFS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1)
+ PNAS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1)
+END IF
+!
+IF ( LCOLD .AND. NMOD_IFN .GE. 1 ) THEN
+ ALLOCATE( PIFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_IFN) )
+ ALLOCATE( PINS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_IFN) )
+ PIFS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IFN_FREE:NSV_LIMA_IFN_FREE+NMOD_IFN-1)
+ PINS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IFN_NUCL:NSV_LIMA_IFN_NUCL+NMOD_IFN-1)
+END IF
+!
+IF ( NMOD_IMM .GE. 1 ) THEN
+ ALLOCATE( PNIS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_IMM) )
+ PNIS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IMM_NUCL:NSV_LIMA_IMM_NUCL+NMOD_IMM-1)
+END IF
+
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'CEDS', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'CEDS', prvs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'CEDS', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'CEDS', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ if ( lwarm ) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'CEDS', pccs(:, :, :) * prhodj(:, :, :) )
+ if ( lcold ) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CEDS', pcis(:, :, :) * prhodj(:, :, :) )
+ if ( lscav .and. laero_mass ) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_scavmass), 'CEDS', pmas(:, :, :) * prhodj(:, :, :) )
+ if ( lwarm ) then
+ do jl = 1, nmod_ccn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
+ call Budget_store_init( tbudgets(idx), 'CEDS', pnfs(:, :, :, jl) * prhodj(:, :, :) )
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_acti - 1 + jl
+ call Budget_store_init( tbudgets(idx), 'CEDS', pnas(:, :, :, jl) * prhodj(:, :, :) )
+ end do
+ end if
+ if ( lcold ) then
+ do jl = 1, nmod_ifn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_free - 1 + jl
+ call Budget_store_init( tbudgets(idx), 'CEDS', pifs(:, :, :, jl) * prhodj(:, :, :) )
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl - 1 + jl
+ call Budget_store_init( tbudgets(idx), 'CEDS', pins(:, :, :, jl) * prhodj(:, :, :) )
+ end do
+ do jl = 1, nmod_imm
+ idx = NBUDGET_SV1 - 1 + nsv_lima_imm_nucl - 1 + jl
+ call Budget_store_init( tbudgets(idx), 'CEDS', pnis(:, :, :, jl) * prhodj(:, :, :) )
+ end do
+ end if
+ end if
+end if
+
+!-------------------------------------------------------------------------------
+!
+!
+!* 2. COMPUTE QUANTITIES WITH THE GUESS OF THE FUTURE INSTANT
+! -------------------------------------------------------
+!
+!* 2.1 remove negative non-precipitating negative water
+! ------------------------------------------------
+!
+IF (ANY(PRVS(:,:,:)+PRCS(:,:,:)+PRIS(:,:,:) < 0.) .AND. NVERB>5) THEN
+ WRITE(ILUOUT,*) 'LIMA_ADJUST: negative values of total water (reset to zero)'
+ WRITE(ILUOUT,*) ' location of minimum PRVS+PRCS+PRIS:',MINLOC(PRVS+PRCS+PRIS)
+ WRITE(ILUOUT,*) ' value of minimum PRVS+PRCS+PRIS:',MINVAL(PRVS+PRCS+PRIS)
+END IF
+!
+WHERE ( PRVS(:,:,:)+PRCS(:,:,:)+PRIS(:,:,:) < 0.)
+ PRVS(:,:,:) = - PRCS(:,:,:) - PRIS(:,:,:)
+END WHERE
+!
+!* 2.2 estimate the Exner function at t+1
+!
+ZEXNS(:,:,:) = ( (2. * PPABST(:,:,:) - PPABSM(:,:,:)) / XP00 ) ** (XRD/XCPD)
+!
+! beginning of the iterative loop
+!
+DO JITER =1,ITERMAX
+!
+!* 2.3 compute the intermediate temperature at t+1, T*
+!
+ ZT(:,:,:) = ( PTHS(:,:,:) * ZDT ) * ZEXNS(:,:,:)
+!
+!* 2.4 compute the specific heat for moist air (Cph) at t+1
+!
+ ZCPH(:,:,:) = XCPD + XCPV *ZDT* PRVS(:,:,:) &
+ + XCL *ZDT* ( PRCS(:,:,:) + PRRS(:,:,:) ) &
+ + XCI *ZDT* ( PRIS(:,:,:) + PRSS(:,:,:) + PRGS(:,:,:) )
+!
+!* 2.5 compute the latent heat of vaporization Lv(T*) at t+1
+! and of sublimation Ls(T*) at t+1
+!
+ ZLV(:,:,:) = XLVTT + ( XCPV - XCL ) * ( ZT(:,:,:) -XTT )
+ ZLS(:,:,:) = XLSTT + ( XCPV - XCI ) * ( ZT(:,:,:) -XTT )
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. FIRST ORDER SUBGRID CONDENSATION SCHEME
+! ---------------------------------------
+!
+ IF ( OSUBG_COND ) THEN
+ call Print_msg( NVERB_FATAL, 'GEN', 'LIMA_ADJUST', 'OSUBG_COND=.true. not yet developed' )
+ ELSE
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 4. FULLY EXPLICIT SCHEME FROM TZIVION et al. (1989)
+! -----------------------------------------------
+!
+!* select cases where r_i>0 and r_c=0
+!
+GMICRO(:,:,:) = .FALSE.
+GMICRO(IIB:IIE,IJB:IJE,IKB:IKE) = &
+ (PRIS(IIB:IIE,IJB:IJE,IKB:IKE)>ZRTMIN(4) .AND. &
+ PCIS(IIB:IIE,IJB:IJE,IKB:IKE)>ZCTMIN(4) ) &
+ .AND. .NOT. (PRCS(IIB:IIE,IJB:IJE,IKB:IKE)>ZRTMIN(2) .AND. &
+ PCCS(IIB:IIE,IJB:IJE,IKB:IKE)>ZCTMIN(2) )
+GMICRO_RI(:,:,:) = GMICRO(:,:,:)
+IMICRO = COUNTJV( GMICRO(:,:,:),I1(:),I2(:),I3(:))
+IF( IMICRO >= 1 ) THEN
+ ALLOCATE(ZRVT(IMICRO))
+ ALLOCATE(ZRIT(IMICRO))
+ ALLOCATE(ZCIT(IMICRO))
+!
+ ALLOCATE(ZRVS(IMICRO))
+ ALLOCATE(ZRIS(IMICRO))
+ ALLOCATE(ZCIS(IMICRO)) !!!BVIE!!!
+ ALLOCATE(ZTHS(IMICRO))
+!
+ ALLOCATE(ZRHODREF(IMICRO))
+ ALLOCATE(ZZT(IMICRO))
+ ALLOCATE(ZPRES(IMICRO))
+ ALLOCATE(ZEXNREF(IMICRO))
+ ALLOCATE(ZZCPH(IMICRO))
+ DO JL=1,IMICRO
+ ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL))
+ ZRIT(JL) = PRIT(I1(JL),I2(JL),I3(JL))
+ ZCIT(JL) = PCIT(I1(JL),I2(JL),I3(JL))
+!
+ ZRVS(JL) = PRVS(I1(JL),I2(JL),I3(JL))
+ ZRIS(JL) = PRIS(I1(JL),I2(JL),I3(JL))
+ ZCIS(JL) = PCIS(I1(JL),I2(JL),I3(JL)) !!!BVIE!!!
+ ZTHS(JL) = PTHS(I1(JL),I2(JL),I3(JL))
+!
+ ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
+ ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
+ ZPRES(JL) = 2.0*PPABST(I1(JL),I2(JL),I3(JL))-PPABSM(I1(JL),I2(JL),I3(JL))
+ ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL))
+ ZZCPH(JL) = ZCPH(I1(JL),I2(JL),I3(JL))
+ ENDDO
+ ALLOCATE(ZZW(IMICRO))
+ ALLOCATE(ZLSFACT(IMICRO))
+ ZLSFACT(:) = (XLSTT+(XCPV-XCI)*(ZZT(:)-XTT))/ZZCPH(:) ! L_s/C_ph
+ ALLOCATE(ZRVSATI(IMICRO))
+ ALLOCATE(ZRVSATI_PRIME(IMICRO))
+ ALLOCATE(ZDELTI(IMICRO))
+ ALLOCATE(ZAI(IMICRO))
+ ALLOCATE(ZCJ(IMICRO))
+ ALLOCATE(ZKA(IMICRO))
+ ALLOCATE(ZDV(IMICRO))
+ ALLOCATE(ZITI(IMICRO))
+!
+ ZKA(:) = 2.38E-2 + 0.0071E-2 * ( ZZT(:) - XTT ) ! k_a
+ ZDV(:) = 0.211E-4 * (ZZT(:)/XTT)**1.94 * (XP00/ZPRES(:)) ! D_v
+ ZCJ(:) = XSCFAC * ZRHODREF(:)**0.3 / SQRT( 1.718E-5+0.0049E-5*(ZZT(:)-XTT) )
+!
+ ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) ) ! es_i
+ ZRVSATI(:) = ZEPS*ZZW(:) / ( ZPRES(:)-ZZW(:) ) ! r_si
+ ZRVSATI_PRIME(:) = (( XBETAI/ZZT(:) - XGAMI ) / ZZT(:)) & ! r'_si
+ * ZRVSATI(:) * ( 1. + ZRVSATI(:)/ZEPS )
+!
+ ZDELTI(:) = ZRVS(:)*ZDT - ZRVSATI(:)
+ ZAI(:) = ( XLSTT + (XCPV-XCI)*(ZZT(:)-XTT) )**2 / (ZKA(:)*XRV*ZZT(:)**2) &
+ + ( XRV*ZZT(:) ) / (ZDV(:)*ZZW(:))
+ ZZW(:) = MIN(1.E8,( XLBI* MAX(ZCIT(:),XCTMIN(4)) &
+ /(MAX(ZRIT(:),XRTMIN(4))) )**XLBEXI)
+ ! Lbda_I
+ ZITI(:) = ZCIT(:) * (X0DEPI/ZZW(:) + X2DEPI*ZCJ(:)*ZCJ(:)/ZZW(:)**(XDI+2.0)) &
+ / (ZRVSATI(:)*ZAI(:))
+!
+ ALLOCATE(ZAII(IMICRO))
+ ALLOCATE(ZDEP(IMICRO))
+!
+ ZAII(:) = 1.0 + ZRVSATI_PRIME(:)*ZLSFACT(:)
+ ZDEP(:) = 0.0
+!
+ ZZW(:) = ZAII(:)*ZITI(:)*ZDT ! R*delta_T
+ WHERE( ZZW(:)<1.0E-2 )
+ ZDEP(:) = ZITI(:)*ZDELTI(:)*(1.0 - (ZZW(:)/2.0)*(1.0-ZZW(:)/3.0))
+ ELSEWHERE
+ ZDEP(:) = ZITI(:)*ZDELTI(:)*(1.0 - EXP(-ZZW(:)))/ZZW(:)
+ END WHERE
+!
+! Integration
+!
+ WHERE( ZDEP(:) < 0.0 )
+ ZDEP(:) = MAX ( ZDEP(:), -ZRIS(:) )
+ ELSEWHERE
+ ZDEP(:) = MIN ( ZDEP(:), ZRVS(:) )
+! ZDEP(:) = MIN ( ZDEP(:), ZCIS(:)*5.E-10 ) !!!BVIE!!!
+ END WHERE
+ WHERE( ZRIS(:) < ZRTMIN(4) )
+ ZDEP(:) = 0.0
+ END WHERE
+ ZRVS(:) = ZRVS(:) - ZDEP(:)
+ ZRIS(:) = ZRIS(:) + ZDEP(:)
+ ZTHS(:) = ZTHS(:) + ZDEP(:) * ZLSFACT(:) / ZEXNREF(:)
+!
+! Implicit ice crystal sublimation if ice saturated conditions are not met
+!
+ ZZT(:) = ( ZTHS(:) * ZDT ) * ( ZPRES(:) / XP00 ) ** (XRD/XCPD)
+ ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) ) ! es_i
+ ZRVSATI(:) = ZEPS*ZZW(:) / ( ZPRES(:)-ZZW(:) ) ! r_si
+ WHERE( ZRVS(:)*ZDT<ZRVSATI(:) )
+ ZZW(:) = ZRVS(:) + ZRIS(:)
+ ZRVS(:) = MIN( ZZW(:),ZRVSATI(:)/ZDT )
+ ZTHS(:) = ZTHS(:) + ( MAX( 0.0,ZZW(:)-ZRVS(:) )-ZRIS(:) ) &
+ * ZLSFACT(:) / ZEXNREF(:)
+ ZRIS(:) = MAX( 0.0,ZZW(:)-ZRVS(:) )
+ END WHERE
+!
+!
+ ZW(:,:,:) = PRVS(:,:,:)
+ PRVS(:,:,:) = UNPACK( ZRVS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PRIS(:,:,:)
+ PRIS(:,:,:) = UNPACK( ZRIS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PTHS(:,:,:)
+ PTHS(:,:,:) = UNPACK( ZTHS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+!
+ DEALLOCATE(ZRVT)
+ DEALLOCATE(ZRIT)
+ DEALLOCATE(ZCIT)
+ DEALLOCATE(ZRVS)
+ DEALLOCATE(ZRIS)
+ DEALLOCATE(ZCIS) !!!BVIE!!!
+ DEALLOCATE(ZTHS)
+ DEALLOCATE(ZRHODREF)
+ DEALLOCATE(ZZT)
+ DEALLOCATE(ZPRES)
+ DEALLOCATE(ZEXNREF)
+ DEALLOCATE(ZZCPH)
+ DEALLOCATE(ZZW)
+ DEALLOCATE(ZLSFACT)
+ DEALLOCATE(ZRVSATI)
+ DEALLOCATE(ZRVSATI_PRIME)
+ DEALLOCATE(ZDELTI)
+ DEALLOCATE(ZAI)
+ DEALLOCATE(ZCJ)
+ DEALLOCATE(ZKA)
+ DEALLOCATE(ZDV)
+ DEALLOCATE(ZITI)
+ DEALLOCATE(ZAII)
+ DEALLOCATE(ZDEP)
+END IF ! IMICRO
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 5. FULLY IMPLICIT CONDENSATION SCHEME
+! ---------------------------------
+!
+!* select cases where r_c>0 and r_i=0
+!
+!
+GMICRO(:,:,:) = .FALSE.
+GMICRO(IIB:IIE,IJB:IJE,IKB:IKE) =( PRCS(IIB:IIE,IJB:IJE,IKB:IKE)>0. .AND. &
+ PCCS(IIB:IIE,IJB:IJE,IKB:IKE)>0. ) .AND. &
+ .NOT.GMICRO_RI(IIB:IIE,IJB:IJE,IKB:IKE)
+GMICRO_RC(:,:,:) = GMICRO(:,:,:)
+IMICRO = COUNTJV( GMICRO(:,:,:),I1(:),I2(:),I3(:))
+IF( IMICRO >= 1 ) THEN
+ ALLOCATE(ZRVT(IMICRO))
+ ALLOCATE(ZRCT(IMICRO))
+!
+ ALLOCATE(ZRVS(IMICRO))
+ ALLOCATE(ZRCS(IMICRO))
+ ALLOCATE(ZCCS(IMICRO))
+ ALLOCATE(ZTHS(IMICRO))
+!
+ ALLOCATE(ZRHODREF(IMICRO))
+ ALLOCATE(ZZT(IMICRO))
+ ALLOCATE(ZPRES(IMICRO))
+ ALLOCATE(ZEXNREF(IMICRO))
+ ALLOCATE(ZZCPH(IMICRO))
+ DO JL=1,IMICRO
+ ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL))
+ ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
+!
+ ZRVS(JL) = PRVS(I1(JL),I2(JL),I3(JL))
+ ZRCS(JL) = PRCS(I1(JL),I2(JL),I3(JL))
+ ZCCS(JL) = PCCS(I1(JL),I2(JL),I3(JL))
+ ZTHS(JL) = PTHS(I1(JL),I2(JL),I3(JL))
+!
+ ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
+ ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
+ ZPRES(JL) = 2.0*PPABST(I1(JL),I2(JL),I3(JL))-PPABSM(I1(JL),I2(JL),I3(JL))
+ ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL))
+ ZZCPH(JL) = ZCPH(I1(JL),I2(JL),I3(JL))
+ ENDDO
+ ALLOCATE(ZZW(IMICRO))
+ ALLOCATE(ZLVFACT(IMICRO))
+ ALLOCATE(ZCND(IMICRO))
+ ALLOCATE(ZRVSATW(IMICRO))
+ ZLVFACT(:) = (XLVTT+(XCPV-XCL)*(ZZT(:)-XTT))/ZZCPH(:) ! L_v/C_ph
+ ZZW(:) = EXP( XALPW - XBETAW/ZZT(:) - XGAMW*ALOG(ZZT(:) ) ) ! es_w
+ ZRVSATW(:) = ZEPS*ZZW(:) / ( ZPRES(:)-ZZW(:) ) ! r_sw
+
+ IF (LADJ) THEN
+ ALLOCATE(ZRVSATW_PRIME(IMICRO))
+ ALLOCATE(ZAWW(IMICRO))
+ ALLOCATE(ZDELT1(IMICRO))
+ ALLOCATE(ZDELT2(IMICRO))
+ ZRVSATW_PRIME(:) = (( XBETAW/ZZT(:) - XGAMW ) / ZZT(:)) & ! r'_sw
+ * ZRVSATW(:) * ( 1. + ZRVSATW(:)/ZEPS )
+ ZAWW(:) = 1.0 + ZRVSATW_PRIME(:)*ZLVFACT(:)
+ ZDELT2(:) = (ZRVSATW_PRIME(:)*ZLVFACT(:)/ZAWW(:)) * &
+ ( ((-2.*XBETAW+XGAMW*ZZT(:))/(XBETAW-XGAMW*ZZT(:)) &
+ + (XBETAW/ZZT(:)-XGAMW)*(1.0+2.0*ZRVSATW(:)/ZEPS))/ZZT(:) )
+ ZDELT1(:) = (ZLVFACT(:)/ZAWW(:)) * ( ZRVSATW(:) - ZRVS(:)*ZDT )
+ ZCND(:) = - ZDELT1(:)*( 1.0 + 0.5*ZDELT1(:)*ZDELT2(:) ) / (ZLVFACT(:)*ZDT)
+ DEALLOCATE(ZRVSATW_PRIME)
+ DEALLOCATE(ZAWW)
+ DEALLOCATE(ZDELT1)
+ DEALLOCATE(ZDELT2)
+ ELSE
+ ALLOCATE(ZS(IMICRO))
+ ALLOCATE(ZZW2(IMICRO))
+ ALLOCATE(ZVEC1(IMICRO))
+ ALLOCATE(IVEC1(IMICRO))
+ ZVEC1(:) = MAX( 1.0001, MIN( FLOAT(NAHEN)-0.0001, XAHENINTP1 * ZZT(:) + XAHENINTP2 ) )
+ IVEC1(:) = INT( ZVEC1(:) )
+ ZVEC1(:) = ZVEC1(:) - FLOAT( IVEC1(:) )
+ ZS(:) = ZRVS(:)*PTSTEP / ZRVSATW(:) - 1.
+ ZZW(:) = ZCCS(:)*PTSTEP/(XLBC*ZCCS(:)/ZRCS(:))**XLBEXC
+ ZZW2(:) = XAHENG3(IVEC1(:)+1)*ZVEC1(:)-XAHENG3(IVEC1(:))*(ZVEC1(:)-1.)
+ ZCND(:) = 2.*3.14*1000.*ZZW2(:)*ZS(:)*ZZW(:)
+ DEALLOCATE(ZS)
+ DEALLOCATE(ZZW2)
+ DEALLOCATE(ZVEC1)
+ DEALLOCATE(IVEC1)
+ END IF
+
+!
+! Integration
+!
+ WHERE( ZCND(:) < 0.0 )
+ ZCND(:) = MAX ( ZCND(:), -ZRCS(:) )
+ ELSEWHERE
+ ZCND(:) = MIN ( ZCND(:), ZRVS(:) )
+ END WHERE
+ ZRVS(:) = ZRVS(:) - ZCND(:)
+ ZRCS(:) = ZRCS(:) + ZCND(:)
+ ZTHS(:) = ZTHS(:) + ZCND(:) * ZLVFACT(:) / ZEXNREF(:)
+!
+ ZW(:,:,:) = PRVS(:,:,:)
+ PRVS(:,:,:) = UNPACK( ZRVS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PRCS(:,:,:)
+ PRCS(:,:,:) = UNPACK( ZRCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PTHS(:,:,:)
+ PTHS(:,:,:) = UNPACK( ZTHS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+!
+ DEALLOCATE(ZRVT)
+ DEALLOCATE(ZRCT)
+ DEALLOCATE(ZRVS)
+ DEALLOCATE(ZRCS)
+ DEALLOCATE(ZCCS)
+ DEALLOCATE(ZTHS)
+ DEALLOCATE(ZRHODREF)
+ DEALLOCATE(ZZT)
+ DEALLOCATE(ZPRES)
+ DEALLOCATE(ZEXNREF)
+ DEALLOCATE(ZZCPH)
+ DEALLOCATE(ZZW)
+ DEALLOCATE(ZLVFACT)
+ DEALLOCATE(ZRVSATW)
+ DEALLOCATE(ZCND)
+END IF ! IMICRO
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 6. IMPLICIT-EXPLICIT SCHEME USING REISIN et al. (1996)
+! ---------------------------------------------------
+!
+!* select cases where r_i>0 and r_c>0 (supercooled water)
+!
+!
+GMICRO(IIB:IIE,IJB:IJE,IKB:IKE) = &
+ .NOT. GMICRO_RI(IIB:IIE,IJB:IJE,IKB:IKE) &
+ .AND. .NOT. GMICRO_RC(IIB:IIE,IJB:IJE,IKB:IKE) &
+ .AND. ( PRIS(IIB:IIE,IJB:IJE,IKB:IKE)>ZRTMIN(4) .AND. &
+ PCIS(IIB:IIE,IJB:IJE,IKB:IKE)>ZCTMIN(4) ) &
+ .AND. ( PRCS(IIB:IIE,IJB:IJE,IKB:IKE)>ZRTMIN(2) .AND. &
+ PCCS(IIB:IIE,IJB:IJE,IKB:IKE)>ZCTMIN(2) )
+IMICRO = COUNTJV( GMICRO(:,:,:),I1(:),I2(:),I3(:))
+IF( IMICRO >= 1 ) THEN
+ ALLOCATE(ZRVT(IMICRO))
+ ALLOCATE(ZRCT(IMICRO))
+ ALLOCATE(ZRIT(IMICRO))
+ ALLOCATE(ZCCT(IMICRO))
+ ALLOCATE(ZCIT(IMICRO))
+!
+ ALLOCATE(ZRVS(IMICRO))
+ ALLOCATE(ZRCS(IMICRO))
+ ALLOCATE(ZRIS(IMICRO))
+ ALLOCATE(ZCCS(IMICRO))
+ ALLOCATE(ZCIS(IMICRO))
+ ALLOCATE(ZTHS(IMICRO))
+!
+ ALLOCATE(ZRHODREF(IMICRO))
+ ALLOCATE(ZZT(IMICRO))
+ ALLOCATE(ZPRES(IMICRO))
+ ALLOCATE(ZEXNREF(IMICRO))
+ ALLOCATE(ZZCPH(IMICRO))
+ DO JL=1,IMICRO
+ ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL))
+ ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
+ ZRIT(JL) = PRIT(I1(JL),I2(JL),I3(JL))
+ ZCCT(JL) = PCCT(I1(JL),I2(JL),I3(JL))
+ ZCIT(JL) = PCIT(I1(JL),I2(JL),I3(JL))
+!
+ ZRVS(JL) = PRVS(I1(JL),I2(JL),I3(JL))
+ ZRCS(JL) = PRCS(I1(JL),I2(JL),I3(JL))
+ ZRIS(JL) = PRIS(I1(JL),I2(JL),I3(JL))
+ ZCCS(JL) = PCCS(I1(JL),I2(JL),I3(JL))
+ ZCIS(JL) = PCIS(I1(JL),I2(JL),I3(JL))
+ ZTHS(JL) = PTHS(I1(JL),I2(JL),I3(JL))
+!
+ ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
+ ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
+ ZPRES(JL) = 2.0*PPABST(I1(JL),I2(JL),I3(JL))-PPABSM(I1(JL),I2(JL),I3(JL))
+ ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL))
+ ZZCPH(JL) = ZCPH(I1(JL),I2(JL),I3(JL))
+ ENDDO
+ ALLOCATE(ZZW(IMICRO))
+ ALLOCATE(ZLVFACT(IMICRO))
+ ALLOCATE(ZLSFACT(IMICRO))
+ ZLVFACT(:) = (XLVTT+(XCPV-XCL)*(ZZT(:)-XTT))/ZZCPH(:) ! L_v/C_ph
+ ZLSFACT(:) = (XLSTT+(XCPV-XCI)*(ZZT(:)-XTT))/ZZCPH(:) ! L_s/C_ph
+ ALLOCATE(ZRVSATW(IMICRO))
+ ALLOCATE(ZRVSATI(IMICRO))
+ ALLOCATE(ZRVSATW_PRIME(IMICRO))
+ ALLOCATE(ZRVSATI_PRIME(IMICRO))
+ ALLOCATE(ZDELTW(IMICRO))
+ ALLOCATE(ZDELTI(IMICRO))
+ ALLOCATE(ZAW(IMICRO))
+ ALLOCATE(ZAI(IMICRO))
+ ALLOCATE(ZCJ(IMICRO))
+ ALLOCATE(ZKA(IMICRO))
+ ALLOCATE(ZDV(IMICRO))
+ ALLOCATE(ZITW(IMICRO))
+ ALLOCATE(ZITI(IMICRO))
+!
+ ZKA(:) = 2.38E-2 + 0.0071E-2 * ( ZZT(:) - XTT ) ! k_a
+ ZDV(:) = 0.211E-4 * (ZZT(:)/XTT)**1.94 * (XP00/ZPRES(:)) ! D_v
+ ZCJ(:) = XSCFAC * ZRHODREF(:)**0.3 / SQRT( 1.718E-5+0.0049E-5*(ZZT(:)-XTT) )
+!
+!* 6.2 implicit adjustment at water saturation
+!
+ ZZW(:) = EXP( XALPW - XBETAW/ZZT(:) - XGAMW*ALOG(ZZT(:) ) ) ! es_w
+ ZRVSATW(:) = ZEPS*ZZW(:) / ( ZPRES(:)-ZZW(:) ) ! r_sw
+ ZRVSATW_PRIME(:) = (( XBETAW/ZZT(:) - XGAMW ) / ZZT(:)) & ! r'_sw
+ * ZRVSATW(:) * ( 1. + ZRVSATW(:)/ZEPS )
+ ZDELTW(:) = ABS( ZRVS(:)*ZDT - ZRVSATW(:) )
+ ZAW(:) = ( XLSTT + (XCPV-XCL)*(ZZT(:)-XTT) )**2 / (ZKA(:)*XRV*ZZT(:)**2) &
+ + ( XRV*ZZT(:) ) / (ZDV(:)*ZZW(:))
+ ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) ) ! es_i
+ ZRVSATI(:) = ZEPS*ZZW(:) / ( ZPRES(:)-ZZW(:) ) ! r_si
+ ZRVSATI_PRIME(:) = (( XBETAI/ZZT(:) - XGAMI ) / ZZT(:)) & ! r'_si
+ * ZRVSATI(:) * ( 1. + ZRVSATI(:)/ZEPS )
+ ZDELTI(:) = ABS( ZRVS(:)*ZDT - ZRVSATI(:) )
+ ZAI(:) = ( XLSTT + (XCPV-XCI)*(ZZT(:)-XTT) )**2 / (ZKA(:)*XRV*ZZT(:)**2) &
+ + ( XRV*ZZT(:) ) / (ZDV(:)*ZZW(:))
+!
+ ZZW(:) = MIN(1.E8,( XLBC* MAX(ZCCT(:),XCTMIN(2)) &
+ /(MAX(ZRCT(:),XRTMIN(2))) )**XLBEXC)
+ ! Lbda_c
+ ZITW(:) = ZCCT(:) * (X0CNDC/ZZW(:) + X2CNDC*ZCJ(:)*ZCJ(:)/ZZW(:)**(XDC+2.0)) &
+ / (ZRVSATW(:)*ZAW(:))
+ ZZW(:) = MIN(1.E8,( XLBI* MAX(ZCIT(:),XCTMIN(4)) &
+ /(MAX(ZRIT(:),XRTMIN(4))) )**XLBEXI)
+ ! Lbda_I
+ ZITI(:) = ZCIT(:) * (X0DEPI/ZZW(:) + X2DEPI*ZCJ(:)*ZCJ(:)/ZZW(:)**(XDI+2.0)) &
+ / (ZRVSATI(:)*ZAI(:))
+!
+ ALLOCATE(ZAWW(IMICRO))
+ ALLOCATE(ZAIW(IMICRO))
+ ALLOCATE(ZAWI(IMICRO))
+ ALLOCATE(ZAII(IMICRO))
+!
+ ALLOCATE(ZFACT(IMICRO))
+ ALLOCATE(ZDELT1(IMICRO))
+ ALLOCATE(ZDELT2(IMICRO))
+!
+ ZAII(:) = ZITI(:)*ZDELTI(:)
+ WHERE( ZAII(:)<1.0E-15 )
+ ZFACT(:) = ZLVFACT(:)
+ ELSEWHERE
+ ZFACT(:) = (ZLVFACT(:)*ZITW(:)*ZDELTW(:)+ZLSFACT(:)*ZITI(:)*ZDELTI(:)) &
+ / (ZITW(:)*ZDELTW(:)+ZITI(:)*ZDELTI(:))
+ END WHERE
+ ZAWW(:) = 1.0 + ZRVSATW_PRIME(:)*ZFACT(:)
+!
+ ZDELT2(:) = (ZRVSATW_PRIME(:)*ZFACT(:)/ZAWW(:)) * &
+ ( ((-2.*XBETAW+XGAMW*ZZT(:))/(XBETAW-XGAMW*ZZT(:)) &
+ + (XBETAW/ZZT(:)-XGAMW)*(1.0+2.0*ZRVSATW(:)/ZEPS))/ZZT(:) )
+ ZDELT1(:) = (ZFACT(:)/ZAWW(:)) * ( ZRVSATW(:) - ZRVS(:)*ZDT )
+!
+ ALLOCATE(ZCND(IMICRO))
+ ALLOCATE(ZDEP(IMICRO))
+ ZCND(:) = 0.0
+ ZDEP(:) = 0.0
+!
+ ZZW(:) = - ZDELT1(:)*( 1.0 + 0.5*ZDELT1(:)*ZDELT2(:) ) / (ZFACT(:)*ZDT)
+ WHERE( ZAII(:)<1.0E-15 )
+ ZCND(:) = ZZW(:)
+ ZDEP(:) = 0.0
+ ELSEWHERE
+ ZCND(:) = ZZW(:)*ZITW(:)*ZDELTW(:) / (ZITW(:)*ZDELTW(:)+ZITI(:)*ZDELTI(:))
+ ZDEP(:) = ZZW(:)*ZITI(:)*ZDELTI(:) / (ZITW(:)*ZDELTW(:)+ZITI(:)*ZDELTI(:))
+ END WHERE
+!
+! Integration
+!
+ WHERE( ZCND(:) < 0.0 )
+ ZCND(:) = MAX ( ZCND(:), -ZRCS(:) )
+ ELSEWHERE
+ ZCND(:) = MIN ( ZCND(:), ZRVS(:) )
+ END WHERE
+ ZRVS(:) = ZRVS(:) - ZCND(:)
+ ZRCS(:) = ZRCS(:) + ZCND(:)
+ ZTHS(:) = ZTHS(:) + ZCND(:) * ZLVFACT(:) / ZEXNREF(:)
+!
+ WHERE( ZDEP(:) < 0.0 )
+ ZDEP(:) = MAX ( ZDEP(:), -ZRIS(:) )
+ ELSEWHERE
+ ZDEP(:) = MIN ( ZDEP(:), ZRVS(:) )
+ END WHERE
+ ZRVS(:) = ZRVS(:) - ZDEP(:)
+ ZRIS(:) = ZRIS(:) + ZDEP(:)
+ ZTHS(:) = ZTHS(:) + ZDEP(:) * ZLSFACT(:) / ZEXNREF(:)
+!
+!* 6.3 explicit integration of the final eva/dep rates
+!
+ ZZT(:) = ( ZTHS(:) * ZDT ) * ( ZPRES(:) / XP00 ) ** (XRD/XCPD)
+ ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) ) ! es_i
+ ZRVSATI(:) = ZEPS*ZZW(:) / ( ZPRES(:)-ZZW(:) ) ! r_si
+!
+! If Si < 0, implicit adjustment to Si=0 using ice only
+!
+ WHERE( ZRVS(:)*ZDT<ZRVSATI(:) )
+ ZZW(:) = ZRVS(:) + ZRIS(:)
+ ZRVS(:) = MIN( ZZW(:),ZRVSATI(:)/ZDT )
+ ZTHS(:) = ZTHS(:) + ( MAX( 0.0,ZZW(:)-ZRVS(:) )-ZRIS(:) ) &
+ * ZLSFACT(:) / ZEXNREF(:)
+ ZRIS(:) = MAX( 0.0,ZZW(:)-ZRVS(:) )
+ END WHERE
+!
+! Following the previous adjustment, the real procedure begins
+!
+ ZZT(:) = ( ZTHS(:) * ZDT ) * ( ZPRES(:) / XP00 ) ** (XRD/XCPD)
+!
+ ZLVFACT(:) = (XLVTT+(XCPV-XCL)*(ZZT(:)-XTT))/ZZCPH(:) ! L_v/C_ph
+ ZLSFACT(:) = (XLSTT+(XCPV-XCI)*(ZZT(:)-XTT))/ZZCPH(:) ! L_s/C_ph
+!
+ ZKA(:) = 2.38E-2 + 0.0071E-2 * ( ZZT(:) - XTT ) ! k_a
+ ZDV(:) = 0.211E-4 * (ZZT(:)/XTT)**1.94 * (XP00/ZPRES(:)) ! D_v
+ ZCJ(:) = XSCFAC * ZRHODREF(:)**0.3 / SQRT( 1.718E-5+0.0049E-5*(ZZT(:)-XTT) )
+!
+ ZZW(:) = EXP( XALPW - XBETAW/ZZT(:) - XGAMW*ALOG(ZZT(:) ) ) ! es_w
+ ZRVSATW(:) = ZEPS*ZZW(:) / ( ZPRES(:)-ZZW(:) ) ! r_sw
+ ZRVSATW_PRIME(:) = (( XBETAW/ZZT(:) - XGAMW ) / ZZT(:)) & ! r'_sw
+ * ZRVSATW(:) * ( 1. + ZRVSATW(:)/ZEPS )
+ ZDELTW(:) = ZRVS(:)*ZDT - ZRVSATW(:)
+ ZAW(:) = ( XLSTT + (XCPV-XCL)*(ZZT(:)-XTT) )**2 / (ZKA(:)*XRV*ZZT(:)**2) &
+ + ( XRV*ZZT(:) ) / (ZDV(:)*ZZW(:))
+!
+ ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) ) ! es_i
+ ZRVSATI(:) = ZEPS*ZZW(:) / ( ZPRES(:)-ZZW(:) ) ! r_si
+ ZRVSATI_PRIME(:) = (( XBETAI/ZZT(:) - XGAMI ) / ZZT(:)) & ! r'_si
+ * ZRVSATI(:) * ( 1. + ZRVSATI(:)/ZEPS )
+ ZDELTI(:) = ZRVS(:)*ZDT - ZRVSATI(:)
+ ZAI(:) = ( XLSTT + (XCPV-XCI)*(ZZT(:)-XTT) )**2 / (ZKA(:)*XRV*ZZT(:)**2) &
+ + ( XRV*ZZT(:) ) / (ZDV(:)*ZZW(:))
+!
+ ZZW(:) = MIN(1.E8,( XLBC* MAX(ZCCS(:),ZCTMIN(2)) &
+ /(MAX(ZRCS(:),ZRTMIN(2))) )**XLBEXC)
+ ! Lbda_c
+ ZITW(:) = ZCCT(:) * (X0CNDC/ZZW(:) + X2CNDC*ZCJ(:)*ZCJ(:)/ZZW(:)**(XDC+2.0)) &
+ / (ZRVSATW(:)*ZAW(:))
+ ZZW(:) = MIN(1.E8,( XLBI* MAX(ZCIS(:),ZCTMIN(4)) &
+ /(MAX(ZRIS(:),ZRTMIN(4))) )**XLBEXI)
+ ! Lbda_I
+ ZITI(:) = ZCIT(:) * (X0DEPI/ZZW(:) + X2DEPI*ZCJ(:)*ZCJ(:)/ZZW(:)**(XDI+2.0)) &
+ / (ZRVSATI(:)*ZAI(:))
+!
+ ZAWW(:) = 1.0 + ZRVSATW_PRIME(:)*ZLVFACT(:)
+ ZAIW(:) = 1.0 + ZRVSATI_PRIME(:)*ZLVFACT(:)
+ ZAWI(:) = 1.0 + ZRVSATW_PRIME(:)*ZLSFACT(:)
+ ZAII(:) = 1.0 + ZRVSATI_PRIME(:)*ZLSFACT(:)
+!
+ ZCND(:) = 0.0
+ ZDEP(:) = 0.0
+ ZZW(:) = ZAWW(:)*ZITW(:) + ZAII(:)*ZITI(:) ! R
+ WHERE( ZZW(:)<1.0E-2 )
+ ZFACT(:) = ZDT*(0.5 - (ZZW(:)*ZDT)/6.0)
+ ELSEWHERE
+ ZFACT(:) = (1.0/ZZW(:))*(1.0-(1.0-EXP(-ZZW(:)*ZDT))/(ZZW(:)*ZDT))
+ END WHERE
+ ZCND(:) = ZITW(:)*(ZDELTW(:)-( ZAWW(:)*ZITW(:)*ZDELTW(:) &
+ + ZAWI(:)*ZITI(:)*ZDELTI(:) )*ZFACT(:))
+ ZDEP(:) = ZITI(:)*(ZDELTI(:)-( ZAIW(:)*ZITW(:)*ZDELTW(:) &
+ + ZAII(:)*ZITI(:)*ZDELTI(:) )*ZFACT(:))
+!
+! Integration
+!
+ WHERE( ZCND(:) < 0.0 )
+ ZCND(:) = MAX ( ZCND(:), -ZRCS(:) )
+ ELSEWHERE
+ ZCND(:) = MIN ( ZCND(:), ZRVS(:) )
+ END WHERE
+ WHERE( ZRCS(:) < ZRTMIN(2) )
+ ZCND(:) = 0.0
+ END WHERE
+ ZRVS(:) = ZRVS(:) - ZCND(:)
+ ZRCS(:) = ZRCS(:) + ZCND(:)
+ ZTHS(:) = ZTHS(:) + ZCND(:) * ZLVFACT(:) / ZEXNREF(:)
+!
+ WHERE( ZDEP(:) < 0.0 )
+ ZDEP(:) = MAX ( ZDEP(:), -ZRIS(:) )
+ ELSEWHERE
+ ZDEP(:) = MIN ( ZDEP(:), ZRVS(:) )
+ END WHERE
+ WHERE( ZRIS(:) < ZRTMIN(4) )
+ ZDEP(:) = 0.0
+ END WHERE
+ ZRVS(:) = ZRVS(:) - ZDEP(:)
+ ZRIS(:) = ZRIS(:) + ZDEP(:)
+ ZTHS(:) = ZTHS(:) + ZDEP(:) * ZLSFACT(:) / ZEXNREF(:)
+!
+! Implicit ice crystal sublimation if ice saturated conditions are not met
+!
+ ZZT(:) = ( ZTHS(:) * ZDT ) * ( ZPRES(:) / XP00 ) ** (XRD/XCPD)
+ ZLVFACT(:) = (XLVTT+(XCPV-XCL)*(ZZT(:)-XTT))/ZZCPH(:) ! L_v/C_ph
+ ZLSFACT(:) = (XLSTT+(XCPV-XCI)*(ZZT(:)-XTT))/ZZCPH(:) ! L_s/C_ph
+ ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) ) ! es_i
+ ZRVSATI(:) = ZEPS*ZZW(:) / ( ZPRES(:)-ZZW(:) ) ! r_si
+ WHERE( ZRVS(:)*ZDT<ZRVSATI(:) )
+ ZZW(:) = ZRVS(:) + ZRIS(:)
+ ZRVS(:) = MIN( ZZW(:),ZRVSATI(:)/ZDT )
+ ZTHS(:) = ZTHS(:) + ( MAX( 0.0,ZZW(:)-ZRVS(:) )-ZRIS(:) ) &
+ * ZLSFACT(:) / ZEXNREF(:)
+ ZRIS(:) = MAX( 0.0,ZZW(:)-ZRVS(:) )
+ END WHERE
+!
+!
+!
+ ZW(:,:,:) = PRVS(:,:,:)
+ PRVS(:,:,:) = UNPACK( ZRVS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PRCS(:,:,:)
+ PRCS(:,:,:) = UNPACK( ZRCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PRIS(:,:,:)
+ PRIS(:,:,:) = UNPACK( ZRIS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PTHS(:,:,:)
+ PTHS(:,:,:) = UNPACK( ZTHS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+!
+ DEALLOCATE(ZRVT)
+ DEALLOCATE(ZRCT)
+ DEALLOCATE(ZRIT)
+ DEALLOCATE(ZCCT)
+ DEALLOCATE(ZCIT)
+ DEALLOCATE(ZRVS)
+ DEALLOCATE(ZRCS)
+ DEALLOCATE(ZRIS)
+ DEALLOCATE(ZCCS)
+ DEALLOCATE(ZCIS)
+ DEALLOCATE(ZTHS)
+ DEALLOCATE(ZRHODREF)
+ DEALLOCATE(ZZT)
+ DEALLOCATE(ZPRES)
+ DEALLOCATE(ZEXNREF)
+ DEALLOCATE(ZZCPH)
+ DEALLOCATE(ZZW)
+ DEALLOCATE(ZLVFACT)
+ DEALLOCATE(ZLSFACT)
+ DEALLOCATE(ZRVSATW)
+ DEALLOCATE(ZRVSATI)
+ DEALLOCATE(ZRVSATW_PRIME)
+ DEALLOCATE(ZRVSATI_PRIME)
+ DEALLOCATE(ZDELTW)
+ DEALLOCATE(ZDELTI)
+ DEALLOCATE(ZAW)
+ DEALLOCATE(ZAI)
+ DEALLOCATE(ZCJ)
+ DEALLOCATE(ZKA)
+ DEALLOCATE(ZDV)
+ DEALLOCATE(ZITW)
+ DEALLOCATE(ZITI)
+ DEALLOCATE(ZAWW)
+ DEALLOCATE(ZAIW)
+ DEALLOCATE(ZAWI)
+ DEALLOCATE(ZAII)
+ DEALLOCATE(ZFACT)
+ DEALLOCATE(ZDELT1)
+ DEALLOCATE(ZDELT2)
+ DEALLOCATE(ZCND)
+ DEALLOCATE(ZDEP)
+END IF ! IMICRO
+!
+END IF ! OSUBG_COND
+!
+! full sublimation of the cloud ice crystals if there are few
+!
+IF ( .NOT. OSUBG_COND ) THEN
+
+ZMASK(:,:,:) = 0.0
+ZW(:,:,:) = 0.
+WHERE (PRIS(:,:,:) <= ZRTMIN(4) .OR. PCIS(:,:,:) <= ZCTMIN(4))
+ PRVS(:,:,:) = PRVS(:,:,:) + PRIS(:,:,:)
+ PTHS(:,:,:) = PTHS(:,:,:) - PRIS(:,:,:)*ZLS(:,:,:)/(ZCPH(:,:,:)*ZEXNS(:,:,:))
+ PRIS(:,:,:) = 0.0
+ ZW(:,:,:) = MAX(PCIS(:,:,:),0.)
+ PCIS(:,:,:) = 0.0
+END WHERE
+!
+IF (LCOLD .AND. (NMOD_IFN .GE. 1 .OR. NMOD_IMM .GE. 1)) THEN
+ ZW1(:,:,:) = 0.
+ IF (NMOD_IFN .GE. 1) ZW1(:,:,:) = ZW1(:,:,:) + SUM(PINS,DIM=4)
+ IF (NMOD_IMM .GE. 1) ZW1(:,:,:) = ZW1(:,:,:) + SUM(PNIS,DIM=4)
+ ZW (:,:,:) = MIN( ZW(:,:,:), ZW1(:,:,:) )
+ ZW2(:,:,:) = 0.
+ WHERE ( ZW(:,:,:) > 0. )
+ ZMASK(:,:,:) = 1.0
+ ZW2(:,:,:) = ZW(:,:,:) / ZW1(:,:,:)
+ ENDWHERE
+END IF
+!
+IF (LCOLD .AND. NMOD_IFN.GE.1) THEN
+ DO JMOD_IFN = 1, NMOD_IFN
+ PIFS(:,:,:,JMOD_IFN) = PIFS(:,:,:,JMOD_IFN) + &
+ ZMASK(:,:,:) * PINS(:,:,:,JMOD_IFN) * ZW2(:,:,:)
+ PINS(:,:,:,JMOD_IFN) = PINS(:,:,:,JMOD_IFN) - &
+ ZMASK(:,:,:) * PINS(:,:,:,JMOD_IFN) * ZW2(:,:,:)
+ PINS(:,:,:,JMOD_IFN) = MAX( 0.0 , PINS(:,:,:,JMOD_IFN) )
+ ENDDO
+END IF
+!
+IF (LCOLD .AND. NMOD_IMM.GE.1) THEN
+ JMOD_IMM = 0
+ DO JMOD = 1, NMOD_CCN
+ IF (NIMM(JMOD) == 1) THEN
+ JMOD_IMM = JMOD_IMM + 1
+ PNAS(:,:,:,JMOD) = PNAS(:,:,:,JMOD) + &
+ ZMASK(:,:,:) * PNIS(:,:,:,JMOD_IMM) * ZW2(:,:,:)
+ PNIS(:,:,:,JMOD_IMM) = PNIS(:,:,:,JMOD_IMM) - &
+ ZMASK(:,:,:) * PNIS(:,:,:,JMOD_IMM) * ZW2(:,:,:)
+ PNIS(:,:,:,JMOD_IMM) = MAX( 0.0 , PNIS(:,:,:,JMOD_IMM) )
+ END IF
+ ENDDO
+END IF
+!
+! complete evaporation of the cloud droplets if there are few
+!
+ZMASK(:,:,:) = 0.0
+ZW(:,:,:) = 0.
+WHERE (PRCS(:,:,:) <= ZRTMIN(2) .OR. PCCS(:,:,:) <= ZCTMIN(2))
+ PRVS(:,:,:) = PRVS(:,:,:) + PRCS(:,:,:)
+ PTHS(:,:,:) = PTHS(:,:,:) - PRCS(:,:,:)*ZLV(:,:,:)/(ZCPH(:,:,:)*ZEXNS(:,:,:))
+ PRCS(:,:,:) = 0.0
+ ZW(:,:,:) = MAX(PCCS(:,:,:),0.)
+ PCCS(:,:,:) = 0.0
+END WHERE
+!
+ZW1(:,:,:) = 0.
+IF (LWARM .AND. NMOD_CCN.GE.1) ZW1(:,:,:) = SUM(PNAS,DIM=4)
+ZW (:,:,:) = MIN( ZW(:,:,:), ZW1(:,:,:) )
+ZW2(:,:,:) = 0.
+WHERE ( ZW(:,:,:) > 0. )
+ ZMASK(:,:,:) = 1.0
+ ZW2(:,:,:) = ZW(:,:,:) / ZW1(:,:,:)
+ENDWHERE
+!
+IF (LWARM .AND. NMOD_CCN.GE.1) THEN
+ DO JMOD = 1, NMOD_CCN
+ PNFS(:,:,:,JMOD) = PNFS(:,:,:,JMOD) + &
+ ZMASK(:,:,:) * PNAS(:,:,:,JMOD) * ZW2(:,:,:)
+ PNAS(:,:,:,JMOD) = PNAS(:,:,:,JMOD) - &
+ ZMASK(:,:,:) * PNAS(:,:,:,JMOD) * ZW2(:,:,:)
+ PNAS(:,:,:,JMOD) = MAX( 0.0 , PNAS(:,:,:,JMOD) )
+ ENDDO
+END IF
+!
+IF (LSCAV .AND. LAERO_MASS) PMAS(:,:,:) = PMAS(:,:,:) * (1-ZMASK(:,:,:))
+!
+! end of the iterative loop
+!
+END IF ! .NOT.OSUBG_COND
+
+END DO
+!
+!
+!* 5.2 compute the cloud fraction PCLDFR (binary !!!!!!!)
+!
+IF ( .NOT. OSUBG_COND ) THEN
+ WHERE (PRCS(:,:,:) + PRIS(:,:,:) + PRSS(:,:,:) > 1.E-12 / ZDT)
+ PCLDFR(:,:,:) = 1.
+ ELSEWHERE
+ PCLDFR(:,:,:) = 0.
+ ENDWHERE
+END IF
+!
+IF ( SIZE(PSRCS,3) /= 0 ) THEN
+ WHERE (PRCS(:,:,:) + PRIS(:,:,:) > 1.E-12 / ZDT)
+ PSRCS(:,:,:) = 1.
+ ELSEWHERE
+ PSRCS(:,:,:) = 0.
+ ENDWHERE
+END IF
+!
+IF ( tpfile%lopened ) THEN
+ TZFIELD%CMNHNAME = 'NEB'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'NEB'
+ TZFIELD%CUNITS = '1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_NEB'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZW)
+END IF
+!
+!
+!* 6. SAVE CHANGES IN PRS AND PSVS
+! ----------------------------
+!
+!
+! Prepare 3D water mixing ratios
+PRS(:,:,:,1) = PRVS(:,:,:)
+IF ( KRR .GE. 2 ) PRS(:,:,:,2) = PRCS(:,:,:)
+IF ( KRR .GE. 3 ) PRS(:,:,:,3) = PRRS(:,:,:)
+IF ( KRR .GE. 4 ) PRS(:,:,:,4) = PRIS(:,:,:)
+IF ( KRR .GE. 5 ) PRS(:,:,:,5) = PRSS(:,:,:)
+IF ( KRR .GE. 6 ) PRS(:,:,:,6) = PRGS(:,:,:)
+!
+! Prepare 3D number concentrations
+!
+IF ( LWARM ) PSVS(:,:,:,NSV_LIMA_NC) = PCCS(:,:,:)
+IF ( LCOLD ) PSVS(:,:,:,NSV_LIMA_NI) = PCIS(:,:,:)
+!
+IF ( LSCAV .AND. LAERO_MASS ) PSVS(:,:,:,NSV_LIMA_SCAVMASS) = PMAS(:,:,:)
+!
+IF ( LWARM .AND. NMOD_CCN .GE. 1 ) THEN
+ PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1) = PNFS(:,:,:,:)
+ PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1) = PNAS(:,:,:,:)
+END IF
+!
+IF ( LCOLD .AND. NMOD_IFN .GE. 1 ) THEN
+ PSVS(:,:,:,NSV_LIMA_IFN_FREE:NSV_LIMA_IFN_FREE+NMOD_IFN-1) = PIFS(:,:,:,:)
+ PSVS(:,:,:,NSV_LIMA_IFN_NUCL:NSV_LIMA_IFN_NUCL+NMOD_IFN-1) = PINS(:,:,:,:)
+END IF
+!
+IF ( LCOLD .AND. NMOD_IMM .GE. 1 ) THEN
+ PSVS(:,:,:,NSV_LIMA_IMM_NUCL:NSV_LIMA_IMM_NUCL+NMOD_IMM-1) = PNIS(:,:,:,:)
+END IF
+!
+! write SSI in LFI
+!
+IF ( tpfile%lopened ) THEN
+ ZT(:,:,:) = ( PTHS(:,:,:) * ZDT ) * ZEXNS(:,:,:)
+ ZW(:,:,:) = EXP( XALPI - XBETAI/ZT(:,:,:) - XGAMI*ALOG(ZT(:,:,:) ) )
+ ZW1(:,:,:)= 2.0*PPABST(:,:,:)-PPABSM(:,:,:)
+ ZW(:,:,:) = PRVT(:,:,:)*( ZW1(:,:,:)-ZW(:,:,:) ) / ( (XMV/XMD) * ZW(:,:,:) ) - 1.0
+
+ TZFIELD%CMNHNAME = 'SSI'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'SSI'
+ TZFIELD%CUNITS = ''
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_SSI'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZW)
+END IF
+!
+!
+!* 7. STORE THE BUDGET TERMS
+! ----------------------
+!
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'CEDS', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'CEDS', prvs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'CEDS', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'CEDS', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ if ( lwarm ) &
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'CEDS', pccs(:, :, :) * prhodj(:, :, :) )
+ if ( lcold ) &
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CEDS', pcis(:, :, :) * prhodj(:, :, :) )
+ if ( lscav .and. laero_mass ) &
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_scavmass), 'CEDS', pmas(:, :, :) * prhodj(:, :, :) )
+ if ( lwarm ) then
+ do jl = 1, nmod_ccn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
+ call Budget_store_end( tbudgets(idx), 'CEDS', pnfs(:, :, :, jl) * prhodj(:, :, :) )
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_acti - 1 + jl
+ call Budget_store_end( tbudgets(idx), 'CEDS', pnas(:, :, :, jl) * prhodj(:, :, :) )
+ end do
+ end if
+ if ( lcold ) then
+ do jl = 1, nmod_ifn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_free - 1 + jl
+ call Budget_store_end( tbudgets(idx), 'CEDS', pifs(:, :, :, jl) * prhodj(:, :, :) )
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl - 1 + jl
+ call Budget_store_end( tbudgets(idx), 'CEDS', pins(:, :, :, jl) * prhodj(:, :, :) )
+ end do
+ do jl = 1, nmod_imm
+ idx = NBUDGET_SV1 - 1 + nsv_lima_imm_nucl - 1 + jl
+ call Budget_store_end( tbudgets(idx), 'CEDS', pnis(:, :, :, jl) * prhodj(:, :, :) )
+ end do
+ end if
+ end if
+end if
+!++cb++
+DEALLOCATE(ZRTMIN)
+DEALLOCATE(ZCTMIN)
+IF (ALLOCATED(PNFS)) DEALLOCATE(PNFS)
+IF (ALLOCATED(PNAS)) DEALLOCATE(PNAS)
+IF (ALLOCATED(PIFS)) DEALLOCATE(PIFS)
+IF (ALLOCATED(PINS)) DEALLOCATE(PINS)
+IF (ALLOCATED(PNIS)) DEALLOCATE(PNIS)
+!--cb--
+!
+!------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_ADJUST
diff --git a/src/mesonh/micro/lima_adjust_split.f90 b/src/mesonh/micro/lima_adjust_split.f90
new file mode 100644
index 000000000..edaeec820
--- /dev/null
+++ b/src/mesonh/micro/lima_adjust_split.f90
@@ -0,0 +1,848 @@
+!MNH_LIC Copyright 2013-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! #############################
+ MODULE MODI_LIMA_ADJUST_SPLIT
+! #############################
+!
+INTERFACE
+!
+ SUBROUTINE LIMA_ADJUST_SPLIT(KRR, KMI, TPFILE, HCONDENS, HLAMBDA3, &
+ OSUBG_COND, OSIGMAS, PTSTEP, PSIGQSAT, &
+ PRHODREF, PRHODJ, PEXNREF, PPABSM, PSIGS, PMFCONV, &
+ PPABST, PZZ, PDTHRAD, PW_NU, &
+ PRT, PRS, PSVT, PSVS, &
+ PTHS, PSRCS, PCLDFR, PRC_MF, PCF_MF )
+!
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_NSV, only: NSV_LIMA_BEG
+!
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+INTEGER, INTENT(IN) :: KMI ! Model index
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+CHARACTER(len=80), INTENT(IN) :: HCONDENS
+CHARACTER(len=4), INTENT(IN) :: HLAMBDA3 ! formulation for lambda3 coeff
+LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid
+ ! Condensation
+LOGICAL, INTENT(IN) :: OSIGMAS ! Switch for Sigma_s:
+ ! use values computed in CONDENSATION
+ ! or that from turbulence scheme
+REAL, INTENT(IN) :: PTSTEP ! Time step
+REAL, INTENT(IN) :: PSIGQSAT ! coeff applied to qsat variance contribution
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Dry density of the
+ ! reference state
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Absolute Pressure at t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV !
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute Pressure at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ !
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD ! Radiative temperature tendency
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
+!
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! m.r. at t
+!
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! m.r. source
+!
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(IN) :: PSVT ! Concentrations at time t
+!
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(INOUT) :: PSVS ! Concentration sources
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux
+ ! s'rc'/2Sigma_s2 at time t+1
+ ! multiplied by Lambda_3
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR ! Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRC_MF! Convective Mass Flux liquid mixing ratio
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCF_MF! Convective Mass Flux Cloud fraction
+!
+END SUBROUTINE LIMA_ADJUST_SPLIT
+!
+END INTERFACE
+!
+END MODULE MODI_LIMA_ADJUST_SPLIT
+!
+! ###########################################################################
+ SUBROUTINE LIMA_ADJUST_SPLIT(KRR, KMI, TPFILE, HCONDENS, HLAMBDA3, &
+ OSUBG_COND, OSIGMAS, PTSTEP, PSIGQSAT, &
+ PRHODREF, PRHODJ, PEXNREF, PPABSM, PSIGS, PMFCONV, &
+ PPABST, PZZ, PDTHRAD, PW_NU, &
+ PRT, PRS, PSVT, PSVS, &
+ PTHS, PSRCS, PCLDFR, PRC_MF, PCF_MF )
+! ###########################################################################
+!
+!!**** *MIMA_ADJUST* - compute the fast microphysical sources
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the fast microphysical sources
+!! through an explict scheme and a saturation ajustement procedure.
+!!
+!!
+!!** METHOD
+!! ------
+!! Reisin et al., 1996 for the explicit scheme when ice is present
+!! Langlois, Tellus, 1973 for the implict adjustment for the cloud water
+!! (refer also to book 1 of the documentation).
+!!
+!! Computations are done separately for three cases :
+!! - ri>0 and rc=0
+!! - rc>0 and ri=0
+!! - ri>0 and rc>0
+!!
+!!
+!! EXTERNAL
+!! --------
+!! None
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST
+!! XP00 ! Reference pressure
+!! XMD,XMV ! Molar mass of dry air and molar mass of vapor
+!! XRD,XRV ! Gaz constant for dry air, gaz constant for vapor
+!! XCPD,XCPV ! Cpd (dry air), Cpv (vapor)
+!! XCL ! Cl (liquid)
+!! XTT ! Triple point temperature
+!! XLVTT ! Vaporization heat constant
+!! XALPW,XBETAW,XGAMW ! Constants for saturation vapor
+!! ! pressure function
+!! Module MODD_CONF
+!! CCONF
+!! Module MODD_BUDGET:
+!! NBUMOD
+!! CBUTYPE
+!! LBU_RTH
+!! LBU_RRV
+!! LBU_RRC
+!! Module MODD_LES : NCTR_LES,LTURB_LES,NMODNBR_LES
+!! XNA declaration (cloud fraction as global var)
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Book 1 and Book2 of documentation ( routine FAST_TERMS )
+!! Langlois, Tellus, 1973
+!!
+!! AUTHOR
+!! ------
+!! E. Richard * Laboratoire d'Aerologie*
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 06/2021 forked from lima_adjust.f90
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+use modd_budget, only: lbu_enable, nbumod, &
+ lbudget_th, lbudget_rv, lbudget_rc, lbudget_ri, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RI, NBUDGET_SV1, &
+ tbudgets
+USE MODD_CONF
+USE MODD_CST
+use modd_field, only: TFIELDDATA, TYPEREAL
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_NSV
+USE MODD_PARAMETERS
+USE MODD_PARAM_LIMA
+USE MODD_PARAM_LIMA_COLD
+USE MODD_PARAM_LIMA_MIXED
+USE MODD_PARAM_LIMA_WARM
+!
+use mode_budget, only: Budget_store_init, Budget_store_end
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+use mode_msg
+use mode_tools, only: Countjv
+!
+USE MODI_CONDENS
+USE MODI_CONDENSATION
+USE MODI_LIMA_FUNCTIONS
+USE MODI_LIMA_CCN_ACTIVATION
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+!
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+INTEGER, INTENT(IN) :: KMI ! Model index
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+CHARACTER(len=80), INTENT(IN) :: HCONDENS
+CHARACTER(len=4), INTENT(IN) :: HLAMBDA3 ! formulation for lambda3 coeff
+LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid
+ ! Condensation
+LOGICAL, INTENT(IN) :: OSIGMAS ! Switch for Sigma_s:
+ ! use values computed in CONDENSATION
+ ! or that from turbulence scheme
+REAL, INTENT(IN) :: PTSTEP ! Time step
+REAL, INTENT(IN) :: PSIGQSAT ! coeff applied to qsat variance contribution
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Dry density of the
+ ! reference state
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Absolute Pressure at t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV !
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute Pressure at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ !
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD ! Radiative temperature tendency
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
+!
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! m.r. at t
+!
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! m.r. source
+!
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(IN) :: PSVT ! Concentrations at time t
+!
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(INOUT) :: PSVS ! Concentration sources
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux
+ ! s'rc'/2Sigma_s2 at time t+1
+ ! multiplied by Lambda_3
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR ! Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRC_MF! Convective Mass Flux liquid mixing ratio
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCF_MF! Convective Mass Flux Cloud fraction
+!
+!
+!* 0.2 Declarations of local variables :
+!
+! 3D Microphysical variables
+REAL, DIMENSION(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3)) &
+ :: PTHT, &
+ PRVT, & ! Water vapor m.r. at t
+ PRCT, & ! Cloud water m.r. at t
+ PRRT, & ! Rain water m.r. at t
+ PRIT, & ! Cloud ice m.r. at t
+ PRST, & ! Aggregate m.r. at t
+ PRGT, & ! Graupel m.r. at t
+!
+ PRVS, & ! Water vapor m.r. source
+ PRCS, & ! Cloud water m.r. source
+ PRRS, & ! Rain water m.r. source
+ PRIS, & ! Cloud ice m.r. source
+ PRSS, & ! Aggregate m.r. source
+ PRGS, & ! Graupel m.r. source
+!
+ PCCT, & ! Cloud water conc. at t
+ PCIT, & ! Cloud ice conc. at t
+!
+ PCCS, & ! Cloud water C. source
+ PMAS, & ! Mass of scavenged AP
+ PCIS ! Ice crystal C. source
+!
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE &
+ :: PNFS, & ! Free CCN C. source
+ PNAS, & ! Activated CCN C. source
+ PNFT, & ! Free CCN C.
+ PNAT ! Activated CCN C.
+! PIFS, & ! Free IFN C. source
+! PINS, & ! Nucleated IFN C. source
+! PNIS ! Acti. IMM. nuclei C. source
+!
+!
+!
+REAL :: ZEPS ! Mv/Md
+REAL :: ZDT ! Time increment (2*Delta t or Delta t if cold start)
+REAL, DIMENSION(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3)) &
+ :: ZEXNS,& ! guess of the Exner function at t+1
+ ZT, ZT2, & ! guess of the temperature at t+1
+ ZCPH, & ! guess of the CPh for the mixing
+ ZW, &
+ ZW1, &
+ ZW2, &
+ ZLV, & ! guess of the Lv at t+1
+ ZLS, & ! guess of the Ls at t+1
+ ZMASK,&
+ ZRV, ZRV2, &
+ ZRC, ZRC2, &
+ ZRI, &
+ ZSIGS, &
+ ZW_MF
+LOGICAL, DIMENSION(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3)) &
+ :: GMICRO ! Test where to compute cond/dep proc.
+INTEGER :: IMICRO
+REAL, DIMENSION(:), ALLOCATABLE &
+ :: ZRVT, ZRCT, ZRIT, ZRVS, ZRCS, ZRIS, ZTHS, &
+ ZCCT, ZCIT, ZCCS, ZCIS, &
+ ZRHODREF, ZZT, ZPRES, ZEXNREF, ZZCPH, &
+ ZZW, ZLVFACT, ZLSFACT, &
+ ZRVSATW, ZRVSATI, ZRVSATW_PRIME, ZRVSATI_PRIME, &
+ ZAW, ZAI, ZCJ, ZKA, ZDV, ZITW, ZITI, ZAWW, ZAIW, &
+ ZAWI, ZAII, ZFACT, ZDELTW, &
+ ZDELTI, ZDELT1, ZDELT2, ZCND, ZDEP, ZS, ZVEC1, ZZW2
+!
+INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC1
+!
+INTEGER :: IRESP ! Return code of FM routines
+INTEGER :: IIU,IJU,IKU! dimensions of dummy arrays
+INTEGER :: IKB ! K index value of the first inner mass point
+INTEGER :: IKE ! K index value of the last inner mass point
+INTEGER :: IIB,IJB ! Horz index values of the first inner mass points
+INTEGER :: IIE,IJE ! Horz index values of the last inner mass points
+INTEGER :: JITER,ITERMAX ! iterative loop for first order adjustment
+INTEGER :: ILUOUT ! Logical unit of output listing
+!
+INTEGER :: ISIZE
+REAL, DIMENSION(:), ALLOCATABLE :: ZRTMIN
+REAL, DIMENSION(:), ALLOCATABLE :: ZCTMIN
+!
+integer :: idx
+INTEGER , DIMENSION(SIZE(GMICRO)) :: I1,I2,I3 ! Used to replace the COUNT
+INTEGER :: JL ! and PACK intrinsics
+INTEGER :: JMOD, JMOD_IFN, JMOD_IMM
+!
+INTEGER , DIMENSION(3) :: BV
+TYPE(TFIELDDATA) :: TZFIELD
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. PRELIMINARIES
+! -------------
+!
+ILUOUT = TLUOUT%NLU
+!
+IIU = SIZE(PEXNREF,1)
+IJU = SIZE(PEXNREF,2)
+IKU = SIZE(PEXNREF,3)
+IIB = 1 + JPHEXT
+IIE = SIZE(PRHODJ,1) - JPHEXT
+IJB = 1 + JPHEXT
+IJE = SIZE(PRHODJ,2) - JPHEXT
+IKB = 1 + JPVEXT
+IKE = SIZE(PRHODJ,3) - JPVEXT
+!
+ZEPS= XMV / XMD
+!
+IF (OSUBG_COND) THEN
+ ITERMAX=1
+ELSE
+ ITERMAX=1
+END IF
+!
+ZDT = PTSTEP
+!
+ISIZE = SIZE(XRTMIN)
+ALLOCATE(ZRTMIN(ISIZE))
+ZRTMIN(:) = XRTMIN(:) / ZDT
+ISIZE = SIZE(XCTMIN)
+ALLOCATE(ZCTMIN(ISIZE))
+ZCTMIN(:) = XCTMIN(:) / ZDT
+!
+! Prepare 3D water mixing ratios
+!
+PTHT = PTHS*PTSTEP
+!
+PRVT(:,:,:) = PRS(:,:,:,1)*PTSTEP
+PRVS(:,:,:) = PRS(:,:,:,1)
+!
+PRCT(:,:,:) = 0.
+PRCS(:,:,:) = 0.
+PRRT(:,:,:) = 0.
+PRRS(:,:,:) = 0.
+PRIT(:,:,:) = 0.
+PRIS(:,:,:) = 0.
+PRST(:,:,:) = 0.
+PRSS(:,:,:) = 0.
+PRGT(:,:,:) = 0.
+PRGS(:,:,:) = 0.
+!
+IF ( KRR .GE. 2 ) PRCT(:,:,:) = PRS(:,:,:,2)*PTSTEP
+IF ( KRR .GE. 2 ) PRCS(:,:,:) = PRS(:,:,:,2)
+IF ( KRR .GE. 3 ) PRRT(:,:,:) = PRT(:,:,:,3)
+IF ( KRR .GE. 3 ) PRRS(:,:,:) = PRS(:,:,:,3)
+IF ( KRR .GE. 4 ) PRIT(:,:,:) = PRT(:,:,:,4)
+IF ( KRR .GE. 4 ) PRIS(:,:,:) = PRS(:,:,:,4)
+IF ( KRR .GE. 5 ) PRST(:,:,:) = PRT(:,:,:,5)
+IF ( KRR .GE. 5 ) PRSS(:,:,:) = PRS(:,:,:,5)
+IF ( KRR .GE. 6 ) PRGT(:,:,:) = PRT(:,:,:,6)
+IF ( KRR .GE. 6 ) PRGS(:,:,:) = PRS(:,:,:,6)
+!
+! Prepare 3D number concentrations
+PCCT(:,:,:) = 0.
+PCIT(:,:,:) = 0.
+PCCS(:,:,:) = 0.
+! PCIS(:,:,:) = 0.
+!
+IF ( LWARM ) PCCT(:,:,:) = PSVS(:,:,:,NSV_LIMA_NC)*PTSTEP
+IF ( LCOLD ) PCIT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NI)
+!
+IF ( LWARM ) PCCS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NC)
+! IF ( LCOLD ) PCIS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NI)
+!
+IF ( LSCAV .AND. LAERO_MASS ) PMAS(:,:,:) = PSVS(:,:,:,NSV_LIMA_SCAVMASS)
+!
+IF ( LWARM .AND. NMOD_CCN.GE.1 ) THEN
+ ALLOCATE( PNFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_CCN) )
+ ALLOCATE( PNAS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_CCN) )
+ ALLOCATE( PNFT(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_CCN) )
+ ALLOCATE( PNAT(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_CCN) )
+ PNFS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1)
+ PNAS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1)
+ PNFT(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1)*PTSTEP
+ PNAT(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1)*PTSTEP
+END IF
+!
+! IF ( LCOLD .AND. NMOD_IFN .GE. 1 ) THEN
+! ALLOCATE( PIFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_IFN) )
+! ALLOCATE( PINS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_IFN) )
+! PIFS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IFN_FREE:NSV_LIMA_IFN_FREE+NMOD_IFN-1)
+! PINS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IFN_NUCL:NSV_LIMA_IFN_NUCL+NMOD_IFN-1)
+! END IF
+!
+! IF ( NMOD_IMM .GE. 1 ) THEN
+! ALLOCATE( PNIS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_IMM) )
+! PNIS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IMM_NUCL:NSV_LIMA_IMM_NUCL+NMOD_IMM-1)
+! END IF
+!
+!
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'CEDS', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'CEDS', prvs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'CEDS', prcs(:, :, :) * prhodj(:, :, :) )
+ !Remark: PRIS is not modified but source term kept for better coherence with lima_adjust and lima_notadjust
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'CEDS', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ if ( lwarm ) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'CEDS', pccs(:, :, :) * prhodj(:, :, :) )
+ if ( lscav .and. laero_mass ) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_scavmass), 'CEDS', pmas(:, :, :) * prhodj(:, :, :) )
+ if ( lwarm ) then
+ do jl = 1, nmod_ccn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
+ call Budget_store_init( tbudgets(idx), 'CEDS', pnfs(:, :, :, jl) * prhodj(:, :, :) )
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_acti - 1 + jl
+ call Budget_store_init( tbudgets(idx), 'CEDS', pnas(:, :, :, jl) * prhodj(:, :, :) )
+ end do
+ end if
+! if ( lcold ) then
+! call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CEDS', pcis(:, :, :) * prhodj(:, :, :) )
+! do jl = 1, nmod_ifn
+! idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_free - 1 + jl
+! call Budget_store_init( tbudgets(idx), 'CEDS', pifs(:, :, :, jl) * prhodj(:, :, :) )
+! idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl - 1 + jl
+! call Budget_store_init( tbudgets(idx), 'CEDS', pins(:, :, :, jl) * prhodj(:, :, :) )
+! end do
+! do jl = 1, nmod_imm
+! idx = NBUDGET_SV1 - 1 + nsv_lima_imm_nucl - 1 + jl
+! call Budget_store_init( tbudgets(idx), 'CEDS', pnis(:, :, :, jl) * prhodj(:, :, :) )
+! end do
+! end if
+ end if
+end if
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 2. COMPUTE QUANTITIES WITH THE GUESS OF THE FUTURE INSTANT
+! -------------------------------------------------------
+!
+!* 2.1 remove negative non-precipitating negative water
+! ------------------------------------------------
+!
+IF (ANY(PRVS(:,:,:)+PRCS(:,:,:)+PRIS(:,:,:) < 0.) .AND. NVERB>5) THEN
+ WRITE(ILUOUT,*) 'LIMA_ADJUST: negative values of total water (reset to zero)'
+ WRITE(ILUOUT,*) ' location of minimum PRVS+PRCS+PRIS:',MINLOC(PRVS+PRCS+PRIS)
+ WRITE(ILUOUT,*) ' value of minimum PRVS+PRCS+PRIS:',MINVAL(PRVS+PRCS+PRIS)
+END IF
+!
+WHERE ( PRVS(:,:,:)+PRCS(:,:,:)+PRIS(:,:,:) < 0.)
+ PRVS(:,:,:) = - PRCS(:,:,:) - PRIS(:,:,:)
+END WHERE
+!
+!* 2.2 estimate the Exner function at t+1
+!
+ZEXNS(:,:,:) = ( (2. * PPABST(:,:,:) - PPABSM(:,:,:)) / XP00 ) ** (XRD/XCPD)
+!
+! beginning of the iterative loop
+!
+DO JITER =1,ITERMAX
+!
+!* 2.3 compute the intermediate temperature at t+1, T*
+!
+ ZT(:,:,:) = ( PTHS(:,:,:) * ZDT ) * ZEXNS(:,:,:)
+ ZT2(:,:,:) = ZT(:,:,:)
+!
+!* 2.4 compute the specific heat for moist air (Cph) at t+1
+!
+ ZCPH(:,:,:) = XCPD + XCPV *ZDT* PRVS(:,:,:) &
+ + XCL *ZDT* ( PRCS(:,:,:) + PRRS(:,:,:) ) &
+ + XCI *ZDT* ( PRIS(:,:,:) + PRSS(:,:,:) + PRGS(:,:,:) )
+!
+!* 2.5 compute the latent heat of vaporization Lv(T*) at t+1
+! and of sublimation Ls(T*) at t+1
+!
+ ZLV(:,:,:) = XLVTT + ( XCPV - XCL ) * ( ZT(:,:,:) -XTT )
+ ZLS(:,:,:) = XLSTT + ( XCPV - XCI ) * ( ZT(:,:,:) -XTT )
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. FIRST ORDER SUBGRID CONDENSATION SCHEME
+! ---------------------------------------
+!
+ IF ( OSUBG_COND ) THEN
+ !
+ ZRV=PRVS*PTSTEP
+ ZRC=PRCS*PTSTEP
+ ZRV2=PRVT
+ ZRC2=PRCT
+ ZRI=0.
+ ZSIGS=PSIGS
+ CALL CONDENSATION(IIU, IJU, IKU, IIB, IIE, IJB, IJE, IKB, IKE, 1, 'S', &
+ HCONDENS, HLAMBDA3, &
+ PPABST, PZZ, PRHODREF, ZT, ZRV, ZRC, ZRI, PRSS*PTSTEP, PRGS*PTSTEP, &
+ ZSIGS, PMFCONV, PCLDFR, PSRCS, .FALSE., OSIGMAS, &
+ PSIGQSAT, PLV=ZLV, PLS=ZLS, PCPH=ZCPH )
+ PCLDFR(:,:,:) = MIN(PCLDFR(:,:,:) + PCF_MF(:,:,:) , 1.)
+ ZRV(:,:,:) = ZRV(:,:,:) - MAX(MIN(PRC_MF(:,:,:), ZRV(:,:,:)),0.)
+ ZRC(:,:,:) = ZRC(:,:,:) + MAX(MIN(PRC_MF(:,:,:), ZRV(:,:,:)),0.)
+ ZW_MF=0.
+ CALL LIMA_CCN_ACTIVATION (TPFILE, &
+ PRHODREF, PEXNREF, PPABST, ZT2, PDTHRAD, PW_NU+ZW_MF, &
+ PTHT, ZRV2, ZRC2, PCCT, PRRT, PNFT, PNAT, &
+ PCLDFR )
+!
+ ELSE
+!
+!-------------------------------------------------------------------------------
+!
+!
+!
+!* FULLY IMPLICIT CONDENSATION SCHEME
+! ---------------------------------
+!
+!* select cases where r_c>0
+!
+!
+ GMICRO(:,:,:) = .FALSE.
+ GMICRO(IIB:IIE,IJB:IJE,IKB:IKE) =( PRCS(IIB:IIE,IJB:IJE,IKB:IKE)>0. .AND. &
+ PCCS(IIB:IIE,IJB:IJE,IKB:IKE)>0. )
+ IMICRO = COUNTJV( GMICRO(:,:,:),I1(:),I2(:),I3(:))
+ IF( IMICRO >= 1 ) THEN
+ ALLOCATE(ZRVT(IMICRO))
+ ALLOCATE(ZRCT(IMICRO))
+!
+ ALLOCATE(ZRVS(IMICRO))
+ ALLOCATE(ZRCS(IMICRO))
+ ALLOCATE(ZCCS(IMICRO))
+ ALLOCATE(ZTHS(IMICRO))
+!
+ ALLOCATE(ZRHODREF(IMICRO))
+ ALLOCATE(ZZT(IMICRO))
+ ALLOCATE(ZPRES(IMICRO))
+ ALLOCATE(ZEXNREF(IMICRO))
+ ALLOCATE(ZZCPH(IMICRO))
+ DO JL=1,IMICRO
+ ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL))
+ ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
+ !
+ ZRVS(JL) = PRVS(I1(JL),I2(JL),I3(JL))
+ ZRCS(JL) = PRCS(I1(JL),I2(JL),I3(JL))
+ ZCCS(JL) = PCCS(I1(JL),I2(JL),I3(JL))
+ ZTHS(JL) = PTHS(I1(JL),I2(JL),I3(JL))
+ !
+ ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
+ ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
+ ZPRES(JL) = 2.0*PPABST(I1(JL),I2(JL),I3(JL))-PPABSM(I1(JL),I2(JL),I3(JL))
+ ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL))
+ ZZCPH(JL) = ZCPH(I1(JL),I2(JL),I3(JL))
+ ENDDO
+ ALLOCATE(ZZW(IMICRO))
+ ALLOCATE(ZLVFACT(IMICRO))
+ ALLOCATE(ZRVSATW(IMICRO))
+ ALLOCATE(ZCND(IMICRO))
+ ZLVFACT(:) = (XLVTT+(XCPV-XCL)*(ZZT(:)-XTT))/ZZCPH(:) ! L_v/C_ph
+ ZZW(:) = EXP( XALPW - XBETAW/ZZT(:) - XGAMW*ALOG(ZZT(:) ) ) ! es_w
+ ZRVSATW(:) = ZEPS*ZZW(:) / ( ZPRES(:)-ZZW(:) ) ! r_sw
+
+ IF (LADJ) THEN
+ ALLOCATE(ZRVSATW_PRIME(IMICRO))
+ ALLOCATE(ZAWW(IMICRO))
+ ALLOCATE(ZDELT1(IMICRO))
+ ALLOCATE(ZDELT2(IMICRO))
+ ZRVSATW_PRIME(:) = (( XBETAW/ZZT(:) - XGAMW ) / ZZT(:)) & ! r'_sw
+ * ZRVSATW(:) * ( 1. + ZRVSATW(:)/ZEPS )
+ ZAWW(:) = 1.0 + ZRVSATW_PRIME(:)*ZLVFACT(:)
+ ZDELT2(:) = (ZRVSATW_PRIME(:)*ZLVFACT(:)/ZAWW(:)) * &
+ ( ((-2.*XBETAW+XGAMW*ZZT(:))/(XBETAW-XGAMW*ZZT(:)) &
+ + (XBETAW/ZZT(:)-XGAMW)*(1.0+2.0*ZRVSATW(:)/ZEPS))/ZZT(:) )
+ ZDELT1(:) = (ZLVFACT(:)/ZAWW(:)) * ( ZRVSATW(:) - ZRVS(:)*ZDT )
+ ZCND(:) = - ZDELT1(:)*( 1.0 + 0.5*ZDELT1(:)*ZDELT2(:) ) / (ZLVFACT(:)*ZDT)
+ DEALLOCATE(ZRVSATW_PRIME)
+ DEALLOCATE(ZAWW)
+ DEALLOCATE(ZDELT1)
+ DEALLOCATE(ZDELT2)
+ ELSE
+ ALLOCATE(ZS(IMICRO))
+ ALLOCATE(ZZW2(IMICRO))
+ ALLOCATE(ZVEC1(IMICRO))
+ ALLOCATE(IVEC1(IMICRO))
+ ZVEC1(:) = MAX( 1.0001, MIN( FLOAT(NAHEN)-0.0001, XAHENINTP1 * ZZT(:) + XAHENINTP2 ) )
+ IVEC1(:) = INT( ZVEC1(:) )
+ ZVEC1(:) = ZVEC1(:) - FLOAT( IVEC1(:) )
+ ZS(:) = ZRVS(:)*PTSTEP / ZRVSATW(:) - 1.
+ ZZW(:) = ZCCS(:)*PTSTEP/(XLBC*ZCCS(:)/ZRCS(:))**XLBEXC
+ ZZW2(:) = XAHENG3(IVEC1(:)+1)*ZVEC1(:)-XAHENG3(IVEC1(:))*(ZVEC1(:)-1.)
+ ZCND(:) = 2.*3.14*1000.*ZZW2(:)*ZS(:)*ZZW(:)
+ DEALLOCATE(ZS)
+ DEALLOCATE(ZZW2)
+ DEALLOCATE(ZVEC1)
+ DEALLOCATE(IVEC1)
+ END IF
+!
+!
+! Integration
+!
+ WHERE( ZCND(:) < 0.0 )
+ ZCND(:) = MAX ( ZCND(:), -ZRCS(:) )
+ ELSEWHERE
+ ZCND(:) = MIN ( ZCND(:), ZRVS(:) )
+ END WHERE
+ ZRVS(:) = ZRVS(:) - ZCND(:)
+ ZRCS(:) = ZRCS(:) + ZCND(:)
+ ZTHS(:) = ZTHS(:) + ZCND(:) * ZLVFACT(:) / ZEXNREF(:)
+!
+ ZW(:,:,:) = PRVS(:,:,:)
+ PRVS(:,:,:) = UNPACK( ZRVS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PRCS(:,:,:)
+ PRCS(:,:,:) = UNPACK( ZRCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PTHS(:,:,:)
+ PTHS(:,:,:) = UNPACK( ZTHS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+!
+ DEALLOCATE(ZRVT)
+ DEALLOCATE(ZRCT)
+ DEALLOCATE(ZRVS)
+ DEALLOCATE(ZRCS)
+ DEALLOCATE(ZTHS)
+ DEALLOCATE(ZRHODREF)
+ DEALLOCATE(ZZT)
+ DEALLOCATE(ZPRES)
+ DEALLOCATE(ZEXNREF)
+ DEALLOCATE(ZZCPH)
+ DEALLOCATE(ZZW)
+ DEALLOCATE(ZLVFACT)
+ DEALLOCATE(ZRVSATW)
+ DEALLOCATE(ZCND)
+ END IF ! IMICRO
+!
+ END IF ! end of adjustment procedure (test on OSUBG_COND)
+!
+! Remove cloud droplets if there are few
+
+ ZMASK(:,:,:) = 0.0
+ ZW(:,:,:) = 0.
+ WHERE (PRCS(:,:,:) <= ZRTMIN(2) .OR. PCCS(:,:,:) <= ZCTMIN(2))
+ PRVS(:,:,:) = PRVS(:,:,:) + PRCS(:,:,:)
+ PTHS(:,:,:) = PTHS(:,:,:) - PRCS(:,:,:)*ZLV(:,:,:)/(ZCPH(:,:,:)*ZEXNS(:,:,:))
+ PRCS(:,:,:) = 0.0
+ ZW(:,:,:) = MAX(PCCS(:,:,:),0.)
+ PCCS(:,:,:) = 0.0
+ END WHERE
+!
+ ZW1(:,:,:) = 0.
+ IF (LWARM .AND. NMOD_CCN.GE.1) ZW1(:,:,:) = SUM(PNAS,DIM=4)
+ ZW (:,:,:) = MIN( ZW(:,:,:), ZW1(:,:,:) )
+ ZW2(:,:,:) = 0.
+ WHERE ( ZW(:,:,:) > 0. )
+ ZMASK(:,:,:) = 1.0
+ ZW2(:,:,:) = ZW(:,:,:) / ZW1(:,:,:)
+ ENDWHERE
+!
+ IF (LWARM .AND. NMOD_CCN.GE.1) THEN
+ DO JMOD = 1, NMOD_CCN
+ PNFS(:,:,:,JMOD) = PNFS(:,:,:,JMOD) + &
+ ZMASK(:,:,:) * PNAS(:,:,:,JMOD) * ZW2(:,:,:)
+ PNAS(:,:,:,JMOD) = PNAS(:,:,:,JMOD) - &
+ ZMASK(:,:,:) * PNAS(:,:,:,JMOD) * ZW2(:,:,:)
+ PNAS(:,:,:,JMOD) = MAX( 0.0 , PNAS(:,:,:,JMOD) )
+ ENDDO
+ END IF
+!
+ IF (LSCAV .AND. LAERO_MASS) PMAS(:,:,:) = PMAS(:,:,:) * (1-ZMASK(:,:,:))
+!
+!
+END DO ! end of the iterative loop
+!
+!
+!* 5.2 compute the cloud fraction PCLDFR (binary !!!!!!!)
+!
+IF ( .NOT. OSUBG_COND ) THEN
+ WHERE (PRCS(:,:,:) + PRIS(:,:,:) + PRSS(:,:,:) > 1.E-12 / ZDT)
+ PCLDFR(:,:,:) = 1.
+ ELSEWHERE
+ PCLDFR(:,:,:) = 0.
+ ENDWHERE
+END IF
+!
+IF ( SIZE(PSRCS,3) /= 0 ) THEN
+ WHERE (PRCS(:,:,:) + PRIS(:,:,:) > 1.E-12 / ZDT)
+ PSRCS(:,:,:) = 1.
+ ELSEWHERE
+ PSRCS(:,:,:) = 0.
+ ENDWHERE
+END IF
+!
+IF ( OSUBG_COND ) THEN
+ !
+ ! Mixing ratio change (cloud liquid water)
+ !
+ ZW1(:,:,:) = (ZRC(:,:,:) - PRCS(:,:,:)*PTSTEP) / PTSTEP
+ WHERE( ZW1(:,:,:) < 0.0 )
+ ZW1(:,:,:) = MAX ( ZW1(:,:,:), -PRCS(:,:,:) )
+ ELSEWHERE
+ ZW1(:,:,:) = MIN ( ZW1(:,:,:), PRVS(:,:,:) )
+ END WHERE
+
+ WHERE (PCCT(:,:,:) < PCLDFR(:,:,:)*XCTMIN(2) .OR. ZRC(:,:,:)<PCLDFR(:,:,:)*XRTMIN(2))
+ ZW1=-PRCS
+ PCCS=0.
+ PCLDFR=0.
+ END WHERE
+
+ PRVS(:,:,:) = PRVS(:,:,:) - ZW1(:,:,:)
+ PRCS(:,:,:) = PRCS(:,:,:) + ZW1(:,:,:)
+ PCCS(:,:,:) = PCCT(:,:,:) / PTSTEP
+ PNFS(:,:,:,:) = PNFT(:,:,:,:) / PTSTEP
+ PNAS(:,:,:,:) = PNAT(:,:,:,:) / PTSTEP
+ PTHS(:,:,:) = PTHS(:,:,:) + &
+ ZW1(:,:,:) * ZLV(:,:,:) / (ZCPH(:,:,:) * PEXNREF(:,:,:))
+END IF ! fin test OSUBG_COND
+
+IF ( tpfile%lopened ) THEN
+ TZFIELD%CMNHNAME = 'NEB'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'NEB'
+ TZFIELD%CUNITS = '1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_NEB'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,PCLDFR)
+END IF
+!
+!
+!* 6. SAVE CHANGES IN PRS AND PSVS
+! ----------------------------
+!
+!
+! Prepare 3D water mixing ratios
+PRS(:,:,:,1) = PRVS(:,:,:)
+IF ( KRR .GE. 2 ) PRS(:,:,:,2) = PRCS(:,:,:)
+IF ( KRR .GE. 3 ) PRS(:,:,:,3) = PRRS(:,:,:)
+IF ( KRR .GE. 4 ) PRS(:,:,:,4) = PRIS(:,:,:)
+IF ( KRR .GE. 5 ) PRS(:,:,:,5) = PRSS(:,:,:)
+IF ( KRR .GE. 6 ) PRS(:,:,:,6) = PRGS(:,:,:)
+!
+! Prepare 3D number concentrations
+!
+IF ( LWARM ) PSVS(:,:,:,NSV_LIMA_NC) = PCCS(:,:,:)
+! IF ( LCOLD ) PSVS(:,:,:,NSV_LIMA_NI) = PCIS(:,:,:)
+!
+IF ( LSCAV .AND. LAERO_MASS ) PSVS(:,:,:,NSV_LIMA_SCAVMASS) = PMAS(:,:,:)
+!
+IF ( LWARM .AND. NMOD_CCN .GE. 1 ) THEN
+ PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1) = PNFS(:,:,:,:)
+ PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1) = PNAS(:,:,:,:)
+END IF
+!
+! IF ( LCOLD .AND. NMOD_IFN .GE. 1 ) THEN
+! PSVS(:,:,:,NSV_LIMA_IFN_FREE:NSV_LIMA_IFN_FREE+NMOD_IFN-1) = PIFS(:,:,:,:)
+! PSVS(:,:,:,NSV_LIMA_IFN_NUCL:NSV_LIMA_IFN_NUCL+NMOD_IFN-1) = PINS(:,:,:,:)
+! END IF
+!
+! IF ( LCOLD .AND. NMOD_IMM .GE. 1 ) THEN
+! PSVS(:,:,:,NSV_LIMA_IMM_NUCL:NSV_LIMA_IMM_NUCL+NMOD_IMM-1) = PNIS(:,:,:,:)
+! END IF
+!
+! write SSI in LFI
+!
+IF ( tpfile%lopened ) THEN
+ ZT(:,:,:) = ( PTHS(:,:,:) * ZDT ) * ZEXNS(:,:,:)
+ ZW(:,:,:) = EXP( XALPI - XBETAI/ZT(:,:,:) - XGAMI*ALOG(ZT(:,:,:) ) )
+ ZW1(:,:,:)= 2.0*PPABST(:,:,:)-PPABSM(:,:,:)
+ ZW(:,:,:) = PRVT(:,:,:)*( ZW1(:,:,:)-ZW(:,:,:) ) / ( (XMV/XMD) * ZW(:,:,:) ) - 1.0
+
+ TZFIELD%CMNHNAME = 'SSI'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'SSI'
+ TZFIELD%CUNITS = ''
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_SSI'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZW)
+END IF
+!
+!
+!* 7. STORE THE BUDGET TERMS
+! ----------------------
+!
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'CEDS', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'CEDS', prvs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'CEDS', prcs(:, :, :) * prhodj(:, :, :) )
+ !Remark: PRIS is not modified but source term kept for better coherence with lima_adjust and lima_notadjust
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'CEDS', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ if ( lwarm ) &
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'CEDS', pccs(:, :, :) * prhodj(:, :, :) )
+ if ( lscav .and. laero_mass ) &
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_scavmass), 'CEDS', pmas(:, :, :) * prhodj(:, :, :) )
+ if ( lwarm ) then
+ do jl = 1, nmod_ccn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
+ call Budget_store_end( tbudgets(idx), 'CEDS', pnfs(:, :, :, jl) * prhodj(:, :, :) )
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_acti - 1 + jl
+ call Budget_store_end( tbudgets(idx), 'CEDS', pnas(:, :, :, jl) * prhodj(:, :, :) )
+ end do
+ end if
+! if ( lcold ) then
+! call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CEDS', pcis(:, :, :) * prhodj(:, :, :) )
+! do jl = 1, nmod_ifn
+! idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_free - 1 + jl
+! call Budget_store_end( tbudgets(idx), 'CEDS', pifs(:, :, :, jl) * prhodj(:, :, :) )
+! idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl - 1 + jl
+! call Budget_store_end( tbudgets(idx), 'CEDS', pins(:, :, :, jl) * prhodj(:, :, :) )
+! end do
+! do jl = 1, nmod_imm
+! idx = NBUDGET_SV1 - 1 + nsv_lima_imm_nucl - 1 + jl
+! call Budget_store_init( tbudgets(idx), 'CEDS', pnis(:, :, :, jl) * prhodj(:, :, :) )
+! end do
+! end if
+ end if
+end if
+!++cb++
+DEALLOCATE(ZRTMIN)
+DEALLOCATE(ZCTMIN)
+IF (ALLOCATED(PNFS)) DEALLOCATE(PNFS)
+IF (ALLOCATED(PNAS)) DEALLOCATE(PNAS)
+IF (ALLOCATED(PNFT)) DEALLOCATE(PNFT)
+IF (ALLOCATED(PNAT)) DEALLOCATE(PNAT)
+! IF (ALLOCATED(PIFS)) DEALLOCATE(PIFS)
+! IF (ALLOCATED(PINS)) DEALLOCATE(PINS)
+! IF (ALLOCATED(PNIS)) DEALLOCATE(PNIS)
+!--cb--
+!
+!------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_ADJUST_SPLIT
diff --git a/src/mesonh/micro/lima_bergeron.f90 b/src/mesonh/micro/lima_bergeron.f90
new file mode 100644
index 000000000..9105c78d6
--- /dev/null
+++ b/src/mesonh/micro/lima_bergeron.f90
@@ -0,0 +1,121 @@
+!MNH_LIC Copyright 2013-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+! #################################
+ MODULE MODI_LIMA_BERGERON
+! #################################
+!
+INTERFACE
+ SUBROUTINE LIMA_BERGERON (LDCOMPUTE, &
+ PRCT, PRIT, PCIT, PLBDI, &
+ PSSIW, PAI, PCJ, PLVFACT, PLSFACT, &
+ P_TH_BERFI, P_RC_BERFI, &
+ PA_TH, PA_RC, PA_RI )
+!
+LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water C. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRIT ! Cloud water C. at t
+REAL, DIMENSION(:), INTENT(IN) :: PCIT ! Cloud water C. at t
+REAL, DIMENSION(:), INTENT(IN) :: PLBDI !
+!
+REAL, DIMENSION(:), INTENT(IN) :: PSSIW !
+REAL, DIMENSION(:), INTENT(IN) :: PAI !
+REAL, DIMENSION(:), INTENT(IN) :: PCJ !
+REAL, DIMENSION(:), INTENT(IN) :: PLVFACT !
+REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_BERFI
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_BERFI
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_TH
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_RC
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_RI
+!!
+END SUBROUTINE LIMA_BERGERON
+END INTERFACE
+END MODULE MODI_LIMA_BERGERON
+!
+! #############################################################
+ SUBROUTINE LIMA_BERGERON( LDCOMPUTE, &
+ PRCT, PRIT, PCIT, PLBDI, &
+ PSSIW, PAI, PCJ, PLVFACT, PLSFACT, &
+ P_TH_BERFI, P_RC_BERFI, &
+ PA_TH, PA_RC, PA_RI )
+! #############################################################
+!
+!! PURPOSE
+!! -------
+!! Compute the Bergeron-Findeisen process rate
+!!
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * CNRM *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 15/03/2018
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN
+USE MODD_PARAM_LIMA_COLD, ONLY : XDI, X0DEPI, X2DEPI
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRCT !
+REAL, DIMENSION(:), INTENT(IN) :: PRIT !
+REAL, DIMENSION(:), INTENT(IN) :: PCIT !
+REAL, DIMENSION(:), INTENT(IN) :: PLBDI !
+!
+REAL, DIMENSION(:), INTENT(IN) :: PSSIW !
+REAL, DIMENSION(:), INTENT(IN) :: PAI !
+REAL, DIMENSION(:), INTENT(IN) :: PCJ !
+REAL, DIMENSION(:), INTENT(IN) :: PLVFACT !
+REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_BERFI
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_BERFI
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_TH
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_RC
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_RI
+!
+!* 0.2 Declarations of local variables :
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 1. Bergeron-Findeisen process
+! --------------------------
+!
+P_TH_BERFI(:) = 0.0
+P_RC_BERFI(:) = 0.0
+!
+WHERE( (PRCT(:)>XRTMIN(2)) .AND. (PRIT(:)>XRTMIN(4)) .AND. (PCIT(:)>XCTMIN(4)) .AND. LDCOMPUTE(:))
+ P_RC_BERFI(:) = - ( PSSIW(:) / PAI(:) ) * PCIT(:) * &
+ ( X0DEPI/PLBDI(:)+X2DEPI*PCJ(:)*PCJ(:)/PLBDI(:)**(XDI+2.0) )
+ P_TH_BERFI(:) = - P_RC_BERFI(:)*(PLSFACT(:)-PLVFACT(:))
+END WHERE
+!
+PA_RC(:) = PA_RC(:) + P_RC_BERFI(:)
+PA_RI(:) = PA_RI(:) - P_RC_BERFI(:)
+PA_TH(:) = PA_TH(:) + P_TH_BERFI(:)
+!
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_BERGERON
diff --git a/src/mesonh/micro/lima_ccn_activation.f90 b/src/mesonh/micro/lima_ccn_activation.f90
new file mode 100644
index 000000000..b7786ea4f
--- /dev/null
+++ b/src/mesonh/micro/lima_ccn_activation.f90
@@ -0,0 +1,835 @@
+!MNH_LIC Copyright 2013-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ###############################
+ MODULE MODI_LIMA_CCN_ACTIVATION
+! ###############################
+!
+INTERFACE
+ SUBROUTINE LIMA_CCN_ACTIVATION (TPFILE, &
+ PRHODREF, PEXNREF, PPABST, PT, PDTHRAD, PW_NU, &
+ PTHT, PRVT, PRCT, PCCT, PRRT, PNFT, PNAT, &
+ PCLDFR )
+USE MODD_IO, ONLY: TFILEDATA
+!
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PT ! Temperature
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD ! Radiative temperature tendency
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
+ ! the nucleation param.
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHT ! Theta at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNFT ! CCN C. available at t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNAT ! CCN C. activated at t
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! Precipitation fraction
+!
+END SUBROUTINE LIMA_CCN_ACTIVATION
+END INTERFACE
+END MODULE MODI_LIMA_CCN_ACTIVATION
+! #############################################################################
+ SUBROUTINE LIMA_CCN_ACTIVATION (TPFILE, &
+ PRHODREF, PEXNREF, PPABST, PT, PDTHRAD, PW_NU, &
+ PTHT, PRVT, PRCT, PCCT, PRRT, PNFT, PNAT, &
+ PCLDFR )
+! #############################################################################
+!
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the activation of CCN
+!! according to Cohard and Pinty, QJRMS, 2000
+!!
+!!
+!!** METHOD
+!! ------
+!! The activation of CCN is checked for quasi-saturated air parcels
+!! to update the cloud droplet number concentration.
+!!
+!! Computation steps :
+!! 1- Check where computations are necessary
+!! 2- and 3- Compute the maximum of supersaturation using the iterative
+!! Ridder algorithm
+!! 4- Compute the nucleation source
+!! 5- Deallocate local variables
+!!
+!! Contains :
+!! 6- Functions : Ridder algorithm
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Cohard, J.-M. and J.-P. Pinty, 2000: A comprehensive two-moment warm
+!! microphysical bulk scheme.
+!! Part I: Description and tests
+!! Part II: 2D experiments with a non-hydrostatic model
+!! Accepted for publication in Quart. J. Roy. Meteor. Soc.
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+! B. Vie 03/03/2020: use DTHRAD instead of dT/dt in Smax diagnostic computation
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY: XALPW, XBETAW, XCL, XCPD, XCPV, XGAMW, XLVTT, XMD, XMNH_EPSILON, XMV, XRV, XTT
+use modd_field, only: TFIELDDATA, TYPEREAL
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
+USE MODD_PARAM_LIMA, ONLY: LACTIT, NMOD_CCN, XCTMIN, XKHEN_MULTI, XRTMIN, XLIMIT_FACTOR
+USE MODD_PARAM_LIMA_WARM, ONLY: XWMIN, NAHEN, NHYP, XAHENINTP1, XAHENINTP2, XCSTDCRIT, XHYPF12, &
+ XHYPINTP1, XHYPINTP2, XTMIN, XHYPF32, XPSI3, XAHENG, XAHENG2, XPSI1, &
+ XLBC, XLBEXC
+USE MODD_TURB_n, ONLY: LSUBG_COND
+
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+use mode_tools, only: Countjv
+
+USE MODI_GAMMA
+
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PT ! Temperature
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD ! Radiative temperature tendency
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
+ ! the nucleation param.
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHT ! Theta at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNFT ! CCN C. available at t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNAT ! CCN C. activated at t
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! Precipitation fraction
+!
+!* 0.1 Declarations of local variables :
+!
+! Packing variables
+LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: GNUCT
+INTEGER :: INUCT
+INTEGER , DIMENSION(SIZE(GNUCT)) :: I1,I2,I3 ! Used to replace the COUNT
+INTEGER :: JL ! and PACK intrinsics
+!
+! Packed micophysical variables
+REAL, DIMENSION(:) , ALLOCATABLE :: ZRCT ! cloud mr
+REAL, DIMENSION(:) , ALLOCATABLE :: ZCCT ! cloud conc.
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFT ! available nucleus conc.
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZNAT ! activated nucleus conc.
+!
+! Other packed variables
+REAL, DIMENSION(:) , ALLOCATABLE :: ZRHODREF ! RHO Dry REFerence
+REAL, DIMENSION(:) , ALLOCATABLE :: ZEXNREF ! EXNer Pressure REFerence
+REAL, DIMENSION(:) , ALLOCATABLE :: ZZT ! Temperature
+!
+! Work arrays
+REAL, DIMENSION(:), ALLOCATABLE :: ZZW1, ZZW2, ZZW3, ZZW4, ZZW5, ZZW6, &
+ ZZTDT, & ! dT/dt
+ ZSW, & ! real supersaturation
+ ZSMAX, & ! Maximum supersaturation
+ ZVEC1
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZTMP, ZCHEN_MULTI
+!
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: ZTDT, ZDRC, ZRVSAT, ZW, ZW2
+REAL, DIMENSION(SIZE(PNFT,1),SIZE(PNFT,2),SIZE(PNFT,3)) &
+ :: ZCONC_TOT ! total CCN C. available
+!
+INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC1 ! Vectors of indices for
+ ! interpolations
+!
+!
+REAL :: ZEPS ! molar mass ratio
+REAL :: ZS1, ZS2, ZXACC
+INTEGER :: JMOD
+INTEGER :: IIB, IIE, IJB, IJE, IKB, IKE ! Physical domain
+!
+INTEGER :: ILUOUT ! Logical unit of output listing
+TYPE(TFIELDDATA) :: TZFIELD
+!-------------------------------------------------------------------------------
+!
+ILUOUT = TLUOUT%NLU
+!
+!* 1. PREPARE COMPUTATIONS - PACK
+! ---------------------------
+!
+IIB=1+JPHEXT
+IIE=SIZE(PRHODREF,1) - JPHEXT
+IJB=1+JPHEXT
+IJE=SIZE(PRHODREF,2) - JPHEXT
+IKB=1+JPVEXT
+IKE=SIZE(PRHODREF,3) - JPVEXT
+!
+! Saturation vapor mixing ratio and radiative tendency
+!
+ZEPS= XMV / XMD
+ZRVSAT(:,:,:) = ZEPS / (PPABST(:,:,:)*EXP(-XALPW+XBETAW/PT(:,:,:)+XGAMW*ALOG(PT(:,:,:))) - 1.0)
+ZTDT(:,:,:) = 0.
+IF (LACTIT .AND. SIZE(PDTHRAD).GT.0) ZTDT(:,:,:) = PDTHRAD(:,:,:) * PEXNREF(:,:,:)
+!
+! find locations where CCN are available
+!
+ZCONC_TOT(:,:,:) = 0.0
+DO JMOD = 1, NMOD_CCN
+ ZCONC_TOT(:,:,:) = ZCONC_TOT(:,:,:) + PNFT(:,:,:,JMOD) ! sum over the free CCN
+ENDDO
+!
+! optimization by looking for locations where
+! the updraft velocity is positive!!!
+!
+GNUCT(:,:,:) = .FALSE.
+!
+GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) = PW_NU(IIB:IIE,IJB:IJE,IKB:IKE)>XWMIN &
+ .OR. PRVT(IIB:IIE,IJB:IJE,IKB:IKE)>ZRVSAT(IIB:IIE,IJB:IJE,IKB:IKE)
+IF (LACTIT) GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) = GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) &
+ .OR. ZTDT(IIB:IIE,IJB:IJE,IKB:IKE)<XTMIN
+!
+GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) = GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) &
+ .AND. PT(IIB:IIE,IJB:IJE,IKB:IKE)>(XTT-22.) &
+ .AND. ZCONC_TOT(IIB:IIE,IJB:IJE,IKB:IKE)>XCTMIN(2)
+!
+IF (LSUBG_COND) GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) = GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) &
+ .AND. PCLDFR(IIB:IIE,IJB:IJE,IKB:IKE)>0.01
+IF (.NOT. LSUBG_COND) GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) = GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) &
+ .AND. PRVT(IIB:IIE,IJB:IJE,IKB:IKE).GE.ZRVSAT(IIB:IIE,IJB:IJE,IKB:IKE)
+!
+
+
+INUCT = COUNTJV( GNUCT(:,:,:),I1(:),I2(:),I3(:))
+!
+IF( INUCT >= 1 ) THEN
+!
+ ALLOCATE(ZNFT(INUCT,NMOD_CCN))
+ ALLOCATE(ZNAT(INUCT,NMOD_CCN))
+ ALLOCATE(ZTMP(INUCT,NMOD_CCN))
+ ALLOCATE(ZRCT(INUCT))
+ ALLOCATE(ZCCT(INUCT))
+ ALLOCATE(ZZT(INUCT))
+ ALLOCATE(ZZTDT(INUCT))
+ ALLOCATE(ZSW(INUCT))
+ ALLOCATE(ZZW1(INUCT))
+ ALLOCATE(ZZW2(INUCT))
+ ALLOCATE(ZZW3(INUCT))
+ ALLOCATE(ZZW4(INUCT))
+ ALLOCATE(ZZW5(INUCT))
+ ALLOCATE(ZZW6(INUCT))
+ ALLOCATE(ZCHEN_MULTI(INUCT,NMOD_CCN))
+ ALLOCATE(ZVEC1(INUCT))
+ ALLOCATE(IVEC1(INUCT))
+ ALLOCATE(ZRHODREF(INUCT))
+ ALLOCATE(ZEXNREF(INUCT))
+ DO JL=1,INUCT
+ ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))/PCLDFR(I1(JL),I2(JL),I3(JL))
+ ZCCT(JL) = PCCT(I1(JL),I2(JL),I3(JL))/PCLDFR(I1(JL),I2(JL),I3(JL))
+ ZZT(JL) = PT(I1(JL),I2(JL),I3(JL))
+ ZZW1(JL) = ZRVSAT(I1(JL),I2(JL),I3(JL))
+ ZZW2(JL) = PW_NU(I1(JL),I2(JL),I3(JL))
+ ZZTDT(JL) = ZTDT(I1(JL),I2(JL),I3(JL))
+ ZSW(JL) = PRVT(I1(JL),I2(JL),I3(JL))/ZRVSAT(I1(JL),I2(JL),I3(JL)) - 1.
+ ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
+ ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL))
+ DO JMOD = 1,NMOD_CCN
+ ZNFT(JL,JMOD) = PNFT(I1(JL),I2(JL),I3(JL),JMOD)
+ ZNAT(JL,JMOD) = PNAT(I1(JL),I2(JL),I3(JL),JMOD)
+ ZCHEN_MULTI(JL,JMOD) = (ZNFT(JL,JMOD)+ZNAT(JL,JMOD))*ZRHODREF(JL) &
+ / XLIMIT_FACTOR(JMOD)
+ ENDDO
+ ENDDO
+!
+ ZZW1(:) = 1.0/ZEPS + 1.0/ZZW1(:) &
+ + (((XLVTT+(XCPV-XCL)*(ZZT(:)-XTT))/ZZT(:))**2)/(XCPD*XRV) ! Psi2
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 2. compute the constant term (ZZW3) relative to smax
+! ----------------------------------------------------
+!
+! Remark : in LIMA's nucleation parameterization, Smax=0.01 for a supersaturation of 1% !
+!
+!
+ ZVEC1(:) = MAX( 1.0001, MIN( REAL(NAHEN)-0.0001, XAHENINTP1 * ZZT(:) + XAHENINTP2 ) )
+ IVEC1(:) = INT( ZVEC1(:) )
+ ZVEC1(:) = ZVEC1(:) - REAL( IVEC1(:) )
+ ALLOCATE(ZSMAX(INUCT))
+!
+!
+ IF (LACTIT) THEN ! including a cooling rate
+!
+! Compute the tabulation of function of ZZW3 :
+!
+! (Psi1*w+Psi3*DT/Dt)**1.5
+! ZZW3 = XAHENG*(Psi1*w + Psi3*DT/Dt)**1.5 = ------------------------
+! 2*pi*rho_l*G**(3/2)
+!
+!
+ ZZW4(:)=XPSI1( IVEC1(:)+1)*ZZW2(:)+XPSI3(IVEC1(:)+1)*ZZTDT(:)
+ ZZW5(:)=XPSI1( IVEC1(:) )*ZZW2(:)+XPSI3(IVEC1(:) )*ZZTDT(:)
+ WHERE (ZZW4(:) < 0. .OR. ZZW5(:) < 0.)
+ ZZW4(:) = 0.
+ ZZW5(:) = 0.
+ END WHERE
+ ZZW3(:) = XAHENG( IVEC1(:)+1)*(ZZW4(:)**1.5)* ZVEC1(:) &
+ - XAHENG( IVEC1(:) )*(ZZW5(:)**1.5)*(ZVEC1(:) - 1.0)
+ ! Cste*((Psi1*w+Psi3*dT/dt)/(G))**1.5
+ ZZW6(:) = XAHENG2( IVEC1(:)+1)*(ZZW4(:)**0.5)* ZVEC1(:) &
+ - XAHENG2( IVEC1(:) )*(ZZW5(:)**0.5)*(ZVEC1(:) - 1.0)
+!
+!
+ ELSE ! LACTIT , for clouds
+!
+!
+! Compute the tabulation of function of ZZW3 :
+!
+! (Psi1 * w)**1.5
+! ZZW3 = XAHENG * (Psi1 * w)**1.5 = -------------------------
+! 2 pi rho_l * G**(3/2)
+!
+!
+ ZZW2(:)=MAX(ZZW2(:),0.)
+ ZZW3(:)=XAHENG(IVEC1(:)+1)*((XPSI1(IVEC1(:)+1)*ZZW2(:))**1.5)* ZVEC1(:) &
+ -XAHENG(IVEC1(:) )*((XPSI1(IVEC1(:) )*ZZW2(:))**1.5)*(ZVEC1(:)-1.0)
+!
+ ZZW6(:)=XAHENG2(IVEC1(:)+1)*((XPSI1(IVEC1(:)+1)*ZZW2(:))**0.5)* ZVEC1(:) &
+ -XAHENG2(IVEC1(:) )*((XPSI1(IVEC1(:) )*ZZW2(:))**0.5)*(ZVEC1(:)-1.0)
+!
+ END IF ! LACTIT
+!
+!
+! (Psi1*w+Psi3*DT/Dt)**1.5 rho_air
+! ZZW3 = ------------------------ * -------
+! 2*pi*rho_l*G**(3/2) Psi2
+!
+ ZZW5(:) = 1.
+ ZZW3(:) = (ZZW3(:)/ZZW1(:))*ZRHODREF(:) ! R.H.S. of Eq 9 of CPB 98 but
+ ! for multiple aerosol modes
+ WHERE (ZRCT(:) > XRTMIN(2) .AND. ZCCT(:) > XCTMIN(2))
+ ZZW6(:) = ZZW6(:) * ZRHODREF(:) * ZCCT(:) / (XLBC*ZCCT(:)/ZRCT(:))**XLBEXC
+ ELSEWHERE
+ ZZW6(:)=0.
+ END WHERE
+
+ WHERE (ZZW3(:) == 0. .AND. .NOT.(ZSW>0.))
+ ZZW5(:) = -1.
+ END WHERE
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 3. Compute the maximum of supersaturation
+! -----------------------------------------
+!
+!
+! estimate S_max for the CPB98 parameterization with SEVERAL aerosols mode
+! Reminder : Smax=0.01 for a 1% supersaturation
+!
+! Interval bounds to tabulate sursaturation Smax
+! Check with values used for tabulation in ini_lima_warm.f90
+ ZS1 = 1.0E-5 ! corresponds to 0.001% supersaturation
+ ZS2 = 5.0E-2 ! corresponds to 5.0% supersaturation
+ ZXACC = 1.0E-10 ! Accuracy needed for the search in [NO UNITS]
+!
+ ZSMAX(:) = ZRIDDR(ZS1,ZS2,ZXACC,ZZW3(:),ZZW6(:),INUCT) ! ZSMAX(:) is in [NO UNITS]
+ ZSMAX(:) = MIN(MAX(ZSMAX(:), ZSW(:)),ZS2)
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 4. Compute the nucleus source
+! -----------------------------
+!
+!
+! Again : Smax=0.01 for a 1% supersaturation
+! Modified values for Beta and C (see in init_aerosol_properties) account for that
+!
+ WHERE (ZZW5(:) > 0. .AND. ZSMAX(:) > 0.)
+ ZVEC1(:) = MAX( 1.0001, MIN( REAL(NHYP)-0.0001, XHYPINTP1*LOG(ZSMAX(:))+XHYPINTP2 ) )
+ IVEC1(:) = INT( ZVEC1(:) )
+ ZVEC1(:) = ZVEC1(:) - REAL( IVEC1(:) )
+ END WHERE
+ ZZW6(:) = 0. ! initialize the change of cloud droplet concentration
+!
+ ZTMP(:,:)=0.0
+!
+! Compute the concentration of activable aerosols for each mode
+! based on the max of supersaturation ( -> ZTMP )
+!
+ DO JMOD = 1, NMOD_CCN ! iteration on mode number
+ ZZW1(:) = 0.
+ ZZW2(:) = 0.
+ ZZW3(:) = 0.
+ !
+ WHERE( ZZW5(:) > 0. .AND. ZSMAX(:)>0.0 )
+ ZZW2(:) = XHYPF12( IVEC1(:)+1,JMOD )* ZVEC1(:) & ! hypergeo function
+ - XHYPF12( IVEC1(:) ,JMOD )*(ZVEC1(:) - 1.0) ! XHYPF12 is tabulated
+ !
+ ZTMP(:,JMOD) = ZCHEN_MULTI(:,JMOD)/ZRHODREF(:)*ZSMAX(:)**XKHEN_MULTI(JMOD)*ZZW2(:)
+ ENDWHERE
+ ENDDO
+!
+! Compute the concentration of aerosols activated at this time step
+! as the difference between ZTMP and the aerosols already activated at t-dt (ZZW1)
+!
+ DO JMOD = 1, NMOD_CCN ! iteration on mode number
+ ZZW1(:) = 0.
+ ZZW2(:) = 0.
+ ZZW3(:) = 0.
+ !
+ WHERE( SUM(ZTMP(:,:),DIM=2) .GT. 0.01E6/ZRHODREF(:) )
+ ZZW1(:) = MIN( ZNFT(:,JMOD),MAX( ZTMP(:,JMOD)- ZNAT(:,JMOD) , 0.0 ) )
+ ENDWHERE
+ !
+ !* update the concentration of activated CCN = Na
+ !
+ PNAT(:,:,:,JMOD) = PNAT(:,:,:,JMOD) + PCLDFR(:,:,:) * UNPACK( ZZW1(:), MASK=GNUCT(:,:,:), FIELD=0.0 )
+ !
+ !* update the concentration of free CCN = Nf
+ !
+ PNFT(:,:,:,JMOD) = PNFT(:,:,:,JMOD) - PCLDFR(:,:,:) * UNPACK( ZZW1(:), MASK=GNUCT(:,:,:), FIELD=0.0 )
+ !
+ !* prepare to update the cloud water concentration
+ !
+ ZZW6(:) = ZZW6(:) + ZZW1(:)
+ ENDDO
+!
+! Output tendencies
+!
+ ZZW1(:)=0.
+ WHERE (ZZW5(:)>0.0 .AND. ZSMAX(:)>0.0) ! ZZW1 is computed with ZSMAX [NO UNIT]
+ ZZW1(:) = MIN(XCSTDCRIT*ZZW6(:)/(((ZZT(:)*ZSMAX(:))**3)*ZRHODREF(:)),1.E-5)
+ END WHERE
+!
+ IF (.NOT.LSUBG_COND) THEN
+ ZW(:,:,:) = MIN( UNPACK( ZZW1(:),MASK=GNUCT(:,:,:),FIELD=0.0 ),PRVT(:,:,:) )
+ PTHT(:,:,:) = PTHT(:,:,:) + ZW(:,:,:) * (XLVTT+(XCPV-XCL)*(PT(:,:,:)-XTT))/ &
+ (PEXNREF(:,:,:)*(XCPD+XCPV*PRVT(:,:,:)+XCL*(PRCT(:,:,:)+PRRT(:,:,:))))
+ PRVT(:,:,:) = PRVT(:,:,:) - ZW(:,:,:)
+ PRCT(:,:,:) = PRCT(:,:,:) + ZW(:,:,:)
+ PCCT(:,:,:) = PCCT(:,:,:) + UNPACK( ZZW6(:),MASK=GNUCT(:,:,:),FIELD=0. )
+ ELSE
+ ZW(:,:,:) = MIN( PCLDFR(:,:,:) * UNPACK( ZZW1(:),MASK=GNUCT(:,:,:),FIELD=0.0 ),PRVT(:,:,:) )
+ PCCT(:,:,:) = PCCT(:,:,:) + PCLDFR(:,:,:) * UNPACK( ZZW6(:),MASK=GNUCT(:,:,:),FIELD=0. )
+ END IF
+!
+ ZW(:,:,:) = UNPACK( 100.0*ZSMAX(:),MASK=GNUCT(:,:,:),FIELD=0.0 )
+ ZW2(:,:,:) = PCLDFR(:,:,:) * UNPACK( ZZW6(:),MASK=GNUCT(:,:,:),FIELD=0.0 )
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 5. Cleaning
+! -----------
+!
+!
+ DEALLOCATE(IVEC1)
+ DEALLOCATE(ZVEC1)
+ DEALLOCATE(ZNFT)
+ DEALLOCATE(ZNAT)
+ DEALLOCATE(ZCCT)
+ DEALLOCATE(ZRCT)
+ DEALLOCATE(ZZT)
+ DEALLOCATE(ZSMAX)
+ DEALLOCATE(ZZW1)
+ DEALLOCATE(ZZW2)
+ DEALLOCATE(ZZW3)
+ DEALLOCATE(ZZW4)
+ DEALLOCATE(ZZW5)
+ DEALLOCATE(ZZW6)
+ DEALLOCATE(ZZTDT)
+ DEALLOCATE(ZSW)
+ DEALLOCATE(ZRHODREF)
+ DEALLOCATE(ZCHEN_MULTI)
+ DEALLOCATE(ZEXNREF)
+!
+END IF ! INUCT
+!
+IF ( tpfile%lopened ) THEN
+ IF ( INUCT == 0 ) THEN
+ ZW (:,:,:) = 0.
+ ZW2(:,:,:) = 0.
+ END IF
+
+ TZFIELD%CMNHNAME ='SMAX'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = ''
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_SMAX'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZW)
+ !
+ TZFIELD%CMNHNAME ='NACT'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'kg-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_NACT'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZW2)
+END IF
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 6. Functions used to compute the maximum of supersaturation
+! -----------------------------------------------------------
+!
+!
+CONTAINS
+!------------------------------------------------------------------------------
+!
+ FUNCTION ZRIDDR(PX1,PX2INIT,PXACC,PZZW3,PZZW6,NPTS) RESULT(PZRIDDR)
+!
+!
+!!**** *ZRIDDR* - iterative algorithm to find root of a function
+!!
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this function is to find the root of a given function
+!! the arguments are the brackets bounds (the interval where to find the root)
+!! the accuracy needed and the input parameters of the given function.
+!! Using Ridders' method, return the root of a function known to lie between
+!! PX1 and PX2. The root, returned as PZRIDDR, will be refined to an approximate
+!! accuracy PXACC.
+!!
+!!** METHOD
+!! ------
+!! Ridders' method
+!!
+!! EXTERNAL
+!! --------
+!! FUNCSMAX
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!! NUMERICAL RECIPES IN FORTRAN 77: THE ART OF SCIENTIFIC COMPUTING
+!! (ISBN 0-521-43064-X)
+!! Copyright (C) 1986-1992 by Cambridge University Press.
+!! Programs Copyright (C) 1986-1992 by Numerical Recipes Software.
+!!
+!! AUTHOR
+!! ------
+!! Frederick Chosson *CERFACS*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 12/07/07
+!! S.BERTHET 2008 vectorization
+!------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+!
+use mode_msg
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments and result
+!
+INTEGER, INTENT(IN) :: NPTS
+REAL, DIMENSION(:), INTENT(IN) :: PZZW3
+REAL, DIMENSION(:), INTENT(IN) :: PZZW6
+REAL, INTENT(IN) :: PX1, PX2INIT, PXACC
+REAL, DIMENSION(:), ALLOCATABLE :: PZRIDDR
+!
+!* 0.2 declarations of local variables
+!
+!
+INTEGER, PARAMETER :: MAXIT=60
+REAL, PARAMETER :: UNUSED=0.0 !-1.11e30
+REAL, DIMENSION(:), ALLOCATABLE :: fh,fl, fm,fnew
+REAL :: s,xh,xl,xm,xnew
+REAL :: PX2
+INTEGER :: j, JL
+!
+ALLOCATE( fh(NPTS))
+ALLOCATE( fl(NPTS))
+ALLOCATE( fm(NPTS))
+ALLOCATE(fnew(NPTS))
+ALLOCATE(PZRIDDR(NPTS))
+!
+PZRIDDR(:)= UNUSED
+PX2 = PX2INIT
+fl(:) = FUNCSMAX(PX1,PZZW3(:),PZZW6(:),NPTS)
+fh(:) = FUNCSMAX(PX2,PZZW3(:),PZZW6(:),NPTS)
+!
+DO JL = 1, NPTS
+ PX2 = PX2INIT
+100 if ((fl(JL) > 0.0 .and. fh(JL) < 0.0) .or. (fl(JL) < 0.0 .and. fh(JL) > 0.0)) then
+ xl = PX1
+ xh = PX2
+ do j=1,MAXIT
+ xm = 0.5*(xl+xh)
+ fm(JL) = SINGL_FUNCSMAX(xm,PZZW3(JL),PZZW6(JL),JL)
+ s = sqrt(fm(JL)**2-fl(JL)*fh(JL))
+ if (s == 0.0) then
+ GO TO 101
+ endif
+ xnew = xm+(xm-xl)*(sign(1.0,fl(JL)-fh(JL))*fm(JL)/s)
+ if (abs(xnew - PZRIDDR(JL)) <= PXACC) then
+ GO TO 101
+ endif
+ PZRIDDR(JL) = xnew
+ fnew(JL) = SINGL_FUNCSMAX(PZRIDDR(JL),PZZW3(JL),PZZW6(JL),JL)
+ if (fnew(JL) == 0.0) then
+ GO TO 101
+ endif
+ if (sign(fm(JL),fnew(JL)) /= fm(JL)) then
+ xl =xm
+ fl(JL)=fm(JL)
+ xh =PZRIDDR(JL)
+ fh(JL)=fnew(JL)
+ else if (sign(fl(JL),fnew(JL)) /= fl(JL)) then
+ xh =PZRIDDR(JL)
+ fh(JL)=fnew(JL)
+ else if (sign(fh(JL),fnew(JL)) /= fh(JL)) then
+ xl =PZRIDDR(JL)
+ fl(JL)=fnew(JL)
+ else if (PX2 .lt. 0.05) then
+ PX2 = PX2 + 1.0E-2
+ PRINT*, 'PX2 ALWAYS too small, we put a greater one : PX2 =',PX2
+ fh(JL) = SINGL_FUNCSMAX(PX2,PZZW3(JL),PZZW6(JL),JL)
+ go to 100
+ end if
+ if (abs(xh-xl) <= PXACC) then
+ GO TO 101
+ endif
+!!SB
+!!$ if (j == MAXIT .and. (abs(xh-xl) > PXACC) ) then
+!!$ PZRIDDR(JL)=0.0
+!!$ go to 101
+!!$ endif
+!!SB
+ end do
+ call Print_msg( NVERB_FATAL, 'GEN', 'ZRIDDR', 'exceeded maximum iterations' )
+ else if (fl(JL) == 0.0) then
+ PZRIDDR(JL)=PX1
+ else if (fh(JL) == 0.0) then
+ PZRIDDR(JL)=PX2
+ else if (PX2 .lt. 0.05) then
+ PX2 = PX2 + 1.0E-2
+ PRINT*, 'PX2 too small, we put a greater one : PX2 =',PX2
+ fh(JL) = SINGL_FUNCSMAX(PX2,PZZW3(JL),PZZW6(JL),JL)
+ go to 100
+ else
+!!$ print*, 'PZRIDDR: root must be bracketed'
+!!$ print*,'npts ',NPTS,'jl',JL
+!!$ print*, 'PX1,PX2,fl,fh',PX1,PX2,fl(JL),fh(JL)
+!!$ print*, 'PX2 = 30 % of supersaturation, there is no solution for Smax'
+!!$ print*, 'try to put greater PX2 (upper bound for Smax research)'
+!!$ STOP
+ PZRIDDR(JL)=0.0
+ go to 101
+ end if
+101 ENDDO
+!
+DEALLOCATE( fh)
+DEALLOCATE( fl)
+DEALLOCATE( fm)
+DEALLOCATE(fnew)
+!
+END FUNCTION ZRIDDR
+!
+!------------------------------------------------------------------------------
+!
+ FUNCTION FUNCSMAX(PPZSMAX,PPZZW3,PPZZW6,NPTS) RESULT(PFUNCSMAX)
+!
+!
+!!**** *FUNCSMAX* - function describing SMAX function that you want to find the root
+!!
+!!
+!! PURPOSE
+!! -------
+!! This function describe the equilibrium between Smax and two aerosol mode
+!! acting as CCN. This function is derive from eq. (9) of CPB98 but for two
+!! aerosols mode described by their respective parameters C, k, Mu, Beta.
+!! the arguments are the supersaturation in "no unit" and the r.h.s. of this eq.
+!! and the ratio of concentration of injected aerosols on maximum concentration
+!! of injected aerosols ever.
+!!** METHOD
+!! ------
+!! This function is called by zriddr.f90
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAM_LIMA_WARM
+!! XHYPF32
+!!
+!! XHYPINTP1
+!! XHYPINTP2
+!!
+!! Module MODD_PARAM_C2R2
+!! XKHEN_MULTI()
+!! NMOD_CCN
+!!
+!! REFERENCE
+!! ---------
+!! Cohard, J.M., J.P.Pinty, K.Suhre, 2000:"On the parameterization of activation
+!! spectra from cloud condensation nuclei microphysical properties",
+!! J. Geophys. Res., Vol.105, N0.D9, pp. 11753-11766
+!!
+!! AUTHOR
+!! ------
+!! Frederick Chosson *CERFACS*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 12/07/07
+!! S.Berthet 19/03/08 Extension a une population multimodale d aerosols
+!
+!------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments and result
+!
+INTEGER, INTENT(IN) :: NPTS
+REAL, INTENT(IN) :: PPZSMAX ! supersaturation is already in no units
+REAL, DIMENSION(:), INTENT(IN) :: PPZZW3 !
+REAL, DIMENSION(:), INTENT(IN) :: PPZZW6 !
+REAL, DIMENSION(:), ALLOCATABLE :: PFUNCSMAX !
+!
+!* 0.2 declarations of local variables
+!
+REAL :: ZHYPF
+!
+REAL :: PZVEC1
+INTEGER :: PIVEC1
+!
+ALLOCATE(PFUNCSMAX(NPTS))
+!
+PFUNCSMAX(:) = 0.
+PZVEC1 = MAX( ( 1.0 + 10.0 * XMNH_EPSILON ) ,MIN( REAL(NHYP)*( 1.0 - 10.0 * XMNH_EPSILON ) , &
+ XHYPINTP1*LOG(PPZSMAX)+XHYPINTP2 ) )
+PIVEC1 = INT( PZVEC1 )
+PZVEC1 = PZVEC1 - REAL( PIVEC1 )
+DO JMOD = 1, NMOD_CCN
+ ZHYPF = 0. ! XHYPF32 is tabulated with ZSMAX in [NO UNITS]
+ ZHYPF = XHYPF32( PIVEC1+1,JMOD ) * PZVEC1 &
+ - XHYPF32( PIVEC1 ,JMOD ) *(PZVEC1 - 1.0)
+ ! sum of s**(ki+2) * F32 * Ci * ki * beta(ki/2,3/2)
+ PFUNCSMAX(:) = PFUNCSMAX(:) + (PPZSMAX)**(XKHEN_MULTI(JMOD) + 2) &
+ * ZHYPF* XKHEN_MULTI(JMOD) * ZCHEN_MULTI(:,JMOD) &
+ * GAMMA_X0D( XKHEN_MULTI(JMOD)/2.0)*GAMMA_X0D(3.0/2.0) &
+ / GAMMA_X0D((XKHEN_MULTI(JMOD)+3.0)/2.0)
+ENDDO
+! function l.h.s. minus r.h.s. of eq. (9) of CPB98 but for NMOD_CCN aerosol mode
+PFUNCSMAX(:) = PFUNCSMAX(:) + PPZZW6(:)*PPZSMAX - PPZZW3(:)
+!
+END FUNCTION FUNCSMAX
+!
+!------------------------------------------------------------------------------
+!
+ FUNCTION SINGL_FUNCSMAX(PPZSMAX,PPZZW3,PPZZW6,KINDEX) RESULT(PSINGL_FUNCSMAX)
+!
+!
+!!**** *SINGL_FUNCSMAX* - same function as FUNCSMAX
+!!
+!!
+!! PURPOSE
+!! -------
+! As for FUNCSMAX but for a scalar
+!!
+!!** METHOD
+!! ------
+!! This function is called by zriddr.f90
+!!
+!------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments and result
+!
+INTEGER, INTENT(IN) :: KINDEX
+REAL, INTENT(IN) :: PPZSMAX ! supersaturation is "no unit"
+REAL, INTENT(IN) :: PPZZW3 !
+REAL, INTENT(IN) :: PPZZW6 !
+REAL :: PSINGL_FUNCSMAX !
+!
+!* 0.2 declarations of local variables
+!
+REAL :: ZHYPF
+!
+REAL :: PZVEC1
+INTEGER :: PIVEC1
+!
+PSINGL_FUNCSMAX = 0.
+PZVEC1 = MAX( 1.0001,MIN( REAL(NHYP)-0.0001, &
+ XHYPINTP1*LOG(PPZSMAX)+XHYPINTP2 ) )
+PIVEC1 = INT( PZVEC1 )
+PZVEC1 = PZVEC1 - REAL( PIVEC1 )
+DO JMOD = 1, NMOD_CCN
+ ZHYPF = 0. ! XHYPF32 is tabulated with ZSMAX in [NO UNITS]
+ ZHYPF = XHYPF32( PIVEC1+1,JMOD ) * PZVEC1 &
+ - XHYPF32( PIVEC1 ,JMOD ) *(PZVEC1 - 1.0)
+ ! sum of s**(ki+2) * F32 * Ci * ki * bêta(ki/2,3/2)
+ PSINGL_FUNCSMAX = PSINGL_FUNCSMAX + (PPZSMAX)**(XKHEN_MULTI(JMOD) + 2) &
+ * ZHYPF* XKHEN_MULTI(JMOD) * ZCHEN_MULTI(KINDEX,JMOD) &
+ * GAMMA_X0D( XKHEN_MULTI(JMOD)/2.0)*GAMMA_X0D(3.0/2.0) &
+ / GAMMA_X0D((XKHEN_MULTI(JMOD)+3.0)/2.0)
+ENDDO
+! function l.h.s. minus r.h.s. of eq. (9) of CPB98 but for NMOD_CCN aerosol mode
+PSINGL_FUNCSMAX = PSINGL_FUNCSMAX + PPZZW6*PPZSMAX - PPZZW3
+!
+END FUNCTION SINGL_FUNCSMAX
+!
+!-----------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_CCN_ACTIVATION
diff --git a/src/mesonh/micro/lima_ccn_hom_freezing.f90 b/src/mesonh/micro/lima_ccn_hom_freezing.f90
new file mode 100644
index 000000000..86b7a9408
--- /dev/null
+++ b/src/mesonh/micro/lima_ccn_hom_freezing.f90
@@ -0,0 +1,397 @@
+!MNH_LIC Copyright 2013-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-------------------------------------------------------------------------------
+! #################################
+ MODULE MODI_LIMA_CCN_HOM_FREEZING
+! #################################
+!
+INTERFACE
+ SUBROUTINE LIMA_CCN_HOM_FREEZING (PRHODREF, PEXNREF, PPABST, PW_NU, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PCCT, PCRT, PCIT, PNFT, PNHT, &
+ PICEFR )
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
+ ! the nucleation param.
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIT ! Cloud ice m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCT ! Cloud water C. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRT ! Rain water C. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Ice crystal C. source
+!
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNFT ! Free CCN conc.
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNHT ! haze homogeneous freezing
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR ! Ice fraction
+!
+END SUBROUTINE LIMA_CCN_HOM_FREEZING
+END INTERFACE
+END MODULE MODI_LIMA_CCN_HOM_FREEZING
+!
+! ##########################################################################
+ SUBROUTINE LIMA_CCN_HOM_FREEZING (PRHODREF, PEXNREF, PPABST, PW_NU, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PCCT, PCRT, PCIT, PNFT, PNHT , &
+ PICEFR )
+! ##########################################################################
+!
+!! PURPOSE
+!! -------
+!! Compute the homogeneous freezing of CCN where T<-35°C
+!!
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 15/03/2018
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY: XP00, XRD, XRV, XMV, XMD, XCPD, XCPV, XCL, XCI, &
+ XTT, XLSTT, XLVTT, XALPI, XBETAI, XGAMI, &
+ XG
+USE MODD_NSV
+USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
+USE MODD_PARAM_LIMA, ONLY: NMOD_CCN, NMOD_IMM, XRTMIN, XCTMIN, XNUC
+USE MODD_PARAM_LIMA_COLD, ONLY: XRCOEF_HONH, XCEXP_DIFVAP_HONH, XCOEF_DIFVAP_HONH,&
+ XCRITSAT1_HONH, XCRITSAT2_HONH, XTMAX_HONH, &
+ XTMIN_HONH, XC1_HONH, XC2_HONH, XC3_HONH, &
+ XDLNJODT1_HONH, XDLNJODT2_HONH, XRHOI_HONH, &
+ XC_HONC, XTEXP1_HONC, XTEXP2_HONC, XTEXP3_HONC, &
+ XTEXP4_HONC, XTEXP5_HONC
+USE MODD_PARAM_LIMA_WARM, ONLY: XLBC
+!
+use mode_tools, only: Countjv
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
+ ! the nucleation param.
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIT ! Cloud ice m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCT ! Cloud water C. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRT ! Rain water C. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Ice crystal C. source
+!
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNFT ! Free CCN conc.
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNHT ! haze homogeneous freezing
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR ! Ice fraction
+!
+!* 0.2 Declarations of local variables :
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRRT ! Rain water m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRGT ! Graupel/hail m.r. at t
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZTHT ! Theta source
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZCCT ! Cloud water conc. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZCRT ! Rain water conc. source
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFT ! available nucleus conc. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZCIT ! Pristine ice conc. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZZNHT ! Nucleated Ice nuclei conc. source
+ !by Homogeneous freezing
+!
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: ZNHT ! Nucleated Ice nuclei conc. source
+ ! by Homogeneous freezing of haze
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: ZW, ZT ! work arrays
+!
+REAL, DIMENSION(:), ALLOCATABLE &
+ :: ZRHODREF, & ! RHO Dry REFerence
+ ZRHODJ, & ! RHO times Jacobian
+ ZZT, & ! Temperature
+ ZPRES, & ! Pressure
+ ZEXNREF, & ! EXNer Pressure REFerence
+ ZZW, & ! Work array
+ ZZX, & ! Work array
+ ZZY, & ! Work array
+ ZLSFACT, & ! L_s/(Pi_ref*C_ph)
+ ZLVFACT, & ! L_v/(Pi_ref*C_ph)
+ ZLBDAC, & ! Slope parameter of the cloud droplet distr.
+ ZSI, & ! Saturation over ice
+ ZTCELSIUS,&
+ ZLS, &
+ ZPSI1, &
+ ZPSI2, &
+ ZTAU, &
+ ZBFACT, &
+ ZW_NU, &
+ ZFREECCN, &
+ ZCCNFROZEN
+!
+INTEGER :: IIB, IIE, IJB, IJE, IKB, IKE ! Physical domain
+INTEGER :: JL, JMOD_CCN, JMOD_IMM ! Loop index
+!
+INTEGER :: INEGT ! Case number of hom. nucleation
+LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: GNEGT ! Test where to compute the hom. nucleation
+INTEGER , DIMENSION(SIZE(GNEGT)) :: I1,I2,I3 ! Used to replace the COUNT
+!
+REAL :: ZEPS ! molar mass ratio
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 1. Preliminary computations and packing
+! ------------------------------------
+!
+!
+! Physical domain
+IIB=1+JPHEXT
+IIE=SIZE(PTHT,1) - JPHEXT
+IJB=1+JPHEXT
+IJE=SIZE(PTHT,2) - JPHEXT
+IKB=1+JPVEXT
+IKE=SIZE(PTHT,3) - JPVEXT
+!
+! Temperature
+ZT(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:)/XP00 ) ** (XRD/XCPD)
+!
+ZNHT(:,:,:) = PNHT(:,:,:)
+!
+! Computations only where the temperature is below -35°C
+! PACK variables
+!
+GNEGT(:,:,:) = .FALSE.
+GNEGT(IIB:IIE,IJB:IJE,IKB:IKE) = ZT(IIB:IIE,IJB:IJE,IKB:IKE)<XTT-35.0
+INEGT = COUNTJV( GNEGT(:,:,:),I1(:),I2(:),I3(:))
+!
+IF (INEGT.GT.0) THEN
+
+ ALLOCATE(ZRVT(INEGT))
+ ALLOCATE(ZRCT(INEGT))
+ ALLOCATE(ZRRT(INEGT))
+ ALLOCATE(ZRIT(INEGT))
+ ALLOCATE(ZRST(INEGT))
+ ALLOCATE(ZRGT(INEGT))
+ !
+ ALLOCATE(ZTHT(INEGT))
+ !
+ ALLOCATE(ZCCT(INEGT))
+ ALLOCATE(ZCRT(INEGT))
+ ALLOCATE(ZCIT(INEGT))
+ !
+ ALLOCATE(ZNFT(INEGT,NMOD_CCN))
+ ALLOCATE(ZZNHT(INEGT))
+ !
+ ALLOCATE(ZRHODREF(INEGT))
+ ALLOCATE(ZZT(INEGT))
+ ALLOCATE(ZPRES(INEGT))
+ ALLOCATE(ZEXNREF(INEGT))
+ !
+ DO JL=1,INEGT
+ ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL))
+ ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
+ ZRRT(JL) = PRRT(I1(JL),I2(JL),I3(JL))
+ ZRIT(JL) = PRIT(I1(JL),I2(JL),I3(JL))
+ ZRST(JL) = PRST(I1(JL),I2(JL),I3(JL))
+ ZRGT(JL) = PRGT(I1(JL),I2(JL),I3(JL))
+ !
+ ZTHT(JL) = PTHT(I1(JL),I2(JL),I3(JL))
+ !
+ ZCCT(JL) = PCCT(I1(JL),I2(JL),I3(JL))
+ ZCRT(JL) = PCRT(I1(JL),I2(JL),I3(JL))
+ ZCIT(JL) = PCIT(I1(JL),I2(JL),I3(JL))
+ !
+ DO JMOD_CCN = 1, NMOD_CCN
+ ZNFT(JL,JMOD_CCN) = PNFT(I1(JL),I2(JL),I3(JL),JMOD_CCN)
+ ENDDO
+ ZZNHT(JL) = ZNHT(I1(JL),I2(JL),I3(JL))
+ ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
+ ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
+ ZPRES(JL) = PPABST(I1(JL),I2(JL),I3(JL))
+ ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL))
+ ENDDO
+!
+! PACK : done
+! Prepare computations
+!
+ ALLOCATE( ZLSFACT (INEGT) )
+ ALLOCATE( ZLVFACT (INEGT) )
+ ALLOCATE( ZSI (INEGT) )
+ ALLOCATE( ZTCELSIUS (INEGT) )
+ ALLOCATE( ZLBDAC (INEGT) )
+!
+ ALLOCATE( ZZW (INEGT) ) ; ZZW(:) = 0.0
+ ALLOCATE( ZZX (INEGT) ) ; ZZX(:) = 0.0
+ ALLOCATE( ZZY (INEGT) ) ; ZZY(:) = 0.0
+!
+ ZTCELSIUS(:) = ZZT(:)-XTT ! T [°C]
+ ZZW(:) = ZEXNREF(:)*( XCPD+XCPV*ZRVT(:)+XCL*(ZRCT(:)+ZRRT(:)) &
+ +XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)) )
+ ZLSFACT(:) = (XLSTT+(XCPV-XCI)*ZTCELSIUS(:))/ZZW(:) ! L_s/(Pi_ref*C_ph)
+ ZLVFACT(:) = (XLVTT+(XCPV-XCL)*ZTCELSIUS(:))/ZZW(:) ! L_v/(Pi_ref*C_ph)
+!
+ ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) ) ! es_i
+ ZSI(:) = ZRVT(:)*(ZPRES(:)-ZZW(:))/((XMV/XMD)*ZZW(:)) ! Saturation over ice
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 2. Haze homogeneous freezing
+! ------------------------
+!
+!
+! Compute the haze homogeneous nucleation source: RHHONI
+!
+ IF( NMOD_CCN.GT.0 ) THEN
+
+! Sum of the available CCN
+ ALLOCATE( ZFREECCN(INEGT) )
+ ALLOCATE( ZCCNFROZEN(INEGT) )
+ ZFREECCN(:)=0.
+ ZCCNFROZEN(:)=0.
+ DO JMOD_CCN = 1, NMOD_CCN
+ ZFREECCN(:) = ZFREECCN(:) + ZNFT(:,JMOD_CCN)
+ END DO
+!
+ ALLOCATE(ZW_NU(INEGT))
+ DO JL=1,INEGT
+ ZW_NU(JL) = PW_NU(I1(JL),I2(JL),I3(JL))
+ END DO
+!
+ ZZW(:) = 0.0
+ ZZX(:) = 0.0
+ ZEPS = XMV / XMD
+ ZZY(:) = XCRITSAT1_HONH - & ! Critical Sat.
+ (MIN( XTMAX_HONH,MAX( XTMIN_HONH,ZZT(:) ) )/XCRITSAT2_HONH)
+!
+ ALLOCATE(ZLS(INEGT))
+ ALLOCATE(ZPSI1(INEGT))
+ ALLOCATE(ZPSI2(INEGT))
+ ALLOCATE(ZTAU(INEGT))
+ ALLOCATE(ZBFACT(INEGT))
+!
+ WHERE( (ZZT(:)<XTT-35.0) .AND. (ZSI(:)>ZZY(:)) )
+ ZLS(:) = XLSTT+(XCPV-XCI)*ZTCELSIUS(:) ! Ls
+!
+ ZPSI1(:) = ZZY(:) * (XG/(XRD*ZZT(:)))*(ZEPS*ZLS(:)/(XCPD*ZZT(:))-1.)
+! ! Psi1 (a1*Scr in KL01)
+! BV correction PSI2 enlever 1/ZEPS ?
+! ZPSI2(:) = ZSI(:) * (1.0/ZEPS+1.0/ZRVT(:)) + &
+ ZPSI2(:) = ZSI(:) * (1.0/ZRVT(:)) + &
+ ZZY(:) * ((ZLS(:)/ZZT(:))**2)/(XCPD*XRV)
+! ! Psi2 (a2+a3*Scr in KL01)
+ ZTAU(:) = 1.0 / ( MAX( XC1_HONH,XC1_HONH*(XC2_HONH-XC3_HONH*ZZT(:)) ) *&
+ ABS( (XDLNJODT1_HONH - XDLNJODT2_HONH*ZZT(:)) * &
+ ((ZPRES(:)/XP00)**(XRD/XCPD))*ZTHT(:) ) )
+!
+ ZBFACT(:) = (XRHOI_HONH/ZRHODREF(:)) * (ZSI(:)/(ZZY(:)-1.0)) &
+! BV correction ZBFACT enlever 1/ZEPS ?
+! * (1.0/ZRVT(:)+1.0/ZEPS) &
+ * (1.0/ZRVT(:)) &
+ / (XCOEF_DIFVAP_HONH*(ZZT(:)**XCEXP_DIFVAP_HONH /ZPRES(:)))
+!
+! BV correction ZZX rho_i{-1} ?
+! ZZX(:) = MAX( MIN( XRHOI_HONH*ZBFACT(:)**1.5 * (ZPSI1(:)/ZPSI2(:)) &
+ ZZX(:) = MAX( MIN( (1/XRHOI_HONH)*ZBFACT(:)**1.5 * (ZPSI1(:)/ZPSI2(:)) &
+ * (ZW_NU(:)/SQRT(ZTAU(:))) , ZFREECCN(:) ) , 0.)
+!
+ ZZW(:) = MIN( XRCOEF_HONH*ZZX(:)*(ZTAU(:)/ZBFACT(:))**1.5 , ZRVT(:) )
+ END WHERE
+!
+! Apply the changes
+ DO JMOD_CCN = 1, NMOD_CCN
+ WHERE(ZFREECCN(:)>1.)
+ ZCCNFROZEN(:) = ZZX(:) * ZNFT(:,JMOD_CCN)/ZFREECCN(:)
+ END WHERE
+ PNFT(:,:,:,JMOD_CCN) = PNFT(:,:,:,JMOD_CCN) - UNPACK( ZCCNFROZEN(:), MASK=GNEGT(:,:,:),FIELD=0.)
+ END DO
+!
+ PTHT(:,:,:) = PTHT(:,:,:) + UNPACK( ZZW(:)*(ZLSFACT(:)-ZLVFACT(:)), MASK=GNEGT(:,:,:),FIELD=0.)
+ PRVT(:,:,:) = PRVT(:,:,:) - UNPACK( ZZW(:), MASK=GNEGT(:,:,:),FIELD=0.)
+ PRIT(:,:,:) = PRIT(:,:,:) + UNPACK( ZZW(:), MASK=GNEGT(:,:,:),FIELD=0.)
+ PCIT(:,:,:) = PCIT(:,:,:) + UNPACK( ZZX(:), MASK=GNEGT(:,:,:),FIELD=0.)
+ PNHT(:,:,:) = PNHT(:,:,:) + UNPACK( ZZX(:), MASK=GNEGT(:,:,:),FIELD=0.)
+
+ DEALLOCATE(ZFREECCN)
+ DEALLOCATE(ZCCNFROZEN)
+ DEALLOCATE(ZLS)
+ DEALLOCATE(ZPSI1)
+ DEALLOCATE(ZPSI2)
+ DEALLOCATE(ZTAU)
+ DEALLOCATE(ZBFACT)
+ DEALLOCATE(ZW_NU)
+!
+ END IF
+!
+!
+ DEALLOCATE(ZRVT)
+ DEALLOCATE(ZRCT)
+ DEALLOCATE(ZRRT)
+ DEALLOCATE(ZRIT)
+ DEALLOCATE(ZRST)
+ DEALLOCATE(ZRGT)
+!
+ DEALLOCATE(ZTHT)
+!
+ DEALLOCATE(ZCCT)
+ DEALLOCATE(ZCRT)
+ DEALLOCATE(ZCIT)
+!
+ DEALLOCATE(ZNFT)
+ DEALLOCATE(ZZNHT)
+!
+ DEALLOCATE(ZRHODREF)
+ DEALLOCATE(ZZT)
+ DEALLOCATE(ZPRES)
+ DEALLOCATE(ZEXNREF)
+!
+ DEALLOCATE(ZLSFACT)
+ DEALLOCATE(ZLVFACT)
+ DEALLOCATE(ZSI)
+ DEALLOCATE(ZTCELSIUS)
+ DEALLOCATE(ZLBDAC)
+!
+ DEALLOCATE(ZZW)
+ DEALLOCATE(ZZX)
+ DEALLOCATE(ZZY)
+!
+!
+END IF ! INEGT>0
+!
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_CCN_HOM_FREEZING
diff --git a/src/mesonh/micro/lima_cold.f90 b/src/mesonh/micro/lima_cold.f90
new file mode 100644
index 000000000..3e0a6b3e4
--- /dev/null
+++ b/src/mesonh/micro/lima_cold.f90
@@ -0,0 +1,435 @@
+!MNH_LIC Copyright 2013-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! #####################
+ MODULE MODI_LIMA_COLD
+! #####################
+!
+INTERFACE
+ SUBROUTINE LIMA_COLD (OSEDI, OHHONI, KSPLITG, PTSTEP, KMI, &
+ KRR, PZZ, PRHODJ, &
+ PRHODREF, PEXNREF, PPABST, PW_NU, &
+ PTHM, PPABSM, &
+ PTHT, PRT, PSVT, &
+ PTHS, PRS, PSVS, &
+ PINPRS, PINPRG, PINPRH)
+!
+USE MODD_NSV, only: NSV_LIMA_BEG
+!
+LOGICAL, INTENT(IN) :: OSEDI ! switch to activate the
+ ! cloud ice sedimentation
+LOGICAL, INTENT(IN) :: OHHONI ! enable haze freezing
+INTEGER, INTENT(IN) :: KSPLITG ! Number of small time step
+ ! for ice sedimendation
+REAL, INTENT(IN) :: PTSTEP ! Time step
+INTEGER, INTENT(IN) :: KMI ! Model index
+!
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
+ ! the nucleation param.
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at time t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! abs. pressure at time t-dt
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! m.r. at t
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(IN) :: PSVT ! Concentrations at time t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! m.r. source
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(INOUT) :: PSVS ! Concentration sources
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS ! Snow instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG ! Graupel instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRH ! Hail instant precip
+!
+END SUBROUTINE LIMA_COLD
+END INTERFACE
+END MODULE MODI_LIMA_COLD
+!
+! ######################################################################
+ SUBROUTINE LIMA_COLD (OSEDI, OHHONI, KSPLITG, PTSTEP, KMI, &
+ KRR, PZZ, PRHODJ, &
+ PRHODREF, PEXNREF, PPABST, PW_NU, &
+ PTHM, PPABSM, &
+ PTHT, PRT, PSVT, &
+ PTHS, PRS, PSVS, &
+ PINPRS, PINPRG, PINPRH)
+! ######################################################################
+!
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the cold-phase
+!! microphysical sources involving only primary ice and snow, except for
+!! the sedimentation which also includes graupelns, and the homogeneous
+!! freezing of CCNs, cloud droplets and raindrops.
+!!
+!!
+!!** METHOD
+!! ------
+!! The nucleation of IFN is parameterized following either Meyers (1992)
+!! or Phillips (2008, 2013).
+!!
+!! The sedimentation rates are computed with a time spliting technique:
+!! an upstream scheme, written as a difference of non-advective fluxes.
+!! This source term is added to the next coming time step (split-implicit
+!! process).
+!!
+!!
+!! REFERENCES
+!! ----------
+!!
+!! Cohard, J.-M. and J.-P. Pinty, 2000: A comprehensive two-moment warm
+!! microphysical bulk scheme.
+!! Part I: Description and tests
+!! Part II: 2D experiments with a non-hydrostatic model
+!! Accepted for publication in Quart. J. Roy. Meteor. Soc.
+!!
+!! Phillips et al., 2008: An empirical parameterization of heterogeneous
+!! ice nucleation for multiple chemical species of aerosols, J. Atmos. Sci.
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets (no more budget calls in this subroutine)
+! P. Wautelet 28/05/2020: bugfix: correct array start for PSVT and PSVS
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+
+use modd_budget, only: lbu_enable, &
+ lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, &
+ NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1, &
+ tbudgets
+USE MODD_NSV
+USE MODD_PARAM_LIMA
+
+use mode_budget, only: Budget_store_init, Budget_store_end
+
+USE MODI_LIMA_COLD_HOM_NUCL
+USE MODI_LIMA_COLD_SEDIMENTATION
+USE MODI_LIMA_COLD_SLOW_PROCESSES
+USE MODI_LIMA_MEYERS
+USE MODI_LIMA_PHILLIPS
+
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+LOGICAL, INTENT(IN) :: OSEDI ! switch to activate the
+ ! cloud ice sedimentation
+LOGICAL, INTENT(IN) :: OHHONI ! enable haze freezing
+INTEGER, INTENT(IN) :: KSPLITG ! Number of small time step
+ ! for ice sedimendation
+REAL, INTENT(IN) :: PTSTEP ! Time step
+INTEGER, INTENT(IN) :: KMI ! Model index
+!
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
+ ! the nucleation param.
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at time t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! abs. pressure at time t-dt
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! m.r. at t
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(IN) :: PSVT ! Concentrations at time t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! m.r. source
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(INOUT) :: PSVS ! Concentration sources
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS ! Snow instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG ! Graupel instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRH ! Hail instant precip
+!
+!* 0.2 Declarations of local variables :
+!
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
+ :: PRVT, & ! Water vapor m.r. at t
+ PRCT, & ! Cloud water m.r. at t
+ PRRT, & ! Rain water m.r. at t
+ PRIT, & ! Cloud ice m.r. at t
+ PRST, & ! Snow/aggregate m.r. at t
+ PRGT, & ! Graupel m.r. at t
+ PRHT, & ! Graupel m.r. at t
+ !
+ PRVS, & ! Water vapor m.r. source
+ PRCS, & ! Cloud water m.r. source
+ PRRS, & ! Rain water m.r. source
+ PRIS, & ! Pristine ice m.r. source
+ PRSS, & ! Snow/aggregate m.r. source
+ PRGS, & ! Graupel/hail m.r. source
+ PRHS, & ! Graupel/hail m.r. source
+ !
+ PCCT, & ! Cloud water C. at t
+ PCRT, & ! Rain water C. at t
+ PCIT, & ! Ice crystal C. at t
+ !
+ PCCS, & ! Cloud water C. source
+ PCRS, & ! Rain water C. source
+ PCIS ! Ice crystal C. source
+!
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: PNFS ! CCN C. available source
+ !used as Free ice nuclei for
+ !HOMOGENEOUS nucleation of haze
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: PNAS ! Cloud C. nuclei C. source
+ !used as Free ice nuclei for
+ !IMMERSION freezing
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: PIFS ! Free ice nuclei C. source
+ !for DEPOSITION and CONTACT
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: PINS ! Activated ice nuclei C. source
+ !for DEPOSITION and CONTACT
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: PNIS ! Activated ice nuclei C. source
+ !for IMMERSION
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: PNHS ! Haze homogeneous activation
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 0. 3D MICROPHYSCAL VARIABLES
+! -------------------------
+!
+!
+! Prepare 3D water mixing ratios
+PRVT(:,:,:) = PRT(:,:,:,1)
+PRVS(:,:,:) = PRS(:,:,:,1)
+!
+PRCT(:,:,:) = 0.
+PRCS(:,:,:) = 0.
+PRRT(:,:,:) = 0.
+PRRS(:,:,:) = 0.
+PRIT(:,:,:) = 0.
+PRIS(:,:,:) = 0.
+PRST(:,:,:) = 0.
+PRSS(:,:,:) = 0.
+PRGT(:,:,:) = 0.
+PRGS(:,:,:) = 0.
+PRHT(:,:,:) = 0.
+PRHS(:,:,:) = 0.
+!
+IF ( KRR .GE. 2 ) PRCT(:,:,:) = PRT(:,:,:,2)
+IF ( KRR .GE. 2 ) PRCS(:,:,:) = PRS(:,:,:,2)
+IF ( KRR .GE. 3 ) PRRT(:,:,:) = PRT(:,:,:,3)
+IF ( KRR .GE. 3 ) PRRS(:,:,:) = PRS(:,:,:,3)
+IF ( KRR .GE. 4 ) PRIT(:,:,:) = PRT(:,:,:,4)
+IF ( KRR .GE. 4 ) PRIS(:,:,:) = PRS(:,:,:,4)
+IF ( KRR .GE. 5 ) PRST(:,:,:) = PRT(:,:,:,5)
+IF ( KRR .GE. 5 ) PRSS(:,:,:) = PRS(:,:,:,5)
+IF ( KRR .GE. 6 ) PRGT(:,:,:) = PRT(:,:,:,6)
+IF ( KRR .GE. 6 ) PRGS(:,:,:) = PRS(:,:,:,6)
+IF ( KRR .GE. 7 ) PRHT(:,:,:) = PRT(:,:,:,7)
+IF ( KRR .GE. 7 ) PRHS(:,:,:) = PRS(:,:,:,7)
+!
+! Prepare 3D number concentrations
+PCCT(:,:,:) = 0.
+PCRT(:,:,:) = 0.
+PCIT(:,:,:) = 0.
+PCCS(:,:,:) = 0.
+PCRS(:,:,:) = 0.
+PCIS(:,:,:) = 0.
+!
+IF ( LWARM ) PCCT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NC)
+IF ( LWARM .AND. LRAIN ) PCRT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NR)
+IF ( LCOLD ) PCIT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NI)
+!
+IF ( LWARM ) PCCS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NC)
+IF ( LWARM .AND. LRAIN ) PCRS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NR)
+IF ( LCOLD ) PCIS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NI)
+!
+IF ( NMOD_CCN .GE. 1 ) THEN
+ ALLOCATE( PNFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_CCN) )
+ ALLOCATE( PNAS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_CCN) )
+ PNFS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1)
+ PNAS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1)
+ELSE
+ ALLOCATE( PNFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),1) )
+ ALLOCATE( PNAS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),1) )
+ PNFS(:,:,:,:) = 0.
+ PNAS(:,:,:,:) = 0.
+END IF
+!
+IF ( NMOD_IFN .GE. 1 ) THEN
+ ALLOCATE( PIFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_IFN) )
+ ALLOCATE( PINS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_IFN) )
+ PIFS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IFN_FREE:NSV_LIMA_IFN_FREE+NMOD_IFN-1)
+ PINS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IFN_NUCL:NSV_LIMA_IFN_NUCL+NMOD_IFN-1)
+ELSE
+ ALLOCATE( PIFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),1) )
+ ALLOCATE( PINS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),1) )
+ PIFS(:,:,:,:) = 0.
+ PINS(:,:,:,:) = 0.
+END IF
+!
+IF ( NMOD_IMM .GE. 1 ) THEN
+ ALLOCATE( PNIS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_IMM) )
+ PNIS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IMM_NUCL:NSV_LIMA_IMM_NUCL+NMOD_IMM-1)
+ELSE
+ ALLOCATE( PNIS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),1) )
+ PNIS(:,:,:,:) = 0.0
+END IF
+!
+IF ( OHHONI ) THEN
+ ALLOCATE( PNHS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3)) )
+ PNHS(:,:,:) = PSVS(:,:,:,NSV_LIMA_HOM_HAZE)
+ELSE
+ ALLOCATE( PNHS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3)) )
+ PNHS(:,:,:) = 0.0
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 1. COMPUTE THE SEDIMENTATION (RS) SOURCE
+! -------------------------------------
+!
+if ( lbu_enable ) then
+ if ( lbudget_ri .and. osedi ) call Budget_store_init( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs .and. lsnow ) call Budget_store_init( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg .and. lsnow ) call Budget_store_init( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh .and. lhail ) call Budget_store_init( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv .and. osedi ) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'SEDI', pcis(:, :, :) * prhodj(:, :, :) )
+end if
+
+CALL LIMA_COLD_SEDIMENTATION (OSEDI, KSPLITG, PTSTEP, KMI, &
+ PZZ, PRHODJ, PRHODREF, &
+ PRIT, PCIT, &
+ PRIS, PRSS, PRGS, PRHS, PCIS, &
+ PINPRS, PINPRG,&
+ PINPRH )
+
+if ( lbu_enable ) then
+ if ( lbudget_ri .and. osedi ) call Budget_store_end( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs .and. lsnow ) call Budget_store_end( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg .and. lsnow ) call Budget_store_end( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh .and. lhail ) call Budget_store_end( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv .and. osedi ) &
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'SEDI', pcis(:, :, :) * prhodj(:, :, :) )
+end if
+!-------------------------------------------------------------------------------
+!
+!
+! COMPUTE THE NUCLEATION PROCESS SOURCES
+! --------------------------------------
+!
+IF (LNUCL) THEN
+!
+ IF ( LMEYERS ) THEN
+ PIFS(:,:,:,:) = 0.0
+ PNIS(:,:,:,:) = 0.0
+ CALL LIMA_MEYERS (OHHONI, PTSTEP, KMI, &
+ PZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PCCT, &
+ PTHS, PRVS, PRCS, PRIS, &
+ PCCS, PCIS, PINS )
+ ELSE
+ CALL LIMA_PHILLIPS (OHHONI, PTSTEP, KMI, &
+ PZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PTHS, PRVS, PRCS, PRIS, &
+ PCIT, PCCS, PCIS, &
+ PNAS, PIFS, PINS, PNIS )
+ END IF
+!
+ IF (LWARM .OR. (LHHONI .AND. NMOD_CCN.GE.1)) THEN
+ CALL LIMA_COLD_HOM_NUCL (OHHONI, PTSTEP, KMI, &
+ PZZ, PRHODJ, &
+ PRHODREF, PEXNREF, PPABST, PW_NU, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PTHS, PRVS, PRCS, PRRS, PRIS, PRGS, &
+ PCCT, &
+ PCCS, PCRS, PNFS, PCIS, PNHS )
+ END IF
+!
+END IF
+!
+!------------------------------------------------------------------------------
+!
+!
+!* 4. SLOW PROCESSES: depositions, aggregation
+! ----------------------------------------
+!
+IF (LSNOW) THEN
+!
+ CALL LIMA_COLD_SLOW_PROCESSES(PTSTEP, KMI, PZZ, PRHODJ, &
+ PRHODREF, PEXNREF, PPABST, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PTHS, PRVS, PRIS, PRSS, &
+ PCIT, PCIS )
+!
+END IF
+!
+!------------------------------------------------------------------------------
+!
+!
+!* 4. REPORT 3D MICROPHYSICAL VARIABLES IN PRS AND PSVS
+! -------------------------------------------------
+!
+PRS(:,:,:,1) = PRVS(:,:,:)
+IF ( KRR .GE. 2 ) PRS(:,:,:,2) = PRCS(:,:,:)
+IF ( KRR .GE. 3 ) PRS(:,:,:,3) = PRRS(:,:,:)
+IF ( KRR .GE. 4 ) PRS(:,:,:,4) = PRIS(:,:,:)
+IF ( KRR .GE. 5 ) PRS(:,:,:,5) = PRSS(:,:,:)
+IF ( KRR .GE. 6 ) PRS(:,:,:,6) = PRGS(:,:,:)
+IF ( KRR .GE. 7 ) PRS(:,:,:,7) = PRHS(:,:,:)
+!
+! Prepare 3D number concentrations
+!
+IF ( LWARM ) PSVS(:,:,:,NSV_LIMA_NC) = PCCS(:,:,:)
+IF ( LWARM .AND. LRAIN ) PSVS(:,:,:,NSV_LIMA_NR) = PCRS(:,:,:)
+IF ( LCOLD ) PSVS(:,:,:,NSV_LIMA_NI) = PCIS(:,:,:)
+!
+IF ( NMOD_CCN .GE. 1 ) THEN
+ PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1) = PNFS(:,:,:,:)
+ PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1) = PNAS(:,:,:,:)
+END IF
+!
+IF ( NMOD_IFN .GE. 1 ) THEN
+ PSVS(:,:,:,NSV_LIMA_IFN_FREE:NSV_LIMA_IFN_FREE+NMOD_IFN-1) = PIFS(:,:,:,:)
+ PSVS(:,:,:,NSV_LIMA_IFN_NUCL:NSV_LIMA_IFN_NUCL+NMOD_IFN-1) = PINS(:,:,:,:)
+END IF
+!
+IF ( NMOD_IMM .GE. 1 ) THEN
+ PSVS(:,:,:,NSV_LIMA_IMM_NUCL:NSV_LIMA_IMM_NUCL+NMOD_IMM-1) = PNIS(:,:,:,:)
+END IF
+
+IF ( OHHONI ) PSVS(:,:,:,NSV_LIMA_HOM_HAZE) = PNHS(:,:,:)
+!
+!++cb++
+IF (ALLOCATED(PNFS)) DEALLOCATE(PNFS)
+IF (ALLOCATED(PNAS)) DEALLOCATE(PNAS)
+IF (ALLOCATED(PIFS)) DEALLOCATE(PIFS)
+IF (ALLOCATED(PINS)) DEALLOCATE(PINS)
+IF (ALLOCATED(PNIS)) DEALLOCATE(PNIS)
+IF (ALLOCATED(PNHS)) DEALLOCATE(PNHS)
+!--cb--
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_COLD
diff --git a/src/mesonh/micro/lima_cold_hom_nucl.f90 b/src/mesonh/micro/lima_cold_hom_nucl.f90
new file mode 100644
index 000000000..407ae868d
--- /dev/null
+++ b/src/mesonh/micro/lima_cold_hom_nucl.f90
@@ -0,0 +1,659 @@
+!MNH_LIC Copyright 2013-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ######################
+ MODULE MODI_LIMA_COLD_HOM_NUCL
+! ######################
+!
+INTERFACE
+ SUBROUTINE LIMA_COLD_HOM_NUCL (OHHONI, PTSTEP, KMI, &
+ PZZ, PRHODJ, &
+ PRHODREF, PEXNREF, PPABST, PW_NU, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PTHS, PRVS, PRCS, PRRS, PRIS, PRGS, &
+ PCCT, &
+ PCCS, PCRS, PNFS, PCIS, PNHS )
+!
+LOGICAL, INTENT(IN) :: OHHONI ! enable haze freezing
+REAL, INTENT(IN) :: PTSTEP ! Time step
+INTEGER, INTENT(IN) :: KMI ! Model index
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
+ ! the nucleation param.
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRGS ! Graupel/hail m.r. source
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCT ! Cloud water C. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCS ! Cloud water C. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCRS ! Rain water C. source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNFS ! CCN C. available source
+ !used as Free ice nuclei for
+ !HOMOGENEOUS nucleation of haze
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIS ! Ice crystal C. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNHS ! haze homogeneous freezing
+!
+END SUBROUTINE LIMA_COLD_HOM_NUCL
+END INTERFACE
+END MODULE MODI_LIMA_COLD_HOM_NUCL
+!
+! ######################################################################
+ SUBROUTINE LIMA_COLD_HOM_NUCL (OHHONI, PTSTEP, KMI, &
+ PZZ, PRHODJ, &
+ PRHODREF, PEXNREF, PPABST, PW_NU, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PTHS, PRVS, PRCS, PRRS, PRIS, PRGS, &
+ PCCT, &
+ PCCS, PCRS, PNFS, PCIS, PNHS )
+! ######################################################################
+!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the cold-phase homogeneous
+!! freezing of CCN, droplets and drops (T<-35°C)
+!!
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!! C. Barthe * LACy* jan. 2014 add budgets
+!! B.Vie 10/2016 Bug zero division
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! M. Leriche 05/2019: suppress unused actived coated IN (immersion) source
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+! P. Wautelet 03/2020: use the new data structures and subroutines for budgets
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+use modd_budget, only: lbu_enable, nbumod, &
+ lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, lbudget_ri, lbudget_rg, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RG, NBUDGET_SV1, &
+ tbudgets
+USE MODD_CST, ONLY: XP00, XRD, XRV, XMV, XMD, XCPD, XCPV, XCL, XCI, &
+ XTT, XLSTT, XLVTT, XALPI, XBETAI, XGAMI, &
+ XG
+USE MODD_NSV
+USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
+USE MODD_PARAM_LIMA, ONLY: NMOD_CCN, NMOD_IMM, XRTMIN, XCTMIN, XNUC, LWARM, LRAIN
+USE MODD_PARAM_LIMA_COLD, ONLY: XRCOEF_HONH, XCEXP_DIFVAP_HONH, XCOEF_DIFVAP_HONH,&
+ XCRITSAT1_HONH, XCRITSAT2_HONH, XTMAX_HONH, &
+ XTMIN_HONH, XC1_HONH, XC2_HONH, XC3_HONH, &
+ XDLNJODT1_HONH, XDLNJODT2_HONH, XRHOI_HONH, &
+ XC_HONC, XTEXP1_HONC, XTEXP2_HONC, XTEXP3_HONC, &
+ XTEXP4_HONC, XTEXP5_HONC
+USE MODD_PARAM_LIMA_WARM, ONLY: XLBC
+
+use mode_budget, only: Budget_store_init, Budget_store_end
+use mode_tools, only: Countjv
+
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+LOGICAL, INTENT(IN) :: OHHONI ! enable haze freezing
+REAL, INTENT(IN) :: PTSTEP ! Time step
+INTEGER, INTENT(IN) :: KMI ! Model index
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
+ ! the nucleation param.
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRGS ! Graupel/hail m.r. source
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCT ! Cloud water C. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCS ! Cloud water C. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCRS ! Rain water C. source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNFS ! CCN C. available source
+ !used as Free ice nuclei for
+ !HOMOGENEOUS nucleation of haze
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIS ! Ice crystal C. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNHS ! haze homogeneous freezing
+!
+!* 0.2 Declarations of local variables :
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRRT ! Rain water m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRGT ! Graupel/hail m.r. at t
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZCCT ! Cloud water conc. at t
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZTHS ! Theta source
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZRVS ! Water vapor m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRCS ! Cloud water m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRRS ! Rain water m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRIS ! Pristine ice m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRGS ! Graupel/hail m.r. source
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZCCS ! Cloud water conc. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZCRS ! Rain water conc. source
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFS ! available nucleus conc. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZCIS ! Pristine ice conc. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZZNHS ! Nucleated Ice nuclei conc. source
+ !by Homogeneous freezing
+!
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: ZNHS ! Nucleated Ice nuclei conc. source
+ ! by Homogeneous freezing of haze
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: ZW, ZT ! work arrays
+!
+REAL, DIMENSION(:), ALLOCATABLE &
+ :: ZRHODREF, & ! RHO Dry REFerence
+ ZRHODJ, & ! RHO times Jacobian
+ ZZT, & ! Temperature
+ ZPRES, & ! Pressure
+ ZEXNREF, & ! EXNer Pressure REFerence
+ ZZW, & ! Work array
+ ZZX, & ! Work array
+ ZZY, & ! Work array
+ ZLSFACT, & ! L_s/(Pi_ref*C_ph)
+ ZLVFACT, & ! L_v/(Pi_ref*C_ph)
+ ZLBDAC, & ! Slope parameter of the cloud droplet distr.
+ ZSI, & ! Saturation over ice
+ ZTCELSIUS,&
+ ZLS, &
+ ZPSI1, &
+ ZPSI2, &
+ ZTAU, &
+ ZBFACT, &
+ ZW_NU, &
+ ZFREECCN, &
+ ZCCNFROZEN
+!
+INTEGER :: IIB, IIE, IJB, IJE, IKB, IKE ! Physical domain
+INTEGER :: JL, JMOD_CCN, JMOD_IMM ! Loop index
+!
+INTEGER :: INEGT ! Case number of hom. nucleation
+integer :: idx
+LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: GNEGT ! Test where to compute the hom. nucleation
+INTEGER , DIMENSION(SIZE(GNEGT)) :: I1,I2,I3 ! Used to replace the COUNT
+!
+REAL :: ZEPS ! molar mass ratio
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 1. PRELIMINARY COMPUTATIONS
+! ------------------------
+!
+!
+! Physical domain
+IIB=1+JPHEXT
+IIE=SIZE(PZZ,1) - JPHEXT
+IJB=1+JPHEXT
+IJE=SIZE(PZZ,2) - JPHEXT
+IKB=1+JPVEXT
+IKE=SIZE(PZZ,3) - JPVEXT
+!
+! Temperature
+ZT(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:)/XP00 ) ** (XRD/XCPD)
+!
+IF( OHHONI ) THEN
+ ZNHS(:,:,:) = PNHS(:,:,:)
+ELSE
+ ZNHS(:,:,:) = 0.0
+END IF
+!
+! Computations only where the temperature is below -35°C
+! PACK variables
+!
+GNEGT(:,:,:) = .FALSE.
+GNEGT(IIB:IIE,IJB:IJE,IKB:IKE) = ZT(IIB:IIE,IJB:IJE,IKB:IKE)<XTT-35.0
+INEGT = COUNTJV( GNEGT(:,:,:),I1(:),I2(:),I3(:))
+!
+IF (INEGT.GT.0) THEN
+
+ ALLOCATE(ZRVT(INEGT))
+ ALLOCATE(ZRCT(INEGT))
+ ALLOCATE(ZRRT(INEGT))
+ ALLOCATE(ZRIT(INEGT))
+ ALLOCATE(ZRST(INEGT))
+ ALLOCATE(ZRGT(INEGT))
+ !
+ ALLOCATE(ZCCT(INEGT))
+ !
+ ALLOCATE(ZRVS(INEGT))
+ ALLOCATE(ZRCS(INEGT))
+ ALLOCATE(ZRRS(INEGT))
+ ALLOCATE(ZRIS(INEGT))
+ ALLOCATE(ZRGS(INEGT))
+ !
+ ALLOCATE(ZTHS(INEGT))
+ !
+ ALLOCATE(ZCCS(INEGT))
+ ALLOCATE(ZCRS(INEGT))
+ ALLOCATE(ZCIS(INEGT))
+ !
+ ALLOCATE(ZNFS(INEGT,NMOD_CCN))
+ ALLOCATE(ZZNHS(INEGT))
+ !
+ ALLOCATE(ZRHODREF(INEGT))
+ ALLOCATE(ZZT(INEGT))
+ ALLOCATE(ZPRES(INEGT))
+ ALLOCATE(ZEXNREF(INEGT))
+ !
+ DO JL=1,INEGT
+ ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL))
+ ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
+ ZRRT(JL) = PRRT(I1(JL),I2(JL),I3(JL))
+ ZRIT(JL) = PRIT(I1(JL),I2(JL),I3(JL))
+ ZRST(JL) = PRST(I1(JL),I2(JL),I3(JL))
+ ZRGT(JL) = PRGT(I1(JL),I2(JL),I3(JL))
+ !
+ ZCCT(JL) = PCCT(I1(JL),I2(JL),I3(JL))
+ !
+ ZRVS(JL) = PRVS(I1(JL),I2(JL),I3(JL))
+ ZRCS(JL) = PRCS(I1(JL),I2(JL),I3(JL))
+ ZRRS(JL) = PRRS(I1(JL),I2(JL),I3(JL))
+ ZRIS(JL) = PRIS(I1(JL),I2(JL),I3(JL))
+ ZRGS(JL) = PRGS(I1(JL),I2(JL),I3(JL))
+ !
+ ZTHS(JL) = PTHS(I1(JL),I2(JL),I3(JL))
+ !
+ ZCCS(JL) = PCCS(I1(JL),I2(JL),I3(JL))
+ ZCRS(JL) = PCRS(I1(JL),I2(JL),I3(JL))
+ ZCIS(JL) = PCIS(I1(JL),I2(JL),I3(JL))
+ !
+ DO JMOD_CCN = 1, NMOD_CCN
+ ZNFS(JL,JMOD_CCN) = PNFS(I1(JL),I2(JL),I3(JL),JMOD_CCN)
+ ENDDO
+ ZZNHS(JL) = ZNHS(I1(JL),I2(JL),I3(JL))
+ ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
+ ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
+ ZPRES(JL) = PPABST(I1(JL),I2(JL),I3(JL))
+ ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL))
+ ENDDO
+!
+! PACK : done
+! Prepare computations
+!
+ ALLOCATE( ZLSFACT (INEGT) )
+ ALLOCATE( ZLVFACT (INEGT) )
+ ALLOCATE( ZSI (INEGT) )
+ ALLOCATE( ZTCELSIUS (INEGT) )
+ ALLOCATE( ZLBDAC (INEGT) )
+!
+ ALLOCATE( ZZW (INEGT) ) ; ZZW(:) = 0.0
+ ALLOCATE( ZZX (INEGT) ) ; ZZX(:) = 0.0
+ ALLOCATE( ZZY (INEGT) ) ; ZZY(:) = 0.0
+!
+ ZTCELSIUS(:) = ZZT(:)-XTT ! T [°C]
+ ZZW(:) = ZEXNREF(:)*( XCPD+XCPV*ZRVT(:)+XCL*(ZRCT(:)+ZRRT(:)) &
+ +XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)) )
+ ZLSFACT(:) = (XLSTT+(XCPV-XCI)*ZTCELSIUS(:))/ZZW(:) ! L_s/(Pi_ref*C_ph)
+ ZLVFACT(:) = (XLVTT+(XCPV-XCL)*ZTCELSIUS(:))/ZZW(:) ! L_v/(Pi_ref*C_ph)
+!
+ ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) ) ! es_i
+ ZSI(:) = ZRVT(:)*(ZPRES(:)-ZZW(:))/((XMV/XMD)*ZZW(:)) ! Saturation over ice
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 2. Haze homogeneous freezing
+! ------------------------
+!
+ if ( nbumod == kmi .and. lbu_enable .and. ohhoni .and. nmod_ccn > 0 ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HONH', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'HONH', prvs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'HONH', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HONH', pcis(:, :, :) * prhodj(:, :, :) )
+ if ( nmod_ccn > 0 ) then
+ do jl = 1, nmod_ccn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
+ call Budget_store_init( tbudgets(idx), 'HONH', pnfs(:, :, :, jl) * prhodj(:, :, :) )
+ end do
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_hom_haze), 'HONH', znhs(:, :, :) * prhodj(:, :, :) )
+ end if
+ end if
+ end if
+!
+! Compute the haze homogeneous nucleation source: RHHONI
+!
+ IF( OHHONI .AND. NMOD_CCN.GT.0 ) THEN
+
+! Sum of the available CCN
+ ALLOCATE( ZFREECCN(INEGT) )
+ ALLOCATE( ZCCNFROZEN(INEGT) )
+ ZFREECCN(:)=0.
+ ZCCNFROZEN(:)=0.
+ DO JMOD_CCN = 1, NMOD_CCN
+ ZFREECCN(:) = ZFREECCN(:) + ZNFS(:,JMOD_CCN)
+ END DO
+!
+ ALLOCATE(ZW_NU(INEGT))
+ DO JL=1,INEGT
+ ZW_NU(JL) = PW_NU(I1(JL),I2(JL),I3(JL))
+ END DO
+!
+ ZZW(:) = 0.0
+ ZZX(:) = 0.0
+ ZEPS = XMV / XMD
+ ZZY(:) = XCRITSAT1_HONH - & ! Critical Sat.
+ (MIN( XTMAX_HONH,MAX( XTMIN_HONH,ZZT(:) ) )/XCRITSAT2_HONH)
+!
+ ALLOCATE(ZLS(INEGT))
+ ALLOCATE(ZPSI1(INEGT))
+ ALLOCATE(ZPSI2(INEGT))
+ ALLOCATE(ZTAU(INEGT))
+ ALLOCATE(ZBFACT(INEGT))
+!
+ WHERE( (ZZT(:)<XTT-35.0) .AND. (ZSI(:)>ZZY(:)) )
+ ZLS(:) = XLSTT+(XCPV-XCI)*ZTCELSIUS(:) ! Ls
+!
+ ZPSI1(:) = ZZY(:) * (XG/(XRD*ZZT(:)))*(ZEPS*ZLS(:)/(XCPD*ZZT(:))-1.)
+! ! Psi1 (a1*Scr in KL01)
+! BV correction PSI2 enlever 1/ZEPS ?
+! ZPSI2(:) = ZSI(:) * (1.0/ZEPS+1.0/ZRVT(:)) + &
+ ZPSI2(:) = ZSI(:) * (1.0/ZRVT(:)) + &
+ ZZY(:) * ((ZLS(:)/ZZT(:))**2)/(XCPD*XRV)
+! ! Psi2 (a2+a3*Scr in KL01)
+ ZTAU(:) = 1.0 / ( MAX( XC1_HONH,XC1_HONH*(XC2_HONH-XC3_HONH*ZZT(:)) ) *&
+ ABS( (XDLNJODT1_HONH - XDLNJODT2_HONH*ZZT(:)) * &
+ ((ZPRES(:)/XP00)**(XRD/XCPD))*ZTHS(:) ) )
+!
+ ZBFACT(:) = (XRHOI_HONH/ZRHODREF(:)) * (ZSI(:)/(ZZY(:)-1.0)) &
+! BV correction ZBFACT enlever 1/ZEPS ?
+! * (1.0/ZRVT(:)+1.0/ZEPS) &
+ * (1.0/ZRVT(:)) &
+ / (XCOEF_DIFVAP_HONH*(ZZT(:)**XCEXP_DIFVAP_HONH /ZPRES(:)))
+!
+! BV correction ZZX rho_i{-1} ?
+! ZZX(:) = MAX( MIN( XRHOI_HONH*ZBFACT(:)**1.5 * (ZPSI1(:)/ZPSI2(:)) &
+ ZZX(:) = MAX( MIN( (1/XRHOI_HONH)*ZBFACT(:)**1.5 * (ZPSI1(:)/ZPSI2(:)) &
+! BV correction ZZX PTSTEP wrong place ?
+! * (ZW_NU(:)/SQRT(ZTAU(:))), ZNFS(:,JMOD_CCN) )/PTSTEP , 0.)
+ * (ZW_NU(:)/SQRT(ZTAU(:)))/PTSTEP , ZFREECCN(:) ) , 0.)
+!
+ ZZW(:) = MIN( XRCOEF_HONH*ZZX(:)*(ZTAU(:)/ZBFACT(:))**1.5 , ZRVS(:) )
+ END WHERE
+!
+! Apply the changes to ZNFS,
+ DO JMOD_CCN = 1, NMOD_CCN
+ WHERE(ZFREECCN(:)>1.)
+ ZCCNFROZEN(:) = ZZX(:) * ZNFS(:,JMOD_CCN)/ZFREECCN(:)
+ ZNFS(:,JMOD_CCN) = ZNFS(:,JMOD_CCN) - ZCCNFROZEN(:)
+ END WHERE
+ ZW(:,:,:) = PNFS(:,:,:,JMOD_CCN)
+ PNFS(:,:,:,JMOD_CCN)=UNPACK( ZNFS(:,JMOD_CCN), MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:))
+ END DO
+ ZZNHS(:) = ZZNHS(:) + ZZX(:)
+ ZNHS(:,:,:) = UNPACK( ZZNHS(:), MASK=GNEGT(:,:,:),FIELD=0.0)
+ PNHS(:,:,:) = ZNHS(:,:,:)
+!
+ DEALLOCATE(ZFREECCN)
+ DEALLOCATE(ZCCNFROZEN)
+ DEALLOCATE(ZLS)
+ DEALLOCATE(ZPSI1)
+ DEALLOCATE(ZPSI2)
+ DEALLOCATE(ZTAU)
+ DEALLOCATE(ZBFACT)
+ DEALLOCATE(ZW_NU)
+!
+ ZRVS(:) = ZRVS(:) - ZZW(:)
+ ZRIS(:) = ZRIS(:) + ZZW(:)
+ ZTHS(:) = ZTHS(:) + ZZW(:) * (ZLSFACT(:)-ZLVFACT(:)) ! f(L_s*(RHHONI))
+ ZCIS(:) = ZCIS(:) + ZZX(:)
+!
+ END IF ! OHHONI
+!
+! Budget storage
+ if ( nbumod == kmi .and. lbu_enable .and. ohhoni .and. nmod_ccn > 0 ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HONH', &
+ Unpack( zths(:), mask = gnegt(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'HONH', &
+ Unpack( zrvs(:), mask = gnegt(:, :, :), field = prvs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'HONH', &
+ Unpack( zris(:), mask = gnegt(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HONH', &
+ Unpack( zcis(:), mask = gnegt(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ if ( nmod_ccn > 0 ) then
+ do jl = 1, nmod_ccn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
+ call Budget_store_end( tbudgets(idx), 'HONH', &
+ Unpack( znfs(:, jl), mask = gnegt(:, :, :), field = pnfs(:, :, :, jl) ) * prhodj(:, :, :) )
+ end do
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_hom_haze), 'HONH', &
+ Unpack( zznhs(:), mask = gnegt(:, :, :), field = znhs(:, :, :) ) * prhodj(:, :, :) )
+ end if
+ end if
+ end if
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 3. Cloud droplets homogeneous freezing
+! -----------------------------------
+!
+!
+! Compute the droplet homogeneous nucleation source: RCHONI
+! -> Pruppacher(1995)
+!
+IF (LWARM) THEN
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HONC', &
+ Unpack( zths(:), mask = gnegt(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'HONC', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'HONC', &
+ Unpack( zris(:), mask = gnegt(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HONC', pccs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HONC', &
+ Unpack( zcis(:), mask = gnegt(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
+ end if
+
+ ZZW(:) = 0.0
+ ZZX(:) = 0.0
+ WHERE( (ZZT(:)<XTT-35.0) .AND. (ZCCT(:)>XCTMIN(2)) .AND. (ZRCT(:)>XRTMIN(2)) )
+ ZLBDAC(:) = XLBC*ZCCT(:) / (ZRCT(:)) ! Lambda_c**3
+ ZZX(:) = 1.0 / ( 1.0 + (XC_HONC/ZLBDAC(:))*PTSTEP* &
+ EXP( XTEXP1_HONC + ZTCELSIUS(:)*( &
+ XTEXP2_HONC + ZTCELSIUS(:)*( &
+ XTEXP3_HONC + ZTCELSIUS(:)*( &
+ XTEXP4_HONC + ZTCELSIUS(:)*XTEXP5_HONC))) ) )**XNUC
+ ZZW(:) = ZCCS(:) * (1.0 - ZZX(:)) ! CCHONI
+!
+ ZCCS(:) = ZCCS(:) - ZZW(:)
+ ZCIS(:) = ZCIS(:) + ZZW(:)
+!
+ ZZW(:) = ZRCS(:) * (1.0 - ZZX(:)) ! RCHONI
+!
+ ZRCS(:) = ZRCS(:) - ZZW(:)
+ ZRIS(:) = ZRIS(:) + ZZW(:)
+ ZTHS(:) = ZTHS(:) + ZZW(:) * (ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(RCHONI))
+ END WHERE
+!
+! Budget storage
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HONC', &
+ Unpack( zths(:), mask = gnegt(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'HONC', &
+ Unpack( zrcs(:), mask = gnegt(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'HONC', &
+ Unpack( zris(:), mask = gnegt(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HONC', &
+ Unpack( zccs(:), mask = gnegt(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HONC', &
+ Unpack( zcis(:), mask = gnegt(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
+ end if
+END IF
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 4. Rain drops homogeneous freezing
+! -------------------------------
+!
+!
+! Compute the drop homogeneous nucleation source: RRHONG
+!
+IF (LWARM .AND. LRAIN) THEN
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HONR', &
+ Unpack( zths(:), mask = gnegt(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'HONR', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'HONR', prgs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'HONR', pcrs(:, :, :) * prhodj(:, :, :) )
+ end if
+ end if
+
+ ZZW(:) = 0.0
+ WHERE( (ZZT(:)<XTT-35.0) .AND. (ZRRS(:)>XRTMIN(3)/PTSTEP) )
+ ZZW(:) = ZRRS(:) ! Instantaneous freezing of the raindrops
+ ZRRS(:) = ZRRS(:) - ZZW(:)
+ ZRGS(:) = ZRGS(:) + ZZW(:)
+ ZTHS(:) = ZTHS(:) + ZZW(:)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(RRHONG))
+!
+ ZCRS(:) = 0.0 ! No more raindrops when T<-35 C
+ ENDWHERE
+!
+! Budget storage
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HONR', &
+ Unpack( zths(:), mask = gnegt(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'HONR', &
+ Unpack( zrrs(:), mask = gnegt(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'HONR', &
+ Unpack( zrgs(:), mask = gnegt(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'HONR', &
+ Unpack( zcrs(:), mask = gnegt(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ end if
+ end if
+END IF
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 4. Unpack variables, clean
+! -----------------------
+!
+!
+! End of homogeneous nucleation processes
+!
+ ZW(:,:,:) = PRVS(:,:,:)
+ PRVS(:,:,:) = UNPACK( ZRVS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PRCS(:,:,:)
+ PRCS(:,:,:) = UNPACK( ZRCS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PRRS(:,:,:)
+ PRRS(:,:,:) = UNPACK( ZRRS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PRIS(:,:,:)
+ PRIS(:,:,:) = UNPACK( ZRIS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PRGS(:,:,:)
+ PRGS(:,:,:) = UNPACK( ZRGS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PTHS(:,:,:)
+ PTHS(:,:,:) = UNPACK( ZTHS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PCCS(:,:,:)
+ PCCS(:,:,:) = UNPACK( ZCCS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PCRS(:,:,:)
+ PCRS(:,:,:) = UNPACK( ZCRS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PCIS(:,:,:)
+ PCIS(:,:,:) = UNPACK( ZCIS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
+!
+ DEALLOCATE(ZRVT)
+ DEALLOCATE(ZRCT)
+ DEALLOCATE(ZRRT)
+ DEALLOCATE(ZRIT)
+ DEALLOCATE(ZRST)
+ DEALLOCATE(ZRGT)
+!
+ DEALLOCATE(ZCCT)
+!
+ DEALLOCATE(ZRVS)
+ DEALLOCATE(ZRCS)
+ DEALLOCATE(ZRRS)
+ DEALLOCATE(ZRIS)
+ DEALLOCATE(ZRGS)
+!
+ DEALLOCATE(ZTHS)
+!
+ DEALLOCATE(ZCCS)
+ DEALLOCATE(ZCRS)
+ DEALLOCATE(ZCIS)
+!
+ DEALLOCATE(ZNFS)
+ DEALLOCATE(ZZNHS)
+!
+ DEALLOCATE(ZRHODREF)
+ DEALLOCATE(ZZT)
+ DEALLOCATE(ZPRES)
+ DEALLOCATE(ZEXNREF)
+!
+ DEALLOCATE(ZLSFACT)
+ DEALLOCATE(ZLVFACT)
+ DEALLOCATE(ZSI)
+ DEALLOCATE(ZTCELSIUS)
+ DEALLOCATE(ZLBDAC)
+!
+ DEALLOCATE(ZZW)
+ DEALLOCATE(ZZX)
+ DEALLOCATE(ZZY)
+!
+END IF ! INEGT>0
+!
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_COLD_HOM_NUCL
diff --git a/src/mesonh/micro/lima_cold_sedimentation.f90 b/src/mesonh/micro/lima_cold_sedimentation.f90
new file mode 100644
index 000000000..6a62652b7
--- /dev/null
+++ b/src/mesonh/micro/lima_cold_sedimentation.f90
@@ -0,0 +1,354 @@
+!MNH_LIC Copyright 2013-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ###################################
+ MODULE MODI_LIMA_COLD_SEDIMENTATION
+! ###################################
+!
+INTERFACE
+ SUBROUTINE LIMA_COLD_SEDIMENTATION (OSEDI, KSPLITG, PTSTEP, KMI, &
+ PZZ, PRHODJ, PRHODREF, &
+ PRIT, PCIT, &
+ PRIS, PRSS, PRGS, PRHS, PCIS, &
+ PINPRS, PINPRG, PINPRH )
+!
+LOGICAL, INTENT(IN) :: OSEDI ! switch to activate the
+ ! cloud ice sedimentation
+INTEGER, INTENT(IN) :: KSPLITG ! Number of small time step
+ ! for ice sedimendation
+REAL, INTENT(IN) :: PTSTEP ! Time step
+INTEGER, INTENT(IN) :: KMI ! Model index
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian (Budgets)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! Ice crystal C. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRGS ! Graupel m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRHS ! Hail m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIS ! Ice crystal C. source
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS ! Snow instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG ! Graupel instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRH ! Hail instant precip
+
+!
+ END SUBROUTINE LIMA_COLD_SEDIMENTATION
+END INTERFACE
+END MODULE MODI_LIMA_COLD_SEDIMENTATION
+!
+!
+! ######################################################################
+ SUBROUTINE LIMA_COLD_SEDIMENTATION (OSEDI, KSPLITG, PTSTEP, KMI, &
+ PZZ, PRHODJ, PRHODREF, &
+ PRIT, PCIT, &
+ PRIS, PRSS, PRGS, PRHS, PCIS, &
+ PINPRS,PINPRG,&
+ PINPRH )
+! ######################################################################
+!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the sediimentation
+!! of primary ice, snow and graupel.
+!!
+!! METHOD
+!! ------
+!! The sedimentation rates are computed with a time spliting technique:
+!! an upstream scheme, written as a difference of non-advective fluxes.
+!! This source term is added to the next coming time step (split-implicit
+!! process).
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!! C. Barthe * LACy * jan. 2014 add budgets
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY : XRHOLW
+USE MODD_NSV
+USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
+USE MODD_PARAM_LIMA, ONLY : XCEXVT, XRTMIN, XCTMIN
+USE MODD_PARAM_LIMA_COLD, ONLY : XLBEXI, XLBI, XDI, &
+ XFSEDRI, XFSEDCI, XFSEDS, XEXSEDS
+USE MODD_PARAM_LIMA_MIXED, ONLY : XFSEDG, XEXSEDG, XFSEDH, XEXSEDH
+!
+use mode_tools, only: Countjv
+!
+IMPLICIT NONE
+!
+
+!
+!* 0.1 Declarations of dummy arguments :
+!
+LOGICAL, INTENT(IN) :: OSEDI ! switch to activate the
+ ! cloud ice sedimentation
+INTEGER, INTENT(IN) :: KSPLITG ! Number of small time step
+ ! for ice sedimendation
+REAL, INTENT(IN) :: PTSTEP ! Time step
+INTEGER, INTENT(IN) :: KMI ! Model index
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian (Budgets)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! Ice crystal C. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRGS ! Graupel m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRHS ! Hail m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIS ! Ice crystal C. source
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS ! Snow instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG ! Graupel instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRH ! Hail instant precip
+
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: JK, JL, JN ! Loop index
+INTEGER :: IIB, IIE, IJB, IJE, IKB, IKE ! Physical domain
+INTEGER :: ISEDIM ! Case number of sedimentation
+!
+LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: GSEDIM ! Test where to compute the SED processes
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: ZW, & ! Work array
+ ZWSEDR, & ! Sedimentation of MMR
+ ZWSEDC ! Sedimentation of number conc.
+!
+REAL, DIMENSION(:), ALLOCATABLE &
+ :: ZRIS, & ! Pristine ice m.r. source
+ ZCIS, & ! Pristine ice conc. source
+ ZRSS, & ! Snow/aggregate m.r. source
+ ZRGS, & ! Graupel/hail m.r. source
+ ZRHS, & ! Graupel/hail m.r. source
+ ZRIT, & ! Pristine ice m.r. at t
+ ZCIT, & ! Pristine ice conc. at t
+ ZRHODREF, & ! RHO Dry REFerence
+ ZRHODJ, & ! RHO times Jacobian
+ ZZW, & ! Work array
+ ZZX, & ! Work array
+ ZZY, & ! Work array
+ ZLBDAI, & ! Slope parameter of the ice crystal distr.
+ ZRTMIN
+!
+INTEGER , DIMENSION(SIZE(PRHODREF)) :: I1,I2,I3 ! Indexes for PACK replacement
+!
+REAL :: ZTSPLITG ! Small time step for rain sedimentation
+!
+!
+!-------------------------------------------------------------------------------
+!
+! Physical domain
+!
+IIB=1+JPHEXT
+IIE=SIZE(PZZ,1) - JPHEXT
+IJB=1+JPHEXT
+IJE=SIZE(PZZ,2) - JPHEXT
+IKB=1+JPVEXT
+IKE=SIZE(PZZ,3) - JPVEXT
+!
+! Time splitting and ZRTMIN
+!
+ALLOCATE(ZRTMIN(SIZE(XRTMIN)))
+ZRTMIN(:) = XRTMIN(:) / PTSTEP
+!
+ZTSPLITG= PTSTEP / REAL(KSPLITG)
+!
+PINPRS(:,:) = 0.
+PINPRG(:,:) = 0.
+PINPRH(:,:) = 0.
+!
+! ################################
+! Compute the sedimentation fluxes
+! ################################
+!
+DO JN = 1 , KSPLITG
+ ! Computation only where enough ice, snow, graupel or hail
+ GSEDIM(:,:,:) = .FALSE.
+ GSEDIM(IIB:IIE,IJB:IJE,IKB:IKE) = PRSS(IIB:IIE,IJB:IJE,IKB:IKE)>ZRTMIN(5) &
+ .OR. PRGS(IIB:IIE,IJB:IJE,IKB:IKE)>ZRTMIN(6) &
+ .OR. PRHS(IIB:IIE,IJB:IJE,IKB:IKE)>ZRTMIN(7)
+ IF( OSEDI ) THEN
+ GSEDIM(IIB:IIE,IJB:IJE,IKB:IKE) = GSEDIM(IIB:IIE,IJB:IJE,IKB:IKE) &
+ .OR. PRIS(IIB:IIE,IJB:IJE,IKB:IKE)>ZRTMIN(4)
+ END IF
+!
+ ISEDIM = COUNTJV( GSEDIM(:,:,:),I1(:),I2(:),I3(:))
+ IF( ISEDIM >= 1 ) THEN
+!
+ IF( JN==1 ) THEN
+ IF( OSEDI ) THEN
+ PCIS(:,:,:) = PCIS(:,:,:) * PTSTEP
+ PRIS(:,:,:) = PRIS(:,:,:) * PTSTEP
+ END IF
+ PRSS(:,:,:) = PRSS(:,:,:) * PTSTEP
+ PRGS(:,:,:) = PRGS(:,:,:) * PTSTEP
+ PRHS(:,:,:) = PRHS(:,:,:) * PTSTEP
+ DO JK = IKB , IKE
+ ZW(:,:,JK)=ZTSPLITG/(PZZ(:,:,JK+1)-PZZ(:,:,JK))
+ END DO
+ END IF
+!
+ ALLOCATE(ZRHODREF(ISEDIM))
+ DO JL = 1,ISEDIM
+ ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
+ END DO
+!
+ ALLOCATE(ZZW(ISEDIM)) ; ZZW(:) = 0.0
+ ALLOCATE(ZZX(ISEDIM)) ; ZZX(:) = 0.0
+ ALLOCATE(ZZY(ISEDIM)) ; ZZY(:) = 0.0
+!
+!* 2.21 for pristine ice
+!
+ IF( OSEDI.AND.MAXVAL(PRIS(:,:,:))>ZRTMIN(4) ) THEN
+ ALLOCATE(ZRIS(ISEDIM))
+ ALLOCATE(ZCIS(ISEDIM))
+ ALLOCATE(ZRIT(ISEDIM))
+ ALLOCATE(ZCIT(ISEDIM))
+ ALLOCATE(ZLBDAI(ISEDIM))
+ DO JL = 1,ISEDIM
+ ZRIS(JL) = PRIS(I1(JL),I2(JL),I3(JL))
+ ZCIS(JL) = PCIS(I1(JL),I2(JL),I3(JL))
+ ZRIT(JL) = PRIT(I1(JL),I2(JL),I3(JL))
+ ZCIT(JL) = PCIT(I1(JL),I2(JL),I3(JL))
+ END DO
+ ZLBDAI(:) = 1.E10
+ WHERE (ZRIS(:)>XRTMIN(4) .AND. ZCIS(:)>XCTMIN(4))
+ ZLBDAI(:) = ( XLBI*ZCIS(:) / ZRIS(:) )**XLBEXI
+ ZZY(:) = ZRHODREF(:)**(-XCEXVT) * ZLBDAI(:)**(-XDI)
+ ZZW(:) = XFSEDRI * ZRIS(:) * ZZY(:) * ZRHODREF(:)
+ ZZX(:) = XFSEDCI * ZCIS(:) * ZZY(:) * ZRHODREF(:)
+ END WHERE
+ ZWSEDR(:,:,:) = UNPACK( ZZW(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
+ ZWSEDR(:,:,IKB:IKE) = MIN( ZWSEDR(:,:,IKB:IKE), PRIS(:,:,IKB:IKE) * PRHODREF(:,:,IKB:IKE) / ZW(:,:,IKB:IKE) )
+ ZWSEDC(:,:,:) = UNPACK( ZZX(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
+ ZWSEDC(:,:,IKB:IKE) = MIN( ZWSEDC(:,:,IKB:IKE), PCIS(:,:,IKB:IKE) * PRHODREF(:,:,IKB:IKE) / ZW(:,:,IKB:IKE) )
+ DO JK = IKB , IKE
+ PRIS(:,:,JK) = PRIS(:,:,JK) + ZW(:,:,JK)* &
+ (ZWSEDR(:,:,JK+1)-ZWSEDR(:,:,JK))/PRHODREF(:,:,JK)
+ PCIS(:,:,JK) = PCIS(:,:,JK) + ZW(:,:,JK)* &
+ (ZWSEDC(:,:,JK+1)-ZWSEDC(:,:,JK))/PRHODREF(:,:,JK)
+ END DO
+ DEALLOCATE(ZRIS)
+ DEALLOCATE(ZCIS)
+ DEALLOCATE(ZRIT)
+ DEALLOCATE(ZCIT)
+ DEALLOCATE(ZLBDAI)
+ END IF
+!
+!* 2.22 for aggregates
+!
+ ZZW(:) = 0.
+ IF( MAXVAL(PRSS(:,:,:))>XRTMIN(5) ) THEN
+ ALLOCATE(ZRSS(ISEDIM))
+ DO JL = 1,ISEDIM
+ ZRSS(JL) = PRSS(I1(JL),I2(JL),I3(JL))
+ END DO
+ WHERE( ZRSS(:)>XRTMIN(5) )
+ ZZW(:) = XFSEDS * (ZRSS(:)*ZRHODREF(:))**XEXSEDS * ZRHODREF(:)**(-XCEXVT)
+ END WHERE
+ ZWSEDR(:,:,:) = UNPACK( ZZW(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
+ ZWSEDR(:,:,IKB:IKE) = MIN( ZWSEDR(:,:,IKB:IKE), PRSS(:,:,IKB:IKE) * PRHODREF(:,:,IKB:IKE) / ZW(:,:,IKB:IKE) )
+ DO JK = IKB , IKE
+ PRSS(:,:,JK) = PRSS(:,:,JK) + ZW(:,:,JK)* &
+ (ZWSEDR(:,:,JK+1)-ZWSEDR(:,:,JK))/PRHODREF(:,:,JK)
+ END DO
+ DEALLOCATE(ZRSS)
+ ELSE
+ ZWSEDR(:,:,IKB) = 0.0
+ END IF
+!
+ PINPRS(:,:) = PINPRS(:,:) + ZWSEDR(:,:,IKB)/XRHOLW/KSPLITG ! in m/s
+!
+!* 2.23 for graupeln
+!
+ ZZW(:) = 0.
+ IF( MAXVAL(PRGS(:,:,:))>XRTMIN(6) ) THEN
+ ALLOCATE(ZRGS(ISEDIM))
+ DO JL = 1,ISEDIM
+ ZRGS(JL) = PRGS(I1(JL),I2(JL),I3(JL))
+ END DO
+ WHERE( ZRGS(:)>XRTMIN(6) )
+ ZZW(:) = XFSEDG * (ZRGS(:)*ZRHODREF(:))**XEXSEDG * ZRHODREF(:)**(-XCEXVT)
+ END WHERE
+ ZWSEDR(:,:,:) = UNPACK( ZZW(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
+ ZWSEDR(:,:,IKB:IKE) = MIN( ZWSEDR(:,:,IKB:IKE), PRGS(:,:,IKB:IKE) * PRHODREF(:,:,IKB:IKE) / ZW(:,:,IKB:IKE) )
+ DO JK = IKB , IKE
+ PRGS(:,:,JK) = PRGS(:,:,JK) + ZW(:,:,JK)* &
+ (ZWSEDR(:,:,JK+1)-ZWSEDR(:,:,JK))/PRHODREF(:,:,JK)
+ END DO
+ DEALLOCATE(ZRGS)
+ ELSE
+ ZWSEDR(:,:,IKB) = 0.0
+ END IF
+!
+ PINPRG(:,:) = PINPRG(:,:) + ZWSEDR(:,:,IKB)/XRHOLW/KSPLITG ! in m/s
+!
+!* 2.23 for hail
+!
+ ZZW(:) = 0.
+ IF( MAXVAL(PRHS(:,:,:))>XRTMIN(7) ) THEN
+ ALLOCATE(ZRHS(ISEDIM))
+ DO JL = 1,ISEDIM
+ ZRHS(JL) = PRHS(I1(JL),I2(JL),I3(JL))
+ END DO
+ WHERE( ZRHS(:)>XRTMIN(7) )
+ ZZW(:) = XFSEDH * (ZRHS(:)*ZRHODREF(:))**XEXSEDH * ZRHODREF(:)**(-XCEXVT)
+ END WHERE
+ ZWSEDR(:,:,:) = UNPACK( ZZW(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
+ ZWSEDR(:,:,IKB:IKE) = MIN( ZWSEDR(:,:,IKB:IKE), PRHS(:,:,IKB:IKE) * PRHODREF(:,:,IKB:IKE) / ZW(:,:,IKB:IKE) )
+ DO JK = IKB , IKE
+ PRHS(:,:,JK) = PRHS(:,:,JK) + ZW(:,:,JK)* &
+ (ZWSEDR(:,:,JK+1)-ZWSEDR(:,:,JK))/PRHODREF(:,:,JK)
+ END DO
+ DEALLOCATE(ZRHS)
+ ELSE
+ ZWSEDR(:,:,IKB) = 0.0
+ END IF
+!
+ PINPRH(:,:) = PINPRH(:,:) + ZWSEDR(:,:,IKB)/XRHOLW/KSPLITG ! in m/s
+!
+!* 2.24 End of sedimentation
+!
+ DEALLOCATE(ZRHODREF)
+ DEALLOCATE(ZZW)
+ DEALLOCATE(ZZX)
+ DEALLOCATE(ZZY)
+ IF( JN==KSPLITG ) THEN
+ IF( OSEDI ) THEN
+ PRIS(:,:,:) = PRIS(:,:,:) / PTSTEP
+ PCIS(:,:,:) = PCIS(:,:,:) / PTSTEP
+ END IF
+ PRSS(:,:,:) = PRSS(:,:,:) / PTSTEP
+ PRGS(:,:,:) = PRGS(:,:,:) / PTSTEP
+ PRHS(:,:,:) = PRHS(:,:,:) / PTSTEP
+ END IF
+ END IF
+END DO
+!++cb++
+DEALLOCATE(ZRTMIN)
+!--cb--
+!
+END SUBROUTINE LIMA_COLD_SEDIMENTATION
+!
+!-------------------------------------------------------------------------------
diff --git a/src/mesonh/micro/lima_cold_slow_processes.f90 b/src/mesonh/micro/lima_cold_slow_processes.f90
new file mode 100644
index 000000000..9fcacdd5a
--- /dev/null
+++ b/src/mesonh/micro/lima_cold_slow_processes.f90
@@ -0,0 +1,537 @@
+!MNH_LIC Copyright 2013-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! #####################
+ MODULE MODI_LIMA_COLD_SLOW_PROCESSES
+! #####################
+!
+INTERFACE
+ SUBROUTINE LIMA_COLD_SLOW_PROCESSES (PTSTEP, KMI, PZZ, PRHODJ, &
+ PRHODREF, PEXNREF, PPABST, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PTHS, PRVS, PRIS, PRSS, &
+ PCIT, PCIS )
+!
+REAL, INTENT(IN) :: PTSTEP ! Time step
+INTEGER, INTENT(IN) :: KMI ! Model index
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! Ice crystal C. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIS ! Ice crystal C. source
+!
+END SUBROUTINE LIMA_COLD_SLOW_PROCESSES
+END INTERFACE
+END MODULE MODI_LIMA_COLD_SLOW_PROCESSES
+!
+! ################################################################################
+ SUBROUTINE LIMA_COLD_SLOW_PROCESSES (PTSTEP, KMI, PZZ, PRHODJ, &
+ PRHODREF, PEXNREF, PPABST, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PTHS, PRVS, PRIS, PRSS, &
+ PCIT, PCIS )
+! ################################################################################
+!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the microphysical sources
+!! for slow cold processes :
+!! - conversion of snow to ice
+!! - deposition of vapor on snow
+!! - conversion of ice to snow (Harrington 1995)
+!! - aggregation of ice on snow
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!! C. Barthe * LACy * jan. 2014 add budgets
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+! P. Wautelet 03/2020: use the new data structures and subroutines for budgets
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+use modd_budget, only: lbu_enable, nbumod, &
+ lbudget_th, lbudget_rv, lbudget_ri, lbudget_rs, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RI, NBUDGET_RS, NBUDGET_SV1, &
+ tbudgets
+USE MODD_CST, ONLY: XP00, XRD, XRV, XMV, XMD, XCPD, XCPV, &
+ XCL, XCI, XTT, XLSTT, XALPI, XBETAI, XGAMI
+USE MODD_NSV, ONLY: NSV_LIMA_NI
+USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
+USE MODD_PARAM_LIMA, ONLY: LSNOW, XRTMIN, XCTMIN, XALPHAI, XALPHAS, &
+ XNUI
+USE MODD_PARAM_LIMA_COLD, ONLY: XLBI, XLBEXI, XLBS, XLBEXS, XBI, XCXS, XCCS, &
+ XLBDAS_MAX, XDSCNVI_LIM, XLBDASCNVI_MAX, &
+ XC0DEPSI, XC1DEPSI, XR0DEPSI, XR1DEPSI, &
+ XSCFAC, X1DEPS, X0DEPS, XEX1DEPS, XEX0DEPS, &
+ XDICNVS_LIM, XLBDAICNVS_LIM, &
+ XC0DEPIS, XC1DEPIS, XR0DEPIS, XR1DEPIS, &
+ XCOLEXIS, XAGGS_CLARGE1, XAGGS_CLARGE2, &
+ XAGGS_RLARGE1, XAGGS_RLARGE2
+
+use mode_budget, only: Budget_store_init, Budget_store_end
+use mode_tools, only: Countjv
+
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, INTENT(IN) :: PTSTEP ! Time step
+INTEGER, INTENT(IN) :: KMI ! Model index
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! Ice crystal C. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIS ! Ice crystal C. source
+!
+!* 0.2 Declarations of local variables :
+!
+LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: GMICRO ! Computations only where necessary
+INTEGER :: IMICRO
+INTEGER , DIMENSION(SIZE(GMICRO)) :: I1,I2,I3 ! Used to replace PACK
+INTEGER :: JL ! and PACK intrinsics
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRRT ! Rain water m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRGT ! Graupel/hail m.r. at t
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZCIT ! Pristine ice conc. at t
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZRVS ! Water vapor m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRIS ! Pristine ice m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRSS ! Snow/aggregate m.r. source
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZTHS ! Theta source
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZCIS ! Pristine ice conc. source
+!
+REAL, DIMENSION(:), ALLOCATABLE &
+ :: ZRHODREF, & ! RHO Dry REFerence
+ ZRHODJ, & ! RHO times Jacobian
+ ZZT, & ! Temperature
+ ZPRES, & ! Pressure
+ ZEXNREF, & ! EXNer Pressure REFerence
+ ZZW, & ! Work array
+ ZZX, & ! Work array
+ ZLSFACT, & ! L_s/(Pi_ref*C_ph)
+ ZSSI, & ! Supersaturation over ice
+ ZLBDAI, & ! Slope parameter of the ice crystal distr.
+ ZLBDAS, & ! Slope parameter of the aggregate distr.
+ ZAI, & ! Thermodynamical function
+ ZCJ, & ! used to compute the ventilation coefficient
+ ZKA, & ! Thermal conductivity of the air
+ ZDV, & ! Diffusivity of water vapor in the air
+ ZVISCA ! Viscosity of air
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZZW1 ! Work arrays
+!
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: ZT, ZW ! Temperature
+!
+INTEGER :: IIB, IIE, IJB, IJE, IKB, IKE ! Physical domain
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZRTMIN, ZCTMIN
+!
+!-------------------------------------------------------------------------------
+!
+! Physical domain
+!
+IIB=1+JPHEXT
+IIE=SIZE(PZZ,1) - JPHEXT
+IJB=1+JPHEXT
+IJE=SIZE(PZZ,2) - JPHEXT
+IKB=1+JPVEXT
+IKE=SIZE(PZZ,3) - JPVEXT
+!
+! Physical limitations
+!
+ALLOCATE(ZRTMIN(SIZE(XRTMIN)))
+ALLOCATE(ZCTMIN(SIZE(XCTMIN)))
+ZRTMIN(:) = XRTMIN(:) / PTSTEP
+ZCTMIN(:) = XCTMIN(:) / PTSTEP
+!
+! Temperature
+ZT(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:)/XP00 ) ** (XRD/XCPD)
+!
+! Looking for regions where computations are necessary
+!
+GMICRO(:,:,:) = .FALSE.
+GMICRO(IIB:IIE,IJB:IJE,IKB:IKE) = &
+ PRIT(IIB:IIE,IJB:IJE,IKB:IKE)>XRTMIN(4) .OR. &
+ PRST(IIB:IIE,IJB:IJE,IKB:IKE)>XRTMIN(5)
+!
+IMICRO = COUNTJV( GMICRO(:,:,:),I1(:),I2(:),I3(:))
+!
+IF( IMICRO >= 1 ) THEN
+!
+!------------------------------------------------------------------------------
+!
+!
+!* 1. Optimization : packing variables
+! --------------------------------
+!
+!
+!
+ ALLOCATE(ZRVT(IMICRO))
+ ALLOCATE(ZRCT(IMICRO))
+ ALLOCATE(ZRRT(IMICRO))
+ ALLOCATE(ZRIT(IMICRO))
+ ALLOCATE(ZRST(IMICRO))
+ ALLOCATE(ZRGT(IMICRO))
+!
+ ALLOCATE(ZCIT(IMICRO))
+!
+ ALLOCATE(ZRVS(IMICRO))
+ ALLOCATE(ZRIS(IMICRO))
+ ALLOCATE(ZRSS(IMICRO))
+!
+ ALLOCATE(ZTHS(IMICRO))
+!
+ ALLOCATE(ZCIS(IMICRO))
+!
+ ALLOCATE(ZRHODREF(IMICRO))
+ ALLOCATE(ZZT(IMICRO))
+ ALLOCATE(ZPRES(IMICRO))
+ ALLOCATE(ZEXNREF(IMICRO))
+ DO JL=1,IMICRO
+ ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL))
+ ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
+ ZRRT(JL) = PRRT(I1(JL),I2(JL),I3(JL))
+ ZRIT(JL) = PRIT(I1(JL),I2(JL),I3(JL))
+ ZRST(JL) = PRST(I1(JL),I2(JL),I3(JL))
+ ZRGT(JL) = PRGT(I1(JL),I2(JL),I3(JL))
+!
+ ZCIT(JL) = PCIT(I1(JL),I2(JL),I3(JL))
+!
+ ZRVS(JL) = PRVS(I1(JL),I2(JL),I3(JL))
+ ZRIS(JL) = PRIS(I1(JL),I2(JL),I3(JL))
+ ZRSS(JL) = PRSS(I1(JL),I2(JL),I3(JL))
+!
+ ZTHS(JL) = PTHS(I1(JL),I2(JL),I3(JL))
+!
+ ZCIS(JL) = PCIS(I1(JL),I2(JL),I3(JL))
+!
+ ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
+ ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
+ ZPRES(JL) = PPABST(I1(JL),I2(JL),I3(JL))
+ ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL))
+ ENDDO
+!
+ IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
+ ALLOCATE(ZRHODJ(IMICRO))
+ ZRHODJ(:) = PACK( PRHODJ(:,:,:),MASK=GMICRO(:,:,:) )
+ END IF
+!
+!
+!------------------------------------------------------------------------------
+!
+!
+!* 2. Microphysical computations
+! --------------------------
+!
+!
+ ALLOCATE(ZZW(IMICRO))
+ ALLOCATE(ZZX(IMICRO))
+ ALLOCATE(ZLSFACT(IMICRO))
+ ALLOCATE(ZSSI(IMICRO))
+ ALLOCATE(ZLBDAI(IMICRO))
+ ALLOCATE(ZLBDAS(IMICRO))
+ ALLOCATE(ZAI(IMICRO))
+ ALLOCATE(ZCJ(IMICRO))
+ ALLOCATE(ZKA(IMICRO))
+ ALLOCATE(ZDV(IMICRO))
+ ALLOCATE(ZZW1(IMICRO,7))
+!
+! Preliminary computations
+!
+ ZZW(:) = ZEXNREF(:)*( XCPD+XCPV*ZRVT(:)+XCL*(ZRCT(:)+ZRRT(:)) &
+ +XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)) )
+!
+ ZLSFACT(:) = (XLSTT+(XCPV-XCI)*(ZZT(:)-XTT))/ZZW(:) ! L_s/(Pi_ref*C_ph)
+!
+ ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) )
+ ZSSI(:) = ZRVT(:)*( ZPRES(:)-ZZW(:) ) / ( (XMV/XMD) * ZZW(:) ) - 1.0
+ ! Supersaturation over ice
+! Distribution parameters for ice and snow
+ ZLBDAI(:) = 1.E10
+ WHERE (ZRIT(:)>XRTMIN(4) .AND. ZCIT(:)>XCTMIN(4))
+ ZLBDAI(:) = ( XLBI*ZCIT(:) / ZRIT(:) )**XLBEXI
+ END WHERE
+ ZLBDAS(:) = 1.E10
+ WHERE (ZRST(:)>XRTMIN(5) )
+ ZLBDAS(:) = XLBS*( ZRHODREF(:)*ZRST(:) )**XLBEXS
+ END WHERE
+!
+ ZKA(:) = 2.38E-2 + 0.0071E-2 * ( ZZT(:) - XTT ) ! k_a
+ ZDV(:) = 0.211E-4 * (ZZT(:)/XTT)**1.94 * (XP00/ZPRES(:)) ! D_v
+!
+! Thermodynamical function ZAI = A_i(T,P)
+ ZAI(:) = ( XLSTT + (XCPV-XCI)*(ZZT(:)-XTT) )**2 / (ZKA(:)*XRV*ZZT(:)**2) &
+ + ( XRV*ZZT(:) ) / (ZDV(:)*ZZW(:))
+! ZCJ = c^prime_j/c_i (in the ventilation factor) ( c_i from v(D)=c_i*D^(d_i) )
+ ZCJ(:) = XSCFAC * ZRHODREF(:)**0.3 / SQRT( 1.718E-5+0.0049E-5*(ZZT(:)-XTT) )
+!
+!
+!
+!
+!* 2.1 Conversion of snow to r_i: RSCNVI
+! ----------------------------------------
+!
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'CNVI', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'CNVI', prss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CNVI', pcis(:, :, :) * prhodj(:, :, :) )
+ end if
+
+ WHERE ( ZRST(:)>XRTMIN(5) )
+ ZLBDAS(:) = MIN( XLBDAS_MAX, &
+ XLBS*( ZRHODREF(:)*MAX( ZRST(:),XRTMIN(5) ) )**XLBEXS )
+ END WHERE
+ ZZW(:) = 0.0
+ WHERE ( ZLBDAS(:)<XLBDASCNVI_MAX .AND. (ZRST(:)>XRTMIN(5)) &
+ .AND. (ZSSI(:)<0.0) )
+ ZZW(:) = (ZLBDAS(:)*XDSCNVI_LIM)**(XALPHAS)
+ ZZX(:) = ( -ZSSI(:)/ZAI(:) ) * (XCCS*ZLBDAS(:)**XCXS)/ZRHODREF(:) * (ZZW(:)**XNUI) &
+ * EXP(-ZZW(:))
+!
+ ZZW(:) = MIN( ( XR0DEPSI+XR1DEPSI*ZCJ(:) )*ZZX(:),ZRSS(:) )
+ ZRIS(:) = ZRIS(:) + ZZW(:)
+ ZRSS(:) = ZRSS(:) - ZZW(:)
+!
+ ZZW(:) = ZZW(:)*( XC0DEPSI+XC1DEPSI*ZCJ(:) )/( XR0DEPSI+XR1DEPSI*ZCJ(:) )
+ ZCIS(:) = ZCIS(:) + ZZW(:)
+ END WHERE
+!
+! Budget storage
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'CNVI', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'CNVI', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CNVI', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
+!
+!
+!* 2.2 Deposition of water vapor on r_s: RVDEPS
+! -----------------------------------------------
+!
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'DEPS', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'DEPS', prvs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'DEPS', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ end if
+
+ ZZW(:) = 0.0
+ WHERE ( (ZRST(:)>XRTMIN(5)) .AND. (ZRSS(:)>ZRTMIN(5)) )
+ ZZW(:) = ( ZSSI(:)/(ZRHODREF(:)*ZAI(:)) ) * &
+ ( X0DEPS*ZLBDAS(:)**XEX0DEPS + X1DEPS*ZCJ(:)*ZLBDAS(:)**XEX1DEPS )
+ ZZW(:) = MIN( ZRVS(:),ZZW(:) )*(0.5+SIGN(0.5,ZZW(:))) &
+ - MIN( ZRSS(:),ABS(ZZW(:)) )*(0.5-SIGN(0.5,ZZW(:)))
+ ZRSS(:) = ZRSS(:) + ZZW(:)
+ ZRVS(:) = ZRVS(:) - ZZW(:)
+ ZTHS(:) = ZTHS(:) + ZZW(:)*ZLSFACT(:)
+ END WHERE
+! Budget storage
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'DEPS', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'DEPS', &
+ Unpack( zrvs(:), mask = gmicro(:, :, :), field = prvs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'DEPS', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ end if
+!
+!* 2.3 Conversion of pristine ice to r_s: RICNVS
+! ------------------------------------------------
+!
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'CNVS', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'CNVS', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CNVS', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
+
+ ZZW(:) = 0.0
+ WHERE ( (ZLBDAI(:)<XLBDAICNVS_LIM) .AND. (ZCIT(:)>XCTMIN(4)) &
+ .AND. (ZSSI(:)>0.0) )
+ ZZW(:) = (ZLBDAI(:)*XDICNVS_LIM)**(XALPHAI)
+ ZZX(:) = ( ZSSI(:)/ZAI(:) )*ZCIT(:) * (ZZW(:)**XNUI) *EXP(-ZZW(:))
+!
+! Correction BVIE
+! ZZW(:) = MAX( MIN( ( XR0DEPIS + XR1DEPIS*ZCJ(:) )*ZZX(:)/ZRHODREF(:) &
+ ZZW(:) = MAX( MIN( ( XR0DEPIS + XR1DEPIS*ZCJ(:) )*ZZX(:) &
+ ,ZRIS(:) ) + ZRTMIN(5), ZRTMIN(5) ) - ZRTMIN(5)
+ ZRIS(:) = ZRIS(:) - ZZW(:)
+ ZRSS(:) = ZRSS(:) + ZZW(:)
+!
+ ZZW(:) = MIN( ZZW(:)*(( XC0DEPIS+XC1DEPIS*ZCJ(:) ) &
+ /( XR0DEPIS+XR1DEPIS*ZCJ(:) )),ZCIS(:) )
+ ZCIS(:) = ZCIS(:) - ZZW(:)
+ END WHERE
+!
+! Budget storage
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'CNVS', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'CNVS', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CNVS', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
+!
+!
+!* 2.4 Aggregation of r_i on r_s: CIAGGS and RIAGGS
+! ---------------------------------------------------
+!
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'AGGS', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'AGGS', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'AGGS', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
+
+ WHERE ( (ZRIT(:)>XRTMIN(4)) .AND. (ZRST(:)>XRTMIN(5)) .AND. (ZRIS(:)>ZRTMIN(4)) &
+ .AND. (ZCIS(:)>ZCTMIN(4)) )
+ ZZW1(:,3) = (ZLBDAI(:) / ZLBDAS(:))**3
+ ZZW1(:,1) = (ZCIT(:)*(XCCS*ZLBDAS(:)**XCXS)/ZRHODREF(:)*EXP( XCOLEXIS*(ZZT(:)-XTT) )) &
+ / (ZLBDAI(:)**3)
+ ZZW1(:,2) = MIN( ZZW1(:,1)*(XAGGS_CLARGE1+XAGGS_CLARGE2*ZZW1(:,3)),ZCIS(:) )
+ ZCIS(:) = ZCIS(:) - ZZW1(:,2)
+!
+ ZZW1(:,1) = ZZW1(:,1) / ZLBDAI(:)**XBI
+ ZZW1(:,2) = MIN( ZZW1(:,1)*(XAGGS_RLARGE1+XAGGS_RLARGE2*ZZW1(:,3)),ZRIS(:) )
+ ZRIS(:) = ZRIS(:) - ZZW1(:,2)
+ ZRSS(:) = ZRSS(:) + ZZW1(:,2)
+ END WHERE
+! Budget storage
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'AGGS', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'AGGS', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'AGGS', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
+!------------------------------------------------------------------------------
+!
+!
+!* 3. Unpacking & Deallocating
+! ------------------------
+!
+!
+ ZW(:,:,:) = PRVS(:,:,:)
+ PRVS(:,:,:) = UNPACK( ZRVS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PRIS(:,:,:)
+ PRIS(:,:,:) = UNPACK( ZRIS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PRSS(:,:,:)
+ PRSS(:,:,:) = UNPACK( ZRSS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+!
+ ZW(:,:,:) = PCIS(:,:,:)
+ PCIS(:,:,:) = UNPACK( ZCIS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+!
+ ZW(:,:,:) = PTHS(:,:,:)
+ PTHS(:,:,:) = UNPACK( ZTHS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+!
+ DEALLOCATE(ZRVT)
+ DEALLOCATE(ZRCT)
+ DEALLOCATE(ZRRT)
+ DEALLOCATE(ZRIT)
+ DEALLOCATE(ZRST)
+ DEALLOCATE(ZRGT)
+ DEALLOCATE(ZCIT)
+ DEALLOCATE(ZRVS)
+ DEALLOCATE(ZRIS)
+ DEALLOCATE(ZRSS)
+ DEALLOCATE(ZTHS)
+ DEALLOCATE(ZCIS)
+ DEALLOCATE(ZRHODREF)
+ DEALLOCATE(ZZT)
+ DEALLOCATE(ZPRES)
+ DEALLOCATE(ZEXNREF)
+ DEALLOCATE(ZZW)
+ DEALLOCATE(ZZX)
+ DEALLOCATE(ZLSFACT)
+ DEALLOCATE(ZSSI)
+ DEALLOCATE(ZLBDAI)
+ DEALLOCATE(ZLBDAS)
+ DEALLOCATE(ZAI)
+ DEALLOCATE(ZCJ)
+ DEALLOCATE(ZKA)
+ DEALLOCATE(ZDV)
+ DEALLOCATE(ZZW1)
+ IF (NBUMOD==KMI .AND. LBU_ENABLE) DEALLOCATE(ZRHODJ)
+!
+END IF
+!
+!++cb++
+DEALLOCATE(ZRTMIN)
+DEALLOCATE(ZCTMIN)
+!--cb--
+!
+END SUBROUTINE LIMA_COLD_SLOW_PROCESSES
+
diff --git a/src/mesonh/micro/lima_compute_cloud_fractions.f90 b/src/mesonh/micro/lima_compute_cloud_fractions.f90
new file mode 100644
index 000000000..ce1cedeee
--- /dev/null
+++ b/src/mesonh/micro/lima_compute_cloud_fractions.f90
@@ -0,0 +1,173 @@
+!MNH_LIC Copyright 2019-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-------------------------------------------------------------------------------
+!#######################################
+MODULE MODI_LIMA_COMPUTE_CLOUD_FRACTIONS
+!#######################################
+ INTERFACE
+ SUBROUTINE LIMA_COMPUTE_CLOUD_FRACTIONS (KIB, KIE, KJB, KJE, KKB, KKE, KKL, &
+ PCCT, PRCT, &
+ PCRT, PRRT, &
+ PCIT, PRIT, &
+ PRST, PRGT, PRHT, &
+ PCLDFR, PICEFR, PPRCFR )
+ INTEGER, INTENT(IN) :: KIB !
+ INTEGER, INTENT(IN) :: KIE !
+ INTEGER, INTENT(IN) :: KJB !
+ INTEGER, INTENT(IN) :: KJE !
+ INTEGER, INTENT(IN) :: KKB !
+ INTEGER, INTENT(IN) :: KKE !
+ INTEGER, INTENT(IN) :: KKL !
+ !
+ REAL, DIMENSION(:,:,:),INTENT(IN) :: PCCT !
+ REAL, DIMENSION(:,:,:),INTENT(IN) :: PRCT !
+ !
+ REAL, DIMENSION(:,:,:),INTENT(IN) :: PCRT !
+ REAL, DIMENSION(:,:,:),INTENT(IN) :: PRRT !
+ !
+ REAL, DIMENSION(:,:,:),INTENT(IN) :: PCIT !
+ REAL, DIMENSION(:,:,:),INTENT(IN) :: PRIT !
+ !
+ REAL, DIMENSION(:,:,:),INTENT(IN) :: PRST !
+ REAL, DIMENSION(:,:,:),INTENT(IN) :: PRGT !
+ REAL, DIMENSION(:,:,:),INTENT(IN) :: PRHT !
+ !
+ REAL, DIMENSION(:,:,:),INTENT(INOUT) :: PCLDFR !
+ REAL, DIMENSION(:,:,:),INTENT(INOUT) :: PICEFR !
+ REAL, DIMENSION(:,:,:),INTENT(INOUT) :: PPRCFR !
+ !
+ END SUBROUTINE LIMA_COMPUTE_CLOUD_FRACTIONS
+ END INTERFACE
+END MODULE MODI_LIMA_COMPUTE_CLOUD_FRACTIONS
+!
+!
+!################################################################
+SUBROUTINE LIMA_COMPUTE_CLOUD_FRACTIONS (KIB, KIE, KJB, KJE, KKB, KKE, KKL, &
+ PCCT, PRCT, &
+ PCRT, PRRT, &
+ PCIT, PRIT, &
+ PRST, PRGT, PRHT, &
+ PCLDFR, PICEFR, PPRCFR )
+!################################################################
+!
+!!
+!! PURPOSE
+!! -------
+!! Compute cloud, ice and precipitating fractions
+!!
+!! AUTHOR
+!! ------
+!! B. Vié * CNRM *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 06/03/2019
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAM_LIMA, ONLY : XCTMIN, XRTMIN
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KIB !
+INTEGER, INTENT(IN) :: KIE !
+INTEGER, INTENT(IN) :: KJB !
+INTEGER, INTENT(IN) :: KJE !
+INTEGER, INTENT(IN) :: KKB !
+INTEGER, INTENT(IN) :: KKE !
+INTEGER, INTENT(IN) :: KKL !
+!
+REAL, DIMENSION(:,:,:),INTENT(IN) :: PCCT !
+REAL, DIMENSION(:,:,:),INTENT(IN) :: PRCT !
+!
+REAL, DIMENSION(:,:,:),INTENT(IN) :: PCRT !
+REAL, DIMENSION(:,:,:),INTENT(IN) :: PRRT !
+!
+REAL, DIMENSION(:,:,:),INTENT(IN) :: PCIT !
+REAL, DIMENSION(:,:,:),INTENT(IN) :: PRIT !
+!
+REAL, DIMENSION(:,:,:),INTENT(IN) :: PRST !
+REAL, DIMENSION(:,:,:),INTENT(IN) :: PRGT !
+REAL, DIMENSION(:,:,:),INTENT(IN) :: PRHT !
+!
+REAL, DIMENSION(:,:,:),INTENT(INOUT) :: PCLDFR !
+REAL, DIMENSION(:,:,:),INTENT(INOUT) :: PICEFR !
+REAL, DIMENSION(:,:,:),INTENT(INOUT) :: PPRCFR !
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: JI, JJ, JK
+!
+!-------------------------------------------------------------------------------
+!
+! CLOUD FRACTIONS
+! ---------------
+!
+! Liquid cloud fraction is kept from input data, except where PCLDFR=0 and rc>0
+WHERE(PCLDFR(:,:,:)<1.E-10 .AND. PRCT(:,:,:)>XRTMIN(2) .AND. PCCT(:,:,:)>XCTMIN(2)) PCLDFR(:,:,:)=1.
+!
+! Ice cloud fraction is currently 0 or 1
+PICEFR(:,:,:)=0.
+WHERE(PICEFR(:,:,:)<1.E-10 .AND. PRIT(:,:,:)>XRTMIN(4) .AND. PCIT(:,:,:)>XCTMIN(4)) PICEFR(:,:,:)=1.
+!
+! Precipitation fraction
+!!$PPRCFR(:,:,:) = MAX(PCLDFR(:,:,:),PICEFR(:,:,:))
+!!$DO JI = KIB,KIE
+!!$ DO JJ = KJB, KJE
+!!$ DO JK=KKE-KKL, KKB, -KKL
+!!$ IF ( (PRRT(JI,JJ,JK).GT.XRTMIN(3) .AND. PCRT(JI,JJ,JK).GT.XCTMIN(3)) .OR. &
+!!$ PRST(JI,JJ,JK).GT.XRTMIN(5) .OR. &
+!!$ PRGT(JI,JJ,JK).GT.XRTMIN(6) .OR. &
+!!$ PRHT(JI,JJ,JK).GT.XRTMIN(7) ) THEN
+!!$ PPRCFR(JI,JJ,JK)=MAX(PPRCFR(JI,JJ,JK),PPRCFR(JI,JJ,JK+KKL))
+!!$ IF (PPRCFR(JI,JJ,JK)==0) THEN
+!!$ PPRCFR(JI,JJ,JK)=1.
+!!$ END IF
+!!$ ELSE
+!!$ !PPRCFR(JI,JJ,JK)=0.
+!!$ END IF
+!!$ END DO
+!!$ END DO
+!!$END DO
+!!$
+!!$PPRCFR(:,:,:) = MAX(PCLDFR(:,:,:),PICEFR(:,:,:))
+!!$DO JI = KIB,KIE
+!!$ DO JJ = KJB, KJE
+!!$ DO JK=KKE-KKL, KKB, -KKL
+!!$ IF ( (PRRT(JI,JJ,JK).GT.0. .AND. PCRT(JI,JJ,JK).GT.0.) .OR. &
+!!$ PRST(JI,JJ,JK).GT.0. .OR. &
+!!$ PRGT(JI,JJ,JK).GT.0. .OR. &
+!!$ PRHT(JI,JJ,JK).GT.0. ) THEN
+!!$ PPRCFR(JI,JJ,JK)=MAX(PPRCFR(JI,JJ,JK),PPRCFR(JI,JJ,JK+KKL))
+!!$ IF (PPRCFR(JI,JJ,JK)==0) THEN
+!!$ PPRCFR(JI,JJ,JK)=1.
+!!$ END IF
+!!$ ELSE
+!!$ !PPRCFR(JI,JJ,JK)=0.
+!!$ END IF
+!!$ END DO
+!!$ END DO
+!!$END DO
+!!$
+!!$PPRCFR(:,:,:) = 0.
+!!$WHERE ( (PRRT(:,:,:).GT.XRTMIN(3) .AND. PCRT(:,:,:).GT.XCTMIN(3)) .OR. &
+!!$ PRST(:,:,:).GT.XRTMIN(5) .OR. &
+!!$ PRGT(:,:,:).GT.XRTMIN(6) .OR. &
+!!$ PRHT(:,:,:).GT.XRTMIN(7) ) PPRCFR(:,:,:) = 1.
+!!$
+PPRCFR(:,:,:) = 0.
+WHERE ( (PRRT(:,:,:).GT.0. .AND. PCRT(:,:,:).GT.0.) .OR. &
+ PRST(:,:,:).GT.0. .OR. &
+ PRGT(:,:,:).GT.0. .OR. &
+ PRHT(:,:,:).GT.0. ) PPRCFR(:,:,:) = 1.
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_COMPUTE_CLOUD_FRACTIONS
diff --git a/src/mesonh/micro/lima_conversion_melting_snow.f90 b/src/mesonh/micro/lima_conversion_melting_snow.f90
new file mode 100644
index 000000000..ff5a69146
--- /dev/null
+++ b/src/mesonh/micro/lima_conversion_melting_snow.f90
@@ -0,0 +1,121 @@
+!MNH_LIC Copyright 2018-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-------------------------------------------------------------------------------
+! #################################
+ MODULE MODI_LIMA_CONVERSION_MELTING_SNOW
+! #################################
+!
+INTERFACE
+ SUBROUTINE LIMA_CONVERSION_MELTING_SNOW (LDCOMPUTE, &
+ PRHODREF, PPRES, PT, PKA, PDV, PCJ, &
+ PRVT, PRST, PLBDS, &
+ P_RS_CMEL )
+!
+LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference Exner function
+REAL, DIMENSION(:), INTENT(IN) :: PPRES !
+REAL, DIMENSION(:), INTENT(IN) :: PT !
+REAL, DIMENSION(:), INTENT(IN) :: PKA !
+REAL, DIMENSION(:), INTENT(IN) :: PDV !
+REAL, DIMENSION(:), INTENT(IN) :: PCJ !
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRVT !
+REAL, DIMENSION(:), INTENT(IN) :: PRST ! Cloud water C. at t
+REAL, DIMENSION(:), INTENT(IN) :: PLBDS !
+!
+REAL, DIMENSION(:), INTENT(OUT) :: P_RS_CMEL
+!
+END SUBROUTINE LIMA_CONVERSION_MELTING_SNOW
+END INTERFACE
+END MODULE MODI_LIMA_CONVERSION_MELTING_SNOW
+!
+! ##############################################################################
+ SUBROUTINE LIMA_CONVERSION_MELTING_SNOW (LDCOMPUTE, &
+ PRHODREF, PPRES, PT, PKA, PDV, PCJ, &
+ PRVT, PRST, PLBDS, &
+ P_RS_CMEL )
+! ##############################################################################
+!
+!! PURPOSE
+!! -------
+!! Compute the conversion-melting of snow into graupel
+!!
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * CNRM *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 15/03/2018
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY : XTT, XMV, XMD, XLVTT, XCPV, XCL, XESTT, XRV
+USE MODD_PARAM_LIMA, ONLY : XRTMIN
+USE MODD_PARAM_LIMA_MIXED, ONLY : XFSCVMG
+USE MODD_PARAM_LIMA_COLD, ONLY : X0DEPS, XEX0DEPS, X1DEPS, XEX1DEPS
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference Exner function
+REAL, DIMENSION(:), INTENT(IN) :: PPRES !
+REAL, DIMENSION(:), INTENT(IN) :: PT !
+REAL, DIMENSION(:), INTENT(IN) :: PKA !
+REAL, DIMENSION(:), INTENT(IN) :: PDV !
+REAL, DIMENSION(:), INTENT(IN) :: PCJ !
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRVT !
+REAL, DIMENSION(:), INTENT(IN) :: PRST ! Cloud water C. at t
+REAL, DIMENSION(:), INTENT(IN) :: PLBDS !
+!
+REAL, DIMENSION(:), INTENT(OUT) :: P_RS_CMEL
+!
+!* 0.2 Declarations of local variables :
+!
+REAL, DIMENSION(SIZE(PRST)) :: ZW ! work arrays
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 1. Conversion-melting of snow
+! --------------------------
+!
+!
+P_RS_CMEL(:)=0.
+!
+ZW(:) = 0.0
+WHERE( (PRST(:)>XRTMIN(5)) .AND. (PT(:)>XTT) .AND. LDCOMPUTE(:) )
+ ZW(:) = PRVT(:)*PPRES(:)/((XMV/XMD)+PRVT(:)) ! Vapor pressure
+ ZW(:) = PKA(:)*(XTT-PT(:)) + &
+ ( PDV(:)*(XLVTT + ( XCPV - XCL ) * ( PT(:) - XTT )) &
+ *(XESTT-ZW(:))/(XRV*PT(:)) )
+!
+! compute RSMLT
+!
+ ZW(:) = XFSCVMG*MAX( 0.0,( -ZW(:) * &
+ ( X0DEPS* PLBDS(:)**XEX0DEPS + &
+ X1DEPS*PCJ(:)*PLBDS(:)**XEX1DEPS ) ))!- &
+! On ne tient pas compte de la collection de pluie et gouttelettes par la neige si T>0 !!!!
+! Note that no heat is exchanged because the graupeln produced are still icy!!!
+ P_RS_CMEL(:) = - ZW(:)
+!
+END WHERE
+!
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_CONVERSION_MELTING_SNOW
diff --git a/src/mesonh/micro/lima_droplets_accretion.f90 b/src/mesonh/micro/lima_droplets_accretion.f90
new file mode 100644
index 000000000..8996b5425
--- /dev/null
+++ b/src/mesonh/micro/lima_droplets_accretion.f90
@@ -0,0 +1,160 @@
+!MNH_LIC Copyright 2018-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-------------------------------------------------------------------------------
+! #################################
+ MODULE MODI_LIMA_DROPLETS_ACCRETION
+! #################################
+!
+INTERFACE
+ SUBROUTINE LIMA_DROPLETS_ACCRETION (LDCOMPUTE, &
+ PRHODREF, &
+ PRCT, PRRT, PCCT, PCRT, &
+ PLBDC, PLBDC3, PLBDR, PLBDR3, &
+ P_RC_ACCR, P_CC_ACCR )
+!
+LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference Exner function
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRRT ! Rain m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PCCT ! Cloud water conc. at t
+REAL, DIMENSION(:), INTENT(IN) :: PCRT ! Rain conc. at t
+REAL, DIMENSION(:), INTENT(IN) :: PLBDC !
+REAL, DIMENSION(:), INTENT(IN) :: PLBDC3 !
+REAL, DIMENSION(:), INTENT(IN) :: PLBDR !
+REAL, DIMENSION(:), INTENT(IN) :: PLBDR3 !
+!
+REAL, DIMENSION(:), INTENT(OUT) :: P_RC_ACCR
+REAL, DIMENSION(:), INTENT(OUT) :: P_CC_ACCR
+!
+END SUBROUTINE LIMA_DROPLETS_ACCRETION
+END INTERFACE
+END MODULE MODI_LIMA_DROPLETS_ACCRETION
+!
+! #####################################################################
+ SUBROUTINE LIMA_DROPLETS_ACCRETION (LDCOMPUTE, &
+ PRHODREF, &
+ PRCT, PRRT, PCCT, PCRT, &
+ PLBDC, PLBDC3, PLBDR, PLBDR3, &
+ P_RC_ACCR, P_CC_ACCR )
+! #####################################################################
+!
+!! PURPOSE
+!! -------
+!! Compute the accretion of cloud droplets by rain drops
+!!
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 15/03/2018
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN
+USE MODD_PARAM_LIMA_WARM, ONLY : XLAUTR, XAUTO1, XLAUTR_THRESHOLD, &
+ XACCR4, XACCR5, XACCR3, XACCR2, XACCR1, &
+ XACCR_CLARGE1, XACCR_CLARGE2, XACCR_RLARGE1, XACCR_RLARGE2, &
+ XACCR_CSMALL1, XACCR_CSMALL2, XACCR_RSMALL1, XACCR_RSMALL2
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference Exner function
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRRT ! Rain m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PCCT ! Cloud water conc. at t
+REAL, DIMENSION(:), INTENT(IN) :: PCRT ! Rain conc. at t
+REAL, DIMENSION(:), INTENT(IN) :: PLBDC !
+REAL, DIMENSION(:), INTENT(IN) :: PLBDC3 !
+REAL, DIMENSION(:), INTENT(IN) :: PLBDR !
+REAL, DIMENSION(:), INTENT(IN) :: PLBDR3 !
+!
+REAL, DIMENSION(:), INTENT(OUT) :: P_RC_ACCR
+REAL, DIMENSION(:), INTENT(OUT) :: P_CC_ACCR
+!
+!* 0.2 Declarations of local variables :
+!
+REAL, DIMENSION(SIZE(PRCT)) :: ZW1, ZW2, ZW3, ZW4 ! work arrays
+LOGICAL, DIMENSION(SIZE(PRCT)) :: GACCR
+!
+!-------------------------------------------------------------------------------
+!
+!
+!
+!* 1. Accretion of cloud droplets on rain drops
+! --------------------------------------------
+!
+P_RC_ACCR(:) = 0.0
+P_CC_ACCR(:) = 0.0
+!
+ZW1(:) = 0.0
+ZW2(:) = 0.0
+ZW3(:) = 0.0
+ZW4(:) = 0.0
+!
+WHERE( PRCT(:)>XRTMIN(2) .AND. PCCT(:)>XCTMIN(2) .AND. PRRT(:)>XRTMIN(3) .AND. PCRT(:)>XCTMIN(3) .AND. LDCOMPUTE(:) )
+ ZW2(:) = MAX( 0.0,XLAUTR*PRHODREF(:)*PRCT(:)*(XAUTO1/PLBDC(:)**4-XLAUTR_THRESHOLD) ) ! L
+ ZW4(:) = XACCR1/PLBDR(:)
+END WHERE
+!
+GACCR(:) = LDCOMPUTE(:) .AND. &
+ PRRT(:)>XRTMIN(3) .AND. &
+ PCRT(:)>XCTMIN(3) .AND. &
+ PRCT(:)>XRTMIN(2) .AND. &
+ PCCT(:)>XCTMIN(2) .AND. &
+ (PRRT(:)>1.2*ZW2(:)/PRHODREF(:) .OR. &
+ ZW4(:)>=MAX(XACCR2,XACCR3/(XACCR4/PLBDC(:)-XACCR5)) )
+!
+! Accretion for D>100 10-6 m
+WHERE( GACCR(:).AND.(ZW4(:)>1.E-4) )
+ ZW3(:) = MIN(PLBDC3(:) / PLBDR3(:),1.E15)
+ ZW1(:) = ( PCCT(:)*PCRT(:) / PLBDC3(:) )*PRHODREF(:)
+ ZW2(:) = ZW1(:)*(XACCR_CLARGE1+XACCR_CLARGE2*ZW3(:))
+!
+ P_CC_ACCR(:) = - ZW2(:)
+!
+ ZW1(:) = ( ZW1(:) / PLBDC3(:) )
+ ZW2(:) = ZW1(:)*(XACCR_RLARGE1+XACCR_RLARGE2*ZW3(:))
+!
+ P_RC_ACCR(:) = - ZW2(:)
+END WHERE
+!
+! Accretion for D<100 10-6 m
+WHERE( GACCR(:).AND.(ZW4(:)<=1.E-4) )
+ ZW3(:) = MIN(PLBDC3(:) / PLBDR3(:), 1.E8)
+ ZW1(:) = ( PCCT(:)*PCRT(:) / PLBDC3(:) )*PRHODREF(:)
+ ZW1(:) = ZW1(:)/PLBDC3(:)
+
+ ZW3(:) = ZW3(:)**2
+ ZW2(:) = ZW1(:)*(XACCR_CSMALL1+XACCR_CSMALL2*ZW3(:))
+!
+ P_CC_ACCR(:) = - ZW2(:)
+!
+ ZW1(:) = ZW1(:) / PLBDC3(:)
+ ZW2(:) = ZW1(:)*(XACCR_RSMALL1+XACCR_RSMALL2*ZW3(:))
+!
+ P_RC_ACCR(:) = - ZW2(:)
+END WHERE
+!
+!
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_DROPLETS_ACCRETION
diff --git a/src/mesonh/micro/lima_droplets_autoconversion.f90 b/src/mesonh/micro/lima_droplets_autoconversion.f90
new file mode 100644
index 000000000..044030f79
--- /dev/null
+++ b/src/mesonh/micro/lima_droplets_autoconversion.f90
@@ -0,0 +1,127 @@
+!MNH_LIC Copyright 2018-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-------------------------------------------------------------------------------
+! #################################
+ MODULE MODI_LIMA_DROPLETS_AUTOCONVERSION
+! #################################
+!
+INTERFACE
+ SUBROUTINE LIMA_DROPLETS_AUTOCONVERSION (LDCOMPUTE, &
+ PRHODREF, &
+ PRCT, PCCT, PLBDC, PLBDR, &
+ P_RC_AUTO, P_CC_AUTO, P_CR_AUTO )
+!
+LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference Exner function
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PCCT ! Cloud water conc. at t
+REAL, DIMENSION(:), INTENT(IN) :: PLBDC !
+REAL, DIMENSION(:), INTENT(IN) :: PLBDR !
+!
+REAL, DIMENSION(:), INTENT(OUT) :: P_RC_AUTO
+REAL, DIMENSION(:), INTENT(OUT) :: P_CC_AUTO
+REAL, DIMENSION(:), INTENT(OUT) :: P_CR_AUTO
+!
+END SUBROUTINE LIMA_DROPLETS_AUTOCONVERSION
+END INTERFACE
+END MODULE MODI_LIMA_DROPLETS_AUTOCONVERSION
+!
+! ##########################################################################
+ SUBROUTINE LIMA_DROPLETS_AUTOCONVERSION (LDCOMPUTE, &
+ PRHODREF, &
+ PRCT, PCCT, PLBDC, PLBDR, &
+ P_RC_AUTO, P_CC_AUTO, P_CR_AUTO )
+! ##########################################################################
+!
+!! PURPOSE
+!! -------
+!! Compute the autoconversion of cloud droplets
+!!
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 15/03/2018
+!! B. Vie 02/03/2020 : missing CC process
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN
+USE MODD_PARAM_LIMA_WARM, ONLY : XLAUTR, XAUTO1, XLAUTR_THRESHOLD, &
+ XITAUTR, XAUTO2, XITAUTR_THRESHOLD, &
+ XACCR4, XACCR5, XACCR3, XACCR1, XAC
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference Exner function
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PCCT ! Cloud water conc. at t
+REAL, DIMENSION(:), INTENT(IN) :: PLBDC !
+REAL, DIMENSION(:), INTENT(IN) :: PLBDR !
+!
+REAL, DIMENSION(:), INTENT(OUT) :: P_RC_AUTO
+REAL, DIMENSION(:), INTENT(OUT) :: P_CC_AUTO
+REAL, DIMENSION(:), INTENT(OUT) :: P_CR_AUTO
+!
+!* 0.2 Declarations of local variables :
+!
+REAL, DIMENSION(SIZE(PRCT)) :: ZW1, ZW2, ZW3 ! work arrays
+!
+!-------------------------------------------------------------------------------
+!
+!
+!
+!* 1. Autoconversion of cloud droplets (Berry-Reinhardt parameterization)
+! ----------------------------------------------------------------------
+!
+!
+!
+P_RC_AUTO(:) = 0.0
+P_CC_AUTO(:) = 0.0
+P_CR_AUTO(:) = 0.0
+!
+ZW3(:) = 0.0
+ZW2(:) = 0.0
+ZW1(:) = 0.0
+WHERE( PRCT(:)>XRTMIN(2) .AND. PCCT(:)>XCTMIN(2) .AND. PLBDC(:)>0. .AND. LDCOMPUTE(:) )
+ ZW2(:) = MAX( 0.0, &
+ XLAUTR*PRHODREF(:)*PRCT(:)*(XAUTO1/min(PLBDC(:),1.e9)**4-XLAUTR_THRESHOLD) ) ! L
+!
+ ZW3(:) = MAX( 0.0, &
+ XITAUTR*ZW2(:)*PRCT(:)*(XAUTO2/PLBDC(:)-XITAUTR_THRESHOLD) ) ! L/tau
+!
+ P_RC_AUTO(:) = - ZW3(:)
+!
+ ZW1(:) = MIN( MIN( 1.2E4, &
+ (XACCR4/PLBDC(:)-XACCR5)/XACCR3 ), &
+ PLBDR(:)/XACCR1 ) ! D**-1 threshold diameter for
+ ! switching the autoconversion regimes
+ ! min (80 microns, D_h, D_r)
+ ZW3(:) = ZW3(:) * MAX( 0.0,ZW1(:) )**3 / XAC
+!
+ P_CC_AUTO(:) = -ZW3(:)
+ P_CR_AUTO(:) = ZW3(:)
+!
+END WHERE
+!
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_DROPLETS_AUTOCONVERSION
diff --git a/src/mesonh/micro/lima_droplets_hom_freezing.f90 b/src/mesonh/micro/lima_droplets_hom_freezing.f90
new file mode 100644
index 000000000..db27f466e
--- /dev/null
+++ b/src/mesonh/micro/lima_droplets_hom_freezing.f90
@@ -0,0 +1,145 @@
+!MNH_LIC Copyright 2013-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+! #################################
+ MODULE MODI_LIMA_DROPLETS_HOM_FREEZING
+! #################################
+!
+INTERFACE
+ SUBROUTINE LIMA_DROPLETS_HOM_FREEZING (PTSTEP, LDCOMPUTE, &
+ PT, PLVFACT, PLSFACT, &
+ PRCT, PCCT, PLBDC, &
+ P_TH_HONC, P_RC_HONC, P_CC_HONC, &
+ PA_TH, PA_RC, PA_CC, PA_RI, PA_CI )
+!
+REAL, INTENT(IN) :: PTSTEP
+LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
+!
+REAL, DIMENSION(:), INTENT(IN) :: PT !
+REAL, DIMENSION(:), INTENT(IN) :: PLVFACT !
+REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PCCT ! Cloud water C. at t
+REAL, DIMENSION(:), INTENT(IN) :: PLBDC ! Cloud water lambda
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_HONC
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_HONC
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_HONC
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_TH
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_RC
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_CC
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_RI
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_CI
+!
+END SUBROUTINE LIMA_DROPLETS_HOM_FREEZING
+END INTERFACE
+END MODULE MODI_LIMA_DROPLETS_HOM_FREEZING
+!
+! ##########################################################################
+ SUBROUTINE LIMA_DROPLETS_HOM_FREEZING (PTSTEP, LDCOMPUTE, &
+ PT, PLVFACT, PLSFACT, &
+ PRCT, PCCT, PLBDC, &
+ P_TH_HONC, P_RC_HONC, P_CC_HONC, &
+ PA_TH, PA_RC, PA_CC, PA_RI, PA_CI )
+! ##########################################################################
+!
+!! PURPOSE
+!! -------
+!! Compute the cloud droplets homogeneous freezing rate
+!!
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * CNRM *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 15/03/2018
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY : XTT
+USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, XNUC
+USE MODD_PARAM_LIMA_COLD, ONLY : XC_HONC, XTEXP1_HONC, XTEXP2_HONC, XTEXP3_HONC, &
+ XTEXP4_HONC, XTEXP5_HONC
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, INTENT(IN) :: PTSTEP
+LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
+!
+REAL, DIMENSION(:), INTENT(IN) :: PT !
+REAL, DIMENSION(:), INTENT(IN) :: PLVFACT !
+REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PCCT ! Cloud water C. at t
+REAL, DIMENSION(:), INTENT(IN) :: PLBDC ! Cloud water lambda
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_HONC
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_HONC
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_HONC
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_TH
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_RC
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_CC
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_RI
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_CI
+!
+!* 0.2 Declarations of local variables :
+!
+REAL, DIMENSION(SIZE(PT)) :: ZZW, ZZX, ZZY, ZTCELSIUS
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 1. Cloud droplets homogeneous freezing
+! -----------------------------------
+!
+!
+P_TH_HONC(:) = 0.
+P_RC_HONC(:) = 0.
+P_CC_HONC(:) = 0.
+!
+WHERE ( (PT(:)<XTT-35.0) .AND. (PCCT(:)>XCTMIN(2)) .AND. (PRCT(:)>XRTMIN(2)) )
+ ZTCELSIUS(:) = PT(:)-XTT ! T [°C]
+ !
+ ZZW(:) = 0.0
+ ZZX(:) = 0.0
+ ZZY(:) = 0.0
+
+ ZZX(:) = 1.0 / ( 1.0 + (XC_HONC/PLBDC(:))*PTSTEP* &
+ EXP( XTEXP1_HONC + ZTCELSIUS(:)*( &
+ XTEXP2_HONC + ZTCELSIUS(:)*( &
+ XTEXP3_HONC + ZTCELSIUS(:)*( &
+ XTEXP4_HONC + ZTCELSIUS(:)*XTEXP5_HONC))) ) )**XNUC
+!
+ ZZW(:) = PCCT(:) * (1.0 - ZZX(:)) ! CCHONI
+ ZZY(:) = PRCT(:) * (1.0 - ZZX(:)) ! RCHONI
+!
+ P_RC_HONC(:) = - ZZY(:)/PTSTEP
+ P_CC_HONC(:) = - ZZW(:)/PTSTEP
+ P_TH_HONC(:) = P_RC_HONC(:) * (PLSFACT(:)-PLVFACT(:))
+!
+ PA_TH(:) = PA_TH(:) + P_TH_HONC(:)
+ PA_RC(:) = PA_RC(:) + P_RC_HONC(:)
+ PA_CC(:) = PA_CC(:) + P_CC_HONC(:)
+ PA_RI(:) = PA_RI(:) - P_RC_HONC(:)
+ PA_CI(:) = PA_CI(:) - P_CC_HONC(:)
+!
+END WHERE
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_DROPLETS_HOM_FREEZING
diff --git a/src/mesonh/micro/lima_droplets_riming_snow.f90 b/src/mesonh/micro/lima_droplets_riming_snow.f90
new file mode 100644
index 000000000..6bef29df3
--- /dev/null
+++ b/src/mesonh/micro/lima_droplets_riming_snow.f90
@@ -0,0 +1,226 @@
+!MNH_LIC Copyright 2018-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-------------------------------------------------------------------------------
+! #################################
+ MODULE MODI_LIMA_DROPLETS_RIMING_SNOW
+! #################################
+!
+INTERFACE
+ SUBROUTINE LIMA_DROPLETS_RIMING_SNOW (PTSTEP, LDCOMPUTE, &
+ PRHODREF, PT, &
+ PRCT, PCCT, PRST, PLBDC, PLBDS, PLVFACT, PLSFACT, &
+ P_TH_RIM, P_RC_RIM, P_CC_RIM, P_RS_RIM, P_RG_RIM, &
+ P_RI_HMS, P_CI_HMS, P_RS_HMS )
+!
+REAL, INTENT(IN) :: PTSTEP
+LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRHODREF !
+REAL, DIMENSION(:), INTENT(IN) :: PT !
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water C. at t
+REAL, DIMENSION(:), INTENT(IN) :: PCCT ! Cloud water C. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRST ! Cloud water C. at t
+REAL, DIMENSION(:), INTENT(IN) :: PLBDC !
+REAL, DIMENSION(:), INTENT(IN) :: PLBDS !
+REAL, DIMENSION(:), INTENT(IN) :: PLVFACT !
+REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
+!
+REAL, DIMENSION(:), INTENT(OUT) :: P_TH_RIM
+REAL, DIMENSION(:), INTENT(OUT) :: P_RC_RIM
+REAL, DIMENSION(:), INTENT(OUT) :: P_CC_RIM
+REAL, DIMENSION(:), INTENT(OUT) :: P_RS_RIM
+REAL, DIMENSION(:), INTENT(OUT) :: P_RG_RIM
+!
+REAL, DIMENSION(:), INTENT(OUT) :: P_RI_HMS
+REAL, DIMENSION(:), INTENT(OUT) :: P_CI_HMS
+REAL, DIMENSION(:), INTENT(OUT) :: P_RS_HMS
+!
+END SUBROUTINE LIMA_DROPLETS_RIMING_SNOW
+END INTERFACE
+END MODULE MODI_LIMA_DROPLETS_RIMING_SNOW
+!
+! #########################################################################################
+ SUBROUTINE LIMA_DROPLETS_RIMING_SNOW (PTSTEP, LDCOMPUTE, &
+ PRHODREF, PT, &
+ PRCT, PCCT, PRST, PLBDC, PLBDS, PLVFACT, PLSFACT, &
+ P_TH_RIM, P_RC_RIM, P_CC_RIM, P_RS_RIM, P_RG_RIM, &
+ P_RI_HMS, P_CI_HMS, P_RS_HMS )
+! #########################################################################################
+!
+!! PURPOSE
+!! -------
+!! Compute the cloud droplets riming of the aggregates rate, and the associated
+!! Hallett-Mossop ice production rate
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * CNRM *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 15/03/2018
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY : XTT
+USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCEXVT
+USE MODD_PARAM_LIMA_MIXED, ONLY : NGAMINC, XRIMINTP1, XRIMINTP2, XGAMINC_RIM1, XGAMINC_RIM2, &
+ XCRIMSS, XEXCRIMSS, XSRIMCG, XEXSRIMCG, &
+ XHMLINTP1, XHMLINTP2, XGAMINC_HMC, XHM_FACTS, XHMTMIN, XHMTMAX
+USE MODD_PARAM_LIMA_COLD, ONLY : XMNU0
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, INTENT(IN) :: PTSTEP
+LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRHODREF !
+REAL, DIMENSION(:), INTENT(IN) :: PT !
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRCT !
+REAL, DIMENSION(:), INTENT(IN) :: PCCT !
+REAL, DIMENSION(:), INTENT(IN) :: PRST !
+REAL, DIMENSION(:), INTENT(IN) :: PLBDC !
+REAL, DIMENSION(:), INTENT(IN) :: PLBDS !
+REAL, DIMENSION(:), INTENT(IN) :: PLVFACT !
+REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
+!
+REAL, DIMENSION(:), INTENT(OUT) :: P_RC_RIM
+REAL, DIMENSION(:), INTENT(OUT) :: P_CC_RIM
+REAL, DIMENSION(:), INTENT(OUT) :: P_RS_RIM
+REAL, DIMENSION(:), INTENT(OUT) :: P_RG_RIM
+!
+REAL, DIMENSION(:), INTENT(OUT) :: P_TH_RIM
+REAL, DIMENSION(:), INTENT(OUT) :: P_RI_HMS
+REAL, DIMENSION(:), INTENT(OUT) :: P_CI_HMS
+REAL, DIMENSION(:), INTENT(OUT) :: P_RS_HMS
+!
+!* 0.2 Declarations of local variables :
+!
+LOGICAL, DIMENSION(SIZE(PRCT)) :: GRIM
+!
+REAL, DIMENSION(SIZE(PRCT)) :: ZZW1, ZZW2, ZZW3, ZZW4
+!
+INTEGER, DIMENSION(SIZE(PRCT)) :: IVEC1,IVEC2 ! Vectors of indices
+REAL, DIMENSION(SIZE(PRCT)) :: ZVEC1,ZVEC2 ! Work vectors
+!
+!-------------------------------------------------------------------------------
+!
+!
+P_TH_RIM(:) = 0.
+P_RC_RIM(:) = 0.
+P_CC_RIM(:) = 0.
+P_RS_RIM(:) = 0.
+P_RG_RIM(:) = 0.
+!
+P_RI_HMS(:) = 0.
+P_CI_HMS(:) = 0.
+P_RS_HMS(:) = 0.
+!
+ZZW1(:) = 0.
+ZZW2(:) = 0.
+ZZW3(:) = 0.
+ZZW4(:) = 0.
+!
+!* Cloud droplet riming of the aggregates
+! --------------------------------------
+!
+!
+GRIM(:) = .False.
+GRIM(:) = (PRCT(:)>XRTMIN(2)) .AND. (PRST(:)>XRTMIN(5)) .AND. (PT(:)<XTT) .AND. LDCOMPUTE(:)
+!
+WHERE( GRIM )
+!
+ ZVEC1(:) = PLBDS(:)
+!
+! 1. find the next lower indice for the ZLBDAS in the geometrical
+! set of Lbda_s used to tabulate some moments of the incomplete
+! gamma function
+!
+ ZVEC2(:) = MAX( 1.0001, MIN( REAL(NGAMINC)-0.0001, &
+ XRIMINTP1 * LOG( ZVEC1(:) ) + XRIMINTP2 ) )
+ IVEC2(:) = INT( ZVEC2(:) )
+ ZVEC2(:) = ZVEC2(:) - REAL( IVEC2(:) )
+!
+! 2. perform the linear interpolation of the normalized
+! "2+XDS"-moment of the incomplete gamma function
+!
+ ZVEC1(:) = XGAMINC_RIM1( IVEC2(:)+1 )* ZVEC2(:) &
+ - XGAMINC_RIM1( IVEC2(:) )*(ZVEC2(:) - 1.0)
+ ZZW1(:) = ZVEC1(:)
+!
+! 3. perform the linear interpolation of the normalized
+! "XBS"-moment of the incomplete gamma function
+!
+ ZVEC1(:) = XGAMINC_RIM2( IVEC2(:)+1 )* ZVEC2(:) &
+ - XGAMINC_RIM2( IVEC2(:) )*(ZVEC2(:) - 1.0)
+ ZZW2(:) = ZVEC1(:)
+!
+! 4. riming
+!
+ ! Cloud droplets collected
+ P_RC_RIM(:) = - XCRIMSS * PRCT(:) * PLBDS(:)**XEXCRIMSS * PRHODREF(:)**(-XCEXVT)
+ P_CC_RIM(:) = P_RC_RIM(:) *(PCCT(:)/PRCT(:)) ! Lambda_c**3
+ !
+ ! Cloud droplets collected on small aggregates add to snow
+ P_RS_RIM(:) = - P_RC_RIM(:) * ZZW1(:)
+ !
+ ! Cloud droplets collected on large aggregates add to graupel
+ P_RG_RIM(:) = - P_RC_RIM(:) - P_RS_RIM(:)
+ !
+ ! Large aggregates collecting droplets add to graupel (instant process ???)
+ ZZW3(:) = XSRIMCG * PLBDS(:)**XEXSRIMCG * (1.0 - ZZW2(:))/(PTSTEP*PRHODREF(:))
+ P_RS_RIM(:) = P_RS_RIM(:) - ZZW3(:)
+ P_RG_RIM(:) = P_RG_RIM(:) + ZZW3(:)
+ !
+ P_TH_RIM(:) = - P_RC_RIM(:)*(PLSFACT(:)-PLVFACT(:))
+END WHERE
+!
+!
+!* Hallett-Mossop ice production (HMS)
+! -----------------------------------
+!
+!
+GRIM(:) = .False.
+GRIM(:) = (PT(:)<XHMTMAX) .AND. (PT(:)>XHMTMIN) .AND. &
+ (PRST(:)>XRTMIN(5)) .AND. (PRCT(:)>XRTMIN(2)) .AND. &
+ LDCOMPUTE(:)
+!
+WHERE ( GRIM )
+!
+ ZVEC1(:) = PLBDC(:)
+ ZVEC2(:) = MAX( 1.0001, MIN( REAL(NGAMINC)-0.0001, &
+ XHMLINTP1 * LOG( ZVEC1(:) ) + XHMLINTP2 ) )
+ IVEC2(:) = INT( ZVEC2(:) )
+ ZVEC2(:) = ZVEC2(:) - REAL( IVEC2(:) )
+ ZVEC1(:) = XGAMINC_HMC( IVEC2(:)+1 )* ZVEC2(:) &
+ - XGAMINC_HMC( IVEC2(:) )*(ZVEC2(:) - 1.0)
+ ZZW4(:) = ZVEC1(:) ! Large droplets
+!
+ WHERE ( ZZW4(:)<0.99 )
+ P_CI_HMS(:) = - P_RC_RIM(:) * (PCCT(:)/PRCT(:)) * (1.0-ZZW4(:)) * XHM_FACTS * &
+ MAX( 0.0, MIN( (PT(:)-XHMTMIN)/3.0,(XHMTMAX-PT(:))/2.0 ) ) ! CCHMSI
+!
+ P_RI_HMS(:) = P_CI_HMS(:) * XMNU0 ! RCHMSI
+ P_RS_HMS(:) = - P_RI_HMS(:)
+ END WHERE
+
+END WHERE
+!
+!
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_DROPLETS_RIMING_SNOW
diff --git a/src/mesonh/micro/lima_droplets_self_collection.f90 b/src/mesonh/micro/lima_droplets_self_collection.f90
new file mode 100644
index 000000000..79312e8cb
--- /dev/null
+++ b/src/mesonh/micro/lima_droplets_self_collection.f90
@@ -0,0 +1,94 @@
+!MNH_LIC Copyright 2018-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-------------------------------------------------------------------------------
+! #################################
+ MODULE MODI_LIMA_DROPLETS_SELF_COLLECTION
+! #################################
+!
+INTERFACE
+ SUBROUTINE LIMA_DROPLETS_SELF_COLLECTION (LDCOMPUTE, &
+ PRHODREF, &
+ PCCT, PLBDC3, &
+ P_CC_SELF )
+!
+LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference Exner function
+!
+REAL, DIMENSION(:), INTENT(IN) :: PCCT ! Cloud water C. at t
+REAL, DIMENSION(:), INTENT(IN) :: PLBDC3 !
+!
+REAL, DIMENSION(:), INTENT(OUT) :: P_CC_SELF
+!
+END SUBROUTINE LIMA_DROPLETS_SELF_COLLECTION
+END INTERFACE
+END MODULE MODI_LIMA_DROPLETS_SELF_COLLECTION
+!
+! ######################################################################
+ SUBROUTINE LIMA_DROPLETS_SELF_COLLECTION (LDCOMPUTE, &
+ PRHODREF, &
+ PCCT, PLBDC3, &
+ P_CC_SELF )
+! ######################################################################
+!
+!! PURPOSE
+!! -------
+!! Compute the self-collection of cloud droplets rate
+!!
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * CNRM *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 15/03/2018
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAM_LIMA, ONLY : XCTMIN
+USE MODD_PARAM_LIMA_WARM, ONLY : XSELFC
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference Exner function
+!
+REAL, DIMENSION(:), INTENT(IN) :: PCCT ! Cloud water C. at t
+REAL, DIMENSION(:), INTENT(IN) :: PLBDC3 !
+!
+REAL, DIMENSION(:), INTENT(OUT) :: P_CC_SELF
+!
+!* 0.2 Declarations of local variables :
+!
+REAL, DIMENSION(SIZE(PCCT)) :: ZW ! work arrays
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 1. Cloud droplets self collection
+! ------------------------------
+!
+!
+P_CC_SELF(:)=0.
+!
+WHERE( PCCT(:)>XCTMIN(2) .AND. LDCOMPUTE(:) )
+ ZW(:) = XSELFC*(PCCT(:)/PLBDC3(:))**2 * PRHODREF(:) ! analytical integration
+ P_CC_SELF(:) = - ZW(:)
+END WHERE
+!
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_DROPLETS_SELF_COLLECTION
diff --git a/src/mesonh/micro/lima_drops_break_up.f90 b/src/mesonh/micro/lima_drops_break_up.f90
new file mode 100644
index 000000000..697c68246
--- /dev/null
+++ b/src/mesonh/micro/lima_drops_break_up.f90
@@ -0,0 +1,100 @@
+!MNH_LIC Copyright 2013-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+! ###############################
+ MODULE MODI_LIMA_DROPS_BREAK_UP
+! ###############################
+!
+INTERFACE
+ SUBROUTINE LIMA_DROPS_BREAK_UP (LDCOMPUTE, &
+ PCRT, PRRT, &
+ P_CR_BRKU, &
+ PB_CR )
+
+!
+LOGICAL, DIMENSION(:), INTENT(IN) :: LDCOMPUTE
+!
+REAL, DIMENSION(:), INTENT(IN) :: PCRT !
+REAL, DIMENSION(:), INTENT(IN) :: PRRT !
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_BRKU ! Concentration change (#/kg)
+REAL, DIMENSION(:), INTENT(INOUT) :: PB_CR ! Cumulated concentration change (#/kg)
+!
+END SUBROUTINE LIMA_DROPS_BREAK_UP
+END INTERFACE
+END MODULE MODI_LIMA_DROPS_BREAK_UP
+!
+!
+! ##########################################
+ SUBROUTINE LIMA_DROPS_BREAK_UP (LDCOMPUTE, &
+ PCRT, PRRT, &
+ P_CR_BRKU, &
+ PB_CR )
+
+! ##########################################
+!
+!!
+!! PURPOSE
+!! -------
+!! Numerical filter to prevent drops from growing too much
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * CNRM *
+!!
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 15/03/2018
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAM_LIMA, ONLY : XCTMIN, XRTMIN
+USE MODD_PARAM_LIMA_WARM, ONLY : XACCR1, XLBEXR, XLBR, XSPONBUD1, XSPONBUD3, XSPONCOEF2
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+LOGICAL, DIMENSION(:), INTENT(IN) :: LDCOMPUTE
+!
+REAL, DIMENSION(:), INTENT(IN) :: PCRT !
+REAL, DIMENSION(:), INTENT(IN) :: PRRT !
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_BRKU ! Concentration change (#/kg)
+REAL, DIMENSION(:), INTENT(INOUT) :: PB_CR ! Cumulated concentration change (#/kg)
+!
+!* 0.2 Declarations of local variables :
+!
+REAL, DIMENSION(SIZE(PCRT)) :: ZWLBDR,ZWLBDR3
+INTEGER :: JL
+!
+!-------------------------------------------------------------------------------
+!
+! SPONTANEOUS BREAK-UP (NUMERICAL FILTER)
+! ---------------------------------------
+!
+P_CR_BRKU(:)=0.
+!
+ZWLBDR3(:) = 1.E30
+ZWLBDR(:) = 1.E10
+WHERE ( PRRT(:)>XRTMIN(3) .AND. PCRT(:)>XCTMIN(3) .AND. LDCOMPUTE(:) )
+ ZWLBDR3(:) = XLBR * PCRT(:) / PRRT(:)
+ ZWLBDR(:) = ZWLBDR3(:)**XLBEXR
+END WHERE
+WHERE (ZWLBDR(:)<(XACCR1/XSPONBUD1) .AND. LDCOMPUTE(:))
+ P_CR_BRKU(:) = PCRT(:)*( MAX((1.+XSPONCOEF2*(XACCR1/ZWLBDR(:)-XSPONBUD1)**2),&
+ (XACCR1/ZWLBDR(:)/XSPONBUD3)**3) -1. )
+END WHERE
+!
+PB_CR(:) = PB_CR(:) + P_CR_BRKU(:)
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_DROPS_BREAK_UP
diff --git a/src/mesonh/micro/lima_drops_hom_freezing.f90 b/src/mesonh/micro/lima_drops_hom_freezing.f90
new file mode 100644
index 000000000..b8382155b
--- /dev/null
+++ b/src/mesonh/micro/lima_drops_hom_freezing.f90
@@ -0,0 +1,144 @@
+!MNH_LIC Copyright 2013-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+! #################################
+ MODULE MODI_LIMA_DROPS_HOM_FREEZING
+! #################################
+!
+INTERFACE
+ SUBROUTINE LIMA_DROPS_HOM_FREEZING (PTSTEP, LDCOMPUTE, &
+ PEXNREF, PPABST, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PCRT, &
+ P_TH_HONR, P_RR_HONR, P_CR_HONR, &
+ PB_TH, PB_RR, PB_CR, PB_RG )
+!
+REAL, INTENT(IN) :: PTSTEP
+LOGICAL, DIMENSION(:), INTENT(IN) :: LDCOMPUTE
+!
+REAL, DIMENSION(:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:), INTENT(IN) :: PPABST ! abs. pressure at time t
+!
+REAL, DIMENSION(:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRGT ! Graupel m.r. at t
+!
+REAL, DIMENSION(:), INTENT(IN) :: PCRT ! Rain water C. at t
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_HONR
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_HONR
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_HONR
+REAL, DIMENSION(:), INTENT(INOUT) :: PB_TH
+REAL, DIMENSION(:), INTENT(INOUT) :: PB_RR
+REAL, DIMENSION(:), INTENT(INOUT) :: PB_CR
+REAL, DIMENSION(:), INTENT(INOUT) :: PB_RG
+!
+END SUBROUTINE LIMA_DROPS_HOM_FREEZING
+END INTERFACE
+END MODULE MODI_LIMA_DROPS_HOM_FREEZING
+!
+! ###############################################################################
+ SUBROUTINE LIMA_DROPS_HOM_FREEZING (PTSTEP, LDCOMPUTE, &
+ PEXNREF, PPABST, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PCRT, &
+ P_TH_HONR, P_RR_HONR, P_CR_HONR, &
+ PB_TH, PB_RR, PB_CR, PB_RG )
+! ###############################################################################
+!
+!! PURPOSE
+!! -------
+!! Homogeneous freezing of rain drops below -35°C
+!!
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * CNRM *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 15/03/2018
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY : XP00, XRD, XCPD, XCPV, XCL, XCI, XTT, XLSTT, XLVTT
+USE MODD_PARAM_LIMA, ONLY : XRTMIN
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, INTENT(IN) :: PTSTEP
+LOGICAL, DIMENSION(:), INTENT(IN) :: LDCOMPUTE
+!
+REAL, DIMENSION(:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:), INTENT(IN) :: PPABST ! abs. pressure at time t
+!
+REAL, DIMENSION(:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRGT ! Graupel m.r. at t
+!
+REAL, DIMENSION(:), INTENT(IN) :: PCRT ! Rain water C. at t
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_HONR
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_HONR
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_HONR
+REAL, DIMENSION(:), INTENT(INOUT) :: PB_TH
+REAL, DIMENSION(:), INTENT(INOUT) :: PB_RR
+REAL, DIMENSION(:), INTENT(INOUT) :: PB_CR
+REAL, DIMENSION(:), INTENT(INOUT) :: PB_RG
+!
+!* 0.2 Declarations of local variables :
+!
+REAL, DIMENSION(SIZE(PTHT)) :: &
+ ZW, &
+ ZT, &
+ ZLSFACT, &
+ ZLVFACT, &
+ ZTCELSIUS
+!
+!-------------------------------------------------------------------------------
+!
+P_TH_HONR(:) = 0.
+P_RR_HONR(:) = 0.
+P_CR_HONR(:) = 0.
+!
+! Temperature
+ZT(:) = PTHT(:) * ( PPABST(:)/XP00 ) ** (XRD/XCPD)
+ZTCELSIUS(:) = ZT(:)-XTT ! T [°C]
+!
+ZW(:) = PEXNREF(:)*( XCPD+XCPV*PRVT(:)+XCL*(PRCT(:)+PRRT(:)) &
+ +XCI*(PRIT(:)+PRST(:)+PRGT(:)) )
+ZLSFACT(:) = (XLSTT+(XCPV-XCI)*ZTCELSIUS(:))/ZW(:) ! L_s/(Pi_ref*C_ph)
+ZLVFACT(:) = (XLVTT+(XCPV-XCL)*ZTCELSIUS(:))/ZW(:) ! L_v/(Pi_ref*C_ph)
+!
+ZW(:) = 0.0
+!
+WHERE( (ZT(:)<XTT-35.0) .AND. (PRRT(:)>XRTMIN(3)) .AND. LDCOMPUTE(:) )
+ P_TH_HONR(:) = PRRT(:)*(ZLSFACT(:)-ZLVFACT(:))
+ P_RR_HONR(:) = - PRRT(:)
+ P_CR_HONR(:) = - PCRT(:)
+ PB_TH(:) = PB_TH(:) + P_TH_HONR(:)
+ PB_RR(:) = PB_RR(:) - PRRT(:)
+ PB_CR(:) = PB_CR(:) - PCRT(:)
+ PB_RG(:) = PB_RG(:) + PRRT(:)
+ENDWHERE
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_DROPS_HOM_FREEZING
diff --git a/src/mesonh/micro/lima_drops_self_collection.f90 b/src/mesonh/micro/lima_drops_self_collection.f90
new file mode 100644
index 000000000..042cde084
--- /dev/null
+++ b/src/mesonh/micro/lima_drops_self_collection.f90
@@ -0,0 +1,123 @@
+!MNH_LIC Copyright 2018-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-------------------------------------------------------------------------------
+! #################################
+ MODULE MODI_LIMA_DROPS_SELF_COLLECTION
+! #################################
+!
+INTERFACE
+ SUBROUTINE LIMA_DROPS_SELF_COLLECTION (LDCOMPUTE, &
+ PRHODREF, &
+ PCRT, PLBDR, PLBDR3, &
+ P_CR_SCBU )
+!
+LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference Exner function
+!
+REAL, DIMENSION(:), INTENT(IN) :: PCRT ! Cloud water C. at t
+REAL, DIMENSION(:), INTENT(IN) :: PLBDR !
+REAL, DIMENSION(:), INTENT(IN) :: PLBDR3 !
+!
+REAL, DIMENSION(:), INTENT(OUT) :: P_CR_SCBU
+!
+END SUBROUTINE LIMA_DROPS_SELF_COLLECTION
+END INTERFACE
+END MODULE MODI_LIMA_DROPS_SELF_COLLECTION
+!
+! #############################################################
+ SUBROUTINE LIMA_DROPS_SELF_COLLECTION (LDCOMPUTE, &
+ PRHODREF, &
+ PCRT, PLBDR, PLBDR3, &
+ P_CR_SCBU )
+! #############################################################
+!
+!! PURPOSE
+!! -------
+!! Compute the self-collection and physical break-up of rain drops
+!!
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * CNRM *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 15/03/2018
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAM_LIMA, ONLY : XCTMIN
+USE MODD_PARAM_LIMA_WARM, ONLY : XACCR1, XSCBUEXP1, XSCBU_EFF1, XSCBU_EFF2, &
+ XSCBU2, XSCBU3
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference Exner function
+!
+REAL, DIMENSION(:), INTENT(IN) :: PCRT ! Rain drops C. at t
+REAL, DIMENSION(:), INTENT(IN) :: PLBDR !
+REAL, DIMENSION(:), INTENT(IN) :: PLBDR3 !
+!
+REAL, DIMENSION(:), INTENT(OUT) :: P_CR_SCBU
+!
+!* 0.2 Declarations of local variables :
+!
+REAL, DIMENSION(SIZE(PCRT)) :: &
+ ZW1, & ! work arrays
+ ZW2, &
+ ZW3, &
+ ZW4, &
+ ZSCBU
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 1. Rain drops self-collection and break-up
+! ---------------------------------------
+!
+!
+P_CR_SCBU(:)=0.
+!
+ZW4(:) =0.
+!
+WHERE( PCRT(:)>XCTMIN(3) .AND. LDCOMPUTE(:) )
+ ZW4(:) = XACCR1 / PLBDR(:) ! Mean diameter
+END WHERE
+ZSCBU(:)=1.
+WHERE (ZW4(:)>=XSCBU_EFF1 .AND. PCRT(:)>XCTMIN(3) .AND. LDCOMPUTE(:)) &
+ ZSCBU(:) = EXP(XSCBUEXP1*(ZW4(:)-XSCBU_EFF1)) ! coalescence efficiency
+WHERE (ZW4(:)>=XSCBU_EFF2 .AND. LDCOMPUTE(:)) ZSCBU(:) = 0.0 ! Break-up
+!
+ZW1(:) = 0.0
+ZW2(:) = 0.0
+ZW3(:) = 0.0
+!
+WHERE (PCRT(:)>XCTMIN(3) .AND. (ZW4(:)>1.E-4) .AND. LDCOMPUTE(:)) ! analytical integration
+ ZW1(:) = XSCBU2 * PCRT(:)**2 / PLBDR3(:) ! D>100 10-6 m
+ ZW3(:) = ZW1(:)*ZSCBU(:)
+END WHERE
+!
+WHERE (PCRT(:)>XCTMIN(3) .AND. (ZW4(:)<=1.E-4) .AND. LDCOMPUTE(:))
+ ZW2(:) = XSCBU3 *(PCRT(:) / PLBDR3(:))**2 ! D<100 10-6 m
+ ZW3(:) = ZW2(:)
+END WHERE
+!
+P_CR_SCBU(:) = - ZW3(:) * PRHODREF(:)
+!
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_DROPS_SELF_COLLECTION
diff --git a/src/mesonh/micro/lima_drops_to_droplets_conv.f90 b/src/mesonh/micro/lima_drops_to_droplets_conv.f90
new file mode 100644
index 000000000..b2c63fde2
--- /dev/null
+++ b/src/mesonh/micro/lima_drops_to_droplets_conv.f90
@@ -0,0 +1,103 @@
+!MNH_LIC Copyright 2013-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+! #################################
+ MODULE MODI_LIMA_DROPS_TO_DROPLETS_CONV
+! #################################
+!
+INTERFACE
+ SUBROUTINE LIMA_DROPS_TO_DROPLETS_CONV (PRHODREF, PRCT, PRRT, PCCT, PCRT, &
+ P_RR_CVRC, P_CR_CVRC )
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCT ! Cloud water C. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRT ! Rain water C. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: P_RR_CVRC
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: P_CR_CVRC
+!
+END SUBROUTINE LIMA_DROPS_TO_DROPLETS_CONV
+END INTERFACE
+END MODULE MODI_LIMA_DROPS_TO_DROPLETS_CONV
+!
+! ######################################################################
+ SUBROUTINE LIMA_DROPS_TO_DROPLETS_CONV (PRHODREF, PRCT, PRRT, PCCT, PCRT, &
+ P_RR_CVRC, P_CR_CVRC )
+! ######################################################################
+!
+!! PURPOSE
+!! -------
+!! Conversion of rain drops into cloud droplets if mean volume diameter < 82µm
+!!
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * CNRM *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 15/03/2018
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY : XPI, XRHOLW
+USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN
+USE MODD_PARAM_LIMA_WARM, ONLY : XLBR, XLBEXR, XLBC, XLBEXC, &
+ XACCR1, XACCR3, XACCR4, XACCR5
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCT ! Cloud water C. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRT ! Rain water C. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: P_RR_CVRC
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: P_CR_CVRC
+!
+!* 0.2 Declarations of local variables :
+!
+REAL, DIMENSION(SIZE(PRCT,1),SIZE(PRCT,2),SIZE(PRCT,3)) :: ZDR
+!
+LOGICAL, DIMENSION(SIZE(PRCT,1),SIZE(PRCT,2),SIZE(PRCT,3)) :: ZMASKR, ZMASKC
+!
+REAL :: ZFACT
+!
+!
+!
+!-------------------------------------------------------------------------------
+!
+P_RR_CVRC(:,:,:) = 0.
+P_CR_CVRC(:,:,:) = 0.
+!
+ZDR(:,:,:) = 9999.
+ZMASKR(:,:,:) = PRRT(:,:,:).GT.XRTMIN(3) .AND. PCRT(:,:,:).GT.XCTMIN(3)
+ZMASKC(:,:,:) = PRCT(:,:,:).GT.XRTMIN(2) .AND. PCCT(:,:,:).GT.XCTMIN(2)
+WHERE(ZMASKR(:,:,:))
+ ZDR(:,:,:)=(6.*PRRT(:,:,:)/XPI/XRHOLW/PCRT(:,:,:))**0.33
+END WHERE
+!
+! Transfer all drops in droplets if out of cloud and Dr<82microns
+!
+WHERE( ZMASKR(:,:,:) .AND. .NOT.ZMASKC(:,:,:) .AND. ZDR(:,:,:).LT.82.E-6)
+ P_RR_CVRC(:,:,:) = -PRRT(:,:,:)
+ P_CR_CVRC(:,:,:) = -PCRT(:,:,:)
+END WHERE
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_DROPS_TO_DROPLETS_CONV
diff --git a/src/mesonh/micro/lima_functions.f90 b/src/mesonh/micro/lima_functions.f90
new file mode 100644
index 000000000..b5a8f17d7
--- /dev/null
+++ b/src/mesonh/micro/lima_functions.f90
@@ -0,0 +1,307 @@
+!MNH_LIC Copyright 2016-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! Modifications:
+! P. Wautelet 22/01/2019: replace double precision declarations by real(kind(0.0d0)) (to allow compilation by NAG compiler)
+! P. Wautelet 19/04/2019: use modd_precision kinds
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+!-----------------------------------------------------------------
+!#################################
+ MODULE MODI_LIMA_FUNCTIONS
+!#################################
+!
+INTERFACE
+!
+FUNCTION MOMG (PALPHA,PNU,PP) RESULT (PMOMG)
+ REAL, INTENT(IN) :: PALPHA
+ REAL, INTENT(IN) :: PNU
+ REAL, INTENT(IN) :: PP
+ REAL :: PMOMG
+END FUNCTION MOMG
+!
+FUNCTION RECT(PA,PB,PX,PX1,PX2) RESULT(PRECT)
+ REAL, INTENT(IN) :: PA
+ REAL, INTENT(IN) :: PB
+ REAL, DIMENSION(:), INTENT(IN) :: PX
+ REAL, INTENT(IN) :: PX1
+ REAL, INTENT(IN) :: PX2
+ REAL, DIMENSION(SIZE(PX,1)) :: PRECT
+END FUNCTION RECT
+!
+FUNCTION DELTA(PA,PB,PX,PX1,PX2) RESULT(PDELTA)
+ REAL, INTENT(IN) :: PA
+ REAL, INTENT(IN) :: PB
+ REAL, DIMENSION(:), INTENT(IN) :: PX
+ REAL, INTENT(IN) :: PX1
+ REAL, INTENT(IN) :: PX2
+ REAL, DIMENSION(SIZE(PX,1)) :: PDELTA
+END FUNCTION DELTA
+!
+FUNCTION DELTA_VEC(PA,PB,PX,PX1,PX2) RESULT(PDELTA_VEC)
+ REAL, INTENT(IN) :: PA
+ REAL, INTENT(IN) :: PB
+ REAL, DIMENSION(:), INTENT(IN) :: PX
+ REAL, DIMENSION(:), INTENT(IN) :: PX1
+ REAL, DIMENSION(:), INTENT(IN) :: PX2
+ REAL, DIMENSION(SIZE(PX,1)) :: PDELTA_VEC
+END FUNCTION DELTA_VEC
+!
+SUBROUTINE GAULAG(x,w,n,alf)
+ INTEGER, INTENT(IN) :: n
+ REAL, INTENT(IN) :: alf
+ REAL, DIMENSION(n), INTENT(INOUT) :: w, x
+END SUBROUTINE GAULAG
+!
+SUBROUTINE GAUHER(x,w,n)
+ INTEGER, INTENT(IN) :: n
+ REAL, DIMENSION(n), INTENT(INOUT) :: w, x
+END SUBROUTINE GAUHER
+!
+END INTERFACE
+!
+END MODULE MODI_LIMA_FUNCTIONS
+!
+!------------------------------------------------------------------------------
+!
+!###########################################
+FUNCTION MOMG (PALPHA,PNU,PP) RESULT (PMOMG)
+!###########################################
+!
+! auxiliary routine used to compute the Pth moment order of the generalized
+! gamma law
+!
+ USE MODI_GAMMA
+!
+ IMPLICIT NONE
+!
+ REAL :: PALPHA ! first shape parameter of the dimensionnal distribution
+ REAL :: PNU ! second shape parameter of the dimensionnal distribution
+ REAL :: PP ! order of the moment
+ REAL :: PMOMG ! result: moment of order ZP
+!
+ PMOMG = GAMMA_X0D(PNU+PP/PALPHA)/GAMMA_X0D(PNU)
+!
+END FUNCTION MOMG
+!
+!------------------------------------------------------------------------------
+!
+!#############################################
+FUNCTION RECT(PA,PB,PX,PX1,PX2) RESULT(PRECT)
+!#############################################
+!
+! PRECT takes the value PA if PX1<=PX<PX2, and PB outside the [PX1;PX2[ interval
+!
+ IMPLICIT NONE
+!
+ REAL, INTENT(IN) :: PA
+ REAL, INTENT(IN) :: PB
+ REAL, DIMENSION(:), INTENT(IN) :: PX
+ REAL, INTENT(IN) :: PX1
+ REAL, INTENT(IN) :: PX2
+ REAL, DIMENSION(SIZE(PX,1)) :: PRECT
+!
+ PRECT(:) = PB
+ WHERE (PX(:).GE.PX1 .AND. PX(:).LT.PX2)
+ PRECT(:) = PA
+ END WHERE
+ RETURN
+!
+END FUNCTION RECT
+!
+!-------------------------------------------------------------------------------
+!
+!###############################################
+FUNCTION DELTA(PA,PB,PX,PX1,PX2) RESULT(PDELTA)
+!###############################################
+!
+! PDELTA takes the value PA if PX<PX1, and PB if PX>=PX2
+! PDELTA is a cubic interpolation between PA and PB for PX between PX1 and PX2
+!
+ IMPLICIT NONE
+!
+ REAL, INTENT(IN) :: PA
+ REAL, INTENT(IN) :: PB
+ REAL, DIMENSION(:), INTENT(IN) :: PX
+ REAL, INTENT(IN) :: PX1
+ REAL, INTENT(IN) :: PX2
+ REAL, DIMENSION(SIZE(PX,1)) :: PDELTA
+!
+!* local variable
+!
+ REAL :: ZA
+!
+ ZA = 6.0*(PA-PB)/(PX2-PX1)**3
+ WHERE (PX(:).LT.PX1)
+ PDELTA(:) = PA
+ ELSEWHERE (PX(:).GE.PX2)
+ PDELTA(:) = PB
+ ELSEWHERE
+ PDELTA(:) = PA + ZA*PX1**2*(PX1/6.0 - 0.5*PX2) &
+ + ZA*PX1*PX2* (PX(:)) &
+ - (0.5*ZA*(PX1+PX2))* (PX(:)**2) &
+ + (ZA/3.0)* (PX(:)**3)
+ END WHERE
+ RETURN
+!
+END FUNCTION DELTA
+!
+!-------------------------------------------------------------------------------
+!
+!#######################################################
+FUNCTION DELTA_VEC(PA,PB,PX,PX1,PX2) RESULT(PDELTA_VEC)
+!#######################################################
+!
+! Same as DELTA for vectorized PX1 and PX2 arguments
+!
+ IMPLICIT NONE
+!
+ REAL, INTENT(IN) :: PA
+ REAL, INTENT(IN) :: PB
+ REAL, DIMENSION(:), INTENT(IN) :: PX
+ REAL, DIMENSION(:), INTENT(IN) :: PX1
+ REAL, DIMENSION(:), INTENT(IN) :: PX2
+ REAL, DIMENSION(SIZE(PX,1)) :: PDELTA_VEC
+!
+!* local variable
+!
+ REAL, DIMENSION(SIZE(PX,1)) :: ZA
+!
+ ZA(:) = 0.0
+ wHERE (PX(:)<=PX1(:))
+ PDELTA_VEC(:) = PA
+ ELSEWHERE (PX(:)>=PX2(:))
+ PDELTA_VEC(:) = PB
+ ELSEWHERE
+ ZA(:) = 6.0*(PA-PB)/(PX2(:)-PX1(:))**3
+ PDELTA_VEC(:) = PA + ZA(:)*PX1(:)**2*(PX1(:)/6.0 - 0.5*PX2(:)) &
+ + ZA(:)*PX1(:)*PX2(:)* (PX(:)) &
+ - (0.5*ZA(:)*(PX1(:)+PX2(:)))* (PX(:)**2) &
+ + (ZA(:)/3.0)* (PX(:)**3)
+ END WHERE
+ RETURN
+!
+END FUNCTION DELTA_VEC
+!
+!-------------------------------------------------------------------------------
+!
+!###########################
+SUBROUTINE gaulag(x,w,n,alf)
+!###########################
+ use modd_precision, only: MNHREAL64
+
+ INTEGER n,MAXIT
+ REAL alf,w(n),x(n)
+ REAL(kind=MNHREAL64) :: EPS
+ PARAMETER (EPS=3.D-14,MAXIT=10)
+ INTEGER i,its,j
+ REAL ai
+ REAL(kind=MNHREAL64) :: p1,p2,p3,pp,z,z1
+!
+ REAL SUMW
+!
+ do 13 i=1,n
+ if(i.eq.1)then
+ z=(1.+alf)*(3.+.92*alf)/(1.+2.4*n+1.8*alf)
+ else if(i.eq.2)then
+ z=z+(15.+6.25*alf)/(1.+.9*alf+2.5*n)
+ else
+ ai=i-2
+ z=z+((1.+2.55*ai)/(1.9*ai)+1.26*ai*alf/(1.+3.5*ai))* &
+ (z-x(i-2))/(1.+.3*alf)
+ endif
+ do 12 its=1,MAXIT
+ p1=1.d0
+ p2=0.d0
+ do 11 j=1,n
+ p3=p2
+ p2=p1
+ p1=((2*j-1+alf-z)*p2-(j-1+alf)*p3)/j
+11 continue
+ pp=(n*p1-(n+alf)*p2)/z
+ z1=z
+ z=z1-p1/pp
+ if(abs(z-z1).le.EPS)goto 1
+12 continue
+1 x(i)=z
+ w(i)=-exp(gammln(alf+n)-gammln(real(n)))/(pp*n*p2)
+13 continue
+!
+! NORMALISATION
+!
+ SUMW = 0.0
+ DO 14 I=1,N
+ SUMW = SUMW + W(I)
+14 CONTINUE
+ DO 15 I=1,N
+ W(I) = W(I)/SUMW
+15 CONTINUE
+!
+ return
+END SUBROUTINE gaulag
+!
+!------------------------------------------------------------------------------
+!
+!##########################################
+SUBROUTINE gauher(x,w,n)
+!##########################################
+ use modd_precision, only: MNHREAL64
+
+ INTEGER n,MAXIT
+ REAL w(n),x(n)
+ REAL(kind=MNHREAL64) :: EPS,PIM4
+ PARAMETER (EPS=3.D-14,PIM4=.7511255444649425D0,MAXIT=10)
+ INTEGER i,its,j,m
+ REAL(kind=MNHREAL64) :: p1,p2,p3,pp,z,z1
+!
+ REAL SUMW
+!
+ m=(n+1)/2
+ do 13 i=1,m
+ if(i.eq.1)then
+ z=sqrt(real(2*n+1))-1.85575*(2*n+1)**(-.16667)
+ else if(i.eq.2)then
+ z=z-1.14*n**.426/z
+ else if (i.eq.3)then
+ z=1.86*z-.86*x(1)
+ else if (i.eq.4)then
+ z=1.91*z-.91*x(2)
+ else
+ z=2.*z-x(i-2)
+ endif
+ do 12 its=1,MAXIT
+ p1=PIM4
+ p2=0.d0
+ do 11 j=1,n
+ p3=p2
+ p2=p1
+ p1=z*sqrt(2.d0/j)*p2-sqrt(dble(j-1)/dble(j))*p3
+11 continue
+ pp=sqrt(2.d0*n)*p2
+ z1=z
+ z=z1-p1/pp
+ if(abs(z-z1).le.EPS)goto 1
+12 continue
+1 x(i)=z
+ x(n+1-i)=-z
+ pp=pp/PIM4 ! NORMALIZATION
+ w(i)=2.0/(pp*pp)
+ w(n+1-i)=w(i)
+13 continue
+!
+! NORMALISATION
+!
+ SUMW = 0.0
+ DO 14 I=1,N
+ SUMW = SUMW + W(I)
+14 CONTINUE
+ DO 15 I=1,N
+ W(I) = W(I)/SUMW
+15 CONTINUE
+!
+ return
+END SUBROUTINE gauher
+!
+!------------------------------------------------------------------------------
diff --git a/src/mesonh/micro/lima_graupel.f90 b/src/mesonh/micro/lima_graupel.f90
new file mode 100644
index 000000000..ad114da36
--- /dev/null
+++ b/src/mesonh/micro/lima_graupel.f90
@@ -0,0 +1,569 @@
+!MNH_LIC Copyright 2018-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! #################################
+ MODULE MODI_LIMA_GRAUPEL
+! #################################
+!
+INTERFACE
+ SUBROUTINE LIMA_GRAUPEL (PTSTEP, LDCOMPUTE, &
+ PRHODREF, PPRES, PT, PKA, PDV, PCJ, &
+ PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PCCT, PCRT, PCIT, &
+ PLBDC, PLBDR, PLBDS, PLBDG, &
+ PLVFACT, PLSFACT, &
+ P_TH_WETG, P_RC_WETG, P_CC_WETG, P_RR_WETG, P_CR_WETG, &
+ P_RI_WETG, P_CI_WETG, P_RS_WETG, P_RG_WETG, P_RH_WETG, &
+ P_TH_DRYG, P_RC_DRYG, P_CC_DRYG, P_RR_DRYG, P_CR_DRYG, &
+ P_RI_DRYG, P_CI_DRYG, P_RS_DRYG, P_RG_DRYG, &
+ P_RI_HMG, P_CI_HMG, P_RG_HMG, &
+ P_TH_GMLT, P_RR_GMLT, P_CR_GMLT, &
+ PA_TH, PA_RC, PA_CC, PA_RR, PA_CR, &
+ PA_RI, PA_CI, PA_RS, PA_RG, PA_RH )
+!
+REAL, INTENT(IN) :: PTSTEP
+LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRHODREF !
+REAL, DIMENSION(:), INTENT(IN) :: PPRES !
+REAL, DIMENSION(:), INTENT(IN) :: PT !
+REAL, DIMENSION(:), INTENT(IN) :: PKA !
+REAL, DIMENSION(:), INTENT(IN) :: PDV !
+REAL, DIMENSION(:), INTENT(IN) :: PCJ !
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRVT !
+REAL, DIMENSION(:), INTENT(IN) :: PRCT !
+REAL, DIMENSION(:), INTENT(IN) :: PRRT !
+REAL, DIMENSION(:), INTENT(IN) :: PRIT !
+REAL, DIMENSION(:), INTENT(IN) :: PRST !
+REAL, DIMENSION(:), INTENT(IN) :: PRGT !
+!
+REAL, DIMENSION(:), INTENT(IN) :: PCCT !
+REAL, DIMENSION(:), INTENT(IN) :: PCRT !
+REAL, DIMENSION(:), INTENT(IN) :: PCIT !
+!
+REAL, DIMENSION(:), INTENT(IN) :: PLBDC !
+REAL, DIMENSION(:), INTENT(IN) :: PLBDR !
+REAL, DIMENSION(:), INTENT(IN) :: PLBDS !
+REAL, DIMENSION(:), INTENT(IN) :: PLBDG !
+!
+REAL, DIMENSION(:), INTENT(IN) :: PLVFACT !
+REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_WETG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_WETG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_WETG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_WETG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_WETG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_WETG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_WETG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_WETG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_WETG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RH_WETG
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_DRYG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_DRYG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_DRYG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_DRYG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_DRYG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_DRYG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_DRYG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_DRYG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_DRYG
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_HMG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_HMG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_HMG
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_GMLT
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_GMLT
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_GMLT
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_TH
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_RC
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_CC
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_RR
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_CR
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_RI
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_CI
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_RS
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_RG
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_RH
+!
+END SUBROUTINE LIMA_GRAUPEL
+END INTERFACE
+END MODULE MODI_LIMA_GRAUPEL
+!
+! #################################################################################
+ SUBROUTINE LIMA_GRAUPEL (PTSTEP, LDCOMPUTE, &
+ PRHODREF, PPRES, PT, PKA, PDV, PCJ, &
+ PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PCCT, PCRT, PCIT, &
+ PLBDC, PLBDR, PLBDS, PLBDG, &
+ PLVFACT, PLSFACT, &
+ P_TH_WETG, P_RC_WETG, P_CC_WETG, P_RR_WETG, P_CR_WETG, &
+ P_RI_WETG, P_CI_WETG, P_RS_WETG, P_RG_WETG, P_RH_WETG, &
+ P_TH_DRYG, P_RC_DRYG, P_CC_DRYG, P_RR_DRYG, P_CR_DRYG, &
+ P_RI_DRYG, P_CI_DRYG, P_RS_DRYG, P_RG_DRYG, &
+ P_RI_HMG, P_CI_HMG, P_RG_HMG, &
+ P_TH_GMLT, P_RR_GMLT, P_CR_GMLT, &
+ PA_TH, PA_RC, PA_CC, PA_RR, PA_CR, &
+ PA_RI, PA_CI, PA_RS, PA_RG, PA_RH )
+! #################################################################################
+!
+!! PURPOSE
+!! -------
+!! Compute the wet/dry growth of graupel, associated Hallett-Mossop ice production,
+!! and graupel melting rates
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * CNRM *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 15/03/2018
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY : XTT, XMD, XMV, XRD, XRV, XLVTT, XLMTT, XESTT, XCL, XCI, XCPV
+USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCEXVT, LHAIL
+USE MODD_PARAM_LIMA_MIXED, ONLY : XCXG, XDG, X0DEPG, X1DEPG, NGAMINC, &
+ XFCDRYG, XFIDRYG, XCOLIG, XCOLSG, XCOLEXIG, XCOLEXSG, &
+ XFSDRYG, XLBSDRYG1, XLBSDRYG2, XLBSDRYG3, XKER_SDRYG, &
+ XFRDRYG, XLBRDRYG1, XLBRDRYG2, XLBRDRYG3, XKER_RDRYG, &
+ XHMTMIN, XHMTMAX, XHMLINTP1, XHMLINTP2, XHM_FACTG, XGAMINC_HMC, &
+ XEX0DEPG, XEX1DEPG, &
+ XDRYINTP1R, XDRYINTP1S, XDRYINTP1G, &
+ XDRYINTP2R, XDRYINTP2S, XDRYINTP2G, &
+ NDRYLBDAR, NDRYLBDAS, NDRYLBDAG
+USE MODD_PARAM_LIMA_COLD, ONLY : XMNU0, XCXS, XBS
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, INTENT(IN) :: PTSTEP
+LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRHODREF !
+REAL, DIMENSION(:), INTENT(IN) :: PPRES !
+REAL, DIMENSION(:), INTENT(IN) :: PT !
+REAL, DIMENSION(:), INTENT(IN) :: PKA !
+REAL, DIMENSION(:), INTENT(IN) :: PDV !
+REAL, DIMENSION(:), INTENT(IN) :: PCJ !
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRVT !
+REAL, DIMENSION(:), INTENT(IN) :: PRCT !
+REAL, DIMENSION(:), INTENT(IN) :: PRRT !
+REAL, DIMENSION(:), INTENT(IN) :: PRIT !
+REAL, DIMENSION(:), INTENT(IN) :: PRST !
+REAL, DIMENSION(:), INTENT(IN) :: PRGT !
+!
+REAL, DIMENSION(:), INTENT(IN) :: PCCT !
+REAL, DIMENSION(:), INTENT(IN) :: PCRT !
+REAL, DIMENSION(:), INTENT(IN) :: PCIT !
+!
+REAL, DIMENSION(:), INTENT(IN) :: PLBDC !
+REAL, DIMENSION(:), INTENT(IN) :: PLBDR !
+REAL, DIMENSION(:), INTENT(IN) :: PLBDS !
+REAL, DIMENSION(:), INTENT(IN) :: PLBDG !
+!
+REAL, DIMENSION(:), INTENT(IN) :: PLVFACT !
+REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_WETG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_WETG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_WETG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_WETG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_WETG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_WETG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_WETG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_WETG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_WETG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RH_WETG
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_DRYG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_DRYG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_DRYG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_DRYG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_DRYG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_DRYG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_DRYG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_DRYG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_DRYG
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_HMG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_HMG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_HMG
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_GMLT
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_GMLT
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_GMLT
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_TH
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_RC
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_CC
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_RR
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_CR
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_RI
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_CI
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_RS
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_RG
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_RH
+!
+!* 0.2 Declarations of local variables :
+!
+LOGICAL, DIMENSION(SIZE(PRCT)) :: GDRY
+INTEGER :: IGDRY
+INTEGER :: JJ
+!
+REAL, DIMENSION(SIZE(PRCT)) :: Z1, Z2, Z3, Z4
+REAL, DIMENSION(SIZE(PRCT)) :: ZZX, ZZW, ZZW1, ZZW2, ZZW3, ZZW4, ZZW5, ZZW6, ZZW7
+REAL, DIMENSION(SIZE(PRCT)) :: ZRDRYG, ZRWETG
+!
+INTEGER, DIMENSION(SIZE(PRCT)) :: IVEC1,IVEC2 ! Vectors of indices
+REAL, DIMENSION(SIZE(PRCT)) :: ZVEC1,ZVEC2, ZVEC3 ! Work vectors
+!
+INTEGER :: NHAIL
+!
+!-------------------------------------------------------------------------------
+!
+!
+P_RC_WETG(:) = 0.
+P_CC_WETG(:) = 0.
+P_RR_WETG(:) = 0.
+P_CR_WETG(:) = 0.
+P_RI_WETG(:) = 0.
+P_CI_WETG(:) = 0.
+P_RS_WETG(:) = 0.
+P_RG_WETG(:) = 0.
+P_RH_WETG(:) = 0.
+!
+P_RC_DRYG(:) = 0.
+P_CC_DRYG(:) = 0.
+P_RR_DRYG(:) = 0.
+P_CR_DRYG(:) = 0.
+P_RI_DRYG(:) = 0.
+P_CI_DRYG(:) = 0.
+P_RS_DRYG(:) = 0.
+P_RG_DRYG(:) = 0.
+!
+P_RI_HMG(:) = 0.
+P_CI_HMG(:) = 0.
+P_RG_HMG(:) = 0.
+!
+P_RR_GMLT(:) = 0.
+P_CR_GMLT(:) = 0.
+!
+ZZW1(:) = 0. ! RCDRYG
+ZZW2(:) = 0. ! RIDRYG
+ZZW3(:) = 0. ! RSDRYG
+ZZW4(:) = 0. ! RRDRYG
+ZZW5(:) = 0. ! RIWETG
+ZZW6(:) = 0. ! RSWETG
+ZZW7(:) = 0. !
+!
+ZRDRYG(:) = 0.
+ZRWETG(:) = 0.
+!
+!
+!* 1. Graupel growth by collection (dry or wet case)
+! --------------------------------------------------
+!
+! 1.a Collection of rc and ri in the dry mode
+! --------------------------------------------
+!
+WHERE( PRGT(:)>XRTMIN(6) .AND. LDCOMPUTE(:) )
+ ZZW(:) = PLBDG(:)**(XCXG-XDG-2.0) * PRHODREF(:)**(-XCEXVT)
+ ZZW1(:) = XFCDRYG * PRCT(:) * ZZW(:) ! RCDRYG - rc collected by graupel in dry mode
+ ZZW2(:) = XFIDRYG * EXP( XCOLEXIG*(PT(:)-XTT) ) * PRIT(:) * ZZW(:) ! RIDRYG - ri collected by graupel in dry mode
+END WHERE
+!
+!* 1.b Collection of rs in the dry mode
+! ------------------------------------
+!
+GDRY(:) = (PRST(:)>XRTMIN(5)) .AND. (PRGT(:)>XRTMIN(6)) .AND. LDCOMPUTE(:)
+!
+WHERE( GDRY )
+!
+!* Select the (ZLBDAG,ZLBDAS) couplet
+!
+ ZVEC1(:) = PLBDG(:)
+ ZVEC2(:) = PLBDS(:)
+!
+!* find the next lower indice for the ZLBDAG and for the ZLBDAS
+! in the geometrical set of (Lbda_g,Lbda_s) couplet use to
+! tabulate the SDRYG-kernel
+!
+ ZVEC1(:) = MAX( 1.0001, MIN( REAL(NDRYLBDAG)-0.0001, &
+ XDRYINTP1G * LOG( ZVEC1(:) ) + XDRYINTP2G ) )
+ IVEC1(:) = INT( ZVEC1(:) )
+ ZVEC1(:) = ZVEC1(:) - REAL( IVEC1(:) )
+!
+ ZVEC2(:) = MAX( 1.0001, MIN( REAL(NDRYLBDAS)-0.0001, &
+ XDRYINTP1S * LOG( ZVEC2(:) ) + XDRYINTP2S ) )
+ IVEC2(:) = INT( ZVEC2(:) )
+ ZVEC2(:) = ZVEC2(:) - REAL( IVEC2(:) )
+!
+!* perform the bilinear interpolation of the normalized
+! SDRYG-kernel
+ !
+ Z1(:) = GET_XKER_SDRYG(IVEC1(:)+1,IVEC2(:)+1)
+ Z2(:) = GET_XKER_SDRYG(IVEC1(:)+1,IVEC2(:) )
+ Z3(:) = GET_XKER_SDRYG(IVEC1(:) ,IVEC2(:)+1)
+ Z4(:) = GET_XKER_SDRYG(IVEC1(:) ,IVEC2(:) )
+ ZVEC3(:) = ( Z1(:)* ZVEC2(:) &
+ - Z2(:)*(ZVEC2(:) - 1.0) ) &
+ * ZVEC1(:) &
+ - ( Z3(:)* ZVEC2(:) &
+ - Z4(:)*(ZVEC2(:) - 1.0) ) &
+ * (ZVEC1(:) - 1.0)
+ ZZW(:) = ZVEC3(:)
+!
+ ZZW3(:) = XFSDRYG * ZZW(:) * EXP( XCOLEXSG*(PT(:)-XTT) ) & ! RSDRYG - rs collected by graupel in dry mode
+ *( PLBDS(:)**(XCXS-XBS) )*( PLBDG(:)**XCXG ) &
+ *( PRHODREF(:)**(-XCEXVT-1.) ) &
+ *( XLBSDRYG1/( PLBDG(:)**2 ) + &
+ XLBSDRYG2/( PLBDG(:) * PLBDS(:) ) + &
+ XLBSDRYG3/( PLBDS(:)**2) )
+END WHERE
+!
+!* 1.c Collection of rr in the dry mode
+! -------------------------------------
+!
+GDRY(:) = (PRRT(:)>XRTMIN(3)) .AND. (PRGT(:)>XRTMIN(6)) .AND. LDCOMPUTE(:)
+!
+WHERE( GDRY )
+!
+!* Select the (ZLBDAG,ZLBDAR) couplet
+!
+ ZVEC1(:) = PLBDG(:)
+ ZVEC2(:) = PLBDR(:)
+!
+!* Find the next lower indice for the ZLBDAG and for the ZLBDAR
+! in the geometrical set of (Lbda_g,Lbda_r) couplet use to
+! tabulate the RDRYG-kernel
+!
+ ZVEC1(:) = MAX( 1.0001, MIN( REAL(NDRYLBDAG)-0.0001, &
+ XDRYINTP1G * LOG( ZVEC1(:) ) + XDRYINTP2G ) )
+ IVEC1(:) = INT( ZVEC1(:) )
+ ZVEC1(:) = ZVEC1(:) - REAL( IVEC1(:) )
+!
+ ZVEC2(:) = MAX( 1.0001, MIN( REAL(NDRYLBDAR)-0.0001, &
+ XDRYINTP1R * LOG( ZVEC2(:) ) + XDRYINTP2R ) )
+ IVEC2(:) = INT( ZVEC2(:) )
+ ZVEC2(:) = ZVEC2(:) - REAL( IVEC2(:) )
+!
+!* Perform the bilinear interpolation of the normalized
+! RDRYG-kernel
+!
+ Z1(:) = GET_XKER_RDRYG(IVEC1(:)+1,IVEC2(:)+1)
+ Z2(:) = GET_XKER_RDRYG(IVEC1(:)+1,IVEC2(:) )
+ Z3(:) = GET_XKER_RDRYG(IVEC1(:) ,IVEC2(:)+1)
+ Z4(:) = GET_XKER_RDRYG(IVEC1(:) ,IVEC2(:) )
+ ZVEC3(:) = ( Z1(:)* ZVEC2(:) &
+ - Z2(:)*(ZVEC2(:) - 1.0) ) &
+ * ZVEC1(:) &
+ - ( Z3(:)* ZVEC2(:) &
+ - Z4(:)*(ZVEC2(:) - 1.0) ) &
+ * (ZVEC1(:) - 1.0)
+ ZZW(:) = ZVEC3(:)
+!
+! BVIE manque PCRT ???????????????????????????????????
+! ZZW4(:) = XFRDRYG * ZZW(:) & ! RRDRYG
+ ZZW4(:) = XFRDRYG * ZZW(:) * PCRT(:) & ! RRDRYG
+ *( PLBDG(:)**XCXG ) * ( PRHODREF(:)**(-XCEXVT-1.) ) &
+ *( XLBRDRYG1/( PLBDG(:)**2 ) + &
+ XLBRDRYG2/( PLBDG(:) * PLBDR(:) ) + &
+ XLBRDRYG3/( PLBDR(:)**2) ) / PLBDR(:)**3
+END WHERE
+!
+! 1.d Total collection in the dry mode
+! ------------------------------------
+!
+ZRDRYG(:) = ZZW1(:) + ZZW2(:) + ZZW3(:) + ZZW4(:)
+!
+! 1.e Collection in the wet mode
+! ------------------------------
+!
+ZZW(:) = 0.0
+WHERE( PRGT(:)>XRTMIN(6) .AND. LDCOMPUTE(:) )
+ ZZW5(:) = ZZW2(:) / (XCOLIG*EXP(XCOLEXIG*(PT(:)-XTT)) ) ! RIWETG
+ ZZW6(:) = ZZW3(:) / (XCOLSG*EXP(XCOLEXSG*(PT(:)-XTT)) ) ! RSWETG
+!
+ ZZW(:) = PRVT(:)*PPRES(:)/((XMV/XMD)+PRVT(:)) ! Vapor pressure
+ ZZW(:) = PKA(:)*(XTT-PT(:)) + &
+ ( PDV(:)*(XLVTT + ( XCPV - XCL ) * ( PT(:) - XTT )) &
+ *(XESTT-ZZW(:))/(XRV*PT(:)) )
+!
+! Total mass gained by graupel in wet mode
+ ZRWETG(:) = MAX( 0.0, &
+ ( ZZW(:) * ( X0DEPG* PLBDG(:)**XEX0DEPG + &
+ X1DEPG*PCJ(:)*PLBDG(:)**XEX1DEPG ) + &
+ ( ZZW5(:)+ZZW6(:) ) * &
+ ( PRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-PT(:))) ) ) / &
+ ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) ) )
+END WHERE
+!
+! 1.f Wet mode and partial conversion to hail
+! -------------------------------------------
+!
+ZZW(:) = 0.0
+NHAIL = 0.
+IF (LHAIL) NHAIL = 1.
+WHERE( LDCOMPUTE(:) .AND. PRGT(:)>XRTMIN(6) .AND. PT(:)<XTT &
+ .AND. ZRDRYG(:)>=ZRWETG(:) .AND. ZRWETG(:)>0.0 )
+!
+! Mass of rain and cloud droplets frozen by graupel in wet mode : RCWETG + RRWETG = RWETG - RIWETG - RSWETG
+ ZZW7(:) = ZRWETG(:) - ZZW5(:) - ZZW6(:)
+!
+! assume a linear percent of conversion of graupel into hail
+! ZZW = percentage of graupel transformed
+!
+ ZZW(:) = ZRDRYG(:)*NHAIL/(ZRWETG(:)+ZRDRYG(:))
+!
+ P_RC_WETG(:) = - ZZW1(:)
+ P_CC_WETG(:) = P_RC_WETG(:) * PCCT(:)/MAX(PRCT(:),XRTMIN(2))
+ P_RR_WETG(:) = - ZZW7(:) + ZZW1(:)
+ P_CR_WETG(:) = P_RR_WETG(:) * PCRT(:)/MAX(PRRT(:),XRTMIN(3))
+ P_RI_WETG(:) = - ZZW5(:)
+ P_CI_WETG(:) = P_RI_WETG(:) * PCIT(:)/MAX(PRIT(:),XRTMIN(4))
+ P_RS_WETG(:) = - ZZW6(:)
+ P_RG_WETG(:) = - PRGT(:)/PTSTEP * ZZW(:) + ZRWETG(:) * (1.-ZZW(:))
+ P_RH_WETG(:) = PRGT(:)/PTSTEP * ZZW(:) + ZRWETG(:) * ZZW(:)
+ !
+ P_TH_WETG(:) = ZZW7(:) * (PLSFACT(:)-PLVFACT(:))
+END WHERE
+!
+! 1.g Dry mode
+! ------------
+!
+WHERE( LDCOMPUTE(:) .AND. PRGT(:)>XRTMIN(6) .AND. PT(:)<XTT &
+ .AND. ZRDRYG(:)<ZRWETG(:) .AND. ZRDRYG(:)>0.0 )
+ !
+ P_RC_DRYG(:) = - ZZW1(:)
+ P_CC_DRYG(:) = P_RC_DRYG(:) * PCCT(:)/MAX(PRCT(:),XRTMIN(2))
+ P_RR_DRYG(:) = - ZZW4(:)
+ P_CR_DRYG(:) = P_RR_DRYG(:) * PCRT(:)/MAX(PRRT(:),XRTMIN(3))
+ P_RI_DRYG(:) = - ZZW2(:)
+ P_CI_DRYG(:) = P_RI_DRYG(:) * PCIT(:)/MAX(PRIT(:),XRTMIN(4))
+ P_RS_DRYG(:) = - ZZW3(:)
+ P_RG_DRYG(:) = ZRDRYG(:)
+ !
+ P_TH_DRYG(:) = (ZZW1(:) + ZZW4(:)) * (PLSFACT(:)-PLVFACT(:))
+END WHERE
+!
+!
+!* 2. Hallett-Mossop process (HMG)
+! --------------------------------
+!
+! BVIE test ZRDRYG<ZZW ?????????????????????????
+!GDRY(:) = (PT(:)<XHMTMAX) .AND. (PT(:)>XHMTMIN) .AND. (ZRDRYG(:)<ZZW(:))&
+GDRY(:) = (PT(:)<XHMTMAX) .AND. (PT(:)>XHMTMIN) .AND. (ZRDRYG(:)<ZRWETG(:))&
+ .AND. (PRGT(:)>XRTMIN(6)) .AND. (PRCT(:)>XRTMIN(2)) .AND. LDCOMPUTE(:)
+
+ZZX(:)=9999.
+ZVEC1(:)=0.
+ZVEC2(:)=0.
+IVEC1(:)=0
+IVEC2(:)=0
+WHERE( GDRY(:) )
+!
+ ZVEC1(:) = PLBDC(:)
+ ZVEC2(:) = MAX( 1.0001, MIN( REAL(NGAMINC)-0.0001, &
+ XHMLINTP1 * LOG( ZVEC1(:) ) + XHMLINTP2 ) )
+ IVEC2(:) = INT( ZVEC2(:) )
+ ZVEC2(:) = ZVEC2(:) - REAL( IVEC2(:) )
+ ZVEC1(:) = XGAMINC_HMC( IVEC2(:)+1 )* ZVEC2(:) &
+ - XGAMINC_HMC( IVEC2(:) )*(ZVEC2(:) - 1.0)
+ ZZX(:) = ZVEC1(:) ! Large droplets
+!
+ WHERE ( ZZX(:)<0.99 ) ! Dry case
+ P_CI_HMG(:) = ZZW1(:)*(PCCT(:)/PRCT(:))*(1.0-ZZX(:))*XHM_FACTG* &
+ MAX( 0.0, MIN( (PT(:)-XHMTMIN)/3.0,(XHMTMAX-PT(:))/2.0 ) )
+ P_RI_HMG(:) = P_CI_HMG(:) * XMNU0
+ P_RG_HMG(:) = - P_RI_HMG(:)
+ END WHERE
+END WHERE
+!
+!
+!* 3. Graupel Melting
+! -------------------
+!
+ZZX(:) = 0.0
+WHERE( (PRGT(:)>XRTMIN(6)) .AND. (PT(:)>XTT) .AND. LDCOMPUTE(:) )
+ ZZX(:) = PRVT(:)*PPRES(:)/((XMV/XMD)+PRVT(:)) ! Vapor pressure
+ ZZX(:) = PKA(:)*(XTT-PT(:)) + &
+ ( PDV(:)*(XLVTT + ( XCPV - XCL ) * ( PT(:) - XTT )) &
+ *(XESTT-ZZX(:))/(XRV*PT(:)) )
+!
+! compute RGMLTR
+!
+ ZZX(:) = MAX( 0.0,( -ZZX(:) * &
+ ( X0DEPG* PLBDG(:)**XEX0DEPG + &
+ X1DEPG*PCJ(:)*PLBDG(:)**XEX1DEPG ) - &
+ ( ZZW1(:)+ZZW4(:) ) * &
+ ( PRHODREF(:)*XCL*(XTT-PT(:))) ) / &
+ ( PRHODREF(:)*XLMTT ) )
+ P_RR_GMLT(:) = ZZX(:)
+ P_CR_GMLT(:) = ZZX(:) * 5.0E6 ! obtained after averaging, Dshed=1mm and 500 microns
+ !
+ P_TH_GMLT(:) = - P_RR_GMLT(:) * (PLSFACT(:)-PLVFACT(:))
+END WHERE
+!
+!
+!
+!
+PA_RC(:) = PA_RC(:) + P_RC_WETG(:) + P_RC_DRYG(:)
+PA_CC(:) = PA_CC(:) + P_CC_WETG(:) + P_CC_DRYG(:)
+PA_RR(:) = PA_RR(:) + P_RR_WETG(:) + P_RR_DRYG(:) + P_RR_GMLT(:)
+PA_CR(:) = PA_CR(:) + P_CR_WETG(:) + P_CR_DRYG(:) + P_CR_GMLT(:)
+PA_RI(:) = PA_RI(:) + P_RI_WETG(:) + P_RI_DRYG(:) + P_RI_HMG(:)
+PA_CI(:) = PA_CI(:) + P_CI_WETG(:) + P_CI_DRYG(:) + P_CI_HMG(:)
+PA_RS(:) = PA_RS(:) + P_RS_WETG(:) + P_RS_DRYG(:)
+PA_RG(:) = PA_RG(:) + P_RG_WETG(:) + P_RG_DRYG(:) + P_RG_HMG(:) - P_RR_GMLT(:)
+PA_RH(:) = PA_RH(:) + P_RH_WETG(:)
+PA_TH(:) = PA_TH(:) + P_TH_WETG(:) + P_TH_DRYG(:) + P_TH_GMLT(:)
+!
+!-------------------------------------------------------------------------------
+!
+CONTAINS
+ FUNCTION GET_XKER_SDRYG(GRAUPEL,SNOW) RESULT(RET)
+ INTEGER, DIMENSION(:) :: GRAUPEL
+ INTEGER, DIMENSION(:) :: SNOW
+ REAL, DIMENSION(SIZE(SNOW)) :: RET
+ !
+ INTEGER I
+ !
+ DO I=1,SIZE(GRAUPEL)
+ RET(I) = XKER_SDRYG(MAX(MIN(GRAUPEL(I),SIZE(XKER_SDRYG,1)),1),MAX(MIN(SNOW(I),SIZE(XKER_SDRYG,2)),1))
+ END DO
+ END FUNCTION GET_XKER_SDRYG
+!
+!-------------------------------------------------------------------------------
+!
+ FUNCTION GET_XKER_RDRYG(GRAUPEL,RAIN) RESULT(RET)
+ INTEGER, DIMENSION(:) :: GRAUPEL
+ INTEGER, DIMENSION(:) :: RAIN
+ REAL, DIMENSION(SIZE(RAIN)) :: RET
+ !
+ INTEGER I
+ !
+ DO I=1,SIZE(GRAUPEL)
+ RET(I) = XKER_RDRYG(MAX(MIN(GRAUPEL(I),SIZE(XKER_RDRYG,1)),1),MAX(MIN(RAIN(I),SIZE(XKER_RDRYG,2)),1))
+ END DO
+ END FUNCTION GET_XKER_RDRYG
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_GRAUPEL
diff --git a/src/mesonh/micro/lima_graupel_deposition.f90 b/src/mesonh/micro/lima_graupel_deposition.f90
new file mode 100644
index 000000000..d283c9699
--- /dev/null
+++ b/src/mesonh/micro/lima_graupel_deposition.f90
@@ -0,0 +1,97 @@
+!MNH_LIC Copyright 2018-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-------------------------------------------------------------------------------
+! #################################
+ MODULE MODI_LIMA_GRAUPEL_DEPOSITION
+! #################################
+!
+INTERFACE
+ SUBROUTINE LIMA_GRAUPEL_DEPOSITION (LDCOMPUTE, PRHODREF, &
+ PRGT, PSSI, PLBDG, PAI, PCJ, PLSFACT, &
+ P_TH_DEPG, P_RG_DEPG )
+!
+LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
+REAL, DIMENSION(:), INTENT(IN) :: PRHODREF !
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRGT ! Cloud water C. at t
+REAL, DIMENSION(:), INTENT(IN) :: PSSI !
+REAL, DIMENSION(:), INTENT(IN) :: PLBDG !
+REAL, DIMENSION(:), INTENT(IN) :: PAI !
+REAL, DIMENSION(:), INTENT(IN) :: PCJ !
+REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
+!
+REAL, DIMENSION(:), INTENT(OUT) :: P_TH_DEPG
+REAL, DIMENSION(:), INTENT(OUT) :: P_RG_DEPG
+!!
+END SUBROUTINE LIMA_GRAUPEL_DEPOSITION
+END INTERFACE
+END MODULE MODI_LIMA_GRAUPEL_DEPOSITION
+!
+! ###########################################################################
+ SUBROUTINE LIMA_GRAUPEL_DEPOSITION (LDCOMPUTE, PRHODREF, &
+ PRGT, PSSI, PLBDG, PAI, PCJ, PLSFACT, &
+ P_TH_DEPG, P_RG_DEPG )
+! ###########################################################################
+!
+!! PURPOSE
+!! -------
+!! Deposition of water vapour on graupel
+!!
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * CNRM *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 15/03/2018
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAM_LIMA, ONLY : XRTMIN
+USE MODD_PARAM_LIMA_MIXED, ONLY : X0DEPG, XEX0DEPG, X1DEPG, XEX1DEPG
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
+REAL, DIMENSION(:), INTENT(IN) :: PRHODREF !
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRGT ! Cloud water C. at t
+REAL, DIMENSION(:), INTENT(IN) :: PSSI !
+REAL, DIMENSION(:), INTENT(IN) :: PLBDG !
+REAL, DIMENSION(:), INTENT(IN) :: PAI !
+REAL, DIMENSION(:), INTENT(IN) :: PCJ !
+REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
+!
+REAL, DIMENSION(:), INTENT(OUT) :: P_TH_DEPG
+REAL, DIMENSION(:), INTENT(OUT) :: P_RG_DEPG
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 1. Deposition of vapour on graupel
+! -------------------------------
+!
+P_TH_DEPG(:) = 0.0
+P_RG_DEPG(:) = 0.0
+WHERE ( (PRGT(:)>XRTMIN(6)) .AND. LDCOMPUTE(:) )
+ P_RG_DEPG(:) = ( PSSI(:)/PAI(:)/PRHODREF(:) ) * &
+ ( X0DEPG*PLBDG(:)**XEX0DEPG + X1DEPG*PCJ(:)*PLBDG(:)**XEX1DEPG )
+ P_TH_DEPG(:) = P_RG_DEPG(:)*PLSFACT(:)
+END WHERE
+!
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_GRAUPEL_DEPOSITION
diff --git a/src/mesonh/micro/lima_ice_aggregation_snow.f90 b/src/mesonh/micro/lima_ice_aggregation_snow.f90
new file mode 100644
index 000000000..15e01ec84
--- /dev/null
+++ b/src/mesonh/micro/lima_ice_aggregation_snow.f90
@@ -0,0 +1,119 @@
+!MNH_LIC Copyright 2018-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-------------------------------------------------------------------------------
+! #################################
+ MODULE MODI_LIMA_ICE_AGGREGATION_SNOW
+! #################################
+!
+INTERFACE
+ SUBROUTINE LIMA_ICE_AGGREGATION_SNOW (LDCOMPUTE, &
+ PT, PRHODREF, &
+ PRIT, PRST, PCIT, PLBDI, PLBDS, &
+ P_RI_AGGS, P_CI_AGGS )
+!
+LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
+!
+REAL, DIMENSION(:), INTENT(IN) :: PT
+REAL, DIMENSION(:), INTENT(IN) :: PRHODREF
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRIT
+REAL, DIMENSION(:), INTENT(IN) :: PRST
+REAL, DIMENSION(:), INTENT(IN) :: PCIT
+REAL, DIMENSION(:), INTENT(IN) :: PLBDI
+REAL, DIMENSION(:), INTENT(IN) :: PLBDS
+!
+REAL, DIMENSION(:), INTENT(OUT) :: P_RI_AGGS
+REAL, DIMENSION(:), INTENT(OUT) :: P_CI_AGGS
+!
+END SUBROUTINE LIMA_ICE_AGGREGATION_SNOW
+END INTERFACE
+END MODULE MODI_LIMA_ICE_AGGREGATION_SNOW
+!
+! #######################################################################
+ SUBROUTINE LIMA_ICE_AGGREGATION_SNOW (LDCOMPUTE, &
+ PT, PRHODREF, &
+ PRIT, PRST, PCIT, PLBDI, PLBDS, &
+ P_RI_AGGS, P_CI_AGGS )
+! #######################################################################
+!
+!! PURPOSE
+!! -------
+!! Compute the aggregation of pristine ice on snow/aggregates
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * CNRM *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 15/03/2018
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY : XTT
+USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN
+USE MODD_PARAM_LIMA_COLD, ONLY : XBI, XCCS, XCXS, XCOLEXIS, XAGGS_CLARGE1, XAGGS_CLARGE2, &
+ XAGGS_RLARGE1, XAGGS_RLARGE2
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
+!
+REAL, DIMENSION(:), INTENT(IN) :: PT
+REAL, DIMENSION(:), INTENT(IN) :: PRHODREF
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRIT
+REAL, DIMENSION(:), INTENT(IN) :: PRST
+REAL, DIMENSION(:), INTENT(IN) :: PCIT
+REAL, DIMENSION(:), INTENT(IN) :: PLBDI
+REAL, DIMENSION(:), INTENT(IN) :: PLBDS
+!
+REAL, DIMENSION(:), INTENT(OUT) :: P_RI_AGGS
+REAL, DIMENSION(:), INTENT(OUT) :: P_CI_AGGS
+!
+!* 0.2 Declarations of local variables :
+!
+REAL, DIMENSION(SIZE(PRIT)) :: ZZW1, ZZW2, ZZW3 ! work arrays
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 2.4 Aggregation of r_i on r_s: CIAGGS and RIAGGS
+! ---------------------------------------------------
+!
+ZZW1(:) = 0.
+ZZW2(:) = 0.
+ZZW3(:) = 0.
+!
+P_RI_AGGS(:) = 0.
+P_CI_AGGS(:) = 0.
+!
+!
+WHERE ( (PRIT(:)>XRTMIN(4)) .AND. (PRST(:)>XRTMIN(5)) .AND. LDCOMPUTE(:) )
+ ZZW1(:) = (PLBDI(:) / PLBDS(:))**3
+ ZZW2(:) = (PCIT(:)*(XCCS*PLBDS(:)**XCXS)/PRHODREF(:)*EXP( XCOLEXIS*(PT(:)-XTT) )) &
+ / (PLBDI(:)**3)
+ ZZW3(:) = ZZW2(:)*(XAGGS_CLARGE1+XAGGS_CLARGE2*ZZW1(:))
+!
+ P_CI_AGGS(:) = - ZZW3(:)
+!
+ ZZW2(:) = ZZW2(:) / PLBDI(:)**XBI
+ ZZW2(:) = ZZW2(:)*(XAGGS_RLARGE1+XAGGS_RLARGE2*ZZW1(:))
+!
+ P_RI_AGGS(:) = - ZZW2(:)
+END WHERE
+!
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_ICE_AGGREGATION_SNOW
diff --git a/src/mesonh/micro/lima_ice_deposition.f90 b/src/mesonh/micro/lima_ice_deposition.f90
new file mode 100644
index 000000000..8c7c57e40
--- /dev/null
+++ b/src/mesonh/micro/lima_ice_deposition.f90
@@ -0,0 +1,175 @@
+!MNH_LIC Copyright 2018-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-------------------------------------------------------------------------------
+! #####################
+ MODULE MODI_LIMA_ICE_DEPOSITION
+! #####################
+!
+INTERFACE
+ SUBROUTINE LIMA_ICE_DEPOSITION (PTSTEP, LDCOMPUTE, &
+ PRHODREF, PSSI, PAI, PCJ, PLSFACT, &
+ PRIT, PCIT, PLBDI, &
+ P_TH_DEPI, P_RI_DEPI, &
+ P_RI_CNVS, P_CI_CNVS )
+!
+REAL, INTENT(IN) :: PTSTEP
+LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:), INTENT(IN) :: PSSI ! abs. pressure at time t
+REAL, DIMENSION(:), INTENT(IN) :: PAI ! abs. pressure at time t
+REAL, DIMENSION(:), INTENT(IN) :: PCJ ! abs. pressure at time t
+REAL, DIMENSION(:), INTENT(IN) :: PLSFACT ! abs. pressure at time t
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
+!
+REAL, DIMENSION(:), INTENT(IN) :: PCIT ! Ice crystal C. at t
+!
+REAL, DIMENSION(:), INTENT(IN) :: PLBDI ! Graupel m.r. at t
+!
+REAL, DIMENSION(:), INTENT(OUT) :: P_TH_DEPI
+REAL, DIMENSION(:), INTENT(OUT) :: P_RI_DEPI
+REAL, DIMENSION(:), INTENT(OUT) :: P_RI_CNVS
+REAL, DIMENSION(:), INTENT(OUT) :: P_CI_CNVS
+!
+END SUBROUTINE LIMA_ICE_DEPOSITION
+END INTERFACE
+END MODULE MODI_LIMA_ICE_DEPOSITION
+!
+! ##########################################################################
+SUBROUTINE LIMA_ICE_DEPOSITION (PTSTEP, LDCOMPUTE, &
+ PRHODREF, PSSI, PAI, PCJ, PLSFACT, &
+ PRIT, PCIT, PLBDI, &
+ P_TH_DEPI, P_RI_DEPI, &
+ P_RI_CNVS, P_CI_CNVS )
+! ##########################################################################
+!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the microphysical sources
+!! for slow cold processes :
+!! - conversion of snow to ice
+!! - deposition of vapor on snow
+!! - conversion of ice to snow (Harrington 1995)
+!!
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * CNRM *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 15/03/2018
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, XALPHAI, XALPHAS, XNUI, XNUS
+USE MODD_PARAM_LIMA_COLD, ONLY : XCXS, XCCS, &
+ XLBDAS_MAX, XDSCNVI_LIM, XLBDASCNVI_MAX, &
+ XC0DEPSI, XC1DEPSI, XR0DEPSI, XR1DEPSI, &
+ XSCFAC, X1DEPS, X0DEPS, XEX1DEPS, XEX0DEPS, &
+ XDICNVS_LIM, XLBDAICNVS_LIM, &
+ XC0DEPIS, XC1DEPIS, XR0DEPIS, XR1DEPIS, &
+ XCOLEXIS, XAGGS_CLARGE1, XAGGS_CLARGE2, &
+ XAGGS_RLARGE1, XAGGS_RLARGE2, &
+ XDI, X0DEPI, X2DEPI
+
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, INTENT(IN) :: PTSTEP
+LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:), INTENT(IN) :: PSSI ! abs. pressure at time t
+REAL, DIMENSION(:), INTENT(IN) :: PAI ! abs. pressure at time t
+REAL, DIMENSION(:), INTENT(IN) :: PCJ ! abs. pressure at time t
+REAL, DIMENSION(:), INTENT(IN) :: PLSFACT ! abs. pressure at time t
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
+!
+REAL, DIMENSION(:), INTENT(IN) :: PCIT ! Ice crystal C. at t
+!
+REAL, DIMENSION(:), INTENT(IN) :: PLBDI ! Graupel m.r. at t
+!
+REAL, DIMENSION(:), INTENT(OUT) :: P_TH_DEPI
+REAL, DIMENSION(:), INTENT(OUT) :: P_RI_DEPI
+REAL, DIMENSION(:), INTENT(OUT) :: P_RI_CNVS
+REAL, DIMENSION(:), INTENT(OUT) :: P_CI_CNVS
+!
+!* 0.2 Declarations of local variables :
+!
+LOGICAL, DIMENSION(SIZE(PRHODREF)) :: GMICRO ! Computations only where necessary
+REAL, DIMENSION(SIZE(PRHODREF)) :: ZZW, ZZW2, ZZX ! Work array
+!
+!
+!-------------------------------------------------------------------------------
+!
+P_TH_DEPI(:) = 0.
+P_RI_DEPI(:) = 0.
+P_RI_CNVS(:) = 0.
+P_CI_CNVS(:) = 0.
+!
+! Physical limitations
+!
+!
+! Looking for regions where computations are necessary
+!
+GMICRO(:) = LDCOMPUTE(:) .AND. PRIT(:)>XRTMIN(4)
+!
+!
+WHERE( GMICRO )
+!
+!
+!* 2.2 Deposition of water vapor on r_i: RVDEPI
+! -----------------------------------------------
+!
+!
+ ZZW(:) = 0.0
+ WHERE ( (PRIT(:)>XRTMIN(4)) .AND. (PCIT(:)>XCTMIN(4)) )
+ ZZW(:) = ( PSSI(:) / PAI(:) ) * PCIT(:) * &
+ ( X0DEPI/PLBDI(:)+X2DEPI*PCJ(:)*PCJ(:)/PLBDI(:)**(XDI+2.0) )
+ END WHERE
+!
+ P_RI_DEPI(:) = ZZW(:)
+!!$ P_TH_DEPI(:) = P_RI_DEPI(:) * PLSFACT(:)
+!
+!!$ PA_TH(:) = PA_TH(:) + P_TH_DEPI(:)
+!!$ PA_RV(:) = PA_RV(:) - P_RI_DEPI(:)
+!!$ PA_RI(:) = PA_RI(:) + P_RI_DEPI(:)
+!
+!
+!* 2.3 Conversion of pristine ice to r_s: RICNVS
+! ------------------------------------------------
+!
+!
+ ZZW(:) = 0.0
+ ZZW2(:) = 0.0
+ WHERE ( (PLBDI(:)<XLBDAICNVS_LIM) .AND. (PCIT(:)>XCTMIN(4)) &
+ .AND. (PSSI(:)>0.0) )
+ ZZW(:) = (PLBDI(:)*XDICNVS_LIM)**(XALPHAI)
+ ZZX(:) = ( PSSI(:)/PAI(:) )*PCIT(:) * (ZZW(:)**XNUI) *EXP(-ZZW(:))
+!
+ ZZW(:) = ( XR0DEPIS + XR1DEPIS*PCJ(:) )*ZZX(:)
+!
+ ZZW2(:) = ZZW(:) * (XC0DEPIS+XC1DEPIS*PCJ(:)) / (XR0DEPIS+XR1DEPIS*PCJ(:))
+ END WHERE
+!
+P_RI_CNVS(:) = - ZZW(:)
+P_CI_CNVS(:) = - ZZW2(:)
+!
+!
+END WHERE
+!
+!
+END SUBROUTINE LIMA_ICE_DEPOSITION
diff --git a/src/mesonh/micro/lima_ice_melting.f90 b/src/mesonh/micro/lima_ice_melting.f90
new file mode 100644
index 000000000..a95f45044
--- /dev/null
+++ b/src/mesonh/micro/lima_ice_melting.f90
@@ -0,0 +1,164 @@
+!MNH_LIC Copyright 2013-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+! #################################
+ MODULE MODI_LIMA_ICE_MELTING
+! #################################
+!
+INTERFACE
+ SUBROUTINE LIMA_ICE_MELTING (PTSTEP, LDCOMPUTE, &
+ PEXNREF, PPABST, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PCIT, PINT, &
+ P_TH_IMLT, P_RC_IMLT, P_CC_IMLT, &
+ PB_TH, PB_RC, PB_CC, PB_RI, PB_CI, PB_IFNN)
+!
+REAL, INTENT(IN) :: PTSTEP
+LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
+!
+REAL, DIMENSION(:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:), INTENT(IN) :: PPABST ! abs. pressure at time t
+!
+REAL, DIMENSION(:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:), INTENT(IN) :: PRVT !
+REAL, DIMENSION(:), INTENT(IN) :: PRCT !
+REAL, DIMENSION(:), INTENT(IN) :: PRRT !
+REAL, DIMENSION(:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRST !
+REAL, DIMENSION(:), INTENT(IN) :: PRGT !
+!
+REAL, DIMENSION(:), INTENT(IN) :: PCIT ! Rain water C. at t
+REAL, DIMENSION(:,:), INTENT(IN) :: PINT ! Nucleated IFN C. at t
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_IMLT
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_IMLT
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_IMLT
+REAL, DIMENSION(:), INTENT(INOUT) :: PB_TH
+REAL, DIMENSION(:), INTENT(INOUT) :: PB_RC
+REAL, DIMENSION(:), INTENT(INOUT) :: PB_CC
+REAL, DIMENSION(:), INTENT(INOUT) :: PB_RI
+REAL, DIMENSION(:), INTENT(INOUT) :: PB_CI
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PB_IFNN
+!
+END SUBROUTINE LIMA_ICE_MELTING
+END INTERFACE
+END MODULE MODI_LIMA_ICE_MELTING
+!
+! ########################################################################
+ SUBROUTINE LIMA_ICE_MELTING (PTSTEP, LDCOMPUTE, &
+ PEXNREF, PPABST, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PCIT, PINT, &
+ P_TH_IMLT, P_RC_IMLT, P_CC_IMLT, &
+ PB_TH, PB_RC, PB_CC, PB_RI, PB_CI, PB_IFNN)
+! ########################################################################
+!
+!! PURPOSE
+!! -------
+!! Melting of pristine ice crystals
+!!
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * CNRM *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 15/03/2018
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY : XP00, XRD, XCPD, XCPV, XCL, XCI, XTT, XLSTT, XLVTT
+USE MODD_PARAM_LIMA, ONLY : XRTMIN, NMOD_IFN
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, INTENT(IN) :: PTSTEP
+LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
+!
+REAL, DIMENSION(:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:), INTENT(IN) :: PPABST ! abs. pressure at time t
+!
+REAL, DIMENSION(:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:), INTENT(IN) :: PRVT !
+REAL, DIMENSION(:), INTENT(IN) :: PRCT !
+REAL, DIMENSION(:), INTENT(IN) :: PRRT !
+REAL, DIMENSION(:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRST !
+REAL, DIMENSION(:), INTENT(IN) :: PRGT !
+!
+REAL, DIMENSION(:), INTENT(IN) :: PCIT ! Rain water C. at t
+REAL, DIMENSION(:,:), INTENT(IN) :: PINT ! Nucleated IFN C. at t
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_IMLT
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_IMLT
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_IMLT
+REAL, DIMENSION(:), INTENT(INOUT) :: PB_TH
+REAL, DIMENSION(:), INTENT(INOUT) :: PB_RC
+REAL, DIMENSION(:), INTENT(INOUT) :: PB_CC
+REAL, DIMENSION(:), INTENT(INOUT) :: PB_RI
+REAL, DIMENSION(:), INTENT(INOUT) :: PB_CI
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PB_IFNN
+!
+!* 0.2 Declarations of local variables :
+!
+REAL, DIMENSION(SIZE(PTHT)) :: &
+ ZW, &
+ ZT, &
+ ZTCELSIUS,&
+ ZLSFACT, &
+ ZLVFACT, &
+ ZMASK
+!
+INTEGER :: JMOD_IFN
+!
+!
+!
+!-------------------------------------------------------------------------------
+!
+P_TH_IMLT(:) = 0.
+P_RC_IMLT(:) = 0.
+P_CC_IMLT(:) = 0.
+!
+! Temperature
+ZT(:) = PTHT(:) * ( PPABST(:)/XP00 ) ** (XRD/XCPD)
+ZTCELSIUS(:) = ZT(:)-XTT
+!
+ZW(:) = PEXNREF(:)*( XCPD+XCPV*PRVT(:)+XCL*(PRCT(:)+PRRT(:)) &
+ +XCI*(PRIT(:)+PRST(:)+PRGT(:)) )
+ZLSFACT(:) = (XLSTT+(XCPV-XCI)*ZTCELSIUS(:))/ZW(:) ! L_s/(Pi_ref*C_ph)
+ZLVFACT(:) = (XLVTT+(XCPV-XCL)*ZTCELSIUS(:))/ZW(:) ! L_v/(Pi_ref*C_ph)
+!
+ZW(:) = 0.0
+!
+ZMASK(:) = 0.
+!
+WHERE( (ZT(:)>XTT) .AND. (PRIT(:)>XRTMIN(4)) .AND. LDCOMPUTE(:) )
+ P_TH_IMLT(:) = - PRIT(:)*(ZLSFACT(:)-ZLVFACT(:))
+ P_RC_IMLT(:) = PRIT(:)
+ P_CC_IMLT(:) = PCIT(:)
+ PB_TH(:) = PB_TH(:) + P_TH_IMLT(:)
+ PB_RC(:) = PB_RC(:) + PRIT(:)
+ PB_CC(:) = PB_CC(:) + PCIT(:)
+ PB_RI(:) = PB_RI(:) - PRIT(:)
+ PB_CI(:) = PB_CI(:) - PCIT(:)
+ ZMASK(:) = 1.
+ENDWHERE
+!
+DO JMOD_IFN = 1,NMOD_IFN
+ PB_IFNN(:,JMOD_IFN) = PB_IFNN(:,JMOD_IFN) - PINT(:,JMOD_IFN)* ZMASK(:)
+ENDDO
+!
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_ICE_MELTING
diff --git a/src/mesonh/micro/lima_ice_snow_deposition.f90 b/src/mesonh/micro/lima_ice_snow_deposition.f90
new file mode 100644
index 000000000..4d92b528a
--- /dev/null
+++ b/src/mesonh/micro/lima_ice_snow_deposition.f90
@@ -0,0 +1,230 @@
+!MNH_LIC Copyright 2013-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+! #####################
+ MODULE MODI_LIMA_ICE_SNOW_DEPOSITION
+! #####################
+!
+INTERFACE
+ SUBROUTINE LIMA_ICE_SNOW_DEPOSITION (PTSTEP, LDCOMPUTE, &
+ PRHODREF, PSSI, PAI, PCJ, PLSFACT, &
+ PRIT, PRST, PCIT, PLBDI, PLBDS, &
+ P_RI_CNVI, P_CI_CNVI, &
+ P_TH_DEPS, P_RS_DEPS, &
+ P_RI_CNVS, P_CI_CNVS, &
+ PA_TH, PA_RV, PA_RI, PA_CI, PA_RS )
+!
+REAL, INTENT(IN) :: PTSTEP
+LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:), INTENT(IN) :: PSSI ! abs. pressure at time t
+REAL, DIMENSION(:), INTENT(IN) :: PAI ! abs. pressure at time t
+REAL, DIMENSION(:), INTENT(IN) :: PCJ ! abs. pressure at time t
+REAL, DIMENSION(:), INTENT(IN) :: PLSFACT ! abs. pressure at time t
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+!
+REAL, DIMENSION(:), INTENT(IN) :: PCIT ! Ice crystal C. at t
+!
+REAL, DIMENSION(:), INTENT(IN) :: PLBDI ! Graupel m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PLBDS ! Graupel m.r. at t
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_CNVI
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_CNVI
+REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_DEPS
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_DEPS
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_CNVS
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_CNVS
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_TH
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_RV
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_RI
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_CI
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_RS
+!
+END SUBROUTINE LIMA_ICE_SNOW_DEPOSITION
+END INTERFACE
+END MODULE MODI_LIMA_ICE_SNOW_DEPOSITION
+!
+! ##########################################################################
+SUBROUTINE LIMA_ICE_SNOW_DEPOSITION (PTSTEP, LDCOMPUTE, &
+ PRHODREF, PSSI, PAI, PCJ, PLSFACT, &
+ PRIT, PRST, PCIT, PLBDI, PLBDS, &
+ P_RI_CNVI, P_CI_CNVI, &
+ P_TH_DEPS, P_RS_DEPS, &
+ P_RI_CNVS, P_CI_CNVS, &
+ PA_TH, PA_RV, PA_RI, PA_CI, PA_RS )
+! ##########################################################################
+!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the microphysical sources
+!! for slow cold processes :
+!! - conversion of snow to ice
+!! - deposition of vapor on snow
+!! - conversion of ice to snow (Harrington 1995)
+!!
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * CNRM *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 15/03/2018
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, XALPHAI, XALPHAS, XNUI, XNUS
+USE MODD_PARAM_LIMA_COLD, ONLY : XCXS, XCCS, &
+ XLBDAS_MAX, XDSCNVI_LIM, XLBDASCNVI_MAX, &
+ XC0DEPSI, XC1DEPSI, XR0DEPSI, XR1DEPSI, &
+ XSCFAC, X1DEPS, X0DEPS, XEX1DEPS, XEX0DEPS, &
+ XDICNVS_LIM, XLBDAICNVS_LIM, &
+ XC0DEPIS, XC1DEPIS, XR0DEPIS, XR1DEPIS, &
+ XCOLEXIS, XAGGS_CLARGE1, XAGGS_CLARGE2, &
+ XAGGS_RLARGE1, XAGGS_RLARGE2
+
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, INTENT(IN) :: PTSTEP
+LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:), INTENT(IN) :: PSSI ! abs. pressure at time t
+REAL, DIMENSION(:), INTENT(IN) :: PAI ! abs. pressure at time t
+REAL, DIMENSION(:), INTENT(IN) :: PCJ ! abs. pressure at time t
+REAL, DIMENSION(:), INTENT(IN) :: PLSFACT ! abs. pressure at time t
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+!
+REAL, DIMENSION(:), INTENT(IN) :: PCIT ! Ice crystal C. at t
+!
+REAL, DIMENSION(:), INTENT(IN) :: PLBDI ! Graupel m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PLBDS ! Graupel m.r. at t
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_CNVI
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_CNVI
+REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_DEPS
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_DEPS
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_CNVS
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_CNVS
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_TH
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_RV
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_RI
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_CI
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_RS
+!
+!* 0.2 Declarations of local variables :
+!
+LOGICAL, DIMENSION(SIZE(PRHODREF)) :: GMICRO ! Computations only where necessary
+REAL, DIMENSION(SIZE(PRHODREF)) :: ZZW, ZZW2, ZZX ! Work array
+!
+!
+!-------------------------------------------------------------------------------
+!
+P_RI_CNVI(:) = 0.
+P_CI_CNVI(:) = 0.
+P_TH_DEPS(:) = 0.
+P_RS_DEPS(:) = 0.
+P_RI_CNVS(:) = 0.
+P_CI_CNVS(:) = 0.
+!
+! Physical limitations
+!
+!
+! Looking for regions where computations are necessary
+!
+GMICRO(:) = .FALSE.
+GMICRO(:) = LDCOMPUTE(:) .AND. &
+ (PRIT(:)>XRTMIN(4) .OR. &
+ PRST(:)>XRTMIN(5))
+!
+!
+WHERE( GMICRO )
+!
+!* 2.1 Conversion of snow to r_i: RSCNVI
+! ----------------------------------------
+!
+!
+ ZZW2(:) = 0.0
+ ZZW(:) = 0.0
+ WHERE ( PLBDS(:)<XLBDASCNVI_MAX .AND. (PRST(:)>XRTMIN(5)) &
+ .AND. (PSSI(:)<0.0) )
+ ZZW(:) = (PLBDS(:)*XDSCNVI_LIM)**(XALPHAS)
+ ZZX(:) = ( -PSSI(:)/PAI(:) ) * (XCCS*PLBDS(:)**XCXS)/PRHODREF(:) * (ZZW(:)**XNUS) * EXP(-ZZW(:))
+!
+ ZZW(:) = ( XR0DEPSI+XR1DEPSI*PCJ(:) )*ZZX(:)
+!
+ ZZW2(:) = ZZW(:)*( XC0DEPSI+XC1DEPSI*PCJ(:) )/( XR0DEPSI+XR1DEPSI*PCJ(:) )
+ END WHERE
+!
+ P_RI_CNVI(:) = ZZW(:)
+ P_CI_CNVI(:) = ZZW2(:)
+!
+ PA_RI(:) = PA_RI(:) + P_RI_CNVI(:)
+ PA_CI(:) = PA_CI(:) + P_CI_CNVI(:)
+ PA_RS(:) = PA_RS(:) - P_RI_CNVI(:)
+!
+!
+!* 2.2 Deposition of water vapor on r_s: RVDEPS
+! -----------------------------------------------
+!
+!
+ ZZW(:) = 0.0
+ WHERE ( (PRST(:)>XRTMIN(5)) )
+ ZZW(:) = ( PSSI(:)/(PAI(:))/PRHODREF(:) ) * &
+ ( X0DEPS*PLBDS(:)**XEX0DEPS + X1DEPS*PCJ(:)*PLBDS(:)**XEX1DEPS )
+ ZZW(:) = ZZW(:)*(0.5+SIGN(0.5,ZZW(:))) - ABS(ZZW(:))*(0.5-SIGN(0.5,ZZW(:)))
+ END WHERE
+!
+ P_RS_DEPS(:) = ZZW(:)
+ P_TH_DEPS(:) = P_RS_DEPS(:) * PLSFACT(:)
+!
+ PA_TH(:) = PA_TH(:) + P_TH_DEPS(:)
+ PA_RV(:) = PA_RV(:) - P_RS_DEPS(:)
+ PA_RS(:) = PA_RS(:) + P_RS_DEPS(:)
+!
+!
+!* 2.3 Conversion of pristine ice to r_s: RICNVS
+! ------------------------------------------------
+!
+!
+ ZZW(:) = 0.0
+ ZZW2(:) = 0.0
+ WHERE ( (PLBDI(:)<XLBDAICNVS_LIM) .AND. (PCIT(:)>XCTMIN(4)) &
+ .AND. (PSSI(:)>0.0) )
+ ZZW(:) = (PLBDI(:)*XDICNVS_LIM)**(XALPHAI)
+ ZZX(:) = ( PSSI(:)/PAI(:) )*PCIT(:) * (ZZW(:)**XNUI) *EXP(-ZZW(:))
+!
+ ZZW(:) = ( XR0DEPIS + XR1DEPIS*PCJ(:) )*ZZX(:)
+!
+ ZZW2(:) = ZZW(:) * (XC0DEPIS+XC1DEPIS*PCJ(:)) / (XR0DEPIS+XR1DEPIS*PCJ(:))
+ END WHERE
+!
+P_RI_CNVS(:) = - ZZW(:)
+P_CI_CNVS(:) = - ZZW2(:)
+!
+PA_RI(:) = PA_RI(:) + P_RI_CNVS(:)
+PA_CI(:) = PA_CI(:) + P_CI_CNVS(:)
+PA_RS(:) = PA_RS(:) - P_RI_CNVS(:)
+!
+!
+END WHERE
+!
+!
+END SUBROUTINE LIMA_ICE_SNOW_DEPOSITION
diff --git a/src/mesonh/micro/lima_init_ccn_activation_spectrum.f90 b/src/mesonh/micro/lima_init_ccn_activation_spectrum.f90
new file mode 100644
index 000000000..16a561740
--- /dev/null
+++ b/src/mesonh/micro/lima_init_ccn_activation_spectrum.f90
@@ -0,0 +1,458 @@
+!MNH_LIC Copyright 2007-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-------------------------------------------------------------------------------
+! ####################
+ MODULE MODI_LIMA_INIT_CCN_ACTIVATION_SPECTRUM
+INTERFACE
+ SUBROUTINE LIMA_INIT_CCN_ACTIVATION_SPECTRUM (CTYPE_CCN,XD,XSIGMA,XLIMIT_FACTOR,XK,XMU,XBETA,XKAPPA)
+ !
+ CHARACTER(LEN=*), INTENT(IN) :: CTYPE_CCN ! Aerosol type
+ REAL, INTENT(IN) :: XD ! Aerosol PSD modal diameter
+ REAL, INTENT(IN) :: XSIGMA ! Aerosol PSD width
+ REAL, INTENT(OUT) :: XLIMIT_FACTOR ! C/Naer
+ REAL, INTENT(OUT) :: XK ! k
+ REAL, INTENT(OUT) :: XMU ! mu
+ REAL, INTENT(OUT) :: XBETA ! beta
+ REAL, INTENT(OUT) :: XKAPPA ! kappa
+!
+ END SUBROUTINE LIMA_INIT_CCN_ACTIVATION_SPECTRUM
+END INTERFACE
+END MODULE MODI_LIMA_INIT_CCN_ACTIVATION_SPECTRUM
+! ####################
+!
+! #############################################################
+ SUBROUTINE LIMA_INIT_CCN_ACTIVATION_SPECTRUM (CTYPE_CCN,XD,XSIGMA,XLIMIT_FACTOR,XK,XMU,XBETA,XKAPPA)
+! #############################################################
+
+!!
+!!
+!! PURPOSE
+!! -------
+!!
+!! Compute mu, k and beta parameters of the activation spectrum based on CCN
+!! characteristics (type and PSD)
+!!
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY : XMV, XAVOGADRO, XBOLTZ, XRHOLW
+!
+USE MODI_GAMMA_INC
+USE MODI_HYPGEO
+USE MODI_HYPSER
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+CHARACTER(LEN=*), INTENT(IN) :: CTYPE_CCN ! Aerosol type
+REAL, INTENT(IN) :: XD ! Aerosol PSD modal diameter
+REAL, INTENT(IN) :: XSIGMA ! Aerosol PSD width
+REAL, INTENT(OUT) :: XLIMIT_FACTOR ! C/Naer
+REAL, INTENT(OUT) :: XK ! k
+REAL, INTENT(OUT) :: XMU ! mu
+REAL, INTENT(OUT) :: XBETA ! beta
+REAL, INTENT(OUT) :: XKAPPA ! kappa
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER, PARAMETER :: M = 1000 ! Number of points (S,Nccn) used to fit the spectra
+INTEGER, PARAMETER :: N = 3 ! Number of parameters to adjust
+REAL, DIMENSION(N) :: PARAMS ! Parameters to adjust by the LM algorithm (k, mu, beta)
+REAL, DIMENSION(M) :: FVEC ! Array to store the distance between theoretical and fitted spectra
+INTEGER :: IFLAG !
+INTEGER :: INFO !
+REAL :: TOL = 1.E-16 ! Fit precision required
+!
+INTEGER :: II, IJ ! Loop indices
+!
+REAL :: XW !
+REAL :: XDDRY = 0.1E-6 ! Dry diameter for which to compute Scrit
+REAL :: XSCRIT ! Scrit for dry diameter XDDRY
+REAL :: XMIN = 0.1E-6 ! minimum diameter for root search (m)
+REAL :: XMAX = 10.E-6 ! maximum diameter for root search (m)
+REAL :: XPREC = 1.E-8 ! precision wanted for root (m)
+!
+!REAL :: XKAPPA ! kappa coefficient
+REAL, DIMENSION(M) :: XS ! saturation ratio (S=1.01 for a 1% supersaturation)
+REAL, DIMENSION(M) :: XDCRIT ! critical diameters (m) for the chosen S values
+REAL, DIMENSION(M) :: XNCCN ! fraction of the aerosols larger than XDCRIT (ie activable)
+REAL, DIMENSION(1) :: XT ! temperature
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. Select kappa value based on CTYPE_CCN
+! ---------------------------------
+!
+! Kappa values are from Petters and Kreidenweis (2007), table 1.
+!
+SELECT CASE (CTYPE_CCN)
+CASE('NH42SO4','C') ! Ammonium sulfate
+ XKAPPA = 0.61
+CASE('NH4NO3') ! Ammonium nitrate
+ XKAPPA = 0.67
+CASE('NaCl','M') ! Sea Salt
+ XKAPPA = 1.28
+CASE('H2SO4') ! Sulfuric acid
+ XKAPPA = 0.90
+CASE('NaNO3') ! Sodium nitrate
+ XKAPPA = 0.88
+CASE('NaHSO4') ! Sodium bisulfate
+ XKAPPA = 0.91
+CASE('Na2SO4') ! Sodium sulfate
+ XKAPPA = 0.80
+CASE('NH43HSO42') ! Letovicite (rare ammonium sulfate mineral)
+ XKAPPA = 0.65
+CASE('SOA') ! Secondary organic aerosol (alpha-pinene, beta-pinene)
+ XKAPPA = 0.1
+CASE DEFAULT
+ XKAPPA = 1.
+END SELECT
+!
+!XT = (/ 270., 271., 272., 273., 274., 275., 276., 277., 278., 279., 280., 281., 282., 283., 284., 285., 286., 287., 288., 289. /)
+XT = (/ 280. /)
+
+!
+! Initialize supersaturation values (in %)
+!
+DO II=1, SIZE(XS)
+ XS(II)=EXP( LOG(10.**(-3.)) + REAL(II) / REAL(SIZE(XS)) * (LOG(10.**2.)-LOG(10.**(-3.))) )
+END DO
+
+DO IJ=1, SIZE(XT)
+!
+!* 2. Compute Nccn(s) for several supersaturation values
+! --------------------------------------------------
+!
+! Get the value of Scrit at Ddry=0.1 micron
+!
+ XDDRY = XD
+ XMIN = XD
+ XMAX = XD*10.
+ XPREC = XD/100.
+ XW = 4 * 0.072 * XMV / XAVOGADRO / XBOLTZ / XT(IJ) / XRHOLW
+ XSCRIT = ZRIDDR(XMIN,XMAX,XPREC,XDDRY,XKAPPA,XT(IJ)) ! wet diameter at Scrit
+ XSCRIT = (XSCRIT**3-XDDRY**3) * EXP(XW/XSCRIT) / (XSCRIT**3-(1-XKAPPA)*XDDRY**3) ! Saturation ratio at Scrit
+ XSCRIT = (XSCRIT - 1.) * 100. ! Scrit (in %)
+!
+! Get the XDCRIT values for XS using the approx.
+! ln(100*(Sw))~Dcrit^(-3/2) where Sw is in % (Sw=1 for a 1% supersaturation)
+!
+ XW = XDDRY * XSCRIT**0.66 ! "a" factor in Ddry_crit = a*S**-0.66
+ XDCRIT(:) = XW * XS(:)**(-0.66) ! Ddry_crit for each value of S
+!
+! Compute Nccn(S) as the incomplete integral of n(D) from 0 to Ddry_crit(S)
+!
+ DO II=1, SIZE(XS)
+ XNCCN(II) = 1- ( 0.5 + SIGN(0.5,XDCRIT(II)-XD) * GAMMA_INC(0.5,(LOG(XDCRIT(II)/XD)/SQRT(2.)/LOG(XSIGMA))**2) )
+ END DO
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. Compute C, k, mu, beta, using the Levenberg-Marquardt algorithm
+! ---------------------------------------------------------------
+!
+ PARAMS(1:3) = (/ 1., 1., 1000. /)
+ IFLAG = 1
+ call lmdif1 ( DISTANCE, M, N, PARAMS, FVEC, TOL, INFO )
+!
+ XLIMIT_FACTOR = gamma(PARAMS(2))*PARAMS(3)**(PARAMS(1)/2)/gamma(1+PARAMS(1)/2)/gamma(PARAMS(2)-PARAMS(1)/2)
+ XK = PARAMS(1)
+ XMU = PARAMS(2)
+ XBETA = PARAMS(3)
+!
+END DO ! loop on temperatures
+!
+!-------------------------------------------------------------------------------
+!
+!* 6. Functions used to compute Scrit at Ddry=0.1 micron
+! --------------------------------------------------
+!
+CONTAINS
+!
+!------------------------------------------------------------------------------
+!
+ FUNCTION ZRIDDR(PX1,PX2,PXACC,XDDRY,XKAPPA,XT) RESULT(PZRIDDR)
+!
+!
+!!**** *ZRIDDR* - iterative algorithm to find root of a function
+!!
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this function is to find the root of a given function
+!! the arguments are the brackets bounds (the interval where to find the root)
+!! the accuracy needed and the input parameters of the given function.
+!! Using Ridders' method, return the root of a function known to lie between
+!! PX1 and PX2. The root, returned as PZRIDDR, will be refined to an approximate
+!! accuracy PXACC.
+!!
+!!** METHOD
+!! ------
+!! Ridders' method
+!!
+!! EXTERNAL
+!! --------
+!! FUNCSMAX
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!! NUMERICAL RECIPES IN FORTRAN 77: THE ART OF SCIENTIFIC COMPUTING
+!! (ISBN 0-521-43064-X)
+!! Copyright (C) 1986-1992 by Cambridge University Press.
+!! Programs Copyright (C) 1986-1992 by Numerical Recipes Software.
+!!
+!! AUTHOR
+!! ------
+!! Frederick Chosson *CERFACS*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 12/07/07
+!! S.BERTHET 2008 vectorization
+!------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments and result
+!
+REAL, INTENT(INOUT) :: PX1, PX2, PXACC
+REAL, INTENT(IN) :: XDDRY, XKAPPA, XT
+REAL :: PZRIDDR
+!
+!* 0.2 declarations of local variables
+!
+!
+INTEGER, PARAMETER :: MAXIT=60
+REAL, PARAMETER :: UNUSED=0.0 !-1.11e30
+REAL :: fh,fl, fm,fnew
+REAL :: s,xh,xl,xm,xnew
+INTEGER :: j, JL
+!
+PZRIDDR= 999999.
+fl = DSDD(PX1,XDDRY,XKAPPA,XT)
+fh = DSDD(PX2,XDDRY,XKAPPA,XT)
+!
+100 if ((fl > 0.0 .and. fh < 0.0) .or. (fl < 0.0 .and. fh > 0.0)) then
+ xl = PX1
+ xh = PX2
+ do j=1,MAXIT
+ xm = 0.5*(xl+xh)
+ fm = DSDD(xm,XDDRY,XKAPPA,XT)
+ s = sqrt(fm**2-fl*fh)
+ if (s == 0.0) then
+ GO TO 101
+ endif
+ xnew = xm+(xm-xl)*(sign(1.0,fl-fh)*fm/s)
+ if (abs(xnew - PZRIDDR) <= PXACC) then
+ GO TO 101
+ endif
+ PZRIDDR = xnew
+ fnew = DSDD(PZRIDDR,XDDRY,XKAPPA,XT)
+ if (fnew == 0.0) then
+ GO TO 101
+ endif
+ if (sign(fm,fnew) /= fm) then
+ xl =xm
+ fl=fm
+ xh =PZRIDDR
+ fh=fnew
+ else if (sign(fl,fnew) /= fl) then
+ xh =PZRIDDR
+ fh=fnew
+ else if (sign(fh,fnew) /= fh) then
+ xl =PZRIDDR
+ fl=fnew
+ else if (PX2 .lt. 0.05) then
+ PX2 = PX2 + 1.0E-2
+ PRINT*, 'PX2 ALWAYS too small, we put a greater one : PX2 =',PX2
+ fh = DSDD(PX2,XDDRY,XKAPPA,XT)
+ go to 100
+ STOP
+ end if
+ if (abs(xh-xl) <= PXACC) then
+ GO TO 101
+ endif
+ end do
+ STOP
+ else if (fl == 0.0) then
+ PZRIDDR=PX1
+ else if (fh == 0.0) then
+ PZRIDDR=PX2
+ else if (PX2 .lt. 0.05) then
+ PX2 = PX2 + 1.0E-2
+ PRINT*, 'PX2 too small, we put a greater one : PX2 =',PX2
+ fh = DSDD(PX2,XDDRY,XKAPPA,XT)
+ go to 100
+ else
+ PZRIDDR=0.0
+ go to 101
+ end if
+!
+101 END FUNCTION ZRIDDR
+!
+!------------------------------------------------------------------------------
+!
+ FUNCTION DSDD(XD,XDDRY,XKAPPA, XT) RESULT(DS)
+!!
+!! PURPOSE
+!! -------
+!! Derivative of S(D) from Petters and Kreidenweis 2007 (eq. 6) to get Dcrit and Scrit
+!!
+!!** METHOD
+!! ------
+!! This function is called by zriddr
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!! Petters and Kreidenweis, 2007: "A single parameter representation of hygroscopic
+!! growth and cloud condensation nucleus activity",
+!! ACP, 7, 1961-1971
+!!
+!! AUTHOR
+!! ------
+!! Benoit Vie *CNRM*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 13/11/17
+!!
+!------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+ USE MODD_CST, ONLY : XMV, XAVOGADRO, XBOLTZ, XRHOLW
+!
+ IMPLICIT NONE
+!
+!* 0.1 declarations of arguments and result
+!
+ REAL, INTENT(IN) :: XD ! supersaturation is already in no units
+ REAL, INTENT(IN) :: XDDRY ! supersaturation is already in no units
+ REAL, INTENT(IN) :: XKAPPA ! supersaturation is already in no units
+ REAL, INTENT(IN) :: XT ! supersaturation is already in no units
+!
+ REAL :: DS ! result
+!
+!* 0.2 declarations of local variables
+!
+ REAL :: XA ! factor inside the exponential
+!
+ XA = 4 * 0.072 * XMV / XAVOGADRO / XBOLTZ / XT / XRHOLW
+ DS = (XD**3-XDDRY**3) * (XD**3-(1-XKAPPA)*XDDRY**3) * XA - 3. * XKAPPA * XD**4 * XDDRY**3
+ DS = DS * EXP(XA/XD) / (XD**3-(1-XKAPPA)*XDDRY**3)**2
+!
+END FUNCTION DSDD
+!
+!-------------------------------------------------------------------------------
+!
+!* 7. Functions used to fit the CCN activation spectra with C s**k F()
+! ----------------------------------------------------------------
+!
+ SUBROUTINE DISTANCE(M,N,X,FVEC,IFLAG)
+!!
+!! PURPOSE
+!! -------
+!! Derivative of S(D) from Petters and Kreidenweis 2007 (eq. 6) to get Dcrit and Scrit
+!!
+!!** METHOD
+!! ------
+!! This function is called by zriddr
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!! Petters and Kreidenweis, 2007: "A single parameter representation of hygroscopic
+!! growth and cloud condensation nucleus activity",
+!! ACP, 7, 1961-1971
+!!
+!! AUTHOR
+!! ------
+!! Benoit Vie *CNRM*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 13/11/17
+!!
+!------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+!* 0.1 declarations of arguments and result
+!
+ integer M
+ integer N
+ real X(N)
+ real FVEC(M)
+ integer IFLAG
+!
+!* 0.2 declarations of local variables
+!
+ integer I
+ real C
+ real ZW, ZW2
+!
+ ! print *, "X = ", X
+ IF ( ANY(X .LT.0.) .OR. X(1).gt.2*X(2)) THEN
+ FVEC(:) = 999999.
+ ELSE
+ C=gamma(X(2))*X(3)**(X(1)/2)/gamma(1+X(1)/2)/gamma(X(2)-X(1)/2)
+ DO I=1, M
+ ! XS in "no units", ie XS=0.01 for a 1% suersaturation
+ ! ZW= C * (XS(I)/100)**X(1) * HYPGEO(X(2),X(1)/2,X(1)/2+1,X(3),XS(I)/100)
+ ZW= C * (XS(I))**X(1) * HYPGEO(X(2),X(1)/2,X(1)/2+1,X(3),XS(I))
+!!$ IF (X(3)*(XS(I)/100)**2 .LT. 0.98) THEN
+!!$ CALL HYPSER(X(2),X(1)/2,X(1)/2+1,-X(3)*(XS(I)/100)**2,ZW2)
+!!$ print *, "args= ", X(2), X(1)/2, X(1)/2+1, -X(3)*(XS(I)/100)**2, " hypser = ", ZW2
+!!$ CALL HYPSER(27.288,0.82/2,0.82/2+1,-38726*(0.5/100)**2,ZW2)
+!!$ print *, "args= ", 27.288, 0.82/2, 0.82/2+1, -38726*(0.5/100)**2, " hypser = ", ZW2
+!!$ END IF
+ ! print *, I, XS(I), C, ZW, XNCCN(I)
+ IF ( ZW.GT.0. .AND. XNCCN(I).GT.0.) THEN
+ FVEC(I) = LOG(ZW) - LOG(XNCCN(I))
+ ELSE
+ FVEC(I) = 0.
+ END IF
+ !FVEC(I) = LOG(MAX(ZW,1.E-24)) - LOG(MAX(XNCCN(I),1.E-24))
+ !FVEC(I) = ZW - XNCCN(I)
+ END DO
+ END IF
+! print *, "distance : ", SUM(FVEC*FVEC)
+!
+ END SUBROUTINE DISTANCE
+!
+!------------------------------------------------------------------------------
+END SUBROUTINE LIMA_INIT_CCN_ACTIVATION_SPECTRUM
diff --git a/src/mesonh/micro/lima_inst_procs.f90 b/src/mesonh/micro/lima_inst_procs.f90
new file mode 100644
index 000000000..ce7a12781
--- /dev/null
+++ b/src/mesonh/micro/lima_inst_procs.f90
@@ -0,0 +1,197 @@
+!MNH_LIC Copyright 2018-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-------------------------------------------------------------------------------
+! ###############################
+ MODULE MODI_LIMA_INST_PROCS
+! ###############################
+!
+INTERFACE
+ SUBROUTINE LIMA_INST_PROCS (PTSTEP, LDCOMPUTE, &
+ PEXNREF, PPABST, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PCCT, PCRT, PCIT, &
+ PINT, &
+ P_CR_BRKU, & ! spontaneous break up of drops (BRKU) : Nr
+ P_TH_HONR, P_RR_HONR, P_CR_HONR, & ! rain drops homogeneous freezing (HONR) : rr, Nr, rg=-rr, th
+ P_TH_IMLT, P_RC_IMLT, P_CC_IMLT, & ! ice melting (IMLT) : rc, Nc, ri=-rc, Ni=-Nc, th, IFNF, IFNA
+ PB_TH, PB_RV, PB_RC, PB_RR, PB_RI, PB_RG, &
+ PB_CC, PB_CR, PB_CI, &
+ PB_IFNN, &
+ PCF1D, PIF1D, PPF1D )
+!
+REAL, INTENT(IN) :: PTSTEP ! Time step
+LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
+!
+REAL, DIMENSION(:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:), INTENT(IN) :: PPABST ! abs. pressure at time t
+!
+REAL, DIMENSION(:), INTENT(IN) :: PTHT ! Theta at t
+REAL, DIMENSION(:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRIT ! Rain water m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRST ! Rain water m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRGT ! Rain water m.r. at t
+!
+REAL, DIMENSION(:), INTENT(IN) :: PCCT ! Cloud water conc. at t
+REAL, DIMENSION(:), INTENT(IN) :: PCRT ! Rain water conc. at t
+REAL, DIMENSION(:), INTENT(IN) :: PCIT ! Prinstine ice conc. at t
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PINT ! IFN C. activated at t
+!
+REAL, DIMENSION(:) , INTENT(INOUT) :: P_CR_BRKU ! Concentration change (#/kg)
+REAL, DIMENSION(:) , INTENT(INOUT) :: P_TH_HONR !
+REAL, DIMENSION(:) , INTENT(INOUT) :: P_RR_HONR ! mr change (kg/kg)
+REAL, DIMENSION(:) , INTENT(INOUT) :: P_CR_HONR ! Concentration change (#/kg)
+REAL, DIMENSION(:) , INTENT(INOUT) :: P_TH_IMLT !
+REAL, DIMENSION(:) , INTENT(INOUT) :: P_RC_IMLT ! mr change (kg/kg)
+REAL, DIMENSION(:) , INTENT(INOUT) :: P_CC_IMLT ! Concentration change (#/kg)
+!
+REAL, DIMENSION(:) , INTENT(INOUT) :: PB_TH ! Cumulated theta change
+REAL, DIMENSION(:) , INTENT(INOUT) :: PB_RV ! Cumulated mr change (kg/kg)
+REAL, DIMENSION(:) , INTENT(INOUT) :: PB_RC ! Cumulated mr change (kg/kg)
+REAL, DIMENSION(:) , INTENT(INOUT) :: PB_RR ! Cumulated mr change (kg/kg)
+REAL, DIMENSION(:) , INTENT(INOUT) :: PB_RI ! Cumulated mr change (kg/kg)
+REAL, DIMENSION(:) , INTENT(INOUT) :: PB_RG ! Cumulated mr change (kg/kg)
+!
+REAL, DIMENSION(:) , INTENT(INOUT) :: PB_CC ! Cumulated concentration change (#/kg)
+REAL, DIMENSION(:) , INTENT(INOUT) :: PB_CR ! Cumulated concentration change (#/kg)
+REAL, DIMENSION(:) , INTENT(INOUT) :: PB_CI ! Cumulated concentration change (#/kg)
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PB_IFNN ! Cumulated concentration change (#/kg)
+!
+REAL, DIMENSION(:) , INTENT(INOUT) :: PCF1D ! Liquid cloud fraction
+REAL, DIMENSION(:) , INTENT(INOUT) :: PIF1D ! Ice cloud fraction
+REAL, DIMENSION(:) , INTENT(INOUT) :: PPF1D ! Precipitation fraction
+!
+ END SUBROUTINE LIMA_INST_PROCS
+END INTERFACE
+END MODULE MODI_LIMA_INST_PROCS
+!
+!
+! ###########################################################################
+SUBROUTINE LIMA_INST_PROCS (PTSTEP, LDCOMPUTE, &
+ PEXNREF, PPABST, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PCCT, PCRT, PCIT, &
+ PINT, &
+ P_CR_BRKU, & ! spontaneous break up of drops (BRKU) : Nr
+ P_TH_HONR, P_RR_HONR, P_CR_HONR, & ! rain drops homogeneous freezing (HONR) : rr, Nr, rg=-rr, th
+ P_TH_IMLT, P_RC_IMLT, P_CC_IMLT, & ! ice melting (IMLT) : rc, Nc, ri=-rc, Ni=-Nc, th, IFNF, IFNA
+ PB_TH, PB_RV, PB_RC, PB_RR, PB_RI, PB_RG, &
+ PB_CC, PB_CR, PB_CI, &
+ PB_IFNN, &
+ PCF1D, PIF1D, PPF1D )
+! ###########################################################################
+!
+!! PURPOSE
+!! -------
+!! Compute sources of instantaneous microphysical processes for the
+!! time-split version of LIMA
+!!
+!! AUTHOR
+!! ------
+!! B. Vié * CNRM *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 15/03/2018
+!!
+!-------------------------------------------------------------------------------
+!
+!
+USE MODD_PARAM_LIMA, ONLY : LCOLD, LWARM, LRAIN
+!
+USE MODI_LIMA_DROPS_BREAK_UP
+USE MODI_LIMA_DROPS_HOM_FREEZING
+USE MODI_LIMA_ICE_MELTING
+
+IMPLICIT NONE
+
+
+
+REAL, INTENT(IN) :: PTSTEP ! Time step
+LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
+!
+REAL, DIMENSION(:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:), INTENT(IN) :: PPABST ! abs. pressure at time t
+!
+REAL, DIMENSION(:), INTENT(IN) :: PTHT ! Theta at t
+REAL, DIMENSION(:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRIT ! Rain water m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRST ! Rain water m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRGT ! Rain water m.r. at t
+!
+REAL, DIMENSION(:), INTENT(IN) :: PCCT ! Cloud water conc. at t
+REAL, DIMENSION(:), INTENT(IN) :: PCRT ! Rain water conc. at t
+REAL, DIMENSION(:), INTENT(IN) :: PCIT ! Prinstine ice conc. at t
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PINT ! IFN C. activated at t
+!
+REAL, DIMENSION(:) , INTENT(INOUT) :: P_CR_BRKU ! Concentration change (#/kg)
+REAL, DIMENSION(:) , INTENT(INOUT) :: P_TH_HONR !
+REAL, DIMENSION(:) , INTENT(INOUT) :: P_RR_HONR ! mr change (kg/kg)
+REAL, DIMENSION(:) , INTENT(INOUT) :: P_CR_HONR ! Concentration change (#/kg)
+REAL, DIMENSION(:) , INTENT(INOUT) :: P_TH_IMLT !
+REAL, DIMENSION(:) , INTENT(INOUT) :: P_RC_IMLT ! mr change (kg/kg)
+REAL, DIMENSION(:) , INTENT(INOUT) :: P_CC_IMLT ! Concentration change (#/kg)
+!
+REAL, DIMENSION(:) , INTENT(INOUT) :: PB_TH ! Cumulated theta change
+REAL, DIMENSION(:) , INTENT(INOUT) :: PB_RV ! Cumulated mr change (kg/kg)
+REAL, DIMENSION(:) , INTENT(INOUT) :: PB_RC ! Cumulated mr change (kg/kg)
+REAL, DIMENSION(:) , INTENT(INOUT) :: PB_RR ! Cumulated mr change (kg/kg)
+REAL, DIMENSION(:) , INTENT(INOUT) :: PB_RI ! Cumulated mr change (kg/kg)
+REAL, DIMENSION(:) , INTENT(INOUT) :: PB_RG ! Cumulated mr change (kg/kg)
+!
+REAL, DIMENSION(:) , INTENT(INOUT) :: PB_CC ! Cumulated concentration change (#/kg)
+REAL, DIMENSION(:) , INTENT(INOUT) :: PB_CR ! Cumulated concentration change (#/kg)
+REAL, DIMENSION(:) , INTENT(INOUT) :: PB_CI ! Cumulated concentration change (#/kg)
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PB_IFNN ! Cumulated concentration change (#/kg)
+!
+REAL, DIMENSION(:) , INTENT(INOUT) :: PCF1D ! Liquid cloud fraction
+REAL, DIMENSION(:) , INTENT(INOUT) :: PIF1D ! Ice cloud fraction
+REAL, DIMENSION(:) , INTENT(INOUT) :: PPF1D ! Precipitation fraction
+!
+!-------------------------------------------------------------------------------
+!
+IF (LWARM .AND. LRAIN) THEN
+ CALL LIMA_DROPS_BREAK_UP (LDCOMPUTE, & ! no dependance on CF, IF or PF
+ PCRT, PRRT, &
+ P_CR_BRKU, &
+ PB_CR )
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+IF (LCOLD .AND. LWARM .AND. LRAIN) THEN
+ CALL LIMA_DROPS_HOM_FREEZING (PTSTEP, LDCOMPUTE, & ! no dependance on CF, IF or PF
+ PEXNREF, PPABST, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PCRT, &
+ P_TH_HONR, P_RR_HONR, P_CR_HONR, &
+ PB_TH, PB_RR, PB_CR, PB_RG )
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+IF (LCOLD .AND. LWARM) THEN
+ CALL LIMA_ICE_MELTING (PTSTEP, LDCOMPUTE, & ! no dependance on CF, IF or PF
+ PEXNREF, PPABST, & ! but ice fraction becomes cloud fraction
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, & ! -> where ?
+ PCIT, PINT, &
+ P_TH_IMLT, P_RC_IMLT, P_CC_IMLT, &
+ PB_TH, PB_RC, PB_CC, PB_RI, PB_CI, PB_IFNN)
+ !
+ !PCF1D(:)=MAX(PCF1D(:),PIF1D(:))
+ !PIF1D(:)=0.
+ !
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_INST_PROCS
diff --git a/src/mesonh/micro/lima_meyers.f90 b/src/mesonh/micro/lima_meyers.f90
new file mode 100644
index 000000000..7e55e1ab7
--- /dev/null
+++ b/src/mesonh/micro/lima_meyers.f90
@@ -0,0 +1,466 @@
+!MNH_LIC Copyright 2013-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! #######################
+ MODULE MODI_LIMA_MEYERS
+! #######################
+!
+INTERFACE
+ SUBROUTINE LIMA_MEYERS (OHHONI, PTSTEP, KMI, &
+ PZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PCCT, &
+ PTHS, PRVS, PRCS, PRIS, &
+ PCCS, PCIS, PINS )
+!
+LOGICAL, INTENT(IN) :: OHHONI ! enable haze freezing
+REAL, INTENT(IN) :: PTSTEP ! Time step
+INTEGER, INTENT(IN) :: KMI ! Model index
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCT ! Cloud water C. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCS ! Cloud water C. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIS ! Ice crystal C. source
+!
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PINS ! Activated ice nuclei C. source
+ !for DEPOSITION and CONTACT
+ !for IMMERSION
+!
+END SUBROUTINE LIMA_MEYERS
+END INTERFACE
+END MODULE MODI_LIMA_MEYERS
+!
+! ###########################################################################
+ SUBROUTINE LIMA_MEYERS (OHHONI, PTSTEP, KMI, &
+ PZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PCCT, &
+ PTHS, PRVS, PRCS, PRIS, &
+ PCCS, PCIS, PINS )
+! ###########################################################################
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the heterogeneous nucleation
+!! following Phillips (2008).
+!!
+!!
+!!** METHOD
+!! ------
+!! The parameterization of Phillips (2008) is based on observed nucleation
+!! in the CFDC for a range of T and Si values. Phillips therefore defines a
+!! reference activity spectrum, that is, for given T and Si values, the
+!! reference concentration of primary ice crystals.
+!!
+!! The activation of IFN is closely related to their total surface. Thus,
+!! the activable fraction of each IFN specie is determined by an integration
+!! over the particle size distributions.
+!!
+!! Subroutine organisation :
+!!
+!! 1- Preliminary computations
+!! 2- Check where computations are necessary, and pack variables
+!! 3- Compute the saturation over water and ice
+!! 4- Compute the reference activity spectrum
+!! -> CALL LIMA_PHILLIPS_REF_SPECTRUM
+!! Integrate over the size distributions to compute the IFN activable fraction
+!! -> CALL LIMA_PHILLIPS_INTEG
+!! 5- Heterogeneous nucleation of insoluble IFN
+!! 6- Heterogeneous nucleation of coated IFN
+!! 7- Unpack variables & deallocations
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Phillips et al., 2008: An empirical parameterization of heterogeneous
+!! ice nucleation for multiple chemical species of aerosols, J. Atmos. Sci.
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!! C. Barthe * LACy * jan. 2014 add budgets
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
+! P. Wautelet 02/02/2021: budgets: add missing source terms for SV budgets in LIMA
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+use modd_budget, only: lbu_enable, nbumod, &
+ lbudget_th, lbudget_rv, lbudget_rc, lbudget_ri, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RI, NBUDGET_SV1, &
+ tbudgets
+USE MODD_CST
+USE MODD_NSV, ONLY: NSV_LIMA_NC, NSV_LIMA_NI, NSV_LIMA_IFN_NUCL
+USE MODD_PARAMETERS
+USE MODD_PARAM_LIMA
+USE MODD_PARAM_LIMA_COLD
+
+use mode_budget, only: Budget_store_init, Budget_store_end
+use mode_tools, only: Countjv
+
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+LOGICAL, INTENT(IN) :: OHHONI ! enable haze freezing
+REAL, INTENT(IN) :: PTSTEP ! Time step
+INTEGER, INTENT(IN) :: KMI ! Model index
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCT ! Cloud water C. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCS ! Cloud water C. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIS ! Ice crystal C. source
+!
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PINS ! Activated ice nuclei C. source
+ !for DEPOSITION and CONTACT
+!
+!
+!* 0.2 Declarations of local variables :
+!
+!
+INTEGER :: IIB, IIE, IJB, IJE, IKB, IKE ! Physical domain
+INTEGER :: JL ! Loop index
+INTEGER :: INEGT ! Case number of nucleation
+!
+LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: GNEGT ! Test where to compute the nucleation
+!
+INTEGER, DIMENSION(SIZE(PRHODREF)) :: I1,I2,I3 ! Indexes for PACK replacement
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRRT ! Rain water m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRGT ! Graupel/hail m.r. at t
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZCCT ! Cloud water conc. at t
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZRVS ! Water vapor m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRCS ! Cloud water m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRIS ! Pristine ice m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZCCS ! Cloud water conc. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZCIS ! Pristine ice conc. source
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZTHS ! Theta source
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZINS ! Nucleated Ice nuclei conc. source
+ ! by Deposition/Contact
+!
+REAL, DIMENSION(:), ALLOCATABLE &
+ :: ZRHODREF, & ! RHO Dry REFerence
+ ZRHODJ, & ! RHO times Jacobian
+ ZZT, & ! Temperature
+ ZPRES, & ! Pressure
+ ZEXNREF, & ! EXNer Pressure REFerence
+ ZZW, & ! Work array
+ ZZX, & ! Work array
+ ZZY, & ! Work array
+ ZLSFACT, & ! L_s/(Pi_ref*C_ph)
+ ZLVFACT, & ! L_v/(Pi_ref*C_ph)
+ ZSSI
+!
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: ZW, ZT ! work arrays
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZTCELSIUS
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 1. PRELIMINARY COMPUTATIONS
+! ------------------------
+!
+!
+! Physical domain
+!
+IIB=1+JPHEXT
+IIE=SIZE(PZZ,1) - JPHEXT
+IJB=1+JPHEXT
+IJE=SIZE(PZZ,2) - JPHEXT
+IKB=1+JPVEXT
+IKE=SIZE(PZZ,3) - JPVEXT
+!
+! Temperature
+!
+ZT(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:)/XP00 ) ** (XRD/XCPD)
+!
+! Saturation over ice
+!
+ZW(:,:,:) = EXP( XALPI - XBETAI/ZT(:,:,:) - XGAMI*ALOG(ZT(:,:,:) ) )
+ZW(:,:,:) = PRVT(:,:,:)*( PPABST(:,:,:)-ZW(:,:,:) ) / ( (XMV/XMD) * ZW(:,:,:) )
+!
+!
+!-------------------------------------------------------------------------------
+!
+! optimization by looking for locations where
+! the temperature is negative only !!!
+!
+GNEGT(:,:,:) = .FALSE.
+GNEGT(IIB:IIE,IJB:IJE,IKB:IKE) = ZT(IIB:IIE,IJB:IJE,IKB:IKE)<XTT .AND. &
+ ZW(IIB:IIE,IJB:IJE,IKB:IKE)>0.8
+INEGT = COUNTJV( GNEGT(:,:,:),I1(:),I2(:),I3(:))
+IF( INEGT >= 1 ) THEN
+ ALLOCATE(ZRVT(INEGT))
+ ALLOCATE(ZRCT(INEGT))
+ ALLOCATE(ZRRT(INEGT))
+ ALLOCATE(ZRIT(INEGT))
+ ALLOCATE(ZRST(INEGT))
+ ALLOCATE(ZRGT(INEGT))
+!
+ ALLOCATE(ZCCT(INEGT))
+!
+ ALLOCATE(ZRVS(INEGT))
+ ALLOCATE(ZRCS(INEGT))
+ ALLOCATE(ZRIS(INEGT))
+!
+ ALLOCATE(ZTHS(INEGT))
+!
+ ALLOCATE(ZCCS(INEGT))
+ ALLOCATE(ZINS(INEGT,1))
+ ALLOCATE(ZCIS(INEGT))
+!
+ ALLOCATE(ZRHODREF(INEGT))
+ ALLOCATE(ZZT(INEGT))
+ ALLOCATE(ZPRES(INEGT))
+ ALLOCATE(ZEXNREF(INEGT))
+ DO JL=1,INEGT
+ ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL))
+ ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
+ ZRRT(JL) = PRRT(I1(JL),I2(JL),I3(JL))
+ ZRIT(JL) = PRIT(I1(JL),I2(JL),I3(JL))
+ ZRST(JL) = PRST(I1(JL),I2(JL),I3(JL))
+ ZRGT(JL) = PRGT(I1(JL),I2(JL),I3(JL))
+!
+ ZCCT(JL) = PCCT(I1(JL),I2(JL),I3(JL))
+!
+ ZRVS(JL) = PRVS(I1(JL),I2(JL),I3(JL))
+ ZRCS(JL) = PRCS(I1(JL),I2(JL),I3(JL))
+ ZRIS(JL) = PRIS(I1(JL),I2(JL),I3(JL))
+!
+ ZTHS(JL) = PTHS(I1(JL),I2(JL),I3(JL))
+!
+ ZCCS(JL) = PCCS(I1(JL),I2(JL),I3(JL))
+ ZCIS(JL) = PCIS(I1(JL),I2(JL),I3(JL))
+!
+ ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
+ ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
+ ZPRES(JL) = PPABST(I1(JL),I2(JL),I3(JL))
+ ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL))
+ ENDDO
+ ALLOCATE(ZZW(INEGT))
+ ALLOCATE(ZZX(INEGT))
+ ALLOCATE(ZZY(INEGT))
+ ALLOCATE(ZLSFACT(INEGT))
+ ALLOCATE(ZLVFACT(INEGT))
+ ALLOCATE(ZSSI(INEGT))
+ ALLOCATE(ZTCELSIUS(INEGT))
+!
+ ZZW(:) = ZEXNREF(:)*( XCPD+XCPV*ZRVT(:)+XCL*(ZRCT(:)+ZRRT(:)) &
+ +XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)) )
+ ZTCELSIUS(:) = MAX( ZZT(:)-XTT,-50.0 )
+ ZLSFACT(:) = (XLSTT+(XCPV-XCI)*ZTCELSIUS(:))/ZZW(:) ! L_s/(Pi_ref*C_ph)
+ ZLVFACT(:) = (XLVTT+(XCPV-XCL)*ZTCELSIUS(:))/ZZW(:) ! L_v/(Pi_ref*C_ph)
+!
+ ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:)) ) ! es_i
+ ZSSI(:) = ZRVT(:)*(ZPRES(:)-ZZW(:))/((XMV/XMD)*ZZW(:)) - 1.0
+ ! Supersaturation over ice
+!
+!* compute the heterogeneous nucleation by deposition: RVHNDI
+!
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HIND', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'HIND', prvs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'HIND', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HIND', pcis(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv .and. nmod_ifn > 0) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl), 'HIND', pins(:, :, :, 1) * prhodj(:, :, :) )
+ end if
+
+ DO JL=1,INEGT
+ ZINS(JL,1) = PINS(I1(JL),I2(JL),I3(JL),1)
+ END DO
+ ZZW(:) = 0.0
+ ZZX(:) = 0.0
+ ZZY(:) = 0.0
+!
+ WHERE( ZZT(:)<XTT-5.0 .AND. ZSSI(:)>0.0 )
+ ZZY(:) = XNUC_DEP*EXP( XEXSI_DEP*100.*MIN(1.,ZSSI(:))+XEX_DEP)/(PTSTEP*ZRHODREF(:))
+ ZZX(:) = MAX( ZZY(:)-ZINS(:,1) , 0.0 )
+ ZZW(:) = MIN( XMNU0*ZZX(:) , ZRVS(:) )
+ END WHERE
+!
+ ZINS(:,1) = ZINS(:,1) + ZZX(:)
+!
+ ZRVS(:) = ZRVS(:) - ZZW(:)
+ ZRIS(:) = ZRIS(:) + ZZW(:)
+ ZTHS(:) = ZTHS(:) + ZZW(:) * (ZLSFACT(:)-ZLVFACT(:)) ! f(L_s*(RVHNDI))
+ ZCIS(:) = ZCIS(:) + ZZX(:)
+!
+!
+! Budget storage
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HIND', &
+ Unpack ( zths(:), mask = gnegt(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'HIND', &
+ Unpack ( zrvs(:), mask = gnegt(:, :, :), field = prvs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'HIND', &
+ Unpack ( zris(:), mask = gnegt(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HIND', &
+ Unpack ( zcis(:), mask = gnegt(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv .and. nmod_ifn > 0 ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl), 'HIND', &
+ Unpack ( zins(:, 1), mask = gnegt(:, :, :), field = pins(:, :, :, 1) ) * prhodj(:, :, :) )
+ end if
+!
+!* compute the heterogeneous nucleation by contact: RVHNCI
+!
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HINC', &
+ Unpack ( zths(:), mask = gnegt(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'HINC', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'HINC', &
+ Unpack ( zris(:), mask = gnegt(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HINC', pccs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HINC', &
+ Unpack ( zcis(:), mask = gnegt(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ if ( nmod_ifn > 0 ) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl), 'HINC', &
+ Unpack ( zins(:, 1), mask = gnegt(:, :, :), field = pins(:, :, :, 1) ) * prhodj(:, :, :) )
+ end if
+ end if
+
+ ZZW(:) = 0.0
+ ZZX(:) = 0.0
+ ZZY(:) = 0.0
+!
+ WHERE( ZZT(:)<XTT-2.0 .AND. ZCCT(:)>XCTMIN(2) .AND. ZRCT(:)>XRTMIN(2) )
+ ZZY(:) = MIN( XNUC_CON * EXP( XEXTT_CON*ZTCELSIUS(:)+XEX_CON ) &
+ /(PTSTEP*ZRHODREF(:)) , ZCCS(:) )
+ ZZX(:) = MAX( ZZY(:)-ZINS(:,1),0.0 )
+ ZZW(:) = MIN( (ZRCT(:)/ZCCT(:))*ZZX(:),ZRCS(:) )
+ END WHERE
+!
+ ZINS(:,1) = ZINS(:,1) + ZZX(:)
+ ZW(:,:,:) = PINS(:,:,:,1)
+ PINS(:,:,:,1) = UNPACK( ZINS(:,1), MASK=GNEGT(:,:,:), FIELD=ZW(:,:,:) )
+!
+ ZRCS(:) = ZRCS(:) - ZZW(:)
+ ZRIS(:) = ZRIS(:) + ZZW(:)
+ ZTHS(:) = ZTHS(:) + ZZW(:)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_s*(RVHNCI))
+ ZCCS(:) = ZCCS(:) - ZZX(:)
+ ZCIS(:) = ZCIS(:) + ZZX(:)
+!
+!* unpack variables
+!
+ ZW(:,:,:) = PRVS(:,:,:)
+ PRVS(:,:,:) = UNPACK( ZRVS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PRCS(:,:,:)
+ PRCS(:,:,:) = UNPACK( ZRCS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PRIS(:,:,:)
+ PRIS(:,:,:) = UNPACK( ZRIS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PTHS(:,:,:)
+ PTHS(:,:,:) = UNPACK( ZTHS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PCCS(:,:,:)
+ PCCS(:,:,:) = UNPACK( ZCCS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PCIS(:,:,:)
+ PCIS(:,:,:) = UNPACK( ZCIS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
+!
+! Budget storage
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HINC', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'HINC', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'HINC', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HINC', pccs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HINC', pcis(:, :, :) * prhodj(:, :, :) )
+ if ( nmod_ifn > 0 ) &
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl), 'HINC', pins(:, :, :, 1) * prhodj(:, :, :) )
+ end if
+ end if
+
+ DEALLOCATE(ZRVT)
+ DEALLOCATE(ZRCT)
+ DEALLOCATE(ZRRT)
+ DEALLOCATE(ZRIT)
+ DEALLOCATE(ZRST)
+ DEALLOCATE(ZRGT)
+!
+ DEALLOCATE(ZCCT)
+!
+ DEALLOCATE(ZRVS)
+ DEALLOCATE(ZRCS)
+ DEALLOCATE(ZRIS)
+!
+ DEALLOCATE(ZTHS)
+!
+ DEALLOCATE(ZCCS)
+ DEALLOCATE(ZINS)
+ DEALLOCATE(ZCIS)
+!
+ DEALLOCATE(ZRHODREF)
+ DEALLOCATE(ZZT)
+ DEALLOCATE(ZTCELSIUS)
+ DEALLOCATE(ZPRES)
+ DEALLOCATE(ZEXNREF)
+ DEALLOCATE(ZSSI)
+ DEALLOCATE(ZZW)
+ DEALLOCATE(ZZX)
+ DEALLOCATE(ZZY)
+ DEALLOCATE(ZLSFACT)
+ DEALLOCATE(ZLVFACT)
+!
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_MEYERS
diff --git a/src/mesonh/micro/lima_meyers_nucleation.f90 b/src/mesonh/micro/lima_meyers_nucleation.f90
new file mode 100644
index 000000000..f0c38fd6a
--- /dev/null
+++ b/src/mesonh/micro/lima_meyers_nucleation.f90
@@ -0,0 +1,348 @@
+!MNH_LIC Copyright 2018-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ##################################
+ MODULE MODI_LIMA_MEYERS_NUCLEATION
+! ##################################
+!
+INTERFACE
+ SUBROUTINE LIMA_MEYERS_NUCLEATION (PTSTEP, &
+ PRHODREF, PEXNREF, PPABST, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PCCT, PCIT, PINT, &
+ P_TH_HIND, P_RI_HIND, P_CI_HIND, &
+ P_TH_HINC, P_RC_HINC, P_CC_HINC, &
+ PICEFR )
+!
+REAL, INTENT(IN) :: PTSTEP
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIT ! Cloud ice m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCT ! Cloud water C. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Ice crystal C. source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PINT ! Activated ice nuclei C.
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_TH_HIND
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_RI_HIND
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_CI_HIND
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_TH_HINC
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_RC_HINC
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_CC_HINC
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR
+!
+END SUBROUTINE LIMA_MEYERS_NUCLEATION
+END INTERFACE
+END MODULE MODI_LIMA_MEYERS_NUCLEATION
+!
+! #############################################################################
+ SUBROUTINE LIMA_MEYERS_NUCLEATION (PTSTEP, &
+ PRHODREF, PEXNREF, PPABST, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PCCT, PCIT, PINT, &
+ P_TH_HIND, P_RI_HIND, P_CI_HIND, &
+ P_TH_HINC, P_RC_HINC, P_CC_HINC, &
+ PICEFR )
+! #############################################################################
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the heterogeneous nucleation
+!! following Meyers (1992).
+!!
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * CNRM *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 15/03/2018
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+! P. Wautelet 27/02/2020: add P_TH_HINC dummy argument + change intent of *_HIND and *_HINC dummy arguments (INOUT->OUT)
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_NSV, ONLY: NSV_LIMA_NC, NSV_LIMA_NI
+USE MODD_PARAMETERS
+USE MODD_PARAM_LIMA
+USE MODD_PARAM_LIMA_COLD
+
+use mode_tools, only: Countjv
+
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, INTENT(IN) :: PTSTEP
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIT ! Cloud ice m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCT ! Cloud water C. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Ice crystal C. source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PINT ! Activated ice nuclei C.
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_TH_HIND
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_RI_HIND
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_CI_HIND
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_TH_HINC
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_RC_HINC
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_CC_HINC
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR
+!
+!
+!* 0.2 Declarations of local variables :
+!
+!
+INTEGER :: IIB, IIE, IJB, IJE, IKB, IKE ! Physical domain
+INTEGER :: JL ! Loop index
+INTEGER :: INEGT ! Case number of nucleation
+!
+LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: GNEGT ! Test where to compute the nucleation
+!
+INTEGER, DIMENSION(SIZE(PRHODREF)) :: I1,I2,I3 ! Indexes for PACK replacement
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRRT ! Rain water m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRGT ! Graupel/hail m.r. at t
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZCCT ! Cloud water conc. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZCIT ! Pristine ice conc. source
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZTHT ! Theta source
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZINT ! Nucleated Ice nuclei conc. source
+ ! by Deposition/Contact
+!
+REAL, DIMENSION(:), ALLOCATABLE &
+ :: ZRHODREF, & ! RHO Dry REFerence
+ ZZT, & ! Temperature
+ ZPRES, & ! Pressure
+ ZEXNREF, & ! EXNer Pressure REFerence
+ ZZW, & ! Work array
+ ZZX, & ! Work array
+ ZZY, & ! Work array
+ ZLSFACT, & ! L_s/(Pi_ref*C_ph)
+ ZLVFACT, & ! L_v/(Pi_ref*C_ph)
+ ZSSI
+!
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: ZW, ZT ! work arrays
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZTCELSIUS
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 1. PRELIMINARY COMPUTATIONS
+! ------------------------
+!
+P_TH_HIND(:,:,:) = 0.
+P_RI_HIND(:,:,:) = 0.
+P_CI_HIND(:,:,:) = 0.
+P_TH_HINC(:,:,:) = 0.
+P_RC_HINC(:,:,:) = 0.
+P_CC_HINC(:,:,:) = 0.
+!
+! Physical domain
+!
+IIB=1+JPHEXT
+IIE=SIZE(PTHT,1) - JPHEXT
+IJB=1+JPHEXT
+IJE=SIZE(PTHT,2) - JPHEXT
+IKB=1+JPVEXT
+IKE=SIZE(PTHT,3) - JPVEXT
+!
+! Temperature
+!
+ZT(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:)/XP00 ) ** (XRD/XCPD)
+!
+! Saturation over ice
+!
+ZW(:,:,:) = EXP( XALPI - XBETAI/ZT(:,:,:) - XGAMI*ALOG(ZT(:,:,:) ) )
+ZW(:,:,:) = PRVT(:,:,:)*( PPABST(:,:,:)-ZW(:,:,:) ) / ( (XMV/XMD) * ZW(:,:,:) )
+!
+!
+!-------------------------------------------------------------------------------
+!
+! optimization by looking for locations where
+! the temperature is negative only !!!
+!
+GNEGT(:,:,:) = .FALSE.
+GNEGT(IIB:IIE,IJB:IJE,IKB:IKE) = ZT(IIB:IIE,IJB:IJE,IKB:IKE)<XTT .AND. &
+ ZW(IIB:IIE,IJB:IJE,IKB:IKE)>0.8
+INEGT = COUNTJV( GNEGT(:,:,:),I1(:),I2(:),I3(:))
+IF( INEGT >= 1 ) THEN
+ ALLOCATE(ZRVT(INEGT))
+ ALLOCATE(ZRCT(INEGT))
+ ALLOCATE(ZRRT(INEGT))
+ ALLOCATE(ZRIT(INEGT))
+ ALLOCATE(ZRST(INEGT))
+ ALLOCATE(ZRGT(INEGT))
+!
+ ALLOCATE(ZTHT(INEGT))
+!
+ ALLOCATE(ZCCT(INEGT))
+ ALLOCATE(ZINT(INEGT,1))
+ ALLOCATE(ZCIT(INEGT))
+!
+ ALLOCATE(ZRHODREF(INEGT))
+ ALLOCATE(ZZT(INEGT))
+ ALLOCATE(ZPRES(INEGT))
+ ALLOCATE(ZEXNREF(INEGT))
+ DO JL=1,INEGT
+ ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL))
+ ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
+ ZRRT(JL) = PRRT(I1(JL),I2(JL),I3(JL))
+ ZRIT(JL) = PRIT(I1(JL),I2(JL),I3(JL))
+ ZRST(JL) = PRST(I1(JL),I2(JL),I3(JL))
+ ZRGT(JL) = PRGT(I1(JL),I2(JL),I3(JL))
+!
+ ZCCT(JL) = PCCT(I1(JL),I2(JL),I3(JL))
+!
+ ZTHT(JL) = PTHT(I1(JL),I2(JL),I3(JL))
+!
+ ZCCT(JL) = PCCT(I1(JL),I2(JL),I3(JL))
+ ZCIT(JL) = PCIT(I1(JL),I2(JL),I3(JL))
+!
+ ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
+ ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
+ ZPRES(JL) = PPABST(I1(JL),I2(JL),I3(JL))
+ ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL))
+ ENDDO
+ ALLOCATE(ZZW(INEGT))
+ ALLOCATE(ZZX(INEGT))
+ ALLOCATE(ZZY(INEGT))
+ ALLOCATE(ZLSFACT(INEGT))
+ ALLOCATE(ZLVFACT(INEGT))
+ ALLOCATE(ZSSI(INEGT))
+ ALLOCATE(ZTCELSIUS(INEGT))
+!
+ ZZW(:) = ZEXNREF(:)*( XCPD+XCPV*ZRVT(:)+XCL*(ZRCT(:)+ZRRT(:)) &
+ +XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)) )
+ ZTCELSIUS(:) = MAX( ZZT(:)-XTT,-50.0 )
+ ZLSFACT(:) = (XLSTT+(XCPV-XCI)*ZTCELSIUS(:))/ZZW(:) ! L_s/(Pi_ref*C_ph)
+ ZLVFACT(:) = (XLVTT+(XCPV-XCL)*ZTCELSIUS(:))/ZZW(:) ! L_v/(Pi_ref*C_ph)
+!
+ ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:)) ) ! es_i
+ ZSSI(:) = ZRVT(:)*(ZPRES(:)-ZZW(:))/((XMV/XMD)*ZZW(:)) - 1.0
+ ! Supersaturation over ice
+!
+!---------------------------------------------------------------------------
+!
+!* compute the heterogeneous nucleation by deposition: RVHNDI
+!
+ DO JL=1,INEGT
+ ZINT(JL,1) = PINT(I1(JL),I2(JL),I3(JL),1)
+ END DO
+ ZZW(:) = 0.0
+ ZZX(:) = 0.0
+ ZZY(:) = 0.0
+!
+ WHERE( ZZT(:)<XTT-5.0 .AND. ZSSI(:)>0.0 )
+ ZZY(:) = XNUC_DEP*EXP( XEXSI_DEP*100.*MIN(1.,ZSSI(:))+XEX_DEP)/ZRHODREF(:)
+ ZZX(:) = MAX( ZZY(:)-ZINT(:,1) , 0.0 ) ! number of ice crystals formed at this time step #/kg
+ ZZW(:) = MIN( XMNU0*ZZX(:) , ZRVT(:) ) ! mass of ice formed at this time step (kg/kg)
+ END WHERE
+ !
+ P_CI_HIND(:,:,:) = UNPACK( ZZX(:), MASK=GNEGT(:,:,:), FIELD=0. )
+ P_RI_HIND(:,:,:) = UNPACK( ZZW(:), MASK=GNEGT(:,:,:), FIELD=0. )
+ P_TH_HIND(:,:,:) = UNPACK( ZZW(:)*(ZLSFACT(:)-ZLVFACT(:)), MASK=GNEGT(:,:,:), FIELD=0. )
+ PTHT(:,:,:) = PTHT(:,:,:) + P_TH_HIND(:,:,:)
+ PRVT(:,:,:) = PRVT(:,:,:) - P_RI_HIND(:,:,:)
+ PRIT(:,:,:) = PRIT(:,:,:) + P_RI_HIND(:,:,:)
+ PCIT(:,:,:) = PCIT(:,:,:) + P_CI_HIND(:,:,:)
+ PINT(:,:,:,1) = PINT(:,:,:,1) + P_CI_HIND(:,:,:)
+!
+!---------------------------------------------------------------------------
+!
+!* compute the heterogeneous nucleation by contact: RVHNCI
+!
+!
+ DO JL=1,INEGT
+ ZINT(JL,1) = PINT(I1(JL),I2(JL),I3(JL),1)
+ END DO
+ ZZW(:) = 0.0
+ ZZX(:) = 0.0
+ ZZY(:) = 0.0
+!
+ WHERE( ZZT(:)<XTT-2.0 .AND. ZCCT(:)>XCTMIN(2) .AND. ZRCT(:)>XRTMIN(2) )
+ ZZY(:) = MIN( XNUC_CON * EXP( XEXTT_CON*ZTCELSIUS(:)+XEX_CON ) &
+ /ZRHODREF(:) , ZCCT(:) )
+ ZZX(:) = MAX( ZZY(:)-ZINT(:,1),0.0 )
+ ZZW(:) = MIN( (ZRCT(:)/ZCCT(:))*ZZX(:),ZRCT(:) )
+ END WHERE
+!
+ P_RC_HINC(:,:,:) = - UNPACK( ZZW(:), MASK=GNEGT(:,:,:), FIELD=0. )
+ P_CC_HINC(:,:,:) = - UNPACK( ZZX(:), MASK=GNEGT(:,:,:), FIELD=0. )
+ P_TH_HINC(:,:,:) = UNPACK( ZZW(:)*(ZLSFACT(:)-ZLVFACT(:)), MASK=GNEGT(:,:,:), FIELD=0. )
+ PTHT(:,:,:) = PTHT(:,:,:) + P_TH_HINC(:,:,:)
+ PRCT(:,:,:) = PRCT(:,:,:) + P_RC_HINC(:,:,:)
+ PRIT(:,:,:) = PRIT(:,:,:) - P_RC_HINC(:,:,:)
+ PCCT(:,:,:) = PCCT(:,:,:) + P_CC_HINC(:,:,:)
+ PCIT(:,:,:) = PCIT(:,:,:) - P_CC_HINC(:,:,:)
+ PINT(:,:,:,1) = PINT(:,:,:,1) - P_CC_HINC(:,:,:)
+!
+ DEALLOCATE(ZRVT)
+ DEALLOCATE(ZRCT)
+ DEALLOCATE(ZRRT)
+ DEALLOCATE(ZRIT)
+ DEALLOCATE(ZRST)
+ DEALLOCATE(ZRGT)
+!
+ DEALLOCATE(ZTHT)
+!
+ DEALLOCATE(ZCCT)
+ DEALLOCATE(ZINT)
+ DEALLOCATE(ZCIT)
+!
+ DEALLOCATE(ZRHODREF)
+ DEALLOCATE(ZZT)
+ DEALLOCATE(ZTCELSIUS)
+ DEALLOCATE(ZPRES)
+ DEALLOCATE(ZEXNREF)
+ DEALLOCATE(ZSSI)
+ DEALLOCATE(ZZW)
+ DEALLOCATE(ZZX)
+ DEALLOCATE(ZZY)
+ DEALLOCATE(ZLSFACT)
+ DEALLOCATE(ZLVFACT)
+!
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_MEYERS_NUCLEATION
diff --git a/src/mesonh/micro/lima_mixed.f90 b/src/mesonh/micro/lima_mixed.f90
new file mode 100644
index 000000000..49024b7b5
--- /dev/null
+++ b/src/mesonh/micro/lima_mixed.f90
@@ -0,0 +1,643 @@
+!MNH_LIC Copyright 2013-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ######################
+ MODULE MODI_LIMA_MIXED
+! ######################
+!
+INTERFACE
+ SUBROUTINE LIMA_MIXED (OSEDI, OHHONI, KSPLITG, PTSTEP, KMI, &
+ KRR, PZZ, PRHODJ, &
+ PRHODREF, PEXNREF, PPABST, PW_NU, &
+ PTHM, PPABSM, &
+ PTHT, PRT, PSVT, &
+ PTHS, PRS, PSVS)
+!
+USE MODD_NSV, only: NSV_LIMA_BEG
+!
+LOGICAL, INTENT(IN) :: OSEDI ! switch to activate the
+ ! cloud ice sedimentation
+LOGICAL, INTENT(IN) :: OHHONI ! enable haze freezing
+INTEGER, INTENT(IN) :: KSPLITG ! Number of small time step
+ ! integration for ice sedimendation
+REAL, INTENT(IN) :: PTSTEP ! Time step
+INTEGER, INTENT(IN) :: KMI ! Model index
+!
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
+ ! the nucleation param.
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at time t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! abs. pressure at time t-dt
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! m.r. at t
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(IN) :: PSVT ! Concentrations at time t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! m.r. source
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(INOUT) :: PSVS ! Concentration sources
+!
+END SUBROUTINE LIMA_MIXED
+END INTERFACE
+END MODULE MODI_LIMA_MIXED
+!
+! #######################################################################
+ SUBROUTINE LIMA_MIXED (OSEDI, OHHONI, KSPLITG, PTSTEP, KMI, &
+ KRR, PZZ, PRHODJ, &
+ PRHODREF, PEXNREF, PPABST, PW_NU, &
+ PTHM, PPABSM, &
+ PTHT, PRT, PSVT, &
+ PTHS, PRS, PSVS )
+! #######################################################################
+!
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the mixed-phase
+!! microphysical processes
+!!
+!!
+!!** METHOD
+!! ------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Most of the parameterizations come from the ICE3 scheme, described in
+!! the MESO-NH scientific documentation.
+!!
+!! Cohard, J.-M. and J.-P. Pinty, 2000: A comprehensive two-moment warm
+!! microphysical bulk scheme.
+!! Part I: Description and tests
+!! Part II: 2D experiments with a non-hydrostatic model
+!! Accepted for publication in Quart. J. Roy. Meteor. Soc.
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!! C. Barthe * LACy * jan. 2014 add budgets
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 03/2020: use the new data structures and subroutines for budgets (no more call to budget in this subroutine)
+! P. Wautelet 28/05/2020: bugfix: correct array start for PSVT and PSVS
+! P. Wautelet 02/02/2021: budgets: add missing source terms for SV budgets in LIMA
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+use modd_budget, only: lbu_enable, nbumod
+USE MODD_CST, ONLY: XP00, XRD, XRV, XMV, XMD, XCPD, XCPV, &
+ XCL, XCI, XTT, XLSTT, XLVTT, &
+ XALPI, XBETAI, XGAMI
+USE MODD_NSV
+USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
+USE MODD_PARAM_LIMA, ONLY: NMOD_IFN, XRTMIN, XCTMIN, LWARM, LCOLD, &
+ NMOD_CCN, NMOD_IMM, LRAIN, LSNOW, LHAIL
+USE MODD_PARAM_LIMA_WARM, ONLY: XLBC, XLBEXC, XLBR, XLBEXR
+USE MODD_PARAM_LIMA_COLD, ONLY: XLBI, XLBEXI, XLBS, XLBEXS, XSCFAC
+USE MODD_PARAM_LIMA_MIXED, ONLY: XLBG, XLBEXG, XLBH, XLBEXH
+
+use mode_tools, only: Countjv
+
+USE MODI_LIMA_MIXED_FAST_PROCESSES
+USE MODI_LIMA_MIXED_SLOW_PROCESSES
+
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+LOGICAL, INTENT(IN) :: OSEDI ! switch to activate the
+ ! cloud ice sedimentation
+LOGICAL, INTENT(IN) :: OHHONI ! enable haze freezing
+INTEGER, INTENT(IN) :: KSPLITG ! Number of small time step
+ ! integration for ice sedimendation
+REAL, INTENT(IN) :: PTSTEP ! Time step
+INTEGER, INTENT(IN) :: KMI ! Model index
+!
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
+ ! the nucleation param.
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at time t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! abs. pressure at time t-dt
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! m.r. at t
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(IN) :: PSVT ! Concentrations at time t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! m.r. source
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(INOUT) :: PSVS ! Concentration sources
+!
+!* 0.2 Declarations of local variables :
+!
+!3D microphysical variables
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
+ :: PRVT, & ! Water vapor m.r. at t
+ PRCT, & ! Cloud water m.r. at t
+ PRRT, & ! Rain water m.r. at t
+ PRIT, & ! Cloud ice m.r. at t
+ PRST, & ! Snow/aggregate m.r. at t
+ PRGT, & ! Graupel m.r. at t
+ PRHT, & ! Hail m.r. at t
+ !
+ PRVS, & ! Water vapor m.r. source
+ PRCS, & ! Cloud water m.r. source
+ PRRS, & ! Rain water m.r. source
+ PRIS, & ! Pristine ice m.r. source
+ PRSS, & ! Snow/aggregate m.r. source
+ PRGS, & ! Graupel m.r. source
+ PRHS, & ! Hail m.r. source
+ !
+ PCCT, & ! Cloud water C. at t
+ PCRT, & ! Rain water C. at t
+ PCIT, & ! Ice crystal C. at t
+ !
+ PCCS, & ! Cloud water C. source
+ PCRS, & ! Rain water C. source
+ PCIS ! Ice crystal C. source
+!
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: PIFS ! Free ice nuclei C. source
+ !for DEPOSITION and CONTACT
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: PINS ! Activated ice nuclei C. source
+ !for DEPOSITION and CONTACT
+!
+! Replace PACK
+LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: GMICRO
+INTEGER :: IMICRO
+INTEGER , DIMENSION(SIZE(GMICRO)) :: I1,I2,I3 ! Used to replace the COUNT
+INTEGER :: JL ! and PACK intrinsics
+!
+! Packed microphysical variables
+REAL, DIMENSION(:), ALLOCATABLE :: ZRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRRT ! Rain water m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRGT ! Graupel m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRHT ! Hail m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZCCT ! Cloud water conc. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZCRT ! Rain water conc. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZCIT ! Pristine ice conc. at t
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZRVS ! Water vapor m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRCS ! Cloud water m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRRS ! Rain water m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRIS ! Pristine ice m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRSS ! Snow/aggregate m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRGS ! Graupel m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRHS ! Hail m.r. source
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZTHS ! Theta source
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZCCS ! Cloud water conc. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZCRS ! Rain water conc. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZCIS ! Pristine ice conc. source
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZIFS ! Free Ice nuclei conc. source
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZINS ! Nucleated Ice nuclei conc. source
+!
+! Other packed variables
+REAL, DIMENSION(:), ALLOCATABLE &
+ :: ZRHODREF, & ! RHO Dry REFerence
+ ZRHODJ, & ! RHO times Jacobian
+ ZZT, & ! Temperature
+ ZPRES, & ! Pressure
+ ZEXNREF, & ! EXNer Pressure REFerence
+ ZZW, & ! Work array
+ ZLSFACT, & ! L_s/(Pi_ref*C_ph)
+ ZLVFACT, & ! L_v/(Pi_ref*C_ph)
+ ZSSI, & ! Supersaturation over ice
+ ZLBDAC, & ! Slope parameter of the cloud droplet distr.
+ ZLBDAR, & ! Slope parameter of the raindrop distr.
+ ZLBDAI, & ! Slope parameter of the ice crystal distr.
+ ZLBDAS, & ! Slope parameter of the aggregate distr.
+ ZLBDAG, & ! Slope parameter of the graupel distr.
+ ZLBDAH, & ! Slope parameter of the hail distr.
+ ZAI, & ! Thermodynamical function
+ ZCJ, & ! used to compute the ventilation coefficient
+ ZKA, & ! Thermal conductivity of the air
+ ZDV ! Diffusivity of water vapor in the air
+!
+! 3D Temperature
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: ZT, ZW
+!
+!
+INTEGER :: IIB, IIE, IJB, IJE, IKB, IKE ! Physical domain
+INTEGER :: JMOD_IFN ! Loop index
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 0. 3D MICROPHYSCAL VARIABLES
+! -------------------------
+!
+!
+! Prepare 3D water mixing ratios
+PRVT(:,:,:) = PRT(:,:,:,1)
+PRVS(:,:,:) = PRS(:,:,:,1)
+!
+PRCT(:,:,:) = 0.
+PRCS(:,:,:) = 0.
+PRRT(:,:,:) = 0.
+PRRS(:,:,:) = 0.
+PRIT(:,:,:) = 0.
+PRIS(:,:,:) = 0.
+PRST(:,:,:) = 0.
+PRSS(:,:,:) = 0.
+PRGT(:,:,:) = 0.
+PRGS(:,:,:) = 0.
+PRHT(:,:,:) = 0.
+PRHS(:,:,:) = 0.
+!
+IF ( KRR .GE. 2 ) PRCT(:,:,:) = PRT(:,:,:,2)
+IF ( KRR .GE. 2 ) PRCS(:,:,:) = PRS(:,:,:,2)
+IF ( KRR .GE. 3 ) PRRT(:,:,:) = PRT(:,:,:,3)
+IF ( KRR .GE. 3 ) PRRS(:,:,:) = PRS(:,:,:,3)
+IF ( KRR .GE. 4 ) PRIT(:,:,:) = PRT(:,:,:,4)
+IF ( KRR .GE. 4 ) PRIS(:,:,:) = PRS(:,:,:,4)
+IF ( KRR .GE. 5 ) PRST(:,:,:) = PRT(:,:,:,5)
+IF ( KRR .GE. 5 ) PRSS(:,:,:) = PRS(:,:,:,5)
+IF ( KRR .GE. 6 ) PRGT(:,:,:) = PRT(:,:,:,6)
+IF ( KRR .GE. 6 ) PRGS(:,:,:) = PRS(:,:,:,6)
+IF ( KRR .GE. 7 ) PRHT(:,:,:) = PRT(:,:,:,7)
+IF ( KRR .GE. 7 ) PRHS(:,:,:) = PRS(:,:,:,7)
+!
+! Prepare 3D number concentrations
+PCCT(:,:,:) = 0.
+PCRT(:,:,:) = 0.
+PCIT(:,:,:) = 0.
+PCCS(:,:,:) = 0.
+PCRS(:,:,:) = 0.
+PCIS(:,:,:) = 0.
+!
+IF ( LWARM ) PCCT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NC)
+IF ( LWARM .AND. LRAIN ) PCRT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NR)
+IF ( LCOLD ) PCIT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NI)
+!
+IF ( LWARM ) PCCS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NC)
+IF ( LWARM .AND. LRAIN ) PCRS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NR)
+IF ( LCOLD ) PCIS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NI)
+!
+IF ( NMOD_IFN .GE. 1 ) THEN
+ ALLOCATE( PIFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_IFN) )
+ ALLOCATE( PINS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_IFN) )
+ PIFS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IFN_FREE:NSV_LIMA_IFN_FREE+NMOD_IFN-1)
+ PINS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IFN_NUCL:NSV_LIMA_IFN_NUCL+NMOD_IFN-1)
+ELSE
+ ALLOCATE( PIFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),1) )
+ ALLOCATE( PINS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),1) )
+ PIFS(:,:,:,:) = 0.
+ PINS(:,:,:,:) = 0.
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 1. Pack variables, computations only where necessary
+! -------------------------------------------------
+!
+! Physical domain
+!
+IIB=1+JPHEXT
+IIE=SIZE(PZZ,1) - JPHEXT
+IJB=1+JPHEXT
+IJE=SIZE(PZZ,2) - JPHEXT
+IKB=1+JPVEXT
+IKE=SIZE(PZZ,3) - JPVEXT
+!
+! Temperature
+ZT(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:)/XP00 ) ** (XRD/XCPD)
+!
+! Looking for regions where computations are necessary
+GMICRO(:,:,:) = .FALSE.
+GMICRO(IIB:IIE,IJB:IJE,IKB:IKE) = PRCT(IIB:IIE,IJB:IJE,IKB:IKE)>XRTMIN(2) .OR. &
+ PRRT(IIB:IIE,IJB:IJE,IKB:IKE)>XRTMIN(3) .OR. &
+ PRIT(IIB:IIE,IJB:IJE,IKB:IKE)>XRTMIN(4) .OR. &
+ PRST(IIB:IIE,IJB:IJE,IKB:IKE)>XRTMIN(5) .OR. &
+ PRGT(IIB:IIE,IJB:IJE,IKB:IKE)>XRTMIN(6) .OR. &
+ PRHT(IIB:IIE,IJB:IJE,IKB:IKE)>XRTMIN(7)
+!
+IMICRO = COUNTJV( GMICRO(:,:,:),I1(:),I2(:),I3(:))
+!
+IF( IMICRO >= 1 ) THEN
+!
+ ALLOCATE(ZRVT(IMICRO))
+ ALLOCATE(ZRCT(IMICRO))
+ ALLOCATE(ZRRT(IMICRO))
+ ALLOCATE(ZRIT(IMICRO))
+ ALLOCATE(ZRST(IMICRO))
+ ALLOCATE(ZRGT(IMICRO))
+ ALLOCATE(ZRHT(IMICRO))
+ !
+ ALLOCATE(ZCCT(IMICRO))
+ ALLOCATE(ZCRT(IMICRO))
+ ALLOCATE(ZCIT(IMICRO))
+ !
+ ALLOCATE(ZRVS(IMICRO))
+ ALLOCATE(ZRCS(IMICRO))
+ ALLOCATE(ZRRS(IMICRO))
+ ALLOCATE(ZRIS(IMICRO))
+ ALLOCATE(ZRSS(IMICRO))
+ ALLOCATE(ZRGS(IMICRO))
+ ALLOCATE(ZRHS(IMICRO))
+ ALLOCATE(ZTHS(IMICRO))
+ !
+ ALLOCATE(ZCCS(IMICRO))
+ ALLOCATE(ZCRS(IMICRO))
+ ALLOCATE(ZCIS(IMICRO))
+ ALLOCATE(ZIFS(IMICRO,NMOD_IFN))
+ ALLOCATE(ZINS(IMICRO,NMOD_IFN))
+ !
+ ALLOCATE(ZRHODREF(IMICRO))
+ ALLOCATE(ZZT(IMICRO))
+ ALLOCATE(ZPRES(IMICRO))
+ ALLOCATE(ZEXNREF(IMICRO))
+ DO JL=1,IMICRO
+ ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL))
+ ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
+ ZRRT(JL) = PRRT(I1(JL),I2(JL),I3(JL))
+ ZRIT(JL) = PRIT(I1(JL),I2(JL),I3(JL))
+ ZRST(JL) = PRST(I1(JL),I2(JL),I3(JL))
+ ZRGT(JL) = PRGT(I1(JL),I2(JL),I3(JL))
+ ZRHT(JL) = PRHT(I1(JL),I2(JL),I3(JL))
+ !
+ ZCCT(JL) = PCCT(I1(JL),I2(JL),I3(JL))
+ ZCRT(JL) = PCRT(I1(JL),I2(JL),I3(JL))
+ ZCIT(JL) = PCIT(I1(JL),I2(JL),I3(JL))
+ !
+ ZRVS(JL) = PRVS(I1(JL),I2(JL),I3(JL))
+ ZRCS(JL) = PRCS(I1(JL),I2(JL),I3(JL))
+ ZRRS(JL) = PRRS(I1(JL),I2(JL),I3(JL))
+ ZRIS(JL) = PRIS(I1(JL),I2(JL),I3(JL))
+ ZRSS(JL) = PRSS(I1(JL),I2(JL),I3(JL))
+ ZRGS(JL) = PRGS(I1(JL),I2(JL),I3(JL))
+ ZRHS(JL) = PRHS(I1(JL),I2(JL),I3(JL))
+ ZTHS(JL) = PTHS(I1(JL),I2(JL),I3(JL))
+ !
+ ZCCS(JL) = PCCS(I1(JL),I2(JL),I3(JL))
+ ZCRS(JL) = PCRS(I1(JL),I2(JL),I3(JL))
+ ZCIS(JL) = PCIS(I1(JL),I2(JL),I3(JL))
+ DO JMOD_IFN = 1, NMOD_IFN
+ ZIFS(JL,JMOD_IFN) = PIFS(I1(JL),I2(JL),I3(JL),JMOD_IFN)
+ ZINS(JL,JMOD_IFN) = PINS(I1(JL),I2(JL),I3(JL),JMOD_IFN)
+ ENDDO
+ !
+ ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
+ ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
+ ZPRES(JL) = PPABST(I1(JL),I2(JL),I3(JL))
+ ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL))
+ ENDDO
+ IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
+ ALLOCATE(ZRHODJ(IMICRO))
+ ZRHODJ(:) = PACK( PRHODJ(:,:,:),MASK=GMICRO(:,:,:) )
+ END IF
+!
+! Atmospheric parameters
+!
+ ALLOCATE(ZZW(IMICRO))
+ ALLOCATE(ZLSFACT(IMICRO))
+ ALLOCATE(ZLVFACT(IMICRO))
+ ALLOCATE(ZSSI(IMICRO))
+ ALLOCATE(ZAI(IMICRO))
+ ALLOCATE(ZCJ(IMICRO))
+ ALLOCATE(ZKA(IMICRO))
+ ALLOCATE(ZDV(IMICRO))
+!
+ ZZW(:) = ZEXNREF(:)*( XCPD+XCPV*ZRVT(:)+XCL*(ZRCT(:)+ZRRT(:)) &
+ +XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)) )
+!
+ ZLSFACT(:) = (XLSTT+(XCPV-XCI)*(ZZT(:)-XTT))/ZZW(:) ! L_s/(Pi_ref*C_ph)
+ ZLVFACT(:) = (XLVTT+(XCPV-XCL)*(ZZT(:)-XTT))/ZZW(:) ! L_v/(Pi_ref*C_ph)
+!
+ ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) )
+ ZSSI(:) = ZRVT(:)*( ZPRES(:)-ZZW(:) ) / ( (XMV/XMD) * ZZW(:) ) - 1.0
+ ! Supersaturation over ice
+!
+ ZKA(:) = 2.38E-2 + 0.0071E-2 * ( ZZT(:) - XTT ) ! k_a
+ ZDV(:) = 0.211E-4 * (ZZT(:)/XTT)**1.94 * (XP00/ZPRES(:)) ! D_v
+!
+! Thermodynamical function ZAI = A_i(T,P)
+ ZAI(:) = ( XLSTT + (XCPV-XCI)*(ZZT(:)-XTT) )**2 / (ZKA(:)*XRV*ZZT(:)**2) &
+ + ( XRV*ZZT(:) ) / (ZDV(:)*ZZW(:))
+! ZCJ = c^prime_j (in the ventilation factor)
+ ZCJ(:) = XSCFAC * ZRHODREF(:)**0.3 / SQRT( 1.718E-5+0.0049E-5*(ZZT(:)-XTT) )
+!
+!
+! Particle distribution parameters
+!
+ ALLOCATE(ZLBDAC(IMICRO))
+ ALLOCATE(ZLBDAR(IMICRO))
+ ALLOCATE(ZLBDAI(IMICRO))
+ ALLOCATE(ZLBDAS(IMICRO))
+ ALLOCATE(ZLBDAG(IMICRO))
+ ALLOCATE(ZLBDAH(IMICRO))
+ ZLBDAC(:) = 1.E10
+ WHERE (ZRCT(:)>XRTMIN(2) .AND. ZCCT(:)>XCTMIN(2))
+ ZLBDAC(:) = ( XLBC*ZCCT(:) / ZRCT(:) )**XLBEXC
+ END WHERE
+ ZLBDAR(:) = 1.E10
+ WHERE (ZRRT(:)>XRTMIN(3) .AND. ZCRT(:)>XCTMIN(3))
+ ZLBDAR(:) = ( XLBR*ZCRT(:) / ZRRT(:) )**XLBEXR
+ END WHERE
+ ZLBDAI(:) = 1.E10
+ WHERE (ZRIT(:)>XRTMIN(4) .AND. ZCIT(:)>XCTMIN(4))
+ ZLBDAI(:) = ( XLBI*ZCIT(:) / ZRIT(:) )**XLBEXI
+ END WHERE
+ ZLBDAS(:) = 1.E10
+ WHERE (ZRST(:)>XRTMIN(5) )
+ ZLBDAS(:) = XLBS*( ZRHODREF(:)*ZRST(:) )**XLBEXS
+ END WHERE
+ ZLBDAG(:) = 1.E10
+ WHERE (ZRGT(:)>XRTMIN(6) )
+ ZLBDAG(:) = XLBG*( ZRHODREF(:)*ZRGT(:) )**XLBEXG
+ END WHERE
+ ZLBDAH(:) = 1.E10
+ WHERE (ZRHT(:)>XRTMIN(7) )
+ ZLBDAH(:) = XLBH*( ZRHODREF(:)*ZRHT(:) )**XLBEXH
+ END WHERE
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 2. Compute the slow processes involving cloud water and graupel
+! ------------------------------------------------------------
+!
+ CALL LIMA_MIXED_SLOW_PROCESSES(ZRHODREF, ZZT, ZSSI, PTSTEP, &
+ ZLSFACT, ZLVFACT, ZAI, ZCJ, &
+ ZRGT, ZCIT, &
+ ZRVS, ZRCS, ZRIS, ZRGS, ZTHS, &
+ ZCCS, ZCIS, ZIFS, ZINS, &
+ ZLBDAI, ZLBDAG, &
+ ZRHODJ, GMICRO, PRHODJ, KMI, &
+ PTHS, PRVS, PRCS, PRIS, PRGS, &
+ PCCS, PCIS, PINS )
+!
+!-------------------------------------------------------------------------------
+!
+!
+! 3. Compute the fast RS and RG processes
+! ------------------------------------
+!
+IF (LSNOW) THEN
+ CALL LIMA_MIXED_FAST_PROCESSES(ZRHODREF, ZZT, ZPRES, PTSTEP, &
+ ZLSFACT, ZLVFACT, ZKA, ZDV, ZCJ, &
+ ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, &
+ ZRHT, ZCCT, ZCRT, ZCIT, &
+ ZRCS, ZRRS, ZRIS, ZRSS, ZRGS, ZRHS, &
+ ZTHS, ZCCS, ZCRS, ZCIS, &
+ ZLBDAC, ZLBDAR, ZLBDAS, ZLBDAG, ZLBDAH, &
+ ZRHODJ, GMICRO, PRHODJ, KMI, PTHS, &
+ PRCS, PRRS, PRIS, PRSS, PRGS, PRHS, &
+ PCCS, PCRS, PCIS )
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!
+!
+! 4. Unpack variables
+! ----------------
+!
+!
+ ZW(:,:,:) = PRVS(:,:,:)
+ PRVS(:,:,:) = UNPACK( ZRVS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PRCS(:,:,:)
+ PRCS(:,:,:) = UNPACK( ZRCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PRRS(:,:,:)
+ PRRS(:,:,:) = UNPACK( ZRRS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PRIS(:,:,:)
+ PRIS(:,:,:) = UNPACK( ZRIS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PRSS(:,:,:)
+ PRSS(:,:,:) = UNPACK( ZRSS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PRGS(:,:,:)
+ PRGS(:,:,:) = UNPACK( ZRGS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PRHS(:,:,:)
+ PRHS(:,:,:) = UNPACK( ZRHS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+!
+ ZW(:,:,:) = PTHS(:,:,:)
+ PTHS(:,:,:) = UNPACK( ZTHS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+!
+ ZW(:,:,:) = PCCS(:,:,:)
+ PCCS(:,:,:) = UNPACK( ZCCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PCRS(:,:,:)
+ PCRS(:,:,:) = UNPACK( ZCRS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PCIS(:,:,:)
+ PCIS(:,:,:) = UNPACK( ZCIS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+!
+ DO JMOD_IFN = 1, NMOD_IFN
+ ZW(:,:,:) = PIFS(:,:,:,JMOD_IFN)
+ PIFS(:,:,:,JMOD_IFN) = UNPACK( ZIFS(:,JMOD_IFN),MASK=GMICRO(:,:,:), &
+ FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PINS(:,:,:,JMOD_IFN)
+ PINS(:,:,:,JMOD_IFN) = UNPACK( ZINS(:,JMOD_IFN),MASK=GMICRO(:,:,:), &
+ FIELD=ZW(:,:,:) )
+ ENDDO
+!
+ DEALLOCATE(ZRVT)
+ DEALLOCATE(ZRCT)
+ DEALLOCATE(ZRRT)
+ DEALLOCATE(ZRIT)
+ DEALLOCATE(ZRST)
+ DEALLOCATE(ZRGT)
+ DEALLOCATE(ZRHT)
+!
+ DEALLOCATE(ZCCT)
+ DEALLOCATE(ZCRT)
+ DEALLOCATE(ZCIT)
+!
+ DEALLOCATE(ZRVS)
+ DEALLOCATE(ZRCS)
+ DEALLOCATE(ZRRS)
+ DEALLOCATE(ZRIS)
+ DEALLOCATE(ZRSS)
+ DEALLOCATE(ZRGS)
+ DEALLOCATE(ZRHS)
+ DEALLOCATE(ZTHS)
+!
+ DEALLOCATE(ZCCS)
+ DEALLOCATE(ZCRS)
+ DEALLOCATE(ZCIS)
+ DEALLOCATE(ZIFS)
+ DEALLOCATE(ZINS)
+!
+ DEALLOCATE(ZRHODREF)
+ DEALLOCATE(ZZT)
+ DEALLOCATE(ZPRES)
+ DEALLOCATE(ZEXNREF)
+!
+ DEALLOCATE(ZZW)
+ DEALLOCATE(ZLSFACT)
+ DEALLOCATE(ZLVFACT)
+ DEALLOCATE(ZSSI)
+ DEALLOCATE(ZAI)
+ DEALLOCATE(ZCJ)
+ DEALLOCATE(ZKA)
+ DEALLOCATE(ZDV)
+!
+ DEALLOCATE(ZLBDAC)
+ DEALLOCATE(ZLBDAR)
+ DEALLOCATE(ZLBDAI)
+ DEALLOCATE(ZLBDAS)
+ DEALLOCATE(ZLBDAG)
+ DEALLOCATE(ZLBDAH)
+!
+ IF (NBUMOD==KMI .AND. LBU_ENABLE) DEALLOCATE(ZRHODJ)
+!
+END IF ! IMICRO >= 1
+!
+!------------------------------------------------------------------------------
+!
+!
+!* 5. REPORT 3D MICROPHYSICAL VARIABLES IN PRS AND PSVS
+! -------------------------------------------------
+!
+PRS(:,:,:,1) = PRVS(:,:,:)
+IF ( KRR .GE. 2 ) PRS(:,:,:,2) = PRCS(:,:,:)
+IF ( KRR .GE. 3 ) PRS(:,:,:,3) = PRRS(:,:,:)
+IF ( KRR .GE. 4 ) PRS(:,:,:,4) = PRIS(:,:,:)
+IF ( KRR .GE. 5 ) PRS(:,:,:,5) = PRSS(:,:,:)
+IF ( KRR .GE. 6 ) PRS(:,:,:,6) = PRGS(:,:,:)
+IF ( KRR .GE. 7 ) PRS(:,:,:,7) = PRHS(:,:,:)
+!
+! Prepare 3D number concentrations
+!
+PSVS(:,:,:,NSV_LIMA_NC) = PCCS(:,:,:)
+IF ( LRAIN ) PSVS(:,:,:,NSV_LIMA_NR) = PCRS(:,:,:)
+PSVS(:,:,:,NSV_LIMA_NI) = PCIS(:,:,:)
+!
+IF ( NMOD_IFN .GE. 1 ) THEN
+ PSVS(:,:,:,NSV_LIMA_IFN_FREE:NSV_LIMA_IFN_FREE+NMOD_IFN-1) = PIFS(:,:,:,:)
+ PSVS(:,:,:,NSV_LIMA_IFN_NUCL:NSV_LIMA_IFN_NUCL+NMOD_IFN-1) = PINS(:,:,:,:)
+END IF
+!
+!++cb++
+IF (ALLOCATED(PIFS)) DEALLOCATE(PIFS)
+IF (ALLOCATED(PINS)) DEALLOCATE(PINS)
+!--cb--
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_MIXED
diff --git a/src/mesonh/micro/lima_mixed_fast_processes.f90 b/src/mesonh/micro/lima_mixed_fast_processes.f90
new file mode 100644
index 000000000..09c86c8a2
--- /dev/null
+++ b/src/mesonh/micro/lima_mixed_fast_processes.f90
@@ -0,0 +1,1426 @@
+!MNH_LIC Copyright 2013-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! #####################################
+ MODULE MODI_LIMA_MIXED_FAST_PROCESSES
+! #####################################
+!
+INTERFACE
+ SUBROUTINE LIMA_MIXED_FAST_PROCESSES (ZRHODREF, ZZT, ZPRES, PTSTEP, &
+ ZLSFACT, ZLVFACT, ZKA, ZDV, ZCJ, &
+ ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, &
+ ZRHT, ZCCT, ZCRT, ZCIT, &
+ ZRCS, ZRRS, ZRIS, ZRSS, ZRGS, ZRHS, &
+ ZTHS, ZCCS, ZCRS, ZCIS, &
+ ZLBDAC, ZLBDAR, ZLBDAS, ZLBDAG, ZLBDAH, &
+ PRHODJ1D, GMICRO, PRHODJ, KMI, PTHS, &
+ PRCS, PRRS, PRIS, PRSS, PRGS, PRHS, &
+ PCCS, PCRS, PCIS )
+!
+REAL, DIMENSION(:), INTENT(IN) :: ZRHODREF ! RHO Dry REFerence
+REAL, DIMENSION(:), INTENT(IN) :: ZZT ! Temperature
+REAL, DIMENSION(:), INTENT(IN) :: ZPRES ! Pressure
+REAL, INTENT(IN) :: PTSTEP ! Time step
+!
+REAL, DIMENSION(:), INTENT(IN) :: ZLSFACT ! L_s/(Pi_ref*C_ph)
+REAL, DIMENSION(:), INTENT(IN) :: ZLVFACT ! L_v/(Pi_ref*C_ph)
+REAL, DIMENSION(:), INTENT(IN) :: ZKA ! Thermal conductivity of the air
+REAL, DIMENSION(:), INTENT(IN) :: ZDV ! Diffusivity of water vapor in the air
+REAL, DIMENSION(:), INTENT(IN) :: ZCJ ! Ventilation coefficient ?
+!
+REAL, DIMENSION(:), INTENT(IN) :: ZRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: ZRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: ZRRT ! Rain water m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: ZRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: ZRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: ZRGT ! Graupel m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: ZRHT ! Hail m.r. at t
+!
+REAL, DIMENSION(:), INTENT(IN) :: ZCCT ! Cloud water conc. at t
+REAL, DIMENSION(:), INTENT(IN) :: ZCRT ! Rain water conc. at t
+REAL, DIMENSION(:), INTENT(IN) :: ZCIT ! Pristine ice conc. at t
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: ZRCS ! Cloud water m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: ZRRS ! Rain water m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: ZRIS ! Pristine ice m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: ZRSS ! Snow/aggregate m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: ZRGS ! Graupel/hail m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: ZRHS ! Hail m.r. source
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: ZTHS ! Theta source
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: ZCCS ! Cloud water conc. source
+REAL, DIMENSION(:), INTENT(INOUT) :: ZCRS ! Rain water conc. source
+REAL, DIMENSION(:), INTENT(INOUT) :: ZCIS ! Pristine ice conc. source
+!
+REAL, DIMENSION(:), INTENT(IN) :: ZLBDAC ! Slope param of the cloud droplet distr.
+REAL, DIMENSION(:), INTENT(IN) :: ZLBDAR ! Slope param of the raindrop distr
+REAL, DIMENSION(:), INTENT(IN) :: ZLBDAS ! Slope param of the aggregate distr.
+REAL, DIMENSION(:), INTENT(IN) :: ZLBDAG ! Slope param of the graupel distr.
+REAL, DIMENSION(:), INTENT(IN) :: ZLBDAH ! Slope param of the hail distr.
+!
+! used for budget storage
+REAL, DIMENSION(:), INTENT(IN) :: PRHODJ1D
+LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: GMICRO
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ
+INTEGER, INTENT(IN) :: KMI
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRSS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIS
+!
+END SUBROUTINE LIMA_MIXED_FAST_PROCESSES
+END INTERFACE
+END MODULE MODI_LIMA_MIXED_FAST_PROCESSES
+!
+! #######################################################################
+ SUBROUTINE LIMA_MIXED_FAST_PROCESSES (ZRHODREF, ZZT, ZPRES, PTSTEP, &
+ ZLSFACT, ZLVFACT, ZKA, ZDV, ZCJ, &
+ ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, &
+ ZRHT, ZCCT, ZCRT, ZCIT, &
+ ZRCS, ZRRS, ZRIS, ZRSS, ZRGS, ZRHS, &
+ ZTHS, ZCCS, ZCRS, ZCIS, &
+ ZLBDAC, ZLBDAR, ZLBDAS, ZLBDAG, ZLBDAH, &
+ PRHODJ1D, GMICRO, PRHODJ, KMI, PTHS, &
+ PRCS, PRRS, PRIS, PRSS, PRGS, PRHS, &
+ PCCS, PCRS, PCIS )
+! #######################################################################
+!
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the mixed-phase
+!! fast processes :
+!!
+!! - Fast RS processes :
+!! - Cloud droplet riming of the aggregates
+!! - Hallett-Mossop ice multiplication process due to snow riming
+!! - Rain accretion onto the aggregates
+!! - Conversion-Melting of the aggregates
+!!
+!! - Fast RG processes :
+!! - Rain contact freezing
+!! - Wet/Dry growth of the graupel
+!! - Hallett-Mossop ice multiplication process due to graupel riming
+!! - Melting of the graupeln
+!!
+!!
+!!** METHOD
+!! ------
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Most of the parameterizations come from the ICE3 scheme, described in
+!! the MESO-NH scientific documentation.
+!!
+!! Cohard, J.-M. and J.-P. Pinty, 2000: A comprehensive two-moment warm
+!! microphysical bulk scheme.
+!! Part I: Description and tests
+!! Part II: 2D experiments with a non-hydrostatic model
+!! Accepted for publication in Quart. J. Roy. Meteor. Soc.
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!! C. Barthe * LACy * jan. 2014 add budgets
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 03/2020: use the new data structures and subroutines for budgets
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+use modd_budget, only: lbu_enable, nbumod, &
+ lbudget_th, lbudget_rc, lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1, &
+ tbudgets
+USE MODD_CST
+USE MODD_NSV
+USE MODD_PARAM_LIMA
+USE MODD_PARAM_LIMA_COLD
+USE MODD_PARAM_LIMA_MIXED
+
+use mode_budget, only: Budget_store_init, Budget_store_end
+
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, DIMENSION(:), INTENT(IN) :: ZRHODREF ! RHO Dry REFerence
+REAL, DIMENSION(:), INTENT(IN) :: ZZT ! Temperature
+REAL, DIMENSION(:), INTENT(IN) :: ZPRES ! Pressure
+REAL, INTENT(IN) :: PTSTEP ! Time step
+!
+REAL, DIMENSION(:), INTENT(IN) :: ZLSFACT ! L_s/(Pi_ref*C_ph)
+REAL, DIMENSION(:), INTENT(IN) :: ZLVFACT ! L_v/(Pi_ref*C_ph)
+REAL, DIMENSION(:), INTENT(IN) :: ZKA ! Thermal conductivity of the air
+REAL, DIMENSION(:), INTENT(IN) :: ZDV ! Diffusivity of water vapor in the air
+REAL, DIMENSION(:), INTENT(IN) :: ZCJ ! Ventilation coefficient ?
+!
+REAL, DIMENSION(:), INTENT(IN) :: ZRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: ZRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: ZRRT ! Rain water m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: ZRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: ZRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: ZRGT ! Graupel/hail m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: ZRHT ! Hail m.r. at t
+!
+REAL, DIMENSION(:), INTENT(IN) :: ZCCT ! Cloud water conc. at t
+REAL, DIMENSION(:), INTENT(IN) :: ZCRT ! Rain water conc. at t
+REAL, DIMENSION(:), INTENT(IN) :: ZCIT ! Pristine ice conc. at t
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: ZRCS ! Cloud water m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: ZRRS ! Rain water m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: ZRIS ! Pristine ice m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: ZRSS ! Snow/aggregate m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: ZRGS ! Graupel/hail m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: ZRHS ! Hail m.r. source
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: ZTHS ! Theta source
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: ZCCS ! Cloud water conc. source
+REAL, DIMENSION(:), INTENT(INOUT) :: ZCRS ! Rain water conc. source
+REAL, DIMENSION(:), INTENT(INOUT) :: ZCIS ! Pristine ice conc. source
+!
+REAL, DIMENSION(:), INTENT(IN) :: ZLBDAC ! Slope param of the cloud droplet distr.
+REAL, DIMENSION(:), INTENT(IN) :: ZLBDAR ! Slope param of the raindrop distr
+REAL, DIMENSION(:), INTENT(IN) :: ZLBDAS ! Slope param of the aggregate distr.
+REAL, DIMENSION(:), INTENT(IN) :: ZLBDAG ! Slope param of the graupel distr.
+REAL, DIMENSION(:), INTENT(IN) :: ZLBDAH ! Slope param of the hail distr.
+!
+! used for budget storage
+REAL, DIMENSION(:), INTENT(IN) :: PRHODJ1D
+LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: GMICRO
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ
+INTEGER, INTENT(IN) :: KMI
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRSS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIS
+
+!
+!* 0.2 Declarations of local variables :
+!
+LOGICAL, DIMENSION(SIZE(ZZT)) :: GRIM, GACC, GDRY, GWET, GHAIL ! Test where to compute
+INTEGER :: IGRIM, IGACC, IGDRY, IGWET, IHAIL
+INTEGER :: JJ
+INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC1,IVEC2 ! Vectors of indices
+REAL, DIMENSION(:), ALLOCATABLE :: ZVEC1,ZVEC2, ZVEC3 ! Work vectors
+REAL, DIMENSION(SIZE(ZZT)) :: ZZW, ZZX
+REAL, DIMENSION(SIZE(ZZT)) :: ZRDRYG, ZRWETG
+REAL, DIMENSION(SIZE(ZZT),7) :: ZZW1
+REAL :: NHAIL
+REAL :: ZTHRH, ZTHRC
+!
+!-------------------------------------------------------------------------------
+!
+! #################
+! FAST RS PROCESSES
+! #################
+!
+SNOW: IF (LSNOW) THEN
+!
+!
+!* 1.1 Cloud droplet riming of the aggregates
+! -------------------------------------------
+!
+ZZW1(:,:) = 0.0
+!
+GRIM(:) = (ZRCT(:)>XRTMIN(2)) .AND. (ZRST(:)>XRTMIN(5)) .AND. (ZRCS(:)>XRTMIN(2)/PTSTEP) .AND. (ZZT(:)<XTT)
+IGRIM = COUNT( GRIM(:) )
+!
+IF( IGRIM>0 ) THEN
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'RIM', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'RIM', &
+ Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'RIM', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'RIM', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'RIM', &
+ Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
+ end if
+!
+! 1.1.0 allocations
+!
+ ALLOCATE(ZVEC1(IGRIM))
+ ALLOCATE(ZVEC2(IGRIM))
+ ALLOCATE(IVEC1(IGRIM))
+ ALLOCATE(IVEC2(IGRIM))
+!
+! 1.1.1 select the ZLBDAS
+!
+ ZVEC1(:) = PACK( ZLBDAS(:),MASK=GRIM(:) )
+!
+! 1.1.2 find the next lower indice for the ZLBDAS in the geometrical
+! set of Lbda_s used to tabulate some moments of the incomplete
+! gamma function
+!
+ ZVEC2(1:IGRIM) = MAX( 1.0001, MIN( REAL(NGAMINC)-0.0001, &
+ XRIMINTP1 * LOG( ZVEC1(1:IGRIM) ) + XRIMINTP2 ) )
+ IVEC2(1:IGRIM) = INT( ZVEC2(1:IGRIM) )
+ ZVEC2(1:IGRIM) = ZVEC2(1:IGRIM) - REAL( IVEC2(1:IGRIM) )
+!
+! 1.1.3 perform the linear interpolation of the normalized
+! "2+XDS"-moment of the incomplete gamma function
+!
+ ZVEC1(1:IGRIM) = XGAMINC_RIM1( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) &
+ - XGAMINC_RIM1( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0)
+ ZZW(:) = UNPACK( VECTOR=ZVEC1(:),MASK=GRIM,FIELD=0.0 )
+!
+! 1.1.4 riming of the small sized aggregates
+!
+ WHERE ( GRIM(:) )
+ ZZW1(:,1) = MIN( ZRCS(:), &
+ XCRIMSS * ZZW(:) * ZRCT(:) & ! RCRIMSS
+ * ZLBDAS(:)**XEXCRIMSS &
+ * ZRHODREF(:)**(-XCEXVT) )
+ ZRCS(:) = ZRCS(:) - ZZW1(:,1)
+ ZRSS(:) = ZRSS(:) + ZZW1(:,1)
+ ZTHS(:) = ZTHS(:) + ZZW1(:,1)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(RCRIMSS))
+!
+ ZCCS(:) = MAX( ZCCS(:)-ZZW1(:,1)*(ZCCT(:)/ZRCT(:)),0.0 ) ! Lambda_c**3
+ END WHERE
+!
+! 1.1.5 perform the linear interpolation of the normalized
+! "XBS"-moment of the incomplete gamma function
+!
+ ZVEC1(1:IGRIM) = XGAMINC_RIM2( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) &
+ - XGAMINC_RIM2( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0)
+ ZZW(:) = UNPACK( VECTOR=ZVEC1(:),MASK=GRIM,FIELD=0.0 )
+!
+! 1.1.6 riming-conversion of the large sized aggregates into graupeln
+!
+!
+ WHERE ( GRIM(:) .AND. (ZRSS(:)>XRTMIN(5)/PTSTEP) )
+ ZZW1(:,2) = MIN( ZRCS(:), &
+ XCRIMSG * ZRCT(:) & ! RCRIMSG
+ * ZLBDAS(:)**XEXCRIMSG &
+ * ZRHODREF(:)**(-XCEXVT) &
+ - ZZW1(:,1) )
+ ZZW1(:,3) = MIN( ZRSS(:), &
+ XSRIMCG * ZLBDAS(:)**XEXSRIMCG & ! RSRIMCG
+ * (1.0 - ZZW(:) )/(PTSTEP*ZRHODREF(:)))
+ ZRCS(:) = ZRCS(:) - ZZW1(:,2)
+ ZRSS(:) = ZRSS(:) - ZZW1(:,3)
+ ZRGS(:) = ZRGS(:) + ZZW1(:,2) + ZZW1(:,3)
+ ZTHS(:) = ZTHS(:) + ZZW1(:,2)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(RCRIMSG))
+!
+ ZCCS(:) = MAX( ZCCS(:)-ZZW1(:,2)*(ZCCT(:)/ZRCT(:)),0.0 ) ! Lambda_c**3
+ END WHERE
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(IVEC1)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(ZVEC1)
+
+ ! Budget storage
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'RIM', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'RIM', &
+ Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'RIM', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'RIM', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'RIM', &
+ Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
+ end if
+END IF
+!
+!* 1.2 Hallett-Mossop ice multiplication process due to snow riming
+! -----------------------------------------------------------------
+!
+!
+GRIM(:) = (ZZT(:)<XHMTMAX) .AND. (ZZT(:)>XHMTMIN) &
+ .AND. (ZRST(:)>XRTMIN(5)) .AND. (ZRCT(:)>XRTMIN(2))
+IGRIM = COUNT( GRIM(:) )
+IF( IGRIM>0 ) THEN
+ ! Budget storage
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'HMS', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'HMS', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HMS', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
+
+ ALLOCATE(ZVEC1(IGRIM))
+ ALLOCATE(ZVEC2(IGRIM))
+ ALLOCATE(IVEC2(IGRIM))
+!
+ ZVEC1(:) = PACK( ZLBDAC(:),MASK=GRIM(:) )
+ ZVEC2(1:IGRIM) = MAX( 1.0001, MIN( REAL(NGAMINC)-0.0001, &
+ XHMLINTP1 * LOG( ZVEC1(1:IGRIM) ) + XHMLINTP2 ) )
+ IVEC2(1:IGRIM) = INT( ZVEC2(1:IGRIM) )
+ ZVEC2(1:IGRIM) = ZVEC2(1:IGRIM) - REAL( IVEC2(1:IGRIM) )
+ ZVEC1(1:IGRIM) = XGAMINC_HMC( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) &
+ - XGAMINC_HMC( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0)
+ ZZX(:) = UNPACK( VECTOR=ZVEC1(:),MASK=GRIM,FIELD=0.0 ) ! Large droplets
+!
+ WHERE ( GRIM(:) .AND. ZZX(:)<0.99 )
+ ZZW1(:,5) = (ZZW1(:,1)+ZZW1(:,2))*(ZCCT(:)/ZRCT(:))*(1.0-ZZX(:))* &
+ XHM_FACTS* &
+ MAX( 0.0, MIN( (ZZT(:)-XHMTMIN)/3.0,(XHMTMAX-ZZT(:))/2.0 ) ) ! CCHMSI
+ ZCIS(:) = ZCIS(:) + ZZW1(:,5)
+!
+ ZZW1(:,6) = ZZW1(:,5) * XMNU0 ! RCHMSI
+ ZRIS(:) = ZRIS(:) + ZZW1(:,6)
+ ZRSS(:) = ZRSS(:) - ZZW1(:,6)
+ END WHERE
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(ZVEC1)
+
+ ! Budget storage
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'HMS', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'HMS', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HMS', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
+END IF
+!
+!
+!* 1.3 Rain accretion onto the aggregates
+! ---------------------------------------
+!
+!
+ZZW1(:,2:3) = 0.0
+GACC(:) = (ZRRT(:)>XRTMIN(3)) .AND. (ZRST(:)>XRTMIN(5)) .AND. (ZRRS(:)>XRTMIN(3)/PTSTEP) .AND. (ZZT(:)<XTT)
+IGACC = COUNT( GACC(:) )
+!
+IF( IGACC>0 .AND. LRAIN) THEN
+ ! Budget storage
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'ACC', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'ACC', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'ACC', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'ACC', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'ACC', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ end if
+!
+! 1.3.0 allocations
+!
+ ALLOCATE(ZVEC1(IGACC))
+ ALLOCATE(ZVEC2(IGACC))
+ ALLOCATE(ZVEC3(IGACC))
+ ALLOCATE(IVEC1(IGACC))
+ ALLOCATE(IVEC2(IGACC))
+!
+! 1.3.1 select the (ZLBDAS,ZLBDAR) couplet
+!
+ ZVEC1(:) = PACK( ZLBDAS(:),MASK=GACC(:) )
+ ZVEC2(:) = PACK( ZLBDAR(:),MASK=GACC(:) )
+!
+! 1.3.2 find the next lower indice for the ZLBDAS and for the ZLBDAR
+! in the geometrical set of (Lbda_s,Lbda_r) couplet use to
+! tabulate the RACCSS-kernel
+!
+ ZVEC1(1:IGACC) = MAX( 1.0001, MIN( REAL(NACCLBDAS)-0.0001, &
+ XACCINTP1S * LOG( ZVEC1(1:IGACC) ) + XACCINTP2S ) )
+ IVEC1(1:IGACC) = INT( ZVEC1(1:IGACC) )
+ ZVEC1(1:IGACC) = ZVEC1(1:IGACC) - REAL( IVEC1(1:IGACC) )
+!
+ ZVEC2(1:IGACC) = MAX( 1.0001, MIN( REAL(NACCLBDAR)-0.0001, &
+ XACCINTP1R * LOG( ZVEC2(1:IGACC) ) + XACCINTP2R ) )
+ IVEC2(1:IGACC) = INT( ZVEC2(1:IGACC) )
+ ZVEC2(1:IGACC) = ZVEC2(1:IGACC) - REAL( IVEC2(1:IGACC) )
+!
+! 1.3.3 perform the bilinear interpolation of the normalized
+! RACCSS-kernel
+!
+ DO JJ = 1,IGACC
+ ZVEC3(JJ) = ( XKER_RACCSS(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_RACCSS(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * ZVEC1(JJ) &
+ - ( XKER_RACCSS(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_RACCSS(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * (ZVEC1(JJ) - 1.0)
+ END DO
+ ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GACC,FIELD=0.0 )
+!
+! 1.3.4 raindrop accretion on the small sized aggregates
+!
+ WHERE ( GACC(:) )
+ ZZW1(:,2) = ZCRT(:) * & !! coef of RRACCS
+ XFRACCSS*( ZLBDAS(:)**XCXS )*( ZRHODREF(:)**(-XCEXVT-1.) ) &
+ *( XLBRACCS1/((ZLBDAS(:)**2) ) + &
+ XLBRACCS2/( ZLBDAS(:) * ZLBDAR(:) ) + &
+ XLBRACCS3/( (ZLBDAR(:)**2)) )/ZLBDAR(:)**3
+ ZZW1(:,4) = MIN( ZRRS(:),ZZW1(:,2)*ZZW(:) ) ! RRACCSS
+ ZRRS(:) = ZRRS(:) - ZZW1(:,4)
+ ZRSS(:) = ZRSS(:) + ZZW1(:,4)
+ ZTHS(:) = ZTHS(:) + ZZW1(:,4)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(RRACCSS))
+!
+ ZCRS(:) = MAX( ZCRS(:)-ZZW1(:,4)*(ZCRT(:)/ZRRT(:)),0.0 ) ! Lambda_r**3
+ END WHERE
+!
+! 1.3.4b perform the bilinear interpolation of the normalized
+! RACCS-kernel
+!
+ DO JJ = 1,IGACC
+ ZVEC3(JJ) = ( XKER_RACCS(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_RACCS(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * ZVEC1(JJ) &
+ - ( XKER_RACCS(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_RACCS(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * (ZVEC1(JJ) - 1.0)
+ END DO
+ ZZW1(:,2) = ZZW1(:,2)*UNPACK( VECTOR=ZVEC3(:),MASK=GACC(:),FIELD=0.0 ) !! RRACCS
+!
+! 1.3.5 perform the bilinear interpolation of the normalized
+! SACCRG-kernel
+!
+ DO JJ = 1,IGACC
+ ZVEC3(JJ) = ( XKER_SACCRG(IVEC2(JJ)+1,IVEC1(JJ)+1)* ZVEC1(JJ) &
+ - XKER_SACCRG(IVEC2(JJ)+1,IVEC1(JJ) )*(ZVEC1(JJ) - 1.0) ) &
+ * ZVEC2(JJ) &
+ - ( XKER_SACCRG(IVEC2(JJ) ,IVEC1(JJ)+1)* ZVEC1(JJ) &
+ - XKER_SACCRG(IVEC2(JJ) ,IVEC1(JJ) )*(ZVEC1(JJ) - 1.0) ) &
+ * (ZVEC2(JJ) - 1.0)
+ END DO
+ ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GACC,FIELD=0.0 )
+!
+! 1.3.6 raindrop accretion-conversion of the large sized aggregates
+! into graupeln
+!
+ WHERE ( GACC(:) .AND. (ZRSS(:)>XRTMIN(5)/PTSTEP) )
+ ZZW1(:,2) = MAX( MIN( ZRRS(:),ZZW1(:,2)-ZZW1(:,4) ) , 0. ) ! RRACCSG
+ ZZW1(:,3) = MIN( ZRSS(:),XFSACCRG*ZZW(:)* & ! RSACCRG
+ ( ZLBDAS(:)**(XCXS-XBS) )*( ZRHODREF(:)**(-XCEXVT-1.) ) &
+ *( XLBSACCR1/((ZLBDAR(:)**2) ) + &
+ XLBSACCR2/( ZLBDAR(:) * ZLBDAS(:) ) + &
+ XLBSACCR3/( (ZLBDAS(:)**2)) ) )
+ ZRRS(:) = ZRRS(:) - ZZW1(:,2)
+ ZRSS(:) = ZRSS(:) - ZZW1(:,3)
+ ZRGS(:) = ZRGS(:) + ZZW1(:,2)+ZZW1(:,3)
+ ZTHS(:) = ZTHS(:) + ZZW1(:,2)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(RRACCSG))
+!
+ ZCRS(:) = MAX( ZCRS(:)-ZZW1(:,2)*(ZCRT(:)/ZRRT(:)),0.0 ) ! Lambda_r**3
+ END WHERE
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(IVEC1)
+ DEALLOCATE(ZVEC3)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(ZVEC1)
+
+ ! Budget storage
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'ACC', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'ACC', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'ACC', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'ACC', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'ACC', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ end if
+END IF
+!
+!* 1.4 Conversion-Melting of the aggregates
+! -----------------------------------------
+!
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'CMEL', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'CMEL', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+end if
+
+ZZW(:) = 0.0
+WHERE( (ZRST(:)>XRTMIN(5)) .AND. (ZRSS(:)>XRTMIN(5)/PTSTEP) .AND. (ZZT(:)>XTT) )
+ ZZW(:) = ZRVT(:)*ZPRES(:)/((XMV/XMD)+ZRVT(:)) ! Vapor pressure
+ ZZW(:) = ZKA(:)*(XTT-ZZT(:)) + &
+ ( ZDV(:)*(XLVTT + ( XCPV - XCL ) * ( ZZT(:) - XTT )) &
+ *(XESTT-ZZW(:))/(XRV*ZZT(:)) )
+!
+! compute RSMLT
+!
+ ZZW(:) = MIN( ZRSS(:), XFSCVMG*MAX( 0.0,( -ZZW(:) * &
+ ( X0DEPS* ZLBDAS(:)**XEX0DEPS + &
+ X1DEPS*ZCJ(:)*ZLBDAS(:)**XEX1DEPS ) - &
+ ( ZZW1(:,1)+ZZW1(:,4) ) * &
+ ( ZRHODREF(:)*XCL*(XTT-ZZT(:))) ) / &
+ ( ZRHODREF(:)*XLMTT ) ) )
+!
+! note that RSCVMG = RSMLT*XFSCVMG but no heat is exchanged (at the rate RSMLT)
+! because the graupeln produced by this process are still icy!!!
+!
+ ZRSS(:) = ZRSS(:) - ZZW(:)
+ ZRGS(:) = ZRGS(:) + ZZW(:)
+END WHERE
+!
+! Budget storage
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'CMEL', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'CMEL', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+end if
+
+END IF SNOW
+!
+!------------------------------------------------------------------------------
+!
+! #################
+! FAST RG PROCESSES
+! #################
+!
+!
+!* 2.1 Rain contact freezing
+! --------------------------
+!
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'CFRZ', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'CFRZ', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'CFRZ', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'CFRZ', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'CFRZ', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CFRZ', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+end if
+
+ZZW1(:,3:4) = 0.0
+WHERE( (ZRIT(:)>XRTMIN(4)) .AND. (ZRRT(:)>XRTMIN(3)) .AND. (ZRIS(:)>XRTMIN(4)/PTSTEP) .AND. (ZRRS(:)>XRTMIN(3)/PTSTEP) )
+ ZZW1(:,3) = MIN( ZRIS(:),XICFRR * ZRIT(:) * ZCRT(:) & ! RICFRRG
+ * ZLBDAR(:)**XEXICFRR &
+ * ZRHODREF(:)**(-XCEXVT-1.0) )
+!
+ ZZW1(:,4) = MIN( ZRRS(:),XRCFRI * ZCIT(:) * ZCRT(:) & ! RRCFRIG
+ * ZLBDAR(:)**XEXRCFRI &
+ * ZRHODREF(:)**(-XCEXVT-2.0) )
+ ZRIS(:) = ZRIS(:) - ZZW1(:,3)
+ ZRRS(:) = ZRRS(:) - ZZW1(:,4)
+ ZRGS(:) = ZRGS(:) + ZZW1(:,3)+ZZW1(:,4)
+ ZTHS(:) = ZTHS(:) + ZZW1(:,4)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*RRCFRIG)
+!
+ ZCIS(:) = MAX( ZCIS(:)-ZZW1(:,3)*(ZCIT(:)/ZRIT(:)),0.0 ) ! CICFRRG
+ ZCRS(:) = MAX( ZCRS(:)-ZZW1(:,4)*(ZCRT(:)/ZRRT(:)),0.0 ) ! CRCFRIG
+END WHERE
+
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'CFRZ', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'CFRZ', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'CFRZ', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'CFRZ', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'CFRZ', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CFRZ', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+end if
+!
+!* 2.2 Compute the Dry growth case
+! --------------------------------
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'WETG', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'WETG', &
+ Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'WETG', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'WETG', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'WETG', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'WETG', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'WETG', &
+ Unpack( zrhs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'WETG', &
+ Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'WETG', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'WETG', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
+end if
+!
+ZZW1(:,:) = 0.0
+WHERE( ((ZRCT(:)>XRTMIN(2)) .AND. (ZRGT(:)>XRTMIN(6)) .AND. (ZRCS(:)>XRTMIN(2)/PTSTEP)) .OR. &
+ ((ZRIT(:)>XRTMIN(4)) .AND. (ZRGT(:)>XRTMIN(6)) .AND. (ZRIS(:)>XRTMIN(4)/PTSTEP)) )
+ ZZW(:) = ZLBDAG(:)**(XCXG-XDG-2.0) * ZRHODREF(:)**(-XCEXVT)
+ ZZW1(:,1) = MIN( ZRCS(:),XFCDRYG * ZRCT(:) * ZZW(:) ) ! RCDRYG
+ ZZW1(:,2) = MIN( ZRIS(:),XFIDRYG * EXP( XCOLEXIG*(ZZT(:)-XTT) ) &
+ * ZRIT(:) * ZZW(:) ) ! RIDRYG
+END WHERE
+!
+!* 2.2.1 accretion of aggregates on the graupeln
+! ----------------------------------------------
+!
+GDRY(:) = (ZRST(:)>XRTMIN(5)) .AND. (ZRGT(:)>XRTMIN(6)) .AND. (ZRSS(:)>XRTMIN(5)/PTSTEP)
+IGDRY = COUNT( GDRY(:) )
+!
+IF( IGDRY>0 ) THEN
+!
+!* 2.2.2 allocations
+!
+ ALLOCATE(ZVEC1(IGDRY))
+ ALLOCATE(ZVEC2(IGDRY))
+ ALLOCATE(ZVEC3(IGDRY))
+ ALLOCATE(IVEC1(IGDRY))
+ ALLOCATE(IVEC2(IGDRY))
+!
+!* 2.2.3 select the (ZLBDAG,ZLBDAS) couplet
+!
+ ZVEC1(:) = PACK( ZLBDAG(:),MASK=GDRY(:) )
+ ZVEC2(:) = PACK( ZLBDAS(:),MASK=GDRY(:) )
+!
+!* 2.2.4 find the next lower indice for the ZLBDAG and for the ZLBDAS
+! in the geometrical set of (Lbda_g,Lbda_s) couplet use to
+! tabulate the SDRYG-kernel
+!
+ ZVEC1(1:IGDRY) = MAX( 1.0001, MIN( REAL(NDRYLBDAG)-0.0001, &
+ XDRYINTP1G * LOG( ZVEC1(1:IGDRY) ) + XDRYINTP2G ) )
+ IVEC1(1:IGDRY) = INT( ZVEC1(1:IGDRY) )
+ ZVEC1(1:IGDRY) = ZVEC1(1:IGDRY) - REAL( IVEC1(1:IGDRY) )
+!
+ ZVEC2(1:IGDRY) = MAX( 1.0001, MIN( REAL(NDRYLBDAS)-0.0001, &
+ XDRYINTP1S * LOG( ZVEC2(1:IGDRY) ) + XDRYINTP2S ) )
+ IVEC2(1:IGDRY) = INT( ZVEC2(1:IGDRY) )
+ ZVEC2(1:IGDRY) = ZVEC2(1:IGDRY) - REAL( IVEC2(1:IGDRY) )
+!
+!* 2.2.5 perform the bilinear interpolation of the normalized
+! SDRYG-kernel
+!
+ DO JJ = 1,IGDRY
+ ZVEC3(JJ) = ( XKER_SDRYG(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_SDRYG(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * ZVEC1(JJ) &
+ - ( XKER_SDRYG(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_SDRYG(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * (ZVEC1(JJ) - 1.0)
+ END DO
+ ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GDRY,FIELD=0.0 )
+!
+ WHERE( GDRY(:) )
+ ZZW1(:,3) = MIN( ZRSS(:),XFSDRYG*ZZW(:) & ! RSDRYG
+ * EXP( XCOLEXSG*(ZZT(:)-XTT) ) &
+ *( ZLBDAS(:)**(XCXS-XBS) )*( ZLBDAG(:)**XCXG ) &
+ *( ZRHODREF(:)**(-XCEXVT-1.) ) &
+ *( XLBSDRYG1/( ZLBDAG(:)**2 ) + &
+ XLBSDRYG2/( ZLBDAG(:) * ZLBDAS(:) ) + &
+ XLBSDRYG3/( ZLBDAS(:)**2) ) )
+ END WHERE
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(IVEC1)
+ DEALLOCATE(ZVEC3)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(ZVEC1)
+END IF
+!
+!* 2.2.6 accretion of raindrops on the graupeln
+! ---------------------------------------------
+!
+GDRY(:) = (ZRRT(:)>XRTMIN(3)) .AND. (ZRGT(:)>XRTMIN(6)) .AND. (ZRRS(:)>XRTMIN(3))
+IGDRY = COUNT( GDRY(:) )
+!
+IF( IGDRY>0 ) THEN
+!
+!* 2.2.7 allocations
+!
+ ALLOCATE(ZVEC1(IGDRY))
+ ALLOCATE(ZVEC2(IGDRY))
+ ALLOCATE(ZVEC3(IGDRY))
+ ALLOCATE(IVEC1(IGDRY))
+ ALLOCATE(IVEC2(IGDRY))
+!
+!* 2.2.8 select the (ZLBDAG,ZLBDAR) couplet
+!
+ ZVEC1(:) = PACK( ZLBDAG(:),MASK=GDRY(:) )
+ ZVEC2(:) = PACK( ZLBDAR(:),MASK=GDRY(:) )
+!
+!* 2.2.9 find the next lower indice for the ZLBDAG and for the ZLBDAR
+! in the geometrical set of (Lbda_g,Lbda_r) couplet use to
+! tabulate the RDRYG-kernel
+!
+ ZVEC1(1:IGDRY) = MAX( 1.0001, MIN( REAL(NDRYLBDAG)-0.0001, &
+ XDRYINTP1G * LOG( ZVEC1(1:IGDRY) ) + XDRYINTP2G ) )
+ IVEC1(1:IGDRY) = INT( ZVEC1(1:IGDRY) )
+ ZVEC1(1:IGDRY) = ZVEC1(1:IGDRY) - REAL( IVEC1(1:IGDRY) )
+!
+ ZVEC2(1:IGDRY) = MAX( 1.0001, MIN( REAL(NDRYLBDAR)-0.0001, &
+ XDRYINTP1R * LOG( ZVEC2(1:IGDRY) ) + XDRYINTP2R ) )
+ IVEC2(1:IGDRY) = INT( ZVEC2(1:IGDRY) )
+ ZVEC2(1:IGDRY) = ZVEC2(1:IGDRY) - REAL( IVEC2(1:IGDRY) )
+!
+!* 2.2.10 perform the bilinear interpolation of the normalized
+! RDRYG-kernel
+!
+ DO JJ = 1,IGDRY
+ ZVEC3(JJ) = ( XKER_RDRYG(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_RDRYG(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * ZVEC1(JJ) &
+ - ( XKER_RDRYG(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_RDRYG(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * (ZVEC1(JJ) - 1.0)
+ END DO
+ ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GDRY,FIELD=0.0 )
+!
+ WHERE( GDRY(:) )
+ ZZW1(:,4) = MIN( ZRRS(:),XFRDRYG*ZZW(:) * ZCRT(:) & ! RRDRYG
+ *( ZLBDAR(:)**(-3) )*( ZLBDAG(:)**XCXG ) &
+ *( ZRHODREF(:)**(-XCEXVT-1.) ) &
+ *( XLBRDRYG1/( ZLBDAG(:)**2 ) + &
+ XLBRDRYG2/( ZLBDAG(:) * ZLBDAR(:) ) + &
+ XLBRDRYG3/( ZLBDAR(:)**2) ) )
+ END WHERE
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(IVEC1)
+ DEALLOCATE(ZVEC3)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(ZVEC1)
+END IF
+!
+ZRDRYG(:) = ZZW1(:,1) + ZZW1(:,2) + ZZW1(:,3) + ZZW1(:,4)
+!
+!
+!* 2.3 Compute the Wet growth case
+! --------------------------------
+!
+!
+ZZW(:) = 0.0
+ZRWETG(:) = 0.0
+WHERE( ZRGT(:)>XRTMIN(6) )
+ ZZW1(:,5) = MIN( ZRIS(:), &
+ ZZW1(:,2) / (XCOLIG*EXP(XCOLEXIG*(ZZT(:)-XTT)) ) ) ! RIWETG
+ ZZW1(:,6) = MIN( ZRSS(:), &
+ ZZW1(:,3) / (XCOLSG*EXP(XCOLEXSG*(ZZT(:)-XTT)) ) ) ! RSWETG
+!
+ ZZW(:) = ZRVT(:)*ZPRES(:)/((XMV/XMD)+ZRVT(:)) ! Vapor pressure
+ ZZW(:) = ZKA(:)*(XTT-ZZT(:)) + &
+ ( ZDV(:)*(XLVTT + ( XCPV - XCL ) * ( ZZT(:) - XTT )) &
+ *(XESTT-ZZW(:))/(XRV*ZZT(:)) )
+!
+! compute RWETG
+!
+ ZRWETG(:) = MAX( 0.0, &
+ ( ZZW(:) * ( X0DEPG* ZLBDAG(:)**XEX0DEPG + &
+ X1DEPG*ZCJ(:)*ZLBDAG(:)**XEX1DEPG ) + &
+ ( ZZW1(:,5)+ZZW1(:,6) ) * &
+ ( ZRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-ZZT(:))) ) ) / &
+ ( ZRHODREF(:)*(XLMTT-XCL*(XTT-ZZT(:))) ) )
+END WHERE
+!
+!
+!* 2.4 Select Wet or Dry case
+! ---------------------------
+!
+!
+! Wet case and partial conversion to hail
+!
+ZZW(:) = 0.0
+NHAIL = 0.
+IF (LHAIL) NHAIL = 1.
+WHERE( ZRGT(:)>XRTMIN(6) .AND. ZZT(:)<XTT &
+ .AND. ZRDRYG(:)>=ZRWETG(:) .AND. ZRWETG(:)>0.0 )
+!
+ ZZW(:) = ZRWETG(:) - ZZW1(:,5) - ZZW1(:,6) ! RCWETG+RRWETG
+!
+! limitation of the available rainwater mixing ratio (RRWETH < RRS !)
+!
+ ZZW1(:,7) = MAX( 0.0,MIN( ZZW(:),ZRRS(:)+ZZW1(:,1) ) )
+ ZZX(:) = ZZW1(:,7) / ZZW(:)
+ ZZW1(:,5) = ZZW1(:,5)*ZZX(:)
+ ZZW1(:,6) = ZZW1(:,6)*ZZX(:)
+ ZRWETG(:) = ZZW1(:,7) + ZZW1(:,5) + ZZW1(:,6)
+!
+ ZRCS(:) = ZRCS(:) - ZZW1(:,1)
+ ZRIS(:) = ZRIS(:) - ZZW1(:,5)
+ ZRSS(:) = ZRSS(:) - ZZW1(:,6)
+!
+! assume a linear percent of conversion of graupel into hail
+!
+ ZRGS(:) = ZRGS(:) + ZRWETG(:)
+ ZZW(:) = ZRGS(:)*ZRDRYG(:)*NHAIL/(ZRWETG(:)+ZRDRYG(:))
+ ZRGS(:) = ZRGS(:) - ZZW(:)
+ ZRHS(:) = ZRHS(:) + ZZW(:)
+ ZRRS(:) = MAX( 0.0,ZRRS(:) - ZZW1(:,7) + ZZW1(:,1) )
+ ZTHS(:) = ZTHS(:) + ZZW1(:,7)*(ZLSFACT(:)-ZLVFACT(:))
+ ! f(L_f*(RCWETG+RRWETG))
+!
+ ZCCS(:) = MAX( ZCCS(:)-ZZW1(:,1)*(ZCCT(:)/MAX(ZRCT(:),XRTMIN(2))),0.0 )
+ ZCIS(:) = MAX( ZCIS(:)-ZZW1(:,5)*(ZCIT(:)/MAX(ZRIT(:),XRTMIN(4))),0.0 )
+ ZCRS(:) = MAX( ZCRS(:)-MAX( ZZW1(:,7)-ZZW1(:,1),0.0 ) &
+ *(ZCRT(:)/MAX(ZRRT(:),XRTMIN(3))),0.0 )
+END WHERE
+!
+! Budget storage
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'WETG', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'WETG', &
+ Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'WETG', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'WETG', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'WETG', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'WETG', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'WETG', &
+ Unpack( zrhs(:), mask = gmicro(:, :, :), field = prhs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'WETG', &
+ Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'WETG', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'WETG', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
+end if
+!
+! Dry case
+!
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'DRYG', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'DRYG', &
+ Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'DRYG', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'DRYG', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'DRYG', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'DRYG', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'DRYG', &
+ Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'DRYG', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'DRYG', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
+end if
+
+WHERE( ZRGT(:)>XRTMIN(6) .AND. ZZT(:)<XTT &
+ .AND. ZRDRYG(:)<ZRWETG(:) .AND. ZRDRYG(:)>0.0 ) ! case
+ ZRCS(:) = ZRCS(:) - ZZW1(:,1)
+ ZRIS(:) = ZRIS(:) - ZZW1(:,2)
+ ZRSS(:) = ZRSS(:) - ZZW1(:,3)
+ ZRRS(:) = ZRRS(:) - ZZW1(:,4)
+ ZRGS(:) = ZRGS(:) + ZRDRYG(:)
+ ZTHS(:) = ZTHS(:) + (ZZW1(:,1)+ZZW1(:,4))*(ZLSFACT(:)-ZLVFACT(:)) !
+ ! f(L_f*(RCDRYG+RRDRYG))
+!
+ ZCCS(:) = MAX( ZCCS(:)-ZZW1(:,1)*(ZCCT(:)/MAX(ZRCT(:),XRTMIN(2))),0.0 )
+ ZCIS(:) = MAX( ZCIS(:)-ZZW1(:,2)*(ZCIT(:)/MAX(ZRIT(:),XRTMIN(4))),0.0 )
+ ZCRS(:) = MAX( ZCRS(:)-ZZW1(:,4)*(ZCRT(:)/MAX(ZRRT(:),XRTMIN(3))),0.0 )
+ ! Approximate rates
+END WHERE
+!
+! Budget storage
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'DRYG', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'DRYG', &
+ Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'DRYG', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'DRYG', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'DRYG', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'DRYG', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'DRYG', &
+ Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'DRYG', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'DRYG', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
+end if
+!
+!
+!* 2.5 Hallett-Mossop ice multiplication process due to graupel riming
+! --------------------------------------------------------------------
+!
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'HMG', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'HMG', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HMG', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+end if
+
+GDRY(:) = (ZZT(:)<XHMTMAX) .AND. (ZZT(:)>XHMTMIN) .AND. (ZRDRYG(:)<ZZW(:))&
+ .AND. (ZRGT(:)>XRTMIN(6)) .AND. (ZRCT(:)>XRTMIN(2))
+IGDRY = COUNT( GDRY(:) )
+IF( IGDRY>0 ) THEN
+ ALLOCATE(ZVEC1(IGDRY))
+ ALLOCATE(ZVEC2(IGDRY))
+ ALLOCATE(IVEC2(IGDRY))
+!
+ ZVEC1(:) = PACK( ZLBDAC(:),MASK=GDRY(:) )
+ ZVEC2(1:IGDRY) = MAX( 1.0001, MIN( REAL(NGAMINC)-0.0001, &
+ XHMLINTP1 * LOG( ZVEC1(1:IGDRY) ) + XHMLINTP2 ) )
+ IVEC2(1:IGDRY) = INT( ZVEC2(1:IGDRY) )
+ ZVEC2(1:IGDRY) = ZVEC2(1:IGDRY) - REAL( IVEC2(1:IGDRY) )
+ ZVEC1(1:IGDRY) = XGAMINC_HMC( IVEC2(1:IGDRY)+1 )* ZVEC2(1:IGDRY) &
+ - XGAMINC_HMC( IVEC2(1:IGDRY) )*(ZVEC2(1:IGDRY) - 1.0)
+ ZZX(:) = UNPACK( VECTOR=ZVEC1(:),MASK=GDRY,FIELD=0.0 ) ! Large droplets
+!
+ WHERE ( GDRY(:) .AND. ZZX(:)<0.99 ) ! Dry case
+ ZZW1(:,5) = ZZW1(:,1)*(ZCCT(:)/ZRCT(:))*(1.0-ZZX(:))*XHM_FACTG* &
+ MAX( 0.0, MIN( (ZZT(:)-XHMTMIN)/3.0,(XHMTMAX-ZZT(:))/2.0 ) ) ! CCHMGI
+ ZCIS(:) = ZCIS(:) + ZZW1(:,5)
+!
+ ZZW1(:,6) = ZZW1(:,5) * XMNU0 ! RCHMGI
+ ZRIS(:) = ZRIS(:) + ZZW1(:,6)
+ ZRGS(:) = ZRGS(:) - ZZW1(:,6)
+ END WHERE
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(ZVEC1)
+END IF
+!
+! Budget storage
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'HMG', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'HMG', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HMG', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+end if
+!
+!* 2.6 Melting of the graupeln
+! ----------------------------
+!
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'GMLT', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'GMLT', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'GMLT', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'GMLT', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+end if
+
+ZZW(:) = 0.0
+WHERE( (ZRGT(:)>XRTMIN(6)) .AND. (ZRGS(:)>XRTMIN(6)/PTSTEP) .AND. (ZZT(:)>XTT) )
+ ZZW(:) = ZRVT(:)*ZPRES(:)/((XMV/XMD)+ZRVT(:)) ! Vapor pressure
+ ZZW(:) = ZKA(:)*(XTT-ZZT(:)) + &
+ ( ZDV(:)*(XLVTT + ( XCPV - XCL ) * ( ZZT(:) - XTT )) &
+ *(XESTT-ZZW(:))/(XRV*ZZT(:)) )
+!
+! compute RGMLTR
+!
+ ZZW(:) = MIN( ZRGS(:), MAX( 0.0,( -ZZW(:) * &
+ ( X0DEPG* ZLBDAG(:)**XEX0DEPG + &
+ X1DEPG*ZCJ(:)*ZLBDAG(:)**XEX1DEPG ) - &
+ ( ZZW1(:,1)+ZZW1(:,4) ) * &
+ ( ZRHODREF(:)*XCL*(XTT-ZZT(:))) ) / &
+ ( ZRHODREF(:)*XLMTT ) ) )
+ ZRRS(:) = ZRRS(:) + ZZW(:)
+ ZRGS(:) = ZRGS(:) - ZZW(:)
+ ZTHS(:) = ZTHS(:) - ZZW(:)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(-RGMLTR))
+!
+! ZCRS(:) = MAX( ZCRS(:) + ZZW(:)*(XCCG*ZLBDAG(:)**XCXG/ZRGT(:)),0.0 )
+ ZCRS(:) = ZCRS(:) + ZZW(:)*5.0E6 ! obtained after averaging
+ ! Dshed=1mm and 500 microns
+END WHERE
+!
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'GMLT', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'GMLT', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'GMLT', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'GMLT', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+end if
+!
+!
+!------------------------------------------------------------------------------
+!
+! #################
+! FAST RH PROCESSES
+! #################
+!
+!
+HAIL: IF (LHAIL) THEN
+!
+GHAIL(:) = ZRHT(:)>XRTMIN(7)
+IHAIL = COUNT(GHAIL(:))
+!
+IF( IHAIL>0 ) THEN
+!
+!* 3.1 Wet growth of hail
+! ----------------------------
+!
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'WETH', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'WETH', &
+ Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'WETH', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'WETH', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'WETH', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'WETH', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'WETH', &
+ Unpack( zrhs(:), mask = gmicro(:, :, :), field = prhs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'WETH', &
+ Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'WETH', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'WETH', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
+ end if
+
+ ZZW1(:,:) = 0.0
+ WHERE( GHAIL(:) .AND. ( (ZRCT(:)>XRTMIN(2) .AND. ZRCS(:)>XRTMIN(2)/PTSTEP) .OR. &
+ (ZRIT(:)>XRTMIN(4) .AND. ZRIS(:)>XRTMIN(4)/PTSTEP) ) )
+ ZZW(:) = ZLBDAH(:)**(XCXH-XDH-2.0) * ZRHODREF(:)**(-XCEXVT)
+ ZZW1(:,1) = MIN( ZRCS(:),XFWETH * ZRCT(:) * ZZW(:) ) ! RCWETH
+ ZZW1(:,2) = MIN( ZRIS(:),XFWETH * ZRIT(:) * ZZW(:) ) ! RIWETH
+ END WHERE
+!
+!* 3.1.1 accretion of aggregates on the hailstones
+! ------------------------------------------------
+!
+ GWET(:) = GHAIL(:) .AND. (ZRST(:)>XRTMIN(5) .AND. ZRSS(:)>XRTMIN(5)/PTSTEP)
+ IGWET = COUNT( GWET(:) )
+!
+ IF( IGWET>0 ) THEN
+!
+!* 3.1.2 allocations
+!
+ ALLOCATE(ZVEC1(IGWET))
+ ALLOCATE(ZVEC2(IGWET))
+ ALLOCATE(ZVEC3(IGWET))
+ ALLOCATE(IVEC1(IGWET))
+ ALLOCATE(IVEC2(IGWET))
+!
+!* 3.1.3 select the (ZLBDAH,ZLBDAS) couplet
+!
+ ZVEC1(:) = PACK( ZLBDAH(:),MASK=GWET(:) )
+ ZVEC2(:) = PACK( ZLBDAS(:),MASK=GWET(:) )
+!
+!* 3.1.4 find the next lower indice for the ZLBDAG and for the ZLBDAS
+! in the geometrical set of (Lbda_h,Lbda_s) couplet use to
+! tabulate the SWETH-kernel
+!
+ ZVEC1(1:IGWET) = MAX( 1.0001, MIN( REAL(NWETLBDAH)-0.0001, &
+ XWETINTP1H * LOG( ZVEC1(1:IGWET) ) + XWETINTP2H ) )
+ IVEC1(1:IGWET) = INT( ZVEC1(1:IGWET) )
+ ZVEC1(1:IGWET) = ZVEC1(1:IGWET) - REAL( IVEC1(1:IGWET) )
+!
+ ZVEC2(1:IGWET) = MAX( 1.0001, MIN( REAL(NWETLBDAS)-0.0001, &
+ XWETINTP1S * LOG( ZVEC2(1:IGWET) ) + XWETINTP2S ) )
+ IVEC2(1:IGWET) = INT( ZVEC2(1:IGWET) )
+ ZVEC2(1:IGWET) = ZVEC2(1:IGWET) - REAL( IVEC2(1:IGWET) )
+!
+!* 3.1.5 perform the bilinear interpolation of the normalized
+! SWETH-kernel
+!
+ DO JJ = 1,IGWET
+ ZVEC3(JJ) = ( XKER_SWETH(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_SWETH(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * ZVEC1(JJ) &
+ - ( XKER_SWETH(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_SWETH(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * (ZVEC1(JJ) - 1.0)
+ END DO
+ ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GWET,FIELD=0.0 )
+!
+ WHERE( GWET(:) )
+ ZZW1(:,3) = MIN( ZRSS(:),XFSWETH*ZZW(:) & ! RSWETH
+ *( ZLBDAS(:)**(XCXS-XBS) )*( ZLBDAH(:)**XCXH ) &
+ *( ZRHODREF(:)**(-XCEXVT-1.) ) &
+ *( XLBSWETH1/( ZLBDAH(:)**2 ) + &
+ XLBSWETH2/( ZLBDAH(:) * ZLBDAS(:) ) + &
+ XLBSWETH3/( ZLBDAS(:)**2) ) )
+ END WHERE
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(IVEC1)
+ DEALLOCATE(ZVEC3)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(ZVEC1)
+ END IF
+!
+!* 3.1.6 accretion of graupeln on the hailstones
+! ----------------------------------------------
+!
+ GWET(:) = GHAIL(:) .AND. (ZRGT(:)>XRTMIN(6) .AND. ZRGS(:)>XRTMIN(6)/PTSTEP)
+ IGWET = COUNT( GWET(:) )
+!
+ IF( IGWET>0 ) THEN
+!
+!* 3.1.7 allocations
+!
+ ALLOCATE(ZVEC1(IGWET))
+ ALLOCATE(ZVEC2(IGWET))
+ ALLOCATE(ZVEC3(IGWET))
+ ALLOCATE(IVEC1(IGWET))
+ ALLOCATE(IVEC2(IGWET))
+!
+!* 3.1.8 select the (ZLBDAH,ZLBDAG) couplet
+!
+ ZVEC1(:) = PACK( ZLBDAH(:),MASK=GWET(:) )
+ ZVEC2(:) = PACK( ZLBDAG(:),MASK=GWET(:) )
+!
+!* 3.1.9 find the next lower indice for the ZLBDAH and for the ZLBDAG
+! in the geometrical set of (Lbda_h,Lbda_g) couplet use to
+! tabulate the GWETH-kernel
+!
+ ZVEC1(1:IGWET) = MAX( 1.0001, MIN( REAL(NWETLBDAG)-0.0001, &
+ XWETINTP1H * LOG( ZVEC1(1:IGWET) ) + XWETINTP2H ) )
+ IVEC1(1:IGWET) = INT( ZVEC1(1:IGWET) )
+ ZVEC1(1:IGWET) = ZVEC1(1:IGWET) - REAL( IVEC1(1:IGWET) )
+!
+ ZVEC2(1:IGWET) = MAX( 1.0001, MIN( REAL(NWETLBDAG)-0.0001, &
+ XWETINTP1G * LOG( ZVEC2(1:IGWET) ) + XWETINTP2G ) )
+ IVEC2(1:IGWET) = INT( ZVEC2(1:IGWET) )
+ ZVEC2(1:IGWET) = ZVEC2(1:IGWET) - REAL( IVEC2(1:IGWET) )
+!
+!* 3.1.10 perform the bilinear interpolation of the normalized
+! GWETH-kernel
+!
+ DO JJ = 1,IGWET
+ ZVEC3(JJ) = ( XKER_GWETH(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_GWETH(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * ZVEC1(JJ) &
+ - ( XKER_GWETH(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_GWETH(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * (ZVEC1(JJ) - 1.0)
+ END DO
+ ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GWET,FIELD=0.0 )
+!
+ WHERE( GWET(:) )
+ ZZW1(:,5) = MAX(MIN( ZRGS(:),XFGWETH*ZZW(:) & ! RGWETH
+ *( ZLBDAG(:)**(XCXG-XBG) )*( ZLBDAH(:)**XCXH ) &
+ *( ZRHODREF(:)**(-XCEXVT-1.) ) &
+ *( XLBGWETH1/( ZLBDAH(:)**2 ) + &
+ XLBGWETH2/( ZLBDAH(:) * ZLBDAG(:) ) + &
+ XLBGWETH3/( ZLBDAG(:)**2) ) ),0. )
+ END WHERE
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(IVEC1)
+ DEALLOCATE(ZVEC3)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(ZVEC1)
+ END IF
+!
+!* 3.2 compute the Wet growth of hail
+! -------------------------------------
+!
+ ZZW(:) = 0.0
+ WHERE( GHAIL(:) .AND. ZZT(:)<XTT )
+ ZZW(:) = ZRVT(:)*ZPRES(:)/((XMV/XMD)+ZRVT(:)) ! Vapor pressure
+ ZZW(:) = ZKA(:)*(XTT-ZZT(:)) + &
+ ( ZDV(:)*(XLVTT + ( XCPV - XCL ) * ( ZZT(:) - XTT )) &
+ *(XESTT-ZZW(:))/(XRV*ZZT(:)) )
+!
+! compute RWETH
+!
+ ZZW(:) = MAX(0., ( ZZW(:) * ( X0DEPH* ZLBDAH(:)**XEX0DEPH + &
+ X1DEPH*ZCJ(:)*ZLBDAH(:)**XEX1DEPH ) + &
+ ( ZZW1(:,2)+ZZW1(:,3)+ZZW1(:,5) ) * &
+ ( ZRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-ZZT(:))) ) ) / &
+ ( ZRHODREF(:)*(XLMTT-XCL*(XTT-ZZT(:))) ) )
+!
+ ZZW1(:,6) = MAX( ZZW(:) - ZZW1(:,2) - ZZW1(:,3) - ZZW1(:,5),0.) ! RCWETH+RRWETH
+ END WHERE
+ WHERE ( GHAIL(:) .AND. ZZT(:)<XTT .AND. ZZW1(:,6)/=0.)
+!
+! limitation of the available rainwater mixing ratio (RRWETH < RRS !)
+!
+ ZZW1(:,4) = MAX( 0.0,MIN( ZZW1(:,6),ZRRS(:)+ZZW1(:,1) ) )
+ ZZX(:) = ZZW1(:,4) / ZZW1(:,6)
+ ZZW1(:,2) = ZZW1(:,2)*ZZX(:)
+ ZZW1(:,3) = ZZW1(:,3)*ZZX(:)
+ ZZW1(:,5) = ZZW1(:,5)*ZZX(:)
+ ZZW(:) = ZZW1(:,4) + ZZW1(:,2) + ZZW1(:,3) + ZZW1(:,5)
+!
+!* 3.2.1 integrate the Wet growth of hail
+!
+ ZRCS(:) = ZRCS(:) - ZZW1(:,1)
+ ZRIS(:) = ZRIS(:) - ZZW1(:,2)
+ ZRSS(:) = ZRSS(:) - ZZW1(:,3)
+ ZRGS(:) = ZRGS(:) - ZZW1(:,5)
+ ZRHS(:) = ZRHS(:) + ZZW(:)
+ ZRRS(:) = MAX( 0.0,ZRRS(:) - ZZW1(:,4) + ZZW1(:,1) )
+ ZTHS(:) = ZTHS(:) + ZZW1(:,4)*(ZLSFACT(:)-ZLVFACT(:))
+ ! f(L_f*(RCWETH+RRWETH))
+!
+ ZCCS(:) = MAX( ZCCS(:)-ZZW1(:,1)*(ZCCT(:)/MAX(ZRCT(:),XRTMIN(2))),0.0 )
+ ZCIS(:) = MAX( ZCIS(:)-ZZW1(:,2)*(ZCIT(:)/MAX(ZRIT(:),XRTMIN(4))),0.0 )
+ ZCRS(:) = MAX( ZCRS(:)-MAX( ZZW1(:,4)-ZZW1(:,1),0.0 ) &
+ *(ZCRT(:)/MAX(ZRRT(:),XRTMIN(3))),0.0 )
+ END WHERE
+
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'WETH', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'WETH', &
+ Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'WETH', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'WETH', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'WETH', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'WETH', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'WETH', &
+ Unpack( zrhs(:), mask = gmicro(:, :, :), field = prhs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'WETH', &
+ Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'WETH', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'WETH', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
+ end if
+END IF ! IHAIL>0
+!
+! Partial reconversion of hail to graupel when rc and rh are small
+!
+!
+!* 3.3 Conversion of the hailstones into graupel
+! -----------------------------------------------
+!
+IF ( IHAIL>0 ) THEN
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'COHG', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'COHG', &
+ Unpack( zrhs(:), mask = gmicro(:, :, :), field = prhs(:, :, :) ) * prhodj(:, :, :) )
+ end if
+
+ ZTHRH=0.01E-3
+ ZTHRC=0.001E-3
+ ZZW(:) = 0.0
+ WHERE( ZRHT(:)<ZTHRH .AND. ZRCT(:)<ZTHRC .AND. ZZT(:)<XTT )
+ ZZW(:) = MIN( 1.0,MAX( 0.0,1.0-(ZRCT(:)/ZTHRC) ) )
+!
+! assume a linear percent conversion rate of hail into graupel
+!
+ ZZW(:) = ZRHS(:)*ZZW(:)
+ ZRGS(:) = ZRGS(:) + ZZW(:) ! partial conversion
+ ZRHS(:) = ZRHS(:) - ZZW(:) ! of hail into graupel
+!
+ END WHERE
+
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'COHG', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'COHG', &
+ Unpack( zrhs(:), mask = gmicro(:, :, :), field = prhs(:, :, :) ) * prhodj(:, :, :) )
+ end if
+END IF
+!
+!* 3.4 Melting of the hailstones
+!
+IF ( IHAIL>0 ) THEN
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HMLT', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'HMLT', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'HMLT', &
+ Unpack( zrhs(:), mask = gmicro(:, :, :), field = prhs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'HMLT', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ end if
+
+ ZZW(:) = 0.0
+ WHERE( GHAIL(:) .AND. (ZRHS(:)>XRTMIN(7)/PTSTEP) .AND. (ZRHT(:)>XRTMIN(7)) .AND. (ZZT(:)>XTT) )
+ ZZW(:) = ZRVT(:)*ZPRES(:)/((XMV/XMD)+ZRVT(:)) ! Vapor pressure
+ ZZW(:) = ZKA(:)*(XTT-ZZT(:)) + &
+ ( ZDV(:)*(XLVTT + ( XCPV - XCL ) * ( ZZT(:) - XTT )) &
+ *(XESTT-ZZW(:))/(XRV*ZZT(:)) )
+!
+! compute RHMLTR
+!
+ ZZW(:) = MIN( ZRHS(:), MAX( 0.0,( -ZZW(:) * &
+ ( X0DEPH* ZLBDAH(:)**XEX0DEPH + &
+ X1DEPH*ZCJ(:)*ZLBDAH(:)**XEX1DEPH ) - &
+ ZZW1(:,6)*( ZRHODREF(:)*XCL*(XTT-ZZT(:))) ) / &
+ ( ZRHODREF(:)*XLMTT ) ) )
+ ZRRS(:) = ZRRS(:) + ZZW(:)
+ ZRHS(:) = ZRHS(:) - ZZW(:)
+ ZTHS(:) = ZTHS(:) - ZZW(:)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(-RHMLTR))
+!
+ ZCRS(:) = MAX( ZCRS(:) + ZZW(:)*(XCCH*ZLBDAH(:)**XCXH/ZRHT(:)),0.0 )
+!
+ END WHERE
+
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HMLT', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'HMLT', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'HMLT', &
+ Unpack( zrhs(:), mask = gmicro(:, :, :), field = prhs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'HMLT', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ end if
+END IF
+
+END IF HAIL
+!
+!------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_MIXED_FAST_PROCESSES
diff --git a/src/mesonh/micro/lima_mixed_slow_processes.f90 b/src/mesonh/micro/lima_mixed_slow_processes.f90
new file mode 100644
index 000000000..6ef9b55f5
--- /dev/null
+++ b/src/mesonh/micro/lima_mixed_slow_processes.f90
@@ -0,0 +1,304 @@
+!MNH_LIC Copyright 2013-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! #####################################
+ MODULE MODI_LIMA_MIXED_SLOW_PROCESSES
+! #####################################
+!
+INTERFACE
+ SUBROUTINE LIMA_MIXED_SLOW_PROCESSES(ZRHODREF, ZZT, ZSSI, PTSTEP, &
+ ZLSFACT, ZLVFACT, ZAI, ZCJ, &
+ ZRGT, ZCIT, &
+ ZRVS, ZRCS, ZRIS, ZRGS, ZTHS, &
+ ZCCS, ZCIS, ZIFS, ZINS, &
+ ZLBDAI, ZLBDAG, &
+ PRHODJ1D, GMICRO, PRHODJ, KMI,&
+ PTHS, PRVS, PRCS, PRIS, PRGS, &
+ PCCS, PCIS, PINS )
+!
+REAL, DIMENSION(:), INTENT(IN) :: ZRHODREF ! RHO Dry REFerence
+REAL, DIMENSION(:), INTENT(IN) :: ZZT ! Temperature
+REAL, DIMENSION(:), INTENT(IN) :: ZSSI ! Supersaturation over ice
+REAL, INTENT(IN) :: PTSTEP ! Time-step
+!
+REAL, DIMENSION(:), INTENT(IN) :: ZLSFACT ! L_s/(Pi_ref*C_ph)
+REAL, DIMENSION(:), INTENT(IN) :: ZLVFACT ! L_v/(Pi_ref*C_ph)
+REAL, DIMENSION(:), INTENT(IN) :: ZAI ! Thermodynamical function
+REAL, DIMENSION(:), INTENT(IN) :: ZCJ ! for the ventilation coefficient
+!
+REAL, DIMENSION(:), INTENT(IN) :: ZRGT ! Graupel/hail m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: ZCIT ! Pristine ice conc. at t
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: ZRVS ! Water vapor m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: ZRCS ! Cloud water m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: ZRIS ! Pristine ice m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: ZRGS ! Graupel/hail m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: ZTHS ! Theta source
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: ZCCS ! Cloud water conc. source
+REAL, DIMENSION(:), INTENT(INOUT) :: ZCIS ! Pristine ice conc. source
+REAL, DIMENSION(:,:), INTENT(INOUT) :: ZIFS ! Free Ice nuclei conc. source
+REAL, DIMENSION(:,:), INTENT(INOUT) :: ZINS ! Nucleated Ice nuclei conc. source
+!
+REAL, DIMENSION(:), INTENT(IN) :: ZLBDAI ! Slope parameter of the ice crystal distr.
+REAL, DIMENSION(:), INTENT(IN) :: ZLBDAG ! Slope parameter of the graupel distr.
+!
+! used for budget storage
+REAL, DIMENSION(:), INTENT(IN) :: PRHODJ1D
+LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: GMICRO
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ
+INTEGER, INTENT(IN) :: KMI
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIS
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PINS
+!
+END SUBROUTINE LIMA_MIXED_SLOW_PROCESSES
+END INTERFACE
+END MODULE MODI_LIMA_MIXED_SLOW_PROCESSES
+!
+! #######################################################################
+ SUBROUTINE LIMA_MIXED_SLOW_PROCESSES(ZRHODREF, ZZT, ZSSI, PTSTEP, &
+ ZLSFACT, ZLVFACT, ZAI, ZCJ, &
+ ZRGT, ZCIT, &
+ ZRVS, ZRCS, ZRIS, ZRGS, ZTHS, &
+ ZCCS, ZCIS, ZIFS, ZINS, &
+ ZLBDAI, ZLBDAG, &
+ PRHODJ1D, GMICRO, PRHODJ, KMI,&
+ PTHS, PRVS, PRCS, PRIS, PRGS, &
+ PCCS, PCIS, PINS )
+! #######################################################################
+!
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the mixed-phase
+!! slow processes :
+!!
+!! Deposition of water vapor on graupeln
+!! Cloud ice Melting
+!! Bergeron-Findeisen effect
+!!
+!!** METHOD
+!! ------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Most of the parameterizations come from the ICE3 scheme, described in
+!! the MESO-NH scientific documentation.
+!!
+!! Cohard, J.-M. and J.-P. Pinty, 2000: A comprehensive two-moment warm
+!! microphysical bulk scheme.
+!! Part I: Description and tests
+!! Part II: 2D experiments with a non-hydrostatic model
+!! Accepted for publication in Quart. J. Roy. Meteor. Soc.
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!! C. Barthe * LACy * jan. 2014 add budgets
+! P. Wautelet 03/2020: use the new data structures and subroutines for budgets
+! P. Wautelet 02/02/2021: budgets: add missing source terms for SV budgets in LIMA
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+use modd_budget, only: lbu_enable, nbumod, &
+ lbudget_th, lbudget_rv, lbudget_rc, lbudget_rc, lbudget_ri, lbudget_rg, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RC, NBUDGET_RI, NBUDGET_RG, NBUDGET_SV1, &
+ tbudgets
+USE MODD_CST, ONLY : XTT, XALPI, XBETAI, XGAMI, &
+ XALPW, XBETAW, XGAMW
+USE MODD_NSV
+USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, NMOD_IFN, LSNOW
+USE MODD_PARAM_LIMA_COLD, ONLY : XDI, X0DEPI, X2DEPI, XSCFAC
+USE MODD_PARAM_LIMA_MIXED, ONLY : XLBG, XLBEXG, XLBDAG_MAX, &
+ X0DEPG, XEX0DEPG, X1DEPG, XEX1DEPG
+use mode_budget, only: Budget_store_add, Budget_store_init, Budget_store_end
+
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, DIMENSION(:), INTENT(IN) :: ZRHODREF ! RHO Dry REFerence
+REAL, DIMENSION(:), INTENT(IN) :: ZZT ! Temperature
+REAL, DIMENSION(:), INTENT(IN) :: ZSSI ! Supersaturation over ice
+REAL, INTENT(IN) :: PTSTEP ! Time-step
+!
+REAL, DIMENSION(:), INTENT(IN) :: ZLSFACT ! L_s/(Pi_ref*C_ph)
+REAL, DIMENSION(:), INTENT(IN) :: ZLVFACT ! L_v/(Pi_ref*C_ph)
+REAL, DIMENSION(:), INTENT(IN) :: ZAI ! Thermodynamical function
+REAL, DIMENSION(:), INTENT(IN) :: ZCJ ! for the ventilation coefficient
+!
+REAL, DIMENSION(:), INTENT(IN) :: ZRGT ! Graupel/hail m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: ZCIT ! Pristine ice conc. at t
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: ZRVS ! Water vapor m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: ZRCS ! Cloud water m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: ZRIS ! Pristine ice m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: ZRGS ! Graupel/hail m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: ZTHS ! Theta source
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: ZCCS ! Cloud water conc. source
+REAL, DIMENSION(:), INTENT(INOUT) :: ZCIS ! Pristine ice conc. source
+REAL, DIMENSION(:,:), INTENT(INOUT) :: ZIFS ! Free Ice nuclei conc. source
+REAL, DIMENSION(:,:), INTENT(INOUT) :: ZINS ! Nucleated Ice nuclei conc. source
+!
+REAL, DIMENSION(:), INTENT(IN) :: ZLBDAI ! Slope parameter of the ice crystal distr.
+REAL, DIMENSION(:), INTENT(IN) :: ZLBDAG ! Slope parameter of the graupel distr.
+!
+! used for budget storage
+REAL, DIMENSION(:), INTENT(IN) :: PRHODJ1D
+LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: GMICRO
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ
+INTEGER, INTENT(IN) :: KMI
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIS
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PINS
+!
+!* 0.2 Declarations of local variables :
+!
+REAL, DIMENSION(SIZE(ZZT)) :: ZZW, ZMASK ! Work vectors
+!
+INTEGER :: JMOD_IFN
+!
+!-------------------------------------------------------------------------------
+!
+!* 1 Deposition of water vapor on r_g: RVDEPG
+! ---------------------------------------------
+!
+!
+IF (LSNOW) THEN
+ ZZW(:) = 0.0
+ WHERE ( (ZRGT(:)>XRTMIN(6)) .AND. (ZRGS(:)>XRTMIN(6)/PTSTEP) )
+ ZZW(:) = ( ZSSI(:)/ZAI(:)/ZRHODREF(:) ) * &
+ ( X0DEPG*ZLBDAG(:)**XEX0DEPG + X1DEPG*ZCJ(:)*ZLBDAG(:)**XEX1DEPG )
+ ZZW(:) = MIN( ZRVS(:),ZZW(:) )*(0.5+SIGN(0.5,ZZW(:))) &
+ - MIN( ZRGS(:),ABS(ZZW(:)) )*(0.5-SIGN(0.5,ZZW(:)))
+ ZRGS(:) = ZRGS(:) + ZZW(:)
+ ZRVS(:) = ZRVS(:) - ZZW(:)
+ ZTHS(:) = ZTHS(:) + ZZW(:)*ZLSFACT(:)
+ END WHERE
+!
+! Budget storage
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'DEPG', &
+ Unpack( zzw(:) * zlsfact(:) * prhodj1d(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'DEPG', &
+ Unpack( -zzw(:) * prhodj1d(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'DEPG', &
+ Unpack( zzw(:) * prhodj1d(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+END IF
+!
+!
+!* 2 cloud ice Melting: RIMLTC and CIMLTC
+! -----------------------------------------
+!
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'IMLT', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'IMLT', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'IMLT', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'IMLT', pccs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'IMLT', pcis(:, :, :) * prhodj(:, :, :) )
+ do jmod_ifn = 1,nmod_ifn
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl + jmod_ifn - 1), 'IMLT', &
+ pins(:, :, :, jmod_ifn) * prhodj(:, :, :) )
+ enddo
+ end if
+ end if
+
+ ZMASK(:) = 1.0
+ WHERE( (ZRIS(:)>XRTMIN(4)/PTSTEP) .AND. (ZZT(:)>XTT) )
+ ZRCS(:) = ZRCS(:) + ZRIS(:)
+ ZTHS(:) = ZTHS(:) - ZRIS(:)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(-RIMLTC))
+ ZRIS(:) = 0.0
+!
+ ZCCS(:) = ZCCS(:) + ZCIS(:)
+ ZCIS(:) = 0.0
+ ZMASK(:)= 0.0
+ END WHERE
+ DO JMOD_IFN = 1,NMOD_IFN
+! Correction BVIE aerosols not released but in droplets
+! ZIFS(:,JMOD_IFN) = ZIFS(:,JMOD_IFN) + ZINS(:,JMOD_IFN)*(1.-ZMASK(:))
+ ZINS(:,JMOD_IFN) = ZINS(:,JMOD_IFN) * ZMASK(:)
+ ENDDO
+!
+! Budget storage
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'IMLT', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'IMLT', &
+ Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'IMLT', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'IMLT', &
+ Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'IMLT', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ do jmod_ifn = 1,nmod_ifn
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl + jmod_ifn - 1), 'IMLT', &
+ Unpack( zins(:, jmod_ifn), mask = gmicro(:, :, :), field = pins(:, :, :, jmod_ifn) ) * prhodj(:, :, :) )
+ enddo
+ end if
+ end if
+!
+!* 3 Bergeron-Findeisen effect: RCBERI
+! --------------------------------------
+!
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'BERFI', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'BERFI', &
+ Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'BERFI', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ end if
+
+ ZZW(:) = 0.0
+ WHERE( (ZRCS(:)>XRTMIN(2)/PTSTEP) .AND. (ZRIS(:)>XRTMIN(4)/PTSTEP) .AND. (ZCIT(:)>XCTMIN(4)) )
+ ZZW(:) = EXP( (XALPW-XALPI) - (XBETAW-XBETAI)/ZZT(:) &
+ - (XGAMW-XGAMI)*ALOG(ZZT(:)) ) -1.0
+ ! supersaturation of saturated water over ice
+ ZZW(:) = MIN( ZRCS(:),( ZZW(:) / ZAI(:) ) * ZCIT(:) * &
+ ( X0DEPI/ZLBDAI(:)+X2DEPI*ZCJ(:)*ZCJ(:)/ZLBDAI(:)**(XDI+2.0) ) )
+ ZRCS(:) = ZRCS(:) - ZZW(:)
+ ZRIS(:) = ZRIS(:) + ZZW(:)
+ ZTHS(:) = ZTHS(:) + ZZW(:)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(RCBERI))
+ END WHERE
+!
+! Budget storage
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'BERFI', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'BERFI', &
+ Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'BERFI', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ end if
+!------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_MIXED_SLOW_PROCESSES
diff --git a/src/mesonh/micro/lima_mixrat_to_nconc.f90 b/src/mesonh/micro/lima_mixrat_to_nconc.f90
new file mode 100644
index 000000000..f21a1afe2
--- /dev/null
+++ b/src/mesonh/micro/lima_mixrat_to_nconc.f90
@@ -0,0 +1,192 @@
+!MNH_LIC Copyright 2016-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ################################
+ MODULE MODI_LIMA_MIXRAT_TO_NCONC
+! ################################
+INTERFACE
+SUBROUTINE LIMA_MIXRAT_TO_NCONC(PPABST, PTHT, PRVT, PSVT)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute pressure
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Potential temperature
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water Vapor mix. ratio
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT ! Mixing ratios IN, conc. OUT
+!
+END SUBROUTINE LIMA_MIXRAT_TO_NCONC
+END INTERFACE
+END MODULE MODI_LIMA_MIXRAT_TO_NCONC
+!
+! ########################################################
+ SUBROUTINE LIMA_MIXRAT_TO_NCONC(PPABST, PTHT, PRVT, PSVT)
+! ########################################################
+!
+!
+!!**** *LIMA_MIXRAT_TO_NCONC* - converts CAMS aerosol mixing ratios into
+!! number concentrations
+!!
+!! PURPOSE
+!! -------
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 23/01/16 (J.-P. Pinty)
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+USE MODD_CST, ONLY : XP00, XMD, XMV, XRD, XCPD, XTT, XPI, XRHOLW, &
+ XALPW, XBETAW, XGAMW, XALPI, XBETAI, XGAMI
+USE MODD_NSV, ONLY : NSV_LIMA_CCN_FREE, NSV_LIMA_IFN_FREE
+USE MODD_PARAM_LIMA, ONLY : NMOD_CCN, NMOD_IFN, &
+ XR_MEAN_CCN, XLOGSIG_CCN, XRHO_CCN, &
+ XMDIAM_IFN, XSIGMA_IFN, XRHO_IFN, &
+ NSPECIE, XFRAC, &
+ CCCN_MODES, CIFN_SPECIES
+!
+IMPLICIT NONE
+!
+!* 0.1. Declaration of arguments
+! ------------------------
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute pressure
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Potential temperature
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water Vapor mix. ratio
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT ! Mixing ratios IN, conc. OUT
+!
+!* 0.2 Declaration of local variables
+! ------------------------------
+!
+REAL,DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: ZT ! Temperature
+REAL,DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: ZREHU ! Relat. Humid.
+REAL,DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: ZGROWTH_FACT
+REAL,DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: ZRHO_CCN_WET
+REAL,DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: ZWORK
+!
+INTEGER :: JLOC, JCCN, JIFN, JSPECIE
+REAL :: ZFACT_CCN, ZFACT_IFN
+!
+!----------------------------------------------------------------------
+!
+! Temperature to compute the relative humidity
+!
+ZT(:,:,:) = PTHT(:,:,:)*(PPABST(:,:,:)/XP00)**(XRD/XCPD)
+ZWORK(:,:,:) = PRVT(:,:,:)*PPABST(:,:,:)/((XMV/XMD)+PRVT(:,:,:))
+ ! water vapor partial pressure
+ZREHU(:,:,:) = ZWORK(:,:,:)/EXP( XALPW-XBETAW/ZT(:,:,:)-XGAMW*ALOG(ZT(:,:,:)) )
+ ! saturation over water
+WHERE ( ZT(:,:,:)<XTT )
+ ZREHU(:,:,:) = ZWORK(:,:,:)/EXP(XALPI-XBETAI/ZT(:,:,:)-XGAMI*ALOG(ZT(:,:,:)))
+ ! saturation over ice
+END WHERE
+ZREHU(:,:,:) = MIN( 0.99, MAX( 0.01,ZREHU(:,:,:) ) )
+!
+! All size distribution parameters are XLOGSIG_CCN and XR_MEAN_CCN (radii)
+! Treatment of the soluble aerosols (CCN)
+!
+! All CAMS aerosol mr are given for dry particles, except for sea-salt (given at Hu=80%)
+!
+!
+
+!IF( NAERO_TYPE=="CCN" ) THEN
+!
+! sea-salt, sulfate, hydrophilic (GADS data)
+!
+! NMOD_CCN=3
+ IF (.NOT.(ALLOCATED(XR_MEAN_CCN))) ALLOCATE(XR_MEAN_CCN(NMOD_CCN))
+ IF (.NOT.(ALLOCATED(XLOGSIG_CCN))) ALLOCATE(XLOGSIG_CCN(NMOD_CCN))
+ IF (.NOT.(ALLOCATED(XRHO_CCN))) ALLOCATE(XRHO_CCN(NMOD_CCN))
+ IF( CCCN_MODES=='CAMS_ACC') THEN
+ XR_MEAN_CCN(:) = (/ 0.2E-6 , 0.5E-6 , 0.4E-6 /)
+ XLOGSIG_CCN(:) = (/ 0.693 , 0.476 , 0.788 /)
+ XRHO_CCN(:) = (/ 2200. , 1700. , 1800. /)
+ END IF
+!
+ IF( CCCN_MODES=='CAMS_AIT') THEN
+ XR_MEAN_CCN(:) = (/ 0.2E-6 , 0.05E-6 , 0.02E-6 /)
+ XLOGSIG_CCN(:) = (/ 0.693 , 0.693 , 0.788 /)
+ XRHO_CCN(:) = (/ 2200. , 1700. , 1800. /)
+ END IF
+!
+DO JCCN = 1,NMOD_CCN
+!
+ JLOC = NSV_LIMA_CCN_FREE + JCCN-1 ! CCN free then CCN acti
+!
+ ZFACT_CCN = ( (0.75/XPI)*EXP(-4.5*(XLOGSIG_CCN(JCCN))**2) )/XR_MEAN_CCN(JCCN)**3
+!
+! JCCN=1 is for Sea Salt
+! JCCN=2 is for Sulphate
+! JCCN=3 is for Hydrophilic OC and BC (sulphate coating)
+!
+ IF( JCCN==1 ) THEN ! Sea salt : convert mass at Hu=80% to dry mass
+ PSVT(:,:,:,JLOC) = PSVT(:,:,:,JLOC) / 4.302
+ END IF
+!
+! compute the CCN number concentration
+!
+! Pourquoi 0.5* ?
+! PSVT(:,:,:,JLOC) =0.5* ZFACT_CCN*(PSVT(:,:,:,JLOC)/XRHO_CCN(JCCN)) ! Result
+ PSVT(:,:,:,JLOC) = ZFACT_CCN*(PSVT(:,:,:,JLOC)/XRHO_CCN(JCCN)) ! Result
+ ! is in #/Kg of dry air
+END DO
+!
+! All size distribution parameters are XSIGMA_IFN and XMDIAM_IFN (diameters)
+! Treatment of the insoluble aerosols (IFN)
+!
+!ELSE IF( NAERO_TYPE=="IFN" ) THEN
+!
+! dust, hydrophobic BIO+ORGA (GADS data)
+!
+! NMOD_IFN=2
+ NSPECIE=4
+ IF (.NOT.(ALLOCATED(XMDIAM_IFN))) ALLOCATE(XMDIAM_IFN(NSPECIE))
+ IF (.NOT.(ALLOCATED(XSIGMA_IFN))) ALLOCATE(XSIGMA_IFN(NSPECIE))
+ IF (.NOT.(ALLOCATED(XRHO_IFN))) ALLOCATE(XRHO_IFN(NSPECIE))
+ IF( CIFN_SPECIES=='CAMS_ACC') THEN
+ XMDIAM_IFN = (/0.8E-6, 3.0E-6, 0.04E-6, 0.8E-6 /)
+ XSIGMA_IFN = (/2.0, 2.15, 2.0, 2.2 /)
+ XRHO_IFN = (/2600., 2600., 1000., 2000. /)
+ END IF
+ IF( CIFN_SPECIES=='CAMS_AIT') THEN
+ XMDIAM_IFN = (/0.8E-6, 3.0E-6, 0.04E-6, 0.04E-6/)
+ XSIGMA_IFN = (/2.0, 2.15, 2.0, 2.2 /)
+ XRHO_IFN = (/2600., 2600., 1000., 1800./)
+ END IF
+ IF (.NOT.(ALLOCATED(XFRAC))) ALLOCATE(XFRAC(NSPECIE,NMOD_IFN))
+ XFRAC(1,1)=1.0
+ XFRAC(2,1)=0.0
+ XFRAC(3,1)=0.0
+ XFRAC(4,1)=0.0
+ XFRAC(1,2)=0.0
+ XFRAC(2,2)=0.0
+ XFRAC(3,2)=0.0
+ XFRAC(4,2)=1.0
+!
+DO JIFN = 1,NMOD_IFN
+!
+! compute the number concentration assuming no deposition of water
+! IFN are considered as insoluble dry aerosols
+!
+ ZFACT_IFN = 0.0
+ DO JSPECIE = 1,NSPECIE ! Conversion factor is weighted by XFRAC
+ ZFACT_IFN = ZFACT_IFN + XFRAC(JSPECIE,JIFN)* &
+ ( (6/XPI)*EXP(-(9.0/2.0)*LOG(XSIGMA_IFN(JSPECIE))**2) ) / &
+ ( XRHO_IFN(JSPECIE)*XMDIAM_IFN(JSPECIE)**3 )
+ END DO
+ JLOC = NSV_LIMA_IFN_FREE + JIFN-1 ! IFN free then IFN nucl
+! Pourquoi 0.5* ?
+! PSVT(:,:,:,JLOC) = 0.5* ZFACT_IFN*PSVT(:,:,:,JLOC) ! Result is in #/Kg of dry air
+ PSVT(:,:,:,JLOC) = ZFACT_IFN*PSVT(:,:,:,JLOC) ! Result is in #/Kg of dry air
+END DO
+!
+END SUBROUTINE LIMA_MIXRAT_TO_NCONC
diff --git a/src/mesonh/micro/lima_notadjust.f90 b/src/mesonh/micro/lima_notadjust.f90
new file mode 100644
index 000000000..94ea1f4fd
--- /dev/null
+++ b/src/mesonh/micro/lima_notadjust.f90
@@ -0,0 +1,624 @@
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ##########################
+ MODULE MODI_LIMA_NOTADJUST
+! ##########################
+!
+INTERFACE
+!
+ SUBROUTINE LIMA_NOTADJUST(KMI, TPFILE, HRAD, &
+ PTSTEP, PRHODJ, PPABSM, PPABST, PRHODREF, PEXNREF, PZZ, &
+ PTHT,PRT, PSVT, PTHS, PRS,PSVS, PCLDFR, PSRCS )
+!
+USE MODD_IO, ONLY: TFILEDATA
+!
+INTEGER, INTENT(IN) :: KMI ! Model index
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+CHARACTER(len=4), INTENT(IN) :: HRAD ! Radiation scheme name
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
+ ! (single if cold start)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Absolute Pressure at t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute Pressure at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Reference density
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! m.r. at t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Concentrations source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! m.r. source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Concentrations source
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux
+ ! s'rc'/2Sigma_s2 at time t+1
+ ! multiplied by Lambda_3
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PCLDFR ! Cloud fraction
+!
+!
+END SUBROUTINE LIMA_NOTADJUST
+!
+END INTERFACE
+!
+END MODULE MODI_LIMA_NOTADJUST
+!
+! ####################################################################################
+ SUBROUTINE LIMA_NOTADJUST(KMI, TPFILE, HRAD, &
+ PTSTEP, PRHODJ, PPABSM, PPABST, PRHODREF, PEXNREF, PZZ, &
+ PTHT,PRT, PSVT, PTHS, PRS,PSVS, PCLDFR, PSRCS )
+! ####################################################################################
+!
+!!**** * - compute pseudo-prognostic of supersaturation according to Thouron
+! et al. 2012
+!! PURPOSE
+!! -------
+!!
+!!** METHOD
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Thouron, O., J.-L. Brenguier, and F. Burnet, Supersaturation calculation
+!! in large eddy simulation models for prediction of the droplet number
+!! concentration, Geosci. Model Dev., 5, 761-772, 2012.
+!!
+!! AUTHOR
+!! ------
+!! B.Vie forked from lima_adjust.f90
+!!
+!! MODIFICATIONS
+!! -------------
+!
+!* 0. DECLARATIONS
+!
+use modd_budget, only: lbu_enable, nbumod, &
+ lbudget_th, lbudget_rv, lbudget_rc, lbudget_ri, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RI, NBUDGET_SV1, &
+ tbudgets
+USE MODD_CONF
+USE MODD_CST
+USE MODD_FIELD, ONLY: TFIELDDATA,TYPEREAL
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_NSV
+USE MODD_PARAMETERS
+USE MODD_PARAM_LIMA
+USE MODD_PARAM_LIMA_COLD
+
+!
+use mode_budget, only: Budget_store_init, Budget_store_end
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+USE MODE_MSG
+use mode_tools, only: Countjv
+use mode_tools_ll, only: GET_INDICE_ll
+!
+USE MODI_PROGNOS_LIMA
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+!
+INTEGER, INTENT(IN) :: KMI ! Model index
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+CHARACTER(len=4), INTENT(IN) :: HRAD ! Radiation scheme name
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
+ ! (single if cold start)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Absolute Pressure at t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute Pressure at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Reference density
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! m.r. at t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Concentrations source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! m.r. source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Concentrations source
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux
+ ! s'rc'/2Sigma_s2 at time t+1
+ ! multiplied by Lambda_3
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PCLDFR ! Cloud fraction
+!
+!
+!* 0.2 Declarations of local variables :
+!
+!
+!
+INTEGER :: IRESP ! Return code of FM routines
+INTEGER :: ILUOUT ! Logical unit of output listing
+
+! For Activation :
+LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: GNUCT, GMICRO ! Test where to compute the HEN process
+INTEGER , DIMENSION(SIZE(GNUCT)) :: I1,I2,I3 ! Used to replace the COUNT
+INTEGER :: JL, JMOD ! and PACK intrinsics
+REAL, DIMENSION(:), ALLOCATABLE ::ZPRES,ZRHOD,ZRR,ZTT,ZRV,ZRC,ZS0,ZCCL, &
+ ZZDZ, ZZLV, ZZCPH, &
+ ZRVT, ZRIT, ZCIT, ZRVS, ZRIS, ZCIS, &
+ ZTHS, ZRHODREF, ZZT, ZEXNREF, ZZW, &
+ ZLSFACT, ZRVSATI, ZRVSATI_PRIME, &
+ ZDELTI, ZAI, ZKA, ZDV, ZITI, ZAII, ZDEP, &
+ ZCJ
+!
+INTEGER :: INUCT
+INTEGER :: IMICRO
+INTEGER :: IIB ! Define the domain where
+INTEGER :: IIE ! the microphysical sources have to be computed
+INTEGER :: IJB !
+INTEGER :: IJE !
+INTEGER :: IKB !
+INTEGER :: IKE !
+
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) ::&
+ ZEXNT,ZEXNS,ZT,ZRVSAT,ZWORK,ZLV,ZLS,ZCPH, ZW1, &
+ ZDZ, ZW
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) ::&
+ ZSAT,ZCCS
+INTEGER :: JK ! For loop
+integer :: idx
+TYPE(TFIELDDATA) :: TZFIELD
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZNFS ! CCN C. available source
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZNAS ! Cloud C. nuclei C. source
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZZNFS ! CCN C. available source
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZZNAS ! Cloud C. nuclei C. source
+REAL :: ZEPS
+
+!-------------------------------------------------------------------------------
+!
+!* 1. PRELIMINARIES
+! -------------
+!
+ILUOUT = TLUOUT%NLU
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+IKB=1+JPVEXT
+IKE=SIZE(PZZ,3) - JPVEXT
+!
+!-------------------------------------------------------------------------------
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'CEDS', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'CEDS', prs(:, :, :, 1) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'CEDS', prs(:, :, :, 2) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'CEDS', prs(:, :, :, 4) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ if ( lwarm ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'CEDS', psvs(:, :, :, nsv_lima_nc) * prhodj(:, :, :) )
+ do jl = nsv_lima_ccn_free, nsv_lima_ccn_free + nmod_ccn - 1
+ idx = NBUDGET_SV1 - 1 + jl
+ call Budget_store_init( tbudgets(idx), 'CEDS', psvs(:, :, :, jl) * prhodj(:, :, :) )
+ end do
+ do jl = nsv_lima_ccn_acti, nsv_lima_ccn_acti + nmod_ccn - 1
+ idx = NBUDGET_SV1 - 1 + jl
+ call Budget_store_init( tbudgets(idx), 'CEDS', psvs(:, :, :, jl) * prhodj(:, :, :) )
+ end do
+ end if
+! if ( lscav .and. laero_mass ) &
+! call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_scavmass), 'CEDS', psvs(:, :, :, nsv_lima_scavmass) &
+! * prhodj(:, :, :) )
+! if ( lcold ) then
+! call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CEDS', psvs(:, :, :, nsv_lima_ni) * prhodj(:, :, :) )
+! do jl = 1, nsv_lima_ifn_free, nsv_lima_ifn_free + nmod_ifn - 1
+! idx = NBUDGET_SV1 - 1 + jl
+! call Budget_store_init( tbudgets(idx), 'CEDS', psvs(:, :, :, jl) * prhodj(:, :, :) )
+! end do
+! do jl = 1, nsv_lima_ifn_nucl, nsv_lima_ifn_nucl + nmod_ifn - 1
+! idx = NBUDGET_SV1 - 1 + jl
+! call Budget_store_init( tbudgets(idx), 'CEDS', psvs(:, :, :, jl) * prhodj(:, :, :) )
+! end do
+! do jl = 1, nsv_lima_imm_nucl, nsv_lima_imm_nucl + nmod_ifn - 1
+! idx = NBUDGET_SV1 - 1 + jl
+! call Budget_store_init( tbudgets(idx), 'CEDS', psvs(:, :, :, jl) * prhodj(:, :, :) )
+! end do
+! end if
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_spro), 'CEDS', psvs(:, :, :, nsv_lima_spro) * prhodj(:, :, :) )
+ end if
+end if
+!
+!* 2. COMPUTE QUANTITIES WITH THE GUESS OF THE FUTURE INSTANT
+! -------------------------------------------------------
+!
+!* 2.1 remove negative non-precipitating negative water
+! ------------------------------------------------
+!
+IF (ANY(PRS(:,:,:,2) < 0. .OR. PSVS(:,:,:,NSV_LIMA_NC) < 0.)) THEN
+ WRITE(ILUOUT,*) 'LIMA_NOTADJUST beginning: negative values of PRCS or PCCS'
+ WRITE(ILUOUT,*) ' location of minimum of PRCS:', MINLOC(PRS(:,:,:,2))
+ WRITE(ILUOUT,*) ' value of minimum :', MINVAL(PRS(:,:,:,2))
+ WRITE(ILUOUT,*) ' location of minimum of PCCS:', MINLOC(PSVS(:,:,:,NSV_LIMA_NC))
+ WRITE(ILUOUT,*) ' value of minimum :', MINVAL(PSVS(:,:,:,NSV_LIMA_NC))
+END IF
+!
+IF (ANY(PRS(:,:,:,2)+PRS(:,:,:,1) < 0.) .AND. NVERB>5) THEN
+ WRITE(ILUOUT,*) 'LIMA_NOT_ADJUST: negative values of total water (reset to zero)'
+ WRITE(ILUOUT,*) ' location of minimum:', MINLOC(PRS(:,:,:,2)+PRS(:,:,:,1))
+ WRITE(ILUOUT,*) ' value of minimum :', MINVAL(PRS(:,:,:,2)+PRS(:,:,:,1))
+!callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','LIMA_NOTADJUST','')
+END IF
+!
+!
+!* 2.2 estimate the Exner function at t+1 and t respectively
+!
+ZEXNS(:,:,:)=((2.* PPABST(:,:,:)-PPABSM(:,:,:))/XP00 )**(XRD/XCPD)
+ZEXNT(:,:,:)=(PPABST(:,:,:)/XP00 )**(XRD/XCPD)
+!sources terms *dt
+PRS(:,:,:,:) = PRS(:,:,:,:) * PTSTEP
+PSVS(:,:,:,:) = PSVS(:,:,:,:) * PTSTEP
+ZSAT(:,:,:) = PSVS(:,:,:,NSV_LIMA_SPRO)-1.0
+ZCCS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NC)
+IF ( NMOD_CCN .GE. 1 ) THEN
+ ALLOCATE( ZNFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_CCN) )
+ ALLOCATE( ZNAS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_CCN) )
+ ZNFS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1)
+ ZNAS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1)
+ELSE
+ ALLOCATE( ZNFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),1) )
+ ALLOCATE( ZNAS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),1) )
+ ZNFS(:,:,:,:) = 0.
+ ZNAS(:,:,:,:) = 0.
+END IF
+ZW(:,:,:)=SUM(ZNAS,4)
+!
+!state temperature at t+dt
+PTHS(:,:,:) = PTHS(:,:,:) * PTSTEP * ZEXNS(:,:,:)
+
+!state temperature at t
+ZT(:,:,:)=PTHT(:,:,:)*ZEXNT(:,:,:)
+!Lv and Cph at t
+ZLV(:,:,:) = XLVTT+(XCPV-XCL)*(ZT(:,:,:)-XTT)
+ZLS(:,:,:) = XLSTT + ( XCPV - XCI ) * ( ZT(:,:,:) -XTT )
+ZCPH(:,:,:)= XCPD+XCPV*PRT(:,:,:,1)+XCL*(PRT(:,:,:,2)+PRT(:,:,:,3)) &
+ +XCI*(PRT(:,:,:,4)+PRT(:,:,:,5)+PRT(:,:,:,6))
+!dz
+DO JK=1,IKE
+ ZDZ(:,:,JK)=PZZ(:,:,JK+1)-PZZ(:,:,JK)
+END DO
+!
+!* 2.3 compute the latent heat of vaporization Lv(T*) at t+1
+!
+!Removed negligible values
+!
+WHERE ( ((PRS(:,:,:,2).LT.XRTMIN(2)) .AND. (ZSAT(:,:,:).LT.0.0)) .OR. &
+ ((PRS(:,:,:,2).GT.0.0) .AND. (ZCCS(:,:,:).LE.0.0)) )
+ PTHS(:,:,:) = PTHS(:,:,:)-(ZLV(:,:,:)/ZCPH(:,:,:))*PRS(:,:,:,2)
+ PRS(:,:,:,1) = PRS(:,:,:,1)+PRS(:,:,:,2)
+ PRS(:,:,:,2) = 0.0
+!ZSAT(:,:,:) = 0.0
+ ZCCS(:,:,:) = 0.0
+!ZNFS(:,:,:,1:NMOD_CCN) = ZNFS(:,:,:,1:NMOD_CCN) + ZNAS(:,:,:,1:NMOD_CCN)
+!ZNAS(:,:,:,1:NMOD_CCN) = 0.
+END WHERE
+!
+
+
+!
+! Ice deposition/sublimation
+!
+ZEPS= XMV / XMD
+GMICRO(:,:,:)=.FALSE.
+GMICRO(IIB:IIE,IJB:IJE,IKB:IKE) = (PRS(IIB:IIE,IJB:IJE,IKB:IKE,4)>XRTMIN(4)/PTSTEP .AND. &
+ PSVS(IIB:IIE,IJB:IJE,IKB:IKE,NSV_LIMA_NI)>XCTMIN(4)/PTSTEP )
+IMICRO = COUNTJV( GMICRO(:,:,:),I1(:),I2(:),I3(:))
+IF( IMICRO >= 1 .AND. .NOT.LPTSPLIT) THEN
+ ALLOCATE(ZRVT(IMICRO))
+ ALLOCATE(ZRIT(IMICRO))
+ ALLOCATE(ZCIT(IMICRO))
+!
+ ALLOCATE(ZRVS(IMICRO))
+ ALLOCATE(ZRIS(IMICRO))
+ ALLOCATE(ZCIS(IMICRO)) !!!BVIE!!!
+ ALLOCATE(ZTHS(IMICRO))
+!
+ ALLOCATE(ZRHODREF(IMICRO))
+ ALLOCATE(ZZT(IMICRO))
+ ALLOCATE(ZPRES(IMICRO))
+ ALLOCATE(ZEXNREF(IMICRO))
+ ALLOCATE(ZZCPH(IMICRO))
+ DO JL=1,IMICRO
+ ZRVT(JL) = PRT(I1(JL),I2(JL),I3(JL),1)
+ ZRIT(JL) = PRT(I1(JL),I2(JL),I3(JL),4)
+ ZCIT(JL) = PSVT(I1(JL),I2(JL),I3(JL),NSV_LIMA_NI)
+!
+ ZRVS(JL) = PRS(I1(JL),I2(JL),I3(JL),1)
+ ZRIS(JL) = PRS(I1(JL),I2(JL),I3(JL),4)
+ ZCIS(JL) = PSVS(I1(JL),I2(JL),I3(JL),NSV_LIMA_NI) !!!BVIE!!!
+ ZTHS(JL) = PTHS(I1(JL),I2(JL),I3(JL))
+!
+ ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
+ ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
+ ZPRES(JL) = 2.0*PPABST(I1(JL),I2(JL),I3(JL))-PPABSM(I1(JL),I2(JL),I3(JL))
+ ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL))
+ ZZCPH(JL) = ZCPH(I1(JL),I2(JL),I3(JL))
+ ENDDO
+ ALLOCATE(ZZW(IMICRO))
+ ALLOCATE(ZLSFACT(IMICRO))
+ ZLSFACT(:) = (XLSTT+(XCPV-XCI)*(ZZT(:)-XTT))/ZZCPH(:) ! L_s/C_ph
+ ALLOCATE(ZRVSATI(IMICRO))
+ ALLOCATE(ZRVSATI_PRIME(IMICRO))
+ ALLOCATE(ZDELTI(IMICRO))
+ ALLOCATE(ZAI(IMICRO))
+ ALLOCATE(ZCJ(IMICRO))
+ ALLOCATE(ZKA(IMICRO))
+ ALLOCATE(ZDV(IMICRO))
+ ALLOCATE(ZITI(IMICRO))
+!
+ ZKA(:) = 2.38E-2 + 0.0071E-2 * ( ZZT(:) - XTT ) ! k_a
+ ZDV(:) = 0.211E-4 * (ZZT(:)/XTT)**1.94 * (XP00/ZPRES(:)) ! D_v
+ ZCJ(:) = XSCFAC * ZRHODREF(:)**0.3 / SQRT( 1.718E-5+0.0049E-5*(ZZT(:)-XTT) )
+!
+ ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) ) ! es_i
+ ZRVSATI(:) = ZEPS*ZZW(:) / ( ZPRES(:)-ZZW(:) ) ! r_si
+ ZRVSATI_PRIME(:) = (( XBETAI/ZZT(:) - XGAMI ) / ZZT(:)) & ! r'_si
+ * ZRVSATI(:) * ( 1. + ZRVSATI(:)/ZEPS )
+!
+ ZDELTI(:) = ZRVS(:)*PTSTEP - ZRVSATI(:)
+ ZAI(:) = ( XLSTT + (XCPV-XCI)*(ZZT(:)-XTT) )**2 / (ZKA(:)*XRV*ZZT(:)**2) &
+ + ( XRV*ZZT(:) ) / (ZDV(:)*ZZW(:))
+ ZZW(:) = MIN(1.E8,( XLBI* MAX(ZCIT(:),XCTMIN(4)) &
+ /(MAX(ZRIT(:),XRTMIN(4))) )**XLBEXI)
+ ! Lbda_I
+ ZITI(:) = ZCIT(:) * (X0DEPI/ZZW(:) + X2DEPI*ZCJ(:)*ZCJ(:)/ZZW(:)**(XDI+2.0)) &
+ / (ZRVSATI(:)*ZAI(:))
+!
+ ALLOCATE(ZAII(IMICRO))
+ ALLOCATE(ZDEP(IMICRO))
+!
+ ZAII(:) = 1.0 + ZRVSATI_PRIME(:)*ZLSFACT(:)
+ ZDEP(:) = 0.0
+!
+ ZZW(:) = ZAII(:)*ZITI(:)*PTSTEP ! R*delta_T
+ WHERE( ZZW(:)<1.0E-2 )
+ ZDEP(:) = ZITI(:)*ZDELTI(:)*(1.0 - (ZZW(:)/2.0)*(1.0-ZZW(:)/3.0))
+ ELSEWHERE
+ ZDEP(:) = ZITI(:)*ZDELTI(:)*(1.0 - EXP(-ZZW(:)))/ZZW(:)
+ END WHERE
+!
+! Integration
+!
+ WHERE( ZDEP(:) < 0.0 )
+ ZDEP(:) = MAX ( ZDEP(:), -ZRIS(:) )
+ ELSEWHERE
+ ZDEP(:) = MIN ( ZDEP(:), ZRVS(:) )
+! ZDEP(:) = MIN ( ZDEP(:), ZCIS(:)*5.E-10 ) !!!BVIE!!!
+ END WHERE
+ WHERE( ZRIS(:) < XRTMIN(4)/PTSTEP )
+ ZDEP(:) = 0.0
+ END WHERE
+ ZRVS(:) = ZRVS(:) - ZDEP(:)
+ ZRIS(:) = ZRIS(:) + ZDEP(:)
+ ZTHS(:) = ZTHS(:) + ZDEP(:) * ZLSFACT(:) / ZEXNREF(:)
+!
+! Implicit ice crystal sublimation if ice saturated conditions are not met
+!
+ ZZT(:) = ( ZTHS(:) * PTSTEP ) * ( ZPRES(:) / XP00 ) ** (XRD/XCPD)
+ ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) ) ! es_i
+ ZRVSATI(:) = ZEPS*ZZW(:) / ( ZPRES(:)-ZZW(:) ) ! r_si
+ WHERE( ZRVS(:)*PTSTEP<ZRVSATI(:) )
+ ZZW(:) = ZRVS(:) + ZRIS(:)
+ ZRVS(:) = MIN( ZZW(:),ZRVSATI(:)/PTSTEP )
+ ZTHS(:) = ZTHS(:) + ( MAX( 0.0,ZZW(:)-ZRVS(:) )-ZRIS(:) ) &
+ * ZLSFACT(:) / ZEXNREF(:)
+ ZRIS(:) = MAX( 0.0,ZZW(:)-ZRVS(:) )
+ END WHERE
+!
+!
+ ZW(:,:,:) = PRS(:,:,:,1)
+ PRS(:,:,:,1) = UNPACK( ZRVS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PRS(:,:,:,4)
+ PRS(:,:,:,4) = UNPACK( ZRIS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PTHS(:,:,:)
+ PTHS(:,:,:) = UNPACK( ZTHS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+!
+ DEALLOCATE(ZRVT)
+ DEALLOCATE(ZRIT)
+ DEALLOCATE(ZCIT)
+ DEALLOCATE(ZRVS)
+ DEALLOCATE(ZRIS)
+ DEALLOCATE(ZCIS) !!!BVIE!!!
+ DEALLOCATE(ZTHS)
+ DEALLOCATE(ZRHODREF)
+ DEALLOCATE(ZZT)
+ DEALLOCATE(ZPRES)
+ DEALLOCATE(ZEXNREF)
+ DEALLOCATE(ZZCPH)
+ DEALLOCATE(ZZW)
+ DEALLOCATE(ZLSFACT)
+ DEALLOCATE(ZRVSATI)
+ DEALLOCATE(ZRVSATI_PRIME)
+ DEALLOCATE(ZDELTI)
+ DEALLOCATE(ZAI)
+ DEALLOCATE(ZCJ)
+ DEALLOCATE(ZKA)
+ DEALLOCATE(ZDV)
+ DEALLOCATE(ZITI)
+ DEALLOCATE(ZAII)
+ DEALLOCATE(ZDEP)
+END IF ! IMICRO
+!
+!selection of mesh where condensation/evaportion/activation is performed
+GNUCT(:,:,:) = .FALSE.
+!GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) = ZSAT(IIB:IIE,IJB:IJE,IKB:IKE)>0.0 .OR. &
+! ZCCS(IIB:IIE,IJB:IJE,IKB:IKE)>0.0
+!GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) = ZSAT(IIB:IIE,IJB:IJE,IKB:IKE)>0.0
+GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) = ZSAT(IIB:IIE,IJB:IJE,IKB:IKE)>0.0 .OR. &
+! ZCCS(IIB:IIE,IJB:IJE,IKB:IKE)>1.E+05
+ ZCCS(IIB:IIE,IJB:IJE,IKB:IKE)>XCTMIN(2)
+INUCT = COUNTJV( GNUCT(:,:,:),I1(:),I2(:),I3(:))
+!3D array to 1D array
+!
+IF( INUCT >= 1 ) THEN
+ ALLOCATE(ZZNFS(INUCT,NMOD_CCN))
+ ALLOCATE(ZZNAS(INUCT,NMOD_CCN))
+ ALLOCATE(ZPRES(INUCT))
+ ALLOCATE(ZRHOD(INUCT))
+ ALLOCATE(ZRR(INUCT))
+ ALLOCATE(ZTT(INUCT))
+ ALLOCATE(ZRV(INUCT))
+ ALLOCATE(ZRC(INUCT))
+ ALLOCATE(ZS0(INUCT))
+ ALLOCATE(ZCCL(INUCT))
+ ALLOCATE(ZZDZ(INUCT))
+ ALLOCATE(ZZLV(INUCT))
+ ALLOCATE(ZZCPH(INUCT))
+ DO JL=1,INUCT
+ ZPRES(JL) = 2. * PPABST(I1(JL),I2(JL),I3(JL)) - PPABSM(I1(JL),I2(JL),I3(JL))
+ ZRHOD(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
+ ZRR(JL) = PRS(I1(JL),I2(JL),I3(JL),3)
+ ZTT(JL) = PTHS(I1(JL),I2(JL),I3(JL))
+ ZRV(JL) = PRS(I1(JL),I2(JL),I3(JL),1)
+ ZRC(JL) = PRS(I1(JL),I2(JL),I3(JL),2)
+ ZS0(JL) = ZSAT(I1(JL),I2(JL),I3(JL))
+ DO JMOD = 1,NMOD_CCN
+ ZZNFS(JL,JMOD) = ZNFS(I1(JL),I2(JL),I3(JL),JMOD)
+ ZZNAS(JL,JMOD) = ZNAS(I1(JL),I2(JL),I3(JL),JMOD)
+ ENDDO
+ ZCCL(JL) = ZCCS(I1(JL),I2(JL),I3(JL))
+ ZZDZ(JL)=ZDZ(I1(JL),I2(JL),I3(JL))
+ ZZLV(JL)=ZLV(I1(JL),I2(JL),I3(JL))
+ ZZCPH(JL)=ZCPH(I1(JL),I2(JL),I3(JL))
+ ENDDO
+ !
+ !Evaporation/Condensation/activation
+ CALL PROGNOS_LIMA(PTSTEP,ZZDZ,ZZLV,ZZCPH,ZPRES,ZRHOD, &
+ ZRR,ZTT,ZRV,ZRC,ZS0,ZZNAS,ZCCL,ZZNFS)
+ !
+!1D array to 3D array
+ DO JMOD = 1, NMOD_CCN
+ ZWORK(:,:,:) = ZNAS(:,:,:,JMOD)
+ ZNAS(:,:,:,JMOD) = UNPACK( ZZNAS(:,JMOD) ,MASK=GNUCT(:,:,:),FIELD=ZWORK(:,:,:) )
+ ZWORK(:,:,:) = ZNFS(:,:,:,JMOD)
+ ZNFS(:,:,:,JMOD) = UNPACK( ZZNFS(:,JMOD) ,MASK=GNUCT(:,:,:),FIELD=ZWORK(:,:,:) )
+ END DO
+ PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1) = ZNFS(:,:,:,:)
+ PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1) = ZNAS(:,:,:,:)
+ !
+ ZWORK(:,:,:) = ZCCS(:,:,:)
+ ZCCS(:,:,:) = UNPACK( ZCCL(:),MASK=GNUCT(:,:,:),FIELD=ZWORK(:,:,:) )
+ PSVS(:,:,:,NSV_LIMA_NC) = ZCCS(:,:,:)
+ !
+ ZWORK(:,:,:) = PTHS(:,:,:)
+ PTHS(:,:,:) = UNPACK( ZTT(:),MASK=GNUCT(:,:,:),FIELD=ZWORK(:,:,:) )
+ ZWORK(:,:,:) = PRS(:,:,:,1)
+ PRS(:,:,:,1) = UNPACK( ZRV(:),MASK=GNUCT(:,:,:),FIELD=ZWORK(:,:,:) )
+ ZWORK(:,:,:) = PRS(:,:,:,2)
+ PRS(:,:,:,2) = UNPACK( ZRC(:),MASK=GNUCT(:,:,:),FIELD=ZWORK(:,:,:) )
+ ZWORK(:,:,:) = ZSAT(:,:,:)
+ ZSAT(:,:,:) = UNPACK( ZS0(:),MASK=GNUCT(:,:,:),FIELD=ZWORK(:,:,:) )
+ !
+ DEALLOCATE(ZPRES)
+ DEALLOCATE(ZRHOD)
+ DEALLOCATE(ZRR)
+ DEALLOCATE(ZTT)
+ DEALLOCATE(ZRV)
+ DEALLOCATE(ZRC)
+ DEALLOCATE(ZS0)
+ DEALLOCATE(ZZNFS)
+ DEALLOCATE(ZZNAS)
+ DEALLOCATE(ZCCL)
+ DEALLOCATE(ZZDZ)
+!
+ENDIF
+!
+!Computation of saturation in the meshes where there is no
+!condensation/evaporation/activation
+WHERE(.NOT.GNUCT(:,:,:) )
+ ZRVSAT(:,:,:) = EXP(XALPW-XBETAW/PTHS(:,:,:)-XGAMW*ALOG(PTHS(:,:,:)))
+ !rvsat
+ ZRVSAT(:,:,:) = (XMV / XMD)*ZRVSAT(:,:,:)/((2.* PPABST(:,:,:)-PPABSM(:,:,:))-ZRVSAT(:,:,:))
+ ZSAT(:,:,:) = (PRS(:,:,:,1)/ZRVSAT(:,:,:))-1D0
+ENDWHERE
+!
+!source terms /dt
+PRS(:,:,:,:) = PRS(:,:,:,:)/PTSTEP
+PTHS(:,:,:) = PTHS(:,:,:)/PTSTEP/ZEXNS(:,:,:)
+ZSAT(:,:,:) = ZSAT(:,:,:)+1.0
+PSVS(:,:,:,NSV_LIMA_SPRO) = ZSAT(:,:,:)
+PSVS(:,:,:,:) = PSVS(:,:,:,:)/PTSTEP
+!
+IF (ANY(PRS(:,:,:,2)+PRS(:,:,:,1) < 0.) .AND. NVERB>5) THEN
+ WRITE(*,*) 'LIMA_NOTADJUST: negative values of total water (reset to zero)'
+ WRITE(*,*) ' location of minimum:', MINLOC(PRS(:,:,:,2)+PRS(:,:,:,1))
+ WRITE(*,*) ' value of minimum :', MINVAL(PRS(:,:,:,2)+PRS(:,:,:,1))
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','LIMA_NOTADJUST','')
+END IF
+!
+!* compute the cloud fraction PCLDFR
+!
+WHERE (PRS(:,:,:,2) > 0. )
+ ZW1(:,:,:) = 1.
+ELSEWHERE
+ ZW1(:,:,:) = 0.
+ENDWHERE
+IF ( SIZE(PSRCS,3) /= 0 ) THEN
+ PSRCS(:,:,:) = ZW1(:,:,:)
+END IF
+!
+IF ( HRAD /= 'NONE' ) THEN
+ PCLDFR(:,:,:) = ZW1(:,:,:)
+END IF
+!
+IF ( tpfile%lopened ) THEN
+ ZW(:,:,:)=SUM(ZNAS,4)-ZW(:,:,:)
+ TZFIELD%CMNHNAME = 'NACT'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'NACT'
+ TZFIELD%CUNITS = ''
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_NACT'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZW)
+END IF
+!
+!* 7. STORE THE BUDGET TERMS
+! ----------------------
+!
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'CEDS', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'CEDS', prs(:, :, :, 1) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'CEDS', prs(:, :, :, 2) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'CEDS', prs(:, :, :, 4) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ if ( lwarm ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'CEDS', psvs(:, :, :, nsv_lima_nc) * prhodj(:, :, :) )
+ do jl = nsv_lima_ccn_free, nsv_lima_ccn_free + nmod_ccn - 1
+ idx = NBUDGET_SV1 - 1 + jl
+ call Budget_store_end( tbudgets(idx), 'CEDS', psvs(:, :, :, jl) * prhodj(:, :, :) )
+ end do
+ do jl = nsv_lima_ccn_acti, nsv_lima_ccn_acti + nmod_ccn - 1
+ idx = NBUDGET_SV1 - 1 + jl
+ call Budget_store_end( tbudgets(idx), 'CEDS', psvs(:, :, :, jl) * prhodj(:, :, :) )
+ end do
+ end if
+! if ( lscav .and. laero_mass ) &
+! call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_scavmass), 'CEDS', psvs(:, :, :, nsv_lima_scavmass) &
+! * prhodj(:, :, :) )
+! if ( lcold ) then
+! call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CEDS', psvs(:, :, :, nsv_lima_ni) * prhodj(:, :, :) )
+! do jl = 1, nsv_lima_ifn_free, nsv_lima_ifn_free + nmod_ifn - 1
+! idx = NBUDGET_SV1 - 1 + jl
+! call Budget_store_end( tbudgets(idx), 'CEDS', psvs(:, :, :, jl) * prhodj(:, :, :) )
+! end do
+! do jl = 1, nsv_lima_ifn_nucl, nsv_lima_ifn_nucl + nmod_ifn - 1
+! idx = NBUDGET_SV1 - 1 + jl
+! call Budget_store_end( tbudgets(idx), 'CEDS', psvs(:, :, :, jl) * prhodj(:, :, :) )
+! end do
+! do jl = 1, nsv_lima_imm_nucl, nsv_lima_imm_nucl + nmod_ifn - 1
+! idx = NBUDGET_SV1 - 1 + jl
+! call Budget_store_end( tbudgets(idx), 'CEDS', psvs(:, :, :, jl) * prhodj(:, :, :) )
+! end do
+! end if
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_spro), 'CEDS', psvs(:, :, :, nsv_lima_spro) * prhodj(:, :, :) )
+ end if
+end if
+!
+END SUBROUTINE LIMA_NOTADJUST
diff --git a/src/mesonh/micro/lima_nucleation_procs.f90 b/src/mesonh/micro/lima_nucleation_procs.f90
new file mode 100644
index 000000000..122d4b3c8
--- /dev/null
+++ b/src/mesonh/micro/lima_nucleation_procs.f90
@@ -0,0 +1,334 @@
+!MNH_LIC Copyright 2018-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-------------------------------------------------------------------------------
+! ###############################
+ MODULE MODI_LIMA_NUCLEATION_PROCS
+! ###############################
+!
+INTERFACE
+ SUBROUTINE LIMA_NUCLEATION_PROCS (PTSTEP, TPFILE, PRHODJ, &
+ PRHODREF, PEXNREF, PPABST, PT, PDTHRAD, PW_NU,&
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PCCT, PCRT, PCIT, &
+ PNFT, PNAT, PIFT, PINT, PNIT, PNHT, &
+ PCLDFR, PICEFR, PPRCFR )
+!
+USE MODD_IO, ONLY: TFILEDATA
+!
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PT ! Temperature
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD ! Radiative temperature tendency
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHT ! Theta at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCT ! Cloud water conc. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRT ! Rain water conc. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Prinstine ice conc. at t
+!
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNFT ! CCN C. available at t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNAT ! CCN C. activated at t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PIFT ! IFN C. available at t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PINT ! IFN C. activated at t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNIT ! Coated IFN activated at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNHT ! CCN hom freezing
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR ! Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR ! Ice fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PPRCFR ! Precipitation fraction
+!
+END SUBROUTINE LIMA_NUCLEATION_PROCS
+END INTERFACE
+END MODULE MODI_LIMA_NUCLEATION_PROCS
+! #############################################################################
+SUBROUTINE LIMA_NUCLEATION_PROCS (PTSTEP, TPFILE, PRHODJ, &
+ PRHODREF, PEXNREF, PPABST, PT, PDTHRAD, PW_NU,&
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PCCT, PCRT, PCIT, &
+ PNFT, PNAT, PIFT, PINT, PNIT, PNHT, &
+ PCLDFR, PICEFR, PPRCFR )
+! #############################################################################
+!
+!! PURPOSE
+!! -------
+!! Compute nucleation processes for the time-split version of LIMA
+!!
+!! AUTHOR
+!! ------
+!! B. Vié * CNRM *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 15/03/2018
+! M. Leriche 06/2019: missing update of PNFT after CCN hom. ncl.
+! P. Wautelet 27/02/2020: bugfix: PNFT was not updated after LIMA_CCN_HOM_FREEZING
+! P. Wautelet 27/02/2020: add Z_TH_HINC variable (for budgets)
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
+! B. Vie 03/03/2020: use DTHRAD instead of dT/dt in Smax diagnostic computation
+!-------------------------------------------------------------------------------
+!
+use modd_budget, only: lbu_enable, lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, &
+ lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RI, NBUDGET_SV1, &
+ tbudgets
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_NSV, ONLY : NSV_LIMA_NC, NSV_LIMA_NR, NSV_LIMA_CCN_FREE, NSV_LIMA_CCN_ACTI, &
+ NSV_LIMA_NI, NSV_LIMA_IFN_FREE, NSV_LIMA_IFN_NUCL, NSV_LIMA_IMM_NUCL, NSV_LIMA_HOM_HAZE
+USE MODD_PARAM_LIMA, ONLY : LCOLD, LNUCL, LMEYERS, LSNOW, LWARM, LACTI, LRAIN, LHHONI, &
+ NMOD_CCN, NMOD_IFN, NMOD_IMM, XCTMIN, XRTMIN, LSPRO
+USE MODD_TURB_n, ONLY : LSUBG_COND
+
+use mode_budget, only: Budget_store_add, Budget_store_init, Budget_store_end
+
+USE MODI_LIMA_CCN_ACTIVATION
+USE MODI_LIMA_CCN_HOM_FREEZING
+USE MODI_LIMA_MEYERS_NUCLEATION
+USE MODI_LIMA_PHILLIPS_IFN_NUCLEATION
+!
+!-------------------------------------------------------------------------------
+!
+IMPLICIT NONE
+!
+!-------------------------------------------------------------------------------
+!
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PT ! Temperature
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD ! Radiative temperature tendency
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHT ! Theta at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Rain water m.r. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCT ! Cloud water conc. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRT ! Rain water conc. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Prinstine ice conc. at t
+!
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNFT ! CCN C. available at t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNAT ! CCN C. activated at t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PIFT ! IFN C. available at t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PINT ! IFN C. activated at t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNIT ! Coated IFN activated at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNHT ! CCN hom. freezing
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR ! Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR ! Ice fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PPRCFR ! Precipitation fraction
+!
+!-------------------------------------------------------------------------------
+!
+REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: Z_TH_HIND, Z_RI_HIND, Z_CI_HIND, Z_TH_HINC, Z_RC_HINC, Z_CC_HINC
+!
+integer :: idx
+INTEGER :: JL
+!
+!-------------------------------------------------------------------------------
+!
+IF ( LWARM .AND. LACTI .AND. NMOD_CCN >=1 ) THEN
+
+ IF (.NOT.LSUBG_COND .AND. .NOT.LSPRO) THEN
+
+ if ( lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HENU', ptht(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'HENU', prvt(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'HENU', prct(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HENU', pcct(:, :, :) * prhodj(:, :, :) / ptstep )
+ do jl = 1, nmod_ccn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
+ call Budget_store_init( tbudgets(idx), 'HENU', pnft(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_acti - 1 + jl
+ call Budget_store_init( tbudgets(idx), 'HENU', pnat(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ end do
+ end if
+ end if
+
+ CALL LIMA_CCN_ACTIVATION( TPFILE, &
+ PRHODREF, PEXNREF, PPABST, PT, PDTHRAD, PW_NU, &
+ PTHT, PRVT, PRCT, PCCT, PRRT, PNFT, PNAT, PCLDFR )
+ if ( lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HENU', ptht(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'HENU', prvt(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'HENU', prct(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HENU', pcct(:, :, :) * prhodj(:, :, :) / ptstep )
+ do jl = 1, nmod_ccn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
+ call Budget_store_end( tbudgets(idx), 'HENU', pnft(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_acti - 1 + jl
+ call Budget_store_end( tbudgets(idx), 'HENU', pnat(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ end do
+ end if
+ end if
+
+ END IF
+
+ WHERE(PCLDFR(:,:,:)<1.E-10 .AND. PRCT(:,:,:)>XRTMIN(2) .AND. PCCT(:,:,:)>XCTMIN(2)) PCLDFR(:,:,:)=1.
+
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+IF ( LCOLD .AND. LNUCL .AND. .NOT.LMEYERS .AND. NMOD_IFN >= 1 ) THEN
+ if ( lbu_enable ) then
+ if ( lbudget_sv ) then
+ do jl = 1, nmod_ifn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_free - 1 + jl
+ call Budget_store_init( tbudgets(idx), 'HIND', pift(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl - 1 + jl
+ call Budget_store_init( tbudgets(idx), 'HIND', pint(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ end do
+
+ do jl = 1, nmod_ccn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_acti - 1 + jl
+ call Budget_store_init( tbudgets(idx), 'HINC', pnat(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ end do
+ do jl = 1, nmod_imm
+ idx = NBUDGET_SV1 - 1 + nsv_lima_imm_nucl - 1 + jl
+ call Budget_store_init( tbudgets(idx), 'HINC', pnit(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ end do
+ end if
+ end if
+
+ CALL LIMA_PHILLIPS_IFN_NUCLEATION (PTSTEP, &
+ PRHODREF, PEXNREF, PPABST, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PCCT, PCIT, PNAT, PIFT, PINT, PNIT, &
+ Z_TH_HIND, Z_RI_HIND, Z_CI_HIND, &
+ Z_TH_HINC, Z_RC_HINC, Z_CC_HINC, &
+ PICEFR )
+ WHERE(PICEFR(:,:,:)<1.E-10 .AND. PRIT(:,:,:)>XRTMIN(4) .AND. PCIT(:,:,:)>XCTMIN(4)) PICEFR(:,:,:)=1.
+!
+ if ( lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HIND', z_th_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'HIND', -z_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HIND', z_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_sv ) then
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HIND', z_ci_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+ do jl = 1, nmod_ifn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_free - 1 + jl
+ call Budget_store_end( tbudgets(idx), 'HIND', pift(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl - 1 + jl
+ call Budget_store_end( tbudgets(idx), 'HIND', pint(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ end do
+ end if
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HINC', z_th_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'HINC', z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HINC', -z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_sv ) then
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HINC', z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HINC', -z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ do jl = 1, nmod_ccn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_acti - 1 + jl
+ call Budget_store_end( tbudgets(idx), 'HINC', pnat(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ end do
+ do jl = 1, nmod_imm
+ idx = NBUDGET_SV1 - 1 + nsv_lima_imm_nucl - 1 + jl
+ call Budget_store_end( tbudgets(idx), 'HINC', pnit(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ end do
+ end if
+ end if
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+IF (LCOLD .AND. LNUCL .AND. LMEYERS) THEN
+ CALL LIMA_MEYERS_NUCLEATION (PTSTEP, &
+ PRHODREF, PEXNREF, PPABST, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PCCT, PCIT, PINT, &
+ Z_TH_HIND, Z_RI_HIND, Z_CI_HIND, &
+ Z_TH_HINC, Z_RC_HINC, Z_CC_HINC, &
+ PICEFR )
+ WHERE(PICEFR(:,:,:)<1.E-10 .AND. PRIT(:,:,:)>XRTMIN(4) .AND. PCIT(:,:,:)>XCTMIN(4)) PICEFR(:,:,:)=1.
+!
+ if ( lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HIND', z_th_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'HIND', -z_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HIND', z_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_sv ) then
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HIND', z_ci_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+ if (nmod_ifn > 0 ) &
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl), 'HIND', &
+ z_ci_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+ end if
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HINC', z_th_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'HINC', z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HINC', -z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_sv ) then
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HINC', z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HINC', -z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ if (nmod_ifn > 0 ) &
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl), 'HINC', &
+ -z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ end if
+ end if
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+IF ( LCOLD .AND. LNUCL .AND. LHHONI .AND. NMOD_CCN >= 1) THEN
+ if ( lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HONH', PTHT(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'HONH', PRVT(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'HONH', PRIT(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HONH', PCIT(:, :, :) * prhodj(:, :, :) / ptstep )
+ do jl = 1, nmod_ccn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
+ call Budget_store_init( tbudgets(idx), 'HONH', PNFT(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ end do
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_hom_haze), 'HONH', PNHT(:, :, :) * prhodj(:, :, :) / ptstep )
+ end if
+ end if
+
+ CALL LIMA_CCN_HOM_FREEZING (PRHODREF, PEXNREF, PPABST, PW_NU, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PCCT, PCRT, PCIT, PNFT, PNHT, &
+ PICEFR )
+ WHERE(PICEFR(:,:,:)<1.E-10 .AND. PRIT(:,:,:)>XRTMIN(4) .AND. PCIT(:,:,:)>XCTMIN(4)) PICEFR(:,:,:)=1.
+!
+ if ( lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HONH', PTHT(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'HONH', PRVT(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'HONH', PRIT(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HONH', PCIT(:, :, :) * prhodj(:, :, :) / ptstep )
+ do jl = 1, nmod_ccn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
+ call Budget_store_end( tbudgets(idx), 'HONH', PNFT(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ end do
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_hom_haze), 'HONH', PNHT(:, :, :) * prhodj(:, :, :) / ptstep )
+ end if
+ end if
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_NUCLEATION_PROCS
diff --git a/src/mesonh/micro/lima_phillips.f90 b/src/mesonh/micro/lima_phillips.f90
new file mode 100644
index 000000000..1ca330e35
--- /dev/null
+++ b/src/mesonh/micro/lima_phillips.f90
@@ -0,0 +1,663 @@
+!MNH_LIC Copyright 2013-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! #########################
+ MODULE MODI_LIMA_PHILLIPS
+! #########################
+!
+INTERFACE
+ SUBROUTINE LIMA_PHILLIPS (OHHONI, PTSTEP, KMI, &
+ PZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PTHS, PRVS, PRCS, PRIS, &
+ PCIT, PCCS, PCIS, &
+ PNAS, PIFS, PINS, PNIS )
+!
+LOGICAL, INTENT(IN) :: OHHONI ! enable haze freezing
+REAL, INTENT(IN) :: PTSTEP ! Time step
+INTEGER, INTENT(IN) :: KMI ! Model index
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! Ice crystal C. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCS ! Cloud water C. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIS ! Ice crystal C. source
+!
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNAS ! Cloud C. nuclei C. source
+ !used as Free ice nuclei for
+ !IMMERSION freezing
+!
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PIFS ! Free ice nuclei C. source
+ !for DEPOSITION and CONTACT
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PINS ! Activated ice nuclei C. source
+ !for DEPOSITION and CONTACT
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNIS ! Activated ice nuclei C. source
+ !for IMMERSION
+!
+END SUBROUTINE LIMA_PHILLIPS
+END INTERFACE
+END MODULE MODI_LIMA_PHILLIPS
+!
+! #####################################################################
+ SUBROUTINE LIMA_PHILLIPS (OHHONI, PTSTEP, KMI, &
+ PZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PTHS, PRVS, PRCS, PRIS, &
+ PCIT, PCCS, PCIS, &
+ PNAS, PIFS, PINS, PNIS )
+! #####################################################################
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the heterogeneous nucleation
+!! following Phillips (2008).
+!!
+!!
+!!** METHOD
+!! ------
+!! The parameterization of Phillips (2008) is based on observed nucleation
+!! in the CFDC for a range of T and Si values. Phillips therefore defines a
+!! reference activity spectrum, that is, for given T and Si values, the
+!! reference concentration of primary ice crystals.
+!!
+!! The activation of IFN is closely related to their total surface. Thus,
+!! the activable fraction of each IFN specie is determined by an integration
+!! over the particle size distributions.
+!!
+!! Subroutine organisation :
+!!
+!! 1- Preliminary computations
+!! 2- Check where computations are necessary, and pack variables
+!! 3- Compute the saturation over water and ice
+!! 4- Compute the reference activity spectrum
+!! -> CALL LIMA_PHILLIPS_REF_SPECTRUM
+!! Integrate over the size distributions to compute the IFN activable fraction
+!! -> CALL LIMA_PHILLIPS_INTEG
+!! 5- Heterogeneous nucleation of insoluble IFN
+!! 6- Heterogeneous nucleation of coated IFN
+!! 7- Unpack variables & deallocations
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Phillips et al., 2008: An empirical parameterization of heterogeneous
+!! ice nucleation for multiple chemical species of aerosols, J. Atmos. Sci.
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!! C. Barthe * LACy * jan. 2014 add budgets
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+! P. Wautelet 03/2020: use the new data structures and subroutines for budgets
+! P. Wautelet 02/02/2021: budgets: add missing source terms for SV budgets in LIMA
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+use modd_budget, only: lbu_enable, nbumod, &
+ lbudget_th, lbudget_rv, lbudget_rc, lbudget_ri, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RI, NBUDGET_SV1, &
+ tbudgets
+USE MODD_CST, ONLY : XP00, XRD, XMV, XMD, XCPD, XCPV, XCL, XCI, &
+ XTT, XLSTT, XLVTT, XALPI, XBETAI, XGAMI, &
+ XALPW, XBETAW, XGAMW, XPI
+USE MODD_NSV, ONLY : NSV_LIMA_NC, NSV_LIMA_NI, NSV_LIMA_CCN_ACTI, NSV_LIMA_IFN_FREE, NSV_LIMA_IFN_NUCL, NSV_LIMA_IMM_NUCL
+USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
+USE MODD_PARAM_LIMA, ONLY : NMOD_IFN, NSPECIE, XFRAC, &
+ NMOD_CCN, NMOD_IMM, NIND_SPECIE, NINDICE_CCN_IMM, &
+ XDSI0, XRTMIN, XCTMIN, NPHILLIPS
+USE MODD_PARAM_LIMA_COLD, ONLY : XMNU0
+
+use mode_budget, only: Budget_store_init, Budget_store_end
+use mode_tools, only: Countjv
+
+USE MODI_LIMA_PHILLIPS_INTEG
+USE MODI_LIMA_PHILLIPS_REF_SPECTRUM
+
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+LOGICAL, INTENT(IN) :: OHHONI ! enable haze freezing
+REAL, INTENT(IN) :: PTSTEP ! Time step
+INTEGER, INTENT(IN) :: KMI ! Model index
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! Ice crystal C. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCS ! Cloud water C. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIS ! Ice crystal C. source
+!
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNAS ! Cloud C. nuclei C. source
+ !used as Free ice nuclei for
+ !IMMERSION freezing
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PIFS ! Free ice nuclei C. source
+ !for DEPOSITION and CONTACT
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PINS ! Activated ice nuclei C. source
+ !for DEPOSITION and CONTACT
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNIS ! Activated ice nuclei C. source
+ !for IMMERSION
+!
+!
+!* 0.2 Declarations of local variables :
+!
+!
+INTEGER :: IIB, IIE, IJB, IJE, IKB, IKE ! Physical domain
+INTEGER :: JL, JMOD_CCN, JMOD_IFN, JSPECIE, JMOD_IMM ! Loop index
+INTEGER :: INEGT ! Case number of sedimentation, nucleation,
+integer :: idx
+!
+LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: GNEGT ! Test where to compute the nucleation
+!
+INTEGER, DIMENSION(SIZE(PRHODREF)) :: I1,I2,I3 ! Indexes for PACK replacement
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRRT ! Rain water m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRGT ! Graupel/hail m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZCIT ! Pristine ice conc. at t
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZRVS ! Water vapor m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRCS ! Cloud water m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRIS ! Pristine ice m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZCCS ! Cloud water conc. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZCIS ! Pristine ice conc. source
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZTHS ! Theta source
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZNAS ! Cloud Cond. nuclei conc. source
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZIFS ! Free Ice nuclei conc. source
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZINS ! Nucleated Ice nuclei conc. source
+ !by Deposition/Contact
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZNIS ! Nucleated Ice nuclei conc. source
+ !by Immersion
+!
+REAL, DIMENSION(:), ALLOCATABLE &
+ :: ZRHODREF, & ! RHO Dry REFerence
+ ZRHODJ, & ! RHO times Jacobian
+ ZZT, & ! Temperature
+ ZPRES, & ! Pressure
+ ZEXNREF, & ! EXNer Pressure REFerence
+ ZZW, & ! Work array
+ ZZX, & ! Work array
+ ZZY, & ! Work array
+ ZLSFACT, & ! L_s/(Pi_ref*C_ph)
+ ZLVFACT, & ! L_v/(Pi_ref*C_ph)
+ ZLBDAC, & ! Slope parameter of the cloud droplet distr.
+ ZSI, &
+ ZSW, &
+ ZSI_W
+!
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: ZW, ZT ! work arrays
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZRTMIN, ZCTMIN
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZSI0, & ! Si threshold in H_X for X={DM,BC,O}
+ Z_FRAC_ACT ! Activable frac. of each AP species
+REAL, DIMENSION(:), ALLOCATABLE :: ZTCELSIUS, ZZT_SI0_BC
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 1. PRELIMINARY COMPUTATIONS
+! ------------------------
+!
+!
+! Physical domain
+!
+IIB=1+JPHEXT
+IIE=SIZE(PZZ,1) - JPHEXT
+IJB=1+JPHEXT
+IJE=SIZE(PZZ,2) - JPHEXT
+IKB=1+JPVEXT
+IKE=SIZE(PZZ,3) - JPVEXT
+!
+! Physical limitations
+!
+ALLOCATE(ZRTMIN(SIZE(XRTMIN)))
+ALLOCATE(ZCTMIN(SIZE(XCTMIN)))
+ZRTMIN(:) = XRTMIN(:) / PTSTEP
+ZCTMIN(:) = XCTMIN(:) / PTSTEP
+!
+! Temperature
+!
+ZT(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:)/XP00 ) ** (XRD/XCPD)
+!
+! Saturation over ice
+!
+ZW(:,:,:) = EXP( XALPI - XBETAI/ZT(:,:,:) - XGAMI*ALOG(ZT(:,:,:) ) )
+ZW(:,:,:) = PRVT(:,:,:)*( PPABST(:,:,:)-ZW(:,:,:) ) / ( (XMV/XMD) * ZW(:,:,:) )
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 2. COMPUTATIONS ONLY WHERE NECESSARY : PACK
+! ----------------------------------------
+!
+!
+GNEGT(:,:,:) = .FALSE.
+GNEGT(IIB:IIE,IJB:IJE,IKB:IKE) = ZT(IIB:IIE,IJB:IJE,IKB:IKE)<XTT-2.0 .AND. &
+ ZW(IIB:IIE,IJB:IJE,IKB:IKE)>0.95
+INEGT = COUNTJV( GNEGT(:,:,:),I1(:),I2(:),I3(:))
+!
+IF (INEGT > 0) THEN
+!
+ALLOCATE(ZRVT(INEGT))
+ALLOCATE(ZRCT(INEGT))
+ALLOCATE(ZRRT(INEGT))
+ALLOCATE(ZRIT(INEGT))
+ALLOCATE(ZRST(INEGT))
+ALLOCATE(ZRGT(INEGT))
+!
+ALLOCATE(ZCIT(INEGT))
+!
+ALLOCATE(ZRVS(INEGT))
+ALLOCATE(ZRCS(INEGT))
+ALLOCATE(ZRIS(INEGT))
+!
+ALLOCATE(ZTHS(INEGT))
+!
+ALLOCATE(ZCCS(INEGT))
+ALLOCATE(ZCIS(INEGT))
+!
+ALLOCATE(ZNAS(INEGT,NMOD_CCN))
+ALLOCATE(ZIFS(INEGT,NMOD_IFN))
+ALLOCATE(ZINS(INEGT,NMOD_IFN))
+ALLOCATE(ZNIS(INEGT,NMOD_IMM))
+!
+ALLOCATE(ZRHODREF(INEGT))
+ALLOCATE(ZZT(INEGT))
+ALLOCATE(ZPRES(INEGT))
+ALLOCATE(ZEXNREF(INEGT))
+!
+DO JL=1,INEGT
+ ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL))
+ ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
+ ZRRT(JL) = PRRT(I1(JL),I2(JL),I3(JL))
+ ZRIT(JL) = PRIT(I1(JL),I2(JL),I3(JL))
+ ZRST(JL) = PRST(I1(JL),I2(JL),I3(JL))
+ ZRGT(JL) = PRGT(I1(JL),I2(JL),I3(JL))
+!
+ ZCIT(JL) = PCIT(I1(JL),I2(JL),I3(JL))
+!
+ ZRVS(JL) = PRVS(I1(JL),I2(JL),I3(JL))
+ ZRCS(JL) = PRCS(I1(JL),I2(JL),I3(JL))
+ ZRIS(JL) = PRIS(I1(JL),I2(JL),I3(JL))
+!
+ ZTHS(JL) = PTHS(I1(JL),I2(JL),I3(JL))
+!
+ ZCCS(JL) = PCCS(I1(JL),I2(JL),I3(JL))
+ ZCIS(JL) = PCIS(I1(JL),I2(JL),I3(JL))
+!
+ DO JMOD_CCN = 1, NMOD_CCN
+ ZNAS(JL,JMOD_CCN) = PNAS(I1(JL),I2(JL),I3(JL),JMOD_CCN)
+ ENDDO
+ DO JMOD_IFN = 1, NMOD_IFN
+ ZIFS(JL,JMOD_IFN) = PIFS(I1(JL),I2(JL),I3(JL),JMOD_IFN)
+ ZINS(JL,JMOD_IFN) = PINS(I1(JL),I2(JL),I3(JL),JMOD_IFN)
+ ENDDO
+ DO JMOD_IMM = 1, NMOD_IMM
+ ZNIS(JL,JMOD_IMM) = PNIS(I1(JL),I2(JL),I3(JL),JMOD_IMM)
+ ENDDO
+ ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
+ ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
+ ZPRES(JL) = PPABST(I1(JL),I2(JL),I3(JL))
+ ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL))
+ENDDO
+!
+! PACK : done
+! Prepare computations
+!
+ALLOCATE( ZLSFACT (INEGT) )
+ALLOCATE( ZLVFACT (INEGT) )
+ALLOCATE( ZSI (INEGT) )
+ALLOCATE( ZTCELSIUS (INEGT) )
+ALLOCATE( ZZT_SI0_BC (INEGT) )
+ALLOCATE( ZLBDAC (INEGT) )
+ALLOCATE( ZSI0 (INEGT,NSPECIE) )
+ALLOCATE( Z_FRAC_ACT (INEGT,NSPECIE) ) ; Z_FRAC_ACT(:,:) = 0.0
+ALLOCATE( ZSW (INEGT) )
+ALLOCATE( ZSI_W (INEGT) )
+!
+ALLOCATE( ZZW (INEGT) ) ; ZZW(:) = 0.0
+ALLOCATE( ZZX (INEGT) ) ; ZZX(:) = 0.0
+ALLOCATE( ZZY (INEGT) ) ; ZZY(:) = 0.0
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 3. COMPUTE THE SATURATION OVER WATER AND ICE
+! -----------------------------------------
+!
+!
+ZTCELSIUS(:) = ZZT(:)-XTT ! T [°C]
+ZZW(:) = ZEXNREF(:)*( XCPD+XCPV*ZRVT(:)+XCL*(ZRCT(:)+ZRRT(:)) &
+ +XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)) )
+ZLSFACT(:) = (XLSTT+(XCPV-XCI)*ZTCELSIUS(:))/ZZW(:) ! L_s/(Pi_ref*C_ph)
+ZLVFACT(:) = (XLVTT+(XCPV-XCL)*ZTCELSIUS(:))/ZZW(:) ! L_v/(Pi_ref*C_ph)
+!
+ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) ) ! es_i
+ZSI(:) = ZRVT(:)*(ZPRES(:)-ZZW(:))/((XMV/XMD)*ZZW(:)) ! Saturation over ice
+!
+ZZY(:) = EXP( XALPW - XBETAW/ZZT(:) - XGAMW*ALOG(ZZT(:) ) ) ! es_w
+ZSW(:) = ZRVT(:)*(ZPRES(:)-ZZY(:))/((XMV/XMD)*ZZY(:)) ! Saturation over water
+!
+ZSI_W(:)= ZZY(:)/ZZW(:) ! Saturation over ice at water saturation: es_w/es_i
+!
+! Saturation parameters for H_X, with X={Dust/Metallic (2 modes), Black Carbon, Organic}
+!
+ZSI0(:,1) = 1.0 + 10.0**( -1.0261 + 3.1656E-3* ZTCELSIUS(:) &
+ + 5.3938E-4*(ZTCELSIUS(:)**2) &
+ + 8.2584E-6*(ZTCELSIUS(:)**3) ) ! with T [°C]
+ZSI0(:,2) = ZSI0(:,1) ! DM2 = DM1
+ZSI0(:,3) = 0.0 ! BC
+ZZT_SI0_BC(:) = MAX( 198.0, MIN( 239.0,ZZT(:) ) )
+ZSI0(:,3) = (-3.118E-5*ZZT_SI0_BC(:)+1.085E-2)*ZZT_SI0_BC(:)+0.5652 - XDSI0(3)
+IF (NPHILLIPS == 8) THEN
+ ZSI0(:,4) = ZSI0(:,3) ! O = BC
+ELSE IF (NPHILLIPS == 13) THEN
+ ZSI0(:,4) = 1.15 ! BIO
+END IF
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 4. COMPUTE THE ACTIVABLE FRACTION OF EACH IFN SPECIE
+! -------------------------------------------------
+!
+!
+! Computation of the reference activity spectrum ( ZZY = N_{IN,1,*} )
+!
+CALL LIMA_PHILLIPS_REF_SPECTRUM(ZZT, ZSI, ZSI_W, ZZY)
+!
+! For each aerosol species (DM1, DM2, BC, O), compute the fraction that may be activated
+! Z_FRAC_ACT(INEGT,NSPECIE) = fraction of each species that may be activated
+!
+CALL LIMA_PHILLIPS_INTEG(ZZT, ZSI, ZSI0, ZSW, ZZY, Z_FRAC_ACT)
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 5. COMPUTE THE HETEROGENEOUS NUCLEATION OF INSOLUBLE IFN
+! -----------------------------------------------------
+!
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HIND', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'HIND', prvs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'HIND', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HIND', pcis(:, :, :) * prhodj(:, :, :) )
+ do jl = 1, nmod_ifn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_free -1 + jl
+ call Budget_store_init( tbudgets(idx), 'HIND', pifs(:, :, :, jl) * prhodj(:, :, :) )
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl -1 + jl
+ call Budget_store_init( tbudgets(idx), 'HIND', pins(:, :, :, jl) * prhodj(:, :, :) )
+ end do
+ end if
+end if
+
+DO JMOD_IFN = 1,NMOD_IFN ! IFN modes
+ ZZX(:)=0.
+ DO JSPECIE = 1, NSPECIE ! Each IFN mode is mixed with DM1, DM2, BC, O
+ ZZX(:)=ZZX(:)+XFRAC(JSPECIE,JMOD_IFN)*(ZIFS(:,JMOD_IFN)+ZINS(:,JMOD_IFN))* &
+ Z_FRAC_ACT(:,JSPECIE)
+ END DO
+! Now : ZZX(:) = number of activable AP.
+! Activated AP at this time step = activable AP - already activated AP
+ ZZX(:) = MIN( ZIFS(:,JMOD_IFN), MAX( (ZZX(:)-ZINS(:,JMOD_IFN)),0.0 ))
+! Correction BVIE division by PTSTEP ?
+! ZZW(:) = MIN( XMNU0*ZZX(:) / PTSTEP , ZRVS(:) )
+ ZZW(:) = MIN( XMNU0*ZZX(:), ZRVS(:) )
+!
+! Update the concentrations and MMR
+!
+ ZIFS(:,JMOD_IFN) = ZIFS(:,JMOD_IFN) - ZZX(:)
+ ZW(:,:,:) = PIFS(:,:,:,JMOD_IFN)
+ PIFS(:,:,:,JMOD_IFN) = UNPACK( ZIFS(:,JMOD_IFN), MASK=GNEGT(:,:,:), &
+ FIELD=ZW(:,:,:) )
+!
+ ZINS(:,JMOD_IFN) = ZINS(:,JMOD_IFN) + ZZX(:)
+ ZW(:,:,:) = PINS(:,:,:,JMOD_IFN)
+ PINS(:,:,:,JMOD_IFN) = UNPACK( ZINS(:,JMOD_IFN), MASK=GNEGT(:,:,:), &
+ FIELD=ZW(:,:,:) )
+!
+ ZRVS(:) = ZRVS(:) - ZZW(:)
+ ZRIS(:) = ZRIS(:) + ZZW(:)
+ ZTHS(:) = ZTHS(:) + ZZW(:)*ZLSFACT(:) !-ZLVFACT(:)) ! f(L_s*(RVHNDI))
+ ZCIS(:) = ZCIS(:) + ZZX(:)
+END DO
+!
+!
+! Budget storage
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HIND', &
+ Unpack ( zths(:), mask = gnegt(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'HIND', &
+ Unpack ( zrvs(:), mask = gnegt(:, :, :), field = prvs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'HIND', &
+ Unpack ( zris(:), mask = gnegt(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HIND', &
+ Unpack ( zcis(:), mask = gnegt(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ do jl = 1, nmod_ifn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_free -1 + jl
+ call Budget_store_end( tbudgets(idx), 'HIND', pifs(:, :, :, jl) * prhodj(:, :, :) )
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl -1 + jl
+ call Budget_store_end( tbudgets(idx), 'HIND', pins(:, :, :, jl) * prhodj(:, :, :) )
+ end do
+ end if
+end if
+!-------------------------------------------------------------------------------
+!
+!
+!* 6. COMPUTE THE HETEROGENEOUS NUCLEATION OF COATED IFN
+! --------------------------------------------------
+!
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HINC', &
+ Unpack ( zths(:), mask = gnegt(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'HINC', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'HINC', &
+ Unpack ( zris(:), mask = gnegt(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HINC', pccs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HINC', &
+ Unpack ( zcis(:), mask = gnegt(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ do jl = 1, nmod_ccn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_acti - 1 + jl
+ call Budget_store_init( tbudgets(idx), 'HINC', pnas(:, :, :, jl) * prhodj(:, :, :) )
+ end do
+ do jl = 1, nmod_imm
+ idx = NBUDGET_SV1 - 1 + nsv_lima_imm_nucl - 1 + jl
+ call Budget_store_init( tbudgets(idx), 'HINC', pnis(:, :, :, jl) * prhodj(:, :, :) )
+ end do
+ end if
+end if
+!
+! Heterogeneous nucleation by immersion of the activated CCN
+! Currently, we represent coated IFN as a pure aerosol type (NIND_SPECIE)
+!
+!
+DO JMOD_IMM = 1,NMOD_IMM ! Coated IFN modes
+ JMOD_CCN = NINDICE_CCN_IMM(JMOD_IMM) ! Corresponding CCN mode
+ IF (JMOD_CCN .GT. 0) THEN
+!
+! OLD LIMA : Compute the appropriate mean diameter and sigma
+! XMDIAM_IMM = MIN( XMDIAM_IFN(NIND_SPECIE) , XR_MEAN_CCN(JMOD_CCN)*2. )
+! XSIGMA_IMM = MIN( XSIGMA_IFN(JSPECIE) , EXP(XLOGSIG_CCN(JMOD_CCN)) )
+!
+ ZZW(:) = MIN( ZCCS(:) , ZNAS(:,JMOD_CCN) )
+ ZZX(:)= ( ZZW(:)+ZNIS(:,JMOD_IMM) ) * Z_FRAC_ACT(:,NIND_SPECIE)
+! Now : ZZX(:) = number of activable AP.
+! Activated AP at this time step = activable AP - already activated AP
+ ZZX(:) = MIN( ZZW(:), MAX( (ZZX(:)-ZNIS(:,JMOD_IMM)),0.0 ) )
+! Correction BVIE division by PTSTEP ?
+! ZZY(:) = MIN( XMNU0*ZZX(:) / PTSTEP , ZRVS(:) )
+ ZZY(:) = MIN( XMNU0*ZZX(:) , ZRVS(:) )
+!
+! Update the concentrations and MMR
+!
+ ZNAS(:,JMOD_CCN) = ZNAS(:,JMOD_CCN) - ZZX(:)
+ ZW(:,:,:) = PNAS(:,:,:,JMOD_CCN)
+ PNAS(:,:,:,JMOD_CCN) = UNPACK(ZNAS(:,JMOD_CCN),MASK=GNEGT(:,:,:), &
+ FIELD=ZW(:,:,:))
+ ZNIS(:,JMOD_IMM) = ZNIS(:,JMOD_IMM) + ZZX(:)
+ ZW(:,:,:) = PNIS(:,:,:,JMOD_IMM)
+ PNIS(:,:,:,JMOD_IMM) = UNPACK(ZNIS(:,JMOD_IMM),MASK=GNEGT(:,:,:), &
+ FIELD=ZW(:,:,:))
+!
+ ZRCS(:) = ZRCS(:) - ZZY(:)
+ ZRIS(:) = ZRIS(:) + ZZY(:)
+ ZTHS(:) = ZTHS(:) + ZZY(:)*ZLSFACT(:) !-ZLVFACT(:)) ! f(L_s*(RVHNCI))
+ ZCCS(:) = ZCCS(:) - ZZX(:)
+ ZCIS(:) = ZCIS(:) + ZZX(:)
+ END IF
+END DO
+!
+! Budget storage
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HINC', &
+ Unpack ( zths(:), mask = gnegt(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'HINC', &
+ Unpack ( zrcs(:), mask = gnegt(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'HINC', &
+ Unpack ( zris(:), mask = gnegt(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HINC', &
+ Unpack ( zccs(:), mask = gnegt(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HINC', &
+ Unpack ( zcis(:), mask = gnegt(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ do jl = 1, nmod_ccn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_acti - 1 + jl
+ call Budget_store_end( tbudgets(idx), 'HINC', pnas(:, :, :, jl) * prhodj(:, :, :) )
+ end do
+ do jl = 1, nmod_imm
+ idx = NBUDGET_SV1 - 1 + nsv_lima_imm_nucl - 1 + jl
+ call Budget_store_end( tbudgets(idx), 'HINC', pnis(:, :, :, jl) * prhodj(:, :, :) )
+ end do
+ end if
+end if
+!-------------------------------------------------------------------------------
+!
+!
+!* 7. UNPACK VARIABLES AND CLEAN
+! --------------------------
+!
+!
+! End of the heterogeneous nucleation following Phillips 08
+! Unpack variables, deallocate...
+!
+!
+ZW(:,:,:) = PRVS(:,:,:)
+PRVS(:,:,:) = UNPACK( ZRVS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
+ZW(:,:,:) = PRCS(:,:,:)
+PRCS(:,:,:) = UNPACK( ZRCS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
+ZW(:,:,:) = PRIS(:,:,:)
+PRIS(:,:,:) = UNPACK( ZRIS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
+ZW(:,:,:) = PTHS(:,:,:)
+PTHS(:,:,:) = UNPACK( ZTHS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
+ZW(:,:,:) = PCCS(:,:,:)
+PCCS(:,:,:) = UNPACK( ZCCS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
+ZW(:,:,:) = PCIS(:,:,:)
+PCIS(:,:,:) = UNPACK( ZCIS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
+!
+DEALLOCATE(ZRTMIN)
+DEALLOCATE(ZCTMIN)
+DEALLOCATE(ZRVT)
+DEALLOCATE(ZRCT)
+DEALLOCATE(ZRRT)
+DEALLOCATE(ZRIT)
+DEALLOCATE(ZRST)
+DEALLOCATE(ZRGT)
+DEALLOCATE(ZCIT)
+DEALLOCATE(ZRVS)
+DEALLOCATE(ZRCS)
+DEALLOCATE(ZRIS)
+DEALLOCATE(ZTHS)
+DEALLOCATE(ZCCS)
+DEALLOCATE(ZCIS)
+DEALLOCATE(ZNAS)
+DEALLOCATE(ZIFS)
+DEALLOCATE(ZINS)
+DEALLOCATE(ZNIS)
+DEALLOCATE(ZRHODREF)
+DEALLOCATE(ZZT)
+DEALLOCATE(ZPRES)
+DEALLOCATE(ZEXNREF)
+DEALLOCATE(ZLSFACT)
+DEALLOCATE(ZLVFACT)
+DEALLOCATE(ZSI)
+DEALLOCATE(ZTCELSIUS)
+DEALLOCATE(ZZT_SI0_BC)
+DEALLOCATE(ZLBDAC)
+DEALLOCATE(ZSI0)
+DEALLOCATE(Z_FRAC_ACT)
+DEALLOCATE(ZSW)
+DEALLOCATE(ZZW)
+DEALLOCATE(ZZX)
+DEALLOCATE(ZZY)
+!++cb++
+ DEALLOCATE(ZSI_W)
+!--cb--
+!
+END IF ! INEGT > 0
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_PHILLIPS
diff --git a/src/mesonh/micro/lima_phillips_ifn_nucleation.f90 b/src/mesonh/micro/lima_phillips_ifn_nucleation.f90
new file mode 100644
index 000000000..1010555ff
--- /dev/null
+++ b/src/mesonh/micro/lima_phillips_ifn_nucleation.f90
@@ -0,0 +1,512 @@
+!MNH_LIC Copyright 2018-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ########################################
+ MODULE MODI_LIMA_PHILLIPS_IFN_NUCLEATION
+! ########################################
+!
+INTERFACE
+ SUBROUTINE LIMA_PHILLIPS_IFN_NUCLEATION (PTSTEP, &
+ PRHODREF, PEXNREF, PPABST, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PCCT, PCIT, PNAT, PIFT, PINT, PNIT, &
+ P_TH_HIND, P_RI_HIND, P_CI_HIND, &
+ P_TH_HINC, P_RC_HINC, P_CC_HINC, &
+ PICEFR )
+!
+REAL, INTENT(IN) :: PTSTEP
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIT ! Cloud ice m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCT ! Cloud water conc. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Cloud water conc. at t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNAT ! CCN conc. used for immersion nucl.
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PIFT ! Free IFN conc.
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PINT ! Nucleated IFN conc.
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNIT ! Nucleated (by immersion) CCN conc.
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_TH_HIND
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_RI_HIND
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_CI_HIND
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_TH_HINC
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_RC_HINC
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_CC_HINC
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR
+!
+END SUBROUTINE LIMA_PHILLIPS_IFN_NUCLEATION
+END INTERFACE
+END MODULE MODI_LIMA_PHILLIPS_IFN_NUCLEATION
+!
+! #################################################################################
+ SUBROUTINE LIMA_PHILLIPS_IFN_NUCLEATION (PTSTEP, &
+ PRHODREF, PEXNREF, PPABST, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PCCT, PCIT, PNAT, PIFT, PINT, PNIT, &
+ P_TH_HIND, P_RI_HIND, P_CI_HIND, &
+ P_TH_HINC, P_RC_HINC, P_CC_HINC, &
+ PICEFR )
+! #################################################################################
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the heterogeneous nucleation
+!! following Phillips (2008) for the time-split version of LIMA
+!!
+!!
+!!** METHOD
+!! ------
+!! The parameterization of Phillips (2008) is based on observed nucleation
+!! in the CFDC for a range of T and Si values. Phillips therefore defines a
+!! reference activity spectrum, that is, for given T and Si values, the
+!! reference concentration of primary ice crystals.
+!!
+!! The activation of IFN is closely related to their total surface. Thus,
+!! the activable fraction of each IFN specie is determined by an integration
+!! over the particle size distributions.
+!!
+!! Subroutine organisation :
+!!
+!! 1- Preliminary computations
+!! 2- Check where computations are necessary, and pack variables
+!! 3- Compute the saturation over water and ice
+!! 4- Compute the reference activity spectrum
+!! -> CALL LIMA_PHILLIPS_REF_SPECTRUM
+!! Integrate over the size distributions to compute the IFN activable fraction
+!! -> CALL LIMA_PHILLIPS_INTEG
+!! 5- Heterogeneous nucleation of insoluble IFN
+!! 6- Heterogeneous nucleation of coated IFN
+!! 7- Unpack variables & deallocations
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Phillips et al., 2008: An empirical parameterization of heterogeneous
+!! ice nucleation for multiple chemical species of aerosols, J. Atmos. Sci.
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 15/03/2018
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+! P. Wautelet 27/02/2020: bugfix: P_TH_HIND was not accumulated (will affect budgets) + add P_TH_HINC dummy argument
+! + change intent of *_HIND and *_HINC dummy arguments (INOUT->OUT)
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY : XP00, XRD, XMV, XMD, XCPD, XCPV, XCL, XCI, &
+ XTT, XLSTT, XLVTT, XALPI, XBETAI, XGAMI, &
+ XALPW, XBETAW, XGAMW, XPI
+USE MODD_NSV, ONLY : NSV_LIMA_NC, NSV_LIMA_NI, NSV_LIMA_IFN_FREE
+USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
+USE MODD_PARAM_LIMA, ONLY : NMOD_IFN, NSPECIE, XFRAC, &
+ NMOD_CCN, NMOD_IMM, NIND_SPECIE, NINDICE_CCN_IMM, &
+ XDSI0, XRTMIN, XCTMIN, NPHILLIPS
+USE MODD_PARAM_LIMA_COLD, ONLY : XMNU0
+
+use mode_tools, only: Countjv
+
+USE MODI_LIMA_PHILLIPS_INTEG
+USE MODI_LIMA_PHILLIPS_REF_SPECTRUM
+
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, INTENT(IN) :: PTSTEP
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIT ! Cloud ice m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCT ! Cloud water conc. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Cloud water conc. at t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNAT ! CCN conc. used for immersion nucl.
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PIFT ! Free IFN conc.
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PINT ! Nucleated IFN conc.
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNIT ! Nucleated (by immersion) CCN conc.
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_TH_HIND
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_RI_HIND
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_CI_HIND
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_TH_HINC
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_RC_HINC
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_CC_HINC
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR
+!
+!
+!* 0.2 Declarations of local variables :
+!
+!
+INTEGER :: IIB, IIE, IJB, IJE, IKB, IKE ! Physical domain
+INTEGER :: JL, JMOD_CCN, JMOD_IFN, JSPECIE, JMOD_IMM ! Loop index
+INTEGER :: INEGT ! Case number of sedimentation, nucleation,
+!
+LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: GNEGT ! Test where to compute the nucleation
+!
+INTEGER, DIMENSION(SIZE(PRHODREF)) :: I1,I2,I3 ! Indexes for PACK replacement
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRRT ! Rain water m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRGT ! Graupel/hail m.r. at t
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZCCT ! Cloud water conc. at t
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZNAT ! Cloud Cond. nuclei conc. source
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZIFT ! Free Ice nuclei conc. source
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZINT ! Nucleated Ice nuclei conc. source
+ !by Deposition/Contact
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZNIT ! Nucleated Ice nuclei conc. source
+ !by Immersion
+!
+REAL, DIMENSION(:), ALLOCATABLE &
+ :: ZRHODREF, & ! RHO Dry REFerence
+ ZRHODJ, & ! RHO times Jacobian
+ ZZT, & ! Temperature
+ ZPRES, & ! Pressure
+ ZEXNREF, & ! EXNer Pressure REFerence
+ ZZW, & ! Work array
+ ZZX, & ! Work array
+ ZZY, & ! Work array
+ ZLSFACT, & ! L_s/(Pi_ref*C_ph)
+ ZLVFACT, & ! L_v/(Pi_ref*C_ph)
+ ZLBDAC, & ! Slope parameter of the cloud droplet distr.
+ ZSI, &
+ ZSW, &
+ ZSI_W
+!
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: ZW, ZT ! work arrays
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZSI0, & ! Si threshold in H_X for X={DM,BC,O}
+ Z_FRAC_ACT ! Activable frac. of each AP species
+REAL, DIMENSION(:), ALLOCATABLE :: ZTCELSIUS, ZZT_SI0_BC
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 1. PRELIMINARY COMPUTATIONS
+! ------------------------
+!
+P_TH_HIND(:,:,:) = 0.
+P_RI_HIND(:,:,:) = 0.
+P_CI_HIND(:,:,:) = 0.
+P_TH_HINC(:,:,:) = 0.
+P_RC_HINC(:,:,:) = 0.
+P_CC_HINC(:,:,:) = 0.
+!
+! Physical domain
+!
+IIB=1+JPHEXT
+IIE=SIZE(PTHT,1) - JPHEXT
+IJB=1+JPHEXT
+IJE=SIZE(PTHT,2) - JPHEXT
+IKB=1+JPVEXT
+IKE=SIZE(PTHT,3) - JPVEXT
+!
+! Temperature
+!
+ZT(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:)/XP00 ) ** (XRD/XCPD)
+!
+! Saturation over ice
+!
+ZW(:,:,:) = EXP( XALPI - XBETAI/ZT(:,:,:) - XGAMI*ALOG(ZT(:,:,:) ) )
+ZW(:,:,:) = PRVT(:,:,:)*( PPABST(:,:,:)-ZW(:,:,:) ) / ( (XMV/XMD) * ZW(:,:,:) )
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 2. COMPUTATIONS ONLY WHERE NECESSARY : PACK
+! ----------------------------------------
+!
+!
+GNEGT(:,:,:) = .FALSE.
+GNEGT(IIB:IIE,IJB:IJE,IKB:IKE) = ZT(IIB:IIE,IJB:IJE,IKB:IKE)<XTT-2.0 .AND. &
+ ZW(IIB:IIE,IJB:IJE,IKB:IKE)>0.95
+!
+INEGT = COUNTJV( GNEGT(:,:,:),I1(:),I2(:),I3(:))
+!
+IF (INEGT > 0) THEN
+!
+ ALLOCATE(ZRVT(INEGT))
+ ALLOCATE(ZRCT(INEGT))
+ ALLOCATE(ZRRT(INEGT))
+ ALLOCATE(ZRIT(INEGT))
+ ALLOCATE(ZRST(INEGT))
+ ALLOCATE(ZRGT(INEGT))
+!
+ ALLOCATE(ZCCT(INEGT))
+!
+ ALLOCATE(ZNAT(INEGT,NMOD_CCN))
+ ALLOCATE(ZIFT(INEGT,NMOD_IFN))
+ ALLOCATE(ZINT(INEGT,NMOD_IFN))
+ ALLOCATE(ZNIT(INEGT,NMOD_IMM))
+!
+ ALLOCATE(ZRHODREF(INEGT))
+ ALLOCATE(ZZT(INEGT))
+ ALLOCATE(ZPRES(INEGT))
+ ALLOCATE(ZEXNREF(INEGT))
+!
+ DO JL=1,INEGT
+ ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL))
+ ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
+ ZRRT(JL) = PRRT(I1(JL),I2(JL),I3(JL))
+ ZRIT(JL) = PRIT(I1(JL),I2(JL),I3(JL))
+ ZRST(JL) = PRST(I1(JL),I2(JL),I3(JL))
+ ZRGT(JL) = PRGT(I1(JL),I2(JL),I3(JL))
+!
+ ZCCT(JL) = PCCT(I1(JL),I2(JL),I3(JL))
+!
+ DO JMOD_CCN = 1, NMOD_CCN
+ ZNAT(JL,JMOD_CCN) = PNAT(I1(JL),I2(JL),I3(JL),JMOD_CCN)
+ ENDDO
+ DO JMOD_IFN = 1, NMOD_IFN
+ ZIFT(JL,JMOD_IFN) = PIFT(I1(JL),I2(JL),I3(JL),JMOD_IFN)
+ ZINT(JL,JMOD_IFN) = PINT(I1(JL),I2(JL),I3(JL),JMOD_IFN)
+ ENDDO
+ DO JMOD_IMM = 1, NMOD_IMM
+ ZNIT(JL,JMOD_IMM) = PNIT(I1(JL),I2(JL),I3(JL),JMOD_IMM)
+ ENDDO
+ ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
+ ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
+ ZPRES(JL) = PPABST(I1(JL),I2(JL),I3(JL))
+ ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL))
+ ENDDO
+!
+! PACK : done
+! Prepare computations
+!
+ ALLOCATE( ZLSFACT (INEGT) )
+ ALLOCATE( ZLVFACT (INEGT) )
+ ALLOCATE( ZSI (INEGT) )
+ ALLOCATE( ZTCELSIUS (INEGT) )
+ ALLOCATE( ZZT_SI0_BC (INEGT) )
+ ALLOCATE( ZLBDAC (INEGT) )
+ ALLOCATE( ZSI0 (INEGT,NSPECIE) )
+ ALLOCATE( Z_FRAC_ACT (INEGT,NSPECIE) ) ; Z_FRAC_ACT(:,:) = 0.0
+ ALLOCATE( ZSW (INEGT) )
+ ALLOCATE( ZSI_W (INEGT) )
+!
+ ALLOCATE( ZZW (INEGT) ) ; ZZW(:) = 0.0
+ ALLOCATE( ZZX (INEGT) ) ; ZZX(:) = 0.0
+ ALLOCATE( ZZY (INEGT) ) ; ZZY(:) = 0.0
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 3. COMPUTE THE SATURATION OVER WATER AND ICE
+! -----------------------------------------
+!
+!
+ ZTCELSIUS(:) = ZZT(:)-XTT ! T [°C]
+ ZZW(:) = ZEXNREF(:)*( XCPD+XCPV*ZRVT(:)+XCL*(ZRCT(:)+ZRRT(:)) &
+ +XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)) )
+ ZLSFACT(:) = (XLSTT+(XCPV-XCI)*ZTCELSIUS(:))/ZZW(:) ! L_s/(Pi_ref*C_ph)
+ ZLVFACT(:) = (XLVTT+(XCPV-XCL)*ZTCELSIUS(:))/ZZW(:) ! L_v/(Pi_ref*C_ph)
+!
+ ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) ) ! es_i
+ ZSI(:) = ZRVT(:)*(ZPRES(:)-ZZW(:))/((XMV/XMD)*ZZW(:)) ! Saturation over ice
+!
+ ZZY(:) = EXP( XALPW - XBETAW/ZZT(:) - XGAMW*ALOG(ZZT(:) ) ) ! es_w
+ ZSW(:) = ZRVT(:)*(ZPRES(:)-ZZY(:))/((XMV/XMD)*ZZY(:)) ! Saturation over water
+!
+ ZSI_W(:)= ZZY(:)/ZZW(:) ! Saturation over ice at water saturation: es_w/es_i
+!
+! Saturation parameters for H_X, with X={Dust/Metallic (2 modes), Black Carbon, Organic}
+!
+ ZSI0(:,1) = 1.0 + 10.0**( -1.0261 + 3.1656E-3* ZTCELSIUS(:) &
+ + 5.3938E-4*(ZTCELSIUS(:)**2) &
+ + 8.2584E-6*(ZTCELSIUS(:)**3) ) ! with T [°C]
+ ZSI0(:,2) = ZSI0(:,1) ! DM2 = DM1
+ ZSI0(:,3) = 0.0 ! BC
+ ZZT_SI0_BC(:) = MAX( 198.0, MIN( 239.0,ZZT(:) ) )
+ ZSI0(:,3) = (-3.118E-5*ZZT_SI0_BC(:)+1.085E-2)*ZZT_SI0_BC(:)+0.5652 - XDSI0(3)
+ IF (NPHILLIPS == 8) THEN
+ ZSI0(:,4) = ZSI0(:,3) ! O = BC
+ ELSE IF (NPHILLIPS == 13) THEN
+ ZSI0(:,4) = 1.15 ! BIO
+ END IF
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 4. COMPUTE THE ACTIVABLE FRACTION OF EACH IFN SPECIE
+! -------------------------------------------------
+!
+!
+! Computation of the reference activity spectrum ( ZZY = N_{IN,1,*} )
+!
+ CALL LIMA_PHILLIPS_REF_SPECTRUM(ZZT, ZSI, ZSI_W, ZZY)
+!
+! For each aerosol species (DM1, DM2, BC, O), compute the fraction that may be activated
+! Z_FRAC_ACT(INEGT,NSPECIE) = fraction of each species that may be activated
+!
+ CALL LIMA_PHILLIPS_INTEG(ZZT, ZSI, ZSI0, ZSW, ZZY, Z_FRAC_ACT)
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 5. COMPUTE THE HETEROGENEOUS NUCLEATION OF INSOLUBLE IFN
+! -----------------------------------------------------
+!
+!
+!
+ DO JMOD_IFN = 1,NMOD_IFN ! IFN modes
+ ZZX(:)=0.
+ DO JSPECIE = 1, NSPECIE ! Each IFN mode is mixed with DM1, DM2, BC, O
+ ZZX(:)=ZZX(:)+XFRAC(JSPECIE,JMOD_IFN)*(ZIFT(:,JMOD_IFN)+ZINT(:,JMOD_IFN))* &
+ Z_FRAC_ACT(:,JSPECIE)
+ END DO
+! Now : ZZX(:) = number conc. of activable AP.
+! Activated AP at this time step = activable AP - already activated AP
+ ZZX(:) = MIN( ZIFT(:,JMOD_IFN), MAX( (ZZX(:)-ZINT(:,JMOD_IFN)),0.0 ))
+ ZZW(:) = MIN( XMNU0*ZZX(:), ZRVT(:) )
+! Now : ZZX(:) = number conc. of AP activated at this time step (#/kg) from IFN mode JMOD_IFN
+! Now : ZZW(:) = mmr of ice nucleated at this time step (kg/kg) from IFN mode JMOD_IFN
+!
+! Update the concentrations and MMR
+!
+ ZW(:,:,:) = UNPACK( ZZX(:), MASK=GNEGT(:,:,:), FIELD=0. )
+ PIFT(:,:,:,JMOD_IFN) = PIFT(:,:,:,JMOD_IFN) - ZW(:,:,:)
+ PINT(:,:,:,JMOD_IFN) = PINT(:,:,:,JMOD_IFN) + ZW(:,:,:)
+!
+ P_CI_HIND(:,:,:) = P_CI_HIND(:,:,:) + ZW(:,:,:)
+ PCIT(:,:,:) = PCIT(:,:,:) + ZW(:,:,:)
+!
+ ZW(:,:,:) = UNPACK( ZZW(:), MASK=GNEGT(:,:,:), FIELD=0. )
+ P_RI_HIND(:,:,:) = P_RI_HIND(:,:,:) + ZW(:,:,:)
+ PRVT(:,:,:) = PRVT(:,:,:) - ZW(:,:,:)
+ PRIT(:,:,:) = PRIT(:,:,:) + ZW(:,:,:)
+!
+ ZW(:,:,:) = UNPACK( ZZW(:)*ZLSFACT(:), MASK=GNEGT(:,:,:), FIELD=0. )
+ P_TH_HIND(:,:,:) = P_TH_HIND(:,:,:) + ZW(:,:,:)
+ PTHT(:,:,:) = PTHT(:,:,:) + ZW(:,:,:)
+ END DO
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 6. COMPUTE THE HETEROGENEOUS NUCLEATION OF COATED IFN
+! --------------------------------------------------
+!
+!
+! Heterogeneous nucleation by immersion of the activated CCN
+! Currently, we represent coated IFN as a pure aerosol type (NIND_SPECIE)
+!
+!
+ DO JMOD_IMM = 1,NMOD_IMM ! Coated IFN modes
+ JMOD_CCN = NINDICE_CCN_IMM(JMOD_IMM) ! Corresponding CCN mode
+ IF (JMOD_CCN .GT. 0) THEN
+!
+! OLD LIMA : Compute the appropriate mean diameter and sigma
+! XMDIAM_IMM = MIN( XMDIAM_IFN(NIND_SPECIE) , XR_MEAN_CCN(JMOD_CCN)*2. )
+! XSIGMA_IMM = MIN( XSIGMA_IFN(JSPECIE) , EXP(XLOGSIG_CCN(JMOD_CCN)) )
+!
+ ZZW(:) = MIN( ZCCT(:) , ZNAT(:,JMOD_CCN) )
+ ZZX(:)= ( ZZW(:)+ZNIT(:,JMOD_IMM) ) * Z_FRAC_ACT(:,NIND_SPECIE)
+! Now : ZZX(:) = number of activable AP.
+! Activated AP at this time step = activable AP - already activated AP
+ ZZX(:) = MIN( ZZW(:), MAX( (ZZX(:)-ZNIT(:,JMOD_IMM)),0.0 ) )
+ ZZY(:) = MIN( XMNU0*ZZX(:) , ZRVT(:), ZRCT(:) )
+!
+! Update the concentrations and MMR
+!
+ ZW(:,:,:) = UNPACK( ZZX(:), MASK=GNEGT(:,:,:), FIELD=0. )
+ PNIT(:,:,:,JMOD_IMM) = PNIT(:,:,:,JMOD_IMM) + ZW(:,:,:)
+ PNAT(:,:,:,JMOD_CCN) = PNAT(:,:,:,JMOD_CCN) - ZW(:,:,:)
+!
+ P_CC_HINC(:,:,:) = P_CC_HINC(:,:,:) - ZW(:,:,:)
+ PCCT(:,:,:) = PCCT(:,:,:) - ZW(:,:,:)
+ PCIT(:,:,:) = PCIT(:,:,:) + ZW(:,:,:)
+!
+ ZW(:,:,:) = UNPACK( ZZY(:), MASK=GNEGT(:,:,:), FIELD=0. )
+ P_RC_HINC(:,:,:) = P_RC_HINC(:,:,:) - ZW(:,:,:)
+ PRCT(:,:,:) = PRCT(:,:,:) - ZW(:,:,:)
+ PRIT(:,:,:) = PRIT(:,:,:) + ZW(:,:,:)
+!
+ ZW(:,:,:) = UNPACK( ZZY(:)*ZLSFACT(:), MASK=GNEGT(:,:,:), FIELD=0. )
+ P_TH_HINC(:,:,:) = P_TH_HINC(:,:,:) + ZW(:,:,:)
+ PTHT(:,:,:) = PTHT(:,:,:) + ZW(:,:,:)
+ END IF
+ END DO
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 7. CLEAN
+! -----
+!
+!
+ DEALLOCATE(ZRVT)
+ DEALLOCATE(ZRCT)
+ DEALLOCATE(ZRRT)
+ DEALLOCATE(ZRIT)
+ DEALLOCATE(ZRST)
+ DEALLOCATE(ZRGT)
+ DEALLOCATE(ZCCT)
+ DEALLOCATE(ZNAT)
+ DEALLOCATE(ZIFT)
+ DEALLOCATE(ZINT)
+ DEALLOCATE(ZNIT)
+ DEALLOCATE(ZRHODREF)
+ DEALLOCATE(ZZT)
+ DEALLOCATE(ZPRES)
+ DEALLOCATE(ZEXNREF)
+ DEALLOCATE(ZLSFACT)
+ DEALLOCATE(ZLVFACT)
+ DEALLOCATE(ZSI)
+ DEALLOCATE(ZTCELSIUS)
+ DEALLOCATE(ZZT_SI0_BC)
+ DEALLOCATE(ZLBDAC)
+ DEALLOCATE(ZSI0)
+ DEALLOCATE(Z_FRAC_ACT)
+ DEALLOCATE(ZSW)
+ DEALLOCATE(ZZW)
+ DEALLOCATE(ZZX)
+ DEALLOCATE(ZZY)
+ DEALLOCATE(ZSI_W)
+!
+END IF ! INEGT > 0
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_PHILLIPS_IFN_NUCLEATION
diff --git a/src/mesonh/micro/lima_phillips_integ.f90 b/src/mesonh/micro/lima_phillips_integ.f90
new file mode 100644
index 000000000..3af3048c6
--- /dev/null
+++ b/src/mesonh/micro/lima_phillips_integ.f90
@@ -0,0 +1,163 @@
+! ###############################
+ MODULE MODI_LIMA_PHILLIPS_INTEG
+! ###############################
+!
+INTERFACE
+ SUBROUTINE LIMA_PHILLIPS_INTEG (ZZT, ZSI, ZSI0, ZSW, ZZY, Z_FRAC_ACT)
+!
+REAL, DIMENSION(:), INTENT(IN) :: ZZT
+REAL, DIMENSION(:), INTENT(IN) :: ZSI
+REAL, DIMENSION(:,:), INTENT(IN) :: ZSI0
+REAL, DIMENSION(:), INTENT(IN) :: ZSW
+REAL, DIMENSION(:), INTENT(IN) :: ZZY
+REAL, DIMENSION(:,:), INTENT(INOUT) :: Z_FRAC_ACT
+!
+END SUBROUTINE LIMA_PHILLIPS_INTEG
+END INTERFACE
+END MODULE MODI_LIMA_PHILLIPS_INTEG
+!
+! ######################################################################
+ SUBROUTINE LIMA_PHILLIPS_INTEG (ZZT, ZSI, ZSI0, ZSW, ZZY, Z_FRAC_ACT)
+! ######################################################################
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the fraction of each aerosol
+!! species (DM1, DM2, BC, O) that may be activated, following Phillips (2008)
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Phillips et al., 2008: An empirical parameterization of heterogeneous
+!! ice nucleation for multiple chemical species of aerosols, J. Atmos. Sci.
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY : XTT, XPI
+USE MODD_PARAM_LIMA, ONLY : XMDIAM_IFN, XSIGMA_IFN, NSPECIE, XFRAC_REF, &
+ XH, XAREA1, XGAMMA, XABSCISS, XWEIGHT, NDIAM, &
+ XT0, XDT0, XDSI0, XSW0, XTX1, XTX2
+USE MODI_LIMA_FUNCTIONS, ONLY : DELTA, DELTA_VEC
+USE MODI_GAMMA_INC
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, DIMENSION(:), INTENT(IN) :: ZZT
+REAL, DIMENSION(:), INTENT(IN) :: ZSI
+REAL, DIMENSION(:,:), INTENT(IN) :: ZSI0
+REAL, DIMENSION(:), INTENT(IN) :: ZSW
+REAL, DIMENSION(:), INTENT(IN) :: ZZY
+REAL, DIMENSION(:,:), INTENT(INOUT) :: Z_FRAC_ACT
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: JSPECIE, JL, JL2
+REAL :: XB
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZZX, & ! Work array
+ ZFACTOR, &
+ ZSUBSAT, &
+ ZEMBRYO
+!
+LOGICAL, DIMENSION(:), ALLOCATABLE :: GINTEG ! Mask to integrate over the
+ ! AP size spectrum
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+DO JSPECIE = 1, NSPECIE ! = 4 = {DM1, DM2, BC, O} respectively
+!
+ ALLOCATE(ZZX (SIZE(ZZT)) ) ; ZZX(:) = 0.0
+ ALLOCATE(ZFACTOR (SIZE(ZZT)) )
+ ALLOCATE(ZSUBSAT (SIZE(ZZT)) )
+ ALLOCATE(ZEMBRYO (SIZE(ZZT)) )
+ ALLOCATE(GINTEG (SIZE(ZZT)) )
+
+! Compute log in advance for efficiency
+ XB = LOG(0.1E-6/XMDIAM_IFN(JSPECIE))/(SQRT(2.0)*LOG(XSIGMA_IFN(JSPECIE)))
+! ZFACTOR = f_c
+ ZFACTOR(:) = DELTA(1.,XH(JSPECIE),ZZT(:),XT0(JSPECIE),XT0(JSPECIE)+XDT0(JSPECIE)) &
+ * DELTA_VEC(0.,1.,ZSI(:),ZSI0(:,JSPECIE),ZSI0(:,JSPECIE)+XDSI0(JSPECIE)) / XGAMMA
+! ZSUBSAT = H_X
+ ZSUBSAT(:) = MIN(ZFACTOR(:)+(1.0-ZFACTOR(:))*DELTA(0.,1.,ZSW(:),XSW0,1.) , 1.0)
+! ZEMBRYO = µ_X/(pi*(D_X)**2) = A
+ ZEMBRYO(:) = ZSUBSAT(:)*DELTA(1.,0.,ZZT(:),XTX1(JSPECIE),XTX2(JSPECIE)) &
+ * XFRAC_REF(JSPECIE)*ZZY(:)/XAREA1(JSPECIE)
+!
+! For T warmer than -35°C, the integration is approximated with µ_X << 1
+! Error function : GAMMA_INC(1/2, x**2) = ERF(x) !!! for x>=0 !!!
+!
+! WHERE (ZZT(:)>(XTT-35.) .AND. ZEMBRYO(:)>1.0E-8)
+! ZZX(:) = ZZX(:) + ZEMBRYO(:) * XPI * (XMDIAM_IFN(JSPECIE))**2 / 2.0 &
+! * EXP(2*(LOG(XSIGMA_IFN(JSPECIE)))**2) &
+! * (1.0+GAMMA_INC(0.5,(SQRT(2.0)*LOG(XSIGMA_IFN(JSPECIE))-XB)**2))
+! END WHERE
+
+ DO JL = 1, SIZE(ZZT)
+ IF (ZZT(JL)>(XTT-35.) .AND. ZEMBRYO(JL)>1.0E-8) THEN
+ ZZX(JL) = ZZX(JL) + ZEMBRYO(JL) * XPI * (XMDIAM_IFN(JSPECIE))**2 / 2.0 &
+ * EXP(2*(LOG(XSIGMA_IFN(JSPECIE)))**2) &
+ * (1.0+SIGN(1.,SQRT(2.0)*LOG(XSIGMA_IFN(JSPECIE))-XB)*GAMMA_INC(0.5,(SQRT(2.0)*LOG(XSIGMA_IFN(JSPECIE))-XB)**2))
+ END IF
+ ENDDO
+
+!
+! For other T, integration between 0 and infinity is made with a Gauss-Hermite
+! quadrature method and integration between 0 and 0.1 uses e(x) ~ 1+x+O(x**2)
+! Beware : here, weights are normalized : XWEIGHT = wi/sqrt(pi)
+!
+ GINTEG(:) = ZZT(:)<=(XTT-35.) .AND. ZSI(:)>1.0 .AND. ZEMBRYO(:)>1.0E-8
+!
+ DO JL = 1, NDIAM
+ DO JL2 = 1, SIZE(GINTEG)
+ IF (GINTEG(JL2)) THEN
+ ZZX(JL2) = ZZX(JL2) - XWEIGHT(JL)*EXP(-ZEMBRYO(JL2)*XPI*(XMDIAM_IFN(JSPECIE))**2 &
+ * EXP(2.0*SQRT(2.0)*LOG(XSIGMA_IFN(JSPECIE)) * XABSCISS(JL)) )
+ END IF
+ ENDDO
+ ENDDO
+!
+! DO JL2 = 1, SIZE(GINTEG)
+! IF (GINTEG(JL2)) THEN
+! ZZX(JL2) = ZZX(JL2) + 0.5* XPI*ZEMBRYO(JL2)*(XMDIAM_IFN(JSPECIE))**2 &
+! * (1.0-( 1.0-GAMMA_INC(0.5,(SQRT(2.0)*LOG(XSIGMA_IFN(JSPECIE))-XB)**2)) &
+! * EXP( 2.0*(LOG(XSIGMA_IFN(JSPECIE)))**2) )
+! END IF
+! ENDDO
+ DO JL2 = 1, SIZE(GINTEG)
+ IF (GINTEG(JL2)) THEN
+ ZZX(JL2) = 1 + ZZX(JL2) &
+ - ( 0.5* XPI*ZEMBRYO(JL2)*(XMDIAM_IFN(JSPECIE))**2 * EXP( 2.0*(LOG(XSIGMA_IFN(JSPECIE)))**2) &
+ * ( 1.0-SIGN(1.,SQRT(2.0)*LOG(XSIGMA_IFN(JSPECIE))-XB)*GAMMA_INC(0.5,(SQRT(2.0)*LOG(XSIGMA_IFN(JSPECIE))-XB)**2)) )
+ END IF
+ ENDDO
+!
+ Z_FRAC_ACT(:,JSPECIE)=ZZX(:)
+!
+ DEALLOCATE(ZZX)
+ DEALLOCATE(ZFACTOR)
+ DEALLOCATE(ZSUBSAT)
+ DEALLOCATE(ZEMBRYO)
+ DEALLOCATE(GINTEG)
+!
+ENDDO
+!
+END SUBROUTINE LIMA_PHILLIPS_INTEG
diff --git a/src/mesonh/micro/lima_phillips_ref_spectrum.f90 b/src/mesonh/micro/lima_phillips_ref_spectrum.f90
new file mode 100644
index 000000000..d549d7051
--- /dev/null
+++ b/src/mesonh/micro/lima_phillips_ref_spectrum.f90
@@ -0,0 +1,140 @@
+! ######################################
+ MODULE MODI_LIMA_PHILLIPS_REF_SPECTRUM
+! ######################################
+!
+INTERFACE
+ SUBROUTINE LIMA_PHILLIPS_REF_SPECTRUM (ZZT, ZSI, ZSI_W, ZZY)
+!
+REAL, DIMENSION(:), INTENT(IN) :: ZZT ! Temperature
+REAL, DIMENSION(:), INTENT(IN) :: ZSI ! Saturation over ice
+REAL, DIMENSION(:), INTENT(IN) :: ZSI_W ! Saturation over ice at water sat.
+REAL, DIMENSION(:), INTENT(INOUT) :: ZZY ! Reference activity spectrum
+!
+END SUBROUTINE LIMA_PHILLIPS_REF_SPECTRUM
+END INTERFACE
+END MODULE MODI_LIMA_PHILLIPS_REF_SPECTRUM
+!
+! ######################################################################
+ SUBROUTINE LIMA_PHILLIPS_REF_SPECTRUM (ZZT, ZSI, ZSI_W, ZZY)
+! ######################################################################
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the reference activation spectrum
+!! described by Phillips (2008)
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Phillips et al., 2008: An empirical parameterization of heterogeneous
+!! ice nucleation for multiple chemical species of aerosols, J. Atmos. Sci.
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY : XTT
+USE MODD_PARAM_LIMA, ONLY : XGAMMA, XRHO_CFDC
+USE MODI_LIMA_FUNCTIONS, ONLY : RECT, DELTA
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, DIMENSION(:), INTENT(IN) :: ZZT ! Temperature
+REAL, DIMENSION(:), INTENT(IN) :: ZSI ! Saturation over ice
+REAL, DIMENSION(:), INTENT(IN) :: ZSI_W ! Saturation over ice at water sat.
+REAL, DIMENSION(:), INTENT(INOUT) :: ZZY ! Reference activity spectrum
+!
+!* 0.2 Declarations of local variables :
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZMAX, &
+ ZMOY, &
+ ZZY1, &
+ ZZY2, &
+ Z1, &
+ Z2, &
+ ZSI2
+!
+REAL :: XPSI
+!
+!-------------------------------------------------------------------------------
+!
+ALLOCATE(ZMAX(SIZE(ZZT))) ; ZMAX(:)= 0.0
+ALLOCATE(ZMOY(SIZE(ZZT))) ; ZMOY(:)= 0.0
+ALLOCATE(ZZY1(SIZE(ZZT))) ; ZZY1(:)= 0.0
+ALLOCATE(ZZY2(SIZE(ZZT))) ; ZZY2(:)= 0.0
+ALLOCATE(Z1(SIZE(ZZT))) ; Z1(:) = 0.0
+ALLOCATE(Z2(SIZE(ZZT))) ; Z2(:) = 0.0
+ALLOCATE(ZSI2(SIZE(ZZT))) ; ZSI2(:)= 0.0
+!
+ZZY(:) = 0.0
+!
+XPSI = 0.058707*XGAMMA/XRHO_CFDC
+!
+ZSI2(:)=min(ZSI(:),ZSI_W(:))
+!
+WHERE( ZSI(:)>1.0 )
+!
+!* T <= -35 C
+!
+ ZZY(:) =1000.*XGAMMA/XRHO_CFDC &
+ * ( EXP(12.96*(MIN(ZSI2(:),7.)-1.1)) )**0.3 &
+ * RECT(1.,0.,ZZT(:),(XTT-80.),(XTT-35.))
+!
+!* -35 C < T <= -25 C (in Appendix A)
+!
+ ZZY1(:) =1000.*XGAMMA/XRHO_CFDC &
+ * ( EXP(12.96*(MIN(ZSI2(:),7.)-1.1)) )**0.3
+ ZZY2(:) =1000.*XPSI &
+ * EXP(12.96*(MIN(ZSI2(:),7.)-1.0)-0.639)
+!
+!* -35 C < T <= -30 C
+!
+ ZMAX(:) =1000.*XGAMMA/XRHO_CFDC &
+ * ( EXP(12.96*(ZSI_W(:)-1.1)) )**0.3 &
+ * RECT(1.,0.,ZZT(:),(XTT-35.),(XTT-30.))
+!
+!* -30 C < T <= -25 C
+!
+ ZMAX(:) = ZMAX(:) +1000.*XPSI &
+ * EXP( 12.96*(ZSI_W(:)-1.0)-0.639 ) &
+ * RECT(1.,0.,ZZT(:),(XTT-30.),(XTT-25.))
+ Z1(:) = MIN(ZZY1(:), ZMAX(:))
+ Z2(:) = MIN(ZZY2(:), ZMAX(:))
+!
+!* T > -25 C
+!
+ ZZY(:) = ZZY(:) + 1000.*XPSI &
+ * EXP( 12.96*(MIN(ZSI2(:),7.)-1.0)-0.639 ) &
+ * RECT(1.,0.,ZZT(:),(XTT-25.),(XTT-2.))
+END WHERE
+!
+WHERE (Z2(:)>0.0 .AND. Z1(:)>0.0)
+ ZMOY(:) = Z2(:)*(Z1(:)/Z2(:))**DELTA(1.,0.,ZZT(:),(XTT-35.),(XTT-25.))
+ ZZY(:) = ZZY(:) + MIN(ZMOY(:),ZMAX(:)) ! N_{IN,1,*}
+END WHERE
+!
+!++cb++
+DEALLOCATE(ZMAX)
+DEALLOCATE(ZMOY)
+DEALLOCATE(ZZY1)
+DEALLOCATE(ZZY2)
+DEALLOCATE(Z1)
+DEALLOCATE(Z2)
+!--cb--
+!
+END SUBROUTINE LIMA_PHILLIPS_REF_SPECTRUM
diff --git a/src/mesonh/micro/lima_precip_scavenging.f90 b/src/mesonh/micro/lima_precip_scavenging.f90
new file mode 100644
index 000000000..aaabf3f29
--- /dev/null
+++ b/src/mesonh/micro/lima_precip_scavenging.f90
@@ -0,0 +1,856 @@
+!MNH_LIC Copyright 2013-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ##################################
+ MODULE MODI_LIMA_PRECIP_SCAVENGING
+! ##################################
+!
+INTERFACE
+ SUBROUTINE LIMA_PRECIP_SCAVENGING (HCLOUD, KLUOUT, KTCOUNT, PTSTEP, &
+ PRRT, PRHODREF, PRHODJ, PZZ, &
+ PPABST, PTHT, PSVT, PRSVS, PINPAP )
+
+use modd_nsv, only: nsv_lima_beg
+
+CHARACTER(LEN=4), INTENT(IN) :: HCLOUD ! cloud paramerization
+INTEGER, INTENT(IN) :: KLUOUT ! unit for output listing
+INTEGER, INTENT(IN) :: KTCOUNT ! iteration count
+REAL, INTENT(IN) :: PTSTEP ! Double timestep except
+ ! for the first time step
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain mixing ratio at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Air Density [kg/m**3]
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry Density [kg]
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Altitude
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute pressure at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+!
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(IN) :: PSVT ! Particle Concentration [kg-1]
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(INOUT) :: PRSVS ! Total Number Scavenging Rate
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPAP
+!
+END SUBROUTINE LIMA_PRECIP_SCAVENGING
+END INTERFACE
+END MODULE MODI_LIMA_PRECIP_SCAVENGING
+!
+!########################################################################
+ SUBROUTINE LIMA_PRECIP_SCAVENGING (HCLOUD, KLUOUT, KTCOUNT, PTSTEP, &
+ PRRT, PRHODREF, PRHODJ, PZZ, &
+ PPABST, PTHT, PSVT, PRSVS, PINPAP )
+!########################################################################x
+!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the total number
+!! below-cloud scavenging rate.
+!!
+!!
+!!** METHOD
+!! ------
+!! We assume a generalized gamma distribution law for the raindrop.
+!! The aerosols particles distribution follows a log-normal law.
+!! First, we have to compute the Collision Efficiency, which takes
+!! account of the three most important wet removal mechanism :
+!! Brownian diffusion, interception and inertial impaction.
+!! It is a function of several number (like Reynolds, Schmidt
+!! or Stokes number for instance). Consequently,
+!! we need first to calculate these numbers.
+!!
+!! Then the scavenging coefficient is deduced from the integration
+!! of the droplet size distribution, the falling velocity of
+!! raindrop and aerosol, their diameter, and the collision
+!! (or collection) efficiency, over the spectrum of droplet
+!! diameters.
+!!
+!! The total scavenging rate of aerosol is computed from the
+!! integration, over all the spectrum of particles aerosols
+!! diameters, of the scavenging coefficient.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! Subroutine SCAV_MASS_SEDIMENTATION
+!!
+!! Function COLL_EFFIC : computes the collision efficiency
+!!
+!! Function CONTJV |
+!! Function GAUHER |
+!! Function GAULAG |-> in lima_functions.f90
+!! Function GAMMLN |
+!!
+!!
+!! REFERENCES
+!! ----------
+!! Seinfeld and Pandis
+!! Andronache
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!!
+! P. Wautelet 28/05/2018: corrected truncated integer division (3/2 -> 1.5)
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+! P. Wautelet 03/2020: use the new data structures and subroutines for budgets
+! P. Wautelet 03/06/2020: bugfix: correct array starts for PSVT and PRSVS
+! P. Wautelet 11/02/2021: bugfix: ZRTMIN was of wrong size (replaced by a scalar)
+! P. Wautelet 11/02/2021: budgets: add missing term SCAV for NSV_LIMA_SCAVMASS budget
+!-------------------------------------------------------------------------------
+!
+!* 0.DECLARATIONS
+! --------------
+!
+use modd_budget, only: lbudget_sv, NBUDGET_SV1, tbudgets
+USE MODD_CST
+USE MODD_NSV
+USE MODD_PARAMETERS
+USE MODD_PARAM_LIMA, ONLY: NMOD_IFN, NSPECIE, XFRAC, &
+ XMDIAM_IFN, XSIGMA_IFN, XRHO_IFN, &
+ NMOD_CCN, XR_MEAN_CCN, XLOGSIG_CCN, XRHO_CCN, &
+ XALPHAR, XNUR, &
+ LAERO_MASS, NDIAMR, NDIAMP, XT0SCAV, XTREF, XNDO, &
+ XMUA0, XT_SUTH_A, XMFPA0, XVISCW, XRHO00, &
+ XRTMIN, XCTMIN
+USE MODD_PARAM_LIMA_WARM, ONLY: XCR, XDR
+
+use mode_budget, only: Budget_store_init, Budget_store_end
+use mode_tools, only: Countjv
+
+USE MODI_GAMMA
+USE MODI_INI_NSV
+USE MODI_LIMA_FUNCTIONS
+
+IMPLICIT NONE
+!
+!* 0.1 declarations of dummy arguments :
+!
+CHARACTER(LEN=4), INTENT(IN) :: HCLOUD ! cloud paramerization
+INTEGER, INTENT(IN) :: KLUOUT ! unit for output listing
+INTEGER, INTENT(IN) :: KTCOUNT ! iteration count
+REAL, INTENT(IN) :: PTSTEP ! Double timestep except
+ ! for the first time step
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain mixing ratio at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Air Density [kg/m**3]
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry Density [kg]
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Altitude
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute pressure at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+!
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(IN) :: PSVT ! Particle Concentration [/m**3]
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(INOUT) :: PRSVS ! Total Number Scavenging Rate
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPAP
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IIB ! Define the domain where is
+INTEGER :: IIE ! the microphysical sources have to be computed
+INTEGER :: IJB !
+INTEGER :: IJE !
+INTEGER :: IKB !
+INTEGER :: IKE !
+!
+INTEGER :: JSV ! CCN or IFN mode
+INTEGER :: J1, J2, IJ, JMOD
+!
+LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: GRAIN, &! Test where rain is present
+ GSCAV ! Test where rain is present
+INTEGER , DIMENSION(SIZE(GSCAV)) :: I1,I2,I3 ! Used to replace the COUNT
+INTEGER :: JL ! and PACK intrinsics
+INTEGER :: ISCAV
+!
+REAL :: ZDENS_RATIO, & !density ratio
+ ZNUM, & !PNU-1.
+ ZSHAPE_FACTOR
+!
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) :: ZW ! work array
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) :: PCRT ! cloud droplet conc.
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZLAMBDAR, & !slope parameter of the
+ ! generalized Gamma
+ !distribution law for the
+ !raindrop
+ ZVISC_RATIO, & !viscosity ratio
+ ZMFPA, & !Mean Free Path
+ ZRHODREF, & !Air Density [kg/m**3]
+ ZVISCA, & !Viscosity of Air [kg/(m*s)]
+ ZT, & !Absolute Temperature
+ ZPABST, &
+ ZRRT, &
+ ZCONCP, &
+ ZCONCR, &
+ ZTOT_SCAV_RATE,&
+ ZTOT_MASS_RATE,&
+ ZMEAN_SCAV_COEF
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: &
+ ZVOLDR, & !Mean volumic Raindrop diameter [m]
+ ZBC_SCAV_COEF, &
+ ZCUNSLIP, & !CUnningham SLIP correction factor
+ ZST_STAR, & !critical Stokes number for impaction
+ ZSC, & !aerosol particle Schmidt number
+ ZRE, & !raindrop Reynolds number (for radius)
+ ZFVELR, & !Falling VELocity of the Raindrop
+ ZRELT, & !RELaxation Time of the particle [s]
+ ZDIFF !Particle Diffusivity
+!
+REAL, DIMENSION(NDIAMP) :: ZVOLDP, & !Mean volumic diameter [m]
+ ZABSCISSP, & !Aerosol Abscisses
+ ZWEIGHTP !Aerosol Weights
+REAL, DIMENSION(NDIAMR) :: ZABSCISSR, & !Raindrop Abscisses
+ ZWEIGHTR !Raindrop Weights
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZCOL_EF, &! Collision efficiency
+ ZSIZE_RATIO, &! Size Ratio
+ ZST ! Stokes number
+!
+REAL, DIMENSION(SIZE(PRRT,1),SIZE(PRRT,2),SIZE(PRRT,3)) :: ZRRS
+!
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: PMEAN_SCAV_COEF, & !Mean Scavenging
+ ! Coefficient
+ PTOT_SCAV_RATE, & !Total Number
+ ! Scavenging Rate
+ PTOT_MASS_RATE !Total Mass
+ ! Scavenging Rate
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3),NDIAMP) &
+ ::PBC_SCAV_COEF !Scavenging Coefficient
+REAL, DIMENSION(:), ALLOCATABLE :: ZKNUDSEN ! Knuudsen number
+!
+! Opt. BVIE
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: ZT_3D, ZCONCR_3D, ZVISCA_3D, ZMFPA_3D, &
+ ZVISC_RATIO_3D, ZLAMBDAR_3D, FACTOR_3D
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3),NDIAMP) &
+ :: ZVOLDR_3D, ZVOLDR_3D_INV, ZVOLDR_3D_POW, &
+ ZFVELR_3D, ZRE_3D, ZRE_3D_SQRT, ZST_STAR_3D
+REAL, DIMENSION(:), ALLOCATABLE :: FACTOR
+REAL, DIMENSION(:,:), ALLOCATABLE :: &
+ ZRE_SQRT, & ! SQRT of raindrop Reynolds number
+ ZRE_INV, & ! INV of raindrop Reynolds number
+ ZSC_INV, & ! INV of aerosol particle Schmidt number
+ ZSC_SQRT, & ! SQRT of aerosol particle Schmidt number
+ ZSC_3SQRT, & ! aerosol particle Schmidt number**(1./3.)
+ ZVOLDR_POW, & ! Mean volumic Raindrop diameter [m] **(2+ZDR)
+ ZVOLDR_INV ! INV of Mean volumic Raindrop diameter [m]
+REAL :: ZDENS_RATIO_SQRT
+INTEGER :: SV_VAR, NM, JM
+integer :: idx
+REAL :: XMDIAMP
+REAL :: XSIGMAP
+REAL :: XRHOP
+REAL :: XFRACP
+!
+!
+!
+!------------------------------------------------------------------------------
+
+if ( lbudget_sv ) then
+ do jl = 1, nmod_ccn
+ idx = nsv_lima_ccn_free - 1 + jl
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + idx), 'SCAV', prsvs(:, :, :, idx) )
+ end do
+ do jl = 1, nmod_ifn
+ idx = nsv_lima_ifn_free - 1 + jl
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + idx), 'SCAV', prsvs(:, :, :, idx) )
+ end do
+ if ( laero_mass ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_scavmass), 'SCAV', prsvs(:, :, :, nsv_lima_scavmass) )
+ end if
+end if
+!
+!* 1. PRELIMINARY COMPUTATIONS
+! ------------------------
+!
+!
+IIB=1+JPHEXT
+IIE=SIZE(PRHODREF,1) - JPHEXT
+IJB=1+JPHEXT
+IJE=SIZE(PRHODREF,2) - JPHEXT
+IKB=1+JPVEXT
+IKE=SIZE(PRHODREF,3) - JPVEXT
+!
+! PCRT
+PCRT(:,:,:)=PSVT(:,:,:,NSV_LIMA_NR)
+!
+! Rain mask
+GRAIN(:,:,:) = .FALSE.
+GRAIN(IIB:IIE,IJB:IJE,IKB:IKE) = (PRRT(IIB:IIE,IJB:IJE,IKB:IKE)>XRTMIN(3) &
+ .AND. PCRT(IIB:IIE,IJB:IJE,IKB:IKE)>XCTMIN(3) )
+!
+! Initialize the total mass scavenging rate if LAERO_MASS=T
+IF (LAERO_MASS) PTOT_MASS_RATE(:,:,:) = 0.
+!
+! Quadrature method: compute absissae and weights
+CALL GAUHER(ZABSCISSP,ZWEIGHTP,NDIAMP)
+ZNUM = XNUR-1.0E0
+CALL GAULAG(ZABSCISSR,ZWEIGHTR,NDIAMR,ZNUM)
+!
+!
+!------------------------------------------------------------------------------
+!
+!
+!* 2. NUMERICAL OPTIMIZATION
+! ----------------------
+!
+!
+! Optimization : compute in advance parameters depending on rain particles and
+! environment conditions only, to avoid multiple identical computations in loops
+!
+!
+ZSHAPE_FACTOR = GAMMA_X0D(XNUR+3./XALPHAR)/GAMMA_X0D(XNUR)
+!
+WHERE ( GRAIN(:,:,:) )
+ !
+ ZT_3D(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:)/XP00 )**(XRD/XCPD)
+ ZCONCR_3D(:,:,:) = PCRT(:,:,:) * PRHODREF(:,:,:) ![/m3]
+ ! Sutherland law for viscosity of air
+ ZVISCA_3D(:,:,:) = XMUA0*(ZT_3D(:,:,:)/XTREF)**1.5*(XTREF+XT_SUTH_A) &
+ /(XT_SUTH_A+ZT_3D(:,:,:))
+ ! Air mean free path
+ ZMFPA_3D(:,:,:) = XMFPA0*(XP00*ZT_3D(:,:,:))/(PPABST(:,:,:)*XT0SCAV)
+ ! Viscosity ratio
+ ZVISC_RATIO_3D(:,:,:) = ZVISCA_3D(:,:,:)/XVISCW !!!!! inversé par rapport à orig. !
+ ! Rain drops parameters
+ ZLAMBDAR_3D(:,:,:) = ( ((XPI/6.)*ZSHAPE_FACTOR*XRHOLW*ZCONCR_3D(:,:,:)) &
+ /(PRHODREF(:,:,:)*PRRT(:,:,:)) )**(1./3.) ![/m]
+ FACTOR_3D(:,:,:) = XPI*0.25*ZCONCR_3D(:,:,:)*XCR*(XRHO00/PRHODREF(:,:,:))**(0.4)
+ !
+END WHERE
+!
+DO J2=1,NDIAMR
+ WHERE ( GRAIN(:,:,:) )
+ ! exchange of variables: [m]
+ ZVOLDR_3D(:,:,:,J2) = ZABSCISSR(J2)**(1./XALPHAR)/ZLAMBDAR_3D(:,:,:)
+ ZVOLDR_3D_INV(:,:,:,J2) = 1./ZVOLDR_3D(:,:,:,J2)
+ ZVOLDR_3D_POW(:,:,:,J2) = ZVOLDR_3D(:,:,:,J2)**(2.+XDR)
+ ! Raindrop Falling VELocity [m/s]
+ ZFVELR_3D(:,:,:,J2) = XCR*(ZVOLDR_3D(:,:,:,J2)**XDR)*(XRHO00/PRHODREF(:,:,:))**(0.4)
+ ! Reynolds number
+ ZRE_3D(:,:,:,J2) = ZVOLDR_3D(:,:,:,J2)*ZFVELR_3D(:,:,:,J2) &
+ *PRHODREF(:,:,:)/(2.0*ZVISCA_3D(:,:,:))
+ ZRE_3D_SQRT(:,:,:,J2) = SQRT( ZRE_3D(:,:,:,J2) )
+ ! Critical Stokes number
+ ZST_STAR_3D(:,:,:,J2) = (1.2+(LOG(1.+ZRE_3D(:,:,:,J2)))/12.) &
+ /(1.+LOG(1.+ZRE_3D(:,:,:,J2)))
+ END WHERE
+END DO
+!
+!
+!------------------------------------------------------------------------------
+!
+!
+!* 3. AEROSOL SCAVENGING
+! ------------------
+!
+!
+! Iteration over the aerosol type and mode
+!
+DO JSV = 1, NMOD_CCN+NMOD_IFN
+!
+ IF (JSV .LE. NMOD_CCN) THEN
+ JMOD = JSV
+ SV_VAR = NSV_LIMA_CCN_FREE -1 + JMOD ! Variable number in PSVT
+ NM = 1 ! Number of species (for IFN int. mixing)
+ ELSE
+ JMOD = JSV - NMOD_CCN
+ SV_VAR = NSV_LIMA_IFN_FREE -1 + JMOD
+ NM = NSPECIE
+ END IF
+!
+ PBC_SCAV_COEF(:,:,:,:) = 0.
+ PMEAN_SCAV_COEF(:,:,:) = 0.
+ PTOT_SCAV_RATE(:,:,:) = 0.
+!
+ GSCAV(:,:,:) = .FALSE.
+ GSCAV(IIB:IIE,IJB:IJE,IKB:IKE) =GRAIN(IIB:IIE,IJB:IJE,IKB:IKE) .AND. &
+ (PSVT(IIB:IIE,IJB:IJE,IKB:IKE,SV_VAR)>1.0E-2)
+ ISCAV = COUNTJV(GSCAV(:,:,:),I1(:),I2(:),I3(:))
+!
+ IF( ISCAV>=1 ) THEN
+ ALLOCATE(ZVISC_RATIO(ISCAV))
+ ALLOCATE(ZRHODREF(ISCAV))
+ ALLOCATE(ZVISCA(ISCAV))
+ ALLOCATE(ZT(ISCAV))
+ ALLOCATE(ZRRT(ISCAV))
+ ALLOCATE(ZCONCR(ISCAV))
+ ALLOCATE(ZLAMBDAR(ISCAV))
+ ALLOCATE(ZCONCP(ISCAV))
+ ALLOCATE(ZMFPA(ISCAV))
+ ALLOCATE(ZTOT_SCAV_RATE(ISCAV))
+ ALLOCATE(ZTOT_MASS_RATE(ISCAV))
+ ALLOCATE(ZMEAN_SCAV_COEF(ISCAV))
+ ALLOCATE(ZPABST(ISCAV))
+ ALLOCATE(ZKNUDSEN(ISCAV))
+ ALLOCATE(FACTOR(ISCAV))
+!
+ ALLOCATE(ZCUNSLIP(ISCAV,NDIAMP))
+ ALLOCATE(ZBC_SCAV_COEF(ISCAV,NDIAMP))
+ ALLOCATE(ZSC(ISCAV,NDIAMP))
+ ALLOCATE(ZSC_INV(ISCAV,NDIAMP))
+ ALLOCATE(ZSC_SQRT(ISCAV,NDIAMP))
+ ALLOCATE(ZSC_3SQRT(ISCAV,NDIAMP))
+ ALLOCATE(ZRELT(ISCAV,NDIAMP))
+ ALLOCATE(ZDIFF(ISCAV,NDIAMP))
+ ALLOCATE(ZVOLDR(ISCAV,NDIAMR))
+ ALLOCATE(ZVOLDR_POW(ISCAV,NDIAMR))
+ ALLOCATE(ZVOLDR_INV(ISCAV,NDIAMR))
+ ALLOCATE(ZRE(ISCAV,NDIAMR))
+ ALLOCATE(ZRE_INV(ISCAV,NDIAMR))
+ ALLOCATE(ZRE_SQRT(ISCAV,NDIAMR))
+ ALLOCATE(ZST_STAR(ISCAV,NDIAMR))
+ ALLOCATE(ZFVELR(ISCAV,NDIAMR))
+ ALLOCATE(ZST(ISCAV,NDIAMP,NDIAMR))
+ ALLOCATE(ZCOL_EF(ISCAV,NDIAMP,NDIAMR))
+ ALLOCATE(ZSIZE_RATIO(ISCAV,NDIAMP,NDIAMR))
+!
+ ZMEAN_SCAV_COEF(:)=0.
+ ZTOT_SCAV_RATE(:) =0.
+ ZTOT_MASS_RATE(:) =0.
+ DO JL=1,ISCAV
+ ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
+ ZT(JL) = ZT_3D(I1(JL),I2(JL),I3(JL))
+ ZRRT(JL) = PRRT(I1(JL),I2(JL),I3(JL))
+ ZPABST(JL) = PPABST(I1(JL),I2(JL),I3(JL))
+ ZCONCP(JL) = PSVT(I1(JL),I2(JL),I3(JL),SV_VAR)*ZRHODREF(JL)![/m3]
+ ZCONCR(JL) = ZCONCR_3D(I1(JL),I2(JL),I3(JL)) ![/m3]
+ ZVISCA(JL) = ZVISCA_3D(I1(JL),I2(JL),I3(JL))
+ ZMFPA(JL) = ZMFPA_3D(I1(JL),I2(JL),I3(JL))
+ ZVISC_RATIO(JL) = ZVISC_RATIO_3D(I1(JL),I2(JL),I3(JL))
+ ZLAMBDAR(JL) = ZLAMBDAR_3D(I1(JL),I2(JL),I3(JL))
+ FACTOR(JL) = FACTOR_3D(I1(JL),I2(JL),I3(JL))
+ ZVOLDR(JL,:) = ZVOLDR_3D(I1(JL),I2(JL),I3(JL),:)
+ ZVOLDR_POW(JL,:) = ZVOLDR_3D_POW(I1(JL),I2(JL),I3(JL),:)
+ ZVOLDR_INV(JL,:) = ZVOLDR_3D_INV(I1(JL),I2(JL),I3(JL),:)
+ ZFVELR(JL,:) = ZFVELR_3D(I1(JL),I2(JL),I3(JL),:)
+ ZRE(JL,:) = ZRE_3D(I1(JL),I2(JL),I3(JL),:)
+ ZRE_SQRT(JL,:) = ZRE_3D_SQRT(I1(JL),I2(JL),I3(JL),:)
+ ZST_STAR(JL,:) = ZST_STAR_3D(I1(JL),I2(JL),I3(JL),:)
+ ENDDO
+ ZRE_INV(:,:) = 1./ZRE(:,:)
+
+ IF (ANY(ZCONCR .eq. 0.)) print *, 'valeur nulle dans ZLAMBDAR !'
+ IF (ANY(ZLAMBDAR .eq. 0.)) print *, 'valeur nulle dans ZLAMBDAR !'
+!
+!------------------------------------------------------------------------------------
+!
+! Loop over the different species (for IFN int. mixing)
+!
+ DO JM = 1, NM ! species (DM1,DM2,BC,O) for IFN
+ IF ( JSV .LE. NMOD_CCN ) THEN ! CCN case
+ XRHOP = XRHO_CCN(JMOD)
+ XMDIAMP = 2*XR_MEAN_CCN(JMOD)
+ XSIGMAP = EXP(XLOGSIG_CCN(JMOD))
+ XFRACP = 1.0
+ ELSE ! IFN case
+ XRHOP = XRHO_IFN(JM)
+ XMDIAMP = XMDIAM_IFN(JM)
+ XSIGMAP = XSIGMA_IFN(JM)
+ XFRACP = XFRAC(JM,JMOD)
+ END IF
+ !-----------------------------------------------------------------------------
+ ! Loop over the aerosols particles diameters (log normal distribution law) :
+ !
+ DO J1=1,NDIAMP
+ ! exchange of variables: [m]
+ ZVOLDP(J1) = XMDIAMP * EXP(ZABSCISSP(J1)*SQRT(2.)*LOG(XSIGMAP))
+ ! Cunningham slip correction factor (1+alpha*Knudsen)
+ ZKNUDSEN(:) = MIN( 20.,ZVOLDP(J1)/ZMFPA(:) )
+ ZCUNSLIP(:,J1) = 1.0+2.0/ZKNUDSEN(:)*(1.257+0.4*EXP(-0.55*ZKNUDSEN(:)))
+ ! Diffusion coefficient
+ ZDIFF(:,J1) = XBOLTZ*ZT(:)*ZCUNSLIP(:,J1)/(3.*XPI*ZVISCA(:)*ZVOLDP(J1))
+ ! Schmidt number
+ ZSC(:,J1) = ZVISCA(:)/(ZRHODREF(:)*ZDIFF(:,J1))
+ ZSC_INV(:,J1) = 1./ZSC(:,J1)
+ ZSC_SQRT(:,J1) = SQRT( ZSC(:,J1) )
+ ZSC_3SQRT(:,J1) = ZSC(:,J1)**(1./3.)
+ ! Characteristic Time Required for reaching terminal velocity
+ ZRELT(:,J1) = (ZVOLDP(J1)**2)*ZCUNSLIP(:,J1)*XRHOP/(18.*ZVISCA(:))
+ ! Density number
+ ZDENS_RATIO = XRHOP/XRHOLW
+ ZDENS_RATIO_SQRT = SQRT(ZDENS_RATIO)
+ ! Initialisation
+ ZBC_SCAV_COEF(:,J1)=0.
+ !-------------------------------------------------------------------------
+ ! Loop over the drops diameters (generalized Gamma distribution) :
+ !
+ DO J2=1,NDIAMR
+ ! Stokes number
+ ZST(:,J1,J2) = 2.*ZRELT(:,J1)*(ZFVELR(:,J2)-ZRELT(1,J1)*XG) &
+ *ZVOLDR_INV(:,J2)
+ ! Size Ratio
+ ZSIZE_RATIO(:,J1,J2) = ZVOLDP(J1)*ZVOLDR_INV(:,J2)
+ ! Collision Efficiency
+ ZCOL_EF(:,J1,J2) = COLL_EFFI(ZRE, ZRE_INV, ZRE_SQRT, ZSC, ZSC_INV, &
+ ZSC_SQRT, ZSC_3SQRT, ZST, ZST_STAR, &
+ ZSIZE_RATIO, ZVISC_RATIO, ZDENS_RATIO_SQRT)
+ ! Below-Cloud Scavenging Coefficient for a fixed ZVOLDP: [/s]
+ ZBC_SCAV_COEF(:,J1) = ZBC_SCAV_COEF(:,J1) + &
+ ZCOL_EF(:,J1,J2) * ZWEIGHTR(J2) * FACTOR(:) * ZVOLDR_POW(:,J2)
+ END DO
+ ! End of the loop over the drops diameters
+ !--------------------------------------------------------------------------
+
+ ! Total NUMBER Scavenging Rate of aerosol [m**-3.s**-1]
+ ZTOT_SCAV_RATE(:) = ZTOT_SCAV_RATE(:) - &
+ ZWEIGHTP(J1)*XFRACP*ZCONCP(:)*ZBC_SCAV_COEF(:,J1)
+ ! Total MASS Scavenging Rate of aerosol [kg.m**-3.s**-1]
+ ZTOT_MASS_RATE(:) = ZTOT_MASS_RATE(:) + &
+ ZWEIGHTP(J1)*XFRACP*ZCONCP(:)*ZBC_SCAV_COEF(:,J1) &
+ *XPI/6.*XRHOP*(ZVOLDP(J1)**3)
+ END DO
+ ! End of the loop over the drops diameters
+ !--------------------------------------------------------------------------
+
+ ! Total NUMBER Scavenging Rate of aerosol [m**-3.s**-1]
+ PTOT_SCAV_RATE(:,:,:)=UNPACK(ZTOT_SCAV_RATE(:),MASK=GSCAV(:,:,:),FIELD=0.0)
+ ! Free particles (CCN or IFN) [/s]:
+ PRSVS(:,:,:,SV_VAR) = max(PRSVS(:,:,:,SV_VAR)+PTOT_SCAV_RATE(:,:,:) &
+ * PRHODJ(:,:,:)/PRHODREF(:,:,:) , 0.0 )
+ ! Total MASS Scavenging Rate of aerosol which REACH THE FLOOR because of
+ ! rain sedimentation [kg.m**-3.s**-1]
+ IF (LAERO_MASS)THEN
+ PTOT_MASS_RATE(:,:,:) = PTOT_MASS_RATE(:,:,:) + &
+ UNPACK(ZTOT_MASS_RATE(:), MASK=GSCAV(:,:,:), FIELD=0.0)
+ CALL SCAV_MASS_SEDIMENTATION( HCLOUD, PTSTEP, KTCOUNT, PZZ, PRHODJ, &
+ PRHODREF, PRRT, PSVT(:,:,:,NSV_LIMA_SCAVMASS),&
+ PRSVS(:,:,:,NSV_LIMA_SCAVMASS), PINPAP )
+ PRSVS(:,:,:,NSV_LIMA_SCAVMASS)=PRSVS(:,:,:,NSV_LIMA_SCAVMASS) + &
+ PTOT_MASS_RATE(:,:,:)*PRHODJ(:,:,:)/PRHODREF(:,:,:)
+ END IF
+ ENDDO
+! End of the loop over the aerosol species
+!--------------------------------------------------------------------------
+!
+!
+!
+ DEALLOCATE(FACTOR)
+ DEALLOCATE(ZSC_INV)
+ DEALLOCATE(ZSC_SQRT)
+ DEALLOCATE(ZSC_3SQRT)
+ DEALLOCATE(ZRE_INV)
+ DEALLOCATE(ZRE_SQRT)
+ DEALLOCATE(ZVOLDR_POW)
+ DEALLOCATE(ZVOLDR_INV)
+!
+ DEALLOCATE(ZFVELR)
+ DEALLOCATE(ZRE)
+ DEALLOCATE(ZST_STAR)
+ DEALLOCATE(ZST)
+ DEALLOCATE(ZSIZE_RATIO)
+ DEALLOCATE(ZCOL_EF)
+ DEALLOCATE(ZVOLDR)
+ DEALLOCATE(ZDIFF)
+ DEALLOCATE(ZRELT)
+ DEALLOCATE(ZSC)
+ DEALLOCATE(ZCUNSLIP)
+ DEALLOCATE(ZBC_SCAV_COEF)
+!
+ DEALLOCATE(ZTOT_SCAV_RATE)
+ DEALLOCATE(ZTOT_MASS_RATE)
+ DEALLOCATE(ZMEAN_SCAV_COEF)
+!
+ DEALLOCATE(ZRRT)
+ DEALLOCATE(ZCONCR)
+ DEALLOCATE(ZLAMBDAR)
+ DEALLOCATE(ZCONCP)
+ DEALLOCATE(ZVISC_RATIO)
+ DEALLOCATE(ZRHODREF)
+ DEALLOCATE(ZVISCA)
+ DEALLOCATE(ZPABST)
+ DEALLOCATE(ZKNUDSEN)
+ DEALLOCATE(ZT)
+ DEALLOCATE(ZMFPA)
+ ENDIF
+ENDDO
+!
+if ( lbudget_sv ) then
+ do jl = 1, nmod_ccn
+ idx = nsv_lima_ccn_free - 1 + jl
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + idx), 'SCAV', prsvs(:, :, :, idx) )
+ end do
+ do jl = 1, nmod_ifn
+ idx = nsv_lima_ifn_free - 1 + jl
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + idx), 'SCAV', prsvs(:, :, :, idx) )
+ end do
+ if ( laero_mass ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_scavmass), 'SCAV', prsvs(:, :, :, nsv_lima_scavmass) )
+ end if
+end if
+!------------------------------------------------------------------------------
+!
+!
+!* 3. SUBROUTINE AND FUNCTION
+! -----------------------
+!
+!
+CONTAINS
+!
+!------------------------------------------------------------------------------
+! ##########################################################################
+ SUBROUTINE SCAV_MASS_SEDIMENTATION( HCLOUD, PTSTEP, KTCOUNT, PZZ, PRHODJ,&
+ PRHODREF, PRAIN, PSVT_MASS, PRSVS_MASS, PINPAP )
+! ##########################################################################
+!
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the total mass of aerosol
+!! scavenged by precipitations
+!!
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!! None
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS
+!! JPHEXT : Horizontal external points number
+!! JPVEXT : Vertical external points number
+!! Module MODD_CONF :
+!! CCONF configuration of the model for the first time step
+!!
+!! REFERENCE
+!! ---------
+!! Book1 of the documentation ( routine CH_AQUEOUS_SEDIMENTATION )
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 22/07/07
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS
+USE MODD_CONF
+!
+USE MODD_PARAM_LIMA, ONLY : XCEXVT, XRTMIN
+USE MODD_PARAM_LIMA_WARM, ONLY : XBR, XDR, XFSEDRR
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+!
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Cloud parameterization
+REAL, INTENT(IN) :: PTSTEP ! Time step
+INTEGER, INTENT(IN) :: KTCOUNT ! Current time step number
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry Density [kg]
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRAIN ! Rain water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVT_MASS ! Precip. aerosols at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRSVS_MASS ! Precip. aerosols source
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPAP
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: JJ, JK, JN, JRR ! Loop indexes
+INTEGER :: IIB, IIE, IJB, IJE, IKB, IKE ! Physical domain
+!
+REAL :: ZTSPLITR ! Small time step for rain sedimentation
+REAL :: ZTSTEP ! Large time step for rain sedimentation
+!
+!
+LOGICAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
+ :: GSEDIM ! where to compute the SED processes
+INTEGER :: ISEDIM
+INTEGER , DIMENSION(SIZE(GSEDIM)) :: I1,I2,I3 ! Used to replace the COUNT
+INTEGER :: JL ! and PACK intrinsics
+!
+!
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
+ :: ZW, & ! work array
+ ZWSED, & ! sedimentation fluxes
+ ZZS ! Rain water m.r. source
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZRRS, & ! Rain water m.r. source
+ ZRHODREF, & ! RHO Dry REFerence
+ ZZW ! Work array
+!
+REAL :: ZRTMIN3
+!
+!
+REAL :: ZVTRMAX, ZDZMIN, ZT
+REAL, SAVE :: ZEXSEDR
+LOGICAL, SAVE :: GSFIRSTCALL = .TRUE.
+INTEGER, SAVE :: ISPLITR
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTE THE LOOP BOUNDS
+! -----------------------
+!
+IIB=1+JPHEXT
+IIE=SIZE(PZZ,1) - JPHEXT
+IJB=1+JPHEXT
+IJE=SIZE(PZZ,2) - JPHEXT
+IKB=1+JPVEXT
+IKE=SIZE(PZZ,3) - JPVEXT
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. COMPUTE THE SEDIMENTATION (RS) SOURCE
+! -------------------------------------
+!
+!* 2.1 splitting factor for high Courant number C=v_fall*(del_Z/del_T)
+!
+firstcall : IF (GSFIRSTCALL) THEN
+ GSFIRSTCALL = .FALSE.
+ ZVTRMAX = 10.
+ ZDZMIN = MINVAL(PZZ(IIB:IIE,IJB:IJE,IKB+1:IKE+1)-PZZ(IIB:IIE,IJB:IJE,IKB:IKE))
+ ISPLITR = 1
+ SPLIT : DO
+ ZT = 2.* PTSTEP / REAL(ISPLITR)
+ IF ( ZT * ZVTRMAX / ZDZMIN .LT. 1.) EXIT SPLIT
+ ISPLITR = ISPLITR + 1
+ END DO SPLIT
+!
+ ZEXSEDR = (XBR+XDR+1.0)/(XBR+1.0)
+!
+END IF firstcall
+!
+!* 2.2 time splitting loop initialization
+!
+IF( (KTCOUNT==1) .AND. (CCONF=='START') ) THEN
+ ZTSPLITR = PTSTEP / REAL(ISPLITR) ! Small time step
+ ZTSTEP = PTSTEP ! Large time step
+ ELSE
+ ZTSPLITR= 2. * PTSTEP / REAL(ISPLITR)
+ ZTSTEP = 2. * PTSTEP
+END IF
+!
+!* 2.3 compute the fluxes
+!
+! optimization by looking for locations where
+! the precipitating fields are larger than a minimal value only !!!
+!
+ZRTMIN3 = XRTMIN(3) / ZTSTEP
+ZZS(:,:,:) = PRAIN(:,:,:)
+DO JN = 1 , ISPLITR
+ GSEDIM(:,:,:) = .FALSE.
+ GSEDIM(IIB:IIE,IJB:IJE,IKB:IKE) = ZZS(IIB:IIE,IJB:IJE,IKB:IKE) > ZRTMIN3
+!
+ ISEDIM = COUNTJV( GSEDIM(:,:,:),I1(:),I2(:),I3(:))
+ IF( ISEDIM >= 1 ) THEN
+ IF( JN==1 ) THEN
+ ZZS(:,:,:) = ZZS(:,:,:) * ZTSTEP
+ DO JK = IKB , IKE-1
+ ZW(:,:,JK) =ZTSPLITR*2./(PRHODREF(:,:,JK)*(PZZ(:,:,JK+2)-PZZ(:,:,JK)))
+ END DO
+ ZW(:,:,IKE) =ZTSPLITR/(PRHODREF(:,:,IKE)*(PZZ(:,:,IKE+1)-PZZ(:,:,IKE)))
+ END IF
+ ALLOCATE(ZRRS(ISEDIM))
+ ALLOCATE(ZRHODREF(ISEDIM))
+ DO JL=1,ISEDIM
+ ZRRS(JL) = ZZS(I1(JL),I2(JL),I3(JL))
+ ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
+ ENDDO
+ ALLOCATE(ZZW(ISEDIM)) ; ZZW(:) = 0.0
+!
+!* 2.2.1 for rain
+!
+ ZZW(:) = XFSEDRR * ZRRS(:)**(ZEXSEDR) * ZRHODREF(:)**(ZEXSEDR-XCEXVT)
+ ZWSED(:,:,:) = UNPACK( ZZW(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
+ DO JK = IKB , IKE
+ ZZS(:,:,JK) = ZZS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+1)-ZWSED(:,:,JK))
+ END DO
+ IF( JN==1 ) THEN
+ PINPAP(:,:) = ZWSED(:,:,IKB)* &
+ ( PSVT_MASS(:,:,IKB)/MAX(ZRTMIN3,PRRT(:,:,IKB)) )
+ END IF
+ DEALLOCATE(ZRHODREF)
+ DEALLOCATE(ZRRS)
+ DEALLOCATE(ZZW)
+ IF( JN==ISPLITR ) THEN
+ GSEDIM(:,:,:) = .FALSE.
+ GSEDIM(IIB:IIE,IJB:IJE,IKB:IKE) = ZZS(IIB:IIE,IJB:IJE,IKB:IKE) > ZRTMIN3
+ ZWSED(:,:,:) = 0.0
+ WHERE( GSEDIM(:,:,:) )
+ ZWSED(:,:,:) = 1.0/ZTSTEP - PRAIN(:,:,:)/ZZS(:,:,:)
+ END WHERE
+ END IF
+ END IF
+END DO
+!
+! Apply the rain sedimentation rate to the WR_xxx aqueous species
+!
+PRSVS_MASS(:,:,:) = PRSVS_MASS(:,:,:) + ZWSED(:,:,:)*PSVT_MASS(:,:,:)
+!
+END SUBROUTINE SCAV_MASS_SEDIMENTATION
+!
+!------------------------------------------------------------------------------
+!
+!###################################################################
+ FUNCTION COLL_EFFI (PRE, PRE_INV, PRE_SQRT, PSC, PSC_INV, PSC_SQRT, &
+ PSC_3SQRT, PST, PST_STAR, PSIZE_RATIO, &
+ PVISC_RATIO, PDENS_RATIO_SQRT) RESULT(PCOL_EF)
+!###################################################################
+!
+!Compute the Raindrop-Aerosol Collision Efficiency
+!
+!* 0. DECLARATIONS
+! ---------------
+!
+ IMPLICIT NONE
+!
+ INTEGER :: I
+!
+ REAL, DIMENSION(:,:), INTENT(IN) :: PRE
+ REAL, DIMENSION(:,:), INTENT(IN) :: PRE_INV
+ REAL, DIMENSION(:,:), INTENT(IN) :: PRE_SQRT
+ REAL, DIMENSION(:,:), INTENT(IN) :: PSC
+ REAL, DIMENSION(:,:), INTENT(IN) :: PSC_INV
+ REAL, DIMENSION(:,:), INTENT(IN) :: PSC_SQRT
+ REAL, DIMENSION(:,:), INTENT(IN) :: PSC_3SQRT
+ REAL, DIMENSION(:,:), INTENT(IN) :: PST_STAR
+!
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PST
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIZE_RATIO
+!
+ REAL, DIMENSION(:), INTENT(IN) :: PVISC_RATIO
+ REAL, INTENT(IN) :: PDENS_RATIO_SQRT
+!
+ REAL, DIMENSION(SIZE(ZRE,1)) :: PCOL_EF !result : collision efficiency
+!
+!-------------------------------------------------------------------------------
+!
+ PCOL_EF(:) = (4.*PSC_INV(:,J1)*PRE_INV(:,J2)*(1.+0.4*PRE_SQRT(:,J2) &
+ *PSC_3SQRT(:,J1)+0.16*PRE_SQRT(:,J2)*PSC_SQRT(:,J1))) &
+ +(4.*PSIZE_RATIO(:,J1,J2)*(PVISC_RATIO(:) &
+ +(1.+2.*PRE_SQRT(:,J2))*PSIZE_RATIO(:,J1,J2)))
+ DO I=1,ISCAV
+ IF (PST(I,J1,J2)>PST_STAR(I,J2)) THEN
+ PCOL_EF(I) = PCOL_EF(I) &
+ +(PDENS_RATIO_SQRT*((PST(I,J1,J2)-PST_STAR(I,J2)) &
+ /(PST(I,J1,J2)-PST_STAR(I,J2)+2./3.))**(3./2.))
+ ENDIF
+ ENDDO
+ END FUNCTION COLL_EFFI
+!
+!------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_PRECIP_SCAVENGING
diff --git a/src/mesonh/micro/lima_rain_accr_snow.f90 b/src/mesonh/micro/lima_rain_accr_snow.f90
new file mode 100644
index 000000000..01c31afbe
--- /dev/null
+++ b/src/mesonh/micro/lima_rain_accr_snow.f90
@@ -0,0 +1,299 @@
+!MNH_LIC Copyright 2018-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! #################################
+ MODULE MODI_LIMA_RAIN_ACCR_SNOW
+! #################################
+!
+INTERFACE
+ SUBROUTINE LIMA_RAIN_ACCR_SNOW (PTSTEP, LDCOMPUTE, &
+ PRHODREF, PT, &
+ PRRT, PCRT, PRST, PLBDR, PLBDS, PLVFACT, PLSFACT, &
+ P_TH_ACC, P_RR_ACC, P_CR_ACC, P_RS_ACC, P_RG_ACC )
+!
+REAL, INTENT(IN) :: PTSTEP
+LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRHODREF !
+REAL, DIMENSION(:), INTENT(IN) :: PT !
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRRT ! Cloud water C. at t
+REAL, DIMENSION(:), INTENT(IN) :: PCRT ! Cloud water C. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRST ! Cloud water C. at t
+REAL, DIMENSION(:), INTENT(IN) :: PLBDR !
+REAL, DIMENSION(:), INTENT(IN) :: PLBDS !
+REAL, DIMENSION(:), INTENT(IN) :: PLVFACT !
+REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
+!
+REAL, DIMENSION(:), INTENT(OUT) :: P_TH_ACC
+REAL, DIMENSION(:), INTENT(OUT) :: P_RR_ACC
+REAL, DIMENSION(:), INTENT(OUT) :: P_CR_ACC
+REAL, DIMENSION(:), INTENT(OUT) :: P_RS_ACC
+REAL, DIMENSION(:), INTENT(OUT) :: P_RG_ACC
+!
+END SUBROUTINE LIMA_RAIN_ACCR_SNOW
+END INTERFACE
+END MODULE MODI_LIMA_RAIN_ACCR_SNOW
+!
+! ###################################################################################
+ SUBROUTINE LIMA_RAIN_ACCR_SNOW (PTSTEP, LDCOMPUTE, &
+ PRHODREF, PT, &
+ PRRT, PCRT, PRST, PLBDR, PLBDS, PLVFACT, PLSFACT, &
+ P_TH_ACC, P_RR_ACC, P_CR_ACC, P_RS_ACC, P_RG_ACC )
+! ###################################################################################
+!
+!! PURPOSE
+!! -------
+!! Compute the rain drops accretion on aggregates
+!!
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * CNRM *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 15/03/2018
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY : XTT
+USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCEXVT
+USE MODD_PARAM_LIMA_COLD, ONLY : XBS, XCXS
+USE MODD_PARAM_LIMA_MIXED, ONLY : NACCLBDAS, XACCINTP1S, XACCINTP2S, &
+ NACCLBDAR, XACCINTP1R, XACCINTP2R, &
+ XKER_RACCSS, XKER_RACCS, XKER_SACCRG, &
+ XFRACCSS, XLBRACCS1, XLBRACCS2, XLBRACCS3, &
+ XFSACCRG, XLBSACCR1, XLBSACCR2, XLBSACCR3
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, INTENT(IN) :: PTSTEP
+LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRHODREF !
+REAL, DIMENSION(:), INTENT(IN) :: PT !
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRRT ! Cloud water C. at t
+REAL, DIMENSION(:), INTENT(IN) :: PCRT ! Cloud water C. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRST ! Cloud water C. at t
+REAL, DIMENSION(:), INTENT(IN) :: PLBDR !
+REAL, DIMENSION(:), INTENT(IN) :: PLBDS !
+REAL, DIMENSION(:), INTENT(IN) :: PLVFACT !
+REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
+!
+REAL, DIMENSION(:), INTENT(OUT) :: P_TH_ACC
+REAL, DIMENSION(:), INTENT(OUT) :: P_RR_ACC
+REAL, DIMENSION(:), INTENT(OUT) :: P_CR_ACC
+REAL, DIMENSION(:), INTENT(OUT) :: P_RS_ACC
+REAL, DIMENSION(:), INTENT(OUT) :: P_RG_ACC
+!
+!* 0.2 Declarations of local variables :
+!
+LOGICAL, DIMENSION(SIZE(PRRT)) :: GACC
+!
+REAL, DIMENSION(SIZE(PRRT)) :: Z1, Z2, Z3, Z4
+REAL, DIMENSION(SIZE(PRRT)) :: ZZW1, ZZW2, ZZW3, ZZW4, ZZW5
+!
+INTEGER, DIMENSION(SIZE(PRRT)) :: IVEC1,IVEC2 ! Vectors of indices
+REAL, DIMENSION(SIZE(PRRT)) :: ZVEC1,ZVEC2,ZVEC3 ! Work vectors
+!
+!-------------------------------------------------------------------------------
+!
+!
+P_TH_ACC(:) = 0.
+P_RR_ACC(:) = 0.
+P_CR_ACC(:) = 0.
+P_RS_ACC(:) = 0.
+P_RG_ACC(:) = 0.
+!
+ZZW1(:) = 0.
+ZZW2(:) = 0.
+ZZW3(:) = 0.
+ZZW4(:) = 0.
+ZZW5(:) = 0.
+!
+IVEC1(:) = 0
+IVEC2(:) = 0
+ZVEC1(:) = 0.
+ZVEC2(:) = 0.
+ZVEC3(:) = 0.
+!
+!* Cloud droplet riming of the aggregates
+! -------------------------------------------
+!
+!
+GACC(:) = .False.
+GACC(:) = (PRRT(:)>XRTMIN(3)) .AND. (PRST(:)>XRTMIN(5)) .AND. (PT(:)<XTT) .AND. LDCOMPUTE(:)
+!
+WHERE( GACC )
+!
+! 1.3.1 select the (ZLBDAS,ZLBDAR) couplet
+ !
+ ZVEC1(:) = MAX(MIN(PLBDS(:),5.E5),5.E1)
+ ZVEC2(:) = PLBDR(:)
+!
+! 1.3.2 find the next lower indice for the ZLBDAS and for the ZLBDAR
+! in the geometrical set of (Lbda_s,Lbda_r) couplet use to
+! tabulate the RACCSS-kernel
+!
+ ZVEC1(:) = MAX( 1.0001, MIN( REAL(NACCLBDAS)-0.0001, &
+ XACCINTP1S * LOG( ZVEC1(:) ) + XACCINTP2S ) )
+ IVEC1(:) = INT( ZVEC1(:) )
+ ZVEC1(:) = ZVEC1(:) - REAL( IVEC1(:) )
+!
+ ZVEC2(:) = MAX( 1.0001, MIN( REAL(NACCLBDAR)-0.0001, &
+ XACCINTP1R * LOG( ZVEC2(:) ) + XACCINTP2R ) )
+ IVEC2(:) = INT( ZVEC2(:) )
+ ZVEC2(:) = ZVEC2(:) - REAL( IVEC2(:) )
+!
+! 1.3.3 perform the bilinear interpolation of the normalized
+! RACCSS-kernel : for small rain drops transformed into snow
+ !
+ Z1(:) = GET_XKER_RACCSS(IVEC1(:)+1,IVEC2(:)+1)
+ Z2(:) = GET_XKER_RACCSS(IVEC1(:)+1,IVEC2(:) )
+ Z3(:) = GET_XKER_RACCSS(IVEC1(:) ,IVEC2(:)+1)
+ Z4(:) = GET_XKER_RACCSS(IVEC1(:) ,IVEC2(:) )
+ ZVEC3(:) = ( Z1(:)* ZVEC2(:) &
+ - Z2(:)*(ZVEC2(:) - 1.0) ) &
+ * ZVEC1(:) &
+ - ( Z3(:)* ZVEC2(:) &
+ - Z4(:)*(ZVEC2(:) - 1.0) ) &
+ * (ZVEC1(:) - 1.0)
+ ZZW1(:) = ZVEC3(:)
+!
+! 1.3.4b perform the bilinear interpolation of the normalized
+! RACCS-kernel : total frozen rain drops
+!
+ Z1(:) = GET_XKER_RACCS(IVEC1(:)+1,IVEC2(:)+1)
+ Z2(:) = GET_XKER_RACCS(IVEC1(:)+1,IVEC2(:) )
+ Z3(:) = GET_XKER_RACCS(IVEC1(:) ,IVEC2(:)+1)
+ Z4(:) = GET_XKER_RACCS(IVEC1(:) ,IVEC2(:) )
+ ZVEC3(:) = ( Z1(:)* ZVEC2(:) &
+ - Z2(:)*(ZVEC2(:) - 1.0) ) &
+ * ZVEC1(:) &
+ - ( Z3(:)* ZVEC2(:) &
+ - Z4(:)*(ZVEC2(:) - 1.0) ) &
+ * (ZVEC1(:) - 1.0)
+ ZZW2(:) = ZVEC3(:)
+!
+! Correction of ZZW1 to ensure that ZZW1 <= ZZW2
+! ie coll. of small drops <= coll. of all drops
+!
+ ZZW1(:) = MIN(ZZW1(:),ZZW2(:))
+!
+! 1.3.5 perform the bilinear interpolation of the normalized
+! SACCRG-kernel : snow transformed into graupel
+!
+ Z1(:) = GET_XKER_SACCRG(IVEC2(:)+1,IVEC1(:)+1)
+ Z2(:) = GET_XKER_SACCRG(IVEC2(:)+1,IVEC1(:) )
+ Z3(:) = GET_XKER_SACCRG(IVEC2(:) ,IVEC1(:)+1)
+ Z4(:) = GET_XKER_SACCRG(IVEC2(:) ,IVEC1(:) )
+ ZVEC3(:) = ( Z1(:)* ZVEC1(:) &
+ - Z2(:)*(ZVEC1(:) - 1.0) ) &
+ * ZVEC2(:) &
+ - ( Z3(:)* ZVEC1(:) &
+ - Z4(:)*(ZVEC1(:) - 1.0) ) &
+ * (ZVEC2(:) - 1.0)
+ ZZW3(:) = ZVEC3(:)
+!
+! 1.3.4 raindrop accretion on the small sized aggregates
+!
+! BVIE manque PCRT ???????????????????????????????????
+! ZZW4(:) = & !! coef of RRACCS and RRACCS
+ ZZW4(:) = PCRT(:) & !! coef of RRACCS and RRACCS
+ * XFRACCSS *( PLBDS(:)**XCXS )*( PRHODREF(:)**(-XCEXVT-1.) ) &
+ *( XLBRACCS1/( PLBDS(:)**2 ) + &
+ XLBRACCS2/( PLBDS(:) * PLBDR(:) ) + &
+ XLBRACCS3/( PLBDR(:)**2 ) ) / PLBDR(:)**3
+
+! ZRRS(:) = ZRRS(:) - ZZW1(:,4)
+! ZRSS(:) = ZRSS(:) + ZZW1(:,4)
+! ZTHS(:) = ZTHS(:) + ZZW1(:,4)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(RRACCSS))
+!
+! ZCRS(:) = MAX( ZCRS(:)-ZZW1(:,4)*(ZCRT(:)/ZRRT(:)),0.0 ) ! Lambda_r**3
+!
+! 1.3.6 raindrop accretion-conversion of the large sized aggregates
+! into graupeln
+!
+ ZZW5(:) = XFSACCRG*ZZW3(:) * & ! RSACCRG
+ ( PLBDS(:)**(XCXS-XBS) )*( PRHODREF(:)**(-XCEXVT-1.) ) &
+ *( XLBSACCR1/((PLBDR(:)**2) ) + &
+ XLBSACCR2/( PLBDR(:) * PLBDS(:) ) + &
+ XLBSACCR3/( (PLBDS(:)**2)) )
+ !
+! P_RR_ACC(:) = - ZZW4(:) * ZZW1(:) ! RRACCSS
+! P_CR_ACC(:) = P_RR_ACC(:) * PCRT(:)/PRRT(:) ! Lambda_r**3
+! P_RS_ACC(:) = - P_RR_ACC(:)
+ !
+! P_RR_ACC(:) = P_RR_ACC(:) - ( ZZW2(:)-P_RS_ACC(:) )
+! P_CR_ACC(:) = P_CR_ACC(:) - ( ZZW2(:)-P_RS_ACC(:) ) * PCRT(:)/PRRT(:) ! Lambda_r**3
+! P_RS_ACC(:) = P_RS_ACC(:) - ZZW5(:)
+! P_RG_ACC(:) = ( ZZW2(:)-P_RS_ACC(:) ) + ZZW5(:)
+ !
+ P_RR_ACC(:) = - ZZW4(:) * ZZW2(:)
+ P_CR_ACC(:) = P_RR_ACC(:) * PCRT(:)/PRRT(:)
+ P_RS_ACC(:) = ZZW4(:) * ZZW1(:) - ZZW5(:)
+ P_RG_ACC(:) = ZZW4(:) * ( ZZW2(:) - ZZW1(:) ) + ZZW5(:)
+ P_TH_ACC(:) = - P_RR_ACC(:) * (PLSFACT(:)-PLVFACT(:))
+ !
+END WHERE
+!
+!
+!-------------------------------------------------------------------------------
+!
+CONTAINS
+ FUNCTION GET_XKER_RACCSS(I1,I2) RESULT(RET)
+ INTEGER, DIMENSION(:) :: I1
+ INTEGER, DIMENSION(:) :: I2
+ REAL, DIMENSION(SIZE(I1)) :: RET
+ !
+ INTEGER I
+ !
+ DO I=1,SIZE(I1)
+ RET(I) = XKER_RACCSS(MAX(MIN(I1(I),SIZE(XKER_RACCSS,1)),1),MAX(MIN(I2(I),SIZE(XKER_RACCSS,2)),1))
+ END DO
+ END FUNCTION GET_XKER_RACCSS
+!
+!-------------------------------------------------------------------------------
+!
+ FUNCTION GET_XKER_RACCS(I1,I2) RESULT(RET)
+ INTEGER, DIMENSION(:) :: I1
+ INTEGER, DIMENSION(:) :: I2
+ REAL, DIMENSION(SIZE(I1)) :: RET
+ !
+ INTEGER I
+ !
+ DO I=1,SIZE(I1)
+ RET(I) = XKER_RACCS(MAX(MIN(I1(I),SIZE(XKER_RACCS,1)),1),MAX(MIN(I2(I),SIZE(XKER_RACCS,2)),1))
+ END DO
+ END FUNCTION GET_XKER_RACCS
+!
+!-------------------------------------------------------------------------------
+!
+ FUNCTION GET_XKER_SACCRG(I1,I2) RESULT(RET)
+ INTEGER, DIMENSION(:) :: I1
+ INTEGER, DIMENSION(:) :: I2
+ REAL, DIMENSION(SIZE(I1)) :: RET
+ !
+ INTEGER I
+ !
+ DO I=1,SIZE(I1)
+ RET(I) = XKER_SACCRG(MAX(MIN(I1(I),SIZE(XKER_SACCRG,1)),1),MAX(MIN(I2(I),SIZE(XKER_SACCRG,2)),1))
+ END DO
+ END FUNCTION GET_XKER_SACCRG
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_RAIN_ACCR_SNOW
diff --git a/src/mesonh/micro/lima_rain_evaporation.f90 b/src/mesonh/micro/lima_rain_evaporation.f90
new file mode 100644
index 000000000..2970e027d
--- /dev/null
+++ b/src/mesonh/micro/lima_rain_evaporation.f90
@@ -0,0 +1,149 @@
+!MNH_LIC Copyright 2018-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ##########################
+ MODULE MODI_LIMA_RAIN_EVAPORATION
+! ##########################
+!
+INTERFACE
+ SUBROUTINE LIMA_RAIN_EVAPORATION (PTSTEP, LDCOMPUTE, &
+ PRHODREF, PT, PLV, PLVFACT, PEVSAT, PRVSAT, &
+ PRVT, PRCT, PRRT, PLBDR, &
+ P_TH_EVAP, P_RR_EVAP, &
+ PEVAP3D )
+!
+REAL, INTENT(IN) :: PTSTEP ! Time step
+LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE !
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(:), INTENT(IN) :: PT ! Temperature
+REAL, DIMENSION(:), INTENT(IN) :: PLV !
+REAL, DIMENSION(:), INTENT(IN) :: PLVFACT !
+REAL, DIMENSION(:), INTENT(IN) :: PEVSAT !
+REAL, DIMENSION(:), INTENT(IN) :: PRVSAT !
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PLBDR ! Lambda(rain)
+!
+REAL, DIMENSION(:), INTENT(OUT) :: P_TH_EVAP
+REAL, DIMENSION(:), INTENT(OUT) :: P_RR_EVAP
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: PEVAP3D ! Rain evap profile
+!
+END SUBROUTINE LIMA_RAIN_EVAPORATION
+END INTERFACE
+END MODULE MODI_LIMA_RAIN_EVAPORATION
+! ###############################################################################
+ SUBROUTINE LIMA_RAIN_EVAPORATION (PTSTEP, LDCOMPUTE, &
+ PRHODREF, PT, PLV, PLVFACT, PEVSAT, PRVSAT, &
+ PRVT, PRCT, PRRT, PLBDR, &
+ P_TH_EVAP, P_RR_EVAP, &
+ PEVAP3D )
+! ###############################################################################
+!
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the raindrop evaporation
+!!
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * CNRM *
+!!
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 15/03/2018
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY : XRHOLW, XRV
+USE MODD_PARAM_LIMA, ONLY : XRTMIN
+USE MODD_PARAM_LIMA_WARM, ONLY : X0EVAR, XEX0EVAR, X1EVAR, XEX2EVAR, XEX1EVAR, XTHCO, XDIVA
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, INTENT(IN) :: PTSTEP ! Time step
+LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE !
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(:), INTENT(IN) :: PT ! Temperature
+REAL, DIMENSION(:), INTENT(IN) :: PLV !
+REAL, DIMENSION(:), INTENT(IN) :: PLVFACT !
+REAL, DIMENSION(:), INTENT(IN) :: PEVSAT !
+REAL, DIMENSION(:), INTENT(IN) :: PRVSAT !
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PLBDR ! Lambda(rain)
+!
+REAL, DIMENSION(:), INTENT(OUT) :: P_TH_EVAP
+REAL, DIMENSION(:), INTENT(OUT) :: P_RR_EVAP
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: PEVAP3D ! Rain evap profile
+!
+!* 0.1 Declarations of local variables :
+!
+!
+LOGICAL, DIMENSION(SIZE(PRHODREF)) :: GEVAP
+REAL, DIMENSION(SIZE(PRHODREF)) :: ZZW1, ZZW2
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 1. PREPARE COMPUTATIONS - PACK
+! ---------------------------
+!
+P_TH_EVAP(:) = 0.
+P_RR_EVAP(:) = 0.
+!
+GEVAP(:) = .FALSE.
+GEVAP(:) = LDCOMPUTE(:) .AND. &
+ PRRT(:)>XRTMIN(3) .AND. &
+ PRVT(:)<PRVSAT(:)
+!
+WHERE ( GEVAP )
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 2. compute the evaporation of rain drops
+! ----------------------------------------
+!
+!
+ ZZW1(:) = MAX((1.0 - PRVT(:)/PRVSAT(:)),0.0) ! Subsaturation
+!
+! Compute the function G(T)
+!
+ ZZW2(:) = 1. / ( XRHOLW*((((PLV(:)/PT(:))**2)/(XTHCO*XRV)) + & ! G
+ (XRV*PT(:))/(XDIVA*PEVSAT(:))))
+!
+! Compute the evaporation tendency
+!
+ ZZW2(:) = ZZW2(:) * ZZW1(:) * PRRT(:) * &
+ (X0EVAR * PLBDR(:)**XEX0EVAR + X1EVAR * PRHODREF(:)**XEX2EVAR * PLBDR(:)**XEX1EVAR)
+ ZZW2(:) = MAX(ZZW2(:),0.0)
+!
+ P_RR_EVAP(:) = - ZZW2(:)
+! P_TH_EVAP(:) = P_RR_EVAP(:) * PLVFACT(:)
+! PEVAP3D(:) = - P_RR_EVAP(:)
+!
+END WHERE
+!
+!-----------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_RAIN_EVAPORATION
diff --git a/src/mesonh/micro/lima_rain_freezing.f90 b/src/mesonh/micro/lima_rain_freezing.f90
new file mode 100644
index 000000000..a5a9225bc
--- /dev/null
+++ b/src/mesonh/micro/lima_rain_freezing.f90
@@ -0,0 +1,134 @@
+!MNH_LIC Copyright 2018-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! #################################
+ MODULE MODI_LIMA_RAIN_FREEZING
+! #################################
+!
+INTERFACE
+ SUBROUTINE LIMA_RAIN_FREEZING (LDCOMPUTE, &
+ PRHODREF, PT, PLVFACT, PLSFACT, &
+ PRRT, PCRT, PRIT, PCIT, PLBDR, &
+ P_TH_CFRZ, P_RR_CFRZ, P_CR_CFRZ, P_RI_CFRZ, P_CI_CFRZ )
+!
+LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference Exner function
+REAL, DIMENSION(:), INTENT(IN) :: PT !
+REAL, DIMENSION(:), INTENT(IN) :: PLVFACT !
+REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRRT !
+REAL, DIMENSION(:), INTENT(IN) :: PCRT !
+REAL, DIMENSION(:), INTENT(IN) :: PRIT !
+REAL, DIMENSION(:), INTENT(IN) :: PCIT !
+REAL, DIMENSION(:), INTENT(IN) :: PLBDR !
+!
+REAL, DIMENSION(:), INTENT(OUT) :: P_TH_CFRZ
+REAL, DIMENSION(:), INTENT(OUT) :: P_RR_CFRZ
+REAL, DIMENSION(:), INTENT(OUT) :: P_CR_CFRZ
+REAL, DIMENSION(:), INTENT(OUT) :: P_RI_CFRZ
+REAL, DIMENSION(:), INTENT(OUT) :: P_CI_CFRZ
+!
+END SUBROUTINE LIMA_RAIN_FREEZING
+END INTERFACE
+END MODULE MODI_LIMA_RAIN_FREEZING
+!
+! #######################################################################################
+ SUBROUTINE LIMA_RAIN_FREEZING (LDCOMPUTE, &
+ PRHODREF, PT, PLVFACT, PLSFACT, &
+ PRRT, PCRT, PRIT, PCIT, PLBDR, &
+ P_TH_CFRZ, P_RR_CFRZ, P_CR_CFRZ, P_RI_CFRZ, P_CI_CFRZ )
+! #######################################################################################
+!
+!! PURPOSE
+!! -------
+!! Compute the rain freezing by contact with an ice crystal
+!!
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * CNRM *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 15/03/2018
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY : XTT
+USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCEXVT
+USE MODD_PARAM_LIMA_MIXED, ONLY : XICFRR, XEXICFRR, XRCFRI, XEXRCFRI
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference Exner function
+REAL, DIMENSION(:), INTENT(IN) :: PT !
+REAL, DIMENSION(:), INTENT(IN) :: PLVFACT !
+REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRRT !
+REAL, DIMENSION(:), INTENT(IN) :: PCRT !
+REAL, DIMENSION(:), INTENT(IN) :: PRIT !
+REAL, DIMENSION(:), INTENT(IN) :: PCIT !
+REAL, DIMENSION(:), INTENT(IN) :: PLBDR !
+!
+REAL, DIMENSION(:), INTENT(OUT) :: P_TH_CFRZ
+REAL, DIMENSION(:), INTENT(OUT) :: P_RR_CFRZ
+REAL, DIMENSION(:), INTENT(OUT) :: P_CR_CFRZ
+REAL, DIMENSION(:), INTENT(OUT) :: P_RI_CFRZ
+REAL, DIMENSION(:), INTENT(OUT) :: P_CI_CFRZ
+!
+!* 0.2 Declarations of local variables :
+!
+REAL, DIMENSION(SIZE(PRRT)) :: ZW1, ZW2 ! work arrays
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 1. PRELIMINARY COMPUTATIONS
+! ------------------------
+!
+!
+P_TH_CFRZ(:)=0.
+P_RR_CFRZ(:)=0.
+P_CR_CFRZ(:)=0.
+P_RI_CFRZ(:)=0.
+P_CI_CFRZ(:)=0.
+!
+ZW1(:)=0.
+ZW2(:)=0.
+!
+WHERE( (PRIT(:)>XRTMIN(4)) .AND. (PRRT(:)>XRTMIN(3)) .AND. (PT(:)<XTT) .AND. LDCOMPUTE(:) )
+!
+ ZW1(:) = XICFRR * PRIT(:) * PCRT(:) & ! RICFRRG
+ * PLBDR(:)**XEXICFRR &
+ * PRHODREF(:)**(-XCEXVT-1.0)
+!
+ ZW2(:) = XRCFRI * PCIT(:) * PCRT(:) & ! RRCFRIG
+ * PLBDR(:)**XEXRCFRI &
+ * PRHODREF(:)**(-XCEXVT-1.0)
+!
+ P_RR_CFRZ(:) = - ZW2(:)
+ P_CR_CFRZ(:) = - ZW2(:) * (PCRT(:)/PRRT(:))
+ P_RI_CFRZ(:) = - ZW1(:)
+ P_CI_CFRZ(:) = - ZW1(:) * (PCIT(:)/PRIT(:))
+ P_TH_CFRZ(:) = - P_RR_CFRZ(:) * (PLSFACT(:)-PLVFACT(:))
+!
+END WHERE
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_RAIN_FREEZING
diff --git a/src/mesonh/micro/lima_read_xker_gweth.f90 b/src/mesonh/micro/lima_read_xker_gweth.f90
new file mode 100644
index 000000000..25a567ec8
--- /dev/null
+++ b/src/mesonh/micro/lima_read_xker_gweth.f90
@@ -0,0 +1,1737 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 microph 2006/05/18 13:07:25
+!-----------------------------------------------------------------
+! ###########################
+ MODULE MODI_LIMA_READ_XKER_GWETH
+! ###########################
+!
+INTERFACE
+ SUBROUTINE LIMA_READ_XKER_GWETH (KWETLBDAH,KWETLBDAG,KND, &
+ PALPHAH,PNUH,PALPHAG,PNUG,PEHG,PBG,PCH,PDH,PCG,PDG, &
+ PWETLBDAH_MAX,PWETLBDAG_MAX,PWETLBDAH_MIN,PWETLBDAG_MIN, &
+ PFDINFTY,PKER_GWETH )
+!
+INTEGER, INTENT(OUT) :: KND,KWETLBDAH,KWETLBDAG
+REAL, INTENT(OUT) :: PALPHAH
+REAL, INTENT(OUT) :: PNUH
+REAL, INTENT(OUT) :: PALPHAG
+REAL, INTENT(OUT) :: PNUG
+REAL, INTENT(OUT) :: PEHG
+REAL, INTENT(OUT) :: PBG
+REAL, INTENT(OUT) :: PCH
+REAL, INTENT(OUT) :: PDH
+REAL, INTENT(OUT) :: PCG
+REAL, INTENT(OUT) :: PDG
+REAL, INTENT(OUT) :: PWETLBDAH_MAX
+REAL, INTENT(OUT) :: PWETLBDAG_MAX
+REAL, INTENT(OUT) :: PWETLBDAH_MIN
+REAL, INTENT(OUT) :: PWETLBDAG_MIN
+REAL, INTENT(OUT) :: PFDINFTY
+REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_GWETH
+!
+END SUBROUTINE LIMA_READ_XKER_GWETH
+!
+END INTERFACE
+!
+END MODULE MODI_LIMA_READ_XKER_GWETH
+! ########################################################################
+ SUBROUTINE LIMA_READ_XKER_GWETH (KWETLBDAH,KWETLBDAG,KND, &
+ PALPHAH,PNUH,PALPHAG,PNUG,PEHG,PBG,PCH,PDH,PCG,PDG, &
+ PWETLBDAH_MAX,PWETLBDAG_MAX,PWETLBDAH_MIN,PWETLBDAG_MIN, &
+ PFDINFTY,PKER_GWETH )
+! ########################################################################
+!
+!!**** * * - initialize the kernels for the graupel-hail wet growth process
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to initialize the kernels PKER_GWETH
+!! prepared from a previous run of the routine INI_RAIN_ICE. The reading
+!! of the kernels is optional after checking for the dimensions of the
+!! arrays.
+!!
+!!** METHOD
+!! ------
+!!
+!!
+!! EXTERNAL
+!! --------
+!! None
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation ( routine READ_XKER_GWETH )
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 19/04/97
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!* 0.2 Declarations of local variables :
+!
+!
+INTEGER, INTENT(OUT) :: KND,KWETLBDAH,KWETLBDAG
+REAL, INTENT(OUT) :: PALPHAH
+REAL, INTENT(OUT) :: PNUH
+REAL, INTENT(OUT) :: PALPHAG
+REAL, INTENT(OUT) :: PNUG
+REAL, INTENT(OUT) :: PEHG
+REAL, INTENT(OUT) :: PBG
+REAL, INTENT(OUT) :: PCH
+REAL, INTENT(OUT) :: PDH
+REAL, INTENT(OUT) :: PCG
+REAL, INTENT(OUT) :: PDG
+REAL, INTENT(OUT) :: PWETLBDAH_MAX
+REAL, INTENT(OUT) :: PWETLBDAG_MAX
+REAL, INTENT(OUT) :: PWETLBDAH_MIN
+REAL, INTENT(OUT) :: PWETLBDAG_MIN
+REAL, INTENT(OUT) :: PFDINFTY
+REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_GWETH
+!
+! ########################################################################
+! #INSERT HERE THE OUTPUT OF INI_RAIN_ICE_HAIL IF THE KERNELS ARE UPDATED#
+! ########################################################################
+!
+KND= 50
+KWETLBDAH= 40
+KWETLBDAG= 40
+PALPHAH= 0.100000E+01
+PNUH= 0.800000E+01
+PALPHAG= 0.100000E+01
+PNUG= 0.100000E+01
+PEHG= 0.100000E+01
+PBG= 0.280000E+01
+PCH= 0.201000E+03
+PDH= 0.640000E+00
+PCG= 0.122000E+03
+PDG= 0.660000E+00
+PWETLBDAH_MAX= 0.100000E+08
+PWETLBDAG_MAX= 0.100000E+08
+PWETLBDAH_MIN= 0.100000E+04
+PWETLBDAG_MIN= 0.100000E+04
+PFDINFTY= 0.200000E+02
+!
+IF( PRESENT(PKER_GWETH) ) THEN
+PKER_GWETH( 1, 1) = 0.662921E+01
+PKER_GWETH( 1, 2) = 0.722485E+01
+PKER_GWETH( 1, 3) = 0.772716E+01
+PKER_GWETH( 1, 4) = 0.814872E+01
+PKER_GWETH( 1, 5) = 0.850191E+01
+PKER_GWETH( 1, 6) = 0.879773E+01
+PKER_GWETH( 1, 7) = 0.904564E+01
+PKER_GWETH( 1, 8) = 0.925363E+01
+PKER_GWETH( 1, 9) = 0.942835E+01
+PKER_GWETH( 1, 10) = 0.957535E+01
+PKER_GWETH( 1, 11) = 0.969921E+01
+PKER_GWETH( 1, 12) = 0.980373E+01
+PKER_GWETH( 1, 13) = 0.989205E+01
+PKER_GWETH( 1, 14) = 0.996677E+01
+PKER_GWETH( 1, 15) = 0.100301E+02
+PKER_GWETH( 1, 16) = 0.100837E+02
+PKER_GWETH( 1, 17) = 0.101293E+02
+PKER_GWETH( 1, 18) = 0.101679E+02
+PKER_GWETH( 1, 19) = 0.102008E+02
+PKER_GWETH( 1, 20) = 0.102288E+02
+PKER_GWETH( 1, 21) = 0.102526E+02
+PKER_GWETH( 1, 22) = 0.102728E+02
+PKER_GWETH( 1, 23) = 0.102901E+02
+PKER_GWETH( 1, 24) = 0.103048E+02
+PKER_GWETH( 1, 25) = 0.103173E+02
+PKER_GWETH( 1, 26) = 0.103280E+02
+PKER_GWETH( 1, 27) = 0.103371E+02
+PKER_GWETH( 1, 28) = 0.103449E+02
+PKER_GWETH( 1, 29) = 0.103515E+02
+PKER_GWETH( 1, 30) = 0.103572E+02
+PKER_GWETH( 1, 31) = 0.103620E+02
+PKER_GWETH( 1, 32) = 0.103661E+02
+PKER_GWETH( 1, 33) = 0.103696E+02
+PKER_GWETH( 1, 34) = 0.103727E+02
+PKER_GWETH( 1, 35) = 0.103752E+02
+PKER_GWETH( 1, 36) = 0.103774E+02
+PKER_GWETH( 1, 37) = 0.103793E+02
+PKER_GWETH( 1, 38) = 0.103809E+02
+PKER_GWETH( 1, 39) = 0.103823E+02
+PKER_GWETH( 1, 40) = 0.103835E+02
+PKER_GWETH( 2, 1) = 0.511505E+01
+PKER_GWETH( 2, 2) = 0.571264E+01
+PKER_GWETH( 2, 3) = 0.622270E+01
+PKER_GWETH( 2, 4) = 0.665279E+01
+PKER_GWETH( 2, 5) = 0.701373E+01
+PKER_GWETH( 2, 6) = 0.731613E+01
+PKER_GWETH( 2, 7) = 0.756942E+01
+PKER_GWETH( 2, 8) = 0.778168E+01
+PKER_GWETH( 2, 9) = 0.795975E+01
+PKER_GWETH( 2, 10) = 0.810934E+01
+PKER_GWETH( 2, 11) = 0.823519E+01
+PKER_GWETH( 2, 12) = 0.834123E+01
+PKER_GWETH( 2, 13) = 0.843071E+01
+PKER_GWETH( 2, 14) = 0.850631E+01
+PKER_GWETH( 2, 15) = 0.857028E+01
+PKER_GWETH( 2, 16) = 0.862446E+01
+PKER_GWETH( 2, 17) = 0.867039E+01
+PKER_GWETH( 2, 18) = 0.870937E+01
+PKER_GWETH( 2, 19) = 0.874247E+01
+PKER_GWETH( 2, 20) = 0.877061E+01
+PKER_GWETH( 2, 21) = 0.879454E+01
+PKER_GWETH( 2, 22) = 0.881490E+01
+PKER_GWETH( 2, 23) = 0.883224E+01
+PKER_GWETH( 2, 24) = 0.884700E+01
+PKER_GWETH( 2, 25) = 0.885958E+01
+PKER_GWETH( 2, 26) = 0.887030E+01
+PKER_GWETH( 2, 27) = 0.887945E+01
+PKER_GWETH( 2, 28) = 0.888725E+01
+PKER_GWETH( 2, 29) = 0.889390E+01
+PKER_GWETH( 2, 30) = 0.889958E+01
+PKER_GWETH( 2, 31) = 0.890442E+01
+PKER_GWETH( 2, 32) = 0.890856E+01
+PKER_GWETH( 2, 33) = 0.891209E+01
+PKER_GWETH( 2, 34) = 0.891511E+01
+PKER_GWETH( 2, 35) = 0.891769E+01
+PKER_GWETH( 2, 36) = 0.891989E+01
+PKER_GWETH( 2, 37) = 0.892177E+01
+PKER_GWETH( 2, 38) = 0.892338E+01
+PKER_GWETH( 2, 39) = 0.892475E+01
+PKER_GWETH( 2, 40) = 0.892593E+01
+PKER_GWETH( 3, 1) = 0.382811E+01
+PKER_GWETH( 3, 2) = 0.441084E+01
+PKER_GWETH( 3, 3) = 0.492273E+01
+PKER_GWETH( 3, 4) = 0.535949E+01
+PKER_GWETH( 3, 5) = 0.572774E+01
+PKER_GWETH( 3, 6) = 0.603679E+01
+PKER_GWETH( 3, 7) = 0.629570E+01
+PKER_GWETH( 3, 8) = 0.651257E+01
+PKER_GWETH( 3, 9) = 0.669430E+01
+PKER_GWETH( 3, 10) = 0.684676E+01
+PKER_GWETH( 3, 11) = 0.697484E+01
+PKER_GWETH( 3, 12) = 0.708258E+01
+PKER_GWETH( 3, 13) = 0.717337E+01
+PKER_GWETH( 3, 14) = 0.724997E+01
+PKER_GWETH( 3, 15) = 0.731469E+01
+PKER_GWETH( 3, 16) = 0.736945E+01
+PKER_GWETH( 3, 17) = 0.741583E+01
+PKER_GWETH( 3, 18) = 0.745515E+01
+PKER_GWETH( 3, 19) = 0.748851E+01
+PKER_GWETH( 3, 20) = 0.751685E+01
+PKER_GWETH( 3, 21) = 0.754093E+01
+PKER_GWETH( 3, 22) = 0.756141E+01
+PKER_GWETH( 3, 23) = 0.757884E+01
+PKER_GWETH( 3, 24) = 0.759368E+01
+PKER_GWETH( 3, 25) = 0.760631E+01
+PKER_GWETH( 3, 26) = 0.761708E+01
+PKER_GWETH( 3, 27) = 0.762626E+01
+PKER_GWETH( 3, 28) = 0.763408E+01
+PKER_GWETH( 3, 29) = 0.764076E+01
+PKER_GWETH( 3, 30) = 0.764645E+01
+PKER_GWETH( 3, 31) = 0.765131E+01
+PKER_GWETH( 3, 32) = 0.765546E+01
+PKER_GWETH( 3, 33) = 0.765900E+01
+PKER_GWETH( 3, 34) = 0.766202E+01
+PKER_GWETH( 3, 35) = 0.766460E+01
+PKER_GWETH( 3, 36) = 0.766681E+01
+PKER_GWETH( 3, 37) = 0.766869E+01
+PKER_GWETH( 3, 38) = 0.767030E+01
+PKER_GWETH( 3, 39) = 0.767168E+01
+PKER_GWETH( 3, 40) = 0.767285E+01
+PKER_GWETH( 4, 1) = 0.276960E+01
+PKER_GWETH( 4, 2) = 0.330386E+01
+PKER_GWETH( 4, 3) = 0.380351E+01
+PKER_GWETH( 4, 4) = 0.424198E+01
+PKER_GWETH( 4, 5) = 0.461597E+01
+PKER_GWETH( 4, 6) = 0.493128E+01
+PKER_GWETH( 4, 7) = 0.519588E+01
+PKER_GWETH( 4, 8) = 0.541757E+01
+PKER_GWETH( 4, 9) = 0.560325E+01
+PKER_GWETH( 4, 10) = 0.575886E+01
+PKER_GWETH( 4, 11) = 0.588939E+01
+PKER_GWETH( 4, 12) = 0.599904E+01
+PKER_GWETH( 4, 13) = 0.609129E+01
+PKER_GWETH( 4, 14) = 0.616901E+01
+PKER_GWETH( 4, 15) = 0.623459E+01
+PKER_GWETH( 4, 16) = 0.629000E+01
+PKER_GWETH( 4, 17) = 0.633687E+01
+PKER_GWETH( 4, 18) = 0.637657E+01
+PKER_GWETH( 4, 19) = 0.641023E+01
+PKER_GWETH( 4, 20) = 0.643879E+01
+PKER_GWETH( 4, 21) = 0.646304E+01
+PKER_GWETH( 4, 22) = 0.648366E+01
+PKER_GWETH( 4, 23) = 0.650119E+01
+PKER_GWETH( 4, 24) = 0.651610E+01
+PKER_GWETH( 4, 25) = 0.652880E+01
+PKER_GWETH( 4, 26) = 0.653962E+01
+PKER_GWETH( 4, 27) = 0.654883E+01
+PKER_GWETH( 4, 28) = 0.655669E+01
+PKER_GWETH( 4, 29) = 0.656338E+01
+PKER_GWETH( 4, 30) = 0.656910E+01
+PKER_GWETH( 4, 31) = 0.657397E+01
+PKER_GWETH( 4, 32) = 0.657813E+01
+PKER_GWETH( 4, 33) = 0.658168E+01
+PKER_GWETH( 4, 34) = 0.658471E+01
+PKER_GWETH( 4, 35) = 0.658729E+01
+PKER_GWETH( 4, 36) = 0.658950E+01
+PKER_GWETH( 4, 37) = 0.659139E+01
+PKER_GWETH( 4, 38) = 0.659300E+01
+PKER_GWETH( 4, 39) = 0.659438E+01
+PKER_GWETH( 4, 40) = 0.659556E+01
+PKER_GWETH( 5, 1) = 0.195940E+01
+PKER_GWETH( 5, 2) = 0.239226E+01
+PKER_GWETH( 5, 3) = 0.285134E+01
+PKER_GWETH( 5, 4) = 0.327973E+01
+PKER_GWETH( 5, 5) = 0.365531E+01
+PKER_GWETH( 5, 6) = 0.397556E+01
+PKER_GWETH( 5, 7) = 0.424553E+01
+PKER_GWETH( 5, 8) = 0.447209E+01
+PKER_GWETH( 5, 9) = 0.466190E+01
+PKER_GWETH( 5, 10) = 0.482088E+01
+PKER_GWETH( 5, 11) = 0.495411E+01
+PKER_GWETH( 5, 12) = 0.506587E+01
+PKER_GWETH( 5, 13) = 0.515975E+01
+PKER_GWETH( 5, 14) = 0.523873E+01
+PKER_GWETH( 5, 15) = 0.530527E+01
+PKER_GWETH( 5, 16) = 0.536141E+01
+PKER_GWETH( 5, 17) = 0.540884E+01
+PKER_GWETH( 5, 18) = 0.544897E+01
+PKER_GWETH( 5, 19) = 0.548295E+01
+PKER_GWETH( 5, 20) = 0.551176E+01
+PKER_GWETH( 5, 21) = 0.553621E+01
+PKER_GWETH( 5, 22) = 0.555697E+01
+PKER_GWETH( 5, 23) = 0.557462E+01
+PKER_GWETH( 5, 24) = 0.558962E+01
+PKER_GWETH( 5, 25) = 0.560239E+01
+PKER_GWETH( 5, 26) = 0.561326E+01
+PKER_GWETH( 5, 27) = 0.562251E+01
+PKER_GWETH( 5, 28) = 0.563040E+01
+PKER_GWETH( 5, 29) = 0.563712E+01
+PKER_GWETH( 5, 30) = 0.564285E+01
+PKER_GWETH( 5, 31) = 0.564774E+01
+PKER_GWETH( 5, 32) = 0.565191E+01
+PKER_GWETH( 5, 33) = 0.565547E+01
+PKER_GWETH( 5, 34) = 0.565851E+01
+PKER_GWETH( 5, 35) = 0.566110E+01
+PKER_GWETH( 5, 36) = 0.566331E+01
+PKER_GWETH( 5, 37) = 0.566521E+01
+PKER_GWETH( 5, 38) = 0.566682E+01
+PKER_GWETH( 5, 39) = 0.566820E+01
+PKER_GWETH( 5, 40) = 0.566938E+01
+PKER_GWETH( 6, 1) = 0.142387E+01
+PKER_GWETH( 6, 2) = 0.169262E+01
+PKER_GWETH( 6, 3) = 0.206631E+01
+PKER_GWETH( 6, 4) = 0.246074E+01
+PKER_GWETH( 6, 5) = 0.282802E+01
+PKER_GWETH( 6, 6) = 0.314972E+01
+PKER_GWETH( 6, 7) = 0.342395E+01
+PKER_GWETH( 6, 8) = 0.365511E+01
+PKER_GWETH( 6, 9) = 0.384909E+01
+PKER_GWETH( 6, 10) = 0.401161E+01
+PKER_GWETH( 6, 11) = 0.414773E+01
+PKER_GWETH( 6, 12) = 0.426180E+01
+PKER_GWETH( 6, 13) = 0.435749E+01
+PKER_GWETH( 6, 14) = 0.443787E+01
+PKER_GWETH( 6, 15) = 0.450549E+01
+PKER_GWETH( 6, 16) = 0.456245E+01
+PKER_GWETH( 6, 17) = 0.461051E+01
+PKER_GWETH( 6, 18) = 0.465112E+01
+PKER_GWETH( 6, 19) = 0.468547E+01
+PKER_GWETH( 6, 20) = 0.471456E+01
+PKER_GWETH( 6, 21) = 0.473922E+01
+PKER_GWETH( 6, 22) = 0.476015E+01
+PKER_GWETH( 6, 23) = 0.477792E+01
+PKER_GWETH( 6, 24) = 0.479302E+01
+PKER_GWETH( 6, 25) = 0.480587E+01
+PKER_GWETH( 6, 26) = 0.481679E+01
+PKER_GWETH( 6, 27) = 0.482610E+01
+PKER_GWETH( 6, 28) = 0.483402E+01
+PKER_GWETH( 6, 29) = 0.484077E+01
+PKER_GWETH( 6, 30) = 0.484652E+01
+PKER_GWETH( 6, 31) = 0.485143E+01
+PKER_GWETH( 6, 32) = 0.485561E+01
+PKER_GWETH( 6, 33) = 0.485918E+01
+PKER_GWETH( 6, 34) = 0.486223E+01
+PKER_GWETH( 6, 35) = 0.486482E+01
+PKER_GWETH( 6, 36) = 0.486704E+01
+PKER_GWETH( 6, 37) = 0.486894E+01
+PKER_GWETH( 6, 38) = 0.487056E+01
+PKER_GWETH( 6, 39) = 0.487194E+01
+PKER_GWETH( 6, 40) = 0.487312E+01
+PKER_GWETH( 7, 1) = 0.116756E+01
+PKER_GWETH( 7, 2) = 0.122777E+01
+PKER_GWETH( 7, 3) = 0.146234E+01
+PKER_GWETH( 7, 4) = 0.178473E+01
+PKER_GWETH( 7, 5) = 0.212359E+01
+PKER_GWETH( 7, 6) = 0.243847E+01
+PKER_GWETH( 7, 7) = 0.271403E+01
+PKER_GWETH( 7, 8) = 0.294885E+01
+PKER_GWETH( 7, 9) = 0.314677E+01
+PKER_GWETH( 7, 10) = 0.331286E+01
+PKER_GWETH( 7, 11) = 0.345202E+01
+PKER_GWETH( 7, 12) = 0.356856E+01
+PKER_GWETH( 7, 13) = 0.366623E+01
+PKER_GWETH( 7, 14) = 0.374816E+01
+PKER_GWETH( 7, 15) = 0.381698E+01
+PKER_GWETH( 7, 16) = 0.387486E+01
+PKER_GWETH( 7, 17) = 0.392363E+01
+PKER_GWETH( 7, 18) = 0.396478E+01
+PKER_GWETH( 7, 19) = 0.399954E+01
+PKER_GWETH( 7, 20) = 0.402895E+01
+PKER_GWETH( 7, 21) = 0.405385E+01
+PKER_GWETH( 7, 22) = 0.407496E+01
+PKER_GWETH( 7, 23) = 0.409288E+01
+PKER_GWETH( 7, 24) = 0.410809E+01
+PKER_GWETH( 7, 25) = 0.412101E+01
+PKER_GWETH( 7, 26) = 0.413201E+01
+PKER_GWETH( 7, 27) = 0.414136E+01
+PKER_GWETH( 7, 28) = 0.414932E+01
+PKER_GWETH( 7, 29) = 0.415610E+01
+PKER_GWETH( 7, 30) = 0.416188E+01
+PKER_GWETH( 7, 31) = 0.416680E+01
+PKER_GWETH( 7, 32) = 0.417100E+01
+PKER_GWETH( 7, 33) = 0.417458E+01
+PKER_GWETH( 7, 34) = 0.417764E+01
+PKER_GWETH( 7, 35) = 0.418024E+01
+PKER_GWETH( 7, 36) = 0.418247E+01
+PKER_GWETH( 7, 37) = 0.418437E+01
+PKER_GWETH( 7, 38) = 0.418599E+01
+PKER_GWETH( 7, 39) = 0.418737E+01
+PKER_GWETH( 7, 40) = 0.418855E+01
+PKER_GWETH( 8, 1) = 0.115655E+01
+PKER_GWETH( 8, 2) = 0.100208E+01
+PKER_GWETH( 8, 3) = 0.105877E+01
+PKER_GWETH( 8, 4) = 0.126349E+01
+PKER_GWETH( 8, 5) = 0.154150E+01
+PKER_GWETH( 8, 6) = 0.183260E+01
+PKER_GWETH( 8, 7) = 0.210253E+01
+PKER_GWETH( 8, 8) = 0.233857E+01
+PKER_GWETH( 8, 9) = 0.253964E+01
+PKER_GWETH( 8, 10) = 0.270911E+01
+PKER_GWETH( 8, 11) = 0.285132E+01
+PKER_GWETH( 8, 12) = 0.297046E+01
+PKER_GWETH( 8, 13) = 0.307026E+01
+PKER_GWETH( 8, 14) = 0.315388E+01
+PKER_GWETH( 8, 15) = 0.322402E+01
+PKER_GWETH( 8, 16) = 0.328294E+01
+PKER_GWETH( 8, 17) = 0.333250E+01
+PKER_GWETH( 8, 18) = 0.337426E+01
+PKER_GWETH( 8, 19) = 0.340948E+01
+PKER_GWETH( 8, 20) = 0.343924E+01
+PKER_GWETH( 8, 21) = 0.346442E+01
+PKER_GWETH( 8, 22) = 0.348573E+01
+PKER_GWETH( 8, 23) = 0.350381E+01
+PKER_GWETH( 8, 24) = 0.351914E+01
+PKER_GWETH( 8, 25) = 0.353216E+01
+PKER_GWETH( 8, 26) = 0.354322E+01
+PKER_GWETH( 8, 27) = 0.355263E+01
+PKER_GWETH( 8, 28) = 0.356064E+01
+PKER_GWETH( 8, 29) = 0.356745E+01
+PKER_GWETH( 8, 30) = 0.357325E+01
+PKER_GWETH( 8, 31) = 0.357820E+01
+PKER_GWETH( 8, 32) = 0.358241E+01
+PKER_GWETH( 8, 33) = 0.358601E+01
+PKER_GWETH( 8, 34) = 0.358907E+01
+PKER_GWETH( 8, 35) = 0.359168E+01
+PKER_GWETH( 8, 36) = 0.359391E+01
+PKER_GWETH( 8, 37) = 0.359582E+01
+PKER_GWETH( 8, 38) = 0.359744E+01
+PKER_GWETH( 8, 39) = 0.359883E+01
+PKER_GWETH( 8, 40) = 0.360002E+01
+PKER_GWETH( 9, 1) = 0.132218E+01
+PKER_GWETH( 9, 2) = 0.987527E+00
+PKER_GWETH( 9, 3) = 0.860208E+00
+PKER_GWETH( 9, 4) = 0.913110E+00
+PKER_GWETH( 9, 5) = 0.109167E+01
+PKER_GWETH( 9, 6) = 0.133139E+01
+PKER_GWETH( 9, 7) = 0.158145E+01
+PKER_GWETH( 9, 8) = 0.181284E+01
+PKER_GWETH( 9, 9) = 0.201502E+01
+PKER_GWETH( 9, 10) = 0.218719E+01
+PKER_GWETH( 9, 11) = 0.233229E+01
+PKER_GWETH( 9, 12) = 0.245406E+01
+PKER_GWETH( 9, 13) = 0.255607E+01
+PKER_GWETH( 9, 14) = 0.264152E+01
+PKER_GWETH( 9, 15) = 0.271312E+01
+PKER_GWETH( 9, 16) = 0.277318E+01
+PKER_GWETH( 9, 17) = 0.282362E+01
+PKER_GWETH( 9, 18) = 0.286605E+01
+PKER_GWETH( 9, 19) = 0.290180E+01
+PKER_GWETH( 9, 20) = 0.293196E+01
+PKER_GWETH( 9, 21) = 0.295743E+01
+PKER_GWETH( 9, 22) = 0.297898E+01
+PKER_GWETH( 9, 23) = 0.299723E+01
+PKER_GWETH( 9, 24) = 0.301270E+01
+PKER_GWETH( 9, 25) = 0.302582E+01
+PKER_GWETH( 9, 26) = 0.303697E+01
+PKER_GWETH( 9, 27) = 0.304644E+01
+PKER_GWETH( 9, 28) = 0.305449E+01
+PKER_GWETH( 9, 29) = 0.306134E+01
+PKER_GWETH( 9, 30) = 0.306718E+01
+PKER_GWETH( 9, 31) = 0.307214E+01
+PKER_GWETH( 9, 32) = 0.307638E+01
+PKER_GWETH( 9, 33) = 0.307998E+01
+PKER_GWETH( 9, 34) = 0.308306E+01
+PKER_GWETH( 9, 35) = 0.308568E+01
+PKER_GWETH( 9, 36) = 0.308792E+01
+PKER_GWETH( 9, 37) = 0.308983E+01
+PKER_GWETH( 9, 38) = 0.309145E+01
+PKER_GWETH( 9, 39) = 0.309285E+01
+PKER_GWETH( 9, 40) = 0.309403E+01
+PKER_GWETH( 10, 1) = 0.158474E+01
+PKER_GWETH( 10, 2) = 0.112606E+01
+PKER_GWETH( 10, 3) = 0.843404E+00
+PKER_GWETH( 10, 4) = 0.738516E+00
+PKER_GWETH( 10, 5) = 0.787554E+00
+PKER_GWETH( 10, 6) = 0.943174E+00
+PKER_GWETH( 10, 7) = 0.114990E+01
+PKER_GWETH( 10, 8) = 0.136468E+01
+PKER_GWETH( 10, 9) = 0.156304E+01
+PKER_GWETH( 10, 10) = 0.173621E+01
+PKER_GWETH( 10, 11) = 0.188364E+01
+PKER_GWETH( 10, 12) = 0.200788E+01
+PKER_GWETH( 10, 13) = 0.211214E+01
+PKER_GWETH( 10, 14) = 0.219948E+01
+PKER_GWETH( 10, 15) = 0.227264E+01
+PKER_GWETH( 10, 16) = 0.233395E+01
+PKER_GWETH( 10, 17) = 0.238537E+01
+PKER_GWETH( 10, 18) = 0.242856E+01
+PKER_GWETH( 10, 19) = 0.246489E+01
+PKER_GWETH( 10, 20) = 0.249549E+01
+PKER_GWETH( 10, 21) = 0.252131E+01
+PKER_GWETH( 10, 22) = 0.254312E+01
+PKER_GWETH( 10, 23) = 0.256156E+01
+PKER_GWETH( 10, 24) = 0.257719E+01
+PKER_GWETH( 10, 25) = 0.259043E+01
+PKER_GWETH( 10, 26) = 0.260166E+01
+PKER_GWETH( 10, 27) = 0.261120E+01
+PKER_GWETH( 10, 28) = 0.261931E+01
+PKER_GWETH( 10, 29) = 0.262620E+01
+PKER_GWETH( 10, 30) = 0.263207E+01
+PKER_GWETH( 10, 31) = 0.263706E+01
+PKER_GWETH( 10, 32) = 0.264131E+01
+PKER_GWETH( 10, 33) = 0.264493E+01
+PKER_GWETH( 10, 34) = 0.264802E+01
+PKER_GWETH( 10, 35) = 0.265065E+01
+PKER_GWETH( 10, 36) = 0.265289E+01
+PKER_GWETH( 10, 37) = 0.265481E+01
+PKER_GWETH( 10, 38) = 0.265644E+01
+PKER_GWETH( 10, 39) = 0.265784E+01
+PKER_GWETH( 10, 40) = 0.265903E+01
+PKER_GWETH( 11, 1) = 0.187936E+01
+PKER_GWETH( 11, 2) = 0.134925E+01
+PKER_GWETH( 11, 3) = 0.959066E+00
+PKER_GWETH( 11, 4) = 0.720467E+00
+PKER_GWETH( 11, 5) = 0.634149E+00
+PKER_GWETH( 11, 6) = 0.679336E+00
+PKER_GWETH( 11, 7) = 0.814841E+00
+PKER_GWETH( 11, 8) = 0.993130E+00
+PKER_GWETH( 11, 9) = 0.117760E+01
+PKER_GWETH( 11, 10) = 0.134764E+01
+PKER_GWETH( 11, 11) = 0.149595E+01
+PKER_GWETH( 11, 12) = 0.162219E+01
+PKER_GWETH( 11, 13) = 0.172857E+01
+PKER_GWETH( 11, 14) = 0.181784E+01
+PKER_GWETH( 11, 15) = 0.189263E+01
+PKER_GWETH( 11, 16) = 0.195527E+01
+PKER_GWETH( 11, 17) = 0.200776E+01
+PKER_GWETH( 11, 18) = 0.205179E+01
+PKER_GWETH( 11, 19) = 0.208876E+01
+PKER_GWETH( 11, 20) = 0.211987E+01
+PKER_GWETH( 11, 21) = 0.214607E+01
+PKER_GWETH( 11, 22) = 0.216817E+01
+PKER_GWETH( 11, 23) = 0.218684E+01
+PKER_GWETH( 11, 24) = 0.220263E+01
+PKER_GWETH( 11, 25) = 0.221601E+01
+PKER_GWETH( 11, 26) = 0.222734E+01
+PKER_GWETH( 11, 27) = 0.223696E+01
+PKER_GWETH( 11, 28) = 0.224512E+01
+PKER_GWETH( 11, 29) = 0.225206E+01
+PKER_GWETH( 11, 30) = 0.225796E+01
+PKER_GWETH( 11, 31) = 0.226298E+01
+PKER_GWETH( 11, 32) = 0.226725E+01
+PKER_GWETH( 11, 33) = 0.227089E+01
+PKER_GWETH( 11, 34) = 0.227399E+01
+PKER_GWETH( 11, 35) = 0.227663E+01
+PKER_GWETH( 11, 36) = 0.227889E+01
+PKER_GWETH( 11, 37) = 0.228081E+01
+PKER_GWETH( 11, 38) = 0.228245E+01
+PKER_GWETH( 11, 39) = 0.228384E+01
+PKER_GWETH( 11, 40) = 0.228504E+01
+PKER_GWETH( 12, 1) = 0.216566E+01
+PKER_GWETH( 12, 2) = 0.160109E+01
+PKER_GWETH( 12, 3) = 0.114873E+01
+PKER_GWETH( 12, 4) = 0.816878E+00
+PKER_GWETH( 12, 5) = 0.615510E+00
+PKER_GWETH( 12, 6) = 0.544612E+00
+PKER_GWETH( 12, 7) = 0.586008E+00
+PKER_GWETH( 12, 8) = 0.703936E+00
+PKER_GWETH( 12, 9) = 0.857718E+00
+PKER_GWETH( 12, 10) = 0.101614E+01
+PKER_GWETH( 12, 11) = 0.116189E+01
+PKER_GWETH( 12, 12) = 0.128892E+01
+PKER_GWETH( 12, 13) = 0.139702E+01
+PKER_GWETH( 12, 14) = 0.148811E+01
+PKER_GWETH( 12, 15) = 0.156454E+01
+PKER_GWETH( 12, 16) = 0.162858E+01
+PKER_GWETH( 12, 17) = 0.168221E+01
+PKER_GWETH( 12, 18) = 0.172715E+01
+PKER_GWETH( 12, 19) = 0.176485E+01
+PKER_GWETH( 12, 20) = 0.179651E+01
+PKER_GWETH( 12, 21) = 0.182314E+01
+PKER_GWETH( 12, 22) = 0.184557E+01
+PKER_GWETH( 12, 23) = 0.186449E+01
+PKER_GWETH( 12, 24) = 0.188048E+01
+PKER_GWETH( 12, 25) = 0.189400E+01
+PKER_GWETH( 12, 26) = 0.190544E+01
+PKER_GWETH( 12, 27) = 0.191515E+01
+PKER_GWETH( 12, 28) = 0.192338E+01
+PKER_GWETH( 12, 29) = 0.193037E+01
+PKER_GWETH( 12, 30) = 0.193631E+01
+PKER_GWETH( 12, 31) = 0.194136E+01
+PKER_GWETH( 12, 32) = 0.194565E+01
+PKER_GWETH( 12, 33) = 0.194931E+01
+PKER_GWETH( 12, 34) = 0.195242E+01
+PKER_GWETH( 12, 35) = 0.195508E+01
+PKER_GWETH( 12, 36) = 0.195734E+01
+PKER_GWETH( 12, 37) = 0.195926E+01
+PKER_GWETH( 12, 38) = 0.196091E+01
+PKER_GWETH( 12, 39) = 0.196231E+01
+PKER_GWETH( 12, 40) = 0.196351E+01
+PKER_GWETH( 13, 1) = 0.242478E+01
+PKER_GWETH( 13, 2) = 0.184651E+01
+PKER_GWETH( 13, 3) = 0.136400E+01
+PKER_GWETH( 13, 4) = 0.978003E+00
+PKER_GWETH( 13, 5) = 0.695793E+00
+PKER_GWETH( 13, 6) = 0.525848E+00
+PKER_GWETH( 13, 7) = 0.467780E+00
+PKER_GWETH( 13, 8) = 0.505573E+00
+PKER_GWETH( 13, 9) = 0.608098E+00
+PKER_GWETH( 13, 10) = 0.740757E+00
+PKER_GWETH( 13, 11) = 0.876797E+00
+PKER_GWETH( 13, 12) = 0.100173E+01
+PKER_GWETH( 13, 13) = 0.111053E+01
+PKER_GWETH( 13, 14) = 0.120309E+01
+PKER_GWETH( 13, 15) = 0.128108E+01
+PKER_GWETH( 13, 16) = 0.134653E+01
+PKER_GWETH( 13, 17) = 0.140136E+01
+PKER_GWETH( 13, 18) = 0.144728E+01
+PKER_GWETH( 13, 19) = 0.148576E+01
+PKER_GWETH( 13, 20) = 0.151804E+01
+PKER_GWETH( 13, 21) = 0.154514E+01
+PKER_GWETH( 13, 22) = 0.156794E+01
+PKER_GWETH( 13, 23) = 0.158715E+01
+PKER_GWETH( 13, 24) = 0.160335E+01
+PKER_GWETH( 13, 25) = 0.161703E+01
+PKER_GWETH( 13, 26) = 0.162860E+01
+PKER_GWETH( 13, 27) = 0.163840E+01
+PKER_GWETH( 13, 28) = 0.164671E+01
+PKER_GWETH( 13, 29) = 0.165376E+01
+PKER_GWETH( 13, 30) = 0.165974E+01
+PKER_GWETH( 13, 31) = 0.166482E+01
+PKER_GWETH( 13, 32) = 0.166914E+01
+PKER_GWETH( 13, 33) = 0.167282E+01
+PKER_GWETH( 13, 34) = 0.167595E+01
+PKER_GWETH( 13, 35) = 0.167862E+01
+PKER_GWETH( 13, 36) = 0.168089E+01
+PKER_GWETH( 13, 37) = 0.168282E+01
+PKER_GWETH( 13, 38) = 0.168447E+01
+PKER_GWETH( 13, 39) = 0.168588E+01
+PKER_GWETH( 13, 40) = 0.168708E+01
+PKER_GWETH( 14, 1) = 0.265128E+01
+PKER_GWETH( 14, 2) = 0.206894E+01
+PKER_GWETH( 14, 3) = 0.157436E+01
+PKER_GWETH( 14, 4) = 0.116200E+01
+PKER_GWETH( 14, 5) = 0.832643E+00
+PKER_GWETH( 14, 6) = 0.592653E+00
+PKER_GWETH( 14, 7) = 0.449243E+00
+PKER_GWETH( 14, 8) = 0.401845E+00
+PKER_GWETH( 14, 9) = 0.436189E+00
+PKER_GWETH( 14, 10) = 0.525318E+00
+PKER_GWETH( 14, 11) = 0.639731E+00
+PKER_GWETH( 14, 12) = 0.756546E+00
+PKER_GWETH( 14, 13) = 0.863627E+00
+PKER_GWETH( 14, 14) = 0.956814E+00
+PKER_GWETH( 14, 15) = 0.103607E+01
+PKER_GWETH( 14, 16) = 0.110285E+01
+PKER_GWETH( 14, 17) = 0.115889E+01
+PKER_GWETH( 14, 18) = 0.120583E+01
+PKER_GWETH( 14, 19) = 0.124515E+01
+PKER_GWETH( 14, 20) = 0.127810E+01
+PKER_GWETH( 14, 21) = 0.130574E+01
+PKER_GWETH( 14, 22) = 0.132895E+01
+PKER_GWETH( 14, 23) = 0.134846E+01
+PKER_GWETH( 14, 24) = 0.136491E+01
+PKER_GWETH( 14, 25) = 0.137878E+01
+PKER_GWETH( 14, 26) = 0.139049E+01
+PKER_GWETH( 14, 27) = 0.140040E+01
+PKER_GWETH( 14, 28) = 0.140879E+01
+PKER_GWETH( 14, 29) = 0.141590E+01
+PKER_GWETH( 14, 30) = 0.142193E+01
+PKER_GWETH( 14, 31) = 0.142705E+01
+PKER_GWETH( 14, 32) = 0.143140E+01
+PKER_GWETH( 14, 33) = 0.143510E+01
+PKER_GWETH( 14, 34) = 0.143825E+01
+PKER_GWETH( 14, 35) = 0.144093E+01
+PKER_GWETH( 14, 36) = 0.144321E+01
+PKER_GWETH( 14, 37) = 0.144515E+01
+PKER_GWETH( 14, 38) = 0.144681E+01
+PKER_GWETH( 14, 39) = 0.144822E+01
+PKER_GWETH( 14, 40) = 0.144942E+01
+PKER_GWETH( 15, 1) = 0.284621E+01
+PKER_GWETH( 15, 2) = 0.226351E+01
+PKER_GWETH( 15, 3) = 0.176529E+01
+PKER_GWETH( 15, 4) = 0.134229E+01
+PKER_GWETH( 15, 5) = 0.989890E+00
+PKER_GWETH( 15, 6) = 0.708881E+00
+PKER_GWETH( 15, 7) = 0.504845E+00
+PKER_GWETH( 15, 8) = 0.383795E+00
+PKER_GWETH( 15, 9) = 0.345252E+00
+PKER_GWETH( 15, 10) = 0.376367E+00
+PKER_GWETH( 15, 11) = 0.453863E+00
+PKER_GWETH( 15, 12) = 0.552469E+00
+PKER_GWETH( 15, 13) = 0.652771E+00
+PKER_GWETH( 15, 14) = 0.744550E+00
+PKER_GWETH( 15, 15) = 0.824363E+00
+PKER_GWETH( 15, 16) = 0.892231E+00
+PKER_GWETH( 15, 17) = 0.949407E+00
+PKER_GWETH( 15, 18) = 0.997387E+00
+PKER_GWETH( 15, 19) = 0.103759E+01
+PKER_GWETH( 15, 20) = 0.107125E+01
+PKER_GWETH( 15, 21) = 0.109946E+01
+PKER_GWETH( 15, 22) = 0.112312E+01
+PKER_GWETH( 15, 23) = 0.114300E+01
+PKER_GWETH( 15, 24) = 0.115971E+01
+PKER_GWETH( 15, 25) = 0.117378E+01
+PKER_GWETH( 15, 26) = 0.118566E+01
+PKER_GWETH( 15, 27) = 0.119569E+01
+PKER_GWETH( 15, 28) = 0.120417E+01
+PKER_GWETH( 15, 29) = 0.121135E+01
+PKER_GWETH( 15, 30) = 0.121743E+01
+PKER_GWETH( 15, 31) = 0.122260E+01
+PKER_GWETH( 15, 32) = 0.122698E+01
+PKER_GWETH( 15, 33) = 0.123071E+01
+PKER_GWETH( 15, 34) = 0.123387E+01
+PKER_GWETH( 15, 35) = 0.123657E+01
+PKER_GWETH( 15, 36) = 0.123886E+01
+PKER_GWETH( 15, 37) = 0.124081E+01
+PKER_GWETH( 15, 38) = 0.124247E+01
+PKER_GWETH( 15, 39) = 0.124389E+01
+PKER_GWETH( 15, 40) = 0.124510E+01
+PKER_GWETH( 16, 1) = 0.301293E+01
+PKER_GWETH( 16, 2) = 0.243100E+01
+PKER_GWETH( 16, 3) = 0.193242E+01
+PKER_GWETH( 16, 4) = 0.150618E+01
+PKER_GWETH( 16, 5) = 0.114441E+01
+PKER_GWETH( 16, 6) = 0.843236E+00
+PKER_GWETH( 16, 7) = 0.603507E+00
+PKER_GWETH( 16, 8) = 0.430078E+00
+PKER_GWETH( 16, 9) = 0.327966E+00
+PKER_GWETH( 16, 10) = 0.296680E+00
+PKER_GWETH( 16, 11) = 0.324772E+00
+PKER_GWETH( 16, 12) = 0.392150E+00
+PKER_GWETH( 16, 13) = 0.477107E+00
+PKER_GWETH( 16, 14) = 0.563219E+00
+PKER_GWETH( 16, 15) = 0.641879E+00
+PKER_GWETH( 16, 16) = 0.710236E+00
+PKER_GWETH( 16, 17) = 0.768350E+00
+PKER_GWETH( 16, 18) = 0.817307E+00
+PKER_GWETH( 16, 19) = 0.858389E+00
+PKER_GWETH( 16, 20) = 0.892809E+00
+PKER_GWETH( 16, 21) = 0.921636E+00
+PKER_GWETH( 16, 22) = 0.945790E+00
+PKER_GWETH( 16, 23) = 0.966049E+00
+PKER_GWETH( 16, 24) = 0.983062E+00
+PKER_GWETH( 16, 25) = 0.997370E+00
+PKER_GWETH( 16, 26) = 0.100942E+01
+PKER_GWETH( 16, 27) = 0.101959E+01
+PKER_GWETH( 16, 28) = 0.102817E+01
+PKER_GWETH( 16, 29) = 0.103543E+01
+PKER_GWETH( 16, 30) = 0.104158E+01
+PKER_GWETH( 16, 31) = 0.104679E+01
+PKER_GWETH( 16, 32) = 0.105121E+01
+PKER_GWETH( 16, 33) = 0.105496E+01
+PKER_GWETH( 16, 34) = 0.105815E+01
+PKER_GWETH( 16, 35) = 0.106086E+01
+PKER_GWETH( 16, 36) = 0.106317E+01
+PKER_GWETH( 16, 37) = 0.106513E+01
+PKER_GWETH( 16, 38) = 0.106680E+01
+PKER_GWETH( 16, 39) = 0.106822E+01
+PKER_GWETH( 16, 40) = 0.106944E+01
+PKER_GWETH( 17, 1) = 0.315524E+01
+PKER_GWETH( 17, 2) = 0.257428E+01
+PKER_GWETH( 17, 3) = 0.207634E+01
+PKER_GWETH( 17, 4) = 0.164974E+01
+PKER_GWETH( 17, 5) = 0.128507E+01
+PKER_GWETH( 17, 6) = 0.975670E+00
+PKER_GWETH( 17, 7) = 0.718280E+00
+PKER_GWETH( 17, 8) = 0.513786E+00
+PKER_GWETH( 17, 9) = 0.366371E+00
+PKER_GWETH( 17, 10) = 0.280370E+00
+PKER_GWETH( 17, 11) = 0.254985E+00
+PKER_GWETH( 17, 12) = 0.280264E+00
+PKER_GWETH( 17, 13) = 0.338829E+00
+PKER_GWETH( 17, 14) = 0.412012E+00
+PKER_GWETH( 17, 15) = 0.485941E+00
+PKER_GWETH( 17, 16) = 0.553357E+00
+PKER_GWETH( 17, 17) = 0.611901E+00
+PKER_GWETH( 17, 18) = 0.661663E+00
+PKER_GWETH( 17, 19) = 0.703581E+00
+PKER_GWETH( 17, 20) = 0.738757E+00
+PKER_GWETH( 17, 21) = 0.768229E+00
+PKER_GWETH( 17, 22) = 0.792912E+00
+PKER_GWETH( 17, 23) = 0.813593E+00
+PKER_GWETH( 17, 24) = 0.830939E+00
+PKER_GWETH( 17, 25) = 0.845506E+00
+PKER_GWETH( 17, 26) = 0.857756E+00
+PKER_GWETH( 17, 27) = 0.868074E+00
+PKER_GWETH( 17, 28) = 0.876776E+00
+PKER_GWETH( 17, 29) = 0.884126E+00
+PKER_GWETH( 17, 30) = 0.890342E+00
+PKER_GWETH( 17, 31) = 0.895604E+00
+PKER_GWETH( 17, 32) = 0.900064E+00
+PKER_GWETH( 17, 33) = 0.903847E+00
+PKER_GWETH( 17, 34) = 0.907059E+00
+PKER_GWETH( 17, 35) = 0.909788E+00
+PKER_GWETH( 17, 36) = 0.912108E+00
+PKER_GWETH( 17, 37) = 0.914081E+00
+PKER_GWETH( 17, 38) = 0.915761E+00
+PKER_GWETH( 17, 39) = 0.917191E+00
+PKER_GWETH( 17, 40) = 0.918409E+00
+PKER_GWETH( 18, 1) = 0.327670E+01
+PKER_GWETH( 18, 2) = 0.269659E+01
+PKER_GWETH( 18, 3) = 0.219947E+01
+PKER_GWETH( 18, 4) = 0.177340E+01
+PKER_GWETH( 18, 5) = 0.140838E+01
+PKER_GWETH( 18, 6) = 0.109640E+01
+PKER_GWETH( 18, 7) = 0.831787E+00
+PKER_GWETH( 18, 8) = 0.611835E+00
+PKER_GWETH( 18, 9) = 0.437396E+00
+PKER_GWETH( 18, 10) = 0.312131E+00
+PKER_GWETH( 18, 11) = 0.239703E+00
+PKER_GWETH( 18, 12) = 0.219181E+00
+PKER_GWETH( 18, 13) = 0.241879E+00
+PKER_GWETH( 18, 14) = 0.292751E+00
+PKER_GWETH( 18, 15) = 0.355792E+00
+PKER_GWETH( 18, 16) = 0.419256E+00
+PKER_GWETH( 18, 17) = 0.477033E+00
+PKER_GWETH( 18, 18) = 0.527174E+00
+PKER_GWETH( 18, 19) = 0.569783E+00
+PKER_GWETH( 18, 20) = 0.605675E+00
+PKER_GWETH( 18, 21) = 0.635795E+00
+PKER_GWETH( 18, 22) = 0.661029E+00
+PKER_GWETH( 18, 23) = 0.682164E+00
+PKER_GWETH( 18, 24) = 0.699872E+00
+PKER_GWETH( 18, 25) = 0.714724E+00
+PKER_GWETH( 18, 26) = 0.727195E+00
+PKER_GWETH( 18, 27) = 0.737684E+00
+PKER_GWETH( 18, 28) = 0.746517E+00
+PKER_GWETH( 18, 29) = 0.753968E+00
+PKER_GWETH( 18, 30) = 0.760260E+00
+PKER_GWETH( 18, 31) = 0.765581E+00
+PKER_GWETH( 18, 32) = 0.770086E+00
+PKER_GWETH( 18, 33) = 0.773904E+00
+PKER_GWETH( 18, 34) = 0.777142E+00
+PKER_GWETH( 18, 35) = 0.779891E+00
+PKER_GWETH( 18, 36) = 0.782227E+00
+PKER_GWETH( 18, 37) = 0.784213E+00
+PKER_GWETH( 18, 38) = 0.785902E+00
+PKER_GWETH( 18, 39) = 0.787339E+00
+PKER_GWETH( 18, 40) = 0.788563E+00
+PKER_GWETH( 19, 1) = 0.338040E+01
+PKER_GWETH( 19, 2) = 0.280098E+01
+PKER_GWETH( 19, 3) = 0.230458E+01
+PKER_GWETH( 19, 4) = 0.187921E+01
+PKER_GWETH( 19, 5) = 0.151464E+01
+PKER_GWETH( 19, 6) = 0.120232E+01
+PKER_GWETH( 19, 7) = 0.935412E+00
+PKER_GWETH( 19, 8) = 0.709100E+00
+PKER_GWETH( 19, 9) = 0.521170E+00
+PKER_GWETH( 19, 10) = 0.372366E+00
+PKER_GWETH( 19, 11) = 0.265933E+00
+PKER_GWETH( 19, 12) = 0.204940E+00
+PKER_GWETH( 19, 13) = 0.188413E+00
+PKER_GWETH( 19, 14) = 0.208761E+00
+PKER_GWETH( 19, 15) = 0.252933E+00
+PKER_GWETH( 19, 16) = 0.307238E+00
+PKER_GWETH( 19, 17) = 0.361714E+00
+PKER_GWETH( 19, 18) = 0.411229E+00
+PKER_GWETH( 19, 19) = 0.454172E+00
+PKER_GWETH( 19, 20) = 0.490657E+00
+PKER_GWETH( 19, 21) = 0.521389E+00
+PKER_GWETH( 19, 22) = 0.547179E+00
+PKER_GWETH( 19, 23) = 0.568786E+00
+PKER_GWETH( 19, 24) = 0.586882E+00
+PKER_GWETH( 19, 25) = 0.602044E+00
+PKER_GWETH( 19, 26) = 0.614761E+00
+PKER_GWETH( 19, 27) = 0.625439E+00
+PKER_GWETH( 19, 28) = 0.634419E+00
+PKER_GWETH( 19, 29) = 0.641982E+00
+PKER_GWETH( 19, 30) = 0.648360E+00
+PKER_GWETH( 19, 31) = 0.653747E+00
+PKER_GWETH( 19, 32) = 0.658302E+00
+PKER_GWETH( 19, 33) = 0.662158E+00
+PKER_GWETH( 19, 34) = 0.665426E+00
+PKER_GWETH( 19, 35) = 0.668199E+00
+PKER_GWETH( 19, 36) = 0.670552E+00
+PKER_GWETH( 19, 37) = 0.672551E+00
+PKER_GWETH( 19, 38) = 0.674251E+00
+PKER_GWETH( 19, 39) = 0.675696E+00
+PKER_GWETH( 19, 40) = 0.676927E+00
+PKER_GWETH( 20, 1) = 0.346899E+01
+PKER_GWETH( 20, 2) = 0.289011E+01
+PKER_GWETH( 20, 3) = 0.239431E+01
+PKER_GWETH( 20, 4) = 0.196955E+01
+PKER_GWETH( 20, 5) = 0.160557E+01
+PKER_GWETH( 20, 6) = 0.129362E+01
+PKER_GWETH( 20, 7) = 0.102639E+01
+PKER_GWETH( 20, 8) = 0.798045E+00
+PKER_GWETH( 20, 9) = 0.604502E+00
+PKER_GWETH( 20, 10) = 0.443925E+00
+PKER_GWETH( 20, 11) = 0.317014E+00
+PKER_GWETH( 20, 12) = 0.226583E+00
+PKER_GWETH( 20, 13) = 0.175230E+00
+PKER_GWETH( 20, 14) = 0.161988E+00
+PKER_GWETH( 20, 15) = 0.180189E+00
+PKER_GWETH( 20, 16) = 0.218528E+00
+PKER_GWETH( 20, 17) = 0.265303E+00
+PKER_GWETH( 20, 18) = 0.312063E+00
+PKER_GWETH( 20, 19) = 0.354496E+00
+PKER_GWETH( 20, 20) = 0.391273E+00
+PKER_GWETH( 20, 21) = 0.422515E+00
+PKER_GWETH( 20, 22) = 0.448829E+00
+PKER_GWETH( 20, 23) = 0.470911E+00
+PKER_GWETH( 20, 24) = 0.489412E+00
+PKER_GWETH( 20, 25) = 0.504907E+00
+PKER_GWETH( 20, 26) = 0.517890E+00
+PKER_GWETH( 20, 27) = 0.528777E+00
+PKER_GWETH( 20, 28) = 0.537920E+00
+PKER_GWETH( 20, 29) = 0.545608E+00
+PKER_GWETH( 20, 30) = 0.552083E+00
+PKER_GWETH( 20, 31) = 0.557544E+00
+PKER_GWETH( 20, 32) = 0.562156E+00
+PKER_GWETH( 20, 33) = 0.566055E+00
+PKER_GWETH( 20, 34) = 0.569357E+00
+PKER_GWETH( 20, 35) = 0.572154E+00
+PKER_GWETH( 20, 36) = 0.574527E+00
+PKER_GWETH( 20, 37) = 0.576541E+00
+PKER_GWETH( 20, 38) = 0.578253E+00
+PKER_GWETH( 20, 39) = 0.579707E+00
+PKER_GWETH( 20, 40) = 0.580945E+00
+PKER_GWETH( 21, 1) = 0.354473E+01
+PKER_GWETH( 21, 2) = 0.296625E+01
+PKER_GWETH( 21, 3) = 0.247091E+01
+PKER_GWETH( 21, 4) = 0.204667E+01
+PKER_GWETH( 21, 5) = 0.168322E+01
+PKER_GWETH( 21, 6) = 0.137177E+01
+PKER_GWETH( 21, 7) = 0.110484E+01
+PKER_GWETH( 21, 8) = 0.876190E+00
+PKER_GWETH( 21, 9) = 0.680837E+00
+PKER_GWETH( 21, 10) = 0.515324E+00
+PKER_GWETH( 21, 11) = 0.378113E+00
+PKER_GWETH( 21, 12) = 0.269896E+00
+PKER_GWETH( 21, 13) = 0.193066E+00
+PKER_GWETH( 21, 14) = 0.149847E+00
+PKER_GWETH( 21, 15) = 0.139314E+00
+PKER_GWETH( 21, 16) = 0.155539E+00
+PKER_GWETH( 21, 17) = 0.188802E+00
+PKER_GWETH( 21, 18) = 0.229088E+00
+PKER_GWETH( 21, 19) = 0.269221E+00
+PKER_GWETH( 21, 20) = 0.305584E+00
+PKER_GWETH( 21, 21) = 0.337081E+00
+PKER_GWETH( 21, 22) = 0.363833E+00
+PKER_GWETH( 21, 23) = 0.386364E+00
+PKER_GWETH( 21, 24) = 0.405272E+00
+PKER_GWETH( 21, 25) = 0.421113E+00
+PKER_GWETH( 21, 26) = 0.434381E+00
+PKER_GWETH( 21, 27) = 0.445497E+00
+PKER_GWETH( 21, 28) = 0.454819E+00
+PKER_GWETH( 21, 29) = 0.462647E+00
+PKER_GWETH( 21, 30) = 0.469230E+00
+PKER_GWETH( 21, 31) = 0.474773E+00
+PKER_GWETH( 21, 32) = 0.479448E+00
+PKER_GWETH( 21, 33) = 0.483396E+00
+PKER_GWETH( 21, 34) = 0.486735E+00
+PKER_GWETH( 21, 35) = 0.489561E+00
+PKER_GWETH( 21, 36) = 0.491955E+00
+PKER_GWETH( 21, 37) = 0.493987E+00
+PKER_GWETH( 21, 38) = 0.495711E+00
+PKER_GWETH( 21, 39) = 0.497176E+00
+PKER_GWETH( 21, 40) = 0.498421E+00
+PKER_GWETH( 22, 1) = 0.360950E+01
+PKER_GWETH( 22, 2) = 0.303135E+01
+PKER_GWETH( 22, 3) = 0.253636E+01
+PKER_GWETH( 22, 4) = 0.211251E+01
+PKER_GWETH( 22, 5) = 0.174949E+01
+PKER_GWETH( 22, 6) = 0.143850E+01
+PKER_GWETH( 22, 7) = 0.117200E+01
+PKER_GWETH( 22, 8) = 0.943598E+00
+PKER_GWETH( 22, 9) = 0.747958E+00
+PKER_GWETH( 22, 10) = 0.580832E+00
+PKER_GWETH( 22, 11) = 0.439289E+00
+PKER_GWETH( 22, 12) = 0.322049E+00
+PKER_GWETH( 22, 13) = 0.229775E+00
+PKER_GWETH( 22, 14) = 0.164515E+00
+PKER_GWETH( 22, 15) = 0.128163E+00
+PKER_GWETH( 22, 16) = 0.119816E+00
+PKER_GWETH( 22, 17) = 0.134267E+00
+PKER_GWETH( 22, 18) = 0.163121E+00
+PKER_GWETH( 22, 19) = 0.197811E+00
+PKER_GWETH( 22, 20) = 0.232255E+00
+PKER_GWETH( 22, 21) = 0.263416E+00
+PKER_GWETH( 22, 22) = 0.290391E+00
+PKER_GWETH( 22, 23) = 0.313297E+00
+PKER_GWETH( 22, 24) = 0.332590E+00
+PKER_GWETH( 22, 25) = 0.348779E+00
+PKER_GWETH( 22, 26) = 0.362344E+00
+PKER_GWETH( 22, 27) = 0.373704E+00
+PKER_GWETH( 22, 28) = 0.383222E+00
+PKER_GWETH( 22, 29) = 0.391204E+00
+PKER_GWETH( 22, 30) = 0.397906E+00
+PKER_GWETH( 22, 31) = 0.403542E+00
+PKER_GWETH( 22, 32) = 0.408288E+00
+PKER_GWETH( 22, 33) = 0.412291E+00
+PKER_GWETH( 22, 34) = 0.415671E+00
+PKER_GWETH( 22, 35) = 0.418529E+00
+PKER_GWETH( 22, 36) = 0.420948E+00
+PKER_GWETH( 22, 37) = 0.422998E+00
+PKER_GWETH( 22, 38) = 0.424737E+00
+PKER_GWETH( 22, 39) = 0.426213E+00
+PKER_GWETH( 22, 40) = 0.427466E+00
+PKER_GWETH( 23, 1) = 0.366493E+01
+PKER_GWETH( 23, 2) = 0.308702E+01
+PKER_GWETH( 23, 3) = 0.259231E+01
+PKER_GWETH( 23, 4) = 0.216876E+01
+PKER_GWETH( 23, 5) = 0.180608E+01
+PKER_GWETH( 23, 6) = 0.149546E+01
+PKER_GWETH( 23, 7) = 0.122935E+01
+PKER_GWETH( 23, 8) = 0.100131E+01
+PKER_GWETH( 23, 9) = 0.805877E+00
+PKER_GWETH( 23, 10) = 0.638482E+00
+PKER_GWETH( 23, 11) = 0.495507E+00
+PKER_GWETH( 23, 12) = 0.374461E+00
+PKER_GWETH( 23, 13) = 0.274294E+00
+PKER_GWETH( 23, 14) = 0.195610E+00
+PKER_GWETH( 23, 15) = 0.140194E+00
+PKER_GWETH( 23, 16) = 0.109633E+00
+PKER_GWETH( 23, 17) = 0.103053E+00
+PKER_GWETH( 23, 18) = 0.115911E+00
+PKER_GWETH( 23, 19) = 0.140932E+00
+PKER_GWETH( 23, 20) = 0.170802E+00
+PKER_GWETH( 23, 21) = 0.200361E+00
+PKER_GWETH( 23, 22) = 0.227063E+00
+PKER_GWETH( 23, 23) = 0.250165E+00
+PKER_GWETH( 23, 24) = 0.269779E+00
+PKER_GWETH( 23, 25) = 0.286298E+00
+PKER_GWETH( 23, 26) = 0.300160E+00
+PKER_GWETH( 23, 27) = 0.311775E+00
+PKER_GWETH( 23, 28) = 0.321502E+00
+PKER_GWETH( 23, 29) = 0.329651E+00
+PKER_GWETH( 23, 30) = 0.336486E+00
+PKER_GWETH( 23, 31) = 0.342224E+00
+PKER_GWETH( 23, 32) = 0.347050E+00
+PKER_GWETH( 23, 33) = 0.351113E+00
+PKER_GWETH( 23, 34) = 0.354540E+00
+PKER_GWETH( 23, 35) = 0.357434E+00
+PKER_GWETH( 23, 36) = 0.359880E+00
+PKER_GWETH( 23, 37) = 0.361951E+00
+PKER_GWETH( 23, 38) = 0.363706E+00
+PKER_GWETH( 23, 39) = 0.365194E+00
+PKER_GWETH( 23, 40) = 0.366458E+00
+PKER_GWETH( 24, 1) = 0.371238E+01
+PKER_GWETH( 24, 2) = 0.313467E+01
+PKER_GWETH( 24, 3) = 0.264017E+01
+PKER_GWETH( 24, 4) = 0.221685E+01
+PKER_GWETH( 24, 5) = 0.185444E+01
+PKER_GWETH( 24, 6) = 0.154410E+01
+PKER_GWETH( 24, 7) = 0.127831E+01
+PKER_GWETH( 24, 8) = 0.105060E+01
+PKER_GWETH( 24, 9) = 0.855474E+00
+PKER_GWETH( 24, 10) = 0.688249E+00
+PKER_GWETH( 24, 11) = 0.545022E+00
+PKER_GWETH( 24, 12) = 0.422707E+00
+PKER_GWETH( 24, 13) = 0.319192E+00
+PKER_GWETH( 24, 14) = 0.233616E+00
+PKER_GWETH( 24, 15) = 0.166516E+00
+PKER_GWETH( 24, 16) = 0.119479E+00
+PKER_GWETH( 24, 17) = 0.937955E-01
+PKER_GWETH( 24, 18) = 0.886577E-01
+PKER_GWETH( 24, 19) = 0.100071E+00
+PKER_GWETH( 24, 20) = 0.121762E+00
+PKER_GWETH( 24, 21) = 0.147476E+00
+PKER_GWETH( 24, 22) = 0.172842E+00
+PKER_GWETH( 24, 23) = 0.195723E+00
+PKER_GWETH( 24, 24) = 0.215508E+00
+PKER_GWETH( 24, 25) = 0.232302E+00
+PKER_GWETH( 24, 26) = 0.246447E+00
+PKER_GWETH( 24, 27) = 0.258317E+00
+PKER_GWETH( 24, 28) = 0.268262E+00
+PKER_GWETH( 24, 29) = 0.276591E+00
+PKER_GWETH( 24, 30) = 0.283569E+00
+PKER_GWETH( 24, 31) = 0.289421E+00
+PKER_GWETH( 24, 32) = 0.294334E+00
+PKER_GWETH( 24, 33) = 0.298465E+00
+PKER_GWETH( 24, 34) = 0.301944E+00
+PKER_GWETH( 24, 35) = 0.304878E+00
+PKER_GWETH( 24, 36) = 0.307355E+00
+PKER_GWETH( 24, 37) = 0.309450E+00
+PKER_GWETH( 24, 38) = 0.311223E+00
+PKER_GWETH( 24, 39) = 0.312725E+00
+PKER_GWETH( 24, 40) = 0.313999E+00
+PKER_GWETH( 25, 1) = 0.375303E+01
+PKER_GWETH( 25, 2) = 0.317546E+01
+PKER_GWETH( 25, 3) = 0.268112E+01
+PKER_GWETH( 25, 4) = 0.225799E+01
+PKER_GWETH( 25, 5) = 0.189577E+01
+PKER_GWETH( 25, 6) = 0.158566E+01
+PKER_GWETH( 25, 7) = 0.132011E+01
+PKER_GWETH( 25, 8) = 0.109268E+01
+PKER_GWETH( 25, 9) = 0.897836E+00
+PKER_GWETH( 25, 10) = 0.730871E+00
+PKER_GWETH( 25, 11) = 0.587782E+00
+PKER_GWETH( 25, 12) = 0.465234E+00
+PKER_GWETH( 25, 13) = 0.360595E+00
+PKER_GWETH( 25, 14) = 0.272075E+00
+PKER_GWETH( 25, 15) = 0.198965E+00
+PKER_GWETH( 25, 16) = 0.141750E+00
+PKER_GWETH( 25, 17) = 0.101826E+00
+PKER_GWETH( 25, 18) = 0.802566E-01
+PKER_GWETH( 25, 19) = 0.762812E-01
+PKER_GWETH( 25, 20) = 0.864000E-01
+PKER_GWETH( 25, 21) = 0.105199E+00
+PKER_GWETH( 25, 22) = 0.127333E+00
+PKER_GWETH( 25, 23) = 0.149100E+00
+PKER_GWETH( 25, 24) = 0.168706E+00
+PKER_GWETH( 25, 25) = 0.185649E+00
+PKER_GWETH( 25, 26) = 0.200030E+00
+PKER_GWETH( 25, 27) = 0.212142E+00
+PKER_GWETH( 25, 28) = 0.222305E+00
+PKER_GWETH( 25, 29) = 0.230821E+00
+PKER_GWETH( 25, 30) = 0.237952E+00
+PKER_GWETH( 25, 31) = 0.243927E+00
+PKER_GWETH( 25, 32) = 0.248938E+00
+PKER_GWETH( 25, 33) = 0.253145E+00
+PKER_GWETH( 25, 34) = 0.256682E+00
+PKER_GWETH( 25, 35) = 0.259660E+00
+PKER_GWETH( 25, 36) = 0.262172E+00
+PKER_GWETH( 25, 37) = 0.264293E+00
+PKER_GWETH( 25, 38) = 0.266086E+00
+PKER_GWETH( 25, 39) = 0.267604E+00
+PKER_GWETH( 25, 40) = 0.268890E+00
+PKER_GWETH( 26, 1) = 0.378785E+01
+PKER_GWETH( 26, 2) = 0.321039E+01
+PKER_GWETH( 26, 3) = 0.271618E+01
+PKER_GWETH( 26, 4) = 0.229319E+01
+PKER_GWETH( 26, 5) = 0.193113E+01
+PKER_GWETH( 26, 6) = 0.162119E+01
+PKER_GWETH( 26, 7) = 0.135583E+01
+PKER_GWETH( 26, 8) = 0.112861E+01
+PKER_GWETH( 26, 9) = 0.934001E+00
+PKER_GWETH( 26, 10) = 0.767278E+00
+PKER_GWETH( 26, 11) = 0.624411E+00
+PKER_GWETH( 26, 12) = 0.501975E+00
+PKER_GWETH( 26, 13) = 0.397120E+00
+PKER_GWETH( 26, 14) = 0.307602E+00
+PKER_GWETH( 26, 15) = 0.231908E+00
+PKER_GWETH( 26, 16) = 0.169451E+00
+PKER_GWETH( 26, 17) = 0.120682E+00
+PKER_GWETH( 26, 18) = 0.867919E-01
+PKER_GWETH( 26, 19) = 0.686817E-01
+PKER_GWETH( 26, 20) = 0.656399E-01
+PKER_GWETH( 26, 21) = 0.746001E-01
+PKER_GWETH( 26, 22) = 0.908895E-01
+PKER_GWETH( 26, 23) = 0.109940E+00
+PKER_GWETH( 26, 24) = 0.128616E+00
+PKER_GWETH( 26, 25) = 0.145415E+00
+PKER_GWETH( 26, 26) = 0.159926E+00
+PKER_GWETH( 26, 27) = 0.172240E+00
+PKER_GWETH( 26, 28) = 0.182610E+00
+PKER_GWETH( 26, 29) = 0.191313E+00
+PKER_GWETH( 26, 30) = 0.198604E+00
+PKER_GWETH( 26, 31) = 0.204711E+00
+PKER_GWETH( 26, 32) = 0.209827E+00
+PKER_GWETH( 26, 33) = 0.214117E+00
+PKER_GWETH( 26, 34) = 0.217719E+00
+PKER_GWETH( 26, 35) = 0.220748E+00
+PKER_GWETH( 26, 36) = 0.223298E+00
+PKER_GWETH( 26, 37) = 0.225448E+00
+PKER_GWETH( 26, 38) = 0.227264E+00
+PKER_GWETH( 26, 39) = 0.228799E+00
+PKER_GWETH( 26, 40) = 0.230098E+00
+PKER_GWETH( 27, 1) = 0.381769E+01
+PKER_GWETH( 27, 2) = 0.324032E+01
+PKER_GWETH( 27, 3) = 0.274621E+01
+PKER_GWETH( 27, 4) = 0.232333E+01
+PKER_GWETH( 27, 5) = 0.196138E+01
+PKER_GWETH( 27, 6) = 0.165158E+01
+PKER_GWETH( 27, 7) = 0.138637E+01
+PKER_GWETH( 27, 8) = 0.115931E+01
+PKER_GWETH( 27, 9) = 0.964884E+00
+PKER_GWETH( 27, 10) = 0.798361E+00
+PKER_GWETH( 27, 11) = 0.655701E+00
+PKER_GWETH( 27, 12) = 0.533453E+00
+PKER_GWETH( 27, 13) = 0.428689E+00
+PKER_GWETH( 27, 14) = 0.338973E+00
+PKER_GWETH( 27, 15) = 0.262392E+00
+PKER_GWETH( 27, 16) = 0.197665E+00
+PKER_GWETH( 27, 17) = 0.144311E+00
+PKER_GWETH( 27, 18) = 0.102745E+00
+PKER_GWETH( 27, 19) = 0.739790E-01
+PKER_GWETH( 27, 20) = 0.587853E-01
+PKER_GWETH( 27, 21) = 0.564914E-01
+PKER_GWETH( 27, 22) = 0.644148E-01
+PKER_GWETH( 27, 23) = 0.785256E-01
+PKER_GWETH( 27, 24) = 0.949195E-01
+PKER_GWETH( 27, 25) = 0.110944E+00
+PKER_GWETH( 27, 26) = 0.125338E+00
+PKER_GWETH( 27, 27) = 0.137765E+00
+PKER_GWETH( 27, 28) = 0.148309E+00
+PKER_GWETH( 27, 29) = 0.157189E+00
+PKER_GWETH( 27, 30) = 0.164640E+00
+PKER_GWETH( 27, 31) = 0.170884E+00
+PKER_GWETH( 27, 32) = 0.176113E+00
+PKER_GWETH( 27, 33) = 0.180493E+00
+PKER_GWETH( 27, 34) = 0.184167E+00
+PKER_GWETH( 27, 35) = 0.187251E+00
+PKER_GWETH( 27, 36) = 0.189844E+00
+PKER_GWETH( 27, 37) = 0.192027E+00
+PKER_GWETH( 27, 38) = 0.193868E+00
+PKER_GWETH( 27, 39) = 0.195422E+00
+PKER_GWETH( 27, 40) = 0.196736E+00
+PKER_GWETH( 28, 1) = 0.384328E+01
+PKER_GWETH( 28, 2) = 0.326598E+01
+PKER_GWETH( 28, 3) = 0.277194E+01
+PKER_GWETH( 28, 4) = 0.234914E+01
+PKER_GWETH( 28, 5) = 0.198729E+01
+PKER_GWETH( 28, 6) = 0.167758E+01
+PKER_GWETH( 28, 7) = 0.141249E+01
+PKER_GWETH( 28, 8) = 0.118556E+01
+PKER_GWETH( 28, 9) = 0.991272E+00
+PKER_GWETH( 28, 10) = 0.824905E+00
+PKER_GWETH( 28, 11) = 0.682416E+00
+PKER_GWETH( 28, 12) = 0.560344E+00
+PKER_GWETH( 28, 13) = 0.455740E+00
+PKER_GWETH( 28, 14) = 0.366097E+00
+PKER_GWETH( 28, 15) = 0.289336E+00
+PKER_GWETH( 28, 16) = 0.223823E+00
+PKER_GWETH( 28, 17) = 0.168475E+00
+PKER_GWETH( 28, 18) = 0.122898E+00
+PKER_GWETH( 28, 19) = 0.874697E-01
+PKER_GWETH( 28, 20) = 0.630639E-01
+PKER_GWETH( 28, 21) = 0.503212E-01
+PKER_GWETH( 28, 22) = 0.486243E-01
+PKER_GWETH( 28, 23) = 0.556229E-01
+PKER_GWETH( 28, 24) = 0.678429E-01
+PKER_GWETH( 28, 25) = 0.819496E-01
+PKER_GWETH( 28, 26) = 0.956978E-01
+PKER_GWETH( 28, 27) = 0.108031E+00
+PKER_GWETH( 28, 28) = 0.118673E+00
+PKER_GWETH( 28, 29) = 0.127702E+00
+PKER_GWETH( 28, 30) = 0.135305E+00
+PKER_GWETH( 28, 31) = 0.141686E+00
+PKER_GWETH( 28, 32) = 0.147032E+00
+PKER_GWETH( 28, 33) = 0.151509E+00
+PKER_GWETH( 28, 34) = 0.155260E+00
+PKER_GWETH( 28, 35) = 0.158405E+00
+PKER_GWETH( 28, 36) = 0.161046E+00
+PKER_GWETH( 28, 37) = 0.163266E+00
+PKER_GWETH( 28, 38) = 0.165135E+00
+PKER_GWETH( 28, 39) = 0.166711E+00
+PKER_GWETH( 28, 40) = 0.168042E+00
+PKER_GWETH( 29, 1) = 0.386522E+01
+PKER_GWETH( 29, 2) = 0.328797E+01
+PKER_GWETH( 29, 3) = 0.279399E+01
+PKER_GWETH( 29, 4) = 0.237126E+01
+PKER_GWETH( 29, 5) = 0.200948E+01
+PKER_GWETH( 29, 6) = 0.169985E+01
+PKER_GWETH( 29, 7) = 0.143485E+01
+PKER_GWETH( 29, 8) = 0.120801E+01
+PKER_GWETH( 29, 9) = 0.101383E+01
+PKER_GWETH( 29, 10) = 0.847587E+00
+PKER_GWETH( 29, 11) = 0.705230E+00
+PKER_GWETH( 29, 12) = 0.583305E+00
+PKER_GWETH( 29, 13) = 0.478852E+00
+PKER_GWETH( 29, 14) = 0.389344E+00
+PKER_GWETH( 29, 15) = 0.312641E+00
+PKER_GWETH( 29, 16) = 0.246962E+00
+PKER_GWETH( 29, 17) = 0.190919E+00
+PKER_GWETH( 29, 18) = 0.143591E+00
+PKER_GWETH( 29, 19) = 0.104661E+00
+PKER_GWETH( 29, 20) = 0.744639E-01
+PKER_GWETH( 29, 21) = 0.537613E-01
+PKER_GWETH( 29, 22) = 0.430826E-01
+PKER_GWETH( 29, 23) = 0.418582E-01
+PKER_GWETH( 29, 24) = 0.480333E-01
+PKER_GWETH( 29, 25) = 0.586131E-01
+PKER_GWETH( 29, 26) = 0.707504E-01
+PKER_GWETH( 29, 27) = 0.825451E-01
+PKER_GWETH( 29, 28) = 0.931120E-01
+PKER_GWETH( 29, 29) = 0.102226E+00
+PKER_GWETH( 29, 30) = 0.109957E+00
+PKER_GWETH( 29, 31) = 0.116467E+00
+PKER_GWETH( 29, 32) = 0.121931E+00
+PKER_GWETH( 29, 33) = 0.126508E+00
+PKER_GWETH( 29, 34) = 0.130342E+00
+PKER_GWETH( 29, 35) = 0.133554E+00
+PKER_GWETH( 29, 36) = 0.136247E+00
+PKER_GWETH( 29, 37) = 0.138508E+00
+PKER_GWETH( 29, 38) = 0.140409E+00
+PKER_GWETH( 29, 39) = 0.142009E+00
+PKER_GWETH( 29, 40) = 0.143358E+00
+PKER_GWETH( 30, 1) = 0.388404E+01
+PKER_GWETH( 30, 2) = 0.330683E+01
+PKER_GWETH( 30, 3) = 0.281290E+01
+PKER_GWETH( 30, 4) = 0.239021E+01
+PKER_GWETH( 30, 5) = 0.202849E+01
+PKER_GWETH( 30, 6) = 0.171892E+01
+PKER_GWETH( 30, 7) = 0.145399E+01
+PKER_GWETH( 30, 8) = 0.122723E+01
+PKER_GWETH( 30, 9) = 0.103313E+01
+PKER_GWETH( 30, 10) = 0.866978E+00
+PKER_GWETH( 30, 11) = 0.724725E+00
+PKER_GWETH( 30, 12) = 0.602915E+00
+PKER_GWETH( 30, 13) = 0.498586E+00
+PKER_GWETH( 30, 14) = 0.409208E+00
+PKER_GWETH( 30, 15) = 0.332618E+00
+PKER_GWETH( 30, 16) = 0.266986E+00
+PKER_GWETH( 30, 17) = 0.210791E+00
+PKER_GWETH( 30, 18) = 0.162848E+00
+PKER_GWETH( 30, 19) = 0.122380E+00
+PKER_GWETH( 30, 20) = 0.891272E-01
+PKER_GWETH( 30, 21) = 0.633929E-01
+PKER_GWETH( 30, 22) = 0.458362E-01
+PKER_GWETH( 30, 23) = 0.368911E-01
+PKER_GWETH( 30, 24) = 0.360374E-01
+PKER_GWETH( 30, 25) = 0.414816E-01
+PKER_GWETH( 30, 26) = 0.506386E-01
+PKER_GWETH( 30, 27) = 0.610806E-01
+PKER_GWETH( 30, 28) = 0.711985E-01
+PKER_GWETH( 30, 29) = 0.802521E-01
+PKER_GWETH( 30, 30) = 0.880569E-01
+PKER_GWETH( 30, 31) = 0.946768E-01
+PKER_GWETH( 30, 32) = 0.100251E+00
+PKER_GWETH( 30, 33) = 0.104929E+00
+PKER_GWETH( 30, 34) = 0.108849E+00
+PKER_GWETH( 30, 35) = 0.112132E+00
+PKER_GWETH( 30, 36) = 0.114882E+00
+PKER_GWETH( 30, 37) = 0.117188E+00
+PKER_GWETH( 30, 38) = 0.119124E+00
+PKER_GWETH( 30, 39) = 0.120751E+00
+PKER_GWETH( 30, 40) = 0.122121E+00
+PKER_GWETH( 31, 1) = 0.390018E+01
+PKER_GWETH( 31, 2) = 0.332301E+01
+PKER_GWETH( 31, 3) = 0.282911E+01
+PKER_GWETH( 31, 4) = 0.240646E+01
+PKER_GWETH( 31, 5) = 0.204478E+01
+PKER_GWETH( 31, 6) = 0.173527E+01
+PKER_GWETH( 31, 7) = 0.147038E+01
+PKER_GWETH( 31, 8) = 0.124368E+01
+PKER_GWETH( 31, 9) = 0.104965E+01
+PKER_GWETH( 31, 10) = 0.883566E+00
+PKER_GWETH( 31, 11) = 0.741393E+00
+PKER_GWETH( 31, 12) = 0.619671E+00
+PKER_GWETH( 31, 13) = 0.515440E+00
+PKER_GWETH( 31, 14) = 0.426169E+00
+PKER_GWETH( 31, 15) = 0.349690E+00
+PKER_GWETH( 31, 16) = 0.284154E+00
+PKER_GWETH( 31, 17) = 0.227995E+00
+PKER_GWETH( 31, 18) = 0.179915E+00
+PKER_GWETH( 31, 19) = 0.138901E+00
+PKER_GWETH( 31, 20) = 0.104299E+00
+PKER_GWETH( 31, 21) = 0.758983E-01
+PKER_GWETH( 31, 22) = 0.539690E-01
+PKER_GWETH( 31, 23) = 0.390809E-01
+PKER_GWETH( 31, 24) = 0.315930E-01
+PKER_GWETH( 31, 25) = 0.310308E-01
+PKER_GWETH( 31, 26) = 0.358252E-01
+PKER_GWETH( 31, 27) = 0.437487E-01
+PKER_GWETH( 31, 28) = 0.527309E-01
+PKER_GWETH( 31, 29) = 0.614103E-01
+PKER_GWETH( 31, 30) = 0.691670E-01
+PKER_GWETH( 31, 31) = 0.758509E-01
+PKER_GWETH( 31, 32) = 0.815193E-01
+PKER_GWETH( 31, 33) = 0.862925E-01
+PKER_GWETH( 31, 34) = 0.902983E-01
+PKER_GWETH( 31, 35) = 0.936547E-01
+PKER_GWETH( 31, 36) = 0.964655E-01
+PKER_GWETH( 31, 37) = 0.988203E-01
+PKER_GWETH( 31, 38) = 0.100795E+00
+PKER_GWETH( 31, 39) = 0.102452E+00
+PKER_GWETH( 31, 40) = 0.103846E+00
+PKER_GWETH( 32, 1) = 0.391403E+01
+PKER_GWETH( 32, 2) = 0.333689E+01
+PKER_GWETH( 32, 3) = 0.284302E+01
+PKER_GWETH( 32, 4) = 0.242040E+01
+PKER_GWETH( 32, 5) = 0.205875E+01
+PKER_GWETH( 32, 6) = 0.174927E+01
+PKER_GWETH( 32, 7) = 0.148443E+01
+PKER_GWETH( 32, 8) = 0.125777E+01
+PKER_GWETH( 32, 9) = 0.106379E+01
+PKER_GWETH( 32, 10) = 0.897764E+00
+PKER_GWETH( 32, 11) = 0.755651E+00
+PKER_GWETH( 32, 12) = 0.633997E+00
+PKER_GWETH( 32, 13) = 0.529842E+00
+PKER_GWETH( 32, 14) = 0.440655E+00
+PKER_GWETH( 32, 15) = 0.364268E+00
+PKER_GWETH( 32, 16) = 0.298826E+00
+PKER_GWETH( 32, 17) = 0.242749E+00
+PKER_GWETH( 32, 18) = 0.194696E+00
+PKER_GWETH( 32, 19) = 0.153558E+00
+PKER_GWETH( 32, 20) = 0.118474E+00
+PKER_GWETH( 32, 21) = 0.888878E-01
+PKER_GWETH( 32, 22) = 0.646314E-01
+PKER_GWETH( 32, 23) = 0.459466E-01
+PKER_GWETH( 32, 24) = 0.333243E-01
+PKER_GWETH( 32, 25) = 0.270613E-01
+PKER_GWETH( 32, 26) = 0.267227E-01
+PKER_GWETH( 32, 27) = 0.309414E-01
+PKER_GWETH( 32, 28) = 0.377959E-01
+PKER_GWETH( 32, 29) = 0.455211E-01
+PKER_GWETH( 32, 30) = 0.529666E-01
+PKER_GWETH( 32, 31) = 0.596121E-01
+PKER_GWETH( 32, 32) = 0.653361E-01
+PKER_GWETH( 32, 33) = 0.701897E-01
+PKER_GWETH( 32, 34) = 0.742768E-01
+PKER_GWETH( 32, 35) = 0.777069E-01
+PKER_GWETH( 32, 36) = 0.805809E-01
+PKER_GWETH( 32, 37) = 0.829877E-01
+PKER_GWETH( 32, 38) = 0.850040E-01
+PKER_GWETH( 32, 39) = 0.866946E-01
+PKER_GWETH( 32, 40) = 0.881139E-01
+PKER_GWETH( 33, 1) = 0.392592E+01
+PKER_GWETH( 33, 2) = 0.334880E+01
+PKER_GWETH( 33, 3) = 0.285495E+01
+PKER_GWETH( 33, 4) = 0.243235E+01
+PKER_GWETH( 33, 5) = 0.207073E+01
+PKER_GWETH( 33, 6) = 0.176128E+01
+PKER_GWETH( 33, 7) = 0.149647E+01
+PKER_GWETH( 33, 8) = 0.126985E+01
+PKER_GWETH( 33, 9) = 0.107590E+01
+PKER_GWETH( 33, 10) = 0.909920E+00
+PKER_GWETH( 33, 11) = 0.767855E+00
+PKER_GWETH( 33, 12) = 0.646253E+00
+PKER_GWETH( 33, 13) = 0.542157E+00
+PKER_GWETH( 33, 14) = 0.453034E+00
+PKER_GWETH( 33, 15) = 0.376719E+00
+PKER_GWETH( 33, 16) = 0.311356E+00
+PKER_GWETH( 33, 17) = 0.255359E+00
+PKER_GWETH( 33, 18) = 0.207375E+00
+PKER_GWETH( 33, 19) = 0.166259E+00
+PKER_GWETH( 33, 20) = 0.131060E+00
+PKER_GWETH( 33, 21) = 0.101048E+00
+PKER_GWETH( 33, 22) = 0.757518E-01
+PKER_GWETH( 33, 23) = 0.550354E-01
+PKER_GWETH( 33, 24) = 0.391173E-01
+PKER_GWETH( 33, 25) = 0.284177E-01
+PKER_GWETH( 33, 26) = 0.231819E-01
+PKER_GWETH( 33, 27) = 0.230157E-01
+PKER_GWETH( 33, 28) = 0.267246E-01
+PKER_GWETH( 33, 29) = 0.326527E-01
+PKER_GWETH( 33, 30) = 0.392968E-01
+PKER_GWETH( 33, 31) = 0.456828E-01
+PKER_GWETH( 33, 32) = 0.513763E-01
+PKER_GWETH( 33, 33) = 0.562781E-01
+PKER_GWETH( 33, 34) = 0.604341E-01
+PKER_GWETH( 33, 35) = 0.639338E-01
+PKER_GWETH( 33, 36) = 0.668709E-01
+PKER_GWETH( 33, 37) = 0.693318E-01
+PKER_GWETH( 33, 38) = 0.713927E-01
+PKER_GWETH( 33, 39) = 0.731192E-01
+PKER_GWETH( 33, 40) = 0.745668E-01
+PKER_GWETH( 34, 1) = 0.393613E+01
+PKER_GWETH( 34, 2) = 0.335902E+01
+PKER_GWETH( 34, 3) = 0.286518E+01
+PKER_GWETH( 34, 4) = 0.244261E+01
+PKER_GWETH( 34, 5) = 0.208101E+01
+PKER_GWETH( 34, 6) = 0.177158E+01
+PKER_GWETH( 34, 7) = 0.150679E+01
+PKER_GWETH( 34, 8) = 0.128020E+01
+PKER_GWETH( 34, 9) = 0.108628E+01
+PKER_GWETH( 34, 10) = 0.920332E+00
+PKER_GWETH( 34, 11) = 0.778304E+00
+PKER_GWETH( 34, 12) = 0.656742E+00
+PKER_GWETH( 34, 13) = 0.552691E+00
+PKER_GWETH( 34, 14) = 0.463618E+00
+PKER_GWETH( 34, 15) = 0.387358E+00
+PKER_GWETH( 34, 16) = 0.322057E+00
+PKER_GWETH( 34, 17) = 0.266128E+00
+PKER_GWETH( 34, 18) = 0.218213E+00
+PKER_GWETH( 34, 19) = 0.177154E+00
+PKER_GWETH( 34, 20) = 0.141973E+00
+PKER_GWETH( 34, 21) = 0.111857E+00
+PKER_GWETH( 34, 22) = 0.861834E-01
+PKER_GWETH( 34, 23) = 0.645549E-01
+PKER_GWETH( 34, 24) = 0.468637E-01
+PKER_GWETH( 34, 25) = 0.333029E-01
+PKER_GWETH( 34, 26) = 0.242359E-01
+PKER_GWETH( 34, 27) = 0.198623E-01
+PKER_GWETH( 34, 28) = 0.198248E-01
+PKER_GWETH( 34, 29) = 0.230830E-01
+PKER_GWETH( 34, 30) = 0.282089E-01
+PKER_GWETH( 34, 31) = 0.339228E-01
+PKER_GWETH( 34, 32) = 0.393998E-01
+PKER_GWETH( 34, 33) = 0.442776E-01
+PKER_GWETH( 34, 34) = 0.484753E-01
+PKER_GWETH( 34, 35) = 0.520340E-01
+PKER_GWETH( 34, 36) = 0.550307E-01
+PKER_GWETH( 34, 37) = 0.575456E-01
+PKER_GWETH( 34, 38) = 0.596528E-01
+PKER_GWETH( 34, 39) = 0.614176E-01
+PKER_GWETH( 34, 40) = 0.628959E-01
+PKER_GWETH( 35, 1) = 0.394489E+01
+PKER_GWETH( 35, 2) = 0.336779E+01
+PKER_GWETH( 35, 3) = 0.287397E+01
+PKER_GWETH( 35, 4) = 0.245141E+01
+PKER_GWETH( 35, 5) = 0.208983E+01
+PKER_GWETH( 35, 6) = 0.178041E+01
+PKER_GWETH( 35, 7) = 0.151564E+01
+PKER_GWETH( 35, 8) = 0.128907E+01
+PKER_GWETH( 35, 9) = 0.109518E+01
+PKER_GWETH( 35, 10) = 0.929255E+00
+PKER_GWETH( 35, 11) = 0.787254E+00
+PKER_GWETH( 35, 12) = 0.665724E+00
+PKER_GWETH( 35, 13) = 0.561707E+00
+PKER_GWETH( 35, 14) = 0.472673E+00
+PKER_GWETH( 35, 15) = 0.396456E+00
+PKER_GWETH( 35, 16) = 0.331202E+00
+PKER_GWETH( 35, 17) = 0.275326E+00
+PKER_GWETH( 35, 18) = 0.227468E+00
+PKER_GWETH( 35, 19) = 0.186468E+00
+PKER_GWETH( 35, 20) = 0.151336E+00
+PKER_GWETH( 35, 21) = 0.121232E+00
+PKER_GWETH( 35, 22) = 0.954658E-01
+PKER_GWETH( 35, 23) = 0.735038E-01
+PKER_GWETH( 35, 24) = 0.550122E-01
+PKER_GWETH( 35, 25) = 0.399049E-01
+PKER_GWETH( 35, 26) = 0.283536E-01
+PKER_GWETH( 35, 27) = 0.206713E-01
+PKER_GWETH( 35, 28) = 0.170206E-01
+PKER_GWETH( 35, 29) = 0.170782E-01
+PKER_GWETH( 35, 30) = 0.199378E-01
+PKER_GWETH( 35, 31) = 0.243699E-01
+PKER_GWETH( 35, 32) = 0.292827E-01
+PKER_GWETH( 35, 33) = 0.339802E-01
+PKER_GWETH( 35, 34) = 0.381591E-01
+PKER_GWETH( 35, 35) = 0.417538E-01
+PKER_GWETH( 35, 36) = 0.448011E-01
+PKER_GWETH( 35, 37) = 0.473670E-01
+PKER_GWETH( 35, 38) = 0.495205E-01
+PKER_GWETH( 35, 39) = 0.513249E-01
+PKER_GWETH( 35, 40) = 0.528360E-01
+PKER_GWETH( 36, 1) = 0.395241E+01
+PKER_GWETH( 36, 2) = 0.337532E+01
+PKER_GWETH( 36, 3) = 0.288151E+01
+PKER_GWETH( 36, 4) = 0.245896E+01
+PKER_GWETH( 36, 5) = 0.209739E+01
+PKER_GWETH( 36, 6) = 0.178799E+01
+PKER_GWETH( 36, 7) = 0.152324E+01
+PKER_GWETH( 36, 8) = 0.129668E+01
+PKER_GWETH( 36, 9) = 0.110281E+01
+PKER_GWETH( 36, 10) = 0.936903E+00
+PKER_GWETH( 36, 11) = 0.794924E+00
+PKER_GWETH( 36, 12) = 0.673418E+00
+PKER_GWETH( 36, 13) = 0.569428E+00
+PKER_GWETH( 36, 14) = 0.480423E+00
+PKER_GWETH( 36, 15) = 0.404239E+00
+PKER_GWETH( 36, 16) = 0.339022E+00
+PKER_GWETH( 36, 17) = 0.283186E+00
+PKER_GWETH( 36, 18) = 0.235374E+00
+PKER_GWETH( 36, 19) = 0.194423E+00
+PKER_GWETH( 36, 20) = 0.159341E+00
+PKER_GWETH( 36, 21) = 0.129279E+00
+PKER_GWETH( 36, 22) = 0.103521E+00
+PKER_GWETH( 36, 23) = 0.814749E-01
+PKER_GWETH( 36, 24) = 0.626882E-01
+PKER_GWETH( 36, 25) = 0.468787E-01
+PKER_GWETH( 36, 26) = 0.339780E-01
+PKER_GWETH( 36, 27) = 0.241398E-01
+PKER_GWETH( 36, 28) = 0.176327E-01
+PKER_GWETH( 36, 29) = 0.145874E-01
+PKER_GWETH( 36, 30) = 0.147147E-01
+PKER_GWETH( 36, 31) = 0.172211E-01
+PKER_GWETH( 36, 32) = 0.210528E-01
+PKER_GWETH( 36, 33) = 0.252768E-01
+PKER_GWETH( 36, 34) = 0.293056E-01
+PKER_GWETH( 36, 35) = 0.328855E-01
+PKER_GWETH( 36, 36) = 0.359639E-01
+PKER_GWETH( 36, 37) = 0.385732E-01
+PKER_GWETH( 36, 38) = 0.407703E-01
+PKER_GWETH( 36, 39) = 0.426143E-01
+PKER_GWETH( 36, 40) = 0.441594E-01
+PKER_GWETH( 37, 1) = 0.395887E+01
+PKER_GWETH( 37, 2) = 0.338179E+01
+PKER_GWETH( 37, 3) = 0.288799E+01
+PKER_GWETH( 37, 4) = 0.246545E+01
+PKER_GWETH( 37, 5) = 0.210388E+01
+PKER_GWETH( 37, 6) = 0.179450E+01
+PKER_GWETH( 37, 7) = 0.152975E+01
+PKER_GWETH( 37, 8) = 0.130321E+01
+PKER_GWETH( 37, 9) = 0.110935E+01
+PKER_GWETH( 37, 10) = 0.943460E+00
+PKER_GWETH( 37, 11) = 0.801498E+00
+PKER_GWETH( 37, 12) = 0.680011E+00
+PKER_GWETH( 37, 13) = 0.576041E+00
+PKER_GWETH( 37, 14) = 0.487060E+00
+PKER_GWETH( 37, 15) = 0.410901E+00
+PKER_GWETH( 37, 16) = 0.345712E+00
+PKER_GWETH( 37, 17) = 0.289908E+00
+PKER_GWETH( 37, 18) = 0.242130E+00
+PKER_GWETH( 37, 19) = 0.201218E+00
+PKER_GWETH( 37, 20) = 0.166178E+00
+PKER_GWETH( 37, 21) = 0.136159E+00
+PKER_GWETH( 37, 22) = 0.110436E+00
+PKER_GWETH( 37, 23) = 0.883954E-01
+PKER_GWETH( 37, 24) = 0.695332E-01
+PKER_GWETH( 37, 25) = 0.534630E-01
+PKER_GWETH( 37, 26) = 0.399468E-01
+PKER_GWETH( 37, 27) = 0.289314E-01
+PKER_GWETH( 37, 28) = 0.205525E-01
+PKER_GWETH( 37, 29) = 0.150421E-01
+PKER_GWETH( 37, 30) = 0.125040E-01
+PKER_GWETH( 37, 31) = 0.126787E-01
+PKER_GWETH( 37, 32) = 0.148743E-01
+PKER_GWETH( 37, 33) = 0.181871E-01
+PKER_GWETH( 37, 34) = 0.218185E-01
+PKER_GWETH( 37, 35) = 0.252735E-01
+PKER_GWETH( 37, 36) = 0.283403E-01
+PKER_GWETH( 37, 37) = 0.309765E-01
+PKER_GWETH( 37, 38) = 0.332107E-01
+PKER_GWETH( 37, 39) = 0.350921E-01
+PKER_GWETH( 37, 40) = 0.366711E-01
+PKER_GWETH( 38, 1) = 0.396441E+01
+PKER_GWETH( 38, 2) = 0.338734E+01
+PKER_GWETH( 38, 3) = 0.289354E+01
+PKER_GWETH( 38, 4) = 0.247101E+01
+PKER_GWETH( 38, 5) = 0.210946E+01
+PKER_GWETH( 38, 6) = 0.180008E+01
+PKER_GWETH( 38, 7) = 0.153534E+01
+PKER_GWETH( 38, 8) = 0.130881E+01
+PKER_GWETH( 38, 9) = 0.111496E+01
+PKER_GWETH( 38, 10) = 0.949083E+00
+PKER_GWETH( 38, 11) = 0.807135E+00
+PKER_GWETH( 38, 12) = 0.685662E+00
+PKER_GWETH( 38, 13) = 0.581708E+00
+PKER_GWETH( 38, 14) = 0.492744E+00
+PKER_GWETH( 38, 15) = 0.416605E+00
+PKER_GWETH( 38, 16) = 0.351438E+00
+PKER_GWETH( 38, 17) = 0.295658E+00
+PKER_GWETH( 38, 18) = 0.247908E+00
+PKER_GWETH( 38, 19) = 0.207026E+00
+PKER_GWETH( 38, 20) = 0.172018E+00
+PKER_GWETH( 38, 21) = 0.142035E+00
+PKER_GWETH( 38, 22) = 0.116348E+00
+PKER_GWETH( 38, 23) = 0.943377E-01
+PKER_GWETH( 38, 24) = 0.754790E-01
+PKER_GWETH( 38, 25) = 0.593406E-01
+PKER_GWETH( 38, 26) = 0.455943E-01
+PKER_GWETH( 38, 27) = 0.340390E-01
+PKER_GWETH( 38, 28) = 0.246337E-01
+PKER_GWETH( 38, 29) = 0.174989E-01
+PKER_GWETH( 38, 30) = 0.128332E-01
+PKER_GWETH( 38, 31) = 0.107204E-01
+PKER_GWETH( 38, 32) = 0.109262E-01
+PKER_GWETH( 38, 33) = 0.128475E-01
+PKER_GWETH( 38, 34) = 0.157112E-01
+PKER_GWETH( 38, 35) = 0.188328E-01
+PKER_GWETH( 38, 36) = 0.217958E-01
+PKER_GWETH( 38, 37) = 0.244229E-01
+PKER_GWETH( 38, 38) = 0.266804E-01
+PKER_GWETH( 38, 39) = 0.285935E-01
+PKER_GWETH( 38, 40) = 0.302045E-01
+PKER_GWETH( 39, 1) = 0.396918E+01
+PKER_GWETH( 39, 2) = 0.339211E+01
+PKER_GWETH( 39, 3) = 0.289832E+01
+PKER_GWETH( 39, 4) = 0.247579E+01
+PKER_GWETH( 39, 5) = 0.211424E+01
+PKER_GWETH( 39, 6) = 0.180487E+01
+PKER_GWETH( 39, 7) = 0.154014E+01
+PKER_GWETH( 39, 8) = 0.131362E+01
+PKER_GWETH( 39, 9) = 0.111978E+01
+PKER_GWETH( 39, 10) = 0.953907E+00
+PKER_GWETH( 39, 11) = 0.811969E+00
+PKER_GWETH( 39, 12) = 0.690507E+00
+PKER_GWETH( 39, 13) = 0.586566E+00
+PKER_GWETH( 39, 14) = 0.497616E+00
+PKER_GWETH( 39, 15) = 0.421492E+00
+PKER_GWETH( 39, 16) = 0.356342E+00
+PKER_GWETH( 39, 17) = 0.300580E+00
+PKER_GWETH( 39, 18) = 0.252850E+00
+PKER_GWETH( 39, 19) = 0.211991E+00
+PKER_GWETH( 39, 20) = 0.177010E+00
+PKER_GWETH( 39, 21) = 0.147055E+00
+PKER_GWETH( 39, 22) = 0.121399E+00
+PKER_GWETH( 39, 23) = 0.994194E-01
+PKER_GWETH( 39, 24) = 0.805856E-01
+PKER_GWETH( 39, 25) = 0.644491E-01
+PKER_GWETH( 39, 26) = 0.506413E-01
+PKER_GWETH( 39, 27) = 0.388827E-01
+PKER_GWETH( 39, 28) = 0.290042E-01
+PKER_GWETH( 39, 29) = 0.209741E-01
+PKER_GWETH( 39, 30) = 0.148991E-01
+PKER_GWETH( 39, 31) = 0.109496E-01
+PKER_GWETH( 39, 32) = 0.919163E-02
+PKER_GWETH( 39, 33) = 0.941674E-02
+PKER_GWETH( 39, 34) = 0.110979E-01
+PKER_GWETH( 39, 35) = 0.135723E-01
+PKER_GWETH( 39, 36) = 0.162554E-01
+PKER_GWETH( 39, 37) = 0.187961E-01
+PKER_GWETH( 39, 38) = 0.210466E-01
+PKER_GWETH( 39, 39) = 0.229798E-01
+PKER_GWETH( 39, 40) = 0.246180E-01
+PKER_GWETH( 40, 1) = 0.397327E+01
+PKER_GWETH( 40, 2) = 0.339620E+01
+PKER_GWETH( 40, 3) = 0.290242E+01
+PKER_GWETH( 40, 4) = 0.247989E+01
+PKER_GWETH( 40, 5) = 0.211835E+01
+PKER_GWETH( 40, 6) = 0.180898E+01
+PKER_GWETH( 40, 7) = 0.154426E+01
+PKER_GWETH( 40, 8) = 0.131774E+01
+PKER_GWETH( 40, 9) = 0.112391E+01
+PKER_GWETH( 40, 10) = 0.958046E+00
+PKER_GWETH( 40, 11) = 0.816115E+00
+PKER_GWETH( 40, 12) = 0.694662E+00
+PKER_GWETH( 40, 13) = 0.590731E+00
+PKER_GWETH( 40, 14) = 0.501791E+00
+PKER_GWETH( 40, 15) = 0.425679E+00
+PKER_GWETH( 40, 16) = 0.360542E+00
+PKER_GWETH( 40, 17) = 0.304795E+00
+PKER_GWETH( 40, 18) = 0.257081E+00
+PKER_GWETH( 40, 19) = 0.216240E+00
+PKER_GWETH( 40, 20) = 0.181278E+00
+PKER_GWETH( 40, 21) = 0.151345E+00
+PKER_GWETH( 40, 22) = 0.125714E+00
+PKER_GWETH( 40, 23) = 0.103760E+00
+PKER_GWETH( 40, 24) = 0.849530E-01
+PKER_GWETH( 40, 25) = 0.688374E-01
+PKER_GWETH( 40, 26) = 0.550302E-01
+PKER_GWETH( 40, 27) = 0.432166E-01
+PKER_GWETH( 40, 28) = 0.331585E-01
+PKER_GWETH( 40, 29) = 0.247136E-01
+PKER_GWETH( 40, 30) = 0.178579E-01
+PKER_GWETH( 40, 31) = 0.126858E-01
+PKER_GWETH( 40, 32) = 0.934299E-02
+PKER_GWETH( 40, 33) = 0.788297E-02
+PKER_GWETH( 40, 34) = 0.811672E-02
+PKER_GWETH( 40, 35) = 0.958788E-02
+PKER_GWETH( 40, 36) = 0.117243E-01
+PKER_GWETH( 40, 37) = 0.140303E-01
+PKER_GWETH( 40, 38) = 0.162089E-01
+PKER_GWETH( 40, 39) = 0.181368E-01
+PKER_GWETH( 40, 40) = 0.197923E-01
+END IF
+!
+END SUBROUTINE LIMA_READ_XKER_GWETH
diff --git a/src/mesonh/micro/lima_read_xker_raccs.f90 b/src/mesonh/micro/lima_read_xker_raccs.f90
new file mode 100644
index 000000000..d29ce6cb2
--- /dev/null
+++ b/src/mesonh/micro/lima_read_xker_raccs.f90
@@ -0,0 +1,4951 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 init 2006/05/18 13:07:25
+!-----------------------------------------------------------------
+! ###########################
+ MODULE MODI_LIMA_READ_XKER_RACCS
+! ###########################
+!
+INTERFACE
+ SUBROUTINE LIMA_READ_XKER_RACCS (KACCLBDAS,KACCLBDAR,KND, &
+ PALPHAS,PNUS,PALPHAR,PNUR,PESR,PBS,PBR,PCS,PDS,PCR,PDR, &
+ PACCLBDAS_MAX,PACCLBDAR_MAX,PACCLBDAS_MIN,PACCLBDAR_MIN, &
+ PFDINFTY,PKER_RACCSS,PKER_RACCS,PKER_SACCRG )
+!
+INTEGER, INTENT(OUT) :: KND,KACCLBDAS,KACCLBDAR
+REAL, INTENT(OUT) :: PALPHAS
+REAL, INTENT(OUT) :: PNUS
+REAL, INTENT(OUT) :: PALPHAR
+REAL, INTENT(OUT) :: PNUR
+REAL, INTENT(OUT) :: PESR
+REAL, INTENT(OUT) :: PBS
+REAL, INTENT(OUT) :: PBR
+REAL, INTENT(OUT) :: PCS
+REAL, INTENT(OUT) :: PDS
+REAL, INTENT(OUT) :: PCR
+REAL, INTENT(OUT) :: PDR
+REAL, INTENT(OUT) :: PACCLBDAS_MAX
+REAL, INTENT(OUT) :: PACCLBDAR_MAX
+REAL, INTENT(OUT) :: PACCLBDAS_MIN
+REAL, INTENT(OUT) :: PACCLBDAR_MIN
+REAL, INTENT(OUT) :: PFDINFTY
+REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_RACCSS
+REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_RACCS
+REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_SACCRG
+!
+END SUBROUTINE LIMA_READ_XKER_RACCS
+!
+END INTERFACE
+!
+END MODULE MODI_LIMA_READ_XKER_RACCS
+! ##########################################################################
+ SUBROUTINE LIMA_READ_XKER_RACCS (KACCLBDAS,KACCLBDAR,KND, &
+ PALPHAS,PNUS,PALPHAR,PNUR,PESR,PBS,PBR,PCS,PDS,PCR,PDR, &
+ PACCLBDAS_MAX,PACCLBDAR_MAX,PACCLBDAS_MIN,PACCLBDAR_MIN, &
+ PFDINFTY,PKER_RACCSS,PKER_RACCS,PKER_SACCRG )
+! ##########################################################################
+!
+!!**** * * - initialize the kernels for the rain-snow accretion process
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to initialize the kernels PKER_RACCSS,
+!! PKER_RACCS and PKER_SACCRG prepared from a previous run of the routine
+!! INI_RAIN_ICE. The reading of the kernels is optional after checking for
+!! the dimensions of the arrays.
+!!
+!!** METHOD
+!! ------
+!!
+!!
+!! EXTERNAL
+!! --------
+!! None
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation ( routine READ_XKER_RACCS )
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 09/04/96
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!* 0.2 Declarations of local variables :
+!
+!
+INTEGER, INTENT(OUT) :: KND,KACCLBDAS,KACCLBDAR
+REAL, INTENT(OUT) :: PALPHAS
+REAL, INTENT(OUT) :: PNUS
+REAL, INTENT(OUT) :: PALPHAR
+REAL, INTENT(OUT) :: PNUR
+REAL, INTENT(OUT) :: PESR
+REAL, INTENT(OUT) :: PBS
+REAL, INTENT(OUT) :: PBR
+REAL, INTENT(OUT) :: PCS
+REAL, INTENT(OUT) :: PDS
+REAL, INTENT(OUT) :: PCR
+REAL, INTENT(OUT) :: PDR
+REAL, INTENT(OUT) :: PACCLBDAS_MAX
+REAL, INTENT(OUT) :: PACCLBDAR_MAX
+REAL, INTENT(OUT) :: PACCLBDAS_MIN
+REAL, INTENT(OUT) :: PACCLBDAR_MIN
+REAL, INTENT(OUT) :: PFDINFTY
+REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_RACCSS
+REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_RACCS
+REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_SACCRG
+!
+! ###################################################################
+! #INSERT HERE THE OUTPUT OF INI_RAIN_ICE IF THE KERNELS ARE UPDATED#
+! ###################################################################
+!
+KND= 50
+KACCLBDAS= 40
+KACCLBDAR= 40
+PALPHAS= 0.100000E+01
+PNUS= 0.100000E+01
+PALPHAR= 0.100000E+01
+PNUR= 0.200000E+01
+PESR= 0.100000E+01
+PBS= 0.190000E+01
+PBR= 0.300000E+01
+PCS= 0.500000E+01
+PDS= 0.270000E+00
+PCR= 0.842000E+03
+PDR= 0.800000E+00
+PACCLBDAS_MAX= 0.500000E+06
+PACCLBDAR_MAX= 0.100000E+08
+PACCLBDAS_MIN= 0.500000E+02
+PACCLBDAR_MIN= 0.100000E+04
+PFDINFTY= 0.200000E+02
+!
+IF( PRESENT(PKER_RACCSS) ) THEN
+ PKER_RACCSS( 1, 1) = 0.814109E+01
+ PKER_RACCSS( 1, 2) = 0.692586E+01
+ PKER_RACCSS( 1, 3) = 0.565192E+01
+ PKER_RACCSS( 1, 4) = 0.444434E+01
+ PKER_RACCSS( 1, 5) = 0.337172E+01
+ PKER_RACCSS( 1, 6) = 0.246569E+01
+ PKER_RACCSS( 1, 7) = 0.173757E+01
+ PKER_RACCSS( 1, 8) = 0.119489E+01
+ PKER_RACCSS( 1, 9) = 0.847828E+00
+ PKER_RACCSS( 1, 10) = 0.697256E+00
+ PKER_RACCSS( 1, 11) = 0.717816E+00
+ PKER_RACCSS( 1, 12) = 0.854882E+00
+ PKER_RACCSS( 1, 13) = 0.104470E+01
+ PKER_RACCSS( 1, 14) = 0.123807E+01
+ PKER_RACCSS( 1, 15) = 0.141081E+01
+ PKER_RACCSS( 1, 16) = 0.155700E+01
+ PKER_RACCSS( 1, 17) = 0.167856E+01
+ PKER_RACCSS( 1, 18) = 0.177921E+01
+ PKER_RACCSS( 1, 19) = 0.186250E+01
+ PKER_RACCSS( 1, 20) = 0.193142E+01
+ PKER_RACCSS( 1, 21) = 0.198845E+01
+ PKER_RACCSS( 1, 22) = 0.203565E+01
+ PKER_RACCSS( 1, 23) = 0.207472E+01
+ PKER_RACCSS( 1, 24) = 0.210705E+01
+ PKER_RACCSS( 1, 25) = 0.213381E+01
+ PKER_RACCSS( 1, 26) = 0.215596E+01
+ PKER_RACCSS( 1, 27) = 0.217429E+01
+ PKER_RACCSS( 1, 28) = 0.218947E+01
+ PKER_RACCSS( 1, 29) = 0.220203E+01
+ PKER_RACCSS( 1, 30) = 0.221243E+01
+ PKER_RACCSS( 1, 31) = 0.222103E+01
+ PKER_RACCSS( 1, 32) = 0.222816E+01
+ PKER_RACCSS( 1, 33) = 0.223406E+01
+ PKER_RACCSS( 1, 34) = 0.223894E+01
+ PKER_RACCSS( 1, 35) = 0.224298E+01
+ PKER_RACCSS( 1, 36) = 0.224632E+01
+ PKER_RACCSS( 1, 37) = 0.224909E+01
+ PKER_RACCSS( 1, 38) = 0.225138E+01
+ PKER_RACCSS( 1, 39) = 0.225328E+01
+ PKER_RACCSS( 1, 40) = 0.225485E+01
+ PKER_RACCSS( 2, 1) = 0.731793E+01
+ PKER_RACCSS( 2, 2) = 0.650784E+01
+ PKER_RACCSS( 2, 3) = 0.549484E+01
+ PKER_RACCSS( 2, 4) = 0.443777E+01
+ PKER_RACCSS( 2, 5) = 0.344045E+01
+ PKER_RACCSS( 2, 6) = 0.256167E+01
+ PKER_RACCSS( 2, 7) = 0.183252E+01
+ PKER_RACCSS( 2, 8) = 0.126978E+01
+ PKER_RACCSS( 2, 9) = 0.884187E+00
+ PKER_RACCSS( 2, 10) = 0.682228E+00
+ PKER_RACCSS( 2, 11) = 0.651607E+00
+ PKER_RACCSS( 2, 12) = 0.749498E+00
+ PKER_RACCSS( 2, 13) = 0.917050E+00
+ PKER_RACCSS( 2, 14) = 0.110111E+01
+ PKER_RACCSS( 2, 15) = 0.127111E+01
+ PKER_RACCSS( 2, 16) = 0.141681E+01
+ PKER_RACCSS( 2, 17) = 0.153841E+01
+ PKER_RACCSS( 2, 18) = 0.163915E+01
+ PKER_RACCSS( 2, 19) = 0.172252E+01
+ PKER_RACCSS( 2, 20) = 0.179149E+01
+ PKER_RACCSS( 2, 21) = 0.184857E+01
+ PKER_RACCSS( 2, 22) = 0.189580E+01
+ PKER_RACCSS( 2, 23) = 0.193488E+01
+ PKER_RACCSS( 2, 24) = 0.196723E+01
+ PKER_RACCSS( 2, 25) = 0.199401E+01
+ PKER_RACCSS( 2, 26) = 0.201617E+01
+ PKER_RACCSS( 2, 27) = 0.203451E+01
+ PKER_RACCSS( 2, 28) = 0.204969E+01
+ PKER_RACCSS( 2, 29) = 0.206226E+01
+ PKER_RACCSS( 2, 30) = 0.207266E+01
+ PKER_RACCSS( 2, 31) = 0.208127E+01
+ PKER_RACCSS( 2, 32) = 0.208839E+01
+ PKER_RACCSS( 2, 33) = 0.209429E+01
+ PKER_RACCSS( 2, 34) = 0.209918E+01
+ PKER_RACCSS( 2, 35) = 0.210322E+01
+ PKER_RACCSS( 2, 36) = 0.210656E+01
+ PKER_RACCSS( 2, 37) = 0.210933E+01
+ PKER_RACCSS( 2, 38) = 0.211163E+01
+ PKER_RACCSS( 2, 39) = 0.211352E+01
+ PKER_RACCSS( 2, 40) = 0.211509E+01
+ PKER_RACCSS( 3, 1) = 0.620923E+01
+ PKER_RACCSS( 3, 2) = 0.585074E+01
+ PKER_RACCSS( 3, 3) = 0.516881E+01
+ PKER_RACCSS( 3, 4) = 0.432464E+01
+ PKER_RACCSS( 3, 5) = 0.344908E+01
+ PKER_RACCSS( 3, 6) = 0.262906E+01
+ PKER_RACCSS( 3, 7) = 0.191653E+01
+ PKER_RACCSS( 3, 8) = 0.134324E+01
+ PKER_RACCSS( 3, 9) = 0.929224E+00
+ PKER_RACCSS( 3, 10) = 0.684394E+00
+ PKER_RACCSS( 3, 11) = 0.605038E+00
+ PKER_RACCSS( 3, 12) = 0.661387E+00
+ PKER_RACCSS( 3, 13) = 0.802622E+00
+ PKER_RACCSS( 3, 14) = 0.974479E+00
+ PKER_RACCSS( 3, 15) = 0.114040E+01
+ PKER_RACCSS( 3, 16) = 0.128524E+01
+ PKER_RACCSS( 3, 17) = 0.140682E+01
+ PKER_RACCSS( 3, 18) = 0.150766E+01
+ PKER_RACCSS( 3, 19) = 0.159112E+01
+ PKER_RACCSS( 3, 20) = 0.166016E+01
+ PKER_RACCSS( 3, 21) = 0.171729E+01
+ PKER_RACCSS( 3, 22) = 0.176455E+01
+ PKER_RACCSS( 3, 23) = 0.180367E+01
+ PKER_RACCSS( 3, 24) = 0.183604E+01
+ PKER_RACCSS( 3, 25) = 0.186283E+01
+ PKER_RACCSS( 3, 26) = 0.188500E+01
+ PKER_RACCSS( 3, 27) = 0.190335E+01
+ PKER_RACCSS( 3, 28) = 0.191854E+01
+ PKER_RACCSS( 3, 29) = 0.193111E+01
+ PKER_RACCSS( 3, 30) = 0.194152E+01
+ PKER_RACCSS( 3, 31) = 0.195013E+01
+ PKER_RACCSS( 3, 32) = 0.195726E+01
+ PKER_RACCSS( 3, 33) = 0.196316E+01
+ PKER_RACCSS( 3, 34) = 0.196805E+01
+ PKER_RACCSS( 3, 35) = 0.197209E+01
+ PKER_RACCSS( 3, 36) = 0.197544E+01
+ PKER_RACCSS( 3, 37) = 0.197821E+01
+ PKER_RACCSS( 3, 38) = 0.198050E+01
+ PKER_RACCSS( 3, 39) = 0.198240E+01
+ PKER_RACCSS( 3, 40) = 0.198397E+01
+ PKER_RACCSS( 4, 1) = 0.489412E+01
+ PKER_RACCSS( 4, 2) = 0.496003E+01
+ PKER_RACCSS( 4, 3) = 0.464691E+01
+ PKER_RACCSS( 4, 4) = 0.407266E+01
+ PKER_RACCSS( 4, 5) = 0.337005E+01
+ PKER_RACCSS( 4, 6) = 0.264746E+01
+ PKER_RACCSS( 4, 7) = 0.197888E+01
+ PKER_RACCSS( 4, 8) = 0.141145E+01
+ PKER_RACCSS( 4, 9) = 0.977676E+00
+ PKER_RACCSS( 4, 10) = 0.697624E+00
+ PKER_RACCSS( 4, 11) = 0.574725E+00
+ PKER_RACCSS( 4, 12) = 0.590243E+00
+ PKER_RACCSS( 4, 13) = 0.701865E+00
+ PKER_RACCSS( 4, 14) = 0.858232E+00
+ PKER_RACCSS( 4, 15) = 0.101841E+01
+ PKER_RACCSS( 4, 16) = 0.116181E+01
+ PKER_RACCSS( 4, 17) = 0.128324E+01
+ PKER_RACCSS( 4, 18) = 0.138420E+01
+ PKER_RACCSS( 4, 19) = 0.146776E+01
+ PKER_RACCSS( 4, 20) = 0.153689E+01
+ PKER_RACCSS( 4, 21) = 0.159407E+01
+ PKER_RACCSS( 4, 22) = 0.164139E+01
+ PKER_RACCSS( 4, 23) = 0.168054E+01
+ PKER_RACCSS( 4, 24) = 0.171293E+01
+ PKER_RACCSS( 4, 25) = 0.173974E+01
+ PKER_RACCSS( 4, 26) = 0.176193E+01
+ PKER_RACCSS( 4, 27) = 0.178029E+01
+ PKER_RACCSS( 4, 28) = 0.179549E+01
+ PKER_RACCSS( 4, 29) = 0.180807E+01
+ PKER_RACCSS( 4, 30) = 0.181848E+01
+ PKER_RACCSS( 4, 31) = 0.182709E+01
+ PKER_RACCSS( 4, 32) = 0.183423E+01
+ PKER_RACCSS( 4, 33) = 0.184013E+01
+ PKER_RACCSS( 4, 34) = 0.184502E+01
+ PKER_RACCSS( 4, 35) = 0.184906E+01
+ PKER_RACCSS( 4, 36) = 0.185241E+01
+ PKER_RACCSS( 4, 37) = 0.185518E+01
+ PKER_RACCSS( 4, 38) = 0.185747E+01
+ PKER_RACCSS( 4, 39) = 0.185937E+01
+ PKER_RACCSS( 4, 40) = 0.186094E+01
+ PKER_RACCSS( 5, 1) = 0.352472E+01
+ PKER_RACCSS( 5, 2) = 0.390184E+01
+ PKER_RACCSS( 5, 3) = 0.393452E+01
+ PKER_RACCSS( 5, 4) = 0.366051E+01
+ PKER_RACCSS( 5, 5) = 0.317719E+01
+ PKER_RACCSS( 5, 6) = 0.259404E+01
+ PKER_RACCSS( 5, 7) = 0.200191E+01
+ PKER_RACCSS( 5, 8) = 0.146469E+01
+ PKER_RACCSS( 5, 9) = 0.102673E+01
+ PKER_RACCSS( 5, 10) = 0.718755E+00
+ PKER_RACCSS( 5, 11) = 0.556693E+00
+ PKER_RACCSS( 5, 12) = 0.533409E+00
+ PKER_RACCSS( 5, 13) = 0.614372E+00
+ PKER_RACCSS( 5, 14) = 0.752546E+00
+ PKER_RACCSS( 5, 15) = 0.904981E+00
+ PKER_RACCSS( 5, 16) = 0.104611E+01
+ PKER_RACCSS( 5, 17) = 0.116720E+01
+ PKER_RACCSS( 5, 18) = 0.126824E+01
+ PKER_RACCSS( 5, 19) = 0.135194E+01
+ PKER_RACCSS( 5, 20) = 0.142116E+01
+ PKER_RACCSS( 5, 21) = 0.147842E+01
+ PKER_RACCSS( 5, 22) = 0.152579E+01
+ PKER_RACCSS( 5, 23) = 0.156498E+01
+ PKER_RACCSS( 5, 24) = 0.159741E+01
+ PKER_RACCSS( 5, 25) = 0.162424E+01
+ PKER_RACCSS( 5, 26) = 0.164644E+01
+ PKER_RACCSS( 5, 27) = 0.166482E+01
+ PKER_RACCSS( 5, 28) = 0.168003E+01
+ PKER_RACCSS( 5, 29) = 0.169261E+01
+ PKER_RACCSS( 5, 30) = 0.170303E+01
+ PKER_RACCSS( 5, 31) = 0.171165E+01
+ PKER_RACCSS( 5, 32) = 0.171879E+01
+ PKER_RACCSS( 5, 33) = 0.172469E+01
+ PKER_RACCSS( 5, 34) = 0.172958E+01
+ PKER_RACCSS( 5, 35) = 0.173363E+01
+ PKER_RACCSS( 5, 36) = 0.173698E+01
+ PKER_RACCSS( 5, 37) = 0.173975E+01
+ PKER_RACCSS( 5, 38) = 0.174205E+01
+ PKER_RACCSS( 5, 39) = 0.174395E+01
+ PKER_RACCSS( 5, 40) = 0.174552E+01
+ PKER_RACCSS( 6, 1) = 0.228210E+01
+ PKER_RACCSS( 6, 2) = 0.280066E+01
+ PKER_RACCSS( 6, 3) = 0.308657E+01
+ PKER_RACCSS( 6, 4) = 0.309355E+01
+ PKER_RACCSS( 6, 5) = 0.285370E+01
+ PKER_RACCSS( 6, 6) = 0.244776E+01
+ PKER_RACCSS( 6, 7) = 0.196661E+01
+ PKER_RACCSS( 6, 8) = 0.148740E+01
+ PKER_RACCSS( 6, 9) = 0.106708E+01
+ PKER_RACCSS( 6, 10) = 0.746205E+00
+ PKER_RACCSS( 6, 11) = 0.551114E+00
+ PKER_RACCSS( 6, 12) = 0.488949E+00
+ PKER_RACCSS( 6, 13) = 0.538117E+00
+ PKER_RACCSS( 6, 14) = 0.656577E+00
+ PKER_RACCSS( 6, 15) = 0.799740E+00
+ PKER_RACCSS( 6, 16) = 0.937749E+00
+ PKER_RACCSS( 6, 17) = 0.105821E+01
+ PKER_RACCSS( 6, 18) = 0.115932E+01
+ PKER_RACCSS( 6, 19) = 0.124316E+01
+ PKER_RACCSS( 6, 20) = 0.131250E+01
+ PKER_RACCSS( 6, 21) = 0.136985E+01
+ PKER_RACCSS( 6, 22) = 0.141729E+01
+ PKER_RACCSS( 6, 23) = 0.145653E+01
+ PKER_RACCSS( 6, 24) = 0.148899E+01
+ PKER_RACCSS( 6, 25) = 0.151585E+01
+ PKER_RACCSS( 6, 26) = 0.153808E+01
+ PKER_RACCSS( 6, 27) = 0.155647E+01
+ PKER_RACCSS( 6, 28) = 0.157169E+01
+ PKER_RACCSS( 6, 29) = 0.158429E+01
+ PKER_RACCSS( 6, 30) = 0.159471E+01
+ PKER_RACCSS( 6, 31) = 0.160334E+01
+ PKER_RACCSS( 6, 32) = 0.161048E+01
+ PKER_RACCSS( 6, 33) = 0.161639E+01
+ PKER_RACCSS( 6, 34) = 0.162128E+01
+ PKER_RACCSS( 6, 35) = 0.162533E+01
+ PKER_RACCSS( 6, 36) = 0.162868E+01
+ PKER_RACCSS( 6, 37) = 0.163145E+01
+ PKER_RACCSS( 6, 38) = 0.163375E+01
+ PKER_RACCSS( 6, 39) = 0.163565E+01
+ PKER_RACCSS( 6, 40) = 0.163722E+01
+ PKER_RACCSS( 7, 1) = 0.148782E+01
+ PKER_RACCSS( 7, 2) = 0.200771E+01
+ PKER_RACCSS( 7, 3) = 0.220555E+01
+ PKER_RACCSS( 7, 4) = 0.241780E+01
+ PKER_RACCSS( 7, 5) = 0.240508E+01
+ PKER_RACCSS( 7, 6) = 0.219547E+01
+ PKER_RACCSS( 7, 7) = 0.185621E+01
+ PKER_RACCSS( 7, 8) = 0.146365E+01
+ PKER_RACCSS( 7, 9) = 0.108448E+01
+ PKER_RACCSS( 7, 10) = 0.770204E+00
+ PKER_RACCSS( 7, 11) = 0.556115E+00
+ PKER_RACCSS( 7, 12) = 0.459612E+00
+ PKER_RACCSS( 7, 13) = 0.474417E+00
+ PKER_RACCSS( 7, 14) = 0.568754E+00
+ PKER_RACCSS( 7, 15) = 0.700250E+00
+ PKER_RACCSS( 7, 16) = 0.834630E+00
+ PKER_RACCSS( 7, 17) = 0.954778E+00
+ PKER_RACCSS( 7, 18) = 0.105642E+01
+ PKER_RACCSS( 7, 19) = 0.114078E+01
+ PKER_RACCSS( 7, 20) = 0.121042E+01
+ PKER_RACCSS( 7, 21) = 0.126792E+01
+ PKER_RACCSS( 7, 22) = 0.131544E+01
+ PKER_RACCSS( 7, 23) = 0.135474E+01
+ PKER_RACCSS( 7, 24) = 0.138724E+01
+ PKER_RACCSS( 7, 25) = 0.141414E+01
+ PKER_RACCSS( 7, 26) = 0.143639E+01
+ PKER_RACCSS( 7, 27) = 0.145480E+01
+ PKER_RACCSS( 7, 28) = 0.147003E+01
+ PKER_RACCSS( 7, 29) = 0.148264E+01
+ PKER_RACCSS( 7, 30) = 0.149307E+01
+ PKER_RACCSS( 7, 31) = 0.150171E+01
+ PKER_RACCSS( 7, 32) = 0.150885E+01
+ PKER_RACCSS( 7, 33) = 0.151477E+01
+ PKER_RACCSS( 7, 34) = 0.151966E+01
+ PKER_RACCSS( 7, 35) = 0.152372E+01
+ PKER_RACCSS( 7, 36) = 0.152707E+01
+ PKER_RACCSS( 7, 37) = 0.152984E+01
+ PKER_RACCSS( 7, 38) = 0.153214E+01
+ PKER_RACCSS( 7, 39) = 0.153404E+01
+ PKER_RACCSS( 7, 40) = 0.153562E+01
+ PKER_RACCSS( 8, 1) = 0.262435E+01
+ PKER_RACCSS( 8, 2) = 0.238666E+01
+ PKER_RACCSS( 8, 3) = 0.233673E+01
+ PKER_RACCSS( 8, 4) = 0.234057E+01
+ PKER_RACCSS( 8, 5) = 0.228742E+01
+ PKER_RACCSS( 8, 6) = 0.212164E+01
+ PKER_RACCSS( 8, 7) = 0.184665E+01
+ PKER_RACCSS( 8, 8) = 0.150391E+01
+ PKER_RACCSS( 8, 9) = 0.114827E+01
+ PKER_RACCSS( 8, 10) = 0.831674E+00
+ PKER_RACCSS( 8, 11) = 0.595148E+00
+ PKER_RACCSS( 8, 12) = 0.463804E+00
+ PKER_RACCSS( 8, 13) = 0.440716E+00
+ PKER_RACCSS( 8, 14) = 0.503716E+00
+ PKER_RACCSS( 8, 15) = 0.616434E+00
+ PKER_RACCSS( 8, 16) = 0.742493E+00
+ PKER_RACCSS( 8, 17) = 0.859895E+00
+ PKER_RACCSS( 8, 18) = 0.960763E+00
+ PKER_RACCSS( 8, 19) = 0.104493E+01
+ PKER_RACCSS( 8, 20) = 0.111460E+01
+ PKER_RACCSS( 8, 21) = 0.117219E+01
+ PKER_RACCSS( 8, 22) = 0.121981E+01
+ PKER_RACCSS( 8, 23) = 0.125918E+01
+ PKER_RACCSS( 8, 24) = 0.129174E+01
+ PKER_RACCSS( 8, 25) = 0.131868E+01
+ PKER_RACCSS( 8, 26) = 0.134096E+01
+ PKER_RACCSS( 8, 27) = 0.135939E+01
+ PKER_RACCSS( 8, 28) = 0.137465E+01
+ PKER_RACCSS( 8, 29) = 0.138727E+01
+ PKER_RACCSS( 8, 30) = 0.139771E+01
+ PKER_RACCSS( 8, 31) = 0.140635E+01
+ PKER_RACCSS( 8, 32) = 0.141350E+01
+ PKER_RACCSS( 8, 33) = 0.141942E+01
+ PKER_RACCSS( 8, 34) = 0.142432E+01
+ PKER_RACCSS( 8, 35) = 0.142838E+01
+ PKER_RACCSS( 8, 36) = 0.143173E+01
+ PKER_RACCSS( 8, 37) = 0.143451E+01
+ PKER_RACCSS( 8, 38) = 0.143681E+01
+ PKER_RACCSS( 8, 39) = 0.143871E+01
+ PKER_RACCSS( 8, 40) = 0.144029E+01
+ PKER_RACCSS( 9, 1) = 0.258564E+01
+ PKER_RACCSS( 9, 2) = 0.212607E+01
+ PKER_RACCSS( 9, 3) = 0.191008E+01
+ PKER_RACCSS( 9, 4) = 0.184553E+01
+ PKER_RACCSS( 9, 5) = 0.182496E+01
+ PKER_RACCSS( 9, 6) = 0.176067E+01
+ PKER_RACCSS( 9, 7) = 0.160989E+01
+ PKER_RACCSS( 9, 8) = 0.137709E+01
+ PKER_RACCSS( 9, 9) = 0.109833E+01
+ PKER_RACCSS( 9, 10) = 0.821651E+00
+ PKER_RACCSS( 9, 11) = 0.593004E+00
+ PKER_RACCSS( 9, 12) = 0.447502E+00
+ PKER_RACCSS( 9, 13) = 0.400378E+00
+ PKER_RACCSS( 9, 14) = 0.440619E+00
+ PKER_RACCSS( 9, 15) = 0.537296E+00
+ PKER_RACCSS( 9, 16) = 0.655296E+00
+ PKER_RACCSS( 9, 17) = 0.769925E+00
+ PKER_RACCSS( 9, 18) = 0.870332E+00
+ PKER_RACCSS( 9, 19) = 0.954640E+00
+ PKER_RACCSS( 9, 20) = 0.102452E+01
+ PKER_RACCSS( 9, 21) = 0.108227E+01
+ PKER_RACCSS( 9, 22) = 0.113001E+01
+ PKER_RACCSS( 9, 23) = 0.116947E+01
+ PKER_RACCSS( 9, 24) = 0.120209E+01
+ PKER_RACCSS( 9, 25) = 0.122908E+01
+ PKER_RACCSS( 9, 26) = 0.125140E+01
+ PKER_RACCSS( 9, 27) = 0.126986E+01
+ PKER_RACCSS( 9, 28) = 0.128513E+01
+ PKER_RACCSS( 9, 29) = 0.129777E+01
+ PKER_RACCSS( 9, 30) = 0.130823E+01
+ PKER_RACCSS( 9, 31) = 0.131688E+01
+ PKER_RACCSS( 9, 32) = 0.132404E+01
+ PKER_RACCSS( 9, 33) = 0.132996E+01
+ PKER_RACCSS( 9, 34) = 0.133487E+01
+ PKER_RACCSS( 9, 35) = 0.133892E+01
+ PKER_RACCSS( 9, 36) = 0.134228E+01
+ PKER_RACCSS( 9, 37) = 0.134506E+01
+ PKER_RACCSS( 9, 38) = 0.134736E+01
+ PKER_RACCSS( 9, 39) = 0.134927E+01
+ PKER_RACCSS( 9, 40) = 0.135084E+01
+ PKER_RACCSS( 10, 1) = 0.326941E+01
+ PKER_RACCSS( 10, 2) = 0.247738E+01
+ PKER_RACCSS( 10, 3) = 0.198894E+01
+ PKER_RACCSS( 10, 4) = 0.173769E+01
+ PKER_RACCSS( 10, 5) = 0.163096E+01
+ PKER_RACCSS( 10, 6) = 0.156919E+01
+ PKER_RACCSS( 10, 7) = 0.147478E+01
+ PKER_RACCSS( 10, 8) = 0.119527E+01
+ PKER_RACCSS( 10, 9) = 0.100108E+01
+ PKER_RACCSS( 10, 10) = 0.781320E+00
+ PKER_RACCSS( 10, 11) = 0.578296E+00
+ PKER_RACCSS( 10, 12) = 0.430609E+00
+ PKER_RACCSS( 10, 13) = 0.363116E+00
+ PKER_RACCSS( 10, 14) = 0.377933E+00
+ PKER_RACCSS( 10, 15) = 0.453999E+00
+ PKER_RACCSS( 10, 16) = 0.559195E+00
+ PKER_RACCSS( 10, 17) = 0.666791E+00
+ PKER_RACCSS( 10, 18) = 0.764030E+00
+ PKER_RACCSS( 10, 19) = 0.848611E+00
+ PKER_RACCSS( 10, 20) = 0.922036E+00
+ PKER_RACCSS( 10, 21) = 0.985589E+00
+ PKER_RACCSS( 10, 22) = 0.103929E+01
+ PKER_RACCSS( 10, 23) = 0.108289E+01
+ PKER_RACCSS( 10, 24) = 0.111739E+01
+ PKER_RACCSS( 10, 25) = 0.114490E+01
+ PKER_RACCSS( 10, 26) = 0.116733E+01
+ PKER_RACCSS( 10, 27) = 0.118583E+01
+ PKER_RACCSS( 10, 28) = 0.120113E+01
+ PKER_RACCSS( 10, 29) = 0.121379E+01
+ PKER_RACCSS( 10, 30) = 0.122426E+01
+ PKER_RACCSS( 10, 31) = 0.123292E+01
+ PKER_RACCSS( 10, 32) = 0.124009E+01
+ PKER_RACCSS( 10, 33) = 0.124602E+01
+ PKER_RACCSS( 10, 34) = 0.125093E+01
+ PKER_RACCSS( 10, 35) = 0.125500E+01
+ PKER_RACCSS( 10, 36) = 0.125836E+01
+ PKER_RACCSS( 10, 37) = 0.126114E+01
+ PKER_RACCSS( 10, 38) = 0.126344E+01
+ PKER_RACCSS( 10, 39) = 0.126535E+01
+ PKER_RACCSS( 10, 40) = 0.126692E+01
+ PKER_RACCSS( 11, 1) = 0.540047E+01
+ PKER_RACCSS( 11, 2) = 0.406788E+01
+ PKER_RACCSS( 11, 3) = 0.307616E+01
+ PKER_RACCSS( 11, 4) = 0.238233E+01
+ PKER_RACCSS( 11, 5) = 0.192893E+01
+ PKER_RACCSS( 11, 6) = 0.164024E+01
+ PKER_RACCSS( 11, 7) = 0.143525E+01
+ PKER_RACCSS( 11, 8) = 0.124898E+01
+ PKER_RACCSS( 11, 9) = 0.104781E+01
+ PKER_RACCSS( 11, 10) = 0.832136E+00
+ PKER_RACCSS( 11, 11) = 0.625559E+00
+ PKER_RACCSS( 11, 12) = 0.461096E+00
+ PKER_RACCSS( 11, 13) = 0.367093E+00
+ PKER_RACCSS( 11, 14) = 0.353793E+00
+ PKER_RACCSS( 11, 15) = 0.408329E+00
+ PKER_RACCSS( 11, 16) = 0.502430E+00
+ PKER_RACCSS( 11, 17) = 0.607438E+00
+ PKER_RACCSS( 11, 18) = 0.705454E+00
+ PKER_RACCSS( 11, 19) = 0.789792E+00
+ PKER_RACCSS( 11, 20) = 0.860149E+00
+ PKER_RACCSS( 11, 21) = 0.918336E+00
+ PKER_RACCSS( 11, 22) = 0.966393E+00
+ PKER_RACCSS( 11, 23) = 0.100609E+01
+ PKER_RACCSS( 11, 24) = 0.103890E+01
+ PKER_RACCSS( 11, 25) = 0.106601E+01
+ PKER_RACCSS( 11, 26) = 0.108843E+01
+ PKER_RACCSS( 11, 27) = 0.110696E+01
+ PKER_RACCSS( 11, 28) = 0.112230E+01
+ PKER_RACCSS( 11, 29) = 0.113498E+01
+ PKER_RACCSS( 11, 30) = 0.114547E+01
+ PKER_RACCSS( 11, 31) = 0.115414E+01
+ PKER_RACCSS( 11, 32) = 0.116132E+01
+ PKER_RACCSS( 11, 33) = 0.116726E+01
+ PKER_RACCSS( 11, 34) = 0.117218E+01
+ PKER_RACCSS( 11, 35) = 0.117625E+01
+ PKER_RACCSS( 11, 36) = 0.117961E+01
+ PKER_RACCSS( 11, 37) = 0.118240E+01
+ PKER_RACCSS( 11, 38) = 0.118470E+01
+ PKER_RACCSS( 11, 39) = 0.118661E+01
+ PKER_RACCSS( 11, 40) = 0.118819E+01
+ PKER_RACCSS( 12, 1) = 0.782212E+01
+ PKER_RACCSS( 12, 2) = 0.599420E+01
+ PKER_RACCSS( 12, 3) = 0.455236E+01
+ PKER_RACCSS( 12, 4) = 0.345125E+01
+ PKER_RACCSS( 12, 5) = 0.264475E+01
+ PKER_RACCSS( 12, 6) = 0.207701E+01
+ PKER_RACCSS( 12, 7) = 0.168031E+01
+ PKER_RACCSS( 12, 8) = 0.138445E+01
+ PKER_RACCSS( 12, 9) = 0.113395E+01
+ PKER_RACCSS( 12, 10) = 0.900399E+00
+ PKER_RACCSS( 12, 11) = 0.683291E+00
+ PKER_RACCSS( 12, 12) = 0.501952E+00
+ PKER_RACCSS( 12, 13) = 0.380903E+00
+ PKER_RACCSS( 12, 14) = 0.335581E+00
+ PKER_RACCSS( 12, 15) = 0.362162E+00
+ PKER_RACCSS( 12, 16) = 0.438221E+00
+ PKER_RACCSS( 12, 17) = 0.534996E+00
+ PKER_RACCSS( 12, 18) = 0.630498E+00
+ PKER_RACCSS( 12, 19) = 0.714544E+00
+ PKER_RACCSS( 12, 20) = 0.785149E+00
+ PKER_RACCSS( 12, 21) = 0.843614E+00
+ PKER_RACCSS( 12, 22) = 0.891886E+00
+ PKER_RACCSS( 12, 23) = 0.931743E+00
+ PKER_RACCSS( 12, 24) = 0.964664E+00
+ PKER_RACCSS( 12, 25) = 0.991866E+00
+ PKER_RACCSS( 12, 26) = 0.101435E+01
+ PKER_RACCSS( 12, 27) = 0.103293E+01
+ PKER_RACCSS( 12, 28) = 0.104830E+01
+ PKER_RACCSS( 12, 29) = 0.106101E+01
+ PKER_RACCSS( 12, 30) = 0.107152E+01
+ PKER_RACCSS( 12, 31) = 0.108022E+01
+ PKER_RACCSS( 12, 32) = 0.108741E+01
+ PKER_RACCSS( 12, 33) = 0.109336E+01
+ PKER_RACCSS( 12, 34) = 0.109828E+01
+ PKER_RACCSS( 12, 35) = 0.110236E+01
+ PKER_RACCSS( 12, 36) = 0.110573E+01
+ PKER_RACCSS( 12, 37) = 0.110852E+01
+ PKER_RACCSS( 12, 38) = 0.111082E+01
+ PKER_RACCSS( 12, 39) = 0.111273E+01
+ PKER_RACCSS( 12, 40) = 0.111431E+01
+ PKER_RACCSS( 13, 1) = 0.981788E+01
+ PKER_RACCSS( 13, 2) = 0.766217E+01
+ PKER_RACCSS( 13, 3) = 0.591544E+01
+ PKER_RACCSS( 13, 4) = 0.452414E+01
+ PKER_RACCSS( 13, 5) = 0.344339E+01
+ PKER_RACCSS( 13, 6) = 0.262943E+01
+ PKER_RACCSS( 13, 7) = 0.203218E+01
+ PKER_RACCSS( 13, 8) = 0.159445E+01
+ PKER_RACCSS( 13, 9) = 0.125920E+01
+ PKER_RACCSS( 13, 10) = 0.982700E+00
+ PKER_RACCSS( 13, 11) = 0.743668E+00
+ PKER_RACCSS( 13, 12) = 0.544085E+00
+ PKER_RACCSS( 13, 13) = 0.399552E+00
+ PKER_RACCSS( 13, 14) = 0.325874E+00
+ PKER_RACCSS( 13, 15) = 0.325287E+00
+ PKER_RACCSS( 13, 16) = 0.381940E+00
+ PKER_RACCSS( 13, 17) = 0.468486E+00
+ PKER_RACCSS( 13, 18) = 0.560310E+00
+ PKER_RACCSS( 13, 19) = 0.643677E+00
+ PKER_RACCSS( 13, 20) = 0.714489E+00
+ PKER_RACCSS( 13, 21) = 0.773275E+00
+ PKER_RACCSS( 13, 22) = 0.821809E+00
+ PKER_RACCSS( 13, 23) = 0.861858E+00
+ PKER_RACCSS( 13, 24) = 0.894921E+00
+ PKER_RACCSS( 13, 25) = 0.922229E+00
+ PKER_RACCSS( 13, 26) = 0.944790E+00
+ PKER_RACCSS( 13, 27) = 0.963435E+00
+ PKER_RACCSS( 13, 28) = 0.978848E+00
+ PKER_RACCSS( 13, 29) = 0.991591E+00
+ PKER_RACCSS( 13, 30) = 0.100213E+01
+ PKER_RACCSS( 13, 31) = 0.101084E+01
+ PKER_RACCSS( 13, 32) = 0.101805E+01
+ PKER_RACCSS( 13, 33) = 0.102401E+01
+ PKER_RACCSS( 13, 34) = 0.102895E+01
+ PKER_RACCSS( 13, 35) = 0.103303E+01
+ PKER_RACCSS( 13, 36) = 0.103640E+01
+ PKER_RACCSS( 13, 37) = 0.103920E+01
+ PKER_RACCSS( 13, 38) = 0.104151E+01
+ PKER_RACCSS( 13, 39) = 0.104342E+01
+ PKER_RACCSS( 13, 40) = 0.104500E+01
+ PKER_RACCSS( 14, 1) = 0.113567E+02
+ PKER_RACCSS( 14, 2) = 0.899336E+01
+ PKER_RACCSS( 14, 3) = 0.705312E+01
+ PKER_RACCSS( 14, 4) = 0.547412E+01
+ PKER_RACCSS( 14, 5) = 0.420687E+01
+ PKER_RACCSS( 14, 6) = 0.320973E+01
+ PKER_RACCSS( 14, 7) = 0.244303E+01
+ PKER_RACCSS( 14, 8) = 0.186415E+01
+ PKER_RACCSS( 14, 9) = 0.142646E+01
+ PKER_RACCSS( 14, 10) = 0.108627E+01
+ PKER_RACCSS( 14, 11) = 0.811450E+00
+ PKER_RACCSS( 14, 12) = 0.588974E+00
+ PKER_RACCSS( 14, 13) = 0.422701E+00
+ PKER_RACCSS( 14, 14) = 0.323861E+00
+ PKER_RACCSS( 14, 15) = 0.298012E+00
+ PKER_RACCSS( 14, 16) = 0.334007E+00
+ PKER_RACCSS( 14, 17) = 0.408204E+00
+ PKER_RACCSS( 14, 18) = 0.494846E+00
+ PKER_RACCSS( 14, 19) = 0.576947E+00
+ PKER_RACCSS( 14, 20) = 0.647860E+00
+ PKER_RACCSS( 14, 21) = 0.707002E+00
+ PKER_RACCSS( 14, 22) = 0.755849E+00
+ PKER_RACCSS( 14, 23) = 0.796134E+00
+ PKER_RACCSS( 14, 24) = 0.829370E+00
+ PKER_RACCSS( 14, 25) = 0.856805E+00
+ PKER_RACCSS( 14, 26) = 0.879461E+00
+ PKER_RACCSS( 14, 27) = 0.898178E+00
+ PKER_RACCSS( 14, 28) = 0.913645E+00
+ PKER_RACCSS( 14, 29) = 0.926429E+00
+ PKER_RACCSS( 14, 30) = 0.936998E+00
+ PKER_RACCSS( 14, 31) = 0.945737E+00
+ PKER_RACCSS( 14, 32) = 0.952964E+00
+ PKER_RACCSS( 14, 33) = 0.958941E+00
+ PKER_RACCSS( 14, 34) = 0.963884E+00
+ PKER_RACCSS( 14, 35) = 0.967974E+00
+ PKER_RACCSS( 14, 36) = 0.971357E+00
+ PKER_RACCSS( 14, 37) = 0.974155E+00
+ PKER_RACCSS( 14, 38) = 0.976471E+00
+ PKER_RACCSS( 14, 39) = 0.978386E+00
+ PKER_RACCSS( 14, 40) = 0.979971E+00
+ PKER_RACCSS( 15, 1) = 0.124924E+02
+ PKER_RACCSS( 15, 2) = 0.100003E+02
+ PKER_RACCSS( 15, 3) = 0.794169E+01
+ PKER_RACCSS( 15, 4) = 0.624828E+01
+ PKER_RACCSS( 15, 5) = 0.486528E+01
+ PKER_RACCSS( 15, 6) = 0.374844E+01
+ PKER_RACCSS( 15, 7) = 0.286039E+01
+ PKER_RACCSS( 15, 8) = 0.216647E+01
+ PKER_RACCSS( 15, 9) = 0.163111E+01
+ PKER_RACCSS( 15, 10) = 0.121825E+01
+ PKER_RACCSS( 15, 11) = 0.895737E+00
+ PKER_RACCSS( 15, 12) = 0.642706E+00
+ PKER_RACCSS( 15, 13) = 0.452742E+00
+ PKER_RACCSS( 15, 14) = 0.330032E+00
+ PKER_RACCSS( 15, 15) = 0.279351E+00
+ PKER_RACCSS( 15, 16) = 0.294228E+00
+ PKER_RACCSS( 15, 17) = 0.354314E+00
+ PKER_RACCSS( 15, 18) = 0.434176E+00
+ PKER_RACCSS( 15, 19) = 0.514178E+00
+ PKER_RACCSS( 15, 20) = 0.584975E+00
+ PKER_RACCSS( 15, 21) = 0.644491E+00
+ PKER_RACCSS( 15, 22) = 0.693710E+00
+ PKER_RACCSS( 15, 23) = 0.734280E+00
+ PKER_RACCSS( 15, 24) = 0.767726E+00
+ PKER_RACCSS( 15, 25) = 0.795316E+00
+ PKER_RACCSS( 15, 26) = 0.818088E+00
+ PKER_RACCSS( 15, 27) = 0.836891E+00
+ PKER_RACCSS( 15, 28) = 0.852423E+00
+ PKER_RACCSS( 15, 29) = 0.865256E+00
+ PKER_RACCSS( 15, 30) = 0.875863E+00
+ PKER_RACCSS( 15, 31) = 0.884631E+00
+ PKER_RACCSS( 15, 32) = 0.891880E+00
+ PKER_RACCSS( 15, 33) = 0.897874E+00
+ PKER_RACCSS( 15, 34) = 0.902831E+00
+ PKER_RACCSS( 15, 35) = 0.906930E+00
+ PKER_RACCSS( 15, 36) = 0.910321E+00
+ PKER_RACCSS( 15, 37) = 0.913126E+00
+ PKER_RACCSS( 15, 38) = 0.915447E+00
+ PKER_RACCSS( 15, 39) = 0.917366E+00
+ PKER_RACCSS( 15, 40) = 0.918954E+00
+ PKER_RACCSS( 16, 1) = 0.136907E+02
+ PKER_RACCSS( 16, 2) = 0.110657E+02
+ PKER_RACCSS( 16, 3) = 0.889092E+01
+ PKER_RACCSS( 16, 4) = 0.709169E+01
+ PKER_RACCSS( 16, 5) = 0.560750E+01
+ PKER_RACCSS( 16, 6) = 0.438940E+01
+ PKER_RACCSS( 16, 7) = 0.339760E+01
+ PKER_RACCSS( 16, 8) = 0.259872E+01
+ PKER_RACCSS( 16, 9) = 0.196266E+01
+ PKER_RACCSS( 16, 10) = 0.146081E+01
+ PKER_RACCSS( 16, 11) = 0.106641E+01
+ PKER_RACCSS( 16, 12) = 0.758348E+00
+ PKER_RACCSS( 16, 13) = 0.524888E+00
+ PKER_RACCSS( 16, 14) = 0.364964E+00
+ PKER_RACCSS( 16, 15) = 0.280630E+00
+ PKER_RACCSS( 16, 16) = 0.267498E+00
+ PKER_RACCSS( 16, 17) = 0.308591E+00
+ PKER_RACCSS( 16, 18) = 0.378682E+00
+ PKER_RACCSS( 16, 19) = 0.455284E+00
+ PKER_RACCSS( 16, 20) = 0.525585E+00
+ PKER_RACCSS( 16, 21) = 0.585451E+00
+ PKER_RACCSS( 16, 22) = 0.635103E+00
+ PKER_RACCSS( 16, 23) = 0.676018E+00
+ PKER_RACCSS( 16, 24) = 0.709719E+00
+ PKER_RACCSS( 16, 25) = 0.737497E+00
+ PKER_RACCSS( 16, 26) = 0.760408E+00
+ PKER_RACCSS( 16, 27) = 0.779316E+00
+ PKER_RACCSS( 16, 28) = 0.794926E+00
+ PKER_RACCSS( 16, 29) = 0.807819E+00
+ PKER_RACCSS( 16, 30) = 0.818471E+00
+ PKER_RACCSS( 16, 31) = 0.827273E+00
+ PKER_RACCSS( 16, 32) = 0.834549E+00
+ PKER_RACCSS( 16, 33) = 0.840564E+00
+ PKER_RACCSS( 16, 34) = 0.845537E+00
+ PKER_RACCSS( 16, 35) = 0.849649E+00
+ PKER_RACCSS( 16, 36) = 0.853049E+00
+ PKER_RACCSS( 16, 37) = 0.855862E+00
+ PKER_RACCSS( 16, 38) = 0.858188E+00
+ PKER_RACCSS( 16, 39) = 0.860112E+00
+ PKER_RACCSS( 16, 40) = 0.861704E+00
+ PKER_RACCSS( 17, 1) = 0.143219E+02
+ PKER_RACCSS( 17, 2) = 0.116425E+02
+ PKER_RACCSS( 17, 3) = 0.942087E+01
+ PKER_RACCSS( 17, 4) = 0.757943E+01
+ PKER_RACCSS( 17, 5) = 0.605456E+01
+ PKER_RACCSS( 17, 6) = 0.479437E+01
+ PKER_RACCSS( 17, 7) = 0.375669E+01
+ PKER_RACCSS( 17, 8) = 0.290705E+01
+ PKER_RACCSS( 17, 9) = 0.221663E+01
+ PKER_RACCSS( 17, 10) = 0.166050E+01
+ PKER_RACCSS( 17, 11) = 0.121648E+01
+ PKER_RACCSS( 17, 12) = 0.866211E+00
+ PKER_RACCSS( 17, 13) = 0.597261E+00
+ PKER_RACCSS( 17, 14) = 0.405300E+00
+ PKER_RACCSS( 17, 15) = 0.290505E+00
+ PKER_RACCSS( 17, 16) = 0.250047E+00
+ PKER_RACCSS( 17, 17) = 0.270435E+00
+ PKER_RACCSS( 17, 18) = 0.328579E+00
+ PKER_RACCSS( 17, 19) = 0.400271E+00
+ PKER_RACCSS( 17, 20) = 0.469487E+00
+ PKER_RACCSS( 17, 21) = 0.529608E+00
+ PKER_RACCSS( 17, 22) = 0.579747E+00
+ PKER_RACCSS( 17, 23) = 0.621077E+00
+ PKER_RACCSS( 17, 24) = 0.655088E+00
+ PKER_RACCSS( 17, 25) = 0.683095E+00
+ PKER_RACCSS( 17, 26) = 0.706175E+00
+ PKER_RACCSS( 17, 27) = 0.725209E+00
+ PKER_RACCSS( 17, 28) = 0.740914E+00
+ PKER_RACCSS( 17, 29) = 0.753878E+00
+ PKER_RACCSS( 17, 30) = 0.764585E+00
+ PKER_RACCSS( 17, 31) = 0.773429E+00
+ PKER_RACCSS( 17, 32) = 0.780736E+00
+ PKER_RACCSS( 17, 33) = 0.786775E+00
+ PKER_RACCSS( 17, 34) = 0.791767E+00
+ PKER_RACCSS( 17, 35) = 0.795894E+00
+ PKER_RACCSS( 17, 36) = 0.799306E+00
+ PKER_RACCSS( 17, 37) = 0.802128E+00
+ PKER_RACCSS( 17, 38) = 0.804461E+00
+ PKER_RACCSS( 17, 39) = 0.806391E+00
+ PKER_RACCSS( 17, 40) = 0.807987E+00
+ PKER_RACCSS( 18, 1) = 0.147209E+02
+ PKER_RACCSS( 18, 2) = 0.120131E+02
+ PKER_RACCSS( 18, 3) = 0.976801E+01
+ PKER_RACCSS( 18, 4) = 0.790632E+01
+ PKER_RACCSS( 18, 5) = 0.636267E+01
+ PKER_RACCSS( 18, 6) = 0.508334E+01
+ PKER_RACCSS( 18, 7) = 0.402439E+01
+ PKER_RACCSS( 18, 8) = 0.314991E+01
+ PKER_RACCSS( 18, 9) = 0.243053E+01
+ PKER_RACCSS( 18, 10) = 0.184200E+01
+ PKER_RACCSS( 18, 11) = 0.136420E+01
+ PKER_RACCSS( 18, 12) = 0.980889E+00
+ PKER_RACCSS( 18, 13) = 0.680705E+00
+ PKER_RACCSS( 18, 14) = 0.458391E+00
+ PKER_RACCSS( 18, 15) = 0.313204E+00
+ PKER_RACCSS( 18, 16) = 0.244163E+00
+ PKER_RACCSS( 18, 17) = 0.241397E+00
+ PKER_RACCSS( 18, 18) = 0.284627E+00
+ PKER_RACCSS( 18, 19) = 0.349372E+00
+ PKER_RACCSS( 18, 20) = 0.416570E+00
+ PKER_RACCSS( 18, 21) = 0.476717E+00
+ PKER_RACCSS( 18, 22) = 0.527374E+00
+ PKER_RACCSS( 18, 23) = 0.569195E+00
+ PKER_RACCSS( 18, 24) = 0.603582E+00
+ PKER_RACCSS( 18, 25) = 0.631866E+00
+ PKER_RACCSS( 18, 26) = 0.655151E+00
+ PKER_RACCSS( 18, 27) = 0.674337E+00
+ PKER_RACCSS( 18, 28) = 0.690157E+00
+ PKER_RACCSS( 18, 29) = 0.703207E+00
+ PKER_RACCSS( 18, 30) = 0.713979E+00
+ PKER_RACCSS( 18, 31) = 0.722873E+00
+ PKER_RACCSS( 18, 32) = 0.730219E+00
+ PKER_RACCSS( 18, 33) = 0.736287E+00
+ PKER_RACCSS( 18, 34) = 0.741302E+00
+ PKER_RACCSS( 18, 35) = 0.745447E+00
+ PKER_RACCSS( 18, 36) = 0.748872E+00
+ PKER_RACCSS( 18, 37) = 0.751705E+00
+ PKER_RACCSS( 18, 38) = 0.754046E+00
+ PKER_RACCSS( 18, 39) = 0.755982E+00
+ PKER_RACCSS( 18, 40) = 0.757584E+00
+ PKER_RACCSS( 19, 1) = 0.149183E+02
+ PKER_RACCSS( 19, 2) = 0.122030E+02
+ PKER_RACCSS( 19, 3) = 0.994164E+01
+ PKER_RACCSS( 19, 4) = 0.807634E+01
+ PKER_RACCSS( 19, 5) = 0.652942E+01
+ PKER_RACCSS( 19, 6) = 0.524643E+01
+ PKER_RACCSS( 19, 7) = 0.418260E+01
+ PKER_RACCSS( 19, 8) = 0.330120E+01
+ PKER_RACCSS( 19, 9) = 0.257220E+01
+ PKER_RACCSS( 19, 10) = 0.197109E+01
+ PKER_RACCSS( 19, 11) = 0.147799E+01
+ PKER_RACCSS( 19, 12) = 0.107723E+01
+ PKER_RACCSS( 19, 13) = 0.757647E+00
+ PKER_RACCSS( 19, 14) = 0.513325E+00
+ PKER_RACCSS( 19, 15) = 0.343389E+00
+ PKER_RACCSS( 19, 16) = 0.247854E+00
+ PKER_RACCSS( 19, 17) = 0.221083E+00
+ PKER_RACCSS( 19, 18) = 0.247150E+00
+ PKER_RACCSS( 19, 19) = 0.302778E+00
+ PKER_RACCSS( 19, 20) = 0.366775E+00
+ PKER_RACCSS( 19, 21) = 0.426568E+00
+ PKER_RACCSS( 19, 22) = 0.477725E+00
+ PKER_RACCSS( 19, 23) = 0.520116E+00
+ PKER_RACCSS( 19, 24) = 0.554956E+00
+ PKER_RACCSS( 19, 25) = 0.583576E+00
+ PKER_RACCSS( 19, 26) = 0.607109E+00
+ PKER_RACCSS( 19, 27) = 0.626480E+00
+ PKER_RACCSS( 19, 28) = 0.642437E+00
+ PKER_RACCSS( 19, 29) = 0.655592E+00
+ PKER_RACCSS( 19, 30) = 0.666442E+00
+ PKER_RACCSS( 19, 31) = 0.675396E+00
+ PKER_RACCSS( 19, 32) = 0.682788E+00
+ PKER_RACCSS( 19, 33) = 0.688892E+00
+ PKER_RACCSS( 19, 34) = 0.693934E+00
+ PKER_RACCSS( 19, 35) = 0.698099E+00
+ PKER_RACCSS( 19, 36) = 0.701541E+00
+ PKER_RACCSS( 19, 37) = 0.704386E+00
+ PKER_RACCSS( 19, 38) = 0.706738E+00
+ PKER_RACCSS( 19, 39) = 0.708682E+00
+ PKER_RACCSS( 19, 40) = 0.710289E+00
+ PKER_RACCSS( 20, 1) = 0.149148E+02
+ PKER_RACCSS( 20, 2) = 0.121968E+02
+ PKER_RACCSS( 20, 3) = 0.994688E+01
+ PKER_RACCSS( 20, 4) = 0.808241E+01
+ PKER_RACCSS( 20, 5) = 0.653732E+01
+ PKER_RACCSS( 20, 6) = 0.525704E+01
+ PKER_RACCSS( 20, 7) = 0.419660E+01
+ PKER_RACCSS( 20, 8) = 0.331897E+01
+ PKER_RACCSS( 20, 9) = 0.259370E+01
+ PKER_RACCSS( 20, 10) = 0.199579E+01
+ PKER_RACCSS( 20, 11) = 0.150482E+01
+ PKER_RACCSS( 20, 12) = 0.110452E+01
+ PKER_RACCSS( 20, 13) = 0.783023E+00
+ PKER_RACCSS( 20, 14) = 0.533371E+00
+ PKER_RACCSS( 20, 15) = 0.353809E+00
+ PKER_RACCSS( 20, 16) = 0.245035E+00
+ PKER_RACCSS( 20, 17) = 0.204243E+00
+ PKER_RACCSS( 20, 18) = 0.219182E+00
+ PKER_RACCSS( 20, 19) = 0.268663E+00
+ PKER_RACCSS( 20, 20) = 0.330431E+00
+ PKER_RACCSS( 20, 21) = 0.389684E+00
+ PKER_RACCSS( 20, 22) = 0.440619E+00
+ PKER_RACCSS( 20, 23) = 0.482783E+00
+ PKER_RACCSS( 20, 24) = 0.517411E+00
+ PKER_RACCSS( 20, 25) = 0.545855E+00
+ PKER_RACCSS( 20, 26) = 0.569246E+00
+ PKER_RACCSS( 20, 27) = 0.588502E+00
+ PKER_RACCSS( 20, 28) = 0.604366E+00
+ PKER_RACCSS( 20, 29) = 0.617445E+00
+ PKER_RACCSS( 20, 30) = 0.628235E+00
+ PKER_RACCSS( 20, 31) = 0.637140E+00
+ PKER_RACCSS( 20, 32) = 0.644493E+00
+ PKER_RACCSS( 20, 33) = 0.650566E+00
+ PKER_RACCSS( 20, 34) = 0.655583E+00
+ PKER_RACCSS( 20, 35) = 0.659729E+00
+ PKER_RACCSS( 20, 36) = 0.663155E+00
+ PKER_RACCSS( 20, 37) = 0.665988E+00
+ PKER_RACCSS( 20, 38) = 0.668329E+00
+ PKER_RACCSS( 20, 39) = 0.670265E+00
+ PKER_RACCSS( 20, 40) = 0.671867E+00
+ PKER_RACCSS( 21, 1) = 0.150013E+02
+ PKER_RACCSS( 21, 2) = 0.122869E+02
+ PKER_RACCSS( 21, 3) = 0.100382E+02
+ PKER_RACCSS( 21, 4) = 0.817497E+01
+ PKER_RACCSS( 21, 5) = 0.663057E+01
+ PKER_RACCSS( 21, 6) = 0.535086E+01
+ PKER_RACCSS( 21, 7) = 0.429034E+01
+ PKER_RACCSS( 21, 8) = 0.341176E+01
+ PKER_RACCSS( 21, 9) = 0.268444E+01
+ PKER_RACCSS( 21, 10) = 0.208320E+01
+ PKER_RACCSS( 21, 11) = 0.158747E+01
+ PKER_RACCSS( 21, 12) = 0.118074E+01
+ PKER_RACCSS( 21, 13) = 0.850535E+00
+ PKER_RACCSS( 21, 14) = 0.588897E+00
+ PKER_RACCSS( 21, 15) = 0.392828E+00
+ PKER_RACCSS( 21, 16) = 0.262954E+00
+ PKER_RACCSS( 21, 17) = 0.199389E+00
+ PKER_RACCSS( 21, 18) = 0.194569E+00
+ PKER_RACCSS( 21, 19) = 0.231063E+00
+ PKER_RACCSS( 21, 20) = 0.286983E+00
+ PKER_RACCSS( 21, 21) = 0.344860E+00
+ PKER_RACCSS( 21, 22) = 0.396111E+00
+ PKER_RACCSS( 21, 23) = 0.438868E+00
+ PKER_RACCSS( 21, 24) = 0.473989E+00
+ PKER_RACCSS( 21, 25) = 0.502799E+00
+ PKER_RACCSS( 21, 26) = 0.526459E+00
+ PKER_RACCSS( 21, 27) = 0.545913E+00
+ PKER_RACCSS( 21, 28) = 0.561925E+00
+ PKER_RACCSS( 21, 29) = 0.575114E+00
+ PKER_RACCSS( 21, 30) = 0.585987E+00
+ PKER_RACCSS( 21, 31) = 0.594955E+00
+ PKER_RACCSS( 21, 32) = 0.602355E+00
+ PKER_RACCSS( 21, 33) = 0.608464E+00
+ PKER_RACCSS( 21, 34) = 0.613509E+00
+ PKER_RACCSS( 21, 35) = 0.617676E+00
+ PKER_RACCSS( 21, 36) = 0.621119E+00
+ PKER_RACCSS( 21, 37) = 0.623965E+00
+ PKER_RACCSS( 21, 38) = 0.626316E+00
+ PKER_RACCSS( 21, 39) = 0.628260E+00
+ PKER_RACCSS( 21, 40) = 0.629867E+00
+ PKER_RACCSS( 22, 1) = 0.150720E+02
+ PKER_RACCSS( 22, 2) = 0.123594E+02
+ PKER_RACCSS( 22, 3) = 0.101123E+02
+ PKER_RACCSS( 22, 4) = 0.825051E+01
+ PKER_RACCSS( 22, 5) = 0.670778E+01
+ PKER_RACCSS( 22, 6) = 0.542920E+01
+ PKER_RACCSS( 22, 7) = 0.436946E+01
+ PKER_RACCSS( 22, 8) = 0.349113E+01
+ PKER_RACCSS( 22, 9) = 0.276334E+01
+ PKER_RACCSS( 22, 10) = 0.216073E+01
+ PKER_RACCSS( 22, 11) = 0.166252E+01
+ PKER_RACCSS( 22, 12) = 0.125192E+01
+ PKER_RACCSS( 22, 13) = 0.915920E+00
+ PKER_RACCSS( 22, 14) = 0.645535E+00
+ PKER_RACCSS( 22, 15) = 0.436397E+00
+ PKER_RACCSS( 22, 16) = 0.288654E+00
+ PKER_RACCSS( 22, 17) = 0.203659E+00
+ PKER_RACCSS( 22, 18) = 0.178071E+00
+ PKER_RACCSS( 22, 19) = 0.199311E+00
+ PKER_RACCSS( 22, 20) = 0.247192E+00
+ PKER_RACCSS( 22, 21) = 0.302537E+00
+ PKER_RACCSS( 22, 22) = 0.353781E+00
+ PKER_RACCSS( 22, 23) = 0.397157E+00
+ PKER_RACCSS( 22, 24) = 0.432857E+00
+ PKER_RACCSS( 22, 25) = 0.462108E+00
+ PKER_RACCSS( 22, 26) = 0.486096E+00
+ PKER_RACCSS( 22, 27) = 0.505793E+00
+ PKER_RACCSS( 22, 28) = 0.521983E+00
+ PKER_RACCSS( 22, 29) = 0.535306E+00
+ PKER_RACCSS( 22, 30) = 0.546278E+00
+ PKER_RACCSS( 22, 31) = 0.555321E+00
+ PKER_RACCSS( 22, 32) = 0.562778E+00
+ PKER_RACCSS( 22, 33) = 0.568931E+00
+ PKER_RACCSS( 22, 34) = 0.574009E+00
+ PKER_RACCSS( 22, 35) = 0.578202E+00
+ PKER_RACCSS( 22, 36) = 0.581665E+00
+ PKER_RACCSS( 22, 37) = 0.584526E+00
+ PKER_RACCSS( 22, 38) = 0.586889E+00
+ PKER_RACCSS( 22, 39) = 0.588843E+00
+ PKER_RACCSS( 22, 40) = 0.590457E+00
+ PKER_RACCSS( 23, 1) = 0.150726E+02
+ PKER_RACCSS( 23, 2) = 0.123607E+02
+ PKER_RACCSS( 23, 3) = 0.101143E+02
+ PKER_RACCSS( 23, 4) = 0.825344E+01
+ PKER_RACCSS( 23, 5) = 0.671177E+01
+ PKER_RACCSS( 23, 6) = 0.543448E+01
+ PKER_RACCSS( 23, 7) = 0.437621E+01
+ PKER_RACCSS( 23, 8) = 0.349956E+01
+ PKER_RACCSS( 23, 9) = 0.277362E+01
+ PKER_RACCSS( 23, 10) = 0.217295E+01
+ PKER_RACCSS( 23, 11) = 0.167667E+01
+ PKER_RACCSS( 23, 12) = 0.126773E+01
+ PKER_RACCSS( 23, 13) = 0.932718E+00
+ PKER_RACCSS( 23, 14) = 0.661907E+00
+ PKER_RACCSS( 23, 15) = 0.449897E+00
+ PKER_RACCSS( 23, 16) = 0.295961E+00
+ PKER_RACCSS( 23, 17) = 0.201862E+00
+ PKER_RACCSS( 23, 18) = 0.166501E+00
+ PKER_RACCSS( 23, 19) = 0.180054E+00
+ PKER_RACCSS( 23, 20) = 0.223817E+00
+ PKER_RACCSS( 23, 21) = 0.277646E+00
+ PKER_RACCSS( 23, 22) = 0.328410E+00
+ PKER_RACCSS( 23, 23) = 0.371512E+00
+ PKER_RACCSS( 23, 24) = 0.406971E+00
+ PKER_RACCSS( 23, 25) = 0.436013E+00
+ PKER_RACCSS( 23, 26) = 0.459823E+00
+ PKER_RACCSS( 23, 27) = 0.479372E+00
+ PKER_RACCSS( 23, 28) = 0.495442E+00
+ PKER_RACCSS( 23, 29) = 0.508667E+00
+ PKER_RACCSS( 23, 30) = 0.519559E+00
+ PKER_RACCSS( 23, 31) = 0.528537E+00
+ PKER_RACCSS( 23, 32) = 0.535942E+00
+ PKER_RACCSS( 23, 33) = 0.542053E+00
+ PKER_RACCSS( 23, 34) = 0.547098E+00
+ PKER_RACCSS( 23, 35) = 0.551263E+00
+ PKER_RACCSS( 23, 36) = 0.554705E+00
+ PKER_RACCSS( 23, 37) = 0.557548E+00
+ PKER_RACCSS( 23, 38) = 0.559898E+00
+ PKER_RACCSS( 23, 39) = 0.561840E+00
+ PKER_RACCSS( 23, 40) = 0.563446E+00
+ PKER_RACCSS( 24, 1) = 0.151324E+02
+ PKER_RACCSS( 24, 2) = 0.124216E+02
+ PKER_RACCSS( 24, 3) = 0.101765E+02
+ PKER_RACCSS( 24, 4) = 0.831675E+01
+ PKER_RACCSS( 24, 5) = 0.677615E+01
+ PKER_RACCSS( 24, 6) = 0.549978E+01
+ PKER_RACCSS( 24, 7) = 0.444223E+01
+ PKER_RACCSS( 24, 8) = 0.356597E+01
+ PKER_RACCSS( 24, 9) = 0.284002E+01
+ PKER_RACCSS( 24, 10) = 0.223881E+01
+ PKER_RACCSS( 24, 11) = 0.174131E+01
+ PKER_RACCSS( 24, 12) = 0.133030E+01
+ PKER_RACCSS( 24, 13) = 0.992011E+00
+ PKER_RACCSS( 24, 14) = 0.716009E+00
+ PKER_RACCSS( 24, 15) = 0.495767E+00
+ PKER_RACCSS( 24, 16) = 0.329155E+00
+ PKER_RACCSS( 24, 17) = 0.217613E+00
+ PKER_RACCSS( 24, 18) = 0.162580E+00
+ PKER_RACCSS( 24, 19) = 0.158691E+00
+ PKER_RACCSS( 24, 20) = 0.191157E+00
+ PKER_RACCSS( 24, 21) = 0.240223E+00
+ PKER_RACCSS( 24, 22) = 0.290187E+00
+ PKER_RACCSS( 24, 23) = 0.333776E+00
+ PKER_RACCSS( 24, 24) = 0.369843E+00
+ PKER_RACCSS( 24, 25) = 0.399359E+00
+ PKER_RACCSS( 24, 26) = 0.423520E+00
+ PKER_RACCSS( 24, 27) = 0.443327E+00
+ PKER_RACCSS( 24, 28) = 0.459588E+00
+ PKER_RACCSS( 24, 29) = 0.472953E+00
+ PKER_RACCSS( 24, 30) = 0.483950E+00
+ PKER_RACCSS( 24, 31) = 0.493007E+00
+ PKER_RACCSS( 24, 32) = 0.500470E+00
+ PKER_RACCSS( 24, 33) = 0.506625E+00
+ PKER_RACCSS( 24, 34) = 0.511703E+00
+ PKER_RACCSS( 24, 35) = 0.515895E+00
+ PKER_RACCSS( 24, 36) = 0.519356E+00
+ PKER_RACCSS( 24, 37) = 0.522215E+00
+ PKER_RACCSS( 24, 38) = 0.524576E+00
+ PKER_RACCSS( 24, 39) = 0.526528E+00
+ PKER_RACCSS( 24, 40) = 0.528140E+00
+ PKER_RACCSS( 25, 1) = 0.151432E+02
+ PKER_RACCSS( 25, 2) = 0.124328E+02
+ PKER_RACCSS( 25, 3) = 0.101882E+02
+ PKER_RACCSS( 25, 4) = 0.832899E+01
+ PKER_RACCSS( 25, 5) = 0.678899E+01
+ PKER_RACCSS( 25, 6) = 0.551328E+01
+ PKER_RACCSS( 25, 7) = 0.445646E+01
+ PKER_RACCSS( 25, 8) = 0.358099E+01
+ PKER_RACCSS( 25, 9) = 0.285587E+01
+ PKER_RACCSS( 25, 10) = 0.225550E+01
+ PKER_RACCSS( 25, 11) = 0.175879E+01
+ PKER_RACCSS( 25, 12) = 0.134845E+01
+ PKER_RACCSS( 25, 13) = 0.101050E+01
+ PKER_RACCSS( 25, 14) = 0.734111E+00
+ PKER_RACCSS( 25, 15) = 0.512093E+00
+ PKER_RACCSS( 25, 16) = 0.341419E+00
+ PKER_RACCSS( 25, 17) = 0.223087E+00
+ PKER_RACCSS( 25, 18) = 0.159345E+00
+ PKER_RACCSS( 25, 19) = 0.147102E+00
+ PKER_RACCSS( 25, 20) = 0.173839E+00
+ PKER_RACCSS( 25, 21) = 0.220264E+00
+ PKER_RACCSS( 25, 22) = 0.269389E+00
+ PKER_RACCSS( 25, 23) = 0.312757E+00
+ PKER_RACCSS( 25, 24) = 0.348700E+00
+ PKER_RACCSS( 25, 25) = 0.378105E+00
+ PKER_RACCSS( 25, 26) = 0.402161E+00
+ PKER_RACCSS( 25, 27) = 0.421874E+00
+ PKER_RACCSS( 25, 28) = 0.438052E+00
+ PKER_RACCSS( 25, 29) = 0.451345E+00
+ PKER_RACCSS( 25, 30) = 0.462282E+00
+ PKER_RACCSS( 25, 31) = 0.471288E+00
+ PKER_RACCSS( 25, 32) = 0.478709E+00
+ PKER_RACCSS( 25, 33) = 0.484830E+00
+ PKER_RACCSS( 25, 34) = 0.489880E+00
+ PKER_RACCSS( 25, 35) = 0.494049E+00
+ PKER_RACCSS( 25, 36) = 0.497492E+00
+ PKER_RACCSS( 25, 37) = 0.500336E+00
+ PKER_RACCSS( 25, 38) = 0.502685E+00
+ PKER_RACCSS( 25, 39) = 0.504627E+00
+ PKER_RACCSS( 25, 40) = 0.506233E+00
+ PKER_RACCSS( 26, 1) = 0.151604E+02
+ PKER_RACCSS( 26, 2) = 0.124505E+02
+ PKER_RACCSS( 26, 3) = 0.102063E+02
+ PKER_RACCSS( 26, 4) = 0.834759E+01
+ PKER_RACCSS( 26, 5) = 0.680810E+01
+ PKER_RACCSS( 26, 6) = 0.553290E+01
+ PKER_RACCSS( 26, 7) = 0.447661E+01
+ PKER_RACCSS( 26, 8) = 0.360165E+01
+ PKER_RACCSS( 26, 9) = 0.287702E+01
+ PKER_RACCSS( 26, 10) = 0.227707E+01
+ PKER_RACCSS( 26, 11) = 0.178069E+01
+ PKER_RACCSS( 26, 12) = 0.137049E+01
+ PKER_RACCSS( 26, 13) = 0.103238E+01
+ PKER_RACCSS( 26, 14) = 0.755232E+00
+ PKER_RACCSS( 26, 15) = 0.531299E+00
+ PKER_RACCSS( 26, 16) = 0.356723E+00
+ PKER_RACCSS( 26, 17) = 0.231969E+00
+ PKER_RACCSS( 26, 18) = 0.159466E+00
+ PKER_RACCSS( 26, 19) = 0.138275E+00
+ PKER_RACCSS( 26, 20) = 0.158408E+00
+ PKER_RACCSS( 26, 21) = 0.201507E+00
+ PKER_RACCSS( 26, 22) = 0.249601E+00
+ PKER_RACCSS( 26, 23) = 0.292817E+00
+ PKER_RACCSS( 26, 24) = 0.328766E+00
+ PKER_RACCSS( 26, 25) = 0.358167E+00
+ PKER_RACCSS( 26, 26) = 0.382203E+00
+ PKER_RACCSS( 26, 27) = 0.401886E+00
+ PKER_RACCSS( 26, 28) = 0.418030E+00
+ PKER_RACCSS( 26, 29) = 0.431290E+00
+ PKER_RACCSS( 26, 30) = 0.442195E+00
+ PKER_RACCSS( 26, 31) = 0.451173E+00
+ PKER_RACCSS( 26, 32) = 0.458570E+00
+ PKER_RACCSS( 26, 33) = 0.464669E+00
+ PKER_RACCSS( 26, 34) = 0.469702E+00
+ PKER_RACCSS( 26, 35) = 0.473856E+00
+ PKER_RACCSS( 26, 36) = 0.477287E+00
+ PKER_RACCSS( 26, 37) = 0.480121E+00
+ PKER_RACCSS( 26, 38) = 0.482463E+00
+ PKER_RACCSS( 26, 39) = 0.484399E+00
+ PKER_RACCSS( 26, 40) = 0.485999E+00
+ PKER_RACCSS( 27, 1) = 0.151814E+02
+ PKER_RACCSS( 27, 2) = 0.124719E+02
+ PKER_RACCSS( 27, 3) = 0.102281E+02
+ PKER_RACCSS( 27, 4) = 0.836990E+01
+ PKER_RACCSS( 27, 5) = 0.683086E+01
+ PKER_RACCSS( 27, 6) = 0.555611E+01
+ PKER_RACCSS( 27, 7) = 0.450023E+01
+ PKER_RACCSS( 27, 8) = 0.362567E+01
+ PKER_RACCSS( 27, 9) = 0.290135E+01
+ PKER_RACCSS( 27, 10) = 0.230164E+01
+ PKER_RACCSS( 27, 11) = 0.180536E+01
+ PKER_RACCSS( 27, 12) = 0.139509E+01
+ PKER_RACCSS( 27, 13) = 0.105660E+01
+ PKER_RACCSS( 27, 14) = 0.778555E+00
+ PKER_RACCSS( 27, 15) = 0.552744E+00
+ PKER_RACCSS( 27, 16) = 0.374600E+00
+ PKER_RACCSS( 27, 17) = 0.243637E+00
+ PKER_RACCSS( 27, 18) = 0.162579E+00
+ PKER_RACCSS( 27, 19) = 0.131954E+00
+ PKER_RACCSS( 27, 20) = 0.144584E+00
+ PKER_RACCSS( 27, 21) = 0.183443E+00
+ PKER_RACCSS( 27, 22) = 0.230184E+00
+ PKER_RACCSS( 27, 23) = 0.273243E+00
+ PKER_RACCSS( 27, 24) = 0.309289E+00
+ PKER_RACCSS( 27, 25) = 0.338774E+00
+ PKER_RACCSS( 27, 26) = 0.362856E+00
+ PKER_RACCSS( 27, 27) = 0.382560E+00
+ PKER_RACCSS( 27, 28) = 0.398710E+00
+ PKER_RACCSS( 27, 29) = 0.411966E+00
+ PKER_RACCSS( 27, 30) = 0.422862E+00
+ PKER_RACCSS( 27, 31) = 0.431828E+00
+ PKER_RACCSS( 27, 32) = 0.439214E+00
+ PKER_RACCSS( 27, 33) = 0.445302E+00
+ PKER_RACCSS( 27, 34) = 0.450325E+00
+ PKER_RACCSS( 27, 35) = 0.454471E+00
+ PKER_RACCSS( 27, 36) = 0.457894E+00
+ PKER_RACCSS( 27, 37) = 0.460722E+00
+ PKER_RACCSS( 27, 38) = 0.463059E+00
+ PKER_RACCSS( 27, 39) = 0.464990E+00
+ PKER_RACCSS( 27, 40) = 0.466587E+00
+ PKER_RACCSS( 28, 1) = 0.151833E+02
+ PKER_RACCSS( 28, 2) = 0.124739E+02
+ PKER_RACCSS( 28, 3) = 0.102303E+02
+ PKER_RACCSS( 28, 4) = 0.837216E+01
+ PKER_RACCSS( 28, 5) = 0.683329E+01
+ PKER_RACCSS( 28, 6) = 0.555874E+01
+ PKER_RACCSS( 28, 7) = 0.450309E+01
+ PKER_RACCSS( 28, 8) = 0.362879E+01
+ PKER_RACCSS( 28, 9) = 0.290477E+01
+ PKER_RACCSS( 28, 10) = 0.230538E+01
+ PKER_RACCSS( 28, 11) = 0.180946E+01
+ PKER_RACCSS( 28, 12) = 0.139955E+01
+ PKER_RACCSS( 28, 13) = 0.106140E+01
+ PKER_RACCSS( 28, 14) = 0.783576E+00
+ PKER_RACCSS( 28, 15) = 0.557673E+00
+ PKER_RACCSS( 28, 16) = 0.378779E+00
+ PKER_RACCSS( 28, 17) = 0.246210E+00
+ PKER_RACCSS( 28, 18) = 0.162452E+00
+ PKER_RACCSS( 28, 19) = 0.128861E+00
+ PKER_RACCSS( 28, 20) = 0.138936E+00
+ PKER_RACCSS( 28, 21) = 0.176459E+00
+ PKER_RACCSS( 28, 22) = 0.222625E+00
+ PKER_RACCSS( 28, 23) = 0.265456E+00
+ PKER_RACCSS( 28, 24) = 0.301332E+00
+ PKER_RACCSS( 28, 25) = 0.330667E+00
+ PKER_RACCSS( 28, 26) = 0.354619E+00
+ PKER_RACCSS( 28, 27) = 0.374211E+00
+ PKER_RACCSS( 28, 28) = 0.390266E+00
+ PKER_RACCSS( 28, 29) = 0.403443E+00
+ PKER_RACCSS( 28, 30) = 0.414273E+00
+ PKER_RACCSS( 28, 31) = 0.423185E+00
+ PKER_RACCSS( 28, 32) = 0.430527E+00
+ PKER_RACCSS( 28, 33) = 0.436580E+00
+ PKER_RACCSS( 28, 34) = 0.441573E+00
+ PKER_RACCSS( 28, 35) = 0.445696E+00
+ PKER_RACCSS( 28, 36) = 0.449101E+00
+ PKER_RACCSS( 28, 37) = 0.451914E+00
+ PKER_RACCSS( 28, 38) = 0.454239E+00
+ PKER_RACCSS( 28, 39) = 0.456161E+00
+ PKER_RACCSS( 28, 40) = 0.457750E+00
+ PKER_RACCSS( 29, 1) = 0.151936E+02
+ PKER_RACCSS( 29, 2) = 0.124845E+02
+ PKER_RACCSS( 29, 3) = 0.102410E+02
+ PKER_RACCSS( 29, 4) = 0.838316E+01
+ PKER_RACCSS( 29, 5) = 0.684451E+01
+ PKER_RACCSS( 29, 6) = 0.557018E+01
+ PKER_RACCSS( 29, 7) = 0.451475E+01
+ PKER_RACCSS( 29, 8) = 0.364064E+01
+ PKER_RACCSS( 29, 9) = 0.291680E+01
+ PKER_RACCSS( 29, 10) = 0.231756E+01
+ PKER_RACCSS( 29, 11) = 0.182172E+01
+ PKER_RACCSS( 29, 12) = 0.141183E+01
+ PKER_RACCSS( 29, 13) = 0.107359E+01
+ PKER_RACCSS( 29, 14) = 0.795449E+00
+ PKER_RACCSS( 29, 15) = 0.568820E+00
+ PKER_RACCSS( 29, 16) = 0.388406E+00
+ PKER_RACCSS( 29, 17) = 0.253055E+00
+ PKER_RACCSS( 29, 18) = 0.165100E+00
+ PKER_RACCSS( 29, 19) = 0.126486E+00
+ PKER_RACCSS( 29, 20) = 0.132218E+00
+ PKER_RACCSS( 29, 21) = 0.167127E+00
+ PKER_RACCSS( 29, 22) = 0.212335E+00
+ PKER_RACCSS( 29, 23) = 0.254984E+00
+ PKER_RACCSS( 29, 24) = 0.290865E+00
+ PKER_RACCSS( 29, 25) = 0.320207E+00
+ PKER_RACCSS( 29, 26) = 0.344152E+00
+ PKER_RACCSS( 29, 27) = 0.363727E+00
+ PKER_RACCSS( 29, 28) = 0.379760E+00
+ PKER_RACCSS( 29, 29) = 0.392914E+00
+ PKER_RACCSS( 29, 30) = 0.403723E+00
+ PKER_RACCSS( 29, 31) = 0.412615E+00
+ PKER_RACCSS( 29, 32) = 0.419938E+00
+ PKER_RACCSS( 29, 33) = 0.425976E+00
+ PKER_RACCSS( 29, 34) = 0.430956E+00
+ PKER_RACCSS( 29, 35) = 0.435068E+00
+ PKER_RACCSS( 29, 36) = 0.438464E+00
+ PKER_RACCSS( 29, 37) = 0.441269E+00
+ PKER_RACCSS( 29, 38) = 0.443588E+00
+ PKER_RACCSS( 29, 39) = 0.445506E+00
+ PKER_RACCSS( 29, 40) = 0.447091E+00
+ PKER_RACCSS( 30, 1) = 0.152092E+02
+ PKER_RACCSS( 30, 2) = 0.125003E+02
+ PKER_RACCSS( 30, 3) = 0.102571E+02
+ PKER_RACCSS( 30, 4) = 0.839954E+01
+ PKER_RACCSS( 30, 5) = 0.686114E+01
+ PKER_RACCSS( 30, 6) = 0.558706E+01
+ PKER_RACCSS( 30, 7) = 0.453184E+01
+ PKER_RACCSS( 30, 8) = 0.365791E+01
+ PKER_RACCSS( 30, 9) = 0.293420E+01
+ PKER_RACCSS( 30, 10) = 0.233502E+01
+ PKER_RACCSS( 30, 11) = 0.183917E+01
+ PKER_RACCSS( 30, 12) = 0.142914E+01
+ PKER_RACCSS( 30, 13) = 0.109060E+01
+ PKER_RACCSS( 30, 14) = 0.811894E+00
+ PKER_RACCSS( 30, 15) = 0.584240E+00
+ PKER_RACCSS( 30, 16) = 0.401963E+00
+ PKER_RACCSS( 30, 17) = 0.263204E+00
+ PKER_RACCSS( 30, 18) = 0.170121E+00
+ PKER_RACCSS( 30, 19) = 0.125069E+00
+ PKER_RACCSS( 30, 20) = 0.124997E+00
+ PKER_RACCSS( 30, 21) = 0.156156E+00
+ PKER_RACCSS( 30, 22) = 0.199916E+00
+ PKER_RACCSS( 30, 23) = 0.242350E+00
+ PKER_RACCSS( 30, 24) = 0.278332E+00
+ PKER_RACCSS( 30, 25) = 0.307780E+00
+ PKER_RACCSS( 30, 26) = 0.331793E+00
+ PKER_RACCSS( 30, 27) = 0.351410E+00
+ PKER_RACCSS( 30, 28) = 0.367466E+00
+ PKER_RACCSS( 30, 29) = 0.380631E+00
+ PKER_RACCSS( 30, 30) = 0.391442E+00
+ PKER_RACCSS( 30, 31) = 0.400333E+00
+ PKER_RACCSS( 30, 32) = 0.407654E+00
+ PKER_RACCSS( 30, 33) = 0.413687E+00
+ PKER_RACCSS( 30, 34) = 0.418663E+00
+ PKER_RACCSS( 30, 35) = 0.422770E+00
+ PKER_RACCSS( 30, 36) = 0.426162E+00
+ PKER_RACCSS( 30, 37) = 0.428964E+00
+ PKER_RACCSS( 30, 38) = 0.431280E+00
+ PKER_RACCSS( 30, 39) = 0.433195E+00
+ PKER_RACCSS( 30, 40) = 0.434778E+00
+ PKER_RACCSS( 31, 1) = 0.152168E+02
+ PKER_RACCSS( 31, 2) = 0.125081E+02
+ PKER_RACCSS( 31, 3) = 0.102650E+02
+ PKER_RACCSS( 31, 4) = 0.840757E+01
+ PKER_RACCSS( 31, 5) = 0.686932E+01
+ PKER_RACCSS( 31, 6) = 0.559536E+01
+ PKER_RACCSS( 31, 7) = 0.454028E+01
+ PKER_RACCSS( 31, 8) = 0.366647E+01
+ PKER_RACCSS( 31, 9) = 0.294286E+01
+ PKER_RACCSS( 31, 10) = 0.234375E+01
+ PKER_RACCSS( 31, 11) = 0.184793E+01
+ PKER_RACCSS( 31, 12) = 0.143790E+01
+ PKER_RACCSS( 31, 13) = 0.109928E+01
+ PKER_RACCSS( 31, 14) = 0.820370E+00
+ PKER_RACCSS( 31, 15) = 0.592284E+00
+ PKER_RACCSS( 31, 16) = 0.409147E+00
+ PKER_RACCSS( 31, 17) = 0.268707E+00
+ PKER_RACCSS( 31, 18) = 0.172988E+00
+ PKER_RACCSS( 31, 19) = 0.124548E+00
+ PKER_RACCSS( 31, 20) = 0.121193E+00
+ PKER_RACCSS( 31, 21) = 0.150187E+00
+ PKER_RACCSS( 31, 22) = 0.193042E+00
+ PKER_RACCSS( 31, 23) = 0.235298E+00
+ PKER_RACCSS( 31, 24) = 0.271298E+00
+ PKER_RACCSS( 31, 25) = 0.300774E+00
+ PKER_RACCSS( 31, 26) = 0.324800E+00
+ PKER_RACCSS( 31, 27) = 0.344418E+00
+ PKER_RACCSS( 31, 28) = 0.360469E+00
+ PKER_RACCSS( 31, 29) = 0.373626E+00
+ PKER_RACCSS( 31, 30) = 0.384427E+00
+ PKER_RACCSS( 31, 31) = 0.393308E+00
+ PKER_RACCSS( 31, 32) = 0.400619E+00
+ PKER_RACCSS( 31, 33) = 0.406643E+00
+ PKER_RACCSS( 31, 34) = 0.411612E+00
+ PKER_RACCSS( 31, 35) = 0.415713E+00
+ PKER_RACCSS( 31, 36) = 0.419099E+00
+ PKER_RACCSS( 31, 37) = 0.421897E+00
+ PKER_RACCSS( 31, 38) = 0.424209E+00
+ PKER_RACCSS( 31, 39) = 0.426121E+00
+ PKER_RACCSS( 31, 40) = 0.427702E+00
+ PKER_RACCSS( 32, 1) = 0.152212E+02
+ PKER_RACCSS( 32, 2) = 0.125125E+02
+ PKER_RACCSS( 32, 3) = 0.102696E+02
+ PKER_RACCSS( 32, 4) = 0.841222E+01
+ PKER_RACCSS( 32, 5) = 0.687405E+01
+ PKER_RACCSS( 32, 6) = 0.560018E+01
+ PKER_RACCSS( 32, 7) = 0.454517E+01
+ PKER_RACCSS( 32, 8) = 0.367144E+01
+ PKER_RACCSS( 32, 9) = 0.294789E+01
+ PKER_RACCSS( 32, 10) = 0.234884E+01
+ PKER_RACCSS( 32, 11) = 0.185306E+01
+ PKER_RACCSS( 32, 12) = 0.144305E+01
+ PKER_RACCSS( 32, 13) = 0.110439E+01
+ PKER_RACCSS( 32, 14) = 0.825390E+00
+ PKER_RACCSS( 32, 15) = 0.597084E+00
+ PKER_RACCSS( 32, 16) = 0.413476E+00
+ PKER_RACCSS( 32, 17) = 0.272077E+00
+ PKER_RACCSS( 32, 18) = 0.174803E+00
+ PKER_RACCSS( 32, 19) = 0.124293E+00
+ PKER_RACCSS( 32, 20) = 0.118931E+00
+ PKER_RACCSS( 32, 21) = 0.146554E+00
+ PKER_RACCSS( 32, 22) = 0.188828E+00
+ PKER_RACCSS( 32, 23) = 0.230954E+00
+ PKER_RACCSS( 32, 24) = 0.266952E+00
+ PKER_RACCSS( 32, 25) = 0.296435E+00
+ PKER_RACCSS( 32, 26) = 0.320462E+00
+ PKER_RACCSS( 32, 27) = 0.340075E+00
+ PKER_RACCSS( 32, 28) = 0.356117E+00
+ PKER_RACCSS( 32, 29) = 0.369263E+00
+ PKER_RACCSS( 32, 30) = 0.380055E+00
+ PKER_RACCSS( 32, 31) = 0.388926E+00
+ PKER_RACCSS( 32, 32) = 0.396228E+00
+ PKER_RACCSS( 32, 33) = 0.402245E+00
+ PKER_RACCSS( 32, 34) = 0.407208E+00
+ PKER_RACCSS( 32, 35) = 0.411303E+00
+ PKER_RACCSS( 32, 36) = 0.414685E+00
+ PKER_RACCSS( 32, 37) = 0.417479E+00
+ PKER_RACCSS( 32, 38) = 0.419788E+00
+ PKER_RACCSS( 32, 39) = 0.421697E+00
+ PKER_RACCSS( 32, 40) = 0.423276E+00
+ PKER_RACCSS( 33, 1) = 0.152252E+02
+ PKER_RACCSS( 33, 2) = 0.125166E+02
+ PKER_RACCSS( 33, 3) = 0.102737E+02
+ PKER_RACCSS( 33, 4) = 0.841642E+01
+ PKER_RACCSS( 33, 5) = 0.687832E+01
+ PKER_RACCSS( 33, 6) = 0.560452E+01
+ PKER_RACCSS( 33, 7) = 0.454958E+01
+ PKER_RACCSS( 33, 8) = 0.367590E+01
+ PKER_RACCSS( 33, 9) = 0.295241E+01
+ PKER_RACCSS( 33, 10) = 0.235339E+01
+ PKER_RACCSS( 33, 11) = 0.185763E+01
+ PKER_RACCSS( 33, 12) = 0.144761E+01
+ PKER_RACCSS( 33, 13) = 0.110891E+01
+ PKER_RACCSS( 33, 14) = 0.829809E+00
+ PKER_RACCSS( 33, 15) = 0.601298E+00
+ PKER_RACCSS( 33, 16) = 0.417299E+00
+ PKER_RACCSS( 33, 17) = 0.275084E+00
+ PKER_RACCSS( 33, 18) = 0.176517E+00
+ PKER_RACCSS( 33, 19) = 0.124255E+00
+ PKER_RACCSS( 33, 20) = 0.117165E+00
+ PKER_RACCSS( 33, 21) = 0.143564E+00
+ PKER_RACCSS( 33, 22) = 0.185315E+00
+ PKER_RACCSS( 33, 23) = 0.227330E+00
+ PKER_RACCSS( 33, 24) = 0.263338E+00
+ PKER_RACCSS( 33, 25) = 0.292840E+00
+ PKER_RACCSS( 33, 26) = 0.316875E+00
+ PKER_RACCSS( 33, 27) = 0.336491E+00
+ PKER_RACCSS( 33, 28) = 0.352533E+00
+ PKER_RACCSS( 33, 29) = 0.365676E+00
+ PKER_RACCSS( 33, 30) = 0.376463E+00
+ PKER_RACCSS( 33, 31) = 0.385329E+00
+ PKER_RACCSS( 33, 32) = 0.392627E+00
+ PKER_RACCSS( 33, 33) = 0.398639E+00
+ PKER_RACCSS( 33, 34) = 0.403598E+00
+ PKER_RACCSS( 33, 35) = 0.407690E+00
+ PKER_RACCSS( 33, 36) = 0.411069E+00
+ PKER_RACCSS( 33, 37) = 0.413860E+00
+ PKER_RACCSS( 33, 38) = 0.416168E+00
+ PKER_RACCSS( 33, 39) = 0.418075E+00
+ PKER_RACCSS( 33, 40) = 0.419653E+00
+ PKER_RACCSS( 34, 1) = 0.152248E+02
+ PKER_RACCSS( 34, 2) = 0.125162E+02
+ PKER_RACCSS( 34, 3) = 0.102733E+02
+ PKER_RACCSS( 34, 4) = 0.841600E+01
+ PKER_RACCSS( 34, 5) = 0.687791E+01
+ PKER_RACCSS( 34, 6) = 0.560412E+01
+ PKER_RACCSS( 34, 7) = 0.454919E+01
+ PKER_RACCSS( 34, 8) = 0.367553E+01
+ PKER_RACCSS( 34, 9) = 0.295206E+01
+ PKER_RACCSS( 34, 10) = 0.235307E+01
+ PKER_RACCSS( 34, 11) = 0.185734E+01
+ PKER_RACCSS( 34, 12) = 0.144736E+01
+ PKER_RACCSS( 34, 13) = 0.110872E+01
+ PKER_RACCSS( 34, 14) = 0.829656E+00
+ PKER_RACCSS( 34, 15) = 0.601205E+00
+ PKER_RACCSS( 34, 16) = 0.417236E+00
+ PKER_RACCSS( 34, 17) = 0.275045E+00
+ PKER_RACCSS( 34, 18) = 0.176424E+00
+ PKER_RACCSS( 34, 19) = 0.124044E+00
+ PKER_RACCSS( 34, 20) = 0.116894E+00
+ PKER_RACCSS( 34, 21) = 0.143258E+00
+ PKER_RACCSS( 34, 22) = 0.184999E+00
+ PKER_RACCSS( 34, 23) = 0.226991E+00
+ PKER_RACCSS( 34, 24) = 0.262972E+00
+ PKER_RACCSS( 34, 25) = 0.292447E+00
+ PKER_RACCSS( 34, 26) = 0.316461E+00
+ PKER_RACCSS( 34, 27) = 0.336058E+00
+ PKER_RACCSS( 34, 28) = 0.352084E+00
+ PKER_RACCSS( 34, 29) = 0.365214E+00
+ PKER_RACCSS( 34, 30) = 0.375991E+00
+ PKER_RACCSS( 34, 31) = 0.384849E+00
+ PKER_RACCSS( 34, 32) = 0.392140E+00
+ PKER_RACCSS( 34, 33) = 0.398147E+00
+ PKER_RACCSS( 34, 34) = 0.403101E+00
+ PKER_RACCSS( 34, 35) = 0.407190E+00
+ PKER_RACCSS( 34, 36) = 0.410566E+00
+ PKER_RACCSS( 34, 37) = 0.413355E+00
+ PKER_RACCSS( 34, 38) = 0.415661E+00
+ PKER_RACCSS( 34, 39) = 0.417567E+00
+ PKER_RACCSS( 34, 40) = 0.419144E+00
+ PKER_RACCSS( 35, 1) = 0.152287E+02
+ PKER_RACCSS( 35, 2) = 0.125202E+02
+ PKER_RACCSS( 35, 3) = 0.102773E+02
+ PKER_RACCSS( 35, 4) = 0.842010E+01
+ PKER_RACCSS( 35, 5) = 0.688207E+01
+ PKER_RACCSS( 35, 6) = 0.560834E+01
+ PKER_RACCSS( 35, 7) = 0.455346E+01
+ PKER_RACCSS( 35, 8) = 0.367984E+01
+ PKER_RACCSS( 35, 9) = 0.295641E+01
+ PKER_RACCSS( 35, 10) = 0.235744E+01
+ PKER_RACCSS( 35, 11) = 0.186171E+01
+ PKER_RACCSS( 35, 12) = 0.145171E+01
+ PKER_RACCSS( 35, 13) = 0.111300E+01
+ PKER_RACCSS( 35, 14) = 0.833823E+00
+ PKER_RACCSS( 35, 15) = 0.605161E+00
+ PKER_RACCSS( 35, 16) = 0.420842E+00
+ PKER_RACCSS( 35, 17) = 0.277903E+00
+ PKER_RACCSS( 35, 18) = 0.178147E+00
+ PKER_RACCSS( 35, 19) = 0.124171E+00
+ PKER_RACCSS( 35, 20) = 0.115464E+00
+ PKER_RACCSS( 35, 21) = 0.140674E+00
+ PKER_RACCSS( 35, 22) = 0.181919E+00
+ PKER_RACCSS( 35, 23) = 0.223809E+00
+ PKER_RACCSS( 35, 24) = 0.259812E+00
+ PKER_RACCSS( 35, 25) = 0.289318E+00
+ PKER_RACCSS( 35, 26) = 0.313352E+00
+ PKER_RACCSS( 35, 27) = 0.332962E+00
+ PKER_RACCSS( 35, 28) = 0.348995E+00
+ PKER_RACCSS( 35, 29) = 0.362129E+00
+ PKER_RACCSS( 35, 30) = 0.372907E+00
+ PKER_RACCSS( 35, 31) = 0.381764E+00
+ PKER_RACCSS( 35, 32) = 0.389054E+00
+ PKER_RACCSS( 35, 33) = 0.395060E+00
+ PKER_RACCSS( 35, 34) = 0.400012E+00
+ PKER_RACCSS( 35, 35) = 0.404099E+00
+ PKER_RACCSS( 35, 36) = 0.407474E+00
+ PKER_RACCSS( 35, 37) = 0.410263E+00
+ PKER_RACCSS( 35, 38) = 0.412567E+00
+ PKER_RACCSS( 35, 39) = 0.414473E+00
+ PKER_RACCSS( 35, 40) = 0.416049E+00
+ PKER_RACCSS( 36, 1) = 0.152383E+02
+ PKER_RACCSS( 36, 2) = 0.125299E+02
+ PKER_RACCSS( 36, 3) = 0.102873E+02
+ PKER_RACCSS( 36, 4) = 0.843016E+01
+ PKER_RACCSS( 36, 5) = 0.689226E+01
+ PKER_RACCSS( 36, 6) = 0.561865E+01
+ PKER_RACCSS( 36, 7) = 0.456388E+01
+ PKER_RACCSS( 36, 8) = 0.369036E+01
+ PKER_RACCSS( 36, 9) = 0.296698E+01
+ PKER_RACCSS( 36, 10) = 0.236804E+01
+ PKER_RACCSS( 36, 11) = 0.187228E+01
+ PKER_RACCSS( 36, 12) = 0.146219E+01
+ PKER_RACCSS( 36, 13) = 0.112330E+01
+ PKER_RACCSS( 36, 14) = 0.843833E+00
+ PKER_RACCSS( 36, 15) = 0.614630E+00
+ PKER_RACCSS( 36, 16) = 0.429489E+00
+ PKER_RACCSS( 36, 17) = 0.284782E+00
+ PKER_RACCSS( 36, 18) = 0.182494E+00
+ PKER_RACCSS( 36, 19) = 0.124882E+00
+ PKER_RACCSS( 36, 20) = 0.112591E+00
+ PKER_RACCSS( 36, 21) = 0.135019E+00
+ PKER_RACCSS( 36, 22) = 0.174978E+00
+ PKER_RACCSS( 36, 23) = 0.216615E+00
+ PKER_RACCSS( 36, 24) = 0.252695E+00
+ PKER_RACCSS( 36, 25) = 0.282303E+00
+ PKER_RACCSS( 36, 26) = 0.306412E+00
+ PKER_RACCSS( 36, 27) = 0.326073E+00
+ PKER_RACCSS( 36, 28) = 0.342140E+00
+ PKER_RACCSS( 36, 29) = 0.355295E+00
+ PKER_RACCSS( 36, 30) = 0.366087E+00
+ PKER_RACCSS( 36, 31) = 0.374952E+00
+ PKER_RACCSS( 36, 32) = 0.382247E+00
+ PKER_RACCSS( 36, 33) = 0.388255E+00
+ PKER_RACCSS( 36, 34) = 0.393208E+00
+ PKER_RACCSS( 36, 35) = 0.397296E+00
+ PKER_RACCSS( 36, 36) = 0.400670E+00
+ PKER_RACCSS( 36, 37) = 0.403458E+00
+ PKER_RACCSS( 36, 38) = 0.405763E+00
+ PKER_RACCSS( 36, 39) = 0.407668E+00
+ PKER_RACCSS( 36, 40) = 0.409243E+00
+ PKER_RACCSS( 37, 1) = 0.000000E+00
+ PKER_RACCSS( 37, 2) = 0.000000E+00
+ PKER_RACCSS( 37, 3) = 0.000000E+00
+ PKER_RACCSS( 37, 4) = 0.000000E+00
+ PKER_RACCSS( 37, 5) = 0.000000E+00
+ PKER_RACCSS( 37, 6) = 0.000000E+00
+ PKER_RACCSS( 37, 7) = 0.000000E+00
+ PKER_RACCSS( 37, 8) = 0.000000E+00
+ PKER_RACCSS( 37, 9) = 0.000000E+00
+ PKER_RACCSS( 37, 10) = 0.000000E+00
+ PKER_RACCSS( 37, 11) = 0.000000E+00
+ PKER_RACCSS( 37, 12) = 0.000000E+00
+ PKER_RACCSS( 37, 13) = 0.000000E+00
+ PKER_RACCSS( 37, 14) = 0.000000E+00
+ PKER_RACCSS( 37, 15) = 0.000000E+00
+ PKER_RACCSS( 37, 16) = 0.000000E+00
+ PKER_RACCSS( 37, 17) = 0.000000E+00
+ PKER_RACCSS( 37, 18) = 0.000000E+00
+ PKER_RACCSS( 37, 19) = 0.000000E+00
+ PKER_RACCSS( 37, 20) = 0.000000E+00
+ PKER_RACCSS( 37, 21) = 0.000000E+00
+ PKER_RACCSS( 37, 22) = 0.000000E+00
+ PKER_RACCSS( 37, 23) = 0.000000E+00
+ PKER_RACCSS( 37, 24) = 0.000000E+00
+ PKER_RACCSS( 37, 25) = 0.000000E+00
+ PKER_RACCSS( 37, 26) = 0.000000E+00
+ PKER_RACCSS( 37, 27) = 0.000000E+00
+ PKER_RACCSS( 37, 28) = 0.000000E+00
+ PKER_RACCSS( 37, 29) = 0.000000E+00
+ PKER_RACCSS( 37, 30) = 0.000000E+00
+ PKER_RACCSS( 37, 31) = 0.000000E+00
+ PKER_RACCSS( 37, 32) = 0.000000E+00
+ PKER_RACCSS( 37, 33) = 0.000000E+00
+ PKER_RACCSS( 37, 34) = 0.000000E+00
+ PKER_RACCSS( 37, 35) = 0.000000E+00
+ PKER_RACCSS( 37, 36) = 0.000000E+00
+ PKER_RACCSS( 37, 37) = 0.000000E+00
+ PKER_RACCSS( 37, 38) = 0.000000E+00
+ PKER_RACCSS( 37, 39) = 0.000000E+00
+ PKER_RACCSS( 37, 40) = 0.000000E+00
+ PKER_RACCSS( 38, 1) = 0.000000E+00
+ PKER_RACCSS( 38, 2) = 0.000000E+00
+ PKER_RACCSS( 38, 3) = 0.000000E+00
+ PKER_RACCSS( 38, 4) = 0.000000E+00
+ PKER_RACCSS( 38, 5) = 0.000000E+00
+ PKER_RACCSS( 38, 6) = 0.000000E+00
+ PKER_RACCSS( 38, 7) = 0.000000E+00
+ PKER_RACCSS( 38, 8) = 0.000000E+00
+ PKER_RACCSS( 38, 9) = 0.000000E+00
+ PKER_RACCSS( 38, 10) = 0.000000E+00
+ PKER_RACCSS( 38, 11) = 0.000000E+00
+ PKER_RACCSS( 38, 12) = 0.000000E+00
+ PKER_RACCSS( 38, 13) = 0.000000E+00
+ PKER_RACCSS( 38, 14) = 0.000000E+00
+ PKER_RACCSS( 38, 15) = 0.000000E+00
+ PKER_RACCSS( 38, 16) = 0.000000E+00
+ PKER_RACCSS( 38, 17) = 0.000000E+00
+ PKER_RACCSS( 38, 18) = 0.000000E+00
+ PKER_RACCSS( 38, 19) = 0.000000E+00
+ PKER_RACCSS( 38, 20) = 0.000000E+00
+ PKER_RACCSS( 38, 21) = 0.000000E+00
+ PKER_RACCSS( 38, 22) = 0.000000E+00
+ PKER_RACCSS( 38, 23) = 0.000000E+00
+ PKER_RACCSS( 38, 24) = 0.000000E+00
+ PKER_RACCSS( 38, 25) = 0.000000E+00
+ PKER_RACCSS( 38, 26) = 0.000000E+00
+ PKER_RACCSS( 38, 27) = 0.000000E+00
+ PKER_RACCSS( 38, 28) = 0.000000E+00
+ PKER_RACCSS( 38, 29) = 0.000000E+00
+ PKER_RACCSS( 38, 30) = 0.000000E+00
+ PKER_RACCSS( 38, 31) = 0.000000E+00
+ PKER_RACCSS( 38, 32) = 0.000000E+00
+ PKER_RACCSS( 38, 33) = 0.000000E+00
+ PKER_RACCSS( 38, 34) = 0.000000E+00
+ PKER_RACCSS( 38, 35) = 0.000000E+00
+ PKER_RACCSS( 38, 36) = 0.000000E+00
+ PKER_RACCSS( 38, 37) = 0.000000E+00
+ PKER_RACCSS( 38, 38) = 0.000000E+00
+ PKER_RACCSS( 38, 39) = 0.000000E+00
+ PKER_RACCSS( 38, 40) = 0.000000E+00
+ PKER_RACCSS( 39, 1) = 0.000000E+00
+ PKER_RACCSS( 39, 2) = 0.000000E+00
+ PKER_RACCSS( 39, 3) = 0.000000E+00
+ PKER_RACCSS( 39, 4) = 0.000000E+00
+ PKER_RACCSS( 39, 5) = 0.000000E+00
+ PKER_RACCSS( 39, 6) = 0.000000E+00
+ PKER_RACCSS( 39, 7) = 0.000000E+00
+ PKER_RACCSS( 39, 8) = 0.000000E+00
+ PKER_RACCSS( 39, 9) = 0.000000E+00
+ PKER_RACCSS( 39, 10) = 0.000000E+00
+ PKER_RACCSS( 39, 11) = 0.000000E+00
+ PKER_RACCSS( 39, 12) = 0.000000E+00
+ PKER_RACCSS( 39, 13) = 0.000000E+00
+ PKER_RACCSS( 39, 14) = 0.000000E+00
+ PKER_RACCSS( 39, 15) = 0.000000E+00
+ PKER_RACCSS( 39, 16) = 0.000000E+00
+ PKER_RACCSS( 39, 17) = 0.000000E+00
+ PKER_RACCSS( 39, 18) = 0.000000E+00
+ PKER_RACCSS( 39, 19) = 0.000000E+00
+ PKER_RACCSS( 39, 20) = 0.000000E+00
+ PKER_RACCSS( 39, 21) = 0.000000E+00
+ PKER_RACCSS( 39, 22) = 0.000000E+00
+ PKER_RACCSS( 39, 23) = 0.000000E+00
+ PKER_RACCSS( 39, 24) = 0.000000E+00
+ PKER_RACCSS( 39, 25) = 0.000000E+00
+ PKER_RACCSS( 39, 26) = 0.000000E+00
+ PKER_RACCSS( 39, 27) = 0.000000E+00
+ PKER_RACCSS( 39, 28) = 0.000000E+00
+ PKER_RACCSS( 39, 29) = 0.000000E+00
+ PKER_RACCSS( 39, 30) = 0.000000E+00
+ PKER_RACCSS( 39, 31) = 0.000000E+00
+ PKER_RACCSS( 39, 32) = 0.000000E+00
+ PKER_RACCSS( 39, 33) = 0.000000E+00
+ PKER_RACCSS( 39, 34) = 0.000000E+00
+ PKER_RACCSS( 39, 35) = 0.000000E+00
+ PKER_RACCSS( 39, 36) = 0.000000E+00
+ PKER_RACCSS( 39, 37) = 0.000000E+00
+ PKER_RACCSS( 39, 38) = 0.000000E+00
+ PKER_RACCSS( 39, 39) = 0.000000E+00
+ PKER_RACCSS( 39, 40) = 0.000000E+00
+ PKER_RACCSS( 40, 1) = 0.000000E+00
+ PKER_RACCSS( 40, 2) = 0.000000E+00
+ PKER_RACCSS( 40, 3) = 0.000000E+00
+ PKER_RACCSS( 40, 4) = 0.000000E+00
+ PKER_RACCSS( 40, 5) = 0.000000E+00
+ PKER_RACCSS( 40, 6) = 0.000000E+00
+ PKER_RACCSS( 40, 7) = 0.000000E+00
+ PKER_RACCSS( 40, 8) = 0.000000E+00
+ PKER_RACCSS( 40, 9) = 0.000000E+00
+ PKER_RACCSS( 40, 10) = 0.000000E+00
+ PKER_RACCSS( 40, 11) = 0.000000E+00
+ PKER_RACCSS( 40, 12) = 0.000000E+00
+ PKER_RACCSS( 40, 13) = 0.000000E+00
+ PKER_RACCSS( 40, 14) = 0.000000E+00
+ PKER_RACCSS( 40, 15) = 0.000000E+00
+ PKER_RACCSS( 40, 16) = 0.000000E+00
+ PKER_RACCSS( 40, 17) = 0.000000E+00
+ PKER_RACCSS( 40, 18) = 0.000000E+00
+ PKER_RACCSS( 40, 19) = 0.000000E+00
+ PKER_RACCSS( 40, 20) = 0.000000E+00
+ PKER_RACCSS( 40, 21) = 0.000000E+00
+ PKER_RACCSS( 40, 22) = 0.000000E+00
+ PKER_RACCSS( 40, 23) = 0.000000E+00
+ PKER_RACCSS( 40, 24) = 0.000000E+00
+ PKER_RACCSS( 40, 25) = 0.000000E+00
+ PKER_RACCSS( 40, 26) = 0.000000E+00
+ PKER_RACCSS( 40, 27) = 0.000000E+00
+ PKER_RACCSS( 40, 28) = 0.000000E+00
+ PKER_RACCSS( 40, 29) = 0.000000E+00
+ PKER_RACCSS( 40, 30) = 0.000000E+00
+ PKER_RACCSS( 40, 31) = 0.000000E+00
+ PKER_RACCSS( 40, 32) = 0.000000E+00
+ PKER_RACCSS( 40, 33) = 0.000000E+00
+ PKER_RACCSS( 40, 34) = 0.000000E+00
+ PKER_RACCSS( 40, 35) = 0.000000E+00
+ PKER_RACCSS( 40, 36) = 0.000000E+00
+ PKER_RACCSS( 40, 37) = 0.000000E+00
+ PKER_RACCSS( 40, 38) = 0.000000E+00
+ PKER_RACCSS( 40, 39) = 0.000000E+00
+ PKER_RACCSS( 40, 40) = 0.000000E+00
+END IF
+!
+IF( PRESENT(PKER_RACCS ) ) THEN
+ PKER_RACCS ( 1, 1) = 0.102167E+02
+ PKER_RACCS ( 1, 2) = 0.798984E+01
+ PKER_RACCS ( 1, 3) = 0.617380E+01
+ PKER_RACCS ( 1, 4) = 0.469167E+01
+ PKER_RACCS ( 1, 5) = 0.348534E+01
+ PKER_RACCS ( 1, 6) = 0.251422E+01
+ PKER_RACCS ( 1, 7) = 0.175460E+01
+ PKER_RACCS ( 1, 8) = 0.119906E+01
+ PKER_RACCS ( 1, 9) = 0.848431E+00
+ PKER_RACCS ( 1, 10) = 0.697315E+00
+ PKER_RACCS ( 1, 11) = 0.717816E+00
+ PKER_RACCS ( 1, 12) = 0.854882E+00
+ PKER_RACCS ( 1, 13) = 0.104470E+01
+ PKER_RACCS ( 1, 14) = 0.123807E+01
+ PKER_RACCS ( 1, 15) = 0.141081E+01
+ PKER_RACCS ( 1, 16) = 0.155700E+01
+ PKER_RACCS ( 1, 17) = 0.167856E+01
+ PKER_RACCS ( 1, 18) = 0.177921E+01
+ PKER_RACCS ( 1, 19) = 0.186250E+01
+ PKER_RACCS ( 1, 20) = 0.193142E+01
+ PKER_RACCS ( 1, 21) = 0.198845E+01
+ PKER_RACCS ( 1, 22) = 0.203565E+01
+ PKER_RACCS ( 1, 23) = 0.207472E+01
+ PKER_RACCS ( 1, 24) = 0.210705E+01
+ PKER_RACCS ( 1, 25) = 0.213381E+01
+ PKER_RACCS ( 1, 26) = 0.215596E+01
+ PKER_RACCS ( 1, 27) = 0.217429E+01
+ PKER_RACCS ( 1, 28) = 0.218947E+01
+ PKER_RACCS ( 1, 29) = 0.220203E+01
+ PKER_RACCS ( 1, 30) = 0.221243E+01
+ PKER_RACCS ( 1, 31) = 0.222103E+01
+ PKER_RACCS ( 1, 32) = 0.222816E+01
+ PKER_RACCS ( 1, 33) = 0.223406E+01
+ PKER_RACCS ( 1, 34) = 0.223894E+01
+ PKER_RACCS ( 1, 35) = 0.224298E+01
+ PKER_RACCS ( 1, 36) = 0.224632E+01
+ PKER_RACCS ( 1, 37) = 0.224909E+01
+ PKER_RACCS ( 1, 38) = 0.225138E+01
+ PKER_RACCS ( 1, 39) = 0.225328E+01
+ PKER_RACCS ( 1, 40) = 0.225485E+01
+ PKER_RACCS ( 2, 1) = 0.104818E+02
+ PKER_RACCS ( 2, 2) = 0.821523E+01
+ PKER_RACCS ( 2, 3) = 0.637111E+01
+ PKER_RACCS ( 2, 4) = 0.486846E+01
+ PKER_RACCS ( 2, 5) = 0.364524E+01
+ PKER_RACCS ( 2, 6) = 0.265651E+01
+ PKER_RACCS ( 2, 7) = 0.187379E+01
+ PKER_RACCS ( 2, 8) = 0.128476E+01
+ PKER_RACCS ( 2, 9) = 0.888040E+00
+ PKER_RACCS ( 2, 10) = 0.682820E+00
+ PKER_RACCS ( 2, 11) = 0.651649E+00
+ PKER_RACCS ( 2, 12) = 0.749498E+00
+ PKER_RACCS ( 2, 13) = 0.917050E+00
+ PKER_RACCS ( 2, 14) = 0.110111E+01
+ PKER_RACCS ( 2, 15) = 0.127111E+01
+ PKER_RACCS ( 2, 16) = 0.141681E+01
+ PKER_RACCS ( 2, 17) = 0.153841E+01
+ PKER_RACCS ( 2, 18) = 0.163915E+01
+ PKER_RACCS ( 2, 19) = 0.172252E+01
+ PKER_RACCS ( 2, 20) = 0.179149E+01
+ PKER_RACCS ( 2, 21) = 0.184857E+01
+ PKER_RACCS ( 2, 22) = 0.189580E+01
+ PKER_RACCS ( 2, 23) = 0.193488E+01
+ PKER_RACCS ( 2, 24) = 0.196723E+01
+ PKER_RACCS ( 2, 25) = 0.199401E+01
+ PKER_RACCS ( 2, 26) = 0.201617E+01
+ PKER_RACCS ( 2, 27) = 0.203451E+01
+ PKER_RACCS ( 2, 28) = 0.204969E+01
+ PKER_RACCS ( 2, 29) = 0.206226E+01
+ PKER_RACCS ( 2, 30) = 0.207266E+01
+ PKER_RACCS ( 2, 31) = 0.208127E+01
+ PKER_RACCS ( 2, 32) = 0.208839E+01
+ PKER_RACCS ( 2, 33) = 0.209429E+01
+ PKER_RACCS ( 2, 34) = 0.209918E+01
+ PKER_RACCS ( 2, 35) = 0.210322E+01
+ PKER_RACCS ( 2, 36) = 0.210656E+01
+ PKER_RACCS ( 2, 37) = 0.210933E+01
+ PKER_RACCS ( 2, 38) = 0.211163E+01
+ PKER_RACCS ( 2, 39) = 0.211352E+01
+ PKER_RACCS ( 2, 40) = 0.211509E+01
+ PKER_RACCS ( 3, 1) = 0.107644E+02
+ PKER_RACCS ( 3, 2) = 0.845121E+01
+ PKER_RACCS ( 3, 3) = 0.657371E+01
+ PKER_RACCS ( 3, 4) = 0.504697E+01
+ PKER_RACCS ( 3, 5) = 0.380515E+01
+ PKER_RACCS ( 3, 6) = 0.279922E+01
+ PKER_RACCS ( 3, 7) = 0.199615E+01
+ PKER_RACCS ( 3, 8) = 0.137873E+01
+ PKER_RACCS ( 3, 9) = 0.942712E+00
+ PKER_RACCS ( 3, 10) = 0.688122E+00
+ PKER_RACCS ( 3, 11) = 0.605662E+00
+ PKER_RACCS ( 3, 12) = 0.661434E+00
+ PKER_RACCS ( 3, 13) = 0.802624E+00
+ PKER_RACCS ( 3, 14) = 0.974479E+00
+ PKER_RACCS ( 3, 15) = 0.114040E+01
+ PKER_RACCS ( 3, 16) = 0.128524E+01
+ PKER_RACCS ( 3, 17) = 0.140682E+01
+ PKER_RACCS ( 3, 18) = 0.150766E+01
+ PKER_RACCS ( 3, 19) = 0.159112E+01
+ PKER_RACCS ( 3, 20) = 0.166016E+01
+ PKER_RACCS ( 3, 21) = 0.171729E+01
+ PKER_RACCS ( 3, 22) = 0.176455E+01
+ PKER_RACCS ( 3, 23) = 0.180367E+01
+ PKER_RACCS ( 3, 24) = 0.183604E+01
+ PKER_RACCS ( 3, 25) = 0.186283E+01
+ PKER_RACCS ( 3, 26) = 0.188500E+01
+ PKER_RACCS ( 3, 27) = 0.190335E+01
+ PKER_RACCS ( 3, 28) = 0.191854E+01
+ PKER_RACCS ( 3, 29) = 0.193111E+01
+ PKER_RACCS ( 3, 30) = 0.194152E+01
+ PKER_RACCS ( 3, 31) = 0.195013E+01
+ PKER_RACCS ( 3, 32) = 0.195726E+01
+ PKER_RACCS ( 3, 33) = 0.196316E+01
+ PKER_RACCS ( 3, 34) = 0.196805E+01
+ PKER_RACCS ( 3, 35) = 0.197209E+01
+ PKER_RACCS ( 3, 36) = 0.197544E+01
+ PKER_RACCS ( 3, 37) = 0.197821E+01
+ PKER_RACCS ( 3, 38) = 0.198050E+01
+ PKER_RACCS ( 3, 39) = 0.198240E+01
+ PKER_RACCS ( 3, 40) = 0.198397E+01
+ PKER_RACCS ( 4, 1) = 0.110672E+02
+ PKER_RACCS ( 4, 2) = 0.870087E+01
+ PKER_RACCS ( 4, 3) = 0.678439E+01
+ PKER_RACCS ( 4, 4) = 0.522941E+01
+ PKER_RACCS ( 4, 5) = 0.396642E+01
+ PKER_RACCS ( 4, 6) = 0.294262E+01
+ PKER_RACCS ( 4, 7) = 0.212084E+01
+ PKER_RACCS ( 4, 8) = 0.147885E+01
+ PKER_RACCS ( 4, 9) = 0.100866E+01
+ PKER_RACCS ( 4, 10) = 0.710145E+00
+ PKER_RACCS ( 4, 11) = 0.578505E+00
+ PKER_RACCS ( 4, 12) = 0.590976E+00
+ PKER_RACCS ( 4, 13) = 0.701961E+00
+ PKER_RACCS ( 4, 14) = 0.858251E+00
+ PKER_RACCS ( 4, 15) = 0.101841E+01
+ PKER_RACCS ( 4, 16) = 0.116181E+01
+ PKER_RACCS ( 4, 17) = 0.128324E+01
+ PKER_RACCS ( 4, 18) = 0.138420E+01
+ PKER_RACCS ( 4, 19) = 0.146776E+01
+ PKER_RACCS ( 4, 20) = 0.153689E+01
+ PKER_RACCS ( 4, 21) = 0.159407E+01
+ PKER_RACCS ( 4, 22) = 0.164139E+01
+ PKER_RACCS ( 4, 23) = 0.168054E+01
+ PKER_RACCS ( 4, 24) = 0.171293E+01
+ PKER_RACCS ( 4, 25) = 0.173974E+01
+ PKER_RACCS ( 4, 26) = 0.176193E+01
+ PKER_RACCS ( 4, 27) = 0.178029E+01
+ PKER_RACCS ( 4, 28) = 0.179549E+01
+ PKER_RACCS ( 4, 29) = 0.180807E+01
+ PKER_RACCS ( 4, 30) = 0.181848E+01
+ PKER_RACCS ( 4, 31) = 0.182709E+01
+ PKER_RACCS ( 4, 32) = 0.183423E+01
+ PKER_RACCS ( 4, 33) = 0.184013E+01
+ PKER_RACCS ( 4, 34) = 0.184502E+01
+ PKER_RACCS ( 4, 35) = 0.184906E+01
+ PKER_RACCS ( 4, 36) = 0.185241E+01
+ PKER_RACCS ( 4, 37) = 0.185518E+01
+ PKER_RACCS ( 4, 38) = 0.185747E+01
+ PKER_RACCS ( 4, 39) = 0.185937E+01
+ PKER_RACCS ( 4, 40) = 0.186094E+01
+ PKER_RACCS ( 5, 1) = 0.113912E+02
+ PKER_RACCS ( 5, 2) = 0.896656E+01
+ PKER_RACCS ( 5, 3) = 0.700573E+01
+ PKER_RACCS ( 5, 4) = 0.541800E+01
+ PKER_RACCS ( 5, 5) = 0.413072E+01
+ PKER_RACCS ( 5, 6) = 0.308761E+01
+ PKER_RACCS ( 5, 7) = 0.224753E+01
+ PKER_RACCS ( 5, 8) = 0.158389E+01
+ PKER_RACCS ( 5, 9) = 0.108428E+01
+ PKER_RACCS ( 5, 10) = 0.746312E+00
+ PKER_RACCS ( 5, 11) = 0.568858E+00
+ PKER_RACCS ( 5, 12) = 0.537607E+00
+ PKER_RACCS ( 5, 13) = 0.615320E+00
+ PKER_RACCS ( 5, 14) = 0.752699E+00
+ PKER_RACCS ( 5, 15) = 0.904977E+00
+ PKER_RACCS ( 5, 16) = 0.104611E+01
+ PKER_RACCS ( 5, 17) = 0.116720E+01
+ PKER_RACCS ( 5, 18) = 0.126824E+01
+ PKER_RACCS ( 5, 19) = 0.135194E+01
+ PKER_RACCS ( 5, 20) = 0.142116E+01
+ PKER_RACCS ( 5, 21) = 0.147842E+01
+ PKER_RACCS ( 5, 22) = 0.152579E+01
+ PKER_RACCS ( 5, 23) = 0.156498E+01
+ PKER_RACCS ( 5, 24) = 0.159741E+01
+ PKER_RACCS ( 5, 25) = 0.162424E+01
+ PKER_RACCS ( 5, 26) = 0.164644E+01
+ PKER_RACCS ( 5, 27) = 0.166482E+01
+ PKER_RACCS ( 5, 28) = 0.168003E+01
+ PKER_RACCS ( 5, 29) = 0.169261E+01
+ PKER_RACCS ( 5, 30) = 0.170303E+01
+ PKER_RACCS ( 5, 31) = 0.171165E+01
+ PKER_RACCS ( 5, 32) = 0.171879E+01
+ PKER_RACCS ( 5, 33) = 0.172469E+01
+ PKER_RACCS ( 5, 34) = 0.172958E+01
+ PKER_RACCS ( 5, 35) = 0.173363E+01
+ PKER_RACCS ( 5, 36) = 0.173698E+01
+ PKER_RACCS ( 5, 37) = 0.173975E+01
+ PKER_RACCS ( 5, 38) = 0.174205E+01
+ PKER_RACCS ( 5, 39) = 0.174395E+01
+ PKER_RACCS ( 5, 40) = 0.174552E+01
+ PKER_RACCS ( 6, 1) = 0.117349E+02
+ PKER_RACCS ( 6, 2) = 0.924914E+01
+ PKER_RACCS ( 6, 3) = 0.723971E+01
+ PKER_RACCS ( 6, 4) = 0.561487E+01
+ PKER_RACCS ( 6, 5) = 0.429976E+01
+ PKER_RACCS ( 6, 6) = 0.323520E+01
+ PKER_RACCS ( 6, 7) = 0.237647E+01
+ PKER_RACCS ( 6, 8) = 0.169289E+01
+ PKER_RACCS ( 6, 9) = 0.116768E+01
+ PKER_RACCS ( 6, 10) = 0.795704E+00
+ PKER_RACCS ( 6, 11) = 0.576137E+00
+ PKER_RACCS ( 6, 12) = 0.501314E+00
+ PKER_RACCS ( 6, 13) = 0.543341E+00
+ PKER_RACCS ( 6, 14) = 0.658228E+00
+ PKER_RACCS ( 6, 15) = 0.800085E+00
+ PKER_RACCS ( 6, 16) = 0.937788E+00
+ PKER_RACCS ( 6, 17) = 0.105821E+01
+ PKER_RACCS ( 6, 18) = 0.115932E+01
+ PKER_RACCS ( 6, 19) = 0.124316E+01
+ PKER_RACCS ( 6, 20) = 0.131250E+01
+ PKER_RACCS ( 6, 21) = 0.136985E+01
+ PKER_RACCS ( 6, 22) = 0.141729E+01
+ PKER_RACCS ( 6, 23) = 0.145653E+01
+ PKER_RACCS ( 6, 24) = 0.148899E+01
+ PKER_RACCS ( 6, 25) = 0.151585E+01
+ PKER_RACCS ( 6, 26) = 0.153808E+01
+ PKER_RACCS ( 6, 27) = 0.155647E+01
+ PKER_RACCS ( 6, 28) = 0.157169E+01
+ PKER_RACCS ( 6, 29) = 0.158429E+01
+ PKER_RACCS ( 6, 30) = 0.159471E+01
+ PKER_RACCS ( 6, 31) = 0.160334E+01
+ PKER_RACCS ( 6, 32) = 0.161048E+01
+ PKER_RACCS ( 6, 33) = 0.161639E+01
+ PKER_RACCS ( 6, 34) = 0.162128E+01
+ PKER_RACCS ( 6, 35) = 0.162533E+01
+ PKER_RACCS ( 6, 36) = 0.162868E+01
+ PKER_RACCS ( 6, 37) = 0.163145E+01
+ PKER_RACCS ( 6, 38) = 0.163375E+01
+ PKER_RACCS ( 6, 39) = 0.163565E+01
+ PKER_RACCS ( 6, 40) = 0.163722E+01
+ PKER_RACCS ( 7, 1) = 0.120933E+02
+ PKER_RACCS ( 7, 2) = 0.954726E+01
+ PKER_RACCS ( 7, 3) = 0.748704E+01
+ PKER_RACCS ( 7, 4) = 0.582164E+01
+ PKER_RACCS ( 7, 5) = 0.447529E+01
+ PKER_RACCS ( 7, 6) = 0.338667E+01
+ PKER_RACCS ( 7, 7) = 0.250813E+01
+ PKER_RACCS ( 7, 8) = 0.180540E+01
+ PKER_RACCS ( 7, 9) = 0.125732E+01
+ PKER_RACCS ( 7, 10) = 0.855207E+00
+ PKER_RACCS ( 7, 11) = 0.597925E+00
+ PKER_RACCS ( 7, 12) = 0.481149E+00
+ PKER_RACCS ( 7, 13) = 0.486186E+00
+ PKER_RACCS ( 7, 14) = 0.575287E+00
+ PKER_RACCS ( 7, 15) = 0.703816E+00
+ PKER_RACCS ( 7, 16) = 0.836624E+00
+ PKER_RACCS ( 7, 17) = 0.955895E+00
+ PKER_RACCS ( 7, 18) = 0.105696E+01
+ PKER_RACCS ( 7, 19) = 0.114096E+01
+ PKER_RACCS ( 7, 20) = 0.121046E+01
+ PKER_RACCS ( 7, 21) = 0.126792E+01
+ PKER_RACCS ( 7, 22) = 0.131544E+01
+ PKER_RACCS ( 7, 23) = 0.135474E+01
+ PKER_RACCS ( 7, 24) = 0.138724E+01
+ PKER_RACCS ( 7, 25) = 0.141414E+01
+ PKER_RACCS ( 7, 26) = 0.143639E+01
+ PKER_RACCS ( 7, 27) = 0.145480E+01
+ PKER_RACCS ( 7, 28) = 0.147003E+01
+ PKER_RACCS ( 7, 29) = 0.148264E+01
+ PKER_RACCS ( 7, 30) = 0.149307E+01
+ PKER_RACCS ( 7, 31) = 0.150171E+01
+ PKER_RACCS ( 7, 32) = 0.150885E+01
+ PKER_RACCS ( 7, 33) = 0.151477E+01
+ PKER_RACCS ( 7, 34) = 0.151966E+01
+ PKER_RACCS ( 7, 35) = 0.152372E+01
+ PKER_RACCS ( 7, 36) = 0.152707E+01
+ PKER_RACCS ( 7, 37) = 0.152984E+01
+ PKER_RACCS ( 7, 38) = 0.153214E+01
+ PKER_RACCS ( 7, 39) = 0.153404E+01
+ PKER_RACCS ( 7, 40) = 0.153562E+01
+ PKER_RACCS ( 8, 1) = 0.124583E+02
+ PKER_RACCS ( 8, 2) = 0.985684E+01
+ PKER_RACCS ( 8, 3) = 0.774660E+01
+ PKER_RACCS ( 8, 4) = 0.603889E+01
+ PKER_RACCS ( 8, 5) = 0.465857E+01
+ PKER_RACCS ( 8, 6) = 0.354333E+01
+ PKER_RACCS ( 8, 7) = 0.264340E+01
+ PKER_RACCS ( 8, 8) = 0.192140E+01
+ PKER_RACCS ( 8, 9) = 0.135239E+01
+ PKER_RACCS ( 8, 10) = 0.923762E+00
+ PKER_RACCS ( 8, 11) = 0.632168E+00
+ PKER_RACCS ( 8, 12) = 0.476040E+00
+ PKER_RACCS ( 8, 13) = 0.443617E+00
+ PKER_RACCS ( 8, 14) = 0.504159E+00
+ PKER_RACCS ( 8, 15) = 0.616439E+00
+ PKER_RACCS ( 8, 16) = 0.742493E+00
+ PKER_RACCS ( 8, 17) = 0.859895E+00
+ PKER_RACCS ( 8, 18) = 0.960763E+00
+ PKER_RACCS ( 8, 19) = 0.104493E+01
+ PKER_RACCS ( 8, 20) = 0.111460E+01
+ PKER_RACCS ( 8, 21) = 0.117219E+01
+ PKER_RACCS ( 8, 22) = 0.121981E+01
+ PKER_RACCS ( 8, 23) = 0.125918E+01
+ PKER_RACCS ( 8, 24) = 0.129174E+01
+ PKER_RACCS ( 8, 25) = 0.131868E+01
+ PKER_RACCS ( 8, 26) = 0.134096E+01
+ PKER_RACCS ( 8, 27) = 0.135939E+01
+ PKER_RACCS ( 8, 28) = 0.137465E+01
+ PKER_RACCS ( 8, 29) = 0.138727E+01
+ PKER_RACCS ( 8, 30) = 0.139771E+01
+ PKER_RACCS ( 8, 31) = 0.140635E+01
+ PKER_RACCS ( 8, 32) = 0.141350E+01
+ PKER_RACCS ( 8, 33) = 0.141942E+01
+ PKER_RACCS ( 8, 34) = 0.142432E+01
+ PKER_RACCS ( 8, 35) = 0.142838E+01
+ PKER_RACCS ( 8, 36) = 0.143173E+01
+ PKER_RACCS ( 8, 37) = 0.143451E+01
+ PKER_RACCS ( 8, 38) = 0.143681E+01
+ PKER_RACCS ( 8, 39) = 0.143871E+01
+ PKER_RACCS ( 8, 40) = 0.144029E+01
+ PKER_RACCS ( 9, 1) = 0.128193E+02
+ PKER_RACCS ( 9, 2) = 0.101710E+02
+ PKER_RACCS ( 9, 3) = 0.801494E+01
+ PKER_RACCS ( 9, 4) = 0.626567E+01
+ PKER_RACCS ( 9, 5) = 0.485005E+01
+ PKER_RACCS ( 9, 6) = 0.370613E+01
+ PKER_RACCS ( 9, 7) = 0.278307E+01
+ PKER_RACCS ( 9, 8) = 0.204116E+01
+ PKER_RACCS ( 9, 9) = 0.145223E+01
+ PKER_RACCS ( 9, 10) = 0.999910E+00
+ PKER_RACCS ( 9, 11) = 0.678225E+00
+ PKER_RACCS ( 9, 12) = 0.485619E+00
+ PKER_RACCS ( 9, 13) = 0.415703E+00
+ PKER_RACCS ( 9, 14) = 0.445551E+00
+ PKER_RACCS ( 9, 15) = 0.538377E+00
+ PKER_RACCS ( 9, 16) = 0.655431E+00
+ PKER_RACCS ( 9, 17) = 0.769934E+00
+ PKER_RACCS ( 9, 18) = 0.870332E+00
+ PKER_RACCS ( 9, 19) = 0.954640E+00
+ PKER_RACCS ( 9, 20) = 0.102452E+01
+ PKER_RACCS ( 9, 21) = 0.108227E+01
+ PKER_RACCS ( 9, 22) = 0.113001E+01
+ PKER_RACCS ( 9, 23) = 0.116947E+01
+ PKER_RACCS ( 9, 24) = 0.120209E+01
+ PKER_RACCS ( 9, 25) = 0.122908E+01
+ PKER_RACCS ( 9, 26) = 0.125140E+01
+ PKER_RACCS ( 9, 27) = 0.126986E+01
+ PKER_RACCS ( 9, 28) = 0.128513E+01
+ PKER_RACCS ( 9, 29) = 0.129777E+01
+ PKER_RACCS ( 9, 30) = 0.130823E+01
+ PKER_RACCS ( 9, 31) = 0.131688E+01
+ PKER_RACCS ( 9, 32) = 0.132404E+01
+ PKER_RACCS ( 9, 33) = 0.132996E+01
+ PKER_RACCS ( 9, 34) = 0.133487E+01
+ PKER_RACCS ( 9, 35) = 0.133892E+01
+ PKER_RACCS ( 9, 36) = 0.134228E+01
+ PKER_RACCS ( 9, 37) = 0.134506E+01
+ PKER_RACCS ( 9, 38) = 0.134736E+01
+ PKER_RACCS ( 9, 39) = 0.134927E+01
+ PKER_RACCS ( 9, 40) = 0.135084E+01
+ PKER_RACCS ( 10, 1) = 0.131653E+02
+ PKER_RACCS ( 10, 2) = 0.104811E+02
+ PKER_RACCS ( 10, 3) = 0.828636E+01
+ PKER_RACCS ( 10, 4) = 0.649911E+01
+ PKER_RACCS ( 10, 5) = 0.504891E+01
+ PKER_RACCS ( 10, 6) = 0.387538E+01
+ PKER_RACCS ( 10, 7) = 0.292777E+01
+ PKER_RACCS ( 10, 8) = 0.216507E+01
+ PKER_RACCS ( 10, 9) = 0.155660E+01
+ PKER_RACCS ( 10, 10) = 0.108253E+01
+ PKER_RACCS ( 10, 11) = 0.733699E+00
+ PKER_RACCS ( 10, 12) = 0.508107E+00
+ PKER_RACCS ( 10, 13) = 0.401864E+00
+ PKER_RACCS ( 10, 14) = 0.399605E+00
+ PKER_RACCS ( 10, 15) = 0.470066E+00
+ PKER_RACCS ( 10, 16) = 0.575534E+00
+ PKER_RACCS ( 10, 17) = 0.685829E+00
+ PKER_RACCS ( 10, 18) = 0.785326E+00
+ PKER_RACCS ( 10, 19) = 0.869715E+00
+ PKER_RACCS ( 10, 20) = 0.939821E+00
+ PKER_RACCS ( 10, 21) = 0.997773E+00
+ PKER_RACCS ( 10, 22) = 0.104565E+01
+ PKER_RACCS ( 10, 23) = 0.108522E+01
+ PKER_RACCS ( 10, 24) = 0.111793E+01
+ PKER_RACCS ( 10, 25) = 0.114497E+01
+ PKER_RACCS ( 10, 26) = 0.116733E+01
+ PKER_RACCS ( 10, 27) = 0.118583E+01
+ PKER_RACCS ( 10, 28) = 0.120113E+01
+ PKER_RACCS ( 10, 29) = 0.121379E+01
+ PKER_RACCS ( 10, 30) = 0.122426E+01
+ PKER_RACCS ( 10, 31) = 0.123292E+01
+ PKER_RACCS ( 10, 32) = 0.124009E+01
+ PKER_RACCS ( 10, 33) = 0.124602E+01
+ PKER_RACCS ( 10, 34) = 0.125093E+01
+ PKER_RACCS ( 10, 35) = 0.125500E+01
+ PKER_RACCS ( 10, 36) = 0.125836E+01
+ PKER_RACCS ( 10, 37) = 0.126114E+01
+ PKER_RACCS ( 10, 38) = 0.126344E+01
+ PKER_RACCS ( 10, 39) = 0.126535E+01
+ PKER_RACCS ( 10, 40) = 0.126692E+01
+ PKER_RACCS ( 11, 1) = 0.134866E+02
+ PKER_RACCS ( 11, 2) = 0.107778E+02
+ PKER_RACCS ( 11, 3) = 0.855355E+01
+ PKER_RACCS ( 11, 4) = 0.673440E+01
+ PKER_RACCS ( 11, 5) = 0.525269E+01
+ PKER_RACCS ( 11, 6) = 0.405032E+01
+ PKER_RACCS ( 11, 7) = 0.307764E+01
+ PKER_RACCS ( 11, 8) = 0.229345E+01
+ PKER_RACCS ( 11, 9) = 0.166544E+01
+ PKER_RACCS ( 11, 10) = 0.117103E+01
+ PKER_RACCS ( 11, 11) = 0.797857E+00
+ PKER_RACCS ( 11, 12) = 0.541886E+00
+ PKER_RACCS ( 11, 13) = 0.401262E+00
+ PKER_RACCS ( 11, 14) = 0.366324E+00
+ PKER_RACCS ( 11, 15) = 0.411835E+00
+ PKER_RACCS ( 11, 16) = 0.503075E+00
+ PKER_RACCS ( 11, 17) = 0.607497E+00
+ PKER_RACCS ( 11, 18) = 0.705455E+00
+ PKER_RACCS ( 11, 19) = 0.789792E+00
+ PKER_RACCS ( 11, 20) = 0.860149E+00
+ PKER_RACCS ( 11, 21) = 0.918336E+00
+ PKER_RACCS ( 11, 22) = 0.966393E+00
+ PKER_RACCS ( 11, 23) = 0.100609E+01
+ PKER_RACCS ( 11, 24) = 0.103890E+01
+ PKER_RACCS ( 11, 25) = 0.106601E+01
+ PKER_RACCS ( 11, 26) = 0.108843E+01
+ PKER_RACCS ( 11, 27) = 0.110696E+01
+ PKER_RACCS ( 11, 28) = 0.112229E+01
+ PKER_RACCS ( 11, 29) = 0.113498E+01
+ PKER_RACCS ( 11, 30) = 0.114547E+01
+ PKER_RACCS ( 11, 31) = 0.115414E+01
+ PKER_RACCS ( 11, 32) = 0.116132E+01
+ PKER_RACCS ( 11, 33) = 0.116726E+01
+ PKER_RACCS ( 11, 34) = 0.117218E+01
+ PKER_RACCS ( 11, 35) = 0.117625E+01
+ PKER_RACCS ( 11, 36) = 0.117961E+01
+ PKER_RACCS ( 11, 37) = 0.118240E+01
+ PKER_RACCS ( 11, 38) = 0.118470E+01
+ PKER_RACCS ( 11, 39) = 0.118661E+01
+ PKER_RACCS ( 11, 40) = 0.118819E+01
+ PKER_RACCS ( 12, 1) = 0.137765E+02
+ PKER_RACCS ( 12, 2) = 0.110532E+02
+ PKER_RACCS ( 12, 3) = 0.880887E+01
+ PKER_RACCS ( 12, 4) = 0.696546E+01
+ PKER_RACCS ( 12, 5) = 0.545739E+01
+ PKER_RACCS ( 12, 6) = 0.422884E+01
+ PKER_RACCS ( 12, 7) = 0.323193E+01
+ PKER_RACCS ( 12, 8) = 0.242617E+01
+ PKER_RACCS ( 12, 9) = 0.177863E+01
+ PKER_RACCS ( 12, 10) = 0.126480E+01
+ PKER_RACCS ( 12, 11) = 0.869502E+00
+ PKER_RACCS ( 12, 12) = 0.586444E+00
+ PKER_RACCS ( 12, 13) = 0.413638E+00
+ PKER_RACCS ( 12, 14) = 0.345906E+00
+ PKER_RACCS ( 12, 15) = 0.364471E+00
+ PKER_RACCS ( 12, 16) = 0.438529E+00
+ PKER_RACCS ( 12, 17) = 0.535017E+00
+ PKER_RACCS ( 12, 18) = 0.630497E+00
+ PKER_RACCS ( 12, 19) = 0.714544E+00
+ PKER_RACCS ( 12, 20) = 0.785149E+00
+ PKER_RACCS ( 12, 21) = 0.843614E+00
+ PKER_RACCS ( 12, 22) = 0.891886E+00
+ PKER_RACCS ( 12, 23) = 0.931743E+00
+ PKER_RACCS ( 12, 24) = 0.964664E+00
+ PKER_RACCS ( 12, 25) = 0.991866E+00
+ PKER_RACCS ( 12, 26) = 0.101435E+01
+ PKER_RACCS ( 12, 27) = 0.103293E+01
+ PKER_RACCS ( 12, 28) = 0.104830E+01
+ PKER_RACCS ( 12, 29) = 0.106101E+01
+ PKER_RACCS ( 12, 30) = 0.107152E+01
+ PKER_RACCS ( 12, 31) = 0.108022E+01
+ PKER_RACCS ( 12, 32) = 0.108741E+01
+ PKER_RACCS ( 12, 33) = 0.109336E+01
+ PKER_RACCS ( 12, 34) = 0.109828E+01
+ PKER_RACCS ( 12, 35) = 0.110236E+01
+ PKER_RACCS ( 12, 36) = 0.110573E+01
+ PKER_RACCS ( 12, 37) = 0.110852E+01
+ PKER_RACCS ( 12, 38) = 0.111082E+01
+ PKER_RACCS ( 12, 39) = 0.111273E+01
+ PKER_RACCS ( 12, 40) = 0.111431E+01
+ PKER_RACCS ( 13, 1) = 0.140319E+02
+ PKER_RACCS ( 13, 2) = 0.113018E+02
+ PKER_RACCS ( 13, 3) = 0.904571E+01
+ PKER_RACCS ( 13, 4) = 0.718591E+01
+ PKER_RACCS ( 13, 5) = 0.565791E+01
+ PKER_RACCS ( 13, 6) = 0.440756E+01
+ PKER_RACCS ( 13, 7) = 0.338881E+01
+ PKER_RACCS ( 13, 8) = 0.256245E+01
+ PKER_RACCS ( 13, 9) = 0.189581E+01
+ PKER_RACCS ( 13, 10) = 0.136334E+01
+ PKER_RACCS ( 13, 11) = 0.947657E+00
+ PKER_RACCS ( 13, 12) = 0.639932E+00
+ PKER_RACCS ( 13, 13) = 0.437803E+00
+ PKER_RACCS ( 13, 14) = 0.338008E+00
+ PKER_RACCS ( 13, 15) = 0.328139E+00
+ PKER_RACCS ( 13, 16) = 0.382351E+00
+ PKER_RACCS ( 13, 17) = 0.468516E+00
+ PKER_RACCS ( 13, 18) = 0.560309E+00
+ PKER_RACCS ( 13, 19) = 0.643677E+00
+ PKER_RACCS ( 13, 20) = 0.714489E+00
+ PKER_RACCS ( 13, 21) = 0.773275E+00
+ PKER_RACCS ( 13, 22) = 0.821808E+00
+ PKER_RACCS ( 13, 23) = 0.861858E+00
+ PKER_RACCS ( 13, 24) = 0.894921E+00
+ PKER_RACCS ( 13, 25) = 0.922228E+00
+ PKER_RACCS ( 13, 26) = 0.944789E+00
+ PKER_RACCS ( 13, 27) = 0.963435E+00
+ PKER_RACCS ( 13, 28) = 0.978847E+00
+ PKER_RACCS ( 13, 29) = 0.991591E+00
+ PKER_RACCS ( 13, 30) = 0.100213E+01
+ PKER_RACCS ( 13, 31) = 0.101084E+01
+ PKER_RACCS ( 13, 32) = 0.101805E+01
+ PKER_RACCS ( 13, 33) = 0.102401E+01
+ PKER_RACCS ( 13, 34) = 0.102895E+01
+ PKER_RACCS ( 13, 35) = 0.103303E+01
+ PKER_RACCS ( 13, 36) = 0.103640E+01
+ PKER_RACCS ( 13, 37) = 0.103920E+01
+ PKER_RACCS ( 13, 38) = 0.104151E+01
+ PKER_RACCS ( 13, 39) = 0.104342E+01
+ PKER_RACCS ( 13, 40) = 0.104500E+01
+ PKER_RACCS ( 14, 1) = 0.142526E+02
+ PKER_RACCS ( 14, 2) = 0.115209E+02
+ PKER_RACCS ( 14, 3) = 0.925951E+01
+ PKER_RACCS ( 14, 4) = 0.739026E+01
+ PKER_RACCS ( 14, 5) = 0.584892E+01
+ PKER_RACCS ( 14, 6) = 0.458219E+01
+ PKER_RACCS ( 14, 7) = 0.354538E+01
+ PKER_RACCS ( 14, 8) = 0.270063E+01
+ PKER_RACCS ( 14, 9) = 0.201611E+01
+ PKER_RACCS ( 14, 10) = 0.146603E+01
+ PKER_RACCS ( 14, 11) = 0.103157E+01
+ PKER_RACCS ( 14, 12) = 0.701686E+00
+ PKER_RACCS ( 14, 13) = 0.472410E+00
+ PKER_RACCS ( 14, 14) = 0.342083E+00
+ PKER_RACCS ( 14, 15) = 0.303081E+00
+ PKER_RACCS ( 14, 16) = 0.334956E+00
+ PKER_RACCS ( 14, 17) = 0.408312E+00
+ PKER_RACCS ( 14, 18) = 0.494848E+00
+ PKER_RACCS ( 14, 19) = 0.576946E+00
+ PKER_RACCS ( 14, 20) = 0.647859E+00
+ PKER_RACCS ( 14, 21) = 0.707002E+00
+ PKER_RACCS ( 14, 22) = 0.755849E+00
+ PKER_RACCS ( 14, 23) = 0.796134E+00
+ PKER_RACCS ( 14, 24) = 0.829370E+00
+ PKER_RACCS ( 14, 25) = 0.856804E+00
+ PKER_RACCS ( 14, 26) = 0.879461E+00
+ PKER_RACCS ( 14, 27) = 0.898177E+00
+ PKER_RACCS ( 14, 28) = 0.913644E+00
+ PKER_RACCS ( 14, 29) = 0.926428E+00
+ PKER_RACCS ( 14, 30) = 0.936997E+00
+ PKER_RACCS ( 14, 31) = 0.945736E+00
+ PKER_RACCS ( 14, 32) = 0.952963E+00
+ PKER_RACCS ( 14, 33) = 0.958940E+00
+ PKER_RACCS ( 14, 34) = 0.963884E+00
+ PKER_RACCS ( 14, 35) = 0.967973E+00
+ PKER_RACCS ( 14, 36) = 0.971356E+00
+ PKER_RACCS ( 14, 37) = 0.974154E+00
+ PKER_RACCS ( 14, 38) = 0.976470E+00
+ PKER_RACCS ( 14, 39) = 0.978385E+00
+ PKER_RACCS ( 14, 40) = 0.979971E+00
+ PKER_RACCS ( 15, 1) = 0.144408E+02
+ PKER_RACCS ( 15, 2) = 0.117106E+02
+ PKER_RACCS ( 15, 3) = 0.944817E+01
+ PKER_RACCS ( 15, 4) = 0.757478E+01
+ PKER_RACCS ( 15, 5) = 0.602588E+01
+ PKER_RACCS ( 15, 6) = 0.474829E+01
+ PKER_RACCS ( 15, 7) = 0.369801E+01
+ PKER_RACCS ( 15, 8) = 0.283819E+01
+ PKER_RACCS ( 15, 9) = 0.213794E+01
+ PKER_RACCS ( 15, 10) = 0.157180E+01
+ PKER_RACCS ( 15, 11) = 0.112020E+01
+ PKER_RACCS ( 15, 12) = 0.770447E+00
+ PKER_RACCS ( 15, 13) = 0.516893E+00
+ PKER_RACCS ( 15, 14) = 0.357861E+00
+ PKER_RACCS ( 15, 15) = 0.289607E+00
+ PKER_RACCS ( 15, 16) = 0.297216E+00
+ PKER_RACCS ( 15, 17) = 0.354956E+00
+ PKER_RACCS ( 15, 18) = 0.434258E+00
+ PKER_RACCS ( 15, 19) = 0.514182E+00
+ PKER_RACCS ( 15, 20) = 0.584974E+00
+ PKER_RACCS ( 15, 21) = 0.644491E+00
+ PKER_RACCS ( 15, 22) = 0.693710E+00
+ PKER_RACCS ( 15, 23) = 0.734280E+00
+ PKER_RACCS ( 15, 24) = 0.767726E+00
+ PKER_RACCS ( 15, 25) = 0.795315E+00
+ PKER_RACCS ( 15, 26) = 0.818087E+00
+ PKER_RACCS ( 15, 27) = 0.836890E+00
+ PKER_RACCS ( 15, 28) = 0.852422E+00
+ PKER_RACCS ( 15, 29) = 0.865255E+00
+ PKER_RACCS ( 15, 30) = 0.875862E+00
+ PKER_RACCS ( 15, 31) = 0.884630E+00
+ PKER_RACCS ( 15, 32) = 0.891879E+00
+ PKER_RACCS ( 15, 33) = 0.897873E+00
+ PKER_RACCS ( 15, 34) = 0.902830E+00
+ PKER_RACCS ( 15, 35) = 0.906929E+00
+ PKER_RACCS ( 15, 36) = 0.910320E+00
+ PKER_RACCS ( 15, 37) = 0.913125E+00
+ PKER_RACCS ( 15, 38) = 0.915446E+00
+ PKER_RACCS ( 15, 39) = 0.917365E+00
+ PKER_RACCS ( 15, 40) = 0.918953E+00
+ PKER_RACCS ( 16, 1) = 0.146000E+02
+ PKER_RACCS ( 16, 2) = 0.118728E+02
+ PKER_RACCS ( 16, 3) = 0.961176E+01
+ PKER_RACCS ( 16, 4) = 0.773776E+01
+ PKER_RACCS ( 16, 5) = 0.618568E+01
+ PKER_RACCS ( 16, 6) = 0.490207E+01
+ PKER_RACCS ( 16, 7) = 0.384296E+01
+ PKER_RACCS ( 16, 8) = 0.297203E+01
+ PKER_RACCS ( 16, 9) = 0.225904E+01
+ PKER_RACCS ( 16, 10) = 0.167906E+01
+ PKER_RACCS ( 16, 11) = 0.121230E+01
+ PKER_RACCS ( 16, 12) = 0.844921E+00
+ PKER_RACCS ( 16, 13) = 0.569587E+00
+ PKER_RACCS ( 16, 14) = 0.384481E+00
+ PKER_RACCS ( 16, 15) = 0.287547E+00
+ PKER_RACCS ( 16, 16) = 0.269381E+00
+ PKER_RACCS ( 16, 17) = 0.308942E+00
+ PKER_RACCS ( 16, 18) = 0.378718E+00
+ PKER_RACCS ( 16, 19) = 0.455285E+00
+ PKER_RACCS ( 16, 20) = 0.525584E+00
+ PKER_RACCS ( 16, 21) = 0.585450E+00
+ PKER_RACCS ( 16, 22) = 0.635102E+00
+ PKER_RACCS ( 16, 23) = 0.676017E+00
+ PKER_RACCS ( 16, 24) = 0.709718E+00
+ PKER_RACCS ( 16, 25) = 0.737496E+00
+ PKER_RACCS ( 16, 26) = 0.760407E+00
+ PKER_RACCS ( 16, 27) = 0.779315E+00
+ PKER_RACCS ( 16, 28) = 0.794925E+00
+ PKER_RACCS ( 16, 29) = 0.807818E+00
+ PKER_RACCS ( 16, 30) = 0.818470E+00
+ PKER_RACCS ( 16, 31) = 0.827272E+00
+ PKER_RACCS ( 16, 32) = 0.834548E+00
+ PKER_RACCS ( 16, 33) = 0.840562E+00
+ PKER_RACCS ( 16, 34) = 0.845535E+00
+ PKER_RACCS ( 16, 35) = 0.849647E+00
+ PKER_RACCS ( 16, 36) = 0.853048E+00
+ PKER_RACCS ( 16, 37) = 0.855860E+00
+ PKER_RACCS ( 16, 38) = 0.858187E+00
+ PKER_RACCS ( 16, 39) = 0.860111E+00
+ PKER_RACCS ( 16, 40) = 0.861703E+00
+ PKER_RACCS ( 17, 1) = 0.147341E+02
+ PKER_RACCS ( 17, 2) = 0.120103E+02
+ PKER_RACCS ( 17, 3) = 0.975189E+01
+ PKER_RACCS ( 17, 4) = 0.787932E+01
+ PKER_RACCS ( 17, 5) = 0.632699E+01
+ PKER_RACCS ( 17, 6) = 0.504099E+01
+ PKER_RACCS ( 17, 7) = 0.397709E+01
+ PKER_RACCS ( 17, 8) = 0.309897E+01
+ PKER_RACCS ( 17, 9) = 0.237672E+01
+ PKER_RACCS ( 17, 10) = 0.178573E+01
+ PKER_RACCS ( 17, 11) = 0.130626E+01
+ PKER_RACCS ( 17, 12) = 0.923760E+00
+ PKER_RACCS ( 17, 13) = 0.629526E+00
+ PKER_RACCS ( 17, 14) = 0.420645E+00
+ PKER_RACCS ( 17, 15) = 0.296483E+00
+ PKER_RACCS ( 17, 16) = 0.251869E+00
+ PKER_RACCS ( 17, 17) = 0.270840E+00
+ PKER_RACCS ( 17, 18) = 0.328636E+00
+ PKER_RACCS ( 17, 19) = 0.400275E+00
+ PKER_RACCS ( 17, 20) = 0.469486E+00
+ PKER_RACCS ( 17, 21) = 0.529608E+00
+ PKER_RACCS ( 17, 22) = 0.579747E+00
+ PKER_RACCS ( 17, 23) = 0.621076E+00
+ PKER_RACCS ( 17, 24) = 0.655088E+00
+ PKER_RACCS ( 17, 25) = 0.683094E+00
+ PKER_RACCS ( 17, 26) = 0.706174E+00
+ PKER_RACCS ( 17, 27) = 0.725208E+00
+ PKER_RACCS ( 17, 28) = 0.740913E+00
+ PKER_RACCS ( 17, 29) = 0.753877E+00
+ PKER_RACCS ( 17, 30) = 0.764583E+00
+ PKER_RACCS ( 17, 31) = 0.773427E+00
+ PKER_RACCS ( 17, 32) = 0.780735E+00
+ PKER_RACCS ( 17, 33) = 0.786774E+00
+ PKER_RACCS ( 17, 34) = 0.791766E+00
+ PKER_RACCS ( 17, 35) = 0.795893E+00
+ PKER_RACCS ( 17, 36) = 0.799305E+00
+ PKER_RACCS ( 17, 37) = 0.802126E+00
+ PKER_RACCS ( 17, 38) = 0.804459E+00
+ PKER_RACCS ( 17, 39) = 0.806389E+00
+ PKER_RACCS ( 17, 40) = 0.807985E+00
+ PKER_RACCS ( 18, 1) = 0.148471E+02
+ PKER_RACCS ( 18, 2) = 0.121265E+02
+ PKER_RACCS ( 18, 3) = 0.987110E+01
+ PKER_RACCS ( 18, 4) = 0.800089E+01
+ PKER_RACCS ( 18, 5) = 0.644994E+01
+ PKER_RACCS ( 18, 6) = 0.516395E+01
+ PKER_RACCS ( 18, 7) = 0.409829E+01
+ PKER_RACCS ( 18, 8) = 0.321639E+01
+ PKER_RACCS ( 18, 9) = 0.248825E+01
+ PKER_RACCS ( 18, 10) = 0.188937E+01
+ PKER_RACCS ( 18, 11) = 0.140001E+01
+ PKER_RACCS ( 18, 12) = 0.100512E+01
+ PKER_RACCS ( 18, 13) = 0.694965E+00
+ PKER_RACCS ( 18, 14) = 0.465425E+00
+ PKER_RACCS ( 18, 15) = 0.316022E+00
+ PKER_RACCS ( 18, 16) = 0.245025E+00
+ PKER_RACCS ( 18, 17) = 0.241586E+00
+ PKER_RACCS ( 18, 18) = 0.284650E+00
+ PKER_RACCS ( 18, 19) = 0.349371E+00
+ PKER_RACCS ( 18, 20) = 0.416569E+00
+ PKER_RACCS ( 18, 21) = 0.476716E+00
+ PKER_RACCS ( 18, 22) = 0.527374E+00
+ PKER_RACCS ( 18, 23) = 0.569195E+00
+ PKER_RACCS ( 18, 24) = 0.603581E+00
+ PKER_RACCS ( 18, 25) = 0.631865E+00
+ PKER_RACCS ( 18, 26) = 0.655150E+00
+ PKER_RACCS ( 18, 27) = 0.674336E+00
+ PKER_RACCS ( 18, 28) = 0.690155E+00
+ PKER_RACCS ( 18, 29) = 0.703206E+00
+ PKER_RACCS ( 18, 30) = 0.713977E+00
+ PKER_RACCS ( 18, 31) = 0.722871E+00
+ PKER_RACCS ( 18, 32) = 0.730217E+00
+ PKER_RACCS ( 18, 33) = 0.736286E+00
+ PKER_RACCS ( 18, 34) = 0.741300E+00
+ PKER_RACCS ( 18, 35) = 0.745445E+00
+ PKER_RACCS ( 18, 36) = 0.748871E+00
+ PKER_RACCS ( 18, 37) = 0.751703E+00
+ PKER_RACCS ( 18, 38) = 0.754044E+00
+ PKER_RACCS ( 18, 39) = 0.755981E+00
+ PKER_RACCS ( 18, 40) = 0.757582E+00
+ PKER_RACCS ( 19, 1) = 0.149424E+02
+ PKER_RACCS ( 19, 2) = 0.122248E+02
+ PKER_RACCS ( 19, 3) = 0.997223E+01
+ PKER_RACCS ( 19, 4) = 0.810461E+01
+ PKER_RACCS ( 19, 5) = 0.655579E+01
+ PKER_RACCS ( 19, 6) = 0.527114E+01
+ PKER_RACCS ( 19, 7) = 0.420569E+01
+ PKER_RACCS ( 19, 8) = 0.332252E+01
+ PKER_RACCS ( 19, 9) = 0.259139E+01
+ PKER_RACCS ( 19, 10) = 0.198760E+01
+ PKER_RACCS ( 19, 11) = 0.149127E+01
+ PKER_RACCS ( 19, 12) = 0.108695E+01
+ PKER_RACCS ( 19, 13) = 0.763957E+00
+ PKER_RACCS ( 19, 14) = 0.516893E+00
+ PKER_RACCS ( 19, 15) = 0.345184E+00
+ PKER_RACCS ( 19, 16) = 0.248721E+00
+ PKER_RACCS ( 19, 17) = 0.221527E+00
+ PKER_RACCS ( 19, 18) = 0.247368E+00
+ PKER_RACCS ( 19, 19) = 0.302857E+00
+ PKER_RACCS ( 19, 20) = 0.366792E+00
+ PKER_RACCS ( 19, 21) = 0.426569E+00
+ PKER_RACCS ( 19, 22) = 0.477725E+00
+ PKER_RACCS ( 19, 23) = 0.520116E+00
+ PKER_RACCS ( 19, 24) = 0.554955E+00
+ PKER_RACCS ( 19, 25) = 0.583575E+00
+ PKER_RACCS ( 19, 26) = 0.607108E+00
+ PKER_RACCS ( 19, 27) = 0.626479E+00
+ PKER_RACCS ( 19, 28) = 0.642436E+00
+ PKER_RACCS ( 19, 29) = 0.655590E+00
+ PKER_RACCS ( 19, 30) = 0.666441E+00
+ PKER_RACCS ( 19, 31) = 0.675394E+00
+ PKER_RACCS ( 19, 32) = 0.682786E+00
+ PKER_RACCS ( 19, 33) = 0.688890E+00
+ PKER_RACCS ( 19, 34) = 0.693932E+00
+ PKER_RACCS ( 19, 35) = 0.698097E+00
+ PKER_RACCS ( 19, 36) = 0.701540E+00
+ PKER_RACCS ( 19, 37) = 0.704385E+00
+ PKER_RACCS ( 19, 38) = 0.706736E+00
+ PKER_RACCS ( 19, 39) = 0.708680E+00
+ PKER_RACCS ( 19, 40) = 0.710287E+00
+ PKER_RACCS ( 20, 1) = 0.150233E+02
+ PKER_RACCS ( 20, 2) = 0.123081E+02
+ PKER_RACCS ( 20, 3) = 0.100581E+02
+ PKER_RACCS ( 20, 4) = 0.819292E+01
+ PKER_RACCS ( 20, 5) = 0.664638E+01
+ PKER_RACCS ( 20, 6) = 0.536365E+01
+ PKER_RACCS ( 20, 7) = 0.429950E+01
+ PKER_RACCS ( 20, 8) = 0.341669E+01
+ PKER_RACCS ( 20, 9) = 0.268467E+01
+ PKER_RACCS ( 20, 10) = 0.207848E+01
+ PKER_RACCS ( 20, 11) = 0.157790E+01
+ PKER_RACCS ( 20, 12) = 0.116706E+01
+ PKER_RACCS ( 20, 13) = 0.834456E+00
+ PKER_RACCS ( 20, 14) = 0.573438E+00
+ PKER_RACCS ( 20, 15) = 0.382407E+00
+ PKER_RACCS ( 20, 16) = 0.262345E+00
+ PKER_RACCS ( 20, 17) = 0.211120E+00
+ PKER_RACCS ( 20, 18) = 0.217516E+00
+ PKER_RACCS ( 20, 19) = 0.261278E+00
+ PKER_RACCS ( 20, 20) = 0.320279E+00
+ PKER_RACCS ( 20, 21) = 0.379014E+00
+ PKER_RACCS ( 20, 22) = 0.430562E+00
+ PKER_RACCS ( 20, 23) = 0.473590E+00
+ PKER_RACCS ( 20, 24) = 0.508970E+00
+ PKER_RACCS ( 20, 25) = 0.537995E+00
+ PKER_RACCS ( 20, 26) = 0.561829E+00
+ PKER_RACCS ( 20, 27) = 0.581423E+00
+ PKER_RACCS ( 20, 28) = 0.597547E+00
+ PKER_RACCS ( 20, 29) = 0.610827E+00
+ PKER_RACCS ( 20, 30) = 0.621772E+00
+ PKER_RACCS ( 20, 31) = 0.630798E+00
+ PKER_RACCS ( 20, 32) = 0.638244E+00
+ PKER_RACCS ( 20, 33) = 0.644390E+00
+ PKER_RACCS ( 20, 34) = 0.649465E+00
+ PKER_RACCS ( 20, 35) = 0.653656E+00
+ PKER_RACCS ( 20, 36) = 0.657117E+00
+ PKER_RACCS ( 20, 37) = 0.659978E+00
+ PKER_RACCS ( 20, 38) = 0.662341E+00
+ PKER_RACCS ( 20, 39) = 0.664294E+00
+ PKER_RACCS ( 20, 40) = 0.665909E+00
+ PKER_RACCS ( 21, 1) = 0.150922E+02
+ PKER_RACCS ( 21, 2) = 0.123791E+02
+ PKER_RACCS ( 21, 3) = 0.101311E+02
+ PKER_RACCS ( 21, 4) = 0.826818E+01
+ PKER_RACCS ( 21, 5) = 0.672379E+01
+ PKER_RACCS ( 21, 6) = 0.544309E+01
+ PKER_RACCS ( 21, 7) = 0.438067E+01
+ PKER_RACCS ( 21, 8) = 0.349910E+01
+ PKER_RACCS ( 21, 9) = 0.276755E+01
+ PKER_RACCS ( 21, 10) = 0.216074E+01
+ PKER_RACCS ( 21, 11) = 0.165815E+01
+ PKER_RACCS ( 21, 12) = 0.124340E+01
+ PKER_RACCS ( 21, 13) = 0.904204E+00
+ PKER_RACCS ( 21, 14) = 0.632746E+00
+ PKER_RACCS ( 21, 15) = 0.426104E+00
+ PKER_RACCS ( 21, 16) = 0.285124E+00
+ PKER_RACCS ( 21, 17) = 0.210547E+00
+ PKER_RACCS ( 21, 18) = 0.196012E+00
+ PKER_RACCS ( 21, 19) = 0.225390E+00
+ PKER_RACCS ( 21, 20) = 0.277352E+00
+ PKER_RACCS ( 21, 21) = 0.334022E+00
+ PKER_RACCS ( 21, 22) = 0.385682E+00
+ PKER_RACCS ( 21, 23) = 0.429377E+00
+ PKER_RACCS ( 21, 24) = 0.465390E+00
+ PKER_RACCS ( 21, 25) = 0.494904E+00
+ PKER_RACCS ( 21, 26) = 0.519101E+00
+ PKER_RACCS ( 21, 27) = 0.538964E+00
+ PKER_RACCS ( 21, 28) = 0.555290E+00
+ PKER_RACCS ( 21, 29) = 0.568721E+00
+ PKER_RACCS ( 21, 30) = 0.579780E+00
+ PKER_RACCS ( 21, 31) = 0.588892E+00
+ PKER_RACCS ( 21, 32) = 0.596405E+00
+ PKER_RACCS ( 21, 33) = 0.602602E+00
+ PKER_RACCS ( 21, 34) = 0.607715E+00
+ PKER_RACCS ( 21, 35) = 0.611936E+00
+ PKER_RACCS ( 21, 36) = 0.615421E+00
+ PKER_RACCS ( 21, 37) = 0.618300E+00
+ PKER_RACCS ( 21, 38) = 0.620677E+00
+ PKER_RACCS ( 21, 39) = 0.622642E+00
+ PKER_RACCS ( 21, 40) = 0.624265E+00
+ PKER_RACCS ( 22, 1) = 0.151514E+02
+ PKER_RACCS ( 22, 2) = 0.124399E+02
+ PKER_RACCS ( 22, 3) = 0.101937E+02
+ PKER_RACCS ( 22, 4) = 0.833253E+01
+ PKER_RACCS ( 22, 5) = 0.679003E+01
+ PKER_RACCS ( 22, 6) = 0.551121E+01
+ PKER_RACCS ( 22, 7) = 0.445059E+01
+ PKER_RACCS ( 22, 8) = 0.357060E+01
+ PKER_RACCS ( 22, 9) = 0.284022E+01
+ PKER_RACCS ( 22, 10) = 0.223394E+01
+ PKER_RACCS ( 22, 11) = 0.173091E+01
+ PKER_RACCS ( 22, 12) = 0.131432E+01
+ PKER_RACCS ( 22, 13) = 0.971179E+00
+ PKER_RACCS ( 22, 14) = 0.692512E+00
+ PKER_RACCS ( 22, 15) = 0.473921E+00
+ PKER_RACCS ( 22, 16) = 0.315613E+00
+ PKER_RACCS ( 22, 17) = 0.219438E+00
+ PKER_RACCS ( 22, 18) = 0.183228E+00
+ PKER_RACCS ( 22, 19) = 0.195928E+00
+ PKER_RACCS ( 22, 20) = 0.238467E+00
+ PKER_RACCS ( 22, 21) = 0.291650E+00
+ PKER_RACCS ( 22, 22) = 0.342933E+00
+ PKER_RACCS ( 22, 23) = 0.387253E+00
+ PKER_RACCS ( 22, 24) = 0.423987E+00
+ PKER_RACCS ( 22, 25) = 0.454083E+00
+ PKER_RACCS ( 22, 26) = 0.478717E+00
+ PKER_RACCS ( 22, 27) = 0.498906E+00
+ PKER_RACCS ( 22, 28) = 0.515474E+00
+ PKER_RACCS ( 22, 29) = 0.529087E+00
+ PKER_RACCS ( 22, 30) = 0.540283E+00
+ PKER_RACCS ( 22, 31) = 0.549500E+00
+ PKER_RACCS ( 22, 32) = 0.557092E+00
+ PKER_RACCS ( 22, 33) = 0.563350E+00
+ PKER_RACCS ( 22, 34) = 0.568510E+00
+ PKER_RACCS ( 22, 35) = 0.572767E+00
+ PKER_RACCS ( 22, 36) = 0.576280E+00
+ PKER_RACCS ( 22, 37) = 0.579180E+00
+ PKER_RACCS ( 22, 38) = 0.581575E+00
+ PKER_RACCS ( 22, 39) = 0.583552E+00
+ PKER_RACCS ( 22, 40) = 0.585186E+00
+ PKER_RACCS ( 23, 1) = 0.152025E+02
+ PKER_RACCS ( 23, 2) = 0.124923E+02
+ PKER_RACCS ( 23, 3) = 0.102475E+02
+ PKER_RACCS ( 23, 4) = 0.838786E+01
+ PKER_RACCS ( 23, 5) = 0.684693E+01
+ PKER_RACCS ( 23, 6) = 0.556974E+01
+ PKER_RACCS ( 23, 7) = 0.451078E+01
+ PKER_RACCS ( 23, 8) = 0.363239E+01
+ PKER_RACCS ( 23, 9) = 0.290344E+01
+ PKER_RACCS ( 23, 10) = 0.229827E+01
+ PKER_RACCS ( 23, 11) = 0.179578E+01
+ PKER_RACCS ( 23, 12) = 0.137880E+01
+ PKER_RACCS ( 23, 13) = 0.103376E+01
+ PKER_RACCS ( 23, 14) = 0.750698E+00
+ PKER_RACCS ( 23, 15) = 0.523775E+00
+ PKER_RACCS ( 23, 16) = 0.351748E+00
+ PKER_RACCS ( 23, 17) = 0.236670E+00
+ PKER_RACCS ( 23, 18) = 0.179378E+00
+ PKER_RACCS ( 23, 19) = 0.173687E+00
+ PKER_RACCS ( 23, 20) = 0.204334E+00
+ PKER_RACCS ( 23, 21) = 0.252182E+00
+ PKER_RACCS ( 23, 22) = 0.302250E+00
+ PKER_RACCS ( 23, 23) = 0.347024E+00
+ PKER_RACCS ( 23, 24) = 0.384540E+00
+ PKER_RACCS ( 23, 25) = 0.415319E+00
+ PKER_RACCS ( 23, 26) = 0.440475E+00
+ PKER_RACCS ( 23, 27) = 0.461054E+00
+ PKER_RACCS ( 23, 28) = 0.477914E+00
+ PKER_RACCS ( 23, 29) = 0.491746E+00
+ PKER_RACCS ( 23, 30) = 0.503108E+00
+ PKER_RACCS ( 23, 31) = 0.512450E+00
+ PKER_RACCS ( 23, 32) = 0.520137E+00
+ PKER_RACCS ( 23, 33) = 0.526468E+00
+ PKER_RACCS ( 23, 34) = 0.531684E+00
+ PKER_RACCS ( 23, 35) = 0.535984E+00
+ PKER_RACCS ( 23, 36) = 0.539531E+00
+ PKER_RACCS ( 23, 37) = 0.542457E+00
+ PKER_RACCS ( 23, 38) = 0.544872E+00
+ PKER_RACCS ( 23, 39) = 0.546865E+00
+ PKER_RACCS ( 23, 40) = 0.548511E+00
+ PKER_RACCS ( 24, 1) = 0.152471E+02
+ PKER_RACCS ( 24, 2) = 0.125379E+02
+ PKER_RACCS ( 24, 3) = 0.102942E+02
+ PKER_RACCS ( 24, 4) = 0.843571E+01
+ PKER_RACCS ( 24, 5) = 0.689606E+01
+ PKER_RACCS ( 24, 6) = 0.562023E+01
+ PKER_RACCS ( 24, 7) = 0.456270E+01
+ PKER_RACCS ( 24, 8) = 0.368577E+01
+ PKER_RACCS ( 24, 9) = 0.295826E+01
+ PKER_RACCS ( 24, 10) = 0.235439E+01
+ PKER_RACCS ( 24, 11) = 0.185292E+01
+ PKER_RACCS ( 24, 12) = 0.143643E+01
+ PKER_RACCS ( 24, 13) = 0.109091E+01
+ PKER_RACCS ( 24, 14) = 0.805605E+00
+ PKER_RACCS ( 24, 15) = 0.573417E+00
+ PKER_RACCS ( 24, 16) = 0.391471E+00
+ PKER_RACCS ( 24, 17) = 0.260876E+00
+ PKER_RACCS ( 24, 18) = 0.184180E+00
+ PKER_RACCS ( 24, 19) = 0.159396E+00
+ PKER_RACCS ( 24, 20) = 0.175814E+00
+ PKER_RACCS ( 24, 21) = 0.216094E+00
+ PKER_RACCS ( 24, 22) = 0.263726E+00
+ PKER_RACCS ( 24, 23) = 0.308551E+00
+ PKER_RACCS ( 24, 24) = 0.346845E+00
+ PKER_RACCS ( 24, 25) = 0.378402E+00
+ PKER_RACCS ( 24, 26) = 0.404175E+00
+ PKER_RACCS ( 24, 27) = 0.425220E+00
+ PKER_RACCS ( 24, 28) = 0.442431E+00
+ PKER_RACCS ( 24, 29) = 0.456527E+00
+ PKER_RACCS ( 24, 30) = 0.468088E+00
+ PKER_RACCS ( 24, 31) = 0.477580E+00
+ PKER_RACCS ( 24, 32) = 0.485382E+00
+ PKER_RACCS ( 24, 33) = 0.491800E+00
+ PKER_RACCS ( 24, 34) = 0.497083E+00
+ PKER_RACCS ( 24, 35) = 0.501435E+00
+ PKER_RACCS ( 24, 36) = 0.505022E+00
+ PKER_RACCS ( 24, 37) = 0.507979E+00
+ PKER_RACCS ( 24, 38) = 0.510418E+00
+ PKER_RACCS ( 24, 39) = 0.512430E+00
+ PKER_RACCS ( 24, 40) = 0.514090E+00
+ PKER_RACCS ( 25, 1) = 0.152861E+02
+ PKER_RACCS ( 25, 2) = 0.125778E+02
+ PKER_RACCS ( 25, 3) = 0.103349E+02
+ PKER_RACCS ( 25, 4) = 0.847739E+01
+ PKER_RACCS ( 25, 5) = 0.693876E+01
+ PKER_RACCS ( 25, 6) = 0.566404E+01
+ PKER_RACCS ( 25, 7) = 0.460768E+01
+ PKER_RACCS ( 25, 8) = 0.373200E+01
+ PKER_RACCS ( 25, 9) = 0.300578E+01
+ PKER_RACCS ( 25, 10) = 0.240320E+01
+ PKER_RACCS ( 25, 11) = 0.190291E+01
+ PKER_RACCS ( 25, 12) = 0.148735E+01
+ PKER_RACCS ( 25, 13) = 0.114219E+01
+ PKER_RACCS ( 25, 14) = 0.856136E+00
+ PKER_RACCS ( 25, 15) = 0.621029E+00
+ PKER_RACCS ( 25, 16) = 0.432440E+00
+ PKER_RACCS ( 25, 17) = 0.290169E+00
+ PKER_RACCS ( 25, 18) = 0.196768E+00
+ PKER_RACCS ( 25, 19) = 0.153201E+00
+ PKER_RACCS ( 25, 20) = 0.153672E+00
+ PKER_RACCS ( 25, 21) = 0.184048E+00
+ PKER_RACCS ( 25, 22) = 0.227585E+00
+ PKER_RACCS ( 25, 23) = 0.271783E+00
+ PKER_RACCS ( 25, 24) = 0.310728E+00
+ PKER_RACCS ( 25, 25) = 0.343135E+00
+ PKER_RACCS ( 25, 26) = 0.369625E+00
+ PKER_RACCS ( 25, 27) = 0.391222E+00
+ PKER_RACCS ( 25, 28) = 0.408850E+00
+ PKER_RACCS ( 25, 29) = 0.423262E+00
+ PKER_RACCS ( 25, 30) = 0.435061E+00
+ PKER_RACCS ( 25, 31) = 0.444734E+00
+ PKER_RACCS ( 25, 32) = 0.452673E+00
+ PKER_RACCS ( 25, 33) = 0.459196E+00
+ PKER_RACCS ( 25, 34) = 0.464560E+00
+ PKER_RACCS ( 25, 35) = 0.468974E+00
+ PKER_RACCS ( 25, 36) = 0.472608E+00
+ PKER_RACCS ( 25, 37) = 0.475602E+00
+ PKER_RACCS ( 25, 38) = 0.478070E+00
+ PKER_RACCS ( 25, 39) = 0.480104E+00
+ PKER_RACCS ( 25, 40) = 0.481782E+00
+ PKER_RACCS ( 26, 1) = 0.153206E+02
+ PKER_RACCS ( 26, 2) = 0.126129E+02
+ PKER_RACCS ( 26, 3) = 0.103707E+02
+ PKER_RACCS ( 26, 4) = 0.851394E+01
+ PKER_RACCS ( 26, 5) = 0.697612E+01
+ PKER_RACCS ( 26, 6) = 0.570228E+01
+ PKER_RACCS ( 26, 7) = 0.464688E+01
+ PKER_RACCS ( 26, 8) = 0.377223E+01
+ PKER_RACCS ( 26, 9) = 0.304711E+01
+ PKER_RACCS ( 26, 10) = 0.244567E+01
+ PKER_RACCS ( 26, 11) = 0.194653E+01
+ PKER_RACCS ( 26, 12) = 0.153202E+01
+ PKER_RACCS ( 26, 13) = 0.118766E+01
+ PKER_RACCS ( 26, 14) = 0.901746E+00
+ PKER_RACCS ( 26, 15) = 0.665390E+00
+ PKER_RACCS ( 26, 16) = 0.472866E+00
+ PKER_RACCS ( 26, 17) = 0.322299E+00
+ PKER_RACCS ( 26, 18) = 0.215438E+00
+ PKER_RACCS ( 26, 19) = 0.154776E+00
+ PKER_RACCS ( 26, 20) = 0.138541E+00
+ PKER_RACCS ( 26, 21) = 0.156867E+00
+ PKER_RACCS ( 26, 22) = 0.194320E+00
+ PKER_RACCS ( 26, 23) = 0.236800E+00
+ PKER_RACCS ( 26, 24) = 0.276076E+00
+ PKER_RACCS ( 26, 25) = 0.309341E+00
+ PKER_RACCS ( 26, 26) = 0.336639E+00
+ PKER_RACCS ( 26, 27) = 0.358880E+00
+ PKER_RACCS ( 26, 28) = 0.377001E+00
+ PKER_RACCS ( 26, 29) = 0.391788E+00
+ PKER_RACCS ( 26, 30) = 0.403872E+00
+ PKER_RACCS ( 26, 31) = 0.413761E+00
+ PKER_RACCS ( 26, 32) = 0.421865E+00
+ PKER_RACCS ( 26, 33) = 0.428514E+00
+ PKER_RACCS ( 26, 34) = 0.433974E+00
+ PKER_RACCS ( 26, 35) = 0.438462E+00
+ PKER_RACCS ( 26, 36) = 0.442154E+00
+ PKER_RACCS ( 26, 37) = 0.445192E+00
+ PKER_RACCS ( 26, 38) = 0.447694E+00
+ PKER_RACCS ( 26, 39) = 0.449755E+00
+ PKER_RACCS ( 26, 40) = 0.451454E+00
+ PKER_RACCS ( 27, 1) = 0.153513E+02
+ PKER_RACCS ( 27, 2) = 0.126440E+02
+ PKER_RACCS ( 27, 3) = 0.104024E+02
+ PKER_RACCS ( 27, 4) = 0.854622E+01
+ PKER_RACCS ( 27, 5) = 0.700904E+01
+ PKER_RACCS ( 27, 6) = 0.573589E+01
+ PKER_RACCS ( 27, 7) = 0.468125E+01
+ PKER_RACCS ( 27, 8) = 0.380743E+01
+ PKER_RACCS ( 27, 9) = 0.308321E+01
+ PKER_RACCS ( 27, 10) = 0.248274E+01
+ PKER_RACCS ( 27, 11) = 0.198462E+01
+ PKER_RACCS ( 27, 12) = 0.157114E+01
+ PKER_RACCS ( 27, 13) = 0.122770E+01
+ PKER_RACCS ( 27, 14) = 0.942392E+00
+ PKER_RACCS ( 27, 15) = 0.705810E+00
+ PKER_RACCS ( 27, 16) = 0.511279E+00
+ PKER_RACCS ( 27, 17) = 0.355415E+00
+ PKER_RACCS ( 27, 18) = 0.238463E+00
+ PKER_RACCS ( 27, 19) = 0.163223E+00
+ PKER_RACCS ( 27, 20) = 0.130700E+00
+ PKER_RACCS ( 27, 21) = 0.135369E+00
+ PKER_RACCS ( 27, 22) = 0.164571E+00
+ PKER_RACCS ( 27, 23) = 0.203879E+00
+ PKER_RACCS ( 27, 24) = 0.242868E+00
+ PKER_RACCS ( 27, 25) = 0.276880E+00
+ PKER_RACCS ( 27, 26) = 0.305049E+00
+ PKER_RACCS ( 27, 27) = 0.328022E+00
+ PKER_RACCS ( 27, 28) = 0.346718E+00
+ PKER_RACCS ( 27, 29) = 0.361946E+00
+ PKER_RACCS ( 27, 30) = 0.374368E+00
+ PKER_RACCS ( 27, 31) = 0.384516E+00
+ PKER_RACCS ( 27, 32) = 0.392817E+00
+ PKER_RACCS ( 27, 33) = 0.399617E+00
+ PKER_RACCS ( 27, 34) = 0.405192E+00
+ PKER_RACCS ( 27, 35) = 0.409769E+00
+ PKER_RACCS ( 27, 36) = 0.413529E+00
+ PKER_RACCS ( 27, 37) = 0.416620E+00
+ PKER_RACCS ( 27, 38) = 0.419163E+00
+ PKER_RACCS ( 27, 39) = 0.421256E+00
+ PKER_RACCS ( 27, 40) = 0.422980E+00
+ PKER_RACCS ( 28, 1) = 0.153787E+02
+ PKER_RACCS ( 28, 2) = 0.126718E+02
+ PKER_RACCS ( 28, 3) = 0.104307E+02
+ PKER_RACCS ( 28, 4) = 0.857492E+01
+ PKER_RACCS ( 28, 5) = 0.703823E+01
+ PKER_RACCS ( 28, 6) = 0.576563E+01
+ PKER_RACCS ( 28, 7) = 0.471159E+01
+ PKER_RACCS ( 28, 8) = 0.383843E+01
+ PKER_RACCS ( 28, 9) = 0.311494E+01
+ PKER_RACCS ( 28, 10) = 0.251526E+01
+ PKER_RACCS ( 28, 11) = 0.201799E+01
+ PKER_RACCS ( 28, 12) = 0.160542E+01
+ PKER_RACCS ( 28, 13) = 0.126288E+01
+ PKER_RACCS ( 28, 14) = 0.978347E+00
+ PKER_RACCS ( 28, 15) = 0.742102E+00
+ PKER_RACCS ( 28, 16) = 0.546792E+00
+ PKER_RACCS ( 28, 17) = 0.387821E+00
+ PKER_RACCS ( 28, 18) = 0.264011E+00
+ PKER_RACCS ( 28, 19) = 0.177228E+00
+ PKER_RACCS ( 28, 20) = 0.129810E+00
+ PKER_RACCS ( 28, 21) = 0.120099E+00
+ PKER_RACCS ( 28, 22) = 0.139117E+00
+ PKER_RACCS ( 28, 23) = 0.173453E+00
+ PKER_RACCS ( 28, 24) = 0.211216E+00
+ PKER_RACCS ( 28, 25) = 0.245678E+00
+ PKER_RACCS ( 28, 26) = 0.274712E+00
+ PKER_RACCS ( 28, 27) = 0.298492E+00
+ PKER_RACCS ( 28, 28) = 0.317842E+00
+ PKER_RACCS ( 28, 29) = 0.333584E+00
+ PKER_RACCS ( 28, 30) = 0.346404E+00
+ PKER_RACCS ( 28, 31) = 0.356858E+00
+ PKER_RACCS ( 28, 32) = 0.365393E+00
+ PKER_RACCS ( 28, 33) = 0.372373E+00
+ PKER_RACCS ( 28, 34) = 0.378086E+00
+ PKER_RACCS ( 28, 35) = 0.382769E+00
+ PKER_RACCS ( 28, 36) = 0.386611E+00
+ PKER_RACCS ( 28, 37) = 0.389765E+00
+ PKER_RACCS ( 28, 38) = 0.392357E+00
+ PKER_RACCS ( 28, 39) = 0.394489E+00
+ PKER_RACCS ( 28, 40) = 0.396242E+00
+ PKER_RACCS ( 29, 1) = 0.154034E+02
+ PKER_RACCS ( 29, 2) = 0.126968E+02
+ PKER_RACCS ( 29, 3) = 0.104560E+02
+ PKER_RACCS ( 29, 4) = 0.860059E+01
+ PKER_RACCS ( 29, 5) = 0.706430E+01
+ PKER_RACCS ( 29, 6) = 0.579212E+01
+ PKER_RACCS ( 29, 7) = 0.473855E+01
+ PKER_RACCS ( 29, 8) = 0.386591E+01
+ PKER_RACCS ( 29, 9) = 0.314299E+01
+ PKER_RACCS ( 29, 10) = 0.254395E+01
+ PKER_RACCS ( 29, 11) = 0.204738E+01
+ PKER_RACCS ( 29, 12) = 0.163556E+01
+ PKER_RACCS ( 29, 13) = 0.129383E+01
+ PKER_RACCS ( 29, 14) = 0.101007E+01
+ PKER_RACCS ( 29, 15) = 0.774394E+00
+ PKER_RACCS ( 29, 16) = 0.579032E+00
+ PKER_RACCS ( 29, 17) = 0.418516E+00
+ PKER_RACCS ( 29, 18) = 0.290262E+00
+ PKER_RACCS ( 29, 19) = 0.194914E+00
+ PKER_RACCS ( 29, 20) = 0.134958E+00
+ PKER_RACCS ( 29, 21) = 0.111247E+00
+ PKER_RACCS ( 29, 22) = 0.118691E+00
+ PKER_RACCS ( 29, 23) = 0.146181E+00
+ PKER_RACCS ( 29, 24) = 0.181396E+00
+ PKER_RACCS ( 29, 25) = 0.215756E+00
+ PKER_RACCS ( 29, 26) = 0.245535E+00
+ PKER_RACCS ( 29, 27) = 0.270155E+00
+ PKER_RACCS ( 29, 28) = 0.290229E+00
+ PKER_RACCS ( 29, 29) = 0.306555E+00
+ PKER_RACCS ( 29, 30) = 0.319836E+00
+ PKER_RACCS ( 29, 31) = 0.330648E+00
+ PKER_RACCS ( 29, 32) = 0.339462E+00
+ PKER_RACCS ( 29, 33) = 0.346655E+00
+ PKER_RACCS ( 29, 34) = 0.352533E+00
+ PKER_RACCS ( 29, 35) = 0.357343E+00
+ PKER_RACCS ( 29, 36) = 0.361282E+00
+ PKER_RACCS ( 29, 37) = 0.364512E+00
+ PKER_RACCS ( 29, 38) = 0.367163E+00
+ PKER_RACCS ( 29, 39) = 0.369340E+00
+ PKER_RACCS ( 29, 40) = 0.371129E+00
+ PKER_RACCS ( 30, 1) = 0.154257E+02
+ PKER_RACCS ( 30, 2) = 0.127194E+02
+ PKER_RACCS ( 30, 3) = 0.104788E+02
+ PKER_RACCS ( 30, 4) = 0.862370E+01
+ PKER_RACCS ( 30, 5) = 0.708771E+01
+ PKER_RACCS ( 30, 6) = 0.581587E+01
+ PKER_RACCS ( 30, 7) = 0.476266E+01
+ PKER_RACCS ( 30, 8) = 0.389043E+01
+ PKER_RACCS ( 30, 9) = 0.316795E+01
+ PKER_RACCS ( 30, 10) = 0.256941E+01
+ PKER_RACCS ( 30, 11) = 0.207340E+01
+ PKER_RACCS ( 30, 12) = 0.166220E+01
+ PKER_RACCS ( 30, 13) = 0.132114E+01
+ PKER_RACCS ( 30, 14) = 0.103807E+01
+ PKER_RACCS ( 30, 15) = 0.803030E+00
+ PKER_RACCS ( 30, 16) = 0.607970E+00
+ PKER_RACCS ( 30, 17) = 0.446859E+00
+ PKER_RACCS ( 30, 18) = 0.316050E+00
+ PKER_RACCS ( 30, 19) = 0.214747E+00
+ PKER_RACCS ( 30, 20) = 0.144869E+00
+ PKER_RACCS ( 30, 21) = 0.108490E+00
+ PKER_RACCS ( 30, 22) = 0.103788E+00
+ PKER_RACCS ( 30, 23) = 0.122733E+00
+ PKER_RACCS ( 30, 24) = 0.153869E+00
+ PKER_RACCS ( 30, 25) = 0.187267E+00
+ PKER_RACCS ( 30, 26) = 0.217494E+00
+ PKER_RACCS ( 30, 27) = 0.242915E+00
+ PKER_RACCS ( 30, 28) = 0.263753E+00
+ PKER_RACCS ( 30, 29) = 0.280725E+00
+ PKER_RACCS ( 30, 30) = 0.294528E+00
+ PKER_RACCS ( 30, 31) = 0.305756E+00
+ PKER_RACCS ( 30, 32) = 0.314894E+00
+ PKER_RACCS ( 30, 33) = 0.322340E+00
+ PKER_RACCS ( 30, 34) = 0.328414E+00
+ PKER_RACCS ( 30, 35) = 0.333374E+00
+ PKER_RACCS ( 30, 36) = 0.337431E+00
+ PKER_RACCS ( 30, 37) = 0.340751E+00
+ PKER_RACCS ( 30, 38) = 0.343472E+00
+ PKER_RACCS ( 30, 39) = 0.345703E+00
+ PKER_RACCS ( 30, 40) = 0.347534E+00
+ PKER_RACCS ( 31, 1) = 0.154460E+02
+ PKER_RACCS ( 31, 2) = 0.127399E+02
+ PKER_RACCS ( 31, 3) = 0.104995E+02
+ PKER_RACCS ( 31, 4) = 0.864461E+01
+ PKER_RACCS ( 31, 5) = 0.710885E+01
+ PKER_RACCS ( 31, 6) = 0.583727E+01
+ PKER_RACCS ( 31, 7) = 0.478435E+01
+ PKER_RACCS ( 31, 8) = 0.391243E+01
+ PKER_RACCS ( 31, 9) = 0.319031E+01
+ PKER_RACCS ( 31, 10) = 0.259216E+01
+ PKER_RACCS ( 31, 11) = 0.209658E+01
+ PKER_RACCS ( 31, 12) = 0.168588E+01
+ PKER_RACCS ( 31, 13) = 0.134536E+01
+ PKER_RACCS ( 31, 14) = 0.106288E+01
+ PKER_RACCS ( 31, 15) = 0.828426E+00
+ PKER_RACCS ( 31, 16) = 0.633811E+00
+ PKER_RACCS ( 31, 17) = 0.472627E+00
+ PKER_RACCS ( 31, 18) = 0.340455E+00
+ PKER_RACCS ( 31, 19) = 0.235395E+00
+ PKER_RACCS ( 31, 20) = 0.158197E+00
+ PKER_RACCS ( 31, 21) = 0.111047E+00
+ PKER_RACCS ( 31, 22) = 0.944902E-01
+ PKER_RACCS ( 31, 23) = 0.103740E+00
+ PKER_RACCS ( 31, 24) = 0.129188E+00
+ PKER_RACCS ( 31, 25) = 0.160505E+00
+ PKER_RACCS ( 31, 26) = 0.190663E+00
+ PKER_RACCS ( 31, 27) = 0.216732E+00
+ PKER_RACCS ( 31, 28) = 0.238325E+00
+ PKER_RACCS ( 31, 29) = 0.255978E+00
+ PKER_RACCS ( 31, 30) = 0.270357E+00
+ PKER_RACCS ( 31, 31) = 0.282055E+00
+ PKER_RACCS ( 31, 32) = 0.291568E+00
+ PKER_RACCS ( 31, 33) = 0.299310E+00
+ PKER_RACCS ( 31, 34) = 0.305614E+00
+ PKER_RACCS ( 31, 35) = 0.310754E+00
+ PKER_RACCS ( 31, 36) = 0.314949E+00
+ PKER_RACCS ( 31, 37) = 0.318377E+00
+ PKER_RACCS ( 31, 38) = 0.321181E+00
+ PKER_RACCS ( 31, 39) = 0.323477E+00
+ PKER_RACCS ( 31, 40) = 0.325358E+00
+ PKER_RACCS ( 32, 1) = 0.154645E+02
+ PKER_RACCS ( 32, 2) = 0.127586E+02
+ PKER_RACCS ( 32, 3) = 0.105183E+02
+ PKER_RACCS ( 32, 4) = 0.866361E+01
+ PKER_RACCS ( 32, 5) = 0.712804E+01
+ PKER_RACCS ( 32, 6) = 0.585666E+01
+ PKER_RACCS ( 32, 7) = 0.480396E+01
+ PKER_RACCS ( 32, 8) = 0.393229E+01
+ PKER_RACCS ( 32, 9) = 0.321044E+01
+ PKER_RACCS ( 32, 10) = 0.261259E+01
+ PKER_RACCS ( 32, 11) = 0.211736E+01
+ PKER_RACCS ( 32, 12) = 0.170704E+01
+ PKER_RACCS ( 32, 13) = 0.136696E+01
+ PKER_RACCS ( 32, 14) = 0.108496E+01
+ PKER_RACCS ( 32, 15) = 0.851011E+00
+ PKER_RACCS ( 32, 16) = 0.656851E+00
+ PKER_RACCS ( 32, 17) = 0.495858E+00
+ PKER_RACCS ( 32, 18) = 0.363104E+00
+ PKER_RACCS ( 32, 19) = 0.255729E+00
+ PKER_RACCS ( 32, 20) = 0.173391E+00
+ PKER_RACCS ( 32, 21) = 0.117751E+00
+ PKER_RACCS ( 32, 22) = 0.904719E-01
+ PKER_RACCS ( 32, 23) = 0.895825E-01
+ PKER_RACCS ( 32, 24) = 0.107971E+00
+ PKER_RACCS ( 32, 25) = 0.135888E+00
+ PKER_RACCS ( 32, 26) = 0.165226E+00
+ PKER_RACCS ( 32, 27) = 0.191642E+00
+ PKER_RACCS ( 32, 28) = 0.213902E+00
+ PKER_RACCS ( 32, 29) = 0.232232E+00
+ PKER_RACCS ( 32, 30) = 0.247217E+00
+ PKER_RACCS ( 32, 31) = 0.259430E+00
+ PKER_RACCS ( 32, 32) = 0.269367E+00
+ PKER_RACCS ( 32, 33) = 0.277448E+00
+ PKER_RACCS ( 32, 34) = 0.284022E+00
+ PKER_RACCS ( 32, 35) = 0.289372E+00
+ PKER_RACCS ( 32, 36) = 0.293732E+00
+ PKER_RACCS ( 32, 37) = 0.297288E+00
+ PKER_RACCS ( 32, 38) = 0.300191E+00
+ PKER_RACCS ( 32, 39) = 0.302565E+00
+ PKER_RACCS ( 32, 40) = 0.304507E+00
+ PKER_RACCS ( 33, 1) = 0.154815E+02
+ PKER_RACCS ( 33, 2) = 0.127757E+02
+ PKER_RACCS ( 33, 3) = 0.105355E+02
+ PKER_RACCS ( 33, 4) = 0.868096E+01
+ PKER_RACCS ( 33, 5) = 0.714554E+01
+ PKER_RACCS ( 33, 6) = 0.587431E+01
+ PKER_RACCS ( 33, 7) = 0.482179E+01
+ PKER_RACCS ( 33, 8) = 0.395030E+01
+ PKER_RACCS ( 33, 9) = 0.322867E+01
+ PKER_RACCS ( 33, 10) = 0.263106E+01
+ PKER_RACCS ( 33, 11) = 0.213609E+01
+ PKER_RACCS ( 33, 12) = 0.172607E+01
+ PKER_RACCS ( 33, 13) = 0.138633E+01
+ PKER_RACCS ( 33, 14) = 0.110471E+01
+ PKER_RACCS ( 33, 15) = 0.871183E+00
+ PKER_RACCS ( 33, 16) = 0.677438E+00
+ PKER_RACCS ( 33, 17) = 0.516731E+00
+ PKER_RACCS ( 33, 18) = 0.383819E+00
+ PKER_RACCS ( 33, 19) = 0.275185E+00
+ PKER_RACCS ( 33, 20) = 0.189408E+00
+ PKER_RACCS ( 33, 21) = 0.127387E+00
+ PKER_RACCS ( 33, 22) = 0.909968E-01
+ PKER_RACCS ( 33, 23) = 0.802651E-01
+ PKER_RACCS ( 33, 24) = 0.906465E-01
+ PKER_RACCS ( 33, 25) = 0.113901E+00
+ PKER_RACCS ( 33, 26) = 0.141477E+00
+ PKER_RACCS ( 33, 27) = 0.167764E+00
+ PKER_RACCS ( 33, 28) = 0.190502E+00
+ PKER_RACCS ( 33, 29) = 0.209445E+00
+ PKER_RACCS ( 33, 30) = 0.225030E+00
+ PKER_RACCS ( 33, 31) = 0.237783E+00
+ PKER_RACCS ( 33, 32) = 0.248183E+00
+ PKER_RACCS ( 33, 33) = 0.256648E+00
+ PKER_RACCS ( 33, 34) = 0.263530E+00
+ PKER_RACCS ( 33, 35) = 0.269127E+00
+ PKER_RACCS ( 33, 36) = 0.273680E+00
+ PKER_RACCS ( 33, 37) = 0.277387E+00
+ PKER_RACCS ( 33, 38) = 0.280409E+00
+ PKER_RACCS ( 33, 39) = 0.282874E+00
+ PKER_RACCS ( 33, 40) = 0.284888E+00
+ PKER_RACCS ( 34, 1) = 0.154971E+02
+ PKER_RACCS ( 34, 2) = 0.127914E+02
+ PKER_RACCS ( 34, 3) = 0.105513E+02
+ PKER_RACCS ( 34, 4) = 0.869687E+01
+ PKER_RACCS ( 34, 5) = 0.716155E+01
+ PKER_RACCS ( 34, 6) = 0.589045E+01
+ PKER_RACCS ( 34, 7) = 0.483806E+01
+ PKER_RACCS ( 34, 8) = 0.396672E+01
+ PKER_RACCS ( 34, 9) = 0.324525E+01
+ PKER_RACCS ( 34, 10) = 0.264782E+01
+ PKER_RACCS ( 34, 11) = 0.215307E+01
+ PKER_RACCS ( 34, 12) = 0.174328E+01
+ PKER_RACCS ( 34, 13) = 0.140380E+01
+ PKER_RACCS ( 34, 14) = 0.112249E+01
+ PKER_RACCS ( 34, 15) = 0.889288E+00
+ PKER_RACCS ( 34, 16) = 0.695896E+00
+ PKER_RACCS ( 34, 17) = 0.535492E+00
+ PKER_RACCS ( 34, 18) = 0.402635E+00
+ PKER_RACCS ( 34, 19) = 0.293345E+00
+ PKER_RACCS ( 34, 20) = 0.205473E+00
+ PKER_RACCS ( 34, 21) = 0.138918E+00
+ PKER_RACCS ( 34, 22) = 0.951741E-01
+ PKER_RACCS ( 34, 23) = 0.754374E-01
+ PKER_RACCS ( 34, 24) = 0.774875E-01
+ PKER_RACCS ( 34, 25) = 0.949890E-01
+ PKER_RACCS ( 34, 26) = 0.119774E+00
+ PKER_RACCS ( 34, 27) = 0.145296E+00
+ PKER_RACCS ( 34, 28) = 0.168211E+00
+ PKER_RACCS ( 34, 29) = 0.187630E+00
+ PKER_RACCS ( 34, 30) = 0.203759E+00
+ PKER_RACCS ( 34, 31) = 0.217043E+00
+ PKER_RACCS ( 34, 32) = 0.227927E+00
+ PKER_RACCS ( 34, 33) = 0.236809E+00
+ PKER_RACCS ( 34, 34) = 0.244039E+00
+ PKER_RACCS ( 34, 35) = 0.249918E+00
+ PKER_RACCS ( 34, 36) = 0.254696E+00
+ PKER_RACCS ( 34, 37) = 0.258581E+00
+ PKER_RACCS ( 34, 38) = 0.261742E+00
+ PKER_RACCS ( 34, 39) = 0.264317E+00
+ PKER_RACCS ( 34, 40) = 0.266416E+00
+ PKER_RACCS ( 35, 1) = 0.155115E+02
+ PKER_RACCS ( 35, 2) = 0.128058E+02
+ PKER_RACCS ( 35, 3) = 0.105659E+02
+ PKER_RACCS ( 35, 4) = 0.871149E+01
+ PKER_RACCS ( 35, 5) = 0.717627E+01
+ PKER_RACCS ( 35, 6) = 0.590526E+01
+ PKER_RACCS ( 35, 7) = 0.485298E+01
+ PKER_RACCS ( 35, 8) = 0.398175E+01
+ PKER_RACCS ( 35, 9) = 0.326040E+01
+ PKER_RACCS ( 35, 10) = 0.266312E+01
+ PKER_RACCS ( 35, 11) = 0.216852E+01
+ PKER_RACCS ( 35, 12) = 0.175891E+01
+ PKER_RACCS ( 35, 13) = 0.141964E+01
+ PKER_RACCS ( 35, 14) = 0.113856E+01
+ PKER_RACCS ( 35, 15) = 0.905624E+00
+ PKER_RACCS ( 35, 16) = 0.712519E+00
+ PKER_RACCS ( 35, 17) = 0.552390E+00
+ PKER_RACCS ( 35, 18) = 0.419682E+00
+ PKER_RACCS ( 35, 19) = 0.310127E+00
+ PKER_RACCS ( 35, 20) = 0.220956E+00
+ PKER_RACCS ( 35, 21) = 0.151287E+00
+ PKER_RACCS ( 35, 22) = 0.101963E+00
+ PKER_RACCS ( 35, 23) = 0.745072E-01
+ PKER_RACCS ( 35, 24) = 0.684396E-01
+ PKER_RACCS ( 35, 25) = 0.794810E-01
+ PKER_RACCS ( 35, 26) = 0.100476E+00
+ PKER_RACCS ( 35, 27) = 0.124496E+00
+ PKER_RACCS ( 35, 28) = 0.147175E+00
+ PKER_RACCS ( 35, 29) = 0.166857E+00
+ PKER_RACCS ( 35, 30) = 0.183413E+00
+ PKER_RACCS ( 35, 31) = 0.197175E+00
+ PKER_RACCS ( 35, 32) = 0.208532E+00
+ PKER_RACCS ( 35, 33) = 0.217848E+00
+ PKER_RACCS ( 35, 34) = 0.225456E+00
+ PKER_RACCS ( 35, 35) = 0.231651E+00
+ PKER_RACCS ( 35, 36) = 0.236687E+00
+ PKER_RACCS ( 35, 37) = 0.240779E+00
+ PKER_RACCS ( 35, 38) = 0.244104E+00
+ PKER_RACCS ( 35, 39) = 0.246808E+00
+ PKER_RACCS ( 35, 40) = 0.249007E+00
+ PKER_RACCS ( 36, 1) = 0.155248E+02
+ PKER_RACCS ( 36, 2) = 0.128192E+02
+ PKER_RACCS ( 36, 3) = 0.105793E+02
+ PKER_RACCS ( 36, 4) = 0.872498E+01
+ PKER_RACCS ( 36, 5) = 0.718982E+01
+ PKER_RACCS ( 36, 6) = 0.591889E+01
+ PKER_RACCS ( 36, 7) = 0.486669E+01
+ PKER_RACCS ( 36, 8) = 0.399555E+01
+ PKER_RACCS ( 36, 9) = 0.327430E+01
+ PKER_RACCS ( 36, 10) = 0.267713E+01
+ PKER_RACCS ( 36, 11) = 0.218265E+01
+ PKER_RACCS ( 36, 12) = 0.177318E+01
+ PKER_RACCS ( 36, 13) = 0.143407E+01
+ PKER_RACCS ( 36, 14) = 0.115317E+01
+ PKER_RACCS ( 36, 15) = 0.920438E+00
+ PKER_RACCS ( 36, 16) = 0.727562E+00
+ PKER_RACCS ( 36, 17) = 0.567668E+00
+ PKER_RACCS ( 36, 18) = 0.435133E+00
+ PKER_RACCS ( 36, 19) = 0.325510E+00
+ PKER_RACCS ( 36, 20) = 0.235636E+00
+ PKER_RACCS ( 36, 21) = 0.163886E+00
+ PKER_RACCS ( 36, 22) = 0.110458E+00
+ PKER_RACCS ( 36, 23) = 0.766826E-01
+ PKER_RACCS ( 36, 24) = 0.631683E-01
+ PKER_RACCS ( 36, 25) = 0.674487E-01
+ PKER_RACCS ( 36, 26) = 0.838666E-01
+ PKER_RACCS ( 36, 27) = 0.105624E+00
+ PKER_RACCS ( 36, 28) = 0.127576E+00
+ PKER_RACCS ( 36, 29) = 0.147242E+00
+ PKER_RACCS ( 36, 30) = 0.164054E+00
+ PKER_RACCS ( 36, 31) = 0.178188E+00
+ PKER_RACCS ( 36, 32) = 0.189965E+00
+ PKER_RACCS ( 36, 33) = 0.199703E+00
+ PKER_RACCS ( 36, 34) = 0.207702E+00
+ PKER_RACCS ( 36, 35) = 0.214240E+00
+ PKER_RACCS ( 36, 36) = 0.219565E+00
+ PKER_RACCS ( 36, 37) = 0.223893E+00
+ PKER_RACCS ( 36, 38) = 0.227409E+00
+ PKER_RACCS ( 36, 39) = 0.230264E+00
+ PKER_RACCS ( 36, 40) = 0.232583E+00
+ PKER_RACCS ( 37, 1) = 0.155372E+02
+ PKER_RACCS ( 37, 2) = 0.128316E+02
+ PKER_RACCS ( 37, 3) = 0.105917E+02
+ PKER_RACCS ( 37, 4) = 0.873745E+01
+ PKER_RACCS ( 37, 5) = 0.720235E+01
+ PKER_RACCS ( 37, 6) = 0.593147E+01
+ PKER_RACCS ( 37, 7) = 0.487933E+01
+ PKER_RACCS ( 37, 8) = 0.400827E+01
+ PKER_RACCS ( 37, 9) = 0.328710E+01
+ PKER_RACCS ( 37, 10) = 0.269001E+01
+ PKER_RACCS ( 37, 11) = 0.219563E+01
+ PKER_RACCS ( 37, 12) = 0.178626E+01
+ PKER_RACCS ( 37, 13) = 0.144727E+01
+ PKER_RACCS ( 37, 14) = 0.116651E+01
+ PKER_RACCS ( 37, 15) = 0.933935E+00
+ PKER_RACCS ( 37, 16) = 0.741238E+00
+ PKER_RACCS ( 37, 17) = 0.581536E+00
+ PKER_RACCS ( 37, 18) = 0.449170E+00
+ PKER_RACCS ( 37, 19) = 0.339580E+00
+ PKER_RACCS ( 37, 20) = 0.249319E+00
+ PKER_RACCS ( 37, 21) = 0.176301E+00
+ PKER_RACCS ( 37, 22) = 0.119980E+00
+ PKER_RACCS ( 37, 23) = 0.812228E-01
+ PKER_RACCS ( 37, 24) = 0.611617E-01
+ PKER_RACCS ( 37, 25) = 0.588377E-01
+ PKER_RACCS ( 37, 26) = 0.701370E-01
+ PKER_RACCS ( 37, 27) = 0.889143E-01
+ PKER_RACCS ( 37, 28) = 0.109599E+00
+ PKER_RACCS ( 37, 29) = 0.128927E+00
+ PKER_RACCS ( 37, 30) = 0.145782E+00
+ PKER_RACCS ( 37, 31) = 0.160136E+00
+ PKER_RACCS ( 37, 32) = 0.172235E+00
+ PKER_RACCS ( 37, 33) = 0.182345E+00
+ PKER_RACCS ( 37, 34) = 0.190722E+00
+ PKER_RACCS ( 37, 35) = 0.197614E+00
+ PKER_RACCS ( 37, 36) = 0.203250E+00
+ PKER_RACCS ( 37, 37) = 0.207843E+00
+ PKER_RACCS ( 37, 38) = 0.211576E+00
+ PKER_RACCS ( 37, 39) = 0.214606E+00
+ PKER_RACCS ( 37, 40) = 0.217065E+00
+ PKER_RACCS ( 38, 1) = 0.155486E+02
+ PKER_RACCS ( 38, 2) = 0.128431E+02
+ PKER_RACCS ( 38, 3) = 0.106033E+02
+ PKER_RACCS ( 38, 4) = 0.874901E+01
+ PKER_RACCS ( 38, 5) = 0.721394E+01
+ PKER_RACCS ( 38, 6) = 0.594312E+01
+ PKER_RACCS ( 38, 7) = 0.489103E+01
+ PKER_RACCS ( 38, 8) = 0.402001E+01
+ PKER_RACCS ( 38, 9) = 0.329890E+01
+ PKER_RACCS ( 38, 10) = 0.270188E+01
+ PKER_RACCS ( 38, 11) = 0.220757E+01
+ PKER_RACCS ( 38, 12) = 0.179829E+01
+ PKER_RACCS ( 38, 13) = 0.145939E+01
+ PKER_RACCS ( 38, 14) = 0.117873E+01
+ PKER_RACCS ( 38, 15) = 0.946284E+00
+ PKER_RACCS ( 38, 16) = 0.753726E+00
+ PKER_RACCS ( 38, 17) = 0.594177E+00
+ PKER_RACCS ( 38, 18) = 0.461958E+00
+ PKER_RACCS ( 38, 19) = 0.352443E+00
+ PKER_RACCS ( 38, 20) = 0.262014E+00
+ PKER_RACCS ( 38, 21) = 0.188177E+00
+ PKER_RACCS ( 38, 22) = 0.129859E+00
+ PKER_RACCS ( 38, 23) = 0.873684E-01
+ PKER_RACCS ( 38, 24) = 0.618482E-01
+ PKER_RACCS ( 38, 25) = 0.533670E-01
+ PKER_RACCS ( 38, 26) = 0.593061E-01
+ PKER_RACCS ( 38, 27) = 0.745116E-01
+ PKER_RACCS ( 38, 28) = 0.934019E-01
+ PKER_RACCS ( 38, 29) = 0.112045E+00
+ PKER_RACCS ( 38, 30) = 0.128716E+00
+ PKER_RACCS ( 38, 31) = 0.143109E+00
+ PKER_RACCS ( 38, 32) = 0.155390E+00
+ PKER_RACCS ( 38, 33) = 0.165779E+00
+ PKER_RACCS ( 38, 34) = 0.174487E+00
+ PKER_RACCS ( 38, 35) = 0.181718E+00
+ PKER_RACCS ( 38, 36) = 0.187676E+00
+ PKER_RACCS ( 38, 37) = 0.192553E+00
+ PKER_RACCS ( 38, 38) = 0.196528E+00
+ PKER_RACCS ( 38, 39) = 0.199758E+00
+ PKER_RACCS ( 38, 40) = 0.202379E+00
+ PKER_RACCS ( 39, 1) = 0.155593E+02
+ PKER_RACCS ( 39, 2) = 0.128537E+02
+ PKER_RACCS ( 39, 3) = 0.106139E+02
+ PKER_RACCS ( 39, 4) = 0.875973E+01
+ PKER_RACCS ( 39, 5) = 0.722471E+01
+ PKER_RACCS ( 39, 6) = 0.595391E+01
+ PKER_RACCS ( 39, 7) = 0.490186E+01
+ PKER_RACCS ( 39, 8) = 0.403089E+01
+ PKER_RACCS ( 39, 9) = 0.330982E+01
+ PKER_RACCS ( 39, 10) = 0.271285E+01
+ PKER_RACCS ( 39, 11) = 0.221860E+01
+ PKER_RACCS ( 39, 12) = 0.180938E+01
+ PKER_RACCS ( 39, 13) = 0.147055E+01
+ PKER_RACCS ( 39, 14) = 0.118998E+01
+ PKER_RACCS ( 39, 15) = 0.957626E+00
+ PKER_RACCS ( 39, 16) = 0.765175E+00
+ PKER_RACCS ( 39, 17) = 0.605746E+00
+ PKER_RACCS ( 39, 18) = 0.473650E+00
+ PKER_RACCS ( 39, 19) = 0.364221E+00
+ PKER_RACCS ( 39, 20) = 0.273730E+00
+ PKER_RACCS ( 39, 21) = 0.199436E+00
+ PKER_RACCS ( 39, 22) = 0.139756E+00
+ PKER_RACCS ( 39, 23) = 0.945196E-01
+ PKER_RACCS ( 39, 24) = 0.645897E-01
+ PKER_RACCS ( 39, 25) = 0.506197E-01
+ PKER_RACCS ( 39, 26) = 0.512198E-01
+ PKER_RACCS ( 39, 27) = 0.624590E-01
+ PKER_RACCS ( 39, 28) = 0.790782E-01
+ PKER_RACCS ( 39, 29) = 0.966942E-01
+ PKER_RACCS ( 39, 30) = 0.112959E+00
+ PKER_RACCS ( 39, 31) = 0.127212E+00
+ PKER_RACCS ( 39, 32) = 0.139513E+00
+ PKER_RACCS ( 39, 33) = 0.150051E+00
+ PKER_RACCS ( 39, 34) = 0.159002E+00
+ PKER_RACCS ( 39, 35) = 0.166528E+00
+ PKER_RACCS ( 39, 36) = 0.172792E+00
+ PKER_RACCS ( 39, 37) = 0.177962E+00
+ PKER_RACCS ( 39, 38) = 0.182197E+00
+ PKER_RACCS ( 39, 39) = 0.185650E+00
+ PKER_RACCS ( 39, 40) = 0.188455E+00
+ PKER_RACCS ( 40, 1) = 0.155692E+02
+ PKER_RACCS ( 40, 2) = 0.128637E+02
+ PKER_RACCS ( 40, 3) = 0.106239E+02
+ PKER_RACCS ( 40, 4) = 0.876971E+01
+ PKER_RACCS ( 40, 5) = 0.723471E+01
+ PKER_RACCS ( 40, 6) = 0.596394E+01
+ PKER_RACCS ( 40, 7) = 0.491192E+01
+ PKER_RACCS ( 40, 8) = 0.404098E+01
+ PKER_RACCS ( 40, 9) = 0.331995E+01
+ PKER_RACCS ( 40, 10) = 0.272302E+01
+ PKER_RACCS ( 40, 11) = 0.222881E+01
+ PKER_RACCS ( 40, 12) = 0.181964E+01
+ PKER_RACCS ( 40, 13) = 0.148087E+01
+ PKER_RACCS ( 40, 14) = 0.120036E+01
+ PKER_RACCS ( 40, 15) = 0.968076E+00
+ PKER_RACCS ( 40, 16) = 0.775708E+00
+ PKER_RACCS ( 40, 17) = 0.616371E+00
+ PKER_RACCS ( 40, 18) = 0.484375E+00
+ PKER_RACCS ( 40, 19) = 0.375030E+00
+ PKER_RACCS ( 40, 20) = 0.284536E+00
+ PKER_RACCS ( 40, 21) = 0.209971E+00
+ PKER_RACCS ( 40, 22) = 0.149448E+00
+ PKER_RACCS ( 40, 23) = 0.102257E+00
+ PKER_RACCS ( 40, 24) = 0.688589E-01
+ PKER_RACCS ( 40, 25) = 0.501439E-01
+ PKER_RACCS ( 40, 26) = 0.457017E-01
+ PKER_RACCS ( 40, 27) = 0.527560E-01
+ PKER_RACCS ( 40, 28) = 0.666825E-01
+ PKER_RACCS ( 40, 29) = 0.829271E-01
+ PKER_RACCS ( 40, 30) = 0.985768E-01
+ PKER_RACCS ( 40, 31) = 0.112531E+00
+ PKER_RACCS ( 40, 32) = 0.124696E+00
+ PKER_RACCS ( 40, 33) = 0.135236E+00
+ PKER_RACCS ( 40, 34) = 0.144309E+00
+ PKER_RACCS ( 40, 35) = 0.152047E+00
+ PKER_RACCS ( 40, 36) = 0.158575E+00
+ PKER_RACCS ( 40, 37) = 0.164022E+00
+ PKER_RACCS ( 40, 38) = 0.168524E+00
+ PKER_RACCS ( 40, 39) = 0.172216E+00
+ PKER_RACCS ( 40, 40) = 0.175226E+00
+END IF
+!
+IF( PRESENT(PKER_SACCRG) ) THEN
+ PKER_SACCRG( 1, 1) = 0.403346E-01
+ PKER_SACCRG( 1, 2) = 0.679214E-01
+ PKER_SACCRG( 1, 3) = 0.105303E+00
+ PKER_SACCRG( 1, 4) = 0.191884E+00
+ PKER_SACCRG( 1, 5) = 0.356499E+00
+ PKER_SACCRG( 1, 6) = 0.645361E+00
+ PKER_SACCRG( 1, 7) = 0.109656E+01
+ PKER_SACCRG( 1, 8) = 0.172233E+01
+ PKER_SACCRG( 1, 9) = 0.249565E+01
+ PKER_SACCRG( 1, 10) = 0.335221E+01
+ PKER_SACCRG( 1, 11) = 0.421020E+01
+ PKER_SACCRG( 1, 12) = 0.500014E+01
+ PKER_SACCRG( 1, 13) = 0.568528E+01
+ PKER_SACCRG( 1, 14) = 0.626334E+01
+ PKER_SACCRG( 1, 15) = 0.675253E+01
+ PKER_SACCRG( 1, 16) = 0.717505E+01
+ PKER_SACCRG( 1, 17) = 0.754648E+01
+ PKER_SACCRG( 1, 18) = 0.787497E+01
+ PKER_SACCRG( 1, 19) = 0.816359E+01
+ PKER_SACCRG( 1, 20) = 0.839531E+01
+ PKER_SACCRG( 1, 21) = 0.861132E+01
+ PKER_SACCRG( 1, 22) = 0.879448E+01
+ PKER_SACCRG( 1, 23) = 0.891918E+01
+ PKER_SACCRG( 1, 24) = 0.905216E+01
+ PKER_SACCRG( 1, 25) = 0.913347E+01
+ PKER_SACCRG( 1, 26) = 0.920118E+01
+ PKER_SACCRG( 1, 27) = 0.926006E+01
+ PKER_SACCRG( 1, 28) = 0.928744E+01
+ PKER_SACCRG( 1, 29) = 0.931698E+01
+ PKER_SACCRG( 1, 30) = 0.934860E+01
+ PKER_SACCRG( 1, 31) = 0.936637E+01
+ PKER_SACCRG( 1, 32) = 0.937727E+01
+ PKER_SACCRG( 1, 33) = 0.938596E+01
+ PKER_SACCRG( 1, 34) = 0.938735E+01
+ PKER_SACCRG( 1, 35) = 0.939455E+01
+ PKER_SACCRG( 1, 36) = 0.940989E+01
+ PKER_SACCRG( 1, 37) = 0.000000E+00
+ PKER_SACCRG( 1, 38) = 0.000000E+00
+ PKER_SACCRG( 1, 39) = 0.000000E+00
+ PKER_SACCRG( 1, 40) = 0.000000E+00
+ PKER_SACCRG( 2, 1) = 0.232705E-01
+ PKER_SACCRG( 2, 2) = 0.335875E-01
+ PKER_SACCRG( 2, 3) = 0.565187E-01
+ PKER_SACCRG( 2, 4) = 0.875474E-01
+ PKER_SACCRG( 2, 5) = 0.159343E+00
+ PKER_SACCRG( 2, 6) = 0.295630E+00
+ PKER_SACCRG( 2, 7) = 0.534289E+00
+ PKER_SACCRG( 2, 8) = 0.906069E+00
+ PKER_SACCRG( 2, 9) = 0.141997E+01
+ PKER_SACCRG( 2, 10) = 0.205255E+01
+ PKER_SACCRG( 2, 11) = 0.274997E+01
+ PKER_SACCRG( 2, 12) = 0.344544E+01
+ PKER_SACCRG( 2, 13) = 0.408314E+01
+ PKER_SACCRG( 2, 14) = 0.463534E+01
+ PKER_SACCRG( 2, 15) = 0.510239E+01
+ PKER_SACCRG( 2, 16) = 0.550069E+01
+ PKER_SACCRG( 2, 17) = 0.584817E+01
+ PKER_SACCRG( 2, 18) = 0.615710E+01
+ PKER_SACCRG( 2, 19) = 0.643286E+01
+ PKER_SACCRG( 2, 20) = 0.665945E+01
+ PKER_SACCRG( 2, 21) = 0.687323E+01
+ PKER_SACCRG( 2, 22) = 0.705716E+01
+ PKER_SACCRG( 2, 23) = 0.718460E+01
+ PKER_SACCRG( 2, 24) = 0.732011E+01
+ PKER_SACCRG( 2, 25) = 0.740395E+01
+ PKER_SACCRG( 2, 26) = 0.747372E+01
+ PKER_SACCRG( 2, 27) = 0.753430E+01
+ PKER_SACCRG( 2, 28) = 0.756268E+01
+ PKER_SACCRG( 2, 29) = 0.759307E+01
+ PKER_SACCRG( 2, 30) = 0.762550E+01
+ PKER_SACCRG( 2, 31) = 0.764373E+01
+ PKER_SACCRG( 2, 32) = 0.765493E+01
+ PKER_SACCRG( 2, 33) = 0.766384E+01
+ PKER_SACCRG( 2, 34) = 0.766528E+01
+ PKER_SACCRG( 2, 35) = 0.767265E+01
+ PKER_SACCRG( 2, 36) = 0.768832E+01
+ PKER_SACCRG( 2, 37) = 0.000000E+00
+ PKER_SACCRG( 2, 38) = 0.000000E+00
+ PKER_SACCRG( 2, 39) = 0.000000E+00
+ PKER_SACCRG( 2, 40) = 0.000000E+00
+ PKER_SACCRG( 3, 1) = 0.183931E-01
+ PKER_SACCRG( 3, 2) = 0.194765E-01
+ PKER_SACCRG( 3, 3) = 0.280964E-01
+ PKER_SACCRG( 3, 4) = 0.472341E-01
+ PKER_SACCRG( 3, 5) = 0.730819E-01
+ PKER_SACCRG( 3, 6) = 0.132827E+00
+ PKER_SACCRG( 3, 7) = 0.245992E+00
+ PKER_SACCRG( 3, 8) = 0.443632E+00
+ PKER_SACCRG( 3, 9) = 0.750424E+00
+ PKER_SACCRG( 3, 10) = 0.117268E+01
+ PKER_SACCRG( 3, 11) = 0.168954E+01
+ PKER_SACCRG( 3, 12) = 0.225593E+01
+ PKER_SACCRG( 3, 13) = 0.281701E+01
+ PKER_SACCRG( 3, 14) = 0.332851E+01
+ PKER_SACCRG( 3, 15) = 0.377021E+01
+ PKER_SACCRG( 3, 16) = 0.414495E+01
+ PKER_SACCRG( 3, 17) = 0.446759E+01
+ PKER_SACCRG( 3, 18) = 0.475325E+01
+ PKER_SACCRG( 3, 19) = 0.501103E+01
+ PKER_SACCRG( 3, 20) = 0.522794E+01
+ PKER_SACCRG( 3, 21) = 0.543570E+01
+ PKER_SACCRG( 3, 22) = 0.561785E+01
+ PKER_SACCRG( 3, 23) = 0.574685E+01
+ PKER_SACCRG( 3, 24) = 0.588391E+01
+ PKER_SACCRG( 3, 25) = 0.597001E+01
+ PKER_SACCRG( 3, 26) = 0.604169E+01
+ PKER_SACCRG( 3, 27) = 0.610387E+01
+ PKER_SACCRG( 3, 28) = 0.613328E+01
+ PKER_SACCRG( 3, 29) = 0.616451E+01
+ PKER_SACCRG( 3, 30) = 0.619771E+01
+ PKER_SACCRG( 3, 31) = 0.621641E+01
+ PKER_SACCRG( 3, 32) = 0.622789E+01
+ PKER_SACCRG( 3, 33) = 0.623702E+01
+ PKER_SACCRG( 3, 34) = 0.623852E+01
+ PKER_SACCRG( 3, 35) = 0.624605E+01
+ PKER_SACCRG( 3, 36) = 0.626204E+01
+ PKER_SACCRG( 3, 37) = 0.000000E+00
+ PKER_SACCRG( 3, 38) = 0.000000E+00
+ PKER_SACCRG( 3, 39) = 0.000000E+00
+ PKER_SACCRG( 3, 40) = 0.000000E+00
+ PKER_SACCRG( 4, 1) = 0.114393E-01
+ PKER_SACCRG( 4, 2) = 0.155094E-01
+ PKER_SACCRG( 4, 3) = 0.164106E-01
+ PKER_SACCRG( 4, 4) = 0.236526E-01
+ PKER_SACCRG( 4, 5) = 0.397213E-01
+ PKER_SACCRG( 4, 6) = 0.613666E-01
+ PKER_SACCRG( 4, 7) = 0.111326E+00
+ PKER_SACCRG( 4, 8) = 0.205685E+00
+ PKER_SACCRG( 4, 9) = 0.369928E+00
+ PKER_SACCRG( 4, 10) = 0.623698E+00
+ PKER_SACCRG( 4, 11) = 0.970783E+00
+ PKER_SACCRG( 4, 12) = 0.139255E+01
+ PKER_SACCRG( 4, 13) = 0.185072E+01
+ PKER_SACCRG( 4, 14) = 0.230015E+01
+ PKER_SACCRG( 4, 15) = 0.270627E+01
+ PKER_SACCRG( 4, 16) = 0.305559E+01
+ PKER_SACCRG( 4, 17) = 0.335340E+01
+ PKER_SACCRG( 4, 18) = 0.361392E+01
+ PKER_SACCRG( 4, 19) = 0.384970E+01
+ PKER_SACCRG( 4, 20) = 0.405246E+01
+ PKER_SACCRG( 4, 21) = 0.425002E+01
+ PKER_SACCRG( 4, 22) = 0.442724E+01
+ PKER_SACCRG( 4, 23) = 0.455616E+01
+ PKER_SACCRG( 4, 24) = 0.469337E+01
+ PKER_SACCRG( 4, 25) = 0.478122E+01
+ PKER_SACCRG( 4, 26) = 0.485452E+01
+ PKER_SACCRG( 4, 27) = 0.491813E+01
+ PKER_SACCRG( 4, 28) = 0.494855E+01
+ PKER_SACCRG( 4, 29) = 0.498058E+01
+ PKER_SACCRG( 4, 30) = 0.501450E+01
+ PKER_SACCRG( 4, 31) = 0.503365E+01
+ PKER_SACCRG( 4, 32) = 0.504542E+01
+ PKER_SACCRG( 4, 33) = 0.505475E+01
+ PKER_SACCRG( 4, 34) = 0.505631E+01
+ PKER_SACCRG( 4, 35) = 0.506399E+01
+ PKER_SACCRG( 4, 36) = 0.508029E+01
+ PKER_SACCRG( 4, 37) = 0.000000E+00
+ PKER_SACCRG( 4, 38) = 0.000000E+00
+ PKER_SACCRG( 4, 39) = 0.000000E+00
+ PKER_SACCRG( 4, 40) = 0.000000E+00
+ PKER_SACCRG( 5, 1) = 0.885989E-02
+ PKER_SACCRG( 5, 2) = 0.975839E-02
+ PKER_SACCRG( 5, 3) = 0.132035E-01
+ PKER_SACCRG( 5, 4) = 0.139558E-01
+ PKER_SACCRG( 5, 5) = 0.200916E-01
+ PKER_SACCRG( 5, 6) = 0.296110E-01
+ PKER_SACCRG( 5, 7) = 0.519536E-01
+ PKER_SACCRG( 5, 8) = 0.940172E-01
+ PKER_SACCRG( 5, 9) = 0.173205E+00
+ PKER_SACCRG( 5, 10) = 0.310322E+00
+ PKER_SACCRG( 5, 11) = 0.520780E+00
+ PKER_SACCRG( 5, 12) = 0.806566E+00
+ PKER_SACCRG( 5, 13) = 0.115020E+01
+ PKER_SACCRG( 5, 14) = 0.151872E+01
+ PKER_SACCRG( 5, 15) = 0.187497E+01
+ PKER_SACCRG( 5, 16) = 0.219377E+01
+ PKER_SACCRG( 5, 17) = 0.246641E+01
+ PKER_SACCRG( 5, 18) = 0.270162E+01
+ PKER_SACCRG( 5, 19) = 0.291200E+01
+ PKER_SACCRG( 5, 20) = 0.309558E+01
+ PKER_SACCRG( 5, 21) = 0.327751E+01
+ PKER_SACCRG( 5, 22) = 0.344551E+01
+ PKER_SACCRG( 5, 23) = 0.357190E+01
+ PKER_SACCRG( 5, 24) = 0.370734E+01
+ PKER_SACCRG( 5, 25) = 0.379614E+01
+ PKER_SACCRG( 5, 26) = 0.387059E+01
+ PKER_SACCRG( 5, 27) = 0.393531E+01
+ PKER_SACCRG( 5, 28) = 0.396669E+01
+ PKER_SACCRG( 5, 29) = 0.399944E+01
+ PKER_SACCRG( 5, 30) = 0.403397E+01
+ PKER_SACCRG( 5, 31) = 0.405353E+01
+ PKER_SACCRG( 5, 32) = 0.406555E+01
+ PKER_SACCRG( 5, 33) = 0.407508E+01
+ PKER_SACCRG( 5, 34) = 0.407671E+01
+ PKER_SACCRG( 5, 35) = 0.408453E+01
+ PKER_SACCRG( 5, 36) = 0.410107E+01
+ PKER_SACCRG( 5, 37) = 0.000000E+00
+ PKER_SACCRG( 5, 38) = 0.000000E+00
+ PKER_SACCRG( 5, 39) = 0.000000E+00
+ PKER_SACCRG( 5, 40) = 0.000000E+00
+ PKER_SACCRG( 6, 1) = 0.939278E-02
+ PKER_SACCRG( 6, 2) = 0.770370E-02
+ PKER_SACCRG( 6, 3) = 0.844219E-02
+ PKER_SACCRG( 6, 4) = 0.113902E-01
+ PKER_SACCRG( 6, 5) = 0.120225E-01
+ PKER_SACCRG( 6, 6) = 0.172828E-01
+ PKER_SACCRG( 6, 7) = 0.254190E-01
+ PKER_SACCRG( 6, 8) = 0.444876E-01
+ PKER_SACCRG( 6, 9) = 0.802697E-01
+ PKER_SACCRG( 6, 10) = 0.147308E+00
+ PKER_SACCRG( 6, 11) = 0.262153E+00
+ PKER_SACCRG( 6, 12) = 0.437891E+00
+ PKER_SACCRG( 6, 13) = 0.673319E+00
+ PKER_SACCRG( 6, 14) = 0.951922E+00
+ PKER_SACCRG( 6, 15) = 0.124486E+01
+ PKER_SACCRG( 6, 16) = 0.152378E+01
+ PKER_SACCRG( 6, 17) = 0.176859E+01
+ PKER_SACCRG( 6, 18) = 0.197911E+01
+ PKER_SACCRG( 6, 19) = 0.216406E+01
+ PKER_SACCRG( 6, 20) = 0.232602E+01
+ PKER_SACCRG( 6, 21) = 0.248802E+01
+ PKER_SACCRG( 6, 22) = 0.264189E+01
+ PKER_SACCRG( 6, 23) = 0.276205E+01
+ PKER_SACCRG( 6, 24) = 0.289262E+01
+ PKER_SACCRG( 6, 25) = 0.298091E+01
+ PKER_SACCRG( 6, 26) = 0.305566E+01
+ PKER_SACCRG( 6, 27) = 0.312099E+01
+ PKER_SACCRG( 6, 28) = 0.315321E+01
+ PKER_SACCRG( 6, 29) = 0.318651E+01
+ PKER_SACCRG( 6, 30) = 0.322151E+01
+ PKER_SACCRG( 6, 31) = 0.324141E+01
+ PKER_SACCRG( 6, 32) = 0.325366E+01
+ PKER_SACCRG( 6, 33) = 0.326335E+01
+ PKER_SACCRG( 6, 34) = 0.326504E+01
+ PKER_SACCRG( 6, 35) = 0.327297E+01
+ PKER_SACCRG( 6, 36) = 0.328972E+01
+ PKER_SACCRG( 6, 37) = 0.000000E+00
+ PKER_SACCRG( 6, 38) = 0.000000E+00
+ PKER_SACCRG( 6, 39) = 0.000000E+00
+ PKER_SACCRG( 6, 40) = 0.000000E+00
+ PKER_SACCRG( 7, 1) = 0.197193E-02
+ PKER_SACCRG( 7, 2) = 0.840926E-02
+ PKER_SACCRG( 7, 3) = 0.684203E-02
+ PKER_SACCRG( 7, 4) = 0.744934E-02
+ PKER_SACCRG( 7, 5) = 0.100142E-01
+ PKER_SACCRG( 7, 6) = 0.105435E-01
+ PKER_SACCRG( 7, 7) = 0.151114E-01
+ PKER_SACCRG( 7, 8) = 0.221799E-01
+ PKER_SACCRG( 7, 9) = 0.387273E-01
+ PKER_SACCRG( 7, 10) = 0.696342E-01
+ PKER_SACCRG( 7, 11) = 0.126786E+00
+ PKER_SACCRG( 7, 12) = 0.224173E+00
+ PKER_SACCRG( 7, 13) = 0.371284E+00
+ PKER_SACCRG( 7, 14) = 0.564401E+00
+ PKER_SACCRG( 7, 15) = 0.787177E+00
+ PKER_SACCRG( 7, 16) = 0.101687E+01
+ PKER_SACCRG( 7, 17) = 0.122807E+01
+ PKER_SACCRG( 7, 18) = 0.141258E+01
+ PKER_SACCRG( 7, 19) = 0.157270E+01
+ PKER_SACCRG( 7, 20) = 0.171283E+01
+ PKER_SACCRG( 7, 21) = 0.185341E+01
+ PKER_SACCRG( 7, 22) = 0.199032E+01
+ PKER_SACCRG( 7, 23) = 0.210129E+01
+ PKER_SACCRG( 7, 24) = 0.222356E+01
+ PKER_SACCRG( 7, 25) = 0.230903E+01
+ PKER_SACCRG( 7, 26) = 0.238240E+01
+ PKER_SACCRG( 7, 27) = 0.244719E+01
+ PKER_SACCRG( 7, 28) = 0.247983E+01
+ PKER_SACCRG( 7, 29) = 0.251337E+01
+ PKER_SACCRG( 7, 30) = 0.254858E+01
+ PKER_SACCRG( 7, 31) = 0.256871E+01
+ PKER_SACCRG( 7, 32) = 0.258114E+01
+ PKER_SACCRG( 7, 33) = 0.259094E+01
+ PKER_SACCRG( 7, 34) = 0.259270E+01
+ PKER_SACCRG( 7, 35) = 0.260070E+01
+ PKER_SACCRG( 7, 36) = 0.261756E+01
+ PKER_SACCRG( 7, 37) = 0.000000E+00
+ PKER_SACCRG( 7, 38) = 0.000000E+00
+ PKER_SACCRG( 7, 39) = 0.000000E+00
+ PKER_SACCRG( 7, 40) = 0.000000E+00
+ PKER_SACCRG( 8, 1) = 0.287028E-02
+ PKER_SACCRG( 8, 2) = 0.183962E-02
+ PKER_SACCRG( 8, 3) = 0.778156E-02
+ PKER_SACCRG( 8, 4) = 0.626956E-02
+ PKER_SACCRG( 8, 5) = 0.676623E-02
+ PKER_SACCRG( 8, 6) = 0.546166E-02
+ PKER_SACCRG( 8, 7) = 0.943103E-02
+ PKER_SACCRG( 8, 8) = 0.135380E-01
+ PKER_SACCRG( 8, 9) = 0.198532E-01
+ PKER_SACCRG( 8, 10) = 0.345712E-01
+ PKER_SACCRG( 8, 11) = 0.614306E-01
+ PKER_SACCRG( 8, 12) = 0.111431E+00
+ PKER_SACCRG( 8, 13) = 0.195294E+00
+ PKER_SACCRG( 8, 14) = 0.318747E+00
+ PKER_SACCRG( 8, 15) = 0.475607E+00
+ PKER_SACCRG( 8, 16) = 0.653793E+00
+ PKER_SACCRG( 8, 17) = 0.827434E+00
+ PKER_SACCRG( 8, 18) = 0.984457E+00
+ PKER_SACCRG( 8, 19) = 0.111823E+01
+ PKER_SACCRG( 8, 20) = 0.123445E+01
+ PKER_SACCRG( 8, 21) = 0.135038E+01
+ PKER_SACCRG( 8, 22) = 0.146703E+01
+ PKER_SACCRG( 8, 23) = 0.156617E+01
+ PKER_SACCRG( 8, 24) = 0.167765E+01
+ PKER_SACCRG( 8, 25) = 0.175863E+01
+ PKER_SACCRG( 8, 26) = 0.182918E+01
+ PKER_SACCRG( 8, 27) = 0.189212E+01
+ PKER_SACCRG( 8, 28) = 0.192450E+01
+ PKER_SACCRG( 8, 29) = 0.195757E+01
+ PKER_SACCRG( 8, 30) = 0.199227E+01
+ PKER_SACCRG( 8, 31) = 0.201226E+01
+ PKER_SACCRG( 8, 32) = 0.202464E+01
+ PKER_SACCRG( 8, 33) = 0.203441E+01
+ PKER_SACCRG( 8, 34) = 0.203619E+01
+ PKER_SACCRG( 8, 35) = 0.204416E+01
+ PKER_SACCRG( 8, 36) = 0.206100E+01
+ PKER_SACCRG( 8, 37) = 0.000000E+00
+ PKER_SACCRG( 8, 38) = 0.000000E+00
+ PKER_SACCRG( 8, 39) = 0.000000E+00
+ PKER_SACCRG( 8, 40) = 0.000000E+00
+ PKER_SACCRG( 9, 1) = 0.227973E-03
+ PKER_SACCRG( 9, 2) = 0.282707E-02
+ PKER_SACCRG( 9, 3) = 0.180146E-02
+ PKER_SACCRG( 9, 4) = 0.195291E-02
+ PKER_SACCRG( 9, 5) = 0.601462E-02
+ PKER_SACCRG( 9, 6) = 0.639847E-02
+ PKER_SACCRG( 9, 7) = 0.503409E-02
+ PKER_SACCRG( 9, 8) = 0.874760E-02
+ PKER_SACCRG( 9, 9) = 0.125924E-01
+ PKER_SACCRG( 9, 10) = 0.187098E-01
+ PKER_SACCRG( 9, 11) = 0.315437E-01
+ PKER_SACCRG( 9, 12) = 0.563136E-01
+ PKER_SACCRG( 9, 13) = 0.100517E+00
+ PKER_SACCRG( 9, 14) = 0.173643E+00
+ PKER_SACCRG( 9, 15) = 0.275822E+00
+ PKER_SACCRG( 9, 16) = 0.405835E+00
+ PKER_SACCRG( 9, 17) = 0.540959E+00
+ PKER_SACCRG( 9, 18) = 0.670349E+00
+ PKER_SACCRG( 9, 19) = 0.779801E+00
+ PKER_SACCRG( 9, 20) = 0.873659E+00
+ PKER_SACCRG( 9, 21) = 0.964651E+00
+ PKER_SACCRG( 9, 22) = 0.105792E+01
+ PKER_SACCRG( 9, 23) = 0.114069E+01
+ PKER_SACCRG( 9, 24) = 0.123707E+01
+ PKER_SACCRG( 9, 25) = 0.131072E+01
+ PKER_SACCRG( 9, 26) = 0.137674E+01
+ PKER_SACCRG( 9, 27) = 0.143675E+01
+ PKER_SACCRG( 9, 28) = 0.146856E+01
+ PKER_SACCRG( 9, 29) = 0.150083E+01
+ PKER_SACCRG( 9, 30) = 0.153465E+01
+ PKER_SACCRG( 9, 31) = 0.155430E+01
+ PKER_SACCRG( 9, 32) = 0.156652E+01
+ PKER_SACCRG( 9, 33) = 0.157614E+01
+ PKER_SACCRG( 9, 34) = 0.157797E+01
+ PKER_SACCRG( 9, 35) = 0.158578E+01
+ PKER_SACCRG( 9, 36) = 0.160221E+01
+ PKER_SACCRG( 9, 37) = 0.000000E+00
+ PKER_SACCRG( 9, 38) = 0.000000E+00
+ PKER_SACCRG( 9, 39) = 0.000000E+00
+ PKER_SACCRG( 9, 40) = 0.000000E+00
+ PKER_SACCRG( 10, 1) = 0.836884E-05
+ PKER_SACCRG( 10, 2) = 0.241023E-03
+ PKER_SACCRG( 10, 3) = 0.298555E-02
+ PKER_SACCRG( 10, 4) = 0.189539E-02
+ PKER_SACCRG( 10, 5) = 0.204013E-02
+ PKER_SACCRG( 10, 6) = 0.618434E-02
+ PKER_SACCRG( 10, 7) = 0.624911E-02
+ PKER_SACCRG( 10, 8) = 0.493580E-02
+ PKER_SACCRG( 10, 9) = 0.859150E-02
+ PKER_SACCRG( 10, 10) = 0.132122E-01
+ PKER_SACCRG( 10, 11) = 0.178104E-01
+ PKER_SACCRG( 10, 12) = 0.313842E-01
+ PKER_SACCRG( 10, 13) = 0.543137E-01
+ PKER_SACCRG( 10, 14) = 0.957524E-01
+ PKER_SACCRG( 10, 15) = 0.158366E+00
+ PKER_SACCRG( 10, 16) = 0.250247E+00
+ PKER_SACCRG( 10, 17) = 0.351339E+00
+ PKER_SACCRG( 10, 18) = 0.455229E+00
+ PKER_SACCRG( 10, 19) = 0.541376E+00
+ PKER_SACCRG( 10, 20) = 0.613508E+00
+ PKER_SACCRG( 10, 21) = 0.679512E+00
+ PKER_SACCRG( 10, 22) = 0.748499E+00
+ PKER_SACCRG( 10, 23) = 0.812917E+00
+ PKER_SACCRG( 10, 24) = 0.891097E+00
+ PKER_SACCRG( 10, 25) = 0.953782E+00
+ PKER_SACCRG( 10, 26) = 0.101178E+01
+ PKER_SACCRG( 10, 27) = 0.106610E+01
+ PKER_SACCRG( 10, 28) = 0.109586E+01
+ PKER_SACCRG( 10, 29) = 0.112638E+01
+ PKER_SACCRG( 10, 30) = 0.115867E+01
+ PKER_SACCRG( 10, 31) = 0.117769E+01
+ PKER_SACCRG( 10, 32) = 0.118959E+01
+ PKER_SACCRG( 10, 33) = 0.119896E+01
+ PKER_SACCRG( 10, 34) = 0.120079E+01
+ PKER_SACCRG( 10, 35) = 0.120838E+01
+ PKER_SACCRG( 10, 36) = 0.122431E+01
+ PKER_SACCRG( 10, 37) = 0.000000E+00
+ PKER_SACCRG( 10, 38) = 0.000000E+00
+ PKER_SACCRG( 10, 39) = 0.000000E+00
+ PKER_SACCRG( 10, 40) = 0.000000E+00
+ PKER_SACCRG( 11, 1) = 0.000000E+00
+ PKER_SACCRG( 11, 2) = 0.984489E-05
+ PKER_SACCRG( 11, 3) = 0.280498E-03
+ PKER_SACCRG( 11, 4) = 0.349195E-02
+ PKER_SACCRG( 11, 5) = 0.223140E-02
+ PKER_SACCRG( 11, 6) = 0.240058E-02
+ PKER_SACCRG( 11, 7) = 0.683543E-02
+ PKER_SACCRG( 11, 8) = 0.692007E-02
+ PKER_SACCRG( 11, 9) = 0.514199E-02
+ PKER_SACCRG( 11, 10) = 0.114977E-01
+ PKER_SACCRG( 11, 11) = 0.109728E-01
+ PKER_SACCRG( 11, 12) = 0.211442E-01
+ PKER_SACCRG( 11, 13) = 0.346586E-01
+ PKER_SACCRG( 11, 14) = 0.591042E-01
+ PKER_SACCRG( 11, 15) = 0.961841E-01
+ PKER_SACCRG( 11, 16) = 0.162562E+00
+ PKER_SACCRG( 11, 17) = 0.237843E+00
+ PKER_SACCRG( 11, 18) = 0.321714E+00
+ PKER_SACCRG( 11, 19) = 0.387542E+00
+ PKER_SACCRG( 11, 20) = 0.440755E+00
+ PKER_SACCRG( 11, 21) = 0.483048E+00
+ PKER_SACCRG( 11, 22) = 0.527421E+00
+ PKER_SACCRG( 11, 23) = 0.571319E+00
+ PKER_SACCRG( 11, 24) = 0.628617E+00
+ PKER_SACCRG( 11, 25) = 0.677728E+00
+ PKER_SACCRG( 11, 26) = 0.725464E+00
+ PKER_SACCRG( 11, 27) = 0.771793E+00
+ PKER_SACCRG( 11, 28) = 0.798056E+00
+ PKER_SACCRG( 11, 29) = 0.825035E+00
+ PKER_SACCRG( 11, 30) = 0.853830E+00
+ PKER_SACCRG( 11, 31) = 0.871001E+00
+ PKER_SACCRG( 11, 32) = 0.881834E+00
+ PKER_SACCRG( 11, 33) = 0.890401E+00
+ PKER_SACCRG( 11, 34) = 0.892044E+00
+ PKER_SACCRG( 11, 35) = 0.899026E+00
+ PKER_SACCRG( 11, 36) = 0.913978E+00
+ PKER_SACCRG( 11, 37) = 0.000000E+00
+ PKER_SACCRG( 11, 38) = 0.000000E+00
+ PKER_SACCRG( 11, 39) = 0.000000E+00
+ PKER_SACCRG( 11, 40) = 0.000000E+00
+ PKER_SACCRG( 12, 1) = 0.000000E+00
+ PKER_SACCRG( 12, 2) = 0.000000E+00
+ PKER_SACCRG( 12, 3) = 0.131525E-04
+ PKER_SACCRG( 12, 4) = 0.376734E-03
+ PKER_SACCRG( 12, 5) = 0.481352E-02
+ PKER_SACCRG( 12, 6) = 0.318057E-02
+ PKER_SACCRG( 12, 7) = 0.345470E-02
+ PKER_SACCRG( 12, 8) = 0.420666E-02
+ PKER_SACCRG( 12, 9) = 0.383001E-02
+ PKER_SACCRG( 12, 10) = 0.110848E-01
+ PKER_SACCRG( 12, 11) = 0.934829E-02
+ PKER_SACCRG( 12, 12) = 0.183949E-01
+ PKER_SACCRG( 12, 13) = 0.295675E-01
+ PKER_SACCRG( 12, 14) = 0.470543E-01
+ PKER_SACCRG( 12, 15) = 0.695886E-01
+ PKER_SACCRG( 12, 16) = 0.122527E+00
+ PKER_SACCRG( 12, 17) = 0.181754E+00
+ PKER_SACCRG( 12, 18) = 0.253508E+00
+ PKER_SACCRG( 12, 19) = 0.304324E+00
+ PKER_SACCRG( 12, 20) = 0.342444E+00
+ PKER_SACCRG( 12, 21) = 0.363399E+00
+ PKER_SACCRG( 12, 22) = 0.384221E+00
+ PKER_SACCRG( 12, 23) = 0.406941E+00
+ PKER_SACCRG( 12, 24) = 0.441951E+00
+ PKER_SACCRG( 12, 25) = 0.474892E+00
+ PKER_SACCRG( 12, 26) = 0.509393E+00
+ PKER_SACCRG( 12, 27) = 0.545053E+00
+ PKER_SACCRG( 12, 28) = 0.566107E+00
+ PKER_SACCRG( 12, 29) = 0.588592E+00
+ PKER_SACCRG( 12, 30) = 0.613355E+00
+ PKER_SACCRG( 12, 31) = 0.628544E+00
+ PKER_SACCRG( 12, 32) = 0.638273E+00
+ PKER_SACCRG( 12, 33) = 0.646003E+00
+ PKER_SACCRG( 12, 34) = 0.647602E+00
+ PKER_SACCRG( 12, 35) = 0.653888E+00
+ PKER_SACCRG( 12, 36) = 0.667119E+00
+ PKER_SACCRG( 12, 37) = 0.000000E+00
+ PKER_SACCRG( 12, 38) = 0.000000E+00
+ PKER_SACCRG( 12, 39) = 0.000000E+00
+ PKER_SACCRG( 12, 40) = 0.000000E+00
+ PKER_SACCRG( 13, 1) = 0.000000E+00
+ PKER_SACCRG( 13, 2) = 0.000000E+00
+ PKER_SACCRG( 13, 3) = 0.715754E-07
+ PKER_SACCRG( 13, 4) = 0.213213E-04
+ PKER_SACCRG( 13, 5) = 0.638125E-03
+ PKER_SACCRG( 13, 6) = 0.842445E-03
+ PKER_SACCRG( 13, 7) = 0.719221E-02
+ PKER_SACCRG( 13, 8) = 0.932081E-02
+ PKER_SACCRG( 13, 9) = 0.442957E-02
+ PKER_SACCRG( 13, 10) = 0.154869E-01
+ PKER_SACCRG( 13, 11) = 0.137909E-01
+ PKER_SACCRG( 13, 12) = 0.248513E-01
+ PKER_SACCRG( 13, 13) = 0.394496E-01
+ PKER_SACCRG( 13, 14) = 0.513911E-01
+ PKER_SACCRG( 13, 15) = 0.661668E-01
+ PKER_SACCRG( 13, 16) = 0.115529E+00
+ PKER_SACCRG( 13, 17) = 0.166381E+00
+ PKER_SACCRG( 13, 18) = 0.234091E+00
+ PKER_SACCRG( 13, 19) = 0.276281E+00
+ PKER_SACCRG( 13, 20) = 0.304686E+00
+ PKER_SACCRG( 13, 21) = 0.307989E+00
+ PKER_SACCRG( 13, 22) = 0.307891E+00
+ PKER_SACCRG( 13, 23) = 0.310412E+00
+ PKER_SACCRG( 13, 24) = 0.323293E+00
+ PKER_SACCRG( 13, 25) = 0.338766E+00
+ PKER_SACCRG( 13, 26) = 0.358236E+00
+ PKER_SACCRG( 13, 27) = 0.380952E+00
+ PKER_SACCRG( 13, 28) = 0.395254E+00
+ PKER_SACCRG( 13, 29) = 0.411396E+00
+ PKER_SACCRG( 13, 30) = 0.429868E+00
+ PKER_SACCRG( 13, 31) = 0.441480E+00
+ PKER_SACCRG( 13, 32) = 0.449014E+00
+ PKER_SACCRG( 13, 33) = 0.455042E+00
+ PKER_SACCRG( 13, 34) = 0.456301E+00
+ PKER_SACCRG( 13, 35) = 0.461238E+00
+ PKER_SACCRG( 13, 36) = 0.471725E+00
+ PKER_SACCRG( 13, 37) = 0.000000E+00
+ PKER_SACCRG( 13, 38) = 0.000000E+00
+ PKER_SACCRG( 13, 39) = 0.000000E+00
+ PKER_SACCRG( 13, 40) = 0.000000E+00
+ PKER_SACCRG( 14, 1) = 0.000000E+00
+ PKER_SACCRG( 14, 2) = 0.000000E+00
+ PKER_SACCRG( 14, 3) = 0.000000E+00
+ PKER_SACCRG( 14, 4) = 0.381946E-06
+ PKER_SACCRG( 14, 5) = 0.473573E-04
+ PKER_SACCRG( 14, 6) = 0.165120E-02
+ PKER_SACCRG( 14, 7) = 0.389733E-02
+ PKER_SACCRG( 14, 8) = 0.389488E-01
+ PKER_SACCRG( 14, 9) = 0.960356E-02
+ PKER_SACCRG( 14, 10) = 0.289006E-01
+ PKER_SACCRG( 14, 11) = 0.219911E-01
+ PKER_SACCRG( 14, 12) = 0.526837E-01
+ PKER_SACCRG( 14, 13) = 0.654887E-01
+ PKER_SACCRG( 14, 14) = 0.683643E-01
+ PKER_SACCRG( 14, 15) = 0.802145E-01
+ PKER_SACCRG( 14, 16) = 0.134652E+00
+ PKER_SACCRG( 14, 17) = 0.180678E+00
+ PKER_SACCRG( 14, 18) = 0.248857E+00
+ PKER_SACCRG( 14, 19) = 0.287693E+00
+ PKER_SACCRG( 14, 20) = 0.311977E+00
+ PKER_SACCRG( 14, 21) = 0.302501E+00
+ PKER_SACCRG( 14, 22) = 0.285666E+00
+ PKER_SACCRG( 14, 23) = 0.270663E+00
+ PKER_SACCRG( 14, 24) = 0.263508E+00
+ PKER_SACCRG( 14, 25) = 0.261858E+00
+ PKER_SACCRG( 14, 26) = 0.265704E+00
+ PKER_SACCRG( 14, 27) = 0.274260E+00
+ PKER_SACCRG( 14, 28) = 0.280343E+00
+ PKER_SACCRG( 14, 29) = 0.288745E+00
+ PKER_SACCRG( 14, 30) = 0.299555E+00
+ PKER_SACCRG( 14, 31) = 0.306742E+00
+ PKER_SACCRG( 14, 32) = 0.311519E+00
+ PKER_SACCRG( 14, 33) = 0.315446E+00
+ PKER_SACCRG( 14, 34) = 0.316143E+00
+ PKER_SACCRG( 14, 35) = 0.319453E+00
+ PKER_SACCRG( 14, 36) = 0.326846E+00
+ PKER_SACCRG( 14, 37) = 0.000000E+00
+ PKER_SACCRG( 14, 38) = 0.000000E+00
+ PKER_SACCRG( 14, 39) = 0.000000E+00
+ PKER_SACCRG( 14, 40) = 0.000000E+00
+ PKER_SACCRG( 15, 1) = 0.000000E+00
+ PKER_SACCRG( 15, 2) = 0.000000E+00
+ PKER_SACCRG( 15, 3) = 0.000000E+00
+ PKER_SACCRG( 15, 4) = 0.000000E+00
+ PKER_SACCRG( 15, 5) = 0.156840E-05
+ PKER_SACCRG( 15, 6) = 0.190758E-03
+ PKER_SACCRG( 15, 7) = 0.213304E-01
+ PKER_SACCRG( 15, 8) = 0.441574E-01
+ PKER_SACCRG( 15, 9) = 0.400468E-01
+ PKER_SACCRG( 15, 10) = 0.704682E-01
+ PKER_SACCRG( 15, 11) = 0.469944E-01
+ PKER_SACCRG( 15, 12) = 0.981183E-01
+ PKER_SACCRG( 15, 13) = 0.100527E+00
+ PKER_SACCRG( 15, 14) = 0.109911E+00
+ PKER_SACCRG( 15, 15) = 0.122766E+00
+ PKER_SACCRG( 15, 16) = 0.166781E+00
+ PKER_SACCRG( 15, 17) = 0.213821E+00
+ PKER_SACCRG( 15, 18) = 0.285192E+00
+ PKER_SACCRG( 15, 19) = 0.323590E+00
+ PKER_SACCRG( 15, 20) = 0.348069E+00
+ PKER_SACCRG( 15, 21) = 0.330921E+00
+ PKER_SACCRG( 15, 22) = 0.302486E+00
+ PKER_SACCRG( 15, 23) = 0.274134E+00
+ PKER_SACCRG( 15, 24) = 0.250992E+00
+ PKER_SACCRG( 15, 25) = 0.234616E+00
+ PKER_SACCRG( 15, 26) = 0.224211E+00
+ PKER_SACCRG( 15, 27) = 0.219091E+00
+ PKER_SACCRG( 15, 28) = 0.216667E+00
+ PKER_SACCRG( 15, 29) = 0.216954E+00
+ PKER_SACCRG( 15, 30) = 0.219635E+00
+ PKER_SACCRG( 15, 31) = 0.221903E+00
+ PKER_SACCRG( 15, 32) = 0.223652E+00
+ PKER_SACCRG( 15, 33) = 0.225260E+00
+ PKER_SACCRG( 15, 34) = 0.225539E+00
+ PKER_SACCRG( 15, 35) = 0.227017E+00
+ PKER_SACCRG( 15, 36) = 0.230425E+00
+ PKER_SACCRG( 15, 37) = 0.000000E+00
+ PKER_SACCRG( 15, 38) = 0.000000E+00
+ PKER_SACCRG( 15, 39) = 0.000000E+00
+ PKER_SACCRG( 15, 40) = 0.000000E+00
+ PKER_SACCRG( 16, 1) = 0.000000E+00
+ PKER_SACCRG( 16, 2) = 0.000000E+00
+ PKER_SACCRG( 16, 3) = 0.000000E+00
+ PKER_SACCRG( 16, 4) = 0.000000E+00
+ PKER_SACCRG( 16, 5) = 0.000000E+00
+ PKER_SACCRG( 16, 6) = 0.119071E-04
+ PKER_SACCRG( 16, 7) = 0.989929E-02
+ PKER_SACCRG( 16, 8) = 0.528890E+00
+ PKER_SACCRG( 16, 9) = 0.450696E-01
+ PKER_SACCRG( 16, 10) = 0.655297E-01
+ PKER_SACCRG( 16, 11) = 0.132187E+00
+ PKER_SACCRG( 16, 12) = 0.215348E+00
+ PKER_SACCRG( 16, 13) = 0.167588E+00
+ PKER_SACCRG( 16, 14) = 0.216205E+00
+ PKER_SACCRG( 16, 15) = 0.162196E+00
+ PKER_SACCRG( 16, 16) = 0.244005E+00
+ PKER_SACCRG( 16, 17) = 0.269648E+00
+ PKER_SACCRG( 16, 18) = 0.340900E+00
+ PKER_SACCRG( 16, 19) = 0.372264E+00
+ PKER_SACCRG( 16, 20) = 0.398617E+00
+ PKER_SACCRG( 16, 21) = 0.377733E+00
+ PKER_SACCRG( 16, 22) = 0.342874E+00
+ PKER_SACCRG( 16, 23) = 0.305984E+00
+ PKER_SACCRG( 16, 24) = 0.271888E+00
+ PKER_SACCRG( 16, 25) = 0.244614E+00
+ PKER_SACCRG( 16, 26) = 0.222952E+00
+ PKER_SACCRG( 16, 27) = 0.206393E+00
+ PKER_SACCRG( 16, 28) = 0.196281E+00
+ PKER_SACCRG( 16, 29) = 0.189043E+00
+ PKER_SACCRG( 16, 30) = 0.183996E+00
+ PKER_SACCRG( 16, 31) = 0.181421E+00
+ PKER_SACCRG( 16, 32) = 0.180072E+00
+ PKER_SACCRG( 16, 33) = 0.179344E+00
+ PKER_SACCRG( 16, 34) = 0.178990E+00
+ PKER_SACCRG( 16, 35) = 0.178753E+00
+ PKER_SACCRG( 16, 36) = 0.178876E+00
+ PKER_SACCRG( 16, 37) = 0.000000E+00
+ PKER_SACCRG( 16, 38) = 0.000000E+00
+ PKER_SACCRG( 16, 39) = 0.000000E+00
+ PKER_SACCRG( 16, 40) = 0.000000E+00
+ PKER_SACCRG( 17, 1) = 0.000000E+00
+ PKER_SACCRG( 17, 2) = 0.000000E+00
+ PKER_SACCRG( 17, 3) = 0.000000E+00
+ PKER_SACCRG( 17, 4) = 0.000000E+00
+ PKER_SACCRG( 17, 5) = 0.000000E+00
+ PKER_SACCRG( 17, 6) = 0.284464E-06
+ PKER_SACCRG( 17, 7) = 0.376463E-02
+ PKER_SACCRG( 17, 8) = 0.586668E+00
+ PKER_SACCRG( 17, 9) = 0.500034E-01
+ PKER_SACCRG( 17, 10) = 0.220639E+00
+ PKER_SACCRG( 17, 11) = 0.146258E+00
+ PKER_SACCRG( 17, 12) = 0.237708E+00
+ PKER_SACCRG( 17, 13) = 0.306782E+00
+ PKER_SACCRG( 17, 14) = 0.354063E+00
+ PKER_SACCRG( 17, 15) = 0.280860E+00
+ PKER_SACCRG( 17, 16) = 0.308089E+00
+ PKER_SACCRG( 17, 17) = 0.339505E+00
+ PKER_SACCRG( 17, 18) = 0.414880E+00
+ PKER_SACCRG( 17, 19) = 0.430629E+00
+ PKER_SACCRG( 17, 20) = 0.452781E+00
+ PKER_SACCRG( 17, 21) = 0.429564E+00
+ PKER_SACCRG( 17, 22) = 0.392080E+00
+ PKER_SACCRG( 17, 23) = 0.351048E+00
+ PKER_SACCRG( 17, 24) = 0.310955E+00
+ PKER_SACCRG( 17, 25) = 0.277207E+00
+ PKER_SACCRG( 17, 26) = 0.248275E+00
+ PKER_SACCRG( 17, 27) = 0.223790E+00
+ PKER_SACCRG( 17, 28) = 0.208062E+00
+ PKER_SACCRG( 17, 29) = 0.195017E+00
+ PKER_SACCRG( 17, 30) = 0.183624E+00
+ PKER_SACCRG( 17, 31) = 0.176886E+00
+ PKER_SACCRG( 17, 32) = 0.172790E+00
+ PKER_SACCRG( 17, 33) = 0.169882E+00
+ PKER_SACCRG( 17, 34) = 0.169010E+00
+ PKER_SACCRG( 17, 35) = 0.166994E+00
+ PKER_SACCRG( 17, 36) = 0.163299E+00
+ PKER_SACCRG( 17, 37) = 0.000000E+00
+ PKER_SACCRG( 17, 38) = 0.000000E+00
+ PKER_SACCRG( 17, 39) = 0.000000E+00
+ PKER_SACCRG( 17, 40) = 0.000000E+00
+ PKER_SACCRG( 18, 1) = 0.000000E+00
+ PKER_SACCRG( 18, 2) = 0.000000E+00
+ PKER_SACCRG( 18, 3) = 0.000000E+00
+ PKER_SACCRG( 18, 4) = 0.000000E+00
+ PKER_SACCRG( 18, 5) = 0.000000E+00
+ PKER_SACCRG( 18, 6) = 0.000000E+00
+ PKER_SACCRG( 18, 7) = 0.105382E-02
+ PKER_SACCRG( 18, 8) = 0.635938E+00
+ PKER_SACCRG( 18, 9) = 0.581236E+00
+ PKER_SACCRG( 18, 10) = 0.175918E+00
+ PKER_SACCRG( 18, 11) = 0.158333E+00
+ PKER_SACCRG( 18, 12) = 0.645276E+00
+ PKER_SACCRG( 18, 13) = 0.647795E+00
+ PKER_SACCRG( 18, 14) = 0.383206E+00
+ PKER_SACCRG( 18, 15) = 0.415829E+00
+ PKER_SACCRG( 18, 16) = 0.392871E+00
+ PKER_SACCRG( 18, 17) = 0.447385E+00
+ PKER_SACCRG( 18, 18) = 0.473465E+00
+ PKER_SACCRG( 18, 19) = 0.487585E+00
+ PKER_SACCRG( 18, 20) = 0.505825E+00
+ PKER_SACCRG( 18, 21) = 0.478975E+00
+ PKER_SACCRG( 18, 22) = 0.440594E+00
+ PKER_SACCRG( 18, 23) = 0.398291E+00
+ PKER_SACCRG( 18, 24) = 0.355953E+00
+ PKER_SACCRG( 18, 25) = 0.319332E+00
+ PKER_SACCRG( 18, 26) = 0.286857E+00
+ PKER_SACCRG( 18, 27) = 0.258053E+00
+ PKER_SACCRG( 18, 28) = 0.239021E+00
+ PKER_SACCRG( 18, 29) = 0.222386E+00
+ PKER_SACCRG( 18, 30) = 0.206903E+00
+ PKER_SACCRG( 18, 31) = 0.197361E+00
+ PKER_SACCRG( 18, 32) = 0.191347E+00
+ PKER_SACCRG( 18, 33) = 0.186901E+00
+ PKER_SACCRG( 18, 34) = 0.185599E+00
+ PKER_SACCRG( 18, 35) = 0.182341E+00
+ PKER_SACCRG( 18, 36) = 0.176179E+00
+ PKER_SACCRG( 18, 37) = 0.000000E+00
+ PKER_SACCRG( 18, 38) = 0.000000E+00
+ PKER_SACCRG( 18, 39) = 0.000000E+00
+ PKER_SACCRG( 18, 40) = 0.000000E+00
+ PKER_SACCRG( 19, 1) = 0.000000E+00
+ PKER_SACCRG( 19, 2) = 0.000000E+00
+ PKER_SACCRG( 19, 3) = 0.000000E+00
+ PKER_SACCRG( 19, 4) = 0.000000E+00
+ PKER_SACCRG( 19, 5) = 0.000000E+00
+ PKER_SACCRG( 19, 6) = 0.000000E+00
+ PKER_SACCRG( 19, 7) = 0.194865E-03
+ PKER_SACCRG( 19, 8) = 0.676347E+00
+ PKER_SACCRG( 19, 9) = 0.621969E+00
+ PKER_SACCRG( 19, 10) = 0.131032E+00
+ PKER_SACCRG( 19, 11) = 0.658583E+00
+ PKER_SACCRG( 19, 12) = 0.685804E+00
+ PKER_SACCRG( 19, 13) = 0.688335E+00
+ PKER_SACCRG( 19, 14) = 0.677066E+00
+ PKER_SACCRG( 19, 15) = 0.442768E+00
+ PKER_SACCRG( 19, 16) = 0.511298E+00
+ PKER_SACCRG( 19, 17) = 0.544390E+00
+ PKER_SACCRG( 19, 18) = 0.574263E+00
+ PKER_SACCRG( 19, 19) = 0.551361E+00
+ PKER_SACCRG( 19, 20) = 0.554396E+00
+ PKER_SACCRG( 19, 21) = 0.521768E+00
+ PKER_SACCRG( 19, 22) = 0.483164E+00
+ PKER_SACCRG( 19, 23) = 0.440915E+00
+ PKER_SACCRG( 19, 24) = 0.398417E+00
+ PKER_SACCRG( 19, 25) = 0.361201E+00
+ PKER_SACCRG( 19, 26) = 0.327700E+00
+ PKER_SACCRG( 19, 27) = 0.297381E+00
+ PKER_SACCRG( 19, 28) = 0.276977E+00
+ PKER_SACCRG( 19, 29) = 0.258775E+00
+ PKER_SACCRG( 19, 30) = 0.241338E+00
+ PKER_SACCRG( 19, 31) = 0.230370E+00
+ PKER_SACCRG( 19, 32) = 0.223349E+00
+ PKER_SACCRG( 19, 33) = 0.218072E+00
+ PKER_SACCRG( 19, 34) = 0.216544E+00
+ PKER_SACCRG( 19, 35) = 0.212586E+00
+ PKER_SACCRG( 19, 36) = 0.204880E+00
+ PKER_SACCRG( 19, 37) = 0.000000E+00
+ PKER_SACCRG( 19, 38) = 0.000000E+00
+ PKER_SACCRG( 19, 39) = 0.000000E+00
+ PKER_SACCRG( 19, 40) = 0.000000E+00
+ PKER_SACCRG( 20, 1) = 0.000000E+00
+ PKER_SACCRG( 20, 2) = 0.000000E+00
+ PKER_SACCRG( 20, 3) = 0.000000E+00
+ PKER_SACCRG( 20, 4) = 0.000000E+00
+ PKER_SACCRG( 20, 5) = 0.000000E+00
+ PKER_SACCRG( 20, 6) = 0.000000E+00
+ PKER_SACCRG( 20, 7) = 0.210974E-04
+ PKER_SACCRG( 20, 8) = 0.709956E+00
+ PKER_SACCRG( 20, 9) = 0.655815E+00
+ PKER_SACCRG( 20, 10) = 0.956725E-01
+ PKER_SACCRG( 20, 11) = 0.692386E+00
+ PKER_SACCRG( 20, 12) = 0.719525E+00
+ PKER_SACCRG( 20, 13) = 0.722068E+00
+ PKER_SACCRG( 20, 14) = 0.710869E+00
+ PKER_SACCRG( 20, 15) = 0.691117E+00
+ PKER_SACCRG( 20, 16) = 0.690018E+00
+ PKER_SACCRG( 20, 17) = 0.573065E+00
+ PKER_SACCRG( 20, 18) = 0.605475E+00
+ PKER_SACCRG( 20, 19) = 0.604580E+00
+ PKER_SACCRG( 20, 20) = 0.595016E+00
+ PKER_SACCRG( 20, 21) = 0.559020E+00
+ PKER_SACCRG( 20, 22) = 0.519154E+00
+ PKER_SACCRG( 20, 23) = 0.477263E+00
+ PKER_SACCRG( 20, 24) = 0.435286E+00
+ PKER_SACCRG( 20, 25) = 0.398364E+00
+ PKER_SACCRG( 20, 26) = 0.364991E+00
+ PKER_SACCRG( 20, 27) = 0.334611E+00
+ PKER_SACCRG( 20, 28) = 0.313905E+00
+ PKER_SACCRG( 20, 29) = 0.295342E+00
+ PKER_SACCRG( 20, 30) = 0.277428E+00
+ PKER_SACCRG( 20, 31) = 0.266023E+00
+ PKER_SACCRG( 20, 32) = 0.258671E+00
+ PKER_SACCRG( 20, 33) = 0.253118E+00
+ PKER_SACCRG( 20, 34) = 0.251504E+00
+ PKER_SACCRG( 20, 35) = 0.247323E+00
+ PKER_SACCRG( 20, 36) = 0.239150E+00
+ PKER_SACCRG( 20, 37) = 0.000000E+00
+ PKER_SACCRG( 20, 38) = 0.000000E+00
+ PKER_SACCRG( 20, 39) = 0.000000E+00
+ PKER_SACCRG( 20, 40) = 0.000000E+00
+ PKER_SACCRG( 21, 1) = 0.000000E+00
+ PKER_SACCRG( 21, 2) = 0.000000E+00
+ PKER_SACCRG( 21, 3) = 0.000000E+00
+ PKER_SACCRG( 21, 4) = 0.000000E+00
+ PKER_SACCRG( 21, 5) = 0.000000E+00
+ PKER_SACCRG( 21, 6) = 0.000000E+00
+ PKER_SACCRG( 21, 7) = 0.115787E-05
+ PKER_SACCRG( 21, 8) = 0.737622E+00
+ PKER_SACCRG( 21, 9) = 0.683641E+00
+ PKER_SACCRG( 21, 10) = 0.742791E-01
+ PKER_SACCRG( 21, 11) = 0.720196E+00
+ PKER_SACCRG( 21, 12) = 0.747281E+00
+ PKER_SACCRG( 21, 13) = 0.749836E+00
+ PKER_SACCRG( 21, 14) = 0.738685E+00
+ PKER_SACCRG( 21, 15) = 0.719015E+00
+ PKER_SACCRG( 21, 16) = 0.717958E+00
+ PKER_SACCRG( 21, 17) = 0.702249E+00
+ PKER_SACCRG( 21, 18) = 0.688360E+00
+ PKER_SACCRG( 21, 19) = 0.631563E+00
+ PKER_SACCRG( 21, 20) = 0.632341E+00
+ PKER_SACCRG( 21, 21) = 0.589665E+00
+ PKER_SACCRG( 21, 22) = 0.548711E+00
+ PKER_SACCRG( 21, 23) = 0.507170E+00
+ PKER_SACCRG( 21, 24) = 0.465784E+00
+ PKER_SACCRG( 21, 25) = 0.429322E+00
+ PKER_SACCRG( 21, 26) = 0.396378E+00
+ PKER_SACCRG( 21, 27) = 0.366391E+00
+ PKER_SACCRG( 21, 28) = 0.345783E+00
+ PKER_SACCRG( 21, 29) = 0.327346E+00
+ PKER_SACCRG( 21, 30) = 0.309575E+00
+ PKER_SACCRG( 21, 31) = 0.298199E+00
+ PKER_SACCRG( 21, 32) = 0.290842E+00
+ PKER_SACCRG( 21, 33) = 0.285284E+00
+ PKER_SACCRG( 21, 34) = 0.283648E+00
+ PKER_SACCRG( 21, 35) = 0.279467E+00
+ PKER_SACCRG( 21, 36) = 0.271303E+00
+ PKER_SACCRG( 21, 37) = 0.000000E+00
+ PKER_SACCRG( 21, 38) = 0.000000E+00
+ PKER_SACCRG( 21, 39) = 0.000000E+00
+ PKER_SACCRG( 21, 40) = 0.000000E+00
+ PKER_SACCRG( 22, 1) = 0.000000E+00
+ PKER_SACCRG( 22, 2) = 0.000000E+00
+ PKER_SACCRG( 22, 3) = 0.000000E+00
+ PKER_SACCRG( 22, 4) = 0.000000E+00
+ PKER_SACCRG( 22, 5) = 0.000000E+00
+ PKER_SACCRG( 22, 6) = 0.000000E+00
+ PKER_SACCRG( 22, 7) = 0.153493E-07
+ PKER_SACCRG( 22, 8) = 0.760420E+00
+ PKER_SACCRG( 22, 9) = 0.706545E+00
+ PKER_SACCRG( 22, 10) = 0.650587E-01
+ PKER_SACCRG( 22, 11) = 0.743098E+00
+ PKER_SACCRG( 22, 12) = 0.770151E+00
+ PKER_SACCRG( 22, 13) = 0.772714E+00
+ PKER_SACCRG( 22, 14) = 0.761598E+00
+ PKER_SACCRG( 22, 15) = 0.741985E+00
+ PKER_SACCRG( 22, 16) = 0.740959E+00
+ PKER_SACCRG( 22, 17) = 0.725323E+00
+ PKER_SACCRG( 22, 18) = 0.711529E+00
+ PKER_SACCRG( 22, 19) = 0.653730E+00
+ PKER_SACCRG( 22, 20) = 0.655849E+00
+ PKER_SACCRG( 22, 21) = 0.613326E+00
+ PKER_SACCRG( 22, 22) = 0.573001E+00
+ PKER_SACCRG( 22, 23) = 0.531612E+00
+ PKER_SACCRG( 22, 24) = 0.490679E+00
+ PKER_SACCRG( 22, 25) = 0.454592E+00
+ PKER_SACCRG( 22, 26) = 0.422026E+00
+ PKER_SACCRG( 22, 27) = 0.392436E+00
+ PKER_SACCRG( 22, 28) = 0.371968E+00
+ PKER_SACCRG( 22, 29) = 0.353731E+00
+ PKER_SACCRG( 22, 30) = 0.336228E+00
+ PKER_SACCRG( 22, 31) = 0.324990E+00
+ PKER_SACCRG( 22, 32) = 0.317714E+00
+ PKER_SACCRG( 22, 33) = 0.312229E+00
+ PKER_SACCRG( 22, 34) = 0.310590E+00
+ PKER_SACCRG( 22, 35) = 0.306480E+00
+ PKER_SACCRG( 22, 36) = 0.298487E+00
+ PKER_SACCRG( 22, 37) = 0.000000E+00
+ PKER_SACCRG( 22, 38) = 0.000000E+00
+ PKER_SACCRG( 22, 39) = 0.000000E+00
+ PKER_SACCRG( 22, 40) = 0.000000E+00
+ PKER_SACCRG( 23, 1) = 0.000000E+00
+ PKER_SACCRG( 23, 2) = 0.000000E+00
+ PKER_SACCRG( 23, 3) = 0.000000E+00
+ PKER_SACCRG( 23, 4) = 0.000000E+00
+ PKER_SACCRG( 23, 5) = 0.000000E+00
+ PKER_SACCRG( 23, 6) = 0.000000E+00
+ PKER_SACCRG( 23, 7) = 0.000000E+00
+ PKER_SACCRG( 23, 8) = 0.779223E+00
+ PKER_SACCRG( 23, 9) = 0.725418E+00
+ PKER_SACCRG( 23, 10) = 0.629066E-01
+ PKER_SACCRG( 23, 11) = 0.761978E+00
+ PKER_SACCRG( 23, 12) = 0.789011E+00
+ PKER_SACCRG( 23, 13) = 0.791581E+00
+ PKER_SACCRG( 23, 14) = 0.780490E+00
+ PKER_SACCRG( 23, 15) = 0.760916E+00
+ PKER_SACCRG( 23, 16) = 0.759915E+00
+ PKER_SACCRG( 23, 17) = 0.744331E+00
+ PKER_SACCRG( 23, 18) = 0.730605E+00
+ PKER_SACCRG( 23, 19) = 0.703564E+00
+ PKER_SACCRG( 23, 20) = 0.675170E+00
+ PKER_SACCRG( 23, 21) = 0.632741E+00
+ PKER_SACCRG( 23, 22) = 0.592686E+00
+ PKER_SACCRG( 23, 23) = 0.551579E+00
+ PKER_SACCRG( 23, 24) = 0.510978E+00
+ PKER_SACCRG( 23, 25) = 0.475153E+00
+ PKER_SACCRG( 23, 26) = 0.442855E+00
+ PKER_SACCRG( 23, 27) = 0.413554E+00
+ PKER_SACCRG( 23, 28) = 0.393180E+00
+ PKER_SACCRG( 23, 29) = 0.375093E+00
+ PKER_SACCRG( 23, 30) = 0.357805E+00
+ PKER_SACCRG( 23, 31) = 0.346682E+00
+ PKER_SACCRG( 23, 32) = 0.339475E+00
+ PKER_SACCRG( 23, 33) = 0.334055E+00
+ PKER_SACCRG( 23, 34) = 0.332413E+00
+ PKER_SACCRG( 23, 35) = 0.328367E+00
+ PKER_SACCRG( 23, 36) = 0.320537E+00
+ PKER_SACCRG( 23, 37) = 0.000000E+00
+ PKER_SACCRG( 23, 38) = 0.000000E+00
+ PKER_SACCRG( 23, 39) = 0.000000E+00
+ PKER_SACCRG( 23, 40) = 0.000000E+00
+ PKER_SACCRG( 24, 1) = 0.000000E+00
+ PKER_SACCRG( 24, 2) = 0.000000E+00
+ PKER_SACCRG( 24, 3) = 0.000000E+00
+ PKER_SACCRG( 24, 4) = 0.000000E+00
+ PKER_SACCRG( 24, 5) = 0.000000E+00
+ PKER_SACCRG( 24, 6) = 0.000000E+00
+ PKER_SACCRG( 24, 7) = 0.000000E+00
+ PKER_SACCRG( 24, 8) = 0.794744E+00
+ PKER_SACCRG( 24, 9) = 0.740984E+00
+ PKER_SACCRG( 24, 10) = 0.633801E-01
+ PKER_SACCRG( 24, 11) = 0.777556E+00
+ PKER_SACCRG( 24, 12) = 0.804576E+00
+ PKER_SACCRG( 24, 13) = 0.807152E+00
+ PKER_SACCRG( 24, 14) = 0.796079E+00
+ PKER_SACCRG( 24, 15) = 0.776533E+00
+ PKER_SACCRG( 24, 16) = 0.775550E+00
+ PKER_SACCRG( 24, 17) = 0.760004E+00
+ PKER_SACCRG( 24, 18) = 0.746329E+00
+ PKER_SACCRG( 24, 19) = 0.719365E+00
+ PKER_SACCRG( 24, 20) = 0.691070E+00
+ PKER_SACCRG( 24, 21) = 0.651450E+00
+ PKER_SACCRG( 24, 22) = 0.608840E+00
+ PKER_SACCRG( 24, 23) = 0.567932E+00
+ PKER_SACCRG( 24, 24) = 0.527565E+00
+ PKER_SACCRG( 24, 25) = 0.491917E+00
+ PKER_SACCRG( 24, 26) = 0.459798E+00
+ PKER_SACCRG( 24, 27) = 0.430691E+00
+ PKER_SACCRG( 24, 28) = 0.410367E+00
+ PKER_SACCRG( 24, 29) = 0.392372E+00
+ PKER_SACCRG( 24, 30) = 0.375227E+00
+ PKER_SACCRG( 24, 31) = 0.364178E+00
+ PKER_SACCRG( 24, 32) = 0.357015E+00
+ PKER_SACCRG( 24, 33) = 0.351637E+00
+ PKER_SACCRG( 24, 34) = 0.349989E+00
+ PKER_SACCRG( 24, 35) = 0.345989E+00
+ PKER_SACCRG( 24, 36) = 0.338276E+00
+ PKER_SACCRG( 24, 37) = 0.000000E+00
+ PKER_SACCRG( 24, 38) = 0.000000E+00
+ PKER_SACCRG( 24, 39) = 0.000000E+00
+ PKER_SACCRG( 24, 40) = 0.000000E+00
+ PKER_SACCRG( 25, 1) = 0.000000E+00
+ PKER_SACCRG( 25, 2) = 0.000000E+00
+ PKER_SACCRG( 25, 3) = 0.000000E+00
+ PKER_SACCRG( 25, 4) = 0.000000E+00
+ PKER_SACCRG( 25, 5) = 0.000000E+00
+ PKER_SACCRG( 25, 6) = 0.000000E+00
+ PKER_SACCRG( 25, 7) = 0.000000E+00
+ PKER_SACCRG( 25, 8) = 0.807563E+00
+ PKER_SACCRG( 25, 9) = 0.753833E+00
+ PKER_SACCRG( 25, 10) = 0.643394E-01
+ PKER_SACCRG( 25, 11) = 0.790417E+00
+ PKER_SACCRG( 25, 12) = 0.817430E+00
+ PKER_SACCRG( 25, 13) = 0.820012E+00
+ PKER_SACCRG( 25, 14) = 0.808951E+00
+ PKER_SACCRG( 25, 15) = 0.789425E+00
+ PKER_SACCRG( 25, 16) = 0.788455E+00
+ PKER_SACCRG( 25, 17) = 0.772937E+00
+ PKER_SACCRG( 25, 18) = 0.759299E+00
+ PKER_SACCRG( 25, 19) = 0.732392E+00
+ PKER_SACCRG( 25, 20) = 0.704169E+00
+ PKER_SACCRG( 25, 21) = 0.664647E+00
+ PKER_SACCRG( 25, 22) = 0.622123E+00
+ PKER_SACCRG( 25, 23) = 0.581352E+00
+ PKER_SACCRG( 25, 24) = 0.541148E+00
+ PKER_SACCRG( 25, 25) = 0.505619E+00
+ PKER_SACCRG( 25, 26) = 0.473619E+00
+ PKER_SACCRG( 25, 27) = 0.444639E+00
+ PKER_SACCRG( 25, 28) = 0.424336E+00
+ PKER_SACCRG( 25, 29) = 0.406394E+00
+ PKER_SACCRG( 25, 30) = 0.389340E+00
+ PKER_SACCRG( 25, 31) = 0.378332E+00
+ PKER_SACCRG( 25, 32) = 0.371193E+00
+ PKER_SACCRG( 25, 33) = 0.365840E+00
+ PKER_SACCRG( 25, 34) = 0.364185E+00
+ PKER_SACCRG( 25, 35) = 0.360213E+00
+ PKER_SACCRG( 25, 36) = 0.352580E+00
+ PKER_SACCRG( 25, 37) = 0.000000E+00
+ PKER_SACCRG( 25, 38) = 0.000000E+00
+ PKER_SACCRG( 25, 39) = 0.000000E+00
+ PKER_SACCRG( 25, 40) = 0.000000E+00
+ PKER_SACCRG( 26, 1) = 0.000000E+00
+ PKER_SACCRG( 26, 2) = 0.000000E+00
+ PKER_SACCRG( 26, 3) = 0.000000E+00
+ PKER_SACCRG( 26, 4) = 0.000000E+00
+ PKER_SACCRG( 26, 5) = 0.000000E+00
+ PKER_SACCRG( 26, 6) = 0.000000E+00
+ PKER_SACCRG( 26, 7) = 0.000000E+00
+ PKER_SACCRG( 26, 8) = 0.818155E+00
+ PKER_SACCRG( 26, 9) = 0.764445E+00
+ PKER_SACCRG( 26, 10) = 0.652138E-01
+ PKER_SACCRG( 26, 11) = 0.801042E+00
+ PKER_SACCRG( 26, 12) = 0.828051E+00
+ PKER_SACCRG( 26, 13) = 0.830636E+00
+ PKER_SACCRG( 26, 14) = 0.819585E+00
+ PKER_SACCRG( 26, 15) = 0.800072E+00
+ PKER_SACCRG( 26, 16) = 0.799113E+00
+ PKER_SACCRG( 26, 17) = 0.783616E+00
+ PKER_SACCRG( 26, 18) = 0.770006E+00
+ PKER_SACCRG( 26, 19) = 0.743140E+00
+ PKER_SACCRG( 26, 20) = 0.714971E+00
+ PKER_SACCRG( 26, 21) = 0.675519E+00
+ PKER_SACCRG( 26, 22) = 0.633061E+00
+ PKER_SACCRG( 26, 23) = 0.592381E+00
+ PKER_SACCRG( 26, 24) = 0.552293E+00
+ PKER_SACCRG( 26, 25) = 0.516845E+00
+ PKER_SACCRG( 26, 26) = 0.484922E+00
+ PKER_SACCRG( 26, 27) = 0.456026E+00
+ PKER_SACCRG( 26, 28) = 0.435725E+00
+ PKER_SACCRG( 26, 29) = 0.417811E+00
+ PKER_SACCRG( 26, 30) = 0.400812E+00
+ PKER_SACCRG( 26, 31) = 0.389826E+00
+ PKER_SACCRG( 26, 32) = 0.382698E+00
+ PKER_SACCRG( 26, 33) = 0.377358E+00
+ PKER_SACCRG( 26, 34) = 0.375696E+00
+ PKER_SACCRG( 26, 35) = 0.371742E+00
+ PKER_SACCRG( 26, 36) = 0.364161E+00
+ PKER_SACCRG( 26, 37) = 0.000000E+00
+ PKER_SACCRG( 26, 38) = 0.000000E+00
+ PKER_SACCRG( 26, 39) = 0.000000E+00
+ PKER_SACCRG( 26, 40) = 0.000000E+00
+ PKER_SACCRG( 27, 1) = 0.000000E+00
+ PKER_SACCRG( 27, 2) = 0.000000E+00
+ PKER_SACCRG( 27, 3) = 0.000000E+00
+ PKER_SACCRG( 27, 4) = 0.000000E+00
+ PKER_SACCRG( 27, 5) = 0.000000E+00
+ PKER_SACCRG( 27, 6) = 0.000000E+00
+ PKER_SACCRG( 27, 7) = 0.000000E+00
+ PKER_SACCRG( 27, 8) = 0.826912E+00
+ PKER_SACCRG( 27, 9) = 0.773214E+00
+ PKER_SACCRG( 27, 10) = 0.722825E+00
+ PKER_SACCRG( 27, 11) = 0.809822E+00
+ PKER_SACCRG( 27, 12) = 0.836829E+00
+ PKER_SACCRG( 27, 13) = 0.839417E+00
+ PKER_SACCRG( 27, 14) = 0.828373E+00
+ PKER_SACCRG( 27, 15) = 0.808870E+00
+ PKER_SACCRG( 27, 16) = 0.807920E+00
+ PKER_SACCRG( 27, 17) = 0.792438E+00
+ PKER_SACCRG( 27, 18) = 0.778848E+00
+ PKER_SACCRG( 27, 19) = 0.752014E+00
+ PKER_SACCRG( 27, 20) = 0.723884E+00
+ PKER_SACCRG( 27, 21) = 0.684484E+00
+ PKER_SACCRG( 27, 22) = 0.642077E+00
+ PKER_SACCRG( 27, 23) = 0.601458E+00
+ PKER_SACCRG( 27, 24) = 0.561451E+00
+ PKER_SACCRG( 27, 25) = 0.526058E+00
+ PKER_SACCRG( 27, 26) = 0.494186E+00
+ PKER_SACCRG( 27, 27) = 0.465344E+00
+ PKER_SACCRG( 27, 28) = 0.445036E+00
+ PKER_SACCRG( 27, 29) = 0.427133E+00
+ PKER_SACCRG( 27, 30) = 0.410167E+00
+ PKER_SACCRG( 27, 31) = 0.399191E+00
+ PKER_SACCRG( 27, 32) = 0.392065E+00
+ PKER_SACCRG( 27, 33) = 0.386731E+00
+ PKER_SACCRG( 27, 34) = 0.385063E+00
+ PKER_SACCRG( 27, 35) = 0.381119E+00
+ PKER_SACCRG( 27, 36) = 0.373572E+00
+ PKER_SACCRG( 27, 37) = 0.000000E+00
+ PKER_SACCRG( 27, 38) = 0.000000E+00
+ PKER_SACCRG( 27, 39) = 0.000000E+00
+ PKER_SACCRG( 27, 40) = 0.000000E+00
+ PKER_SACCRG( 28, 1) = 0.000000E+00
+ PKER_SACCRG( 28, 2) = 0.000000E+00
+ PKER_SACCRG( 28, 3) = 0.000000E+00
+ PKER_SACCRG( 28, 4) = 0.000000E+00
+ PKER_SACCRG( 28, 5) = 0.000000E+00
+ PKER_SACCRG( 28, 6) = 0.000000E+00
+ PKER_SACCRG( 28, 7) = 0.000000E+00
+ PKER_SACCRG( 28, 8) = 0.834152E+00
+ PKER_SACCRG( 28, 9) = 0.780463E+00
+ PKER_SACCRG( 28, 10) = 0.730085E+00
+ PKER_SACCRG( 28, 11) = 0.817081E+00
+ PKER_SACCRG( 28, 12) = 0.844087E+00
+ PKER_SACCRG( 28, 13) = 0.846678E+00
+ PKER_SACCRG( 28, 14) = 0.835638E+00
+ PKER_SACCRG( 28, 15) = 0.816143E+00
+ PKER_SACCRG( 28, 16) = 0.815199E+00
+ PKER_SACCRG( 28, 17) = 0.799728E+00
+ PKER_SACCRG( 28, 18) = 0.786155E+00
+ PKER_SACCRG( 28, 19) = 0.759343E+00
+ PKER_SACCRG( 28, 20) = 0.731242E+00
+ PKER_SACCRG( 28, 21) = 0.691881E+00
+ PKER_SACCRG( 28, 22) = 0.649512E+00
+ PKER_SACCRG( 28, 23) = 0.608935E+00
+ PKER_SACCRG( 28, 24) = 0.568988E+00
+ PKER_SACCRG( 28, 25) = 0.533631E+00
+ PKER_SACCRG( 28, 26) = 0.501792E+00
+ PKER_SACCRG( 28, 27) = 0.472984E+00
+ PKER_SACCRG( 28, 28) = 0.452665E+00
+ PKER_SACCRG( 28, 29) = 0.434765E+00
+ PKER_SACCRG( 28, 30) = 0.417816E+00
+ PKER_SACCRG( 28, 31) = 0.406842E+00
+ PKER_SACCRG( 28, 32) = 0.399715E+00
+ PKER_SACCRG( 28, 33) = 0.394383E+00
+ PKER_SACCRG( 28, 34) = 0.392708E+00
+ PKER_SACCRG( 28, 35) = 0.388770E+00
+ PKER_SACCRG( 28, 36) = 0.381244E+00
+ PKER_SACCRG( 28, 37) = 0.000000E+00
+ PKER_SACCRG( 28, 38) = 0.000000E+00
+ PKER_SACCRG( 28, 39) = 0.000000E+00
+ PKER_SACCRG( 28, 40) = 0.000000E+00
+ PKER_SACCRG( 29, 1) = 0.000000E+00
+ PKER_SACCRG( 29, 2) = 0.000000E+00
+ PKER_SACCRG( 29, 3) = 0.000000E+00
+ PKER_SACCRG( 29, 4) = 0.000000E+00
+ PKER_SACCRG( 29, 5) = 0.000000E+00
+ PKER_SACCRG( 29, 6) = 0.000000E+00
+ PKER_SACCRG( 29, 7) = 0.000000E+00
+ PKER_SACCRG( 29, 8) = 0.840140E+00
+ PKER_SACCRG( 29, 9) = 0.786456E+00
+ PKER_SACCRG( 29, 10) = 0.736085E+00
+ PKER_SACCRG( 29, 11) = 0.823083E+00
+ PKER_SACCRG( 29, 12) = 0.850089E+00
+ PKER_SACCRG( 29, 13) = 0.852682E+00
+ PKER_SACCRG( 29, 14) = 0.841646E+00
+ PKER_SACCRG( 29, 15) = 0.822156E+00
+ PKER_SACCRG( 29, 16) = 0.821217E+00
+ PKER_SACCRG( 29, 17) = 0.805755E+00
+ PKER_SACCRG( 29, 18) = 0.792194E+00
+ PKER_SACCRG( 29, 19) = 0.765399E+00
+ PKER_SACCRG( 29, 20) = 0.737321E+00
+ PKER_SACCRG( 29, 21) = 0.697987E+00
+ PKER_SACCRG( 29, 22) = 0.655647E+00
+ PKER_SACCRG( 29, 23) = 0.615100E+00
+ PKER_SACCRG( 29, 24) = 0.575195E+00
+ PKER_SACCRG( 29, 25) = 0.539863E+00
+ PKER_SACCRG( 29, 26) = 0.508047E+00
+ PKER_SACCRG( 29, 27) = 0.479260E+00
+ PKER_SACCRG( 29, 28) = 0.458928E+00
+ PKER_SACCRG( 29, 29) = 0.441026E+00
+ PKER_SACCRG( 29, 30) = 0.424085E+00
+ PKER_SACCRG( 29, 31) = 0.413109E+00
+ PKER_SACCRG( 29, 32) = 0.405979E+00
+ PKER_SACCRG( 29, 33) = 0.400646E+00
+ PKER_SACCRG( 29, 34) = 0.398965E+00
+ PKER_SACCRG( 29, 35) = 0.395030E+00
+ PKER_SACCRG( 29, 36) = 0.387518E+00
+ PKER_SACCRG( 29, 37) = 0.000000E+00
+ PKER_SACCRG( 29, 38) = 0.000000E+00
+ PKER_SACCRG( 29, 39) = 0.000000E+00
+ PKER_SACCRG( 29, 40) = 0.000000E+00
+ PKER_SACCRG( 30, 1) = 0.000000E+00
+ PKER_SACCRG( 30, 2) = 0.000000E+00
+ PKER_SACCRG( 30, 3) = 0.000000E+00
+ PKER_SACCRG( 30, 4) = 0.000000E+00
+ PKER_SACCRG( 30, 5) = 0.000000E+00
+ PKER_SACCRG( 30, 6) = 0.000000E+00
+ PKER_SACCRG( 30, 7) = 0.000000E+00
+ PKER_SACCRG( 30, 8) = 0.845094E+00
+ PKER_SACCRG( 30, 9) = 0.791414E+00
+ PKER_SACCRG( 30, 10) = 0.741047E+00
+ PKER_SACCRG( 30, 11) = 0.828048E+00
+ PKER_SACCRG( 30, 12) = 0.855054E+00
+ PKER_SACCRG( 30, 13) = 0.857648E+00
+ PKER_SACCRG( 30, 14) = 0.846615E+00
+ PKER_SACCRG( 30, 15) = 0.827129E+00
+ PKER_SACCRG( 30, 16) = 0.826194E+00
+ PKER_SACCRG( 30, 17) = 0.810738E+00
+ PKER_SACCRG( 30, 18) = 0.797187E+00
+ PKER_SACCRG( 30, 19) = 0.770405E+00
+ PKER_SACCRG( 30, 20) = 0.742343E+00
+ PKER_SACCRG( 30, 21) = 0.703031E+00
+ PKER_SACCRG( 30, 22) = 0.660711E+00
+ PKER_SACCRG( 30, 23) = 0.620186E+00
+ PKER_SACCRG( 30, 24) = 0.580313E+00
+ PKER_SACCRG( 30, 25) = 0.544997E+00
+ PKER_SACCRG( 30, 26) = 0.513195E+00
+ PKER_SACCRG( 30, 27) = 0.484422E+00
+ PKER_SACCRG( 30, 28) = 0.464077E+00
+ PKER_SACCRG( 30, 29) = 0.446170E+00
+ PKER_SACCRG( 30, 30) = 0.429233E+00
+ PKER_SACCRG( 30, 31) = 0.418253E+00
+ PKER_SACCRG( 30, 32) = 0.411117E+00
+ PKER_SACCRG( 30, 33) = 0.405783E+00
+ PKER_SACCRG( 30, 34) = 0.404097E+00
+ PKER_SACCRG( 30, 35) = 0.400163E+00
+ PKER_SACCRG( 30, 36) = 0.392659E+00
+ PKER_SACCRG( 30, 37) = 0.000000E+00
+ PKER_SACCRG( 30, 38) = 0.000000E+00
+ PKER_SACCRG( 30, 39) = 0.000000E+00
+ PKER_SACCRG( 30, 40) = 0.000000E+00
+ PKER_SACCRG( 31, 1) = 0.000000E+00
+ PKER_SACCRG( 31, 2) = 0.000000E+00
+ PKER_SACCRG( 31, 3) = 0.000000E+00
+ PKER_SACCRG( 31, 4) = 0.000000E+00
+ PKER_SACCRG( 31, 5) = 0.000000E+00
+ PKER_SACCRG( 31, 6) = 0.000000E+00
+ PKER_SACCRG( 31, 7) = 0.000000E+00
+ PKER_SACCRG( 31, 8) = 0.849193E+00
+ PKER_SACCRG( 31, 9) = 0.795515E+00
+ PKER_SACCRG( 31, 10) = 0.745151E+00
+ PKER_SACCRG( 31, 11) = 0.832155E+00
+ PKER_SACCRG( 31, 12) = 0.859161E+00
+ PKER_SACCRG( 31, 13) = 0.861757E+00
+ PKER_SACCRG( 31, 14) = 0.850726E+00
+ PKER_SACCRG( 31, 15) = 0.831243E+00
+ PKER_SACCRG( 31, 16) = 0.830311E+00
+ PKER_SACCRG( 31, 17) = 0.814860E+00
+ PKER_SACCRG( 31, 18) = 0.801315E+00
+ PKER_SACCRG( 31, 19) = 0.774544E+00
+ PKER_SACCRG( 31, 20) = 0.746495E+00
+ PKER_SACCRG( 31, 21) = 0.707199E+00
+ PKER_SACCRG( 31, 22) = 0.665314E+00
+ PKER_SACCRG( 31, 23) = 0.624385E+00
+ PKER_SACCRG( 31, 24) = 0.584535E+00
+ PKER_SACCRG( 31, 25) = 0.549231E+00
+ PKER_SACCRG( 31, 26) = 0.517437E+00
+ PKER_SACCRG( 31, 27) = 0.488673E+00
+ PKER_SACCRG( 31, 28) = 0.468316E+00
+ PKER_SACCRG( 31, 29) = 0.450402E+00
+ PKER_SACCRG( 31, 30) = 0.433466E+00
+ PKER_SACCRG( 31, 31) = 0.422481E+00
+ PKER_SACCRG( 31, 32) = 0.415341E+00
+ PKER_SACCRG( 31, 33) = 0.410003E+00
+ PKER_SACCRG( 31, 34) = 0.408314E+00
+ PKER_SACCRG( 31, 35) = 0.404379E+00
+ PKER_SACCRG( 31, 36) = 0.396881E+00
+ PKER_SACCRG( 31, 37) = 0.000000E+00
+ PKER_SACCRG( 31, 38) = 0.000000E+00
+ PKER_SACCRG( 31, 39) = 0.000000E+00
+ PKER_SACCRG( 31, 40) = 0.000000E+00
+ PKER_SACCRG( 32, 1) = 0.000000E+00
+ PKER_SACCRG( 32, 2) = 0.000000E+00
+ PKER_SACCRG( 32, 3) = 0.000000E+00
+ PKER_SACCRG( 32, 4) = 0.000000E+00
+ PKER_SACCRG( 32, 5) = 0.000000E+00
+ PKER_SACCRG( 32, 6) = 0.000000E+00
+ PKER_SACCRG( 32, 7) = 0.000000E+00
+ PKER_SACCRG( 32, 8) = 0.852585E+00
+ PKER_SACCRG( 32, 9) = 0.798908E+00
+ PKER_SACCRG( 32, 10) = 0.748546E+00
+ PKER_SACCRG( 32, 11) = 0.835553E+00
+ PKER_SACCRG( 32, 12) = 0.862560E+00
+ PKER_SACCRG( 32, 13) = 0.865156E+00
+ PKER_SACCRG( 32, 14) = 0.854127E+00
+ PKER_SACCRG( 32, 15) = 0.834646E+00
+ PKER_SACCRG( 32, 16) = 0.833717E+00
+ PKER_SACCRG( 32, 17) = 0.818269E+00
+ PKER_SACCRG( 32, 18) = 0.804730E+00
+ PKER_SACCRG( 32, 19) = 0.777966E+00
+ PKER_SACCRG( 32, 20) = 0.749927E+00
+ PKER_SACCRG( 32, 21) = 0.710643E+00
+ PKER_SACCRG( 32, 22) = 0.668772E+00
+ PKER_SACCRG( 32, 23) = 0.627853E+00
+ PKER_SACCRG( 32, 24) = 0.588019E+00
+ PKER_SACCRG( 32, 25) = 0.552723E+00
+ PKER_SACCRG( 32, 26) = 0.520936E+00
+ PKER_SACCRG( 32, 27) = 0.492177E+00
+ PKER_SACCRG( 32, 28) = 0.471809E+00
+ PKER_SACCRG( 32, 29) = 0.453889E+00
+ PKER_SACCRG( 32, 30) = 0.436952E+00
+ PKER_SACCRG( 32, 31) = 0.425962E+00
+ PKER_SACCRG( 32, 32) = 0.418817E+00
+ PKER_SACCRG( 32, 33) = 0.413477E+00
+ PKER_SACCRG( 32, 34) = 0.411784E+00
+ PKER_SACCRG( 32, 35) = 0.407849E+00
+ PKER_SACCRG( 32, 36) = 0.400353E+00
+ PKER_SACCRG( 32, 37) = 0.000000E+00
+ PKER_SACCRG( 32, 38) = 0.000000E+00
+ PKER_SACCRG( 32, 39) = 0.000000E+00
+ PKER_SACCRG( 32, 40) = 0.000000E+00
+ PKER_SACCRG( 33, 1) = 0.000000E+00
+ PKER_SACCRG( 33, 2) = 0.000000E+00
+ PKER_SACCRG( 33, 3) = 0.000000E+00
+ PKER_SACCRG( 33, 4) = 0.000000E+00
+ PKER_SACCRG( 33, 5) = 0.000000E+00
+ PKER_SACCRG( 33, 6) = 0.000000E+00
+ PKER_SACCRG( 33, 7) = 0.000000E+00
+ PKER_SACCRG( 33, 8) = 0.855391E+00
+ PKER_SACCRG( 33, 9) = 0.801716E+00
+ PKER_SACCRG( 33, 10) = 0.751355E+00
+ PKER_SACCRG( 33, 11) = 0.838364E+00
+ PKER_SACCRG( 33, 12) = 0.865372E+00
+ PKER_SACCRG( 33, 13) = 0.867969E+00
+ PKER_SACCRG( 33, 14) = 0.856941E+00
+ PKER_SACCRG( 33, 15) = 0.837462E+00
+ PKER_SACCRG( 33, 16) = 0.836534E+00
+ PKER_SACCRG( 33, 17) = 0.821090E+00
+ PKER_SACCRG( 33, 18) = 0.807555E+00
+ PKER_SACCRG( 33, 19) = 0.780797E+00
+ PKER_SACCRG( 33, 20) = 0.752765E+00
+ PKER_SACCRG( 33, 21) = 0.713491E+00
+ PKER_SACCRG( 33, 22) = 0.671630E+00
+ PKER_SACCRG( 33, 23) = 0.630717E+00
+ PKER_SACCRG( 33, 24) = 0.590897E+00
+ PKER_SACCRG( 33, 25) = 0.555606E+00
+ PKER_SACCRG( 33, 26) = 0.523823E+00
+ PKER_SACCRG( 33, 27) = 0.495067E+00
+ PKER_SACCRG( 33, 28) = 0.474689E+00
+ PKER_SACCRG( 33, 29) = 0.456764E+00
+ PKER_SACCRG( 33, 30) = 0.439825E+00
+ PKER_SACCRG( 33, 31) = 0.428830E+00
+ PKER_SACCRG( 33, 32) = 0.421681E+00
+ PKER_SACCRG( 33, 33) = 0.416338E+00
+ PKER_SACCRG( 33, 34) = 0.414643E+00
+ PKER_SACCRG( 33, 35) = 0.410707E+00
+ PKER_SACCRG( 33, 36) = 0.403213E+00
+ PKER_SACCRG( 33, 37) = 0.000000E+00
+ PKER_SACCRG( 33, 38) = 0.000000E+00
+ PKER_SACCRG( 33, 39) = 0.000000E+00
+ PKER_SACCRG( 33, 40) = 0.000000E+00
+ PKER_SACCRG( 34, 1) = 0.000000E+00
+ PKER_SACCRG( 34, 2) = 0.000000E+00
+ PKER_SACCRG( 34, 3) = 0.000000E+00
+ PKER_SACCRG( 34, 4) = 0.000000E+00
+ PKER_SACCRG( 34, 5) = 0.000000E+00
+ PKER_SACCRG( 34, 6) = 0.000000E+00
+ PKER_SACCRG( 34, 7) = 0.000000E+00
+ PKER_SACCRG( 34, 8) = 0.857714E+00
+ PKER_SACCRG( 34, 9) = 0.804039E+00
+ PKER_SACCRG( 34, 10) = 0.753680E+00
+ PKER_SACCRG( 34, 11) = 0.840691E+00
+ PKER_SACCRG( 34, 12) = 0.867699E+00
+ PKER_SACCRG( 34, 13) = 0.870297E+00
+ PKER_SACCRG( 34, 14) = 0.859270E+00
+ PKER_SACCRG( 34, 15) = 0.839792E+00
+ PKER_SACCRG( 34, 16) = 0.838866E+00
+ PKER_SACCRG( 34, 17) = 0.823423E+00
+ PKER_SACCRG( 34, 18) = 0.809892E+00
+ PKER_SACCRG( 34, 19) = 0.783139E+00
+ PKER_SACCRG( 34, 20) = 0.755113E+00
+ PKER_SACCRG( 34, 21) = 0.715845E+00
+ PKER_SACCRG( 34, 22) = 0.673992E+00
+ PKER_SACCRG( 34, 23) = 0.633085E+00
+ PKER_SACCRG( 34, 24) = 0.593274E+00
+ PKER_SACCRG( 34, 25) = 0.557987E+00
+ PKER_SACCRG( 34, 26) = 0.526206E+00
+ PKER_SACCRG( 34, 27) = 0.497452E+00
+ PKER_SACCRG( 34, 28) = 0.477066E+00
+ PKER_SACCRG( 34, 29) = 0.459136E+00
+ PKER_SACCRG( 34, 30) = 0.442195E+00
+ PKER_SACCRG( 34, 31) = 0.431196E+00
+ PKER_SACCRG( 34, 32) = 0.424043E+00
+ PKER_SACCRG( 34, 33) = 0.418698E+00
+ PKER_SACCRG( 34, 34) = 0.417000E+00
+ PKER_SACCRG( 34, 35) = 0.413064E+00
+ PKER_SACCRG( 34, 36) = 0.405570E+00
+ PKER_SACCRG( 34, 37) = 0.000000E+00
+ PKER_SACCRG( 34, 38) = 0.000000E+00
+ PKER_SACCRG( 34, 39) = 0.000000E+00
+ PKER_SACCRG( 34, 40) = 0.000000E+00
+ PKER_SACCRG( 35, 1) = 0.000000E+00
+ PKER_SACCRG( 35, 2) = 0.000000E+00
+ PKER_SACCRG( 35, 3) = 0.000000E+00
+ PKER_SACCRG( 35, 4) = 0.000000E+00
+ PKER_SACCRG( 35, 5) = 0.000000E+00
+ PKER_SACCRG( 35, 6) = 0.000000E+00
+ PKER_SACCRG( 35, 7) = 0.000000E+00
+ PKER_SACCRG( 35, 8) = 0.859637E+00
+ PKER_SACCRG( 35, 9) = 0.805962E+00
+ PKER_SACCRG( 35, 10) = 0.755603E+00
+ PKER_SACCRG( 35, 11) = 0.842616E+00
+ PKER_SACCRG( 35, 12) = 0.869625E+00
+ PKER_SACCRG( 35, 13) = 0.872223E+00
+ PKER_SACCRG( 35, 14) = 0.861197E+00
+ PKER_SACCRG( 35, 15) = 0.841720E+00
+ PKER_SACCRG( 35, 16) = 0.840795E+00
+ PKER_SACCRG( 35, 17) = 0.825354E+00
+ PKER_SACCRG( 35, 18) = 0.811826E+00
+ PKER_SACCRG( 35, 19) = 0.785076E+00
+ PKER_SACCRG( 35, 20) = 0.757054E+00
+ PKER_SACCRG( 35, 21) = 0.717792E+00
+ PKER_SACCRG( 35, 22) = 0.675945E+00
+ PKER_SACCRG( 35, 23) = 0.635042E+00
+ PKER_SACCRG( 35, 24) = 0.595238E+00
+ PKER_SACCRG( 35, 25) = 0.559954E+00
+ PKER_SACCRG( 35, 26) = 0.528174E+00
+ PKER_SACCRG( 35, 27) = 0.499421E+00
+ PKER_SACCRG( 35, 28) = 0.479029E+00
+ PKER_SACCRG( 35, 29) = 0.461094E+00
+ PKER_SACCRG( 35, 30) = 0.444151E+00
+ PKER_SACCRG( 35, 31) = 0.433148E+00
+ PKER_SACCRG( 35, 32) = 0.425993E+00
+ PKER_SACCRG( 35, 33) = 0.420646E+00
+ PKER_SACCRG( 35, 34) = 0.418946E+00
+ PKER_SACCRG( 35, 35) = 0.415009E+00
+ PKER_SACCRG( 35, 36) = 0.407516E+00
+ PKER_SACCRG( 35, 37) = 0.000000E+00
+ PKER_SACCRG( 35, 38) = 0.000000E+00
+ PKER_SACCRG( 35, 39) = 0.000000E+00
+ PKER_SACCRG( 35, 40) = 0.000000E+00
+ PKER_SACCRG( 36, 1) = 0.000000E+00
+ PKER_SACCRG( 36, 2) = 0.000000E+00
+ PKER_SACCRG( 36, 3) = 0.000000E+00
+ PKER_SACCRG( 36, 4) = 0.000000E+00
+ PKER_SACCRG( 36, 5) = 0.000000E+00
+ PKER_SACCRG( 36, 6) = 0.000000E+00
+ PKER_SACCRG( 36, 7) = 0.000000E+00
+ PKER_SACCRG( 36, 8) = 0.861228E+00
+ PKER_SACCRG( 36, 9) = 0.807554E+00
+ PKER_SACCRG( 36, 10) = 0.757195E+00
+ PKER_SACCRG( 36, 11) = 0.844210E+00
+ PKER_SACCRG( 36, 12) = 0.871219E+00
+ PKER_SACCRG( 36, 13) = 0.873817E+00
+ PKER_SACCRG( 36, 14) = 0.862791E+00
+ PKER_SACCRG( 36, 15) = 0.843315E+00
+ PKER_SACCRG( 36, 16) = 0.842391E+00
+ PKER_SACCRG( 36, 17) = 0.826952E+00
+ PKER_SACCRG( 36, 18) = 0.813425E+00
+ PKER_SACCRG( 36, 19) = 0.786678E+00
+ PKER_SACCRG( 36, 20) = 0.758660E+00
+ PKER_SACCRG( 36, 21) = 0.719402E+00
+ PKER_SACCRG( 36, 22) = 0.677560E+00
+ PKER_SACCRG( 36, 23) = 0.636660E+00
+ PKER_SACCRG( 36, 24) = 0.596861E+00
+ PKER_SACCRG( 36, 25) = 0.561579E+00
+ PKER_SACCRG( 36, 26) = 0.529800E+00
+ PKER_SACCRG( 36, 27) = 0.501048E+00
+ PKER_SACCRG( 36, 28) = 0.480650E+00
+ PKER_SACCRG( 36, 29) = 0.462712E+00
+ PKER_SACCRG( 36, 30) = 0.445767E+00
+ PKER_SACCRG( 36, 31) = 0.434761E+00
+ PKER_SACCRG( 36, 32) = 0.427602E+00
+ PKER_SACCRG( 36, 33) = 0.422254E+00
+ PKER_SACCRG( 36, 34) = 0.420553E+00
+ PKER_SACCRG( 36, 35) = 0.416615E+00
+ PKER_SACCRG( 36, 36) = 0.409122E+00
+ PKER_SACCRG( 36, 37) = 0.000000E+00
+ PKER_SACCRG( 36, 38) = 0.000000E+00
+ PKER_SACCRG( 36, 39) = 0.000000E+00
+ PKER_SACCRG( 36, 40) = 0.000000E+00
+ PKER_SACCRG( 37, 1) = 0.000000E+00
+ PKER_SACCRG( 37, 2) = 0.000000E+00
+ PKER_SACCRG( 37, 3) = 0.000000E+00
+ PKER_SACCRG( 37, 4) = 0.000000E+00
+ PKER_SACCRG( 37, 5) = 0.000000E+00
+ PKER_SACCRG( 37, 6) = 0.000000E+00
+ PKER_SACCRG( 37, 7) = 0.000000E+00
+ PKER_SACCRG( 37, 8) = 0.862545E+00
+ PKER_SACCRG( 37, 9) = 0.808871E+00
+ PKER_SACCRG( 37, 10) = 0.758513E+00
+ PKER_SACCRG( 37, 11) = 0.845529E+00
+ PKER_SACCRG( 37, 12) = 0.872538E+00
+ PKER_SACCRG( 37, 13) = 0.875137E+00
+ PKER_SACCRG( 37, 14) = 0.864111E+00
+ PKER_SACCRG( 37, 15) = 0.844636E+00
+ PKER_SACCRG( 37, 16) = 0.843713E+00
+ PKER_SACCRG( 37, 17) = 0.828275E+00
+ PKER_SACCRG( 37, 18) = 0.814749E+00
+ PKER_SACCRG( 37, 19) = 0.788004E+00
+ PKER_SACCRG( 37, 20) = 0.759989E+00
+ PKER_SACCRG( 37, 21) = 0.720734E+00
+ PKER_SACCRG( 37, 22) = 0.678896E+00
+ PKER_SACCRG( 37, 23) = 0.637998E+00
+ PKER_SACCRG( 37, 24) = 0.598203E+00
+ PKER_SACCRG( 37, 25) = 0.562923E+00
+ PKER_SACCRG( 37, 26) = 0.531144E+00
+ PKER_SACCRG( 37, 27) = 0.502392E+00
+ PKER_SACCRG( 37, 28) = 0.481990E+00
+ PKER_SACCRG( 37, 29) = 0.464049E+00
+ PKER_SACCRG( 37, 30) = 0.447102E+00
+ PKER_SACCRG( 37, 31) = 0.436093E+00
+ PKER_SACCRG( 37, 32) = 0.428933E+00
+ PKER_SACCRG( 37, 33) = 0.423583E+00
+ PKER_SACCRG( 37, 34) = 0.421881E+00
+ PKER_SACCRG( 37, 35) = 0.417942E+00
+ PKER_SACCRG( 37, 36) = 0.410449E+00
+ PKER_SACCRG( 37, 37) = 0.000000E+00
+ PKER_SACCRG( 37, 38) = 0.000000E+00
+ PKER_SACCRG( 37, 39) = 0.000000E+00
+ PKER_SACCRG( 37, 40) = 0.000000E+00
+ PKER_SACCRG( 38, 1) = 0.000000E+00
+ PKER_SACCRG( 38, 2) = 0.000000E+00
+ PKER_SACCRG( 38, 3) = 0.000000E+00
+ PKER_SACCRG( 38, 4) = 0.000000E+00
+ PKER_SACCRG( 38, 5) = 0.000000E+00
+ PKER_SACCRG( 38, 6) = 0.000000E+00
+ PKER_SACCRG( 38, 7) = 0.000000E+00
+ PKER_SACCRG( 38, 8) = 0.864084E+00
+ PKER_SACCRG( 38, 9) = 0.810382E+00
+ PKER_SACCRG( 38, 10) = 0.759998E+00
+ PKER_SACCRG( 38, 11) = 0.847060E+00
+ PKER_SACCRG( 38, 12) = 0.874083E+00
+ PKER_SACCRG( 38, 13) = 0.876684E+00
+ PKER_SACCRG( 38, 14) = 0.865653E+00
+ PKER_SACCRG( 38, 15) = 0.846168E+00
+ PKER_SACCRG( 38, 16) = 0.845245E+00
+ PKER_SACCRG( 38, 17) = 0.829800E+00
+ PKER_SACCRG( 38, 18) = 0.816269E+00
+ PKER_SACCRG( 38, 19) = 0.789511E+00
+ PKER_SACCRG( 38, 20) = 0.761484E+00
+ PKER_SACCRG( 38, 21) = 0.722211E+00
+ PKER_SACCRG( 38, 22) = 0.680354E+00
+ PKER_SACCRG( 38, 23) = 0.639436E+00
+ PKER_SACCRG( 38, 24) = 0.599624E+00
+ PKER_SACCRG( 38, 25) = 0.564327E+00
+ PKER_SACCRG( 38, 26) = 0.532532E+00
+ PKER_SACCRG( 38, 27) = 0.503764E+00
+ PKER_SACCRG( 38, 28) = 0.483348E+00
+ PKER_SACCRG( 38, 29) = 0.465395E+00
+ PKER_SACCRG( 38, 30) = 0.448438E+00
+ PKER_SACCRG( 38, 31) = 0.437422E+00
+ PKER_SACCRG( 38, 32) = 0.430256E+00
+ PKER_SACCRG( 38, 33) = 0.424902E+00
+ PKER_SACCRG( 38, 34) = 0.423198E+00
+ PKER_SACCRG( 38, 35) = 0.419256E+00
+ PKER_SACCRG( 38, 36) = 0.411759E+00
+ PKER_SACCRG( 38, 37) = 0.000000E+00
+ PKER_SACCRG( 38, 38) = 0.000000E+00
+ PKER_SACCRG( 38, 39) = 0.000000E+00
+ PKER_SACCRG( 38, 40) = 0.000000E+00
+ PKER_SACCRG( 39, 1) = 0.000000E+00
+ PKER_SACCRG( 39, 2) = 0.000000E+00
+ PKER_SACCRG( 39, 3) = 0.000000E+00
+ PKER_SACCRG( 39, 4) = 0.000000E+00
+ PKER_SACCRG( 39, 5) = 0.000000E+00
+ PKER_SACCRG( 39, 6) = 0.000000E+00
+ PKER_SACCRG( 39, 7) = 0.000000E+00
+ PKER_SACCRG( 39, 8) = 0.864538E+00
+ PKER_SACCRG( 39, 9) = 0.810864E+00
+ PKER_SACCRG( 39, 10) = 0.760506E+00
+ PKER_SACCRG( 39, 11) = 0.847524E+00
+ PKER_SACCRG( 39, 12) = 0.874534E+00
+ PKER_SACCRG( 39, 13) = 0.877133E+00
+ PKER_SACCRG( 39, 14) = 0.866108E+00
+ PKER_SACCRG( 39, 15) = 0.846633E+00
+ PKER_SACCRG( 39, 16) = 0.845711E+00
+ PKER_SACCRG( 39, 17) = 0.830275E+00
+ PKER_SACCRG( 39, 18) = 0.816752E+00
+ PKER_SACCRG( 39, 19) = 0.790009E+00
+ PKER_SACCRG( 39, 20) = 0.761998E+00
+ PKER_SACCRG( 39, 21) = 0.722748E+00
+ PKER_SACCRG( 39, 22) = 0.680914E+00
+ PKER_SACCRG( 39, 23) = 0.640019E+00
+ PKER_SACCRG( 39, 24) = 0.600230E+00
+ PKER_SACCRG( 39, 25) = 0.564952E+00
+ PKER_SACCRG( 39, 26) = 0.533174E+00
+ PKER_SACCRG( 39, 27) = 0.504421E+00
+ PKER_SACCRG( 39, 28) = 0.484013E+00
+ PKER_SACCRG( 39, 29) = 0.466067E+00
+ PKER_SACCRG( 39, 30) = 0.449117E+00
+ PKER_SACCRG( 39, 31) = 0.438105E+00
+ PKER_SACCRG( 39, 32) = 0.430941E+00
+ PKER_SACCRG( 39, 33) = 0.425589E+00
+ PKER_SACCRG( 39, 34) = 0.423885E+00
+ PKER_SACCRG( 39, 35) = 0.419946E+00
+ PKER_SACCRG( 39, 36) = 0.412452E+00
+ PKER_SACCRG( 39, 37) = 0.000000E+00
+ PKER_SACCRG( 39, 38) = 0.000000E+00
+ PKER_SACCRG( 39, 39) = 0.000000E+00
+ PKER_SACCRG( 39, 40) = 0.000000E+00
+ PKER_SACCRG( 40, 1) = 0.000000E+00
+ PKER_SACCRG( 40, 2) = 0.000000E+00
+ PKER_SACCRG( 40, 3) = 0.000000E+00
+ PKER_SACCRG( 40, 4) = 0.000000E+00
+ PKER_SACCRG( 40, 5) = 0.000000E+00
+ PKER_SACCRG( 40, 6) = 0.000000E+00
+ PKER_SACCRG( 40, 7) = 0.000000E+00
+ PKER_SACCRG( 40, 8) = 0.865285E+00
+ PKER_SACCRG( 40, 9) = 0.811611E+00
+ PKER_SACCRG( 40, 10) = 0.761253E+00
+ PKER_SACCRG( 40, 11) = 0.848272E+00
+ PKER_SACCRG( 40, 12) = 0.875282E+00
+ PKER_SACCRG( 40, 13) = 0.877881E+00
+ PKER_SACCRG( 40, 14) = 0.866857E+00
+ PKER_SACCRG( 40, 15) = 0.847382E+00
+ PKER_SACCRG( 40, 16) = 0.846460E+00
+ PKER_SACCRG( 40, 17) = 0.831024E+00
+ PKER_SACCRG( 40, 18) = 0.817502E+00
+ PKER_SACCRG( 40, 19) = 0.790761E+00
+ PKER_SACCRG( 40, 20) = 0.762751E+00
+ PKER_SACCRG( 40, 21) = 0.723502E+00
+ PKER_SACCRG( 40, 22) = 0.681670E+00
+ PKER_SACCRG( 40, 23) = 0.640776E+00
+ PKER_SACCRG( 40, 24) = 0.600989E+00
+ PKER_SACCRG( 40, 25) = 0.565711E+00
+ PKER_SACCRG( 40, 26) = 0.533933E+00
+ PKER_SACCRG( 40, 27) = 0.505180E+00
+ PKER_SACCRG( 40, 28) = 0.484770E+00
+ PKER_SACCRG( 40, 29) = 0.466822E+00
+ PKER_SACCRG( 40, 30) = 0.449871E+00
+ PKER_SACCRG( 40, 31) = 0.438858E+00
+ PKER_SACCRG( 40, 32) = 0.431693E+00
+ PKER_SACCRG( 40, 33) = 0.426340E+00
+ PKER_SACCRG( 40, 34) = 0.424636E+00
+ PKER_SACCRG( 40, 35) = 0.420696E+00
+ PKER_SACCRG( 40, 36) = 0.413202E+00
+ PKER_SACCRG( 40, 37) = 0.000000E+00
+ PKER_SACCRG( 40, 38) = 0.000000E+00
+ PKER_SACCRG( 40, 39) = 0.000000E+00
+ PKER_SACCRG( 40, 40) = 0.000000E+00
+END IF
+
+!
+END SUBROUTINE LIMA_READ_XKER_RACCS
diff --git a/src/mesonh/micro/lima_read_xker_rdryg.f90 b/src/mesonh/micro/lima_read_xker_rdryg.f90
new file mode 100644
index 000000000..de1a42874
--- /dev/null
+++ b/src/mesonh/micro/lima_read_xker_rdryg.f90
@@ -0,0 +1,1736 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 init 2006/05/18 13:07:25
+!-----------------------------------------------------------------
+! ###########################
+ MODULE MODI_LIMA_READ_XKER_RDRYG
+! ###########################
+!
+INTERFACE
+ SUBROUTINE LIMA_READ_XKER_RDRYG (KDRYLBDAG,KDRYLBDAR,KND, &
+ PALPHAG,PNUG,PALPHAR,PNUR,PEGR,PBR,PCG,PDG,PCR,PDR, &
+ PDRYLBDAG_MAX,PDRYLBDAR_MAX,PDRYLBDAG_MIN,PDRYLBDAR_MIN, &
+ PFDINFTY,PKER_RDRYG )
+!
+INTEGER, INTENT(OUT) :: KND,KDRYLBDAG,KDRYLBDAR
+REAL, INTENT(OUT) :: PALPHAG
+REAL, INTENT(OUT) :: PNUG
+REAL, INTENT(OUT) :: PALPHAR
+REAL, INTENT(OUT) :: PNUR
+REAL, INTENT(OUT) :: PEGR
+REAL, INTENT(OUT) :: PBR
+REAL, INTENT(OUT) :: PCG
+REAL, INTENT(OUT) :: PDG
+REAL, INTENT(OUT) :: PCR
+REAL, INTENT(OUT) :: PDR
+REAL, INTENT(OUT) :: PDRYLBDAG_MAX
+REAL, INTENT(OUT) :: PDRYLBDAR_MAX
+REAL, INTENT(OUT) :: PDRYLBDAG_MIN
+REAL, INTENT(OUT) :: PDRYLBDAR_MIN
+REAL, INTENT(OUT) :: PFDINFTY
+REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_RDRYG
+!
+END SUBROUTINE LIMA_READ_XKER_RDRYG
+!
+END INTERFACE
+!
+END MODULE MODI_LIMA_READ_XKER_RDRYG
+! ########################################################################
+ SUBROUTINE LIMA_READ_XKER_RDRYG (KDRYLBDAG,KDRYLBDAR,KND, &
+ PALPHAG,PNUG,PALPHAR,PNUR,PEGR,PBR,PCG,PDG,PCR,PDR, &
+ PDRYLBDAG_MAX,PDRYLBDAR_MAX,PDRYLBDAG_MIN,PDRYLBDAR_MIN, &
+ PFDINFTY,PKER_RDRYG )
+! ########################################################################
+!
+!!**** * * - initialize the kernels for the snow-graupel dry growth process
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to initialize the kernels PKER_RDRYG
+!! prepared from a previous run of the routine INI_RAIN_ICE. The reading of
+!! the kernels is optional after checking for the dimensions of the arrays.
+!!
+!!** METHOD
+!! ------
+!!
+!!
+!! EXTERNAL
+!! --------
+!! None
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation ( routine READ_XKER_RDRYG )
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 09/04/96
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!* 0.2 Declarations of local variables :
+!
+!
+INTEGER, INTENT(OUT) :: KND,KDRYLBDAG,KDRYLBDAR
+REAL, INTENT(OUT) :: PALPHAG
+REAL, INTENT(OUT) :: PNUG
+REAL, INTENT(OUT) :: PALPHAR
+REAL, INTENT(OUT) :: PNUR
+REAL, INTENT(OUT) :: PEGR
+REAL, INTENT(OUT) :: PBR
+REAL, INTENT(OUT) :: PCG
+REAL, INTENT(OUT) :: PDG
+REAL, INTENT(OUT) :: PCR
+REAL, INTENT(OUT) :: PDR
+REAL, INTENT(OUT) :: PDRYLBDAG_MAX
+REAL, INTENT(OUT) :: PDRYLBDAR_MAX
+REAL, INTENT(OUT) :: PDRYLBDAG_MIN
+REAL, INTENT(OUT) :: PDRYLBDAR_MIN
+REAL, INTENT(OUT) :: PFDINFTY
+REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_RDRYG
+!
+! ###################################################################
+! #INSERT HERE THE OUTPUT OF INI_RAIN_ICE IF THE KERNELS ARE UPDATED#
+! ###################################################################
+!
+KND= 50
+KDRYLBDAG= 40
+KDRYLBDAR= 40
+PALPHAG= 0.100000E+01
+PNUG= 0.100000E+01
+PALPHAR= 0.100000E+01
+PNUR= 0.200000E+01
+PEGR= 0.100000E+01
+PBR= 0.300000E+01
+PCG= 0.122000E+03
+PDG= 0.660000E+00
+PCR= 0.842000E+03
+PDR= 0.800000E+00
+PDRYLBDAG_MAX= 0.100000E+08
+PDRYLBDAR_MAX= 0.100000E+08
+PDRYLBDAG_MIN= 0.100000E+04
+PDRYLBDAR_MIN= 0.100000E+04
+PFDINFTY= 0.200000E+02
+!
+IF( PRESENT(PKER_RDRYG) ) THEN
+PKER_RDRYG( 1, 1) = 0.134210E+02
+PKER_RDRYG( 1, 2) = 0.106490E+02
+PKER_RDRYG( 1, 3) = 0.834292E+01
+PKER_RDRYG( 1, 4) = 0.642847E+01
+PKER_RDRYG( 1, 5) = 0.484974E+01
+PKER_RDRYG( 1, 6) = 0.356945E+01
+PKER_RDRYG( 1, 7) = 0.256678E+01
+PKER_RDRYG( 1, 8) = 0.183093E+01
+PKER_RDRYG( 1, 9) = 0.135156E+01
+PKER_RDRYG( 1, 10) = 0.110260E+01
+PKER_RDRYG( 1, 11) = 0.104070E+01
+PKER_RDRYG( 1, 12) = 0.110897E+01
+PKER_RDRYG( 1, 13) = 0.125122E+01
+PKER_RDRYG( 1, 14) = 0.142283E+01
+PKER_RDRYG( 1, 15) = 0.159456E+01
+PKER_RDRYG( 1, 16) = 0.175135E+01
+PKER_RDRYG( 1, 17) = 0.188742E+01
+PKER_RDRYG( 1, 18) = 0.200233E+01
+PKER_RDRYG( 1, 19) = 0.209795E+01
+PKER_RDRYG( 1, 20) = 0.217687E+01
+PKER_RDRYG( 1, 21) = 0.224175E+01
+PKER_RDRYG( 1, 22) = 0.229504E+01
+PKER_RDRYG( 1, 23) = 0.233883E+01
+PKER_RDRYG( 1, 24) = 0.237485E+01
+PKER_RDRYG( 1, 25) = 0.240449E+01
+PKER_RDRYG( 1, 26) = 0.242888E+01
+PKER_RDRYG( 1, 27) = 0.244897E+01
+PKER_RDRYG( 1, 28) = 0.246553E+01
+PKER_RDRYG( 1, 29) = 0.247917E+01
+PKER_RDRYG( 1, 30) = 0.249042E+01
+PKER_RDRYG( 1, 31) = 0.249970E+01
+PKER_RDRYG( 1, 32) = 0.250735E+01
+PKER_RDRYG( 1, 33) = 0.251366E+01
+PKER_RDRYG( 1, 34) = 0.251887E+01
+PKER_RDRYG( 1, 35) = 0.252317E+01
+PKER_RDRYG( 1, 36) = 0.252671E+01
+PKER_RDRYG( 1, 37) = 0.252964E+01
+PKER_RDRYG( 1, 38) = 0.253206E+01
+PKER_RDRYG( 1, 39) = 0.253406E+01
+PKER_RDRYG( 1, 40) = 0.253571E+01
+PKER_RDRYG( 2, 1) = 0.138258E+02
+PKER_RDRYG( 2, 2) = 0.110664E+02
+PKER_RDRYG( 2, 3) = 0.877034E+01
+PKER_RDRYG( 2, 4) = 0.686001E+01
+PKER_RDRYG( 2, 5) = 0.527438E+01
+PKER_RDRYG( 2, 6) = 0.396820E+01
+PKER_RDRYG( 2, 7) = 0.291168E+01
+PKER_RDRYG( 2, 8) = 0.208952E+01
+PKER_RDRYG( 2, 9) = 0.149350E+01
+PKER_RDRYG( 2, 10) = 0.111353E+01
+PKER_RDRYG( 2, 11) = 0.926786E+00
+PKER_RDRYG( 2, 12) = 0.892818E+00
+PKER_RDRYG( 2, 13) = 0.963446E+00
+PKER_RDRYG( 2, 14) = 0.109105E+01
+PKER_RDRYG( 2, 15) = 0.123930E+01
+PKER_RDRYG( 2, 16) = 0.138520E+01
+PKER_RDRYG( 2, 17) = 0.151708E+01
+PKER_RDRYG( 2, 18) = 0.163089E+01
+PKER_RDRYG( 2, 19) = 0.172673E+01
+PKER_RDRYG( 2, 20) = 0.180633E+01
+PKER_RDRYG( 2, 21) = 0.187195E+01
+PKER_RDRYG( 2, 22) = 0.192586E+01
+PKER_RDRYG( 2, 23) = 0.197013E+01
+PKER_RDRYG( 2, 24) = 0.200651E+01
+PKER_RDRYG( 2, 25) = 0.203642E+01
+PKER_RDRYG( 2, 26) = 0.206103E+01
+PKER_RDRYG( 2, 27) = 0.208129E+01
+PKER_RDRYG( 2, 28) = 0.209797E+01
+PKER_RDRYG( 2, 29) = 0.211172E+01
+PKER_RDRYG( 2, 30) = 0.212304E+01
+PKER_RDRYG( 2, 31) = 0.213238E+01
+PKER_RDRYG( 2, 32) = 0.214007E+01
+PKER_RDRYG( 2, 33) = 0.214642E+01
+PKER_RDRYG( 2, 34) = 0.215166E+01
+PKER_RDRYG( 2, 35) = 0.215598E+01
+PKER_RDRYG( 2, 36) = 0.215954E+01
+PKER_RDRYG( 2, 37) = 0.216249E+01
+PKER_RDRYG( 2, 38) = 0.216492E+01
+PKER_RDRYG( 2, 39) = 0.216692E+01
+PKER_RDRYG( 2, 40) = 0.216858E+01
+PKER_RDRYG( 3, 1) = 0.141567E+02
+PKER_RDRYG( 3, 2) = 0.114089E+02
+PKER_RDRYG( 3, 3) = 0.912360E+01
+PKER_RDRYG( 3, 4) = 0.722169E+01
+PKER_RDRYG( 3, 5) = 0.563921E+01
+PKER_RDRYG( 3, 6) = 0.432602E+01
+PKER_RDRYG( 3, 7) = 0.324547E+01
+PKER_RDRYG( 3, 8) = 0.237429E+01
+PKER_RDRYG( 3, 9) = 0.170066E+01
+PKER_RDRYG( 3, 10) = 0.121912E+01
+PKER_RDRYG( 3, 11) = 0.919677E+00
+PKER_RDRYG( 3, 12) = 0.780708E+00
+PKER_RDRYG( 3, 13) = 0.767737E+00
+PKER_RDRYG( 3, 14) = 0.837693E+00
+PKER_RDRYG( 3, 15) = 0.951377E+00
+PKER_RDRYG( 3, 16) = 0.107910E+01
+PKER_RDRYG( 3, 17) = 0.120275E+01
+PKER_RDRYG( 3, 18) = 0.131354E+01
+PKER_RDRYG( 3, 19) = 0.140872E+01
+PKER_RDRYG( 3, 20) = 0.148863E+01
+PKER_RDRYG( 3, 21) = 0.155489E+01
+PKER_RDRYG( 3, 22) = 0.160944E+01
+PKER_RDRYG( 3, 23) = 0.165424E+01
+PKER_RDRYG( 3, 24) = 0.169103E+01
+PKER_RDRYG( 3, 25) = 0.172125E+01
+PKER_RDRYG( 3, 26) = 0.174610E+01
+PKER_RDRYG( 3, 27) = 0.176654E+01
+PKER_RDRYG( 3, 28) = 0.178336E+01
+PKER_RDRYG( 3, 29) = 0.179721E+01
+PKER_RDRYG( 3, 30) = 0.180862E+01
+PKER_RDRYG( 3, 31) = 0.181802E+01
+PKER_RDRYG( 3, 32) = 0.182577E+01
+PKER_RDRYG( 3, 33) = 0.183215E+01
+PKER_RDRYG( 3, 34) = 0.183742E+01
+PKER_RDRYG( 3, 35) = 0.184177E+01
+PKER_RDRYG( 3, 36) = 0.184535E+01
+PKER_RDRYG( 3, 37) = 0.184831E+01
+PKER_RDRYG( 3, 38) = 0.185075E+01
+PKER_RDRYG( 3, 39) = 0.185277E+01
+PKER_RDRYG( 3, 40) = 0.185443E+01
+PKER_RDRYG( 4, 1) = 0.144269E+02
+PKER_RDRYG( 4, 2) = 0.116888E+02
+PKER_RDRYG( 4, 3) = 0.941339E+01
+PKER_RDRYG( 4, 4) = 0.752068E+01
+PKER_RDRYG( 4, 5) = 0.594528E+01
+PKER_RDRYG( 4, 6) = 0.463440E+01
+PKER_RDRYG( 4, 7) = 0.354694E+01
+PKER_RDRYG( 4, 8) = 0.265338E+01
+PKER_RDRYG( 4, 9) = 0.193548E+01
+PKER_RDRYG( 4, 10) = 0.138447E+01
+PKER_RDRYG( 4, 11) = 0.996309E+00
+PKER_RDRYG( 4, 12) = 0.761568E+00
+PKER_RDRYG( 4, 13) = 0.660627E+00
+PKER_RDRYG( 4, 14) = 0.661754E+00
+PKER_RDRYG( 4, 15) = 0.729010E+00
+PKER_RDRYG( 4, 16) = 0.829397E+00
+PKER_RDRYG( 4, 17) = 0.939122E+00
+PKER_RDRYG( 4, 18) = 0.104378E+01
+PKER_RDRYG( 4, 19) = 0.113682E+01
+PKER_RDRYG( 4, 20) = 0.121638E+01
+PKER_RDRYG( 4, 21) = 0.128300E+01
+PKER_RDRYG( 4, 22) = 0.133814E+01
+PKER_RDRYG( 4, 23) = 0.138351E+01
+PKER_RDRYG( 4, 24) = 0.142074E+01
+PKER_RDRYG( 4, 25) = 0.145131E+01
+PKER_RDRYG( 4, 26) = 0.147642E+01
+PKER_RDRYG( 4, 27) = 0.149706E+01
+PKER_RDRYG( 4, 28) = 0.151403E+01
+PKER_RDRYG( 4, 29) = 0.152800E+01
+PKER_RDRYG( 4, 30) = 0.153950E+01
+PKER_RDRYG( 4, 31) = 0.154897E+01
+PKER_RDRYG( 4, 32) = 0.155678E+01
+PKER_RDRYG( 4, 33) = 0.156321E+01
+PKER_RDRYG( 4, 34) = 0.156851E+01
+PKER_RDRYG( 4, 35) = 0.157288E+01
+PKER_RDRYG( 4, 36) = 0.157649E+01
+PKER_RDRYG( 4, 37) = 0.157946E+01
+PKER_RDRYG( 4, 38) = 0.158192E+01
+PKER_RDRYG( 4, 39) = 0.158394E+01
+PKER_RDRYG( 4, 40) = 0.158562E+01
+PKER_RDRYG( 5, 1) = 0.146477E+02
+PKER_RDRYG( 5, 2) = 0.119175E+02
+PKER_RDRYG( 5, 3) = 0.965028E+01
+PKER_RDRYG( 5, 4) = 0.776596E+01
+PKER_RDRYG( 5, 5) = 0.619837E+01
+PKER_RDRYG( 5, 6) = 0.489342E+01
+PKER_RDRYG( 5, 7) = 0.380757E+01
+PKER_RDRYG( 5, 8) = 0.290717E+01
+PKER_RDRYG( 5, 9) = 0.216844E+01
+PKER_RDRYG( 5, 10) = 0.157730E+01
+PKER_RDRYG( 5, 11) = 0.112773E+01
+PKER_RDRYG( 5, 12) = 0.815273E+00
+PKER_RDRYG( 5, 13) = 0.632305E+00
+PKER_RDRYG( 5, 14) = 0.560193E+00
+PKER_RDRYG( 5, 15) = 0.571354E+00
+PKER_RDRYG( 5, 16) = 0.634685E+00
+PKER_RDRYG( 5, 17) = 0.723003E+00
+PKER_RDRYG( 5, 18) = 0.816915E+00
+PKER_RDRYG( 5, 19) = 0.905398E+00
+PKER_RDRYG( 5, 20) = 0.983467E+00
+PKER_RDRYG( 5, 21) = 0.104994E+01
+PKER_RDRYG( 5, 22) = 0.110547E+01
+PKER_RDRYG( 5, 23) = 0.115137E+01
+PKER_RDRYG( 5, 24) = 0.118909E+01
+PKER_RDRYG( 5, 25) = 0.122003E+01
+PKER_RDRYG( 5, 26) = 0.124544E+01
+PKER_RDRYG( 5, 27) = 0.126630E+01
+PKER_RDRYG( 5, 28) = 0.128345E+01
+PKER_RDRYG( 5, 29) = 0.129755E+01
+PKER_RDRYG( 5, 30) = 0.130915E+01
+PKER_RDRYG( 5, 31) = 0.131870E+01
+PKER_RDRYG( 5, 32) = 0.132657E+01
+PKER_RDRYG( 5, 33) = 0.133305E+01
+PKER_RDRYG( 5, 34) = 0.133839E+01
+PKER_RDRYG( 5, 35) = 0.134279E+01
+PKER_RDRYG( 5, 36) = 0.134641E+01
+PKER_RDRYG( 5, 37) = 0.134941E+01
+PKER_RDRYG( 5, 38) = 0.135188E+01
+PKER_RDRYG( 5, 39) = 0.135391E+01
+PKER_RDRYG( 5, 40) = 0.135559E+01
+PKER_RDRYG( 6, 1) = 0.148285E+02
+PKER_RDRYG( 6, 2) = 0.121043E+02
+PKER_RDRYG( 6, 3) = 0.984376E+01
+PKER_RDRYG( 6, 4) = 0.796646E+01
+PKER_RDRYG( 6, 5) = 0.640602E+01
+PKER_RDRYG( 6, 6) = 0.510770E+01
+PKER_RDRYG( 6, 7) = 0.402676E+01
+PKER_RDRYG( 6, 8) = 0.312733E+01
+PKER_RDRYG( 6, 9) = 0.238192E+01
+PKER_RDRYG( 6, 10) = 0.177145E+01
+PKER_RDRYG( 6, 11) = 0.128511E+01
+PKER_RDRYG( 6, 12) = 0.918271E+00
+PKER_RDRYG( 6, 13) = 0.668096E+00
+PKER_RDRYG( 6, 14) = 0.526360E+00
+PKER_RDRYG( 6, 15) = 0.476580E+00
+PKER_RDRYG( 6, 16) = 0.494226E+00
+PKER_RDRYG( 6, 17) = 0.552847E+00
+PKER_RDRYG( 6, 18) = 0.630007E+00
+PKER_RDRYG( 6, 19) = 0.710312E+00
+PKER_RDRYG( 6, 20) = 0.784988E+00
+PKER_RDRYG( 6, 21) = 0.850444E+00
+PKER_RDRYG( 6, 22) = 0.905977E+00
+PKER_RDRYG( 6, 23) = 0.952261E+00
+PKER_RDRYG( 6, 24) = 0.990455E+00
+PKER_RDRYG( 6, 25) = 0.102182E+01
+PKER_RDRYG( 6, 26) = 0.104755E+01
+PKER_RDRYG( 6, 27) = 0.106866E+01
+PKER_RDRYG( 6, 28) = 0.108600E+01
+PKER_RDRYG( 6, 29) = 0.110024E+01
+PKER_RDRYG( 6, 30) = 0.111196E+01
+PKER_RDRYG( 6, 31) = 0.112160E+01
+PKER_RDRYG( 6, 32) = 0.112953E+01
+PKER_RDRYG( 6, 33) = 0.113606E+01
+PKER_RDRYG( 6, 34) = 0.114144E+01
+PKER_RDRYG( 6, 35) = 0.114587E+01
+PKER_RDRYG( 6, 36) = 0.114953E+01
+PKER_RDRYG( 6, 37) = 0.115254E+01
+PKER_RDRYG( 6, 38) = 0.115502E+01
+PKER_RDRYG( 6, 39) = 0.115707E+01
+PKER_RDRYG( 6, 40) = 0.115876E+01
+PKER_RDRYG( 7, 1) = 0.149770E+02
+PKER_RDRYG( 7, 2) = 0.122574E+02
+PKER_RDRYG( 7, 3) = 0.100019E+02
+PKER_RDRYG( 7, 4) = 0.813025E+01
+PKER_RDRYG( 7, 5) = 0.657577E+01
+PKER_RDRYG( 7, 6) = 0.528352E+01
+PKER_RDRYG( 7, 7) = 0.420821E+01
+PKER_RDRYG( 7, 8) = 0.331283E+01
+PKER_RDRYG( 7, 9) = 0.256784E+01
+PKER_RDRYG( 7, 10) = 0.195082E+01
+PKER_RDRYG( 7, 11) = 0.144657E+01
+PKER_RDRYG( 7, 12) = 0.104687E+01
+PKER_RDRYG( 7, 13) = 0.748356E+00
+PKER_RDRYG( 7, 14) = 0.548446E+00
+PKER_RDRYG( 7, 15) = 0.439652E+00
+PKER_RDRYG( 7, 16) = 0.406642E+00
+PKER_RDRYG( 7, 17) = 0.428019E+00
+PKER_RDRYG( 7, 18) = 0.481606E+00
+PKER_RDRYG( 7, 19) = 0.548855E+00
+PKER_RDRYG( 7, 20) = 0.617296E+00
+PKER_RDRYG( 7, 21) = 0.680279E+00
+PKER_RDRYG( 7, 22) = 0.735137E+00
+PKER_RDRYG( 7, 23) = 0.781510E+00
+PKER_RDRYG( 7, 24) = 0.820079E+00
+PKER_RDRYG( 7, 25) = 0.851863E+00
+PKER_RDRYG( 7, 26) = 0.877947E+00
+PKER_RDRYG( 7, 27) = 0.899335E+00
+PKER_RDRYG( 7, 28) = 0.916884E+00
+PKER_RDRYG( 7, 29) = 0.931293E+00
+PKER_RDRYG( 7, 30) = 0.943132E+00
+PKER_RDRYG( 7, 31) = 0.952865E+00
+PKER_RDRYG( 7, 32) = 0.960872E+00
+PKER_RDRYG( 7, 33) = 0.967460E+00
+PKER_RDRYG( 7, 34) = 0.972885E+00
+PKER_RDRYG( 7, 35) = 0.977352E+00
+PKER_RDRYG( 7, 36) = 0.981033E+00
+PKER_RDRYG( 7, 37) = 0.984066E+00
+PKER_RDRYG( 7, 38) = 0.986565E+00
+PKER_RDRYG( 7, 39) = 0.988627E+00
+PKER_RDRYG( 7, 40) = 0.990326E+00
+PKER_RDRYG( 8, 1) = 0.150992E+02
+PKER_RDRYG( 8, 2) = 0.123831E+02
+PKER_RDRYG( 8, 3) = 0.101315E+02
+PKER_RDRYG( 8, 4) = 0.826417E+01
+PKER_RDRYG( 8, 5) = 0.671445E+01
+PKER_RDRYG( 8, 6) = 0.542727E+01
+PKER_RDRYG( 8, 7) = 0.435711E+01
+PKER_RDRYG( 8, 8) = 0.346649E+01
+PKER_RDRYG( 8, 9) = 0.272482E+01
+PKER_RDRYG( 8, 10) = 0.210780E+01
+PKER_RDRYG( 8, 11) = 0.159717E+01
+PKER_RDRYG( 8, 12) = 0.118083E+01
+PKER_RDRYG( 8, 13) = 0.852650E+00
+PKER_RDRYG( 8, 14) = 0.610124E+00
+PKER_RDRYG( 8, 15) = 0.451060E+00
+PKER_RDRYG( 8, 16) = 0.368291E+00
+PKER_RDRYG( 8, 17) = 0.347823E+00
+PKER_RDRYG( 8, 18) = 0.371281E+00
+PKER_RDRYG( 8, 19) = 0.419706E+00
+PKER_RDRYG( 8, 20) = 0.477953E+00
+PKER_RDRYG( 8, 21) = 0.536200E+00
+PKER_RDRYG( 8, 22) = 0.589265E+00
+PKER_RDRYG( 8, 23) = 0.635216E+00
+PKER_RDRYG( 8, 24) = 0.673937E+00
+PKER_RDRYG( 8, 25) = 0.706074E+00
+PKER_RDRYG( 8, 26) = 0.732525E+00
+PKER_RDRYG( 8, 27) = 0.754218E+00
+PKER_RDRYG( 8, 28) = 0.772002E+00
+PKER_RDRYG( 8, 29) = 0.786590E+00
+PKER_RDRYG( 8, 30) = 0.798567E+00
+PKER_RDRYG( 8, 31) = 0.808406E+00
+PKER_RDRYG( 8, 32) = 0.816494E+00
+PKER_RDRYG( 8, 33) = 0.823145E+00
+PKER_RDRYG( 8, 34) = 0.828619E+00
+PKER_RDRYG( 8, 35) = 0.833124E+00
+PKER_RDRYG( 8, 36) = 0.836834E+00
+PKER_RDRYG( 8, 37) = 0.839890E+00
+PKER_RDRYG( 8, 38) = 0.842408E+00
+PKER_RDRYG( 8, 39) = 0.844484E+00
+PKER_RDRYG( 8, 40) = 0.846195E+00
+PKER_RDRYG( 9, 1) = 0.152001E+02
+PKER_RDRYG( 9, 2) = 0.124866E+02
+PKER_RDRYG( 9, 3) = 0.102380E+02
+PKER_RDRYG( 9, 4) = 0.837392E+01
+PKER_RDRYG( 9, 5) = 0.682786E+01
+PKER_RDRYG( 9, 6) = 0.554471E+01
+PKER_RDRYG( 9, 7) = 0.447886E+01
+PKER_RDRYG( 9, 8) = 0.359262E+01
+PKER_RDRYG( 9, 9) = 0.285496E+01
+PKER_RDRYG( 9, 10) = 0.224062E+01
+PKER_RDRYG( 9, 11) = 0.172961E+01
+PKER_RDRYG( 9, 12) = 0.130712E+01
+PKER_RDRYG( 9, 13) = 0.963568E+00
+PKER_RDRYG( 9, 14) = 0.694236E+00
+PKER_RDRYG( 9, 15) = 0.497828E+00
+PKER_RDRYG( 9, 16) = 0.371725E+00
+PKER_RDRYG( 9, 17) = 0.309284E+00
+PKER_RDRYG( 9, 18) = 0.298254E+00
+PKER_RDRYG( 9, 19) = 0.322338E+00
+PKER_RDRYG( 9, 20) = 0.365743E+00
+PKER_RDRYG( 9, 21) = 0.416082E+00
+PKER_RDRYG( 9, 22) = 0.465554E+00
+PKER_RDRYG( 9, 23) = 0.510205E+00
+PKER_RDRYG( 9, 24) = 0.548676E+00
+PKER_RDRYG( 9, 25) = 0.581002E+00
+PKER_RDRYG( 9, 26) = 0.607778E+00
+PKER_RDRYG( 9, 27) = 0.629790E+00
+PKER_RDRYG( 9, 28) = 0.647834E+00
+PKER_RDRYG( 9, 29) = 0.662622E+00
+PKER_RDRYG( 9, 30) = 0.674751E+00
+PKER_RDRYG( 9, 31) = 0.684707E+00
+PKER_RDRYG( 9, 32) = 0.692884E+00
+PKER_RDRYG( 9, 33) = 0.699606E+00
+PKER_RDRYG( 9, 34) = 0.705133E+00
+PKER_RDRYG( 9, 35) = 0.709680E+00
+PKER_RDRYG( 9, 36) = 0.713422E+00
+PKER_RDRYG( 9, 37) = 0.716504E+00
+PKER_RDRYG( 9, 38) = 0.719042E+00
+PKER_RDRYG( 9, 39) = 0.721132E+00
+PKER_RDRYG( 9, 40) = 0.722855E+00
+PKER_RDRYG( 10, 1) = 0.152836E+02
+PKER_RDRYG( 10, 2) = 0.125721E+02
+PKER_RDRYG( 10, 3) = 0.103257E+02
+PKER_RDRYG( 10, 4) = 0.846410E+01
+PKER_RDRYG( 10, 5) = 0.692082E+01
+PKER_RDRYG( 10, 6) = 0.564078E+01
+PKER_RDRYG( 10, 7) = 0.457835E+01
+PKER_RDRYG( 10, 8) = 0.369576E+01
+PKER_RDRYG( 10, 9) = 0.296182E+01
+PKER_RDRYG( 10, 10) = 0.235084E+01
+PKER_RDRYG( 10, 11) = 0.184198E+01
+PKER_RDRYG( 10, 12) = 0.141881E+01
+PKER_RDRYG( 10, 13) = 0.106933E+01
+PKER_RDRYG( 10, 14) = 0.786016E+00
+PKER_RDRYG( 10, 15) = 0.565474E+00
+PKER_RDRYG( 10, 16) = 0.406543E+00
+PKER_RDRYG( 10, 17) = 0.307053E+00
+PKER_RDRYG( 10, 18) = 0.260725E+00
+PKER_RDRYG( 10, 19) = 0.256389E+00
+PKER_RDRYG( 10, 20) = 0.280106E+00
+PKER_RDRYG( 10, 21) = 0.318661E+00
+PKER_RDRYG( 10, 22) = 0.362054E+00
+PKER_RDRYG( 10, 23) = 0.404004E+00
+PKER_RDRYG( 10, 24) = 0.441559E+00
+PKER_RDRYG( 10, 25) = 0.473763E+00
+PKER_RDRYG( 10, 26) = 0.500741E+00
+PKER_RDRYG( 10, 27) = 0.523049E+00
+PKER_RDRYG( 10, 28) = 0.541369E+00
+PKER_RDRYG( 10, 29) = 0.556378E+00
+PKER_RDRYG( 10, 30) = 0.568677E+00
+PKER_RDRYG( 10, 31) = 0.578762E+00
+PKER_RDRYG( 10, 32) = 0.587040E+00
+PKER_RDRYG( 10, 33) = 0.593837E+00
+PKER_RDRYG( 10, 34) = 0.599424E+00
+PKER_RDRYG( 10, 35) = 0.604017E+00
+PKER_RDRYG( 10, 36) = 0.607795E+00
+PKER_RDRYG( 10, 37) = 0.610904E+00
+PKER_RDRYG( 10, 38) = 0.613463E+00
+PKER_RDRYG( 10, 39) = 0.615571E+00
+PKER_RDRYG( 10, 40) = 0.617307E+00
+PKER_RDRYG( 11, 1) = 0.153530E+02
+PKER_RDRYG( 11, 2) = 0.126429E+02
+PKER_RDRYG( 11, 3) = 0.103982E+02
+PKER_RDRYG( 11, 4) = 0.853842E+01
+PKER_RDRYG( 11, 5) = 0.699724E+01
+PKER_RDRYG( 11, 6) = 0.571954E+01
+PKER_RDRYG( 11, 7) = 0.465974E+01
+PKER_RDRYG( 11, 8) = 0.378005E+01
+PKER_RDRYG( 11, 9) = 0.304921E+01
+PKER_RDRYG( 11, 10) = 0.244139E+01
+PKER_RDRYG( 11, 11) = 0.193535E+01
+PKER_RDRYG( 11, 12) = 0.151386E+01
+PKER_RDRYG( 11, 13) = 0.116347E+01
+PKER_RDRYG( 11, 14) = 0.874451E+00
+PKER_RDRYG( 11, 15) = 0.640975E+00
+PKER_RDRYG( 11, 16) = 0.460649E+00
+PKER_RDRYG( 11, 17) = 0.332340E+00
+PKER_RDRYG( 11, 18) = 0.254216E+00
+PKER_RDRYG( 11, 19) = 0.220358E+00
+PKER_RDRYG( 11, 20) = 0.220732E+00
+PKER_RDRYG( 11, 21) = 0.243530E+00
+PKER_RDRYG( 11, 22) = 0.277653E+00
+PKER_RDRYG( 11, 23) = 0.314885E+00
+PKER_RDRYG( 11, 24) = 0.350439E+00
+PKER_RDRYG( 11, 25) = 0.381996E+00
+PKER_RDRYG( 11, 26) = 0.408939E+00
+PKER_RDRYG( 11, 27) = 0.431452E+00
+PKER_RDRYG( 11, 28) = 0.450036E+00
+PKER_RDRYG( 11, 29) = 0.465283E+00
+PKER_RDRYG( 11, 30) = 0.477770E+00
+PKER_RDRYG( 11, 31) = 0.488000E+00
+PKER_RDRYG( 11, 32) = 0.496387E+00
+PKER_RDRYG( 11, 33) = 0.503270E+00
+PKER_RDRYG( 11, 34) = 0.508921E+00
+PKER_RDRYG( 11, 35) = 0.513565E+00
+PKER_RDRYG( 11, 36) = 0.517382E+00
+PKER_RDRYG( 11, 37) = 0.520521E+00
+PKER_RDRYG( 11, 38) = 0.523104E+00
+PKER_RDRYG( 11, 39) = 0.525230E+00
+PKER_RDRYG( 11, 40) = 0.526981E+00
+PKER_RDRYG( 12, 1) = 0.154107E+02
+PKER_RDRYG( 12, 2) = 0.127017E+02
+PKER_RDRYG( 12, 3) = 0.104582E+02
+PKER_RDRYG( 12, 4) = 0.859986E+01
+PKER_RDRYG( 12, 5) = 0.706024E+01
+PKER_RDRYG( 12, 6) = 0.578430E+01
+PKER_RDRYG( 12, 7) = 0.472649E+01
+PKER_RDRYG( 12, 8) = 0.384903E+01
+PKER_RDRYG( 12, 9) = 0.312065E+01
+PKER_RDRYG( 12, 10) = 0.251546E+01
+PKER_RDRYG( 12, 11) = 0.201208E+01
+PKER_RDRYG( 12, 12) = 0.159294E+01
+PKER_RDRYG( 12, 13) = 0.124384E+01
+PKER_RDRYG( 12, 14) = 0.953734E+00
+PKER_RDRYG( 12, 15) = 0.714822E+00
+PKER_RDRYG( 12, 16) = 0.522561E+00
+PKER_RDRYG( 12, 17) = 0.375074E+00
+PKER_RDRYG( 12, 18) = 0.271992E+00
+PKER_RDRYG( 12, 19) = 0.210994E+00
+PKER_RDRYG( 12, 20) = 0.186793E+00
+PKER_RDRYG( 12, 21) = 0.190524E+00
+PKER_RDRYG( 12, 22) = 0.211914E+00
+PKER_RDRYG( 12, 23) = 0.241853E+00
+PKER_RDRYG( 12, 24) = 0.273771E+00
+PKER_RDRYG( 12, 25) = 0.303824E+00
+PKER_RDRYG( 12, 26) = 0.330330E+00
+PKER_RDRYG( 12, 27) = 0.352868E+00
+PKER_RDRYG( 12, 28) = 0.371654E+00
+PKER_RDRYG( 12, 29) = 0.387136E+00
+PKER_RDRYG( 12, 30) = 0.399827E+00
+PKER_RDRYG( 12, 31) = 0.410216E+00
+PKER_RDRYG( 12, 32) = 0.418726E+00
+PKER_RDRYG( 12, 33) = 0.425702E+00
+PKER_RDRYG( 12, 34) = 0.431426E+00
+PKER_RDRYG( 12, 35) = 0.436125E+00
+PKER_RDRYG( 12, 36) = 0.439985E+00
+PKER_RDRYG( 12, 37) = 0.443157E+00
+PKER_RDRYG( 12, 38) = 0.445766E+00
+PKER_RDRYG( 12, 39) = 0.447913E+00
+PKER_RDRYG( 12, 40) = 0.449679E+00
+PKER_RDRYG( 13, 1) = 0.154588E+02
+PKER_RDRYG( 13, 2) = 0.127507E+02
+PKER_RDRYG( 13, 3) = 0.105081E+02
+PKER_RDRYG( 13, 4) = 0.865080E+01
+PKER_RDRYG( 13, 5) = 0.711233E+01
+PKER_RDRYG( 13, 6) = 0.583772E+01
+PKER_RDRYG( 13, 7) = 0.478139E+01
+PKER_RDRYG( 13, 8) = 0.390560E+01
+PKER_RDRYG( 13, 9) = 0.317911E+01
+PKER_RDRYG( 13, 10) = 0.257601E+01
+PKER_RDRYG( 13, 11) = 0.207487E+01
+PKER_RDRYG( 13, 12) = 0.165798E+01
+PKER_RDRYG( 13, 13) = 0.131083E+01
+PKER_RDRYG( 13, 14) = 0.102169E+01
+PKER_RDRYG( 13, 15) = 0.781536E+00
+PKER_RDRYG( 13, 16) = 0.584105E+00
+PKER_RDRYG( 13, 17) = 0.425921E+00
+PKER_RDRYG( 13, 18) = 0.305717E+00
+PKER_RDRYG( 13, 19) = 0.222926E+00
+PKER_RDRYG( 13, 20) = 0.175670E+00
+PKER_RDRYG( 13, 21) = 0.158795E+00
+PKER_RDRYG( 13, 22) = 0.164617E+00
+PKER_RDRYG( 13, 23) = 0.184416E+00
+PKER_RDRYG( 13, 24) = 0.210615E+00
+PKER_RDRYG( 13, 25) = 0.237900E+00
+PKER_RDRYG( 13, 26) = 0.263298E+00
+PKER_RDRYG( 13, 27) = 0.285545E+00
+PKER_RDRYG( 13, 28) = 0.304391E+00
+PKER_RDRYG( 13, 29) = 0.320063E+00
+PKER_RDRYG( 13, 30) = 0.332961E+00
+PKER_RDRYG( 13, 31) = 0.343525E+00
+PKER_RDRYG( 13, 32) = 0.352171E+00
+PKER_RDRYG( 13, 33) = 0.359251E+00
+PKER_RDRYG( 13, 34) = 0.365054E+00
+PKER_RDRYG( 13, 35) = 0.369814E+00
+PKER_RDRYG( 13, 36) = 0.373722E+00
+PKER_RDRYG( 13, 37) = 0.376931E+00
+PKER_RDRYG( 13, 38) = 0.379569E+00
+PKER_RDRYG( 13, 39) = 0.381737E+00
+PKER_RDRYG( 13, 40) = 0.383521E+00
+PKER_RDRYG( 14, 1) = 0.154991E+02
+PKER_RDRYG( 14, 2) = 0.127916E+02
+PKER_RDRYG( 14, 3) = 0.105497E+02
+PKER_RDRYG( 14, 4) = 0.869314E+01
+PKER_RDRYG( 14, 5) = 0.715554E+01
+PKER_RDRYG( 14, 6) = 0.588191E+01
+PKER_RDRYG( 14, 7) = 0.482668E+01
+PKER_RDRYG( 14, 8) = 0.395215E+01
+PKER_RDRYG( 14, 9) = 0.322708E+01
+PKER_RDRYG( 14, 10) = 0.262557E+01
+PKER_RDRYG( 14, 11) = 0.212620E+01
+PKER_RDRYG( 14, 12) = 0.171122E+01
+PKER_RDRYG( 14, 13) = 0.136596E+01
+PKER_RDRYG( 14, 14) = 0.107842E+01
+PKER_RDRYG( 14, 15) = 0.838958E+00
+PKER_RDRYG( 14, 16) = 0.640183E+00
+PKER_RDRYG( 14, 17) = 0.477107E+00
+PKER_RDRYG( 14, 18) = 0.347057E+00
+PKER_RDRYG( 14, 19) = 0.249165E+00
+PKER_RDRYG( 14, 20) = 0.183013E+00
+PKER_RDRYG( 14, 21) = 0.146601E+00
+PKER_RDRYG( 14, 22) = 0.135353E+00
+PKER_RDRYG( 14, 23) = 0.142468E+00
+PKER_RDRYG( 14, 24) = 0.160555E+00
+PKER_RDRYG( 14, 25) = 0.183354E+00
+PKER_RDRYG( 14, 26) = 0.206635E+00
+PKER_RDRYG( 14, 27) = 0.228070E+00
+PKER_RDRYG( 14, 28) = 0.246738E+00
+PKER_RDRYG( 14, 29) = 0.262495E+00
+PKER_RDRYG( 14, 30) = 0.275569E+00
+PKER_RDRYG( 14, 31) = 0.286313E+00
+PKER_RDRYG( 14, 32) = 0.295107E+00
+PKER_RDRYG( 14, 33) = 0.302303E+00
+PKER_RDRYG( 14, 34) = 0.308195E+00
+PKER_RDRYG( 14, 35) = 0.313023E+00
+PKER_RDRYG( 14, 36) = 0.316982E+00
+PKER_RDRYG( 14, 37) = 0.320232E+00
+PKER_RDRYG( 14, 38) = 0.322901E+00
+PKER_RDRYG( 14, 39) = 0.325094E+00
+PKER_RDRYG( 14, 40) = 0.326896E+00
+PKER_RDRYG( 15, 1) = 0.155328E+02
+PKER_RDRYG( 15, 2) = 0.128258E+02
+PKER_RDRYG( 15, 3) = 0.105844E+02
+PKER_RDRYG( 15, 4) = 0.872843E+01
+PKER_RDRYG( 15, 5) = 0.719148E+01
+PKER_RDRYG( 15, 6) = 0.591857E+01
+PKER_RDRYG( 15, 7) = 0.486417E+01
+PKER_RDRYG( 15, 8) = 0.399057E+01
+PKER_RDRYG( 15, 9) = 0.326656E+01
+PKER_RDRYG( 15, 10) = 0.266625E+01
+PKER_RDRYG( 15, 11) = 0.216823E+01
+PKER_RDRYG( 15, 12) = 0.175475E+01
+PKER_RDRYG( 15, 13) = 0.141110E+01
+PKER_RDRYG( 15, 14) = 0.112517E+01
+PKER_RDRYG( 15, 15) = 0.887014E+00
+PKER_RDRYG( 15, 16) = 0.688694E+00
+PKER_RDRYG( 15, 17) = 0.524210E+00
+PKER_RDRYG( 15, 18) = 0.389564E+00
+PKER_RDRYG( 15, 19) = 0.282710E+00
+PKER_RDRYG( 15, 20) = 0.203209E+00
+PKER_RDRYG( 15, 21) = 0.150500E+00
+PKER_RDRYG( 15, 22) = 0.122720E+00
+PKER_RDRYG( 15, 23) = 0.115684E+00
+PKER_RDRYG( 15, 24) = 0.123454E+00
+PKER_RDRYG( 15, 25) = 0.139800E+00
+PKER_RDRYG( 15, 26) = 0.159573E+00
+PKER_RDRYG( 15, 27) = 0.179400E+00
+PKER_RDRYG( 15, 28) = 0.197477E+00
+PKER_RDRYG( 15, 29) = 0.213128E+00
+PKER_RDRYG( 15, 30) = 0.226299E+00
+PKER_RDRYG( 15, 31) = 0.237204E+00
+PKER_RDRYG( 15, 32) = 0.246155E+00
+PKER_RDRYG( 15, 33) = 0.253478E+00
+PKER_RDRYG( 15, 34) = 0.259467E+00
+PKER_RDRYG( 15, 35) = 0.264371E+00
+PKER_RDRYG( 15, 36) = 0.268388E+00
+PKER_RDRYG( 15, 37) = 0.271682E+00
+PKER_RDRYG( 15, 38) = 0.274385E+00
+PKER_RDRYG( 15, 39) = 0.276605E+00
+PKER_RDRYG( 15, 40) = 0.278428E+00
+PKER_RDRYG( 16, 1) = 0.155611E+02
+PKER_RDRYG( 16, 2) = 0.128544E+02
+PKER_RDRYG( 16, 3) = 0.106134E+02
+PKER_RDRYG( 16, 4) = 0.875790E+01
+PKER_RDRYG( 16, 5) = 0.722144E+01
+PKER_RDRYG( 16, 6) = 0.594908E+01
+PKER_RDRYG( 16, 7) = 0.489528E+01
+PKER_RDRYG( 16, 8) = 0.402238E+01
+PKER_RDRYG( 16, 9) = 0.329915E+01
+PKER_RDRYG( 16, 10) = 0.269974E+01
+PKER_RDRYG( 16, 11) = 0.220274E+01
+PKER_RDRYG( 16, 12) = 0.179040E+01
+PKER_RDRYG( 16, 13) = 0.144802E+01
+PKER_RDRYG( 16, 14) = 0.116345E+01
+PKER_RDRYG( 16, 15) = 0.926641E+00
+PKER_RDRYG( 16, 16) = 0.729392E+00
+PKER_RDRYG( 16, 17) = 0.565165E+00
+PKER_RDRYG( 16, 18) = 0.429078E+00
+PKER_RDRYG( 16, 19) = 0.317968E+00
+PKER_RDRYG( 16, 20) = 0.230366E+00
+PKER_RDRYG( 16, 21) = 0.165832E+00
+PKER_RDRYG( 16, 22) = 0.123999E+00
+PKER_RDRYG( 16, 23) = 0.102998E+00
+PKER_RDRYG( 16, 24) = 0.991169E-01
+PKER_RDRYG( 16, 25) = 0.107099E+00
+PKER_RDRYG( 16, 26) = 0.121727E+00
+PKER_RDRYG( 16, 27) = 0.138829E+00
+PKER_RDRYG( 16, 28) = 0.155681E+00
+PKER_RDRYG( 16, 29) = 0.170911E+00
+PKER_RDRYG( 16, 30) = 0.184033E+00
+PKER_RDRYG( 16, 31) = 0.195040E+00
+PKER_RDRYG( 16, 32) = 0.204136E+00
+PKER_RDRYG( 16, 33) = 0.211593E+00
+PKER_RDRYG( 16, 34) = 0.217691E+00
+PKER_RDRYG( 16, 35) = 0.222677E+00
+PKER_RDRYG( 16, 36) = 0.226759E+00
+PKER_RDRYG( 16, 37) = 0.230102E+00
+PKER_RDRYG( 16, 38) = 0.232843E+00
+PKER_RDRYG( 16, 39) = 0.235091E+00
+PKER_RDRYG( 16, 40) = 0.236937E+00
+PKER_RDRYG( 17, 1) = 0.155848E+02
+PKER_RDRYG( 17, 2) = 0.128785E+02
+PKER_RDRYG( 17, 3) = 0.106378E+02
+PKER_RDRYG( 17, 4) = 0.878258E+01
+PKER_RDRYG( 17, 5) = 0.724648E+01
+PKER_RDRYG( 17, 6) = 0.597452E+01
+PKER_RDRYG( 17, 7) = 0.492118E+01
+PKER_RDRYG( 17, 8) = 0.404879E+01
+PKER_RDRYG( 17, 9) = 0.332615E+01
+PKER_RDRYG( 17, 10) = 0.272740E+01
+PKER_RDRYG( 17, 11) = 0.223115E+01
+PKER_RDRYG( 17, 12) = 0.181967E+01
+PKER_RDRYG( 17, 13) = 0.147827E+01
+PKER_RDRYG( 17, 14) = 0.119477E+01
+PKER_RDRYG( 17, 15) = 0.959115E+00
+PKER_RDRYG( 17, 16) = 0.762992E+00
+PKER_RDRYG( 17, 17) = 0.599624E+00
+PKER_RDRYG( 17, 18) = 0.463642E+00
+PKER_RDRYG( 17, 19) = 0.351078E+00
+PKER_RDRYG( 17, 20) = 0.259445E+00
+PKER_RDRYG( 17, 21) = 0.187672E+00
+PKER_RDRYG( 17, 22) = 0.135435E+00
+PKER_RDRYG( 17, 23) = 0.102368E+00
+PKER_RDRYG( 17, 24) = 0.867396E-01
+PKER_RDRYG( 17, 25) = 0.850688E-01
+PKER_RDRYG( 17, 26) = 0.929638E-01
+PKER_RDRYG( 17, 27) = 0.105991E+00
+PKER_RDRYG( 17, 28) = 0.120728E+00
+PKER_RDRYG( 17, 29) = 0.135039E+00
+PKER_RDRYG( 17, 30) = 0.147861E+00
+PKER_RDRYG( 17, 31) = 0.158856E+00
+PKER_RDRYG( 17, 32) = 0.168054E+00
+PKER_RDRYG( 17, 33) = 0.175640E+00
+PKER_RDRYG( 17, 34) = 0.181854E+00
+PKER_RDRYG( 17, 35) = 0.186932E+00
+PKER_RDRYG( 17, 36) = 0.191084E+00
+PKER_RDRYG( 17, 37) = 0.194481E+00
+PKER_RDRYG( 17, 38) = 0.197264E+00
+PKER_RDRYG( 17, 39) = 0.199545E+00
+PKER_RDRYG( 17, 40) = 0.201416E+00
+PKER_RDRYG( 18, 1) = 0.156048E+02
+PKER_RDRYG( 18, 2) = 0.128987E+02
+PKER_RDRYG( 18, 3) = 0.106582E+02
+PKER_RDRYG( 18, 4) = 0.880327E+01
+PKER_RDRYG( 18, 5) = 0.726745E+01
+PKER_RDRYG( 18, 6) = 0.599579E+01
+PKER_RDRYG( 18, 7) = 0.494280E+01
+PKER_RDRYG( 18, 8) = 0.407079E+01
+PKER_RDRYG( 18, 9) = 0.334857E+01
+PKER_RDRYG( 18, 10) = 0.275031E+01
+PKER_RDRYG( 18, 11) = 0.225462E+01
+PKER_RDRYG( 18, 12) = 0.184378E+01
+PKER_RDRYG( 18, 13) = 0.150310E+01
+PKER_RDRYG( 18, 14) = 0.122043E+01
+PKER_RDRYG( 18, 15) = 0.985691E+00
+PKER_RDRYG( 18, 16) = 0.790542E+00
+PKER_RDRYG( 18, 17) = 0.628114E+00
+PKER_RDRYG( 18, 18) = 0.492811E+00
+PKER_RDRYG( 18, 19) = 0.380219E+00
+PKER_RDRYG( 18, 20) = 0.287142E+00
+PKER_RDRYG( 18, 21) = 0.211629E+00
+PKER_RDRYG( 18, 22) = 0.152851E+00
+PKER_RDRYG( 18, 23) = 0.110724E+00
+PKER_RDRYG( 18, 24) = 0.847137E-01
+PKER_RDRYG( 18, 25) = 0.732323E-01
+PKER_RDRYG( 18, 26) = 0.732076E-01
+PKER_RDRYG( 18, 27) = 0.807748E-01
+PKER_RDRYG( 18, 28) = 0.922834E-01
+PKER_RDRYG( 18, 29) = 0.104948E+00
+PKER_RDRYG( 18, 30) = 0.117078E+00
+PKER_RDRYG( 18, 31) = 0.127868E+00
+PKER_RDRYG( 18, 32) = 0.137079E+00
+PKER_RDRYG( 18, 33) = 0.144764E+00
+PKER_RDRYG( 18, 34) = 0.151091E+00
+PKER_RDRYG( 18, 35) = 0.156269E+00
+PKER_RDRYG( 18, 36) = 0.160499E+00
+PKER_RDRYG( 18, 37) = 0.163956E+00
+PKER_RDRYG( 18, 38) = 0.166785E+00
+PKER_RDRYG( 18, 39) = 0.169102E+00
+PKER_RDRYG( 18, 40) = 0.171000E+00
+PKER_RDRYG( 19, 1) = 0.156217E+02
+PKER_RDRYG( 19, 2) = 0.129157E+02
+PKER_RDRYG( 19, 3) = 0.106754E+02
+PKER_RDRYG( 19, 4) = 0.882064E+01
+PKER_RDRYG( 19, 5) = 0.728503E+01
+PKER_RDRYG( 19, 6) = 0.601361E+01
+PKER_RDRYG( 19, 7) = 0.496087E+01
+PKER_RDRYG( 19, 8) = 0.408915E+01
+PKER_RDRYG( 19, 9) = 0.336725E+01
+PKER_RDRYG( 19, 10) = 0.276936E+01
+PKER_RDRYG( 19, 11) = 0.227408E+01
+PKER_RDRYG( 19, 12) = 0.186371E+01
+PKER_RDRYG( 19, 13) = 0.152357E+01
+PKER_RDRYG( 19, 14) = 0.124151E+01
+PKER_RDRYG( 19, 15) = 0.100747E+01
+PKER_RDRYG( 19, 16) = 0.813095E+00
+PKER_RDRYG( 19, 17) = 0.651490E+00
+PKER_RDRYG( 19, 18) = 0.516968E+00
+PKER_RDRYG( 19, 19) = 0.404911E+00
+PKER_RDRYG( 19, 20) = 0.311706E+00
+PKER_RDRYG( 19, 21) = 0.234763E+00
+PKER_RDRYG( 19, 22) = 0.172575E+00
+PKER_RDRYG( 19, 23) = 0.124563E+00
+PKER_RDRYG( 19, 24) = 0.906076E-01
+PKER_RDRYG( 19, 25) = 0.702940E-01
+PKER_RDRYG( 19, 26) = 0.620081E-01
+PKER_RDRYG( 19, 27) = 0.630865E-01
+PKER_RDRYG( 19, 28) = 0.702057E-01
+PKER_RDRYG( 19, 29) = 0.803254E-01
+PKER_RDRYG( 19, 30) = 0.911904E-01
+PKER_RDRYG( 19, 31) = 0.101465E+00
+PKER_RDRYG( 19, 32) = 0.110536E+00
+PKER_RDRYG( 19, 33) = 0.118251E+00
+PKER_RDRYG( 19, 34) = 0.124670E+00
+PKER_RDRYG( 19, 35) = 0.129948E+00
+PKER_RDRYG( 19, 36) = 0.134262E+00
+PKER_RDRYG( 19, 37) = 0.137786E+00
+PKER_RDRYG( 19, 38) = 0.140666E+00
+PKER_RDRYG( 19, 39) = 0.143022E+00
+PKER_RDRYG( 19, 40) = 0.144951E+00
+PKER_RDRYG( 20, 1) = 0.156359E+02
+PKER_RDRYG( 20, 2) = 0.129300E+02
+PKER_RDRYG( 20, 3) = 0.106899E+02
+PKER_RDRYG( 20, 4) = 0.883526E+01
+PKER_RDRYG( 20, 5) = 0.729981E+01
+PKER_RDRYG( 20, 6) = 0.602856E+01
+PKER_RDRYG( 20, 7) = 0.497602E+01
+PKER_RDRYG( 20, 8) = 0.410451E+01
+PKER_RDRYG( 20, 9) = 0.338285E+01
+PKER_RDRYG( 20, 10) = 0.278523E+01
+PKER_RDRYG( 20, 11) = 0.229026E+01
+PKER_RDRYG( 20, 12) = 0.188023E+01
+PKER_RDRYG( 20, 13) = 0.154049E+01
+PKER_RDRYG( 20, 14) = 0.125889E+01
+PKER_RDRYG( 20, 15) = 0.102536E+01
+PKER_RDRYG( 20, 16) = 0.831581E+00
+PKER_RDRYG( 20, 17) = 0.670632E+00
+PKER_RDRYG( 20, 18) = 0.536803E+00
+PKER_RDRYG( 20, 19) = 0.425393E+00
+PKER_RDRYG( 20, 20) = 0.332592E+00
+PKER_RDRYG( 20, 21) = 0.255441E+00
+PKER_RDRYG( 20, 22) = 0.191863E+00
+PKER_RDRYG( 20, 23) = 0.140678E+00
+PKER_RDRYG( 20, 24) = 0.101505E+00
+PKER_RDRYG( 20, 25) = 0.742493E-01
+PKER_RDRYG( 20, 26) = 0.584264E-01
+PKER_RDRYG( 20, 27) = 0.526432E-01
+PKER_RDRYG( 20, 28) = 0.544495E-01
+PKER_RDRYG( 20, 29) = 0.610513E-01
+PKER_RDRYG( 20, 30) = 0.699078E-01
+PKER_RDRYG( 20, 31) = 0.792045E-01
+PKER_RDRYG( 20, 32) = 0.878929E-01
+PKER_RDRYG( 20, 33) = 0.955190E-01
+PKER_RDRYG( 20, 34) = 0.101978E+00
+PKER_RDRYG( 20, 35) = 0.107340E+00
+PKER_RDRYG( 20, 36) = 0.111742E+00
+PKER_RDRYG( 20, 37) = 0.115338E+00
+PKER_RDRYG( 20, 38) = 0.118274E+00
+PKER_RDRYG( 20, 39) = 0.120673E+00
+PKER_RDRYG( 20, 40) = 0.122635E+00
+PKER_RDRYG( 21, 1) = 0.156479E+02
+PKER_RDRYG( 21, 2) = 0.129421E+02
+PKER_RDRYG( 21, 3) = 0.107021E+02
+PKER_RDRYG( 21, 4) = 0.884758E+01
+PKER_RDRYG( 21, 5) = 0.731225E+01
+PKER_RDRYG( 21, 6) = 0.604114E+01
+PKER_RDRYG( 21, 7) = 0.498874E+01
+PKER_RDRYG( 21, 8) = 0.411739E+01
+PKER_RDRYG( 21, 9) = 0.339591E+01
+PKER_RDRYG( 21, 10) = 0.279849E+01
+PKER_RDRYG( 21, 11) = 0.230374E+01
+PKER_RDRYG( 21, 12) = 0.189397E+01
+PKER_RDRYG( 21, 13) = 0.155452E+01
+PKER_RDRYG( 21, 14) = 0.127326E+01
+PKER_RDRYG( 21, 15) = 0.104012E+01
+PKER_RDRYG( 21, 16) = 0.846776E+00
+PKER_RDRYG( 21, 17) = 0.686327E+00
+PKER_RDRYG( 21, 18) = 0.553054E+00
+PKER_RDRYG( 21, 19) = 0.442227E+00
+PKER_RDRYG( 21, 20) = 0.349958E+00
+PKER_RDRYG( 21, 21) = 0.273107E+00
+PKER_RDRYG( 21, 22) = 0.209258E+00
+PKER_RDRYG( 21, 23) = 0.156741E+00
+PKER_RDRYG( 21, 24) = 0.114650E+00
+PKER_RDRYG( 21, 25) = 0.827499E-01
+PKER_RDRYG( 21, 26) = 0.609346E-01
+PKER_RDRYG( 21, 27) = 0.487447E-01
+PKER_RDRYG( 21, 28) = 0.448236E-01
+PKER_RDRYG( 21, 29) = 0.470754E-01
+PKER_RDRYG( 21, 30) = 0.531032E-01
+PKER_RDRYG( 21, 31) = 0.608204E-01
+PKER_RDRYG( 21, 32) = 0.687615E-01
+PKER_RDRYG( 21, 33) = 0.761062E-01
+PKER_RDRYG( 21, 34) = 0.825119E-01
+PKER_RDRYG( 21, 35) = 0.879190E-01
+PKER_RDRYG( 21, 36) = 0.923978E-01
+PKER_RDRYG( 21, 37) = 0.960692E-01
+PKER_RDRYG( 21, 38) = 0.990669E-01
+PKER_RDRYG( 21, 39) = 0.101514E+00
+PKER_RDRYG( 21, 40) = 0.103513E+00
+PKER_RDRYG( 22, 1) = 0.156580E+02
+PKER_RDRYG( 22, 2) = 0.129523E+02
+PKER_RDRYG( 22, 3) = 0.107124E+02
+PKER_RDRYG( 22, 4) = 0.885797E+01
+PKER_RDRYG( 22, 5) = 0.732273E+01
+PKER_RDRYG( 22, 6) = 0.605172E+01
+PKER_RDRYG( 22, 7) = 0.499943E+01
+PKER_RDRYG( 22, 8) = 0.412821E+01
+PKER_RDRYG( 22, 9) = 0.340686E+01
+PKER_RDRYG( 22, 10) = 0.280959E+01
+PKER_RDRYG( 22, 11) = 0.231501E+01
+PKER_RDRYG( 22, 12) = 0.190543E+01
+PKER_RDRYG( 22, 13) = 0.156620E+01
+PKER_RDRYG( 22, 14) = 0.128518E+01
+PKER_RDRYG( 22, 15) = 0.105232E+01
+PKER_RDRYG( 22, 16) = 0.859305E+00
+PKER_RDRYG( 22, 17) = 0.699230E+00
+PKER_RDRYG( 22, 18) = 0.566381E+00
+PKER_RDRYG( 22, 19) = 0.456024E+00
+PKER_RDRYG( 22, 20) = 0.364245E+00
+PKER_RDRYG( 22, 21) = 0.287830E+00
+PKER_RDRYG( 22, 22) = 0.224192E+00
+PKER_RDRYG( 22, 23) = 0.171359E+00
+PKER_RDRYG( 22, 24) = 0.128001E+00
+PKER_RDRYG( 22, 25) = 0.934489E-01
+PKER_RDRYG( 22, 26) = 0.674901E-01
+PKER_RDRYG( 22, 27) = 0.500882E-01
+PKER_RDRYG( 22, 28) = 0.407416E-01
+PKER_RDRYG( 22, 29) = 0.382527E-01
+PKER_RDRYG( 22, 30) = 0.407450E-01
+PKER_RDRYG( 22, 31) = 0.462007E-01
+PKER_RDRYG( 22, 32) = 0.529000E-01
+PKER_RDRYG( 22, 33) = 0.596709E-01
+PKER_RDRYG( 22, 34) = 0.658722E-01
+PKER_RDRYG( 22, 35) = 0.712512E-01
+PKER_RDRYG( 22, 36) = 0.757772E-01
+PKER_RDRYG( 22, 37) = 0.795178E-01
+PKER_RDRYG( 22, 38) = 0.825803E-01
+PKER_RDRYG( 22, 39) = 0.850795E-01
+PKER_RDRYG( 22, 40) = 0.871191E-01
+PKER_RDRYG( 23, 1) = 0.156666E+02
+PKER_RDRYG( 23, 2) = 0.129610E+02
+PKER_RDRYG( 23, 3) = 0.107211E+02
+PKER_RDRYG( 23, 4) = 0.886674E+01
+PKER_RDRYG( 23, 5) = 0.733158E+01
+PKER_RDRYG( 23, 6) = 0.606064E+01
+PKER_RDRYG( 23, 7) = 0.500844E+01
+PKER_RDRYG( 23, 8) = 0.413730E+01
+PKER_RDRYG( 23, 9) = 0.341606E+01
+PKER_RDRYG( 23, 10) = 0.281890E+01
+PKER_RDRYG( 23, 11) = 0.232445E+01
+PKER_RDRYG( 23, 12) = 0.191501E+01
+PKER_RDRYG( 23, 13) = 0.157594E+01
+PKER_RDRYG( 23, 14) = 0.129510E+01
+PKER_RDRYG( 23, 15) = 0.106245E+01
+PKER_RDRYG( 23, 16) = 0.869674E+00
+PKER_RDRYG( 23, 17) = 0.709873E+00
+PKER_RDRYG( 23, 18) = 0.577340E+00
+PKER_RDRYG( 23, 19) = 0.467343E+00
+PKER_RDRYG( 23, 20) = 0.375961E+00
+PKER_RDRYG( 23, 21) = 0.299956E+00
+PKER_RDRYG( 23, 22) = 0.236671E+00
+PKER_RDRYG( 23, 23) = 0.183979E+00
+PKER_RDRYG( 23, 24) = 0.140272E+00
+PKER_RDRYG( 23, 25) = 0.104494E+00
+PKER_RDRYG( 23, 26) = 0.761340E-01
+PKER_RDRYG( 23, 27) = 0.550738E-01
+PKER_RDRYG( 23, 28) = 0.412380E-01
+PKER_RDRYG( 23, 29) = 0.341626E-01
+PKER_RDRYG( 23, 30) = 0.327198E-01
+PKER_RDRYG( 23, 31) = 0.353014E-01
+PKER_RDRYG( 23, 32) = 0.401947E-01
+PKER_RDRYG( 23, 33) = 0.459971E-01
+PKER_RDRYG( 23, 34) = 0.517601E-01
+PKER_RDRYG( 23, 35) = 0.569916E-01
+PKER_RDRYG( 23, 36) = 0.615074E-01
+PKER_RDRYG( 23, 37) = 0.652947E-01
+PKER_RDRYG( 23, 38) = 0.684187E-01
+PKER_RDRYG( 23, 39) = 0.709735E-01
+PKER_RDRYG( 23, 40) = 0.730575E-01
+PKER_RDRYG( 24, 1) = 0.156739E+02
+PKER_RDRYG( 24, 2) = 0.129683E+02
+PKER_RDRYG( 24, 3) = 0.107284E+02
+PKER_RDRYG( 24, 4) = 0.887415E+01
+PKER_RDRYG( 24, 5) = 0.733905E+01
+PKER_RDRYG( 24, 6) = 0.606817E+01
+PKER_RDRYG( 24, 7) = 0.501603E+01
+PKER_RDRYG( 24, 8) = 0.414497E+01
+PKER_RDRYG( 24, 9) = 0.342381E+01
+PKER_RDRYG( 24, 10) = 0.282673E+01
+PKER_RDRYG( 24, 11) = 0.233237E+01
+PKER_RDRYG( 24, 12) = 0.192304E+01
+PKER_RDRYG( 24, 13) = 0.158408E+01
+PKER_RDRYG( 24, 14) = 0.130338E+01
+PKER_RDRYG( 24, 15) = 0.107089E+01
+PKER_RDRYG( 24, 16) = 0.878282E+00
+PKER_RDRYG( 24, 17) = 0.718684E+00
+PKER_RDRYG( 24, 18) = 0.586383E+00
+PKER_RDRYG( 24, 19) = 0.476653E+00
+PKER_RDRYG( 24, 20) = 0.385576E+00
+PKER_RDRYG( 24, 21) = 0.309906E+00
+PKER_RDRYG( 24, 22) = 0.246964E+00
+PKER_RDRYG( 24, 23) = 0.194554E+00
+PKER_RDRYG( 24, 24) = 0.150927E+00
+PKER_RDRYG( 24, 25) = 0.114779E+00
+PKER_RDRYG( 24, 26) = 0.852750E-01
+PKER_RDRYG( 24, 27) = 0.620279E-01
+PKER_RDRYG( 24, 28) = 0.449765E-01
+PKER_RDRYG( 24, 29) = 0.340278E-01
+PKER_RDRYG( 24, 30) = 0.287248E-01
+PKER_RDRYG( 24, 31) = 0.280506E-01
+PKER_RDRYG( 24, 32) = 0.306122E-01
+PKER_RDRYG( 24, 33) = 0.349754E-01
+PKER_RDRYG( 24, 34) = 0.399788E-01
+PKER_RDRYG( 24, 35) = 0.448785E-01
+PKER_RDRYG( 24, 36) = 0.492896E-01
+PKER_RDRYG( 24, 37) = 0.530789E-01
+PKER_RDRYG( 24, 38) = 0.562478E-01
+PKER_RDRYG( 24, 39) = 0.588567E-01
+PKER_RDRYG( 24, 40) = 0.609882E-01
+PKER_RDRYG( 25, 1) = 0.156801E+02
+PKER_RDRYG( 25, 2) = 0.129745E+02
+PKER_RDRYG( 25, 3) = 0.107347E+02
+PKER_RDRYG( 25, 4) = 0.888043E+01
+PKER_RDRYG( 25, 5) = 0.734536E+01
+PKER_RDRYG( 25, 6) = 0.607453E+01
+PKER_RDRYG( 25, 7) = 0.502245E+01
+PKER_RDRYG( 25, 8) = 0.415144E+01
+PKER_RDRYG( 25, 9) = 0.343033E+01
+PKER_RDRYG( 25, 10) = 0.283332E+01
+PKER_RDRYG( 25, 11) = 0.233903E+01
+PKER_RDRYG( 25, 12) = 0.192978E+01
+PKER_RDRYG( 25, 13) = 0.159091E+01
+PKER_RDRYG( 25, 14) = 0.131031E+01
+PKER_RDRYG( 25, 15) = 0.107793E+01
+PKER_RDRYG( 25, 16) = 0.885452E+00
+PKER_RDRYG( 25, 17) = 0.726001E+00
+PKER_RDRYG( 25, 18) = 0.593871E+00
+PKER_RDRYG( 25, 19) = 0.484338E+00
+PKER_RDRYG( 25, 20) = 0.393487E+00
+PKER_RDRYG( 25, 21) = 0.318075E+00
+PKER_RDRYG( 25, 22) = 0.255416E+00
+PKER_RDRYG( 25, 23) = 0.203291E+00
+PKER_RDRYG( 25, 24) = 0.159889E+00
+PKER_RDRYG( 25, 25) = 0.123773E+00
+PKER_RDRYG( 25, 26) = 0.938825E-01
+PKER_RDRYG( 25, 27) = 0.695667E-01
+PKER_RDRYG( 25, 28) = 0.505383E-01
+PKER_RDRYG( 25, 29) = 0.367602E-01
+PKER_RDRYG( 25, 30) = 0.281404E-01
+PKER_RDRYG( 25, 31) = 0.242165E-01
+PKER_RDRYG( 25, 32) = 0.240985E-01
+PKER_RDRYG( 25, 33) = 0.265682E-01
+PKER_RDRYG( 25, 34) = 0.304264E-01
+PKER_RDRYG( 25, 35) = 0.347350E-01
+PKER_RDRYG( 25, 36) = 0.388954E-01
+PKER_RDRYG( 25, 37) = 0.426118E-01
+PKER_RDRYG( 25, 38) = 0.457911E-01
+PKER_RDRYG( 25, 39) = 0.484422E-01
+PKER_RDRYG( 25, 40) = 0.506210E-01
+PKER_RDRYG( 26, 1) = 0.156853E+02
+PKER_RDRYG( 26, 2) = 0.129797E+02
+PKER_RDRYG( 26, 3) = 0.107400E+02
+PKER_RDRYG( 26, 4) = 0.888574E+01
+PKER_RDRYG( 26, 5) = 0.735071E+01
+PKER_RDRYG( 26, 6) = 0.607992E+01
+PKER_RDRYG( 26, 7) = 0.502787E+01
+PKER_RDRYG( 26, 8) = 0.415690E+01
+PKER_RDRYG( 26, 9) = 0.343584E+01
+PKER_RDRYG( 26, 10) = 0.283888E+01
+PKER_RDRYG( 26, 11) = 0.234464E+01
+PKER_RDRYG( 26, 12) = 0.193545E+01
+PKER_RDRYG( 26, 13) = 0.159665E+01
+PKER_RDRYG( 26, 14) = 0.131612E+01
+PKER_RDRYG( 26, 15) = 0.108382E+01
+PKER_RDRYG( 26, 16) = 0.891439E+00
+PKER_RDRYG( 26, 17) = 0.732097E+00
+PKER_RDRYG( 26, 18) = 0.600091E+00
+PKER_RDRYG( 26, 19) = 0.490702E+00
+PKER_RDRYG( 26, 20) = 0.400018E+00
+PKER_RDRYG( 26, 21) = 0.324798E+00
+PKER_RDRYG( 26, 22) = 0.262357E+00
+PKER_RDRYG( 26, 23) = 0.210471E+00
+PKER_RDRYG( 26, 24) = 0.167304E+00
+PKER_RDRYG( 26, 25) = 0.131363E+00
+PKER_RDRYG( 26, 26) = 0.101467E+00
+PKER_RDRYG( 26, 27) = 0.767609E-01
+PKER_RDRYG( 26, 28) = 0.567283E-01
+PKER_RDRYG( 26, 29) = 0.411794E-01
+PKER_RDRYG( 26, 30) = 0.300747E-01
+PKER_RDRYG( 26, 31) = 0.233080E-01
+PKER_RDRYG( 26, 32) = 0.204716E-01
+PKER_RDRYG( 26, 33) = 0.207372E-01
+PKER_RDRYG( 26, 34) = 0.230713E-01
+PKER_RDRYG( 26, 35) = 0.264699E-01
+PKER_RDRYG( 26, 36) = 0.301689E-01
+PKER_RDRYG( 26, 37) = 0.336958E-01
+PKER_RDRYG( 26, 38) = 0.368256E-01
+PKER_RDRYG( 26, 39) = 0.394921E-01
+PKER_RDRYG( 26, 40) = 0.417098E-01
+PKER_RDRYG( 27, 1) = 0.156897E+02
+PKER_RDRYG( 27, 2) = 0.129842E+02
+PKER_RDRYG( 27, 3) = 0.107444E+02
+PKER_RDRYG( 27, 4) = 0.889024E+01
+PKER_RDRYG( 27, 5) = 0.735524E+01
+PKER_RDRYG( 27, 6) = 0.608447E+01
+PKER_RDRYG( 27, 7) = 0.503245E+01
+PKER_RDRYG( 27, 8) = 0.416152E+01
+PKER_RDRYG( 27, 9) = 0.344049E+01
+PKER_RDRYG( 27, 10) = 0.284357E+01
+PKER_RDRYG( 27, 11) = 0.234937E+01
+PKER_RDRYG( 27, 12) = 0.194022E+01
+PKER_RDRYG( 27, 13) = 0.160147E+01
+PKER_RDRYG( 27, 14) = 0.132100E+01
+PKER_RDRYG( 27, 15) = 0.108876E+01
+PKER_RDRYG( 27, 16) = 0.896452E+00
+PKER_RDRYG( 27, 17) = 0.737189E+00
+PKER_RDRYG( 27, 18) = 0.605275E+00
+PKER_RDRYG( 27, 19) = 0.495991E+00
+PKER_RDRYG( 27, 20) = 0.405429E+00
+PKER_RDRYG( 27, 21) = 0.330350E+00
+PKER_RDRYG( 27, 22) = 0.268071E+00
+PKER_RDRYG( 27, 23) = 0.216369E+00
+PKER_RDRYG( 27, 24) = 0.173404E+00
+PKER_RDRYG( 27, 25) = 0.137657E+00
+PKER_RDRYG( 27, 26) = 0.107894E+00
+PKER_RDRYG( 27, 27) = 0.831508E-01
+PKER_RDRYG( 27, 28) = 0.627371E-01
+PKER_RDRYG( 27, 29) = 0.462532E-01
+PKER_RDRYG( 27, 30) = 0.335602E-01
+PKER_RDRYG( 27, 31) = 0.246352E-01
+PKER_RDRYG( 27, 32) = 0.193701E-01
+PKER_RDRYG( 27, 33) = 0.173556E-01
+PKER_RDRYG( 27, 34) = 0.178767E-01
+PKER_RDRYG( 27, 35) = 0.200407E-01
+PKER_RDRYG( 27, 36) = 0.230216E-01
+PKER_RDRYG( 27, 37) = 0.261908E-01
+PKER_RDRYG( 27, 38) = 0.291792E-01
+PKER_RDRYG( 27, 39) = 0.318140E-01
+PKER_RDRYG( 27, 40) = 0.340498E-01
+PKER_RDRYG( 28, 1) = 0.156935E+02
+PKER_RDRYG( 28, 2) = 0.129880E+02
+PKER_RDRYG( 28, 3) = 0.107482E+02
+PKER_RDRYG( 28, 4) = 0.889406E+01
+PKER_RDRYG( 28, 5) = 0.735908E+01
+PKER_RDRYG( 28, 6) = 0.608833E+01
+PKER_RDRYG( 28, 7) = 0.503634E+01
+PKER_RDRYG( 28, 8) = 0.416543E+01
+PKER_RDRYG( 28, 9) = 0.344443E+01
+PKER_RDRYG( 28, 10) = 0.284753E+01
+PKER_RDRYG( 28, 11) = 0.235337E+01
+PKER_RDRYG( 28, 12) = 0.194425E+01
+PKER_RDRYG( 28, 13) = 0.160554E+01
+PKER_RDRYG( 28, 14) = 0.132511E+01
+PKER_RDRYG( 28, 15) = 0.109292E+01
+PKER_RDRYG( 28, 16) = 0.900659E+00
+PKER_RDRYG( 28, 17) = 0.741455E+00
+PKER_RDRYG( 28, 18) = 0.609608E+00
+PKER_RDRYG( 28, 19) = 0.500400E+00
+PKER_RDRYG( 28, 20) = 0.409927E+00
+PKER_RDRYG( 28, 21) = 0.334951E+00
+PKER_RDRYG( 28, 22) = 0.272791E+00
+PKER_RDRYG( 28, 23) = 0.221227E+00
+PKER_RDRYG( 28, 24) = 0.178418E+00
+PKER_RDRYG( 28, 25) = 0.142839E+00
+PKER_RDRYG( 28, 26) = 0.113236E+00
+PKER_RDRYG( 28, 27) = 0.885917E-01
+PKER_RDRYG( 28, 28) = 0.681158E-01
+PKER_RDRYG( 28, 29) = 0.512555E-01
+PKER_RDRYG( 28, 30) = 0.377074E-01
+PKER_RDRYG( 28, 31) = 0.273581E-01
+PKER_RDRYG( 28, 32) = 0.202058E-01
+PKER_RDRYG( 28, 33) = 0.161272E-01
+PKER_RDRYG( 28, 34) = 0.147463E-01
+PKER_RDRYG( 28, 35) = 0.154299E-01
+PKER_RDRYG( 28, 36) = 0.174181E-01
+PKER_RDRYG( 28, 37) = 0.200165E-01
+PKER_RDRYG( 28, 38) = 0.227292E-01
+PKER_RDRYG( 28, 39) = 0.252583E-01
+PKER_RDRYG( 28, 40) = 0.274748E-01
+PKER_RDRYG( 29, 1) = 0.156967E+02
+PKER_RDRYG( 29, 2) = 0.129912E+02
+PKER_RDRYG( 29, 3) = 0.107515E+02
+PKER_RDRYG( 29, 4) = 0.889730E+01
+PKER_RDRYG( 29, 5) = 0.736233E+01
+PKER_RDRYG( 29, 6) = 0.609161E+01
+PKER_RDRYG( 29, 7) = 0.503963E+01
+PKER_RDRYG( 29, 8) = 0.416874E+01
+PKER_RDRYG( 29, 9) = 0.344776E+01
+PKER_RDRYG( 29, 10) = 0.285088E+01
+PKER_RDRYG( 29, 11) = 0.235675E+01
+PKER_RDRYG( 29, 12) = 0.194766E+01
+PKER_RDRYG( 29, 13) = 0.160897E+01
+PKER_RDRYG( 29, 14) = 0.132857E+01
+PKER_RDRYG( 29, 15) = 0.109641E+01
+PKER_RDRYG( 29, 16) = 0.904196E+00
+PKER_RDRYG( 29, 17) = 0.745035E+00
+PKER_RDRYG( 29, 18) = 0.613237E+00
+PKER_RDRYG( 29, 19) = 0.504086E+00
+PKER_RDRYG( 29, 20) = 0.413678E+00
+PKER_RDRYG( 29, 21) = 0.338776E+00
+PKER_RDRYG( 29, 22) = 0.276704E+00
+PKER_RDRYG( 29, 23) = 0.225241E+00
+PKER_RDRYG( 29, 24) = 0.182548E+00
+PKER_RDRYG( 29, 25) = 0.147101E+00
+PKER_RDRYG( 29, 26) = 0.117639E+00
+PKER_RDRYG( 29, 27) = 0.931243E-01
+PKER_RDRYG( 29, 28) = 0.727192E-01
+PKER_RDRYG( 29, 29) = 0.557785E-01
+PKER_RDRYG( 29, 30) = 0.418595E-01
+PKER_RDRYG( 29, 31) = 0.307224E-01
+PKER_RDRYG( 29, 32) = 0.223096E-01
+PKER_RDRYG( 29, 33) = 0.165947E-01
+PKER_RDRYG( 29, 34) = 0.134638E-01
+PKER_RDRYG( 29, 35) = 0.125669E-01
+PKER_RDRYG( 29, 36) = 0.133388E-01
+PKER_RDRYG( 29, 37) = 0.151398E-01
+PKER_RDRYG( 29, 38) = 0.174018E-01
+PKER_RDRYG( 29, 39) = 0.197163E-01
+PKER_RDRYG( 29, 40) = 0.218551E-01
+PKER_RDRYG( 30, 1) = 0.156994E+02
+PKER_RDRYG( 30, 2) = 0.129939E+02
+PKER_RDRYG( 30, 3) = 0.107542E+02
+PKER_RDRYG( 30, 4) = 0.890005E+01
+PKER_RDRYG( 30, 5) = 0.736510E+01
+PKER_RDRYG( 30, 6) = 0.609438E+01
+PKER_RDRYG( 30, 7) = 0.504242E+01
+PKER_RDRYG( 30, 8) = 0.417154E+01
+PKER_RDRYG( 30, 9) = 0.345058E+01
+PKER_RDRYG( 30, 10) = 0.285372E+01
+PKER_RDRYG( 30, 11) = 0.235960E+01
+PKER_RDRYG( 30, 12) = 0.195054E+01
+PKER_RDRYG( 30, 13) = 0.161187E+01
+PKER_RDRYG( 30, 14) = 0.133149E+01
+PKER_RDRYG( 30, 15) = 0.109936E+01
+PKER_RDRYG( 30, 16) = 0.907174E+00
+PKER_RDRYG( 30, 17) = 0.748046E+00
+PKER_RDRYG( 30, 18) = 0.616285E+00
+PKER_RDRYG( 30, 19) = 0.507176E+00
+PKER_RDRYG( 30, 20) = 0.416814E+00
+PKER_RDRYG( 30, 21) = 0.341968E+00
+PKER_RDRYG( 30, 22) = 0.279958E+00
+PKER_RDRYG( 30, 23) = 0.228569E+00
+PKER_RDRYG( 30, 24) = 0.185961E+00
+PKER_RDRYG( 30, 25) = 0.150613E+00
+PKER_RDRYG( 30, 26) = 0.121262E+00
+PKER_RDRYG( 30, 27) = 0.968655E-01
+PKER_RDRYG( 30, 28) = 0.765650E-01
+PKER_RDRYG( 30, 29) = 0.596711E-01
+PKER_RDRYG( 30, 30) = 0.456581E-01
+PKER_RDRYG( 30, 31) = 0.341736E-01
+PKER_RDRYG( 30, 32) = 0.250373E-01
+PKER_RDRYG( 30, 33) = 0.182029E-01
+PKER_RDRYG( 30, 34) = 0.136572E-01
+PKER_RDRYG( 30, 35) = 0.112718E-01
+PKER_RDRYG( 30, 36) = 0.107288E-01
+PKER_RDRYG( 30, 37) = 0.115403E-01
+PKER_RDRYG( 30, 38) = 0.131623E-01
+PKER_RDRYG( 30, 39) = 0.151226E-01
+PKER_RDRYG( 30, 40) = 0.170966E-01
+PKER_RDRYG( 31, 1) = 0.157017E+02
+PKER_RDRYG( 31, 2) = 0.129962E+02
+PKER_RDRYG( 31, 3) = 0.107565E+02
+PKER_RDRYG( 31, 4) = 0.890239E+01
+PKER_RDRYG( 31, 5) = 0.736744E+01
+PKER_RDRYG( 31, 6) = 0.609674E+01
+PKER_RDRYG( 31, 7) = 0.504479E+01
+PKER_RDRYG( 31, 8) = 0.417392E+01
+PKER_RDRYG( 31, 9) = 0.345297E+01
+PKER_RDRYG( 31, 10) = 0.285613E+01
+PKER_RDRYG( 31, 11) = 0.236203E+01
+PKER_RDRYG( 31, 12) = 0.195297E+01
+PKER_RDRYG( 31, 13) = 0.161433E+01
+PKER_RDRYG( 31, 14) = 0.133396E+01
+PKER_RDRYG( 31, 15) = 0.110185E+01
+PKER_RDRYG( 31, 16) = 0.909687E+00
+PKER_RDRYG( 31, 17) = 0.750583E+00
+PKER_RDRYG( 31, 18) = 0.618849E+00
+PKER_RDRYG( 31, 19) = 0.509771E+00
+PKER_RDRYG( 31, 20) = 0.419444E+00
+PKER_RDRYG( 31, 21) = 0.344637E+00
+PKER_RDRYG( 31, 22) = 0.282674E+00
+PKER_RDRYG( 31, 23) = 0.231338E+00
+PKER_RDRYG( 31, 24) = 0.188793E+00
+PKER_RDRYG( 31, 25) = 0.153517E+00
+PKER_RDRYG( 31, 26) = 0.124249E+00
+PKER_RDRYG( 31, 27) = 0.999464E-01
+PKER_RDRYG( 31, 28) = 0.797438E-01
+PKER_RDRYG( 31, 29) = 0.629334E-01
+PKER_RDRYG( 31, 30) = 0.489476E-01
+PKER_RDRYG( 31, 31) = 0.373591E-01
+PKER_RDRYG( 31, 32) = 0.278881E-01
+PKER_RDRYG( 31, 33) = 0.203979E-01
+PKER_RDRYG( 31, 34) = 0.148616E-01
+PKER_RDRYG( 31, 35) = 0.112574E-01
+PKER_RDRYG( 31, 36) = 0.946007E-02
+PKER_RDRYG( 31, 37) = 0.918277E-02
+PKER_RDRYG( 31, 38) = 0.999683E-02
+PKER_RDRYG( 31, 39) = 0.114431E-01
+PKER_RDRYG( 31, 40) = 0.131376E-01
+PKER_RDRYG( 32, 1) = 0.157037E+02
+PKER_RDRYG( 32, 2) = 0.129982E+02
+PKER_RDRYG( 32, 3) = 0.107585E+02
+PKER_RDRYG( 32, 4) = 0.890438E+01
+PKER_RDRYG( 32, 5) = 0.736944E+01
+PKER_RDRYG( 32, 6) = 0.609874E+01
+PKER_RDRYG( 32, 7) = 0.504680E+01
+PKER_RDRYG( 32, 8) = 0.417594E+01
+PKER_RDRYG( 32, 9) = 0.345501E+01
+PKER_RDRYG( 32, 10) = 0.285817E+01
+PKER_RDRYG( 32, 11) = 0.236408E+01
+PKER_RDRYG( 32, 12) = 0.195504E+01
+PKER_RDRYG( 32, 13) = 0.161640E+01
+PKER_RDRYG( 32, 14) = 0.133606E+01
+PKER_RDRYG( 32, 15) = 0.110396E+01
+PKER_RDRYG( 32, 16) = 0.911809E+00
+PKER_RDRYG( 32, 17) = 0.752724E+00
+PKER_RDRYG( 32, 18) = 0.621010E+00
+PKER_RDRYG( 32, 19) = 0.511954E+00
+PKER_RDRYG( 32, 20) = 0.421653E+00
+PKER_RDRYG( 32, 21) = 0.346876E+00
+PKER_RDRYG( 32, 22) = 0.284947E+00
+PKER_RDRYG( 32, 23) = 0.233649E+00
+PKER_RDRYG( 32, 24) = 0.191149E+00
+PKER_RDRYG( 32, 25) = 0.155926E+00
+PKER_RDRYG( 32, 26) = 0.126720E+00
+PKER_RDRYG( 32, 27) = 0.102487E+00
+PKER_RDRYG( 32, 28) = 0.823637E-01
+PKER_RDRYG( 32, 29) = 0.656344E-01
+PKER_RDRYG( 32, 30) = 0.517143E-01
+PKER_RDRYG( 32, 31) = 0.401375E-01
+PKER_RDRYG( 32, 32) = 0.305566E-01
+PKER_RDRYG( 32, 33) = 0.227484E-01
+PKER_RDRYG( 32, 34) = 0.166190E-01
+PKER_RDRYG( 32, 35) = 0.121425E-01
+PKER_RDRYG( 32, 36) = 0.929636E-02
+PKER_RDRYG( 32, 37) = 0.796211E-02
+PKER_RDRYG( 32, 38) = 0.787497E-02
+PKER_RDRYG( 32, 39) = 0.866604E-02
+PKER_RDRYG( 32, 40) = 0.994926E-02
+PKER_RDRYG( 33, 1) = 0.157053E+02
+PKER_RDRYG( 33, 2) = 0.129999E+02
+PKER_RDRYG( 33, 3) = 0.107602E+02
+PKER_RDRYG( 33, 4) = 0.890607E+01
+PKER_RDRYG( 33, 5) = 0.737114E+01
+PKER_RDRYG( 33, 6) = 0.610045E+01
+PKER_RDRYG( 33, 7) = 0.504851E+01
+PKER_RDRYG( 33, 8) = 0.417766E+01
+PKER_RDRYG( 33, 9) = 0.345673E+01
+PKER_RDRYG( 33, 10) = 0.285990E+01
+PKER_RDRYG( 33, 11) = 0.236582E+01
+PKER_RDRYG( 33, 12) = 0.195679E+01
+PKER_RDRYG( 33, 13) = 0.161816E+01
+PKER_RDRYG( 33, 14) = 0.133783E+01
+PKER_RDRYG( 33, 15) = 0.110574E+01
+PKER_RDRYG( 33, 16) = 0.913604E+00
+PKER_RDRYG( 33, 17) = 0.754532E+00
+PKER_RDRYG( 33, 18) = 0.622834E+00
+PKER_RDRYG( 33, 19) = 0.513795E+00
+PKER_RDRYG( 33, 20) = 0.423513E+00
+PKER_RDRYG( 33, 21) = 0.348758E+00
+PKER_RDRYG( 33, 22) = 0.286853E+00
+PKER_RDRYG( 33, 23) = 0.235584E+00
+PKER_RDRYG( 33, 24) = 0.193116E+00
+PKER_RDRYG( 33, 25) = 0.157931E+00
+PKER_RDRYG( 33, 26) = 0.128770E+00
+PKER_RDRYG( 33, 27) = 0.104589E+00
+PKER_RDRYG( 33, 28) = 0.845253E-01
+PKER_RDRYG( 33, 29) = 0.678623E-01
+PKER_RDRYG( 33, 30) = 0.540092E-01
+PKER_RDRYG( 33, 31) = 0.424830E-01
+PKER_RDRYG( 33, 32) = 0.329012E-01
+PKER_RDRYG( 33, 33) = 0.249827E-01
+PKER_RDRYG( 33, 34) = 0.185543E-01
+PKER_RDRYG( 33, 35) = 0.135404E-01
+PKER_RDRYG( 33, 36) = 0.993014E-02
+PKER_RDRYG( 33, 37) = 0.769477E-02
+PKER_RDRYG( 33, 38) = 0.672045E-02
+PKER_RDRYG( 33, 39) = 0.676668E-02
+PKER_RDRYG( 33, 40) = 0.751623E-02
+PKER_RDRYG( 34, 1) = 0.157068E+02
+PKER_RDRYG( 34, 2) = 0.130013E+02
+PKER_RDRYG( 34, 3) = 0.107616E+02
+PKER_RDRYG( 34, 4) = 0.890751E+01
+PKER_RDRYG( 34, 5) = 0.737258E+01
+PKER_RDRYG( 34, 6) = 0.610189E+01
+PKER_RDRYG( 34, 7) = 0.504996E+01
+PKER_RDRYG( 34, 8) = 0.417912E+01
+PKER_RDRYG( 34, 9) = 0.345819E+01
+PKER_RDRYG( 34, 10) = 0.286137E+01
+PKER_RDRYG( 34, 11) = 0.236730E+01
+PKER_RDRYG( 34, 12) = 0.195827E+01
+PKER_RDRYG( 34, 13) = 0.161965E+01
+PKER_RDRYG( 34, 14) = 0.133933E+01
+PKER_RDRYG( 34, 15) = 0.110725E+01
+PKER_RDRYG( 34, 16) = 0.915123E+00
+PKER_RDRYG( 34, 17) = 0.756062E+00
+PKER_RDRYG( 34, 18) = 0.624375E+00
+PKER_RDRYG( 34, 19) = 0.515349E+00
+PKER_RDRYG( 34, 20) = 0.425082E+00
+PKER_RDRYG( 34, 21) = 0.350342E+00
+PKER_RDRYG( 34, 22) = 0.288455E+00
+PKER_RDRYG( 34, 23) = 0.237207E+00
+PKER_RDRYG( 34, 24) = 0.194764E+00
+PKER_RDRYG( 34, 25) = 0.159606E+00
+PKER_RDRYG( 34, 26) = 0.130477E+00
+PKER_RDRYG( 34, 27) = 0.106334E+00
+PKER_RDRYG( 34, 28) = 0.863139E-01
+PKER_RDRYG( 34, 29) = 0.697015E-01
+PKER_RDRYG( 34, 30) = 0.559040E-01
+PKER_RDRYG( 34, 31) = 0.444327E-01
+PKER_RDRYG( 34, 32) = 0.348892E-01
+PKER_RDRYG( 34, 33) = 0.269596E-01
+PKER_RDRYG( 34, 34) = 0.204175E-01
+PKER_RDRYG( 34, 35) = 0.151283E-01
+PKER_RDRYG( 34, 36) = 0.110336E-01
+PKER_RDRYG( 34, 37) = 0.812881E-02
+PKER_RDRYG( 34, 38) = 0.638384E-02
+PKER_RDRYG( 34, 39) = 0.568390E-02
+PKER_RDRYG( 34, 40) = 0.582227E-02
+PKER_RDRYG( 35, 1) = 0.157080E+02
+PKER_RDRYG( 35, 2) = 0.130025E+02
+PKER_RDRYG( 35, 3) = 0.107628E+02
+PKER_RDRYG( 35, 4) = 0.890873E+01
+PKER_RDRYG( 35, 5) = 0.737381E+01
+PKER_RDRYG( 35, 6) = 0.610313E+01
+PKER_RDRYG( 35, 7) = 0.505120E+01
+PKER_RDRYG( 35, 8) = 0.418036E+01
+PKER_RDRYG( 35, 9) = 0.345944E+01
+PKER_RDRYG( 35, 10) = 0.286262E+01
+PKER_RDRYG( 35, 11) = 0.236855E+01
+PKER_RDRYG( 35, 12) = 0.195953E+01
+PKER_RDRYG( 35, 13) = 0.162092E+01
+PKER_RDRYG( 35, 14) = 0.134060E+01
+PKER_RDRYG( 35, 15) = 0.110853E+01
+PKER_RDRYG( 35, 16) = 0.916411E+00
+PKER_RDRYG( 35, 17) = 0.757357E+00
+PKER_RDRYG( 35, 18) = 0.625679E+00
+PKER_RDRYG( 35, 19) = 0.516663E+00
+PKER_RDRYG( 35, 20) = 0.426406E+00
+PKER_RDRYG( 35, 21) = 0.351679E+00
+PKER_RDRYG( 35, 22) = 0.289805E+00
+PKER_RDRYG( 35, 23) = 0.238572E+00
+PKER_RDRYG( 35, 24) = 0.196146E+00
+PKER_RDRYG( 35, 25) = 0.161009E+00
+PKER_RDRYG( 35, 26) = 0.131903E+00
+PKER_RDRYG( 35, 27) = 0.107787E+00
+PKER_RDRYG( 35, 28) = 0.877991E-01
+PKER_RDRYG( 35, 29) = 0.712238E-01
+PKER_RDRYG( 35, 30) = 0.574690E-01
+PKER_RDRYG( 35, 31) = 0.460443E-01
+PKER_RDRYG( 35, 32) = 0.365454E-01
+PKER_RDRYG( 35, 33) = 0.286436E-01
+PKER_RDRYG( 35, 34) = 0.220827E-01
+PKER_RDRYG( 35, 35) = 0.166801E-01
+PKER_RDRYG( 35, 36) = 0.123284E-01
+PKER_RDRYG( 35, 37) = 0.899312E-02
+PKER_RDRYG( 35, 38) = 0.666232E-02
+PKER_RDRYG( 35, 39) = 0.530804E-02
+PKER_RDRYG( 35, 40) = 0.482355E-02
+PKER_RDRYG( 36, 1) = 0.157090E+02
+PKER_RDRYG( 36, 2) = 0.130036E+02
+PKER_RDRYG( 36, 3) = 0.107639E+02
+PKER_RDRYG( 36, 4) = 0.890977E+01
+PKER_RDRYG( 36, 5) = 0.737485E+01
+PKER_RDRYG( 36, 6) = 0.610418E+01
+PKER_RDRYG( 36, 7) = 0.505225E+01
+PKER_RDRYG( 36, 8) = 0.418142E+01
+PKER_RDRYG( 36, 9) = 0.346050E+01
+PKER_RDRYG( 36, 10) = 0.286369E+01
+PKER_RDRYG( 36, 11) = 0.236962E+01
+PKER_RDRYG( 36, 12) = 0.196060E+01
+PKER_RDRYG( 36, 13) = 0.162200E+01
+PKER_RDRYG( 36, 14) = 0.134168E+01
+PKER_RDRYG( 36, 15) = 0.110962E+01
+PKER_RDRYG( 36, 16) = 0.917502E+00
+PKER_RDRYG( 36, 17) = 0.758455E+00
+PKER_RDRYG( 36, 18) = 0.626784E+00
+PKER_RDRYG( 36, 19) = 0.517775E+00
+PKER_RDRYG( 36, 20) = 0.427526E+00
+PKER_RDRYG( 36, 21) = 0.352807E+00
+PKER_RDRYG( 36, 22) = 0.290944E+00
+PKER_RDRYG( 36, 23) = 0.239723E+00
+PKER_RDRYG( 36, 24) = 0.197309E+00
+PKER_RDRYG( 36, 25) = 0.162187E+00
+PKER_RDRYG( 36, 26) = 0.133098E+00
+PKER_RDRYG( 36, 27) = 0.109002E+00
+PKER_RDRYG( 36, 28) = 0.890365E-01
+PKER_RDRYG( 36, 29) = 0.724882E-01
+PKER_RDRYG( 36, 30) = 0.587648E-01
+PKER_RDRYG( 36, 31) = 0.473761E-01
+PKER_RDRYG( 36, 32) = 0.379160E-01
+PKER_RDRYG( 36, 33) = 0.300505E-01
+PKER_RDRYG( 36, 34) = 0.235088E-01
+PKER_RDRYG( 36, 35) = 0.180811E-01
+PKER_RDRYG( 36, 36) = 0.136215E-01
+PKER_RDRYG( 36, 37) = 0.100480E-01
+PKER_RDRYG( 36, 38) = 0.733183E-02
+PKER_RDRYG( 36, 39) = 0.546978E-02
+PKER_RDRYG( 36, 40) = 0.442459E-02
+PKER_RDRYG( 37, 1) = 0.157099E+02
+PKER_RDRYG( 37, 2) = 0.130045E+02
+PKER_RDRYG( 37, 3) = 0.107648E+02
+PKER_RDRYG( 37, 4) = 0.891066E+01
+PKER_RDRYG( 37, 5) = 0.737574E+01
+PKER_RDRYG( 37, 6) = 0.610507E+01
+PKER_RDRYG( 37, 7) = 0.505315E+01
+PKER_RDRYG( 37, 8) = 0.418231E+01
+PKER_RDRYG( 37, 9) = 0.346140E+01
+PKER_RDRYG( 37, 10) = 0.286459E+01
+PKER_RDRYG( 37, 11) = 0.237053E+01
+PKER_RDRYG( 37, 12) = 0.196151E+01
+PKER_RDRYG( 37, 13) = 0.162291E+01
+PKER_RDRYG( 37, 14) = 0.134260E+01
+PKER_RDRYG( 37, 15) = 0.111054E+01
+PKER_RDRYG( 37, 16) = 0.918429E+00
+PKER_RDRYG( 37, 17) = 0.759387E+00
+PKER_RDRYG( 37, 18) = 0.627720E+00
+PKER_RDRYG( 37, 19) = 0.518717E+00
+PKER_RDRYG( 37, 20) = 0.428474E+00
+PKER_RDRYG( 37, 21) = 0.353762E+00
+PKER_RDRYG( 37, 22) = 0.291907E+00
+PKER_RDRYG( 37, 23) = 0.240693E+00
+PKER_RDRYG( 37, 24) = 0.198289E+00
+PKER_RDRYG( 37, 25) = 0.163177E+00
+PKER_RDRYG( 37, 26) = 0.134101E+00
+PKER_RDRYG( 37, 27) = 0.110019E+00
+PKER_RDRYG( 37, 28) = 0.900708E-01
+PKER_RDRYG( 37, 29) = 0.735419E-01
+PKER_RDRYG( 37, 30) = 0.598414E-01
+PKER_RDRYG( 37, 31) = 0.484792E-01
+PKER_RDRYG( 37, 32) = 0.390495E-01
+PKER_RDRYG( 37, 33) = 0.312163E-01
+PKER_RDRYG( 37, 34) = 0.247033E-01
+PKER_RDRYG( 37, 35) = 0.192878E-01
+PKER_RDRYG( 37, 36) = 0.147988E-01
+PKER_RDRYG( 37, 37) = 0.111191E-01
+PKER_RDRYG( 37, 38) = 0.818617E-02
+PKER_RDRYG( 37, 39) = 0.598058E-02
+PKER_RDRYG( 37, 40) = 0.449521E-02
+PKER_RDRYG( 38, 1) = 0.157107E+02
+PKER_RDRYG( 38, 2) = 0.130052E+02
+PKER_RDRYG( 38, 3) = 0.107655E+02
+PKER_RDRYG( 38, 4) = 0.891142E+01
+PKER_RDRYG( 38, 5) = 0.737650E+01
+PKER_RDRYG( 38, 6) = 0.610583E+01
+PKER_RDRYG( 38, 7) = 0.505391E+01
+PKER_RDRYG( 38, 8) = 0.418308E+01
+PKER_RDRYG( 38, 9) = 0.346217E+01
+PKER_RDRYG( 38, 10) = 0.286536E+01
+PKER_RDRYG( 38, 11) = 0.237130E+01
+PKER_RDRYG( 38, 12) = 0.196229E+01
+PKER_RDRYG( 38, 13) = 0.162369E+01
+PKER_RDRYG( 38, 14) = 0.134338E+01
+PKER_RDRYG( 38, 15) = 0.111132E+01
+PKER_RDRYG( 38, 16) = 0.919216E+00
+PKER_RDRYG( 38, 17) = 0.760177E+00
+PKER_RDRYG( 38, 18) = 0.628515E+00
+PKER_RDRYG( 38, 19) = 0.519516E+00
+PKER_RDRYG( 38, 20) = 0.429278E+00
+PKER_RDRYG( 38, 21) = 0.354571E+00
+PKER_RDRYG( 38, 22) = 0.292721E+00
+PKER_RDRYG( 38, 23) = 0.241514E+00
+PKER_RDRYG( 38, 24) = 0.199117E+00
+PKER_RDRYG( 38, 25) = 0.164013E+00
+PKER_RDRYG( 38, 26) = 0.134945E+00
+PKER_RDRYG( 38, 27) = 0.110874E+00
+PKER_RDRYG( 38, 28) = 0.909377E-01
+PKER_RDRYG( 38, 29) = 0.744229E-01
+PKER_RDRYG( 38, 30) = 0.607388E-01
+PKER_RDRYG( 38, 31) = 0.493960E-01
+PKER_RDRYG( 38, 32) = 0.399888E-01
+PKER_RDRYG( 38, 33) = 0.321810E-01
+PKER_RDRYG( 38, 34) = 0.256949E-01
+PKER_RDRYG( 38, 35) = 0.203021E-01
+PKER_RDRYG( 38, 36) = 0.158193E-01
+PKER_RDRYG( 38, 37) = 0.121074E-01
+PKER_RDRYG( 38, 38) = 0.907255E-02
+PKER_RDRYG( 38, 39) = 0.666890E-02
+PKER_RDRYG( 38, 40) = 0.488099E-02
+PKER_RDRYG( 39, 1) = 0.157113E+02
+PKER_RDRYG( 39, 2) = 0.130059E+02
+PKER_RDRYG( 39, 3) = 0.107662E+02
+PKER_RDRYG( 39, 4) = 0.891206E+01
+PKER_RDRYG( 39, 5) = 0.737715E+01
+PKER_RDRYG( 39, 6) = 0.610648E+01
+PKER_RDRYG( 39, 7) = 0.505456E+01
+PKER_RDRYG( 39, 8) = 0.418373E+01
+PKER_RDRYG( 39, 9) = 0.346282E+01
+PKER_RDRYG( 39, 10) = 0.286602E+01
+PKER_RDRYG( 39, 11) = 0.237195E+01
+PKER_RDRYG( 39, 12) = 0.196295E+01
+PKER_RDRYG( 39, 13) = 0.162435E+01
+PKER_RDRYG( 39, 14) = 0.134404E+01
+PKER_RDRYG( 39, 15) = 0.111199E+01
+PKER_RDRYG( 39, 16) = 0.919884E+00
+PKER_RDRYG( 39, 17) = 0.760849E+00
+PKER_RDRYG( 39, 18) = 0.629189E+00
+PKER_RDRYG( 39, 19) = 0.520193E+00
+PKER_RDRYG( 39, 20) = 0.429959E+00
+PKER_RDRYG( 39, 21) = 0.355256E+00
+PKER_RDRYG( 39, 22) = 0.293410E+00
+PKER_RDRYG( 39, 23) = 0.242208E+00
+PKER_RDRYG( 39, 24) = 0.199816E+00
+PKER_RDRYG( 39, 25) = 0.164718E+00
+PKER_RDRYG( 39, 26) = 0.135657E+00
+PKER_RDRYG( 39, 27) = 0.111594E+00
+PKER_RDRYG( 39, 28) = 0.916661E-01
+PKER_RDRYG( 39, 29) = 0.751615E-01
+PKER_RDRYG( 39, 30) = 0.614894E-01
+PKER_RDRYG( 39, 31) = 0.501605E-01
+PKER_RDRYG( 39, 32) = 0.407696E-01
+PKER_RDRYG( 39, 33) = 0.329808E-01
+PKER_RDRYG( 39, 34) = 0.265161E-01
+PKER_RDRYG( 39, 35) = 0.211454E-01
+PKER_RDRYG( 39, 36) = 0.166802E-01
+PKER_RDRYG( 39, 37) = 0.129700E-01
+PKER_RDRYG( 39, 38) = 0.990158E-02
+PKER_RDRYG( 39, 39) = 0.740159E-02
+PKER_RDRYG( 39, 40) = 0.543265E-02
+PKER_RDRYG( 40, 1) = 0.157118E+02
+PKER_RDRYG( 40, 2) = 0.130064E+02
+PKER_RDRYG( 40, 3) = 0.107667E+02
+PKER_RDRYG( 40, 4) = 0.891261E+01
+PKER_RDRYG( 40, 5) = 0.737770E+01
+PKER_RDRYG( 40, 6) = 0.610703E+01
+PKER_RDRYG( 40, 7) = 0.505511E+01
+PKER_RDRYG( 40, 8) = 0.418429E+01
+PKER_RDRYG( 40, 9) = 0.346338E+01
+PKER_RDRYG( 40, 10) = 0.286657E+01
+PKER_RDRYG( 40, 11) = 0.237251E+01
+PKER_RDRYG( 40, 12) = 0.196351E+01
+PKER_RDRYG( 40, 13) = 0.162491E+01
+PKER_RDRYG( 40, 14) = 0.134461E+01
+PKER_RDRYG( 40, 15) = 0.111256E+01
+PKER_RDRYG( 40, 16) = 0.920453E+00
+PKER_RDRYG( 40, 17) = 0.761419E+00
+PKER_RDRYG( 40, 18) = 0.629762E+00
+PKER_RDRYG( 40, 19) = 0.520769E+00
+PKER_RDRYG( 40, 20) = 0.430537E+00
+PKER_RDRYG( 40, 21) = 0.355837E+00
+PKER_RDRYG( 40, 22) = 0.293995E+00
+PKER_RDRYG( 40, 23) = 0.242796E+00
+PKER_RDRYG( 40, 24) = 0.200408E+00
+PKER_RDRYG( 40, 25) = 0.165315E+00
+PKER_RDRYG( 40, 26) = 0.136259E+00
+PKER_RDRYG( 40, 27) = 0.112201E+00
+PKER_RDRYG( 40, 28) = 0.922796E-01
+PKER_RDRYG( 40, 29) = 0.757823E-01
+PKER_RDRYG( 40, 30) = 0.621188E-01
+PKER_RDRYG( 40, 31) = 0.507999E-01
+PKER_RDRYG( 40, 32) = 0.414208E-01
+PKER_RDRYG( 40, 33) = 0.336459E-01
+PKER_RDRYG( 40, 34) = 0.271972E-01
+PKER_RDRYG( 40, 35) = 0.218444E-01
+PKER_RDRYG( 40, 36) = 0.173974E-01
+PKER_RDRYG( 40, 37) = 0.137005E-01
+PKER_RDRYG( 40, 38) = 0.106300E-01
+PKER_RDRYG( 40, 39) = 0.809434E-02
+PKER_RDRYG( 40, 40) = 0.603544E-02
+END IF
+!
+END SUBROUTINE LIMA_READ_XKER_RDRYG
diff --git a/src/mesonh/micro/lima_read_xker_sdryg.f90 b/src/mesonh/micro/lima_read_xker_sdryg.f90
new file mode 100644
index 000000000..b47dc11a0
--- /dev/null
+++ b/src/mesonh/micro/lima_read_xker_sdryg.f90
@@ -0,0 +1,3337 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 init 2006/05/18 13:07:25
+!-----------------------------------------------------------------
+! ###########################
+ MODULE MODI_LIMA_READ_XKER_SDRYG
+! ###########################
+!
+INTERFACE
+ SUBROUTINE LIMA_READ_XKER_SDRYG (KDRYLBDAG,KDRYLBDAS,KND, &
+ PALPHAG,PNUG,PALPHAS,PNUS,PEGS,PBS,PCG,PDG,PCS,PDS, &
+ PDRYLBDAG_MAX,PDRYLBDAS_MAX,PDRYLBDAG_MIN,PDRYLBDAS_MIN, &
+ PFDINFTY,PKER_SDRYG )
+!
+INTEGER, INTENT(OUT) :: KND,KDRYLBDAG,KDRYLBDAS
+REAL, INTENT(OUT) :: PALPHAG
+REAL, INTENT(OUT) :: PNUG
+REAL, INTENT(OUT) :: PALPHAS
+REAL, INTENT(OUT) :: PNUS
+REAL, INTENT(OUT) :: PEGS
+REAL, INTENT(OUT) :: PBS
+REAL, INTENT(OUT) :: PCG
+REAL, INTENT(OUT) :: PDG
+REAL, INTENT(OUT) :: PCS
+REAL, INTENT(OUT) :: PDS
+REAL, INTENT(OUT) :: PDRYLBDAG_MAX
+REAL, INTENT(OUT) :: PDRYLBDAS_MAX
+REAL, INTENT(OUT) :: PDRYLBDAG_MIN
+REAL, INTENT(OUT) :: PDRYLBDAS_MIN
+REAL, INTENT(OUT) :: PFDINFTY
+REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_SDRYG
+!
+END SUBROUTINE LIMA_READ_XKER_SDRYG
+!
+END INTERFACE
+!
+END MODULE MODI_LIMA_READ_XKER_SDRYG
+! ########################################################################
+ SUBROUTINE LIMA_READ_XKER_SDRYG (KDRYLBDAG,KDRYLBDAS,KND, &
+ PALPHAG,PNUG,PALPHAS,PNUS,PEGS,PBS,PCG,PDG,PCS,PDS, &
+ PDRYLBDAG_MAX,PDRYLBDAS_MAX,PDRYLBDAG_MIN,PDRYLBDAS_MIN, &
+ PFDINFTY,PKER_SDRYG )
+! ########################################################################
+!
+!!**** * * - initialize the kernels for the snow-graupel dry growth process
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to initialize the kernels PKER_SDRYG
+!! prepared from a previous run of the routine INI_RAIN_ICE. The reading
+!! of the kernels is optional after checking for the dimensions of the
+!! arrays.
+!!
+!!** METHOD
+!! ------
+!!
+!!
+!! EXTERNAL
+!! --------
+!! None
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation ( routine READ_XKER_SDRYG )
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 09/04/96
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!* 0.2 Declarations of local variables :
+!
+!
+INTEGER, INTENT(OUT) :: KND,KDRYLBDAG,KDRYLBDAS
+REAL, INTENT(OUT) :: PALPHAG
+REAL, INTENT(OUT) :: PNUG
+REAL, INTENT(OUT) :: PALPHAS
+REAL, INTENT(OUT) :: PNUS
+REAL, INTENT(OUT) :: PEGS
+REAL, INTENT(OUT) :: PBS
+REAL, INTENT(OUT) :: PCG
+REAL, INTENT(OUT) :: PDG
+REAL, INTENT(OUT) :: PCS
+REAL, INTENT(OUT) :: PDS
+REAL, INTENT(OUT) :: PDRYLBDAG_MAX
+REAL, INTENT(OUT) :: PDRYLBDAS_MAX
+REAL, INTENT(OUT) :: PDRYLBDAG_MIN
+REAL, INTENT(OUT) :: PDRYLBDAS_MIN
+REAL, INTENT(OUT) :: PFDINFTY
+REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_SDRYG
+!
+! ###################################################################
+! #INSERT HERE THE OUTPUT OF INI_RAIN_ICE IF THE KERNELS ARE UPDATED#
+! ###################################################################
+!
+KND= 50
+KDRYLBDAG= 40
+KDRYLBDAS= 80
+PALPHAG= 0.100000E+01
+PNUG= 0.100000E+01
+PALPHAS= 0.100000E+01
+PNUS= 0.100000E+01
+PEGS= 0.100000E+01
+PBS= 0.190000E+01
+PCG= 0.122000E+03
+PDG= 0.660000E+00
+PCS= 0.500000E+01
+PDS= 0.270000E+00
+PDRYLBDAG_MAX= 0.100000E+08
+PDRYLBDAS_MAX= 0.250000E+10
+PDRYLBDAG_MIN= 0.100000E+04
+PDRYLBDAS_MIN= 0.250000E+02
+PFDINFTY= 0.200000E+02
+!
+IF( PRESENT(PKER_SDRYG) ) THEN
+PKER_SDRYG( 1, 1) = 0.181263E+01
+PKER_SDRYG( 1, 2) = 0.163147E+01
+PKER_SDRYG( 1, 3) = 0.146558E+01
+PKER_SDRYG( 1, 4) = 0.131501E+01
+PKER_SDRYG( 1, 5) = 0.117971E+01
+PKER_SDRYG( 1, 6) = 0.105940E+01
+PKER_SDRYG( 1, 7) = 0.954664E+00
+PKER_SDRYG( 1, 8) = 0.865241E+00
+PKER_SDRYG( 1, 9) = 0.791190E+00
+PKER_SDRYG( 1, 10) = 0.733135E+00
+PKER_SDRYG( 1, 11) = 0.691332E+00
+PKER_SDRYG( 1, 12) = 0.666135E+00
+PKER_SDRYG( 1, 13) = 0.658669E+00
+PKER_SDRYG( 1, 14) = 0.669468E+00
+PKER_SDRYG( 1, 15) = 0.699407E+00
+PKER_SDRYG( 1, 16) = 0.749020E+00
+PKER_SDRYG( 1, 17) = 0.817882E+00
+PKER_SDRYG( 1, 18) = 0.905102E+00
+PKER_SDRYG( 1, 19) = 0.100805E+01
+PKER_SDRYG( 1, 20) = 0.112208E+01
+PKER_SDRYG( 1, 21) = 0.124139E+01
+PKER_SDRYG( 1, 22) = 0.136056E+01
+PKER_SDRYG( 1, 23) = 0.147535E+01
+PKER_SDRYG( 1, 24) = 0.158271E+01
+PKER_SDRYG( 1, 25) = 0.168072E+01
+PKER_SDRYG( 1, 26) = 0.176838E+01
+PKER_SDRYG( 1, 27) = 0.184560E+01
+PKER_SDRYG( 1, 28) = 0.191298E+01
+PKER_SDRYG( 1, 29) = 0.197156E+01
+PKER_SDRYG( 1, 30) = 0.202257E+01
+PKER_SDRYG( 1, 31) = 0.206716E+01
+PKER_SDRYG( 1, 32) = 0.210638E+01
+PKER_SDRYG( 1, 33) = 0.214108E+01
+PKER_SDRYG( 1, 34) = 0.217197E+01
+PKER_SDRYG( 1, 35) = 0.219964E+01
+PKER_SDRYG( 1, 36) = 0.222456E+01
+PKER_SDRYG( 1, 37) = 0.224714E+01
+PKER_SDRYG( 1, 38) = 0.226768E+01
+PKER_SDRYG( 1, 39) = 0.228645E+01
+PKER_SDRYG( 1, 40) = 0.230366E+01
+PKER_SDRYG( 1, 41) = 0.231950E+01
+PKER_SDRYG( 1, 42) = 0.233413E+01
+PKER_SDRYG( 1, 43) = 0.234766E+01
+PKER_SDRYG( 1, 44) = 0.236020E+01
+PKER_SDRYG( 1, 45) = 0.237186E+01
+PKER_SDRYG( 1, 46) = 0.238271E+01
+PKER_SDRYG( 1, 47) = 0.239281E+01
+PKER_SDRYG( 1, 48) = 0.240224E+01
+PKER_SDRYG( 1, 49) = 0.241105E+01
+PKER_SDRYG( 1, 50) = 0.241928E+01
+PKER_SDRYG( 1, 51) = 0.242698E+01
+PKER_SDRYG( 1, 52) = 0.243418E+01
+PKER_SDRYG( 1, 53) = 0.244092E+01
+PKER_SDRYG( 1, 54) = 0.244724E+01
+PKER_SDRYG( 1, 55) = 0.245316E+01
+PKER_SDRYG( 1, 56) = 0.245871E+01
+PKER_SDRYG( 1, 57) = 0.246392E+01
+PKER_SDRYG( 1, 58) = 0.246880E+01
+PKER_SDRYG( 1, 59) = 0.247338E+01
+PKER_SDRYG( 1, 60) = 0.247767E+01
+PKER_SDRYG( 1, 61) = 0.248171E+01
+PKER_SDRYG( 1, 62) = 0.248549E+01
+PKER_SDRYG( 1, 63) = 0.248904E+01
+PKER_SDRYG( 1, 64) = 0.249237E+01
+PKER_SDRYG( 1, 65) = 0.249550E+01
+PKER_SDRYG( 1, 66) = 0.249843E+01
+PKER_SDRYG( 1, 67) = 0.250119E+01
+PKER_SDRYG( 1, 68) = 0.250377E+01
+PKER_SDRYG( 1, 69) = 0.250620E+01
+PKER_SDRYG( 1, 70) = 0.250848E+01
+PKER_SDRYG( 1, 71) = 0.251062E+01
+PKER_SDRYG( 1, 72) = 0.251263E+01
+PKER_SDRYG( 1, 73) = 0.251452E+01
+PKER_SDRYG( 1, 74) = 0.251629E+01
+PKER_SDRYG( 1, 75) = 0.251796E+01
+PKER_SDRYG( 1, 76) = 0.251952E+01
+PKER_SDRYG( 1, 77) = 0.252099E+01
+PKER_SDRYG( 1, 78) = 0.252236E+01
+PKER_SDRYG( 1, 79) = 0.252366E+01
+PKER_SDRYG( 1, 80) = 0.252487E+01
+PKER_SDRYG( 2, 1) = 0.199024E+01
+PKER_SDRYG( 2, 2) = 0.180156E+01
+PKER_SDRYG( 2, 3) = 0.162637E+01
+PKER_SDRYG( 2, 4) = 0.146459E+01
+PKER_SDRYG( 2, 5) = 0.131591E+01
+PKER_SDRYG( 2, 6) = 0.118046E+01
+PKER_SDRYG( 2, 7) = 0.105818E+01
+PKER_SDRYG( 2, 8) = 0.949189E+00
+PKER_SDRYG( 2, 9) = 0.853560E+00
+PKER_SDRYG( 2, 10) = 0.771539E+00
+PKER_SDRYG( 2, 11) = 0.703653E+00
+PKER_SDRYG( 2, 12) = 0.650109E+00
+PKER_SDRYG( 2, 13) = 0.611685E+00
+PKER_SDRYG( 2, 14) = 0.589133E+00
+PKER_SDRYG( 2, 15) = 0.583308E+00
+PKER_SDRYG( 2, 16) = 0.595133E+00
+PKER_SDRYG( 2, 17) = 0.625162E+00
+PKER_SDRYG( 2, 18) = 0.673359E+00
+PKER_SDRYG( 2, 19) = 0.738907E+00
+PKER_SDRYG( 2, 20) = 0.819564E+00
+PKER_SDRYG( 2, 21) = 0.912202E+00
+PKER_SDRYG( 2, 22) = 0.101189E+01
+PKER_SDRYG( 2, 23) = 0.111334E+01
+PKER_SDRYG( 2, 24) = 0.121202E+01
+PKER_SDRYG( 2, 25) = 0.130478E+01
+PKER_SDRYG( 2, 26) = 0.138982E+01
+PKER_SDRYG( 2, 27) = 0.146651E+01
+PKER_SDRYG( 2, 28) = 0.153473E+01
+PKER_SDRYG( 2, 29) = 0.159487E+01
+PKER_SDRYG( 2, 30) = 0.164760E+01
+PKER_SDRYG( 2, 31) = 0.169376E+01
+PKER_SDRYG( 2, 32) = 0.173428E+01
+PKER_SDRYG( 2, 33) = 0.177003E+01
+PKER_SDRYG( 2, 34) = 0.180176E+01
+PKER_SDRYG( 2, 35) = 0.183010E+01
+PKER_SDRYG( 2, 36) = 0.185555E+01
+PKER_SDRYG( 2, 37) = 0.187853E+01
+PKER_SDRYG( 2, 38) = 0.189939E+01
+PKER_SDRYG( 2, 39) = 0.191841E+01
+PKER_SDRYG( 2, 40) = 0.193583E+01
+PKER_SDRYG( 2, 41) = 0.195183E+01
+PKER_SDRYG( 2, 42) = 0.196657E+01
+PKER_SDRYG( 2, 43) = 0.198020E+01
+PKER_SDRYG( 2, 44) = 0.199282E+01
+PKER_SDRYG( 2, 45) = 0.200454E+01
+PKER_SDRYG( 2, 46) = 0.201543E+01
+PKER_SDRYG( 2, 47) = 0.202557E+01
+PKER_SDRYG( 2, 48) = 0.203503E+01
+PKER_SDRYG( 2, 49) = 0.204386E+01
+PKER_SDRYG( 2, 50) = 0.205211E+01
+PKER_SDRYG( 2, 51) = 0.205982E+01
+PKER_SDRYG( 2, 52) = 0.206703E+01
+PKER_SDRYG( 2, 53) = 0.207379E+01
+PKER_SDRYG( 2, 54) = 0.208011E+01
+PKER_SDRYG( 2, 55) = 0.208604E+01
+PKER_SDRYG( 2, 56) = 0.209159E+01
+PKER_SDRYG( 2, 57) = 0.209680E+01
+PKER_SDRYG( 2, 58) = 0.210169E+01
+PKER_SDRYG( 2, 59) = 0.210627E+01
+PKER_SDRYG( 2, 60) = 0.211056E+01
+PKER_SDRYG( 2, 61) = 0.211460E+01
+PKER_SDRYG( 2, 62) = 0.211838E+01
+PKER_SDRYG( 2, 63) = 0.212193E+01
+PKER_SDRYG( 2, 64) = 0.212526E+01
+PKER_SDRYG( 2, 65) = 0.212839E+01
+PKER_SDRYG( 2, 66) = 0.213133E+01
+PKER_SDRYG( 2, 67) = 0.213408E+01
+PKER_SDRYG( 2, 68) = 0.213667E+01
+PKER_SDRYG( 2, 69) = 0.213910E+01
+PKER_SDRYG( 2, 70) = 0.214138E+01
+PKER_SDRYG( 2, 71) = 0.214352E+01
+PKER_SDRYG( 2, 72) = 0.214553E+01
+PKER_SDRYG( 2, 73) = 0.214742E+01
+PKER_SDRYG( 2, 74) = 0.214919E+01
+PKER_SDRYG( 2, 75) = 0.215085E+01
+PKER_SDRYG( 2, 76) = 0.215242E+01
+PKER_SDRYG( 2, 77) = 0.215388E+01
+PKER_SDRYG( 2, 78) = 0.215526E+01
+PKER_SDRYG( 2, 79) = 0.215655E+01
+PKER_SDRYG( 2, 80) = 0.215777E+01
+PKER_SDRYG( 3, 1) = 0.215301E+01
+PKER_SDRYG( 3, 2) = 0.196106E+01
+PKER_SDRYG( 3, 3) = 0.178154E+01
+PKER_SDRYG( 3, 4) = 0.161399E+01
+PKER_SDRYG( 3, 5) = 0.145810E+01
+PKER_SDRYG( 3, 6) = 0.131365E+01
+PKER_SDRYG( 3, 7) = 0.118061E+01
+PKER_SDRYG( 3, 8) = 0.105881E+01
+PKER_SDRYG( 3, 9) = 0.948427E+00
+PKER_SDRYG( 3, 10) = 0.849613E+00
+PKER_SDRYG( 3, 11) = 0.762396E+00
+PKER_SDRYG( 3, 12) = 0.687541E+00
+PKER_SDRYG( 3, 13) = 0.625331E+00
+PKER_SDRYG( 3, 14) = 0.576279E+00
+PKER_SDRYG( 3, 15) = 0.541413E+00
+PKER_SDRYG( 3, 16) = 0.521621E+00
+PKER_SDRYG( 3, 17) = 0.517675E+00
+PKER_SDRYG( 3, 18) = 0.530574E+00
+PKER_SDRYG( 3, 19) = 0.560443E+00
+PKER_SDRYG( 3, 20) = 0.606854E+00
+PKER_SDRYG( 3, 21) = 0.668028E+00
+PKER_SDRYG( 3, 22) = 0.741035E+00
+PKER_SDRYG( 3, 23) = 0.822187E+00
+PKER_SDRYG( 3, 24) = 0.907057E+00
+PKER_SDRYG( 3, 25) = 0.991322E+00
+PKER_SDRYG( 3, 26) = 0.107147E+01
+PKER_SDRYG( 3, 27) = 0.114544E+01
+PKER_SDRYG( 3, 28) = 0.121245E+01
+PKER_SDRYG( 3, 29) = 0.127245E+01
+PKER_SDRYG( 3, 30) = 0.132580E+01
+PKER_SDRYG( 3, 31) = 0.137302E+01
+PKER_SDRYG( 3, 32) = 0.141473E+01
+PKER_SDRYG( 3, 33) = 0.145157E+01
+PKER_SDRYG( 3, 34) = 0.148421E+01
+PKER_SDRYG( 3, 35) = 0.151328E+01
+PKER_SDRYG( 3, 36) = 0.153931E+01
+PKER_SDRYG( 3, 37) = 0.156275E+01
+PKER_SDRYG( 3, 38) = 0.158397E+01
+PKER_SDRYG( 3, 39) = 0.160327E+01
+PKER_SDRYG( 3, 40) = 0.162090E+01
+PKER_SDRYG( 3, 41) = 0.163707E+01
+PKER_SDRYG( 3, 42) = 0.165195E+01
+PKER_SDRYG( 3, 43) = 0.166569E+01
+PKER_SDRYG( 3, 44) = 0.167839E+01
+PKER_SDRYG( 3, 45) = 0.169017E+01
+PKER_SDRYG( 3, 46) = 0.170112E+01
+PKER_SDRYG( 3, 47) = 0.171130E+01
+PKER_SDRYG( 3, 48) = 0.172079E+01
+PKER_SDRYG( 3, 49) = 0.172965E+01
+PKER_SDRYG( 3, 50) = 0.173791E+01
+PKER_SDRYG( 3, 51) = 0.174564E+01
+PKER_SDRYG( 3, 52) = 0.175287E+01
+PKER_SDRYG( 3, 53) = 0.175963E+01
+PKER_SDRYG( 3, 54) = 0.176596E+01
+PKER_SDRYG( 3, 55) = 0.177190E+01
+PKER_SDRYG( 3, 56) = 0.177746E+01
+PKER_SDRYG( 3, 57) = 0.178267E+01
+PKER_SDRYG( 3, 58) = 0.178755E+01
+PKER_SDRYG( 3, 59) = 0.179214E+01
+PKER_SDRYG( 3, 60) = 0.179644E+01
+PKER_SDRYG( 3, 61) = 0.180047E+01
+PKER_SDRYG( 3, 62) = 0.180425E+01
+PKER_SDRYG( 3, 63) = 0.180781E+01
+PKER_SDRYG( 3, 64) = 0.181114E+01
+PKER_SDRYG( 3, 65) = 0.181427E+01
+PKER_SDRYG( 3, 66) = 0.181720E+01
+PKER_SDRYG( 3, 67) = 0.181996E+01
+PKER_SDRYG( 3, 68) = 0.182255E+01
+PKER_SDRYG( 3, 69) = 0.182498E+01
+PKER_SDRYG( 3, 70) = 0.182726E+01
+PKER_SDRYG( 3, 71) = 0.182940E+01
+PKER_SDRYG( 3, 72) = 0.183141E+01
+PKER_SDRYG( 3, 73) = 0.183330E+01
+PKER_SDRYG( 3, 74) = 0.183507E+01
+PKER_SDRYG( 3, 75) = 0.183673E+01
+PKER_SDRYG( 3, 76) = 0.183829E+01
+PKER_SDRYG( 3, 77) = 0.183976E+01
+PKER_SDRYG( 3, 78) = 0.184114E+01
+PKER_SDRYG( 3, 79) = 0.184243E+01
+PKER_SDRYG( 3, 80) = 0.184365E+01
+PKER_SDRYG( 4, 1) = 0.229654E+01
+PKER_SDRYG( 4, 2) = 0.210356E+01
+PKER_SDRYG( 4, 3) = 0.192245E+01
+PKER_SDRYG( 4, 4) = 0.175260E+01
+PKER_SDRYG( 4, 5) = 0.159350E+01
+PKER_SDRYG( 4, 6) = 0.144476E+01
+PKER_SDRYG( 4, 7) = 0.130608E+01
+PKER_SDRYG( 4, 8) = 0.117720E+01
+PKER_SDRYG( 4, 9) = 0.105807E+01
+PKER_SDRYG( 4, 10) = 0.948604E+00
+PKER_SDRYG( 4, 11) = 0.849002E+00
+PKER_SDRYG( 4, 12) = 0.759416E+00
+PKER_SDRYG( 4, 13) = 0.680260E+00
+PKER_SDRYG( 4, 14) = 0.611882E+00
+PKER_SDRYG( 4, 15) = 0.554963E+00
+PKER_SDRYG( 4, 16) = 0.510479E+00
+PKER_SDRYG( 4, 17) = 0.479128E+00
+PKER_SDRYG( 4, 18) = 0.462033E+00
+PKER_SDRYG( 4, 19) = 0.460154E+00
+PKER_SDRYG( 4, 20) = 0.473966E+00
+PKER_SDRYG( 4, 21) = 0.503313E+00
+PKER_SDRYG( 4, 22) = 0.547021E+00
+PKER_SDRYG( 4, 23) = 0.602691E+00
+PKER_SDRYG( 4, 24) = 0.667130E+00
+PKER_SDRYG( 4, 25) = 0.736445E+00
+PKER_SDRYG( 4, 26) = 0.807101E+00
+PKER_SDRYG( 4, 27) = 0.875737E+00
+PKER_SDRYG( 4, 28) = 0.940003E+00
+PKER_SDRYG( 4, 29) = 0.998698E+00
+PKER_SDRYG( 4, 30) = 0.105152E+01
+PKER_SDRYG( 4, 31) = 0.109873E+01
+PKER_SDRYG( 4, 32) = 0.114082E+01
+PKER_SDRYG( 4, 33) = 0.117832E+01
+PKER_SDRYG( 4, 34) = 0.121173E+01
+PKER_SDRYG( 4, 35) = 0.124152E+01
+PKER_SDRYG( 4, 36) = 0.126818E+01
+PKER_SDRYG( 4, 37) = 0.129212E+01
+PKER_SDRYG( 4, 38) = 0.131373E+01
+PKER_SDRYG( 4, 39) = 0.133335E+01
+PKER_SDRYG( 4, 40) = 0.135123E+01
+PKER_SDRYG( 4, 41) = 0.136759E+01
+PKER_SDRYG( 4, 42) = 0.138262E+01
+PKER_SDRYG( 4, 43) = 0.139647E+01
+PKER_SDRYG( 4, 44) = 0.140927E+01
+PKER_SDRYG( 4, 45) = 0.142112E+01
+PKER_SDRYG( 4, 46) = 0.143212E+01
+PKER_SDRYG( 4, 47) = 0.144235E+01
+PKER_SDRYG( 4, 48) = 0.145188E+01
+PKER_SDRYG( 4, 49) = 0.146076E+01
+PKER_SDRYG( 4, 50) = 0.146905E+01
+PKER_SDRYG( 4, 51) = 0.147679E+01
+PKER_SDRYG( 4, 52) = 0.148403E+01
+PKER_SDRYG( 4, 53) = 0.149081E+01
+PKER_SDRYG( 4, 54) = 0.149715E+01
+PKER_SDRYG( 4, 55) = 0.150309E+01
+PKER_SDRYG( 4, 56) = 0.150865E+01
+PKER_SDRYG( 4, 57) = 0.151387E+01
+PKER_SDRYG( 4, 58) = 0.151876E+01
+PKER_SDRYG( 4, 59) = 0.152334E+01
+PKER_SDRYG( 4, 60) = 0.152764E+01
+PKER_SDRYG( 4, 61) = 0.153168E+01
+PKER_SDRYG( 4, 62) = 0.153546E+01
+PKER_SDRYG( 4, 63) = 0.153902E+01
+PKER_SDRYG( 4, 64) = 0.154235E+01
+PKER_SDRYG( 4, 65) = 0.154548E+01
+PKER_SDRYG( 4, 66) = 0.154842E+01
+PKER_SDRYG( 4, 67) = 0.155117E+01
+PKER_SDRYG( 4, 68) = 0.155376E+01
+PKER_SDRYG( 4, 69) = 0.155619E+01
+PKER_SDRYG( 4, 70) = 0.155847E+01
+PKER_SDRYG( 4, 71) = 0.156061E+01
+PKER_SDRYG( 4, 72) = 0.156262E+01
+PKER_SDRYG( 4, 73) = 0.156451E+01
+PKER_SDRYG( 4, 74) = 0.156628E+01
+PKER_SDRYG( 4, 75) = 0.156795E+01
+PKER_SDRYG( 4, 76) = 0.156951E+01
+PKER_SDRYG( 4, 77) = 0.157098E+01
+PKER_SDRYG( 4, 78) = 0.157235E+01
+PKER_SDRYG( 4, 79) = 0.157365E+01
+PKER_SDRYG( 4, 80) = 0.157486E+01
+PKER_SDRYG( 5, 1) = 0.242058E+01
+PKER_SDRYG( 5, 2) = 0.222747E+01
+PKER_SDRYG( 5, 3) = 0.204603E+01
+PKER_SDRYG( 5, 4) = 0.187558E+01
+PKER_SDRYG( 5, 5) = 0.171547E+01
+PKER_SDRYG( 5, 6) = 0.156517E+01
+PKER_SDRYG( 5, 7) = 0.142419E+01
+PKER_SDRYG( 5, 8) = 0.129215E+01
+PKER_SDRYG( 5, 9) = 0.116874E+01
+PKER_SDRYG( 5, 10) = 0.105374E+01
+PKER_SDRYG( 5, 11) = 0.947064E+00
+PKER_SDRYG( 5, 12) = 0.848754E+00
+PKER_SDRYG( 5, 13) = 0.758866E+00
+PKER_SDRYG( 5, 14) = 0.677714E+00
+PKER_SDRYG( 5, 15) = 0.605727E+00
+PKER_SDRYG( 5, 16) = 0.543389E+00
+PKER_SDRYG( 5, 17) = 0.491619E+00
+PKER_SDRYG( 5, 18) = 0.451355E+00
+PKER_SDRYG( 5, 19) = 0.423473E+00
+PKER_SDRYG( 5, 20) = 0.409129E+00
+PKER_SDRYG( 5, 21) = 0.409111E+00
+PKER_SDRYG( 5, 22) = 0.423458E+00
+PKER_SDRYG( 5, 23) = 0.451630E+00
+PKER_SDRYG( 5, 24) = 0.491797E+00
+PKER_SDRYG( 5, 25) = 0.541294E+00
+PKER_SDRYG( 5, 26) = 0.596703E+00
+PKER_SDRYG( 5, 27) = 0.654696E+00
+PKER_SDRYG( 5, 28) = 0.712443E+00
+PKER_SDRYG( 5, 29) = 0.767659E+00
+PKER_SDRYG( 5, 30) = 0.818920E+00
+PKER_SDRYG( 5, 31) = 0.865491E+00
+PKER_SDRYG( 5, 32) = 0.907343E+00
+PKER_SDRYG( 5, 33) = 0.944838E+00
+PKER_SDRYG( 5, 34) = 0.978432E+00
+PKER_SDRYG( 5, 35) = 0.100859E+01
+PKER_SDRYG( 5, 36) = 0.103569E+01
+PKER_SDRYG( 5, 37) = 0.106011E+01
+PKER_SDRYG( 5, 38) = 0.108214E+01
+PKER_SDRYG( 5, 39) = 0.110210E+01
+PKER_SDRYG( 5, 40) = 0.112025E+01
+PKER_SDRYG( 5, 41) = 0.113682E+01
+PKER_SDRYG( 5, 42) = 0.115202E+01
+PKER_SDRYG( 5, 43) = 0.116600E+01
+PKER_SDRYG( 5, 44) = 0.117890E+01
+PKER_SDRYG( 5, 45) = 0.119084E+01
+PKER_SDRYG( 5, 46) = 0.120190E+01
+PKER_SDRYG( 5, 47) = 0.121218E+01
+PKER_SDRYG( 5, 48) = 0.122174E+01
+PKER_SDRYG( 5, 49) = 0.123065E+01
+PKER_SDRYG( 5, 50) = 0.123897E+01
+PKER_SDRYG( 5, 51) = 0.124673E+01
+PKER_SDRYG( 5, 52) = 0.125398E+01
+PKER_SDRYG( 5, 53) = 0.126077E+01
+PKER_SDRYG( 5, 54) = 0.126712E+01
+PKER_SDRYG( 5, 55) = 0.127307E+01
+PKER_SDRYG( 5, 56) = 0.127864E+01
+PKER_SDRYG( 5, 57) = 0.128386E+01
+PKER_SDRYG( 5, 58) = 0.128875E+01
+PKER_SDRYG( 5, 59) = 0.129334E+01
+PKER_SDRYG( 5, 60) = 0.129764E+01
+PKER_SDRYG( 5, 61) = 0.130168E+01
+PKER_SDRYG( 5, 62) = 0.130547E+01
+PKER_SDRYG( 5, 63) = 0.130902E+01
+PKER_SDRYG( 5, 64) = 0.131236E+01
+PKER_SDRYG( 5, 65) = 0.131549E+01
+PKER_SDRYG( 5, 66) = 0.131842E+01
+PKER_SDRYG( 5, 67) = 0.132118E+01
+PKER_SDRYG( 5, 68) = 0.132377E+01
+PKER_SDRYG( 5, 69) = 0.132620E+01
+PKER_SDRYG( 5, 70) = 0.132848E+01
+PKER_SDRYG( 5, 71) = 0.133062E+01
+PKER_SDRYG( 5, 72) = 0.133263E+01
+PKER_SDRYG( 5, 73) = 0.133452E+01
+PKER_SDRYG( 5, 74) = 0.133629E+01
+PKER_SDRYG( 5, 75) = 0.133796E+01
+PKER_SDRYG( 5, 76) = 0.133952E+01
+PKER_SDRYG( 5, 77) = 0.134098E+01
+PKER_SDRYG( 5, 78) = 0.134236E+01
+PKER_SDRYG( 5, 79) = 0.134365E+01
+PKER_SDRYG( 5, 80) = 0.134487E+01
+PKER_SDRYG( 6, 1) = 0.252692E+01
+PKER_SDRYG( 6, 2) = 0.233392E+01
+PKER_SDRYG( 6, 3) = 0.215256E+01
+PKER_SDRYG( 6, 4) = 0.198212E+01
+PKER_SDRYG( 6, 5) = 0.182193E+01
+PKER_SDRYG( 6, 6) = 0.167134E+01
+PKER_SDRYG( 6, 7) = 0.152979E+01
+PKER_SDRYG( 6, 8) = 0.139676E+01
+PKER_SDRYG( 6, 9) = 0.127181E+01
+PKER_SDRYG( 6, 10) = 0.115455E+01
+PKER_SDRYG( 6, 11) = 0.104468E+01
+PKER_SDRYG( 6, 12) = 0.942046E+00
+PKER_SDRYG( 6, 13) = 0.846498E+00
+PKER_SDRYG( 6, 14) = 0.758078E+00
+PKER_SDRYG( 6, 15) = 0.676915E+00
+PKER_SDRYG( 6, 16) = 0.603393E+00
+PKER_SDRYG( 6, 17) = 0.537925E+00
+PKER_SDRYG( 6, 18) = 0.481299E+00
+PKER_SDRYG( 6, 19) = 0.434300E+00
+PKER_SDRYG( 6, 20) = 0.397962E+00
+PKER_SDRYG( 6, 21) = 0.373555E+00
+PKER_SDRYG( 6, 22) = 0.361810E+00
+PKER_SDRYG( 6, 23) = 0.363261E+00
+PKER_SDRYG( 6, 24) = 0.377804E+00
+PKER_SDRYG( 6, 25) = 0.404141E+00
+PKER_SDRYG( 6, 26) = 0.440111E+00
+PKER_SDRYG( 6, 27) = 0.482932E+00
+PKER_SDRYG( 6, 28) = 0.529526E+00
+PKER_SDRYG( 6, 29) = 0.577250E+00
+PKER_SDRYG( 6, 30) = 0.623904E+00
+PKER_SDRYG( 6, 31) = 0.668115E+00
+PKER_SDRYG( 6, 32) = 0.708971E+00
+PKER_SDRYG( 6, 33) = 0.746106E+00
+PKER_SDRYG( 6, 34) = 0.779586E+00
+PKER_SDRYG( 6, 35) = 0.809709E+00
+PKER_SDRYG( 6, 36) = 0.836864E+00
+PKER_SDRYG( 6, 37) = 0.861427E+00
+PKER_SDRYG( 6, 38) = 0.883701E+00
+PKER_SDRYG( 6, 39) = 0.903939E+00
+PKER_SDRYG( 6, 40) = 0.922359E+00
+PKER_SDRYG( 6, 41) = 0.939166E+00
+PKER_SDRYG( 6, 42) = 0.954549E+00
+PKER_SDRYG( 6, 43) = 0.968675E+00
+PKER_SDRYG( 6, 44) = 0.981689E+00
+PKER_SDRYG( 6, 45) = 0.993712E+00
+PKER_SDRYG( 6, 46) = 0.100485E+01
+PKER_SDRYG( 6, 47) = 0.101518E+01
+PKER_SDRYG( 6, 48) = 0.102479E+01
+PKER_SDRYG( 6, 49) = 0.103373E+01
+PKER_SDRYG( 6, 50) = 0.104207E+01
+PKER_SDRYG( 6, 51) = 0.104986E+01
+PKER_SDRYG( 6, 52) = 0.105713E+01
+PKER_SDRYG( 6, 53) = 0.106393E+01
+PKER_SDRYG( 6, 54) = 0.107029E+01
+PKER_SDRYG( 6, 55) = 0.107624E+01
+PKER_SDRYG( 6, 56) = 0.108182E+01
+PKER_SDRYG( 6, 57) = 0.108704E+01
+PKER_SDRYG( 6, 58) = 0.109194E+01
+PKER_SDRYG( 6, 59) = 0.109653E+01
+PKER_SDRYG( 6, 60) = 0.110084E+01
+PKER_SDRYG( 6, 61) = 0.110488E+01
+PKER_SDRYG( 6, 62) = 0.110866E+01
+PKER_SDRYG( 6, 63) = 0.111222E+01
+PKER_SDRYG( 6, 64) = 0.111556E+01
+PKER_SDRYG( 6, 65) = 0.111869E+01
+PKER_SDRYG( 6, 66) = 0.112162E+01
+PKER_SDRYG( 6, 67) = 0.112438E+01
+PKER_SDRYG( 6, 68) = 0.112697E+01
+PKER_SDRYG( 6, 69) = 0.112940E+01
+PKER_SDRYG( 6, 70) = 0.113168E+01
+PKER_SDRYG( 6, 71) = 0.113382E+01
+PKER_SDRYG( 6, 72) = 0.113583E+01
+PKER_SDRYG( 6, 73) = 0.113772E+01
+PKER_SDRYG( 6, 74) = 0.113949E+01
+PKER_SDRYG( 6, 75) = 0.114116E+01
+PKER_SDRYG( 6, 76) = 0.114272E+01
+PKER_SDRYG( 6, 77) = 0.114419E+01
+PKER_SDRYG( 6, 78) = 0.114556E+01
+PKER_SDRYG( 6, 79) = 0.114686E+01
+PKER_SDRYG( 6, 80) = 0.114807E+01
+PKER_SDRYG( 7, 1) = 0.261786E+01
+PKER_SDRYG( 7, 2) = 0.242499E+01
+PKER_SDRYG( 7, 3) = 0.224378E+01
+PKER_SDRYG( 7, 4) = 0.207350E+01
+PKER_SDRYG( 7, 5) = 0.191346E+01
+PKER_SDRYG( 7, 6) = 0.176300E+01
+PKER_SDRYG( 7, 7) = 0.162153E+01
+PKER_SDRYG( 7, 8) = 0.148846E+01
+PKER_SDRYG( 7, 9) = 0.136328E+01
+PKER_SDRYG( 7, 10) = 0.124549E+01
+PKER_SDRYG( 7, 11) = 0.113468E+01
+PKER_SDRYG( 7, 12) = 0.103050E+01
+PKER_SDRYG( 7, 13) = 0.932669E+00
+PKER_SDRYG( 7, 14) = 0.840960E+00
+PKER_SDRYG( 7, 15) = 0.755294E+00
+PKER_SDRYG( 7, 16) = 0.675723E+00
+PKER_SDRYG( 7, 17) = 0.602410E+00
+PKER_SDRYG( 7, 18) = 0.535732E+00
+PKER_SDRYG( 7, 19) = 0.476253E+00
+PKER_SDRYG( 7, 20) = 0.424743E+00
+PKER_SDRYG( 7, 21) = 0.382214E+00
+PKER_SDRYG( 7, 22) = 0.349787E+00
+PKER_SDRYG( 7, 23) = 0.328527E+00
+PKER_SDRYG( 7, 24) = 0.319129E+00
+PKER_SDRYG( 7, 25) = 0.321804E+00
+PKER_SDRYG( 7, 26) = 0.335925E+00
+PKER_SDRYG( 7, 27) = 0.359789E+00
+PKER_SDRYG( 7, 28) = 0.391183E+00
+PKER_SDRYG( 7, 29) = 0.427436E+00
+PKER_SDRYG( 7, 30) = 0.466046E+00
+PKER_SDRYG( 7, 31) = 0.504837E+00
+PKER_SDRYG( 7, 32) = 0.542368E+00
+PKER_SDRYG( 7, 33) = 0.577763E+00
+PKER_SDRYG( 7, 34) = 0.610469E+00
+PKER_SDRYG( 7, 35) = 0.640344E+00
+PKER_SDRYG( 7, 36) = 0.667411E+00
+PKER_SDRYG( 7, 37) = 0.691907E+00
+PKER_SDRYG( 7, 38) = 0.714147E+00
+PKER_SDRYG( 7, 39) = 0.734403E+00
+PKER_SDRYG( 7, 40) = 0.752915E+00
+PKER_SDRYG( 7, 41) = 0.769870E+00
+PKER_SDRYG( 7, 42) = 0.785417E+00
+PKER_SDRYG( 7, 43) = 0.799696E+00
+PKER_SDRYG( 7, 44) = 0.812835E+00
+PKER_SDRYG( 7, 45) = 0.824958E+00
+PKER_SDRYG( 7, 46) = 0.836170E+00
+PKER_SDRYG( 7, 47) = 0.846564E+00
+PKER_SDRYG( 7, 48) = 0.856219E+00
+PKER_SDRYG( 7, 49) = 0.865201E+00
+PKER_SDRYG( 7, 50) = 0.873570E+00
+PKER_SDRYG( 7, 51) = 0.881376E+00
+PKER_SDRYG( 7, 52) = 0.888666E+00
+PKER_SDRYG( 7, 53) = 0.895479E+00
+PKER_SDRYG( 7, 54) = 0.901851E+00
+PKER_SDRYG( 7, 55) = 0.907814E+00
+PKER_SDRYG( 7, 56) = 0.913398E+00
+PKER_SDRYG( 7, 57) = 0.918628E+00
+PKER_SDRYG( 7, 58) = 0.923530E+00
+PKER_SDRYG( 7, 59) = 0.928125E+00
+PKER_SDRYG( 7, 60) = 0.932433E+00
+PKER_SDRYG( 7, 61) = 0.936474E+00
+PKER_SDRYG( 7, 62) = 0.940264E+00
+PKER_SDRYG( 7, 63) = 0.943820E+00
+PKER_SDRYG( 7, 64) = 0.947157E+00
+PKER_SDRYG( 7, 65) = 0.950288E+00
+PKER_SDRYG( 7, 66) = 0.953227E+00
+PKER_SDRYG( 7, 67) = 0.955985E+00
+PKER_SDRYG( 7, 68) = 0.958574E+00
+PKER_SDRYG( 7, 69) = 0.961004E+00
+PKER_SDRYG( 7, 70) = 0.963286E+00
+PKER_SDRYG( 7, 71) = 0.965428E+00
+PKER_SDRYG( 7, 72) = 0.967438E+00
+PKER_SDRYG( 7, 73) = 0.969326E+00
+PKER_SDRYG( 7, 74) = 0.971099E+00
+PKER_SDRYG( 7, 75) = 0.972763E+00
+PKER_SDRYG( 7, 76) = 0.974325E+00
+PKER_SDRYG( 7, 77) = 0.975792E+00
+PKER_SDRYG( 7, 78) = 0.977169E+00
+PKER_SDRYG( 7, 79) = 0.978462E+00
+PKER_SDRYG( 7, 80) = 0.979677E+00
+PKER_SDRYG( 8, 1) = 0.269561E+01
+PKER_SDRYG( 8, 2) = 0.250283E+01
+PKER_SDRYG( 8, 3) = 0.232174E+01
+PKER_SDRYG( 8, 4) = 0.215161E+01
+PKER_SDRYG( 8, 5) = 0.199174E+01
+PKER_SDRYG( 8, 6) = 0.184149E+01
+PKER_SDRYG( 8, 7) = 0.170023E+01
+PKER_SDRYG( 8, 8) = 0.156739E+01
+PKER_SDRYG( 8, 9) = 0.144242E+01
+PKER_SDRYG( 8, 10) = 0.132479E+01
+PKER_SDRYG( 8, 11) = 0.121403E+01
+PKER_SDRYG( 8, 12) = 0.110969E+01
+PKER_SDRYG( 8, 13) = 0.101137E+01
+PKER_SDRYG( 8, 14) = 0.918736E+00
+PKER_SDRYG( 8, 15) = 0.831495E+00
+PKER_SDRYG( 8, 16) = 0.749451E+00
+PKER_SDRYG( 8, 17) = 0.672563E+00
+PKER_SDRYG( 8, 18) = 0.600835E+00
+PKER_SDRYG( 8, 19) = 0.534485E+00
+PKER_SDRYG( 8, 20) = 0.473951E+00
+PKER_SDRYG( 8, 21) = 0.419909E+00
+PKER_SDRYG( 8, 22) = 0.373149E+00
+PKER_SDRYG( 8, 23) = 0.334877E+00
+PKER_SDRYG( 8, 24) = 0.306095E+00
+PKER_SDRYG( 8, 25) = 0.287726E+00
+PKER_SDRYG( 8, 26) = 0.280481E+00
+PKER_SDRYG( 8, 27) = 0.283946E+00
+PKER_SDRYG( 8, 28) = 0.297076E+00
+PKER_SDRYG( 8, 29) = 0.318238E+00
+PKER_SDRYG( 8, 30) = 0.345049E+00
+PKER_SDRYG( 8, 31) = 0.375221E+00
+PKER_SDRYG( 8, 32) = 0.406792E+00
+PKER_SDRYG( 8, 33) = 0.438182E+00
+PKER_SDRYG( 8, 34) = 0.468400E+00
+PKER_SDRYG( 8, 35) = 0.496851E+00
+PKER_SDRYG( 8, 36) = 0.523262E+00
+PKER_SDRYG( 8, 37) = 0.547514E+00
+PKER_SDRYG( 8, 38) = 0.569649E+00
+PKER_SDRYG( 8, 39) = 0.589826E+00
+PKER_SDRYG( 8, 40) = 0.608254E+00
+PKER_SDRYG( 8, 41) = 0.625149E+00
+PKER_SDRYG( 8, 42) = 0.640693E+00
+PKER_SDRYG( 8, 43) = 0.655025E+00
+PKER_SDRYG( 8, 44) = 0.668253E+00
+PKER_SDRYG( 8, 45) = 0.680470E+00
+PKER_SDRYG( 8, 46) = 0.691766E+00
+PKER_SDRYG( 8, 47) = 0.702228E+00
+PKER_SDRYG( 8, 48) = 0.711935E+00
+PKER_SDRYG( 8, 49) = 0.720959E+00
+PKER_SDRYG( 8, 50) = 0.729360E+00
+PKER_SDRYG( 8, 51) = 0.737193E+00
+PKER_SDRYG( 8, 52) = 0.744502E+00
+PKER_SDRYG( 8, 53) = 0.751331E+00
+PKER_SDRYG( 8, 54) = 0.757715E+00
+PKER_SDRYG( 8, 55) = 0.763688E+00
+PKER_SDRYG( 8, 56) = 0.769279E+00
+PKER_SDRYG( 8, 57) = 0.774516E+00
+PKER_SDRYG( 8, 58) = 0.779422E+00
+PKER_SDRYG( 8, 59) = 0.784021E+00
+PKER_SDRYG( 8, 60) = 0.788332E+00
+PKER_SDRYG( 8, 61) = 0.792375E+00
+PKER_SDRYG( 8, 62) = 0.796167E+00
+PKER_SDRYG( 8, 63) = 0.799725E+00
+PKER_SDRYG( 8, 64) = 0.803062E+00
+PKER_SDRYG( 8, 65) = 0.806194E+00
+PKER_SDRYG( 8, 66) = 0.809134E+00
+PKER_SDRYG( 8, 67) = 0.811893E+00
+PKER_SDRYG( 8, 68) = 0.814482E+00
+PKER_SDRYG( 8, 69) = 0.816913E+00
+PKER_SDRYG( 8, 70) = 0.819194E+00
+PKER_SDRYG( 8, 71) = 0.821336E+00
+PKER_SDRYG( 8, 72) = 0.823347E+00
+PKER_SDRYG( 8, 73) = 0.825235E+00
+PKER_SDRYG( 8, 74) = 0.827008E+00
+PKER_SDRYG( 8, 75) = 0.828672E+00
+PKER_SDRYG( 8, 76) = 0.830234E+00
+PKER_SDRYG( 8, 77) = 0.831701E+00
+PKER_SDRYG( 8, 78) = 0.833078E+00
+PKER_SDRYG( 8, 79) = 0.834372E+00
+PKER_SDRYG( 8, 80) = 0.835586E+00
+PKER_SDRYG( 9, 1) = 0.276207E+01
+PKER_SDRYG( 9, 2) = 0.256937E+01
+PKER_SDRYG( 9, 3) = 0.238837E+01
+PKER_SDRYG( 9, 4) = 0.221834E+01
+PKER_SDRYG( 9, 5) = 0.205861E+01
+PKER_SDRYG( 9, 6) = 0.190852E+01
+PKER_SDRYG( 9, 7) = 0.176746E+01
+PKER_SDRYG( 9, 8) = 0.163486E+01
+PKER_SDRYG( 9, 9) = 0.151015E+01
+PKER_SDRYG( 9, 10) = 0.139283E+01
+PKER_SDRYG( 9, 11) = 0.128239E+01
+PKER_SDRYG( 9, 12) = 0.117836E+01
+PKER_SDRYG( 9, 13) = 0.108030E+01
+PKER_SDRYG( 9, 14) = 0.987804E+00
+PKER_SDRYG( 9, 15) = 0.900480E+00
+PKER_SDRYG( 9, 16) = 0.818006E+00
+PKER_SDRYG( 9, 17) = 0.740119E+00
+PKER_SDRYG( 9, 18) = 0.666640E+00
+PKER_SDRYG( 9, 19) = 0.597469E+00
+PKER_SDRYG( 9, 20) = 0.532692E+00
+PKER_SDRYG( 9, 21) = 0.472590E+00
+PKER_SDRYG( 9, 22) = 0.417593E+00
+PKER_SDRYG( 9, 23) = 0.368487E+00
+PKER_SDRYG( 9, 24) = 0.326216E+00
+PKER_SDRYG( 9, 25) = 0.291847E+00
+PKER_SDRYG( 9, 26) = 0.266518E+00
+PKER_SDRYG( 9, 27) = 0.250973E+00
+PKER_SDRYG( 9, 28) = 0.245401E+00
+PKER_SDRYG( 9, 29) = 0.249224E+00
+PKER_SDRYG( 9, 30) = 0.261135E+00
+PKER_SDRYG( 9, 31) = 0.279371E+00
+PKER_SDRYG( 9, 32) = 0.301823E+00
+PKER_SDRYG( 9, 33) = 0.326652E+00
+PKER_SDRYG( 9, 34) = 0.352342E+00
+PKER_SDRYG( 9, 35) = 0.377786E+00
+PKER_SDRYG( 9, 36) = 0.402202E+00
+PKER_SDRYG( 9, 37) = 0.425256E+00
+PKER_SDRYG( 9, 38) = 0.446772E+00
+PKER_SDRYG( 9, 39) = 0.466663E+00
+PKER_SDRYG( 9, 40) = 0.484977E+00
+PKER_SDRYG( 9, 41) = 0.501779E+00
+PKER_SDRYG( 9, 42) = 0.517214E+00
+PKER_SDRYG( 9, 43) = 0.531452E+00
+PKER_SDRYG( 9, 44) = 0.544618E+00
+PKER_SDRYG( 9, 45) = 0.556824E+00
+PKER_SDRYG( 9, 46) = 0.568153E+00
+PKER_SDRYG( 9, 47) = 0.578667E+00
+PKER_SDRYG( 9, 48) = 0.588428E+00
+PKER_SDRYG( 9, 49) = 0.597497E+00
+PKER_SDRYG( 9, 50) = 0.605935E+00
+PKER_SDRYG( 9, 51) = 0.613795E+00
+PKER_SDRYG( 9, 52) = 0.621127E+00
+PKER_SDRYG( 9, 53) = 0.627973E+00
+PKER_SDRYG( 9, 54) = 0.634371E+00
+PKER_SDRYG( 9, 55) = 0.640354E+00
+PKER_SDRYG( 9, 56) = 0.645954E+00
+PKER_SDRYG( 9, 57) = 0.651197E+00
+PKER_SDRYG( 9, 58) = 0.656109E+00
+PKER_SDRYG( 9, 59) = 0.660711E+00
+PKER_SDRYG( 9, 60) = 0.665026E+00
+PKER_SDRYG( 9, 61) = 0.669071E+00
+PKER_SDRYG( 9, 62) = 0.672865E+00
+PKER_SDRYG( 9, 63) = 0.676424E+00
+PKER_SDRYG( 9, 64) = 0.679763E+00
+PKER_SDRYG( 9, 65) = 0.682897E+00
+PKER_SDRYG( 9, 66) = 0.685837E+00
+PKER_SDRYG( 9, 67) = 0.688596E+00
+PKER_SDRYG( 9, 68) = 0.691186E+00
+PKER_SDRYG( 9, 69) = 0.693617E+00
+PKER_SDRYG( 9, 70) = 0.695899E+00
+PKER_SDRYG( 9, 71) = 0.698041E+00
+PKER_SDRYG( 9, 72) = 0.700052E+00
+PKER_SDRYG( 9, 73) = 0.701940E+00
+PKER_SDRYG( 9, 74) = 0.703713E+00
+PKER_SDRYG( 9, 75) = 0.705377E+00
+PKER_SDRYG( 9, 76) = 0.706940E+00
+PKER_SDRYG( 9, 77) = 0.708407E+00
+PKER_SDRYG( 9, 78) = 0.709784E+00
+PKER_SDRYG( 9, 79) = 0.711077E+00
+PKER_SDRYG( 9, 80) = 0.712292E+00
+PKER_SDRYG( 10, 1) = 0.281890E+01
+PKER_SDRYG( 10, 2) = 0.262625E+01
+PKER_SDRYG( 10, 3) = 0.244531E+01
+PKER_SDRYG( 10, 4) = 0.227537E+01
+PKER_SDRYG( 10, 5) = 0.211573E+01
+PKER_SDRYG( 10, 6) = 0.196576E+01
+PKER_SDRYG( 10, 7) = 0.182485E+01
+PKER_SDRYG( 10, 8) = 0.169243E+01
+PKER_SDRYG( 10, 9) = 0.156795E+01
+PKER_SDRYG( 10, 10) = 0.145089E+01
+PKER_SDRYG( 10, 11) = 0.134077E+01
+PKER_SDRYG( 10, 12) = 0.123711E+01
+PKER_SDRYG( 10, 13) = 0.113947E+01
+PKER_SDRYG( 10, 14) = 0.104741E+01
+PKER_SDRYG( 10, 15) = 0.960534E+00
+PKER_SDRYG( 10, 16) = 0.878447E+00
+PKER_SDRYG( 10, 17) = 0.800800E+00
+PKER_SDRYG( 10, 18) = 0.727272E+00
+PKER_SDRYG( 10, 19) = 0.657611E+00
+PKER_SDRYG( 10, 20) = 0.591632E+00
+PKER_SDRYG( 10, 21) = 0.529264E+00
+PKER_SDRYG( 10, 22) = 0.470668E+00
+PKER_SDRYG( 10, 23) = 0.416097E+00
+PKER_SDRYG( 10, 24) = 0.366106E+00
+PKER_SDRYG( 10, 25) = 0.321553E+00
+PKER_SDRYG( 10, 26) = 0.283464E+00
+PKER_SDRYG( 10, 27) = 0.252856E+00
+PKER_SDRYG( 10, 28) = 0.230814E+00
+PKER_SDRYG( 10, 29) = 0.217753E+00
+PKER_SDRYG( 10, 30) = 0.213511E+00
+PKER_SDRYG( 10, 31) = 0.217435E+00
+PKER_SDRYG( 10, 32) = 0.227916E+00
+PKER_SDRYG( 10, 33) = 0.243286E+00
+PKER_SDRYG( 10, 34) = 0.261931E+00
+PKER_SDRYG( 10, 35) = 0.282270E+00
+PKER_SDRYG( 10, 36) = 0.303153E+00
+PKER_SDRYG( 10, 37) = 0.323799E+00
+PKER_SDRYG( 10, 38) = 0.343682E+00
+PKER_SDRYG( 10, 39) = 0.362526E+00
+PKER_SDRYG( 10, 40) = 0.380218E+00
+PKER_SDRYG( 10, 41) = 0.396712E+00
+PKER_SDRYG( 10, 42) = 0.412002E+00
+PKER_SDRYG( 10, 43) = 0.426131E+00
+PKER_SDRYG( 10, 44) = 0.439189E+00
+PKER_SDRYG( 10, 45) = 0.451282E+00
+PKER_SDRYG( 10, 46) = 0.462518E+00
+PKER_SDRYG( 10, 47) = 0.472980E+00
+PKER_SDRYG( 10, 48) = 0.482733E+00
+PKER_SDRYG( 10, 49) = 0.491822E+00
+PKER_SDRYG( 10, 50) = 0.500291E+00
+PKER_SDRYG( 10, 51) = 0.508181E+00
+PKER_SDRYG( 10, 52) = 0.515537E+00
+PKER_SDRYG( 10, 53) = 0.522403E+00
+PKER_SDRYG( 10, 54) = 0.528816E+00
+PKER_SDRYG( 10, 55) = 0.534811E+00
+PKER_SDRYG( 10, 56) = 0.540420E+00
+PKER_SDRYG( 10, 57) = 0.545671E+00
+PKER_SDRYG( 10, 58) = 0.550588E+00
+PKER_SDRYG( 10, 59) = 0.555195E+00
+PKER_SDRYG( 10, 60) = 0.559513E+00
+PKER_SDRYG( 10, 61) = 0.563561E+00
+PKER_SDRYG( 10, 62) = 0.567358E+00
+PKER_SDRYG( 10, 63) = 0.570918E+00
+PKER_SDRYG( 10, 64) = 0.574259E+00
+PKER_SDRYG( 10, 65) = 0.577393E+00
+PKER_SDRYG( 10, 66) = 0.580334E+00
+PKER_SDRYG( 10, 67) = 0.583094E+00
+PKER_SDRYG( 10, 68) = 0.585685E+00
+PKER_SDRYG( 10, 69) = 0.588116E+00
+PKER_SDRYG( 10, 70) = 0.590398E+00
+PKER_SDRYG( 10, 71) = 0.592541E+00
+PKER_SDRYG( 10, 72) = 0.594552E+00
+PKER_SDRYG( 10, 73) = 0.596440E+00
+PKER_SDRYG( 10, 74) = 0.598213E+00
+PKER_SDRYG( 10, 75) = 0.599877E+00
+PKER_SDRYG( 10, 76) = 0.601440E+00
+PKER_SDRYG( 10, 77) = 0.602907E+00
+PKER_SDRYG( 10, 78) = 0.604284E+00
+PKER_SDRYG( 10, 79) = 0.605578E+00
+PKER_SDRYG( 10, 80) = 0.606792E+00
+PKER_SDRYG( 11, 1) = 0.286750E+01
+PKER_SDRYG( 11, 2) = 0.267488E+01
+PKER_SDRYG( 11, 3) = 0.249399E+01
+PKER_SDRYG( 11, 4) = 0.232410E+01
+PKER_SDRYG( 11, 5) = 0.216454E+01
+PKER_SDRYG( 11, 6) = 0.201465E+01
+PKER_SDRYG( 11, 7) = 0.187385E+01
+PKER_SDRYG( 11, 8) = 0.174156E+01
+PKER_SDRYG( 11, 9) = 0.161724E+01
+PKER_SDRYG( 11, 10) = 0.150038E+01
+PKER_SDRYG( 11, 11) = 0.139051E+01
+PKER_SDRYG( 11, 12) = 0.128715E+01
+PKER_SDRYG( 11, 13) = 0.118986E+01
+PKER_SDRYG( 11, 14) = 0.109824E+01
+PKER_SDRYG( 11, 15) = 0.101186E+01
+PKER_SDRYG( 11, 16) = 0.930332E+00
+PKER_SDRYG( 11, 17) = 0.853282E+00
+PKER_SDRYG( 11, 18) = 0.780348E+00
+PKER_SDRYG( 11, 19) = 0.711193E+00
+PKER_SDRYG( 11, 20) = 0.645511E+00
+PKER_SDRYG( 11, 21) = 0.583060E+00
+PKER_SDRYG( 11, 22) = 0.523685E+00
+PKER_SDRYG( 11, 23) = 0.467360E+00
+PKER_SDRYG( 11, 24) = 0.414210E+00
+PKER_SDRYG( 11, 25) = 0.364609E+00
+PKER_SDRYG( 11, 26) = 0.319253E+00
+PKER_SDRYG( 11, 27) = 0.278944E+00
+PKER_SDRYG( 11, 28) = 0.244812E+00
+PKER_SDRYG( 11, 29) = 0.217874E+00
+PKER_SDRYG( 11, 30) = 0.198828E+00
+PKER_SDRYG( 11, 31) = 0.187973E+00
+PKER_SDRYG( 11, 32) = 0.184872E+00
+PKER_SDRYG( 11, 33) = 0.188508E+00
+PKER_SDRYG( 11, 34) = 0.197506E+00
+PKER_SDRYG( 11, 35) = 0.210328E+00
+PKER_SDRYG( 11, 36) = 0.225647E+00
+PKER_SDRYG( 11, 37) = 0.242242E+00
+PKER_SDRYG( 11, 38) = 0.259254E+00
+PKER_SDRYG( 11, 39) = 0.276128E+00
+PKER_SDRYG( 11, 40) = 0.292461E+00
+PKER_SDRYG( 11, 41) = 0.308005E+00
+PKER_SDRYG( 11, 42) = 0.322690E+00
+PKER_SDRYG( 11, 43) = 0.336481E+00
+PKER_SDRYG( 11, 44) = 0.349355E+00
+PKER_SDRYG( 11, 45) = 0.361342E+00
+PKER_SDRYG( 11, 46) = 0.372471E+00
+PKER_SDRYG( 11, 47) = 0.382818E+00
+PKER_SDRYG( 11, 48) = 0.392468E+00
+PKER_SDRYG( 11, 49) = 0.401482E+00
+PKER_SDRYG( 11, 50) = 0.409913E+00
+PKER_SDRYG( 11, 51) = 0.417799E+00
+PKER_SDRYG( 11, 52) = 0.425169E+00
+PKER_SDRYG( 11, 53) = 0.432052E+00
+PKER_SDRYG( 11, 54) = 0.438481E+00
+PKER_SDRYG( 11, 55) = 0.444490E+00
+PKER_SDRYG( 11, 56) = 0.450109E+00
+PKER_SDRYG( 11, 57) = 0.455368E+00
+PKER_SDRYG( 11, 58) = 0.460292E+00
+PKER_SDRYG( 11, 59) = 0.464904E+00
+PKER_SDRYG( 11, 60) = 0.469226E+00
+PKER_SDRYG( 11, 61) = 0.473277E+00
+PKER_SDRYG( 11, 62) = 0.477076E+00
+PKER_SDRYG( 11, 63) = 0.480638E+00
+PKER_SDRYG( 11, 64) = 0.483980E+00
+PKER_SDRYG( 11, 65) = 0.487116E+00
+PKER_SDRYG( 11, 66) = 0.490058E+00
+PKER_SDRYG( 11, 67) = 0.492818E+00
+PKER_SDRYG( 11, 68) = 0.495409E+00
+PKER_SDRYG( 11, 69) = 0.497841E+00
+PKER_SDRYG( 11, 70) = 0.500124E+00
+PKER_SDRYG( 11, 71) = 0.502267E+00
+PKER_SDRYG( 11, 72) = 0.504278E+00
+PKER_SDRYG( 11, 73) = 0.506166E+00
+PKER_SDRYG( 11, 74) = 0.507939E+00
+PKER_SDRYG( 11, 75) = 0.509604E+00
+PKER_SDRYG( 11, 76) = 0.511166E+00
+PKER_SDRYG( 11, 77) = 0.512633E+00
+PKER_SDRYG( 11, 78) = 0.514011E+00
+PKER_SDRYG( 11, 79) = 0.515304E+00
+PKER_SDRYG( 11, 80) = 0.516519E+00
+PKER_SDRYG( 12, 1) = 0.290906E+01
+PKER_SDRYG( 12, 2) = 0.271647E+01
+PKER_SDRYG( 12, 3) = 0.253562E+01
+PKER_SDRYG( 12, 4) = 0.236577E+01
+PKER_SDRYG( 12, 5) = 0.220625E+01
+PKER_SDRYG( 12, 6) = 0.205643E+01
+PKER_SDRYG( 12, 7) = 0.191570E+01
+PKER_SDRYG( 12, 8) = 0.178350E+01
+PKER_SDRYG( 12, 9) = 0.165930E+01
+PKER_SDRYG( 12, 10) = 0.154259E+01
+PKER_SDRYG( 12, 11) = 0.143289E+01
+PKER_SDRYG( 12, 12) = 0.132974E+01
+PKER_SDRYG( 12, 13) = 0.123273E+01
+PKER_SDRYG( 12, 14) = 0.114144E+01
+PKER_SDRYG( 12, 15) = 0.105546E+01
+PKER_SDRYG( 12, 16) = 0.974419E+00
+PKER_SDRYG( 12, 17) = 0.897945E+00
+PKER_SDRYG( 12, 18) = 0.825675E+00
+PKER_SDRYG( 12, 19) = 0.757259E+00
+PKER_SDRYG( 12, 20) = 0.692357E+00
+PKER_SDRYG( 12, 21) = 0.630647E+00
+PKER_SDRYG( 12, 22) = 0.571852E+00
+PKER_SDRYG( 12, 23) = 0.515731E+00
+PKER_SDRYG( 12, 24) = 0.462161E+00
+PKER_SDRYG( 12, 25) = 0.411137E+00
+PKER_SDRYG( 12, 26) = 0.362843E+00
+PKER_SDRYG( 12, 27) = 0.317811E+00
+PKER_SDRYG( 12, 28) = 0.276701E+00
+PKER_SDRYG( 12, 29) = 0.240451E+00
+PKER_SDRYG( 12, 30) = 0.210140E+00
+PKER_SDRYG( 12, 31) = 0.186654E+00
+PKER_SDRYG( 12, 32) = 0.170411E+00
+PKER_SDRYG( 12, 33) = 0.161472E+00
+PKER_SDRYG( 12, 34) = 0.159162E+00
+PKER_SDRYG( 12, 35) = 0.162388E+00
+PKER_SDRYG( 12, 36) = 0.169994E+00
+PKER_SDRYG( 12, 37) = 0.180588E+00
+PKER_SDRYG( 12, 38) = 0.193112E+00
+PKER_SDRYG( 12, 39) = 0.206687E+00
+PKER_SDRYG( 12, 40) = 0.220641E+00
+PKER_SDRYG( 12, 41) = 0.234505E+00
+PKER_SDRYG( 12, 42) = 0.247994E+00
+PKER_SDRYG( 12, 43) = 0.260933E+00
+PKER_SDRYG( 12, 44) = 0.273225E+00
+PKER_SDRYG( 12, 45) = 0.284842E+00
+PKER_SDRYG( 12, 46) = 0.295768E+00
+PKER_SDRYG( 12, 47) = 0.305996E+00
+PKER_SDRYG( 12, 48) = 0.315542E+00
+PKER_SDRYG( 12, 49) = 0.324451E+00
+PKER_SDRYG( 12, 50) = 0.332775E+00
+PKER_SDRYG( 12, 51) = 0.340574E+00
+PKER_SDRYG( 12, 52) = 0.347888E+00
+PKER_SDRYG( 12, 53) = 0.354748E+00
+PKER_SDRYG( 12, 54) = 0.361176E+00
+PKER_SDRYG( 12, 55) = 0.367194E+00
+PKER_SDRYG( 12, 56) = 0.372824E+00
+PKER_SDRYG( 12, 57) = 0.378091E+00
+PKER_SDRYG( 12, 58) = 0.383022E+00
+PKER_SDRYG( 12, 59) = 0.387639E+00
+PKER_SDRYG( 12, 60) = 0.391966E+00
+PKER_SDRYG( 12, 61) = 0.396020E+00
+PKER_SDRYG( 12, 62) = 0.399822E+00
+PKER_SDRYG( 12, 63) = 0.403386E+00
+PKER_SDRYG( 12, 64) = 0.406730E+00
+PKER_SDRYG( 12, 65) = 0.409867E+00
+PKER_SDRYG( 12, 66) = 0.412810E+00
+PKER_SDRYG( 12, 67) = 0.415571E+00
+PKER_SDRYG( 12, 68) = 0.418163E+00
+PKER_SDRYG( 12, 69) = 0.420595E+00
+PKER_SDRYG( 12, 70) = 0.422878E+00
+PKER_SDRYG( 12, 71) = 0.425021E+00
+PKER_SDRYG( 12, 72) = 0.427033E+00
+PKER_SDRYG( 12, 73) = 0.428922E+00
+PKER_SDRYG( 12, 74) = 0.430695E+00
+PKER_SDRYG( 12, 75) = 0.432359E+00
+PKER_SDRYG( 12, 76) = 0.433922E+00
+PKER_SDRYG( 12, 77) = 0.435389E+00
+PKER_SDRYG( 12, 78) = 0.436767E+00
+PKER_SDRYG( 12, 79) = 0.438060E+00
+PKER_SDRYG( 12, 80) = 0.439274E+00
+PKER_SDRYG( 13, 1) = 0.294461E+01
+PKER_SDRYG( 13, 2) = 0.275204E+01
+PKER_SDRYG( 13, 3) = 0.257121E+01
+PKER_SDRYG( 13, 4) = 0.240139E+01
+PKER_SDRYG( 13, 5) = 0.224191E+01
+PKER_SDRYG( 13, 6) = 0.209213E+01
+PKER_SDRYG( 13, 7) = 0.195146E+01
+PKER_SDRYG( 13, 8) = 0.181933E+01
+PKER_SDRYG( 13, 9) = 0.169521E+01
+PKER_SDRYG( 13, 10) = 0.157859E+01
+PKER_SDRYG( 13, 11) = 0.146902E+01
+PKER_SDRYG( 13, 12) = 0.136604E+01
+PKER_SDRYG( 13, 13) = 0.126922E+01
+PKER_SDRYG( 13, 14) = 0.117816E+01
+PKER_SDRYG( 13, 15) = 0.109248E+01
+PKER_SDRYG( 13, 16) = 0.101180E+01
+PKER_SDRYG( 13, 17) = 0.935773E+00
+PKER_SDRYG( 13, 18) = 0.864045E+00
+PKER_SDRYG( 13, 19) = 0.796277E+00
+PKER_SDRYG( 13, 20) = 0.732136E+00
+PKER_SDRYG( 13, 21) = 0.671293E+00
+PKER_SDRYG( 13, 22) = 0.613429E+00
+PKER_SDRYG( 13, 23) = 0.558244E+00
+PKER_SDRYG( 13, 24) = 0.505468E+00
+PKER_SDRYG( 13, 25) = 0.454895E+00
+PKER_SDRYG( 13, 26) = 0.406428E+00
+PKER_SDRYG( 13, 27) = 0.360131E+00
+PKER_SDRYG( 13, 28) = 0.316299E+00
+PKER_SDRYG( 13, 29) = 0.275456E+00
+PKER_SDRYG( 13, 30) = 0.238374E+00
+PKER_SDRYG( 13, 31) = 0.206109E+00
+PKER_SDRYG( 13, 32) = 0.179451E+00
+PKER_SDRYG( 13, 33) = 0.159190E+00
+PKER_SDRYG( 13, 34) = 0.145545E+00
+PKER_SDRYG( 13, 35) = 0.138171E+00
+PKER_SDRYG( 13, 36) = 0.136403E+00
+PKER_SDRYG( 13, 37) = 0.139198E+00
+PKER_SDRYG( 13, 38) = 0.145447E+00
+PKER_SDRYG( 13, 39) = 0.154142E+00
+PKER_SDRYG( 13, 40) = 0.164364E+00
+PKER_SDRYG( 13, 41) = 0.175488E+00
+PKER_SDRYG( 13, 42) = 0.186961E+00
+PKER_SDRYG( 13, 43) = 0.198418E+00
+PKER_SDRYG( 13, 44) = 0.209659E+00
+PKER_SDRYG( 13, 45) = 0.220512E+00
+PKER_SDRYG( 13, 46) = 0.230875E+00
+PKER_SDRYG( 13, 47) = 0.240723E+00
+PKER_SDRYG( 13, 48) = 0.250043E+00
+PKER_SDRYG( 13, 49) = 0.258814E+00
+PKER_SDRYG( 13, 50) = 0.267045E+00
+PKER_SDRYG( 13, 51) = 0.274749E+00
+PKER_SDRYG( 13, 52) = 0.281964E+00
+PKER_SDRYG( 13, 53) = 0.288735E+00
+PKER_SDRYG( 13, 54) = 0.295096E+00
+PKER_SDRYG( 13, 55) = 0.301076E+00
+PKER_SDRYG( 13, 56) = 0.306693E+00
+PKER_SDRYG( 13, 57) = 0.311961E+00
+PKER_SDRYG( 13, 58) = 0.316898E+00
+PKER_SDRYG( 13, 59) = 0.321521E+00
+PKER_SDRYG( 13, 60) = 0.325852E+00
+PKER_SDRYG( 13, 61) = 0.329911E+00
+PKER_SDRYG( 13, 62) = 0.333715E+00
+PKER_SDRYG( 13, 63) = 0.337282E+00
+PKER_SDRYG( 13, 64) = 0.340628E+00
+PKER_SDRYG( 13, 65) = 0.343766E+00
+PKER_SDRYG( 13, 66) = 0.346710E+00
+PKER_SDRYG( 13, 67) = 0.349472E+00
+PKER_SDRYG( 13, 68) = 0.352064E+00
+PKER_SDRYG( 13, 69) = 0.354497E+00
+PKER_SDRYG( 13, 70) = 0.356781E+00
+PKER_SDRYG( 13, 71) = 0.358924E+00
+PKER_SDRYG( 13, 72) = 0.360936E+00
+PKER_SDRYG( 13, 73) = 0.362825E+00
+PKER_SDRYG( 13, 74) = 0.364598E+00
+PKER_SDRYG( 13, 75) = 0.366263E+00
+PKER_SDRYG( 13, 76) = 0.367826E+00
+PKER_SDRYG( 13, 77) = 0.369293E+00
+PKER_SDRYG( 13, 78) = 0.370671E+00
+PKER_SDRYG( 13, 79) = 0.371964E+00
+PKER_SDRYG( 13, 80) = 0.373178E+00
+PKER_SDRYG( 14, 1) = 0.297502E+01
+PKER_SDRYG( 14, 2) = 0.278247E+01
+PKER_SDRYG( 14, 3) = 0.260165E+01
+PKER_SDRYG( 14, 4) = 0.243185E+01
+PKER_SDRYG( 14, 5) = 0.227240E+01
+PKER_SDRYG( 14, 6) = 0.212265E+01
+PKER_SDRYG( 14, 7) = 0.198202E+01
+PKER_SDRYG( 14, 8) = 0.184993E+01
+PKER_SDRYG( 14, 9) = 0.172587E+01
+PKER_SDRYG( 14, 10) = 0.160933E+01
+PKER_SDRYG( 14, 11) = 0.149985E+01
+PKER_SDRYG( 14, 12) = 0.139698E+01
+PKER_SDRYG( 14, 13) = 0.130029E+01
+PKER_SDRYG( 14, 14) = 0.120941E+01
+PKER_SDRYG( 14, 15) = 0.112394E+01
+PKER_SDRYG( 14, 16) = 0.104352E+01
+PKER_SDRYG( 14, 17) = 0.967815E+00
+PKER_SDRYG( 14, 18) = 0.896486E+00
+PKER_SDRYG( 14, 19) = 0.829209E+00
+PKER_SDRYG( 14, 20) = 0.765666E+00
+PKER_SDRYG( 14, 21) = 0.705545E+00
+PKER_SDRYG( 14, 22) = 0.648535E+00
+PKER_SDRYG( 14, 23) = 0.594329E+00
+PKER_SDRYG( 14, 24) = 0.542628E+00
+PKER_SDRYG( 14, 25) = 0.493150E+00
+PKER_SDRYG( 14, 26) = 0.445651E+00
+PKER_SDRYG( 14, 27) = 0.399968E+00
+PKER_SDRYG( 14, 28) = 0.356041E+00
+PKER_SDRYG( 14, 29) = 0.314021E+00
+PKER_SDRYG( 14, 30) = 0.274267E+00
+PKER_SDRYG( 14, 31) = 0.237374E+00
+PKER_SDRYG( 14, 32) = 0.204260E+00
+PKER_SDRYG( 14, 33) = 0.175765E+00
+PKER_SDRYG( 14, 34) = 0.152637E+00
+PKER_SDRYG( 14, 35) = 0.135365E+00
+PKER_SDRYG( 14, 36) = 0.123949E+00
+PKER_SDRYG( 14, 37) = 0.117859E+00
+PKER_SDRYG( 14, 38) = 0.116422E+00
+PKER_SDRYG( 14, 39) = 0.118727E+00
+PKER_SDRYG( 14, 40) = 0.123806E+00
+PKER_SDRYG( 14, 41) = 0.130898E+00
+PKER_SDRYG( 14, 42) = 0.139254E+00
+PKER_SDRYG( 14, 43) = 0.148386E+00
+PKER_SDRYG( 14, 44) = 0.157857E+00
+PKER_SDRYG( 14, 45) = 0.167407E+00
+PKER_SDRYG( 14, 46) = 0.176814E+00
+PKER_SDRYG( 14, 47) = 0.185950E+00
+PKER_SDRYG( 14, 48) = 0.194744E+00
+PKER_SDRYG( 14, 49) = 0.203138E+00
+PKER_SDRYG( 14, 50) = 0.211120E+00
+PKER_SDRYG( 14, 51) = 0.218676E+00
+PKER_SDRYG( 14, 52) = 0.225795E+00
+PKER_SDRYG( 14, 53) = 0.232480E+00
+PKER_SDRYG( 14, 54) = 0.238754E+00
+PKER_SDRYG( 14, 55) = 0.244647E+00
+PKER_SDRYG( 14, 56) = 0.250193E+00
+PKER_SDRYG( 14, 57) = 0.255414E+00
+PKER_SDRYG( 14, 58) = 0.260327E+00
+PKER_SDRYG( 14, 59) = 0.264945E+00
+PKER_SDRYG( 14, 60) = 0.269277E+00
+PKER_SDRYG( 14, 61) = 0.273339E+00
+PKER_SDRYG( 14, 62) = 0.277147E+00
+PKER_SDRYG( 14, 63) = 0.280716E+00
+PKER_SDRYG( 14, 64) = 0.284064E+00
+PKER_SDRYG( 14, 65) = 0.287203E+00
+PKER_SDRYG( 14, 66) = 0.290149E+00
+PKER_SDRYG( 14, 67) = 0.292912E+00
+PKER_SDRYG( 14, 68) = 0.295505E+00
+PKER_SDRYG( 14, 69) = 0.297939E+00
+PKER_SDRYG( 14, 70) = 0.300223E+00
+PKER_SDRYG( 14, 71) = 0.302366E+00
+PKER_SDRYG( 14, 72) = 0.304379E+00
+PKER_SDRYG( 14, 73) = 0.306268E+00
+PKER_SDRYG( 14, 74) = 0.308041E+00
+PKER_SDRYG( 14, 75) = 0.309706E+00
+PKER_SDRYG( 14, 76) = 0.311269E+00
+PKER_SDRYG( 14, 77) = 0.312736E+00
+PKER_SDRYG( 14, 78) = 0.314114E+00
+PKER_SDRYG( 14, 79) = 0.315407E+00
+PKER_SDRYG( 14, 80) = 0.316622E+00
+PKER_SDRYG( 15, 1) = 0.300103E+01
+PKER_SDRYG( 15, 2) = 0.280849E+01
+PKER_SDRYG( 15, 3) = 0.262769E+01
+PKER_SDRYG( 15, 4) = 0.245790E+01
+PKER_SDRYG( 15, 5) = 0.229847E+01
+PKER_SDRYG( 15, 6) = 0.214875E+01
+PKER_SDRYG( 15, 7) = 0.200814E+01
+PKER_SDRYG( 15, 8) = 0.187609E+01
+PKER_SDRYG( 15, 9) = 0.175207E+01
+PKER_SDRYG( 15, 10) = 0.163559E+01
+PKER_SDRYG( 15, 11) = 0.152617E+01
+PKER_SDRYG( 15, 12) = 0.142337E+01
+PKER_SDRYG( 15, 13) = 0.132679E+01
+PKER_SDRYG( 15, 14) = 0.123602E+01
+PKER_SDRYG( 15, 15) = 0.115070E+01
+PKER_SDRYG( 15, 16) = 0.107047E+01
+PKER_SDRYG( 15, 17) = 0.994997E+00
+PKER_SDRYG( 15, 18) = 0.923952E+00
+PKER_SDRYG( 15, 19) = 0.857028E+00
+PKER_SDRYG( 15, 20) = 0.793920E+00
+PKER_SDRYG( 15, 21) = 0.734336E+00
+PKER_SDRYG( 15, 22) = 0.677982E+00
+PKER_SDRYG( 15, 23) = 0.624570E+00
+PKER_SDRYG( 15, 24) = 0.573810E+00
+PKER_SDRYG( 15, 25) = 0.525415E+00
+PKER_SDRYG( 15, 26) = 0.479106E+00
+PKER_SDRYG( 15, 27) = 0.434625E+00
+PKER_SDRYG( 15, 28) = 0.391766E+00
+PKER_SDRYG( 15, 29) = 0.350403E+00
+PKER_SDRYG( 15, 30) = 0.310560E+00
+PKER_SDRYG( 15, 31) = 0.272465E+00
+PKER_SDRYG( 15, 32) = 0.236568E+00
+PKER_SDRYG( 15, 33) = 0.203576E+00
+PKER_SDRYG( 15, 34) = 0.174281E+00
+PKER_SDRYG( 15, 35) = 0.149398E+00
+PKER_SDRYG( 15, 36) = 0.129630E+00
+PKER_SDRYG( 15, 37) = 0.114988E+00
+PKER_SDRYG( 15, 38) = 0.105420E+00
+PKER_SDRYG( 15, 39) = 0.100387E+00
+PKER_SDRYG( 15, 40) = 0.991260E-01
+PKER_SDRYG( 15, 41) = 0.100927E+00
+PKER_SDRYG( 15, 42) = 0.105008E+00
+PKER_SDRYG( 15, 43) = 0.110722E+00
+PKER_SDRYG( 15, 44) = 0.117557E+00
+PKER_SDRYG( 15, 45) = 0.125044E+00
+PKER_SDRYG( 15, 46) = 0.132897E+00
+PKER_SDRYG( 15, 47) = 0.140870E+00
+PKER_SDRYG( 15, 48) = 0.148774E+00
+PKER_SDRYG( 15, 49) = 0.156516E+00
+PKER_SDRYG( 15, 50) = 0.164008E+00
+PKER_SDRYG( 15, 51) = 0.171192E+00
+PKER_SDRYG( 15, 52) = 0.178051E+00
+PKER_SDRYG( 15, 53) = 0.184577E+00
+PKER_SDRYG( 15, 54) = 0.190747E+00
+PKER_SDRYG( 15, 55) = 0.196565E+00
+PKER_SDRYG( 15, 56) = 0.202034E+00
+PKER_SDRYG( 15, 57) = 0.207177E+00
+PKER_SDRYG( 15, 58) = 0.212021E+00
+PKER_SDRYG( 15, 59) = 0.216585E+00
+PKER_SDRYG( 15, 60) = 0.220887E+00
+PKER_SDRYG( 15, 61) = 0.224936E+00
+PKER_SDRYG( 15, 62) = 0.228741E+00
+PKER_SDRYG( 15, 63) = 0.232312E+00
+PKER_SDRYG( 15, 64) = 0.235662E+00
+PKER_SDRYG( 15, 65) = 0.238803E+00
+PKER_SDRYG( 15, 66) = 0.241750E+00
+PKER_SDRYG( 15, 67) = 0.244514E+00
+PKER_SDRYG( 15, 68) = 0.247108E+00
+PKER_SDRYG( 15, 69) = 0.249543E+00
+PKER_SDRYG( 15, 70) = 0.251827E+00
+PKER_SDRYG( 15, 71) = 0.253971E+00
+PKER_SDRYG( 15, 72) = 0.255984E+00
+PKER_SDRYG( 15, 73) = 0.257873E+00
+PKER_SDRYG( 15, 74) = 0.259647E+00
+PKER_SDRYG( 15, 75) = 0.261312E+00
+PKER_SDRYG( 15, 76) = 0.262875E+00
+PKER_SDRYG( 15, 77) = 0.264342E+00
+PKER_SDRYG( 15, 78) = 0.265720E+00
+PKER_SDRYG( 15, 79) = 0.267013E+00
+PKER_SDRYG( 15, 80) = 0.268228E+00
+PKER_SDRYG( 16, 1) = 0.302329E+01
+PKER_SDRYG( 16, 2) = 0.283075E+01
+PKER_SDRYG( 16, 3) = 0.264996E+01
+PKER_SDRYG( 16, 4) = 0.248019E+01
+PKER_SDRYG( 16, 5) = 0.232076E+01
+PKER_SDRYG( 16, 6) = 0.217106E+01
+PKER_SDRYG( 16, 7) = 0.203047E+01
+PKER_SDRYG( 16, 8) = 0.189845E+01
+PKER_SDRYG( 16, 9) = 0.177446E+01
+PKER_SDRYG( 16, 10) = 0.165801E+01
+PKER_SDRYG( 16, 11) = 0.154864E+01
+PKER_SDRYG( 16, 12) = 0.144590E+01
+PKER_SDRYG( 16, 13) = 0.134939E+01
+PKER_SDRYG( 16, 14) = 0.125871E+01
+PKER_SDRYG( 16, 15) = 0.117350E+01
+PKER_SDRYG( 16, 16) = 0.109340E+01
+PKER_SDRYG( 16, 17) = 0.101809E+01
+PKER_SDRYG( 16, 18) = 0.947248E+00
+PKER_SDRYG( 16, 19) = 0.880574E+00
+PKER_SDRYG( 16, 20) = 0.817777E+00
+PKER_SDRYG( 16, 21) = 0.758577E+00
+PKER_SDRYG( 16, 22) = 0.702699E+00
+PKER_SDRYG( 16, 23) = 0.649873E+00
+PKER_SDRYG( 16, 24) = 0.599828E+00
+PKER_SDRYG( 16, 25) = 0.552297E+00
+PKER_SDRYG( 16, 26) = 0.507010E+00
+PKER_SDRYG( 16, 27) = 0.463701E+00
+PKER_SDRYG( 16, 28) = 0.422113E+00
+PKER_SDRYG( 16, 29) = 0.382023E+00
+PKER_SDRYG( 16, 30) = 0.343269E+00
+PKER_SDRYG( 16, 31) = 0.305794E+00
+PKER_SDRYG( 16, 32) = 0.269715E+00
+PKER_SDRYG( 16, 33) = 0.235329E+00
+PKER_SDRYG( 16, 34) = 0.203179E+00
+PKER_SDRYG( 16, 35) = 0.173939E+00
+PKER_SDRYG( 16, 36) = 0.148290E+00
+PKER_SDRYG( 16, 37) = 0.126911E+00
+PKER_SDRYG( 16, 38) = 0.110074E+00
+PKER_SDRYG( 16, 39) = 0.977722E-01
+PKER_SDRYG( 16, 40) = 0.897236E-01
+PKER_SDRYG( 16, 41) = 0.854547E-01
+PKER_SDRYG( 16, 42) = 0.842616E-01
+PKER_SDRYG( 16, 43) = 0.855520E-01
+PKER_SDRYG( 16, 44) = 0.887781E-01
+PKER_SDRYG( 16, 45) = 0.933675E-01
+PKER_SDRYG( 16, 46) = 0.989218E-01
+PKER_SDRYG( 16, 47) = 0.105082E+00
+PKER_SDRYG( 16, 48) = 0.111617E+00
+PKER_SDRYG( 16, 49) = 0.118278E+00
+PKER_SDRYG( 16, 50) = 0.124959E+00
+PKER_SDRYG( 16, 51) = 0.131533E+00
+PKER_SDRYG( 16, 52) = 0.137923E+00
+PKER_SDRYG( 16, 53) = 0.144095E+00
+PKER_SDRYG( 16, 54) = 0.150006E+00
+PKER_SDRYG( 16, 55) = 0.155648E+00
+PKER_SDRYG( 16, 56) = 0.161010E+00
+PKER_SDRYG( 16, 57) = 0.166080E+00
+PKER_SDRYG( 16, 58) = 0.170856E+00
+PKER_SDRYG( 16, 59) = 0.175353E+00
+PKER_SDRYG( 16, 60) = 0.179587E+00
+PKER_SDRYG( 16, 61) = 0.183582E+00
+PKER_SDRYG( 16, 62) = 0.187351E+00
+PKER_SDRYG( 16, 63) = 0.190904E+00
+PKER_SDRYG( 16, 64) = 0.194247E+00
+PKER_SDRYG( 16, 65) = 0.197388E+00
+PKER_SDRYG( 16, 66) = 0.200335E+00
+PKER_SDRYG( 16, 67) = 0.203101E+00
+PKER_SDRYG( 16, 68) = 0.205696E+00
+PKER_SDRYG( 16, 69) = 0.208131E+00
+PKER_SDRYG( 16, 70) = 0.210416E+00
+PKER_SDRYG( 16, 71) = 0.212560E+00
+PKER_SDRYG( 16, 72) = 0.214573E+00
+PKER_SDRYG( 16, 73) = 0.216463E+00
+PKER_SDRYG( 16, 74) = 0.218237E+00
+PKER_SDRYG( 16, 75) = 0.219902E+00
+PKER_SDRYG( 16, 76) = 0.221465E+00
+PKER_SDRYG( 16, 77) = 0.222933E+00
+PKER_SDRYG( 16, 78) = 0.224310E+00
+PKER_SDRYG( 16, 79) = 0.225604E+00
+PKER_SDRYG( 16, 80) = 0.226819E+00
+PKER_SDRYG( 17, 1) = 0.304233E+01
+PKER_SDRYG( 17, 2) = 0.284980E+01
+PKER_SDRYG( 17, 3) = 0.266901E+01
+PKER_SDRYG( 17, 4) = 0.249924E+01
+PKER_SDRYG( 17, 5) = 0.233983E+01
+PKER_SDRYG( 17, 6) = 0.219014E+01
+PKER_SDRYG( 17, 7) = 0.204957E+01
+PKER_SDRYG( 17, 8) = 0.191757E+01
+PKER_SDRYG( 17, 9) = 0.179360E+01
+PKER_SDRYG( 17, 10) = 0.167718E+01
+PKER_SDRYG( 17, 11) = 0.156784E+01
+PKER_SDRYG( 17, 12) = 0.146515E+01
+PKER_SDRYG( 17, 13) = 0.136868E+01
+PKER_SDRYG( 17, 14) = 0.127807E+01
+PKER_SDRYG( 17, 15) = 0.119293E+01
+PKER_SDRYG( 17, 16) = 0.111293E+01
+PKER_SDRYG( 17, 17) = 0.103773E+01
+PKER_SDRYG( 17, 18) = 0.967037E+00
+PKER_SDRYG( 17, 19) = 0.900542E+00
+PKER_SDRYG( 17, 20) = 0.837966E+00
+PKER_SDRYG( 17, 21) = 0.779040E+00
+PKER_SDRYG( 17, 22) = 0.723501E+00
+PKER_SDRYG( 17, 23) = 0.671093E+00
+PKER_SDRYG( 17, 24) = 0.621566E+00
+PKER_SDRYG( 17, 25) = 0.574672E+00
+PKER_SDRYG( 17, 26) = 0.530159E+00
+PKER_SDRYG( 17, 27) = 0.487780E+00
+PKER_SDRYG( 17, 28) = 0.447283E+00
+PKER_SDRYG( 17, 29) = 0.408426E+00
+PKER_SDRYG( 17, 30) = 0.370984E+00
+PKER_SDRYG( 17, 31) = 0.334777E+00
+PKER_SDRYG( 17, 32) = 0.299703E+00
+PKER_SDRYG( 17, 33) = 0.265795E+00
+PKER_SDRYG( 17, 34) = 0.233237E+00
+PKER_SDRYG( 17, 35) = 0.202426E+00
+PKER_SDRYG( 17, 36) = 0.173914E+00
+PKER_SDRYG( 17, 37) = 0.148301E+00
+PKER_SDRYG( 17, 38) = 0.126202E+00
+PKER_SDRYG( 17, 39) = 0.107984E+00
+PKER_SDRYG( 17, 40) = 0.936873E-01
+PKER_SDRYG( 17, 41) = 0.833770E-01
+PKER_SDRYG( 17, 42) = 0.765063E-01
+PKER_SDRYG( 17, 43) = 0.727630E-01
+PKER_SDRYG( 17, 44) = 0.715986E-01
+PKER_SDRYG( 17, 45) = 0.724633E-01
+PKER_SDRYG( 17, 46) = 0.749323E-01
+PKER_SDRYG( 17, 47) = 0.785778E-01
+PKER_SDRYG( 17, 48) = 0.830719E-01
+PKER_SDRYG( 17, 49) = 0.881403E-01
+PKER_SDRYG( 17, 50) = 0.935486E-01
+PKER_SDRYG( 17, 51) = 0.991378E-01
+PKER_SDRYG( 17, 52) = 0.104781E+00
+PKER_SDRYG( 17, 53) = 0.110369E+00
+PKER_SDRYG( 17, 54) = 0.115842E+00
+PKER_SDRYG( 17, 55) = 0.121148E+00
+PKER_SDRYG( 17, 56) = 0.126252E+00
+PKER_SDRYG( 17, 57) = 0.131138E+00
+PKER_SDRYG( 17, 58) = 0.135801E+00
+PKER_SDRYG( 17, 59) = 0.140221E+00
+PKER_SDRYG( 17, 60) = 0.144398E+00
+PKER_SDRYG( 17, 61) = 0.148334E+00
+PKER_SDRYG( 17, 62) = 0.152044E+00
+PKER_SDRYG( 17, 63) = 0.155543E+00
+PKER_SDRYG( 17, 64) = 0.158847E+00
+PKER_SDRYG( 17, 65) = 0.161964E+00
+PKER_SDRYG( 17, 66) = 0.164902E+00
+PKER_SDRYG( 17, 67) = 0.167664E+00
+PKER_SDRYG( 17, 68) = 0.170259E+00
+PKER_SDRYG( 17, 69) = 0.172695E+00
+PKER_SDRYG( 17, 70) = 0.174981E+00
+PKER_SDRYG( 17, 71) = 0.177126E+00
+PKER_SDRYG( 17, 72) = 0.179139E+00
+PKER_SDRYG( 17, 73) = 0.181029E+00
+PKER_SDRYG( 17, 74) = 0.182803E+00
+PKER_SDRYG( 17, 75) = 0.184468E+00
+PKER_SDRYG( 17, 76) = 0.186032E+00
+PKER_SDRYG( 17, 77) = 0.187499E+00
+PKER_SDRYG( 17, 78) = 0.188877E+00
+PKER_SDRYG( 17, 79) = 0.190171E+00
+PKER_SDRYG( 17, 80) = 0.191386E+00
+PKER_SDRYG( 18, 1) = 0.305861E+01
+PKER_SDRYG( 18, 2) = 0.286609E+01
+PKER_SDRYG( 18, 3) = 0.268530E+01
+PKER_SDRYG( 18, 4) = 0.251555E+01
+PKER_SDRYG( 18, 5) = 0.235614E+01
+PKER_SDRYG( 18, 6) = 0.220646E+01
+PKER_SDRYG( 18, 7) = 0.206590E+01
+PKER_SDRYG( 18, 8) = 0.193391E+01
+PKER_SDRYG( 18, 9) = 0.180996E+01
+PKER_SDRYG( 18, 10) = 0.169356E+01
+PKER_SDRYG( 18, 11) = 0.158425E+01
+PKER_SDRYG( 18, 12) = 0.148158E+01
+PKER_SDRYG( 18, 13) = 0.138516E+01
+PKER_SDRYG( 18, 14) = 0.129459E+01
+PKER_SDRYG( 18, 15) = 0.120951E+01
+PKER_SDRYG( 18, 16) = 0.112957E+01
+PKER_SDRYG( 18, 17) = 0.105446E+01
+PKER_SDRYG( 18, 18) = 0.983869E+00
+PKER_SDRYG( 18, 19) = 0.917502E+00
+PKER_SDRYG( 18, 20) = 0.855084E+00
+PKER_SDRYG( 18, 21) = 0.796353E+00
+PKER_SDRYG( 18, 22) = 0.741055E+00
+PKER_SDRYG( 18, 23) = 0.688947E+00
+PKER_SDRYG( 18, 24) = 0.639789E+00
+PKER_SDRYG( 18, 25) = 0.593351E+00
+PKER_SDRYG( 18, 26) = 0.549400E+00
+PKER_SDRYG( 18, 27) = 0.507707E+00
+PKER_SDRYG( 18, 28) = 0.468042E+00
+PKER_SDRYG( 18, 29) = 0.430173E+00
+PKER_SDRYG( 18, 30) = 0.393871E+00
+PKER_SDRYG( 18, 31) = 0.358924E+00
+PKER_SDRYG( 18, 32) = 0.325148E+00
+PKER_SDRYG( 18, 33) = 0.292420E+00
+PKER_SDRYG( 18, 34) = 0.260716E+00
+PKER_SDRYG( 18, 35) = 0.230147E+00
+PKER_SDRYG( 18, 36) = 0.200989E+00
+PKER_SDRYG( 18, 37) = 0.173670E+00
+PKER_SDRYG( 18, 38) = 0.148685E+00
+PKER_SDRYG( 18, 39) = 0.126560E+00
+PKER_SDRYG( 18, 40) = 0.107668E+00
+PKER_SDRYG( 18, 41) = 0.921800E-01
+PKER_SDRYG( 18, 42) = 0.801537E-01
+PKER_SDRYG( 18, 43) = 0.713567E-01
+PKER_SDRYG( 18, 44) = 0.654782E-01
+PKER_SDRYG( 18, 45) = 0.621068E-01
+PKER_SDRYG( 18, 46) = 0.608901E-01
+PKER_SDRYG( 18, 47) = 0.613554E-01
+PKER_SDRYG( 18, 48) = 0.631511E-01
+PKER_SDRYG( 18, 49) = 0.660247E-01
+PKER_SDRYG( 18, 50) = 0.696433E-01
+PKER_SDRYG( 18, 51) = 0.737836E-01
+PKER_SDRYG( 18, 52) = 0.782701E-01
+PKER_SDRYG( 18, 53) = 0.829722E-01
+PKER_SDRYG( 18, 54) = 0.877276E-01
+PKER_SDRYG( 18, 55) = 0.924938E-01
+PKER_SDRYG( 18, 56) = 0.971825E-01
+PKER_SDRYG( 18, 57) = 0.101744E+00
+PKER_SDRYG( 18, 58) = 0.106160E+00
+PKER_SDRYG( 18, 59) = 0.110397E+00
+PKER_SDRYG( 18, 60) = 0.114449E+00
+PKER_SDRYG( 18, 61) = 0.118307E+00
+PKER_SDRYG( 18, 62) = 0.121962E+00
+PKER_SDRYG( 18, 63) = 0.125411E+00
+PKER_SDRYG( 18, 64) = 0.128663E+00
+PKER_SDRYG( 18, 65) = 0.131730E+00
+PKER_SDRYG( 18, 66) = 0.134628E+00
+PKER_SDRYG( 18, 67) = 0.137364E+00
+PKER_SDRYG( 18, 68) = 0.139945E+00
+PKER_SDRYG( 18, 69) = 0.142375E+00
+PKER_SDRYG( 18, 70) = 0.144660E+00
+PKER_SDRYG( 18, 71) = 0.146805E+00
+PKER_SDRYG( 18, 72) = 0.148819E+00
+PKER_SDRYG( 18, 73) = 0.150709E+00
+PKER_SDRYG( 18, 74) = 0.152483E+00
+PKER_SDRYG( 18, 75) = 0.154149E+00
+PKER_SDRYG( 18, 76) = 0.155712E+00
+PKER_SDRYG( 18, 77) = 0.157180E+00
+PKER_SDRYG( 18, 78) = 0.158558E+00
+PKER_SDRYG( 18, 79) = 0.159852E+00
+PKER_SDRYG( 18, 80) = 0.161067E+00
+PKER_SDRYG( 19, 1) = 0.307255E+01
+PKER_SDRYG( 19, 2) = 0.288003E+01
+PKER_SDRYG( 19, 3) = 0.269925E+01
+PKER_SDRYG( 19, 4) = 0.252949E+01
+PKER_SDRYG( 19, 5) = 0.237010E+01
+PKER_SDRYG( 19, 6) = 0.222042E+01
+PKER_SDRYG( 19, 7) = 0.207987E+01
+PKER_SDRYG( 19, 8) = 0.194789E+01
+PKER_SDRYG( 19, 9) = 0.182395E+01
+PKER_SDRYG( 19, 10) = 0.170757E+01
+PKER_SDRYG( 19, 11) = 0.159827E+01
+PKER_SDRYG( 19, 12) = 0.149563E+01
+PKER_SDRYG( 19, 13) = 0.139923E+01
+PKER_SDRYG( 19, 14) = 0.130869E+01
+PKER_SDRYG( 19, 15) = 0.122365E+01
+PKER_SDRYG( 19, 16) = 0.114377E+01
+PKER_SDRYG( 19, 17) = 0.106872E+01
+PKER_SDRYG( 19, 18) = 0.998202E+00
+PKER_SDRYG( 19, 19) = 0.931926E+00
+PKER_SDRYG( 19, 20) = 0.869623E+00
+PKER_SDRYG( 19, 21) = 0.811031E+00
+PKER_SDRYG( 19, 22) = 0.755906E+00
+PKER_SDRYG( 19, 23) = 0.704011E+00
+PKER_SDRYG( 19, 24) = 0.655117E+00
+PKER_SDRYG( 19, 25) = 0.609004E+00
+PKER_SDRYG( 19, 26) = 0.565455E+00
+PKER_SDRYG( 19, 27) = 0.524258E+00
+PKER_SDRYG( 19, 28) = 0.485199E+00
+PKER_SDRYG( 19, 29) = 0.448065E+00
+PKER_SDRYG( 19, 30) = 0.412644E+00
+PKER_SDRYG( 19, 31) = 0.378726E+00
+PKER_SDRYG( 19, 32) = 0.346109E+00
+PKER_SDRYG( 19, 33) = 0.314617E+00
+PKER_SDRYG( 19, 34) = 0.284120E+00
+PKER_SDRYG( 19, 35) = 0.254566E+00
+PKER_SDRYG( 19, 36) = 0.226009E+00
+PKER_SDRYG( 19, 37) = 0.198643E+00
+PKER_SDRYG( 19, 38) = 0.172786E+00
+PKER_SDRYG( 19, 39) = 0.148830E+00
+PKER_SDRYG( 19, 40) = 0.127216E+00
+PKER_SDRYG( 19, 41) = 0.108286E+00
+PKER_SDRYG( 19, 42) = 0.922237E-01
+PKER_SDRYG( 19, 43) = 0.791616E-01
+PKER_SDRYG( 19, 44) = 0.689769E-01
+PKER_SDRYG( 19, 45) = 0.613748E-01
+PKER_SDRYG( 19, 46) = 0.562746E-01
+PKER_SDRYG( 19, 47) = 0.531554E-01
+PKER_SDRYG( 19, 48) = 0.518361E-01
+PKER_SDRYG( 19, 49) = 0.519775E-01
+PKER_SDRYG( 19, 50) = 0.532667E-01
+PKER_SDRYG( 19, 51) = 0.554628E-01
+PKER_SDRYG( 19, 52) = 0.583379E-01
+PKER_SDRYG( 19, 53) = 0.617174E-01
+PKER_SDRYG( 19, 54) = 0.654271E-01
+PKER_SDRYG( 19, 55) = 0.693467E-01
+PKER_SDRYG( 19, 56) = 0.733724E-01
+PKER_SDRYG( 19, 57) = 0.774227E-01
+PKER_SDRYG( 19, 58) = 0.814369E-01
+PKER_SDRYG( 19, 59) = 0.853677E-01
+PKER_SDRYG( 19, 60) = 0.891824E-01
+PKER_SDRYG( 19, 61) = 0.928586E-01
+PKER_SDRYG( 19, 62) = 0.963820E-01
+PKER_SDRYG( 19, 63) = 0.997497E-01
+PKER_SDRYG( 19, 64) = 0.102946E+00
+PKER_SDRYG( 19, 65) = 0.105969E+00
+PKER_SDRYG( 19, 66) = 0.108823E+00
+PKER_SDRYG( 19, 67) = 0.111515E+00
+PKER_SDRYG( 19, 68) = 0.114057E+00
+PKER_SDRYG( 19, 69) = 0.116458E+00
+PKER_SDRYG( 19, 70) = 0.118726E+00
+PKER_SDRYG( 19, 71) = 0.120863E+00
+PKER_SDRYG( 19, 72) = 0.122875E+00
+PKER_SDRYG( 19, 73) = 0.124765E+00
+PKER_SDRYG( 19, 74) = 0.126539E+00
+PKER_SDRYG( 19, 75) = 0.128205E+00
+PKER_SDRYG( 19, 76) = 0.129769E+00
+PKER_SDRYG( 19, 77) = 0.131237E+00
+PKER_SDRYG( 19, 78) = 0.132615E+00
+PKER_SDRYG( 19, 79) = 0.133909E+00
+PKER_SDRYG( 19, 80) = 0.135123E+00
+PKER_SDRYG( 20, 1) = 0.308447E+01
+PKER_SDRYG( 20, 2) = 0.289195E+01
+PKER_SDRYG( 20, 3) = 0.271117E+01
+PKER_SDRYG( 20, 4) = 0.254143E+01
+PKER_SDRYG( 20, 5) = 0.238203E+01
+PKER_SDRYG( 20, 6) = 0.223236E+01
+PKER_SDRYG( 20, 7) = 0.209182E+01
+PKER_SDRYG( 20, 8) = 0.195984E+01
+PKER_SDRYG( 20, 9) = 0.183591E+01
+PKER_SDRYG( 20, 10) = 0.171954E+01
+PKER_SDRYG( 20, 11) = 0.161026E+01
+PKER_SDRYG( 20, 12) = 0.150763E+01
+PKER_SDRYG( 20, 13) = 0.141126E+01
+PKER_SDRYG( 20, 14) = 0.132074E+01
+PKER_SDRYG( 20, 15) = 0.123573E+01
+PKER_SDRYG( 20, 16) = 0.115588E+01
+PKER_SDRYG( 20, 17) = 0.108088E+01
+PKER_SDRYG( 20, 18) = 0.101042E+01
+PKER_SDRYG( 20, 19) = 0.944207E+00
+PKER_SDRYG( 20, 20) = 0.881986E+00
+PKER_SDRYG( 20, 21) = 0.823495E+00
+PKER_SDRYG( 20, 22) = 0.768494E+00
+PKER_SDRYG( 20, 23) = 0.716752E+00
+PKER_SDRYG( 20, 24) = 0.668047E+00
+PKER_SDRYG( 20, 25) = 0.622167E+00
+PKER_SDRYG( 20, 26) = 0.578906E+00
+PKER_SDRYG( 20, 27) = 0.538063E+00
+PKER_SDRYG( 20, 28) = 0.499440E+00
+PKER_SDRYG( 20, 29) = 0.462841E+00
+PKER_SDRYG( 20, 30) = 0.428070E+00
+PKER_SDRYG( 20, 31) = 0.394930E+00
+PKER_SDRYG( 20, 32) = 0.363228E+00
+PKER_SDRYG( 20, 33) = 0.332779E+00
+PKER_SDRYG( 20, 34) = 0.303417E+00
+PKER_SDRYG( 20, 35) = 0.275014E+00
+PKER_SDRYG( 20, 36) = 0.247503E+00
+PKER_SDRYG( 20, 37) = 0.220909E+00
+PKER_SDRYG( 20, 38) = 0.195362E+00
+PKER_SDRYG( 20, 39) = 0.171100E+00
+PKER_SDRYG( 20, 40) = 0.148434E+00
+PKER_SDRYG( 20, 41) = 0.127703E+00
+PKER_SDRYG( 20, 42) = 0.109201E+00
+PKER_SDRYG( 20, 43) = 0.931127E-01
+PKER_SDRYG( 20, 44) = 0.795450E-01
+PKER_SDRYG( 20, 45) = 0.684619E-01
+PKER_SDRYG( 20, 46) = 0.597138E-01
+PKER_SDRYG( 20, 47) = 0.531640E-01
+PKER_SDRYG( 20, 48) = 0.485713E-01
+PKER_SDRYG( 20, 49) = 0.457023E-01
+PKER_SDRYG( 20, 50) = 0.442778E-01
+PKER_SDRYG( 20, 51) = 0.441239E-01
+PKER_SDRYG( 20, 52) = 0.449550E-01
+PKER_SDRYG( 20, 53) = 0.465614E-01
+PKER_SDRYG( 20, 54) = 0.488440E-01
+PKER_SDRYG( 20, 55) = 0.515730E-01
+PKER_SDRYG( 20, 56) = 0.546214E-01
+PKER_SDRYG( 20, 57) = 0.578936E-01
+PKER_SDRYG( 20, 58) = 0.612990E-01
+PKER_SDRYG( 20, 59) = 0.647325E-01
+PKER_SDRYG( 20, 60) = 0.681741E-01
+PKER_SDRYG( 20, 61) = 0.715569E-01
+PKER_SDRYG( 20, 62) = 0.748508E-01
+PKER_SDRYG( 20, 63) = 0.780435E-01
+PKER_SDRYG( 20, 64) = 0.811089E-01
+PKER_SDRYG( 20, 65) = 0.840439E-01
+PKER_SDRYG( 20, 66) = 0.868407E-01
+PKER_SDRYG( 20, 67) = 0.894925E-01
+PKER_SDRYG( 20, 68) = 0.919967E-01
+PKER_SDRYG( 20, 69) = 0.943597E-01
+PKER_SDRYG( 20, 70) = 0.965903E-01
+PKER_SDRYG( 20, 71) = 0.986983E-01
+PKER_SDRYG( 20, 72) = 0.100690E+00
+PKER_SDRYG( 20, 73) = 0.102570E+00
+PKER_SDRYG( 20, 74) = 0.104341E+00
+PKER_SDRYG( 20, 75) = 0.106005E+00
+PKER_SDRYG( 20, 76) = 0.107569E+00
+PKER_SDRYG( 20, 77) = 0.109037E+00
+PKER_SDRYG( 20, 78) = 0.110416E+00
+PKER_SDRYG( 20, 79) = 0.111710E+00
+PKER_SDRYG( 20, 80) = 0.112924E+00
+PKER_SDRYG( 21, 1) = 0.309467E+01
+PKER_SDRYG( 21, 2) = 0.290215E+01
+PKER_SDRYG( 21, 3) = 0.272138E+01
+PKER_SDRYG( 21, 4) = 0.255163E+01
+PKER_SDRYG( 21, 5) = 0.239224E+01
+PKER_SDRYG( 21, 6) = 0.224257E+01
+PKER_SDRYG( 21, 7) = 0.210203E+01
+PKER_SDRYG( 21, 8) = 0.197007E+01
+PKER_SDRYG( 21, 9) = 0.184615E+01
+PKER_SDRYG( 21, 10) = 0.172978E+01
+PKER_SDRYG( 21, 11) = 0.162051E+01
+PKER_SDRYG( 21, 12) = 0.151789E+01
+PKER_SDRYG( 21, 13) = 0.142153E+01
+PKER_SDRYG( 21, 14) = 0.133104E+01
+PKER_SDRYG( 21, 15) = 0.124605E+01
+PKER_SDRYG( 21, 16) = 0.116623E+01
+PKER_SDRYG( 21, 17) = 0.109126E+01
+PKER_SDRYG( 21, 18) = 0.102083E+01
+PKER_SDRYG( 21, 19) = 0.954672E+00
+PKER_SDRYG( 21, 20) = 0.892510E+00
+PKER_SDRYG( 21, 21) = 0.834093E+00
+PKER_SDRYG( 21, 22) = 0.779182E+00
+PKER_SDRYG( 21, 23) = 0.727550E+00
+PKER_SDRYG( 21, 24) = 0.678981E+00
+PKER_SDRYG( 21, 25) = 0.633268E+00
+PKER_SDRYG( 21, 26) = 0.590214E+00
+PKER_SDRYG( 21, 27) = 0.549625E+00
+PKER_SDRYG( 21, 28) = 0.511316E+00
+PKER_SDRYG( 21, 29) = 0.475102E+00
+PKER_SDRYG( 21, 30) = 0.440802E+00
+PKER_SDRYG( 21, 31) = 0.408235E+00
+PKER_SDRYG( 21, 32) = 0.377220E+00
+PKER_SDRYG( 21, 33) = 0.347581E+00
+PKER_SDRYG( 21, 34) = 0.319145E+00
+PKER_SDRYG( 21, 35) = 0.291760E+00
+PKER_SDRYG( 21, 36) = 0.265305E+00
+PKER_SDRYG( 21, 37) = 0.239708E+00
+PKER_SDRYG( 21, 38) = 0.214974E+00
+PKER_SDRYG( 21, 39) = 0.191196E+00
+PKER_SDRYG( 21, 40) = 0.168553E+00
+PKER_SDRYG( 21, 41) = 0.147284E+00
+PKER_SDRYG( 21, 42) = 0.127658E+00
+PKER_SDRYG( 21, 43) = 0.109904E+00
+PKER_SDRYG( 21, 44) = 0.941689E-01
+PKER_SDRYG( 21, 45) = 0.805651E-01
+PKER_SDRYG( 21, 46) = 0.690716E-01
+PKER_SDRYG( 21, 47) = 0.595900E-01
+PKER_SDRYG( 21, 48) = 0.520709E-01
+PKER_SDRYG( 21, 49) = 0.463366E-01
+PKER_SDRYG( 21, 50) = 0.421453E-01
+PKER_SDRYG( 21, 51) = 0.394599E-01
+PKER_SDRYG( 21, 52) = 0.379410E-01
+PKER_SDRYG( 21, 53) = 0.375222E-01
+PKER_SDRYG( 21, 54) = 0.379878E-01
+PKER_SDRYG( 21, 55) = 0.391684E-01
+PKER_SDRYG( 21, 56) = 0.409134E-01
+PKER_SDRYG( 21, 57) = 0.430879E-01
+PKER_SDRYG( 21, 58) = 0.455943E-01
+PKER_SDRYG( 21, 59) = 0.483097E-01
+PKER_SDRYG( 21, 60) = 0.511611E-01
+PKER_SDRYG( 21, 61) = 0.540832E-01
+PKER_SDRYG( 21, 62) = 0.570182E-01
+PKER_SDRYG( 21, 63) = 0.599262E-01
+PKER_SDRYG( 21, 64) = 0.627739E-01
+PKER_SDRYG( 21, 65) = 0.655385E-01
+PKER_SDRYG( 21, 66) = 0.682053E-01
+PKER_SDRYG( 21, 67) = 0.707625E-01
+PKER_SDRYG( 21, 68) = 0.732087E-01
+PKER_SDRYG( 21, 69) = 0.755315E-01
+PKER_SDRYG( 21, 70) = 0.777294E-01
+PKER_SDRYG( 21, 71) = 0.798052E-01
+PKER_SDRYG( 21, 72) = 0.817651E-01
+PKER_SDRYG( 21, 73) = 0.836157E-01
+PKER_SDRYG( 21, 74) = 0.853654E-01
+PKER_SDRYG( 21, 75) = 0.870178E-01
+PKER_SDRYG( 21, 76) = 0.885760E-01
+PKER_SDRYG( 21, 77) = 0.900423E-01
+PKER_SDRYG( 21, 78) = 0.914203E-01
+PKER_SDRYG( 21, 79) = 0.927143E-01
+PKER_SDRYG( 21, 80) = 0.939293E-01
+PKER_SDRYG( 22, 1) = 0.310340E+01
+PKER_SDRYG( 22, 2) = 0.291088E+01
+PKER_SDRYG( 22, 3) = 0.273011E+01
+PKER_SDRYG( 22, 4) = 0.256036E+01
+PKER_SDRYG( 22, 5) = 0.240098E+01
+PKER_SDRYG( 22, 6) = 0.225131E+01
+PKER_SDRYG( 22, 7) = 0.211078E+01
+PKER_SDRYG( 22, 8) = 0.197881E+01
+PKER_SDRYG( 22, 9) = 0.185490E+01
+PKER_SDRYG( 22, 10) = 0.173854E+01
+PKER_SDRYG( 22, 11) = 0.162927E+01
+PKER_SDRYG( 22, 12) = 0.152667E+01
+PKER_SDRYG( 22, 13) = 0.143032E+01
+PKER_SDRYG( 22, 14) = 0.133984E+01
+PKER_SDRYG( 22, 15) = 0.125486E+01
+PKER_SDRYG( 22, 16) = 0.117506E+01
+PKER_SDRYG( 22, 17) = 0.110011E+01
+PKER_SDRYG( 22, 18) = 0.102972E+01
+PKER_SDRYG( 22, 19) = 0.963596E+00
+PKER_SDRYG( 22, 20) = 0.901477E+00
+PKER_SDRYG( 22, 21) = 0.843114E+00
+PKER_SDRYG( 22, 22) = 0.788268E+00
+PKER_SDRYG( 22, 23) = 0.736716E+00
+PKER_SDRYG( 22, 24) = 0.688246E+00
+PKER_SDRYG( 22, 25) = 0.642654E+00
+PKER_SDRYG( 22, 26) = 0.599749E+00
+PKER_SDRYG( 22, 27) = 0.559343E+00
+PKER_SDRYG( 22, 28) = 0.521260E+00
+PKER_SDRYG( 22, 29) = 0.485324E+00
+PKER_SDRYG( 22, 30) = 0.451364E+00
+PKER_SDRYG( 22, 31) = 0.419213E+00
+PKER_SDRYG( 22, 32) = 0.388704E+00
+PKER_SDRYG( 22, 33) = 0.359670E+00
+PKER_SDRYG( 22, 34) = 0.331948E+00
+PKER_SDRYG( 22, 35) = 0.305382E+00
+PKER_SDRYG( 22, 36) = 0.279831E+00
+PKER_SDRYG( 22, 37) = 0.255180E+00
+PKER_SDRYG( 22, 38) = 0.231361E+00
+PKER_SDRYG( 22, 39) = 0.208367E+00
+PKER_SDRYG( 22, 40) = 0.186266E+00
+PKER_SDRYG( 22, 41) = 0.165198E+00
+PKER_SDRYG( 22, 42) = 0.145353E+00
+PKER_SDRYG( 22, 43) = 0.126934E+00
+PKER_SDRYG( 22, 44) = 0.110117E+00
+PKER_SDRYG( 22, 45) = 0.950242E-01
+PKER_SDRYG( 22, 46) = 0.817187E-01
+PKER_SDRYG( 22, 47) = 0.701989E-01
+PKER_SDRYG( 22, 48) = 0.604077E-01
+PKER_SDRYG( 22, 49) = 0.522862E-01
+PKER_SDRYG( 22, 50) = 0.457355E-01
+PKER_SDRYG( 22, 51) = 0.406096E-01
+PKER_SDRYG( 22, 52) = 0.368134E-01
+PKER_SDRYG( 22, 53) = 0.342156E-01
+PKER_SDRYG( 22, 54) = 0.326793E-01
+PKER_SDRYG( 22, 55) = 0.320323E-01
+PKER_SDRYG( 22, 56) = 0.321937E-01
+PKER_SDRYG( 22, 57) = 0.329850E-01
+PKER_SDRYG( 22, 58) = 0.342698E-01
+PKER_SDRYG( 22, 59) = 0.360064E-01
+PKER_SDRYG( 22, 60) = 0.380365E-01
+PKER_SDRYG( 22, 61) = 0.402760E-01
+PKER_SDRYG( 22, 62) = 0.426662E-01
+PKER_SDRYG( 22, 63) = 0.451444E-01
+PKER_SDRYG( 22, 64) = 0.476417E-01
+PKER_SDRYG( 22, 65) = 0.501412E-01
+PKER_SDRYG( 22, 66) = 0.525978E-01
+PKER_SDRYG( 22, 67) = 0.549924E-01
+PKER_SDRYG( 22, 68) = 0.573119E-01
+PKER_SDRYG( 22, 69) = 0.595407E-01
+PKER_SDRYG( 22, 70) = 0.616759E-01
+PKER_SDRYG( 22, 71) = 0.637106E-01
+PKER_SDRYG( 22, 72) = 0.656407E-01
+PKER_SDRYG( 22, 73) = 0.674641E-01
+PKER_SDRYG( 22, 74) = 0.691851E-01
+PKER_SDRYG( 22, 75) = 0.708107E-01
+PKER_SDRYG( 22, 76) = 0.723473E-01
+PKER_SDRYG( 22, 77) = 0.737996E-01
+PKER_SDRYG( 22, 78) = 0.751703E-01
+PKER_SDRYG( 22, 79) = 0.764615E-01
+PKER_SDRYG( 22, 80) = 0.776757E-01
+PKER_SDRYG( 23, 1) = 0.311087E+01
+PKER_SDRYG( 23, 2) = 0.291835E+01
+PKER_SDRYG( 23, 3) = 0.273758E+01
+PKER_SDRYG( 23, 4) = 0.256784E+01
+PKER_SDRYG( 23, 5) = 0.240845E+01
+PKER_SDRYG( 23, 6) = 0.225879E+01
+PKER_SDRYG( 23, 7) = 0.211825E+01
+PKER_SDRYG( 23, 8) = 0.198629E+01
+PKER_SDRYG( 23, 9) = 0.186238E+01
+PKER_SDRYG( 23, 10) = 0.174603E+01
+PKER_SDRYG( 23, 11) = 0.163677E+01
+PKER_SDRYG( 23, 12) = 0.153417E+01
+PKER_SDRYG( 23, 13) = 0.143783E+01
+PKER_SDRYG( 23, 14) = 0.134736E+01
+PKER_SDRYG( 23, 15) = 0.126240E+01
+PKER_SDRYG( 23, 16) = 0.118261E+01
+PKER_SDRYG( 23, 17) = 0.110768E+01
+PKER_SDRYG( 23, 18) = 0.103731E+01
+PKER_SDRYG( 23, 19) = 0.971209E+00
+PKER_SDRYG( 23, 20) = 0.909123E+00
+PKER_SDRYG( 23, 21) = 0.850799E+00
+PKER_SDRYG( 23, 22) = 0.796001E+00
+PKER_SDRYG( 23, 23) = 0.744508E+00
+PKER_SDRYG( 23, 24) = 0.696109E+00
+PKER_SDRYG( 23, 25) = 0.650606E+00
+PKER_SDRYG( 23, 26) = 0.607808E+00
+PKER_SDRYG( 23, 27) = 0.567535E+00
+PKER_SDRYG( 23, 28) = 0.529615E+00
+PKER_SDRYG( 23, 29) = 0.493879E+00
+PKER_SDRYG( 23, 30) = 0.460166E+00
+PKER_SDRYG( 23, 31) = 0.428317E+00
+PKER_SDRYG( 23, 32) = 0.398176E+00
+PKER_SDRYG( 23, 33) = 0.369589E+00
+PKER_SDRYG( 23, 34) = 0.342402E+00
+PKER_SDRYG( 23, 35) = 0.316466E+00
+PKER_SDRYG( 23, 36) = 0.291637E+00
+PKER_SDRYG( 23, 37) = 0.267784E+00
+PKER_SDRYG( 23, 38) = 0.244803E+00
+PKER_SDRYG( 23, 39) = 0.222628E+00
+PKER_SDRYG( 23, 40) = 0.201247E+00
+PKER_SDRYG( 23, 41) = 0.180713E+00
+PKER_SDRYG( 23, 42) = 0.161137E+00
+PKER_SDRYG( 23, 43) = 0.142671E+00
+PKER_SDRYG( 23, 44) = 0.125476E+00
+PKER_SDRYG( 23, 45) = 0.109687E+00
+PKER_SDRYG( 23, 46) = 0.953871E-01
+PKER_SDRYG( 23, 47) = 0.826169E-01
+PKER_SDRYG( 23, 48) = 0.713617E-01
+PKER_SDRYG( 23, 49) = 0.615668E-01
+PKER_SDRYG( 23, 50) = 0.531991E-01
+PKER_SDRYG( 23, 51) = 0.461730E-01
+PKER_SDRYG( 23, 52) = 0.403882E-01
+PKER_SDRYG( 23, 53) = 0.358096E-01
+PKER_SDRYG( 23, 54) = 0.323398E-01
+PKER_SDRYG( 23, 55) = 0.298278E-01
+PKER_SDRYG( 23, 56) = 0.282645E-01
+PKER_SDRYG( 23, 57) = 0.274478E-01
+PKER_SDRYG( 23, 58) = 0.273472E-01
+PKER_SDRYG( 23, 59) = 0.278235E-01
+PKER_SDRYG( 23, 60) = 0.287808E-01
+PKER_SDRYG( 23, 61) = 0.301115E-01
+PKER_SDRYG( 23, 62) = 0.317312E-01
+PKER_SDRYG( 23, 63) = 0.335818E-01
+PKER_SDRYG( 23, 64) = 0.355711E-01
+PKER_SDRYG( 23, 65) = 0.376525E-01
+PKER_SDRYG( 23, 66) = 0.397832E-01
+PKER_SDRYG( 23, 67) = 0.419209E-01
+PKER_SDRYG( 23, 68) = 0.440372E-01
+PKER_SDRYG( 23, 69) = 0.461097E-01
+PKER_SDRYG( 23, 70) = 0.481216E-01
+PKER_SDRYG( 23, 71) = 0.500634E-01
+PKER_SDRYG( 23, 72) = 0.519255E-01
+PKER_SDRYG( 23, 73) = 0.537073E-01
+PKER_SDRYG( 23, 74) = 0.553996E-01
+PKER_SDRYG( 23, 75) = 0.570010E-01
+PKER_SDRYG( 23, 76) = 0.585138E-01
+PKER_SDRYG( 23, 77) = 0.599425E-01
+PKER_SDRYG( 23, 78) = 0.612921E-01
+PKER_SDRYG( 23, 79) = 0.625682E-01
+PKER_SDRYG( 23, 80) = 0.637735E-01
+PKER_SDRYG( 24, 1) = 0.311725E+01
+PKER_SDRYG( 24, 2) = 0.292474E+01
+PKER_SDRYG( 24, 3) = 0.274397E+01
+PKER_SDRYG( 24, 4) = 0.257423E+01
+PKER_SDRYG( 24, 5) = 0.241484E+01
+PKER_SDRYG( 24, 6) = 0.226518E+01
+PKER_SDRYG( 24, 7) = 0.212465E+01
+PKER_SDRYG( 24, 8) = 0.199269E+01
+PKER_SDRYG( 24, 9) = 0.186878E+01
+PKER_SDRYG( 24, 10) = 0.175243E+01
+PKER_SDRYG( 24, 11) = 0.164318E+01
+PKER_SDRYG( 24, 12) = 0.154059E+01
+PKER_SDRYG( 24, 13) = 0.144425E+01
+PKER_SDRYG( 24, 14) = 0.135379E+01
+PKER_SDRYG( 24, 15) = 0.126883E+01
+PKER_SDRYG( 24, 16) = 0.118906E+01
+PKER_SDRYG( 24, 17) = 0.111414E+01
+PKER_SDRYG( 24, 18) = 0.104379E+01
+PKER_SDRYG( 24, 19) = 0.977708E+00
+PKER_SDRYG( 24, 20) = 0.915646E+00
+PKER_SDRYG( 24, 21) = 0.857350E+00
+PKER_SDRYG( 24, 22) = 0.802588E+00
+PKER_SDRYG( 24, 23) = 0.751138E+00
+PKER_SDRYG( 24, 24) = 0.702792E+00
+PKER_SDRYG( 24, 25) = 0.657353E+00
+PKER_SDRYG( 24, 26) = 0.614634E+00
+PKER_SDRYG( 24, 27) = 0.574458E+00
+PKER_SDRYG( 24, 28) = 0.536656E+00
+PKER_SDRYG( 24, 29) = 0.501065E+00
+PKER_SDRYG( 24, 30) = 0.467530E+00
+PKER_SDRYG( 24, 31) = 0.435900E+00
+PKER_SDRYG( 24, 32) = 0.406028E+00
+PKER_SDRYG( 24, 33) = 0.377767E+00
+PKER_SDRYG( 24, 34) = 0.350976E+00
+PKER_SDRYG( 24, 35) = 0.325513E+00
+PKER_SDRYG( 24, 36) = 0.301240E+00
+PKER_SDRYG( 24, 37) = 0.278025E+00
+PKER_SDRYG( 24, 38) = 0.255748E+00
+PKER_SDRYG( 24, 39) = 0.234312E+00
+PKER_SDRYG( 24, 40) = 0.213656E+00
+PKER_SDRYG( 24, 41) = 0.193765E+00
+PKER_SDRYG( 24, 42) = 0.174681E+00
+PKER_SDRYG( 24, 43) = 0.156497E+00
+PKER_SDRYG( 24, 44) = 0.139338E+00
+PKER_SDRYG( 24, 45) = 0.123333E+00
+PKER_SDRYG( 24, 46) = 0.108586E+00
+PKER_SDRYG( 24, 47) = 0.951564E-01
+PKER_SDRYG( 24, 48) = 0.830549E-01
+PKER_SDRYG( 24, 49) = 0.722530E-01
+PKER_SDRYG( 24, 50) = 0.627027E-01
+PKER_SDRYG( 24, 51) = 0.543516E-01
+PKER_SDRYG( 24, 52) = 0.471379E-01
+PKER_SDRYG( 24, 53) = 0.410008E-01
+PKER_SDRYG( 24, 54) = 0.358942E-01
+PKER_SDRYG( 24, 55) = 0.317729E-01
+PKER_SDRYG( 24, 56) = 0.285445E-01
+PKER_SDRYG( 24, 57) = 0.261582E-01
+PKER_SDRYG( 24, 58) = 0.245542E-01
+PKER_SDRYG( 24, 59) = 0.236475E-01
+PKER_SDRYG( 24, 60) = 0.233281E-01
+PKER_SDRYG( 24, 61) = 0.235527E-01
+PKER_SDRYG( 24, 62) = 0.242044E-01
+PKER_SDRYG( 24, 63) = 0.251935E-01
+PKER_SDRYG( 24, 64) = 0.264894E-01
+PKER_SDRYG( 24, 65) = 0.279912E-01
+PKER_SDRYG( 24, 66) = 0.296368E-01
+PKER_SDRYG( 24, 67) = 0.313850E-01
+PKER_SDRYG( 24, 68) = 0.331947E-01
+PKER_SDRYG( 24, 69) = 0.350172E-01
+PKER_SDRYG( 24, 70) = 0.368385E-01
+PKER_SDRYG( 24, 71) = 0.386288E-01
+PKER_SDRYG( 24, 72) = 0.403749E-01
+PKER_SDRYG( 24, 73) = 0.420647E-01
+PKER_SDRYG( 24, 74) = 0.436892E-01
+PKER_SDRYG( 24, 75) = 0.452460E-01
+PKER_SDRYG( 24, 76) = 0.467291E-01
+PKER_SDRYG( 24, 77) = 0.481362E-01
+PKER_SDRYG( 24, 78) = 0.494656E-01
+PKER_SDRYG( 24, 79) = 0.507207E-01
+PKER_SDRYG( 24, 80) = 0.519066E-01
+PKER_SDRYG( 25, 1) = 0.312272E+01
+PKER_SDRYG( 25, 2) = 0.293021E+01
+PKER_SDRYG( 25, 3) = 0.274944E+01
+PKER_SDRYG( 25, 4) = 0.257970E+01
+PKER_SDRYG( 25, 5) = 0.242031E+01
+PKER_SDRYG( 25, 6) = 0.227065E+01
+PKER_SDRYG( 25, 7) = 0.213012E+01
+PKER_SDRYG( 25, 8) = 0.199817E+01
+PKER_SDRYG( 25, 9) = 0.187426E+01
+PKER_SDRYG( 25, 10) = 0.175791E+01
+PKER_SDRYG( 25, 11) = 0.164866E+01
+PKER_SDRYG( 25, 12) = 0.154607E+01
+PKER_SDRYG( 25, 13) = 0.144974E+01
+PKER_SDRYG( 25, 14) = 0.135928E+01
+PKER_SDRYG( 25, 15) = 0.127434E+01
+PKER_SDRYG( 25, 16) = 0.119457E+01
+PKER_SDRYG( 25, 17) = 0.111967E+01
+PKER_SDRYG( 25, 18) = 0.104932E+01
+PKER_SDRYG( 25, 19) = 0.983257E+00
+PKER_SDRYG( 25, 20) = 0.921213E+00
+PKER_SDRYG( 25, 21) = 0.862939E+00
+PKER_SDRYG( 25, 22) = 0.808203E+00
+PKER_SDRYG( 25, 23) = 0.756785E+00
+PKER_SDRYG( 25, 24) = 0.708478E+00
+PKER_SDRYG( 25, 25) = 0.663086E+00
+PKER_SDRYG( 25, 26) = 0.620425E+00
+PKER_SDRYG( 25, 27) = 0.580319E+00
+PKER_SDRYG( 25, 28) = 0.542604E+00
+PKER_SDRYG( 25, 29) = 0.507119E+00
+PKER_SDRYG( 25, 30) = 0.473714E+00
+PKER_SDRYG( 25, 31) = 0.442243E+00
+PKER_SDRYG( 25, 32) = 0.412566E+00
+PKER_SDRYG( 25, 33) = 0.384544E+00
+PKER_SDRYG( 25, 34) = 0.358043E+00
+PKER_SDRYG( 25, 35) = 0.332931E+00
+PKER_SDRYG( 25, 36) = 0.309077E+00
+PKER_SDRYG( 25, 37) = 0.286354E+00
+PKER_SDRYG( 25, 38) = 0.264640E+00
+PKER_SDRYG( 25, 39) = 0.243825E+00
+PKER_SDRYG( 25, 40) = 0.223821E+00
+PKER_SDRYG( 25, 41) = 0.204568E+00
+PKER_SDRYG( 25, 42) = 0.186052E+00
+PKER_SDRYG( 25, 43) = 0.168306E+00
+PKER_SDRYG( 25, 44) = 0.151409E+00
+PKER_SDRYG( 25, 45) = 0.135468E+00
+PKER_SDRYG( 25, 46) = 0.120590E+00
+PKER_SDRYG( 25, 47) = 0.106855E+00
+PKER_SDRYG( 25, 48) = 0.943025E-01
+PKER_SDRYG( 25, 49) = 0.829276E-01
+PKER_SDRYG( 25, 50) = 0.726914E-01
+PKER_SDRYG( 25, 51) = 0.635357E-01
+PKER_SDRYG( 25, 52) = 0.554038E-01
+PKER_SDRYG( 25, 53) = 0.482351E-01
+PKER_SDRYG( 25, 54) = 0.419759E-01
+PKER_SDRYG( 25, 55) = 0.365989E-01
+PKER_SDRYG( 25, 56) = 0.320611E-01
+PKER_SDRYG( 25, 57) = 0.283066E-01
+PKER_SDRYG( 25, 58) = 0.253217E-01
+PKER_SDRYG( 25, 59) = 0.230681E-01
+PKER_SDRYG( 25, 60) = 0.214485E-01
+PKER_SDRYG( 25, 61) = 0.204594E-01
+PKER_SDRYG( 25, 62) = 0.199802E-01
+PKER_SDRYG( 25, 63) = 0.199893E-01
+PKER_SDRYG( 25, 64) = 0.203928E-01
+PKER_SDRYG( 25, 65) = 0.211342E-01
+PKER_SDRYG( 25, 66) = 0.221323E-01
+PKER_SDRYG( 25, 67) = 0.233322E-01
+PKER_SDRYG( 25, 68) = 0.246954E-01
+PKER_SDRYG( 25, 69) = 0.261541E-01
+PKER_SDRYG( 25, 70) = 0.276764E-01
+PKER_SDRYG( 25, 71) = 0.292337E-01
+PKER_SDRYG( 25, 72) = 0.307948E-01
+PKER_SDRYG( 25, 73) = 0.323388E-01
+PKER_SDRYG( 25, 74) = 0.338507E-01
+PKER_SDRYG( 25, 75) = 0.353179E-01
+PKER_SDRYG( 25, 76) = 0.367344E-01
+PKER_SDRYG( 25, 77) = 0.380928E-01
+PKER_SDRYG( 25, 78) = 0.393925E-01
+PKER_SDRYG( 25, 79) = 0.406269E-01
+PKER_SDRYG( 25, 80) = 0.417949E-01
+PKER_SDRYG( 26, 1) = 0.312740E+01
+PKER_SDRYG( 26, 2) = 0.293488E+01
+PKER_SDRYG( 26, 3) = 0.275412E+01
+PKER_SDRYG( 26, 4) = 0.258438E+01
+PKER_SDRYG( 26, 5) = 0.242499E+01
+PKER_SDRYG( 26, 6) = 0.227533E+01
+PKER_SDRYG( 26, 7) = 0.213481E+01
+PKER_SDRYG( 26, 8) = 0.200285E+01
+PKER_SDRYG( 26, 9) = 0.187895E+01
+PKER_SDRYG( 26, 10) = 0.176260E+01
+PKER_SDRYG( 26, 11) = 0.165335E+01
+PKER_SDRYG( 26, 12) = 0.155077E+01
+PKER_SDRYG( 26, 13) = 0.145444E+01
+PKER_SDRYG( 26, 14) = 0.136398E+01
+PKER_SDRYG( 26, 15) = 0.127904E+01
+PKER_SDRYG( 26, 16) = 0.119928E+01
+PKER_SDRYG( 26, 17) = 0.112439E+01
+PKER_SDRYG( 26, 18) = 0.105405E+01
+PKER_SDRYG( 26, 19) = 0.987997E+00
+PKER_SDRYG( 26, 20) = 0.925966E+00
+PKER_SDRYG( 26, 21) = 0.867709E+00
+PKER_SDRYG( 26, 22) = 0.812992E+00
+PKER_SDRYG( 26, 23) = 0.761598E+00
+PKER_SDRYG( 26, 24) = 0.713319E+00
+PKER_SDRYG( 26, 25) = 0.667963E+00
+PKER_SDRYG( 26, 26) = 0.625344E+00
+PKER_SDRYG( 26, 27) = 0.585291E+00
+PKER_SDRYG( 26, 28) = 0.547639E+00
+PKER_SDRYG( 26, 29) = 0.512232E+00
+PKER_SDRYG( 26, 30) = 0.478922E+00
+PKER_SDRYG( 26, 31) = 0.447567E+00
+PKER_SDRYG( 26, 32) = 0.418032E+00
+PKER_SDRYG( 26, 33) = 0.390184E+00
+PKER_SDRYG( 26, 34) = 0.363896E+00
+PKER_SDRYG( 26, 35) = 0.339042E+00
+PKER_SDRYG( 26, 36) = 0.315501E+00
+PKER_SDRYG( 26, 37) = 0.293150E+00
+PKER_SDRYG( 26, 38) = 0.271872E+00
+PKER_SDRYG( 26, 39) = 0.251556E+00
+PKER_SDRYG( 26, 40) = 0.232100E+00
+PKER_SDRYG( 26, 41) = 0.213421E+00
+PKER_SDRYG( 26, 42) = 0.195465E+00
+PKER_SDRYG( 26, 43) = 0.178217E+00
+PKER_SDRYG( 26, 44) = 0.161705E+00
+PKER_SDRYG( 26, 45) = 0.145996E+00
+PKER_SDRYG( 26, 46) = 0.131182E+00
+PKER_SDRYG( 26, 47) = 0.117353E+00
+PKER_SDRYG( 26, 48) = 0.104576E+00
+PKER_SDRYG( 26, 49) = 0.928753E-01
+PKER_SDRYG( 26, 50) = 0.822363E-01
+PKER_SDRYG( 26, 51) = 0.726111E-01
+PKER_SDRYG( 26, 52) = 0.639383E-01
+PKER_SDRYG( 26, 53) = 0.561507E-01
+PKER_SDRYG( 26, 54) = 0.491858E-01
+PKER_SDRYG( 26, 55) = 0.429946E-01
+PKER_SDRYG( 26, 56) = 0.375430E-01
+PKER_SDRYG( 26, 57) = 0.327992E-01
+PKER_SDRYG( 26, 58) = 0.287370E-01
+PKER_SDRYG( 26, 59) = 0.253369E-01
+PKER_SDRYG( 26, 60) = 0.225882E-01
+PKER_SDRYG( 26, 61) = 0.204316E-01
+PKER_SDRYG( 26, 62) = 0.188398E-01
+PKER_SDRYG( 26, 63) = 0.177875E-01
+PKER_SDRYG( 26, 64) = 0.172085E-01
+PKER_SDRYG( 26, 65) = 0.170417E-01
+PKER_SDRYG( 26, 66) = 0.172497E-01
+PKER_SDRYG( 26, 67) = 0.177584E-01
+PKER_SDRYG( 26, 68) = 0.185080E-01
+PKER_SDRYG( 26, 69) = 0.194673E-01
+PKER_SDRYG( 26, 70) = 0.205752E-01
+PKER_SDRYG( 26, 71) = 0.217845E-01
+PKER_SDRYG( 26, 72) = 0.230647E-01
+PKER_SDRYG( 26, 73) = 0.243883E-01
+PKER_SDRYG( 26, 74) = 0.257208E-01
+PKER_SDRYG( 26, 75) = 0.270503E-01
+PKER_SDRYG( 26, 76) = 0.283574E-01
+PKER_SDRYG( 26, 77) = 0.296325E-01
+PKER_SDRYG( 26, 78) = 0.308653E-01
+PKER_SDRYG( 26, 79) = 0.320509E-01
+PKER_SDRYG( 26, 80) = 0.331872E-01
+PKER_SDRYG( 27, 1) = 0.313140E+01
+PKER_SDRYG( 27, 2) = 0.293889E+01
+PKER_SDRYG( 27, 3) = 0.275812E+01
+PKER_SDRYG( 27, 4) = 0.258838E+01
+PKER_SDRYG( 27, 5) = 0.242900E+01
+PKER_SDRYG( 27, 6) = 0.227934E+01
+PKER_SDRYG( 27, 7) = 0.213881E+01
+PKER_SDRYG( 27, 8) = 0.200686E+01
+PKER_SDRYG( 27, 9) = 0.188295E+01
+PKER_SDRYG( 27, 10) = 0.176661E+01
+PKER_SDRYG( 27, 11) = 0.165736E+01
+PKER_SDRYG( 27, 12) = 0.155478E+01
+PKER_SDRYG( 27, 13) = 0.145845E+01
+PKER_SDRYG( 27, 14) = 0.136800E+01
+PKER_SDRYG( 27, 15) = 0.128307E+01
+PKER_SDRYG( 27, 16) = 0.120331E+01
+PKER_SDRYG( 27, 17) = 0.112842E+01
+PKER_SDRYG( 27, 18) = 0.105809E+01
+PKER_SDRYG( 27, 19) = 0.992047E+00
+PKER_SDRYG( 27, 20) = 0.930026E+00
+PKER_SDRYG( 27, 21) = 0.871781E+00
+PKER_SDRYG( 27, 22) = 0.817079E+00
+PKER_SDRYG( 27, 23) = 0.765702E+00
+PKER_SDRYG( 27, 24) = 0.717445E+00
+PKER_SDRYG( 27, 25) = 0.672115E+00
+PKER_SDRYG( 27, 26) = 0.629528E+00
+PKER_SDRYG( 27, 27) = 0.589513E+00
+PKER_SDRYG( 27, 28) = 0.551908E+00
+PKER_SDRYG( 27, 29) = 0.516558E+00
+PKER_SDRYG( 27, 30) = 0.483318E+00
+PKER_SDRYG( 27, 31) = 0.452049E+00
+PKER_SDRYG( 27, 32) = 0.422618E+00
+PKER_SDRYG( 27, 33) = 0.394898E+00
+PKER_SDRYG( 27, 34) = 0.368766E+00
+PKER_SDRYG( 27, 35) = 0.344102E+00
+PKER_SDRYG( 27, 36) = 0.320791E+00
+PKER_SDRYG( 27, 37) = 0.298718E+00
+PKER_SDRYG( 27, 38) = 0.277772E+00
+PKER_SDRYG( 27, 39) = 0.257843E+00
+PKER_SDRYG( 27, 40) = 0.238828E+00
+PKER_SDRYG( 27, 41) = 0.220635E+00
+PKER_SDRYG( 27, 42) = 0.203186E+00
+PKER_SDRYG( 27, 43) = 0.186431E+00
+PKER_SDRYG( 27, 44) = 0.170354E+00
+PKER_SDRYG( 27, 45) = 0.154979E+00
+PKER_SDRYG( 27, 46) = 0.140365E+00
+PKER_SDRYG( 27, 47) = 0.126590E+00
+PKER_SDRYG( 27, 48) = 0.113733E+00
+PKER_SDRYG( 27, 49) = 0.101848E+00
+PKER_SDRYG( 27, 50) = 0.909527E-01
+PKER_SDRYG( 27, 51) = 0.810258E-01
+PKER_SDRYG( 27, 52) = 0.720165E-01
+PKER_SDRYG( 27, 53) = 0.638590E-01
+PKER_SDRYG( 27, 54) = 0.564823E-01
+PKER_SDRYG( 27, 55) = 0.498226E-01
+PKER_SDRYG( 27, 56) = 0.438282E-01
+PKER_SDRYG( 27, 57) = 0.384597E-01
+PKER_SDRYG( 27, 58) = 0.336864E-01
+PKER_SDRYG( 27, 59) = 0.294887E-01
+PKER_SDRYG( 27, 60) = 0.258548E-01
+PKER_SDRYG( 27, 61) = 0.227747E-01
+PKER_SDRYG( 27, 62) = 0.202164E-01
+PKER_SDRYG( 27, 63) = 0.181747E-01
+PKER_SDRYG( 27, 64) = 0.166401E-01
+PKER_SDRYG( 27, 65) = 0.155455E-01
+PKER_SDRYG( 27, 66) = 0.148848E-01
+PKER_SDRYG( 27, 67) = 0.145861E-01
+PKER_SDRYG( 27, 68) = 0.146311E-01
+PKER_SDRYG( 27, 69) = 0.149518E-01
+PKER_SDRYG( 27, 70) = 0.155127E-01
+PKER_SDRYG( 27, 71) = 0.162573E-01
+PKER_SDRYG( 27, 72) = 0.171427E-01
+PKER_SDRYG( 27, 73) = 0.181459E-01
+PKER_SDRYG( 27, 74) = 0.192163E-01
+PKER_SDRYG( 27, 75) = 0.203307E-01
+PKER_SDRYG( 27, 76) = 0.214704E-01
+PKER_SDRYG( 27, 77) = 0.226118E-01
+PKER_SDRYG( 27, 78) = 0.237398E-01
+PKER_SDRYG( 27, 79) = 0.248439E-01
+PKER_SDRYG( 27, 80) = 0.259151E-01
+PKER_SDRYG( 28, 1) = 0.313482E+01
+PKER_SDRYG( 28, 2) = 0.294231E+01
+PKER_SDRYG( 28, 3) = 0.276154E+01
+PKER_SDRYG( 28, 4) = 0.259180E+01
+PKER_SDRYG( 28, 5) = 0.243242E+01
+PKER_SDRYG( 28, 6) = 0.228277E+01
+PKER_SDRYG( 28, 7) = 0.214224E+01
+PKER_SDRYG( 28, 8) = 0.201029E+01
+PKER_SDRYG( 28, 9) = 0.188638E+01
+PKER_SDRYG( 28, 10) = 0.177004E+01
+PKER_SDRYG( 28, 11) = 0.166079E+01
+PKER_SDRYG( 28, 12) = 0.155821E+01
+PKER_SDRYG( 28, 13) = 0.146189E+01
+PKER_SDRYG( 28, 14) = 0.137144E+01
+PKER_SDRYG( 28, 15) = 0.128651E+01
+PKER_SDRYG( 28, 16) = 0.120676E+01
+PKER_SDRYG( 28, 17) = 0.113187E+01
+PKER_SDRYG( 28, 18) = 0.106155E+01
+PKER_SDRYG( 28, 19) = 0.995508E+00
+PKER_SDRYG( 28, 20) = 0.933495E+00
+PKER_SDRYG( 28, 21) = 0.875258E+00
+PKER_SDRYG( 28, 22) = 0.820568E+00
+PKER_SDRYG( 28, 23) = 0.769204E+00
+PKER_SDRYG( 28, 24) = 0.720964E+00
+PKER_SDRYG( 28, 25) = 0.675653E+00
+PKER_SDRYG( 28, 26) = 0.633090E+00
+PKER_SDRYG( 28, 27) = 0.593104E+00
+PKER_SDRYG( 28, 28) = 0.555533E+00
+PKER_SDRYG( 28, 29) = 0.520226E+00
+PKER_SDRYG( 28, 30) = 0.487038E+00
+PKER_SDRYG( 28, 31) = 0.455832E+00
+PKER_SDRYG( 28, 32) = 0.426477E+00
+PKER_SDRYG( 28, 33) = 0.398851E+00
+PKER_SDRYG( 28, 34) = 0.372833E+00
+PKER_SDRYG( 28, 35) = 0.348309E+00
+PKER_SDRYG( 28, 36) = 0.325168E+00
+PKER_SDRYG( 28, 37) = 0.303302E+00
+PKER_SDRYG( 28, 38) = 0.282604E+00
+PKER_SDRYG( 28, 39) = 0.262970E+00
+PKER_SDRYG( 28, 40) = 0.244301E+00
+PKER_SDRYG( 28, 41) = 0.226500E+00
+PKER_SDRYG( 28, 42) = 0.209481E+00
+PKER_SDRYG( 28, 43) = 0.193174E+00
+PKER_SDRYG( 28, 44) = 0.177531E+00
+PKER_SDRYG( 28, 45) = 0.162537E+00
+PKER_SDRYG( 28, 46) = 0.148212E+00
+PKER_SDRYG( 28, 47) = 0.134605E+00
+PKER_SDRYG( 28, 48) = 0.121788E+00
+PKER_SDRYG( 28, 49) = 0.109827E+00
+PKER_SDRYG( 28, 50) = 0.987695E-01
+PKER_SDRYG( 28, 51) = 0.886258E-01
+PKER_SDRYG( 28, 52) = 0.793726E-01
+PKER_SDRYG( 28, 53) = 0.709584E-01
+PKER_SDRYG( 28, 54) = 0.633172E-01
+PKER_SDRYG( 28, 55) = 0.563782E-01
+PKER_SDRYG( 28, 56) = 0.500750E-01
+PKER_SDRYG( 28, 57) = 0.443534E-01
+PKER_SDRYG( 28, 58) = 0.391703E-01
+PKER_SDRYG( 28, 59) = 0.344918E-01
+PKER_SDRYG( 28, 60) = 0.302964E-01
+PKER_SDRYG( 28, 61) = 0.265756E-01
+PKER_SDRYG( 28, 62) = 0.233172E-01
+PKER_SDRYG( 28, 63) = 0.205132E-01
+PKER_SDRYG( 28, 64) = 0.181605E-01
+PKER_SDRYG( 28, 65) = 0.162558E-01
+PKER_SDRYG( 28, 66) = 0.147609E-01
+PKER_SDRYG( 28, 67) = 0.136620E-01
+PKER_SDRYG( 28, 68) = 0.129448E-01
+PKER_SDRYG( 28, 69) = 0.125564E-01
+PKER_SDRYG( 28, 70) = 0.124665E-01
+PKER_SDRYG( 28, 71) = 0.126409E-01
+PKER_SDRYG( 28, 72) = 0.130274E-01
+PKER_SDRYG( 28, 73) = 0.135904E-01
+PKER_SDRYG( 28, 74) = 0.142998E-01
+PKER_SDRYG( 28, 75) = 0.151150E-01
+PKER_SDRYG( 28, 76) = 0.160038E-01
+PKER_SDRYG( 28, 77) = 0.169418E-01
+PKER_SDRYG( 28, 78) = 0.179108E-01
+PKER_SDRYG( 28, 79) = 0.188859E-01
+PKER_SDRYG( 28, 80) = 0.198573E-01
+PKER_SDRYG( 29, 1) = 0.313775E+01
+PKER_SDRYG( 29, 2) = 0.294524E+01
+PKER_SDRYG( 29, 3) = 0.276447E+01
+PKER_SDRYG( 29, 4) = 0.259474E+01
+PKER_SDRYG( 29, 5) = 0.243535E+01
+PKER_SDRYG( 29, 6) = 0.228570E+01
+PKER_SDRYG( 29, 7) = 0.214517E+01
+PKER_SDRYG( 29, 8) = 0.201322E+01
+PKER_SDRYG( 29, 9) = 0.188932E+01
+PKER_SDRYG( 29, 10) = 0.177297E+01
+PKER_SDRYG( 29, 11) = 0.166373E+01
+PKER_SDRYG( 29, 12) = 0.156115E+01
+PKER_SDRYG( 29, 13) = 0.146483E+01
+PKER_SDRYG( 29, 14) = 0.137438E+01
+PKER_SDRYG( 29, 15) = 0.128945E+01
+PKER_SDRYG( 29, 16) = 0.120970E+01
+PKER_SDRYG( 29, 17) = 0.113482E+01
+PKER_SDRYG( 29, 18) = 0.106450E+01
+PKER_SDRYG( 29, 19) = 0.998466E+00
+PKER_SDRYG( 29, 20) = 0.936458E+00
+PKER_SDRYG( 29, 21) = 0.878229E+00
+PKER_SDRYG( 29, 22) = 0.823547E+00
+PKER_SDRYG( 29, 23) = 0.772194E+00
+PKER_SDRYG( 29, 24) = 0.723965E+00
+PKER_SDRYG( 29, 25) = 0.678669E+00
+PKER_SDRYG( 29, 26) = 0.636124E+00
+PKER_SDRYG( 29, 27) = 0.596159E+00
+PKER_SDRYG( 29, 28) = 0.558615E+00
+PKER_SDRYG( 29, 29) = 0.523340E+00
+PKER_SDRYG( 29, 30) = 0.490190E+00
+PKER_SDRYG( 29, 31) = 0.459030E+00
+PKER_SDRYG( 29, 32) = 0.429733E+00
+PKER_SDRYG( 29, 33) = 0.402176E+00
+PKER_SDRYG( 29, 34) = 0.376242E+00
+PKER_SDRYG( 29, 35) = 0.351822E+00
+PKER_SDRYG( 29, 36) = 0.328807E+00
+PKER_SDRYG( 29, 37) = 0.307093E+00
+PKER_SDRYG( 29, 38) = 0.286580E+00
+PKER_SDRYG( 29, 39) = 0.267168E+00
+PKER_SDRYG( 29, 40) = 0.248763E+00
+PKER_SDRYG( 29, 41) = 0.231269E+00
+PKER_SDRYG( 29, 42) = 0.214600E+00
+PKER_SDRYG( 29, 43) = 0.198675E+00
+PKER_SDRYG( 29, 44) = 0.183429E+00
+PKER_SDRYG( 29, 45) = 0.168818E+00
+PKER_SDRYG( 29, 46) = 0.154826E+00
+PKER_SDRYG( 29, 47) = 0.141470E+00
+PKER_SDRYG( 29, 48) = 0.128793E+00
+PKER_SDRYG( 29, 49) = 0.116859E+00
+PKER_SDRYG( 29, 50) = 0.105725E+00
+PKER_SDRYG( 29, 51) = 0.954304E-01
+PKER_SDRYG( 29, 52) = 0.859836E-01
+PKER_SDRYG( 29, 53) = 0.773596E-01
+PKER_SDRYG( 29, 54) = 0.695082E-01
+PKER_SDRYG( 29, 55) = 0.623650E-01
+PKER_SDRYG( 29, 56) = 0.558611E-01
+PKER_SDRYG( 29, 57) = 0.499316E-01
+PKER_SDRYG( 29, 58) = 0.445208E-01
+PKER_SDRYG( 29, 59) = 0.395814E-01
+PKER_SDRYG( 29, 60) = 0.350788E-01
+PKER_SDRYG( 29, 61) = 0.309897E-01
+PKER_SDRYG( 29, 62) = 0.272977E-01
+PKER_SDRYG( 29, 63) = 0.239931E-01
+PKER_SDRYG( 29, 64) = 0.210731E-01
+PKER_SDRYG( 29, 65) = 0.185324E-01
+PKER_SDRYG( 29, 66) = 0.163751E-01
+PKER_SDRYG( 29, 67) = 0.145805E-01
+PKER_SDRYG( 29, 68) = 0.131445E-01
+PKER_SDRYG( 29, 69) = 0.120720E-01
+PKER_SDRYG( 29, 70) = 0.113116E-01
+PKER_SDRYG( 29, 71) = 0.108560E-01
+PKER_SDRYG( 29, 72) = 0.106640E-01
+PKER_SDRYG( 29, 73) = 0.107167E-01
+PKER_SDRYG( 29, 74) = 0.109632E-01
+PKER_SDRYG( 29, 75) = 0.113846E-01
+PKER_SDRYG( 29, 76) = 0.119375E-01
+PKER_SDRYG( 29, 77) = 0.125899E-01
+PKER_SDRYG( 29, 78) = 0.133280E-01
+PKER_SDRYG( 29, 79) = 0.141136E-01
+PKER_SDRYG( 29, 80) = 0.149298E-01
+PKER_SDRYG( 30, 1) = 0.314026E+01
+PKER_SDRYG( 30, 2) = 0.294775E+01
+PKER_SDRYG( 30, 3) = 0.276698E+01
+PKER_SDRYG( 30, 4) = 0.259724E+01
+PKER_SDRYG( 30, 5) = 0.243786E+01
+PKER_SDRYG( 30, 6) = 0.228821E+01
+PKER_SDRYG( 30, 7) = 0.214768E+01
+PKER_SDRYG( 30, 8) = 0.201573E+01
+PKER_SDRYG( 30, 9) = 0.189183E+01
+PKER_SDRYG( 30, 10) = 0.177549E+01
+PKER_SDRYG( 30, 11) = 0.166624E+01
+PKER_SDRYG( 30, 12) = 0.156366E+01
+PKER_SDRYG( 30, 13) = 0.146734E+01
+PKER_SDRYG( 30, 14) = 0.137690E+01
+PKER_SDRYG( 30, 15) = 0.129197E+01
+PKER_SDRYG( 30, 16) = 0.121222E+01
+PKER_SDRYG( 30, 17) = 0.113734E+01
+PKER_SDRYG( 30, 18) = 0.106702E+01
+PKER_SDRYG( 30, 19) = 0.100099E+01
+PKER_SDRYG( 30, 20) = 0.938991E+00
+PKER_SDRYG( 30, 21) = 0.880767E+00
+PKER_SDRYG( 30, 22) = 0.826092E+00
+PKER_SDRYG( 30, 23) = 0.774746E+00
+PKER_SDRYG( 30, 24) = 0.726527E+00
+PKER_SDRYG( 30, 25) = 0.681242E+00
+PKER_SDRYG( 30, 26) = 0.638710E+00
+PKER_SDRYG( 30, 27) = 0.598762E+00
+PKER_SDRYG( 30, 28) = 0.561237E+00
+PKER_SDRYG( 30, 29) = 0.525986E+00
+PKER_SDRYG( 30, 30) = 0.492864E+00
+PKER_SDRYG( 30, 31) = 0.461740E+00
+PKER_SDRYG( 30, 32) = 0.432485E+00
+PKER_SDRYG( 30, 33) = 0.404979E+00
+PKER_SDRYG( 30, 34) = 0.379109E+00
+PKER_SDRYG( 30, 35) = 0.354764E+00
+PKER_SDRYG( 30, 36) = 0.331842E+00
+PKER_SDRYG( 30, 37) = 0.310241E+00
+PKER_SDRYG( 30, 38) = 0.289866E+00
+PKER_SDRYG( 30, 39) = 0.270620E+00
+PKER_SDRYG( 30, 40) = 0.252414E+00
+PKER_SDRYG( 30, 41) = 0.235157E+00
+PKER_SDRYG( 30, 42) = 0.218763E+00
+PKER_SDRYG( 30, 43) = 0.203150E+00
+PKER_SDRYG( 30, 44) = 0.188244E+00
+PKER_SDRYG( 30, 45) = 0.173985E+00
+PKER_SDRYG( 30, 46) = 0.160331E+00
+PKER_SDRYG( 30, 47) = 0.147268E+00
+PKER_SDRYG( 30, 48) = 0.134807E+00
+PKER_SDRYG( 30, 49) = 0.122990E+00
+PKER_SDRYG( 30, 50) = 0.111870E+00
+PKER_SDRYG( 30, 51) = 0.101498E+00
+PKER_SDRYG( 30, 52) = 0.919089E-01
+PKER_SDRYG( 30, 53) = 0.831067E-01
+PKER_SDRYG( 30, 54) = 0.750668E-01
+PKER_SDRYG( 30, 55) = 0.677413E-01
+PKER_SDRYG( 30, 56) = 0.610688E-01
+PKER_SDRYG( 30, 57) = 0.549841E-01
+PKER_SDRYG( 30, 58) = 0.494242E-01
+PKER_SDRYG( 30, 59) = 0.443338E-01
+PKER_SDRYG( 30, 60) = 0.396667E-01
+PKER_SDRYG( 30, 61) = 0.353851E-01
+PKER_SDRYG( 30, 62) = 0.314617E-01
+PKER_SDRYG( 30, 63) = 0.278788E-01
+PKER_SDRYG( 30, 64) = 0.246216E-01
+PKER_SDRYG( 30, 65) = 0.216840E-01
+PKER_SDRYG( 30, 66) = 0.190676E-01
+PKER_SDRYG( 30, 67) = 0.167678E-01
+PKER_SDRYG( 30, 68) = 0.147843E-01
+PKER_SDRYG( 30, 69) = 0.131194E-01
+PKER_SDRYG( 30, 70) = 0.117708E-01
+PKER_SDRYG( 30, 71) = 0.107143E-01
+PKER_SDRYG( 30, 72) = 0.994008E-02
+PKER_SDRYG( 30, 73) = 0.944116E-02
+PKER_SDRYG( 30, 74) = 0.917473E-02
+PKER_SDRYG( 30, 75) = 0.912540E-02
+PKER_SDRYG( 30, 76) = 0.926519E-02
+PKER_SDRYG( 30, 77) = 0.955670E-02
+PKER_SDRYG( 30, 78) = 0.997708E-02
+PKER_SDRYG( 30, 79) = 0.105008E-01
+PKER_SDRYG( 30, 80) = 0.111005E-01
+PKER_SDRYG( 31, 1) = 0.314241E+01
+PKER_SDRYG( 31, 2) = 0.294989E+01
+PKER_SDRYG( 31, 3) = 0.276913E+01
+PKER_SDRYG( 31, 4) = 0.259939E+01
+PKER_SDRYG( 31, 5) = 0.244001E+01
+PKER_SDRYG( 31, 6) = 0.229035E+01
+PKER_SDRYG( 31, 7) = 0.214983E+01
+PKER_SDRYG( 31, 8) = 0.201788E+01
+PKER_SDRYG( 31, 9) = 0.189397E+01
+PKER_SDRYG( 31, 10) = 0.177763E+01
+PKER_SDRYG( 31, 11) = 0.166839E+01
+PKER_SDRYG( 31, 12) = 0.156581E+01
+PKER_SDRYG( 31, 13) = 0.146949E+01
+PKER_SDRYG( 31, 14) = 0.137905E+01
+PKER_SDRYG( 31, 15) = 0.129412E+01
+PKER_SDRYG( 31, 16) = 0.121438E+01
+PKER_SDRYG( 31, 17) = 0.113950E+01
+PKER_SDRYG( 31, 18) = 0.106918E+01
+PKER_SDRYG( 31, 19) = 0.100316E+01
+PKER_SDRYG( 31, 20) = 0.941157E+00
+PKER_SDRYG( 31, 21) = 0.882937E+00
+PKER_SDRYG( 31, 22) = 0.828266E+00
+PKER_SDRYG( 31, 23) = 0.776926E+00
+PKER_SDRYG( 31, 24) = 0.728714E+00
+PKER_SDRYG( 31, 25) = 0.683437E+00
+PKER_SDRYG( 31, 26) = 0.640916E+00
+PKER_SDRYG( 31, 27) = 0.600980E+00
+PKER_SDRYG( 31, 28) = 0.563470E+00
+PKER_SDRYG( 31, 29) = 0.528236E+00
+PKER_SDRYG( 31, 30) = 0.495137E+00
+PKER_SDRYG( 31, 31) = 0.464039E+00
+PKER_SDRYG( 31, 32) = 0.434815E+00
+PKER_SDRYG( 31, 33) = 0.407348E+00
+PKER_SDRYG( 31, 34) = 0.381525E+00
+PKER_SDRYG( 31, 35) = 0.357237E+00
+PKER_SDRYG( 31, 36) = 0.334384E+00
+PKER_SDRYG( 31, 37) = 0.312867E+00
+PKER_SDRYG( 31, 38) = 0.292593E+00
+PKER_SDRYG( 31, 39) = 0.273472E+00
+PKER_SDRYG( 31, 40) = 0.255415E+00
+PKER_SDRYG( 31, 41) = 0.238337E+00
+PKER_SDRYG( 31, 42) = 0.222155E+00
+PKER_SDRYG( 31, 43) = 0.206789E+00
+PKER_SDRYG( 31, 44) = 0.192162E+00
+PKER_SDRYG( 31, 45) = 0.178206E+00
+PKER_SDRYG( 31, 46) = 0.164865E+00
+PKER_SDRYG( 31, 47) = 0.152101E+00
+PKER_SDRYG( 31, 48) = 0.139898E+00
+PKER_SDRYG( 31, 49) = 0.128268E+00
+PKER_SDRYG( 31, 50) = 0.117245E+00
+PKER_SDRYG( 31, 51) = 0.106877E+00
+PKER_SDRYG( 31, 52) = 0.972093E-01
+PKER_SDRYG( 31, 53) = 0.882710E-01
+PKER_SDRYG( 31, 54) = 0.800646E-01
+PKER_SDRYG( 31, 55) = 0.725658E-01
+PKER_SDRYG( 31, 56) = 0.657293E-01
+PKER_SDRYG( 31, 57) = 0.594973E-01
+PKER_SDRYG( 31, 58) = 0.538082E-01
+PKER_SDRYG( 31, 59) = 0.486029E-01
+PKER_SDRYG( 31, 60) = 0.438281E-01
+PKER_SDRYG( 31, 61) = 0.394382E-01
+PKER_SDRYG( 31, 62) = 0.353958E-01
+PKER_SDRYG( 31, 63) = 0.316723E-01
+PKER_SDRYG( 31, 64) = 0.282443E-01
+PKER_SDRYG( 31, 65) = 0.250971E-01
+PKER_SDRYG( 31, 66) = 0.222220E-01
+PKER_SDRYG( 31, 67) = 0.196134E-01
+PKER_SDRYG( 31, 68) = 0.172700E-01
+PKER_SDRYG( 31, 69) = 0.151950E-01
+PKER_SDRYG( 31, 70) = 0.133842E-01
+PKER_SDRYG( 31, 71) = 0.118468E-01
+PKER_SDRYG( 31, 72) = 0.105682E-01
+PKER_SDRYG( 31, 73) = 0.954383E-02
+PKER_SDRYG( 31, 74) = 0.878311E-02
+PKER_SDRYG( 31, 75) = 0.824730E-02
+PKER_SDRYG( 31, 76) = 0.792838E-02
+PKER_SDRYG( 31, 77) = 0.780258E-02
+PKER_SDRYG( 31, 78) = 0.785165E-02
+PKER_SDRYG( 31, 79) = 0.803984E-02
+PKER_SDRYG( 31, 80) = 0.835401E-02
+PKER_SDRYG( 32, 1) = 0.314424E+01
+PKER_SDRYG( 32, 2) = 0.295173E+01
+PKER_SDRYG( 32, 3) = 0.277096E+01
+PKER_SDRYG( 32, 4) = 0.260122E+01
+PKER_SDRYG( 32, 5) = 0.244184E+01
+PKER_SDRYG( 32, 6) = 0.229219E+01
+PKER_SDRYG( 32, 7) = 0.215166E+01
+PKER_SDRYG( 32, 8) = 0.201971E+01
+PKER_SDRYG( 32, 9) = 0.189581E+01
+PKER_SDRYG( 32, 10) = 0.177947E+01
+PKER_SDRYG( 32, 11) = 0.167023E+01
+PKER_SDRYG( 32, 12) = 0.156765E+01
+PKER_SDRYG( 32, 13) = 0.147133E+01
+PKER_SDRYG( 32, 14) = 0.138089E+01
+PKER_SDRYG( 32, 15) = 0.129596E+01
+PKER_SDRYG( 32, 16) = 0.121622E+01
+PKER_SDRYG( 32, 17) = 0.114134E+01
+PKER_SDRYG( 32, 18) = 0.107103E+01
+PKER_SDRYG( 32, 19) = 0.100500E+01
+PKER_SDRYG( 32, 20) = 0.943008E+00
+PKER_SDRYG( 32, 21) = 0.884791E+00
+PKER_SDRYG( 32, 22) = 0.830124E+00
+PKER_SDRYG( 32, 23) = 0.778789E+00
+PKER_SDRYG( 32, 24) = 0.730582E+00
+PKER_SDRYG( 32, 25) = 0.685312E+00
+PKER_SDRYG( 32, 26) = 0.642798E+00
+PKER_SDRYG( 32, 27) = 0.602872E+00
+PKER_SDRYG( 32, 28) = 0.565373E+00
+PKER_SDRYG( 32, 29) = 0.530153E+00
+PKER_SDRYG( 32, 30) = 0.497070E+00
+PKER_SDRYG( 32, 31) = 0.465991E+00
+PKER_SDRYG( 32, 32) = 0.436792E+00
+PKER_SDRYG( 32, 33) = 0.409354E+00
+PKER_SDRYG( 32, 34) = 0.383565E+00
+PKER_SDRYG( 32, 35) = 0.359320E+00
+PKER_SDRYG( 32, 36) = 0.336518E+00
+PKER_SDRYG( 32, 37) = 0.315064E+00
+PKER_SDRYG( 32, 38) = 0.294866E+00
+PKER_SDRYG( 32, 39) = 0.275837E+00
+PKER_SDRYG( 32, 40) = 0.257892E+00
+PKER_SDRYG( 32, 41) = 0.240949E+00
+PKER_SDRYG( 32, 42) = 0.224929E+00
+PKER_SDRYG( 32, 43) = 0.209753E+00
+PKER_SDRYG( 32, 44) = 0.195347E+00
+PKER_SDRYG( 32, 45) = 0.181641E+00
+PKER_SDRYG( 32, 46) = 0.168572E+00
+PKER_SDRYG( 32, 47) = 0.156087E+00
+PKER_SDRYG( 32, 48) = 0.144150E+00
+PKER_SDRYG( 32, 49) = 0.132746E+00
+PKER_SDRYG( 32, 50) = 0.121885E+00
+PKER_SDRYG( 32, 51) = 0.111598E+00
+PKER_SDRYG( 32, 52) = 0.101925E+00
+PKER_SDRYG( 32, 53) = 0.929079E-01
+PKER_SDRYG( 32, 54) = 0.845713E-01
+PKER_SDRYG( 32, 55) = 0.769159E-01
+PKER_SDRYG( 32, 56) = 0.699183E-01
+PKER_SDRYG( 32, 57) = 0.635355E-01
+PKER_SDRYG( 32, 58) = 0.577136E-01
+PKER_SDRYG( 32, 59) = 0.523950E-01
+PKER_SDRYG( 32, 60) = 0.475243E-01
+PKER_SDRYG( 32, 61) = 0.430512E-01
+PKER_SDRYG( 32, 62) = 0.389325E-01
+PKER_SDRYG( 32, 63) = 0.351313E-01
+PKER_SDRYG( 32, 64) = 0.316183E-01
+PKER_SDRYG( 32, 65) = 0.283700E-01
+PKER_SDRYG( 32, 66) = 0.253685E-01
+PKER_SDRYG( 32, 67) = 0.226014E-01
+PKER_SDRYG( 32, 68) = 0.200616E-01
+PKER_SDRYG( 32, 69) = 0.177438E-01
+PKER_SDRYG( 32, 70) = 0.156482E-01
+PKER_SDRYG( 32, 71) = 0.137766E-01
+PKER_SDRYG( 32, 72) = 0.121294E-01
+PKER_SDRYG( 32, 73) = 0.107083E-01
+PKER_SDRYG( 32, 74) = 0.951507E-02
+PKER_SDRYG( 32, 75) = 0.854960E-02
+PKER_SDRYG( 32, 76) = 0.779589E-02
+PKER_SDRYG( 32, 77) = 0.724397E-02
+PKER_SDRYG( 32, 78) = 0.689318E-02
+PKER_SDRYG( 32, 79) = 0.670835E-02
+PKER_SDRYG( 32, 80) = 0.668173E-02
+PKER_SDRYG( 33, 1) = 0.314581E+01
+PKER_SDRYG( 33, 2) = 0.295330E+01
+PKER_SDRYG( 33, 3) = 0.277253E+01
+PKER_SDRYG( 33, 4) = 0.260280E+01
+PKER_SDRYG( 33, 5) = 0.244341E+01
+PKER_SDRYG( 33, 6) = 0.229376E+01
+PKER_SDRYG( 33, 7) = 0.215323E+01
+PKER_SDRYG( 33, 8) = 0.202128E+01
+PKER_SDRYG( 33, 9) = 0.189738E+01
+PKER_SDRYG( 33, 10) = 0.178104E+01
+PKER_SDRYG( 33, 11) = 0.167180E+01
+PKER_SDRYG( 33, 12) = 0.156922E+01
+PKER_SDRYG( 33, 13) = 0.147291E+01
+PKER_SDRYG( 33, 14) = 0.138246E+01
+PKER_SDRYG( 33, 15) = 0.129754E+01
+PKER_SDRYG( 33, 16) = 0.121780E+01
+PKER_SDRYG( 33, 17) = 0.114292E+01
+PKER_SDRYG( 33, 18) = 0.107261E+01
+PKER_SDRYG( 33, 19) = 0.100659E+01
+PKER_SDRYG( 33, 20) = 0.944590E+00
+PKER_SDRYG( 33, 21) = 0.886376E+00
+PKER_SDRYG( 33, 22) = 0.831711E+00
+PKER_SDRYG( 33, 23) = 0.780380E+00
+PKER_SDRYG( 33, 24) = 0.732177E+00
+PKER_SDRYG( 33, 25) = 0.686912E+00
+PKER_SDRYG( 33, 26) = 0.644404E+00
+PKER_SDRYG( 33, 27) = 0.604485E+00
+PKER_SDRYG( 33, 28) = 0.566995E+00
+PKER_SDRYG( 33, 29) = 0.531785E+00
+PKER_SDRYG( 33, 30) = 0.498715E+00
+PKER_SDRYG( 33, 31) = 0.467651E+00
+PKER_SDRYG( 33, 32) = 0.438470E+00
+PKER_SDRYG( 33, 33) = 0.411054E+00
+PKER_SDRYG( 33, 34) = 0.385291E+00
+PKER_SDRYG( 33, 35) = 0.361078E+00
+PKER_SDRYG( 33, 36) = 0.338315E+00
+PKER_SDRYG( 33, 37) = 0.316908E+00
+PKER_SDRYG( 33, 38) = 0.296767E+00
+PKER_SDRYG( 33, 39) = 0.277807E+00
+PKER_SDRYG( 33, 40) = 0.259946E+00
+PKER_SDRYG( 33, 41) = 0.243104E+00
+PKER_SDRYG( 33, 42) = 0.227205E+00
+PKER_SDRYG( 33, 43) = 0.212175E+00
+PKER_SDRYG( 33, 44) = 0.197941E+00
+PKER_SDRYG( 33, 45) = 0.184435E+00
+PKER_SDRYG( 33, 46) = 0.171590E+00
+PKER_SDRYG( 33, 47) = 0.159348E+00
+PKER_SDRYG( 33, 48) = 0.147660E+00
+PKER_SDRYG( 33, 49) = 0.136493E+00
+PKER_SDRYG( 33, 50) = 0.125832E+00
+PKER_SDRYG( 33, 51) = 0.115684E+00
+PKER_SDRYG( 33, 52) = 0.106078E+00
+PKER_SDRYG( 33, 53) = 0.970492E-01
+PKER_SDRYG( 33, 54) = 0.886343E-01
+PKER_SDRYG( 33, 55) = 0.808544E-01
+PKER_SDRYG( 33, 56) = 0.737092E-01
+PKER_SDRYG( 33, 57) = 0.671759E-01
+PKER_SDRYG( 33, 58) = 0.612140E-01
+PKER_SDRYG( 33, 59) = 0.557733E-01
+PKER_SDRYG( 33, 60) = 0.508001E-01
+PKER_SDRYG( 33, 61) = 0.462428E-01
+PKER_SDRYG( 33, 62) = 0.420544E-01
+PKER_SDRYG( 33, 63) = 0.381941E-01
+PKER_SDRYG( 33, 64) = 0.346270E-01
+PKER_SDRYG( 33, 65) = 0.313244E-01
+PKER_SDRYG( 33, 66) = 0.282623E-01
+PKER_SDRYG( 33, 67) = 0.254222E-01
+PKER_SDRYG( 33, 68) = 0.227902E-01
+PKER_SDRYG( 33, 69) = 0.203548E-01
+PKER_SDRYG( 33, 70) = 0.181098E-01
+PKER_SDRYG( 33, 71) = 0.160530E-01
+PKER_SDRYG( 33, 72) = 0.141818E-01
+PKER_SDRYG( 33, 73) = 0.124982E-01
+PKER_SDRYG( 33, 74) = 0.110068E-01
+PKER_SDRYG( 33, 75) = 0.970368E-02
+PKER_SDRYG( 33, 76) = 0.859751E-02
+PKER_SDRYG( 33, 77) = 0.767929E-02
+PKER_SDRYG( 33, 78) = 0.694381E-02
+PKER_SDRYG( 33, 79) = 0.639919E-02
+PKER_SDRYG( 33, 80) = 0.601899E-02
+PKER_SDRYG( 34, 1) = 0.314716E+01
+PKER_SDRYG( 34, 2) = 0.295464E+01
+PKER_SDRYG( 34, 3) = 0.277388E+01
+PKER_SDRYG( 34, 4) = 0.260414E+01
+PKER_SDRYG( 34, 5) = 0.244476E+01
+PKER_SDRYG( 34, 6) = 0.229510E+01
+PKER_SDRYG( 34, 7) = 0.215458E+01
+PKER_SDRYG( 34, 8) = 0.202263E+01
+PKER_SDRYG( 34, 9) = 0.189873E+01
+PKER_SDRYG( 34, 10) = 0.178239E+01
+PKER_SDRYG( 34, 11) = 0.167315E+01
+PKER_SDRYG( 34, 12) = 0.157057E+01
+PKER_SDRYG( 34, 13) = 0.147425E+01
+PKER_SDRYG( 34, 14) = 0.138381E+01
+PKER_SDRYG( 34, 15) = 0.129889E+01
+PKER_SDRYG( 34, 16) = 0.121914E+01
+PKER_SDRYG( 34, 17) = 0.114427E+01
+PKER_SDRYG( 34, 18) = 0.107396E+01
+PKER_SDRYG( 34, 19) = 0.100794E+01
+PKER_SDRYG( 34, 20) = 0.945943E+00
+PKER_SDRYG( 34, 21) = 0.887731E+00
+PKER_SDRYG( 34, 22) = 0.833069E+00
+PKER_SDRYG( 34, 23) = 0.781740E+00
+PKER_SDRYG( 34, 24) = 0.733540E+00
+PKER_SDRYG( 34, 25) = 0.688279E+00
+PKER_SDRYG( 34, 26) = 0.645776E+00
+PKER_SDRYG( 34, 27) = 0.605862E+00
+PKER_SDRYG( 34, 28) = 0.568379E+00
+PKER_SDRYG( 34, 29) = 0.533177E+00
+PKER_SDRYG( 34, 30) = 0.500116E+00
+PKER_SDRYG( 34, 31) = 0.469064E+00
+PKER_SDRYG( 34, 32) = 0.439896E+00
+PKER_SDRYG( 34, 33) = 0.412496E+00
+PKER_SDRYG( 34, 34) = 0.386754E+00
+PKER_SDRYG( 34, 35) = 0.362565E+00
+PKER_SDRYG( 34, 36) = 0.339831E+00
+PKER_SDRYG( 34, 37) = 0.318459E+00
+PKER_SDRYG( 34, 38) = 0.298361E+00
+PKER_SDRYG( 34, 39) = 0.279453E+00
+PKER_SDRYG( 34, 40) = 0.261654E+00
+PKER_SDRYG( 34, 41) = 0.244888E+00
+PKER_SDRYG( 34, 42) = 0.229081E+00
+PKER_SDRYG( 34, 43) = 0.214161E+00
+PKER_SDRYG( 34, 44) = 0.200059E+00
+PKER_SDRYG( 34, 45) = 0.186708E+00
+PKER_SDRYG( 34, 46) = 0.174043E+00
+PKER_SDRYG( 34, 47) = 0.162003E+00
+PKER_SDRYG( 34, 48) = 0.150534E+00
+PKER_SDRYG( 34, 49) = 0.139590E+00
+PKER_SDRYG( 34, 50) = 0.129139E+00
+PKER_SDRYG( 34, 51) = 0.119169E+00
+PKER_SDRYG( 34, 52) = 0.109684E+00
+PKER_SDRYG( 34, 53) = 0.100710E+00
+PKER_SDRYG( 34, 54) = 0.922778E-01
+PKER_SDRYG( 34, 55) = 0.844206E-01
+PKER_SDRYG( 34, 56) = 0.771566E-01
+PKER_SDRYG( 34, 57) = 0.704841E-01
+PKER_SDRYG( 34, 58) = 0.643812E-01
+PKER_SDRYG( 34, 59) = 0.588101E-01
+PKER_SDRYG( 34, 60) = 0.537237E-01
+PKER_SDRYG( 34, 61) = 0.490721E-01
+PKER_SDRYG( 34, 62) = 0.448073E-01
+PKER_SDRYG( 34, 63) = 0.408857E-01
+PKER_SDRYG( 34, 64) = 0.372690E-01
+PKER_SDRYG( 34, 65) = 0.339245E-01
+PKER_SDRYG( 34, 66) = 0.308247E-01
+PKER_SDRYG( 34, 67) = 0.279467E-01
+PKER_SDRYG( 34, 68) = 0.252716E-01
+PKER_SDRYG( 34, 69) = 0.227841E-01
+PKER_SDRYG( 34, 70) = 0.204724E-01
+PKER_SDRYG( 34, 71) = 0.183278E-01
+PKER_SDRYG( 34, 72) = 0.163442E-01
+PKER_SDRYG( 34, 73) = 0.145187E-01
+PKER_SDRYG( 34, 74) = 0.128499E-01
+PKER_SDRYG( 34, 75) = 0.113397E-01
+PKER_SDRYG( 34, 76) = 0.998905E-02
+PKER_SDRYG( 34, 77) = 0.880025E-02
+PKER_SDRYG( 34, 78) = 0.777536E-02
+PKER_SDRYG( 34, 79) = 0.691458E-02
+PKER_SDRYG( 34, 80) = 0.621944E-02
+PKER_SDRYG( 35, 1) = 0.314831E+01
+PKER_SDRYG( 35, 2) = 0.295579E+01
+PKER_SDRYG( 35, 3) = 0.277503E+01
+PKER_SDRYG( 35, 4) = 0.260529E+01
+PKER_SDRYG( 35, 5) = 0.244591E+01
+PKER_SDRYG( 35, 6) = 0.229625E+01
+PKER_SDRYG( 35, 7) = 0.215573E+01
+PKER_SDRYG( 35, 8) = 0.202378E+01
+PKER_SDRYG( 35, 9) = 0.189988E+01
+PKER_SDRYG( 35, 10) = 0.178354E+01
+PKER_SDRYG( 35, 11) = 0.167430E+01
+PKER_SDRYG( 35, 12) = 0.157172E+01
+PKER_SDRYG( 35, 13) = 0.147540E+01
+PKER_SDRYG( 35, 14) = 0.138496E+01
+PKER_SDRYG( 35, 15) = 0.130004E+01
+PKER_SDRYG( 35, 16) = 0.122030E+01
+PKER_SDRYG( 35, 17) = 0.114542E+01
+PKER_SDRYG( 35, 18) = 0.107511E+01
+PKER_SDRYG( 35, 19) = 0.100909E+01
+PKER_SDRYG( 35, 20) = 0.947100E+00
+PKER_SDRYG( 35, 21) = 0.888890E+00
+PKER_SDRYG( 35, 22) = 0.834229E+00
+PKER_SDRYG( 35, 23) = 0.782902E+00
+PKER_SDRYG( 35, 24) = 0.734705E+00
+PKER_SDRYG( 35, 25) = 0.689447E+00
+PKER_SDRYG( 35, 26) = 0.646947E+00
+PKER_SDRYG( 35, 27) = 0.607038E+00
+PKER_SDRYG( 35, 28) = 0.569560E+00
+PKER_SDRYG( 35, 29) = 0.534364E+00
+PKER_SDRYG( 35, 30) = 0.501310E+00
+PKER_SDRYG( 35, 31) = 0.470267E+00
+PKER_SDRYG( 35, 32) = 0.441110E+00
+PKER_SDRYG( 35, 33) = 0.413722E+00
+PKER_SDRYG( 35, 34) = 0.387995E+00
+PKER_SDRYG( 35, 35) = 0.363825E+00
+PKER_SDRYG( 35, 36) = 0.341113E+00
+PKER_SDRYG( 35, 37) = 0.319768E+00
+PKER_SDRYG( 35, 38) = 0.299702E+00
+PKER_SDRYG( 35, 39) = 0.280832E+00
+PKER_SDRYG( 35, 40) = 0.263081E+00
+PKER_SDRYG( 35, 41) = 0.246372E+00
+PKER_SDRYG( 35, 42) = 0.230634E+00
+PKER_SDRYG( 35, 43) = 0.215798E+00
+PKER_SDRYG( 35, 44) = 0.201796E+00
+PKER_SDRYG( 35, 45) = 0.188564E+00
+PKER_SDRYG( 35, 46) = 0.176039E+00
+PKER_SDRYG( 35, 47) = 0.164162E+00
+PKER_SDRYG( 35, 48) = 0.152875E+00
+PKER_SDRYG( 35, 49) = 0.142127E+00
+PKER_SDRYG( 35, 50) = 0.131877E+00
+PKER_SDRYG( 35, 51) = 0.122094E+00
+PKER_SDRYG( 35, 52) = 0.112767E+00
+PKER_SDRYG( 35, 53) = 0.103898E+00
+PKER_SDRYG( 35, 54) = 0.955102E-01
+PKER_SDRYG( 35, 55) = 0.876322E-01
+PKER_SDRYG( 35, 56) = 0.802923E-01
+PKER_SDRYG( 35, 57) = 0.735065E-01
+PKER_SDRYG( 35, 58) = 0.672725E-01
+PKER_SDRYG( 35, 59) = 0.615692E-01
+PKER_SDRYG( 35, 60) = 0.563610E-01
+PKER_SDRYG( 35, 61) = 0.516040E-01
+PKER_SDRYG( 35, 62) = 0.472519E-01
+PKER_SDRYG( 35, 63) = 0.432599E-01
+PKER_SDRYG( 35, 64) = 0.395875E-01
+PKER_SDRYG( 35, 65) = 0.361991E-01
+PKER_SDRYG( 35, 66) = 0.330642E-01
+PKER_SDRYG( 35, 67) = 0.301570E-01
+PKER_SDRYG( 35, 68) = 0.274555E-01
+PKER_SDRYG( 35, 69) = 0.249416E-01
+PKER_SDRYG( 35, 70) = 0.226001E-01
+PKER_SDRYG( 35, 71) = 0.204182E-01
+PKER_SDRYG( 35, 72) = 0.183863E-01
+PKER_SDRYG( 35, 73) = 0.164969E-01
+PKER_SDRYG( 35, 74) = 0.147442E-01
+PKER_SDRYG( 35, 75) = 0.131255E-01
+PKER_SDRYG( 35, 76) = 0.116402E-01
+PKER_SDRYG( 35, 77) = 0.102875E-01
+PKER_SDRYG( 35, 78) = 0.906989E-02
+PKER_SDRYG( 35, 79) = 0.799132E-02
+PKER_SDRYG( 35, 80) = 0.704902E-02
+PKER_SDRYG( 36, 1) = 0.314929E+01
+PKER_SDRYG( 36, 2) = 0.295678E+01
+PKER_SDRYG( 36, 3) = 0.277601E+01
+PKER_SDRYG( 36, 4) = 0.260627E+01
+PKER_SDRYG( 36, 5) = 0.244689E+01
+PKER_SDRYG( 36, 6) = 0.229724E+01
+PKER_SDRYG( 36, 7) = 0.215671E+01
+PKER_SDRYG( 36, 8) = 0.202476E+01
+PKER_SDRYG( 36, 9) = 0.190086E+01
+PKER_SDRYG( 36, 10) = 0.178452E+01
+PKER_SDRYG( 36, 11) = 0.167528E+01
+PKER_SDRYG( 36, 12) = 0.157271E+01
+PKER_SDRYG( 36, 13) = 0.147639E+01
+PKER_SDRYG( 36, 14) = 0.138595E+01
+PKER_SDRYG( 36, 15) = 0.130103E+01
+PKER_SDRYG( 36, 16) = 0.122128E+01
+PKER_SDRYG( 36, 17) = 0.114641E+01
+PKER_SDRYG( 36, 18) = 0.107610E+01
+PKER_SDRYG( 36, 19) = 0.101008E+01
+PKER_SDRYG( 36, 20) = 0.948090E+00
+PKER_SDRYG( 36, 21) = 0.889880E+00
+PKER_SDRYG( 36, 22) = 0.835221E+00
+PKER_SDRYG( 36, 23) = 0.783896E+00
+PKER_SDRYG( 36, 24) = 0.735701E+00
+PKER_SDRYG( 36, 25) = 0.690445E+00
+PKER_SDRYG( 36, 26) = 0.647948E+00
+PKER_SDRYG( 36, 27) = 0.608042E+00
+PKER_SDRYG( 36, 28) = 0.570567E+00
+PKER_SDRYG( 36, 29) = 0.535376E+00
+PKER_SDRYG( 36, 30) = 0.502328E+00
+PKER_SDRYG( 36, 31) = 0.471291E+00
+PKER_SDRYG( 36, 32) = 0.442142E+00
+PKER_SDRYG( 36, 33) = 0.414765E+00
+PKER_SDRYG( 36, 34) = 0.389049E+00
+PKER_SDRYG( 36, 35) = 0.364893E+00
+PKER_SDRYG( 36, 36) = 0.342198E+00
+PKER_SDRYG( 36, 37) = 0.320873E+00
+PKER_SDRYG( 36, 38) = 0.300831E+00
+PKER_SDRYG( 36, 39) = 0.281991E+00
+PKER_SDRYG( 36, 40) = 0.264276E+00
+PKER_SDRYG( 36, 41) = 0.247610E+00
+PKER_SDRYG( 36, 42) = 0.231924E+00
+PKER_SDRYG( 36, 43) = 0.217150E+00
+PKER_SDRYG( 36, 44) = 0.203224E+00
+PKER_SDRYG( 36, 45) = 0.190084E+00
+PKER_SDRYG( 36, 46) = 0.177667E+00
+PKER_SDRYG( 36, 47) = 0.165917E+00
+PKER_SDRYG( 36, 48) = 0.154777E+00
+PKER_SDRYG( 36, 49) = 0.144194E+00
+PKER_SDRYG( 36, 50) = 0.134122E+00
+PKER_SDRYG( 36, 51) = 0.124519E+00
+PKER_SDRYG( 36, 52) = 0.115360E+00
+PKER_SDRYG( 36, 53) = 0.106630E+00
+PKER_SDRYG( 36, 54) = 0.983351E-01
+PKER_SDRYG( 36, 55) = 0.904924E-01
+PKER_SDRYG( 36, 56) = 0.831287E-01
+PKER_SDRYG( 36, 57) = 0.762689E-01
+PKER_SDRYG( 36, 58) = 0.699271E-01
+PKER_SDRYG( 36, 59) = 0.641001E-01
+PKER_SDRYG( 36, 60) = 0.587680E-01
+PKER_SDRYG( 36, 61) = 0.538972E-01
+PKER_SDRYG( 36, 62) = 0.494467E-01
+PKER_SDRYG( 36, 63) = 0.453735E-01
+PKER_SDRYG( 36, 64) = 0.416358E-01
+PKER_SDRYG( 36, 65) = 0.381961E-01
+PKER_SDRYG( 36, 66) = 0.350213E-01
+PKER_SDRYG( 36, 67) = 0.320830E-01
+PKER_SDRYG( 36, 68) = 0.293569E-01
+PKER_SDRYG( 36, 69) = 0.268227E-01
+PKER_SDRYG( 36, 70) = 0.244628E-01
+PKER_SDRYG( 36, 71) = 0.222628E-01
+PKER_SDRYG( 36, 72) = 0.202100E-01
+PKER_SDRYG( 36, 73) = 0.182942E-01
+PKER_SDRYG( 36, 74) = 0.165070E-01
+PKER_SDRYG( 36, 75) = 0.148415E-01
+PKER_SDRYG( 36, 76) = 0.132934E-01
+PKER_SDRYG( 36, 77) = 0.118592E-01
+PKER_SDRYG( 36, 78) = 0.105376E-01
+PKER_SDRYG( 36, 79) = 0.932874E-02
+PKER_SDRYG( 36, 80) = 0.823481E-02
+PKER_SDRYG( 37, 1) = 0.315013E+01
+PKER_SDRYG( 37, 2) = 0.295762E+01
+PKER_SDRYG( 37, 3) = 0.277685E+01
+PKER_SDRYG( 37, 4) = 0.260712E+01
+PKER_SDRYG( 37, 5) = 0.244774E+01
+PKER_SDRYG( 37, 6) = 0.229808E+01
+PKER_SDRYG( 37, 7) = 0.215756E+01
+PKER_SDRYG( 37, 8) = 0.202561E+01
+PKER_SDRYG( 37, 9) = 0.190171E+01
+PKER_SDRYG( 37, 10) = 0.178537E+01
+PKER_SDRYG( 37, 11) = 0.167613E+01
+PKER_SDRYG( 37, 12) = 0.157355E+01
+PKER_SDRYG( 37, 13) = 0.147723E+01
+PKER_SDRYG( 37, 14) = 0.138679E+01
+PKER_SDRYG( 37, 15) = 0.130187E+01
+PKER_SDRYG( 37, 16) = 0.122213E+01
+PKER_SDRYG( 37, 17) = 0.114725E+01
+PKER_SDRYG( 37, 18) = 0.107695E+01
+PKER_SDRYG( 37, 19) = 0.101093E+01
+PKER_SDRYG( 37, 20) = 0.948936E+00
+PKER_SDRYG( 37, 21) = 0.890727E+00
+PKER_SDRYG( 37, 22) = 0.836069E+00
+PKER_SDRYG( 37, 23) = 0.784745E+00
+PKER_SDRYG( 37, 24) = 0.736552E+00
+PKER_SDRYG( 37, 25) = 0.691298E+00
+PKER_SDRYG( 37, 26) = 0.648803E+00
+PKER_SDRYG( 37, 27) = 0.608899E+00
+PKER_SDRYG( 37, 28) = 0.571428E+00
+PKER_SDRYG( 37, 29) = 0.536240E+00
+PKER_SDRYG( 37, 30) = 0.503196E+00
+PKER_SDRYG( 37, 31) = 0.472165E+00
+PKER_SDRYG( 37, 32) = 0.443022E+00
+PKER_SDRYG( 37, 33) = 0.415652E+00
+PKER_SDRYG( 37, 34) = 0.389946E+00
+PKER_SDRYG( 37, 35) = 0.365800E+00
+PKER_SDRYG( 37, 36) = 0.343117E+00
+PKER_SDRYG( 37, 37) = 0.321808E+00
+PKER_SDRYG( 37, 38) = 0.301785E+00
+PKER_SDRYG( 37, 39) = 0.282968E+00
+PKER_SDRYG( 37, 40) = 0.265279E+00
+PKER_SDRYG( 37, 41) = 0.248646E+00
+PKER_SDRYG( 37, 42) = 0.232999E+00
+PKER_SDRYG( 37, 43) = 0.218273E+00
+PKER_SDRYG( 37, 44) = 0.204405E+00
+PKER_SDRYG( 37, 45) = 0.191333E+00
+PKER_SDRYG( 37, 46) = 0.179000E+00
+PKER_SDRYG( 37, 47) = 0.167348E+00
+PKER_SDRYG( 37, 48) = 0.156324E+00
+PKER_SDRYG( 37, 49) = 0.145874E+00
+PKER_SDRYG( 37, 50) = 0.135951E+00
+PKER_SDRYG( 37, 51) = 0.126509E+00
+PKER_SDRYG( 37, 52) = 0.117512E+00
+PKER_SDRYG( 37, 53) = 0.108934E+00
+PKER_SDRYG( 37, 54) = 0.100762E+00
+PKER_SDRYG( 37, 55) = 0.930002E-01
+PKER_SDRYG( 37, 56) = 0.856646E-01
+PKER_SDRYG( 37, 57) = 0.787788E-01
+PKER_SDRYG( 37, 58) = 0.723653E-01
+PKER_SDRYG( 37, 59) = 0.664358E-01
+PKER_SDRYG( 37, 60) = 0.609872E-01
+PKER_SDRYG( 37, 61) = 0.560001E-01
+PKER_SDRYG( 37, 62) = 0.514432E-01
+PKER_SDRYG( 37, 63) = 0.472782E-01
+PKER_SDRYG( 37, 64) = 0.434648E-01
+PKER_SDRYG( 37, 65) = 0.399644E-01
+PKER_SDRYG( 37, 66) = 0.367420E-01
+PKER_SDRYG( 37, 67) = 0.337668E-01
+PKER_SDRYG( 37, 68) = 0.310124E-01
+PKER_SDRYG( 37, 69) = 0.284563E-01
+PKER_SDRYG( 37, 70) = 0.260793E-01
+PKER_SDRYG( 37, 71) = 0.238651E-01
+PKER_SDRYG( 37, 72) = 0.217997E-01
+PKER_SDRYG( 37, 73) = 0.198713E-01
+PKER_SDRYG( 37, 74) = 0.180696E-01
+PKER_SDRYG( 37, 75) = 0.163859E-01
+PKER_SDRYG( 37, 76) = 0.148129E-01
+PKER_SDRYG( 37, 77) = 0.133450E-01
+PKER_SDRYG( 37, 78) = 0.119777E-01
+PKER_SDRYG( 37, 79) = 0.107079E-01
+PKER_SDRYG( 37, 80) = 0.953408E-02
+PKER_SDRYG( 38, 1) = 0.315085E+01
+PKER_SDRYG( 38, 2) = 0.295834E+01
+PKER_SDRYG( 38, 3) = 0.277757E+01
+PKER_SDRYG( 38, 4) = 0.260784E+01
+PKER_SDRYG( 38, 5) = 0.244846E+01
+PKER_SDRYG( 38, 6) = 0.229880E+01
+PKER_SDRYG( 38, 7) = 0.215828E+01
+PKER_SDRYG( 38, 8) = 0.202633E+01
+PKER_SDRYG( 38, 9) = 0.190243E+01
+PKER_SDRYG( 38, 10) = 0.178609E+01
+PKER_SDRYG( 38, 11) = 0.167685E+01
+PKER_SDRYG( 38, 12) = 0.157427E+01
+PKER_SDRYG( 38, 13) = 0.147795E+01
+PKER_SDRYG( 38, 14) = 0.138751E+01
+PKER_SDRYG( 38, 15) = 0.130259E+01
+PKER_SDRYG( 38, 16) = 0.122285E+01
+PKER_SDRYG( 38, 17) = 0.114798E+01
+PKER_SDRYG( 38, 18) = 0.107767E+01
+PKER_SDRYG( 38, 19) = 0.101165E+01
+PKER_SDRYG( 38, 20) = 0.949660E+00
+PKER_SDRYG( 38, 21) = 0.891452E+00
+PKER_SDRYG( 38, 22) = 0.836795E+00
+PKER_SDRYG( 38, 23) = 0.785472E+00
+PKER_SDRYG( 38, 24) = 0.737279E+00
+PKER_SDRYG( 38, 25) = 0.692026E+00
+PKER_SDRYG( 38, 26) = 0.649533E+00
+PKER_SDRYG( 38, 27) = 0.609632E+00
+PKER_SDRYG( 38, 28) = 0.572163E+00
+PKER_SDRYG( 38, 29) = 0.536978E+00
+PKER_SDRYG( 38, 30) = 0.503937E+00
+PKER_SDRYG( 38, 31) = 0.472910E+00
+PKER_SDRYG( 38, 32) = 0.443772E+00
+PKER_SDRYG( 38, 33) = 0.416408E+00
+PKER_SDRYG( 38, 34) = 0.390708E+00
+PKER_SDRYG( 38, 35) = 0.366570E+00
+PKER_SDRYG( 38, 36) = 0.343898E+00
+PKER_SDRYG( 38, 37) = 0.322600E+00
+PKER_SDRYG( 38, 38) = 0.302592E+00
+PKER_SDRYG( 38, 39) = 0.283791E+00
+PKER_SDRYG( 38, 40) = 0.266123E+00
+PKER_SDRYG( 38, 41) = 0.249515E+00
+PKER_SDRYG( 38, 42) = 0.233898E+00
+PKER_SDRYG( 38, 43) = 0.219208E+00
+PKER_SDRYG( 38, 44) = 0.205383E+00
+PKER_SDRYG( 38, 45) = 0.192364E+00
+PKER_SDRYG( 38, 46) = 0.180094E+00
+PKER_SDRYG( 38, 47) = 0.168518E+00
+PKER_SDRYG( 38, 48) = 0.157584E+00
+PKER_SDRYG( 38, 49) = 0.147240E+00
+PKER_SDRYG( 38, 50) = 0.137437E+00
+PKER_SDRYG( 38, 51) = 0.128131E+00
+PKER_SDRYG( 38, 52) = 0.119279E+00
+PKER_SDRYG( 38, 53) = 0.110847E+00
+PKER_SDRYG( 38, 54) = 0.102812E+00
+PKER_SDRYG( 38, 55) = 0.951603E-01
+PKER_SDRYG( 38, 56) = 0.878956E-01
+PKER_SDRYG( 38, 57) = 0.810320E-01
+PKER_SDRYG( 38, 58) = 0.745909E-01
+PKER_SDRYG( 38, 59) = 0.685921E-01
+PKER_SDRYG( 38, 60) = 0.630462E-01
+PKER_SDRYG( 38, 61) = 0.579494E-01
+PKER_SDRYG( 38, 62) = 0.532834E-01
+PKER_SDRYG( 38, 63) = 0.490188E-01
+PKER_SDRYG( 38, 64) = 0.451197E-01
+PKER_SDRYG( 38, 65) = 0.415486E-01
+PKER_SDRYG( 38, 66) = 0.382697E-01
+PKER_SDRYG( 38, 67) = 0.352502E-01
+PKER_SDRYG( 38, 68) = 0.324616E-01
+PKER_SDRYG( 38, 69) = 0.298793E-01
+PKER_SDRYG( 38, 70) = 0.274823E-01
+PKER_SDRYG( 38, 71) = 0.252528E-01
+PKER_SDRYG( 38, 72) = 0.231754E-01
+PKER_SDRYG( 38, 73) = 0.212373E-01
+PKER_SDRYG( 38, 74) = 0.194269E-01
+PKER_SDRYG( 38, 75) = 0.177345E-01
+PKER_SDRYG( 38, 76) = 0.161517E-01
+PKER_SDRYG( 38, 77) = 0.146709E-01
+PKER_SDRYG( 38, 78) = 0.132861E-01
+PKER_SDRYG( 38, 79) = 0.119920E-01
+PKER_SDRYG( 38, 80) = 0.107845E-01
+PKER_SDRYG( 39, 1) = 0.315147E+01
+PKER_SDRYG( 39, 2) = 0.295896E+01
+PKER_SDRYG( 39, 3) = 0.277819E+01
+PKER_SDRYG( 39, 4) = 0.260845E+01
+PKER_SDRYG( 39, 5) = 0.244907E+01
+PKER_SDRYG( 39, 6) = 0.229942E+01
+PKER_SDRYG( 39, 7) = 0.215889E+01
+PKER_SDRYG( 39, 8) = 0.202694E+01
+PKER_SDRYG( 39, 9) = 0.190304E+01
+PKER_SDRYG( 39, 10) = 0.178670E+01
+PKER_SDRYG( 39, 11) = 0.167746E+01
+PKER_SDRYG( 39, 12) = 0.157489E+01
+PKER_SDRYG( 39, 13) = 0.147857E+01
+PKER_SDRYG( 39, 14) = 0.138813E+01
+PKER_SDRYG( 39, 15) = 0.130321E+01
+PKER_SDRYG( 39, 16) = 0.122347E+01
+PKER_SDRYG( 39, 17) = 0.114859E+01
+PKER_SDRYG( 39, 18) = 0.107829E+01
+PKER_SDRYG( 39, 19) = 0.101227E+01
+PKER_SDRYG( 39, 20) = 0.950279E+00
+PKER_SDRYG( 39, 21) = 0.892072E+00
+PKER_SDRYG( 39, 22) = 0.837415E+00
+PKER_SDRYG( 39, 23) = 0.786093E+00
+PKER_SDRYG( 39, 24) = 0.737901E+00
+PKER_SDRYG( 39, 25) = 0.692649E+00
+PKER_SDRYG( 39, 26) = 0.650158E+00
+PKER_SDRYG( 39, 27) = 0.610257E+00
+PKER_SDRYG( 39, 28) = 0.572790E+00
+PKER_SDRYG( 39, 29) = 0.537608E+00
+PKER_SDRYG( 39, 30) = 0.504570E+00
+PKER_SDRYG( 39, 31) = 0.473545E+00
+PKER_SDRYG( 39, 32) = 0.444411E+00
+PKER_SDRYG( 39, 33) = 0.417051E+00
+PKER_SDRYG( 39, 34) = 0.391357E+00
+PKER_SDRYG( 39, 35) = 0.367225E+00
+PKER_SDRYG( 39, 36) = 0.344561E+00
+PKER_SDRYG( 39, 37) = 0.323272E+00
+PKER_SDRYG( 39, 38) = 0.303274E+00
+PKER_SDRYG( 39, 39) = 0.284487E+00
+PKER_SDRYG( 39, 40) = 0.266835E+00
+PKER_SDRYG( 39, 41) = 0.250245E+00
+PKER_SDRYG( 39, 42) = 0.234652E+00
+PKER_SDRYG( 39, 43) = 0.219989E+00
+PKER_SDRYG( 39, 44) = 0.206198E+00
+PKER_SDRYG( 39, 45) = 0.193218E+00
+PKER_SDRYG( 39, 46) = 0.180996E+00
+PKER_SDRYG( 39, 47) = 0.169478E+00
+PKER_SDRYG( 39, 48) = 0.158613E+00
+PKER_SDRYG( 39, 49) = 0.148351E+00
+PKER_SDRYG( 39, 50) = 0.138645E+00
+PKER_SDRYG( 39, 51) = 0.129448E+00
+PKER_SDRYG( 39, 52) = 0.120720E+00
+PKER_SDRYG( 39, 53) = 0.112420E+00
+PKER_SDRYG( 39, 54) = 0.104517E+00
+PKER_SDRYG( 39, 55) = 0.969883E-01
+PKER_SDRYG( 39, 56) = 0.898223E-01
+PKER_SDRYG( 39, 57) = 0.830208E-01
+PKER_SDRYG( 39, 58) = 0.765970E-01
+PKER_SDRYG( 39, 59) = 0.705698E-01
+PKER_SDRYG( 39, 60) = 0.649571E-01
+PKER_SDRYG( 39, 61) = 0.597681E-01
+PKER_SDRYG( 39, 62) = 0.549988E-01
+PKER_SDRYG( 39, 63) = 0.506318E-01
+PKER_SDRYG( 39, 64) = 0.466394E-01
+PKER_SDRYG( 39, 65) = 0.429883E-01
+PKER_SDRYG( 39, 66) = 0.396433E-01
+PKER_SDRYG( 39, 67) = 0.365711E-01
+PKER_SDRYG( 39, 68) = 0.337413E-01
+PKER_SDRYG( 39, 69) = 0.311271E-01
+PKER_SDRYG( 39, 70) = 0.287058E-01
+PKER_SDRYG( 39, 71) = 0.264578E-01
+PKER_SDRYG( 39, 72) = 0.243664E-01
+PKER_SDRYG( 39, 73) = 0.224176E-01
+PKER_SDRYG( 39, 74) = 0.205989E-01
+PKER_SDRYG( 39, 75) = 0.188998E-01
+PKER_SDRYG( 39, 76) = 0.173110E-01
+PKER_SDRYG( 39, 77) = 0.158243E-01
+PKER_SDRYG( 39, 78) = 0.144326E-01
+PKER_SDRYG( 39, 79) = 0.131297E-01
+PKER_SDRYG( 39, 80) = 0.119101E-01
+PKER_SDRYG( 40, 1) = 0.315200E+01
+PKER_SDRYG( 40, 2) = 0.295948E+01
+PKER_SDRYG( 40, 3) = 0.277872E+01
+PKER_SDRYG( 40, 4) = 0.260898E+01
+PKER_SDRYG( 40, 5) = 0.244960E+01
+PKER_SDRYG( 40, 6) = 0.229994E+01
+PKER_SDRYG( 40, 7) = 0.215942E+01
+PKER_SDRYG( 40, 8) = 0.202747E+01
+PKER_SDRYG( 40, 9) = 0.190357E+01
+PKER_SDRYG( 40, 10) = 0.178723E+01
+PKER_SDRYG( 40, 11) = 0.167799E+01
+PKER_SDRYG( 40, 12) = 0.157542E+01
+PKER_SDRYG( 40, 13) = 0.147910E+01
+PKER_SDRYG( 40, 14) = 0.138866E+01
+PKER_SDRYG( 40, 15) = 0.130374E+01
+PKER_SDRYG( 40, 16) = 0.122400E+01
+PKER_SDRYG( 40, 17) = 0.114912E+01
+PKER_SDRYG( 40, 18) = 0.107882E+01
+PKER_SDRYG( 40, 19) = 0.101280E+01
+PKER_SDRYG( 40, 20) = 0.950809E+00
+PKER_SDRYG( 40, 21) = 0.892602E+00
+PKER_SDRYG( 40, 22) = 0.837945E+00
+PKER_SDRYG( 40, 23) = 0.786624E+00
+PKER_SDRYG( 40, 24) = 0.738433E+00
+PKER_SDRYG( 40, 25) = 0.693182E+00
+PKER_SDRYG( 40, 26) = 0.650691E+00
+PKER_SDRYG( 40, 27) = 0.610792E+00
+PKER_SDRYG( 40, 28) = 0.573327E+00
+PKER_SDRYG( 40, 29) = 0.538146E+00
+PKER_SDRYG( 40, 30) = 0.505110E+00
+PKER_SDRYG( 40, 31) = 0.474088E+00
+PKER_SDRYG( 40, 32) = 0.444957E+00
+PKER_SDRYG( 40, 33) = 0.417600E+00
+PKER_SDRYG( 40, 34) = 0.391910E+00
+PKER_SDRYG( 40, 35) = 0.367783E+00
+PKER_SDRYG( 40, 36) = 0.345124E+00
+PKER_SDRYG( 40, 37) = 0.323843E+00
+PKER_SDRYG( 40, 38) = 0.303853E+00
+PKER_SDRYG( 40, 39) = 0.285076E+00
+PKER_SDRYG( 40, 40) = 0.267436E+00
+PKER_SDRYG( 40, 41) = 0.250861E+00
+PKER_SDRYG( 40, 42) = 0.235285E+00
+PKER_SDRYG( 40, 43) = 0.220643E+00
+PKER_SDRYG( 40, 44) = 0.206877E+00
+PKER_SDRYG( 40, 45) = 0.193928E+00
+PKER_SDRYG( 40, 46) = 0.181743E+00
+PKER_SDRYG( 40, 47) = 0.170269E+00
+PKER_SDRYG( 40, 48) = 0.159457E+00
+PKER_SDRYG( 40, 49) = 0.149258E+00
+PKER_SDRYG( 40, 50) = 0.139627E+00
+PKER_SDRYG( 40, 51) = 0.130518E+00
+PKER_SDRYG( 40, 52) = 0.121890E+00
+PKER_SDRYG( 40, 53) = 0.113703E+00
+PKER_SDRYG( 40, 54) = 0.105920E+00
+PKER_SDRYG( 40, 55) = 0.985112E-01
+PKER_SDRYG( 40, 56) = 0.914559E-01
+PKER_SDRYG( 40, 57) = 0.847430E-01
+PKER_SDRYG( 40, 58) = 0.783738E-01
+PKER_SDRYG( 40, 59) = 0.723597E-01
+PKER_SDRYG( 40, 60) = 0.667182E-01
+PKER_SDRYG( 40, 61) = 0.614651E-01
+PKER_SDRYG( 40, 62) = 0.566085E-01
+PKER_SDRYG( 40, 63) = 0.521442E-01
+PKER_SDRYG( 40, 64) = 0.480558E-01
+PKER_SDRYG( 40, 65) = 0.443173E-01
+PKER_SDRYG( 40, 66) = 0.408974E-01
+PKER_SDRYG( 40, 67) = 0.377635E-01
+PKER_SDRYG( 40, 68) = 0.348844E-01
+PKER_SDRYG( 40, 69) = 0.322318E-01
+PKER_SDRYG( 40, 70) = 0.297808E-01
+PKER_SDRYG( 40, 71) = 0.275102E-01
+PKER_SDRYG( 40, 72) = 0.254017E-01
+PKER_SDRYG( 40, 73) = 0.234398E-01
+PKER_SDRYG( 40, 74) = 0.216113E-01
+PKER_SDRYG( 40, 75) = 0.199047E-01
+PKER_SDRYG( 40, 76) = 0.183101E-01
+PKER_SDRYG( 40, 77) = 0.168188E-01
+PKER_SDRYG( 40, 78) = 0.154231E-01
+PKER_SDRYG( 40, 79) = 0.141161E-01
+PKER_SDRYG( 40, 80) = 0.128918E-01
+END IF
+!
+END SUBROUTINE LIMA_READ_XKER_SDRYG
diff --git a/src/mesonh/micro/lima_read_xker_sweth.f90 b/src/mesonh/micro/lima_read_xker_sweth.f90
new file mode 100644
index 000000000..cfc5ade58
--- /dev/null
+++ b/src/mesonh/micro/lima_read_xker_sweth.f90
@@ -0,0 +1,3337 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 microph 2006/05/18 13:07:25
+!-----------------------------------------------------------------
+! ###########################
+ MODULE MODI_LIMA_READ_XKER_SWETH
+! ###########################
+!
+INTERFACE
+ SUBROUTINE LIMA_READ_XKER_SWETH (KWETLBDAH,KWETLBDAS,KND, &
+ PALPHAH,PNUH,PALPHAS,PNUS,PEHS,PBS,PCH,PDH,PCS,PDS, &
+ PWETLBDAH_MAX,PWETLBDAS_MAX,PWETLBDAH_MIN,PWETLBDAS_MIN, &
+ PFDINFTY,PKER_SWETH )
+!
+INTEGER, INTENT(OUT) :: KND,KWETLBDAH,KWETLBDAS
+REAL, INTENT(OUT) :: PALPHAH
+REAL, INTENT(OUT) :: PNUH
+REAL, INTENT(OUT) :: PALPHAS
+REAL, INTENT(OUT) :: PNUS
+REAL, INTENT(OUT) :: PEHS
+REAL, INTENT(OUT) :: PBS
+REAL, INTENT(OUT) :: PCH
+REAL, INTENT(OUT) :: PDH
+REAL, INTENT(OUT) :: PCS
+REAL, INTENT(OUT) :: PDS
+REAL, INTENT(OUT) :: PWETLBDAH_MAX
+REAL, INTENT(OUT) :: PWETLBDAS_MAX
+REAL, INTENT(OUT) :: PWETLBDAH_MIN
+REAL, INTENT(OUT) :: PWETLBDAS_MIN
+REAL, INTENT(OUT) :: PFDINFTY
+REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_SWETH
+!
+END SUBROUTINE LIMA_READ_XKER_SWETH
+!
+END INTERFACE
+!
+END MODULE MODI_LIMA_READ_XKER_SWETH
+! ########################################################################
+ SUBROUTINE LIMA_READ_XKER_SWETH (KWETLBDAH,KWETLBDAS,KND, &
+ PALPHAH,PNUH,PALPHAS,PNUS,PEHS,PBS,PCH,PDH,PCS,PDS, &
+ PWETLBDAH_MAX,PWETLBDAS_MAX,PWETLBDAH_MIN,PWETLBDAS_MIN, &
+ PFDINFTY,PKER_SWETH )
+! ########################################################################
+!
+!!**** * * - initialize the kernels for the snow-hail wet growth process
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to initialize the kernels PKER_SWETH
+!! prepared from a previous run of the routine INI_RAIN_ICE. The reading
+!! of the kernels is optional after checking for the dimensions of the
+!! arrays.
+!!
+!!** METHOD
+!! ------
+!!
+!!
+!! EXTERNAL
+!! --------
+!! None
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation ( routine READ_XKER_SWETH )
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 19/04/97
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!* 0.2 Declarations of local variables :
+!
+!
+INTEGER, INTENT(OUT) :: KND,KWETLBDAH,KWETLBDAS
+REAL, INTENT(OUT) :: PALPHAH
+REAL, INTENT(OUT) :: PNUH
+REAL, INTENT(OUT) :: PALPHAS
+REAL, INTENT(OUT) :: PNUS
+REAL, INTENT(OUT) :: PEHS
+REAL, INTENT(OUT) :: PBS
+REAL, INTENT(OUT) :: PCH
+REAL, INTENT(OUT) :: PDH
+REAL, INTENT(OUT) :: PCS
+REAL, INTENT(OUT) :: PDS
+REAL, INTENT(OUT) :: PWETLBDAH_MAX
+REAL, INTENT(OUT) :: PWETLBDAS_MAX
+REAL, INTENT(OUT) :: PWETLBDAH_MIN
+REAL, INTENT(OUT) :: PWETLBDAS_MIN
+REAL, INTENT(OUT) :: PFDINFTY
+REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_SWETH
+!
+! ########################################################################
+! #INSERT HERE THE OUTPUT OF INI_RAIN_ICE_HAIL IF THE KERNELS ARE UPDATED#
+! ########################################################################
+!
+KND= 50
+KWETLBDAH= 40
+KWETLBDAS= 80
+PALPHAH= 0.100000E+01
+PNUH= 0.800000E+01
+PALPHAS= 0.100000E+01
+PNUS= 0.100000E+01
+PEHS= 0.100000E+01
+PBS= 0.190000E+01
+PCH= 0.201000E+03
+PDH= 0.640000E+00
+PCS= 0.500000E+01
+PDS= 0.270000E+00
+PWETLBDAH_MAX= 0.100000E+08
+PWETLBDAS_MAX= 0.250000E+10
+PWETLBDAH_MIN= 0.100000E+04
+PWETLBDAS_MIN= 0.250000E+02
+PFDINFTY= 0.200000E+02
+!
+IF( PRESENT(PKER_SWETH) ) THEN
+PKER_SWETH( 1, 1) = 0.594408E+01
+PKER_SWETH( 1, 2) = 0.615804E+01
+PKER_SWETH( 1, 3) = 0.636519E+01
+PKER_SWETH( 1, 4) = 0.656714E+01
+PKER_SWETH( 1, 5) = 0.676556E+01
+PKER_SWETH( 1, 6) = 0.696207E+01
+PKER_SWETH( 1, 7) = 0.715814E+01
+PKER_SWETH( 1, 8) = 0.735491E+01
+PKER_SWETH( 1, 9) = 0.755300E+01
+PKER_SWETH( 1, 10) = 0.775225E+01
+PKER_SWETH( 1, 11) = 0.795159E+01
+PKER_SWETH( 1, 12) = 0.814900E+01
+PKER_SWETH( 1, 13) = 0.834171E+01
+PKER_SWETH( 1, 14) = 0.852662E+01
+PKER_SWETH( 1, 15) = 0.870080E+01
+PKER_SWETH( 1, 16) = 0.886196E+01
+PKER_SWETH( 1, 17) = 0.900870E+01
+PKER_SWETH( 1, 18) = 0.914061E+01
+PKER_SWETH( 1, 19) = 0.925806E+01
+PKER_SWETH( 1, 20) = 0.936202E+01
+PKER_SWETH( 1, 21) = 0.945377E+01
+PKER_SWETH( 1, 22) = 0.953473E+01
+PKER_SWETH( 1, 23) = 0.960629E+01
+PKER_SWETH( 1, 24) = 0.966973E+01
+PKER_SWETH( 1, 25) = 0.972622E+01
+PKER_SWETH( 1, 26) = 0.977674E+01
+PKER_SWETH( 1, 27) = 0.982214E+01
+PKER_SWETH( 1, 28) = 0.986313E+01
+PKER_SWETH( 1, 29) = 0.990032E+01
+PKER_SWETH( 1, 30) = 0.993419E+01
+PKER_SWETH( 1, 31) = 0.996517E+01
+PKER_SWETH( 1, 32) = 0.999360E+01
+PKER_SWETH( 1, 33) = 0.100198E+02
+PKER_SWETH( 1, 34) = 0.100439E+02
+PKER_SWETH( 1, 35) = 0.100663E+02
+PKER_SWETH( 1, 36) = 0.100870E+02
+PKER_SWETH( 1, 37) = 0.101063E+02
+PKER_SWETH( 1, 38) = 0.101243E+02
+PKER_SWETH( 1, 39) = 0.101410E+02
+PKER_SWETH( 1, 40) = 0.101566E+02
+PKER_SWETH( 1, 41) = 0.101711E+02
+PKER_SWETH( 1, 42) = 0.101847E+02
+PKER_SWETH( 1, 43) = 0.101975E+02
+PKER_SWETH( 1, 44) = 0.102094E+02
+PKER_SWETH( 1, 45) = 0.102206E+02
+PKER_SWETH( 1, 46) = 0.102310E+02
+PKER_SWETH( 1, 47) = 0.102408E+02
+PKER_SWETH( 1, 48) = 0.102500E+02
+PKER_SWETH( 1, 49) = 0.102586E+02
+PKER_SWETH( 1, 50) = 0.102667E+02
+PKER_SWETH( 1, 51) = 0.102743E+02
+PKER_SWETH( 1, 52) = 0.102814E+02
+PKER_SWETH( 1, 53) = 0.102880E+02
+PKER_SWETH( 1, 54) = 0.102943E+02
+PKER_SWETH( 1, 55) = 0.103002E+02
+PKER_SWETH( 1, 56) = 0.103057E+02
+PKER_SWETH( 1, 57) = 0.103108E+02
+PKER_SWETH( 1, 58) = 0.103157E+02
+PKER_SWETH( 1, 59) = 0.103203E+02
+PKER_SWETH( 1, 60) = 0.103245E+02
+PKER_SWETH( 1, 61) = 0.103286E+02
+PKER_SWETH( 1, 62) = 0.103323E+02
+PKER_SWETH( 1, 63) = 0.103359E+02
+PKER_SWETH( 1, 64) = 0.103392E+02
+PKER_SWETH( 1, 65) = 0.103423E+02
+PKER_SWETH( 1, 66) = 0.103453E+02
+PKER_SWETH( 1, 67) = 0.103480E+02
+PKER_SWETH( 1, 68) = 0.103506E+02
+PKER_SWETH( 1, 69) = 0.103530E+02
+PKER_SWETH( 1, 70) = 0.103553E+02
+PKER_SWETH( 1, 71) = 0.103574E+02
+PKER_SWETH( 1, 72) = 0.103595E+02
+PKER_SWETH( 1, 73) = 0.103613E+02
+PKER_SWETH( 1, 74) = 0.103631E+02
+PKER_SWETH( 1, 75) = 0.103648E+02
+PKER_SWETH( 1, 76) = 0.103663E+02
+PKER_SWETH( 1, 77) = 0.103678E+02
+PKER_SWETH( 1, 78) = 0.103692E+02
+PKER_SWETH( 1, 79) = 0.103705E+02
+PKER_SWETH( 1, 80) = 0.103717E+02
+PKER_SWETH( 2, 1) = 0.465456E+01
+PKER_SWETH( 2, 2) = 0.486187E+01
+PKER_SWETH( 2, 3) = 0.506117E+01
+PKER_SWETH( 2, 4) = 0.525380E+01
+PKER_SWETH( 2, 5) = 0.544116E+01
+PKER_SWETH( 2, 6) = 0.562472E+01
+PKER_SWETH( 2, 7) = 0.580594E+01
+PKER_SWETH( 2, 8) = 0.598611E+01
+PKER_SWETH( 2, 9) = 0.616626E+01
+PKER_SWETH( 2, 10) = 0.634695E+01
+PKER_SWETH( 2, 11) = 0.652809E+01
+PKER_SWETH( 2, 12) = 0.670877E+01
+PKER_SWETH( 2, 13) = 0.688725E+01
+PKER_SWETH( 2, 14) = 0.706117E+01
+PKER_SWETH( 2, 15) = 0.722787E+01
+PKER_SWETH( 2, 16) = 0.738481E+01
+PKER_SWETH( 2, 17) = 0.753004E+01
+PKER_SWETH( 2, 18) = 0.766237E+01
+PKER_SWETH( 2, 19) = 0.778146E+01
+PKER_SWETH( 2, 20) = 0.788768E+01
+PKER_SWETH( 2, 21) = 0.798187E+01
+PKER_SWETH( 2, 22) = 0.806519E+01
+PKER_SWETH( 2, 23) = 0.813889E+01
+PKER_SWETH( 2, 24) = 0.820419E+01
+PKER_SWETH( 2, 25) = 0.826224E+01
+PKER_SWETH( 2, 26) = 0.831405E+01
+PKER_SWETH( 2, 27) = 0.836050E+01
+PKER_SWETH( 2, 28) = 0.840234E+01
+PKER_SWETH( 2, 29) = 0.844021E+01
+PKER_SWETH( 2, 30) = 0.847462E+01
+PKER_SWETH( 2, 31) = 0.850603E+01
+PKER_SWETH( 2, 32) = 0.853480E+01
+PKER_SWETH( 2, 33) = 0.856125E+01
+PKER_SWETH( 2, 34) = 0.858563E+01
+PKER_SWETH( 2, 35) = 0.860816E+01
+PKER_SWETH( 2, 36) = 0.862904E+01
+PKER_SWETH( 2, 37) = 0.864841E+01
+PKER_SWETH( 2, 38) = 0.866643E+01
+PKER_SWETH( 2, 39) = 0.868321E+01
+PKER_SWETH( 2, 40) = 0.869886E+01
+PKER_SWETH( 2, 41) = 0.871346E+01
+PKER_SWETH( 2, 42) = 0.872711E+01
+PKER_SWETH( 2, 43) = 0.873987E+01
+PKER_SWETH( 2, 44) = 0.875180E+01
+PKER_SWETH( 2, 45) = 0.876298E+01
+PKER_SWETH( 2, 46) = 0.877344E+01
+PKER_SWETH( 2, 47) = 0.878325E+01
+PKER_SWETH( 2, 48) = 0.879244E+01
+PKER_SWETH( 2, 49) = 0.880106E+01
+PKER_SWETH( 2, 50) = 0.880914E+01
+PKER_SWETH( 2, 51) = 0.881672E+01
+PKER_SWETH( 2, 52) = 0.882383E+01
+PKER_SWETH( 2, 53) = 0.883050E+01
+PKER_SWETH( 2, 54) = 0.883676E+01
+PKER_SWETH( 2, 55) = 0.884263E+01
+PKER_SWETH( 2, 56) = 0.884815E+01
+PKER_SWETH( 2, 57) = 0.885332E+01
+PKER_SWETH( 2, 58) = 0.885818E+01
+PKER_SWETH( 2, 59) = 0.886274E+01
+PKER_SWETH( 2, 60) = 0.886702E+01
+PKER_SWETH( 2, 61) = 0.887104E+01
+PKER_SWETH( 2, 62) = 0.887482E+01
+PKER_SWETH( 2, 63) = 0.887836E+01
+PKER_SWETH( 2, 64) = 0.888169E+01
+PKER_SWETH( 2, 65) = 0.888481E+01
+PKER_SWETH( 2, 66) = 0.888774E+01
+PKER_SWETH( 2, 67) = 0.889049E+01
+PKER_SWETH( 2, 68) = 0.889308E+01
+PKER_SWETH( 2, 69) = 0.889551E+01
+PKER_SWETH( 2, 70) = 0.889778E+01
+PKER_SWETH( 2, 71) = 0.889992E+01
+PKER_SWETH( 2, 72) = 0.890193E+01
+PKER_SWETH( 2, 73) = 0.890382E+01
+PKER_SWETH( 2, 74) = 0.890559E+01
+PKER_SWETH( 2, 75) = 0.890725E+01
+PKER_SWETH( 2, 76) = 0.890882E+01
+PKER_SWETH( 2, 77) = 0.891028E+01
+PKER_SWETH( 2, 78) = 0.891166E+01
+PKER_SWETH( 2, 79) = 0.891295E+01
+PKER_SWETH( 2, 80) = 0.891417E+01
+PKER_SWETH( 3, 1) = 0.355241E+01
+PKER_SWETH( 3, 2) = 0.375388E+01
+PKER_SWETH( 3, 3) = 0.394699E+01
+PKER_SWETH( 3, 4) = 0.413258E+01
+PKER_SWETH( 3, 5) = 0.431174E+01
+PKER_SWETH( 3, 6) = 0.448568E+01
+PKER_SWETH( 3, 7) = 0.465567E+01
+PKER_SWETH( 3, 8) = 0.482298E+01
+PKER_SWETH( 3, 9) = 0.498877E+01
+PKER_SWETH( 3, 10) = 0.515397E+01
+PKER_SWETH( 3, 11) = 0.531908E+01
+PKER_SWETH( 3, 12) = 0.548405E+01
+PKER_SWETH( 3, 13) = 0.564811E+01
+PKER_SWETH( 3, 14) = 0.580980E+01
+PKER_SWETH( 3, 15) = 0.596707E+01
+PKER_SWETH( 3, 16) = 0.611763E+01
+PKER_SWETH( 3, 17) = 0.625931E+01
+PKER_SWETH( 3, 18) = 0.639043E+01
+PKER_SWETH( 3, 19) = 0.650999E+01
+PKER_SWETH( 3, 20) = 0.661772E+01
+PKER_SWETH( 3, 21) = 0.671394E+01
+PKER_SWETH( 3, 22) = 0.679944E+01
+PKER_SWETH( 3, 23) = 0.687523E+01
+PKER_SWETH( 3, 24) = 0.694243E+01
+PKER_SWETH( 3, 25) = 0.700212E+01
+PKER_SWETH( 3, 26) = 0.705531E+01
+PKER_SWETH( 3, 27) = 0.710290E+01
+PKER_SWETH( 3, 28) = 0.714567E+01
+PKER_SWETH( 3, 29) = 0.718428E+01
+PKER_SWETH( 3, 30) = 0.721929E+01
+PKER_SWETH( 3, 31) = 0.725118E+01
+PKER_SWETH( 3, 32) = 0.728033E+01
+PKER_SWETH( 3, 33) = 0.730707E+01
+PKER_SWETH( 3, 34) = 0.733169E+01
+PKER_SWETH( 3, 35) = 0.735440E+01
+PKER_SWETH( 3, 36) = 0.737543E+01
+PKER_SWETH( 3, 37) = 0.739492E+01
+PKER_SWETH( 3, 38) = 0.741303E+01
+PKER_SWETH( 3, 39) = 0.742988E+01
+PKER_SWETH( 3, 40) = 0.744559E+01
+PKER_SWETH( 3, 41) = 0.746023E+01
+PKER_SWETH( 3, 42) = 0.747391E+01
+PKER_SWETH( 3, 43) = 0.748670E+01
+PKER_SWETH( 3, 44) = 0.749866E+01
+PKER_SWETH( 3, 45) = 0.750985E+01
+PKER_SWETH( 3, 46) = 0.752033E+01
+PKER_SWETH( 3, 47) = 0.753014E+01
+PKER_SWETH( 3, 48) = 0.753934E+01
+PKER_SWETH( 3, 49) = 0.754797E+01
+PKER_SWETH( 3, 50) = 0.755605E+01
+PKER_SWETH( 3, 51) = 0.756364E+01
+PKER_SWETH( 3, 52) = 0.757075E+01
+PKER_SWETH( 3, 53) = 0.757742E+01
+PKER_SWETH( 3, 54) = 0.758369E+01
+PKER_SWETH( 3, 55) = 0.758956E+01
+PKER_SWETH( 3, 56) = 0.759508E+01
+PKER_SWETH( 3, 57) = 0.760025E+01
+PKER_SWETH( 3, 58) = 0.760511E+01
+PKER_SWETH( 3, 59) = 0.760967E+01
+PKER_SWETH( 3, 60) = 0.761396E+01
+PKER_SWETH( 3, 61) = 0.761798E+01
+PKER_SWETH( 3, 62) = 0.762175E+01
+PKER_SWETH( 3, 63) = 0.762529E+01
+PKER_SWETH( 3, 64) = 0.762862E+01
+PKER_SWETH( 3, 65) = 0.763174E+01
+PKER_SWETH( 3, 66) = 0.763467E+01
+PKER_SWETH( 3, 67) = 0.763743E+01
+PKER_SWETH( 3, 68) = 0.764001E+01
+PKER_SWETH( 3, 69) = 0.764244E+01
+PKER_SWETH( 3, 70) = 0.764472E+01
+PKER_SWETH( 3, 71) = 0.764686E+01
+PKER_SWETH( 3, 72) = 0.764887E+01
+PKER_SWETH( 3, 73) = 0.765075E+01
+PKER_SWETH( 3, 74) = 0.765253E+01
+PKER_SWETH( 3, 75) = 0.765419E+01
+PKER_SWETH( 3, 76) = 0.765575E+01
+PKER_SWETH( 3, 77) = 0.765722E+01
+PKER_SWETH( 3, 78) = 0.765859E+01
+PKER_SWETH( 3, 79) = 0.765989E+01
+PKER_SWETH( 3, 80) = 0.766110E+01
+PKER_SWETH( 4, 1) = 0.261585E+01
+PKER_SWETH( 4, 2) = 0.280948E+01
+PKER_SWETH( 4, 3) = 0.299603E+01
+PKER_SWETH( 4, 4) = 0.317539E+01
+PKER_SWETH( 4, 5) = 0.334799E+01
+PKER_SWETH( 4, 6) = 0.351456E+01
+PKER_SWETH( 4, 7) = 0.367607E+01
+PKER_SWETH( 4, 8) = 0.383360E+01
+PKER_SWETH( 4, 9) = 0.398823E+01
+PKER_SWETH( 4, 10) = 0.414100E+01
+PKER_SWETH( 4, 11) = 0.429270E+01
+PKER_SWETH( 4, 12) = 0.444383E+01
+PKER_SWETH( 4, 13) = 0.459433E+01
+PKER_SWETH( 4, 14) = 0.474359E+01
+PKER_SWETH( 4, 15) = 0.489033E+01
+PKER_SWETH( 4, 16) = 0.503281E+01
+PKER_SWETH( 4, 17) = 0.516906E+01
+PKER_SWETH( 4, 18) = 0.529721E+01
+PKER_SWETH( 4, 19) = 0.541582E+01
+PKER_SWETH( 4, 20) = 0.552404E+01
+PKER_SWETH( 4, 21) = 0.562165E+01
+PKER_SWETH( 4, 22) = 0.570898E+01
+PKER_SWETH( 4, 23) = 0.578673E+01
+PKER_SWETH( 4, 24) = 0.585579E+01
+PKER_SWETH( 4, 25) = 0.591716E+01
+PKER_SWETH( 4, 26) = 0.597181E+01
+PKER_SWETH( 4, 27) = 0.602062E+01
+PKER_SWETH( 4, 28) = 0.606439E+01
+PKER_SWETH( 4, 29) = 0.610382E+01
+PKER_SWETH( 4, 30) = 0.613949E+01
+PKER_SWETH( 4, 31) = 0.617190E+01
+PKER_SWETH( 4, 32) = 0.620147E+01
+PKER_SWETH( 4, 33) = 0.622855E+01
+PKER_SWETH( 4, 34) = 0.625342E+01
+PKER_SWETH( 4, 35) = 0.627635E+01
+PKER_SWETH( 4, 36) = 0.629753E+01
+PKER_SWETH( 4, 37) = 0.631716E+01
+PKER_SWETH( 4, 38) = 0.633537E+01
+PKER_SWETH( 4, 39) = 0.635230E+01
+PKER_SWETH( 4, 40) = 0.636806E+01
+PKER_SWETH( 4, 41) = 0.638276E+01
+PKER_SWETH( 4, 42) = 0.639648E+01
+PKER_SWETH( 4, 43) = 0.640930E+01
+PKER_SWETH( 4, 44) = 0.642128E+01
+PKER_SWETH( 4, 45) = 0.643249E+01
+PKER_SWETH( 4, 46) = 0.644298E+01
+PKER_SWETH( 4, 47) = 0.645281E+01
+PKER_SWETH( 4, 48) = 0.646202E+01
+PKER_SWETH( 4, 49) = 0.647065E+01
+PKER_SWETH( 4, 50) = 0.647874E+01
+PKER_SWETH( 4, 51) = 0.648633E+01
+PKER_SWETH( 4, 52) = 0.649345E+01
+PKER_SWETH( 4, 53) = 0.650012E+01
+PKER_SWETH( 4, 54) = 0.650639E+01
+PKER_SWETH( 4, 55) = 0.651227E+01
+PKER_SWETH( 4, 56) = 0.651778E+01
+PKER_SWETH( 4, 57) = 0.652296E+01
+PKER_SWETH( 4, 58) = 0.652782E+01
+PKER_SWETH( 4, 59) = 0.653238E+01
+PKER_SWETH( 4, 60) = 0.653666E+01
+PKER_SWETH( 4, 61) = 0.654068E+01
+PKER_SWETH( 4, 62) = 0.654446E+01
+PKER_SWETH( 4, 63) = 0.654800E+01
+PKER_SWETH( 4, 64) = 0.655133E+01
+PKER_SWETH( 4, 65) = 0.655445E+01
+PKER_SWETH( 4, 66) = 0.655738E+01
+PKER_SWETH( 4, 67) = 0.656014E+01
+PKER_SWETH( 4, 68) = 0.656272E+01
+PKER_SWETH( 4, 69) = 0.656515E+01
+PKER_SWETH( 4, 70) = 0.656743E+01
+PKER_SWETH( 4, 71) = 0.656957E+01
+PKER_SWETH( 4, 72) = 0.657158E+01
+PKER_SWETH( 4, 73) = 0.657346E+01
+PKER_SWETH( 4, 74) = 0.657524E+01
+PKER_SWETH( 4, 75) = 0.657690E+01
+PKER_SWETH( 4, 76) = 0.657846E+01
+PKER_SWETH( 4, 77) = 0.657993E+01
+PKER_SWETH( 4, 78) = 0.658130E+01
+PKER_SWETH( 4, 79) = 0.658260E+01
+PKER_SWETH( 4, 80) = 0.658381E+01
+PKER_SWETH( 5, 1) = 0.183666E+01
+PKER_SWETH( 5, 2) = 0.201461E+01
+PKER_SWETH( 5, 3) = 0.219011E+01
+PKER_SWETH( 5, 4) = 0.236116E+01
+PKER_SWETH( 5, 5) = 0.252677E+01
+PKER_SWETH( 5, 6) = 0.268674E+01
+PKER_SWETH( 5, 7) = 0.284137E+01
+PKER_SWETH( 5, 8) = 0.299127E+01
+PKER_SWETH( 5, 9) = 0.313728E+01
+PKER_SWETH( 5, 10) = 0.328031E+01
+PKER_SWETH( 5, 11) = 0.342122E+01
+PKER_SWETH( 5, 12) = 0.356074E+01
+PKER_SWETH( 5, 13) = 0.369927E+01
+PKER_SWETH( 5, 14) = 0.383682E+01
+PKER_SWETH( 5, 15) = 0.397284E+01
+PKER_SWETH( 5, 16) = 0.410626E+01
+PKER_SWETH( 5, 17) = 0.423559E+01
+PKER_SWETH( 5, 18) = 0.435911E+01
+PKER_SWETH( 5, 19) = 0.447524E+01
+PKER_SWETH( 5, 20) = 0.458272E+01
+PKER_SWETH( 5, 21) = 0.468086E+01
+PKER_SWETH( 5, 22) = 0.476948E+01
+PKER_SWETH( 5, 23) = 0.484888E+01
+PKER_SWETH( 5, 24) = 0.491969E+01
+PKER_SWETH( 5, 25) = 0.498273E+01
+PKER_SWETH( 5, 26) = 0.503887E+01
+PKER_SWETH( 5, 27) = 0.508897E+01
+PKER_SWETH( 5, 28) = 0.513382E+01
+PKER_SWETH( 5, 29) = 0.517414E+01
+PKER_SWETH( 5, 30) = 0.521054E+01
+PKER_SWETH( 5, 31) = 0.524353E+01
+PKER_SWETH( 5, 32) = 0.527356E+01
+PKER_SWETH( 5, 33) = 0.530100E+01
+PKER_SWETH( 5, 34) = 0.532617E+01
+PKER_SWETH( 5, 35) = 0.534933E+01
+PKER_SWETH( 5, 36) = 0.537069E+01
+PKER_SWETH( 5, 37) = 0.539046E+01
+PKER_SWETH( 5, 38) = 0.540878E+01
+PKER_SWETH( 5, 39) = 0.542580E+01
+PKER_SWETH( 5, 40) = 0.544164E+01
+PKER_SWETH( 5, 41) = 0.545639E+01
+PKER_SWETH( 5, 42) = 0.547015E+01
+PKER_SWETH( 5, 43) = 0.548300E+01
+PKER_SWETH( 5, 44) = 0.549501E+01
+PKER_SWETH( 5, 45) = 0.550624E+01
+PKER_SWETH( 5, 46) = 0.551675E+01
+PKER_SWETH( 5, 47) = 0.552659E+01
+PKER_SWETH( 5, 48) = 0.553581E+01
+PKER_SWETH( 5, 49) = 0.554445E+01
+PKER_SWETH( 5, 50) = 0.555254E+01
+PKER_SWETH( 5, 51) = 0.556014E+01
+PKER_SWETH( 5, 52) = 0.556726E+01
+PKER_SWETH( 5, 53) = 0.557394E+01
+PKER_SWETH( 5, 54) = 0.558021E+01
+PKER_SWETH( 5, 55) = 0.558609E+01
+PKER_SWETH( 5, 56) = 0.559160E+01
+PKER_SWETH( 5, 57) = 0.559678E+01
+PKER_SWETH( 5, 58) = 0.560164E+01
+PKER_SWETH( 5, 59) = 0.560621E+01
+PKER_SWETH( 5, 60) = 0.561049E+01
+PKER_SWETH( 5, 61) = 0.561451E+01
+PKER_SWETH( 5, 62) = 0.561829E+01
+PKER_SWETH( 5, 63) = 0.562183E+01
+PKER_SWETH( 5, 64) = 0.562516E+01
+PKER_SWETH( 5, 65) = 0.562828E+01
+PKER_SWETH( 5, 66) = 0.563121E+01
+PKER_SWETH( 5, 67) = 0.563396E+01
+PKER_SWETH( 5, 68) = 0.563655E+01
+PKER_SWETH( 5, 69) = 0.563898E+01
+PKER_SWETH( 5, 70) = 0.564126E+01
+PKER_SWETH( 5, 71) = 0.564340E+01
+PKER_SWETH( 5, 72) = 0.564540E+01
+PKER_SWETH( 5, 73) = 0.564729E+01
+PKER_SWETH( 5, 74) = 0.564906E+01
+PKER_SWETH( 5, 75) = 0.565073E+01
+PKER_SWETH( 5, 76) = 0.565229E+01
+PKER_SWETH( 5, 77) = 0.565375E+01
+PKER_SWETH( 5, 78) = 0.565513E+01
+PKER_SWETH( 5, 79) = 0.565642E+01
+PKER_SWETH( 5, 80) = 0.565764E+01
+PKER_SWETH( 6, 1) = 0.122732E+01
+PKER_SWETH( 6, 2) = 0.137201E+01
+PKER_SWETH( 6, 3) = 0.152420E+01
+PKER_SWETH( 6, 4) = 0.167900E+01
+PKER_SWETH( 6, 5) = 0.183306E+01
+PKER_SWETH( 6, 6) = 0.198423E+01
+PKER_SWETH( 6, 7) = 0.213147E+01
+PKER_SWETH( 6, 8) = 0.227444E+01
+PKER_SWETH( 6, 9) = 0.241330E+01
+PKER_SWETH( 6, 10) = 0.254856E+01
+PKER_SWETH( 6, 11) = 0.268088E+01
+PKER_SWETH( 6, 12) = 0.281097E+01
+PKER_SWETH( 6, 13) = 0.293942E+01
+PKER_SWETH( 6, 14) = 0.306659E+01
+PKER_SWETH( 6, 15) = 0.319250E+01
+PKER_SWETH( 6, 16) = 0.331667E+01
+PKER_SWETH( 6, 17) = 0.343821E+01
+PKER_SWETH( 6, 18) = 0.355580E+01
+PKER_SWETH( 6, 19) = 0.366800E+01
+PKER_SWETH( 6, 20) = 0.377342E+01
+PKER_SWETH( 6, 21) = 0.387101E+01
+PKER_SWETH( 6, 22) = 0.396016E+01
+PKER_SWETH( 6, 23) = 0.404075E+01
+PKER_SWETH( 6, 24) = 0.411307E+01
+PKER_SWETH( 6, 25) = 0.417768E+01
+PKER_SWETH( 6, 26) = 0.423531E+01
+PKER_SWETH( 6, 27) = 0.428674E+01
+PKER_SWETH( 6, 28) = 0.433274E+01
+PKER_SWETH( 6, 29) = 0.437401E+01
+PKER_SWETH( 6, 30) = 0.441119E+01
+PKER_SWETH( 6, 31) = 0.444482E+01
+PKER_SWETH( 6, 32) = 0.447537E+01
+PKER_SWETH( 6, 33) = 0.450322E+01
+PKER_SWETH( 6, 34) = 0.452871E+01
+PKER_SWETH( 6, 35) = 0.455213E+01
+PKER_SWETH( 6, 36) = 0.457369E+01
+PKER_SWETH( 6, 37) = 0.459362E+01
+PKER_SWETH( 6, 38) = 0.461207E+01
+PKER_SWETH( 6, 39) = 0.462919E+01
+PKER_SWETH( 6, 40) = 0.464510E+01
+PKER_SWETH( 6, 41) = 0.465991E+01
+PKER_SWETH( 6, 42) = 0.467372E+01
+PKER_SWETH( 6, 43) = 0.468661E+01
+PKER_SWETH( 6, 44) = 0.469865E+01
+PKER_SWETH( 6, 45) = 0.470990E+01
+PKER_SWETH( 6, 46) = 0.472043E+01
+PKER_SWETH( 6, 47) = 0.473028E+01
+PKER_SWETH( 6, 48) = 0.473951E+01
+PKER_SWETH( 6, 49) = 0.474816E+01
+PKER_SWETH( 6, 50) = 0.475627E+01
+PKER_SWETH( 6, 51) = 0.476387E+01
+PKER_SWETH( 6, 52) = 0.477099E+01
+PKER_SWETH( 6, 53) = 0.477767E+01
+PKER_SWETH( 6, 54) = 0.478394E+01
+PKER_SWETH( 6, 55) = 0.478983E+01
+PKER_SWETH( 6, 56) = 0.479535E+01
+PKER_SWETH( 6, 57) = 0.480053E+01
+PKER_SWETH( 6, 58) = 0.480539E+01
+PKER_SWETH( 6, 59) = 0.480995E+01
+PKER_SWETH( 6, 60) = 0.481424E+01
+PKER_SWETH( 6, 61) = 0.481826E+01
+PKER_SWETH( 6, 62) = 0.482203E+01
+PKER_SWETH( 6, 63) = 0.482557E+01
+PKER_SWETH( 6, 64) = 0.482890E+01
+PKER_SWETH( 6, 65) = 0.483203E+01
+PKER_SWETH( 6, 66) = 0.483496E+01
+PKER_SWETH( 6, 67) = 0.483771E+01
+PKER_SWETH( 6, 68) = 0.484030E+01
+PKER_SWETH( 6, 69) = 0.484272E+01
+PKER_SWETH( 6, 70) = 0.484500E+01
+PKER_SWETH( 6, 71) = 0.484714E+01
+PKER_SWETH( 6, 72) = 0.484915E+01
+PKER_SWETH( 6, 73) = 0.485104E+01
+PKER_SWETH( 6, 74) = 0.485281E+01
+PKER_SWETH( 6, 75) = 0.485447E+01
+PKER_SWETH( 6, 76) = 0.485604E+01
+PKER_SWETH( 6, 77) = 0.485750E+01
+PKER_SWETH( 6, 78) = 0.485888E+01
+PKER_SWETH( 6, 79) = 0.486017E+01
+PKER_SWETH( 6, 80) = 0.486139E+01
+PKER_SWETH( 7, 1) = 0.820900E+00
+PKER_SWETH( 7, 2) = 0.905506E+00
+PKER_SWETH( 7, 3) = 0.101233E+01
+PKER_SWETH( 7, 4) = 0.113395E+01
+PKER_SWETH( 7, 5) = 0.126438E+01
+PKER_SWETH( 7, 6) = 0.139888E+01
+PKER_SWETH( 7, 7) = 0.153405E+01
+PKER_SWETH( 7, 8) = 0.166779E+01
+PKER_SWETH( 7, 9) = 0.179891E+01
+PKER_SWETH( 7, 10) = 0.192695E+01
+PKER_SWETH( 7, 11) = 0.205196E+01
+PKER_SWETH( 7, 12) = 0.217429E+01
+PKER_SWETH( 7, 13) = 0.229440E+01
+PKER_SWETH( 7, 14) = 0.241276E+01
+PKER_SWETH( 7, 15) = 0.252965E+01
+PKER_SWETH( 7, 16) = 0.264507E+01
+PKER_SWETH( 7, 17) = 0.275862E+01
+PKER_SWETH( 7, 18) = 0.286951E+01
+PKER_SWETH( 7, 19) = 0.297663E+01
+PKER_SWETH( 7, 20) = 0.307872E+01
+PKER_SWETH( 7, 21) = 0.317460E+01
+PKER_SWETH( 7, 22) = 0.326335E+01
+PKER_SWETH( 7, 23) = 0.334449E+01
+PKER_SWETH( 7, 24) = 0.341791E+01
+PKER_SWETH( 7, 25) = 0.348388E+01
+PKER_SWETH( 7, 26) = 0.354293E+01
+PKER_SWETH( 7, 27) = 0.359570E+01
+PKER_SWETH( 7, 28) = 0.364289E+01
+PKER_SWETH( 7, 29) = 0.368518E+01
+PKER_SWETH( 7, 30) = 0.372321E+01
+PKER_SWETH( 7, 31) = 0.375754E+01
+PKER_SWETH( 7, 32) = 0.378865E+01
+PKER_SWETH( 7, 33) = 0.381696E+01
+PKER_SWETH( 7, 34) = 0.384281E+01
+PKER_SWETH( 7, 35) = 0.386651E+01
+PKER_SWETH( 7, 36) = 0.388831E+01
+PKER_SWETH( 7, 37) = 0.390841E+01
+PKER_SWETH( 7, 38) = 0.392700E+01
+PKER_SWETH( 7, 39) = 0.394423E+01
+PKER_SWETH( 7, 40) = 0.396023E+01
+PKER_SWETH( 7, 41) = 0.397511E+01
+PKER_SWETH( 7, 42) = 0.398897E+01
+PKER_SWETH( 7, 43) = 0.400190E+01
+PKER_SWETH( 7, 44) = 0.401397E+01
+PKER_SWETH( 7, 45) = 0.402525E+01
+PKER_SWETH( 7, 46) = 0.403580E+01
+PKER_SWETH( 7, 47) = 0.404567E+01
+PKER_SWETH( 7, 48) = 0.405491E+01
+PKER_SWETH( 7, 49) = 0.406357E+01
+PKER_SWETH( 7, 50) = 0.407168E+01
+PKER_SWETH( 7, 51) = 0.407929E+01
+PKER_SWETH( 7, 52) = 0.408642E+01
+PKER_SWETH( 7, 53) = 0.409310E+01
+PKER_SWETH( 7, 54) = 0.409938E+01
+PKER_SWETH( 7, 55) = 0.410526E+01
+PKER_SWETH( 7, 56) = 0.411078E+01
+PKER_SWETH( 7, 57) = 0.411596E+01
+PKER_SWETH( 7, 58) = 0.412083E+01
+PKER_SWETH( 7, 59) = 0.412539E+01
+PKER_SWETH( 7, 60) = 0.412968E+01
+PKER_SWETH( 7, 61) = 0.413370E+01
+PKER_SWETH( 7, 62) = 0.413747E+01
+PKER_SWETH( 7, 63) = 0.414102E+01
+PKER_SWETH( 7, 64) = 0.414434E+01
+PKER_SWETH( 7, 65) = 0.414747E+01
+PKER_SWETH( 7, 66) = 0.415040E+01
+PKER_SWETH( 7, 67) = 0.415315E+01
+PKER_SWETH( 7, 68) = 0.415574E+01
+PKER_SWETH( 7, 69) = 0.415817E+01
+PKER_SWETH( 7, 70) = 0.416045E+01
+PKER_SWETH( 7, 71) = 0.416259E+01
+PKER_SWETH( 7, 72) = 0.416460E+01
+PKER_SWETH( 7, 73) = 0.416648E+01
+PKER_SWETH( 7, 74) = 0.416825E+01
+PKER_SWETH( 7, 75) = 0.416992E+01
+PKER_SWETH( 7, 76) = 0.417148E+01
+PKER_SWETH( 7, 77) = 0.417294E+01
+PKER_SWETH( 7, 78) = 0.417432E+01
+PKER_SWETH( 7, 79) = 0.417561E+01
+PKER_SWETH( 7, 80) = 0.417683E+01
+PKER_SWETH( 8, 1) = 0.649351E+00
+PKER_SWETH( 8, 2) = 0.650011E+00
+PKER_SWETH( 8, 3) = 0.685517E+00
+PKER_SWETH( 8, 4) = 0.749664E+00
+PKER_SWETH( 8, 5) = 0.835874E+00
+PKER_SWETH( 8, 6) = 0.937419E+00
+PKER_SWETH( 8, 7) = 0.104881E+01
+PKER_SWETH( 8, 8) = 0.116549E+01
+PKER_SWETH( 8, 9) = 0.128413E+01
+PKER_SWETH( 8, 10) = 0.140255E+01
+PKER_SWETH( 8, 11) = 0.151951E+01
+PKER_SWETH( 8, 12) = 0.163444E+01
+PKER_SWETH( 8, 13) = 0.174722E+01
+PKER_SWETH( 8, 14) = 0.185802E+01
+PKER_SWETH( 8, 15) = 0.196710E+01
+PKER_SWETH( 8, 16) = 0.207463E+01
+PKER_SWETH( 8, 17) = 0.218056E+01
+PKER_SWETH( 8, 18) = 0.228455E+01
+PKER_SWETH( 8, 19) = 0.238589E+01
+PKER_SWETH( 8, 20) = 0.248364E+01
+PKER_SWETH( 8, 21) = 0.257669E+01
+PKER_SWETH( 8, 22) = 0.266404E+01
+PKER_SWETH( 8, 23) = 0.274491E+01
+PKER_SWETH( 8, 24) = 0.281887E+01
+PKER_SWETH( 8, 25) = 0.288587E+01
+PKER_SWETH( 8, 26) = 0.294616E+01
+PKER_SWETH( 8, 27) = 0.300021E+01
+PKER_SWETH( 8, 28) = 0.304860E+01
+PKER_SWETH( 8, 29) = 0.309196E+01
+PKER_SWETH( 8, 30) = 0.313090E+01
+PKER_SWETH( 8, 31) = 0.316598E+01
+PKER_SWETH( 8, 32) = 0.319771E+01
+PKER_SWETH( 8, 33) = 0.322652E+01
+PKER_SWETH( 8, 34) = 0.325278E+01
+PKER_SWETH( 8, 35) = 0.327680E+01
+PKER_SWETH( 8, 36) = 0.329884E+01
+PKER_SWETH( 8, 37) = 0.331915E+01
+PKER_SWETH( 8, 38) = 0.333789E+01
+PKER_SWETH( 8, 39) = 0.335525E+01
+PKER_SWETH( 8, 40) = 0.337134E+01
+PKER_SWETH( 8, 41) = 0.338630E+01
+PKER_SWETH( 8, 42) = 0.340022E+01
+PKER_SWETH( 8, 43) = 0.341320E+01
+PKER_SWETH( 8, 44) = 0.342530E+01
+PKER_SWETH( 8, 45) = 0.343661E+01
+PKER_SWETH( 8, 46) = 0.344718E+01
+PKER_SWETH( 8, 47) = 0.345707E+01
+PKER_SWETH( 8, 48) = 0.346633E+01
+PKER_SWETH( 8, 49) = 0.347500E+01
+PKER_SWETH( 8, 50) = 0.348312E+01
+PKER_SWETH( 8, 51) = 0.349073E+01
+PKER_SWETH( 8, 52) = 0.349787E+01
+PKER_SWETH( 8, 53) = 0.350456E+01
+PKER_SWETH( 8, 54) = 0.351083E+01
+PKER_SWETH( 8, 55) = 0.351672E+01
+PKER_SWETH( 8, 56) = 0.352224E+01
+PKER_SWETH( 8, 57) = 0.352743E+01
+PKER_SWETH( 8, 58) = 0.353229E+01
+PKER_SWETH( 8, 59) = 0.353686E+01
+PKER_SWETH( 8, 60) = 0.354114E+01
+PKER_SWETH( 8, 61) = 0.354516E+01
+PKER_SWETH( 8, 62) = 0.354894E+01
+PKER_SWETH( 8, 63) = 0.355249E+01
+PKER_SWETH( 8, 64) = 0.355581E+01
+PKER_SWETH( 8, 65) = 0.355894E+01
+PKER_SWETH( 8, 66) = 0.356187E+01
+PKER_SWETH( 8, 67) = 0.356462E+01
+PKER_SWETH( 8, 68) = 0.356721E+01
+PKER_SWETH( 8, 69) = 0.356964E+01
+PKER_SWETH( 8, 70) = 0.357192E+01
+PKER_SWETH( 8, 71) = 0.357406E+01
+PKER_SWETH( 8, 72) = 0.357606E+01
+PKER_SWETH( 8, 73) = 0.357795E+01
+PKER_SWETH( 8, 74) = 0.357972E+01
+PKER_SWETH( 8, 75) = 0.358139E+01
+PKER_SWETH( 8, 76) = 0.358295E+01
+PKER_SWETH( 8, 77) = 0.358441E+01
+PKER_SWETH( 8, 78) = 0.358579E+01
+PKER_SWETH( 8, 79) = 0.358708E+01
+PKER_SWETH( 8, 80) = 0.358830E+01
+PKER_SWETH( 9, 1) = 0.702519E+00
+PKER_SWETH( 9, 2) = 0.616447E+00
+PKER_SWETH( 9, 3) = 0.568133E+00
+PKER_SWETH( 9, 4) = 0.555691E+00
+PKER_SWETH( 9, 5) = 0.575613E+00
+PKER_SWETH( 9, 6) = 0.622847E+00
+PKER_SWETH( 9, 7) = 0.691366E+00
+PKER_SWETH( 9, 8) = 0.775606E+00
+PKER_SWETH( 9, 9) = 0.870423E+00
+PKER_SWETH( 9, 10) = 0.971456E+00
+PKER_SWETH( 9, 11) = 0.107560E+01
+PKER_SWETH( 9, 12) = 0.118058E+01
+PKER_SWETH( 9, 13) = 0.128511E+01
+PKER_SWETH( 9, 14) = 0.138846E+01
+PKER_SWETH( 9, 15) = 0.149035E+01
+PKER_SWETH( 9, 16) = 0.159076E+01
+PKER_SWETH( 9, 17) = 0.168968E+01
+PKER_SWETH( 9, 18) = 0.178699E+01
+PKER_SWETH( 9, 19) = 0.188233E+01
+PKER_SWETH( 9, 20) = 0.197509E+01
+PKER_SWETH( 9, 21) = 0.206443E+01
+PKER_SWETH( 9, 22) = 0.214939E+01
+PKER_SWETH( 9, 23) = 0.222911E+01
+PKER_SWETH( 9, 24) = 0.230291E+01
+PKER_SWETH( 9, 25) = 0.237045E+01
+PKER_SWETH( 9, 26) = 0.243169E+01
+PKER_SWETH( 9, 27) = 0.248687E+01
+PKER_SWETH( 9, 28) = 0.253642E+01
+PKER_SWETH( 9, 29) = 0.258086E+01
+PKER_SWETH( 9, 30) = 0.262075E+01
+PKER_SWETH( 9, 31) = 0.265665E+01
+PKER_SWETH( 9, 32) = 0.268906E+01
+PKER_SWETH( 9, 33) = 0.271842E+01
+PKER_SWETH( 9, 34) = 0.274512E+01
+PKER_SWETH( 9, 35) = 0.276950E+01
+PKER_SWETH( 9, 36) = 0.279183E+01
+PKER_SWETH( 9, 37) = 0.281235E+01
+PKER_SWETH( 9, 38) = 0.283128E+01
+PKER_SWETH( 9, 39) = 0.284877E+01
+PKER_SWETH( 9, 40) = 0.286497E+01
+PKER_SWETH( 9, 41) = 0.288002E+01
+PKER_SWETH( 9, 42) = 0.289400E+01
+PKER_SWETH( 9, 43) = 0.290703E+01
+PKER_SWETH( 9, 44) = 0.291918E+01
+PKER_SWETH( 9, 45) = 0.293052E+01
+PKER_SWETH( 9, 46) = 0.294112E+01
+PKER_SWETH( 9, 47) = 0.295103E+01
+PKER_SWETH( 9, 48) = 0.296030E+01
+PKER_SWETH( 9, 49) = 0.296898E+01
+PKER_SWETH( 9, 50) = 0.297711E+01
+PKER_SWETH( 9, 51) = 0.298473E+01
+PKER_SWETH( 9, 52) = 0.299187E+01
+PKER_SWETH( 9, 53) = 0.299857E+01
+PKER_SWETH( 9, 54) = 0.300485E+01
+PKER_SWETH( 9, 55) = 0.301074E+01
+PKER_SWETH( 9, 56) = 0.301626E+01
+PKER_SWETH( 9, 57) = 0.302145E+01
+PKER_SWETH( 9, 58) = 0.302631E+01
+PKER_SWETH( 9, 59) = 0.303088E+01
+PKER_SWETH( 9, 60) = 0.303517E+01
+PKER_SWETH( 9, 61) = 0.303919E+01
+PKER_SWETH( 9, 62) = 0.304297E+01
+PKER_SWETH( 9, 63) = 0.304651E+01
+PKER_SWETH( 9, 64) = 0.304984E+01
+PKER_SWETH( 9, 65) = 0.305296E+01
+PKER_SWETH( 9, 66) = 0.305590E+01
+PKER_SWETH( 9, 67) = 0.305865E+01
+PKER_SWETH( 9, 68) = 0.306124E+01
+PKER_SWETH( 9, 69) = 0.306366E+01
+PKER_SWETH( 9, 70) = 0.306594E+01
+PKER_SWETH( 9, 71) = 0.306808E+01
+PKER_SWETH( 9, 72) = 0.307009E+01
+PKER_SWETH( 9, 73) = 0.307198E+01
+PKER_SWETH( 9, 74) = 0.307375E+01
+PKER_SWETH( 9, 75) = 0.307541E+01
+PKER_SWETH( 9, 76) = 0.307697E+01
+PKER_SWETH( 9, 77) = 0.307844E+01
+PKER_SWETH( 9, 78) = 0.307982E+01
+PKER_SWETH( 9, 79) = 0.308111E+01
+PKER_SWETH( 9, 80) = 0.308233E+01
+PKER_SWETH( 10, 1) = 0.910019E+00
+PKER_SWETH( 10, 2) = 0.761058E+00
+PKER_SWETH( 10, 3) = 0.642166E+00
+PKER_SWETH( 10, 4) = 0.555322E+00
+PKER_SWETH( 10, 5) = 0.501395E+00
+PKER_SWETH( 10, 6) = 0.479375E+00
+PKER_SWETH( 10, 7) = 0.486799E+00
+PKER_SWETH( 10, 8) = 0.519678E+00
+PKER_SWETH( 10, 9) = 0.573342E+00
+PKER_SWETH( 10, 10) = 0.642647E+00
+PKER_SWETH( 10, 11) = 0.723043E+00
+PKER_SWETH( 10, 12) = 0.810494E+00
+PKER_SWETH( 10, 13) = 0.901923E+00
+PKER_SWETH( 10, 14) = 0.995138E+00
+PKER_SWETH( 10, 15) = 0.108870E+01
+PKER_SWETH( 10, 16) = 0.118176E+01
+PKER_SWETH( 10, 17) = 0.127386E+01
+PKER_SWETH( 10, 18) = 0.136474E+01
+PKER_SWETH( 10, 19) = 0.145412E+01
+PKER_SWETH( 10, 20) = 0.154161E+01
+PKER_SWETH( 10, 21) = 0.162661E+01
+PKER_SWETH( 10, 22) = 0.170837E+01
+PKER_SWETH( 10, 23) = 0.178607E+01
+PKER_SWETH( 10, 24) = 0.185894E+01
+PKER_SWETH( 10, 25) = 0.192641E+01
+PKER_SWETH( 10, 26) = 0.198818E+01
+PKER_SWETH( 10, 27) = 0.204425E+01
+PKER_SWETH( 10, 28) = 0.209483E+01
+PKER_SWETH( 10, 29) = 0.214031E+01
+PKER_SWETH( 10, 30) = 0.218118E+01
+PKER_SWETH( 10, 31) = 0.221794E+01
+PKER_SWETH( 10, 32) = 0.225107E+01
+PKER_SWETH( 10, 33) = 0.228104E+01
+PKER_SWETH( 10, 34) = 0.230823E+01
+PKER_SWETH( 10, 35) = 0.233301E+01
+PKER_SWETH( 10, 36) = 0.235566E+01
+PKER_SWETH( 10, 37) = 0.237643E+01
+PKER_SWETH( 10, 38) = 0.239556E+01
+PKER_SWETH( 10, 39) = 0.241320E+01
+PKER_SWETH( 10, 40) = 0.242953E+01
+PKER_SWETH( 10, 41) = 0.244467E+01
+PKER_SWETH( 10, 42) = 0.245873E+01
+PKER_SWETH( 10, 43) = 0.247182E+01
+PKER_SWETH( 10, 44) = 0.248402E+01
+PKER_SWETH( 10, 45) = 0.249539E+01
+PKER_SWETH( 10, 46) = 0.250602E+01
+PKER_SWETH( 10, 47) = 0.251595E+01
+PKER_SWETH( 10, 48) = 0.252524E+01
+PKER_SWETH( 10, 49) = 0.253393E+01
+PKER_SWETH( 10, 50) = 0.254208E+01
+PKER_SWETH( 10, 51) = 0.254970E+01
+PKER_SWETH( 10, 52) = 0.255685E+01
+PKER_SWETH( 10, 53) = 0.256355E+01
+PKER_SWETH( 10, 54) = 0.256983E+01
+PKER_SWETH( 10, 55) = 0.257573E+01
+PKER_SWETH( 10, 56) = 0.258126E+01
+PKER_SWETH( 10, 57) = 0.258644E+01
+PKER_SWETH( 10, 58) = 0.259131E+01
+PKER_SWETH( 10, 59) = 0.259588E+01
+PKER_SWETH( 10, 60) = 0.260017E+01
+PKER_SWETH( 10, 61) = 0.260419E+01
+PKER_SWETH( 10, 62) = 0.260797E+01
+PKER_SWETH( 10, 63) = 0.261151E+01
+PKER_SWETH( 10, 64) = 0.261484E+01
+PKER_SWETH( 10, 65) = 0.261796E+01
+PKER_SWETH( 10, 66) = 0.262090E+01
+PKER_SWETH( 10, 67) = 0.262365E+01
+PKER_SWETH( 10, 68) = 0.262624E+01
+PKER_SWETH( 10, 69) = 0.262866E+01
+PKER_SWETH( 10, 70) = 0.263094E+01
+PKER_SWETH( 10, 71) = 0.263308E+01
+PKER_SWETH( 10, 72) = 0.263509E+01
+PKER_SWETH( 10, 73) = 0.263698E+01
+PKER_SWETH( 10, 74) = 0.263875E+01
+PKER_SWETH( 10, 75) = 0.264042E+01
+PKER_SWETH( 10, 76) = 0.264198E+01
+PKER_SWETH( 10, 77) = 0.264344E+01
+PKER_SWETH( 10, 78) = 0.264482E+01
+PKER_SWETH( 10, 79) = 0.264611E+01
+PKER_SWETH( 10, 80) = 0.264733E+01
+PKER_SWETH( 11, 1) = 0.117970E+01
+PKER_SWETH( 11, 2) = 0.999555E+00
+PKER_SWETH( 11, 3) = 0.839382E+00
+PKER_SWETH( 11, 4) = 0.701679E+00
+PKER_SWETH( 11, 5) = 0.588986E+00
+PKER_SWETH( 11, 6) = 0.503339E+00
+PKER_SWETH( 11, 7) = 0.446069E+00
+PKER_SWETH( 11, 8) = 0.417187E+00
+PKER_SWETH( 11, 9) = 0.414688E+00
+PKER_SWETH( 11, 10) = 0.436027E+00
+PKER_SWETH( 11, 11) = 0.477087E+00
+PKER_SWETH( 11, 12) = 0.533660E+00
+PKER_SWETH( 11, 13) = 0.601609E+00
+PKER_SWETH( 11, 14) = 0.677240E+00
+PKER_SWETH( 11, 15) = 0.757583E+00
+PKER_SWETH( 11, 16) = 0.840432E+00
+PKER_SWETH( 11, 17) = 0.924274E+00
+PKER_SWETH( 11, 18) = 0.100809E+01
+PKER_SWETH( 11, 19) = 0.109125E+01
+PKER_SWETH( 11, 20) = 0.117322E+01
+PKER_SWETH( 11, 21) = 0.125348E+01
+PKER_SWETH( 11, 22) = 0.133144E+01
+PKER_SWETH( 11, 23) = 0.140636E+01
+PKER_SWETH( 11, 24) = 0.147751E+01
+PKER_SWETH( 11, 25) = 0.154422E+01
+PKER_SWETH( 11, 26) = 0.160600E+01
+PKER_SWETH( 11, 27) = 0.166258E+01
+PKER_SWETH( 11, 28) = 0.171399E+01
+PKER_SWETH( 11, 29) = 0.176042E+01
+PKER_SWETH( 11, 30) = 0.180224E+01
+PKER_SWETH( 11, 31) = 0.183988E+01
+PKER_SWETH( 11, 32) = 0.187378E+01
+PKER_SWETH( 11, 33) = 0.190440E+01
+PKER_SWETH( 11, 34) = 0.193214E+01
+PKER_SWETH( 11, 35) = 0.195735E+01
+PKER_SWETH( 11, 36) = 0.198036E+01
+PKER_SWETH( 11, 37) = 0.200142E+01
+PKER_SWETH( 11, 38) = 0.202076E+01
+PKER_SWETH( 11, 39) = 0.203859E+01
+PKER_SWETH( 11, 40) = 0.205505E+01
+PKER_SWETH( 11, 41) = 0.207030E+01
+PKER_SWETH( 11, 42) = 0.208445E+01
+PKER_SWETH( 11, 43) = 0.209760E+01
+PKER_SWETH( 11, 44) = 0.210985E+01
+PKER_SWETH( 11, 45) = 0.212127E+01
+PKER_SWETH( 11, 46) = 0.213193E+01
+PKER_SWETH( 11, 47) = 0.214188E+01
+PKER_SWETH( 11, 48) = 0.215119E+01
+PKER_SWETH( 11, 49) = 0.215990E+01
+PKER_SWETH( 11, 50) = 0.216805E+01
+PKER_SWETH( 11, 51) = 0.217569E+01
+PKER_SWETH( 11, 52) = 0.218285E+01
+PKER_SWETH( 11, 53) = 0.218955E+01
+PKER_SWETH( 11, 54) = 0.219584E+01
+PKER_SWETH( 11, 55) = 0.220174E+01
+PKER_SWETH( 11, 56) = 0.220727E+01
+PKER_SWETH( 11, 57) = 0.221246E+01
+PKER_SWETH( 11, 58) = 0.221733E+01
+PKER_SWETH( 11, 59) = 0.222190E+01
+PKER_SWETH( 11, 60) = 0.222618E+01
+PKER_SWETH( 11, 61) = 0.223021E+01
+PKER_SWETH( 11, 62) = 0.223399E+01
+PKER_SWETH( 11, 63) = 0.223753E+01
+PKER_SWETH( 11, 64) = 0.224086E+01
+PKER_SWETH( 11, 65) = 0.224399E+01
+PKER_SWETH( 11, 66) = 0.224692E+01
+PKER_SWETH( 11, 67) = 0.224967E+01
+PKER_SWETH( 11, 68) = 0.225226E+01
+PKER_SWETH( 11, 69) = 0.225469E+01
+PKER_SWETH( 11, 70) = 0.225697E+01
+PKER_SWETH( 11, 71) = 0.225911E+01
+PKER_SWETH( 11, 72) = 0.226112E+01
+PKER_SWETH( 11, 73) = 0.226300E+01
+PKER_SWETH( 11, 74) = 0.226477E+01
+PKER_SWETH( 11, 75) = 0.226644E+01
+PKER_SWETH( 11, 76) = 0.226800E+01
+PKER_SWETH( 11, 77) = 0.226947E+01
+PKER_SWETH( 11, 78) = 0.227084E+01
+PKER_SWETH( 11, 79) = 0.227214E+01
+PKER_SWETH( 11, 80) = 0.227335E+01
+PKER_SWETH( 12, 1) = 0.144652E+01
+PKER_SWETH( 12, 2) = 0.125611E+01
+PKER_SWETH( 12, 3) = 0.107975E+01
+PKER_SWETH( 12, 4) = 0.918380E+00
+PKER_SWETH( 12, 5) = 0.773485E+00
+PKER_SWETH( 12, 6) = 0.647036E+00
+PKER_SWETH( 12, 7) = 0.541359E+00
+PKER_SWETH( 12, 8) = 0.458510E+00
+PKER_SWETH( 12, 9) = 0.399890E+00
+PKER_SWETH( 12, 10) = 0.366094E+00
+PKER_SWETH( 12, 11) = 0.356301E+00
+PKER_SWETH( 12, 12) = 0.368080E+00
+PKER_SWETH( 12, 13) = 0.398694E+00
+PKER_SWETH( 12, 14) = 0.444471E+00
+PKER_SWETH( 12, 15) = 0.501775E+00
+PKER_SWETH( 12, 16) = 0.567143E+00
+PKER_SWETH( 12, 17) = 0.637796E+00
+PKER_SWETH( 12, 18) = 0.711513E+00
+PKER_SWETH( 12, 19) = 0.786658E+00
+PKER_SWETH( 12, 20) = 0.862084E+00
+PKER_SWETH( 12, 21) = 0.936916E+00
+PKER_SWETH( 12, 22) = 0.101042E+01
+PKER_SWETH( 12, 23) = 0.108188E+01
+PKER_SWETH( 12, 24) = 0.115058E+01
+PKER_SWETH( 12, 25) = 0.121581E+01
+PKER_SWETH( 12, 26) = 0.127697E+01
+PKER_SWETH( 12, 27) = 0.133361E+01
+PKER_SWETH( 12, 28) = 0.138552E+01
+PKER_SWETH( 12, 29) = 0.143272E+01
+PKER_SWETH( 12, 30) = 0.147541E+01
+PKER_SWETH( 12, 31) = 0.151391E+01
+PKER_SWETH( 12, 32) = 0.154861E+01
+PKER_SWETH( 12, 33) = 0.157992E+01
+PKER_SWETH( 12, 34) = 0.160825E+01
+PKER_SWETH( 12, 35) = 0.163395E+01
+PKER_SWETH( 12, 36) = 0.165735E+01
+PKER_SWETH( 12, 37) = 0.167873E+01
+PKER_SWETH( 12, 38) = 0.169832E+01
+PKER_SWETH( 12, 39) = 0.171635E+01
+PKER_SWETH( 12, 40) = 0.173297E+01
+PKER_SWETH( 12, 41) = 0.174834E+01
+PKER_SWETH( 12, 42) = 0.176259E+01
+PKER_SWETH( 12, 43) = 0.177582E+01
+PKER_SWETH( 12, 44) = 0.178812E+01
+PKER_SWETH( 12, 45) = 0.179959E+01
+PKER_SWETH( 12, 46) = 0.181028E+01
+PKER_SWETH( 12, 47) = 0.182026E+01
+PKER_SWETH( 12, 48) = 0.182960E+01
+PKER_SWETH( 12, 49) = 0.183832E+01
+PKER_SWETH( 12, 50) = 0.184649E+01
+PKER_SWETH( 12, 51) = 0.185414E+01
+PKER_SWETH( 12, 52) = 0.186130E+01
+PKER_SWETH( 12, 53) = 0.186801E+01
+PKER_SWETH( 12, 54) = 0.187430E+01
+PKER_SWETH( 12, 55) = 0.188021E+01
+PKER_SWETH( 12, 56) = 0.188574E+01
+PKER_SWETH( 12, 57) = 0.189093E+01
+PKER_SWETH( 12, 58) = 0.189580E+01
+PKER_SWETH( 12, 59) = 0.190037E+01
+PKER_SWETH( 12, 60) = 0.190466E+01
+PKER_SWETH( 12, 61) = 0.190869E+01
+PKER_SWETH( 12, 62) = 0.191247E+01
+PKER_SWETH( 12, 63) = 0.191601E+01
+PKER_SWETH( 12, 64) = 0.191934E+01
+PKER_SWETH( 12, 65) = 0.192247E+01
+PKER_SWETH( 12, 66) = 0.192540E+01
+PKER_SWETH( 12, 67) = 0.192815E+01
+PKER_SWETH( 12, 68) = 0.193074E+01
+PKER_SWETH( 12, 69) = 0.193317E+01
+PKER_SWETH( 12, 70) = 0.193545E+01
+PKER_SWETH( 12, 71) = 0.193759E+01
+PKER_SWETH( 12, 72) = 0.193960E+01
+PKER_SWETH( 12, 73) = 0.194149E+01
+PKER_SWETH( 12, 74) = 0.194326E+01
+PKER_SWETH( 12, 75) = 0.194492E+01
+PKER_SWETH( 12, 76) = 0.194648E+01
+PKER_SWETH( 12, 77) = 0.194795E+01
+PKER_SWETH( 12, 78) = 0.194933E+01
+PKER_SWETH( 12, 79) = 0.195062E+01
+PKER_SWETH( 12, 80) = 0.195183E+01
+PKER_SWETH( 13, 1) = 0.168479E+01
+PKER_SWETH( 13, 2) = 0.149223E+01
+PKER_SWETH( 13, 3) = 0.131178E+01
+PKER_SWETH( 13, 4) = 0.114318E+01
+PKER_SWETH( 13, 5) = 0.986502E+00
+PKER_SWETH( 13, 6) = 0.842330E+00
+PKER_SWETH( 13, 7) = 0.711777E+00
+PKER_SWETH( 13, 8) = 0.596438E+00
+PKER_SWETH( 13, 9) = 0.498240E+00
+PKER_SWETH( 13, 10) = 0.419186E+00
+PKER_SWETH( 13, 11) = 0.360884E+00
+PKER_SWETH( 13, 12) = 0.324082E+00
+PKER_SWETH( 13, 13) = 0.308477E+00
+PKER_SWETH( 13, 14) = 0.312993E+00
+PKER_SWETH( 13, 15) = 0.335025E+00
+PKER_SWETH( 13, 16) = 0.371680E+00
+PKER_SWETH( 13, 17) = 0.419845E+00
+PKER_SWETH( 13, 18) = 0.476331E+00
+PKER_SWETH( 13, 19) = 0.538496E+00
+PKER_SWETH( 13, 20) = 0.604102E+00
+PKER_SWETH( 13, 21) = 0.671400E+00
+PKER_SWETH( 13, 22) = 0.739062E+00
+PKER_SWETH( 13, 23) = 0.806033E+00
+PKER_SWETH( 13, 24) = 0.871408E+00
+PKER_SWETH( 13, 25) = 0.934369E+00
+PKER_SWETH( 13, 26) = 0.994201E+00
+PKER_SWETH( 13, 27) = 0.105032E+01
+PKER_SWETH( 13, 28) = 0.110232E+01
+PKER_SWETH( 13, 29) = 0.115001E+01
+PKER_SWETH( 13, 30) = 0.119341E+01
+PKER_SWETH( 13, 31) = 0.123271E+01
+PKER_SWETH( 13, 32) = 0.126820E+01
+PKER_SWETH( 13, 33) = 0.130023E+01
+PKER_SWETH( 13, 34) = 0.132918E+01
+PKER_SWETH( 13, 35) = 0.135541E+01
+PKER_SWETH( 13, 36) = 0.137925E+01
+PKER_SWETH( 13, 37) = 0.140098E+01
+PKER_SWETH( 13, 38) = 0.142086E+01
+PKER_SWETH( 13, 39) = 0.143911E+01
+PKER_SWETH( 13, 40) = 0.145591E+01
+PKER_SWETH( 13, 41) = 0.147142E+01
+PKER_SWETH( 13, 42) = 0.148578E+01
+PKER_SWETH( 13, 43) = 0.149910E+01
+PKER_SWETH( 13, 44) = 0.151147E+01
+PKER_SWETH( 13, 45) = 0.152298E+01
+PKER_SWETH( 13, 46) = 0.153372E+01
+PKER_SWETH( 13, 47) = 0.154373E+01
+PKER_SWETH( 13, 48) = 0.155309E+01
+PKER_SWETH( 13, 49) = 0.156184E+01
+PKER_SWETH( 13, 50) = 0.157002E+01
+PKER_SWETH( 13, 51) = 0.157768E+01
+PKER_SWETH( 13, 52) = 0.158485E+01
+PKER_SWETH( 13, 53) = 0.159157E+01
+PKER_SWETH( 13, 54) = 0.159787E+01
+PKER_SWETH( 13, 55) = 0.160377E+01
+PKER_SWETH( 13, 56) = 0.160931E+01
+PKER_SWETH( 13, 57) = 0.161451E+01
+PKER_SWETH( 13, 58) = 0.161938E+01
+PKER_SWETH( 13, 59) = 0.162395E+01
+PKER_SWETH( 13, 60) = 0.162824E+01
+PKER_SWETH( 13, 61) = 0.163227E+01
+PKER_SWETH( 13, 62) = 0.163605E+01
+PKER_SWETH( 13, 63) = 0.163959E+01
+PKER_SWETH( 13, 64) = 0.164292E+01
+PKER_SWETH( 13, 65) = 0.164605E+01
+PKER_SWETH( 13, 66) = 0.164898E+01
+PKER_SWETH( 13, 67) = 0.165174E+01
+PKER_SWETH( 13, 68) = 0.165432E+01
+PKER_SWETH( 13, 69) = 0.165675E+01
+PKER_SWETH( 13, 70) = 0.165903E+01
+PKER_SWETH( 13, 71) = 0.166117E+01
+PKER_SWETH( 13, 72) = 0.166318E+01
+PKER_SWETH( 13, 73) = 0.166507E+01
+PKER_SWETH( 13, 74) = 0.166684E+01
+PKER_SWETH( 13, 75) = 0.166850E+01
+PKER_SWETH( 13, 76) = 0.167007E+01
+PKER_SWETH( 13, 77) = 0.167153E+01
+PKER_SWETH( 13, 78) = 0.167291E+01
+PKER_SWETH( 13, 79) = 0.167420E+01
+PKER_SWETH( 13, 80) = 0.167542E+01
+PKER_SWETH( 14, 1) = 0.189106E+01
+PKER_SWETH( 14, 2) = 0.169828E+01
+PKER_SWETH( 14, 3) = 0.151724E+01
+PKER_SWETH( 14, 4) = 0.134728E+01
+PKER_SWETH( 14, 5) = 0.118787E+01
+PKER_SWETH( 14, 6) = 0.103869E+01
+PKER_SWETH( 14, 7) = 0.899664E+00
+PKER_SWETH( 14, 8) = 0.771152E+00
+PKER_SWETH( 14, 9) = 0.653915E+00
+PKER_SWETH( 14, 10) = 0.549229E+00
+PKER_SWETH( 14, 11) = 0.458726E+00
+PKER_SWETH( 14, 12) = 0.384162E+00
+PKER_SWETH( 14, 13) = 0.327214E+00
+PKER_SWETH( 14, 14) = 0.288898E+00
+PKER_SWETH( 14, 15) = 0.269417E+00
+PKER_SWETH( 14, 16) = 0.268018E+00
+PKER_SWETH( 14, 17) = 0.283099E+00
+PKER_SWETH( 14, 18) = 0.312281E+00
+PKER_SWETH( 14, 19) = 0.352665E+00
+PKER_SWETH( 14, 20) = 0.401510E+00
+PKER_SWETH( 14, 21) = 0.456229E+00
+PKER_SWETH( 14, 22) = 0.514536E+00
+PKER_SWETH( 14, 23) = 0.574635E+00
+PKER_SWETH( 14, 24) = 0.635018E+00
+PKER_SWETH( 14, 25) = 0.694493E+00
+PKER_SWETH( 14, 26) = 0.752055E+00
+PKER_SWETH( 14, 27) = 0.806900E+00
+PKER_SWETH( 14, 28) = 0.858415E+00
+PKER_SWETH( 14, 29) = 0.906197E+00
+PKER_SWETH( 14, 30) = 0.950060E+00
+PKER_SWETH( 14, 31) = 0.990018E+00
+PKER_SWETH( 14, 32) = 0.102624E+01
+PKER_SWETH( 14, 33) = 0.105899E+01
+PKER_SWETH( 14, 34) = 0.108860E+01
+PKER_SWETH( 14, 35) = 0.111540E+01
+PKER_SWETH( 14, 36) = 0.113971E+01
+PKER_SWETH( 14, 37) = 0.116183E+01
+PKER_SWETH( 14, 38) = 0.118203E+01
+PKER_SWETH( 14, 39) = 0.120054E+01
+PKER_SWETH( 14, 40) = 0.121754E+01
+PKER_SWETH( 14, 41) = 0.123321E+01
+PKER_SWETH( 14, 42) = 0.124769E+01
+PKER_SWETH( 14, 43) = 0.126111E+01
+PKER_SWETH( 14, 44) = 0.127356E+01
+PKER_SWETH( 14, 45) = 0.128513E+01
+PKER_SWETH( 14, 46) = 0.129591E+01
+PKER_SWETH( 14, 47) = 0.130596E+01
+PKER_SWETH( 14, 48) = 0.131535E+01
+PKER_SWETH( 14, 49) = 0.132412E+01
+PKER_SWETH( 14, 50) = 0.133232E+01
+PKER_SWETH( 14, 51) = 0.133999E+01
+PKER_SWETH( 14, 52) = 0.134717E+01
+PKER_SWETH( 14, 53) = 0.135390E+01
+PKER_SWETH( 14, 54) = 0.136020E+01
+PKER_SWETH( 14, 55) = 0.136611E+01
+PKER_SWETH( 14, 56) = 0.137166E+01
+PKER_SWETH( 14, 57) = 0.137685E+01
+PKER_SWETH( 14, 58) = 0.138173E+01
+PKER_SWETH( 14, 59) = 0.138630E+01
+PKER_SWETH( 14, 60) = 0.139059E+01
+PKER_SWETH( 14, 61) = 0.139462E+01
+PKER_SWETH( 14, 62) = 0.139840E+01
+PKER_SWETH( 14, 63) = 0.140195E+01
+PKER_SWETH( 14, 64) = 0.140528E+01
+PKER_SWETH( 14, 65) = 0.140841E+01
+PKER_SWETH( 14, 66) = 0.141134E+01
+PKER_SWETH( 14, 67) = 0.141410E+01
+PKER_SWETH( 14, 68) = 0.141668E+01
+PKER_SWETH( 14, 69) = 0.141911E+01
+PKER_SWETH( 14, 70) = 0.142139E+01
+PKER_SWETH( 14, 71) = 0.142353E+01
+PKER_SWETH( 14, 72) = 0.142554E+01
+PKER_SWETH( 14, 73) = 0.142743E+01
+PKER_SWETH( 14, 74) = 0.142920E+01
+PKER_SWETH( 14, 75) = 0.143086E+01
+PKER_SWETH( 14, 76) = 0.143242E+01
+PKER_SWETH( 14, 77) = 0.143389E+01
+PKER_SWETH( 14, 78) = 0.143527E+01
+PKER_SWETH( 14, 79) = 0.143656E+01
+PKER_SWETH( 14, 80) = 0.143777E+01
+PKER_SWETH( 15, 1) = 0.206851E+01
+PKER_SWETH( 15, 2) = 0.187578E+01
+PKER_SWETH( 15, 3) = 0.169474E+01
+PKER_SWETH( 15, 4) = 0.152469E+01
+PKER_SWETH( 15, 5) = 0.136497E+01
+PKER_SWETH( 15, 6) = 0.121496E+01
+PKER_SWETH( 15, 7) = 0.107417E+01
+PKER_SWETH( 15, 8) = 0.942229E+00
+PKER_SWETH( 15, 9) = 0.818993E+00
+PKER_SWETH( 15, 10) = 0.704619E+00
+PKER_SWETH( 15, 11) = 0.599635E+00
+PKER_SWETH( 15, 12) = 0.505012E+00
+PKER_SWETH( 15, 13) = 0.422101E+00
+PKER_SWETH( 15, 14) = 0.352467E+00
+PKER_SWETH( 15, 15) = 0.297703E+00
+PKER_SWETH( 15, 16) = 0.258998E+00
+PKER_SWETH( 15, 17) = 0.236959E+00
+PKER_SWETH( 15, 18) = 0.231267E+00
+PKER_SWETH( 15, 19) = 0.240828E+00
+PKER_SWETH( 15, 20) = 0.263715E+00
+PKER_SWETH( 15, 21) = 0.297593E+00
+PKER_SWETH( 15, 22) = 0.339817E+00
+PKER_SWETH( 15, 23) = 0.387934E+00
+PKER_SWETH( 15, 24) = 0.439655E+00
+PKER_SWETH( 15, 25) = 0.493057E+00
+PKER_SWETH( 15, 26) = 0.546554E+00
+PKER_SWETH( 15, 27) = 0.598863E+00
+PKER_SWETH( 15, 28) = 0.648998E+00
+PKER_SWETH( 15, 29) = 0.696248E+00
+PKER_SWETH( 15, 30) = 0.740165E+00
+PKER_SWETH( 15, 31) = 0.780538E+00
+PKER_SWETH( 15, 32) = 0.817363E+00
+PKER_SWETH( 15, 33) = 0.850785E+00
+PKER_SWETH( 15, 34) = 0.881046E+00
+PKER_SWETH( 15, 35) = 0.908438E+00
+PKER_SWETH( 15, 36) = 0.933267E+00
+PKER_SWETH( 15, 37) = 0.955825E+00
+PKER_SWETH( 15, 38) = 0.976380E+00
+PKER_SWETH( 15, 39) = 0.995170E+00
+PKER_SWETH( 15, 40) = 0.101240E+01
+PKER_SWETH( 15, 41) = 0.102825E+01
+PKER_SWETH( 15, 42) = 0.104288E+01
+PKER_SWETH( 15, 43) = 0.105640E+01
+PKER_SWETH( 15, 44) = 0.106894E+01
+PKER_SWETH( 15, 45) = 0.108059E+01
+PKER_SWETH( 15, 46) = 0.109142E+01
+PKER_SWETH( 15, 47) = 0.110151E+01
+PKER_SWETH( 15, 48) = 0.111093E+01
+PKER_SWETH( 15, 49) = 0.111972E+01
+PKER_SWETH( 15, 50) = 0.112794E+01
+PKER_SWETH( 15, 51) = 0.113563E+01
+PKER_SWETH( 15, 52) = 0.114282E+01
+PKER_SWETH( 15, 53) = 0.114956E+01
+PKER_SWETH( 15, 54) = 0.115587E+01
+PKER_SWETH( 15, 55) = 0.116179E+01
+PKER_SWETH( 15, 56) = 0.116733E+01
+PKER_SWETH( 15, 57) = 0.117253E+01
+PKER_SWETH( 15, 58) = 0.117741E+01
+PKER_SWETH( 15, 59) = 0.118199E+01
+PKER_SWETH( 15, 60) = 0.118628E+01
+PKER_SWETH( 15, 61) = 0.119031E+01
+PKER_SWETH( 15, 62) = 0.119409E+01
+PKER_SWETH( 15, 63) = 0.119764E+01
+PKER_SWETH( 15, 64) = 0.120097E+01
+PKER_SWETH( 15, 65) = 0.120410E+01
+PKER_SWETH( 15, 66) = 0.120703E+01
+PKER_SWETH( 15, 67) = 0.120979E+01
+PKER_SWETH( 15, 68) = 0.121237E+01
+PKER_SWETH( 15, 69) = 0.121480E+01
+PKER_SWETH( 15, 70) = 0.121708E+01
+PKER_SWETH( 15, 71) = 0.121922E+01
+PKER_SWETH( 15, 72) = 0.122123E+01
+PKER_SWETH( 15, 73) = 0.122312E+01
+PKER_SWETH( 15, 74) = 0.122489E+01
+PKER_SWETH( 15, 75) = 0.122656E+01
+PKER_SWETH( 15, 76) = 0.122812E+01
+PKER_SWETH( 15, 77) = 0.122958E+01
+PKER_SWETH( 15, 78) = 0.123096E+01
+PKER_SWETH( 15, 79) = 0.123225E+01
+PKER_SWETH( 15, 80) = 0.123347E+01
+PKER_SWETH( 16, 1) = 0.222105E+01
+PKER_SWETH( 16, 2) = 0.202837E+01
+PKER_SWETH( 16, 3) = 0.184739E+01
+PKER_SWETH( 16, 4) = 0.167741E+01
+PKER_SWETH( 16, 5) = 0.151773E+01
+PKER_SWETH( 16, 6) = 0.136773E+01
+PKER_SWETH( 16, 7) = 0.122679E+01
+PKER_SWETH( 16, 8) = 0.109439E+01
+PKER_SWETH( 16, 9) = 0.970044E+00
+PKER_SWETH( 16, 10) = 0.853387E+00
+PKER_SWETH( 16, 11) = 0.744213E+00
+PKER_SWETH( 16, 12) = 0.642547E+00
+PKER_SWETH( 16, 13) = 0.548734E+00
+PKER_SWETH( 16, 14) = 0.463499E+00
+PKER_SWETH( 16, 15) = 0.387925E+00
+PKER_SWETH( 16, 16) = 0.323415E+00
+PKER_SWETH( 16, 17) = 0.271432E+00
+PKER_SWETH( 16, 18) = 0.233220E+00
+PKER_SWETH( 16, 19) = 0.209657E+00
+PKER_SWETH( 16, 20) = 0.200923E+00
+PKER_SWETH( 16, 21) = 0.206127E+00
+PKER_SWETH( 16, 22) = 0.223993E+00
+PKER_SWETH( 16, 23) = 0.252341E+00
+PKER_SWETH( 16, 24) = 0.288839E+00
+PKER_SWETH( 16, 25) = 0.331067E+00
+PKER_SWETH( 16, 26) = 0.376740E+00
+PKER_SWETH( 16, 27) = 0.423873E+00
+PKER_SWETH( 16, 28) = 0.470831E+00
+PKER_SWETH( 16, 29) = 0.516360E+00
+PKER_SWETH( 16, 30) = 0.559563E+00
+PKER_SWETH( 16, 31) = 0.599884E+00
+PKER_SWETH( 16, 32) = 0.637048E+00
+PKER_SWETH( 16, 33) = 0.671007E+00
+PKER_SWETH( 16, 34) = 0.701874E+00
+PKER_SWETH( 16, 35) = 0.729862E+00
+PKER_SWETH( 16, 36) = 0.755230E+00
+PKER_SWETH( 16, 37) = 0.778255E+00
+PKER_SWETH( 16, 38) = 0.799202E+00
+PKER_SWETH( 16, 39) = 0.818313E+00
+PKER_SWETH( 16, 40) = 0.835804E+00
+PKER_SWETH( 16, 41) = 0.851863E+00
+PKER_SWETH( 16, 42) = 0.866650E+00
+PKER_SWETH( 16, 43) = 0.880303E+00
+PKER_SWETH( 16, 44) = 0.892941E+00
+PKER_SWETH( 16, 45) = 0.904664E+00
+PKER_SWETH( 16, 46) = 0.915558E+00
+PKER_SWETH( 16, 47) = 0.925699E+00
+PKER_SWETH( 16, 48) = 0.935152E+00
+PKER_SWETH( 16, 49) = 0.943974E+00
+PKER_SWETH( 16, 50) = 0.952215E+00
+PKER_SWETH( 16, 51) = 0.959919E+00
+PKER_SWETH( 16, 52) = 0.967128E+00
+PKER_SWETH( 16, 53) = 0.973876E+00
+PKER_SWETH( 16, 54) = 0.980196E+00
+PKER_SWETH( 16, 55) = 0.986118E+00
+PKER_SWETH( 16, 56) = 0.991669E+00
+PKER_SWETH( 16, 57) = 0.996874E+00
+PKER_SWETH( 16, 58) = 0.100175E+01
+PKER_SWETH( 16, 59) = 0.100633E+01
+PKER_SWETH( 16, 60) = 0.101063E+01
+PKER_SWETH( 16, 61) = 0.101466E+01
+PKER_SWETH( 16, 62) = 0.101844E+01
+PKER_SWETH( 16, 63) = 0.102199E+01
+PKER_SWETH( 16, 64) = 0.102532E+01
+PKER_SWETH( 16, 65) = 0.102845E+01
+PKER_SWETH( 16, 66) = 0.103138E+01
+PKER_SWETH( 16, 67) = 0.103414E+01
+PKER_SWETH( 16, 68) = 0.103673E+01
+PKER_SWETH( 16, 69) = 0.103916E+01
+PKER_SWETH( 16, 70) = 0.104144E+01
+PKER_SWETH( 16, 71) = 0.104358E+01
+PKER_SWETH( 16, 72) = 0.104559E+01
+PKER_SWETH( 16, 73) = 0.104747E+01
+PKER_SWETH( 16, 74) = 0.104925E+01
+PKER_SWETH( 16, 75) = 0.105091E+01
+PKER_SWETH( 16, 76) = 0.105247E+01
+PKER_SWETH( 16, 77) = 0.105394E+01
+PKER_SWETH( 16, 78) = 0.105531E+01
+PKER_SWETH( 16, 79) = 0.105661E+01
+PKER_SWETH( 16, 80) = 0.105782E+01
+PKER_SWETH( 17, 1) = 0.235216E+01
+PKER_SWETH( 17, 2) = 0.215952E+01
+PKER_SWETH( 17, 3) = 0.197860E+01
+PKER_SWETH( 17, 4) = 0.180867E+01
+PKER_SWETH( 17, 5) = 0.164907E+01
+PKER_SWETH( 17, 6) = 0.149914E+01
+PKER_SWETH( 17, 7) = 0.135829E+01
+PKER_SWETH( 17, 8) = 0.122594E+01
+PKER_SWETH( 17, 9) = 0.110158E+01
+PKER_SWETH( 17, 10) = 0.984701E+00
+PKER_SWETH( 17, 11) = 0.874876E+00
+PKER_SWETH( 17, 12) = 0.771739E+00
+PKER_SWETH( 17, 13) = 0.675054E+00
+PKER_SWETH( 17, 14) = 0.584764E+00
+PKER_SWETH( 17, 15) = 0.501058E+00
+PKER_SWETH( 17, 16) = 0.424483E+00
+PKER_SWETH( 17, 17) = 0.355906E+00
+PKER_SWETH( 17, 18) = 0.296493E+00
+PKER_SWETH( 17, 19) = 0.247642E+00
+PKER_SWETH( 17, 20) = 0.210649E+00
+PKER_SWETH( 17, 21) = 0.186453E+00
+PKER_SWETH( 17, 22) = 0.175549E+00
+PKER_SWETH( 17, 23) = 0.177592E+00
+PKER_SWETH( 17, 24) = 0.191285E+00
+PKER_SWETH( 17, 25) = 0.215005E+00
+PKER_SWETH( 17, 26) = 0.246505E+00
+PKER_SWETH( 17, 27) = 0.283441E+00
+PKER_SWETH( 17, 28) = 0.323511E+00
+PKER_SWETH( 17, 29) = 0.364750E+00
+PKER_SWETH( 17, 30) = 0.405561E+00
+PKER_SWETH( 17, 31) = 0.444783E+00
+PKER_SWETH( 17, 32) = 0.481674E+00
+PKER_SWETH( 17, 33) = 0.515838E+00
+PKER_SWETH( 17, 34) = 0.547151E+00
+PKER_SWETH( 17, 35) = 0.575673E+00
+PKER_SWETH( 17, 36) = 0.601576E+00
+PKER_SWETH( 17, 37) = 0.625091E+00
+PKER_SWETH( 17, 38) = 0.646461E+00
+PKER_SWETH( 17, 39) = 0.665927E+00
+PKER_SWETH( 17, 40) = 0.683709E+00
+PKER_SWETH( 17, 41) = 0.700001E+00
+PKER_SWETH( 17, 42) = 0.714974E+00
+PKER_SWETH( 17, 43) = 0.728775E+00
+PKER_SWETH( 17, 44) = 0.741528E+00
+PKER_SWETH( 17, 45) = 0.753341E+00
+PKER_SWETH( 17, 46) = 0.764305E+00
+PKER_SWETH( 17, 47) = 0.774501E+00
+PKER_SWETH( 17, 48) = 0.783997E+00
+PKER_SWETH( 17, 49) = 0.792851E+00
+PKER_SWETH( 17, 50) = 0.801118E+00
+PKER_SWETH( 17, 51) = 0.808842E+00
+PKER_SWETH( 17, 52) = 0.816066E+00
+PKER_SWETH( 17, 53) = 0.822826E+00
+PKER_SWETH( 17, 54) = 0.829156E+00
+PKER_SWETH( 17, 55) = 0.835085E+00
+PKER_SWETH( 17, 56) = 0.840642E+00
+PKER_SWETH( 17, 57) = 0.845851E+00
+PKER_SWETH( 17, 58) = 0.850735E+00
+PKER_SWETH( 17, 59) = 0.855316E+00
+PKER_SWETH( 17, 60) = 0.859613E+00
+PKER_SWETH( 17, 61) = 0.863645E+00
+PKER_SWETH( 17, 62) = 0.867428E+00
+PKER_SWETH( 17, 63) = 0.870979E+00
+PKER_SWETH( 17, 64) = 0.874311E+00
+PKER_SWETH( 17, 65) = 0.877439E+00
+PKER_SWETH( 17, 66) = 0.880375E+00
+PKER_SWETH( 17, 67) = 0.883131E+00
+PKER_SWETH( 17, 68) = 0.885718E+00
+PKER_SWETH( 17, 69) = 0.888147E+00
+PKER_SWETH( 17, 70) = 0.890427E+00
+PKER_SWETH( 17, 71) = 0.892568E+00
+PKER_SWETH( 17, 72) = 0.894578E+00
+PKER_SWETH( 17, 73) = 0.896465E+00
+PKER_SWETH( 17, 74) = 0.898237E+00
+PKER_SWETH( 17, 75) = 0.899901E+00
+PKER_SWETH( 17, 76) = 0.901463E+00
+PKER_SWETH( 17, 77) = 0.902929E+00
+PKER_SWETH( 17, 78) = 0.904307E+00
+PKER_SWETH( 17, 79) = 0.905600E+00
+PKER_SWETH( 17, 80) = 0.906814E+00
+PKER_SWETH( 18, 1) = 0.246485E+01
+PKER_SWETH( 18, 2) = 0.227225E+01
+PKER_SWETH( 18, 3) = 0.209136E+01
+PKER_SWETH( 18, 4) = 0.192149E+01
+PKER_SWETH( 18, 5) = 0.176194E+01
+PKER_SWETH( 18, 6) = 0.161208E+01
+PKER_SWETH( 18, 7) = 0.147130E+01
+PKER_SWETH( 18, 8) = 0.133905E+01
+PKER_SWETH( 18, 9) = 0.121479E+01
+PKER_SWETH( 18, 10) = 0.109802E+01
+PKER_SWETH( 18, 11) = 0.988254E+00
+PKER_SWETH( 18, 12) = 0.885064E+00
+PKER_SWETH( 18, 13) = 0.788046E+00
+PKER_SWETH( 18, 14) = 0.696856E+00
+PKER_SWETH( 18, 15) = 0.611240E+00
+PKER_SWETH( 18, 16) = 0.531085E+00
+PKER_SWETH( 18, 17) = 0.456489E+00
+PKER_SWETH( 18, 18) = 0.387822E+00
+PKER_SWETH( 18, 19) = 0.325787E+00
+PKER_SWETH( 18, 20) = 0.271388E+00
+PKER_SWETH( 18, 21) = 0.225865E+00
+PKER_SWETH( 18, 22) = 0.190524E+00
+PKER_SWETH( 18, 23) = 0.166451E+00
+PKER_SWETH( 18, 24) = 0.154224E+00
+PKER_SWETH( 18, 25) = 0.153728E+00
+PKER_SWETH( 18, 26) = 0.164235E+00
+PKER_SWETH( 18, 27) = 0.184044E+00
+PKER_SWETH( 18, 28) = 0.211126E+00
+PKER_SWETH( 18, 29) = 0.243228E+00
+PKER_SWETH( 18, 30) = 0.278092E+00
+PKER_SWETH( 18, 31) = 0.313828E+00
+PKER_SWETH( 18, 32) = 0.348949E+00
+PKER_SWETH( 18, 33) = 0.382443E+00
+PKER_SWETH( 18, 34) = 0.413728E+00
+PKER_SWETH( 18, 35) = 0.442554E+00
+PKER_SWETH( 18, 36) = 0.468900E+00
+PKER_SWETH( 18, 37) = 0.492882E+00
+PKER_SWETH( 18, 38) = 0.514690E+00
+PKER_SWETH( 18, 39) = 0.534538E+00
+PKER_SWETH( 18, 40) = 0.552641E+00
+PKER_SWETH( 18, 41) = 0.569197E+00
+PKER_SWETH( 18, 42) = 0.584381E+00
+PKER_SWETH( 18, 43) = 0.598350E+00
+PKER_SWETH( 18, 44) = 0.611236E+00
+PKER_SWETH( 18, 45) = 0.623153E+00
+PKER_SWETH( 18, 46) = 0.634198E+00
+PKER_SWETH( 18, 47) = 0.644457E+00
+PKER_SWETH( 18, 48) = 0.654002E+00
+PKER_SWETH( 18, 49) = 0.662895E+00
+PKER_SWETH( 18, 50) = 0.671191E+00
+PKER_SWETH( 18, 51) = 0.678938E+00
+PKER_SWETH( 18, 52) = 0.686179E+00
+PKER_SWETH( 18, 53) = 0.692953E+00
+PKER_SWETH( 18, 54) = 0.699294E+00
+PKER_SWETH( 18, 55) = 0.705231E+00
+PKER_SWETH( 18, 56) = 0.710794E+00
+PKER_SWETH( 18, 57) = 0.716008E+00
+PKER_SWETH( 18, 58) = 0.720896E+00
+PKER_SWETH( 18, 59) = 0.725480E+00
+PKER_SWETH( 18, 60) = 0.729780E+00
+PKER_SWETH( 18, 61) = 0.733814E+00
+PKER_SWETH( 18, 62) = 0.737598E+00
+PKER_SWETH( 18, 63) = 0.741150E+00
+PKER_SWETH( 18, 64) = 0.744483E+00
+PKER_SWETH( 18, 65) = 0.747611E+00
+PKER_SWETH( 18, 66) = 0.750548E+00
+PKER_SWETH( 18, 67) = 0.753304E+00
+PKER_SWETH( 18, 68) = 0.755892E+00
+PKER_SWETH( 18, 69) = 0.758321E+00
+PKER_SWETH( 18, 70) = 0.760601E+00
+PKER_SWETH( 18, 71) = 0.762742E+00
+PKER_SWETH( 18, 72) = 0.764752E+00
+PKER_SWETH( 18, 73) = 0.766640E+00
+PKER_SWETH( 18, 74) = 0.768412E+00
+PKER_SWETH( 18, 75) = 0.770075E+00
+PKER_SWETH( 18, 76) = 0.771638E+00
+PKER_SWETH( 18, 77) = 0.773104E+00
+PKER_SWETH( 18, 78) = 0.774481E+00
+PKER_SWETH( 18, 79) = 0.775774E+00
+PKER_SWETH( 18, 80) = 0.776989E+00
+PKER_SWETH( 19, 1) = 0.256173E+01
+PKER_SWETH( 19, 2) = 0.236914E+01
+PKER_SWETH( 19, 3) = 0.218829E+01
+PKER_SWETH( 19, 4) = 0.201844E+01
+PKER_SWETH( 19, 5) = 0.185894E+01
+PKER_SWETH( 19, 6) = 0.170913E+01
+PKER_SWETH( 19, 7) = 0.156841E+01
+PKER_SWETH( 19, 8) = 0.143624E+01
+PKER_SWETH( 19, 9) = 0.131207E+01
+PKER_SWETH( 19, 10) = 0.119540E+01
+PKER_SWETH( 19, 11) = 0.108576E+01
+PKER_SWETH( 19, 12) = 0.982703E+00
+PKER_SWETH( 19, 13) = 0.885808E+00
+PKER_SWETH( 19, 14) = 0.794678E+00
+PKER_SWETH( 19, 15) = 0.708950E+00
+PKER_SWETH( 19, 16) = 0.628301E+00
+PKER_SWETH( 19, 17) = 0.552477E+00
+PKER_SWETH( 19, 18) = 0.481331E+00
+PKER_SWETH( 19, 19) = 0.414882E+00
+PKER_SWETH( 19, 20) = 0.353398E+00
+PKER_SWETH( 19, 21) = 0.297416E+00
+PKER_SWETH( 19, 22) = 0.247807E+00
+PKER_SWETH( 19, 23) = 0.205699E+00
+PKER_SWETH( 19, 24) = 0.172316E+00
+PKER_SWETH( 19, 25) = 0.148819E+00
+PKER_SWETH( 19, 26) = 0.135924E+00
+PKER_SWETH( 19, 27) = 0.133720E+00
+PKER_SWETH( 19, 28) = 0.141549E+00
+PKER_SWETH( 19, 29) = 0.158042E+00
+PKER_SWETH( 19, 30) = 0.181252E+00
+PKER_SWETH( 19, 31) = 0.208933E+00
+PKER_SWETH( 19, 32) = 0.239000E+00
+PKER_SWETH( 19, 33) = 0.269677E+00
+PKER_SWETH( 19, 34) = 0.299634E+00
+PKER_SWETH( 19, 35) = 0.328045E+00
+PKER_SWETH( 19, 36) = 0.354467E+00
+PKER_SWETH( 19, 37) = 0.378756E+00
+PKER_SWETH( 19, 38) = 0.400947E+00
+PKER_SWETH( 19, 39) = 0.421175E+00
+PKER_SWETH( 19, 40) = 0.439618E+00
+PKER_SWETH( 19, 41) = 0.456462E+00
+PKER_SWETH( 19, 42) = 0.471885E+00
+PKER_SWETH( 19, 43) = 0.486045E+00
+PKER_SWETH( 19, 44) = 0.499082E+00
+PKER_SWETH( 19, 45) = 0.511119E+00
+PKER_SWETH( 19, 46) = 0.522259E+00
+PKER_SWETH( 19, 47) = 0.532591E+00
+PKER_SWETH( 19, 48) = 0.542192E+00
+PKER_SWETH( 19, 49) = 0.551129E+00
+PKER_SWETH( 19, 50) = 0.559459E+00
+PKER_SWETH( 19, 51) = 0.567233E+00
+PKER_SWETH( 19, 52) = 0.574495E+00
+PKER_SWETH( 19, 53) = 0.581285E+00
+PKER_SWETH( 19, 54) = 0.587637E+00
+PKER_SWETH( 19, 55) = 0.593585E+00
+PKER_SWETH( 19, 56) = 0.599155E+00
+PKER_SWETH( 19, 57) = 0.604374E+00
+PKER_SWETH( 19, 58) = 0.609267E+00
+PKER_SWETH( 19, 59) = 0.613855E+00
+PKER_SWETH( 19, 60) = 0.618157E+00
+PKER_SWETH( 19, 61) = 0.622193E+00
+PKER_SWETH( 19, 62) = 0.625979E+00
+PKER_SWETH( 19, 63) = 0.629532E+00
+PKER_SWETH( 19, 64) = 0.632866E+00
+PKER_SWETH( 19, 65) = 0.635995E+00
+PKER_SWETH( 19, 66) = 0.638932E+00
+PKER_SWETH( 19, 67) = 0.641689E+00
+PKER_SWETH( 19, 68) = 0.644277E+00
+PKER_SWETH( 19, 69) = 0.646706E+00
+PKER_SWETH( 19, 70) = 0.648987E+00
+PKER_SWETH( 19, 71) = 0.651128E+00
+PKER_SWETH( 19, 72) = 0.653138E+00
+PKER_SWETH( 19, 73) = 0.655026E+00
+PKER_SWETH( 19, 74) = 0.656798E+00
+PKER_SWETH( 19, 75) = 0.658461E+00
+PKER_SWETH( 19, 76) = 0.660024E+00
+PKER_SWETH( 19, 77) = 0.661490E+00
+PKER_SWETH( 19, 78) = 0.662868E+00
+PKER_SWETH( 19, 79) = 0.664161E+00
+PKER_SWETH( 19, 80) = 0.665375E+00
+PKER_SWETH( 20, 1) = 0.264500E+01
+PKER_SWETH( 20, 2) = 0.245243E+01
+PKER_SWETH( 20, 3) = 0.227160E+01
+PKER_SWETH( 20, 4) = 0.210178E+01
+PKER_SWETH( 20, 5) = 0.194230E+01
+PKER_SWETH( 20, 6) = 0.179253E+01
+PKER_SWETH( 20, 7) = 0.165187E+01
+PKER_SWETH( 20, 8) = 0.151975E+01
+PKER_SWETH( 20, 9) = 0.139564E+01
+PKER_SWETH( 20, 10) = 0.127905E+01
+PKER_SWETH( 20, 11) = 0.116951E+01
+PKER_SWETH( 20, 12) = 0.106658E+01
+PKER_SWETH( 20, 13) = 0.969820E+00
+PKER_SWETH( 20, 14) = 0.878851E+00
+PKER_SWETH( 20, 15) = 0.793291E+00
+PKER_SWETH( 20, 16) = 0.712786E+00
+PKER_SWETH( 20, 17) = 0.637005E+00
+PKER_SWETH( 20, 18) = 0.565650E+00
+PKER_SWETH( 20, 19) = 0.498472E+00
+PKER_SWETH( 20, 20) = 0.435308E+00
+PKER_SWETH( 20, 21) = 0.376129E+00
+PKER_SWETH( 20, 22) = 0.321110E+00
+PKER_SWETH( 20, 23) = 0.270680E+00
+PKER_SWETH( 20, 24) = 0.225582E+00
+PKER_SWETH( 20, 25) = 0.186836E+00
+PKER_SWETH( 20, 26) = 0.155610E+00
+PKER_SWETH( 20, 27) = 0.133055E+00
+PKER_SWETH( 20, 28) = 0.119975E+00
+PKER_SWETH( 20, 29) = 0.116599E+00
+PKER_SWETH( 20, 30) = 0.122369E+00
+PKER_SWETH( 20, 31) = 0.136033E+00
+PKER_SWETH( 20, 32) = 0.155727E+00
+PKER_SWETH( 20, 33) = 0.179407E+00
+PKER_SWETH( 20, 34) = 0.205090E+00
+PKER_SWETH( 20, 35) = 0.231197E+00
+PKER_SWETH( 20, 36) = 0.256588E+00
+PKER_SWETH( 20, 37) = 0.280587E+00
+PKER_SWETH( 20, 38) = 0.302872E+00
+PKER_SWETH( 20, 39) = 0.323359E+00
+PKER_SWETH( 20, 40) = 0.342106E+00
+PKER_SWETH( 20, 41) = 0.359241E+00
+PKER_SWETH( 20, 42) = 0.374919E+00
+PKER_SWETH( 20, 43) = 0.389291E+00
+PKER_SWETH( 20, 44) = 0.402502E+00
+PKER_SWETH( 20, 45) = 0.414676E+00
+PKER_SWETH( 20, 46) = 0.425924E+00
+PKER_SWETH( 20, 47) = 0.436341E+00
+PKER_SWETH( 20, 48) = 0.446009E+00
+PKER_SWETH( 20, 49) = 0.454997E+00
+PKER_SWETH( 20, 50) = 0.463367E+00
+PKER_SWETH( 20, 51) = 0.471171E+00
+PKER_SWETH( 20, 52) = 0.478457E+00
+PKER_SWETH( 20, 53) = 0.485265E+00
+PKER_SWETH( 20, 54) = 0.491632E+00
+PKER_SWETH( 20, 55) = 0.497590E+00
+PKER_SWETH( 20, 56) = 0.503169E+00
+PKER_SWETH( 20, 57) = 0.508395E+00
+PKER_SWETH( 20, 58) = 0.513293E+00
+PKER_SWETH( 20, 59) = 0.517884E+00
+PKER_SWETH( 20, 60) = 0.522189E+00
+PKER_SWETH( 20, 61) = 0.526227E+00
+PKER_SWETH( 20, 62) = 0.530016E+00
+PKER_SWETH( 20, 63) = 0.533570E+00
+PKER_SWETH( 20, 64) = 0.536905E+00
+PKER_SWETH( 20, 65) = 0.540035E+00
+PKER_SWETH( 20, 66) = 0.542973E+00
+PKER_SWETH( 20, 67) = 0.545730E+00
+PKER_SWETH( 20, 68) = 0.548318E+00
+PKER_SWETH( 20, 69) = 0.550748E+00
+PKER_SWETH( 20, 70) = 0.553029E+00
+PKER_SWETH( 20, 71) = 0.555170E+00
+PKER_SWETH( 20, 72) = 0.557181E+00
+PKER_SWETH( 20, 73) = 0.559068E+00
+PKER_SWETH( 20, 74) = 0.560840E+00
+PKER_SWETH( 20, 75) = 0.562504E+00
+PKER_SWETH( 20, 76) = 0.564067E+00
+PKER_SWETH( 20, 77) = 0.565533E+00
+PKER_SWETH( 20, 78) = 0.566911E+00
+PKER_SWETH( 20, 79) = 0.568204E+00
+PKER_SWETH( 20, 80) = 0.569418E+00
+PKER_SWETH( 21, 1) = 0.271658E+01
+PKER_SWETH( 21, 2) = 0.252403E+01
+PKER_SWETH( 21, 3) = 0.234321E+01
+PKER_SWETH( 21, 4) = 0.217341E+01
+PKER_SWETH( 21, 5) = 0.201396E+01
+PKER_SWETH( 21, 6) = 0.186421E+01
+PKER_SWETH( 21, 7) = 0.172358E+01
+PKER_SWETH( 21, 8) = 0.159150E+01
+PKER_SWETH( 21, 9) = 0.146745E+01
+PKER_SWETH( 21, 10) = 0.135092E+01
+PKER_SWETH( 21, 11) = 0.124145E+01
+PKER_SWETH( 21, 12) = 0.113861E+01
+PKER_SWETH( 21, 13) = 0.104196E+01
+PKER_SWETH( 21, 14) = 0.951122E+00
+PKER_SWETH( 21, 15) = 0.865719E+00
+PKER_SWETH( 21, 16) = 0.785398E+00
+PKER_SWETH( 21, 17) = 0.709821E+00
+PKER_SWETH( 21, 18) = 0.638672E+00
+PKER_SWETH( 21, 19) = 0.571650E+00
+PKER_SWETH( 21, 20) = 0.508481E+00
+PKER_SWETH( 21, 21) = 0.448928E+00
+PKER_SWETH( 21, 22) = 0.392821E+00
+PKER_SWETH( 21, 23) = 0.340101E+00
+PKER_SWETH( 21, 24) = 0.290879E+00
+PKER_SWETH( 21, 25) = 0.245501E+00
+PKER_SWETH( 21, 26) = 0.204609E+00
+PKER_SWETH( 21, 27) = 0.169114E+00
+PKER_SWETH( 21, 28) = 0.140143E+00
+PKER_SWETH( 21, 29) = 0.118804E+00
+PKER_SWETH( 21, 30) = 0.105905E+00
+PKER_SWETH( 21, 31) = 0.101754E+00
+PKER_SWETH( 21, 32) = 0.105915E+00
+PKER_SWETH( 21, 33) = 0.117110E+00
+PKER_SWETH( 21, 34) = 0.133717E+00
+PKER_SWETH( 21, 35) = 0.153768E+00
+PKER_SWETH( 21, 36) = 0.175523E+00
+PKER_SWETH( 21, 37) = 0.197593E+00
+PKER_SWETH( 21, 38) = 0.219023E+00
+PKER_SWETH( 21, 39) = 0.239267E+00
+PKER_SWETH( 21, 40) = 0.258077E+00
+PKER_SWETH( 21, 41) = 0.275405E+00
+PKER_SWETH( 21, 42) = 0.291307E+00
+PKER_SWETH( 21, 43) = 0.305894E+00
+PKER_SWETH( 21, 44) = 0.319290E+00
+PKER_SWETH( 21, 45) = 0.331618E+00
+PKER_SWETH( 21, 46) = 0.342990E+00
+PKER_SWETH( 21, 47) = 0.353504E+00
+PKER_SWETH( 21, 48) = 0.363248E+00
+PKER_SWETH( 21, 49) = 0.372296E+00
+PKER_SWETH( 21, 50) = 0.380712E+00
+PKER_SWETH( 21, 51) = 0.388553E+00
+PKER_SWETH( 21, 52) = 0.395866E+00
+PKER_SWETH( 21, 53) = 0.402696E+00
+PKER_SWETH( 21, 54) = 0.409079E+00
+PKER_SWETH( 21, 55) = 0.415050E+00
+PKER_SWETH( 21, 56) = 0.420639E+00
+PKER_SWETH( 21, 57) = 0.425872E+00
+PKER_SWETH( 21, 58) = 0.430776E+00
+PKER_SWETH( 21, 59) = 0.435372E+00
+PKER_SWETH( 21, 60) = 0.439681E+00
+PKER_SWETH( 21, 61) = 0.443722E+00
+PKER_SWETH( 21, 62) = 0.447512E+00
+PKER_SWETH( 21, 63) = 0.451068E+00
+PKER_SWETH( 21, 64) = 0.454404E+00
+PKER_SWETH( 21, 65) = 0.457535E+00
+PKER_SWETH( 21, 66) = 0.460473E+00
+PKER_SWETH( 21, 67) = 0.463231E+00
+PKER_SWETH( 21, 68) = 0.465820E+00
+PKER_SWETH( 21, 69) = 0.468250E+00
+PKER_SWETH( 21, 70) = 0.470532E+00
+PKER_SWETH( 21, 71) = 0.472673E+00
+PKER_SWETH( 21, 72) = 0.474684E+00
+PKER_SWETH( 21, 73) = 0.476571E+00
+PKER_SWETH( 21, 74) = 0.478344E+00
+PKER_SWETH( 21, 75) = 0.480008E+00
+PKER_SWETH( 21, 76) = 0.481570E+00
+PKER_SWETH( 21, 77) = 0.483037E+00
+PKER_SWETH( 21, 78) = 0.484414E+00
+PKER_SWETH( 21, 79) = 0.485707E+00
+PKER_SWETH( 21, 80) = 0.486921E+00
+PKER_SWETH( 22, 1) = 0.277812E+01
+PKER_SWETH( 22, 2) = 0.258557E+01
+PKER_SWETH( 22, 3) = 0.240477E+01
+PKER_SWETH( 22, 4) = 0.223498E+01
+PKER_SWETH( 22, 5) = 0.207555E+01
+PKER_SWETH( 22, 6) = 0.192582E+01
+PKER_SWETH( 22, 7) = 0.178522E+01
+PKER_SWETH( 22, 8) = 0.165317E+01
+PKER_SWETH( 22, 9) = 0.152915E+01
+PKER_SWETH( 22, 10) = 0.141267E+01
+PKER_SWETH( 22, 11) = 0.130326E+01
+PKER_SWETH( 22, 12) = 0.120048E+01
+PKER_SWETH( 22, 13) = 0.110391E+01
+PKER_SWETH( 22, 14) = 0.101317E+01
+PKER_SWETH( 22, 15) = 0.927888E+00
+PKER_SWETH( 22, 16) = 0.847710E+00
+PKER_SWETH( 22, 17) = 0.772307E+00
+PKER_SWETH( 22, 18) = 0.701363E+00
+PKER_SWETH( 22, 19) = 0.634577E+00
+PKER_SWETH( 22, 20) = 0.571663E+00
+PKER_SWETH( 22, 21) = 0.512351E+00
+PKER_SWETH( 22, 22) = 0.456387E+00
+PKER_SWETH( 22, 23) = 0.403551E+00
+PKER_SWETH( 22, 24) = 0.353674E+00
+PKER_SWETH( 22, 25) = 0.306679E+00
+PKER_SWETH( 22, 26) = 0.262639E+00
+PKER_SWETH( 22, 27) = 0.221831E+00
+PKER_SWETH( 22, 28) = 0.184828E+00
+PKER_SWETH( 22, 29) = 0.152460E+00
+PKER_SWETH( 22, 30) = 0.125752E+00
+PKER_SWETH( 22, 31) = 0.105794E+00
+PKER_SWETH( 22, 32) = 0.933885E-01
+PKER_SWETH( 22, 33) = 0.887837E-01
+PKER_SWETH( 22, 34) = 0.916083E-01
+PKER_SWETH( 22, 35) = 0.100750E+00
+PKER_SWETH( 22, 36) = 0.114556E+00
+PKER_SWETH( 22, 37) = 0.131388E+00
+PKER_SWETH( 22, 38) = 0.149687E+00
+PKER_SWETH( 22, 39) = 0.168264E+00
+PKER_SWETH( 22, 40) = 0.186315E+00
+PKER_SWETH( 22, 41) = 0.203399E+00
+PKER_SWETH( 22, 42) = 0.219317E+00
+PKER_SWETH( 22, 43) = 0.234029E+00
+PKER_SWETH( 22, 44) = 0.247581E+00
+PKER_SWETH( 22, 45) = 0.260059E+00
+PKER_SWETH( 22, 46) = 0.271563E+00
+PKER_SWETH( 22, 47) = 0.282186E+00
+PKER_SWETH( 22, 48) = 0.292018E+00
+PKER_SWETH( 22, 49) = 0.301134E+00
+PKER_SWETH( 22, 50) = 0.309604E+00
+PKER_SWETH( 22, 51) = 0.317487E+00
+PKER_SWETH( 22, 52) = 0.324833E+00
+PKER_SWETH( 22, 53) = 0.331687E+00
+PKER_SWETH( 22, 54) = 0.338090E+00
+PKER_SWETH( 22, 55) = 0.344075E+00
+PKER_SWETH( 22, 56) = 0.349675E+00
+PKER_SWETH( 22, 57) = 0.354918E+00
+PKER_SWETH( 22, 58) = 0.359828E+00
+PKER_SWETH( 22, 59) = 0.364430E+00
+PKER_SWETH( 22, 60) = 0.368743E+00
+PKER_SWETH( 22, 61) = 0.372787E+00
+PKER_SWETH( 22, 62) = 0.376579E+00
+PKER_SWETH( 22, 63) = 0.380137E+00
+PKER_SWETH( 22, 64) = 0.383475E+00
+PKER_SWETH( 22, 65) = 0.386607E+00
+PKER_SWETH( 22, 66) = 0.389546E+00
+PKER_SWETH( 22, 67) = 0.392305E+00
+PKER_SWETH( 22, 68) = 0.394894E+00
+PKER_SWETH( 22, 69) = 0.397325E+00
+PKER_SWETH( 22, 70) = 0.399606E+00
+PKER_SWETH( 22, 71) = 0.401748E+00
+PKER_SWETH( 22, 72) = 0.403759E+00
+PKER_SWETH( 22, 73) = 0.405647E+00
+PKER_SWETH( 22, 74) = 0.407419E+00
+PKER_SWETH( 22, 75) = 0.409083E+00
+PKER_SWETH( 22, 76) = 0.410645E+00
+PKER_SWETH( 22, 77) = 0.412112E+00
+PKER_SWETH( 22, 78) = 0.413490E+00
+PKER_SWETH( 22, 79) = 0.414783E+00
+PKER_SWETH( 22, 80) = 0.415997E+00
+PKER_SWETH( 23, 1) = 0.283102E+01
+PKER_SWETH( 23, 2) = 0.263848E+01
+PKER_SWETH( 23, 3) = 0.245768E+01
+PKER_SWETH( 23, 4) = 0.228791E+01
+PKER_SWETH( 23, 5) = 0.212849E+01
+PKER_SWETH( 23, 6) = 0.197878E+01
+PKER_SWETH( 23, 7) = 0.183819E+01
+PKER_SWETH( 23, 8) = 0.170617E+01
+PKER_SWETH( 23, 9) = 0.158218E+01
+PKER_SWETH( 23, 10) = 0.146573E+01
+PKER_SWETH( 23, 11) = 0.135636E+01
+PKER_SWETH( 23, 12) = 0.125363E+01
+PKER_SWETH( 23, 13) = 0.115712E+01
+PKER_SWETH( 23, 14) = 0.106646E+01
+PKER_SWETH( 23, 15) = 0.981260E+00
+PKER_SWETH( 23, 16) = 0.901190E+00
+PKER_SWETH( 23, 17) = 0.825917E+00
+PKER_SWETH( 23, 18) = 0.755130E+00
+PKER_SWETH( 23, 19) = 0.688534E+00
+PKER_SWETH( 23, 20) = 0.625847E+00
+PKER_SWETH( 23, 21) = 0.566798E+00
+PKER_SWETH( 23, 22) = 0.511131E+00
+PKER_SWETH( 23, 23) = 0.458600E+00
+PKER_SWETH( 23, 24) = 0.408976E+00
+PKER_SWETH( 23, 25) = 0.362052E+00
+PKER_SWETH( 23, 26) = 0.317669E+00
+PKER_SWETH( 23, 27) = 0.275744E+00
+PKER_SWETH( 23, 28) = 0.236322E+00
+PKER_SWETH( 23, 29) = 0.199652E+00
+PKER_SWETH( 23, 30) = 0.166228E+00
+PKER_SWETH( 23, 31) = 0.136821E+00
+PKER_SWETH( 23, 32) = 0.112388E+00
+PKER_SWETH( 23, 33) = 0.939206E-01
+PKER_SWETH( 23, 34) = 0.821751E-01
+PKER_SWETH( 23, 35) = 0.773938E-01
+PKER_SWETH( 23, 36) = 0.791534E-01
+PKER_SWETH( 23, 37) = 0.864193E-01
+PKER_SWETH( 23, 38) = 0.978352E-01
+PKER_SWETH( 23, 39) = 0.111845E+00
+PKER_SWETH( 23, 40) = 0.127143E+00
+PKER_SWETH( 23, 41) = 0.142733E+00
+PKER_SWETH( 23, 42) = 0.157936E+00
+PKER_SWETH( 23, 43) = 0.172382E+00
+PKER_SWETH( 23, 44) = 0.185898E+00
+PKER_SWETH( 23, 45) = 0.198442E+00
+PKER_SWETH( 23, 46) = 0.210045E+00
+PKER_SWETH( 23, 47) = 0.220770E+00
+PKER_SWETH( 23, 48) = 0.230692E+00
+PKER_SWETH( 23, 49) = 0.239885E+00
+PKER_SWETH( 23, 50) = 0.248416E+00
+PKER_SWETH( 23, 51) = 0.256346E+00
+PKER_SWETH( 23, 52) = 0.263730E+00
+PKER_SWETH( 23, 53) = 0.270613E+00
+PKER_SWETH( 23, 54) = 0.277038E+00
+PKER_SWETH( 23, 55) = 0.283042E+00
+PKER_SWETH( 23, 56) = 0.288655E+00
+PKER_SWETH( 23, 57) = 0.293908E+00
+PKER_SWETH( 23, 58) = 0.298826E+00
+PKER_SWETH( 23, 59) = 0.303434E+00
+PKER_SWETH( 23, 60) = 0.307751E+00
+PKER_SWETH( 23, 61) = 0.311799E+00
+PKER_SWETH( 23, 62) = 0.315594E+00
+PKER_SWETH( 23, 63) = 0.319154E+00
+PKER_SWETH( 23, 64) = 0.322494E+00
+PKER_SWETH( 23, 65) = 0.325627E+00
+PKER_SWETH( 23, 66) = 0.328568E+00
+PKER_SWETH( 23, 67) = 0.331327E+00
+PKER_SWETH( 23, 68) = 0.333917E+00
+PKER_SWETH( 23, 69) = 0.336348E+00
+PKER_SWETH( 23, 70) = 0.338630E+00
+PKER_SWETH( 23, 71) = 0.340772E+00
+PKER_SWETH( 23, 72) = 0.342783E+00
+PKER_SWETH( 23, 73) = 0.344671E+00
+PKER_SWETH( 23, 74) = 0.346443E+00
+PKER_SWETH( 23, 75) = 0.348107E+00
+PKER_SWETH( 23, 76) = 0.349670E+00
+PKER_SWETH( 23, 77) = 0.351137E+00
+PKER_SWETH( 23, 78) = 0.352514E+00
+PKER_SWETH( 23, 79) = 0.353807E+00
+PKER_SWETH( 23, 80) = 0.355022E+00
+PKER_SWETH( 24, 1) = 0.287649E+01
+PKER_SWETH( 24, 2) = 0.268396E+01
+PKER_SWETH( 24, 3) = 0.250317E+01
+PKER_SWETH( 24, 4) = 0.233341E+01
+PKER_SWETH( 24, 5) = 0.217399E+01
+PKER_SWETH( 24, 6) = 0.202430E+01
+PKER_SWETH( 24, 7) = 0.188372E+01
+PKER_SWETH( 24, 8) = 0.175172E+01
+PKER_SWETH( 24, 9) = 0.162775E+01
+PKER_SWETH( 24, 10) = 0.151133E+01
+PKER_SWETH( 24, 11) = 0.140199E+01
+PKER_SWETH( 24, 12) = 0.129929E+01
+PKER_SWETH( 24, 13) = 0.120283E+01
+PKER_SWETH( 24, 14) = 0.111222E+01
+PKER_SWETH( 24, 15) = 0.102709E+01
+PKER_SWETH( 24, 16) = 0.947100E+00
+PKER_SWETH( 24, 17) = 0.871925E+00
+PKER_SWETH( 24, 18) = 0.801255E+00
+PKER_SWETH( 24, 19) = 0.734802E+00
+PKER_SWETH( 24, 20) = 0.672286E+00
+PKER_SWETH( 24, 21) = 0.613444E+00
+PKER_SWETH( 24, 22) = 0.558025E+00
+PKER_SWETH( 24, 23) = 0.505784E+00
+PKER_SWETH( 24, 24) = 0.456492E+00
+PKER_SWETH( 24, 25) = 0.409924E+00
+PKER_SWETH( 24, 26) = 0.365874E+00
+PKER_SWETH( 24, 27) = 0.324153E+00
+PKER_SWETH( 24, 28) = 0.284613E+00
+PKER_SWETH( 24, 29) = 0.247175E+00
+PKER_SWETH( 24, 30) = 0.211878E+00
+PKER_SWETH( 24, 31) = 0.178940E+00
+PKER_SWETH( 24, 32) = 0.148822E+00
+PKER_SWETH( 24, 33) = 0.122216E+00
+PKER_SWETH( 24, 34) = 0.100012E+00
+PKER_SWETH( 24, 35) = 0.831056E-01
+PKER_SWETH( 24, 36) = 0.721377E-01
+PKER_SWETH( 24, 37) = 0.673132E-01
+PKER_SWETH( 24, 38) = 0.682186E-01
+PKER_SWETH( 24, 39) = 0.739244E-01
+PKER_SWETH( 24, 40) = 0.832005E-01
+PKER_SWETH( 24, 41) = 0.947760E-01
+PKER_SWETH( 24, 42) = 0.107532E+00
+PKER_SWETH( 24, 43) = 0.120598E+00
+PKER_SWETH( 24, 44) = 0.133420E+00
+PKER_SWETH( 24, 45) = 0.145669E+00
+PKER_SWETH( 24, 46) = 0.157186E+00
+PKER_SWETH( 24, 47) = 0.167927E+00
+PKER_SWETH( 24, 48) = 0.177903E+00
+PKER_SWETH( 24, 49) = 0.187160E+00
+PKER_SWETH( 24, 50) = 0.195752E+00
+PKER_SWETH( 24, 51) = 0.203734E+00
+PKER_SWETH( 24, 52) = 0.211160E+00
+PKER_SWETH( 24, 53) = 0.218077E+00
+PKER_SWETH( 24, 54) = 0.224528E+00
+PKER_SWETH( 24, 55) = 0.230551E+00
+PKER_SWETH( 24, 56) = 0.236181E+00
+PKER_SWETH( 24, 57) = 0.241446E+00
+PKER_SWETH( 24, 58) = 0.246373E+00
+PKER_SWETH( 24, 59) = 0.250988E+00
+PKER_SWETH( 24, 60) = 0.255311E+00
+PKER_SWETH( 24, 61) = 0.259363E+00
+PKER_SWETH( 24, 62) = 0.263162E+00
+PKER_SWETH( 24, 63) = 0.266724E+00
+PKER_SWETH( 24, 64) = 0.270065E+00
+PKER_SWETH( 24, 65) = 0.273200E+00
+PKER_SWETH( 24, 66) = 0.276142E+00
+PKER_SWETH( 24, 67) = 0.278902E+00
+PKER_SWETH( 24, 68) = 0.281493E+00
+PKER_SWETH( 24, 69) = 0.283924E+00
+PKER_SWETH( 24, 70) = 0.286206E+00
+PKER_SWETH( 24, 71) = 0.288349E+00
+PKER_SWETH( 24, 72) = 0.290360E+00
+PKER_SWETH( 24, 73) = 0.292248E+00
+PKER_SWETH( 24, 74) = 0.294021E+00
+PKER_SWETH( 24, 75) = 0.295685E+00
+PKER_SWETH( 24, 76) = 0.297248E+00
+PKER_SWETH( 24, 77) = 0.298715E+00
+PKER_SWETH( 24, 78) = 0.300092E+00
+PKER_SWETH( 24, 79) = 0.301385E+00
+PKER_SWETH( 24, 80) = 0.302600E+00
+PKER_SWETH( 25, 1) = 0.291559E+01
+PKER_SWETH( 25, 2) = 0.272306E+01
+PKER_SWETH( 25, 3) = 0.254227E+01
+PKER_SWETH( 25, 4) = 0.237251E+01
+PKER_SWETH( 25, 5) = 0.221311E+01
+PKER_SWETH( 25, 6) = 0.206342E+01
+PKER_SWETH( 25, 7) = 0.192286E+01
+PKER_SWETH( 25, 8) = 0.179087E+01
+PKER_SWETH( 25, 9) = 0.166692E+01
+PKER_SWETH( 25, 10) = 0.155051E+01
+PKER_SWETH( 25, 11) = 0.144120E+01
+PKER_SWETH( 25, 12) = 0.133853E+01
+PKER_SWETH( 25, 13) = 0.124210E+01
+PKER_SWETH( 25, 14) = 0.115153E+01
+PKER_SWETH( 25, 15) = 0.106645E+01
+PKER_SWETH( 25, 16) = 0.986522E+00
+PKER_SWETH( 25, 17) = 0.911418E+00
+PKER_SWETH( 25, 18) = 0.840837E+00
+PKER_SWETH( 25, 19) = 0.774489E+00
+PKER_SWETH( 25, 20) = 0.712102E+00
+PKER_SWETH( 25, 21) = 0.653415E+00
+PKER_SWETH( 25, 22) = 0.598183E+00
+PKER_SWETH( 25, 23) = 0.546167E+00
+PKER_SWETH( 25, 24) = 0.497142E+00
+PKER_SWETH( 25, 25) = 0.450891E+00
+PKER_SWETH( 25, 26) = 0.407203E+00
+PKER_SWETH( 25, 27) = 0.365878E+00
+PKER_SWETH( 25, 28) = 0.326729E+00
+PKER_SWETH( 25, 29) = 0.289588E+00
+PKER_SWETH( 25, 30) = 0.254321E+00
+PKER_SWETH( 25, 31) = 0.220863E+00
+PKER_SWETH( 25, 32) = 0.189255E+00
+PKER_SWETH( 25, 33) = 0.159705E+00
+PKER_SWETH( 25, 34) = 0.132637E+00
+PKER_SWETH( 25, 35) = 0.108685E+00
+PKER_SWETH( 25, 36) = 0.886458E-01
+PKER_SWETH( 25, 37) = 0.733000E-01
+PKER_SWETH( 25, 38) = 0.631817E-01
+PKER_SWETH( 25, 39) = 0.584175E-01
+PKER_SWETH( 25, 40) = 0.586280E-01
+PKER_SWETH( 25, 41) = 0.629970E-01
+PKER_SWETH( 25, 42) = 0.704646E-01
+PKER_SWETH( 25, 43) = 0.799685E-01
+PKER_SWETH( 25, 44) = 0.905525E-01
+PKER_SWETH( 25, 45) = 0.101507E+00
+PKER_SWETH( 25, 46) = 0.112335E+00
+PKER_SWETH( 25, 47) = 0.122751E+00
+PKER_SWETH( 25, 48) = 0.132601E+00
+PKER_SWETH( 25, 49) = 0.141833E+00
+PKER_SWETH( 25, 50) = 0.150445E+00
+PKER_SWETH( 25, 51) = 0.158463E+00
+PKER_SWETH( 25, 52) = 0.165926E+00
+PKER_SWETH( 25, 53) = 0.172877E+00
+PKER_SWETH( 25, 54) = 0.179357E+00
+PKER_SWETH( 25, 55) = 0.185404E+00
+PKER_SWETH( 25, 56) = 0.191051E+00
+PKER_SWETH( 25, 57) = 0.196330E+00
+PKER_SWETH( 25, 58) = 0.201268E+00
+PKER_SWETH( 25, 59) = 0.205891E+00
+PKER_SWETH( 25, 60) = 0.210221E+00
+PKER_SWETH( 25, 61) = 0.214278E+00
+PKER_SWETH( 25, 62) = 0.218080E+00
+PKER_SWETH( 25, 63) = 0.221646E+00
+PKER_SWETH( 25, 64) = 0.224989E+00
+PKER_SWETH( 25, 65) = 0.228126E+00
+PKER_SWETH( 25, 66) = 0.231069E+00
+PKER_SWETH( 25, 67) = 0.233830E+00
+PKER_SWETH( 25, 68) = 0.236422E+00
+PKER_SWETH( 25, 69) = 0.238854E+00
+PKER_SWETH( 25, 70) = 0.241137E+00
+PKER_SWETH( 25, 71) = 0.243279E+00
+PKER_SWETH( 25, 72) = 0.245291E+00
+PKER_SWETH( 25, 73) = 0.247179E+00
+PKER_SWETH( 25, 74) = 0.248952E+00
+PKER_SWETH( 25, 75) = 0.250616E+00
+PKER_SWETH( 25, 76) = 0.252179E+00
+PKER_SWETH( 25, 77) = 0.253646E+00
+PKER_SWETH( 25, 78) = 0.255024E+00
+PKER_SWETH( 25, 79) = 0.256317E+00
+PKER_SWETH( 25, 80) = 0.257531E+00
+PKER_SWETH( 26, 1) = 0.294919E+01
+PKER_SWETH( 26, 2) = 0.275667E+01
+PKER_SWETH( 26, 3) = 0.257589E+01
+PKER_SWETH( 26, 4) = 0.240613E+01
+PKER_SWETH( 26, 5) = 0.224673E+01
+PKER_SWETH( 26, 6) = 0.209706E+01
+PKER_SWETH( 26, 7) = 0.195650E+01
+PKER_SWETH( 26, 8) = 0.182452E+01
+PKER_SWETH( 26, 9) = 0.170058E+01
+PKER_SWETH( 26, 10) = 0.158419E+01
+PKER_SWETH( 26, 11) = 0.147489E+01
+PKER_SWETH( 26, 12) = 0.137225E+01
+PKER_SWETH( 26, 13) = 0.127585E+01
+PKER_SWETH( 26, 14) = 0.118531E+01
+PKER_SWETH( 26, 15) = 0.110026E+01
+PKER_SWETH( 26, 16) = 0.102038E+01
+PKER_SWETH( 26, 17) = 0.945328E+00
+PKER_SWETH( 26, 18) = 0.874813E+00
+PKER_SWETH( 26, 19) = 0.808544E+00
+PKER_SWETH( 26, 20) = 0.746253E+00
+PKER_SWETH( 26, 21) = 0.687683E+00
+PKER_SWETH( 26, 22) = 0.632590E+00
+PKER_SWETH( 26, 23) = 0.580743E+00
+PKER_SWETH( 26, 24) = 0.531921E+00
+PKER_SWETH( 26, 25) = 0.485912E+00
+PKER_SWETH( 26, 26) = 0.442513E+00
+PKER_SWETH( 26, 27) = 0.401527E+00
+PKER_SWETH( 26, 28) = 0.362766E+00
+PKER_SWETH( 26, 29) = 0.326051E+00
+PKER_SWETH( 26, 30) = 0.291214E+00
+PKER_SWETH( 26, 31) = 0.258107E+00
+PKER_SWETH( 26, 32) = 0.226621E+00
+PKER_SWETH( 26, 33) = 0.196706E+00
+PKER_SWETH( 26, 34) = 0.168416E+00
+PKER_SWETH( 26, 35) = 0.141958E+00
+PKER_SWETH( 26, 36) = 0.117722E+00
+PKER_SWETH( 26, 37) = 0.962814E-01
+PKER_SWETH( 26, 38) = 0.783300E-01
+PKER_SWETH( 26, 39) = 0.645079E-01
+PKER_SWETH( 26, 40) = 0.552534E-01
+PKER_SWETH( 26, 41) = 0.506271E-01
+PKER_SWETH( 26, 42) = 0.502626E-01
+PKER_SWETH( 26, 43) = 0.534894E-01
+PKER_SWETH( 26, 44) = 0.594360E-01
+PKER_SWETH( 26, 45) = 0.671708E-01
+PKER_SWETH( 26, 46) = 0.759473E-01
+PKER_SWETH( 26, 47) = 0.851241E-01
+PKER_SWETH( 26, 48) = 0.942847E-01
+PKER_SWETH( 26, 49) = 0.103164E+00
+PKER_SWETH( 26, 50) = 0.111616E+00
+PKER_SWETH( 26, 51) = 0.119577E+00
+PKER_SWETH( 26, 52) = 0.127034E+00
+PKER_SWETH( 26, 53) = 0.134000E+00
+PKER_SWETH( 26, 54) = 0.140501E+00
+PKER_SWETH( 26, 55) = 0.146568E+00
+PKER_SWETH( 26, 56) = 0.152234E+00
+PKER_SWETH( 26, 57) = 0.157529E+00
+PKER_SWETH( 26, 58) = 0.162480E+00
+PKER_SWETH( 26, 59) = 0.167112E+00
+PKER_SWETH( 26, 60) = 0.171449E+00
+PKER_SWETH( 26, 61) = 0.175512E+00
+PKER_SWETH( 26, 62) = 0.179319E+00
+PKER_SWETH( 26, 63) = 0.182888E+00
+PKER_SWETH( 26, 64) = 0.186234E+00
+PKER_SWETH( 26, 65) = 0.189373E+00
+PKER_SWETH( 26, 66) = 0.192317E+00
+PKER_SWETH( 26, 67) = 0.195080E+00
+PKER_SWETH( 26, 68) = 0.197672E+00
+PKER_SWETH( 26, 69) = 0.200105E+00
+PKER_SWETH( 26, 70) = 0.202388E+00
+PKER_SWETH( 26, 71) = 0.204532E+00
+PKER_SWETH( 26, 72) = 0.206543E+00
+PKER_SWETH( 26, 73) = 0.208432E+00
+PKER_SWETH( 26, 74) = 0.210205E+00
+PKER_SWETH( 26, 75) = 0.211870E+00
+PKER_SWETH( 26, 76) = 0.213432E+00
+PKER_SWETH( 26, 77) = 0.214900E+00
+PKER_SWETH( 26, 78) = 0.216277E+00
+PKER_SWETH( 26, 79) = 0.217571E+00
+PKER_SWETH( 26, 80) = 0.218785E+00
+PKER_SWETH( 27, 1) = 0.297808E+01
+PKER_SWETH( 27, 2) = 0.278556E+01
+PKER_SWETH( 27, 3) = 0.260479E+01
+PKER_SWETH( 27, 4) = 0.243504E+01
+PKER_SWETH( 27, 5) = 0.227564E+01
+PKER_SWETH( 27, 6) = 0.212597E+01
+PKER_SWETH( 27, 7) = 0.198542E+01
+PKER_SWETH( 27, 8) = 0.185344E+01
+PKER_SWETH( 27, 9) = 0.172951E+01
+PKER_SWETH( 27, 10) = 0.161314E+01
+PKER_SWETH( 27, 11) = 0.150385E+01
+PKER_SWETH( 27, 12) = 0.140122E+01
+PKER_SWETH( 27, 13) = 0.130484E+01
+PKER_SWETH( 27, 14) = 0.121432E+01
+PKER_SWETH( 27, 15) = 0.112931E+01
+PKER_SWETH( 27, 16) = 0.104946E+01
+PKER_SWETH( 27, 17) = 0.974450E+00
+PKER_SWETH( 27, 18) = 0.903983E+00
+PKER_SWETH( 27, 19) = 0.837775E+00
+PKER_SWETH( 27, 20) = 0.775555E+00
+PKER_SWETH( 27, 21) = 0.717072E+00
+PKER_SWETH( 27, 22) = 0.662084E+00
+PKER_SWETH( 27, 23) = 0.610364E+00
+PKER_SWETH( 27, 24) = 0.561694E+00
+PKER_SWETH( 27, 25) = 0.515868E+00
+PKER_SWETH( 27, 26) = 0.472688E+00
+PKER_SWETH( 27, 27) = 0.431963E+00
+PKER_SWETH( 27, 28) = 0.393511E+00
+PKER_SWETH( 27, 29) = 0.357155E+00
+PKER_SWETH( 27, 30) = 0.322725E+00
+PKER_SWETH( 27, 31) = 0.290064E+00
+PKER_SWETH( 27, 32) = 0.259024E+00
+PKER_SWETH( 27, 33) = 0.229483E+00
+PKER_SWETH( 27, 34) = 0.201355E+00
+PKER_SWETH( 27, 35) = 0.174615E+00
+PKER_SWETH( 27, 36) = 0.149334E+00
+PKER_SWETH( 27, 37) = 0.125718E+00
+PKER_SWETH( 27, 38) = 0.104127E+00
+PKER_SWETH( 27, 39) = 0.850544E-01
+PKER_SWETH( 27, 40) = 0.690877E-01
+PKER_SWETH( 27, 41) = 0.567360E-01
+PKER_SWETH( 27, 42) = 0.483077E-01
+PKER_SWETH( 27, 43) = 0.438459E-01
+PKER_SWETH( 27, 44) = 0.430396E-01
+PKER_SWETH( 27, 45) = 0.452998E-01
+PKER_SWETH( 27, 46) = 0.499404E-01
+PKER_SWETH( 27, 47) = 0.562217E-01
+PKER_SWETH( 27, 48) = 0.634525E-01
+PKER_SWETH( 27, 49) = 0.711393E-01
+PKER_SWETH( 27, 50) = 0.788981E-01
+PKER_SWETH( 27, 51) = 0.864846E-01
+PKER_SWETH( 27, 52) = 0.937536E-01
+PKER_SWETH( 27, 53) = 0.100637E+00
+PKER_SWETH( 27, 54) = 0.107111E+00
+PKER_SWETH( 27, 55) = 0.113177E+00
+PKER_SWETH( 27, 56) = 0.118852E+00
+PKER_SWETH( 27, 57) = 0.124158E+00
+PKER_SWETH( 27, 58) = 0.129121E+00
+PKER_SWETH( 27, 59) = 0.133764E+00
+PKER_SWETH( 27, 60) = 0.138109E+00
+PKER_SWETH( 27, 61) = 0.142178E+00
+PKER_SWETH( 27, 62) = 0.145991E+00
+PKER_SWETH( 27, 63) = 0.149563E+00
+PKER_SWETH( 27, 64) = 0.152913E+00
+PKER_SWETH( 27, 65) = 0.156054E+00
+PKER_SWETH( 27, 66) = 0.159000E+00
+PKER_SWETH( 27, 67) = 0.161764E+00
+PKER_SWETH( 27, 68) = 0.164357E+00
+PKER_SWETH( 27, 69) = 0.166791E+00
+PKER_SWETH( 27, 70) = 0.169075E+00
+PKER_SWETH( 27, 71) = 0.171219E+00
+PKER_SWETH( 27, 72) = 0.173231E+00
+PKER_SWETH( 27, 73) = 0.175120E+00
+PKER_SWETH( 27, 74) = 0.176893E+00
+PKER_SWETH( 27, 75) = 0.178558E+00
+PKER_SWETH( 27, 76) = 0.180121E+00
+PKER_SWETH( 27, 77) = 0.181588E+00
+PKER_SWETH( 27, 78) = 0.182966E+00
+PKER_SWETH( 27, 79) = 0.184259E+00
+PKER_SWETH( 27, 80) = 0.185474E+00
+PKER_SWETH( 28, 1) = 0.300292E+01
+PKER_SWETH( 28, 2) = 0.281040E+01
+PKER_SWETH( 28, 3) = 0.262963E+01
+PKER_SWETH( 28, 4) = 0.245988E+01
+PKER_SWETH( 28, 5) = 0.230049E+01
+PKER_SWETH( 28, 6) = 0.215082E+01
+PKER_SWETH( 28, 7) = 0.201028E+01
+PKER_SWETH( 28, 8) = 0.187831E+01
+PKER_SWETH( 28, 9) = 0.175438E+01
+PKER_SWETH( 28, 10) = 0.163802E+01
+PKER_SWETH( 28, 11) = 0.152874E+01
+PKER_SWETH( 28, 12) = 0.142612E+01
+PKER_SWETH( 28, 13) = 0.132976E+01
+PKER_SWETH( 28, 14) = 0.123926E+01
+PKER_SWETH( 28, 15) = 0.115426E+01
+PKER_SWETH( 28, 16) = 0.107444E+01
+PKER_SWETH( 28, 17) = 0.999462E+00
+PKER_SWETH( 28, 18) = 0.929033E+00
+PKER_SWETH( 28, 19) = 0.862870E+00
+PKER_SWETH( 28, 20) = 0.800705E+00
+PKER_SWETH( 28, 21) = 0.742287E+00
+PKER_SWETH( 28, 22) = 0.687378E+00
+PKER_SWETH( 28, 23) = 0.635752E+00
+PKER_SWETH( 28, 24) = 0.587197E+00
+PKER_SWETH( 28, 25) = 0.541509E+00
+PKER_SWETH( 28, 26) = 0.498494E+00
+PKER_SWETH( 28, 27) = 0.457967E+00
+PKER_SWETH( 28, 28) = 0.419751E+00
+PKER_SWETH( 28, 29) = 0.383673E+00
+PKER_SWETH( 28, 30) = 0.349569E+00
+PKER_SWETH( 28, 31) = 0.317283E+00
+PKER_SWETH( 28, 32) = 0.286664E+00
+PKER_SWETH( 28, 33) = 0.257572E+00
+PKER_SWETH( 28, 34) = 0.229887E+00
+PKER_SWETH( 28, 35) = 0.203511E+00
+PKER_SWETH( 28, 36) = 0.178386E+00
+PKER_SWETH( 28, 37) = 0.154515E+00
+PKER_SWETH( 28, 38) = 0.131988E+00
+PKER_SWETH( 28, 39) = 0.111005E+00
+PKER_SWETH( 28, 40) = 0.918807E-01
+PKER_SWETH( 28, 41) = 0.750363E-01
+PKER_SWETH( 28, 42) = 0.609249E-01
+PKER_SWETH( 28, 43) = 0.499395E-01
+PKER_SWETH( 28, 44) = 0.423051E-01
+PKER_SWETH( 28, 45) = 0.380232E-01
+PKER_SWETH( 28, 46) = 0.368477E-01
+PKER_SWETH( 28, 47) = 0.383224E-01
+PKER_SWETH( 28, 48) = 0.418693E-01
+PKER_SWETH( 28, 49) = 0.468853E-01
+PKER_SWETH( 28, 50) = 0.528439E-01
+PKER_SWETH( 28, 51) = 0.592713E-01
+PKER_SWETH( 28, 52) = 0.658408E-01
+PKER_SWETH( 28, 53) = 0.723285E-01
+PKER_SWETH( 28, 54) = 0.785904E-01
+PKER_SWETH( 28, 55) = 0.845537E-01
+PKER_SWETH( 28, 56) = 0.901848E-01
+PKER_SWETH( 28, 57) = 0.954771E-01
+PKER_SWETH( 28, 58) = 0.100439E+00
+PKER_SWETH( 28, 59) = 0.105087E+00
+PKER_SWETH( 28, 60) = 0.109439E+00
+PKER_SWETH( 28, 61) = 0.113515E+00
+PKER_SWETH( 28, 62) = 0.117332E+00
+PKER_SWETH( 28, 63) = 0.120909E+00
+PKER_SWETH( 28, 64) = 0.124262E+00
+PKER_SWETH( 28, 65) = 0.127406E+00
+PKER_SWETH( 28, 66) = 0.130355E+00
+PKER_SWETH( 28, 67) = 0.133120E+00
+PKER_SWETH( 28, 68) = 0.135715E+00
+PKER_SWETH( 28, 69) = 0.138149E+00
+PKER_SWETH( 28, 70) = 0.140434E+00
+PKER_SWETH( 28, 71) = 0.142578E+00
+PKER_SWETH( 28, 72) = 0.144591E+00
+PKER_SWETH( 28, 73) = 0.146480E+00
+PKER_SWETH( 28, 74) = 0.148254E+00
+PKER_SWETH( 28, 75) = 0.149919E+00
+PKER_SWETH( 28, 76) = 0.151482E+00
+PKER_SWETH( 28, 77) = 0.152949E+00
+PKER_SWETH( 28, 78) = 0.154327E+00
+PKER_SWETH( 28, 79) = 0.155621E+00
+PKER_SWETH( 28, 80) = 0.156835E+00
+PKER_SWETH( 29, 1) = 0.302428E+01
+PKER_SWETH( 29, 2) = 0.283176E+01
+PKER_SWETH( 29, 3) = 0.265098E+01
+PKER_SWETH( 29, 4) = 0.248124E+01
+PKER_SWETH( 29, 5) = 0.232185E+01
+PKER_SWETH( 29, 6) = 0.217218E+01
+PKER_SWETH( 29, 7) = 0.203165E+01
+PKER_SWETH( 29, 8) = 0.189968E+01
+PKER_SWETH( 29, 9) = 0.177576E+01
+PKER_SWETH( 29, 10) = 0.165940E+01
+PKER_SWETH( 29, 11) = 0.155013E+01
+PKER_SWETH( 29, 12) = 0.144753E+01
+PKER_SWETH( 29, 13) = 0.135117E+01
+PKER_SWETH( 29, 14) = 0.126068E+01
+PKER_SWETH( 29, 15) = 0.117571E+01
+PKER_SWETH( 29, 16) = 0.109590E+01
+PKER_SWETH( 29, 17) = 0.102095E+01
+PKER_SWETH( 29, 18) = 0.950548E+00
+PKER_SWETH( 29, 19) = 0.884419E+00
+PKER_SWETH( 29, 20) = 0.822295E+00
+PKER_SWETH( 29, 21) = 0.763926E+00
+PKER_SWETH( 29, 22) = 0.709077E+00
+PKER_SWETH( 29, 23) = 0.657523E+00
+PKER_SWETH( 29, 24) = 0.609055E+00
+PKER_SWETH( 29, 25) = 0.563470E+00
+PKER_SWETH( 29, 26) = 0.520580E+00
+PKER_SWETH( 29, 27) = 0.480203E+00
+PKER_SWETH( 29, 28) = 0.442165E+00
+PKER_SWETH( 29, 29) = 0.406299E+00
+PKER_SWETH( 29, 30) = 0.372447E+00
+PKER_SWETH( 29, 31) = 0.340455E+00
+PKER_SWETH( 29, 32) = 0.310175E+00
+PKER_SWETH( 29, 33) = 0.281469E+00
+PKER_SWETH( 29, 34) = 0.254205E+00
+PKER_SWETH( 29, 35) = 0.228266E+00
+PKER_SWETH( 29, 36) = 0.203556E+00
+PKER_SWETH( 29, 37) = 0.180007E+00
+PKER_SWETH( 29, 38) = 0.157592E+00
+PKER_SWETH( 29, 39) = 0.136340E+00
+PKER_SWETH( 29, 40) = 0.116352E+00
+PKER_SWETH( 29, 41) = 0.978136E-01
+PKER_SWETH( 29, 42) = 0.809885E-01
+PKER_SWETH( 29, 43) = 0.662043E-01
+PKER_SWETH( 29, 44) = 0.538061E-01
+PKER_SWETH( 29, 45) = 0.440664E-01
+PKER_SWETH( 29, 46) = 0.371573E-01
+PKER_SWETH( 29, 47) = 0.330684E-01
+PKER_SWETH( 29, 48) = 0.315985E-01
+PKER_SWETH( 29, 49) = 0.324092E-01
+PKER_SWETH( 29, 50) = 0.350441E-01
+PKER_SWETH( 29, 51) = 0.390177E-01
+PKER_SWETH( 29, 52) = 0.438760E-01
+PKER_SWETH( 29, 53) = 0.492363E-01
+PKER_SWETH( 29, 54) = 0.548009E-01
+PKER_SWETH( 29, 55) = 0.603500E-01
+PKER_SWETH( 29, 56) = 0.657504E-01
+PKER_SWETH( 29, 57) = 0.709231E-01
+PKER_SWETH( 29, 58) = 0.758271E-01
+PKER_SWETH( 29, 59) = 0.804506E-01
+PKER_SWETH( 29, 60) = 0.847948E-01
+PKER_SWETH( 29, 61) = 0.888701E-01
+PKER_SWETH( 29, 62) = 0.926906E-01
+PKER_SWETH( 29, 63) = 0.962714E-01
+PKER_SWETH( 29, 64) = 0.996278E-01
+PKER_SWETH( 29, 65) = 0.102775E+00
+PKER_SWETH( 29, 66) = 0.105725E+00
+PKER_SWETH( 29, 67) = 0.108493E+00
+PKER_SWETH( 29, 68) = 0.111089E+00
+PKER_SWETH( 29, 69) = 0.113525E+00
+PKER_SWETH( 29, 70) = 0.115810E+00
+PKER_SWETH( 29, 71) = 0.117955E+00
+PKER_SWETH( 29, 72) = 0.119968E+00
+PKER_SWETH( 29, 73) = 0.121858E+00
+PKER_SWETH( 29, 74) = 0.123632E+00
+PKER_SWETH( 29, 75) = 0.125297E+00
+PKER_SWETH( 29, 76) = 0.126860E+00
+PKER_SWETH( 29, 77) = 0.128328E+00
+PKER_SWETH( 29, 78) = 0.129706E+00
+PKER_SWETH( 29, 79) = 0.130999E+00
+PKER_SWETH( 29, 80) = 0.132214E+00
+PKER_SWETH( 30, 1) = 0.304263E+01
+PKER_SWETH( 30, 2) = 0.285012E+01
+PKER_SWETH( 30, 3) = 0.266934E+01
+PKER_SWETH( 30, 4) = 0.249960E+01
+PKER_SWETH( 30, 5) = 0.234021E+01
+PKER_SWETH( 30, 6) = 0.219055E+01
+PKER_SWETH( 30, 7) = 0.205001E+01
+PKER_SWETH( 30, 8) = 0.191805E+01
+PKER_SWETH( 30, 9) = 0.179414E+01
+PKER_SWETH( 30, 10) = 0.167778E+01
+PKER_SWETH( 30, 11) = 0.156852E+01
+PKER_SWETH( 30, 12) = 0.146592E+01
+PKER_SWETH( 30, 13) = 0.136957E+01
+PKER_SWETH( 30, 14) = 0.127910E+01
+PKER_SWETH( 30, 15) = 0.119413E+01
+PKER_SWETH( 30, 16) = 0.111434E+01
+PKER_SWETH( 30, 17) = 0.103941E+01
+PKER_SWETH( 30, 18) = 0.969029E+00
+PKER_SWETH( 30, 19) = 0.902926E+00
+PKER_SWETH( 30, 20) = 0.840833E+00
+PKER_SWETH( 30, 21) = 0.782502E+00
+PKER_SWETH( 30, 22) = 0.727698E+00
+PKER_SWETH( 30, 23) = 0.676199E+00
+PKER_SWETH( 30, 24) = 0.627795E+00
+PKER_SWETH( 30, 25) = 0.582290E+00
+PKER_SWETH( 30, 26) = 0.539494E+00
+PKER_SWETH( 30, 27) = 0.499230E+00
+PKER_SWETH( 30, 28) = 0.461327E+00
+PKER_SWETH( 30, 29) = 0.425623E+00
+PKER_SWETH( 30, 30) = 0.391964E+00
+PKER_SWETH( 30, 31) = 0.360198E+00
+PKER_SWETH( 30, 32) = 0.330184E+00
+PKER_SWETH( 30, 33) = 0.301784E+00
+PKER_SWETH( 30, 34) = 0.274868E+00
+PKER_SWETH( 30, 35) = 0.249313E+00
+PKER_SWETH( 30, 36) = 0.225011E+00
+PKER_SWETH( 30, 37) = 0.201868E+00
+PKER_SWETH( 30, 38) = 0.179815E+00
+PKER_SWETH( 30, 39) = 0.158815E+00
+PKER_SWETH( 30, 40) = 0.138868E+00
+PKER_SWETH( 30, 41) = 0.120024E+00
+PKER_SWETH( 30, 42) = 0.102388E+00
+PKER_SWETH( 30, 43) = 0.861144E-01
+PKER_SWETH( 30, 44) = 0.714080E-01
+PKER_SWETH( 30, 45) = 0.585069E-01
+PKER_SWETH( 30, 46) = 0.476515E-01
+PKER_SWETH( 30, 47) = 0.390335E-01
+PKER_SWETH( 30, 48) = 0.327743E-01
+PKER_SWETH( 30, 49) = 0.288723E-01
+PKER_SWETH( 30, 50) = 0.271805E-01
+PKER_SWETH( 30, 51) = 0.274431E-01
+PKER_SWETH( 30, 52) = 0.293182E-01
+PKER_SWETH( 30, 53) = 0.324139E-01
+PKER_SWETH( 30, 54) = 0.363508E-01
+PKER_SWETH( 30, 55) = 0.408047E-01
+PKER_SWETH( 30, 56) = 0.455006E-01
+PKER_SWETH( 30, 57) = 0.502456E-01
+PKER_SWETH( 30, 58) = 0.549025E-01
+PKER_SWETH( 30, 59) = 0.593913E-01
+PKER_SWETH( 30, 60) = 0.636662E-01
+PKER_SWETH( 30, 61) = 0.677085E-01
+PKER_SWETH( 30, 62) = 0.715153E-01
+PKER_SWETH( 30, 63) = 0.750918E-01
+PKER_SWETH( 30, 64) = 0.784481E-01
+PKER_SWETH( 30, 65) = 0.815963E-01
+PKER_SWETH( 30, 66) = 0.845489E-01
+PKER_SWETH( 30, 67) = 0.873181E-01
+PKER_SWETH( 30, 68) = 0.899158E-01
+PKER_SWETH( 30, 69) = 0.923528E-01
+PKER_SWETH( 30, 70) = 0.946394E-01
+PKER_SWETH( 30, 71) = 0.967852E-01
+PKER_SWETH( 30, 72) = 0.987990E-01
+PKER_SWETH( 30, 73) = 0.100689E+00
+PKER_SWETH( 30, 74) = 0.102463E+00
+PKER_SWETH( 30, 75) = 0.104129E+00
+PKER_SWETH( 30, 76) = 0.105692E+00
+PKER_SWETH( 30, 77) = 0.107160E+00
+PKER_SWETH( 30, 78) = 0.108538E+00
+PKER_SWETH( 30, 79) = 0.109832E+00
+PKER_SWETH( 30, 80) = 0.111046E+00
+PKER_SWETH( 31, 1) = 0.305841E+01
+PKER_SWETH( 31, 2) = 0.286590E+01
+PKER_SWETH( 31, 3) = 0.268513E+01
+PKER_SWETH( 31, 4) = 0.251539E+01
+PKER_SWETH( 31, 5) = 0.235600E+01
+PKER_SWETH( 31, 6) = 0.220634E+01
+PKER_SWETH( 31, 7) = 0.206581E+01
+PKER_SWETH( 31, 8) = 0.193385E+01
+PKER_SWETH( 31, 9) = 0.180994E+01
+PKER_SWETH( 31, 10) = 0.169358E+01
+PKER_SWETH( 31, 11) = 0.158433E+01
+PKER_SWETH( 31, 12) = 0.148173E+01
+PKER_SWETH( 31, 13) = 0.138539E+01
+PKER_SWETH( 31, 14) = 0.129492E+01
+PKER_SWETH( 31, 15) = 0.120997E+01
+PKER_SWETH( 31, 16) = 0.113019E+01
+PKER_SWETH( 31, 17) = 0.105527E+01
+PKER_SWETH( 31, 18) = 0.984906E+00
+PKER_SWETH( 31, 19) = 0.918822E+00
+PKER_SWETH( 31, 20) = 0.856754E+00
+PKER_SWETH( 31, 21) = 0.798451E+00
+PKER_SWETH( 31, 22) = 0.743681E+00
+PKER_SWETH( 31, 23) = 0.692223E+00
+PKER_SWETH( 31, 24) = 0.643870E+00
+PKER_SWETH( 31, 25) = 0.598424E+00
+PKER_SWETH( 31, 26) = 0.555700E+00
+PKER_SWETH( 31, 27) = 0.515521E+00
+PKER_SWETH( 31, 28) = 0.477722E+00
+PKER_SWETH( 31, 29) = 0.442141E+00
+PKER_SWETH( 31, 30) = 0.408628E+00
+PKER_SWETH( 31, 31) = 0.377036E+00
+PKER_SWETH( 31, 32) = 0.347228E+00
+PKER_SWETH( 31, 33) = 0.319067E+00
+PKER_SWETH( 31, 34) = 0.292428E+00
+PKER_SWETH( 31, 35) = 0.267187E+00
+PKER_SWETH( 31, 36) = 0.243232E+00
+PKER_SWETH( 31, 37) = 0.220461E+00
+PKER_SWETH( 31, 38) = 0.198785E+00
+PKER_SWETH( 31, 39) = 0.178137E+00
+PKER_SWETH( 31, 40) = 0.158477E+00
+PKER_SWETH( 31, 41) = 0.139795E+00
+PKER_SWETH( 31, 42) = 0.122116E+00
+PKER_SWETH( 31, 43) = 0.105498E+00
+PKER_SWETH( 31, 44) = 0.900345E-01
+PKER_SWETH( 31, 45) = 0.758410E-01
+PKER_SWETH( 31, 46) = 0.630589E-01
+PKER_SWETH( 31, 47) = 0.518477E-01
+PKER_SWETH( 31, 48) = 0.423630E-01
+PKER_SWETH( 31, 49) = 0.347372E-01
+PKER_SWETH( 31, 50) = 0.290641E-01
+PKER_SWETH( 31, 51) = 0.253414E-01
+PKER_SWETH( 31, 52) = 0.234859E-01
+PKER_SWETH( 31, 53) = 0.233114E-01
+PKER_SWETH( 31, 54) = 0.245489E-01
+PKER_SWETH( 31, 55) = 0.269042E-01
+PKER_SWETH( 31, 56) = 0.300674E-01
+PKER_SWETH( 31, 57) = 0.337384E-01
+PKER_SWETH( 31, 58) = 0.376964E-01
+PKER_SWETH( 31, 59) = 0.417445E-01
+PKER_SWETH( 31, 60) = 0.457577E-01
+PKER_SWETH( 31, 61) = 0.496524E-01
+PKER_SWETH( 31, 62) = 0.533798E-01
+PKER_SWETH( 31, 63) = 0.569162E-01
+PKER_SWETH( 31, 64) = 0.602537E-01
+PKER_SWETH( 31, 65) = 0.633942E-01
+PKER_SWETH( 31, 66) = 0.663443E-01
+PKER_SWETH( 31, 67) = 0.691135E-01
+PKER_SWETH( 31, 68) = 0.717119E-01
+PKER_SWETH( 31, 69) = 0.741499E-01
+PKER_SWETH( 31, 70) = 0.764375E-01
+PKER_SWETH( 31, 71) = 0.785841E-01
+PKER_SWETH( 31, 72) = 0.805986E-01
+PKER_SWETH( 31, 73) = 0.824892E-01
+PKER_SWETH( 31, 74) = 0.842638E-01
+PKER_SWETH( 31, 75) = 0.859296E-01
+PKER_SWETH( 31, 76) = 0.874932E-01
+PKER_SWETH( 31, 77) = 0.889612E-01
+PKER_SWETH( 31, 78) = 0.903393E-01
+PKER_SWETH( 31, 79) = 0.916331E-01
+PKER_SWETH( 31, 80) = 0.928478E-01
+PKER_SWETH( 32, 1) = 0.307198E+01
+PKER_SWETH( 32, 2) = 0.287947E+01
+PKER_SWETH( 32, 3) = 0.269870E+01
+PKER_SWETH( 32, 4) = 0.252896E+01
+PKER_SWETH( 32, 5) = 0.236957E+01
+PKER_SWETH( 32, 6) = 0.221991E+01
+PKER_SWETH( 32, 7) = 0.207938E+01
+PKER_SWETH( 32, 8) = 0.194742E+01
+PKER_SWETH( 32, 9) = 0.182351E+01
+PKER_SWETH( 32, 10) = 0.170716E+01
+PKER_SWETH( 32, 11) = 0.159791E+01
+PKER_SWETH( 32, 12) = 0.149532E+01
+PKER_SWETH( 32, 13) = 0.139899E+01
+PKER_SWETH( 32, 14) = 0.130853E+01
+PKER_SWETH( 32, 15) = 0.122358E+01
+PKER_SWETH( 32, 16) = 0.114381E+01
+PKER_SWETH( 32, 17) = 0.106890E+01
+PKER_SWETH( 32, 18) = 0.998547E+00
+PKER_SWETH( 32, 19) = 0.932479E+00
+PKER_SWETH( 32, 20) = 0.870428E+00
+PKER_SWETH( 32, 21) = 0.812147E+00
+PKER_SWETH( 32, 22) = 0.757404E+00
+PKER_SWETH( 32, 23) = 0.705977E+00
+PKER_SWETH( 32, 24) = 0.657662E+00
+PKER_SWETH( 32, 25) = 0.612261E+00
+PKER_SWETH( 32, 26) = 0.569591E+00
+PKER_SWETH( 32, 27) = 0.529478E+00
+PKER_SWETH( 32, 28) = 0.491757E+00
+PKER_SWETH( 32, 29) = 0.456270E+00
+PKER_SWETH( 32, 30) = 0.422869E+00
+PKER_SWETH( 32, 31) = 0.391411E+00
+PKER_SWETH( 32, 32) = 0.361760E+00
+PKER_SWETH( 32, 33) = 0.333785E+00
+PKER_SWETH( 32, 34) = 0.307363E+00
+PKER_SWETH( 32, 35) = 0.282372E+00
+PKER_SWETH( 32, 36) = 0.258701E+00
+PKER_SWETH( 32, 37) = 0.236242E+00
+PKER_SWETH( 32, 38) = 0.214902E+00
+PKER_SWETH( 32, 39) = 0.194597E+00
+PKER_SWETH( 32, 40) = 0.175263E+00
+PKER_SWETH( 32, 41) = 0.156861E+00
+PKER_SWETH( 32, 42) = 0.139376E+00
+PKER_SWETH( 32, 43) = 0.122822E+00
+PKER_SWETH( 32, 44) = 0.107235E+00
+PKER_SWETH( 32, 45) = 0.926714E-01
+PKER_SWETH( 32, 46) = 0.791985E-01
+PKER_SWETH( 32, 47) = 0.668908E-01
+PKER_SWETH( 32, 48) = 0.558298E-01
+PKER_SWETH( 32, 49) = 0.461095E-01
+PKER_SWETH( 32, 50) = 0.378288E-01
+PKER_SWETH( 32, 51) = 0.310726E-01
+PKER_SWETH( 32, 52) = 0.259224E-01
+PKER_SWETH( 32, 53) = 0.223881E-01
+PKER_SWETH( 32, 54) = 0.204125E-01
+PKER_SWETH( 32, 55) = 0.198855E-01
+PKER_SWETH( 32, 56) = 0.206112E-01
+PKER_SWETH( 32, 57) = 0.223423E-01
+PKER_SWETH( 32, 58) = 0.248393E-01
+PKER_SWETH( 32, 59) = 0.278564E-01
+PKER_SWETH( 32, 60) = 0.311658E-01
+PKER_SWETH( 32, 61) = 0.346111E-01
+PKER_SWETH( 32, 62) = 0.380645E-01
+PKER_SWETH( 32, 63) = 0.414420E-01
+PKER_SWETH( 32, 64) = 0.446910E-01
+PKER_SWETH( 32, 65) = 0.477849E-01
+PKER_SWETH( 32, 66) = 0.507120E-01
+PKER_SWETH( 32, 67) = 0.534705E-01
+PKER_SWETH( 32, 68) = 0.560645E-01
+PKER_SWETH( 32, 69) = 0.585012E-01
+PKER_SWETH( 32, 70) = 0.607887E-01
+PKER_SWETH( 32, 71) = 0.629357E-01
+PKER_SWETH( 32, 72) = 0.649507E-01
+PKER_SWETH( 32, 73) = 0.668419E-01
+PKER_SWETH( 32, 74) = 0.686169E-01
+PKER_SWETH( 32, 75) = 0.702830E-01
+PKER_SWETH( 32, 76) = 0.718470E-01
+PKER_SWETH( 32, 77) = 0.733151E-01
+PKER_SWETH( 32, 78) = 0.746934E-01
+PKER_SWETH( 32, 79) = 0.759873E-01
+PKER_SWETH( 32, 80) = 0.772022E-01
+PKER_SWETH( 33, 1) = 0.308365E+01
+PKER_SWETH( 33, 2) = 0.289113E+01
+PKER_SWETH( 33, 3) = 0.271036E+01
+PKER_SWETH( 33, 4) = 0.254062E+01
+PKER_SWETH( 33, 5) = 0.238124E+01
+PKER_SWETH( 33, 6) = 0.223158E+01
+PKER_SWETH( 33, 7) = 0.209105E+01
+PKER_SWETH( 33, 8) = 0.195909E+01
+PKER_SWETH( 33, 9) = 0.183519E+01
+PKER_SWETH( 33, 10) = 0.171884E+01
+PKER_SWETH( 33, 11) = 0.160959E+01
+PKER_SWETH( 33, 12) = 0.150700E+01
+PKER_SWETH( 33, 13) = 0.141067E+01
+PKER_SWETH( 33, 14) = 0.132022E+01
+PKER_SWETH( 33, 15) = 0.123527E+01
+PKER_SWETH( 33, 16) = 0.115551E+01
+PKER_SWETH( 33, 17) = 0.108061E+01
+PKER_SWETH( 33, 18) = 0.101027E+01
+PKER_SWETH( 33, 19) = 0.944211E+00
+PKER_SWETH( 33, 20) = 0.882174E+00
+PKER_SWETH( 33, 21) = 0.823911E+00
+PKER_SWETH( 33, 22) = 0.769187E+00
+PKER_SWETH( 33, 23) = 0.717785E+00
+PKER_SWETH( 33, 24) = 0.669498E+00
+PKER_SWETH( 33, 25) = 0.624132E+00
+PKER_SWETH( 33, 26) = 0.581504E+00
+PKER_SWETH( 33, 27) = 0.541441E+00
+PKER_SWETH( 33, 28) = 0.503779E+00
+PKER_SWETH( 33, 29) = 0.468364E+00
+PKER_SWETH( 33, 30) = 0.435048E+00
+PKER_SWETH( 33, 31) = 0.403692E+00
+PKER_SWETH( 33, 32) = 0.374162E+00
+PKER_SWETH( 33, 33) = 0.346331E+00
+PKER_SWETH( 33, 34) = 0.320078E+00
+PKER_SWETH( 33, 35) = 0.295284E+00
+PKER_SWETH( 33, 36) = 0.271839E+00
+PKER_SWETH( 33, 37) = 0.249637E+00
+PKER_SWETH( 33, 38) = 0.228579E+00
+PKER_SWETH( 33, 39) = 0.208576E+00
+PKER_SWETH( 33, 40) = 0.189552E+00
+PKER_SWETH( 33, 41) = 0.171446E+00
+PKER_SWETH( 33, 42) = 0.154219E+00
+PKER_SWETH( 33, 43) = 0.137857E+00
+PKER_SWETH( 33, 44) = 0.122365E+00
+PKER_SWETH( 33, 45) = 0.107772E+00
+PKER_SWETH( 33, 46) = 0.941135E-01
+PKER_SWETH( 33, 47) = 0.814306E-01
+PKER_SWETH( 33, 48) = 0.697596E-01
+PKER_SWETH( 33, 49) = 0.591329E-01
+PKER_SWETH( 33, 50) = 0.495874E-01
+PKER_SWETH( 33, 51) = 0.411680E-01
+PKER_SWETH( 33, 52) = 0.339301E-01
+PKER_SWETH( 33, 53) = 0.279413E-01
+PKER_SWETH( 33, 54) = 0.232585E-01
+PKER_SWETH( 33, 55) = 0.199094E-01
+PKER_SWETH( 33, 56) = 0.178713E-01
+PKER_SWETH( 33, 57) = 0.170702E-01
+PKER_SWETH( 33, 58) = 0.173718E-01
+PKER_SWETH( 33, 59) = 0.185930E-01
+PKER_SWETH( 33, 60) = 0.205264E-01
+PKER_SWETH( 33, 61) = 0.229634E-01
+PKER_SWETH( 33, 62) = 0.257251E-01
+PKER_SWETH( 33, 63) = 0.286451E-01
+PKER_SWETH( 33, 64) = 0.316079E-01
+PKER_SWETH( 33, 65) = 0.345319E-01
+PKER_SWETH( 33, 66) = 0.373616E-01
+PKER_SWETH( 33, 67) = 0.400676E-01
+PKER_SWETH( 33, 68) = 0.426346E-01
+PKER_SWETH( 33, 69) = 0.450580E-01
+PKER_SWETH( 33, 70) = 0.473394E-01
+PKER_SWETH( 33, 71) = 0.494840E-01
+PKER_SWETH( 33, 72) = 0.514983E-01
+PKER_SWETH( 33, 73) = 0.533894E-01
+PKER_SWETH( 33, 74) = 0.551646E-01
+PKER_SWETH( 33, 75) = 0.568310E-01
+PKER_SWETH( 33, 76) = 0.583952E-01
+PKER_SWETH( 33, 77) = 0.598636E-01
+PKER_SWETH( 33, 78) = 0.612421E-01
+PKER_SWETH( 33, 79) = 0.625362E-01
+PKER_SWETH( 33, 80) = 0.637511E-01
+PKER_SWETH( 34, 1) = 0.309367E+01
+PKER_SWETH( 34, 2) = 0.290116E+01
+PKER_SWETH( 34, 3) = 0.272039E+01
+PKER_SWETH( 34, 4) = 0.255065E+01
+PKER_SWETH( 34, 5) = 0.239127E+01
+PKER_SWETH( 34, 6) = 0.224161E+01
+PKER_SWETH( 34, 7) = 0.210108E+01
+PKER_SWETH( 34, 8) = 0.196913E+01
+PKER_SWETH( 34, 9) = 0.184522E+01
+PKER_SWETH( 34, 10) = 0.172888E+01
+PKER_SWETH( 34, 11) = 0.161963E+01
+PKER_SWETH( 34, 12) = 0.151704E+01
+PKER_SWETH( 34, 13) = 0.142072E+01
+PKER_SWETH( 34, 14) = 0.133026E+01
+PKER_SWETH( 34, 15) = 0.124533E+01
+PKER_SWETH( 34, 16) = 0.116557E+01
+PKER_SWETH( 34, 17) = 0.109067E+01
+PKER_SWETH( 34, 18) = 0.102034E+01
+PKER_SWETH( 34, 19) = 0.954292E+00
+PKER_SWETH( 34, 20) = 0.892266E+00
+PKER_SWETH( 34, 21) = 0.834015E+00
+PKER_SWETH( 34, 22) = 0.779307E+00
+PKER_SWETH( 34, 23) = 0.727923E+00
+PKER_SWETH( 34, 24) = 0.679659E+00
+PKER_SWETH( 34, 25) = 0.634319E+00
+PKER_SWETH( 34, 26) = 0.591723E+00
+PKER_SWETH( 34, 27) = 0.551698E+00
+PKER_SWETH( 34, 28) = 0.514082E+00
+PKER_SWETH( 34, 29) = 0.478721E+00
+PKER_SWETH( 34, 30) = 0.445471E+00
+PKER_SWETH( 34, 31) = 0.414193E+00
+PKER_SWETH( 34, 32) = 0.384756E+00
+PKER_SWETH( 34, 33) = 0.357036E+00
+PKER_SWETH( 34, 34) = 0.330913E+00
+PKER_SWETH( 34, 35) = 0.306273E+00
+PKER_SWETH( 34, 36) = 0.283006E+00
+PKER_SWETH( 34, 37) = 0.261009E+00
+PKER_SWETH( 34, 38) = 0.240184E+00
+PKER_SWETH( 34, 39) = 0.220436E+00
+PKER_SWETH( 34, 40) = 0.201685E+00
+PKER_SWETH( 34, 41) = 0.183858E+00
+PKER_SWETH( 34, 42) = 0.166898E+00
+PKER_SWETH( 34, 43) = 0.150769E+00
+PKER_SWETH( 34, 44) = 0.135455E+00
+PKER_SWETH( 34, 45) = 0.120960E+00
+PKER_SWETH( 34, 46) = 0.107304E+00
+PKER_SWETH( 34, 47) = 0.945159E-01
+PKER_SWETH( 34, 48) = 0.826218E-01
+PKER_SWETH( 34, 49) = 0.716384E-01
+PKER_SWETH( 34, 50) = 0.615720E-01
+PKER_SWETH( 34, 51) = 0.524221E-01
+PKER_SWETH( 34, 52) = 0.441914E-01
+PKER_SWETH( 34, 53) = 0.368950E-01
+PKER_SWETH( 34, 54) = 0.305630E-01
+PKER_SWETH( 34, 55) = 0.252431E-01
+PKER_SWETH( 34, 56) = 0.209881E-01
+PKER_SWETH( 34, 57) = 0.178255E-01
+PKER_SWETH( 34, 58) = 0.157648E-01
+PKER_SWETH( 34, 59) = 0.147630E-01
+PKER_SWETH( 34, 60) = 0.147237E-01
+PKER_SWETH( 34, 61) = 0.155170E-01
+PKER_SWETH( 34, 62) = 0.169756E-01
+PKER_SWETH( 34, 63) = 0.189247E-01
+PKER_SWETH( 34, 64) = 0.212006E-01
+PKER_SWETH( 34, 65) = 0.236626E-01
+PKER_SWETH( 34, 66) = 0.261994E-01
+PKER_SWETH( 34, 67) = 0.287254E-01
+PKER_SWETH( 34, 68) = 0.311875E-01
+PKER_SWETH( 34, 69) = 0.335528E-01
+PKER_SWETH( 34, 70) = 0.358031E-01
+PKER_SWETH( 34, 71) = 0.379320E-01
+PKER_SWETH( 34, 72) = 0.399386E-01
+PKER_SWETH( 34, 73) = 0.418263E-01
+PKER_SWETH( 34, 74) = 0.436002E-01
+PKER_SWETH( 34, 75) = 0.452662E-01
+PKER_SWETH( 34, 76) = 0.468304E-01
+PKER_SWETH( 34, 77) = 0.482989E-01
+PKER_SWETH( 34, 78) = 0.496775E-01
+PKER_SWETH( 34, 79) = 0.509718E-01
+PKER_SWETH( 34, 80) = 0.521868E-01
+PKER_SWETH( 35, 1) = 0.310229E+01
+PKER_SWETH( 35, 2) = 0.290978E+01
+PKER_SWETH( 35, 3) = 0.272901E+01
+PKER_SWETH( 35, 4) = 0.255927E+01
+PKER_SWETH( 35, 5) = 0.239989E+01
+PKER_SWETH( 35, 6) = 0.225023E+01
+PKER_SWETH( 35, 7) = 0.210971E+01
+PKER_SWETH( 35, 8) = 0.197775E+01
+PKER_SWETH( 35, 9) = 0.185385E+01
+PKER_SWETH( 35, 10) = 0.173750E+01
+PKER_SWETH( 35, 11) = 0.162826E+01
+PKER_SWETH( 35, 12) = 0.152568E+01
+PKER_SWETH( 35, 13) = 0.142935E+01
+PKER_SWETH( 35, 14) = 0.133890E+01
+PKER_SWETH( 35, 15) = 0.125397E+01
+PKER_SWETH( 35, 16) = 0.117421E+01
+PKER_SWETH( 35, 17) = 0.109932E+01
+PKER_SWETH( 35, 18) = 0.102899E+01
+PKER_SWETH( 35, 19) = 0.962954E+00
+PKER_SWETH( 35, 20) = 0.900936E+00
+PKER_SWETH( 35, 21) = 0.842695E+00
+PKER_SWETH( 35, 22) = 0.787999E+00
+PKER_SWETH( 35, 23) = 0.736630E+00
+PKER_SWETH( 35, 24) = 0.688382E+00
+PKER_SWETH( 35, 25) = 0.643063E+00
+PKER_SWETH( 35, 26) = 0.600491E+00
+PKER_SWETH( 35, 27) = 0.560496E+00
+PKER_SWETH( 35, 28) = 0.522915E+00
+PKER_SWETH( 35, 29) = 0.487596E+00
+PKER_SWETH( 35, 30) = 0.454396E+00
+PKER_SWETH( 35, 31) = 0.423178E+00
+PKER_SWETH( 35, 32) = 0.393812E+00
+PKER_SWETH( 35, 33) = 0.366177E+00
+PKER_SWETH( 35, 34) = 0.340155E+00
+PKER_SWETH( 35, 35) = 0.315634E+00
+PKER_SWETH( 35, 36) = 0.292507E+00
+PKER_SWETH( 35, 37) = 0.270673E+00
+PKER_SWETH( 35, 38) = 0.250034E+00
+PKER_SWETH( 35, 39) = 0.230497E+00
+PKER_SWETH( 35, 40) = 0.211978E+00
+PKER_SWETH( 35, 41) = 0.194397E+00
+PKER_SWETH( 35, 42) = 0.177688E+00
+PKER_SWETH( 35, 43) = 0.161799E+00
+PKER_SWETH( 35, 44) = 0.146695E+00
+PKER_SWETH( 35, 45) = 0.132358E+00
+PKER_SWETH( 35, 46) = 0.118793E+00
+PKER_SWETH( 35, 47) = 0.106016E+00
+PKER_SWETH( 35, 48) = 0.940490E-01
+PKER_SWETH( 35, 49) = 0.829116E-01
+PKER_SWETH( 35, 50) = 0.726109E-01
+PKER_SWETH( 35, 51) = 0.631403E-01
+PKER_SWETH( 35, 52) = 0.544809E-01
+PKER_SWETH( 35, 53) = 0.466098E-01
+PKER_SWETH( 35, 54) = 0.395099E-01
+PKER_SWETH( 35, 55) = 0.331777E-01
+PKER_SWETH( 35, 56) = 0.276290E-01
+PKER_SWETH( 35, 57) = 0.228990E-01
+PKER_SWETH( 35, 58) = 0.190322E-01
+PKER_SWETH( 35, 59) = 0.160626E-01
+PKER_SWETH( 35, 60) = 0.140126E-01
+PKER_SWETH( 35, 61) = 0.128671E-01
+PKER_SWETH( 35, 62) = 0.125631E-01
+PKER_SWETH( 35, 63) = 0.130040E-01
+PKER_SWETH( 35, 64) = 0.140640E-01
+PKER_SWETH( 35, 65) = 0.155956E-01
+PKER_SWETH( 35, 66) = 0.174553E-01
+PKER_SWETH( 35, 67) = 0.195193E-01
+PKER_SWETH( 35, 68) = 0.216784E-01
+PKER_SWETH( 35, 69) = 0.238555E-01
+PKER_SWETH( 35, 70) = 0.259938E-01
+PKER_SWETH( 35, 71) = 0.280589E-01
+PKER_SWETH( 35, 72) = 0.300308E-01
+PKER_SWETH( 35, 73) = 0.319003E-01
+PKER_SWETH( 35, 74) = 0.336651E-01
+PKER_SWETH( 35, 75) = 0.353268E-01
+PKER_SWETH( 35, 76) = 0.368892E-01
+PKER_SWETH( 35, 77) = 0.383569E-01
+PKER_SWETH( 35, 78) = 0.397353E-01
+PKER_SWETH( 35, 79) = 0.410295E-01
+PKER_SWETH( 35, 80) = 0.422447E-01
+PKER_SWETH( 36, 1) = 0.310970E+01
+PKER_SWETH( 36, 2) = 0.291719E+01
+PKER_SWETH( 36, 3) = 0.273642E+01
+PKER_SWETH( 36, 4) = 0.256668E+01
+PKER_SWETH( 36, 5) = 0.240730E+01
+PKER_SWETH( 36, 6) = 0.225765E+01
+PKER_SWETH( 36, 7) = 0.211712E+01
+PKER_SWETH( 36, 8) = 0.198517E+01
+PKER_SWETH( 36, 9) = 0.186126E+01
+PKER_SWETH( 36, 10) = 0.174492E+01
+PKER_SWETH( 36, 11) = 0.163568E+01
+PKER_SWETH( 36, 12) = 0.153310E+01
+PKER_SWETH( 36, 13) = 0.143677E+01
+PKER_SWETH( 36, 14) = 0.134632E+01
+PKER_SWETH( 36, 15) = 0.126139E+01
+PKER_SWETH( 36, 16) = 0.118164E+01
+PKER_SWETH( 36, 17) = 0.110675E+01
+PKER_SWETH( 36, 18) = 0.103643E+01
+PKER_SWETH( 36, 19) = 0.970397E+00
+PKER_SWETH( 36, 20) = 0.908386E+00
+PKER_SWETH( 36, 21) = 0.850153E+00
+PKER_SWETH( 36, 22) = 0.795466E+00
+PKER_SWETH( 36, 23) = 0.744108E+00
+PKER_SWETH( 36, 24) = 0.695873E+00
+PKER_SWETH( 36, 25) = 0.650570E+00
+PKER_SWETH( 36, 26) = 0.608017E+00
+PKER_SWETH( 36, 27) = 0.568044E+00
+PKER_SWETH( 36, 28) = 0.530490E+00
+PKER_SWETH( 36, 29) = 0.495203E+00
+PKER_SWETH( 36, 30) = 0.462042E+00
+PKER_SWETH( 36, 31) = 0.430869E+00
+PKER_SWETH( 36, 32) = 0.401559E+00
+PKER_SWETH( 36, 33) = 0.373989E+00
+PKER_SWETH( 36, 34) = 0.348045E+00
+PKER_SWETH( 36, 35) = 0.323616E+00
+PKER_SWETH( 36, 36) = 0.300599E+00
+PKER_SWETH( 36, 37) = 0.278892E+00
+PKER_SWETH( 36, 38) = 0.258401E+00
+PKER_SWETH( 36, 39) = 0.239034E+00
+PKER_SWETH( 36, 40) = 0.220706E+00
+PKER_SWETH( 36, 41) = 0.203335E+00
+PKER_SWETH( 36, 42) = 0.186850E+00
+PKER_SWETH( 36, 43) = 0.171188E+00
+PKER_SWETH( 36, 44) = 0.156300E+00
+PKER_SWETH( 36, 45) = 0.142151E+00
+PKER_SWETH( 36, 46) = 0.128727E+00
+PKER_SWETH( 36, 47) = 0.116029E+00
+PKER_SWETH( 36, 48) = 0.104072E+00
+PKER_SWETH( 36, 49) = 0.928735E-01
+PKER_SWETH( 36, 50) = 0.824495E-01
+PKER_SWETH( 36, 51) = 0.728026E-01
+PKER_SWETH( 36, 52) = 0.639198E-01
+PKER_SWETH( 36, 53) = 0.557752E-01
+PKER_SWETH( 36, 54) = 0.483333E-01
+PKER_SWETH( 36, 55) = 0.415587E-01
+PKER_SWETH( 36, 56) = 0.354254E-01
+PKER_SWETH( 36, 57) = 0.299195E-01
+PKER_SWETH( 36, 58) = 0.250483E-01
+PKER_SWETH( 36, 59) = 0.208397E-01
+PKER_SWETH( 36, 60) = 0.173299E-01
+PKER_SWETH( 36, 61) = 0.145557E-01
+PKER_SWETH( 36, 62) = 0.125495E-01
+PKER_SWETH( 36, 63) = 0.113080E-01
+PKER_SWETH( 36, 64) = 0.108016E-01
+PKER_SWETH( 36, 65) = 0.109613E-01
+PKER_SWETH( 36, 66) = 0.116849E-01
+PKER_SWETH( 36, 67) = 0.128598E-01
+PKER_SWETH( 36, 68) = 0.143640E-01
+PKER_SWETH( 36, 69) = 0.160768E-01
+PKER_SWETH( 36, 70) = 0.179090E-01
+PKER_SWETH( 36, 71) = 0.197779E-01
+PKER_SWETH( 36, 72) = 0.216309E-01
+PKER_SWETH( 36, 73) = 0.234315E-01
+PKER_SWETH( 36, 74) = 0.251579E-01
+PKER_SWETH( 36, 75) = 0.267991E-01
+PKER_SWETH( 36, 76) = 0.283509E-01
+PKER_SWETH( 36, 77) = 0.298135E-01
+PKER_SWETH( 36, 78) = 0.311895E-01
+PKER_SWETH( 36, 79) = 0.324827E-01
+PKER_SWETH( 36, 80) = 0.336974E-01
+PKER_SWETH( 37, 1) = 0.311608E+01
+PKER_SWETH( 37, 2) = 0.292356E+01
+PKER_SWETH( 37, 3) = 0.274280E+01
+PKER_SWETH( 37, 4) = 0.257306E+01
+PKER_SWETH( 37, 5) = 0.241368E+01
+PKER_SWETH( 37, 6) = 0.226402E+01
+PKER_SWETH( 37, 7) = 0.212349E+01
+PKER_SWETH( 37, 8) = 0.199154E+01
+PKER_SWETH( 37, 9) = 0.186764E+01
+PKER_SWETH( 37, 10) = 0.175130E+01
+PKER_SWETH( 37, 11) = 0.164205E+01
+PKER_SWETH( 37, 12) = 0.153947E+01
+PKER_SWETH( 37, 13) = 0.144315E+01
+PKER_SWETH( 37, 14) = 0.135271E+01
+PKER_SWETH( 37, 15) = 0.126778E+01
+PKER_SWETH( 37, 16) = 0.118803E+01
+PKER_SWETH( 37, 17) = 0.111314E+01
+PKER_SWETH( 37, 18) = 0.104282E+01
+PKER_SWETH( 37, 19) = 0.976794E+00
+PKER_SWETH( 37, 20) = 0.914788E+00
+PKER_SWETH( 37, 21) = 0.856560E+00
+PKER_SWETH( 37, 22) = 0.801881E+00
+PKER_SWETH( 37, 23) = 0.750531E+00
+PKER_SWETH( 37, 24) = 0.702307E+00
+PKER_SWETH( 37, 25) = 0.657016E+00
+PKER_SWETH( 37, 26) = 0.614477E+00
+PKER_SWETH( 37, 27) = 0.574521E+00
+PKER_SWETH( 37, 28) = 0.536988E+00
+PKER_SWETH( 37, 29) = 0.501726E+00
+PKER_SWETH( 37, 30) = 0.468594E+00
+PKER_SWETH( 37, 31) = 0.437458E+00
+PKER_SWETH( 37, 32) = 0.408190E+00
+PKER_SWETH( 37, 33) = 0.380671E+00
+PKER_SWETH( 37, 34) = 0.354786E+00
+PKER_SWETH( 37, 35) = 0.330429E+00
+PKER_SWETH( 37, 36) = 0.307496E+00
+PKER_SWETH( 37, 37) = 0.285889E+00
+PKER_SWETH( 37, 38) = 0.265514E+00
+PKER_SWETH( 37, 39) = 0.246283E+00
+PKER_SWETH( 37, 40) = 0.228109E+00
+PKER_SWETH( 37, 41) = 0.210913E+00
+PKER_SWETH( 37, 42) = 0.194619E+00
+PKER_SWETH( 37, 43) = 0.179160E+00
+PKER_SWETH( 37, 44) = 0.164477E+00
+PKER_SWETH( 37, 45) = 0.150523E+00
+PKER_SWETH( 37, 46) = 0.137268E+00
+PKER_SWETH( 37, 47) = 0.124695E+00
+PKER_SWETH( 37, 48) = 0.112806E+00
+PKER_SWETH( 37, 49) = 0.101613E+00
+PKER_SWETH( 37, 50) = 0.911322E-01
+PKER_SWETH( 37, 51) = 0.813759E-01
+PKER_SWETH( 37, 52) = 0.723446E-01
+PKER_SWETH( 37, 53) = 0.640238E-01
+PKER_SWETH( 37, 54) = 0.563838E-01
+PKER_SWETH( 37, 55) = 0.493857E-01
+PKER_SWETH( 37, 56) = 0.429865E-01
+PKER_SWETH( 37, 57) = 0.371471E-01
+PKER_SWETH( 37, 58) = 0.318367E-01
+PKER_SWETH( 37, 59) = 0.270401E-01
+PKER_SWETH( 37, 60) = 0.227582E-01
+PKER_SWETH( 37, 61) = 0.190115E-01
+PKER_SWETH( 37, 62) = 0.158324E-01
+PKER_SWETH( 37, 63) = 0.132541E-01
+PKER_SWETH( 37, 64) = 0.113154E-01
+PKER_SWETH( 37, 65) = 0.100251E-01
+PKER_SWETH( 37, 66) = 0.936563E-02
+PKER_SWETH( 37, 67) = 0.929977E-02
+PKER_SWETH( 37, 68) = 0.975168E-02
+PKER_SWETH( 37, 69) = 0.106226E-01
+PKER_SWETH( 37, 70) = 0.118165E-01
+PKER_SWETH( 37, 71) = 0.132315E-01
+PKER_SWETH( 37, 72) = 0.147715E-01
+PKER_SWETH( 37, 73) = 0.163699E-01
+PKER_SWETH( 37, 74) = 0.179714E-01
+PKER_SWETH( 37, 75) = 0.195388E-01
+PKER_SWETH( 37, 76) = 0.210485E-01
+PKER_SWETH( 37, 77) = 0.224882E-01
+PKER_SWETH( 37, 78) = 0.238523E-01
+PKER_SWETH( 37, 79) = 0.251394E-01
+PKER_SWETH( 37, 80) = 0.263512E-01
+PKER_SWETH( 38, 1) = 0.312155E+01
+PKER_SWETH( 38, 2) = 0.292904E+01
+PKER_SWETH( 38, 3) = 0.274827E+01
+PKER_SWETH( 38, 4) = 0.257854E+01
+PKER_SWETH( 38, 5) = 0.241915E+01
+PKER_SWETH( 38, 6) = 0.226950E+01
+PKER_SWETH( 38, 7) = 0.212897E+01
+PKER_SWETH( 38, 8) = 0.199702E+01
+PKER_SWETH( 38, 9) = 0.187312E+01
+PKER_SWETH( 38, 10) = 0.175678E+01
+PKER_SWETH( 38, 11) = 0.164753E+01
+PKER_SWETH( 38, 12) = 0.154496E+01
+PKER_SWETH( 38, 13) = 0.144864E+01
+PKER_SWETH( 38, 14) = 0.135819E+01
+PKER_SWETH( 38, 15) = 0.127326E+01
+PKER_SWETH( 38, 16) = 0.119352E+01
+PKER_SWETH( 38, 17) = 0.111863E+01
+PKER_SWETH( 38, 18) = 0.104832E+01
+PKER_SWETH( 38, 19) = 0.982291E+00
+PKER_SWETH( 38, 20) = 0.920289E+00
+PKER_SWETH( 38, 21) = 0.862066E+00
+PKER_SWETH( 38, 22) = 0.807392E+00
+PKER_SWETH( 38, 23) = 0.756049E+00
+PKER_SWETH( 38, 24) = 0.707832E+00
+PKER_SWETH( 38, 25) = 0.662551E+00
+PKER_SWETH( 38, 26) = 0.620024E+00
+PKER_SWETH( 38, 27) = 0.580081E+00
+PKER_SWETH( 38, 28) = 0.542564E+00
+PKER_SWETH( 38, 29) = 0.507322E+00
+PKER_SWETH( 38, 30) = 0.474213E+00
+PKER_SWETH( 38, 31) = 0.443103E+00
+PKER_SWETH( 38, 32) = 0.413868E+00
+PKER_SWETH( 38, 33) = 0.386388E+00
+PKER_SWETH( 38, 34) = 0.360550E+00
+PKER_SWETH( 38, 35) = 0.336248E+00
+PKER_SWETH( 38, 36) = 0.313380E+00
+PKER_SWETH( 38, 37) = 0.291851E+00
+PKER_SWETH( 38, 38) = 0.271567E+00
+PKER_SWETH( 38, 39) = 0.252443E+00
+PKER_SWETH( 38, 40) = 0.234393E+00
+PKER_SWETH( 38, 41) = 0.217338E+00
+PKER_SWETH( 38, 42) = 0.201203E+00
+PKER_SWETH( 38, 43) = 0.185918E+00
+PKER_SWETH( 38, 44) = 0.171419E+00
+PKER_SWETH( 38, 45) = 0.157652E+00
+PKER_SWETH( 38, 46) = 0.144573E+00
+PKER_SWETH( 38, 47) = 0.132151E+00
+PKER_SWETH( 38, 48) = 0.120374E+00
+PKER_SWETH( 38, 49) = 0.109240E+00
+PKER_SWETH( 38, 50) = 0.987594E-01
+PKER_SWETH( 38, 51) = 0.889476E-01
+PKER_SWETH( 38, 52) = 0.798146E-01
+PKER_SWETH( 38, 53) = 0.713596E-01
+PKER_SWETH( 38, 54) = 0.635674E-01
+PKER_SWETH( 38, 55) = 0.564087E-01
+PKER_SWETH( 38, 56) = 0.498437E-01
+PKER_SWETH( 38, 57) = 0.438276E-01
+PKER_SWETH( 38, 58) = 0.383165E-01
+PKER_SWETH( 38, 59) = 0.332715E-01
+PKER_SWETH( 38, 60) = 0.286636E-01
+PKER_SWETH( 38, 61) = 0.244758E-01
+PKER_SWETH( 38, 62) = 0.207079E-01
+PKER_SWETH( 38, 63) = 0.173736E-01
+PKER_SWETH( 38, 64) = 0.144984E-01
+PKER_SWETH( 38, 65) = 0.121181E-01
+PKER_SWETH( 38, 66) = 0.102648E-01
+PKER_SWETH( 38, 67) = 0.895844E-02
+PKER_SWETH( 38, 68) = 0.819655E-02
+PKER_SWETH( 38, 69) = 0.795499E-02
+PKER_SWETH( 38, 70) = 0.818194E-02
+PKER_SWETH( 38, 71) = 0.880268E-02
+PKER_SWETH( 38, 72) = 0.973113E-02
+PKER_SWETH( 38, 73) = 0.108789E-01
+PKER_SWETH( 38, 74) = 0.121690E-01
+PKER_SWETH( 38, 75) = 0.135287E-01
+PKER_SWETH( 38, 76) = 0.149074E-01
+PKER_SWETH( 38, 77) = 0.162683E-01
+PKER_SWETH( 38, 78) = 0.175866E-01
+PKER_SWETH( 38, 79) = 0.188485E-01
+PKER_SWETH( 38, 80) = 0.200469E-01
+PKER_SWETH( 39, 1) = 0.312626E+01
+PKER_SWETH( 39, 2) = 0.293375E+01
+PKER_SWETH( 39, 3) = 0.275298E+01
+PKER_SWETH( 39, 4) = 0.258325E+01
+PKER_SWETH( 39, 5) = 0.242386E+01
+PKER_SWETH( 39, 6) = 0.227421E+01
+PKER_SWETH( 39, 7) = 0.213368E+01
+PKER_SWETH( 39, 8) = 0.200173E+01
+PKER_SWETH( 39, 9) = 0.187783E+01
+PKER_SWETH( 39, 10) = 0.176149E+01
+PKER_SWETH( 39, 11) = 0.165225E+01
+PKER_SWETH( 39, 12) = 0.154967E+01
+PKER_SWETH( 39, 13) = 0.145335E+01
+PKER_SWETH( 39, 14) = 0.136291E+01
+PKER_SWETH( 39, 15) = 0.127798E+01
+PKER_SWETH( 39, 16) = 0.119824E+01
+PKER_SWETH( 39, 17) = 0.112335E+01
+PKER_SWETH( 39, 18) = 0.105304E+01
+PKER_SWETH( 39, 19) = 0.987015E+00
+PKER_SWETH( 39, 20) = 0.925016E+00
+PKER_SWETH( 39, 21) = 0.866797E+00
+PKER_SWETH( 39, 22) = 0.812128E+00
+PKER_SWETH( 39, 23) = 0.760790E+00
+PKER_SWETH( 39, 24) = 0.712579E+00
+PKER_SWETH( 39, 25) = 0.667305E+00
+PKER_SWETH( 39, 26) = 0.624787E+00
+PKER_SWETH( 39, 27) = 0.584855E+00
+PKER_SWETH( 39, 28) = 0.547350E+00
+PKER_SWETH( 39, 29) = 0.512122E+00
+PKER_SWETH( 39, 30) = 0.479031E+00
+PKER_SWETH( 39, 31) = 0.447943E+00
+PKER_SWETH( 39, 32) = 0.418733E+00
+PKER_SWETH( 39, 33) = 0.391283E+00
+PKER_SWETH( 39, 34) = 0.365481E+00
+PKER_SWETH( 39, 35) = 0.341221E+00
+PKER_SWETH( 39, 36) = 0.318405E+00
+PKER_SWETH( 39, 37) = 0.296935E+00
+PKER_SWETH( 39, 38) = 0.276723E+00
+PKER_SWETH( 39, 39) = 0.257682E+00
+PKER_SWETH( 39, 40) = 0.239730E+00
+PKER_SWETH( 39, 41) = 0.222789E+00
+PKER_SWETH( 39, 42) = 0.206783E+00
+PKER_SWETH( 39, 43) = 0.191643E+00
+PKER_SWETH( 39, 44) = 0.177303E+00
+PKER_SWETH( 39, 45) = 0.163704E+00
+PKER_SWETH( 39, 46) = 0.150794E+00
+PKER_SWETH( 39, 47) = 0.138532E+00
+PKER_SWETH( 39, 48) = 0.126891E+00
+PKER_SWETH( 39, 49) = 0.115856E+00
+PKER_SWETH( 39, 50) = 0.105427E+00
+PKER_SWETH( 39, 51) = 0.956115E-01
+PKER_SWETH( 39, 52) = 0.864237E-01
+PKER_SWETH( 39, 53) = 0.778719E-01
+PKER_SWETH( 39, 54) = 0.699550E-01
+PKER_SWETH( 39, 55) = 0.626577E-01
+PKER_SWETH( 39, 56) = 0.559517E-01
+PKER_SWETH( 39, 57) = 0.497985E-01
+PKER_SWETH( 39, 58) = 0.441542E-01
+PKER_SWETH( 39, 59) = 0.389738E-01
+PKER_SWETH( 39, 60) = 0.342166E-01
+PKER_SWETH( 39, 61) = 0.298469E-01
+PKER_SWETH( 39, 62) = 0.258389E-01
+PKER_SWETH( 39, 63) = 0.221768E-01
+PKER_SWETH( 39, 64) = 0.188576E-01
+PKER_SWETH( 39, 65) = 0.158916E-01
+PKER_SWETH( 39, 66) = 0.132994E-01
+PKER_SWETH( 39, 67) = 0.111114E-01
+PKER_SWETH( 39, 68) = 0.936006E-02
+PKER_SWETH( 39, 69) = 0.806501E-02
+PKER_SWETH( 39, 70) = 0.723816E-02
+PKER_SWETH( 39, 71) = 0.686650E-02
+PKER_SWETH( 39, 72) = 0.691235E-02
+PKER_SWETH( 39, 73) = 0.732242E-02
+PKER_SWETH( 39, 74) = 0.802562E-02
+PKER_SWETH( 39, 75) = 0.894621E-02
+PKER_SWETH( 39, 76) = 0.100126E-01
+PKER_SWETH( 39, 77) = 0.111624E-01
+PKER_SWETH( 39, 78) = 0.123458E-01
+PKER_SWETH( 39, 79) = 0.135242E-01
+PKER_SWETH( 39, 80) = 0.146735E-01
+PKER_SWETH( 40, 1) = 0.313031E+01
+PKER_SWETH( 40, 2) = 0.293780E+01
+PKER_SWETH( 40, 3) = 0.275703E+01
+PKER_SWETH( 40, 4) = 0.258729E+01
+PKER_SWETH( 40, 5) = 0.242791E+01
+PKER_SWETH( 40, 6) = 0.227826E+01
+PKER_SWETH( 40, 7) = 0.213773E+01
+PKER_SWETH( 40, 8) = 0.200578E+01
+PKER_SWETH( 40, 9) = 0.188188E+01
+PKER_SWETH( 40, 10) = 0.176554E+01
+PKER_SWETH( 40, 11) = 0.165630E+01
+PKER_SWETH( 40, 12) = 0.155372E+01
+PKER_SWETH( 40, 13) = 0.145740E+01
+PKER_SWETH( 40, 14) = 0.136696E+01
+PKER_SWETH( 40, 15) = 0.128203E+01
+PKER_SWETH( 40, 16) = 0.120229E+01
+PKER_SWETH( 40, 17) = 0.112741E+01
+PKER_SWETH( 40, 18) = 0.105710E+01
+PKER_SWETH( 40, 19) = 0.991076E+00
+PKER_SWETH( 40, 20) = 0.929079E+00
+PKER_SWETH( 40, 21) = 0.870863E+00
+PKER_SWETH( 40, 22) = 0.816197E+00
+PKER_SWETH( 40, 23) = 0.764863E+00
+PKER_SWETH( 40, 24) = 0.716657E+00
+PKER_SWETH( 40, 25) = 0.671389E+00
+PKER_SWETH( 40, 26) = 0.628877E+00
+PKER_SWETH( 40, 27) = 0.588953E+00
+PKER_SWETH( 40, 28) = 0.551458E+00
+PKER_SWETH( 40, 29) = 0.516242E+00
+PKER_SWETH( 40, 30) = 0.483165E+00
+PKER_SWETH( 40, 31) = 0.452093E+00
+PKER_SWETH( 40, 32) = 0.422902E+00
+PKER_SWETH( 40, 33) = 0.395476E+00
+PKER_SWETH( 40, 34) = 0.369701E+00
+PKER_SWETH( 40, 35) = 0.345475E+00
+PKER_SWETH( 40, 36) = 0.322698E+00
+PKER_SWETH( 40, 37) = 0.301275E+00
+PKER_SWETH( 40, 38) = 0.281119E+00
+PKER_SWETH( 40, 39) = 0.262143E+00
+PKER_SWETH( 40, 40) = 0.244268E+00
+PKER_SWETH( 40, 41) = 0.227416E+00
+PKER_SWETH( 40, 42) = 0.211515E+00
+PKER_SWETH( 40, 43) = 0.196493E+00
+PKER_SWETH( 40, 44) = 0.182286E+00
+PKER_SWETH( 40, 45) = 0.168832E+00
+PKER_SWETH( 40, 46) = 0.156075E+00
+PKER_SWETH( 40, 47) = 0.143968E+00
+PKER_SWETH( 40, 48) = 0.132471E+00
+PKER_SWETH( 40, 49) = 0.121560E+00
+PKER_SWETH( 40, 50) = 0.111219E+00
+PKER_SWETH( 40, 51) = 0.101447E+00
+PKER_SWETH( 40, 52) = 0.922530E-01
+PKER_SWETH( 40, 53) = 0.836474E-01
+PKER_SWETH( 40, 54) = 0.756380E-01
+PKER_SWETH( 40, 55) = 0.682230E-01
+PKER_SWETH( 40, 56) = 0.613879E-01
+PKER_SWETH( 40, 57) = 0.551058E-01
+PKER_SWETH( 40, 58) = 0.493398E-01
+PKER_SWETH( 40, 59) = 0.440480E-01
+PKER_SWETH( 40, 60) = 0.391874E-01
+PKER_SWETH( 40, 61) = 0.347167E-01
+PKER_SWETH( 40, 62) = 0.305992E-01
+PKER_SWETH( 40, 63) = 0.268049E-01
+PKER_SWETH( 40, 64) = 0.233110E-01
+PKER_SWETH( 40, 65) = 0.201033E-01
+PKER_SWETH( 40, 66) = 0.171779E-01
+PKER_SWETH( 40, 67) = 0.145412E-01
+PKER_SWETH( 40, 68) = 0.122100E-01
+PKER_SWETH( 40, 69) = 0.102095E-01
+PKER_SWETH( 40, 70) = 0.856828E-02
+PKER_SWETH( 40, 71) = 0.730855E-02
+PKER_SWETH( 40, 72) = 0.644644E-02
+PKER_SWETH( 40, 73) = 0.598027E-02
+PKER_SWETH( 40, 74) = 0.588539E-02
+PKER_SWETH( 40, 75) = 0.612142E-02
+PKER_SWETH( 40, 76) = 0.663468E-02
+PKER_SWETH( 40, 77) = 0.735968E-02
+PKER_SWETH( 40, 78) = 0.823287E-02
+PKER_SWETH( 40, 79) = 0.919883E-02
+PKER_SWETH( 40, 80) = 0.102081E-01
+END IF
+!
+END SUBROUTINE LIMA_READ_XKER_SWETH
diff --git a/src/mesonh/micro/lima_sedimentation.f90 b/src/mesonh/micro/lima_sedimentation.f90
new file mode 100644
index 000000000..365ae0f23
--- /dev/null
+++ b/src/mesonh/micro/lima_sedimentation.f90
@@ -0,0 +1,244 @@
+!MNH_LIC Copyright 2018-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ###################################
+ MODULE MODI_LIMA_SEDIMENTATION
+! ###################################
+!
+INTERFACE
+ SUBROUTINE LIMA_SEDIMENTATION (KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL, &
+ HPHASE, KMOMENTS, KID, KSPLITG, PTSTEP, PDZZ, PRHODREF, &
+ PPABST, PT, PRT_SUM, PCPT, PRS, PCS, PINPR )
+!
+INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL
+CHARACTER(1), INTENT(IN) :: HPHASE ! Liquid or solid hydrometeors
+INTEGER, INTENT(IN) :: KMOMENTS ! Number of moments
+INTEGER, INTENT(IN) :: KID ! Hydrometeor ID
+INTEGER, INTENT(IN) :: KSPLITG !
+REAL, INTENT(IN) :: PTSTEP ! Time step
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PT ! Temperature
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRT_SUM ! total water mixing ratio
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCPT ! Cp
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRS ! m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCS ! C. source
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPR ! Instant precip rate
+!
+END SUBROUTINE LIMA_SEDIMENTATION
+END INTERFACE
+END MODULE MODI_LIMA_SEDIMENTATION
+!
+!
+! ######################################################################
+ SUBROUTINE LIMA_SEDIMENTATION (KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL, &
+ HPHASE, KMOMENTS, KID, KSPLITG, PTSTEP, PDZZ, PRHODREF, &
+ PPABST, PT, PRT_SUM, PCPT, PRS, PCS, PINPR )
+! ######################################################################
+!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the sedimentation of any hydrometeor,
+!! also accounting for the transport of heat
+!!
+!! METHOD
+!! ------
+!! The sedimentation rates are computed with a time spliting technique:
+!! an upstream scheme, written as a difference of non-advective fluxes.
+!! This source term is added to the next coming time step (split-implicit
+!! process).
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * CNRM *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 15/03/2018
+!!
+!! B.Vie 02/2019 Desactivate (comment) the heat transport by droplets
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+! B. Vie 03/2020: disable temperature change of droplets by air temperature
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY: XRHOLW, XCL, XCI
+USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
+USE MODD_PARAM_LIMA, ONLY: XCEXVT, XRTMIN, XCTMIN, NSPLITSED, &
+ XLB, XLBEX, XD, XFSEDR, XFSEDC, &
+ XALPHAC, XNUC
+USE MODD_PARAM_LIMA_COLD, ONLY: XLBEXI, XLBI, XDI
+
+use mode_tools, only: Countjv
+
+USE MODI_GAMMA, ONLY: GAMMA_X0D
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL
+CHARACTER(1), INTENT(IN) :: HPHASE ! Liquid or solid hydrometeors
+INTEGER, INTENT(IN) :: KMOMENTS ! Number of moments
+INTEGER, INTENT(IN) :: KID ! Hydrometeor ID
+INTEGER, INTENT(IN) :: KSPLITG !
+REAL, INTENT(IN) :: PTSTEP ! Time step
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PT ! Temperature
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRT_SUM ! total water mixing ratio
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCPT ! Cp
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRS ! m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCS ! C. source
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPR ! Instant precip rate
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: JK, JL, JN ! Loop index
+INTEGER :: ISEDIM ! Case number of sedimentation
+!
+LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: GSEDIM ! Test where to compute the SED processes
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: ZW, & ! Work array
+ ZWSEDR, & ! Sedimentation of MMR
+ ZWSEDC, & ! Sedimentation of number conc.
+ ZWDT ! Temperature change
+!
+REAL, DIMENSION(:), ALLOCATABLE &
+ :: ZRS, & ! m.r. source
+ ZCS, & ! conc. source
+ ZRHODREF, & ! RHO Dry REFerence
+ ZPABST, & ! Pressure
+ ZT, & ! Temperature
+ ZZW, & ! Work array
+ ZZX, & ! Work array
+ ZZY, & ! Work array
+ ZLBDA, & ! Slope parameter
+ ZCC ! Cunningham corrective term for droplets fall speed
+!
+INTEGER , DIMENSION(SIZE(PRHODREF)) :: I1,I2,I3 ! Indexes for PACK replacement
+!
+REAL :: ZTSPLITG ! Small time step for rain sedimentation
+REAL :: ZC ! Cpl or Cpi
+!
+!
+!-------------------------------------------------------------------------------
+!
+! Time splitting
+!
+ZTSPLITG= PTSTEP / REAL(NSPLITSED(KID))
+!
+ZWDT=0.
+PINPR(:,:) = 0.
+!
+PRS(:,:,:) = PRS(:,:,:) * PTSTEP
+IF (KMOMENTS==2) PCS(:,:,:) = PCS(:,:,:) * PTSTEP
+DO JK = KKTB , KKTE
+ ZW(:,:,JK)=ZTSPLITG/PDZZ(:,:,JK)
+END DO
+!
+IF (HPHASE=='L') ZC=XCL
+IF (HPHASE=='I') ZC=XCI
+!
+! ################################
+! Compute the sedimentation fluxes
+! ################################
+!
+DO JN = 1 , NSPLITSED(KID)
+ ! Computation only where enough ice, snow, graupel or hail
+ GSEDIM(:,:,:) = .FALSE.
+ GSEDIM(KIB:KIE,KJB:KJE,KKTB:KKTE) = PRS(KIB:KIE,KJB:KJE,KKTB:KKTE)>XRTMIN(KID)
+ IF (KMOMENTS==2) GSEDIM(:,:,:) = GSEDIM(:,:,:) .AND. PCS(:,:,:)>XCTMIN(KID)
+ ISEDIM = COUNTJV( GSEDIM(:,:,:),I1(:),I2(:),I3(:))
+!
+ IF( ISEDIM >= 1 ) THEN
+!
+ ALLOCATE(ZRHODREF(ISEDIM))
+ ALLOCATE(ZPABST(ISEDIM))
+ ALLOCATE(ZT(ISEDIM))
+ ALLOCATE(ZRS(ISEDIM))
+ ALLOCATE(ZCS(ISEDIM))
+ ALLOCATE(ZLBDA(ISEDIM)) ; ZLBDA(:) = 1.E10
+ ALLOCATE(ZCC(ISEDIM)) ; ZCC(:) = 1.0
+ ALLOCATE(ZZW(ISEDIM)) ; ZZW(:) = 0.0
+ ALLOCATE(ZZX(ISEDIM)) ; ZZX(:) = 0.0
+ ALLOCATE(ZZY(ISEDIM)) ; ZZY(:) = 0.0
+!
+ DO JL = 1,ISEDIM
+ ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
+ ZPABST(JL) = PPABST(I1(JL),I2(JL),I3(JL))
+ ZT(JL) = PT(I1(JL),I2(JL),I3(JL))
+ ZRS(JL) = PRS(I1(JL),I2(JL),I3(JL))
+ IF (KMOMENTS==2) ZCS(JL) = PCS(I1(JL),I2(JL),I3(JL))
+ END DO
+!
+ IF (KMOMENTS==1) ZLBDA(:) = XLB(KID) * ( ZRHODREF(:) * ZRS(:) )**XLBEX(KID)
+ IF (KMOMENTS==2) ZLBDA(:) = ( XLB(KID)*ZCS(:) / ZRS(:) )**XLBEX(KID)
+!
+ ZZY(:) = ZRHODREF(:)**(-XCEXVT) * ZLBDA(:)**(-XD(KID))
+ ZZW(:) = XFSEDR(KID) * ZRS(:) * ZZY(:) * ZRHODREF(:)
+ IF (KMOMENTS==2) ZZX(:) = XFSEDC(KID) * ZCS(:) * ZZY(:) * ZRHODREF(:)
+
+ IF (KID==2) THEN
+ ZCC(:) = 0.5*GAMMA_X0D(XNUC+1./XALPHAC)/(GAMMA_X0D(XNUC)*ZLBDA(:))
+ ZCC(:) = 1.+1.26*6.6E-8*(101325./ZPABST(:))*(ZT(:)/293.15)/ZCC(:)
+ ZZW(:) = ZCC(:) * ZZW(:)
+ ZZX(:) = ZCC(:) * ZZX(:)
+ END IF
+
+ ZWSEDR(:,:,:) = UNPACK( ZZW(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
+ ZWSEDR(:,:,KKTB:KKTE) = MIN( ZWSEDR(:,:,KKTB:KKTE), PRS(:,:,KKTB:KKTE) * PRHODREF(:,:,KKTB:KKTE) / ZW(:,:,KKTB:KKTE) )
+ IF (KMOMENTS==2) THEN
+ ZWSEDC(:,:,:) = UNPACK( ZZX(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
+ ZWSEDC(:,:,KKTB:KKTE) = MIN( ZWSEDC(:,:,KKTB:KKTE), PCS(:,:,KKTB:KKTE) * PRHODREF(:,:,KKTB:KKTE) / ZW(:,:,KKTB:KKTE) )
+ END IF
+
+ DO JK = KKTB , KKTE
+ PRS(:,:,JK) = PRS(:,:,JK) + ZW(:,:,JK)* &
+ (ZWSEDR(:,:,JK+KKL)-ZWSEDR(:,:,JK))/PRHODREF(:,:,JK)
+ IF (KMOMENTS==2) PCS(:,:,JK) = PCS(:,:,JK) + ZW(:,:,JK)* &
+ (ZWSEDC(:,:,JK+KKL)-ZWSEDC(:,:,JK))/PRHODREF(:,:,JK)
+ ! Heat transport
+ !PRT_SUM(:,:,JK-KKL) = PRT_SUM(:,:,JK-KKL) + ZW(:,:,JK-KKL)*ZWSEDR(:,:,JK)/PRHODREF(:,:,JK-KKL)
+ !PRT_SUM(:,:,JK) = PRT_SUM(:,:,JK) - ZW(:,:,JK)*ZWSEDR(:,:,JK)/PRHODREF(:,:,JK)
+ !PCPT(:,:,JK-KKL) = PCPT(:,:,JK-KKL) + ZC * (ZW(:,:,JK-KKL)*ZWSEDR(:,:,JK)/PRHODREF(:,:,JK-KKL))
+ !PCPT(:,:,JK) = PCPT(:,:,JK) - ZC * (ZW(:,:,JK)*ZWSEDR(:,:,JK)/PRHODREF(:,:,JK))
+ !ZWDT(:,:,JK) =(PRHODREF(:,:,JK+KKL)*(1.+PRT_SUM(:,:,JK))*PCPT(:,:,JK)*PT(:,:,JK) + &
+ ! ZW(:,:,JK)*ZWSEDR(:,:,JK+1)*ZC*PT(:,:,JK+KKL)) / &
+ ! (PRHODREF(:,:,JK+KKL)*(1.+PRT_SUM(:,:,JK))*PCPT(:,:,JK) + ZW(:,:,JK)*ZWSEDR(:,:,JK+KKL)*ZC)
+ !ZWDT(:,:,JK) = ZWDT(:,:,JK) - PT(:,:,JK)
+ END DO
+ DEALLOCATE(ZRHODREF)
+ DEALLOCATE(ZPABST)
+ DEALLOCATE(ZT)
+ DEALLOCATE(ZRS)
+ DEALLOCATE(ZCS)
+ DEALLOCATE(ZCC)
+ DEALLOCATE(ZLBDA)
+ DEALLOCATE(ZZW)
+ DEALLOCATE(ZZX)
+ DEALLOCATE(ZZY)
+ !
+ PINPR(:,:) = PINPR(:,:) + ZWSEDR(:,:,KKB)/XRHOLW/NSPLITSED(KID) ! in m/s
+ !PT(:,:,:) = PT(:,:,:) + ZWDT(:,:,:)
+
+ END IF
+END DO
+!
+PRS(:,:,:) = PRS(:,:,:) / PTSTEP
+IF (KMOMENTS==2) PCS(:,:,:) = PCS(:,:,:) / PTSTEP
+!
+END SUBROUTINE LIMA_SEDIMENTATION
+!
+!-------------------------------------------------------------------------------
diff --git a/src/mesonh/micro/lima_snow_deposition.f90 b/src/mesonh/micro/lima_snow_deposition.f90
new file mode 100644
index 000000000..697f9ee74
--- /dev/null
+++ b/src/mesonh/micro/lima_snow_deposition.f90
@@ -0,0 +1,163 @@
+!MNH_LIC Copyright 2018-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! #####################
+ MODULE MODI_LIMA_SNOW_DEPOSITION
+! #####################
+!
+INTERFACE
+ SUBROUTINE LIMA_SNOW_DEPOSITION (LDCOMPUTE, &
+ PRHODREF, PSSI, PAI, PCJ, PLSFACT, &
+ PRST, PLBDS, &
+ P_RI_CNVI, P_CI_CNVI, &
+ P_TH_DEPS, P_RS_DEPS )
+!
+LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:), INTENT(IN) :: PSSI ! abs. pressure at time t
+REAL, DIMENSION(:), INTENT(IN) :: PAI ! abs. pressure at time t
+REAL, DIMENSION(:), INTENT(IN) :: PCJ ! abs. pressure at time t
+REAL, DIMENSION(:), INTENT(IN) :: PLSFACT ! abs. pressure at time t
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+!
+REAL, DIMENSION(:), INTENT(IN) :: PLBDS ! Graupel m.r. at t
+!
+REAL, DIMENSION(:), INTENT(OUT) :: P_RI_CNVI
+REAL, DIMENSION(:), INTENT(OUT) :: P_CI_CNVI
+REAL, DIMENSION(:), INTENT(OUT) :: P_TH_DEPS
+REAL, DIMENSION(:), INTENT(OUT) :: P_RS_DEPS
+!
+END SUBROUTINE LIMA_SNOW_DEPOSITION
+END INTERFACE
+END MODULE MODI_LIMA_SNOW_DEPOSITION
+!
+! ##########################################################################
+SUBROUTINE LIMA_SNOW_DEPOSITION (LDCOMPUTE, &
+ PRHODREF, PSSI, PAI, PCJ, PLSFACT, &
+ PRST, PLBDS, &
+ P_RI_CNVI, P_CI_CNVI, &
+ P_TH_DEPS, P_RS_DEPS )
+! ##########################################################################
+!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the microphysical sources
+!! for slow cold processes :
+!! - conversion of snow to ice
+!! - deposition of vapor on snow
+!! - conversion of ice to snow (Harrington 1995)
+!!
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * CNRM *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 15/03/2018
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, XALPHAI, XALPHAS, XNUI, XNUS
+USE MODD_PARAM_LIMA_COLD, ONLY : XCXS, XCCS, &
+ XLBDAS_MAX, XDSCNVI_LIM, XLBDASCNVI_MAX, &
+ XC0DEPSI, XC1DEPSI, XR0DEPSI, XR1DEPSI, &
+ XSCFAC, X1DEPS, X0DEPS, XEX1DEPS, XEX0DEPS, &
+ XDICNVS_LIM, XLBDAICNVS_LIM, &
+ XC0DEPIS, XC1DEPIS, XR0DEPIS, XR1DEPIS, &
+ XCOLEXIS, XAGGS_CLARGE1, XAGGS_CLARGE2, &
+ XAGGS_RLARGE1, XAGGS_RLARGE2
+
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:), INTENT(IN) :: PSSI ! abs. pressure at time t
+REAL, DIMENSION(:), INTENT(IN) :: PAI ! abs. pressure at time t
+REAL, DIMENSION(:), INTENT(IN) :: PCJ ! abs. pressure at time t
+REAL, DIMENSION(:), INTENT(IN) :: PLSFACT ! abs. pressure at time t
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+!
+REAL, DIMENSION(:), INTENT(IN) :: PLBDS ! Graupel m.r. at t
+!
+REAL, DIMENSION(:), INTENT(OUT) :: P_RI_CNVI
+REAL, DIMENSION(:), INTENT(OUT) :: P_CI_CNVI
+REAL, DIMENSION(:), INTENT(OUT) :: P_TH_DEPS
+REAL, DIMENSION(:), INTENT(OUT) :: P_RS_DEPS
+!
+!* 0.2 Declarations of local variables :
+!
+LOGICAL, DIMENSION(SIZE(PRHODREF)) :: GMICRO ! Computations only where necessary
+REAL, DIMENSION(SIZE(PRHODREF)) :: ZZW, ZZW2, ZZX ! Work array
+!
+!
+!-------------------------------------------------------------------------------
+!
+P_RI_CNVI(:) = 0.
+P_CI_CNVI(:) = 0.
+P_TH_DEPS(:) = 0.
+P_RS_DEPS(:) = 0.
+!
+! Physical limitations
+!
+!
+! Looking for regions where computations are necessary
+!
+GMICRO(:) = LDCOMPUTE(:) .AND. PRST(:)>XRTMIN(5)
+!
+!
+WHERE( GMICRO )
+!
+!* 2.1 Conversion of snow to r_i: RSCNVI
+! ----------------------------------------
+!
+!
+ ZZW2(:) = 0.0
+ ZZW(:) = 0.0
+ WHERE ( PLBDS(:)<XLBDASCNVI_MAX .AND. (PRST(:)>XRTMIN(5)) &
+ .AND. (PSSI(:)<0.0) )
+ ZZW(:) = (PLBDS(:)*XDSCNVI_LIM)**(XALPHAS)
+ ZZX(:) = ( -PSSI(:)/PAI(:) ) * (XCCS*PLBDS(:)**XCXS) * (ZZW(:)**XNUS) * EXP(-ZZW(:))
+!
+ ZZW(:) = ( XR0DEPSI+XR1DEPSI*PCJ(:) )*ZZX(:)
+!
+ ZZW2(:) = ZZW(:)*( XC0DEPSI+XC1DEPSI*PCJ(:) )/( XR0DEPSI+XR1DEPSI*PCJ(:) )
+ END WHERE
+!
+ P_RI_CNVI(:) = ZZW(:)
+ P_CI_CNVI(:) = ZZW2(:)
+!
+!
+!* 2.2 Deposition of water vapor on r_s: RVDEPS
+! -----------------------------------------------
+!
+!
+ ZZW(:) = 0.0
+ WHERE ( (PRST(:)>XRTMIN(5)) )
+ ZZW(:) = ( PSSI(:)/(PAI(:)) ) * &
+ ( X0DEPS*PLBDS(:)**XEX0DEPS + X1DEPS*PCJ(:)*PLBDS(:)**XEX1DEPS )
+ ZZW(:) = ZZW(:)*(0.5+SIGN(0.5,ZZW(:))) - ABS(ZZW(:))*(0.5-SIGN(0.5,ZZW(:)))
+ END WHERE
+!
+ P_RS_DEPS(:) = ZZW(:)
+!!$ P_TH_DEPS(:) = P_RS_DEPS(:) * PLSFACT(:)
+!
+END WHERE
+!
+!
+END SUBROUTINE LIMA_SNOW_DEPOSITION
diff --git a/src/mesonh/micro/lima_tendencies.f90 b/src/mesonh/micro/lima_tendencies.f90
new file mode 100644
index 000000000..bd98d503c
--- /dev/null
+++ b/src/mesonh/micro/lima_tendencies.f90
@@ -0,0 +1,797 @@
+!MNH_LIC Copyright 2018-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!###############################
+MODULE MODI_LIMA_TENDENCIES
+!###############################
+ INTERFACE
+ SUBROUTINE LIMA_TENDENCIES (PTSTEP, LDCOMPUTE, &
+ PEXNREF, PRHODREF, PPABST, PTHT, &
+ PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, &
+ PCCT, PCRT, PCIT, &
+ P_TH_HONC, P_RC_HONC, P_CC_HONC, &
+ P_CC_SELF, &
+ P_RC_AUTO, P_CC_AUTO, P_CR_AUTO, &
+ P_RC_ACCR, P_CC_ACCR, &
+ P_CR_SCBU, &
+ P_TH_EVAP, P_RR_EVAP, &
+ P_RI_CNVI, P_CI_CNVI, &
+ P_TH_DEPS, P_RS_DEPS, &
+ P_TH_DEPI, P_RI_DEPI, &
+ P_RI_CNVS, P_CI_CNVS, &
+ P_RI_AGGS, P_CI_AGGS, &
+ P_TH_DEPG, P_RG_DEPG, &
+ P_TH_BERFI, P_RC_BERFI, &
+ P_TH_RIM, P_RC_RIM, P_CC_RIM, P_RS_RIM, P_RG_RIM, &
+ P_RI_HMS, P_CI_HMS, P_RS_HMS, &
+ P_TH_ACC, P_RR_ACC, P_CR_ACC, P_RS_ACC, P_RG_ACC, &
+ P_RS_CMEL, &
+ P_TH_CFRZ, P_RR_CFRZ, P_CR_CFRZ, P_RI_CFRZ, P_CI_CFRZ, &
+ P_TH_WETG, P_RC_WETG, P_CC_WETG, P_RR_WETG, P_CR_WETG, &
+ P_RI_WETG, P_CI_WETG, P_RS_WETG, P_RG_WETG, P_RH_WETG, &
+ P_TH_DRYG, P_RC_DRYG, P_CC_DRYG, P_RR_DRYG, P_CR_DRYG, &
+ P_RI_DRYG, P_CI_DRYG, P_RS_DRYG, P_RG_DRYG, &
+ P_RI_HMG, P_CI_HMG, P_RG_HMG, &
+ P_TH_GMLT, P_RR_GMLT, P_CR_GMLT, &
+!!! Z_RC_WETH, Z_CC_WETH, Z_RR_WETH, Z_CR_WETH, & ! wet growth of hail (WETH) : rc, Nc, rr, Nr, ri, Ni, rs, rg, rh, th
+!!! Z_RI_WETH, Z_CI_WETH, Z_RS_WETH, Z_RG_WETH, Z_RH_WETH, & ! wet growth of hail (WETH) : rc, Nc, rr, Nr, ri, Ni, rs, rg, rh, th
+!!! Z_RG_COHG, & ! conversion of hail into graupel (COHG) : rg, rh
+!!! Z_RR_HMLT, Z_CR_HMLT ! hail melting (HMLT) : rr, Nr, rh=-rr, th
+ PA_TH, PA_RV, PA_RC, PA_CC, PA_RR, PA_CR, &
+ PA_RI, PA_CI, PA_RS, PA_RG, PA_RH, &
+ PEVAP3D, &
+ PCF1D, PIF1D, PPF1D )
+!
+REAL, INTENT(IN) :: PTSTEP
+LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
+!
+REAL, DIMENSION(:), INTENT(IN) :: PEXNREF !
+REAL, DIMENSION(:), INTENT(IN) :: PRHODREF !
+REAL, DIMENSION(:), INTENT(IN) :: PPABST ! Pressure
+REAL, DIMENSION(:), INTENT(IN) :: PTHT ! Potential temperature
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRVT !
+REAL, DIMENSION(:), INTENT(IN) :: PRCT !
+REAL, DIMENSION(:), INTENT(IN) :: PRRT !
+REAL, DIMENSION(:), INTENT(IN) :: PRIT !
+REAL, DIMENSION(:), INTENT(IN) :: PRST !
+REAL, DIMENSION(:), INTENT(IN) :: PRGT !
+REAL, DIMENSION(:), INTENT(IN) :: PRHT ! Mixing ratios (kg/kg)
+!
+REAL, DIMENSION(:), INTENT(IN) :: PCCT !
+REAL, DIMENSION(:), INTENT(IN) :: PCRT !
+REAL, DIMENSION(:), INTENT(IN) :: PCIT ! Number concentrations (/kg)
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_HONC
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_HONC
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_HONC ! droplets homogeneous freezing (HONC) : rc, Nc, ri=-rc, Ni=-Nc, th
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_SELF ! self collection of droplets (SELF) : Nc
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_AUTO
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_AUTO
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_AUTO ! autoconversion of cloud droplets (AUTO) : rc, Nc, rr=-rc, Nr
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_ACCR
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_ACCR ! accretion of droplets by rain drops (ACCR) : rc, Nc, rr=-rr
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_SCBU ! self collectio break up of drops (SCBU) : Nr
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_EVAP
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_EVAP ! evaporation of rain drops (EVAP) : rr, rv=-rr
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_CNVI
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_CNVI ! conversion snow -> ice (CNVI) : ri, Ni, rs=-ri
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_DEPS
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_DEPS ! deposition of vapor on snow (DEPS) : rv=-rs, rs, th
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_DEPI
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_DEPI ! deposition of vapor on ice (DEPI) : rv=-ri, ri, th
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_CNVS
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_CNVS ! conversion ice -> snow (CNVS) : ri, Ni, rs=-ri
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_AGGS
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_AGGS ! aggregation of ice on snow (AGGS) : ri, Ni, rs=-ri
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_DEPG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_DEPG ! deposition of vapor on graupel (DEPG) : rv=-rg, rg, th
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_BERFI
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_BERFI ! Bergeron (BERFI) : rc, ri=-rc, th
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_RIM
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_RIM
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_RIM
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_RIM
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_RIM ! cloud droplet riming (RIM) : rc, Nc, rs, rg, th
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_HMS
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_HMS
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_HMS ! hallett mossop snow (HMS) : ri, Ni, rs
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_ACC
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_ACC
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_ACC
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_ACC
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_ACC ! rain accretion on aggregates (ACC) : rr, Nr, rs, rg, th
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_CMEL ! conversion-melting (CMEL) : rs, rg=-rs
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_CFRZ
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_CFRZ
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_CFRZ
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_CFRZ
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_CFRZ ! rain freezing (CFRZ) : rr, Nr, ri, Ni, rg=-rr-ri, th
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_WETG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_WETG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_WETG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_WETG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_WETG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_WETG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_WETG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_WETG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_WETG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RH_WETG ! wet growth of graupel (WETG) : rc, NC, rr, Nr, ri, Ni, rs, rg, rh, th
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_DRYG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_DRYG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_DRYG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_DRYG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_DRYG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_DRYG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_DRYG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_DRYG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_DRYG ! dry growth of graupel (DRYG) : rc, Nc, rr, Nr, ri, Ni, rs, rg, th
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_HMG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_HMG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_HMG ! hallett mossop graupel (HMG) : ri, Ni, rg
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_GMLT
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_GMLT
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_GMLT ! graupel melting (GMLT) : rr, Nr, rg=-rr, th
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_TH
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_RV
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_RC
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_CC
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_RR
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_CR
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_RI
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_CI
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_RS
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_RG
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_RH
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: PEVAP3D
+!
+REAL, DIMENSION(:), INTENT(IN) :: PCF1D
+REAL, DIMENSION(:), INTENT(IN) :: PIF1D
+REAL, DIMENSION(:), INTENT(IN) :: PPF1D
+!
+ END SUBROUTINE LIMA_TENDENCIES
+ END INTERFACE
+END MODULE MODI_LIMA_TENDENCIES
+!#####################################################################
+!
+!#####################################################################
+SUBROUTINE LIMA_TENDENCIES (PTSTEP, LDCOMPUTE, &
+ PEXNREF, PRHODREF, PPABST, PTHT, &
+ PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, &
+ PCCT, PCRT, PCIT, &
+ P_TH_HONC, P_RC_HONC, P_CC_HONC, &
+ P_CC_SELF, &
+ P_RC_AUTO, P_CC_AUTO, P_CR_AUTO, &
+ P_RC_ACCR, P_CC_ACCR, &
+ P_CR_SCBU, &
+ P_TH_EVAP, P_RR_EVAP, &
+ P_RI_CNVI, P_CI_CNVI, &
+ P_TH_DEPS, P_RS_DEPS, &
+ P_TH_DEPI, P_RI_DEPI, &
+ P_RI_CNVS, P_CI_CNVS, &
+ P_RI_AGGS, P_CI_AGGS, &
+ P_TH_DEPG, P_RG_DEPG, &
+ P_TH_BERFI, P_RC_BERFI, &
+ P_TH_RIM, P_RC_RIM, P_CC_RIM, P_RS_RIM, P_RG_RIM, &
+ P_RI_HMS, P_CI_HMS, P_RS_HMS, &
+ P_TH_ACC, P_RR_ACC, P_CR_ACC, P_RS_ACC, P_RG_ACC, &
+ P_RS_CMEL, &
+ P_TH_CFRZ, P_RR_CFRZ, P_CR_CFRZ, P_RI_CFRZ, P_CI_CFRZ, &
+ P_TH_WETG, P_RC_WETG, P_CC_WETG, P_RR_WETG, P_CR_WETG, &
+ P_RI_WETG, P_CI_WETG, P_RS_WETG, P_RG_WETG, P_RH_WETG, &
+ P_TH_DRYG, P_RC_DRYG, P_CC_DRYG, P_RR_DRYG, P_CR_DRYG, &
+ P_RI_DRYG, P_CI_DRYG, P_RS_DRYG, P_RG_DRYG, &
+ P_RI_HMG, P_CI_HMG, P_RG_HMG, &
+ P_TH_GMLT, P_RR_GMLT, P_CR_GMLT, &
+!!! Z_RC_WETH, Z_CC_WETH, Z_RR_WETH, Z_CR_WETH, & ! wet growth of hail (WETH) : rc, Nc, rr, Nr, ri, Ni, rs, rg, rh, th
+!!! Z_RI_WETH, Z_CI_WETH, Z_RS_WETH, Z_RG_WETH, Z_RH_WETH, & ! wet growth of hail (WETH) : rc, Nc, rr, Nr, ri, Ni, rs, rg, rh, th
+!!! Z_RG_COHG, & ! conversion of hail into graupel (COHG) : rg, rh
+!!! Z_RR_HMLT, Z_CR_HMLT ! hail melting (HMLT) : rr, Nr, rh=-rr, th
+ PA_TH, PA_RV, PA_RC, PA_CC, PA_RR, PA_CR, &
+ PA_RI, PA_CI, PA_RS, PA_RG, PA_RH, &
+ PEVAP3D, &
+ PCF1D, PIF1D, PPF1D )
+! ######################################################################
+!!
+!! PURPOSE
+!! -------
+!! Compute sources of non-instantaneous microphysical processes for the
+!! time-split version of LIMA
+!!
+!! AUTHOR
+!! ------
+!! B. Vié * CNRM *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 15/03/2018
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY : XP00, XRD, XRV, XMD, XMV, XCPD, XCPV, XCL, XCI, XLVTT, XLSTT, XTT, &
+ XALPW, XBETAW, XGAMW, XALPI, XBETAI, XGAMI
+USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, &
+ LCOLD, LNUCL, LSNOW, LHAIL, LWARM, LACTI, LRAIN
+USE MODD_PARAM_LIMA_WARM, ONLY : XLBC, XLBEXC, XLBR, XLBEXR
+USE MODD_PARAM_LIMA_MIXED, ONLY : XLBG, XLBEXG, XLBH, XLBEXH, XLBDAG_MAX
+USE MODD_PARAM_LIMA_COLD, ONLY : XSCFAC, XLBI, XLBEXI, XLBS, XLBEXS, XLBDAS_MAX
+!
+USE MODI_LIMA_DROPLETS_HOM_FREEZING
+USE MODI_LIMA_DROPLETS_SELF_COLLECTION
+USE MODI_LIMA_DROPLETS_AUTOCONVERSION
+USE MODI_LIMA_DROPLETS_ACCRETION
+USE MODI_LIMA_DROPS_SELF_COLLECTION
+USE MODI_LIMA_RAIN_EVAPORATION
+USE MODI_LIMA_ICE_DEPOSITION
+USE MODI_LIMA_SNOW_DEPOSITION
+USE MODI_LIMA_ICE_AGGREGATION_SNOW
+USE MODI_LIMA_GRAUPEL_DEPOSITION
+USE MODI_LIMA_DROPLETS_RIMING_SNOW
+USE MODI_LIMA_RAIN_ACCR_SNOW
+USE MODI_LIMA_CONVERSION_MELTING_SNOW
+USE MODI_LIMA_RAIN_FREEZING
+USE MODI_LIMA_GRAUPEL
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, INTENT(IN) :: PTSTEP
+LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
+!
+REAL, DIMENSION(:), INTENT(IN) :: PEXNREF !
+REAL, DIMENSION(:), INTENT(IN) :: PRHODREF !
+REAL, DIMENSION(:), INTENT(IN) :: PPABST ! Pressure
+REAL, DIMENSION(:), INTENT(IN) :: PTHT ! Potential temperature
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRVT !
+REAL, DIMENSION(:), INTENT(IN) :: PRCT !
+REAL, DIMENSION(:), INTENT(IN) :: PRRT !
+REAL, DIMENSION(:), INTENT(IN) :: PRIT !
+REAL, DIMENSION(:), INTENT(IN) :: PRST !
+REAL, DIMENSION(:), INTENT(IN) :: PRGT !
+REAL, DIMENSION(:), INTENT(IN) :: PRHT ! Mixing ratios (kg/kg)
+!
+REAL, DIMENSION(:), INTENT(IN) :: PCCT !
+REAL, DIMENSION(:), INTENT(IN) :: PCRT !
+REAL, DIMENSION(:), INTENT(IN) :: PCIT ! Number concentrations (/kg)
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_HONC
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_HONC
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_HONC ! droplets homogeneous freezing (HONC) : rc, Nc, ri=-rc, Ni=-Nc, th
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_SELF ! self collection of droplets (SELF) : Nc
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_AUTO
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_AUTO
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_AUTO ! autoconversion of cloud droplets (AUTO) : rc, Nc, rr=-rc, Nr
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_ACCR
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_ACCR ! accretion of droplets by rain drops (ACCR) : rc, Nc, rr=-rr
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_SCBU ! self collectio break up of drops (SCBU) : Nr
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_EVAP
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_EVAP ! evaporation of rain drops (EVAP) : rr, rv=-rr
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_CNVI
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_CNVI ! conversion snow -> ice (CNVI) : ri, Ni, rs=-ri
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_DEPS
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_DEPS ! deposition of vapor on snow (DEPS) : rv=-rs, rs, th
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_DEPI
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_DEPI ! deposition of vapor on ice (DEPI) : rv=-ri, ri, th
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_CNVS
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_CNVS ! conversion ice -> snow (CNVS) : ri, Ni, rs=-ri
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_AGGS
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_AGGS ! aggregation of ice on snow (AGGS) : ri, Ni, rs=-ri
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_DEPG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_DEPG ! deposition of vapor on graupel (DEPG) : rv=-rg, rg, th
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_BERFI
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_BERFI ! Bergeron (BERFI) : rc, ri=-rc, th
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_RIM
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_RIM
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_RIM
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_RIM
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_RIM ! cloud droplet riming (RIM) : rc, Nc, rs, rg, th
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_HMS
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_HMS
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_HMS ! hallett mossop snow (HMS) : ri, Ni, rs
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_ACC
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_ACC
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_ACC
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_ACC
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_ACC ! rain accretion on aggregates (ACC) : rr, Nr, rs, rg, th
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_CMEL ! conversion-melting (CMEL) : rs, rg=-rs
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_CFRZ
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_CFRZ
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_CFRZ
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_CFRZ
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_CFRZ ! rain freezing (CFRZ) : rr, Nr, ri, Ni, rg=-rr-ri, th
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_WETG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_WETG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_WETG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_WETG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_WETG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_WETG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_WETG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_WETG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_WETG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RH_WETG ! wet growth of graupel (WETG) : rc, NC, rr, Nr, ri, Ni, rs, rg, rh, th
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_DRYG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_DRYG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_DRYG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_DRYG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_DRYG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_DRYG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_DRYG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_DRYG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_DRYG ! dry growth of graupel (DRYG) : rc, Nc, rr, Nr, ri, Ni, rs, rg, th
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_HMG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_HMG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_HMG ! hallett mossop graupel (HMG) : ri, Ni, rg
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_GMLT
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_GMLT
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_GMLT ! graupel melting (GMLT) : rr, Nr, rg=-rr, th
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_TH
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_RV
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_RC
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_CC
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_RR
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_CR
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_RI
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_CI
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_RS
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_RG
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_RH
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: PEVAP3D
+!
+REAL, DIMENSION(:), INTENT(IN) :: PCF1D
+REAL, DIMENSION(:), INTENT(IN) :: PIF1D
+REAL, DIMENSION(:), INTENT(IN) :: PPF1D
+!
+!* 0.2 Declarations of local variables :
+!
+REAL, DIMENSION(SIZE(PRCT)) :: ZT
+
+REAL, DIMENSION(SIZE(PRCT)) :: ZLBDC
+REAL, DIMENSION(SIZE(PRCT)) :: ZLBDC3
+REAL, DIMENSION(SIZE(PRCT)) :: ZLBDR
+REAL, DIMENSION(SIZE(PRCT)) :: ZLBDR3
+REAL, DIMENSION(SIZE(PRCT)) :: ZLBDI
+REAL, DIMENSION(SIZE(PRCT)) :: ZLBDS
+REAL, DIMENSION(SIZE(PRCT)) :: ZLBDG
+REAL, DIMENSION(SIZE(PRCT)) :: ZLBDH
+
+REAL, DIMENSION(SIZE(PRCT)) :: ZAI
+REAL, DIMENSION(SIZE(PRCT)) :: ZKA
+REAL, DIMENSION(SIZE(PRCT)) :: ZDV
+REAL, DIMENSION(SIZE(PRCT)) :: ZCJ
+
+REAL, DIMENSION(SIZE(PRCT)) :: ZEPS
+REAL, DIMENSION(SIZE(PRCT)) :: ZEVSAT
+REAL, DIMENSION(SIZE(PRCT)) :: ZEISAT
+REAL, DIMENSION(SIZE(PRCT)) :: ZRVSAT
+REAL, DIMENSION(SIZE(PRCT)) :: ZRISAT
+!
+REAL, DIMENSION(SIZE(PRCT)) :: ZSSI
+REAL, DIMENSION(SIZE(PRCT)) :: ZSSIW
+
+REAL, DIMENSION(SIZE(PRCT)) :: ZLV
+REAL, DIMENSION(SIZE(PRCT)) :: ZLS
+REAL, DIMENSION(SIZE(PRCT)) :: ZLVFACT
+REAL, DIMENSION(SIZE(PRCT)) :: ZLSFACT
+!
+REAL, DIMENSION(SIZE(PRCT)) :: ZW
+!
+REAL, DIMENSION(SIZE(PRCT)) :: ZCF1D
+REAL, DIMENSION(SIZE(PRCT)) :: ZIF1D
+REAL, DIMENSION(SIZE(PRCT)) :: ZPF1D
+!
+!-------------------------------------------------------------------------------
+! Pre-compute quantities
+!
+! Prevent fractions to reach 0 (divide by 0)
+!
+ZCF1D(:) = MAX(PCF1D(:),0.01)
+ZIF1D(:) = MAX(PIF1D(:),0.01)
+ZPF1D(:) = MAX(PPF1D(:),0.01)
+!
+! Is it necessary to compute the following quantities
+! accounting for subgrig cloud fraction ?
+! lambda does not depend on cloud fraction for 2-m species
+! lambda depends on CF for 1-m species ?
+!
+!
+! Is it necessary to change water vapour in cloudy / non cloudy parts ?
+!
+!
+WHERE (LDCOMPUTE(:))
+ ZT(:) = PTHT(:) * ( PPABST(:)/XP00 ) ** (XRD/XCPD)
+!
+ ZW(:) = PEXNREF(:)*( XCPD &
+ +XCPV*PRVT(:) &
+ +XCL*(PRCT(:)+PRRT(:)) &
+ +XCI*(PRIT(:)+PRST(:)+PRGT(:)+PRHT(:)) )
+!
+ ZLV(:) = XLVTT + (XCPV-XCL)*(ZT(:)-XTT)
+ ZLVFACT(:) = ZLV(:)/ZW(:) ! L_v/(Pi_ref*C_ph)
+ ZLS(:) = XLSTT + (XCPV-XCI)*(ZT(:)-XTT)
+ ZLSFACT(:) = ZLS(:)/ZW(:) ! L_s/(Pi_ref*C_ph)
+!
+ ZEVSAT(:) = EXP( XALPW - XBETAW/ZT(:) - XGAMW*ALOG(ZT(:) ) )
+ ZEISAT(:) = EXP( XALPI - XBETAI/ZT(:) - XGAMI*ALOG(ZT(:) ) )
+ !
+ ZEPS= XMV / XMD
+ ZRVSAT(:) = ZEPS * ZEVSAT(:) / (PPABST(:) - ZEVSAT(:))
+ ZRISAT(:) = ZEPS * ZEISAT(:) / (PPABST(:) - ZEISAT(:))
+ !
+ ZSSI(:) = PRVT(:)/ZRISAT(:) - 1.0 ! Si = rv/rsi - 1
+ ZSSIW(:) = ZRVSAT(:)/ZRISAT(:) - 1.0 ! Siw = rsw/rsi - 1
+!
+ ZKA(:) = 2.38E-2 + 0.0071E-2 * ( ZT(:) - XTT )
+!
+ ZDV(:) = 0.211E-4 * (ZT(:)/XTT)**1.94 * (XP00/PPABST(:))
+!
+ ZAI(:) = ( XLSTT + (XCPV-XCI)*(ZT(:)-XTT) )**2 / (ZKA(:)*XRV*ZT(:)**2) &
+ + ( XRV*ZT(:) ) / (ZDV(:)*ZEISAT(:))
+!
+ ZCJ(:) = XSCFAC * PRHODREF(:)**0.3 / SQRT( 1.718E-5+0.0049E-5*(ZT(:)-XTT) )
+!
+END WHERE
+!
+!
+ZLBDC(:) = 1.E10
+ZLBDC3(:) = 1.E30
+WHERE (PRCT(:)>XRTMIN(2) .AND. PCCT(:)>XCTMIN(2) .AND. LDCOMPUTE(:))
+ ZLBDC3(:) = XLBC*PCCT(:) / PRCT(:)
+ ZLBDC(:) = ZLBDC3(:)**XLBEXC
+END WHERE
+ZLBDR(:) = 1.E10
+ZLBDR3(:) = 1.E30
+WHERE (PRRT(:)>XRTMIN(3) .AND. PCRT(:)>XCTMIN(3) .AND. LDCOMPUTE(:))
+ ZLBDR3(:) = XLBR*PCRT(:) / PRRT(:)
+ ZLBDR(:) = ZLBDR3(:)**XLBEXR
+END WHERE
+ZLBDI(:) = 1.E10
+WHERE (PRIT(:)>XRTMIN(4) .AND. PCIT(:)>XCTMIN(4) .AND. LDCOMPUTE(:))
+ ZLBDI(:) = ( XLBI*PCIT(:) / PRIT(:) )**XLBEXI
+END WHERE
+ZLBDS(:) = 1.E10
+WHERE (PRST(:)>XRTMIN(5) .AND. LDCOMPUTE(:) )
+ ZLBDS(:) = XLBS*( PRHODREF(:)*PRST(:) )**XLBEXS
+END WHERE
+ZLBDG(:) = 1.E10
+WHERE (PRGT(:)>XRTMIN(6) .AND. LDCOMPUTE(:) )
+ ZLBDG(:) = XLBG*( PRHODREF(:)*PRGT(:) )**XLBEXG
+END WHERE
+ZLBDH(:) = 1.E10
+WHERE (PRHT(:)>XRTMIN(7) .AND. LDCOMPUTE(:) )
+ ZLBDH(:) = XLBH*( PRHODREF(:)*PRHT(:) )**XLBEXH
+END WHERE
+!
+!-------------------------------------------------------------------------------
+! Call microphysical processes
+!
+IF (LCOLD .AND. LWARM) THEN
+ CALL LIMA_DROPLETS_HOM_FREEZING (PTSTEP, LDCOMPUTE, & ! independent from CF,IF,PF
+ ZT, ZLVFACT, ZLSFACT, &
+ PRCT, PCCT, ZLBDC, &
+ P_TH_HONC, P_RC_HONC, P_CC_HONC, &
+ PA_TH, PA_RC, PA_CC, PA_RI, PA_CI )
+END IF
+!
+IF (LWARM .AND. LRAIN) THEN
+ CALL LIMA_DROPLETS_SELF_COLLECTION (LDCOMPUTE, & ! depends on CF
+ PRHODREF, &
+ PCCT/ZCF1D, ZLBDC3, &
+ P_CC_SELF )
+ P_CC_SELF(:) = P_CC_SELF(:) * ZCF1D(:)
+ PA_CC(:) = PA_CC(:) + P_CC_SELF(:)
+END IF
+!
+IF (LWARM .AND. LRAIN) THEN
+ CALL LIMA_DROPLETS_AUTOCONVERSION (LDCOMPUTE, & ! depends on CF
+ PRHODREF, &
+ PRCT/ZCF1D, PCCT/ZCF1D, ZLBDC, ZLBDR, &
+ P_RC_AUTO, P_CC_AUTO, P_CR_AUTO )
+ P_RC_AUTO(:) = P_RC_AUTO(:) * ZCF1D(:)
+ P_CC_AUTO(:) = P_CC_AUTO(:) * ZCF1D(:)
+ P_CR_AUTO(:) = P_CR_AUTO(:) * ZCF1D(:)
+ !
+ PA_RC(:) = PA_RC(:) + P_RC_AUTO(:)
+ PA_CC(:) = PA_CC(:) + P_CC_AUTO(:)
+ PA_RR(:) = PA_RR(:) - P_RC_AUTO(:)
+ PA_CR(:) = PA_CR(:) + P_CR_AUTO(:)
+END IF
+!
+IF (LWARM .AND. LRAIN) THEN
+ CALL LIMA_DROPLETS_ACCRETION (LDCOMPUTE, & ! depends on CF, PF
+ PRHODREF, &
+ PRCT/ZCF1D, PRRT/ZPF1D, PCCT/ZCF1D, PCRT/ZPF1D,&
+ ZLBDC, ZLBDC3, ZLBDR, ZLBDR3, &
+ P_RC_ACCR, P_CC_ACCR )
+ !
+ P_CC_ACCR(:) = P_CC_ACCR(:) * ZCF1D(:)
+ P_RC_ACCR(:) = P_RC_ACCR(:) * ZCF1D(:)
+ !
+ PA_RC(:) = PA_RC(:) + P_RC_ACCR(:)
+ PA_CC(:) = PA_CC(:) + P_CC_ACCR(:)
+ PA_RR(:) = PA_RR(:) - P_RC_ACCR(:)
+END IF
+!
+IF (LWARM .AND. LRAIN) THEN
+ CALL LIMA_DROPS_SELF_COLLECTION (LDCOMPUTE, & ! depends on PF
+ PRHODREF, &
+ PCRT/ZPF1D(:), ZLBDR, ZLBDR3, &
+ P_CR_SCBU )
+ !
+ P_CR_SCBU(:) = P_CR_SCBU(:) * ZPF1D(:)
+ !
+ PA_CR(:) = PA_CR(:) + P_CR_SCBU(:)
+END IF
+!
+IF (LWARM .AND. LRAIN) THEN
+ CALL LIMA_RAIN_EVAPORATION (PTSTEP, LDCOMPUTE, & ! depends on PF > CF
+ PRHODREF, ZT, ZLV, ZLVFACT, ZEVSAT, ZRVSAT, &
+ PRVT, PRCT/ZPF1D, PRRT/ZPF1D, ZLBDR, &
+ P_TH_EVAP, P_RR_EVAP, &
+ PEVAP3D )
+ P_RR_EVAP(:) = P_RR_EVAP(:) * MAX((ZPF1D(:) - ZCF1D(:)),0.)
+ P_TH_EVAP(:) = P_RR_EVAP(:) * ZLVFACT(:)
+ PEVAP3D(:) = - P_RR_EVAP(:)
+ !
+ PA_TH(:) = PA_TH(:) + P_TH_EVAP(:)
+ PA_RV(:) = PA_RV(:) - P_RR_EVAP(:)
+ PA_RR(:) = PA_RR(:) + P_RR_EVAP(:)
+END IF
+!
+IF (LCOLD) THEN
+ !
+ ! Includes vapour deposition on ice, ice -> snow conversion
+ !
+ CALL LIMA_ICE_DEPOSITION (PTSTEP, LDCOMPUTE, & ! depends on IF, PF
+ PRHODREF, ZSSI, ZAI, ZCJ, ZLSFACT, &
+ PRIT/ZIF1D, PCIT/ZIF1D, ZLBDI, &
+ P_TH_DEPI, P_RI_DEPI, &
+ P_RI_CNVS, P_CI_CNVS )
+ !
+ P_RI_DEPI(:) = P_RI_DEPI(:) * ZIF1D(:)
+ P_RI_CNVS(:) = P_RI_CNVS(:) * ZIF1D(:)
+ P_CI_CNVS(:) = P_CI_CNVS(:) * ZIF1D(:)
+ P_TH_DEPI(:) = P_RI_DEPI(:) * ZLSFACT(:)
+ !
+ PA_TH(:) = PA_TH(:) + P_TH_DEPI(:)
+ PA_RV(:) = PA_RV(:) - P_RI_DEPI(:)
+ PA_RI(:) = PA_RI(:) + P_RI_DEPI(:) + P_RI_CNVS(:)
+ PA_CI(:) = PA_CI(:) + P_CI_CNVS(:)
+ PA_RS(:) = PA_RS(:) - P_RI_CNVS(:)
+
+END IF
+!
+IF (LCOLD .AND. LSNOW) THEN
+ !
+ ! Includes vapour deposition on snow, snow -> ice conversion
+ !
+ CALL LIMA_SNOW_DEPOSITION (LDCOMPUTE, & ! depends on IF, PF
+ PRHODREF, ZSSI, ZAI, ZCJ, ZLSFACT, &
+ PRST/ZPF1D, ZLBDS, &
+ P_RI_CNVI, P_CI_CNVI, &
+ P_TH_DEPS, P_RS_DEPS )
+ !
+ P_RI_CNVI(:) = P_RI_CNVI(:) * ZPF1D(:)
+ P_CI_CNVI(:) = P_CI_CNVI(:) * ZPF1D(:)
+ P_RS_DEPS(:) = P_RS_DEPS(:) * ZPF1D(:)
+ P_TH_DEPS(:) = P_RS_DEPS(:) * ZLSFACT(:)
+ !
+ PA_RI(:) = PA_RI(:) + P_RI_CNVI(:)
+ PA_CI(:) = PA_CI(:) + P_CI_CNVI(:)
+ PA_RS(:) = PA_RS(:) - P_RI_CNVI(:) + P_RS_DEPS(:)
+ PA_TH(:) = PA_TH(:) + P_TH_DEPS(:)
+ PA_RV(:) = PA_RV(:) - P_RS_DEPS(:)
+
+END IF
+!
+! Lambda_s limited for collection processes to prevent too high concentrations
+! must be changed or removed if C and x modified
+!
+ZLBDS(:) = MIN( XLBDAS_MAX, ZLBDS(:))
+!
+!
+IF (LCOLD .AND. LSNOW) THEN
+ CALL LIMA_ICE_AGGREGATION_SNOW (LDCOMPUTE, & ! depends on IF, PF
+ ZT, PRHODREF, &
+ PRIT/ZIF1D, PRST/ZPF1D, PCIT/ZIF1D, ZLBDI, ZLBDS, &
+ P_RI_AGGS, P_CI_AGGS )
+ P_CI_AGGS(:) = P_CI_AGGS(:) * ZIF1D(:)
+ P_RI_AGGS(:) = P_RI_AGGS(:) * ZIF1D(:)
+ !
+ PA_RI(:) = PA_RI(:) + P_RI_AGGS(:)
+ PA_CI(:) = PA_CI(:) + P_CI_AGGS(:)
+ PA_RS(:) = PA_RS(:) - P_RI_AGGS(:)
+END IF
+!
+IF (LWARM .AND. LCOLD) THEN
+ CALL LIMA_GRAUPEL_DEPOSITION (LDCOMPUTE, PRHODREF, & ! depends on PF ?
+ PRGT/ZPF1D, ZSSI, ZLBDG, ZAI, ZCJ, ZLSFACT, &
+ P_TH_DEPG, P_RG_DEPG )
+ P_RG_DEPG(:) = P_RG_DEPG(:) * ZPF1D(:)
+ P_TH_DEPG(:) = P_RG_DEPG(:) * ZLSFACT(:)
+ !
+ PA_RV(:) = PA_RV(:) - P_RG_DEPG(:)
+ PA_RG(:) = PA_RG(:) + P_RG_DEPG(:)
+ PA_TH(:) = PA_TH(:) + P_TH_DEPG(:)
+END IF
+!
+!!$IF (LWARM .AND. LCOLD) THEN
+!!$ CALL LIMA_BERGERON (LDCOMPUTE, & ! depends on CF, IF
+!!$ PRCT, PRIT, PCIT, ZLBDI, &
+!!$ ZSSIW, ZAI, ZCJ, ZLVFACT, ZLSFACT, &
+!!$ P_TH_BERFI, P_RC_BERFI, &
+!!$ PA_TH, PA_RC, PA_RI )
+!!$END IF
+P_TH_BERFI(:) = 0.
+P_RC_BERFI(:) = 0.
+!
+!
+IF (LWARM .AND. LCOLD .AND. LSNOW) THEN
+ !
+ ! Graupel production as tendency (or should be tendency + instant to stick to the previous version ?)
+ ! Includes the Hallett Mossop process for riming of droplets by snow (HMS)
+ !
+ CALL LIMA_DROPLETS_RIMING_SNOW (PTSTEP, LDCOMPUTE, & ! depends on CF
+ PRHODREF, ZT, &
+ PRCT/ZCF1D, PCCT/ZCF1D, PRST/ZPF1D, ZLBDC, ZLBDS, ZLVFACT, ZLSFACT, &
+ P_TH_RIM, P_RC_RIM, P_CC_RIM, P_RS_RIM, P_RG_RIM, &
+ P_RI_HMS, P_CI_HMS, P_RS_HMS )
+ P_RC_RIM(:) = P_RC_RIM(:) * ZCF1D(:)
+ P_CC_RIM(:) = P_CC_RIM(:) * ZCF1D(:)
+ P_RS_RIM(:) = P_RS_RIM(:) * ZCF1D(:)
+ P_RG_RIM(:) = P_RG_RIM(:) * ZCF1D(:)
+ P_TH_RIM(:) = - P_RC_RIM(:) * (ZLSFACT(:)-ZLVFACT(:))
+ P_RI_HMS(:) = P_RI_HMS(:) * ZCF1D(:)
+ P_CI_HMS(:) = P_CI_HMS(:) * ZCF1D(:)
+ P_RS_HMS(:) = P_RS_HMS(:) * ZCF1D(:)
+ !
+ PA_RC(:) = PA_RC(:) + P_RC_RIM(:)
+ PA_CC(:) = PA_CC(:) + P_CC_RIM(:)
+ PA_RI(:) = PA_RI(:) + P_RI_HMS(:)
+ PA_CI(:) = PA_CI(:) + P_CI_HMS(:)
+ PA_RS(:) = PA_RS(:) + P_RS_RIM(:) + P_RS_HMS(:)
+ PA_RG(:) = PA_RG(:) + P_RG_RIM(:)
+ PA_TH(:) = PA_TH(:) + P_TH_RIM(:)
+
+END IF
+!
+IF (LWARM .AND. LRAIN .AND. LCOLD .AND. LSNOW) THEN
+ CALL LIMA_RAIN_ACCR_SNOW (PTSTEP, LDCOMPUTE, & ! depends on PF
+ PRHODREF, ZT, &
+ PRRT/ZPF1D, PCRT/ZPF1D, PRST/ZPF1D, ZLBDR, ZLBDS, ZLVFACT, ZLSFACT, &
+ P_TH_ACC, P_RR_ACC, P_CR_ACC, P_RS_ACC, P_RG_ACC )
+ P_RR_ACC(:) = P_RR_ACC(:) * ZPF1D(:)
+ P_CR_ACC(:) = P_CR_ACC(:) * ZPF1D(:)
+ P_RS_ACC(:) = P_RS_ACC(:) * ZPF1D(:)
+ P_RG_ACC(:) = P_RG_ACC(:) * ZPF1D(:)
+ P_TH_ACC(:) = - P_RR_ACC(:) * (ZLSFACT(:)-ZLVFACT(:))
+ !
+ PA_RR(:) = PA_RR(:) + P_RR_ACC(:)
+ PA_CR(:) = PA_CR(:) + P_CR_ACC(:)
+ PA_RS(:) = PA_RS(:) + P_RS_ACC(:)
+ PA_RG(:) = PA_RG(:) + P_RG_ACC(:)
+ PA_TH(:) = PA_TH(:) + P_TH_ACC(:)
+
+END IF
+!
+IF (LWARM .AND. LCOLD .AND. LSNOW) THEN
+ !
+ ! Conversion melting of snow should account for collected droplets and drops where T>0C, but does not !
+ ! Some thermodynamical computations inside, to externalize ?
+ !
+ CALL LIMA_CONVERSION_MELTING_SNOW (LDCOMPUTE, & ! depends on PF
+ PRHODREF, PPABST, ZT, ZKA, ZDV, ZCJ, &
+ PRVT, PRST/ZPF1D, ZLBDS, &
+ P_RS_CMEL )
+ P_RS_CMEL(:) = P_RS_CMEL(:) * ZPF1D(:)
+ !
+ PA_RS(:) = PA_RS(:) + P_RS_CMEL(:)
+ PA_RG(:) = PA_RG(:) - P_RS_CMEL(:)
+
+END IF
+!
+IF (LWARM .AND. LRAIN .AND. LCOLD ) THEN
+ CALL LIMA_RAIN_FREEZING (LDCOMPUTE, & ! depends on PF, IF
+ PRHODREF, ZT, ZLVFACT, ZLSFACT, &
+ PRRT/ZPF1D, PCRT/ZPF1D, PRIT/ZIF1D, PCIT/ZIF1D, ZLBDR, &
+ P_TH_CFRZ, P_RR_CFRZ, P_CR_CFRZ, P_RI_CFRZ, P_CI_CFRZ )
+ P_RR_CFRZ(:) = P_RR_CFRZ(:) * ZIF1D(:)
+ P_CR_CFRZ(:) = P_CR_CFRZ(:) * ZIF1D(:)
+ P_RI_CFRZ(:) = P_RI_CFRZ(:) * ZIF1D(:)
+ P_CI_CFRZ(:) = P_CI_CFRZ(:) * ZIF1D(:)
+ P_TH_CFRZ(:) = - P_RR_CFRZ(:) * (ZLSFACT(:)-ZLVFACT(:))
+!
+ PA_TH(:) = PA_TH(:) + P_TH_CFRZ(:)
+ PA_RR(:) = PA_RR(:) + P_RR_CFRZ(:)
+ PA_CR(:) = PA_CR(:) + P_CR_CFRZ(:)
+ PA_RI(:) = PA_RI(:) + P_RI_CFRZ(:)
+ PA_CI(:) = PA_CI(:) + P_CI_CFRZ(:)
+ PA_RG(:) = PA_RG(:) - P_RR_CFRZ(:) - P_RI_CFRZ(:)
+
+END IF
+!
+IF (LWARM .AND. LCOLD) THEN
+ !
+ ! Melting of graupel should account for collected droplets and drops where T>0C, but does not !
+ ! Collection and water shedding should also happen where T>0C, but do not !
+ ! Hail production as tendency (should be instant to stick to the previous version ?)
+ ! Includes Hallett-Mossop process for riming of droplets by graupel (HMG)
+ ! Some thermodynamical computations inside, to externalize ?
+ !
+ CALL LIMA_GRAUPEL (PTSTEP, LDCOMPUTE, & ! depends on PF, CF, IF
+ PRHODREF, PPABST, ZT, ZKA, ZDV, ZCJ, &
+ PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PCCT, PCRT, PCIT, &
+ ZLBDC, ZLBDR, ZLBDS, ZLBDG, &
+ ZLVFACT, ZLSFACT, &
+ P_TH_WETG, P_RC_WETG, P_CC_WETG, P_RR_WETG, P_CR_WETG, &
+ P_RI_WETG, P_CI_WETG, P_RS_WETG, P_RG_WETG, P_RH_WETG, &
+ P_TH_DRYG, P_RC_DRYG, P_CC_DRYG, P_RR_DRYG, P_CR_DRYG, &
+ P_RI_DRYG, P_CI_DRYG, P_RS_DRYG, P_RG_DRYG, &
+ P_RI_HMG, P_CI_HMG, P_RG_HMG, &
+ P_TH_GMLT, P_RR_GMLT, P_CR_GMLT, &
+ PA_TH, PA_RC, PA_CC, PA_RR, PA_CR, &
+ PA_RI, PA_CI, PA_RS, PA_RG, PA_RH )
+END IF
+!
+IF (LWARM .AND. LCOLD .AND. LHAIL) THEN
+! CALL LIMA_HAIL_GROWTH
+
+! CALL LIMA_HAIL_CONVERSION
+
+! CALL LIMA_HAIL_MELTING
+END IF
+ !
+END SUBROUTINE LIMA_TENDENCIES
diff --git a/src/mesonh/micro/lima_warm.f90 b/src/mesonh/micro/lima_warm.f90
new file mode 100644
index 000000000..14b1a09fc
--- /dev/null
+++ b/src/mesonh/micro/lima_warm.f90
@@ -0,0 +1,486 @@
+!MNH_LIC Copyright 2013-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! #####################
+ MODULE MODI_LIMA_WARM
+! #####################
+!
+INTERFACE
+ SUBROUTINE LIMA_WARM (OACTIT, OSEDC, ORAIN, KSPLITR, PTSTEP, KMI, &
+ TPFILE, KRR, PZZ, PRHODJ, &
+ PRHODREF, PEXNREF, PW_NU, PPABSM, PPABST, &
+ PTHM, PRCM, &
+ PTHT, PRT, PSVT, &
+ PTHS, PRS, PSVS, &
+ PINPRC, PINPRR, PINDEP, PINPRR3D, PEVAP3D )
+!
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_NSV, only: NSV_LIMA_BEG
+!
+LOGICAL, INTENT(IN) :: OACTIT ! Switch to activate the
+ ! activation by radiative
+ ! tendency
+LOGICAL, INTENT(IN) :: OSEDC ! switch to activate the
+ ! cloud droplet sedimentation
+LOGICAL, INTENT(IN) :: ORAIN ! switch to activate the
+ ! rain formation by coalescence
+INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step
+ ! for sedimendation
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
+ ! (single if cold start)
+INTEGER, INTENT(IN) :: KMI ! Model index
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
+ ! the nucleation param.
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! abs. pressure at time t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at time t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCM ! Cloud water m.r. at t-dt
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! m.r. at t
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(IN) :: PSVT ! Concentrations at time t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! m.r. source
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(INOUT) :: PSVS ! Concentration sources
+!
+!
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC ! Cloud instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR ! Rain instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINDEP ! Cloud droplets deposition
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRR3D ! Rain inst precip 3D
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D ! Rain evap profile
+!
+END SUBROUTINE LIMA_WARM
+END INTERFACE
+END MODULE MODI_LIMA_WARM
+! #####################################################################
+ SUBROUTINE LIMA_WARM (OACTIT, OSEDC, ORAIN, KSPLITR, PTSTEP, KMI, &
+ TPFILE, KRR, PZZ, PRHODJ, &
+ PRHODREF, PEXNREF, PW_NU, PPABSM, PPABST, &
+ PTHM, PRCM, &
+ PTHT, PRT, PSVT, &
+ PTHS, PRS, PSVS, &
+ PINPRC, PINPRR, PINDEP, PINPRR3D, PEVAP3D )
+! #####################################################################
+!
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the warm microphysical
+!! sources: nucleation, sedimentation, autoconversion, accretion,
+!! self-collection and vaporisation which are parameterized according
+!! to Cohard and Pinty, QJRMS, 2000
+!!
+!!
+!!** METHOD
+!! ------
+!! The activation of CCN is checked for quasi-saturated air parcels
+!! to update the cloud droplet number concentration. Then assuming a
+!! generalized gamma distribution law for the cloud droplets and the
+!! raindrops, the zeroth and third order moments tendencies are evaluated
+!! for all the coalescence terms by integrating the Stochastic Collection
+!! Equation. As autoconversion is a process that cannot be resolved
+!! analytically, the Berry-Reinhardt parameterisation is employed with
+!! modifications to initiate the raindrop spectrum mode. The integration
+!! of the raindrop evaporation below clouds is straightforward.
+!!
+!! The sedimentation rates are computed with a time spliting technique:
+!! an upstream scheme, written as a difference of non-advective fluxes.
+!! This source term is added to the next coming time step (split-implicit
+!! process).
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Cohard, J.-M. and J.-P. Pinty, 2000: A comprehensive two-moment warm
+!! microphysical bulk scheme.
+!! Part I: Description and tests
+!! Part II: 2D experiments with a non-hydrostatic model
+!! Accepted for publication in Quart. J. Roy. Meteor. Soc.
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!! C. Barthe * LACy * jan. 2014 add budgets
+!! J. Escobar : for real*4 , use XMNH_HUGE
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets (no more budget calls in this subroutine)
+! B. Vie 03/02/2020: correction of activation of water deposition on the ground
+! B. Vie 03/03/2020: use DTHRAD instead of dT/dt in Smax diagnostic computation
+! P. Wautelet 28/05/2020: bugfix: correct array start for PSVT and PSVS
+! P. Wautelet 02/02/2021: budgets: add missing source terms for SV budgets in LIMA
+! B. Vie 06/2021 Add prognostic supersaturation for LIMA
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+use modd_budget, only: lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, NBUDGET_SV1, &
+ tbudgets
+USE MODD_CONF
+USE MODD_CST
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_NSV
+USE MODD_PARAMETERS
+USE MODD_PARAM_LIMA
+USE MODD_PARAM_LIMA_WARM
+
+use mode_budget, only: Budget_store_init, Budget_store_end
+
+USE MODI_LIMA_WARM_COAL
+USE MODI_LIMA_WARM_EVAP
+USE MODI_LIMA_WARM_NUCL
+USE MODI_LIMA_WARM_SEDIMENTATION
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+LOGICAL, INTENT(IN) :: OACTIT ! Switch to activate the
+ ! activation by radiative
+ ! tendency
+LOGICAL, INTENT(IN) :: OSEDC ! switch to activate the
+ ! cloud droplet sedimentation
+LOGICAL, INTENT(IN) :: ORAIN ! switch to activate the
+ ! rain formation by coalescence
+INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step
+ ! for sedimendation
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
+ ! (single if cold start)
+INTEGER, INTENT(IN) :: KMI ! Model index
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
+ ! the nucleation param.
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! abs. pressure at time t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at time t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCM ! Cloud water m.r. at t-dt
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! m.r. at t
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(IN) :: PSVT ! Concentrations at time t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! m.r. source
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(INOUT) :: PSVS ! Concentration sources
+!
+!
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC ! Cloud instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR ! Rain instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINDEP ! Cloud droplets deposition
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRR3D ! Rain inst precip 3D
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D ! Rain evap profile
+!
+!* 0.2 Declarations of local variables :
+!
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: PRVT, & ! Water vapor m.r. at t
+ PRCT, & ! Cloud water m.r. at t
+ PRRT, & ! Rain water m.r. at t
+ !
+ PRVS, & ! Water vapor m.r. source
+ PRCS, & ! Cloud water m.r. source
+ PRRS, & ! Rain water m.r. source
+ !
+ PCCT, & ! Cloud water C. at t
+ PCRT, & ! Rain water C. at t
+ !
+ PCCS, & ! Cloud water C. source
+ PCRS ! Rain water C. source
+!
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZNFS ! CCN C. available source
+ !used as Free ice nuclei for
+ !HOMOGENEOUS nucleation of haze
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZNAS ! Cloud C. nuclei C. source
+ !used as Free ice nuclei for
+ !IMMERSION freezing
+!
+!
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: ZT
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: ZWLBDR,ZWLBDR3,ZWLBDC,ZWLBDC3
+integer :: idx
+INTEGER :: JL
+!
+LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2)) :: GDEP
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 0. 3D MICROPHYSCAL VARIABLES
+! -------------------------
+!
+!
+! Prepare 3D water mixing ratios
+PRVT(:,:,:) = PRT(:,:,:,1)
+PRVS(:,:,:) = PRS(:,:,:,1)
+!
+PRCT(:,:,:) = 0.
+PRCS(:,:,:) = 0.
+PRRT(:,:,:) = 0.
+PRRS(:,:,:) = 0.
+!
+IF ( KRR .GE. 2 ) PRCT(:,:,:) = PRT(:,:,:,2)
+IF ( KRR .GE. 2 ) PRCS(:,:,:) = PRS(:,:,:,2)
+IF ( KRR .GE. 3 ) PRRT(:,:,:) = PRT(:,:,:,3)
+IF ( KRR .GE. 3 ) PRRS(:,:,:) = PRS(:,:,:,3)
+!
+! Prepare 3D number concentrations
+PCCT(:,:,:) = 0.
+PCRT(:,:,:) = 0.
+PCCS(:,:,:) = 0.
+PCRS(:,:,:) = 0.
+!
+IF ( LWARM ) PCCT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NC)
+IF ( LWARM .AND. LRAIN ) PCRT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NR)
+!
+IF ( LWARM ) PCCS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NC)
+IF ( LWARM .AND. LRAIN ) PCRS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NR)
+!
+IF ( NMOD_CCN .GE. 1 ) THEN
+ ALLOCATE( ZNFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_CCN) )
+ ALLOCATE( ZNAS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_CCN) )
+ ZNFS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1)
+ ZNAS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1)
+ELSE
+ ALLOCATE( ZNFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),1) )
+ ALLOCATE( ZNAS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),1) )
+ ZNFS(:,:,:,:) = 0.
+ ZNAS(:,:,:,:) = 0.
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 1. COMPUTE THE SLOPE PARAMETERS ZLBDC,ZLBDR
+! ----------------------------------------
+!
+!
+ZWLBDC3(:,:,:) = XMNH_HUGE
+ZWLBDC(:,:,:) = 1.E15
+!
+WHERE (PRCT(:,:,:)>XRTMIN(2) .AND. PCCT(:,:,:)>XCTMIN(2))
+ ZWLBDC3(:,:,:) = XLBC * PCCT(:,:,:) / PRCT(:,:,:)
+ ZWLBDC(:,:,:) = ZWLBDC3(:,:,:)**XLBEXC
+END WHERE
+!
+ZWLBDR3(:,:,:) = 1.E30
+ZWLBDR(:,:,:) = 1.E10
+WHERE (PRRT(:,:,:)>XRTMIN(3) .AND. PCRT(:,:,:)>XCTMIN(3))
+ ZWLBDR3(:,:,:) = XLBR * PCRT(:,:,:) / PRRT(:,:,:)
+ ZWLBDR(:,:,:) = ZWLBDR3(:,:,:)**XLBEXR
+END WHERE
+ZT(:,:,:) = PTHT(:,:,:) * (PPABST(:,:,:)/XP00)**(XRD/XCPD)
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 2. COMPUTE THE SEDIMENTATION (RS) SOURCE
+! -------------------------------------
+!
+!
+if ( lbudget_rc .and. osedc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rr .and. orain ) call Budget_store_init( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_sv ) then
+ if ( osedc ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'SEDI', pccs(:, :, :) * prhodj(:, :, :) )
+ if ( orain ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'SEDI', pcrs(:, :, :) * prhodj(:, :, :) )
+end if
+
+CALL LIMA_WARM_SEDIMENTATION (OSEDC, KSPLITR, PTSTEP, KMI, &
+ PZZ, PRHODREF, PPABST, ZT, &
+ ZWLBDC, &
+ PRCT, PRRT, PCCT, PCRT, &
+ PRCS, PRRS, PCCS, PCRS, &
+ PINPRC, PINPRR, &
+ PINPRR3D )
+
+if ( lbudget_rc .and. osedc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rr .and. orain ) call Budget_store_end( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_sv ) then
+ if ( osedc ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'SEDI', pccs(:, :, :) * prhodj(:, :, :) )
+ if ( orain ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'SEDI', pcrs(:, :, :) * prhodj(:, :, :) )
+end if
+!
+! 2.bis Deposition at 1st level above ground
+!
+IF (LDEPOC) THEN
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'DEPO', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'DEPO', pccs(:, :, :) * prhodj(:, :, :) )
+
+ PINDEP(:,:)=0.
+ GDEP(:,:) = .FALSE.
+ GDEP(:,:) = PRCS(:,:,2) >0 .AND. PCCS(:,:,2) >0 .AND. PRCT(:,:,2) >0 .AND. PCCT(:,:,2) >0
+ WHERE (GDEP)
+ PRCS(:,:,2) = PRCS(:,:,2) - XVDEPOC * PRCT(:,:,2) / ( PZZ(:,:,3) - PZZ(:,:,2))
+ PCCS(:,:,2) = PCCS(:,:,2) - XVDEPOC * PCCT(:,:,2) / ( PZZ(:,:,3) - PZZ(:,:,2))
+ PINPRC(:,:) = PINPRC(:,:) + XVDEPOC * PRCT(:,:,2) * PRHODREF(:,:,2) /XRHOLW
+ PINDEP(:,:) = XVDEPOC * PRCT(:,:,2) * PRHODREF(:,:,2) /XRHOLW
+ END WHERE
+
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'DEPO', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'DEPO', pccs(:, :, :) * prhodj(:, :, :) )
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. COMPUTES THE NUCLEATION PROCESS SOURCES
+! --------------------------------------
+!
+!
+IF ( LACTI .AND. NMOD_CCN > 0 .AND. .NOT. LSPRO ) THEN
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HENU', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'HENU', prvs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'HENU', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HENU', pccs(:, :, :) * prhodj(:, :, :) )
+ do jl = 1, nmod_ccn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
+ call Budget_store_init( tbudgets(idx), 'HENU', znfs(:, :, :, jl) * prhodj(:, :, :) )
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_acti - 1 + jl
+ call Budget_store_init( tbudgets(idx), 'HENU', znas(:, :, :, jl) * prhodj(:, :, :) )
+ end do
+ end if
+
+ CALL LIMA_WARM_NUCL( OACTIT, PTSTEP, KMI, TPFILE, &
+ PRHODREF, PEXNREF, PPABST, ZT, PTHM, PW_NU, &
+ PRCM, PRVT, PRCT, PRRT, &
+ PTHS, PRVS, PRCS, PCCS, ZNFS, ZNAS )
+
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HENU', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'HENU', prvs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'HENU', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HENU', pccs(:, :, :) * prhodj(:, :, :) )
+ do jl = 1, nmod_ccn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
+ call Budget_store_end( tbudgets(idx), 'HENU', znfs(:, :, :, jl) * prhodj(:, :, :) )
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_acti - 1 + jl
+ call Budget_store_end( tbudgets(idx), 'HENU', znas(:, :, :, jl) * prhodj(:, :, :) )
+ end do
+ end if
+END IF ! LACTI
+!
+!
+!------------------------------------------------------------------------------
+!
+!* 3. COALESCENCE PROCESSES
+! ---------------------
+!
+!
+ CALL LIMA_WARM_COAL (PTSTEP, KMI, &
+ PRHODREF, ZWLBDC3, ZWLBDC, ZWLBDR3, ZWLBDR, &
+ PRCT, PRRT, PCCT, PCRT, &
+ PRCS, PRRS, PCCS, PCRS, &
+ PRHODJ )
+!
+!
+!-------------------------------------------------------------------------------
+!
+! 4. EVAPORATION OF RAINDROPS
+! ------------------------
+!
+!
+IF (ORAIN) THEN
+
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'REVA', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'REVA', prvs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'REVA', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'REVA', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'REVA', pccs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'REVA', pcrs(:, :, :) * prhodj(:, :, :) )
+
+ CALL LIMA_WARM_EVAP (PTSTEP, KMI, &
+ PRHODREF, PEXNREF, PPABST, ZT, &
+ ZWLBDC3, ZWLBDC, ZWLBDR3, ZWLBDR, &
+ PRVT, PRCT, PRRT, PCRT, &
+ PRVS, PRCS, PRRS, PCCS, PCRS, PTHS, &
+ PEVAP3D )
+
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'REVA', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'REVA', prvs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'REVA', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'REVA', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'REVA', pccs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'REVA', pcrs(:, :, :) * prhodj(:, :, :) )
+!-------------------------------------------------------------------------------
+!
+! 5. SPONTANEOUS BREAK-UP (NUMERICAL FILTER)
+! --------------------
+!
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'BRKU', pcrs(:, :, :) * prhodj(:, :, :) )
+
+ ZWLBDR(:,:,:) = 1.E10
+ WHERE (PRRS(:,:,:)>XRTMIN(3)/PTSTEP.AND.PCRS(:,:,:)>XCTMIN(3)/PTSTEP )
+ ZWLBDR3(:,:,:) = XLBR * PCRS(:,:,:) / PRRS(:,:,:)
+ ZWLBDR(:,:,:) = ZWLBDR3(:,:,:)**XLBEXR
+ END WHERE
+ WHERE (ZWLBDR(:,:,:)<(XACCR1/XSPONBUD1))
+ PCRS(:,:,:) = PCRS(:,:,:)*MAX((1.+XSPONCOEF2*(XACCR1/ZWLBDR(:,:,:)-XSPONBUD1)**2),&
+ (XACCR1/ZWLBDR(:,:,:)/XSPONBUD3)**3)
+ END WHERE
+!
+! Budget storage
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'BRKU', pcrs(:, :, :) * prhodj(:, :, :) )
+ENDIF ! ORAIN
+!
+!------------------------------------------------------------------------------
+!
+!
+!* 6. REPORT 3D MICROPHYSICAL VARIABLES IN PRS AND PSVS
+! -------------------------------------------------
+!
+PRS(:,:,:,1) = PRVS(:,:,:)
+IF ( KRR .GE. 2 ) PRS(:,:,:,2) = PRCS(:,:,:)
+IF ( KRR .GE. 3 ) PRS(:,:,:,3) = PRRS(:,:,:)
+!
+! Prepare 3D number concentrations
+!
+IF ( LWARM ) PSVS(:,:,:,NSV_LIMA_NC) = PCCS(:,:,:)
+IF ( LWARM .AND. LRAIN ) PSVS(:,:,:,NSV_LIMA_NR) = PCRS(:,:,:)
+!
+IF ( NMOD_CCN .GE. 1 ) THEN
+ PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1) = ZNFS(:,:,:,:)
+ PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1) = ZNAS(:,:,:,:)
+END IF
+!
+IF (ALLOCATED(ZNFS)) DEALLOCATE(ZNFS)
+IF (ALLOCATED(ZNAS)) DEALLOCATE(ZNAS)
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_WARM
diff --git a/src/mesonh/micro/lima_warm_coal.f90 b/src/mesonh/micro/lima_warm_coal.f90
new file mode 100644
index 000000000..4ec69ac58
--- /dev/null
+++ b/src/mesonh/micro/lima_warm_coal.f90
@@ -0,0 +1,460 @@
+!MNH_LIC Copyright 2013-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ##########################
+ MODULE MODI_LIMA_WARM_COAL
+! ##########################
+!
+INTERFACE
+ SUBROUTINE LIMA_WARM_COAL (PTSTEP, KMI, &
+ PRHODREF, ZWLBDC3, ZWLBDC, ZWLBDR3, ZWLBDR, &
+ PRCT, PRRT, PCCT, PCRT, &
+ PRCS, PRRS, PCCS, PCRS, &
+ PRHODJ )
+!
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
+ ! (single if cold start)
+INTEGER, INTENT(IN) :: KMI ! Model index
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZWLBDC3 ! Lambda(cloud) **3
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZWLBDC ! Lambda(cloud)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZWLBDR3 ! Lambda(rain) **3
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZWLBDR ! Lambda(rain)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCT ! Cloud water C. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRT ! Rain water C. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCS ! Cloud water C. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCRS ! Rain water C. source
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ
+!
+ END SUBROUTINE LIMA_WARM_COAL
+END INTERFACE
+END MODULE MODI_LIMA_WARM_COAL
+! #############################################################################
+ SUBROUTINE LIMA_WARM_COAL (PTSTEP, KMI, &
+ PRHODREF, ZWLBDC3, ZWLBDC, ZWLBDR3, ZWLBDR, &
+ PRCT, PRRT, PCCT, PCRT, &
+ PRCS, PRRS, PCCS, PCRS, &
+ PRHODJ )
+! #############################################################################
+!
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the microphysical sources:
+!! nucleation, sedimentation, autoconversion, accretion, self-collection
+!! and vaporisation which are parameterized according to Cohard and Pinty
+!! QJRMS, 2000
+!!
+!!
+!!** METHOD
+!! ------
+!! Assuming a generalized gamma distribution law for the cloud droplets
+!! and the raindrops, the zeroth and third order moments tendencies
+!! are evaluated for all the coalescence terms by integrating the
+!! Stochastic Collection Equation. As autoconversion is a process that
+!! cannot be resolved analytically, the Berry-Reinhardt parameterisation
+!! is employed with modifications to initiate the raindrop spectrum mode.
+!!
+!! Computation steps :
+!! 1- Check where computations are necessary, pack variables
+!! 2- Self collection of cloud droplets
+!! 3- Autoconversion of cloud droplets (Berry-Reinhardt parameterization)
+!! 4- Accretion sources
+!! 5- Self collection - Coalescence/Break-up
+!! 6- Unpack variables, clean
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Cohard, J.-M. and J.-P. Pinty, 2000: A comprehensive two-moment warm
+!! microphysical bulk scheme.
+!! Part I: Description and tests
+!! Part II: 2D experiments with a non-hydrostatic model
+!! Accepted for publication in Quart. J. Roy. Meteor. Soc.
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!! C. Barthe * LACy * jan. 2014 add budgets
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets (no more budget calls in this subroutine)
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+use modd_budget, only: lbudget_rc, lbudget_rr, lbudget_sv, NBUDGET_RC, NBUDGET_RR, NBUDGET_SV1, tbudgets
+USE MODD_NSV, ONLY: NSV_LIMA_NC, NSV_LIMA_NR
+USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
+USE MODD_PARAM_LIMA
+USE MODD_PARAM_LIMA_WARM
+
+use mode_budget, only: Budget_store_init, Budget_store_end
+use mode_tools, only: Countjv
+
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
+ ! (single if cold start)
+INTEGER, INTENT(IN) :: KMI ! Model index
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZWLBDC3 ! Lambda(cloud) **3
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZWLBDC ! Lambda(cloud)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZWLBDR3 ! Lambda(rain) **3
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZWLBDR ! Lambda(rain)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCT ! Cloud water C. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRT ! Rain water C. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCS ! Cloud water C. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCRS ! Rain water C. source
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ
+!
+!* 0.1 Declarations of local variables :
+!
+! Packing variables
+LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: GMICRO
+INTEGER :: IMICRO
+INTEGER , DIMENSION(SIZE(GMICRO)) :: I1,I2,I3 ! Used to replace the COUNT
+INTEGER :: JL ! and PACK intrinsics
+!
+! Packed micophysical variables
+REAL, DIMENSION(:) , ALLOCATABLE :: ZRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:) , ALLOCATABLE :: ZRRT ! Rain water m.r. at t
+REAL, DIMENSION(:) , ALLOCATABLE :: ZCCT ! cloud conc. at t
+REAL, DIMENSION(:) , ALLOCATABLE :: ZCRT ! rain conc. at t
+!
+REAL, DIMENSION(:) , ALLOCATABLE :: ZRCS ! Cloud water m.r. source
+REAL, DIMENSION(:) , ALLOCATABLE :: ZRRS ! Rain water m.r. source
+REAL, DIMENSION(:) , ALLOCATABLE :: ZCCS ! cloud conc. source
+REAL, DIMENSION(:) , ALLOCATABLE :: ZCRS ! rain conc. source
+!
+! Other packed variables
+REAL, DIMENSION(:) , ALLOCATABLE :: ZRHODREF ! RHO Dry REFerence
+REAL, DIMENSION(:) , ALLOCATABLE :: ZLBDC3
+REAL, DIMENSION(:) , ALLOCATABLE :: ZLBDC
+REAL, DIMENSION(:) , ALLOCATABLE :: ZLBDR3
+REAL, DIMENSION(:) , ALLOCATABLE :: ZLBDR
+!
+! Work arrays
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: ZW
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZZW1, ZZW2, ZZW3, ZZW4, ZSCBU
+LOGICAL, DIMENSION(:), ALLOCATABLE :: GSELF, &
+ GACCR, &
+ GSCBU, &
+ GENABLE_ACCR_SCBU
+!
+!
+INTEGER :: ISELF, IACCR, ISCBU
+INTEGER :: IIB, IIE, IJB, IJE, IKB, IKE ! Physical domain
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 1. PREPARE COMPUTATIONS - PACK
+! ---------------------------
+!
+!
+IIB=1+JPHEXT
+IIE=SIZE(PRHODREF,1) - JPHEXT
+IJB=1+JPHEXT
+IJE=SIZE(PRHODREF,2) - JPHEXT
+IKB=1+JPVEXT
+IKE=SIZE(PRHODREF,3) - JPVEXT
+!
+GMICRO(:,:,:) = .FALSE.
+GMICRO(IIB:IIE,IJB:IJE,IKB:IKE) = &
+ PRCT(IIB:IIE,IJB:IJE,IKB:IKE)>XRTMIN(2) .OR. &
+ PRRT(IIB:IIE,IJB:IJE,IKB:IKE)>XRTMIN(3)
+!
+IMICRO = COUNTJV( GMICRO(:,:,:),I1(:),I2(:),I3(:))
+!
+IF( IMICRO >= 1 ) THEN
+ ALLOCATE(ZRCT(IMICRO))
+ ALLOCATE(ZRRT(IMICRO))
+ ALLOCATE(ZCCT(IMICRO))
+ ALLOCATE(ZCRT(IMICRO))
+!
+ ALLOCATE(ZRCS(IMICRO))
+ ALLOCATE(ZRRS(IMICRO))
+ ALLOCATE(ZCCS(IMICRO))
+ ALLOCATE(ZCRS(IMICRO))
+!
+ ALLOCATE(ZLBDC(IMICRO))
+ ALLOCATE(ZLBDC3(IMICRO))
+ ALLOCATE(ZLBDR(IMICRO))
+ ALLOCATE(ZLBDR3(IMICRO))
+!
+ ALLOCATE(ZRHODREF(IMICRO))
+ DO JL=1,IMICRO
+ ZCCT(JL) = PCCT(I1(JL),I2(JL),I3(JL))
+ ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
+ ZRRT(JL) = PRRT(I1(JL),I2(JL),I3(JL))
+ ZCRT(JL) = PCRT(I1(JL),I2(JL),I3(JL))
+ ZCCS(JL) = PCCS(I1(JL),I2(JL),I3(JL))
+ ZRCS(JL) = PRCS(I1(JL),I2(JL),I3(JL))
+ ZRRS(JL) = PRRS(I1(JL),I2(JL),I3(JL))
+ ZCRS(JL) = PCRS(I1(JL),I2(JL),I3(JL))
+ ZLBDR(JL) = ZWLBDR(I1(JL),I2(JL),I3(JL))
+ ZLBDR3(JL) = ZWLBDR3(I1(JL),I2(JL),I3(JL))
+ ZLBDC(JL) = ZWLBDC(I1(JL),I2(JL),I3(JL))
+ ZLBDC3(JL) = ZWLBDC3(I1(JL),I2(JL),I3(JL))
+ ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
+ END DO
+!
+ ALLOCATE(GSELF(IMICRO))
+ ALLOCATE(GACCR(IMICRO))
+ ALLOCATE(GSCBU(IMICRO))
+ ALLOCATE(ZZW1(IMICRO))
+ ALLOCATE(ZZW2(IMICRO))
+ ALLOCATE(ZZW3(IMICRO))
+!
+!
+!-------------------------------------------------------------------------------
+!
+IF (LRAIN) THEN
+!
+!* 2. Self-collection of cloud droplets
+! ------------------------------------
+!
+!
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'SELF', pccs(:, :, :) * prhodj(:, :, :) )
+
+ GSELF(:) = ZCCT(:)>XCTMIN(2)
+ ISELF = COUNT(GSELF(:))
+ IF( ISELF>0 ) THEN
+ ZZW1(:) = XSELFC*(ZCCT(:)/ZLBDC3(:))**2 * ZRHODREF(:) ! analytical integration
+ WHERE( GSELF(:) )
+ ZCCS(:) = ZCCS(:) - MIN( ZCCS(:),ZZW1(:) )
+ END WHERE
+ END IF
+
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'SELF', &
+ Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
+
+!-------------------------------------------------------------------------------
+!
+!
+!* 3. Autoconversion of cloud droplets (Berry-Reinhardt parameterization)
+! ----------------------------------------------------------------------
+!
+!
+!
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'AUTO', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'AUTO', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ !call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'AUTO', pccs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'AUTO', pcrs(:, :, :) * prhodj(:, :, :) )
+ end if
+
+ ZZW2(:) = 0.0
+ ZZW1(:) = 0.0
+ WHERE( ZRCT(:)>XRTMIN(2) )
+ ZZW2(:) = MAX( 0.0,XLAUTR*ZRHODREF(:)*ZRCT(:)* &
+ (XAUTO1/min(ZLBDC(:),1.e9)**4-XLAUTR_THRESHOLD) ) ! L
+!
+ ZZW3(:) = MIN( ZRCS(:), MAX( 0.0,XITAUTR*ZZW2(:)*ZRCT(:)* &
+ (XAUTO2/ZLBDC(:)-XITAUTR_THRESHOLD) ) ) ! L/tau
+!
+ ZRCS(:) = ZRCS(:) - ZZW3(:)
+ ZRRS(:) = ZRRS(:) + ZZW3(:)
+!
+ ZZW1(:) = MIN( MIN( 1.2E4,(XACCR4/ZLBDC(:)-XACCR5)/XACCR3), &
+ ZLBDR(:)/XACCR1 ) ! D**-1 threshold diameter for
+ ! switching the autoconversion regimes
+ ! min (80 microns, D_h, D_r)
+ ZZW3(:) = ZZW3(:) * MAX( 0.0,ZZW1(:) )**3 / XAC
+ ZCRS(:) = ZCRS(:) + ZZW3(:)
+ END WHERE
+
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'AUTO', &
+ Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'AUTO', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ !This budget is = 0 for nsv_lima_nc => not necessary to call it (ZCCS is not modified in this part)
+ !call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'AUTO', &
+ ! Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'AUTO', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ end if
+
+!-------------------------------------------------------------------------------
+!
+!
+!* 4. Accretion sources
+! --------------------
+!
+!
+ GACCR(:) = ZRRT(:)>XRTMIN(3) .AND. ZCRT(:)>XCTMIN(3)
+ IACCR = COUNT(GACCR(:))
+ IF( IACCR>0 ) THEN
+ ALLOCATE(ZZW4(IMICRO)); ZZW4(:) = XACCR1/ZLBDR(:)
+ ALLOCATE(GENABLE_ACCR_SCBU(IMICRO))
+ GENABLE_ACCR_SCBU(:) = ZRRT(:)>1.2*ZZW2(:)/ZRHODREF(:) .OR. &
+ ZZW4(:)>=MAX( XACCR2,XACCR3/(XACCR4/ZLBDC(:)-XACCR5) )
+ GACCR(:) = GACCR(:) .AND. ZRCT(:)>XRTMIN(2) .AND. ZCCT(:)>XCTMIN(2) .AND. GENABLE_ACCR_SCBU(:)
+ END IF
+!
+ IACCR = COUNT(GACCR(:))
+ IF( IACCR>0 ) THEN
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'ACCR', &
+ Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'ACCR', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'ACCR', &
+ Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
+ WHERE( GACCR(:).AND.(ZZW4(:)>1.E-4) ) ! Accretion for D>100 10-6 m
+ ZZW3(:) = ZLBDC3(:) / ZLBDR3(:)
+ ZZW1(:) = ( ZCCT(:)*ZCRT(:) / ZLBDC3(:) )*ZRHODREF(:)
+ ZZW2(:) = MIN( ZZW1(:)*(XACCR_CLARGE1+XACCR_CLARGE2*ZZW3(:)),ZCCS(:) )
+ ZCCS(:) = ZCCS(:) - ZZW2(:)
+!
+ ZZW1(:) = ( ZZW1(:) / ZLBDC3(:) )
+ ZZW2(:) = MIN( ZZW1(:)*(XACCR_RLARGE1+XACCR_RLARGE2*ZZW3(:)),ZRCS(:) )
+ ZRCS(:) = ZRCS(:) - ZZW2(:)
+ ZRRS(:) = ZRRS(:) + ZZW2(:)
+ END WHERE
+ WHERE( GACCR(:).AND.(ZZW4(:)<=1.E-4) ) ! Accretion for D<100 10-6 m
+ ZZW3(:) = MIN(ZLBDC3(:) / ZLBDR3(:), 1.E8)
+ ZZW1(:) = ( ZCCT(:)*ZCRT(:) / ZLBDC3(:) )*ZRHODREF(:)
+ ZZW1(:) = ZZW1(:) / ZLBDC3(:)
+ ZZW3(:) = ZZW3(:)**2
+ ZZW2(:) = MIN( ZZW1(:)*(XACCR_CSMALL1+XACCR_CSMALL2*ZZW3(:)),ZCCS(:) )
+ ZCCS(:) = ZCCS(:) - ZZW2(:)
+!
+ ZZW1(:) = ZZW1(:) / ZLBDC3(:)
+ ZZW2(:) = MIN( ZZW1(:)*(XACCR_RSMALL1+XACCR_RSMALL2*ZZW3(:)) &
+ ,ZRCS(:) )
+ ZRCS(:) = ZRCS(:) - ZZW2(:)
+ ZRRS(:) = ZRRS(:) + ZZW2(:)
+ END WHERE
+
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'ACCR', &
+ Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'ACCR', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'ACCR', &
+ Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
+ END IF
+!-------------------------------------------------------------------------------
+!
+!
+!* 5. Self collection - Coalescence/Break-up
+! -----------------------------------------
+!
+!
+ IF( IACCR>0 ) THEN
+ GSCBU(:) = ZCRT(:)>XCTMIN(3) .AND. GENABLE_ACCR_SCBU(:)
+ ISCBU = COUNT(GSCBU(:))
+ ELSE
+ ISCBU = 0.0
+ END IF
+ IF( ISCBU>0 ) THEN
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'SCBU', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+!
+!* 5.1 efficiencies
+!
+ IF (.NOT.ALLOCATED(ZZW4)) ALLOCATE(ZZW4(IMICRO))
+ ZZW4(:) = XACCR1 / ZLBDR(:) ! Mean diameter
+ ALLOCATE(ZSCBU(IMICRO))
+ ZSCBU(:) = 1.0
+ WHERE (ZZW4(:)>=XSCBU_EFF1 .AND. GSCBU(:)) ZSCBU(:) = & ! Coalescence
+ EXP(XSCBUEXP1*(ZZW4(:)-XSCBU_EFF1)) ! efficiency
+ WHERE (ZZW4(:)>=XSCBU_EFF2) ZSCBU(:) = 0.0 ! Break-up
+!
+!* 5.2 integration
+!
+ ZZW1(:) = 0.0
+ ZZW2(:) = 0.0
+ ZZW3(:) = 0.0
+ ZZW4(:) = XACCR1 / ZLBDR(:) ! Mean volume drop diameter
+ WHERE (GSCBU(:).AND.(ZZW4(:)>1.E-4)) ! analytical integration
+ ZZW1(:) = XSCBU2 * ZCRT(:)**2 / ZLBDR3(:) ! D>100 10-6 m
+ ZZW3(:) = ZZW1(:)*ZSCBU(:)
+ END WHERE
+ WHERE (GSCBU(:).AND.(ZZW4(:)<=1.E-4))
+ ZZW2(:) = XSCBU3 *(ZCRT(:) / ZLBDR3(:))**2 ! D<100 10-6 m
+ ZZW3(:) = ZZW2(:)
+ END WHERE
+ ZCRS(:) = ZCRS(:) - MIN( ZCRS(:),ZZW3(:) * ZRHODREF(:) )
+ DEALLOCATE(ZSCBU)
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'SCBU', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ END IF
+END IF ! LRAIN
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 6. Unpack and clean
+! -------------------
+!
+!
+ ZW(:,:,:) = PRCS(:,:,:)
+ PRCS(:,:,:) = UNPACK( ZRCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PRRS(:,:,:)
+ PRRS(:,:,:) = UNPACK( ZRRS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PCCS(:,:,:)
+ PCCS(:,:,:) = UNPACK( ZCCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PCRS(:,:,:)
+ PCRS(:,:,:) = UNPACK( ZCRS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+!
+ DEALLOCATE(ZRCT)
+ DEALLOCATE(ZRRT)
+ DEALLOCATE(ZCCT)
+ DEALLOCATE(ZCRT)
+ DEALLOCATE(ZRCS)
+ DEALLOCATE(ZRRS)
+ DEALLOCATE(ZCRS)
+ DEALLOCATE(ZCCS)
+ DEALLOCATE(ZRHODREF)
+ DEALLOCATE(GSELF)
+ DEALLOCATE(GACCR)
+ DEALLOCATE(GSCBU)
+ IF( ALLOCATED(GENABLE_ACCR_SCBU) ) DEALLOCATE(GENABLE_ACCR_SCBU)
+ DEALLOCATE(ZZW1)
+ DEALLOCATE(ZZW2)
+ DEALLOCATE(ZZW3)
+ IF( ALLOCATED(ZZW4) ) DEALLOCATE(ZZW4)
+ DEALLOCATE(ZLBDR3)
+ DEALLOCATE(ZLBDC3)
+ DEALLOCATE(ZLBDR)
+ DEALLOCATE(ZLBDC)
+END IF ! IMICRO
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_WARM_COAL
diff --git a/src/mesonh/micro/lima_warm_evap.f90 b/src/mesonh/micro/lima_warm_evap.f90
new file mode 100644
index 000000000..9a67a4b82
--- /dev/null
+++ b/src/mesonh/micro/lima_warm_evap.f90
@@ -0,0 +1,353 @@
+!MNH_LIC Copyright 2013-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ##########################
+ MODULE MODI_LIMA_WARM_EVAP
+! ##########################
+!
+INTERFACE
+ SUBROUTINE LIMA_WARM_EVAP (PTSTEP, KMI, &
+ PRHODREF, PEXNREF, PPABST, ZT, &
+ ZWLBDC3, ZWLBDC, ZWLBDR3, ZWLBDR, &
+ PRVT, PRCT, PRRT, PCRT, &
+ PRVS, PRCS, PRRS, PCCS, PCRS, PTHS, &
+ PEVAP3D)
+!
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
+ ! (single if cold start)
+INTEGER, INTENT(IN) :: KMI ! Model index
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZT ! Temperature
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: ZWLBDC3 ! Lambda(cloud) **3
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: ZWLBDC ! Lambda(cloud)
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: ZWLBDR3 ! Lambda(rain) **3
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: ZWLBDR ! Lambda(rain)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRT ! Rain water C. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCS ! Cloud water C. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCRS ! Rain water C. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D ! Rain evap profile
+!
+ END SUBROUTINE LIMA_WARM_EVAP
+END INTERFACE
+END MODULE MODI_LIMA_WARM_EVAP
+! #############################################################################
+ SUBROUTINE LIMA_WARM_EVAP (PTSTEP, KMI, &
+ PRHODREF, PEXNREF, PPABST, ZT, &
+ ZWLBDC3, ZWLBDC, ZWLBDR3, ZWLBDR, &
+ PRVT, PRCT, PRRT, PCRT, &
+ PRVS, PRCS, PRRS, PCCS, PCRS, PTHS, &
+ PEVAP3D)
+! #############################################################################
+!
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the raindrop evaporation
+!!
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
+USE MODD_PARAM_LIMA
+USE MODD_PARAM_LIMA_WARM
+!
+use mode_tools, only: Countjv
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
+ ! (single if cold start)
+INTEGER, INTENT(IN) :: KMI ! Model index
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZT ! Temperature
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: ZWLBDC3 ! Lambda(cloud) **3
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: ZWLBDC ! Lambda(cloud)
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: ZWLBDR3 ! Lambda(rain) **3
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: ZWLBDR ! Lambda(rain)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRT ! Rain water C. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCS ! Cloud water C. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCRS ! Rain water C. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D ! Rain evap profile
+!
+!* 0.1 Declarations of local variables :
+!
+! Packing variables
+LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: GEVAP, GMICRO
+INTEGER :: IEVAP, IMICRO
+INTEGER , DIMENSION(SIZE(GEVAP)) :: I1,I2,I3 ! Used to replace the COUNT
+INTEGER :: JL ! and PACK intrinsics
+!
+! Packed micophysical variables
+REAL, DIMENSION(:) , ALLOCATABLE :: ZRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:) , ALLOCATABLE :: ZRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:) , ALLOCATABLE :: ZRRT ! Rain water m.r. at t
+REAL, DIMENSION(:) , ALLOCATABLE :: ZCRT ! rain conc. at t
+!
+REAL, DIMENSION(:) , ALLOCATABLE :: ZRVS ! Water vapor m.r. source
+REAL, DIMENSION(:) , ALLOCATABLE :: ZRRS ! Rain water m.r. source
+REAL, DIMENSION(:) , ALLOCATABLE :: ZTHS ! Theta source
+!
+! Other packed variables
+REAL, DIMENSION(:) , ALLOCATABLE :: ZRHODREF ! RHO Dry REFerence
+REAL, DIMENSION(:) , ALLOCATABLE :: ZEXNREF ! EXNer Pressure REFerence
+REAL, DIMENSION(:) , ALLOCATABLE :: ZZT ! Temperature
+REAL, DIMENSION(:) , ALLOCATABLE :: ZLBDR ! Lambda(rain)
+!
+! Work arrays
+REAL, DIMENSION(:), ALLOCATABLE :: ZZW1, ZZW2, ZZW3, &
+ ZRTMIN, ZCTMIN, &
+ ZZLV ! Latent heat of vaporization at T
+!
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: ZW, ZW2, ZRVSAT, ZDR
+!
+!
+REAL :: ZEPS, ZFACT
+INTEGER :: IIB, IIE, IJB, IJE, IKB, IKE ! Physical domain
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 1. PREPARE COMPUTATIONS - PACK
+! ---------------------------
+!
+!
+IIB=1+JPHEXT
+IIE=SIZE(PRHODREF,1) - JPHEXT
+IJB=1+JPHEXT
+IJE=SIZE(PRHODREF,2) - JPHEXT
+IKB=1+JPVEXT
+IKE=SIZE(PRHODREF,3) - JPVEXT
+!
+ALLOCATE(ZRTMIN(SIZE(XRTMIN)))
+ALLOCATE(ZCTMIN(SIZE(XCTMIN)))
+ZRTMIN(:) = XRTMIN(:) / PTSTEP
+ZCTMIN(:) = XCTMIN(:) / PTSTEP
+!
+ZEPS= XMV / XMD
+ZRVSAT(:,:,:) = ZEPS / (PPABST(:,:,:) * &
+ EXP(-XALPW+XBETAW/ZT(:,:,:)+XGAMW*ALOG(ZT(:,:,:))) - 1.0)
+
+!
+GEVAP(:,:,:) = .FALSE.
+GEVAP(IIB:IIE,IJB:IJE,IKB:IKE) = &
+ PRRS(IIB:IIE,IJB:IJE,IKB:IKE)>ZRTMIN(3) .AND. &
+ PRVT(IIB:IIE,IJB:IJE,IKB:IKE)<ZRVSAT(IIB:IIE,IJB:IJE,IKB:IKE)
+!
+IEVAP = COUNTJV( GEVAP(:,:,:),I1(:),I2(:),I3(:))
+!
+IF( IEVAP >= 1 ) THEN
+ ALLOCATE(ZRVT(IEVAP))
+ ALLOCATE(ZRCT(IEVAP))
+ ALLOCATE(ZRRT(IEVAP))
+ ALLOCATE(ZCRT(IEVAP))
+!
+ ALLOCATE(ZRVS(IEVAP))
+ ALLOCATE(ZRRS(IEVAP))
+ ALLOCATE(ZTHS(IEVAP))
+!
+ ALLOCATE(ZLBDR(IEVAP))
+!
+ ALLOCATE(ZRHODREF(IEVAP))
+ ALLOCATE(ZEXNREF(IEVAP))
+!
+ ALLOCATE(ZZT(IEVAP))
+ ALLOCATE(ZZLV(IEVAP))
+ ALLOCATE(ZZW1(IEVAP))
+ DO JL=1,IEVAP
+ ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL))
+ ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
+ ZRRT(JL) = PRRT(I1(JL),I2(JL),I3(JL))
+ ZCRT(JL) = PCRT(I1(JL),I2(JL),I3(JL))
+ ZRRS(JL) = PRRS(I1(JL),I2(JL),I3(JL))
+ ZRVS(JL) = PRVS(I1(JL),I2(JL),I3(JL))
+ ZTHS(JL) = PTHS(I1(JL),I2(JL),I3(JL))
+ ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
+ ZZW1(JL) = ZRVSAT(I1(JL),I2(JL),I3(JL))
+ ZLBDR(JL) = ZWLBDR(I1(JL),I2(JL),I3(JL))
+ ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
+ ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL))
+ END DO
+ ZZLV(:) = XLVTT + (XCPV-XCL)*(ZZT(:)-XTT)
+!
+ ALLOCATE(ZZW2(IEVAP))
+ ALLOCATE(ZZW3(IEVAP))
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 2. compute the evaporation of rain drops
+! ----------------------------------------
+!
+!
+ ZZW3(:) = MAX((1.0 - ZRVT(:)/ZZW1(:)),0.0) ! Subsaturation
+!
+! Compute the function G(T)
+!
+ ZZW2(:) = 1. / ( XRHOLW*((((ZZLV(:)/ZZT(:))**2)/(XTHCO*XRV)) + & ! G
+ (XRV*ZZT(:))/(XDIVA*EXP(XALPW-XBETAW/ZZT(:)-XGAMW*ALOG(ZZT(:))))))
+!
+! Compute the evaporation tendency
+!
+ ZZW2(:) = MIN( ZZW2(:) * ZZW3(:) * ZRRT(:) * &
+ (X0EVAR*ZLBDR(:)**XEX0EVAR + X1EVAR*ZRHODREF(:)**XEX2EVAR* &
+ ZLBDR(:)**XEX1EVAR),ZRRS(:) )
+ ZZW2(:) = MAX(ZZW2(:),0.0)
+!
+! Adjust sources
+!
+ ZRVS(:) = ZRVS(:) + ZZW2(:)
+ ZRRS(:) = ZRRS(:) - ZZW2(:)
+ ZTHS(:) = ZTHS(:) - ZZW2(:)*ZZLV(:) / &
+ ( ZEXNREF(:)*(XCPD + XCPV*ZRVT(:) + XCL*(ZRCT(:) + ZRRT(:)) ) )
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 3. Unpack and clean
+! -------------------
+!
+!
+ ZW(:,:,:) = PRVS(:,:,:)
+ PRVS(:,:,:) = UNPACK( ZRVS(:),MASK=GEVAP(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PRRS(:,:,:)
+ PRRS(:,:,:) = UNPACK( ZRRS(:),MASK=GEVAP(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PTHS(:,:,:)
+ PTHS(:,:,:) = UNPACK( ZTHS(:),MASK=GEVAP(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:)= PEVAP3D(:,:,:)
+ PEVAP3D(:,:,:) = UNPACK( ZZW2(:),MASK=GEVAP(:,:,:),FIELD=ZW(:,:,:) )
+!
+ DEALLOCATE(ZRCT)
+ DEALLOCATE(ZRRT)
+ DEALLOCATE(ZRVT)
+ DEALLOCATE(ZCRT)
+ DEALLOCATE(ZRVS)
+ DEALLOCATE(ZRRS)
+ DEALLOCATE(ZTHS)
+ DEALLOCATE(ZZLV)
+ DEALLOCATE(ZZT)
+ DEALLOCATE(ZRHODREF)
+ DEALLOCATE(ZEXNREF)
+ DEALLOCATE(ZZW1)
+ DEALLOCATE(ZZW2)
+ DEALLOCATE(ZZW3)
+ DEALLOCATE(ZLBDR)
+!
+!
+!-----------------------------------------------------------------------------
+!
+!
+!* 4. Update Nr if: 80 microns < Dr < D_h
+! ---------------------------------------
+!
+!
+ GEVAP(:,:,:) = PRRS(:,:,:)>ZRTMIN(3) .AND. PCRS(:,:,:)>ZCTMIN(3)
+ ZDR(:,:,:) = 9999.
+ WHERE (GEVAP(:,:,:))
+ ZDR(:,:,:)=(6.*PRRS(:,:,:)/XPI/XRHOLW/PCRS(:,:,:))**0.33
+ ZWLBDR3(:,:,:) = XLBR * PCRS(:,:,:) / PRRS(:,:,:)
+ ZWLBDR(:,:,:) = ZWLBDR3(:,:,:)**XLBEXR
+ END WHERE
+ !
+ WHERE (GEVAP(:,:,:) .AND. ZDR(:,:,:).LT.82.E-6)
+ PCCS(:,:,:) = PCCS(:,:,:)+PCRS(:,:,:)
+ PCRS(:,:,:) = 0.
+ PRCS(:,:,:) = PRCS(:,:,:)+PRRS(:,:,:)
+ PRRS(:,:,:) = 0.
+ END WHERE
+
+!!$ GMICRO(:,:,:) = GEVAP(:,:,:) .AND. ZWLBDR(:,:,:)/XACCR1>ZWLBDC3(:,:,:)
+!!$ ! the raindrops are too small, that is lower than D_h
+!!$ ZFACT = 1.2E4*XACCR1
+!!$ WHERE (GMICRO(:,:,:))
+!!$ ZWLBDC(:,:,:) = XLBR / MIN( ZFACT,ZWLBDC3(:,:,:) )**3
+!!$ ZW(:,:,:) = MIN( MAX( &
+!!$ (PRHODREF(:,:,:)*PRRS(:,:,:) - ZWLBDC(:,:,:)*PCRS(:,:,:)) / &
+!!$ (PRHODREF(:,:,:)*PRCS(:,:,:)/PCCS(:,:,:) - ZWLBDC(:,:,:)) , &
+!!$ 0.0 ),PCRS(:,:,:), &
+!!$ PCCS(:,:,:)*PRRS(:,:,:)/(PRCS(:,:,:)))
+!!$!
+!!$! Compute the percent (=1 if (ZWLBDR/XACCR1) >= 1.2E4
+!!$! of transfer with (=0 if (ZWLBDR/XACCR1) <= (XACCR4/ZWLBDC-XACCR5)/XACCR3
+!!$!
+!!$ ZW(:,:,:) = ZW(:,:,:)*( (MIN(ZWLBDR(:,:,:),1.2E4*XACCR1)-ZWLBDC3(:,:,:)) / &
+!!$ ( 1.2E4*XACCR1 -ZWLBDC3(:,:,:)) )
+!!$!
+!!$ ZW2(:,:,:) = PCCS(:,:,:) !temporary storage
+!!$ PCCS(:,:,:) = PCCS(:,:,:)+ZW(:,:,:)
+!!$ PCRS(:,:,:) = PCRS(:,:,:)-ZW(:,:,:)
+!!$ ZW(:,:,:) = ZW(:,:,:) * (PRHODREF(:,:,:)*PRCS(:,:,:)/ZW2(:,:,:))
+!!$ PRCS(:,:,:) = PRCS(:,:,:)+ZW(:,:,:)
+!!$ PRRS(:,:,:) = PRRS(:,:,:)-ZW(:,:,:)
+!!$ END WHERE
+!!$!
+!!$ GEVAP(:,:,:) = PRRS(:,:,:)<ZRTMIN(3) .OR. PCRS(:,:,:)<ZCTMIN(3)
+!!$ WHERE (GEVAP(:,:,:))
+!!$ PCRS(:,:,:) = 0.0
+!!$ PRRS(:,:,:) = 0.0
+!!$ END WHERE
+!
+END IF ! IEVAP
+!
+!++cb++
+DEALLOCATE(ZRTMIN)
+DEALLOCATE(ZCTMIN)
+!--cb--
+!
+!-----------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_WARM_EVAP
diff --git a/src/mesonh/micro/lima_warm_nucl.f90 b/src/mesonh/micro/lima_warm_nucl.f90
new file mode 100644
index 000000000..549a5fc84
--- /dev/null
+++ b/src/mesonh/micro/lima_warm_nucl.f90
@@ -0,0 +1,860 @@
+!MNH_LIC Copyright 2013-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ##########################
+ MODULE MODI_LIMA_WARM_NUCL
+! ##########################
+!
+INTERFACE
+ SUBROUTINE LIMA_WARM_NUCL( OACTIT, PTSTEP, KMI, TPFILE, &
+ PRHODREF, PEXNREF, PPABST, PT, PTM, PW_NU, &
+ PRCM, PRVT, PRCT, PRRT, &
+ PTHS, PRVS, PRCS, PCCS, PNFS, PNAS )
+!
+USE MODD_IO, ONLY: TFILEDATA
+!
+LOGICAL, INTENT(IN) :: OACTIT ! Switch to activate the
+ ! activation by radiative
+ ! tendency
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
+ ! (single if cold start)
+INTEGER, INTENT(IN) :: KMI ! Model index
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PT ! Temperature
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTM ! Temperature at time t-dt
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
+ ! the nucleation param.
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCM ! Cloud water m.r. at t-dt
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+!
+REAL, DIMENSION(:,:,:) , INTENT(INOUT) :: PCCS ! Cloud water C. source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNFS ! CCN C. available source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNAS ! CCN C. activated source
+!
+END SUBROUTINE LIMA_WARM_NUCL
+END INTERFACE
+END MODULE MODI_LIMA_WARM_NUCL
+! #######################################################################
+ SUBROUTINE LIMA_WARM_NUCL( OACTIT, PTSTEP, KMI, TPFILE, &
+ PRHODREF, PEXNREF, PPABST, PT, PTM, PW_NU, &
+ PRCM, PRVT, PRCT, PRRT, &
+ PTHS, PRVS, PRCS, PCCS, PNFS, PNAS )
+! #######################################################################
+!
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the activation of CCN
+!! according to Cohard and Pinty, QJRMS, 2000
+!!
+!!
+!!** METHOD
+!! ------
+!! The activation of CCN is checked for quasi-saturated air parcels
+!! to update the cloud droplet number concentration.
+!!
+!! Computation steps :
+!! 1- Check where computations are necessary
+!! 2- and 3- Compute the maximum of supersaturation using the iterative
+!! Ridder algorithm
+!! 4- Compute the nucleation source
+!! 5- Deallocate local variables
+!!
+!! Contains :
+!! 6- Functions : Ridder algorithm
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Cohard, J.-M. and J.-P. Pinty, 2000: A comprehensive two-moment warm
+!! microphysical bulk scheme.
+!! Part I: Description and tests
+!! Part II: 2D experiments with a non-hydrostatic model
+!! Accepted for publication in Quart. J. Roy. Meteor. Soc.
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!! J. Escobar : 10/2017 , for real*4 use XMNH_EPSILON
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+! B. Vie 03/03/2020: use DTHRAD instead of dT/dt in Smax diagnostic computation
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+use modd_field, only: TFIELDDATA, TYPEREAL
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
+USE MODD_PARAM_LIMA
+USE MODD_PARAM_LIMA_WARM
+
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+use mode_tools, only: Countjv
+
+USE MODI_GAMMA
+
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+LOGICAL, INTENT(IN) :: OACTIT ! Switch to activate the
+ ! activation by radiative
+ ! tendency
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
+ ! (single if cold start)
+INTEGER, INTENT(IN) :: KMI ! Model index
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PT ! Temperature
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTM ! Temperature at time t-dt
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
+ ! the nucleation param.
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCM ! Cloud water m.r. at t-dt
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+!
+REAL, DIMENSION(:,:,:) , INTENT(INOUT) :: PCCS ! Cloud water C. source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNFS ! CCN C. available source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNAS ! CCN C. activated source
+!
+!
+!* 0.1 Declarations of local variables :
+!
+! Packing variables
+LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: GNUCT
+INTEGER :: INUCT
+INTEGER , DIMENSION(SIZE(GNUCT)) :: I1,I2,I3 ! Used to replace the COUNT
+INTEGER :: JL ! and PACK intrinsics
+!
+! Packed micophysical variables
+REAL, DIMENSION(:) , ALLOCATABLE :: ZRCS ! cloud mr source
+REAL, DIMENSION(:) , ALLOCATABLE :: ZCCS ! cloud conc. source
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFS ! available nucleus conc. source
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZNAS ! activated nucleus conc. source
+!
+! Other packed variables
+REAL, DIMENSION(:) , ALLOCATABLE :: ZRHODREF ! RHO Dry REFerence
+REAL, DIMENSION(:) , ALLOCATABLE :: ZEXNREF ! EXNer Pressure REFerence
+REAL, DIMENSION(:) , ALLOCATABLE :: ZZT ! Temperature
+!
+! Work arrays
+REAL, DIMENSION(:), ALLOCATABLE :: ZZW1, ZZW2, ZZW3, ZZW4, ZZW5, ZZW6, &
+ ZCTMIN, &
+ ZZTDT, & ! dT/dt
+ ZSW, & ! real supersaturation
+ ZSMAX, & ! Maximum supersaturation
+ ZVEC1
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZTMP, ZCHEN_MULTI
+!
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: ZTDT, ZDRC, ZRVSAT, ZW, ZW2
+REAL, DIMENSION(SIZE(PNFS,1),SIZE(PNFS,2),SIZE(PNFS,3)) &
+ :: ZCONC_TOT ! total CCN C. available
+!
+INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC1 ! Vectors of indices for
+ ! interpolations
+!
+!
+REAL :: ZEPS ! molar mass ratio
+REAL :: ZS1, ZS2, ZXACC
+INTEGER :: JMOD
+INTEGER :: IIB, IIE, IJB, IJE, IKB, IKE ! Physical domain
+!
+INTEGER :: ILUOUT ! Logical unit of output listing
+TYPE(TFIELDDATA) :: TZFIELD
+!-------------------------------------------------------------------------------
+!
+ILUOUT = TLUOUT%NLU
+!
+!* 1. PREPARE COMPUTATIONS - PACK
+! ---------------------------
+!
+!
+IIB=1+JPHEXT
+IIE=SIZE(PRHODREF,1) - JPHEXT
+IJB=1+JPHEXT
+IJE=SIZE(PRHODREF,2) - JPHEXT
+IKB=1+JPVEXT
+IKE=SIZE(PRHODREF,3) - JPVEXT
+!
+ALLOCATE(ZCTMIN(SIZE(XCTMIN)))
+ZCTMIN(:) = XCTMIN(:) / PTSTEP
+!
+! Saturation vapor mixing ratio and radiative tendency
+!
+ZEPS= XMV / XMD
+ZRVSAT(:,:,:) = ZEPS / (PPABST(:,:,:)*EXP(-XALPW+XBETAW/PT(:,:,:)+XGAMW*ALOG(PT(:,:,:))) - 1.0)
+ZTDT(:,:,:) = 0.
+IF (OACTIT .AND. SIZE(PTM).GT.0) ZTDT(:,:,:) = PTM(:,:,:) * PEXNREF(:,:,:) ! dThRad
+!
+! find locations where CCN are available
+!
+ZCONC_TOT(:,:,:) = 0.0
+DO JMOD = 1, NMOD_CCN
+ ZCONC_TOT(:,:,:) = ZCONC_TOT(:,:,:) + PNFS(:,:,:,JMOD) ! sum over the free CCN
+ENDDO
+!
+! optimization by looking for locations where
+! the updraft velocity is positive!!!
+!
+GNUCT(:,:,:) = .FALSE.
+!
+! NEW : -22°C = limit sup for condensation freezing in Fridlin et al., 2007
+IF( OACTIT ) THEN
+ GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) = (PW_NU(IIB:IIE,IJB:IJE,IKB:IKE)>XWMIN .OR. &
+ ZTDT(IIB:IIE,IJB:IJE,IKB:IKE)<XTMIN .OR. &
+ PRVT(IIB:IIE,IJB:IJE,IKB:IKE)>ZRVSAT(IIB:IIE,IJB:IJE,IKB:IKE) ) .AND.&
+ PRVT(IIB:IIE,IJB:IJE,IKB:IKE).GE.ZRVSAT(IIB:IIE,IJB:IJE,IKB:IKE)&
+ .AND. PT(IIB:IIE,IJB:IJE,IKB:IKE)>(XTT-22.) &
+ .AND. ZCONC_TOT(IIB:IIE,IJB:IJE,IKB:IKE)>ZCTMIN(2)
+ELSE
+ GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) = (PW_NU(IIB:IIE,IJB:IJE,IKB:IKE)>XWMIN .OR. &
+ PRVT(IIB:IIE,IJB:IJE,IKB:IKE)>ZRVSAT(IIB:IIE,IJB:IJE,IKB:IKE) ) .AND.&
+ PRVT(IIB:IIE,IJB:IJE,IKB:IKE).GE.ZRVSAT(IIB:IIE,IJB:IJE,IKB:IKE)&
+ .AND. PT(IIB:IIE,IJB:IJE,IKB:IKE)>(XTT-22.) &
+ .AND. ZCONC_TOT(IIB:IIE,IJB:IJE,IKB:IKE)>ZCTMIN(2)
+END IF
+INUCT = COUNTJV( GNUCT(:,:,:),I1(:),I2(:),I3(:))
+!
+IF( INUCT >= 1 ) THEN
+!
+ ALLOCATE(ZNFS(INUCT,NMOD_CCN))
+ ALLOCATE(ZNAS(INUCT,NMOD_CCN))
+ ALLOCATE(ZTMP(INUCT,NMOD_CCN))
+ ALLOCATE(ZRCS(INUCT))
+ ALLOCATE(ZCCS(INUCT))
+ ALLOCATE(ZZT(INUCT))
+ ALLOCATE(ZZTDT(INUCT))
+ ALLOCATE(ZSW(INUCT))
+ ALLOCATE(ZZW1(INUCT))
+ ALLOCATE(ZZW2(INUCT))
+ ALLOCATE(ZZW3(INUCT))
+ ALLOCATE(ZZW4(INUCT))
+ ALLOCATE(ZZW5(INUCT))
+ ALLOCATE(ZZW6(INUCT))
+ ALLOCATE(ZCHEN_MULTI(INUCT,NMOD_CCN))
+ ALLOCATE(ZVEC1(INUCT))
+ ALLOCATE(IVEC1(INUCT))
+ ALLOCATE(ZRHODREF(INUCT))
+ ALLOCATE(ZEXNREF(INUCT))
+ DO JL=1,INUCT
+ ZRCS(JL) = PRCS(I1(JL),I2(JL),I3(JL))
+ ZCCS(JL) = PCCS(I1(JL),I2(JL),I3(JL))
+ ZZT(JL) = PT(I1(JL),I2(JL),I3(JL))
+ ZZW1(JL) = ZRVSAT(I1(JL),I2(JL),I3(JL))
+ ZZW2(JL) = PW_NU(I1(JL),I2(JL),I3(JL))
+ ZZTDT(JL) = ZTDT(I1(JL),I2(JL),I3(JL))
+ ZSW(JL) = PRVT(I1(JL),I2(JL),I3(JL))/ZRVSAT(I1(JL),I2(JL),I3(JL)) - 1.
+ ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
+ ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL))
+ DO JMOD = 1,NMOD_CCN
+ ZNFS(JL,JMOD) = PNFS(I1(JL),I2(JL),I3(JL),JMOD)
+ ZNAS(JL,JMOD) = PNAS(I1(JL),I2(JL),I3(JL),JMOD)
+ ZCHEN_MULTI(JL,JMOD) = (ZNFS(JL,JMOD)+ZNAS(JL,JMOD))*PTSTEP*ZRHODREF(JL) &
+ / XLIMIT_FACTOR(JMOD)
+ ENDDO
+ ENDDO
+!
+ ZZW1(:) = 1.0/ZEPS + 1.0/ZZW1(:) &
+ + (((XLVTT+(XCPV-XCL)*(ZZT(:)-XTT))/ZZT(:))**2)/(XCPD*XRV) ! Psi2
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 2. compute the constant term (ZZW3) relative to smax
+! ----------------------------------------------------
+!
+! Remark : in LIMA's nucleation parameterization, Smax=0.01 for a supersaturation of 1% !
+!
+!
+ ZVEC1(:) = MAX( 1.0001, MIN( REAL(NAHEN)-0.0001, XAHENINTP1 * ZZT(:) + XAHENINTP2 ) )
+ IVEC1(:) = INT( ZVEC1(:) )
+ ZVEC1(:) = ZVEC1(:) - REAL( IVEC1(:) )
+ ALLOCATE(ZSMAX(INUCT))
+!
+!
+ IF (OACTIT) THEN ! including a cooling rate
+!
+! Compute the tabulation of function of ZZW3 :
+!
+! (Psi1*w+Psi3*DT/Dt)**1.5
+! ZZW3 = XAHENG*(Psi1*w + Psi3*DT/Dt)**1.5 = ------------------------
+! 2*pi*rho_l*G**(3/2)
+!
+!
+ ZZW4(:)=XPSI1( IVEC1(:)+1)*ZZW2(:)+XPSI3(IVEC1(:)+1)*ZZTDT(:)
+ ZZW5(:)=XPSI1( IVEC1(:) )*ZZW2(:)+XPSI3(IVEC1(:) )*ZZTDT(:)
+ WHERE (ZZW4(:) < 0. .OR. ZZW5(:) < 0.)
+ ZZW4(:) = 0.
+ ZZW5(:) = 0.
+ END WHERE
+ ZZW3(:) = XAHENG( IVEC1(:)+1)*(ZZW4(:)**1.5)* ZVEC1(:) &
+ - XAHENG( IVEC1(:) )*(ZZW5(:)**1.5)*(ZVEC1(:) - 1.0)
+ ! Cste*((Psi1*w+Psi3*dT/dt)/(G))**1.5
+ ZZW6(:) = XAHENG2( IVEC1(:)+1)*(ZZW4(:)**0.5)* ZVEC1(:) &
+ - XAHENG2( IVEC1(:) )*(ZZW5(:)**0.5)*(ZVEC1(:) - 1.0)
+!
+!
+ ELSE ! OACTIT , for clouds
+!
+!
+! Compute the tabulation of function of ZZW3 :
+!
+! (Psi1 * w)**1.5
+! ZZW3 = XAHENG * (Psi1 * w)**1.5 = -------------------------
+! 2 pi rho_l * G**(3/2)
+!
+!
+ ZZW2(:)=MAX(ZZW2(:),0.)
+ ZZW3(:)=XAHENG(IVEC1(:)+1)*((XPSI1(IVEC1(:)+1)*ZZW2(:))**1.5)* ZVEC1(:) &
+ -XAHENG(IVEC1(:) )*((XPSI1(IVEC1(:) )*ZZW2(:))**1.5)*(ZVEC1(:)-1.0)
+!
+ ZZW6(:)=XAHENG2(IVEC1(:)+1)*((XPSI1(IVEC1(:)+1)*ZZW2(:))**0.5)* ZVEC1(:) &
+ -XAHENG2(IVEC1(:) )*((XPSI1(IVEC1(:) )*ZZW2(:))**0.5)*(ZVEC1(:)-1.0)
+!
+ END IF ! OACTIT
+!
+!
+! (Psi1*w+Psi3*DT/Dt)**1.5 rho_air
+! ZZW3 = ------------------------ * -------
+! 2*pi*rho_l*G**(3/2) Psi2
+!
+ ZZW5(:) = 1.
+ ZZW3(:) = (ZZW3(:)/ZZW1(:))*ZRHODREF(:) ! R.H.S. of Eq 9 of CPB 98 but
+ ! for multiple aerosol modes
+ WHERE (ZRCS(:) > XRTMIN(2) .AND. ZCCS(:) > XCTMIN(2))
+ ZZW6(:) = ZZW6(:) * ZRHODREF(:) * ZCCS(:) * PTSTEP / (XLBC*ZCCS(:)/ZRCS(:))**XLBEXC
+ ELSEWHERE
+ ZZW6(:)=0.
+ END WHERE
+
+ WHERE (ZZW3(:) == 0. .AND. .NOT.(ZSW>0.))
+ ZZW5(:) = -1.
+ END WHERE
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 3. Compute the maximum of supersaturation
+! -----------------------------------------
+!
+!
+! estimate S_max for the CPB98 parameterization with SEVERAL aerosols mode
+! Reminder : Smax=0.01 for a 1% supersaturation
+!
+! Interval bounds to tabulate sursaturation Smax
+! Check with values used for tabulation in ini_lima_warm.f90
+ ZS1 = 1.0E-5 ! corresponds to 0.001% supersaturation
+ ZS2 = 5.0E-2 ! corresponds to 5.0% supersaturation
+ ZXACC = 1.0E-10 ! Accuracy needed for the search in [NO UNITS]
+!
+ ZSMAX(:) = ZRIDDR(ZS1,ZS2,ZXACC,ZZW3(:),ZZW6(:),INUCT) ! ZSMAX(:) is in [NO UNITS]
+ ZSMAX(:) = MIN(MAX(ZSMAX(:), ZSW(:)),ZS2)
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 4. Compute the nucleus source
+! -----------------------------
+!
+!
+! Again : Smax=0.01 for a 1% supersaturation
+! Modified values for Beta and C (see in init_aerosol_properties) account for that
+!
+ WHERE (ZZW5(:) > 0. .AND. ZSMAX(:) > 0.)
+ ZVEC1(:) = MAX( 1.0001, MIN( REAL(NHYP)-0.0001, XHYPINTP1*LOG(ZSMAX(:))+XHYPINTP2 ) )
+ IVEC1(:) = INT( ZVEC1(:) )
+ ZVEC1(:) = ZVEC1(:) - REAL( IVEC1(:) )
+ END WHERE
+ ZZW6(:) = 0. ! initialize the change of cloud droplet concentration
+!
+ ZTMP(:,:)=0.0
+!
+! Compute the concentration of activable aerosols for each mode
+! based on the max of supersaturation ( -> ZTMP )
+!
+ DO JMOD = 1, NMOD_CCN ! iteration on mode number
+ ZZW1(:) = 0.
+ ZZW2(:) = 0.
+ ZZW3(:) = 0.
+ !
+ WHERE( ZZW5(:) > 0. .AND. ZSMAX(:)>0.0 )
+ ZZW2(:) = XHYPF12( IVEC1(:)+1,JMOD )* ZVEC1(:) & ! hypergeo function
+ - XHYPF12( IVEC1(:) ,JMOD )*(ZVEC1(:) - 1.0) ! XHYPF12 is tabulated
+ !
+ ZTMP(:,JMOD) = ZCHEN_MULTI(:,JMOD)/ZRHODREF(:)*ZSMAX(:)**XKHEN_MULTI(JMOD)*ZZW2(:)/PTSTEP
+ ENDWHERE
+ ENDDO
+!
+! Compute the concentration of aerosols activated at this time step
+! as the difference between ZTMP and the aerosols already activated at t-dt (ZZW1)
+!
+ DO JMOD = 1, NMOD_CCN ! iteration on mode number
+ ZZW1(:) = 0.
+ ZZW2(:) = 0.
+ ZZW3(:) = 0.
+ !
+ WHERE( SUM(ZTMP(:,:),DIM=2)*PTSTEP .GT. 0.01E6/ZRHODREF(:) )
+ ZZW1(:) = MIN( ZNFS(:,JMOD),MAX( ZTMP(:,JMOD)- ZNAS(:,JMOD) , 0.0 ) )
+ ENDWHERE
+ !
+ !* update the concentration of activated CCN = Na
+ !
+ PNAS(:,:,:,JMOD) = PNAS(:,:,:,JMOD) + UNPACK( ZZW1(:), MASK=GNUCT(:,:,:), FIELD=0.0 )
+ !
+ !* update the concentration of free CCN = Nf
+ !
+ PNFS(:,:,:,JMOD) = PNFS(:,:,:,JMOD) - UNPACK( ZZW1(:), MASK=GNUCT(:,:,:), FIELD=0.0 )
+ !
+ !* prepare to update the cloud water concentration
+ !
+ ZZW6(:) = ZZW6(:) + ZZW1(:)
+ ENDDO
+!
+! Update PRVS, PRCS, PCCS, and PTHS
+!
+ ZZW1(:)=0.
+ WHERE (ZZW5(:)>0.0 .AND. ZSMAX(:)>0.0) ! ZZW1 is computed with ZSMAX [NO UNIT]
+ ZZW1(:) = MIN(XCSTDCRIT*ZZW6(:)/(((ZZT(:)*ZSMAX(:))**3)*ZRHODREF(:)),1.E-5)
+ END WHERE
+ ZW(:,:,:) = MIN( UNPACK( ZZW1(:),MASK=GNUCT(:,:,:),FIELD=0.0 ),PRVS(:,:,:) )
+!
+ PRVS(:,:,:) = PRVS(:,:,:) - ZW(:,:,:)
+ PRCS(:,:,:) = PRCS(:,:,:) + ZW(:,:,:)
+ ZW(:,:,:) = ZW(:,:,:) * (XLVTT+(XCPV-XCL)*(PT(:,:,:)-XTT))/ &
+ (PEXNREF(:,:,:)*(XCPD+XCPV*PRVT(:,:,:)+XCL*(PRCT(:,:,:)+PRRT(:,:,:))))
+ PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)
+!
+ ZW(:,:,:) = PCCS(:,:,:)
+ PCCS(:,:,:) = UNPACK( ZZW6(:)+ZCCS(:),MASK=GNUCT(:,:,:),FIELD=ZW(:,:,:) )
+!
+ ZW(:,:,:) = UNPACK( 100.0*ZSMAX(:),MASK=GNUCT(:,:,:),FIELD=0.0 )
+ ZW2(:,:,:) = UNPACK( ZZW6(:),MASK=GNUCT(:,:,:),FIELD=0.0 )
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 5. Cleaning
+! -----------
+!
+!
+ DEALLOCATE(IVEC1)
+ DEALLOCATE(ZVEC1)
+ DEALLOCATE(ZNFS)
+ DEALLOCATE(ZNAS)
+ DEALLOCATE(ZCCS)
+ DEALLOCATE(ZRCS)
+ DEALLOCATE(ZZT)
+ DEALLOCATE(ZSMAX)
+ DEALLOCATE(ZZW1)
+ DEALLOCATE(ZZW2)
+ DEALLOCATE(ZZW3)
+ DEALLOCATE(ZZW4)
+ DEALLOCATE(ZZW5)
+ DEALLOCATE(ZZW6)
+ DEALLOCATE(ZZTDT)
+ DEALLOCATE(ZSW)
+ DEALLOCATE(ZRHODREF)
+ DEALLOCATE(ZCHEN_MULTI)
+ DEALLOCATE(ZEXNREF)
+!
+END IF ! INUCT
+!
+!++cb++
+DEALLOCATE(ZCTMIN)
+!--cb--
+IF ( tpfile%lopened ) THEN
+ IF ( INUCT == 0 ) THEN
+ ZW (:,:,:) = 0.
+ ZW2(:,:,:) = 0.
+ END IF
+
+ TZFIELD%CMNHNAME ='SMAX'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = ''
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_SMAX'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZW)
+ !
+ TZFIELD%CMNHNAME ='NACT'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'kg-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_NACT'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZW2)
+END IF
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 6. Functions used to compute the maximum of supersaturation
+! -----------------------------------------------------------
+!
+!
+CONTAINS
+!------------------------------------------------------------------------------
+!
+ FUNCTION ZRIDDR(PX1,PX2INIT,PXACC,PZZW3,PZZW6,NPTS) RESULT(PZRIDDR)
+!
+!
+!!**** *ZRIDDR* - iterative algorithm to find root of a function
+!!
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this function is to find the root of a given function
+!! the arguments are the brackets bounds (the interval where to find the root)
+!! the accuracy needed and the input parameters of the given function.
+!! Using Ridders' method, return the root of a function known to lie between
+!! PX1 and PX2. The root, returned as PZRIDDR, will be refined to an approximate
+!! accuracy PXACC.
+!!
+!!** METHOD
+!! ------
+!! Ridders' method
+!!
+!! EXTERNAL
+!! --------
+!! FUNCSMAX
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!! NUMERICAL RECIPES IN FORTRAN 77: THE ART OF SCIENTIFIC COMPUTING
+!! (ISBN 0-521-43064-X)
+!! Copyright (C) 1986-1992 by Cambridge University Press.
+!! Programs Copyright (C) 1986-1992 by Numerical Recipes Software.
+!!
+!! AUTHOR
+!! ------
+!! Frederick Chosson *CERFACS*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 12/07/07
+!! S.BERTHET 2008 vectorization
+!------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+!
+use mode_msg
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments and result
+!
+INTEGER, INTENT(IN) :: NPTS
+REAL, DIMENSION(:), INTENT(IN) :: PZZW3
+REAL, DIMENSION(:), INTENT(IN) :: PZZW6
+REAL, INTENT(IN) :: PX1, PX2INIT, PXACC
+REAL, DIMENSION(:), ALLOCATABLE :: PZRIDDR
+!
+!* 0.2 declarations of local variables
+!
+!
+INTEGER, PARAMETER :: MAXIT=60
+REAL, PARAMETER :: UNUSED=0.0 !-1.11e30
+REAL, DIMENSION(:), ALLOCATABLE :: fh,fl, fm,fnew
+REAL :: s,xh,xl,xm,xnew
+REAL :: PX2
+INTEGER :: j, JL
+!
+ALLOCATE( fh(NPTS))
+ALLOCATE( fl(NPTS))
+ALLOCATE( fm(NPTS))
+ALLOCATE(fnew(NPTS))
+ALLOCATE(PZRIDDR(NPTS))
+!
+PZRIDDR(:)= UNUSED
+PX2 = PX2INIT
+fl(:) = FUNCSMAX(PX1,PZZW3(:),PZZW6(:),NPTS)
+fh(:) = FUNCSMAX(PX2,PZZW3(:),PZZW6(:),NPTS)
+!
+DO JL = 1, NPTS
+ PX2 = PX2INIT
+100 if ((fl(JL) > 0.0 .and. fh(JL) < 0.0) .or. (fl(JL) < 0.0 .and. fh(JL) > 0.0)) then
+ xl = PX1
+ xh = PX2
+ do j=1,MAXIT
+ xm = 0.5*(xl+xh)
+ fm(JL) = SINGL_FUNCSMAX(xm,PZZW3(JL),PZZW6(JL),JL)
+ s = sqrt(fm(JL)**2-fl(JL)*fh(JL))
+ if (s == 0.0) then
+ GO TO 101
+ endif
+ xnew = xm+(xm-xl)*(sign(1.0,fl(JL)-fh(JL))*fm(JL)/s)
+ if (abs(xnew - PZRIDDR(JL)) <= PXACC) then
+ GO TO 101
+ endif
+ PZRIDDR(JL) = xnew
+ fnew(JL) = SINGL_FUNCSMAX(PZRIDDR(JL),PZZW3(JL),PZZW6(JL),JL)
+ if (fnew(JL) == 0.0) then
+ GO TO 101
+ endif
+ if (sign(fm(JL),fnew(JL)) /= fm(JL)) then
+ xl =xm
+ fl(JL)=fm(JL)
+ xh =PZRIDDR(JL)
+ fh(JL)=fnew(JL)
+ else if (sign(fl(JL),fnew(JL)) /= fl(JL)) then
+ xh =PZRIDDR(JL)
+ fh(JL)=fnew(JL)
+ else if (sign(fh(JL),fnew(JL)) /= fh(JL)) then
+ xl =PZRIDDR(JL)
+ fl(JL)=fnew(JL)
+ else if (PX2 .lt. 0.05) then
+ PX2 = PX2 + 1.0E-2
+ PRINT*, 'PX2 ALWAYS too small, we put a greater one : PX2 =',PX2
+ fh(JL) = SINGL_FUNCSMAX(PX2,PZZW3(JL),PZZW6(JL),JL)
+ go to 100
+ end if
+ if (abs(xh-xl) <= PXACC) then
+ GO TO 101
+ endif
+!!SB
+!!$ if (j == MAXIT .and. (abs(xh-xl) > PXACC) ) then
+!!$ PZRIDDR(JL)=0.0
+!!$ go to 101
+!!$ endif
+!!SB
+ end do
+ call Print_msg( NVERB_FATAL, 'GEN', 'ZRIDDR', 'exceeded maximum iterations' )
+ else if (fl(JL) == 0.0) then
+ PZRIDDR(JL)=PX1
+ else if (fh(JL) == 0.0) then
+ PZRIDDR(JL)=PX2
+ else if (PX2 .lt. 0.05) then
+ PX2 = PX2 + 1.0E-2
+ PRINT*, 'PX2 too small, we put a greater one : PX2 =',PX2
+ fh(JL) = SINGL_FUNCSMAX(PX2,PZZW3(JL),PZZW6(JL),JL)
+ go to 100
+ else
+!!$ print*, 'PZRIDDR: root must be bracketed'
+!!$ print*,'npts ',NPTS,'jl',JL
+!!$ print*, 'PX1,PX2,fl,fh',PX1,PX2,fl(JL),fh(JL)
+!!$ print*, 'PX2 = 30 % of supersaturation, there is no solution for Smax'
+!!$ print*, 'try to put greater PX2 (upper bound for Smax research)'
+!!$ STOP
+ PZRIDDR(JL)=0.0
+ go to 101
+ end if
+101 ENDDO
+!
+DEALLOCATE( fh)
+DEALLOCATE( fl)
+DEALLOCATE( fm)
+DEALLOCATE(fnew)
+!
+END FUNCTION ZRIDDR
+!
+!------------------------------------------------------------------------------
+!
+ FUNCTION FUNCSMAX(PPZSMAX,PPZZW3,PPZZW6,NPTS) RESULT(PFUNCSMAX)
+!
+!
+!!**** *FUNCSMAX* - function describing SMAX function that you want to find the root
+!!
+!!
+!! PURPOSE
+!! -------
+!! This function describe the equilibrium between Smax and two aerosol mode
+!! acting as CCN. This function is derive from eq. (9) of CPB98 but for two
+!! aerosols mode described by their respective parameters C, k, Mu, Beta.
+!! the arguments are the supersaturation in "no unit" and the r.h.s. of this eq.
+!! and the ratio of concentration of injected aerosols on maximum concentration
+!! of injected aerosols ever.
+!!** METHOD
+!! ------
+!! This function is called by zriddr.f90
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAM_LIMA_WARM
+!! XHYPF32
+!!
+!! XHYPINTP1
+!! XHYPINTP2
+!!
+!! Module MODD_PARAM_C2R2
+!! XKHEN_MULTI()
+!! NMOD_CCN
+!!
+!! REFERENCE
+!! ---------
+!! Cohard, J.M., J.P.Pinty, K.Suhre, 2000:"On the parameterization of activation
+!! spectra from cloud condensation nuclei microphysical properties",
+!! J. Geophys. Res., Vol.105, N0.D9, pp. 11753-11766
+!!
+!! AUTHOR
+!! ------
+!! Frederick Chosson *CERFACS*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 12/07/07
+!! S.Berthet 19/03/08 Extension a une population multimodale d aerosols
+!
+!------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments and result
+!
+INTEGER, INTENT(IN) :: NPTS
+REAL, INTENT(IN) :: PPZSMAX ! supersaturation is already in no units
+REAL, DIMENSION(:), INTENT(IN) :: PPZZW3 !
+REAL, DIMENSION(:), INTENT(IN) :: PPZZW6 !
+REAL, DIMENSION(:), ALLOCATABLE :: PFUNCSMAX !
+!
+!* 0.2 declarations of local variables
+!
+REAL :: ZHYPF
+!
+REAL :: PZVEC1
+INTEGER :: PIVEC1
+!
+ALLOCATE(PFUNCSMAX(NPTS))
+!
+PFUNCSMAX(:) = 0.
+PZVEC1 = MAX( ( 1.0 + 10.0 * XMNH_EPSILON ) ,MIN( REAL(NHYP)*( 1.0 - 10.0 * XMNH_EPSILON ) , &
+ XHYPINTP1*LOG(PPZSMAX)+XHYPINTP2 ) )
+PIVEC1 = INT( PZVEC1 )
+PZVEC1 = PZVEC1 - REAL( PIVEC1 )
+DO JMOD = 1, NMOD_CCN
+ ZHYPF = 0. ! XHYPF32 is tabulated with ZSMAX in [NO UNITS]
+ ZHYPF = XHYPF32( PIVEC1+1,JMOD ) * PZVEC1 &
+ - XHYPF32( PIVEC1 ,JMOD ) *(PZVEC1 - 1.0)
+ ! sum of s**(ki+2) * F32 * Ci * ki * beta(ki/2,3/2)
+ PFUNCSMAX(:) = PFUNCSMAX(:) + (PPZSMAX)**(XKHEN_MULTI(JMOD) + 2) &
+ * ZHYPF* XKHEN_MULTI(JMOD) * ZCHEN_MULTI(:,JMOD) &
+ * GAMMA_X0D( XKHEN_MULTI(JMOD)/2.0)*GAMMA_X0D(3.0/2.0) &
+ / GAMMA_X0D((XKHEN_MULTI(JMOD)+3.0)/2.0)
+ENDDO
+! function l.h.s. minus r.h.s. of eq. (9) of CPB98 but for NMOD_CCN aerosol mode
+PFUNCSMAX(:) = PFUNCSMAX(:) + PPZZW6(:)*PPZSMAX - PPZZW3(:)
+!
+END FUNCTION FUNCSMAX
+!
+!------------------------------------------------------------------------------
+!
+ FUNCTION SINGL_FUNCSMAX(PPZSMAX,PPZZW3,PPZZW6,KINDEX) RESULT(PSINGL_FUNCSMAX)
+!
+!
+!!**** *SINGL_FUNCSMAX* - same function as FUNCSMAX
+!!
+!!
+!! PURPOSE
+!! -------
+! As for FUNCSMAX but for a scalar
+!!
+!!** METHOD
+!! ------
+!! This function is called by zriddr.f90
+!!
+!------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments and result
+!
+INTEGER, INTENT(IN) :: KINDEX
+REAL, INTENT(IN) :: PPZSMAX ! supersaturation is "no unit"
+REAL, INTENT(IN) :: PPZZW3 !
+REAL, INTENT(IN) :: PPZZW6 !
+REAL :: PSINGL_FUNCSMAX !
+!
+!* 0.2 declarations of local variables
+!
+REAL :: ZHYPF
+!
+REAL :: PZVEC1
+INTEGER :: PIVEC1
+!
+PSINGL_FUNCSMAX = 0.
+PZVEC1 = MAX( 1.0001,MIN( REAL(NHYP)-0.0001, &
+ XHYPINTP1*LOG(PPZSMAX)+XHYPINTP2 ) )
+PIVEC1 = INT( PZVEC1 )
+PZVEC1 = PZVEC1 - REAL( PIVEC1 )
+DO JMOD = 1, NMOD_CCN
+ ZHYPF = 0. ! XHYPF32 is tabulated with ZSMAX in [NO UNITS]
+ ZHYPF = XHYPF32( PIVEC1+1,JMOD ) * PZVEC1 &
+ - XHYPF32( PIVEC1 ,JMOD ) *(PZVEC1 - 1.0)
+ ! sum of s**(ki+2) * F32 * Ci * ki * bêta(ki/2,3/2)
+ PSINGL_FUNCSMAX = PSINGL_FUNCSMAX + (PPZSMAX)**(XKHEN_MULTI(JMOD) + 2) &
+ * ZHYPF* XKHEN_MULTI(JMOD) * ZCHEN_MULTI(KINDEX,JMOD) &
+ * GAMMA_X0D( XKHEN_MULTI(JMOD)/2.0)*GAMMA_X0D(3.0/2.0) &
+ / GAMMA_X0D((XKHEN_MULTI(JMOD)+3.0)/2.0)
+ENDDO
+! function l.h.s. minus r.h.s. of eq. (9) of CPB98 but for NMOD_CCN aerosol mode
+PSINGL_FUNCSMAX = PSINGL_FUNCSMAX + PPZZW6*PPZSMAX - PPZZW3
+!
+END FUNCTION SINGL_FUNCSMAX
+!
+!-----------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_WARM_NUCL
diff --git a/src/mesonh/micro/lima_warm_sedimentation.f90 b/src/mesonh/micro/lima_warm_sedimentation.f90
new file mode 100644
index 000000000..f74899b38
--- /dev/null
+++ b/src/mesonh/micro/lima_warm_sedimentation.f90
@@ -0,0 +1,396 @@
+!MNH_LIC Copyright 2013-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ###################################
+ MODULE MODI_LIMA_WARM_SEDIMENTATION
+! ###################################
+!
+INTERFACE
+ SUBROUTINE LIMA_WARM_SEDIMENTATION (OSEDC, KSPLITR, PTSTEP, KMI, &
+ PZZ, PRHODREF, PPABST, ZT, &
+ ZWLBDC, &
+ PRCT, PRRT, PCCT, PCRT, &
+ PRCS, PRRS, PCCS, PCRS, &
+ PINPRC, PINPRR, PINPRR3D )
+!
+LOGICAL, INTENT(IN) :: OSEDC ! switch to activate the
+ ! cloud droplet sedimentation
+INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step
+ ! for sedimendation
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
+ ! (single if cold start)
+INTEGER, INTENT(IN) :: KMI ! Model index
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZT ! Temperature
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZWLBDC ! libre parcours moyen
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCT ! Cloud water C. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRT ! Rain water C. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCS ! Cloud water C. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCRS ! Rain water C. source
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC ! Cloud instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR ! Rain instant precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRR3D ! Rain inst precip 3D
+!
+END SUBROUTINE LIMA_WARM_SEDIMENTATION
+END INTERFACE
+END MODULE MODI_LIMA_WARM_SEDIMENTATION
+! #####################################################################
+ SUBROUTINE LIMA_WARM_SEDIMENTATION (OSEDC, KSPLITR, PTSTEP, KMI, &
+ PZZ, PRHODREF, PPABST, ZT, &
+ ZWLBDC, &
+ PRCT, PRRT, PCCT, PCRT, &
+ PRCS, PRRS, PCCS, PCRS, &
+ PINPRC, PINPRR, PINPRR3D )
+! #####################################################################
+!
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the sedimentation
+!! of cloud droplets and rain drops
+!!
+!!
+!!** METHOD
+!! ------
+!! The sedimentation rates are computed with a time spliting technique:
+!! an upstream scheme, written as a difference of non-advective fluxes.
+!! This source term is added to the next coming time step (split-implicit
+!! process).
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Cohard, J.-M. and J.-P. Pinty, 2000: A comprehensive two-moment warm
+!! microphysical bulk scheme.
+!! Part I: Description and tests
+!! Part II: 2D experiments with a non-hydrostatic model
+!! Accepted for publication in Quart. J. Roy. Meteor. Soc.
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY: XRHOLW
+USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
+USE MODD_PARAM_LIMA, ONLY: XRTMIN, XCTMIN, XALPHAC, XNUC, XCEXVT
+USE MODD_PARAM_LIMA_WARM, ONLY: XLBC, XLBEXC, XLBR, XLBEXR, &
+ XFSEDRC, XFSEDCC, XFSEDRR, XFSEDCR,&
+ XDC, XDR
+
+use mode_tools, only: Countjv
+
+USE MODI_GAMMA, ONLY: GAMMA_X0D
+
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+LOGICAL, INTENT(IN) :: OSEDC ! switch to activate the
+ ! cloud droplet sedimentation
+INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step
+ ! for sedimendation
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
+ ! (single if cold start)
+INTEGER, INTENT(IN) :: KMI ! Model index
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZT ! Temperature
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZWLBDC ! libre parcours moyen
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCT ! Cloud water C. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRT ! Rain water C. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCS ! Cloud water C. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCRS ! Rain water C. source
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC ! Cloud instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR ! Rain instant precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRR3D ! Rain inst precip 3D
+!
+!
+!* 0.2 Declarations of local variables :
+!
+! Packing variables
+LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: GSEDIM
+INTEGER :: ISEDIM
+INTEGER , DIMENSION(SIZE(GSEDIM)) :: I1,I2,I3 ! Used to replace the COUNT
+INTEGER :: JL ! and PACK intrinsics
+!
+! Packed micophysical variables
+REAL, DIMENSION(:) , ALLOCATABLE :: ZRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:) , ALLOCATABLE :: ZRRT ! Rain water m.r. at t
+REAL, DIMENSION(:) , ALLOCATABLE :: ZCCT ! cloud conc. at t
+REAL, DIMENSION(:) , ALLOCATABLE :: ZCRT ! rain conc. at t
+!
+REAL, DIMENSION(:) , ALLOCATABLE :: ZRCS ! Cloud water m.r. source
+REAL, DIMENSION(:) , ALLOCATABLE :: ZRRS ! Rain water m.r. source
+REAL, DIMENSION(:) , ALLOCATABLE :: ZCCS ! cloud conc. source
+REAL, DIMENSION(:) , ALLOCATABLE :: ZCRS ! rain conc. source
+!
+! Other packed variables
+REAL, DIMENSION(:) , ALLOCATABLE :: ZRHODREF ! RHO Dry REFerence
+REAL, DIMENSION(:) , ALLOCATABLE :: ZLBDC
+REAL, DIMENSION(:) , ALLOCATABLE :: ZLBDR
+!
+! Work arrays
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: ZW, &
+ ZWLBDA, & ! Mean free path
+ ZWSEDR, ZWSEDC, & ! Sedim. fluxes
+ ZRAY, & ! Mean volumic radius
+ ZCC ! Terminal vertical velocity
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZZW1, ZZW2, ZZW3, &
+ ZTCC, &
+ ZRTMIN, ZCTMIN
+!
+!
+INTEGER :: JK ! Vertical loop index for the rain sedimentation
+INTEGER :: JN ! Temporal loop index for the rain sedimentation
+INTEGER :: IIB, IIE, IJB, IJE, IKB, IKE ! Physical domain
+REAL :: ZTSPLITR ! Small time step for rain sedimentation
+!
+!-------------------------------------------------------------------------------
+!
+! 0. Prepare computations
+! -----------------------
+!
+!
+ALLOCATE(ZRTMIN(SIZE(XCTMIN)))
+ALLOCATE(ZCTMIN(SIZE(XCTMIN)))
+ZRTMIN(:) = XRTMIN(:) / PTSTEP
+ZCTMIN(:) = XCTMIN(:) / PTSTEP
+!
+IIB=1+JPHEXT
+IIE=SIZE(PZZ,1) - JPHEXT
+IJB=1+JPHEXT
+IJE=SIZE(PZZ,2) - JPHEXT
+IKB=1+JPVEXT
+IKE=SIZE(PZZ,3) - JPVEXT
+!
+ZTSPLITR= PTSTEP / REAL(KSPLITR)
+!
+PINPRC(:,:) = 0.
+PINPRR(:,:) = 0.
+PINPRR3D(:,:,:) = 0.
+!
+IF (OSEDC) THEN
+ ZWLBDA(:,:,:) = 0.
+ ZRAY(:,:,:) = 0.
+ ZCC(:,:,:) = 1.
+ DO JK=IKB,IKE
+ ZWLBDA(:,:,JK) = 6.6E-8*(101325./PPABST(:,:,JK))*(ZT(:,:,JK)/293.15)
+ END DO
+ WHERE (PRCT(:,:,:)>XRTMIN(2) .AND. PCCT(:,:,:)>XCTMIN(2))
+ ZRAY(:,:,:) = 0.5*GAMMA_X0D(XNUC+1./XALPHAC)/(GAMMA_X0D(XNUC)*ZWLBDC(:,:,:))
+ ! ZCC : Corrective Cunningham term for the terminal velocity
+ ZCC(:,:,:)=1.+1.26*ZWLBDA(:,:,:)/ZRAY(:,:,:)
+ END WHERE
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!
+! 1. Computations only where necessary
+! ------------------------------------
+!
+!
+DO JN = 1 , KSPLITR
+ GSEDIM(:,:,:) = .FALSE.
+ GSEDIM(IIB:IIE,IJB:IJE,IKB:IKE) = PRRS(IIB:IIE,IJB:IJE,IKB:IKE)>ZRTMIN(3) &
+ .AND. PCRS(IIB:IIE,IJB:IJE,IKB:IKE)>ZCTMIN(3)
+ IF( OSEDC ) THEN
+ GSEDIM(IIB:IIE,IJB:IJE,IKB:IKE) = GSEDIM(IIB:IIE,IJB:IJE,IKB:IKE) .OR. &
+ (PRCS(IIB:IIE,IJB:IJE,IKB:IKE)>ZRTMIN(2) &
+ .AND. PCCS(IIB:IIE,IJB:IJE,IKB:IKE)>ZCTMIN(2) )
+ END IF
+!
+ ISEDIM = COUNTJV( GSEDIM(:,:,:),I1(:),I2(:),I3(:))
+ IF( ISEDIM >= 1 ) THEN
+!
+ IF( JN==1 ) THEN
+ IF( OSEDC ) THEN
+ PRCS(:,:,:) = PRCS(:,:,:) * PTSTEP
+ PCCS(:,:,:) = PCCS(:,:,:) * PTSTEP
+ END IF
+ PRRS(:,:,:) = PRRS(:,:,:) * PTSTEP
+ PCRS(:,:,:) = PCRS(:,:,:) * PTSTEP
+ DO JK = IKB , IKE
+ ZW(:,:,JK)=ZTSPLITR/(PZZ(:,:,JK+1)-PZZ(:,:,JK))
+ END DO
+ END IF
+!
+ ALLOCATE(ZRHODREF(ISEDIM))
+ DO JL = 1,ISEDIM
+ ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
+ END DO
+!
+ ALLOCATE(ZZW1(ISEDIM))
+ ALLOCATE(ZZW2(ISEDIM))
+ ALLOCATE(ZZW3(ISEDIM))
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+! 2. Cloud droplets sedimentation
+! -------------------------------
+!
+!
+ IF( OSEDC .AND. MAXVAL(PRCS(:,:,:))>ZRTMIN(2) ) THEN
+ ZZW1(:) = 0.0
+ ZZW2(:) = 0.0
+ ZZW3(:) = 0.0
+ ALLOCATE(ZRCS(ISEDIM))
+ ALLOCATE(ZCCS(ISEDIM))
+ ALLOCATE(ZRCT(ISEDIM))
+ ALLOCATE(ZCCT(ISEDIM))
+ ALLOCATE(ZTCC(ISEDIM))
+ ALLOCATE(ZLBDC(ISEDIM))
+ DO JL = 1,ISEDIM
+ ZRCS(JL) = PRCS(I1(JL),I2(JL),I3(JL))
+ ZCCS(JL) = PCCS(I1(JL),I2(JL),I3(JL))
+ ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
+ ZCCT(JL) = PCCT(I1(JL),I2(JL),I3(JL))
+ ZTCC(JL) = ZCC (I1(JL),I2(JL),I3(JL))
+ END DO
+ ZLBDC(:) = 1.E15
+ WHERE (ZRCS(:)>XRTMIN(2) .AND. ZCCS(:)>XCTMIN(2))
+ ZLBDC(:) = ( XLBC*ZCCS(:) / ZRCS(:) )**XLBEXC
+ ZZW3(:) = ZRHODREF(:)**(-XCEXVT) * ZLBDC(:)**(-XDC)
+ ZZW1(:) = ZTCC(:) * XFSEDRC * ZRCS(:) * ZZW3(:) * ZRHODREF(:)
+ ZZW2(:) = ZTCC(:) * XFSEDCC * ZCCS(:) * ZZW3(:) * ZRHODREF(:)
+ END WHERE
+ ZWSEDR(:,:,:) = UNPACK( ZZW1(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
+ ZWSEDR(:,:,IKB:IKE) = MIN( ZWSEDR(:,:,IKB:IKE), PRCS(:,:,IKB:IKE) * PRHODREF(:,:,IKB:IKE) / ZW(:,:,IKB:IKE) )
+ ZWSEDC(:,:,:) = UNPACK( ZZW2(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
+ ZWSEDC(:,:,IKB:IKE) = MIN( ZWSEDC(:,:,IKB:IKE), PCCS(:,:,IKB:IKE) * PRHODREF(:,:,IKB:IKE) / ZW(:,:,IKB:IKE) )
+ DO JK = IKB , IKE
+ PRCS(:,:,JK) = PRCS(:,:,JK) + ZW(:,:,JK)* &
+ (ZWSEDR(:,:,JK+1)-ZWSEDR(:,:,JK))/PRHODREF(:,:,JK)
+ PCCS(:,:,JK) = PCCS(:,:,JK) + ZW(:,:,JK)* &
+ (ZWSEDC(:,:,JK+1)-ZWSEDC(:,:,JK))/PRHODREF(:,:,JK)
+ END DO
+ DEALLOCATE(ZRCS)
+ DEALLOCATE(ZCCS)
+ DEALLOCATE(ZRCT)
+ DEALLOCATE(ZCCT)
+ DEALLOCATE(ZTCC)
+ DEALLOCATE(ZLBDC)
+!
+ PINPRC(:,:) = PINPRC(:,:) + ZWSEDR(:,:,IKB)/XRHOLW/KSPLITR ! in m/s
+ ELSE
+ ZWSEDR(:,:,IKB) = 0.0
+ END IF ! OSEDC
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+! 2. Rain drops sedimentation
+! ---------------------------
+!
+!
+ IF( MAXVAL(PRRS(:,:,:))>ZRTMIN(3) ) THEN
+ ZZW1(:) = 0.0
+ ZZW2(:) = 0.0
+ ZZW3(:) = 0.0
+ ALLOCATE(ZRRS(ISEDIM))
+ ALLOCATE(ZCRS(ISEDIM))
+ ALLOCATE(ZRRT(ISEDIM))
+ ALLOCATE(ZCRT(ISEDIM))
+ ALLOCATE(ZLBDR(ISEDIM))
+ DO JL = 1,ISEDIM
+ ZRRS(JL) = PRRS(I1(JL),I2(JL),I3(JL))
+ ZCRS(JL) = PCRS(I1(JL),I2(JL),I3(JL))
+ ZRRT(JL) = PRRT(I1(JL),I2(JL),I3(JL))
+ ZCRT(JL) = PCRT(I1(JL),I2(JL),I3(JL))
+ END DO
+ ZLBDR(:) = 1.E10
+ WHERE (ZRRS(:)>XRTMIN(3) .AND. ZCRS(:)>XCTMIN(3))
+ ZLBDR(:) = ( XLBR*ZCRS(:) / ZRRS(:) )**XLBEXR
+ ZZW3(:) = ZRHODREF(:)**(-XCEXVT) * (ZLBDR(:)**(-XDR))
+ ZZW1(:) = XFSEDRR * ZRRS(:) * ZZW3(:) * ZRHODREF(:)
+ ZZW2(:) = XFSEDCR * ZCRS(:) * ZZW3(:) * ZRHODREF(:)
+ END WHERE
+ ZWSEDR(:,:,:) = UNPACK( ZZW1(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
+ ZWSEDR(:,:,IKB:IKE) = MIN( ZWSEDR(:,:,IKB:IKE), PRRS(:,:,IKB:IKE) * PRHODREF(:,:,IKB:IKE) / ZW(:,:,IKB:IKE) )
+ ZWSEDC(:,:,:) = UNPACK( ZZW2(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
+ ZWSEDC(:,:,IKB:IKE) = MIN( ZWSEDC(:,:,IKB:IKE), PCRS(:,:,IKB:IKE) * PRHODREF(:,:,IKB:IKE) / ZW(:,:,IKB:IKE) )
+ DO JK = IKB , IKE
+ PRRS(:,:,JK) = PRRS(:,:,JK) + ZW(:,:,JK)* &
+ (ZWSEDR(:,:,JK+1)-ZWSEDR(:,:,JK))/PRHODREF(:,:,JK)
+ PCRS(:,:,JK) = PCRS(:,:,JK) + ZW(:,:,JK)* &
+ (ZWSEDC(:,:,JK+1)-ZWSEDC(:,:,JK))/PRHODREF(:,:,JK)
+ END DO
+ DEALLOCATE(ZRRS)
+ DEALLOCATE(ZCRS)
+ DEALLOCATE(ZRRT)
+ DEALLOCATE(ZCRT)
+ DEALLOCATE(ZLBDR)
+ ELSE
+ ZWSEDR(:,:,IKB) = 0.0
+ END IF ! max PRRS > ZRTMIN(3)
+!
+ PINPRR(:,:) = PINPRR(:,:) + ZWSEDR(:,:,IKB)/XRHOLW/KSPLITR ! in m/s
+ PINPRR3D(:,:,:) = PINPRR3D(:,:,:) + ZWSEDR(:,:,:)/XRHOLW/KSPLITR ! in m/s
+!
+ DEALLOCATE(ZRHODREF)
+ DEALLOCATE(ZZW1)
+ DEALLOCATE(ZZW2)
+ DEALLOCATE(ZZW3)
+ IF( JN==KSPLITR ) THEN
+ IF( OSEDC ) THEN
+ PRCS(:,:,:) = PRCS(:,:,:) / PTSTEP
+ PCCS(:,:,:) = PCCS(:,:,:) / PTSTEP
+ END IF
+ PRRS(:,:,:) = PRRS(:,:,:) / PTSTEP
+ PCRS(:,:,:) = PCRS(:,:,:) / PTSTEP
+ END IF
+ END IF ! ISEDIM
+END DO ! KSPLITR
+!
+!++cb++
+DEALLOCATE(ZRTMIN)
+DEALLOCATE(ZCTMIN)
+!--cb--
+
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_WARM_SEDIMENTATION
diff --git a/src/mesonh/micro/modd_blankn.f90 b/src/mesonh/micro/modd_blankn.f90
new file mode 100644
index 000000000..642810313
--- /dev/null
+++ b/src/mesonh/micro/modd_blankn.f90
@@ -0,0 +1,173 @@
+!MNH_LIC Copyright 1996-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! #################
+ MODULE MODD_BLANK_n
+! #################
+!
+!!**** *MODD_BLANK$n* - Declarative module for MesoNH developpers namelist
+!!
+!! PURPOSE
+!! -------
+!!
+!! Offer dummy real, integer, logical and character variables for
+!! test and debugging purposes.
+!!
+!!** METHOD
+!! ------
+!!
+!! Eight dummy real, integer, logical and character*80 variables are
+!! defined and passed through the namelist read operations. None of the
+!! MesoNH routines uses any of those variables. When a developper choses
+!! to introduce temporarily a parameter to some subroutine, he has to
+!! introduce a USE MODD_BLANK statement into that subroutine. Then he
+!! can use any of the variables defined here and change them easily via
+!! the namelist input.
+!!
+!! REFERENCE
+!! ---------
+!! None
+!!
+!! AUTHOR
+!! ------
+!! K. Suhre *Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!! Original 25/04/96
+!! updated 17/11/00 (P Jabouille) Use dummy array
+!! updated 26/10/21 (Q.Rodier) Use for n model (grid-nesting)
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS, ONLY : JPDUMMY, JPMODELMAX
+!
+IMPLICIT NONE
+!
+TYPE BLANK_t
+!
+ LOGICAL :: LDUMMY1
+ LOGICAL :: LDUMMY2
+ LOGICAL :: LDUMMY3
+ LOGICAL :: LDUMMY4
+ LOGICAL :: LDUMMY5
+ LOGICAL :: LDUMMY6
+ LOGICAL :: LDUMMY7
+ LOGICAL :: LDUMMY8
+!
+ CHARACTER(len=80) :: CDUMMY1
+ CHARACTER(len=80) :: CDUMMY2
+ CHARACTER(len=80) :: CDUMMY3
+ CHARACTER(len=80) :: CDUMMY4
+ CHARACTER(len=80) :: CDUMMY5
+ CHARACTER(len=80) :: CDUMMY6
+ CHARACTER(len=80) :: CDUMMY7
+ CHARACTER(len=80) :: CDUMMY8
+!
+ INTEGER :: NDUMMY1
+ INTEGER :: NDUMMY2
+ INTEGER :: NDUMMY3
+ INTEGER :: NDUMMY4
+ INTEGER :: NDUMMY5
+ INTEGER :: NDUMMY6
+ INTEGER :: NDUMMY7
+ INTEGER :: NDUMMY8
+!
+ REAL :: XDUMMY1
+ REAL :: XDUMMY2
+ REAL :: XDUMMY3
+ REAL :: XDUMMY4
+ REAL :: XDUMMY5
+ REAL :: XDUMMY6
+ REAL :: XDUMMY7
+ REAL :: XDUMMY8
+!
+END TYPE BLANK_t
+!
+TYPE(BLANK_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: BLANK_MODEL
+!
+LOGICAL, POINTER :: LDUMMY1=>NULL()
+LOGICAL, POINTER :: LDUMMY2=>NULL()
+LOGICAL, POINTER :: LDUMMY3=>NULL()
+LOGICAL, POINTER :: LDUMMY4=>NULL()
+LOGICAL, POINTER :: LDUMMY5=>NULL()
+LOGICAL, POINTER :: LDUMMY6=>NULL()
+LOGICAL, POINTER :: LDUMMY7=>NULL()
+LOGICAL, POINTER :: LDUMMY8=>NULL()
+!
+CHARACTER(len=80), POINTER :: CDUMMY1=>NULL()
+CHARACTER(len=80), POINTER :: CDUMMY2=>NULL()
+CHARACTER(len=80), POINTER :: CDUMMY3=>NULL()
+CHARACTER(len=80), POINTER :: CDUMMY4=>NULL()
+CHARACTER(len=80), POINTER :: CDUMMY5=>NULL()
+CHARACTER(len=80), POINTER :: CDUMMY6=>NULL()
+CHARACTER(len=80), POINTER :: CDUMMY7=>NULL()
+CHARACTER(len=80), POINTER :: CDUMMY8=>NULL()
+!
+INTEGER, POINTER :: NDUMMY1=>NULL()
+INTEGER, POINTER :: NDUMMY2=>NULL()
+INTEGER, POINTER :: NDUMMY3=>NULL()
+INTEGER, POINTER :: NDUMMY4=>NULL()
+INTEGER, POINTER :: NDUMMY5=>NULL()
+INTEGER, POINTER :: NDUMMY6=>NULL()
+INTEGER, POINTER :: NDUMMY7=>NULL()
+INTEGER, POINTER :: NDUMMY8=>NULL()
+!
+REAL, POINTER :: XDUMMY1=>NULL()
+REAL, POINTER :: XDUMMY2=>NULL()
+REAL, POINTER :: XDUMMY3=>NULL()
+REAL, POINTER :: XDUMMY4=>NULL()
+REAL, POINTER :: XDUMMY5=>NULL()
+REAL, POINTER :: XDUMMY6=>NULL()
+REAL, POINTER :: XDUMMY7=>NULL()
+REAL, POINTER :: XDUMMY8=>NULL()
+!
+CONTAINS
+!
+SUBROUTINE BLANK_GOTO_MODEL(KFROM,KTO)
+INTEGER, INTENT(IN) :: KFROM, KTO
+!
+LDUMMY1=>BLANK_MODEL(KTO)%LDUMMY1
+LDUMMY2=>BLANK_MODEL(KTO)%LDUMMY2
+LDUMMY3=>BLANK_MODEL(KTO)%LDUMMY3
+LDUMMY4=>BLANK_MODEL(KTO)%LDUMMY4
+LDUMMY5=>BLANK_MODEL(KTO)%LDUMMY5
+LDUMMY6=>BLANK_MODEL(KTO)%LDUMMY6
+LDUMMY7=>BLANK_MODEL(KTO)%LDUMMY7
+LDUMMY8=>BLANK_MODEL(KTO)%LDUMMY8
+
+CDUMMY1=>BLANK_MODEL(KTO)%CDUMMY1
+CDUMMY2=>BLANK_MODEL(KTO)%CDUMMY2
+CDUMMY3=>BLANK_MODEL(KTO)%CDUMMY3
+CDUMMY4=>BLANK_MODEL(KTO)%CDUMMY4
+CDUMMY5=>BLANK_MODEL(KTO)%CDUMMY5
+CDUMMY6=>BLANK_MODEL(KTO)%CDUMMY6
+CDUMMY7=>BLANK_MODEL(KTO)%CDUMMY7
+CDUMMY8=>BLANK_MODEL(KTO)%CDUMMY8
+!
+NDUMMY1=>BLANK_MODEL(KTO)%NDUMMY1
+NDUMMY2=>BLANK_MODEL(KTO)%NDUMMY2
+NDUMMY3=>BLANK_MODEL(KTO)%NDUMMY3
+NDUMMY4=>BLANK_MODEL(KTO)%NDUMMY4
+NDUMMY5=>BLANK_MODEL(KTO)%NDUMMY5
+NDUMMY6=>BLANK_MODEL(KTO)%NDUMMY6
+NDUMMY7=>BLANK_MODEL(KTO)%NDUMMY7
+NDUMMY8=>BLANK_MODEL(KTO)%NDUMMY8
+!
+XDUMMY1=>BLANK_MODEL(KTO)%XDUMMY1
+XDUMMY2=>BLANK_MODEL(KTO)%XDUMMY2
+XDUMMY3=>BLANK_MODEL(KTO)%XDUMMY3
+XDUMMY4=>BLANK_MODEL(KTO)%XDUMMY4
+XDUMMY5=>BLANK_MODEL(KTO)%XDUMMY5
+XDUMMY6=>BLANK_MODEL(KTO)%XDUMMY6
+XDUMMY7=>BLANK_MODEL(KTO)%XDUMMY7
+XDUMMY8=>BLANK_MODEL(KTO)%XDUMMY8
+!
+END SUBROUTINE BLANK_GOTO_MODEL
+!
+END MODULE MODD_BLANK_n
diff --git a/src/mesonh/micro/modd_conf.f90 b/src/mesonh/micro/modd_conf.f90
new file mode 100644
index 000000000..a7995fec5
--- /dev/null
+++ b/src/mesonh/micro/modd_conf.f90
@@ -0,0 +1,127 @@
+!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! #################
+ MODULE MODD_CONF
+! #################
+!
+!!**** *MODD_CONF* - declaration of configuration variables
+!!
+!! PURPOSE
+!! -------
+! The purpose of this declarative module is to specify the variables
+! which concern the configuration of all models. For exemple,
+! the type of geometry (Cartesian or conformal projection plane).
+!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (module MODD_CONF)
+!! Technical Specifications Report of the Meso-NH (chapters 2 and 3)
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq *Meteo France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 05/05/94
+!! J. Stein 09/01/95 add the 1D switch
+!! J. Stein and P. Jabouille 30/04/96 add the storage type
+!! J.-P. Pinty 13/02/96 add LFORCING switch
+!! J. Stein 25/07/97 add the equation system switch
+!! P. Jabouille 07/05/98 add LPACK
+!! V. Masson 18/03/98 add the VERSION switch
+!! V. Masson 15/03/99 add PROGRAM swith
+!! P. Jabouille 21/07/99 add NHALO and CSPLIT
+!! P. Jabouille 26/06/01 lagrangian variables
+!! V. Masson 09/07/01 add LNEUTRAL switch
+!! P. Jabouille 18/04/02 add NBUGFIX and CBIBUSER
+!! C. Lac 01/04/14 add LCHECK
+!! G. Tanguy 01/04/14 add LCOUPLING
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+CHARACTER (LEN=5),SAVE :: CCONF ! Configuration of models
+ ! 'START' for start configuration
+ ! 'RESTART' for restart configuration
+LOGICAL,SAVE :: LTHINSHELL ! Logical for thinshell approximation
+ ! .TRUE. = thinshell approximation
+ ! .FALSE. = no thinshell approximation
+LOGICAL,SAVE :: LCARTESIAN ! Logical for cartesian geometry :
+ ! .TRUE. = cartesian geometry
+ ! .FALSE. = conformal projection
+LOGICAL,SAVE :: L2D = .FALSE. ! Logical for 2D model version
+ ! .TRUE. = 2D model version
+ ! .FALSE. = 3D model version
+LOGICAL,SAVE :: L1D ! Logical for 1D model version
+ ! .TRUE. = 1D model version
+ ! .FALSE. = 2D or 3D model version
+LOGICAL,SAVE :: LFLAT ! Logical for zero ororography
+ ! .TRUE. = no orography (zs=0.)
+ ! .FALSE. = orography
+INTEGER,SAVE :: NMODEL ! Number of nested models
+INTEGER,SAVE :: NVERB ! Level of informations on output-listing
+ ! 0 for minimum of prints
+ ! 5 for intermediate level of prints
+ ! 10 for maximum of prints
+CHARACTER (LEN=5),SAVE :: CEXP ! Experiment name
+CHARACTER (LEN=5),SAVE :: CSEG ! name of segment
+LOGICAL,SAVE :: LFORCING ! Logical for forcing sources
+ ! .TRUE. = add forcing sources
+ ! .FALSE. = no forcing fields
+!
+CHARACTER (LEN=3),SAVE :: CEQNSYS! EQuatioN SYStem resolved by the MESONH model
+ ! 'LHE' Lipps and HEmler anelastic system
+ ! 'DUR' approximated form of the DURran version
+ ! of the anelastic sytem
+ ! 'MAE' classical Modified Anelastic Equations
+ ! but with not any approximation in the
+ ! momentum equation
+ ! 'FCE' fully compressible equations ( not
+ ! yet developped )
+LOGICAL,SAVE :: LPACK ! Logical to compress 1D or 2D FM files
+!
+!
+INTEGER,DIMENSION(3),SAVE :: NMNHVERSION ! Version of MesoNH
+INTEGER,SAVE :: NMASDEV ! NMASDEV=XY corresponds to the masdevX_Y
+INTEGER,SAVE :: NBUGFIX ! NBUGFIX=n corresponds to the BUGn of masdevX_Y
+CHARACTER(LEN=10),SAVE :: CBIBUSER! CBIBUSER is the name of the user binary library
+!
+CHARACTER(LEN=6),SAVE :: CPROGRAM ! CPROGRAM is the program currently running:
+! ! 'PGD ','ADVPGD','NESPGD','REAL ','IDEAL '
+! ! 'MESONH','SPAWN ','DIAG ','SPEC '
+!
+INTEGER,SAVE :: NHALO ! Size of the halo for parallel distribution
+!
+!INTEGER,SAVE :: JPHEXT = 1 ! Horizontal External points number
+!
+CHARACTER (LEN=10),SAVE :: CSPLIT ! kind of domain splitting for parallel distribution
+ ! "BSPLITTING","XSPLITTING","YSPLITTING"
+LOGICAL,SAVE :: LLG ! Logical to use lagrangian variables
+LOGICAL,SAVE :: LINIT_LG ! to reinitialize lagrangian variables
+CHARACTER (LEN=5),SAVE :: CINIT_LG ! to reinitialize LG variables at every output
+LOGICAL,SAVE :: LNOMIXLG ! to use turbulence for lagrangian variables
+!
+LOGICAL,SAVE :: LNEUTRAL ! True if ref. theta field is uniform
+!
+LOGICAL,SAVE :: LCPL_AROME ! true if coupling file are issued from AROME
+LOGICAL,SAVE :: LCOUPLING ! true if coupling file (and not intial file)
+ ! (with LCOUPLING=T in PREP_REAL_CASE)
+!
+LOGICAL,SAVE :: LCHECK ! To test reproducibility
+!
+END MODULE MODD_CONF
diff --git a/src/mesonh/micro/modd_cst.f90 b/src/mesonh/micro/modd_cst.f90
new file mode 100644
index 000000000..73607888c
--- /dev/null
+++ b/src/mesonh/micro/modd_cst.f90
@@ -0,0 +1,116 @@
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ###############
+ MODULE MODD_CST
+! ###############
+!
+!!**** *MODD_CST* - declaration of Physic constants
+!!
+!! PURPOSE
+!! -------
+! The purpose of this declarative module is to declare the
+! Physics constants.
+!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (MODD_CST)
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq *Meteo France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 16/05/94
+!! J. Stein 02/01/95 add xrholw
+!! J.-P. Pinty 13/12/95 add XALPI,XBETAI,XGAMI
+!! J. Stein 25/07/97 add XTH00
+!! V. Masson 05/10/98 add XRHOLI
+!! C. Mari 31/10/00 add NDAYSEC
+!! V. Masson 01/03/03 add conductivity of ice
+!! J.Escobar : 10/2017 : for real*4 , add XMNH_HUGE_12_LOG
+!! J.L. Redelsperger 03/2021 add constants for ocean penetrating solar
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+REAL,SAVE :: XPI ! Pi
+!
+REAL,SAVE :: XDAY,XSIYEA,XSIDAY ! day duration, sideral year duration,
+ ! sideral day duration
+!
+REAL,SAVE :: XKARMAN ! von karman constant
+REAL,SAVE :: XLIGHTSPEED ! light speed
+REAL,SAVE :: XPLANCK ! Planck constant
+REAL,SAVE :: XBOLTZ ! Boltzman constant
+REAL,SAVE :: XAVOGADRO ! Avogadro number
+!
+REAL,SAVE :: XRADIUS,XOMEGA ! Earth radius, earth rotation
+REAL,SAVE :: XG ! Gravity constant
+!
+REAL,SAVE :: XP00 ! Reference pressure
+REAL,SAVE :: XP00OCEAN ! Reference pressure for ocean model
+REAL,SAVE :: XRH00OCEAN ! Reference density for ocean model
+!
+REAL,SAVE :: XSTEFAN,XI0 ! Stefan-Boltzman constant, solar constant
+!
+REAL,SAVE :: XMD,XMV ! Molar mass of dry air and molar mass of vapor
+REAL,SAVE :: XRD,XRV ! Gaz constant for dry air, gaz constant for vapor
+REAL,SAVE :: XEPSILO ! XMV/XMD
+REAL,SAVE :: XCPD,XCPV ! Cpd (dry air), Cpv (vapor)
+REAL,SAVE :: XRHOLW ! Volumic mass of liquid water
+REAL,SAVE :: XCL,XCI ! Cl (liquid), Ci (ice)
+REAL,SAVE :: XTT ! Triple point temperature
+REAL,SAVE :: XLVTT ! Vaporization heat constant
+REAL,SAVE :: XLSTT ! Sublimation heat constant
+REAL,SAVE :: XLMTT ! Melting heat constant
+REAL,SAVE :: XESTT ! Saturation vapor pressure at triple point
+ ! temperature
+REAL,SAVE :: XALPW,XBETAW,XGAMW ! Constants for saturation vapor
+ ! pressure function
+REAL,SAVE :: XALPI,XBETAI,XGAMI ! Constants for saturation vapor
+ ! pressure function over solid ice
+REAL,SAVE :: XCONDI ! thermal conductivity of ice (W m-1 K-1)
+REAL,SAVE :: XALPHAOC ! thermal expansion coefficient for ocean (K-1)
+REAL,SAVE :: XBETAOC ! Haline contraction coeff for ocean (S-1)
+REAL,SAVE :: XTH00 ! reference value for the potential temperature
+REAL,SAVE :: XTH00OCEAN ! Ref value for pot temp in ocean model
+REAL,SAVE :: XSA00OCEAN ! Ref value for SAlinity in ocean model
+REAL,SAVE :: XROC=0.69! 3 coeffs for SW penetration in Ocean (Hoecker et al)
+REAL,SAVE :: XD1=1.1
+REAL,SAVE :: XD2=23.
+! Values used in SURFEX CMO
+!REAL,SAVE :: XROC=0.58
+!REAL,SAVE :: XD1=0.35
+!REAL,SAVE :: XD2=23.
+
+REAL,SAVE :: XRHOLI ! Volumic mass of liquid water
+!
+INTEGER, SAVE :: NDAYSEC ! Number of seconds in a day
+!
+!
+! Some machine precision value depending of real4/8 use
+!
+REAL,SAVE :: XMNH_TINY ! minimum real on this machine
+REAL,SAVE :: XMNH_TINY_12 ! sqrt(minimum real on this machine)
+REAL,SAVE :: XMNH_EPSILON ! minimum space with 1.0
+REAL,SAVE :: XMNH_HUGE ! maximum real on this machine
+REAL,SAVE :: XMNH_HUGE_12_LOG ! maximum log(sqrt(real)) on this machine
+
+REAL,SAVE :: XEPS_DT ! default value for DT test
+REAL,SAVE :: XRES_FLAT_CART ! default flat&cart residual tolerance
+REAL,SAVE :: XRES_OTHER ! default not flat&cart residual tolerance
+REAL,SAVE :: XRES_PREP ! default prep residual tolerance
+
+!
+END MODULE MODD_CST
diff --git a/src/mesonh/micro/modd_dyn.f90 b/src/mesonh/micro/modd_dyn.f90
new file mode 100644
index 000000000..244a67f95
--- /dev/null
+++ b/src/mesonh/micro/modd_dyn.f90
@@ -0,0 +1,86 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$ $Date$
+!-----------------------------------------------------------------
+!-----------------------------------------------------------------
+!-----------------------------------------------------------------
+! ################
+ MODULE MODD_DYN
+! ################
+!
+!!**** *MODD_DYN* - declaration of dynamic control variables
+!!
+!! PURPOSE
+!! -------
+! The purpose of this declarative module is to declare the dynamic
+! control variables for all models.
+!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS : contains the maximum number of coupling files
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (module MODD_DYN)
+!! Technical Specifications Report of the Meso-NH (chapters 2 and 3)
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq *Meteo France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 06/05/94
+!! Modifications 17/10/94 (Stein) For LCORIO
+!! Modifications 12/12/94 (Stein) remove LABSLAYER + add XALZBOT
+!! and XALKBOT
+!! Modifications 10/03/95 (I.Mallet) add coupling variables
+!! 04/05/07 (C.Lac) Separation of num.diffusion
+!! between variables
+!---------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS
+!
+IMPLICIT NONE
+!
+REAL ,SAVE :: XSEGLEN ! Duration of segment (in seconds)
+REAL ,SAVE :: XASSELIN ! Asselin coefficient
+REAL ,SAVE :: XASSELIN_SV! Asselin coefficient for tracer variables
+LOGICAL,SAVE :: LCORIO ! Coriolis flag
+LOGICAL,SAVE :: LNUMDIFU ! logical switch for the NUMerical DIFFusion:
+ ! .TRUE. active .FALSE. unactive
+ ! for momentum
+LOGICAL,SAVE :: LNUMDIFTH ! For theta and mixing ratio
+LOGICAL,SAVE :: LNUMDIFSV ! For scalar variables
+LOGICAL,SAVE :: LSTEADYLS ! logical switch to remove all Larger Scale fields
+ ! evolution during the segment (the LS fields are
+ ! STEADY).TRUE. LS steady .FALSE. LS unsteady
+REAL ,SAVE :: XALKTOP ! Damping coef. at the top of the absorbing
+ ! layer
+REAL ,SAVE :: XALZBOT ! Height of the absorbing layer base
+!
+REAL ,SAVE :: XALKGRD ! Damping coef. at the top of the absorbing
+ ! layer (bottom layer)
+REAL ,SAVE :: XALZBAS ! Height of the absorbing layer base (bottom layer)
+!
+INTEGER,SAVE :: NCPL_NBR ! NumBeR of CouPLing files
+INTEGER,SAVE :: NCPL_CUR ! Number of CURrent CouPLing file
+!
+LOGICAL, SAVE, DIMENSION(JPMODELMAX) :: LUSERV_G, LUSERC_G, LUSERR_G, LUSERI_G
+LOGICAL, SAVE, DIMENSION(JPMODELMAX) :: LUSERS_G, LUSERH_G, LUSERG_G
+LOGICAL, SAVE, DIMENSION(JPMODELMAX) :: LUSETKE
+LOGICAL, SAVE, DIMENSION(JPSVMAX,JPMODELMAX) :: LUSESV
+REAL, SAVE, DIMENSION(JPCPLFILEMAX,JPMODELMAX) :: NCPL_TIMES ! array of
+ ! the number for the coupling instants of every nested model
+REAL, SAVE :: XTSTEP_MODEL1 ! time step of the
+ ! outermost model
+END MODULE MODD_DYN
diff --git a/src/mesonh/micro/modd_elec_descr.f90 b/src/mesonh/micro/modd_elec_descr.f90
new file mode 100644
index 000000000..82d346588
--- /dev/null
+++ b/src/mesonh/micro/modd_elec_descr.f90
@@ -0,0 +1,178 @@
+!MNH_LIC Copyright 2002-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! #######################
+ MODULE MODD_ELEC_DESCR
+! #######################
+!
+!!**** *MODD_ELEC_DESCR* - declaration of the electrical descriptive constants
+!!
+!! PURPOSE
+!! -------
+!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! Gilles Molinie * Laboratoire d'Aerologie *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 14/11/02
+!! M. Chong 26/01/10 Small ions parameters
+!! +Option for Fair weather field from
+!! Helsdon-Farley (JGR, 1987, 5661-5675)
+!! Add "Beard" effect via sedimentation process
+!! J.-P. Pinty 25/10/13 Add "Latham" effect via aggregation process
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS, ONLY: JPSVNAMELGTMAX
+
+IMPLICIT NONE
+!
+! Namelist
+LOGICAL :: LOCG=.FALSE. ! .T.: only charge generation
+LOGICAL :: LELEC_FIELD=.TRUE. ! .T.: the electric field is computed
+LOGICAL :: LFW_HELFA=.FALSE. ! .T.: Helsdon-Farley Fair Weather field
+LOGICAL :: LCOSMIC_APPROX=.FALSE. ! .T.: Neglecting height variations of fair
+ ! weather ion current in calculating ion
+ ! source (XIONSOURCEFW) from cosmic rays
+LOGICAL :: LION_ATTACH = .TRUE. ! .T.: Ion attachment to hydrometeors
+CHARACTER (LEN=3) :: CDRIFT = 'PPM' ! PPM (advection) or DIV (Divergence form)
+LOGICAL :: LRELAX2FW_ION = .FALSE. ! .T.= Relaxation to fair weather ion
+ ! concentration in rim zone and top absorbing
+ ! layer
+LOGICAL :: LFLASH_GEOM=.TRUE. ! .T.: the 'geometric' flash scheme is used
+LOGICAL :: LSAVE_COORD=.FALSE. ! .T.: the flash coord are written in an ascii file
+INTEGER :: NFLASH_WRITE = 1000 ! Number of flashes to be saved before writing
+ ! the diag and/or coordinates in ascii files
+LOGICAL :: LINDUCTIVE=.FALSE. ! .T.: inductive process is taken into account
+LOGICAL :: LLNOX_EXPLICIT=.FALSE. ! .T.: lnox production is computed
+LOGICAL :: LSERIES_ELEC=.FALSE. ! .T.: looking for flash rate proxies
+INTEGER :: NTSAVE_SERIES = 60 ! time interval at which data from
+ ! series_cloud_elec are written in an ascii file
+!
+CHARACTER (LEN=5) :: CNI_CHARGING='TAKAH' ! Choice of the charging process
+REAL :: XQTC=263. ! temperature charge reversal for 'HELFA'
+REAL :: XLIM_NI_IS=10.E-15 ! max magnitude of dq for I-S non-inductive charging (C)
+REAL :: XLIM_NI_IG=30.E-15 ! max magnitude of dq for I-G non-inductive charging (C)
+REAL :: XLIM_NI_SG=100.E-15 ! max magnitude of dq for S-G non-inductive charging (C)
+!
+CHARACTER (LEN=5) :: CLSOL='RICHA' ! Choice of the Laplace equation solver
+INTEGER :: NLAPITR_ELEC=4 ! Nb of iteration for the elec field solveur
+REAL :: XRELAX_ELEC=1 ! Relaxation factor for the elec field solveur
+!
+REAL :: XETRIG=200.E3 ! E threshold for lightning triggering
+REAL :: XEBALANCE=0.1 ! Proportion of XETRIG that the lightning must reduce
+REAL :: XEPROP=15.E3 ! E threshold for lightning propagation
+!
+REAL :: XQEXCES=2.E-10 ! Charge in excess of qexces => pt available for cell detection
+REAL :: XQNEUT=1.E-10 ! Charge in excess of qneut is neutralized
+REAL :: XDFRAC_ECLAIR=2.3 ! Fractal dimension of lightning flashes
+REAL :: XDFRAC_L=1500. ! Linear coefficient for the branch number
+!
+REAL :: XWANG_A = 0.34E21 ! Wang eta al. parameters of
+REAL :: XWANG_B = 1.3E16 ! LNOX production
+!
+!
+REAL, DIMENSION(:), SAVE, ALLOCATABLE :: XQTMIN ! Min values allowed for the
+ ! volumetric charge
+REAL, DIMENSION(:) , ALLOCATABLE :: XRTMIN_ELEC ! Limit value of R where charge is available
+!
+REAL, SAVE :: XCXR ! Exponent in the concentration-slope
+REAL :: XEPSILON ! Dielectric permittivity of air (F/m)
+REAL :: XECHARGE ! Elementary charge (C)
+!
+! charge-diameter relationship : e_x and f_x in q_x=e_xD^f_x
+!
+REAL, DIMENSION(:), SAVE, ALLOCATABLE :: XEC, XER, XEI, XES, XEG, XEH ! e_x
+REAL, SAVE :: XFC, XFR, XFI, XFS, XFG, XFH ! f_x
+!
+!
+! parameters relative to electrification
+!
+REAL :: XESR, & ! Mean collection efficiency for rain-aggregate,
+ XEGR, & ! graupel_rain,
+ XEGS ! graupel_snow
+REAL :: XDELTATMIN ! Minimum temperature gap between ZTT(:) and XQTC
+!
+REAL :: XQINDIV_C_CST, & !
+ XQINDIV_R_CST, & !
+ XQINDIV_I_CST, & ! Constants for the individual charge
+ XQINDIV_I_EXP, & ! calculation
+ XQINDIV_S_CST, & !
+ XQINDIV_G_CST !
+!
+REAL, SAVE :: XLBDAR_MAXE, & ! Max values allowed for the shape
+ XLBDAS_MAXE, & ! when computation of charge separation
+ XLBDAG_MAXE, & ! and of lightning neutralisation
+ XLBDAH_MAXE !
+REAL :: XALPHACQ, XNUCQ, XLBDACQ
+!
+!
+! parameters relative to the electric field
+!
+REAL :: XE_0, XKEF ! Constant for the fair weather electric field
+
+REAL, SAVE :: XE0_HF, XA1_HF, XB1_HF, XA2_HF, XB2_HF, XA3_HF, XB3_HF ! Coeffs.
+ ! Helsdon-Farley Fair Weather Electric Field
+REAL, SAVE :: XIONCOMB ! Ionic recombination coefficient (m3/s)
+REAL, SAVE :: XF_POS, XF_NEG ! Constant for positive/negative ion mobility
+ ! law (m2/V/s)
+REAL, SAVE :: XEXPMOB ! Exponent of ion mobility law (m-1)
+
+REAL, SAVE :: XFCORONA ! Factor for corona current (A m /V3)
+REAL, SAVE :: XECORONA ! Electric field threshold for corona (V/m)
+
+! Fair Weather electric property (Chiu, JGR 1978, 5025-5049)
+!
+REAL, SAVE :: XJCURR_FW ! Air-earth conduction current (A/m2)
+!
+! Lightning flashes
+!
+INTEGER :: NMAX_CELL ! max number of electrified cells in the domain
+INTEGER :: NBRANCH_MAX ! max number of branches per flash
+INTEGER :: NLEADER_MAX ! max number of segments in the bi-leader
+REAL :: XE_THRESH ! electric field threshold for cell detection
+!
+INTEGER, PARAMETER :: NLGHTMAX = 5000, & ! Nb max of lightnings
+ NSEGMAX = 500 ! Nb max of segments
+!
+! Parameters relative to the lightning
+!
+INTEGER :: NNBLIGHT=0 ! Nb of lightning flashes
+!
+REAL, DIMENSION(:), ALLOCATABLE :: XNEUT_POS, XNEUT_NEG
+INTEGER :: NNB_CG ! Nb of CG flashes
+INTEGER :: NNB_CG_POS ! Nb of positive CG flashes
+REAL :: XALT_CG ! Altitude (m) at which CG are detected
+!
+CHARACTER(LEN=JPSVNAMELGTMAX), DIMENSION(8) &
+ :: CELECNAMES=(/'QNIONP','QCELEC','QRELEC','QIELEC','QSELEC', &
+ 'QGELEC','QHELEC','QNIONN'/)
+! QNIONP (QNIONN): Positive (Negative) ion concentration
+! basenames of the SV articles stored in the binary files
+!
+REAL :: XLNOX_ECLAIR
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: XEPOTFW_TOP
+!
+! Parameters relative to the "Beard" effect ELEC=>MICROPHYS
+!
+LOGICAL :: LSEDIM_BEARD=.FALSE. ! .T.: to enable ELEC=>MICROPHYS via
+! ! particule sedimentation rate
+LOGICAL :: LIAGGS_LATHAM=.FALSE. ! .T.: to enable ELEC=>MICROPHYS via
+! ! ice aggregation rate
+!
+END MODULE MODD_ELEC_DESCR
diff --git a/src/mesonh/micro/modd_les.f90 b/src/mesonh/micro/modd_les.f90
new file mode 100644
index 000000000..db71d6f33
--- /dev/null
+++ b/src/mesonh/micro/modd_les.f90
@@ -0,0 +1,458 @@
+!MNH_LIC Copyright 1995-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ###############
+ MODULE MODD_LES
+! ###############
+!
+!!**** *MODD_LES* - declaration of prognostic variables
+!!
+!! PURPOSE
+!! -------
+! The purpose of this declarative module is to specify the
+! resolved fluxes and the spectra computed in LES mode
+!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (module MODD_LES)
+!! Technical Specifications Report of the Meso-NH (chapters 2 and 3)
+!!
+!!
+!! AUTHOR
+!! ------
+!! J. Cuxart *INM and Meteo France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original March 10, 1995
+!!
+!! (J.Stein) Sept. 25, 1995 add the model number in LES mode
+!! J. Cuxart Oct. 4, 1996 New time series
+!! V. Masson Jan. 20, 2000 New LES routines variables & //
+!! V. Masson Nov. 6, 2002 LES budgets
+!! F. Couvreux Oct 1, 2006 LES PDF
+!! J.Pergaud Oct , 2007 MF LES
+!! P. Aumond Oct ,2009 User multimaskS + 4th order
+!! C.Lac Oct ,2014 Correction on user masks
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
+! P. Wautelet 30/03/2021: budgets: LES cartesian subdomain limits are defined in the physical domain
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS
+!
+IMPLICIT NONE
+!
+!-------------------------------------------------------------------------------
+!
+!* namelist variables
+!
+LOGICAL :: LLES_MEAN ! flag to activate the mean computations
+LOGICAL :: LLES_RESOLVED ! flag to activate the resolved var. computations
+LOGICAL :: LLES_SUBGRID ! flag to activate the subgrid var. computations
+LOGICAL :: LLES_UPDRAFT ! flag to activate the computations in updrafts
+LOGICAL :: LLES_DOWNDRAFT ! flag to activate the computations in downdrafts
+LOGICAL :: LLES_SPECTRA ! flag to activate the spectra computations
+LOGICAL :: LLES_PDF ! flag to activate the pdf computations
+!
+INTEGER, DIMENSION(900) :: NLES_LEVELS ! physical model levels for LES comp.
+REAL, DIMENSION(900) :: XLES_ALTITUDES ! alt. levels for LES comp.
+INTEGER, DIMENSION(900) :: NSPECTRA_LEVELS ! physical model levels for spectra comp.
+REAL, DIMENSION(900) :: XSPECTRA_ALTITUDES ! alt. levels for spectra comp.
+!
+INTEGER, DIMENSION( 10) :: NLES_TEMP_SERIE_I ! I, J and Z point
+INTEGER, DIMENSION( 10) :: NLES_TEMP_SERIE_J ! localizations to
+INTEGER, DIMENSION( 10) :: NLES_TEMP_SERIE_Z ! record temporal data
+
+CHARACTER(LEN=4) :: CLES_NORM_TYPE ! type of turbulence normalization
+CHARACTER(LEN=3) :: CBL_HEIGHT_DEF ! definition of the boundary layer height
+
+REAL :: XLES_TEMP_SAMPLING ! temporal sampling between each computation
+REAL :: XLES_TEMP_MEAN_START ! time (in s) from the beginning of the simulation
+REAL :: XLES_TEMP_MEAN_END ! for start and end of the temporal averaged comp.
+REAL :: XLES_TEMP_MEAN_STEP ! time step for each averaging
+
+LOGICAL :: LLES_CART_MASK ! flag to use a cartesian mask
+INTEGER :: NLES_IINF ! definition of the cartesians mask in physical domain
+INTEGER :: NLES_ISUP ! for NLES_CART_MODNBR model
+INTEGER :: NLES_JINF ! "
+INTEGER :: NLES_JSUP ! "
+LOGICAL :: LLES_NEB_MASK ! flag to use a 2D nebulosity mask
+LOGICAL :: LLES_CORE_MASK ! flag to use a 3D cloud core mask
+LOGICAL :: LLES_MY_MASK ! flag to use its own mask (must be coded by user)
+INTEGER :: NLES_MASKS_USER ! number of user masks for LES computations
+LOGICAL :: LLES_CS_MASK ! flag to use conditional sampling mask
+INTEGER :: NPDF ! number of pdf intervals
+!
+!-------------------------------------------------------------------------------
+!
+INTEGER, DIMENSION(JPMODELMAX) :: NLESn_IINF ! definition of the cartesians mask in physical domain
+INTEGER, DIMENSION(JPMODELMAX) :: NLESn_ISUP ! for all models
+INTEGER, DIMENSION(JPMODELMAX) :: NLESn_JINF ! "
+INTEGER, DIMENSION(JPMODELMAX) :: NLESn_JSUP ! "
+!
+CHARACTER(LEN=4), DIMENSION(2,JPMODELMAX) :: CLES_LBCX
+! X boundary conditions for 2 points correlations computations for all models
+!
+CHARACTER(LEN=4), DIMENSION(2,JPMODELMAX) :: CLES_LBCY
+! Y boundary conditions for 2 points correlations computations for all models
+!
+!-------------------------------------------------------------------------------
+!
+LOGICAL :: LLES ! flag to compute the LES diagnostics
+!
+LOGICAL :: LLES_CALL ! flag to compute the LES diagnostics at current
+! ! time step
+!
+!
+LOGICAL, DIMENSION(:,:,:), ALLOCATABLE :: LLES_CURRENT_CART_MASK
+! 2D cartesian mask of the current model
+!
+LOGICAL, DIMENSION(:,:,:), ALLOCATABLE :: LLES_CURRENT_NEB_MASK
+! 2D nebulosity mask of the current model
+!
+LOGICAL, DIMENSION(:,:,:), ALLOCATABLE :: LLES_CURRENT_CORE_MASK
+! 2D surface precipitations mask of the current model
+!
+! 2D owner mask of the current model
+LOGICAL, DIMENSION(:,:,:,:), ALLOCATABLE :: LLES_CURRENT_MY_MASKS
+!
+LOGICAL, DIMENSION(:,:,:), ALLOCATABLE :: LLES_CURRENT_CS1_MASK
+LOGICAL, DIMENSION(:,:,:), ALLOCATABLE :: LLES_CURRENT_CS2_MASK
+LOGICAL, DIMENSION(:,:,:), ALLOCATABLE :: LLES_CURRENT_CS3_MASK
+! 2D conditional sampling mask of the current model
+!
+INTEGER :: NLES_CURRENT_TCOUNT
+! current model LES time counter
+!
+INTEGER :: NLES_CURRENT_TIMES
+! current model NLES_TIMES (number of LES samplings)
+!
+INTEGER :: NLES_CURRENT_IINF, NLES_CURRENT_ISUP, NLES_CURRENT_JINF, NLES_CURRENT_JSUP
+! coordinates (in physical domain) for write_diachro, set to NLESn_IINF(current model), etc...
+!
+REAL :: XLES_CURRENT_DOMEGAX, XLES_CURRENT_DOMEGAY
+! minimum wavelength in spectra analysis
+!
+CHARACTER(LEN=4), DIMENSION(2) :: CLES_CURRENT_LBCX
+! current model X boundary conditions for 2 points correlations computations
+!
+CHARACTER(LEN=4), DIMENSION(2) :: CLES_CURRENT_LBCY
+! current model Y boundary conditions for 2 points correlations computations
+!
+REAL, DIMENSION(:), ALLOCATABLE :: XLES_CURRENT_Z
+! altitudes for diachro
+!
+REAL :: XLES_CURRENT_ZS
+! orography (used for normalization of altitudes)
+!
+INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: NKLIN_CURRENT_LES
+! levels for vertical interpolation
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XCOEFLIN_CURRENT_LES
+! coefficients for vertical interpolation
+!
+INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: NKLIN_CURRENT_SPEC
+! levels for vertical interpolation
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XCOEFLIN_CURRENT_SPEC
+! coefficients for vertical interpolation
+!
+REAL,DIMENSION(2) :: XTIME_LES
+! time spent in subgrid LES computations in this time-step in TURB
+!
+!-------------------------------------------------------------------------------
+!
+!* normalization variables
+!
+REAL, DIMENSION(:), ALLOCATABLE :: XLES_NORM_M
+! normalization coefficient for distances (Meters)
+!
+REAL, DIMENSION(:), ALLOCATABLE :: XLES_NORM_K
+! normalization coefficient for temperatures (Kelvin)
+!
+REAL, DIMENSION(:), ALLOCATABLE :: XLES_NORM_S
+! normalization coefficient for times (Seconds)
+!
+REAL, DIMENSION(:), ALLOCATABLE :: XLES_NORM_RHO
+! normalization coefficient for densities
+!
+REAL, DIMENSION(:), ALLOCATABLE :: XLES_NORM_RV
+! normalization coefficient for mixing ratio
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: XLES_NORM_SV
+! normalization coefficient for scalar variables
+!
+REAL, DIMENSION(:), ALLOCATABLE :: XLES_NORM_P
+! normalization coefficient for pressure
+!
+!-------------------------------------------------------------------------------
+!
+!* monitoring variables
+!
+INTEGER :: NLES_MASKS ! number of masks for LES computations
+INTEGER :: NLES_K ! number of vertical levels for local diagnostics
+INTEGER :: NSPECTRA_K ! number of vertical levels for spectra
+!
+CHARACTER(LEN=1) :: CLES_LEVEL_TYPE ! type of vertical levels for local diag.
+CHARACTER(LEN=1) :: CSPECTRA_LEVEL_TYPE ! type of vertical levels for spectra
+!
+!-------------------------------------------------------------------------------
+!
+!* subgrid variables for current model
+!
+! ______
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_W_SBG_WThl ! <w'w'Thl'>
+! _____
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_W_SBG_WRt ! <w'w'Rt'>
+! _____
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_W_SBG_Thl2 ! <w'Thl'2>
+! ____
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_W_SBG_Rt2 ! <w'Rt'2>
+! _______
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_W_SBG_ThlRt! <w'Thl'Rt'>
+! _____
+REAL, DIMENSION(:,:,:,:),ALLOCATABLE:: X_LES_RES_W_SBG_WSv ! <w'w'Sv'>
+! ____
+REAL, DIMENSION(:,:,:,:),ALLOCATABLE:: X_LES_RES_W_SBG_Sv2 ! <w'Sv'2>
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XLES_SUBGRID_RCSIGS ! rc sigmas
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XLES_SUBGRID_RCSIGC ! rc sigmac
+! _____
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_ddxa_U_SBG_UaU ! <du'/dxa ua'u'>
+! _____
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_ddxa_V_SBG_UaV ! <dv'/dxa ua'v'>
+! _____
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_ddxa_W_SBG_UaW ! <dw'/dxa ua'w'>
+! _______
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_ddxa_W_SBG_UaThl ! <dw'/dxa ua'Thl'>
+! _____
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_ddxa_Thl_SBG_UaW ! <dThl'/dxa ua'w'>
+! ___
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_ddz_Thl_SBG_W2 ! <dThl'/dz w'2>
+! ______
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_ddxa_W_SBG_UaRt ! <dw'/dxa ua'Rt'>
+! _____
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_ddxa_Rt_SBG_UaW ! <dRt'/dxa ua'w'>
+! ___
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_ddz_Rt_SBG_W2 ! <dRt'/dz w'2>
+! ______
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_ddxa_Thl_SBG_UaRt! <dThl'/dxa ua'Rt'>
+! _______
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_ddxa_Rt_SBG_UaThl! <dRt'/dxa ua'Thl'>
+! _______
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_ddxa_Thl_SBG_UaThl! <dThl'/dxa ua'Thl'>
+! ______
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_ddxa_Rt_SBG_UaRt ! <dRt'/dxa ua'Rt'>
+! ______
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: X_LES_RES_ddxa_W_SBG_UaSv ! <dw'/dxa ua'Sv'>
+! _____
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: X_LES_RES_ddxa_Sv_SBG_UaW ! <dSv'/dxa ua'w'>
+! ___
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: X_LES_RES_ddz_Sv_SBG_W2 ! <dSv'/dz w'2>
+! ______
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: X_LES_RES_ddxa_Sv_SBG_UaSv ! <dSv'/dxa ua'Sv'>
+!
+! ___
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_U2 ! <u'2>
+! ___
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_V2 ! <v'2>
+! ___
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_W2 ! <w'2>
+! _____
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_Thl2 ! <Thl'2>
+! ____
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_Rt2 ! <Rt'2>
+! ____
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_Rc2 ! <Rc'2>
+! ____
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_Ri2 ! <Ri'2>
+! _______
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_ThlRt ! <Thl'Rt'>
+! ____
+REAL, DIMENSION(:,:,:,:),ALLOCATABLE:: X_LES_SUBGRID_Sv2 ! <Sv'2>
+! ____
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_UV ! <u'v'>
+! ____
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WU ! <w'u'>
+! ____
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WV ! <w'v'>
+! ______
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_UThl ! <u'Thl'>
+! ______
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_VThl ! <v'Thl'>
+! ______
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WThl ! <w'Thl'>
+! _____
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_URt ! <u'Rt'>
+! _____
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_VRt ! <v'Rt'>
+! _____
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WRt ! <w'Rt'>
+! _____
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_URc ! <u'Rc'>
+! _____
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_VRc ! <v'Rc'>
+! _____
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WRc ! <w'Rc'>
+! _____
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: X_LES_SUBGRID_USv ! <u'Sv'>
+! _____
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: X_LES_SUBGRID_VSv ! <v'Sv'>
+! _____
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WSv ! <w'Sv'>
+! ___
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_UTke ! <u'e>
+! ___
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_VTke ! <v'e>
+! ___
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WTke ! <w'e>
+! ___
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_ddz_WTke ! <dw'e/dz>
+! ______
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WThv ! <w'Thv'>
+! ________
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_ThlThv ! <Thl'Thv'>
+! _______
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_RtThv ! <Rt'Thv'>
+! _______
+REAL, DIMENSION(:,:,:,:),ALLOCATABLE:: X_LES_SUBGRID_SvThv ! <Sv'Thv'>
+! ______
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_W2Thl ! <w'2Thl>
+! _____
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_W2Rt ! <w'2Rt>
+! _____
+REAL, DIMENSION(:,:,:,:),ALLOCATABLE:: X_LES_SUBGRID_W2Sv ! <w'2Sv>
+! _______
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WThlRt ! <w'ThlRt>
+! ______
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WThl2 ! <w'Thl2>
+! _____
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WRt2 ! <w'Rt2>
+! _____
+REAL, DIMENSION(:,:,:,:),ALLOCATABLE:: X_LES_SUBGRID_WSv2 ! <w'Sv2>
+! _______
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_DISS_Tke ! <epsilon>
+! ____________
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_DISS_Thl2 ! <epsilon_Thl2>
+! ___________
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_DISS_Rt2 ! <epsilon_Rt2>
+! ______________
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_DISS_ThlRt! <epsilon_ThlRt>
+! ___________
+REAL, DIMENSION(:,:,:,:),ALLOCATABLE:: X_LES_SUBGRID_DISS_Sv2 ! <epsilon_Sv2>
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WP ! <w'p'>
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_ThlPz ! <Thl'dp'/dz>
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_RtPz ! <Rt'dp'/dz>
+!
+REAL, DIMENSION(:,:,:,:),ALLOCATABLE:: X_LES_SUBGRID_SvPz ! <Sv'dp'/dz>
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_PHI3 ! phi3
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_PSI3 ! psi3
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_LMix ! mixing length
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_LDiss ! dissipative length
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_Km ! eddy diffusivity for momentum
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_Kh ! eddy diffusivity for heat
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_THLUP_MF ! Thl of the Updraft
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_RTUP_MF ! Rt of the Updraft
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_RVUP_MF ! Rv of the Updraft
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_RCUP_MF ! Rc of the Updraft
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_RIUP_MF ! Ri of the Updraft
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WUP_MF ! Thl of the Updraft
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_MASSFLUX ! Mass Flux
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_DETR ! Detrainment
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_ENTR ! Entrainment
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_FRACUP ! Updraft Fraction
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_THVUP_MF ! Thv of the Updraft
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WTHLMF ! Flux of thl
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WRTMF ! Flux of rt
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WTHVMF ! Flux of thv
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WUMF ! Flux of u
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WVMF ! Flux of v
+!
+!* surface variables
+!
+REAL, DIMENSION(:), ALLOCATABLE :: X_LES_USTAR ! local u* temporal series
+REAL, DIMENSION(:), ALLOCATABLE :: X_LES_UW0 ! uw temporal series
+REAL, DIMENSION(:), ALLOCATABLE :: X_LES_VW0 ! vw temporal series
+REAL, DIMENSION(:), ALLOCATABLE :: X_LES_Q0 ! Qo temporal series
+REAL, DIMENSION(:), ALLOCATABLE :: X_LES_E0 ! Eo temporal series
+REAL, DIMENSION(:,:), ALLOCATABLE :: X_LES_SV0 ! scalar surface fluxes
+!
+!* pdf variables
+REAL :: XRV_PDF_MIN ! min of rv pdf
+REAL :: XRV_PDF_MAX ! max of rv pdf
+REAL :: XTH_PDF_MIN ! min of theta pdf
+REAL :: XTH_PDF_MAX ! max of theta pdf
+REAL :: XW_PDF_MIN ! min of w pdf
+REAL :: XW_PDF_MAX ! max of w pdf
+REAL :: XTHV_PDF_MIN ! min of thetav pdf
+REAL :: XTHV_PDF_MAX ! max of thetav pdf
+REAL :: XRC_PDF_MIN ! min of rc pdf
+REAL :: XRC_PDF_MAX ! max of rc pdf
+REAL :: XRR_PDF_MIN ! min of rr pdf
+REAL :: XRR_PDF_MAX ! max of rr pdf
+REAL :: XRI_PDF_MIN ! min of ri pdf
+REAL :: XRI_PDF_MAX ! max of ri pdf
+REAL :: XRS_PDF_MIN ! min of rs pdf
+REAL :: XRS_PDF_MAX ! max of rs pdf
+REAL :: XRG_PDF_MIN ! min of rg pdf
+REAL :: XRG_PDF_MAX ! max of rg pdf
+REAL :: XRT_PDF_MIN ! min of rt pdf
+REAL :: XRT_PDF_MAX ! max of rt pdf
+REAL :: XTHL_PDF_MIN ! min of thetal pdf
+REAL :: XTHL_PDF_MAX ! max of thetal pdf
+!-------------------------------------------------------------------------------
+!* pdf distribution
+!
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XLES_PDF_RV ! rv pdf
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XLES_PDF_TH ! theta pdf
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XLES_PDF_W ! w pdf
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XLES_PDF_THV ! thetav pdf
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XLES_PDF_RC ! rc pdf
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XLES_PDF_RR ! rr pdf
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XLES_PDF_RI ! ri pdf
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XLES_PDF_RS ! rs pdf
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XLES_PDF_RG ! rg pdf
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XLES_PDF_RT ! rt pdf
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XLES_PDF_THL ! thetal pdf
+!
+!
+!-------------------------------------------------------------------------------
+!
+END MODULE MODD_LES
diff --git a/src/mesonh/micro/modd_lima_precip_scavengingn.f90 b/src/mesonh/micro/modd_lima_precip_scavengingn.f90
new file mode 100644
index 000000000..a5f30e7a2
--- /dev/null
+++ b/src/mesonh/micro/modd_lima_precip_scavengingn.f90
@@ -0,0 +1,50 @@
+!MNH_LIC Copyright 2013-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ####################################
+ MODULE MODD_LIMA_PRECIP_SCAVENGING_n
+! ####################################
+!
+!!**** *MODD_PRECIP_SCAVENGING$n* - declaration of scavenged aerosols
+!! precipitating fields
+!!
+!! PURPOSE
+!! -------
+! Stores the INstantaneous and ACcumulated PRecipitating fields of
+!! scavenged aerosol by rain
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS, ONLY: JPMODELMAX
+!
+IMPLICIT NONE
+!
+REAL, DIMENSION(:,:), POINTER :: XINPAP=>NULL(), XACPAP=>NULL()
+ ! Instant and cumul of ground
+ ! precipitation fields of Scavenged
+ ! Aerosol Particles
+
+CONTAINS
+
+SUBROUTINE LIMA_PRECIP_SCAVENGING_GOTO_MODEL(KFROM, KTO)
+ INTEGER, INTENT(IN) :: KFROM, KTO
+END SUBROUTINE LIMA_PRECIP_SCAVENGING_GOTO_MODEL
+!
+!
+END MODULE MODD_LIMA_PRECIP_SCAVENGING_n
diff --git a/src/mesonh/micro/modd_lunit.f90 b/src/mesonh/micro/modd_lunit.f90
new file mode 100644
index 000000000..d19cf3d35
--- /dev/null
+++ b/src/mesonh/micro/modd_lunit.f90
@@ -0,0 +1,49 @@
+!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! #################
+ MODULE MODD_LUNIT
+! #################
+!
+!!**** *MODD_LUNIT* - declaration of names and logical unit numbers of files
+!!
+!! PURPOSE
+!! -------
+! The purpose of this declarative module is to declare the
+! logical unit numbers of output file for all models.
+!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (MODD_LUNIT)
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq *Meteo France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 05/05/94
+!! V. Masson 01/2004 add file names for use in externalized surface
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 14/02/2019: remove CLUOUT/CLUOUT0 and associated variables
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_IO, ONLY: TFILEDATA
+!
+IMPLICIT NONE
+!
+TYPE(TFILEDATA),POINTER :: TLUOUT0 => NULL() ! output_listing file
+TYPE(TFILEDATA),POINTER :: TOUTDATAFILE => NULL() ! output data file being written
+TYPE(TFILEDATA),POINTER :: TPGDFILE => NULL() ! PGD file
+!
+END MODULE MODD_LUNIT
diff --git a/src/mesonh/micro/modd_neb.f90 b/src/mesonh/micro/modd_neb.f90
new file mode 100644
index 000000000..984059f43
--- /dev/null
+++ b/src/mesonh/micro/modd_neb.f90
@@ -0,0 +1,43 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+! ######spl
+ MODULE MODD_NEB
+! #############################
+!
+!!**** *MODD_NEB* - Declaration of nebulosity constants
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this declarative module is to declare some
+!! constants for nebulosity calculation
+!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! S. Riette (Meteo France)
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 24 Aug 2011
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+REAL,SAVE :: XTMINMIX ! minimum temperature of mixed phase
+REAL,SAVE :: XTMAXMIX ! maximum temperature of mixed phase
+!
+!
+END MODULE MODD_NEB
diff --git a/src/mesonh/micro/modd_nsv.f90 b/src/mesonh/micro/modd_nsv.f90
new file mode 100644
index 000000000..7a842a5c1
--- /dev/null
+++ b/src/mesonh/micro/modd_nsv.f90
@@ -0,0 +1,253 @@
+!MNH_LIC Copyright 2001-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-------------------------------------------------------------------------------
+! ###############
+ MODULE MODD_NSV
+! ###############
+!
+!!**** *MODD_NSV* - declaration of scalar variables numbers
+!!
+!! PURPOSE
+!! -------
+!! Arrays to store the per-model NSV_* values number (suffix _A denote an array)
+!!
+!! AUTHOR
+!! ------
+!! D. Gazen L.A.
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/02/01
+!! J.-P. Pinty 29/11/02 add C3R5, ELEC
+!! V. Masson 01/2004 add scalar names
+!! M. Leriche 12/04/07 add aqueous chemistry
+!! M. Leriche 08/07/10 add ice phase chemistry
+!! C.Lac 07/11 add conditional sampling
+!! Pialat/Tulet 15/02/12 add ForeFire
+!! Modification 01/2016 (JP Pinty) Add LIMA
+!! V. Vionnet 07/17 add blowing snow
+! P. Wautelet 10/03/2021: add CSVNAMES and CSVNAMES_A to store the name of all the scalar variables
+! B. Vie 06/2021: add prognostic supersaturation for LIMA
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS, ONLY : JPMODELMAX, & ! Maximum allowed number of nested models
+ JPSVMAX, & ! Maximum number of scalar variables
+ JPSVNAMELGTMAX ! Maximum length of a scalar variable name
+!
+IMPLICIT NONE
+SAVE
+!
+REAL,DIMENSION(JPSVMAX) :: XSVMIN ! minimum value for SV variables
+!
+LOGICAL :: LINI_NSV = .FALSE. ! becomes True when routine INI_NSV is called
+!
+CHARACTER(LEN=JPSVNAMELGTMAX), DIMENSION(:,:), ALLOCATABLE, TARGET :: CSVNAMES_A !Names of all the scalar variables
+
+INTEGER,DIMENSION(JPMODELMAX)::NSV_A = 0 ! total number of scalar variables
+ ! NSV_A = NSV_USER_A+NSV_C2R2_A+NSV_CHEM_A+..
+INTEGER,DIMENSION(JPMODELMAX)::NSV_USER_A = 0 ! number of user scalar variables with
+ ! indices in the range : 1...NSV_USER_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_C2R2_A = 0 ! number of liq scalar in C2R2
+ ! and in C3R5
+INTEGER,DIMENSION(JPMODELMAX)::NSV_C2R2BEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_C2R2END_A = 0 ! NSV_C2R2BEG_A...NSV_C2R2END_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_C1R3_A = 0 ! number of ice scalar in C3R5
+INTEGER,DIMENSION(JPMODELMAX)::NSV_C1R3BEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_C1R3END_A = 0 ! NSV_C1R3BEG_A...NSV_C1R3END_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_ELEC_A = 0 ! number of scalar in ELEC
+INTEGER,DIMENSION(JPMODELMAX)::NSV_ELECBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_ELECEND_A = 0 ! NSV_ELECBEG_A...NSV_ELECEND_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CHEM_A = 0 ! number of chemical scalar
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CHEMBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CHEMEND_A = 0 ! NSV_CHEMBEG_A...NSV_CHEMEND_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CHGS_A = 0 ! number of gaseous chemcial species
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CHGSBEG_A = 0 ! with indices
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CHGSEND_A = 0 ! NSV_CHGSBEG_
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CHAC_A = 0 ! number of aqueous chemical species
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CHACBEG_A = 0 ! with indices
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CHACEND_A = 0 ! NSV_CHACBEG
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CHIC_A = 0 ! number of ice phase chemical species
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CHICBEG_A = 0 ! with indices
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CHICEND_A = 0 ! NSV_CHICBEG
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LG_A = 0 ! number of LaGrangian
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LGBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LGEND_A = 0 ! NSV_LGBEG_A...NSV_LGEND_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LNOX_A = 0 ! number of lightning NOx
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LNOXBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LNOXEND_A = 0 ! NSV_LNOXBEG_A...NSV_LNOXEND_A !
+INTEGER,DIMENSION(JPMODELMAX)::NSV_DST_A = 0 ! number of dust scalar
+INTEGER,DIMENSION(JPMODELMAX)::NSV_DSTBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_DSTEND_A = 0 ! NSV_DSTBEG_A...NSV_DSTEND_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_SLT_A = 0 ! number of sea salt scalar
+INTEGER,DIMENSION(JPMODELMAX)::NSV_SLTBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_SLTEND_A = 0 ! NSV_SLTBEG_A...NSV_SLTEND_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_AER_A = 0 ! number of aerosol scalar
+INTEGER,DIMENSION(JPMODELMAX)::NSV_AERBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_AEREND_A = 0 ! NSV_AERBEG_A...NSV_AEREND_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_DSTDEP_A = 0 ! number of aerosol scalar
+INTEGER,DIMENSION(JPMODELMAX)::NSV_DSTDEPBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_DSTDEPEND_A = 0 ! NSV_AERBEG_A...NSV_AEREND_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_AERDEP_A = 0 ! number of aerosol scalar
+INTEGER,DIMENSION(JPMODELMAX)::NSV_AERDEPBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_AERDEPEND_A = 0 ! NSV_AERBEG_A...NSV_AEREND_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_SLTDEP_A = 0 ! number of aerosol scalar
+INTEGER,DIMENSION(JPMODELMAX)::NSV_SLTDEPBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_SLTDEPEND_A = 0 ! NSV_SLTBEG_A...NSV_SLTEND_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_PP_A = 0 ! number of passive pol.
+INTEGER,DIMENSION(JPMODELMAX)::NSV_PPBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_PPEND_A = 0 ! NSV_PPBEG_A...NSV_PPEND_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CS_A = 0 ! number of condit.samplings
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CSBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CSEND_A = 0 ! NSV_CSBEG_A...NSV_CSEND_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_A = 0 ! number of scalar in LIMA
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_BEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_END_A = 0 ! NSV_LIMA_BEG_A...NSV_LIMA_END_A
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_NC_A = 0 ! First Nc variable
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_NR_A = 0 ! First Nr variable
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_CCN_FREE_A = 0 ! First Free CCN conc.
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_CCN_ACTI_A = 0 ! First Acti. CNN conc.
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_SCAVMASS_A = 0 ! Scavenged mass variable
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_NI_A = 0 ! First Ni var.
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_IFN_FREE_A = 0 ! First Free IFN conc.
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_IFN_NUCL_A = 0 ! First Nucl. IFN conc.
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_IMM_NUCL_A = 0 ! First Nucl. IMM conc.
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_HOM_HAZE_A = 0 ! Hom. freezing of CCN
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_SPRO_A = 0 ! Supersaturation
+!
+#ifdef MNH_FOREFIRE
+INTEGER,DIMENSION(JPMODELMAX)::NSV_FF_A = 0 ! number of ForeFire scalar variables
+INTEGER,DIMENSION(JPMODELMAX)::NSV_FFBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_FFEND_A = 0 ! NSV_FFBEG_A...NSV_FFEND_A
+#endif
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_SNW_A = 0 ! number of blowing snow scalar
+INTEGER,DIMENSION(JPMODELMAX)::NSV_SNWBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_SNWEND_A = 0 ! NSV_SNWBEG_A...NSV_SNWEND_A
+!
+!###############################################################################
+!
+! variables updated for the current model
+!
+CHARACTER(LEN=JPSVNAMELGTMAX), DIMENSION(:), POINTER :: CSVNAMES !Names of all the scalar variables
+CHARACTER(LEN=6), DIMENSION(:), ALLOCATABLE :: CSV ! name of the scalar variables
+INTEGER :: NSV = 0 ! total number of user scalar variables
+!
+INTEGER :: NSV_USER = 0 ! number of user scalar variables with indices
+ ! in the range : 1...NSV_USER
+INTEGER :: NSV_C2R2 = 0 ! number of liq scalar used in C2R2 and in C3R5
+INTEGER :: NSV_C2R2BEG = 0 ! with indices in the range :
+INTEGER :: NSV_C2R2END = 0 ! NSV_C2R2BEG...NSV_C2R2END
+!
+INTEGER :: NSV_C1R3 = 0 ! number of ice scalar used in C3R5
+INTEGER :: NSV_C1R3BEG = 0 ! with indices in the range :
+INTEGER :: NSV_C1R3END = 0 ! NSV_C1R3BEG...NSV_C1R3END
+!
+INTEGER :: NSV_ELEC = 0 ! number of scalar variables used in ELEC
+INTEGER :: NSV_ELECBEG = 0 ! with indices in the range :
+INTEGER :: NSV_ELECEND = 0 ! NSV_ELECBEG...NSV_ELECEND
+!
+INTEGER :: NSV_CHEM = 0 ! number of chemical scalar variables
+INTEGER :: NSV_CHEMBEG = 0 ! with indices in the range :
+INTEGER :: NSV_CHEMEND = 0 ! NSV_CHEMBEG...NSV_CHEMEND
+!
+INTEGER :: NSV_CHGS = 0 ! number of gas-phase chemicals
+INTEGER :: NSV_CHGSBEG = 0 ! with indices in the range :
+INTEGER :: NSV_CHGSEND = 0 ! NSV_CHGSBEG...NSV_CHGSEND
+!
+INTEGER :: NSV_CHAC = 0 ! number of aqueous-phase chemicals
+INTEGER :: NSV_CHACBEG = 0 ! with indices in the range :
+INTEGER :: NSV_CHACEND = 0 ! NSV_CHACBEG...NSV_CHACEND
+!
+INTEGER :: NSV_CHIC = 0 ! number of ice-phase chemicals
+INTEGER :: NSV_CHICBEG = 0 ! with indices in the range :
+INTEGER :: NSV_CHICEND = 0 ! NSV_CHICBEG...NSV_CHICEND
+!
+INTEGER :: NSV_LG = 0 ! number of lagrangian
+INTEGER :: NSV_LGBEG = 0 ! with indices in the range :
+INTEGER :: NSV_LGEND = 0 ! NSV_LGBEG...NSV_LGEND
+!
+INTEGER :: NSV_LNOX = 0 ! number of lightning NOx variables
+INTEGER :: NSV_LNOXBEG = 0 ! with indices in the range :
+INTEGER :: NSV_LNOXEND = 0 ! NSV_LNOXBEG...NSV_LNOXEND
+!
+INTEGER :: NSV_DST = 0 ! number of dust scalar variables
+INTEGER :: NSV_DSTBEG = 0 ! with indices in the range :
+INTEGER :: NSV_DSTEND = 0 ! NSV_DSTBEG...NSV_DSTEND
+
+INTEGER :: NSV_SLT = 0 ! number of sea salt scalar variables
+INTEGER :: NSV_SLTBEG = 0 ! with indices in the range :
+INTEGER :: NSV_SLTEND = 0 ! NSV_SLTBEG...NSV_SLTEND
+
+INTEGER :: NSV_AER = 0 ! number of aerosol scalar variables
+INTEGER :: NSV_AERBEG = 0 ! with indices in the range :
+INTEGER :: NSV_AEREND = 0 ! NSV_AERBEG...NSV_AEREND
+
+INTEGER :: NSV_DSTDEP = 0 ! number of aerosol scalar variables
+INTEGER :: NSV_DSTDEPBEG = 0 ! with indices in the range :
+INTEGER :: NSV_DSTDEPEND = 0 ! NSV_AERBEG...NSV_AEREND
+!
+INTEGER :: NSV_AERDEP = 0 ! number of aerosol scalar variables
+INTEGER :: NSV_AERDEPBEG = 0 ! with indices in the range :
+INTEGER :: NSV_AERDEPEND = 0 ! NSV_AERBEG...NSV_AEREND
+
+INTEGER :: NSV_SLTDEP = 0 ! number of aerosol scalar variables
+INTEGER :: NSV_SLTDEPBEG = 0 ! with indices in the range :
+INTEGER :: NSV_SLTDEPEND = 0 ! NSV_AERBEG...NSV_AEREND
+!
+INTEGER :: NSV_PP = 0 ! number of passive pollutants
+INTEGER :: NSV_PPBEG = 0 ! with indices in the range :
+INTEGER :: NSV_PPEND = 0 ! NSV_PPBEG...NSV_PPEND
+!
+INTEGER :: NSV_CS = 0 ! number of condit.samplings
+INTEGER :: NSV_CSBEG = 0 ! with indices in the range :
+INTEGER :: NSV_CSEND = 0 ! NSV_CSBEG...NSV_CSEND
+!
+INTEGER :: NSV_LIMA ! number of scalar in LIMA
+INTEGER :: NSV_LIMA_BEG ! with indices in the range :
+INTEGER :: NSV_LIMA_END ! NSV_LIMA_BEG_A...NSV_LIMA_END_A
+INTEGER :: NSV_LIMA_NC !
+INTEGER :: NSV_LIMA_NR !
+INTEGER :: NSV_LIMA_CCN_FREE !
+INTEGER :: NSV_LIMA_CCN_ACTI !
+INTEGER :: NSV_LIMA_SCAVMASS !
+INTEGER :: NSV_LIMA_NI !
+INTEGER :: NSV_LIMA_IFN_FREE !
+INTEGER :: NSV_LIMA_IFN_NUCL !
+INTEGER :: NSV_LIMA_IMM_NUCL !
+INTEGER :: NSV_LIMA_HOM_HAZE !
+INTEGER :: NSV_LIMA_SPRO !
+!
+#ifdef MNH_FOREFIRE
+INTEGER :: NSV_FF = 0 ! number of ForeFire scalar variables
+INTEGER :: NSV_FFBEG = 0 ! with indices in the range :
+INTEGER :: NSV_FFEND = 0 ! NSV_FFBEG...NSV_FFEND
+#endif
+!
+INTEGER :: NSV_SNW = 0 ! number of blowing snow scalar variables
+INTEGER :: NSV_SNWBEG = 0 ! with indices in the range :
+INTEGER :: NSV_SNWEND = 0 ! NSV_SNWBEG...NSV_SNWEND
+
+END MODULE MODD_NSV
diff --git a/src/mesonh/micro/modd_param_c1r3.f90 b/src/mesonh/micro/modd_param_c1r3.f90
new file mode 100644
index 000000000..700526c7a
--- /dev/null
+++ b/src/mesonh/micro/modd_param_c1r3.f90
@@ -0,0 +1,65 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 modd 2006/05/18 13:07:25
+!-----------------------------------------------------------------
+! ######################
+ MODULE MODD_PARAM_C1R3
+! ######################
+!
+!!**** *MODD_PARAM_C1R3* - declaration of the control parameters
+!! for use in the cold scheme.
+!!
+!! PURPOSE
+!! -------
+! The purpose of this declarative module is to declare the microphysical
+! constants. This includes the descriptive parameters for the raindrop
+! and the parameters relevant of the dimensional distributions.
+!
+!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (MODD_PARAM_C1R3)
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty *Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 04/04/2001
+!! Jean-Pierre PINTY 29/ 6/01 Add RHHONI process (freezing haze part.)
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+REAL,SAVE :: XALPHAI,XNUI, & ! Pristine ice distribution parameters
+ XALPHAS,XNUS, & ! Snow/aggregate distribution parameters
+ XALPHAG,XNUG ! Graupel distribution parameters
+REAL,SAVE :: XFACTNUC_DEP,XFACTNUC_CON ! Amplification factor for IN conc.
+ ! DEP refers to DEPosition mode
+ ! CON refers to CONtact mode
+!
+LOGICAL, SAVE :: LSEDI ! TRUE to enable the pristine ice
+ ! sedimentation
+LOGICAL, SAVE :: LHHONI ! TRUE to enable the freezing of haze
+ ! particules
+!
+CHARACTER(LEN=4), SAVE :: CPRISTINE_ICE_C1R3 ! Pristine type PLAT, COLU or BURO
+CHARACTER(LEN=4), SAVE :: CHEVRIMED_ICE_C1R3 ! Heavily rimed type GRAU or HAIL
+!
+END MODULE MODD_PARAM_C1R3
+!
+!
diff --git a/src/mesonh/micro/modd_param_c2r2.f90 b/src/mesonh/micro/modd_param_c2r2.f90
new file mode 100644
index 000000000..83d7f5d1c
--- /dev/null
+++ b/src/mesonh/micro/modd_param_c2r2.f90
@@ -0,0 +1,80 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source: /home/cvsroot/MNH-VX-Y-Z/src/MNH/modd_param_c2r2.f90,v $ $Revision: 1.1.8.1.2.1.16.1.2.1 $
+! MASDEV4_7 modd 2006/10/16 14:23:23
+!-----------------------------------------------------------------
+! ######################
+ MODULE MODD_PARAM_C2R2
+! ######################
+!
+!!**** *MODD_PARAM_C2R2* - declaration of the control parameters
+!! for use in the warm scheme.
+!!
+!! PURPOSE
+!! -------
+! The purpose of this declarative module is to declare the microphysical
+! constants. This includes the descriptive parameters for the raindrop
+! and the parameters relevant of the dimensional distributions.
+!
+! The four constants used to set the actiavtion spectrum are also
+! defined
+!
+! N_activated = (C*S**k)*F_hypgeo(mu,k/2,k/2+1;-beta*S**2)
+! DN_activated/DS = k*(C*S**(k-1))*(1+beta*S**2)**-mu
+!
+!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (MODD_PARAM_C2R2)
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty *Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 04/11/2000
+!! 10/2016 (C.Lac) Add droplet deposition
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+REAL,SAVE :: XALPHAR,XNUR, & ! Raindrop distribution parameters
+ XALPHAC,XNUC ! Cloud droplet distribution parameters
+!
+LOGICAL, SAVE :: LRAIN ! TRUE to enable the formation of rain
+LOGICAL, SAVE :: LSEDC ! TRUE to enable the droplet sedimentation
+LOGICAL, SAVE :: LACTIT ! TRUE to enable the usage of
+ ! dT/dt in CCN activation (twomey and CPB98)
+LOGICAL, SAVE :: LSUPSAT ! TRUE for prognostic supersaturation
+LOGICAL, SAVE :: LDEPOC ! TRUE to enable cloud droplet deposition
+LOGICAL, SAVE :: LACTTKE ! TRUE to take into account TKE in W for activation
+!
+REAL,SAVE :: XCHEN,XKHEN, & ! Parameters used to define the CCN
+ XMUHEN,XBETAHEN ! activation spectra (CPB or TWO)
+REAL,SAVE :: XVDEPOC ! Droplet deposition velocity
+!
+CHARACTER(LEN=3),SAVE :: HPARAM_CCN ! Parameterization used for the CCN activation
+CHARACTER(LEN=3),SAVE :: HINI_CCN ! Initialization type of the CCN activation
+CHARACTER(LEN=1),SAVE :: HTYPE_CCN ! 'M' or 'C' standard type of CCN
+REAL,SAVE :: XCONC_CCN, & ! Concentration of the CCN
+ XR_MEAN_CCN, & ! Geometric mean radius of the CCN
+ XLOGSIG_CCN, & ! Log of geometric dispersion of the CCN
+ XFSOLUB_CCN, & ! Fractionnal solubility of the CCN
+ XACTEMP_CCN, & ! Expected temperature of CCN activation
+ XAERDIFF, XAERHEIGHT ! For the vertical gradient of
+ ! aerosol distribution
+END MODULE MODD_PARAM_C2R2
+!
+!
diff --git a/src/mesonh/micro/modd_param_ice.f90 b/src/mesonh/micro/modd_param_ice.f90
new file mode 100644
index 000000000..ddafd7516
--- /dev/null
+++ b/src/mesonh/micro/modd_param_ice.f90
@@ -0,0 +1,83 @@
+!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ######spl
+ MODULE MODD_PARAM_ICE
+! #####################
+!
+!!**** *MODD_PARAM_ICE* - declaration of the control parameters for the
+!! mixed phase cloud parameterization
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this declarative module is to define the set of space
+!! and time control parameters for the microphysics.
+!!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (module MODD_PARAM_ICE)
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty *Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 14/12/95
+!! Jan 2015 S. Riette: new ICE3/ICE4 parameters
+!! 01/10/16 (C.Lac) Add droplet deposition for fog
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+LOGICAL, SAVE :: LWARM ! When .TRUE. activates the formation of rain by
+ ! the warm microphysical processes
+LOGICAL, SAVE :: LSEDIC ! TRUE to enable the droplet sedimentation
+LOGICAL, SAVE :: LDEPOSC ! TRUE to enable cloud droplet deposition
+REAL, SAVE :: XVDEPOSC ! Droplet deposition velocity
+!
+CHARACTER(LEN=4), SAVE :: CPRISTINE_ICE ! Pristine ice type PLAT, COLU or BURO
+CHARACTER(LEN=4), SAVE :: CSEDIM ! Sedimentation calculation mode
+!
+LOGICAL, SAVE :: LRED ! To use modified ICE3/ICE4 to reduce time step dependency
+LOGICAL, SAVE :: LFEEDBACKT ! When .TRUE. feed back on temperature is taken into account
+LOGICAL, SAVE :: LEVLIMIT ! When .TRUE. water vapour pressure is limited by saturation
+LOGICAL, SAVE :: LNULLWETG ! When .TRUE. graupel wet growth is activated with null rate (to allow water shedding)
+LOGICAL, SAVE :: LWETGPOST ! When .TRUE. graupel wet growth is activated with positive temperature (to allow water shedding)
+LOGICAL, SAVE :: LNULLWETH ! Same as LNULLWETG but for hail
+LOGICAL, SAVE :: LWETHPOST ! Same as LWETGPOST but for hail
+CHARACTER(LEN=4), SAVE :: CSNOWRIMING ! OLD or M90 for Murakami 1990 formulation
+REAL, SAVE :: XFRACM90 ! Fraction used for the Murakami 1990 formulation
+INTEGER, SAVE :: NMAXITER ! Maximum number of iterations for mixing ratio or time splitting
+REAL, SAVE :: XMRSTEP ! maximum mixing ratio step for mixing ratio splitting
+LOGICAL, SAVE :: LCONVHG ! TRUE to allow the conversion from hail to graupel
+LOGICAL, SAVE :: LCRFLIMIT !True to limit rain contact freezing to possible heat exchange
+!
+REAL, SAVE :: XTSTEP_TS ! Approximative time step for time-splitting (0 for no time-splitting)
+!
+CHARACTER(len=80), SAVE :: CSUBG_RC_RR_ACCR ! subgrid rc-rr accretion
+CHARACTER(len=80), SAVE :: CSUBG_RR_EVAP ! subgrid rr evaporation
+CHARACTER(len=80), SAVE :: CSUBG_PR_PDF ! pdf for subgrid precipitation
+!
+LOGICAL, SAVE :: LADJ_BEFORE ! must we perform an adjustment before rain_ice call
+LOGICAL, SAVE :: LADJ_AFTER ! must we perform an adjustment after rain_ice call
+CHARACTER(len=1), SAVE :: CFRAC_ICE_ADJUST ! ice fraction for adjustments
+CHARACTER(len=1), SAVE :: CFRAC_ICE_SHALLOW_MF ! ice fraction for shallow_mf
+LOGICAL, SAVE :: LSEDIM_AFTER ! sedimentation done before (.FALSE.) or after (.TRUE.) microphysics
+!
+REAL, SAVE :: XSPLIT_MAXCFL ! Maximum CFL number allowed for SPLIT scheme
+!
+!-------------------------------------------------------------------------------
+!
+END MODULE MODD_PARAM_ICE
diff --git a/src/mesonh/micro/modd_param_lima.f90 b/src/mesonh/micro/modd_param_lima.f90
new file mode 100644
index 000000000..66156a056
--- /dev/null
+++ b/src/mesonh/micro/modd_param_lima.f90
@@ -0,0 +1,216 @@
+!MNH_LIC Copyright 2013-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-------------------------------------------------------------------------------
+! ######################
+ MODULE MODD_PARAM_LIMA
+! ######################
+!
+!!**** *MODD_PARAM_LIMA* - declaration of the control parameters
+!! for use in the LIMA scheme.
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this declarative module is to declare the microphysical
+!! constants. This includes the descriptive parameters for the raindrop
+!! and the parameters relevant of the dimensional distributions.
+!!
+!!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty *Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!!
+!-------------------------------------------------------------------------------
+!
+USE MODD_PARAMETERS, ONLY : JPLIMACCNMAX, JPLIMAIFNMAX
+!
+IMPLICIT NONE
+!
+LOGICAL, SAVE :: LLIMA_DIAG ! Compute diagnostics for concentration /m3
+!
+LOGICAL, SAVE :: LPTSPLIT ! activate time-splitting technique by S. Riette
+LOGICAL, SAVE :: LFEEDBACKT ! recompute tendencies if T changes sign
+INTEGER, SAVE :: NMAXITER ! maximum number of iterations
+REAL, SAVE :: XMRSTEP ! maximum change in mixing ratio allowed before recomputing tedencies
+REAL, SAVE :: XTSTEP_TS ! maximum time for the sub-time-step
+!
+!* 1. COLD SCHEME
+! -----------
+!
+! 1.1 Cold scheme configuration
+!
+LOGICAL, SAVE :: LCOLD ! TRUE to enable the cold scheme
+LOGICAL, SAVE :: LNUCL ! TRUE to enable ice nucleation
+LOGICAL, SAVE :: LSEDI ! TRUE to enable pristine ice sedimentation
+LOGICAL, SAVE :: LHHONI ! TRUE to enable freezing of haze particules
+LOGICAL, SAVE :: LSNOW ! TRUE to enable snow and graupel
+LOGICAL, SAVE :: LHAIL ! TRUE to enable hail
+LOGICAL, SAVE :: LMEYERS ! TRUE to use Meyers nucleation
+!
+! 1.2 IFN initialisation
+!
+INTEGER, SAVE :: NMOD_IFN ! Number of IFN modes
+REAL, DIMENSION(JPLIMAIFNMAX), SAVE :: XIFN_CONC ! Ref. concentration of IFN(#/L)
+LOGICAL, SAVE :: LIFN_HOM ! True for z-homogeneous IFN concentrations
+CHARACTER(LEN=8), SAVE :: CIFN_SPECIES ! Internal mixing species definitions
+CHARACTER(LEN=8), SAVE :: CINT_MIXING ! Internal mixing type selection (pure DM1 ...)
+INTEGER, SAVE :: NMOD_IMM ! Number of CCN modes acting by immersion
+INTEGER, SAVE :: NIND_SPECIE ! CCN acting by immersion are considered pure
+ ! IFN of either DM = 1, BC = 2 or O = 3
+INTEGER, DIMENSION(:), SAVE, ALLOCATABLE :: NIMM ! Link between CCN and IMM modes
+INTEGER, DIMENSION(:), SAVE, ALLOCATABLE :: NINDICE_CCN_IMM ! ??????????
+INTEGER, SAVE :: NSPECIE ! Internal mixing number of species
+REAL, DIMENSION(:), SAVE, ALLOCATABLE :: XMDIAM_IFN ! Mean diameter of IFN modes
+REAL, DIMENSION(:), SAVE, ALLOCATABLE :: XSIGMA_IFN ! Sigma of IFN modes
+REAL, DIMENSION(:), SAVE, ALLOCATABLE :: XRHO_IFN ! Density of IFN modes
+REAL, DIMENSION(:,:), SAVE, ALLOCATABLE :: XFRAC ! Composition of each IFN mode
+REAL, DIMENSION(:), SAVE, ALLOCATABLE :: XFRAC_REF ! AP compostion in Phillips 08
+!
+! 1.3 Ice characteristics
+!
+CHARACTER(LEN=4), SAVE :: CPRISTINE_ICE_LIMA ! Pristine type PLAT, COLU or BURO
+CHARACTER(LEN=4), SAVE :: CHEVRIMED_ICE_LIMA ! Heavily rimed type GRAU or HAIL
+REAL,SAVE :: XALPHAI,XNUI, & ! Pristine ice distribution parameters
+ XALPHAS,XNUS, & ! Snow/aggregate distribution parameters
+ XALPHAG,XNUG ! Graupel distribution parameters
+!
+! 1.4 Phillips (2013) nucleation parameterization
+!
+INTEGER, SAVE :: NPHILLIPS ! =8 for Phillips08, =13 for Phillips13
+!
+REAL, DIMENSION(4), SAVE :: XT0 ! Threshold of T in H_X for X={DM1,DM2,BC,O} [K]
+REAL, DIMENSION(4), SAVE :: XDT0 ! Range in T for transition of H_X near XT0 [K]
+REAL, DIMENSION(4), SAVE :: XDSI0 ! Range in Si for transition of H_X near XSI0
+REAL, SAVE :: XSW0 ! Threshold of Sw in H_X
+REAL, SAVE :: XRHO_CFDC ! Air density at which CFDC data were reported [kg m**3]
+REAL, DIMENSION(4), SAVE :: XH ! Fraction<<1 of aerosol for X={DM,BC,O}
+REAL, DIMENSION(4), SAVE :: XAREA1 ! Total surface of all aerosols in group X with
+ ! diameters between 0.1 and 1 µm, for X={DM1,DM2,BC,O} [m**2 kg**-1]
+REAL, SAVE :: XGAMMA ! Factor boosting IN concentration due to
+ ! bulk-liquid modes
+!
+REAL, DIMENSION(4), SAVE :: XTX1 ! Threshold of T in Xi for X={DM1,DM2,BC,O} [K]
+REAL, DIMENSION(4), SAVE :: XTX2 ! Threshold of T in Xi for X={DM1,DM2,BC,O} [K]
+!
+REAL,DIMENSION(:), SAVE, ALLOCATABLE :: XABSCISS, XWEIGHT ! Gauss quadrature method
+INTEGER, SAVE :: NDIAM ! Gauss quadrature accuracy
+!
+! 1.5 Meyers (1992) nucleation parameterization
+!
+REAL,SAVE :: XFACTNUC_DEP,XFACTNUC_CON ! Amplification factor for IN conc.
+ ! DEP refers to DEPosition mode
+ ! CON refers to CONtact mode
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 2. WARM SCHEME
+! -----------
+!
+! 2.1 Warm scheme configuration
+!
+LOGICAL, SAVE :: LWARM ! TRUE to enable the warm scheme
+LOGICAL, SAVE :: LACTI ! TRUE to enable CCN activation
+LOGICAL, SAVE :: LRAIN ! TRUE to enable the formation of rain
+LOGICAL, SAVE :: LSEDC ! TRUE to enable the droplet sedimentation
+LOGICAL, SAVE :: LACTIT ! TRUE to enable the usage of dT/dt in CCN activation
+LOGICAL, SAVE :: LBOUND ! TRUE to enable the continuously replenishing
+ ! aerosol concentrations through the open
+ ! lateral boundaries -> boundaries.f90
+LOGICAL, SAVE :: LDEPOC ! Deposition of rc at 1st level above ground
+LOGICAL, SAVE :: LACTTKE ! TRUE to take into account TKE in W for activation
+LOGICAL, SAVE :: LADJ ! TRUE for adjustment procedure + Smax (false for diagnostic supersaturation)
+LOGICAL, SAVE :: LSPRO ! TRUE for prognostic supersaturation
+!
+! 2.2 CCN initialisation
+!
+INTEGER, SAVE :: NMOD_CCN ! Number of CCN modes
+REAL, DIMENSION(JPLIMACCNMAX), SAVE :: XCCN_CONC ! CCN conc. (#/cm3)
+LOGICAL, SAVE :: LCCN_HOM ! True for z-homogeneous CCN concentrations
+CHARACTER(LEN=8),SAVE :: CCCN_MODES ! CCN modes characteristics (Jungfraujoch ...)
+REAL, DIMENSION(:), SAVE, ALLOCATABLE :: XR_MEAN_CCN, & ! Mean radius of CCN modes
+ XLOGSIG_CCN, & ! Log of geometric dispersion of the CCN modes
+ XRHO_CCN ! Density of the CCN modes
+REAL, DIMENSION(:), SAVE, ALLOCATABLE :: XKHEN_MULTI, & ! Parameters defining the CCN activation
+ XMUHEN_MULTI, & ! spectra for a multimodal aerosol distribution
+ XBETAHEN_MULTI !
+REAL, DIMENSION(:,:,:) ,SAVE, ALLOCATABLE :: XCONC_CCN_TOT ! Total aerosol number concentration
+REAL, DIMENSION(:), SAVE, ALLOCATABLE :: XLIMIT_FACTOR ! compute CHEN ????????????
+!
+! 2.3 Water particles characteristics
+!
+REAL,SAVE :: XALPHAR,XNUR, & ! Raindrop distribution parameters
+ XALPHAC,XNUC ! Cloud droplet distribution parameters
+!
+! 2.4 CCN activation
+!
+CHARACTER(LEN=3),SAVE :: HPARAM_CCN = 'CPB' ! Parameterization of the CCN activation
+CHARACTER(LEN=3),SAVE :: HINI_CCN ! Initialization type of CCN activation
+CHARACTER(LEN=10),DIMENSION(JPLIMACCNMAX),SAVE :: HTYPE_CCN ! 'M' or 'C' CCN type
+REAL,SAVE :: XFSOLUB_CCN, & ! Fractionnal solubility of the CCN
+ XACTEMP_CCN, & ! Expected temperature of CCN activation
+ XAERDIFF, XAERHEIGHT ! For the vertical gradient of aerosol distribution
+!
+! Cloud droplet deposition
+!
+REAL, SAVE :: XVDEPOC
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 3. BELOW CLOUD SCAVENGING
+! ----------------------
+!
+LOGICAL, SAVE :: LSCAV ! TRUE for aerosol scavenging by precipitations
+LOGICAL, SAVE :: LAERO_MASS ! TRUE to compute the total aerosol mass scavenging rate
+!
+INTEGER :: NDIAMR = 20 ! Max Number of droplet for quadrature method
+INTEGER :: NDIAMP = 20 ! Max Number of aerosol particle for quadrature method
+!
+REAL, SAVE :: XT0SCAV = 293.15 ! [K]
+REAL, SAVE :: XTREF = 273.15 ! [K]
+REAL, SAVE :: XNDO = 8.*1.0E6 ! [/m**4]
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 4. ATMOSPHERIC & OTHER PARAMETERS
+! ------------------------------
+!
+REAL, SAVE :: XMUA0 = 1.711E-05 ![Pa.s] Air Viscosity at T=273.15K
+REAL, SAVE :: XT_SUTH_A = 110.4 ![K] Sutherland Temperature for Air
+REAL, SAVE :: XMFPA0 = 6.6E-08 ![m] Mean Free Path of Air under standard conditions
+!
+REAL, SAVE :: XVISCW = 1.0E-3 ![Pa.s] water viscosity at 20°C
+! Correction
+!REAL, SAVE :: XRHO00 = 1.292 !rho on the floor [Kg/m**3]
+REAL, SAVE :: XRHO00 = 1.2041 !rho at P=1013.25 and T=20°C
+!
+REAL,SAVE :: XCEXVT ! air density fall speed correction
+!
+REAL,DIMENSION(:),SAVE,ALLOCATABLE :: XRTMIN ! Min values of the mixing ratios
+REAL,DIMENSION(:),SAVE,ALLOCATABLE :: XCTMIN ! Min values of the drop concentrations
+!
+!
+! Sedimentation variables
+!
+INTEGER,DIMENSION(7),SAVE :: NSPLITSED
+REAL,DIMENSION(7),SAVE :: XLB
+REAL,DIMENSION(7),SAVE :: XLBEX
+REAL,DIMENSION(7),SAVE :: XD
+REAL,DIMENSION(7),SAVE :: XFSEDR
+REAL,DIMENSION(7),SAVE :: XFSEDC
+!
+END MODULE MODD_PARAM_LIMA
diff --git a/src/mesonh/micro/modd_param_lima_cold.f90 b/src/mesonh/micro/modd_param_lima_cold.f90
new file mode 100644
index 000000000..64494219e
--- /dev/null
+++ b/src/mesonh/micro/modd_param_lima_cold.f90
@@ -0,0 +1,128 @@
+!MNH_LIC Copyright 2013-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ###########################
+ MODULE MODD_PARAM_LIMA_COLD
+! ###########################
+!
+!!**** *MODD_PARAM_LIMA_COLD* - declaration of some descriptive parameters and
+!! microphysical factors extensively used in
+!! the LIMA cold scheme.
+!! AUTHOR
+!! ------
+!! J.-P. Pinty *Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!!
+!-------------------------------------------------------------------------------
+USE MODD_PARAMETERS, ONLY: JPSVNAMELGTMAX
+!
+IMPLICIT NONE
+!
+!* 1. DESCRIPTIVE PARAMETERS
+! ----------------------
+!
+! Declaration of microphysical constants, including the descriptive
+! parameters for the raindrop and the ice crystal habits, and the
+! parameters relevant of the dimensional distributions.
+!
+! m(D) = XAx * D**XBx : Mass-MaxDim relationship
+! v(D) = XCx * D**XDx : Fallspeed-MaxDim relationship
+! N(Lbda) = XCCx * Lbda**XCXx : NumberConc-Slopeparam relationship
+! XF0x, XF1x, XF2x : Ventilation factors
+! XC1x : Shape parameter for deposition
+!
+! and
+!
+! XALPHAx, XNUx : Generalized GAMMA law
+! Lbda = XLBx * (r_x*rho_dref)**XLBEXx : Slope parameter of the
+! distribution law
+!
+REAL,SAVE :: XLBEXI,XLBI ! Prist. ice distribution parameters
+REAL,SAVE :: XLBEXS,XLBS ! Snow/agg. distribution parameters
+!
+REAL,SAVE :: XAI,XBI,XC_I,XDI ,XF0I,XF2I,XC1I ! Cloud ice charact.
+REAL,SAVE :: XF0IS,XF1IS ! (large Di vent. coef.)
+REAL,SAVE :: XAS,XBS,XCS,XDS,XCCS,XCXS,XF0S,XF1S,XC1S ! Snow/agg. charact.
+!
+REAL,SAVE :: XLBDAS_MAX ! Max values allowed for the shape
+ ! parameter of snow
+!
+CHARACTER(LEN=JPSVNAMELGTMAX),DIMENSION(5),PARAMETER &
+ :: CLIMA_COLD_NAMES=(/'CICE ','CIFNFREE','CIFNNUCL', &
+ 'CCNINIMM','CCCNNUCL'/)
+ ! basenames of the SV articles stored
+ ! in the binary files
+ !with IF:Ice-nuclei Free (nonactivated IFN by Dep/Cond)
+ ! IN:Ice-nuclei Nucleated (activated IFN by Dep/Cond)
+ ! NI:Nuclei Immersed (activated IFN by Imm)
+ ! HF:Homogeneous Freezing
+CHARACTER(LEN=JPSVNAMELGTMAX),DIMENSION(5),PARAMETER &
+ :: CLIMA_COLD_CONC=(/'NI ','NIF','NIN','NNI','NNH'/)!for DIAG
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. MICROPHYSICAL FACTORS
+! ---------------------
+!
+REAL,SAVE :: XFSEDRI,XFSEDCI, & ! Constants for sedimentation
+ XFSEDS, XEXSEDS ! fluxes of ice and snow
+!
+REAL,SAVE :: XNUC_DEP,XEXSI_DEP,XEX_DEP, & ! Constants for heterogeneous
+ XNUC_CON,XEXTT_CON,XEX_CON, & ! ice nucleation : DEP et CON
+ XMNU0 ! mass of nucleated ice crystal
+!
+REAL,SAVE :: XRHOI_HONH,XCEXP_DIFVAP_HONH, & ! Constants for homogeneous
+ XCOEF_DIFVAP_HONH,XRCOEF_HONH, & ! haze freezing : HHONI
+ XCRITSAT1_HONH,XCRITSAT2_HONH, &
+ XTMIN_HONH,XTMAX_HONH, &
+ XDLNJODT1_HONH,XDLNJODT2_HONH, &
+ XC1_HONH,XC2_HONH,XC3_HONH
+!
+REAL,SAVE :: XC_HONC,XR_HONC, & ! Constants for homogeneous
+ XTEXP1_HONC,XTEXP2_HONC, & ! droplet freezing : CHONI
+ XTEXP3_HONC,XTEXP4_HONC, &
+ XTEXP5_HONC
+!
+REAL,SAVE :: XCSCNVI_MAX, XLBDASCNVI_MAX, &
+ XRHORSMIN, &
+ XDSCNVI_LIM, XLBDASCNVI_LIM, & ! Constants for snow
+ XC0DEPSI,XC1DEPSI, & ! sublimation conversion to
+ XR0DEPSI,XR1DEPSI ! pristine ice : SCNVI
+!
+REAL,SAVE :: XSCFAC, & ! Constants for the Bergeron
+ X0DEPI,X2DEPI, & ! Findeisen process and
+ X0DEPS,X1DEPS,XEX0DEPS,XEX1DEPS ! deposition
+!
+REAL,SAVE :: XDICNVS_LIM, XLBDAICNVS_LIM, & ! Constants for pristine ice
+ XC0DEPIS,XC1DEPIS, & ! deposition conversion to
+ XR0DEPIS,XR1DEPIS ! snow : ICNVS
+!
+REAL,SAVE :: XCOLEXIS, & ! Constants for snow
+ XAGGS_CLARGE1,XAGGS_CLARGE2, & ! aggregation : AGG
+ XAGGS_RLARGE1,XAGGS_RLARGE2
+!
+!??????????????????
+REAL,SAVE :: XKER_ZRNIC_A1,XKER_ZRNIC_A2 ! Long-Zrnic Kernels (ini_ice_coma)
+!
+REAL,SAVE :: XSELFI,XCOLEXII ! Constants for pristine ice
+ ! self-collection (ini_ice_coma)
+!
+REAL,SAVE :: XAUTO3, XAUTO4, & ! Constants for pristine ice
+ XLAUTS, XLAUTS_THRESHOLD, & ! autoconversion : AUT
+ XITAUTS, XITAUTS_THRESHOLD, & ! (ini_ice_com)
+ XTEXAUTI
+!
+REAL,SAVE :: XCONCI_MAX ! Limitation of the pristine
+ ! ice concentration (init and grid-nesting)
+REAL,SAVE :: XFREFFI ! Factor to compute the cloud ice effective radius
+!
+!-------------------------------------------------------------------------------
+!
+END MODULE MODD_PARAM_LIMA_COLD
diff --git a/src/mesonh/micro/modd_param_lima_mixed.f90 b/src/mesonh/micro/modd_param_lima_mixed.f90
new file mode 100644
index 000000000..f13accfc6
--- /dev/null
+++ b/src/mesonh/micro/modd_param_lima_mixed.f90
@@ -0,0 +1,169 @@
+! ############################
+ MODULE MODD_PARAM_LIMA_MIXED
+! ###########################{
+!
+!!**** *MODD_PARAM_LIMA_MIXED* - declaration of some descriptive parameters and
+!! microphysical factors extensively used in
+!! the LIMA mixed scheme.
+!! AUTHOR
+!! ------
+!! J.-P. Pinty *Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!!
+!-------------------------------------------------------------------------------
+!
+IMPLICIT NONE
+!
+!* 1. DESCRIPTIVE PARAMETERS
+! ----------------------
+!
+! Declaration of microphysical constants, including the descriptive
+! parameters for the raindrop and the ice crystal habits, and the
+! parameters relevant of the dimensional distributions.
+!
+! m(D) = XAx * D**XBx : Mass-MaxDim relationship
+! v(D) = XCx * D**XDx : Fallspeed-MaxDim relationship
+! N(Lbda) = XCCx * Lbda**XCXx : NumberConc-Slopeparam relationship
+! XF0x, XF1x, XF2x : Ventilation factors
+! XC1x : Shape parameter for deposition
+!
+! and
+!
+! XALPHAx, XNUx : Generalized GAMMA law
+! Lbda = XLBx * (r_x*rho_dref)**XLBEXx : Slope parameter of the
+! distribution law
+!
+REAL,SAVE :: XAG,XBG,XCG,XDG,XCCG,XCXG,XF0G,XF1G,XC1G ! Graupel charact.
+REAL,SAVE :: XLBEXG,XLBG ! Graupel distribution parameters
+REAL,SAVE :: XLBDAG_MAX ! Max values allowed for the shape
+ ! parameter of graupeln
+!
+REAL,SAVE :: XAH,XBH,XCH,XDH,XCCH,XCXH,XF0H,XF1H,XC1H ! Hail charact.
+REAL,SAVE :: XALPHAH,XNUH,XLBEXH,XLBH ! Hail distribution parameters
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. MICROPHYSICAL FACTORS - Graupel
+! -------------------------------
+!
+REAL,SAVE :: XFSEDG, XEXSEDG ! Sedimentation fluxes of Graupel
+!
+REAL,SAVE :: X0DEPG,X1DEPG,XEX0DEPG,XEX1DEPG ! Deposition on graupel
+!
+REAL,SAVE :: XHMTMIN,XHMTMAX,XHM1,XHM2, & ! Constants for the
+ XHM_YIELD,XHM_COLLCS,XHM_FACTS, & ! revised
+ XHM_COLLCG,XHM_FACTG, & ! Hallett-Mossop process
+ XGAMINC_HMC_BOUND_MIN, & ! Min val. of Lbda_c for HMC
+ XGAMINC_HMC_BOUND_MAX, & ! Max val. of Lbda_c for HMC
+ XHMSINTP1,XHMSINTP2, & ! (this is no more used !)
+ XHMLINTP1,XHMLINTP2
+!
+REAL,SAVE :: XDCSLIM,XCOLCS, & ! Constants for the riming of
+ XEXCRIMSS,XCRIMSS, & ! the aggregates : RIM
+ XEXCRIMSG,XCRIMSG, & !
+ XEXSRIMCG,XSRIMCG, & !
+ XGAMINC_BOUND_MIN, & ! Min val. of Lbda_s for RIM
+ XGAMINC_BOUND_MAX, & ! Max val. of Lbda_s for RIM
+ XRIMINTP1,XRIMINTP2 ! Csts for lin. interpol. of
+ ! the tab. incomplete Gamma law
+INTEGER,SAVE :: NGAMINC ! Number of tab. Lbda_s
+REAL, DIMENSION(:), SAVE, ALLOCATABLE &
+ :: XGAMINC_RIM1, & ! Tab. incomplete Gamma funct.
+ XGAMINC_RIM2, & ! for XDS+2 and for XBS
+ XGAMINC_HMC ! and for the HM process
+!
+REAL,SAVE :: XFRACCSS, & ! Constants for the accretion
+ XLBRACCS1,XLBRACCS2,XLBRACCS3, & ! raindrops onto the aggregates
+ XFSACCRG, & ! ACC (processes RACCSS and
+ XLBSACCR1,XLBSACCR2,XLBSACCR3, & ! SACCRG)
+ XACCLBDAS_MIN, & ! Min val. of Lbda_s for ACC
+ XACCLBDAS_MAX, & ! Max val. of Lbda_s for ACC
+ XACCLBDAR_MIN, & ! Min val. of Lbda_r for ACC
+ XACCLBDAR_MAX, & ! Max val. of Lbda_r for ACC
+ XACCINTP1S,XACCINTP2S, & ! Csts for bilin. interpol. of
+ XACCINTP1R,XACCINTP2R ! Lbda_s and Lbda_r in the
+ ! XKER_RACCSS and XKER_SACCRG
+ ! tables
+INTEGER,SAVE :: NACCLBDAS, & ! Number of Lbda_s values and
+ NACCLBDAR ! of Lbda_r values in the
+ ! XKER_RACCSS and XKER_SACCRG
+ ! tables
+REAL,DIMENSION(:,:), SAVE, ALLOCATABLE &
+ :: XKER_RACCSS, & ! Normalized kernel for RACCSS
+ XKER_RACCS, & ! Normalized kernel for RACCS
+ XKER_SACCRG ! Normalized kernel for SACCRG
+REAL,SAVE :: XFSCVMG ! Melting-conversion factor of
+ ! the aggregates
+!
+REAL,SAVE :: XCOLIR, & ! Constants for rain contact
+ XEXRCFRI,XRCFRI, & ! freezing : CFR
+ XEXICFRR,XICFRR !
+!
+REAL,SAVE :: XFCDRYG, & ! Constants for the dry growth
+ XCOLCG, & ! of the graupeln :
+ XCOLIG,XCOLEXIG,XFIDRYG, & !
+ XCOLSG,XCOLEXSG,XFSDRYG, & ! RCDRYG
+ XLBSDRYG1,XLBSDRYG2,XLBSDRYG3, & ! RIDRYG
+ XFRDRYG, & ! RSDRYG
+ XLBRDRYG1,XLBRDRYG2,XLBRDRYG3, & ! RRDRYG
+ XDRYLBDAR_MIN, & ! Min val. of Lbda_r for DRY
+ XDRYLBDAR_MAX, & ! Max val. of Lbda_r for DRY
+ XDRYLBDAS_MIN, & ! Min val. of Lbda_s for DRY
+ XDRYLBDAS_MAX, & ! Max val. of Lbda_s for DRY
+ XDRYLBDAG_MIN, & ! Min val. of Lbda_g for DRY
+ XDRYLBDAG_MAX, & ! Max val. of Lbda_g for DRY
+ XDRYINTP1R,XDRYINTP2R, & ! Csts for bilin. interpol. of
+ XDRYINTP1S,XDRYINTP2S, & ! Lbda_r, Lbda_s and Lbda_g in
+ XDRYINTP1G,XDRYINTP2G ! the XKER_SDRYG and XKER_RDRYG
+ ! tables
+INTEGER,SAVE :: NDRYLBDAR, & ! Number of Lbda_r,
+ NDRYLBDAS, & ! of Lbda_s and
+ NDRYLBDAG ! of Lbda_g values in
+ ! the XKER_SDRYG and XKER_RDRYG
+ ! tables
+REAL,DIMENSION(:,:), SAVE, ALLOCATABLE &
+ :: XKER_SDRYG, & ! Normalized kernel for SDRYG
+ XKER_RDRYG ! Normalized kernel for RDRYG
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. MICROPHYSICAL FACTORS - Hail
+! ----------------------------
+!
+REAL,SAVE :: XFSEDH,XEXSEDH ! Constants for sedimentation
+!
+!
+REAL,SAVE :: X0DEPH,X1DEPH,XEX0DEPH,XEX1DEPH ! Constants for deposition
+!
+REAL,SAVE :: XFWETH,XFSWETH, & ! Constants for the wet growth
+ XLBSWETH1,XLBSWETH2,XLBSWETH3, & ! of the hailstones : WET
+ XFGWETH, & ! processes RSWETH
+ XLBGWETH1,XLBGWETH2,XLBGWETH3, & ! RGWETH
+ XWETLBDAS_MIN, & ! Min val. of Lbda_s for WET
+ XWETLBDAS_MAX, & ! Max val. of Lbda_s for WET
+ XWETLBDAG_MIN, & ! Min val. of Lbda_g for WET
+ XWETLBDAG_MAX, & ! Max val. of Lbda_g for WET
+ XWETLBDAH_MIN, & ! Min val. of Lbda_h for WET
+ XWETLBDAH_MAX, & ! Max val. of Lbda_h for WET
+ XWETINTP1S,XWETINTP2S, & ! Csts for bilin. interpol. of
+ XWETINTP1G,XWETINTP2G, & ! Lbda_r, Lbda_s and Lbda_g in
+ XWETINTP1H,XWETINTP2H ! the XKER_SWETH and XKER_GWETH
+ ! tables
+INTEGER,SAVE :: NWETLBDAS, & ! Number of Lbda_s,
+ NWETLBDAG, & ! of Lbda_g and
+ NWETLBDAH ! of Lbda_h values in
+ ! the XKER_SWETH and XKER_GWETH
+ ! tables
+REAL,DIMENSION(:,:), SAVE, ALLOCATABLE &
+ :: XKER_SWETH, & ! Normalized kernel for SWETH
+ XKER_GWETH ! Normalized kernel for GWETH
+
+!
+!-------------------------------------------------------------------------------
+!
+END MODULE MODD_PARAM_LIMA_MIXED
diff --git a/src/mesonh/micro/modd_param_lima_warm.f90 b/src/mesonh/micro/modd_param_lima_warm.f90
new file mode 100644
index 000000000..65a3d1027
--- /dev/null
+++ b/src/mesonh/micro/modd_param_lima_warm.f90
@@ -0,0 +1,125 @@
+!MNH_LIC Copyright 2013-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ###########################
+ MODULE MODD_PARAM_LIMA_WARM
+! ###########################
+!
+!!**** *MODD_PARAM_LIMA_WARM* - declaration of some descriptive parameters and
+!! microphysical factors extensively used in
+!! the LIMA warm scheme.
+!! AUTHOR
+!! ------
+!! J.-P. Pinty *Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!!
+!-------------------------------------------------------------------------------
+USE MODD_PARAMETERS, ONLY: JPSVNAMELGTMAX
+!
+IMPLICIT NONE
+!
+!* 1. DESCRIPTIVE PARAMETERS
+! ----------------------
+!
+REAL,SAVE :: XLBC, XLBEXC, & ! shape parameters of the cloud droplets
+ XLBR, XLBEXR ! shape parameters of the raindrops
+!
+REAL,SAVE :: XAR,XBR,XCR,XDR,XF0R,XF1R, & ! Raindrop charact.
+ XCCR, & !For diagnostics
+ XAC,XBC,XCC,XDC,XF0C,XF2C,XC1C ! Cloud droplet charact.
+!
+!
+CHARACTER(LEN=JPSVNAMELGTMAX),DIMENSION(5),PARAMETER &
+ :: CLIMA_WARM_NAMES=(/'CCLOUD ','CRAIN ','CCCNFREE','CCCNACTI','SPRO '/)
+ ! basenames of the SV articles stored
+ ! in the binary files
+CHARACTER(LEN=JPSVNAMELGTMAX),DIMENSION(5),PARAMETER &
+ :: CLIMA_WARM_CONC=(/'NC ','NR ','NFREE','NCCN ','SS '/)
+! ! basenames of the SV articles stored
+! ! in the binary files for DIAG
+!
+!* Special issue for Below-Cloud SCAVenging of Aerosol particles
+CHARACTER(LEN=JPSVNAMELGTMAX),DIMENSION(2) :: CAERO_MASS =(/'MASSAP', 'MAP '/)
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. MICROPHYSICAL FACTORS
+! ---------------------
+!
+REAL,SAVE :: XFSEDRR,XFSEDCR, & ! Constants for sedimentation
+ XFSEDRC,XFSEDCC ! fluxes of R, C
+!
+!
+REAL,SAVE :: XDIVA, & ! Diffusivity of water vapor
+ XTHCO ! Thermal conductivity
+REAL,SAVE :: XWMIN ! Min value of updraft velocity
+ ! to enable nucleation process
+REAL,SAVE :: XTMIN ! Min value of
+ ! temperature evolution
+ ! to enable nucleation process
+REAL,SAVE :: XCSTHEN,XCSTDCRIT ! Cst for HEN precalculations
+INTEGER, SAVE :: NHYP ! Number of value of the HYP
+ ! functions
+REAL,SAVE :: XHYPINTP1, XHYPINTP2 ! Factors defining the
+ ! supersaturation log scale
+REAL, DIMENSION(:,:), SAVE, ALLOCATABLE & ! Tabulated HYPgeometric
+ :: XHYPF12, XHYPF32 ! functions used in HEN
+INTEGER, SAVE :: NAHEN ! Number of value of the AHEN
+ ! functions
+REAL,SAVE :: XAHENINTP1, XAHENINTP2 ! Factors defining the
+ ! temperatures in lin scale
+REAL, DIMENSION(:), SAVE, ALLOCATABLE & !
+ :: XAHENG,XAHENG2,XAHENG3,XPSI1, XPSI3, & ! Twomey-CPB98 and
+ XAHENF,XAHENY ! Feingold-Heymsfield
+ ! parameterization to compute Smax
+REAL,SAVE :: XWCOEF_F1, XWCOEF_F2, XWCOEF_F3, & ! COEF_F of the polynomial temp.
+ XWCOEF_Y1, XWCOEF_Y2, XWCOEF_Y3 ! COEF_Y of the polynomial temp.
+ ! function powering W
+!
+!
+REAL,SAVE :: XKERA1, XKERA2 ! Constants to define the lin
+ ! and parabolic kernel param.
+REAL,SAVE :: XSELFC ! Constants for cloud droplet
+ ! selfcollection : SELF
+!
+REAL,SAVE :: XAUTO1, XAUTO2, XCAUTR, & ! Constants for cloud droplet
+ XLAUTR, XLAUTR_THRESHOLD, & ! autoconversion : AUT
+ XITAUTR, XITAUTR_THRESHOLD
+!
+REAL,SAVE :: XACCR1, XACCR2, XACCR3, & ! Constants for the accretion
+ XACCR4, XACCR5, XACCR6, & ! process
+ XACCR_CLARGE1, XACCR_CLARGE2, XACCR_RLARGE1, XACCR_RLARGE2, &
+ XACCR_CSMALL1, XACCR_CSMALL2, XACCR_RSMALL1, XACCR_RSMALL2
+!
+REAL,SAVE :: XSCBU2, XSCBU3, & ! Constants for the raindrop
+ XSCBU_EFF1, XSCBU_EFF2, XSCBUEXP1 ! breakup-selfcollection: SCBU
+!
+REAL,SAVE :: XSPONBUD1,XSPONBUD2,XSPONBUD3, & ! Spontaneous Break-up
+ XSPONCOEF2 ! (drop size limiter)
+!
+REAL,SAVE :: X0EVAR, X1EVAR, & ! Constants for raindrop
+ XEX0EVAR, XEX1EVAR, XEX2EVAR ! evaporation: EVA
+!
+REAL,DIMENSION(:,:,:,:), SAVE, ALLOCATABLE :: XCONCC_INI
+REAL,SAVE :: XCONCR_PARAM_INI
+ ! Used to initialize the
+ ! concentrations from mixing ratios
+ ! (init and grid-nesting from Kessler)
+!
+REAL,SAVE :: X0CNDC, X2CNDC ! Constants for cloud droplet
+ ! condensation/evaporation
+REAL,SAVE :: XFREFFC ! Factor to compute the cloud droplet effective radius
+REAL,SAVE :: XFREFFR ! Factor to compute the rain drop effective radius
+REAL,SAVE :: XCREC, XCRER
+ ! Factors to compute reff when cloud and rain are present
+!
+!-------------------------------------------------------------------------------
+!
+END MODULE MODD_PARAM_LIMA_WARM
diff --git a/src/mesonh/micro/modd_parameters.f90 b/src/mesonh/micro/modd_parameters.f90
new file mode 100644
index 000000000..c21c6e709
--- /dev/null
+++ b/src/mesonh/micro/modd_parameters.f90
@@ -0,0 +1,98 @@
+!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ######################
+ MODULE MODD_PARAMETERS
+! ######################
+!
+!!**** *MODD_PARAMETERS* - declaration of parameter variables
+!!
+!! PURPOSE
+!! -------
+! The purpose of this declarative module is to specify the variables
+! which have the PARAMETER attribute
+!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (module MODD_PARAMETER)
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq *Meteo France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 4/07/94
+!! Modification 10/03/95 (I.Mallet) add the coupling files maximum number
+!! Modification 10/04/95 (Ph. Hereil) add the budget related informations
+!! Modification 15/03/99 (V. Masson) add default value
+!! Modification 17/11/00 (P.Jabouille) add the dummy array size
+!! Modification 22/01/01 (D.Gazen) change JPSVMAX from 100 to 200
+!! and JPBUMAX from 120 to 250
+!! Modification 17/05/04 (P.Jabouille) add JPOUTMAX
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! B.VIE 2016 LIMA
+! P. Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! Q. Rodier 29/03/2019: increase maximum number of outputs to 999
+! P. Wautelet 17/01/2020: add NBUNAMELGTMAX and NCOMMENTLGTMAX parameters
+! P. Wautelet 13/03/2020: remove JPBUMAX and JPBUPROMAX
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!JUAN CYCLK
+!INTEGER, PARAMETER :: JPHEXT = 3 ! Horizontal External points number
+INTEGER,SAVE :: JPHEXT = 1 ! Horizontal External points number
+!
+!JUAN CYCLK
+INTEGER, PARAMETER :: JPVEXT = 1 ! Vertical External points number
+INTEGER, PARAMETER :: JPVEXT_TURB = 1 ! Vertical External points number
+INTEGER, PARAMETER :: JPMODELMAX = 8 ! Maximum allowed number of nested models
+INTEGER, PARAMETER :: JPCPLFILEMAX = 24 ! Maximum allowed number of CouPLing FILEs
+INTEGER, PARAMETER :: JPRIMMAX = 6 ! Maximum number of points for the
+ ! horizontal relaxation for the outermost verticals
+INTEGER, PARAMETER :: JPSVMAX = 200 ! Maximum number of scalar variables
+INTEGER, PARAMETER :: JPSVNAMELGTMAX = 10 ! Maximum length of a scalar variable name (do not set to less than 10)
+!
+!
+REAL, PARAMETER :: XUNDEF = 999. ! default value for undefined or unused
+! ! field.
+REAL, PARAMETER :: XNEGUNDEF = -999. ! default value for undefined or unused
+! ! field (negative value guaranteed)
+INTEGER, PARAMETER :: NUNDEF = 999 ! default value for undefined or unused
+! ! field.
+INTEGER, PARAMETER :: NNEGUNDEF = -999 ! default value for undefined or unused
+! ! field (negative value guaranteed)
+INTEGER, PARAMETER :: JPDUMMY = 20 ! Size of dummy array
+!
+INTEGER, PARAMETER :: JPOUTMAX = 999 ! Maximum allowed number of OUTput files
+INTEGER, PARAMETER :: JPOUTVARMAX = 192 ! Maximum allowed number of variables in an output file
+!
+INTEGER, PARAMETER :: NBUNAMELGTMAX = 32 ! Maximum length of a budget name
+INTEGER, PARAMETER :: NCOMMENTLGTMAX = 100 ! Maximum length of a comment
+INTEGER, PARAMETER :: NMNHNAMELGTMAX = 32 ! Maximum length of a MNH variable name
+INTEGER, PARAMETER :: NSTDNAMELGTMAX = 64 ! Maximum length of the standard name of a variable (CF convention)
+!
+INTEGER, PARAMETER :: NDIRNAMELGTMAX = 512 ! Maximum length of a directory name
+INTEGER, PARAMETER :: NFILENAMELGTMAX = 32 ! Maximum length of a file name (must be at least NFILENAMELGTMAXLFI)
+INTEGER, PARAMETER :: NFILENAMELGTMAXLFI = 28 ! Maximum length of a file name in LFI file (this is necessary
+ ! to keep backward compatibility), MUST BE 28
+!
+INTEGER, PARAMETER :: NLFIMAXCOMMENTLENGTH = 100 ! Length of comments in LFI files
+!
+INTEGER, PARAMETER :: JPLIMACCNMAX = 10 ! Maximum allowed number of CCN modes in LIMA
+INTEGER, PARAMETER :: JPLIMAIFNMAX = 10 ! Maximum allowed number of IFN modes in LIMA
+!
+INTEGER, PARAMETER :: NGRIDUNKNOWN = -1 ! Unknown Arakawa grid number
+!
+END MODULE MODD_PARAMETERS
diff --git a/src/mesonh/micro/modd_rain_c2r2_descr.f90 b/src/mesonh/micro/modd_rain_c2r2_descr.f90
new file mode 100644
index 000000000..82146aac4
--- /dev/null
+++ b/src/mesonh/micro/modd_rain_c2r2_descr.f90
@@ -0,0 +1,72 @@
+!MNH_LIC Copyright 2000-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ###########################
+ MODULE MODD_RAIN_C2R2_DESCR
+! ###########################
+!
+!!**** *MODD_RAIN_C2R2_DESCR* - declaration of the microphysical descriptive
+!! constants for use in the warm scheme.
+!!
+!! PURPOSE
+!! -------
+! The purpose of this declarative module is to declare the microphysical
+! constants. This includes the descriptive parameters for the raindrop
+! and the parameters relevant of the dimensional distributions.
+!
+! m(D) = XAx * D**XBx : Mass-MaxDim relationship
+! v(D) = XCx * D**XDx : Fallspeed-MaxDim relationship
+! XF0x, XF1x, XF2x : Ventilation factors
+!
+! and
+!
+! XALPHAx, XNUx : Generalized GAMMA law
+! XLBx : Slope parameter of the
+! distribution law
+!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (MODD_RAIN_C2R2_DESCR)
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty *Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 04/11/2000
+!! J.-P. Pinty 29/11/02 add cloud doplet fall speed parameters
+!!
+!-------------------------------------------------------------------------------
+USE MODD_PARAMETERS, ONLY: JPSVNAMELGTMAX
+!
+!* 0. DECLARATIONS
+! ------------
+!
+REAL,SAVE :: XCEXVT ! air density fall speed correction
+!
+REAL,SAVE :: XAR,XBR,XCR,XDR,XF0R,XF1R, & ! Raindrop charact.
+ XAC,XBC,XCC,XDC,XF0C,XF2C,XC1C ! Cloud droplet charact.
+!
+REAL,DIMENSION(:),SAVE,ALLOCATABLE :: XRTMIN
+ ! Min values of the mixing ratios
+REAL,DIMENSION(:),SAVE,ALLOCATABLE :: XCTMIN
+ ! Min values of the drop concentrations
+REAL,SAVE :: XLBC, XLBEXC, & ! shape parameters of the cloud droplets
+ XLBR, XLBEXR ! shape parameters of the raindrops
+!
+CHARACTER(LEN=JPSVNAMELGTMAX),DIMENSION(4),PARAMETER &
+ :: C2R2NAMES=(/'CCCN ','CCLOUD','CRAIN ','SUPSAT'/)
+ ! basenames of the SV articles stored
+ ! in the binary files
+!
+END MODULE MODD_RAIN_C2R2_DESCR
+!
+!
diff --git a/src/mesonh/micro/modd_rain_c2r2_khko_param.f90 b/src/mesonh/micro/modd_rain_c2r2_khko_param.f90
new file mode 100644
index 000000000..639abf3c1
--- /dev/null
+++ b/src/mesonh/micro/modd_rain_c2r2_khko_param.f90
@@ -0,0 +1,120 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 modd 2006/10/16 14:23:23
+!-----------------------------------------------------------------
+! ###########################
+ MODULE MODD_RAIN_C2R2_KHKO_PARAM
+! ###########################
+!
+!!**** *MODD_RAIN_C2R2_KHKO_PARAM* - declaration of some microphysical factors
+!! extensively used in the warm scheme.
+!!
+!! PURPOSE
+!! -------
+! The purpose of this declarative module is to declare some precomputed
+! microphysical paramters directly used in routine RAIN_C2R2_KHKO
+!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty *Laboratoire d'Aerologie*
+!! O.Geoffroy (GMEI)
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 04/12/95
+!! J.-P. Pinty 29/11/02 add cloud droplet cond/eva parameters for C3R5
+!! G.Delautier 2014 : fusion MODD_RAIN_KHKO_PARAM et MODD_RAIN_C2R2_PARAM
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+REAL,SAVE :: XFSEDRR,XFSEDCR, & ! Constants for sedimentation
+ XFSEDRC,XFSEDCC ! fluxes of R, C
+!
+!
+REAL,SAVE :: XDIVA, & ! Diffusivity of water vapor
+ XTHCO ! Thermal conductivity
+REAL,SAVE :: XWMIN ! Min value of updraft velocity
+ ! to enable nucleation process
+REAL,SAVE :: XTMIN ! Min value of
+ ! temperature evolution
+ ! to enable nucleation process
+REAL,SAVE :: XCSTHEN,XCSTDCRIT ! Cst for HEN precalculations
+INTEGER, SAVE :: NHYP ! Number of value of the HYP
+ ! functions
+REAL,SAVE :: XHYPINTP1, XHYPINTP2 ! Factors defining the
+ ! supersaturation log scale
+REAL, DIMENSION(:), SAVE, ALLOCATABLE & ! Tabulated HYPgeometric
+ :: XHYPF12, XHYPF32 ! functions used in HEN
+INTEGER, SAVE :: NAHEN ! Number of value of the AHEN
+ ! functions
+REAL,SAVE :: XAHENINTP1, XAHENINTP2 ! Factors defining the
+ ! temperatures in lin scale
+REAL, DIMENSION(:), SAVE, ALLOCATABLE & !
+ :: XAHENG,XPSI1, XPSI3, & ! Twomey-CPB98 and
+ XAHENF,XAHENY ! Feingold-Heymsfield
+ ! parameterization to compute Smax
+REAL,SAVE :: XWCOEF_F1, XWCOEF_F2, XWCOEF_F3, & ! COEF_F of the polynomial temp.
+ XWCOEF_Y1, XWCOEF_Y2, XWCOEF_Y3 ! COEF_Y of the polynomial temp.
+ ! function powering W
+!
+!
+REAL,SAVE :: XKERA1, XKERA2 ! Constants to define the lin
+ ! and parabolic kernel param.
+REAL,SAVE :: XSELFC ! Constants for cloud droplet
+ ! selfcollection : SELF
+!
+REAL,SAVE :: XAUTO1, XAUTO2, XCAUTR, & ! Constants for cloud droplet
+ XLAUTR, XLAUTR_THRESHOLD, & ! autoconversion : AUT
+ XITAUTR, XITAUTR_THRESHOLD
+!
+REAL,SAVE :: XACCR1, XACCR2, XACCR3, & ! Constants for the accretion
+ XACCR4, XACCR5, XACCR6, & ! process
+ XACCR_CLARGE1, XACCR_CLARGE2, XACCR_RLARGE1, XACCR_RLARGE2, &
+ XACCR_CSMALL1, XACCR_CSMALL2, XACCR_RSMALL1, XACCR_RSMALL2
+!
+REAL,SAVE :: XSCBU2, XSCBU3, & ! Constants for the raindrop
+ XSCBU_EFF1, XSCBU_EFF2, XSCBUEXP1 ! breakup-selfcollection: SCBU
+!
+REAL,SAVE :: XSPONBUD1,XSPONBUD2,XSPONBUD3, & ! Spontaneous Break-up
+ XSPONCOEF2 ! (drop size limiter)
+!
+REAL,SAVE :: X0EVAR, X1EVAR, & ! Constants for raindrop
+ XEX0EVAR, XEX1EVAR, XEX2EVAR ! evaporation: EVA
+!
+REAL,SAVE :: XCONCC_INI, XCONCR_PARAM_INI ! Used to initialize the
+ ! concentrations from mixing ratios
+ ! (init and grid-nesting from Kessler)
+!
+REAL,SAVE :: X0CNDC, X2CNDC ! Constants for cloud droplet
+ ! condensation/evaporation
+REAL,SAVE :: XFREFFC ! Factor to compute the cloud droplet effective radius
+REAL,SAVE :: XFREFFR ! Factor to compute the rain drop effective radius
+REAL,SAVE :: XCREC, XCRER
+ ! Factors to compute reff when cloud and rain are present
+!
+REAL,SAVE :: XR0 ! new drizzle drops radius
+ ! autoconversion
+!
+REAL,SAVE :: XCEVAP ! Constants for raindrop
+ ! evaporation
+
+END MODULE MODD_RAIN_C2R2_KHKO_PARAM
diff --git a/src/mesonh/micro/modd_rain_ice_descr.f90 b/src/mesonh/micro/modd_rain_ice_descr.f90
new file mode 100644
index 000000000..96295e4e7
--- /dev/null
+++ b/src/mesonh/micro/modd_rain_ice_descr.f90
@@ -0,0 +1,87 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 modd 2006/10/16 14:23:23
+!-----------------------------------------------------------------
+! ##########################
+ MODULE MODD_RAIN_ICE_DESCR
+! ##########################
+!
+!!**** *MODD_RAIN_ICE_DESCR* - declaration of the microphysical descriptive
+!! constants for use in the warm and cold schemes.
+!!
+!! PURPOSE
+!! -------
+! The purpose of this declarative module is to declare the microphysical
+! constants. This includes the descriptive parameters for the raindrop and
+! the ice crystal habits and the parameters relevant of the dimensional
+! distributions.
+!
+! m(D) = XAx * D**XBx : Mass-MaxDim relationship
+! v(D) = XCx * D**XDx : Fallspeed-MaxDim relationship
+! N(Lbda) = XCCx * Lbda**XCXx : NumberConc-Slopeparam relationship
+! XF0x, XF1x, XF2x : Ventilation factors
+! XC1x : Shape parameter for deposition
+!
+! and
+!
+! XALPHAx, XNUx : Generalized GAMMA law
+! Lbda = XLBx * (r_x*rho_dref)**XLBEXx : Slope parameter of the
+! distribution law
+!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (MODD_RAIN_ICE_DESCR)
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty *Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 04/12/95
+!! J.-P. Pinty 29/11/02 add ICE4
+!! C. LAC 26/01/2012 : suppression de XCONC qui n'était pas utilisé
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+REAL,SAVE :: XCEXVT ! air density fall speed correction
+!
+REAL,SAVE :: XAC,XBC,XCC,XDC ! Cloud droplet charact.
+REAL,SAVE :: XAR,XBR,XCR,XDR,XCCR ,XF0R,XF1R,XC1R ! Raindrop charact.
+REAL,SAVE :: XAI,XBI,XC_I,XDI ,XF0I,XF2I,XC1I ! Cloud ice charact.
+REAL,SAVE :: XAS,XBS,XCS,XDS,XCCS,XCXS,XF0S,XF1S,XC1S ! Snow/agg. charact.
+REAL,SAVE :: XAG,XBG,XCG,XDG,XCCG,XCXG,XF0G,XF1G,XC1G ! Graupel charact.
+REAL,SAVE :: XAH,XBH,XCH,XDH,XCCH,XCXH,XF0H,XF1H,XC1H ! Hail charact.
+!
+REAL,SAVE :: XALPHAC,XNUC,XALPHAC2,XNUC2, XLBEXC ! Cloud droplet distribution parameters
+REAL,DIMENSION(2), SAVE :: XLBC ! Cloud droplet distribution parameters
+REAL,SAVE :: XALPHAR,XNUR,XLBEXR,XLBR ! Raindrop distribution parameters
+REAL,SAVE :: XALPHAI,XNUI,XLBEXI,XLBI ! Cloud ice distribution parameters
+REAL,SAVE :: XALPHAS,XNUS,XLBEXS,XLBS ! Snow/agg. distribution parameters
+REAL,SAVE :: XALPHAG,XNUG,XLBEXG,XLBG ! Graupel distribution parameters
+REAL,SAVE :: XALPHAH,XNUH,XLBEXH,XLBH ! Hail distribution parameters
+!
+REAL,SAVE :: XLBDAR_MAX,XLBDAS_MAX,XLBDAG_MAX ! Max values allowed for the shape
+ ! parameters (rain,snow,graupeln)
+!
+REAL,DIMENSION(:),SAVE,ALLOCATABLE :: XRTMIN ! Min values allowed for the mixing ratios
+REAL,SAVE :: XCONC_SEA ! Diagnostic concentration of droplets over sea
+REAL,SAVE :: XCONC_LAND ! Diagnostic concentration of droplets over land
+REAL,SAVE :: XCONC_URBAN ! Diagnostic concentration of droplets over urban area
+!
+END MODULE MODD_RAIN_ICE_DESCR
diff --git a/src/mesonh/micro/modd_rain_ice_param.f90 b/src/mesonh/micro/modd_rain_ice_param.f90
new file mode 100644
index 000000000..7568e2a68
--- /dev/null
+++ b/src/mesonh/micro/modd_rain_ice_param.f90
@@ -0,0 +1,185 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+! ######spl
+ MODULE MODD_RAIN_ICE_PARAM
+! ##########################
+!
+!!**** *MODD_RAIN_ICE_PARAM* - declaration of some microphysical factors
+!! extensively used in the warm and cold schemes.
+!!
+!! PURPOSE
+!! -------
+! The purpose of this declarative module is to declare some precomputed
+! microphysical paramters directly used in routine RAIN_ICE.
+!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (MODD_RAIN_ICE_PARAM)
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty *Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 04/12/95
+!! J.-P. Pinty 29/11/02 add ICE4
+!! S. Riette 11/2016: new ICE3/ICE4 processes
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+REAL,DIMENSION(2),SAVE :: XFSEDC ! Constants for sedimentation fluxes of C
+REAL,SAVE :: XFSEDR,XEXSEDR, & ! Constants for sedimentation
+ XFSEDI,XEXCSEDI,XEXRSEDI, & ! fluxes of R, I, S and G
+ XFSEDS,XEXSEDS, &
+ XFSEDG,XEXSEDG
+!
+REAL,SAVE :: XNU10,XALPHA1,XBETA1, & ! Constants for heterogeneous
+ XNU20,XALPHA2,XBETA2, & ! ice nucleation : HEN
+ XMNU0 ! mass of nucleated ice crystal
+!
+REAL,SAVE :: XALPHA3,XBETA3, & ! Constants for homogeneous
+ XHON ! ice nucleation : HON
+!
+REAL,SAVE :: XSCFAC, & ! Constants for raindrop
+ X0EVAR,X1EVAR,XEX0EVAR,XEX1EVAR, & ! evaporation: EVA and for
+ X0DEPI,X2DEPI, & ! deposition : DEP on I,
+ X0DEPS,X1DEPS,XEX0DEPS,XEX1DEPS, & ! on S and
+ X0DEPG,X1DEPG,XEX0DEPG,XEX1DEPG ! on G
+!
+REAL,SAVE :: XTIMAUTI,XTEXAUTI,XCRIAUTI, & ! Constants for pristine ice
+ XT0CRIAUTI,XACRIAUTI,XBCRIAUTI ! autoconversion : AUT
+!
+REAL,SAVE :: XCOLIS,XCOLEXIS, & ! Constants for snow
+ XFIAGGS, & ! aggregation : AGG
+ XEXIAGGS
+!
+REAL,SAVE :: XTIMAUTC, & ! Constants for cloud droplet
+ XCRIAUTC ! autoconversion : AUT
+!
+REAL,SAVE :: XFCACCR, & ! Constants for cloud droplet
+ XEXCACCR ! accretion on raindrops : ACC
+!
+REAL,SAVE :: XDCSLIM,XCOLCS, & ! Constants for the riming of
+ XEXCRIMSS,XCRIMSS, & ! the aggregates : RIM
+ XEXCRIMSG,XCRIMSG, & !
+ XEXSRIMCG,XSRIMCG, & !
+ XEXSRIMCG2,XSRIMCG2, & !
+ XSRIMCG3, & !
+ XGAMINC_BOUND_MIN, & ! Min val. of Lbda_s for RIM
+ XGAMINC_BOUND_MAX, & ! Max val. of Lbda_s for RIM
+ XRIMINTP1,XRIMINTP2 ! Csts for lin. interpol. of
+ ! the tab. incomplete Gamma law
+INTEGER,SAVE :: NGAMINC ! Number of tab. Lbda_s
+REAL, DIMENSION(:), SAVE, ALLOCATABLE &
+ :: XGAMINC_RIM1, & ! Tab. incomplete Gamma funct.
+ XGAMINC_RIM2, & ! for XDS+2 and for XBS
+ XGAMINC_RIM4 ! and for 2+XDS+XBS-XBG
+!
+REAL,SAVE :: XFRACCSS, & ! Constants for the accretion
+ XLBRACCS1,XLBRACCS2,XLBRACCS3, & ! raindrops onto the aggregates
+ XFSACCRG, & ! ACC (processes RACCSS and
+ XLBSACCR1,XLBSACCR2,XLBSACCR3, & ! SACCRG)
+ XACCLBDAS_MIN, & ! Min val. of Lbda_s for ACC
+ XACCLBDAS_MAX, & ! Max val. of Lbda_s for ACC
+ XACCLBDAR_MIN, & ! Min val. of Lbda_r for ACC
+ XACCLBDAR_MAX, & ! Max val. of Lbda_r for ACC
+ XACCINTP1S,XACCINTP2S, & ! Csts for bilin. interpol. of
+ XACCINTP1R,XACCINTP2R ! Lbda_s and Lbda_r in the
+ ! XKER_RACCSS and XKER_SACCRG
+ ! tables
+INTEGER,SAVE :: NACCLBDAS, & ! Number of Lbda_s values and
+ NACCLBDAR ! of Lbda_r values in the
+ ! XKER_RACCSS and XKER_SACCRG
+ ! tables
+REAL,DIMENSION(:,:), SAVE, ALLOCATABLE &
+ :: XKER_RACCSS, & ! Normalized kernel for RACCSS
+ XKER_RACCS, & ! Normalized kernel for RACCS
+ XKER_SACCRG ! Normalized kernel for SACCRG
+REAL,SAVE :: XFSCVMG ! Melting-conversion factor of
+ ! the aggregates
+!
+REAL,SAVE :: XCOLIR, & ! Constants for rain contact
+ XEXRCFRI,XRCFRI, & ! freezing : CFR
+ XEXICFRR,XICFRR !
+!
+REAL,SAVE :: XFCDRYG, & ! Constants for the dry growth
+ XCOLIG,XCOLEXIG,XFIDRYG, & ! of the graupeln : DRY
+ XFIDRYG2, XEXFIDRYG, &
+ XCOLSG,XCOLEXSG,XFSDRYG, & ! processes RCDRYG
+ XLBSDRYG1,XLBSDRYG2,XLBSDRYG3, & ! RIDRYG
+ XFRDRYG, & ! RSDRYG
+ XLBRDRYG1,XLBRDRYG2,XLBRDRYG3, & ! RRDRYG
+ XDRYLBDAR_MIN, & ! Min val. of Lbda_r for DRY
+ XDRYLBDAR_MAX, & ! Max val. of Lbda_r for DRY
+ XDRYLBDAS_MIN, & ! Min val. of Lbda_s for DRY
+ XDRYLBDAS_MAX, & ! Max val. of Lbda_s for DRY
+ XDRYLBDAG_MIN, & ! Min val. of Lbda_g for DRY
+ XDRYLBDAG_MAX, & ! Max val. of Lbda_g for DRY
+ XDRYINTP1R,XDRYINTP2R, & ! Csts for bilin. interpol. of
+ XDRYINTP1S,XDRYINTP2S, & ! Lbda_r, Lbda_s and Lbda_g in
+ XDRYINTP1G,XDRYINTP2G ! the XKER_SDRYG and XKER_RDRYG
+ ! tables
+INTEGER,SAVE :: NDRYLBDAR, & ! Number of Lbda_r,
+ NDRYLBDAS, & ! of Lbda_s and
+ NDRYLBDAG ! of Lbda_g values in
+ ! the XKER_SDRYG and XKER_RDRYG
+ ! tables
+REAL,DIMENSION(:,:), SAVE, ALLOCATABLE &
+ :: XKER_SDRYG, & ! Normalized kernel for SDRYG
+ XKER_RDRYG ! Normalized kernel for RDRYG
+!
+! addition of Hail category
+!
+REAL,SAVE :: XFSEDH,XEXSEDH ! Constants for sedimentation
+!
+!
+REAL,SAVE :: X0DEPH,X1DEPH,XEX0DEPH,XEX1DEPH ! Constants for deposition
+!
+REAL,SAVE :: XCOLIH, XCOLEXIH, & ! Constants for the dry growth
+ & XCOLSH, XCOLEXSH, & ! of the hail
+ & XCOLGH, XCOLEXGH !
+!
+REAL,SAVE :: XFWETH,XFSWETH, & ! Constants for the wet growth
+ XLBSWETH1,XLBSWETH2,XLBSWETH3, & ! of the hailstones : WET
+ XFGWETH, & ! processes RSWETH
+ XLBGWETH1,XLBGWETH2,XLBGWETH3, & ! RGWETH
+ XFRWETH, & ! RRWETH
+ XLBRWETH1,XLBRWETH2,XLBRWETH3, & !
+ XWETLBDAS_MIN, & ! Min val. of Lbda_s for WET
+ XWETLBDAS_MAX, & ! Max val. of Lbda_s for WET
+ XWETLBDAG_MIN, & ! Min val. of Lbda_g for WET
+ XWETLBDAG_MAX, & ! Max val. of Lbda_g for WET
+ XWETLBDAR_MIN, & ! Min val. of Lbda_r for WET
+ XWETLBDAR_MAX, & ! Max val. of Lbda_r for WET
+ XWETLBDAH_MIN, & ! Min val. of Lbda_h for WET
+ XWETLBDAH_MAX, & ! Max val. of Lbda_h for WET
+ XWETINTP1S,XWETINTP2S, & ! Csts for bilin. interpol. of
+ XWETINTP1G,XWETINTP2G, & ! Lbda_r, Lbda_s, Lbda_g
+ XWETINTP1R,XWETINTP2R, & ! and Lbda_h in
+ XWETINTP1H,XWETINTP2H ! the XKER_SWETH, XKER_GWETH
+ ! and XKER_RWETH tables
+INTEGER,SAVE :: NWETLBDAS, & ! Number of Lbda_s,
+ NWETLBDAG, & ! of Lbda_g,
+ NWETLBDAR, & ! of Lbda_r and
+ NWETLBDAH ! of Lbda_h values in
+ ! the XKER_SWETH, XKER_GWETH
+ ! and XKER_RWETH tables
+REAL,DIMENSION(:,:), SAVE, ALLOCATABLE &
+ :: XKER_SWETH, & ! Normalized kernel for SWETH
+ XKER_GWETH, & ! Normalized kernel for GWETH
+ XKER_RWETH ! Normalized kernel for RWETH
+!
+END MODULE MODD_RAIN_ICE_PARAM
diff --git a/src/mesonh/micro/modn_param_lima.f90 b/src/mesonh/micro/modn_param_lima.f90
new file mode 100644
index 000000000..f86b1add0
--- /dev/null
+++ b/src/mesonh/micro/modn_param_lima.f90
@@ -0,0 +1,36 @@
+!MNH_LIC Copyright 2001-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-------------------------------------------------------------------------------
+! ######################
+ MODULE MODN_PARAM_LIMA
+! ######################
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAM_LIMA
+!
+IMPLICIT NONE
+!
+!
+NAMELIST/NAM_PARAM_LIMA/LCOLD, LNUCL, LSEDI, LSNOW, LHAIL, LHHONI, LMEYERS,&
+ NMOD_IFN, XIFN_CONC, LIFN_HOM, &
+ CIFN_SPECIES, CINT_MIXING, NMOD_IMM, NIND_SPECIE, &
+ CPRISTINE_ICE_LIMA, CHEVRIMED_ICE_LIMA, &
+ XALPHAI, XNUI, XALPHAS, XNUS, XALPHAG, XNUG, &
+ XFACTNUC_DEP, XFACTNUC_CON, NPHILLIPS, &
+!
+ LWARM, LACTI, LRAIN, LSEDC, LACTIT, LBOUND, LSPRO, &
+ LADJ, &
+ NMOD_CCN, XCCN_CONC, &
+ LCCN_HOM, CCCN_MODES, HINI_CCN, HTYPE_CCN, &
+ XALPHAC, XNUC, XALPHAR, XNUR, &
+ XFSOLUB_CCN, XACTEMP_CCN, XAERDIFF, XAERHEIGHT, &
+ LSCAV, LAERO_MASS, LDEPOC, XVDEPOC, LACTTKE, &
+ LPTSPLIT, LFEEDBACKT, NMAXITER, XMRSTEP, XTSTEP_TS
+!
+END MODULE MODN_PARAM_LIMA
diff --git a/src/mesonh/micro/prognos_lima.f90 b/src/mesonh/micro/prognos_lima.f90
new file mode 100644
index 000000000..648348502
--- /dev/null
+++ b/src/mesonh/micro/prognos_lima.f90
@@ -0,0 +1,393 @@
+!MNH_LIC Copyright 2012-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! #######################
+ MODULE MODI_PROGNOS_LIMA
+! #######################
+!
+INTERFACE
+!
+SUBROUTINE PROGNOS_LIMA(PTSTEP,PDZ,PLV,PCPH,PPRES,PRHOD,PRR,PTT,PRV,PRC,PS0,PNAS,PCCS,PNFS)
+!
+REAL, INTENT(IN) :: PTSTEP
+REAL, DIMENSION(:), INTENT(IN) :: PPRES
+REAL, DIMENSION(:), INTENT(IN) :: PDZ
+REAL, DIMENSION(:), INTENT(IN) :: PLV
+REAL, DIMENSION(:), INTENT(IN) :: PCPH
+REAL, DIMENSION(:), INTENT(IN) :: PRHOD
+REAL, DIMENSION(:), INTENT(IN) :: PRR
+REAL, DIMENSION(:), INTENT(INOUT) :: PTT ! PTHS
+REAL, DIMENSION(:), INTENT(INOUT) :: PRV ! PRVS
+REAL, DIMENSION(:), INTENT(INOUT) :: PRC ! PRCS
+REAL, DIMENSION(:), INTENT(INOUT) :: PS0 ! PSVS sursat source
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PNAS ! PSVS activated aerosols source
+REAL, DIMENSION(:), INTENT(INOUT) :: PCCS ! PSVS droplet concentration source
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PNFS ! PSVS free aerosol source
+!
+END SUBROUTINE PROGNOS_LIMA
+!
+END INTERFACE
+!
+END MODULE MODI_PROGNOS_LIMA
+!
+! ###################################################################################
+ SUBROUTINE PROGNOS_LIMA(PTSTEP,PDZ,PLV,PCPH,PPRES,PRHOD,PRR,PTT,PRV,PRC,PS0,PNAS,PCCS,PNFS)
+! ###################################################################################
+!
+!!**** * - compute pseudo-prognostic of supersaturation according to Thouron
+! et al. 2012
+!! PURPOSE
+!! -------
+!!
+!!** METHOD
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Thouron, O., J.-L. Brenguier, and F. Burnet, Supersaturation calculation
+!! in large eddy simulation models for prediction of the droplet number
+!! concentration, Geosci. Model Dev., 5, 761-772, 2012.
+!!
+!! AUTHOR
+!! ------
+!! 06/2021 B. Vie forked from prognos.f90
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+USE MODD_CST
+USE MODD_PARAM_LIMA
+USE MODD_PARAM_LIMA_WARM
+!
+USE MODE_IO
+USE MODE_MSG
+!
+USE MODI_GAMMA
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+!
+!
+REAL, INTENT(IN) :: PTSTEP
+REAL, DIMENSION(:), INTENT(IN) :: PPRES
+REAL, DIMENSION(:), INTENT(IN) :: PDZ
+REAL, DIMENSION(:), INTENT(IN) :: PLV
+REAL, DIMENSION(:), INTENT(IN) :: PCPH
+REAL, DIMENSION(:), INTENT(IN) :: PRHOD
+REAL, DIMENSION(:), INTENT(IN) :: PRR
+REAL, DIMENSION(:), INTENT(INOUT) :: PTT ! PTHS
+REAL, DIMENSION(:), INTENT(INOUT) :: PRV ! PRVS
+REAL, DIMENSION(:), INTENT(INOUT) :: PRC ! PRCS
+REAL, DIMENSION(:), INTENT(INOUT) :: PS0 ! PSVS sursat source
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PNAS ! PSVS activated aerosols source
+REAL, DIMENSION(:), INTENT(INOUT) :: PCCS ! PSVS droplet concentration source
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PNFS ! PSVS free aerosol source
+!
+!
+!* 0.2 Declarations of local variables :
+!
+!
+REAL, DIMENSION(SIZE(PRHOD,1)) :: ZW1,ZW2,ZDZRC2,ZDZRC,ZCPH
+REAL, DIMENSION(SIZE(PRHOD,1)) :: ZA1,ZA2,ZB,ZC,ZG
+REAL, DIMENSION(SIZE(PRHOD,1)) :: ZLV,ZTT1,ZRT,ZTL,ZTT1_TEMP,ZTT2_TEMP
+REAL, DIMENSION(SIZE(PRHOD,1)) :: ZRMOY,ZRVSAT1,ZRVSAT2
+REAL, DIMENSION(SIZE(PRHOD,1)) :: ZVEC2 ! Work vectors forinterpolations
+INTEGER, DIMENSION(SIZE(PRHOD,1)):: IVEC2 ! Vectors of indices for interpolations
+INTEGER :: J1,J2,JMOD,INUCT,JL
+REAL,DIMENSION(SIZE(PS0,1)) ::MEM_PS0,ADJU2
+REAL::AER_RAD
+REAL, DIMENSION(SIZE(PRHOD,1)) :: ZFLAG_ACT !Flag for activation
+!
+INTEGER :: IRESP ! Return code of FM routines
+INTEGER :: ILUOUT ! Logical unit of output listing
+CHARACTER(LEN=100) :: YMSG
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZCHEN_MULTI,ZTMP
+REAL, DIMENSION(:), ALLOCATABLE :: ZZW1, ZZW2, ZZW6, ZVEC1
+INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC1 ! Vectors of indices for
+ ! interpolations
+
+!
+INUCT = SIZE(PTT,1)
+!
+!
+ ALLOCATE(ZZW1(INUCT))
+ ALLOCATE(ZZW2(INUCT))
+ ALLOCATE(ZZW6(INUCT))
+ ALLOCATE(ZCHEN_MULTI(INUCT,NMOD_CCN))
+ ALLOCATE(ZTMP(INUCT,NMOD_CCN))
+ ALLOCATE(ZVEC1(INUCT))
+ ALLOCATE(IVEC1(INUCT))
+!
+!
+ DO JL=1,INUCT
+ DO JMOD = 1,NMOD_CCN
+ ZCHEN_MULTI(JL,JMOD) = (PNFS(JL,JMOD)+PNAS(JL,JMOD))*PRHOD(JL) &
+ / XLIMIT_FACTOR(JMOD)
+ ENDDO
+ END DO
+!print*,'ZCHEN_MULTI=',MINVAL(ZCHEN_MULTI(:,1)), MAXVAL(ZCHEN_MULTI(:,1)), &
+! 'ZCHEN_MULTI(1,1)=',ZCHEN_MULTI(1,1)
+!
+!* . Compute the nucleus source
+! -----------------------------
+!
+!
+! Modified values for Beta and C (see in init_aerosol_properties) account for that
+!
+ WHERE ( PS0(:) > 0.)
+ ZVEC1(:) = MAX( 1.0001, MIN( REAL(NHYP)-0.0001, &
+ XHYPINTP1*LOG(PS0(:))+XHYPINTP2 ) )
+ IVEC1(:) = INT( ZVEC1(:) )
+ ZVEC1(:) = ZVEC1(:) - REAL( IVEC1(:) )
+ END WHERE
+!print*,'ZVEC1=',MINVAL(ZVEC1), MAXVAL(ZVEC1)
+ ZZW6(:) = 0. ! initialize the change of cloud droplet concentration
+!
+ ZTMP(:,:)=0.0
+!
+! Compute the concentration of activable aerosols for each mode
+! based on the supersaturation ( -> ZTMP )
+!
+ DO JMOD = 1, NMOD_CCN ! iteration on mode number
+ ZZW1(:) = 0.
+ !
+ WHERE( PS0(:)>0.0 )
+ ZZW1(:) = XHYPF12( IVEC1(:)+1,JMOD )* ZVEC1(:) & ! hypergeo function
+ - XHYPF12( IVEC1(:) ,JMOD )*(ZVEC1(:) - 1.0) ! XHYPF12 is tabulated
+ !
+ ZTMP(:,JMOD) = (ZCHEN_MULTI(:,JMOD)/PRHOD(:))*PS0(:)**XKHEN_MULTI(JMOD) &
+ *ZZW1(:)
+ ! ZTMP(:,JMOD) = (ZCHEN_MULTI(:,JMOD)/PRHOD(:))*100*PS0(:)**XKHEN_MULTI(JMOD) &
+ ENDWHERE
+!print*,'ZZW1=',MINVAL(ZZW1), MAXVAL(ZZW1)
+!print*,'ZTMP=',MINVAL(ZTMP), MAXVAL(ZTMP)
+ ENDDO
+!
+! Compute the concentration of aerosols activated at this time step
+! as the difference between ZTMP and the aerosols already activated at t-dt (ZZW1)
+!
+ DO JMOD = 1, NMOD_CCN ! iteration on mode number
+ ZZW2(:) = 0.
+ !
+! WHERE( SUM(ZTMP(:,:),DIM=2)*PTSTEP .GT. 15.E6/PRHOD(:) )
+ ZZW2(:) = MIN( PNFS(:,JMOD),MAX( ZTMP(:,JMOD)- PNAS(:,JMOD) , 0.0 ) )
+! ENDWHERE
+!print*,'ZTMP=',ZTMP(:,1)
+!print*,'PNAS=',PNAS(:,1)
+!print*,'PNFS=',PNFS(:,1)
+!print*,'ZZW2=',ZZW2(:)
+ !
+ !* update the concentration of activated CCN = Na
+ !
+ PNAS(:,JMOD) = (PNAS(:,JMOD) + ZZW2(:))
+ !
+ !* update the concentration of free CCN = Nf
+ !
+ PNFS(:,JMOD) = (PNFS(:,JMOD) - ZZW2(:))
+ !
+ !* prepare to update the cloud water concentration
+ !
+ ZZW6(:) = ZZW6(:) + ZZW2(:)
+!print*,'ZZW6=',MINVAL(ZZW6), MAXVAL(ZZW6)
+ ENDDO
+!
+!FLAG ACTIVE A TRUE (1.0) si on active pas
+ZFLAG_ACT(:)=0.0
+DO J2=1,SIZE(PRC,1)
+ IF (ZZW2(J2).EQ.0.0) THEN
+ ZFLAG_ACT(J2)=1.0
+ ENDIF
+!print*,'ZFLAG_ACT=',ZFLAG_ACT(J2)
+ENDDO
+!
+! Mean radius
+!minimum radius of cloud droplet
+AER_RAD=1.0E-6
+ZRMOY(:)=0.0
+DO J2=1,SIZE(PRC,1)
+ IF ((PRC(J2).NE.0.) .AND. (PCCS(J2).NE.0.)) THEN
+ ZRMOY(J2)=(MOMG(XALPHAC,XNUC,3.0)*4.0*XPI*PCCS(J2)*XRHOLW/&
+ (3.0*PRC(J2)*PRHOD(J2)))**(1.0/3.0)
+ ZRMOY(J2)=(PCCS(J2)*MOMG(XALPHAC,XNUC,1.0)/ZRMOY(J2))
+ ENDIF
+!ZRMOY(J2)=ZRMOY(J2)+(ZZW2(J2)*AER_RAD)
+ ZRMOY(J2)=ZRMOY(J2)+(ZZW6(J2)*AER_RAD)
+ENDDO
+ !print*,'prognos RMOY=',MINVAL(ZRMOY),MAXVAL(ZRMOY)
+!
+! PCCS(:) = ZZW6(:) * PTSTEP
+ PCCS(:) = PCCS(:) + ZZW6(:)
+ !print*,'prognos PCCS=',MINVAL(PCCS),MAXVAL(PCCS)
+!
+!CALCUL DE A1 => Estimation de (drs/dt)f
+!T(=Ã determiner) avant forcage; T'(=PTT) apres forcage
+!Calcul de ZTT1: calculé en inversant S0(T)jusqu'à T:
+! l'erreur faite sur cette inversion est supérieur à la précision
+! recherchée, on applique à rs(T') pour cxalculer le DT=T'-T qui
+! correspond à la variation rs(T')-rs(T). Permet de recuperer une valeur
+! correcte de DT et donc de determiner T comme T=T'-DT
+!ZRVSAT1=rs(T)
+!
+!print*,'prognos : PS0=',MINVAL(PS0),MAXVAL(PS0)
+ZRVSAT1(:)=PRV(:)/(PS0(:)+1.0)
+!ZTT1<--es(T) de rs(T)
+ZTT1_TEMP(:)=PPRES(:)*((((XMV / XMD)/ZRVSAT1(:))+1.0)**(-1D0))
+!ZTT1<--T de es(T)
+ZTT1_TEMP(:)=LOG(ZTT1_TEMP(:)/610.8)
+ZTT1_TEMP(:)=(31.25*ZTT1_TEMP(:) -17.5688*273.15)/(ZTT1_TEMP(:) - 17.5688)
+!es(T')
+ZW1(:)=EXP(XALPW-XBETAW/PTT(:)-XGAMW*LOG(PTT(:)))
+!ZRVSAT2=rs(T')
+ZRVSAT2(:)=(XMV / XMD)*ZW1(:)/(PPRES(:)-ZW1(:))
+!ZTT2<--es(T') de rs(T')
+ZTT2_TEMP(:)=PPRES(:)*((((XMV / XMD)/ZRVSAT2(:))+1.0)**(-1D0))
+!ZTT2<--T' de es(T')
+IF (MINVAL(ZTT2_TEMP).LT.0.0) THEN
+ WRITE(YMSG,*) 'ZTT2_TEMP',MINVAL(ZTT2_TEMP),MINLOC(ZTT2_TEMP)
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','PROGNOS_LIMA',YMSG)
+ENDIF
+!
+ZTT2_TEMP(:)=LOG(ZW1(:)/610.8)
+ZTT2_TEMP(:)=(31.25*ZTT2_TEMP(:) -17.5688*273.15)/(ZTT2_TEMP(:) - 17.5688)
+!ZTT1=T'-DT
+ZTT1(:)=PTT(:)-(ZTT2_TEMP(:)-ZTT1_TEMP(:))
+!Lv(T)
+ZLV(:) = XLVTT+(XCPV-XCL)*(ZTT1(:)-XTT)
+!
+ZA1(:)=-(((PS0(:)+1.0)**2.0)/PRV(:))*(ZRVSAT2(:)-(PRV(:)/(PS0(:)+1.0)))/PTSTEP
+!G
+ZG(:)= 1.0/(XRHOLW*((XRV*ZTT1(:)/(XDIVA*EXP(XALPW-(XBETAW/ZTT1(:))-(XGAMW*LOG(ZTT1(:)))))) &
++((ZLV(:)/(XTHCO*ZTT1(:)))*((ZLV(:)/(ZTT1(:)*XRV))-1.0))))
+!
+ZC(:)=4.0*XPI*(XRHOLW/PRHOD(:))*ZG(:)
+ZDZRC(:)=0.0
+ZDZRC(:)=ZC(:)*PS0(:)*ZRMOY(:)
+MEM_PS0(:)=PS0(:)
+!CALCUL DE B => Estimation de (drs/dT)ce
+!T(=PTT) avant condensation; T'(=Ã determiner) apres condensation
+!Lv(T),Cph(T)
+ZLV(:) = XLVTT+(XCPV-XCL)*(PTT(:)-XTT)
+ZCPH(:)= XCPD+XCPV*PRV(:)+XCL*(PRC(:)+PRR(:))
+!T'=T+(DT)ce
+ZTT1(:)=PTT(:)+(ZDZRC(:)*PTSTEP*ZLV(:)/ZCPH(:))
+!es(T')
+ZW1(:)=EXP(XALPW-XBETAW/PTT(:)-XGAMW*LOG(PTT(:)))
+!rs(T')
+ZW1(:)=(XMV / XMD)*ZW1(:)/(PPRES(:)-ZW1(:))
+!es(Tcond)
+ZW2(:)=EXP(XALPW-XBETAW/ZTT1(:)-XGAMW*LOG(ZTT1(:)))
+!rs(Tcond)
+ZW2(:)=(XMV / XMD)*ZW2(:)/(PPRES(:)-ZW2(:))
+!
+WHERE (ZTT1(:).NE.PTT(:))
+ ZB(:)=(ZLV(:)/ZCPH(:))*((ZW2(:)-ZW1(:))/(ZTT1(:)-PTT(:)))
+ELSEWHERE
+ ZB(:)=0.0
+ ZDZRC(:)=0.0
+ENDWHERE
+!Calcul de S+dS
+PS0(:)=PS0(:)+((ZA1(:)-(((ZB(:)*(PS0(:)+1.0)+1.0)*ZDZRC(:))/ZRVSAT1(:)))*PTSTEP)
+!
+PS0=MAX(PS0,-0.98)
+!Ajustement tel que rv=(s+1)*rvs
+ZTL(:)=PTT(:)-(PLV(:)/PCPH(:))*PRC(:)
+ZRT(:)=PRC(:)+PRV(:)
+ZDZRC2(:)=PRC(:)
+DO J2=1,SIZE(ZDZRC,1)
+ IF ((ZDZRC(J2).NE.0.0).OR.(ZDZRC2(J2).NE.0.0)) THEN
+ DO J1=1,5
+ ZLV(J2) = XLVTT+(XCPV-XCL)*(PTT(J2)-XTT)
+ ZCPH(J2)=XCPD+XCPV*PRV(J2)+XCL*(PRC(J2)+PRR(J2))
+ ZW1(J2)=EXP(XALPW-XBETAW/PTT(J2)-XGAMW*LOG(PTT(J2)))
+ ZRVSAT1(J2)=(XMV / XMD)*ZW1(J2)/(PPRES(J2)-ZW1(J2))
+ PRV(J2)=MIN(ZRT(J2),(PS0(J2)+1.0)*ZRVSAT1(J2))
+ PRC(J2)=MAX(ZRT(J2)-PRV(J2),0.0)
+ PTT(J2)=0.5*PTT(J2)+0.5*(ZTL(J2)+(ZLV(J2)*PRC(J2)/ZCPH(J2)))
+ ENDDO
+ ZLV(J2) = XLVTT+(XCPV-XCL)*(PTT(J2)-XTT)
+ ZCPH(J2)=XCPD+XCPV*PRV(J2)+XCL*(PRC(J2)+PRR(J2))
+ PTT(J2)=ZTL(J2)+(ZLV(J2)*PRC(J2)/ZCPH(J2))
+ ENDIF
+ENDDO
+ADJU2(:)=0.0
+!
+!Correction dans les mailles où ds a été surestimée
+ZDZRC2(:)=PRC(:)-ZDZRC2(:)
+WHERE ((MEM_PS0(:).LE.0.0).AND.(PS0(:).GT.0.0).AND.(ZDZRC2(:).LT.0.0))
+ PS0(:)=0.0
+ ADJU2(:)=1.0
+ENDWHERE
+!
+WHERE ((MEM_PS0(:).GE.0.0).AND.(PS0(:).LT.0.0).AND.(ZDZRC2(:).GT.0.0))
+ PS0(:)=0.0
+ ADJU2(:)=1.0
+ENDWHERE
+!
+DO J2=1,SIZE(ADJU2,1)
+ IF (ADJU2(J2)==1) THEN
+ DO J1=1,5
+ ZLV(J2) = XLVTT+(XCPV-XCL)*(PTT(J2)-XTT)
+ ZCPH(J2)=XCPD+XCPV*PRV(J2)+XCL*(PRC(J2)+PRR(J2))
+ ZW1(J2)=EXP(XALPW-XBETAW/PTT(J2)-XGAMW*LOG(PTT(J2)))
+ ZRVSAT1(J2)=(XMV / XMD)*ZW1(J2)/(PPRES(J2)-ZW1(J2))
+ PRV(J2)=MIN(ZRT(J2),(PS0(J2)+1.0)*ZRVSAT1(J2))
+ PRC(J2)=MAX(ZRT(J2)-PRV(J2),0.0)
+ PTT(J2)=0.5*PTT(J2)+0.5*(ZTL(J2)+(ZLV(J2)*PRC(J2)/ZCPH(J2)))
+ ENDDO
+ ZLV(J2) = XLVTT+(XCPV-XCL)*(PTT(J2)-XTT)
+ ZCPH(J2)=XCPD+XCPV*PRV(J2)+XCL*(PRC(J2)+PRR(J2))
+ PTT(J2)=ZTL(J2)+(ZLV(J2)*PRC(J2)/ZCPH(J2))
+ ENDIF
+ENDDO
+!
+!Elimination de l'eau liquide dans les mailles où le rayon des gouttelettes est
+!inférieur à AER_RAD
+ZRMOY(:)=0.0
+DO J2=1,SIZE(PRC,1)
+ IF ((PRC(J2).NE.0.) .AND. (PCCS(J2).NE.0.)) THEN
+ ZRMOY(J2)=(MOMG(XALPHAC,XNUC,3.0)*4.0*XPI*PCCS(J2)*XRHOLW/&
+ (3.0*PRC(J2)*PRHOD(J2)))**(1.0/3.0)
+ ZRMOY(J2)=MOMG(XALPHAC,XNUC,1.0)/ZRMOY(J2)
+ IF ((ZFLAG_ACT(J2).EQ.1.0).AND.(MEM_PS0(J2).LT.0.0).AND.(ZRMOY(J2).LT.AER_RAD)) THEN
+ PTT(J2)=ZTL(J2)
+ PRV(J2)=ZRT(J2)
+ PRC(J2)=0.0
+ ENDIF
+ ENDIF
+ENDDO
+!
+!Calcul de S au regard de T et rv en fin de pas de temps
+ZW1=EXP(XALPW-XBETAW/PTT(:)-XGAMW*LOG(PTT(:)))
+ !rvsat
+ZRVSAT1(:)=(XMV / XMD)*ZW1(:)/(PPRES-ZW1(:))
+!
+WHERE (PRC(:)==0.0D0)
+ PS0(:)=(PRV(:)/ZRVSAT1(:))-1D0
+ENDWHERE
+!
+ DEALLOCATE(ZZW1,ZZW2,ZZW6,ZCHEN_MULTI,ZTMP,ZVEC1,IVEC1)
+!
+!
+CONTAINS
+!
+FUNCTION MOMG (PALPHA,PNU,PP) RESULT (PMOMG)
+USE MODI_GAMMA
+IMPLICIT NONE
+REAL :: PALPHA ! first shape parameter of the DIMENSIONnal distribution
+REAL :: PNU ! second shape parameter of the DIMENSIONnal distribution
+REAL :: PP ! order of the moment
+REAL :: PMOMG ! result: moment of order ZP
+PMOMG = GAMMA(PNU+PP/PALPHA)/GAMMA(PNU)
+!
+END FUNCTION MOMG
+!
+END SUBROUTINE PROGNOS_LIMA
diff --git a/src/mesonh/micro/radar_rain_ice.f90 b/src/mesonh/micro/radar_rain_ice.f90
new file mode 100644
index 000000000..eddac2294
--- /dev/null
+++ b/src/mesonh/micro/radar_rain_ice.f90
@@ -0,0 +1,486 @@
+!MNH_LIC Copyright 1996-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+
+! ##########################
+ MODULE MODI_RADAR_RAIN_ICE
+! ##########################
+!
+INTERFACE
+ SUBROUTINE RADAR_RAIN_ICE(PRT,PCIT,PRHODREF,PTEMP,PRARE,PVDOP,PRZDR,PRKDP,&
+ PCRT)
+!
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! microphysical mix. ratios at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! pristine ice concentration at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! density of the ref. state
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTEMP ! air temperature
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRARE! radar reflectivity in dBZ
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PVDOP! radar Doppler fall speed
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRZDR! radar differential reflectivity
+ ! H-V in dBZ
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRKDP! radar differential phase shift
+ ! H-V in degree/km
+REAL, DIMENSION(:,:,:), INTENT(IN),OPTIONAL :: PCRT ! rain concentration at t
+
+!
+END SUBROUTINE RADAR_RAIN_ICE
+!
+END INTERFACE
+!
+END MODULE MODI_RADAR_RAIN_ICE
+! #########################################################################
+ SUBROUTINE RADAR_RAIN_ICE(PRT,PCIT,PRHODREF,PTEMP,PRARE,PVDOP,PRZDR,PRKDP,PCRT)
+! #########################################################################
+!
+!!**** *RADAR_RAIN_ICE * - computes some pertinent radar parameters
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the equivalent reflectivity,
+!! the Doppler reflectivity and the H and V polarized reflectivities of a
+!! mixed phase cloud.
+!!
+!!** METHOD
+!! ------
+!! The reflectivities are computed using the n(D) * D**6 formula. The
+!! equivalent reflectiviy is the sum of the reflectivity produced by the
+!! the raindrops and the equivalent reflectivities of the ice crystals.
+!! The latter are computed using the melted diameter. The Doppler
+!! reflectivity is the 'fall speed'-moment of individual particle
+!! reflectivity. Ice crystal are assumed to have no preferred orientation.
+!! the Z_VV formula is taken from Brandes et al. (MWR, 1995).
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST
+!! XPI !
+!! XRHOLW ! Liquid water density
+!! Module MODD_RAIN_ICE_DESCR
+!! Module MODD_RAIN_ICE_PARAM
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation ( routine RADAR_RAIN_ICE )
+!! Smith P.L., 1984: Equivalent Radar Reflectivity Factors for Snow and
+!! Ice Particles, JCAM, 23, 1258-1260.
+!! Andsager K., K. V. Beard, and N. F. Laird, 1999: Laboratory Measurements
+!! of Axis Ratio for Large Raindrops, JAS, 56, 2673-2683.
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 04/05/96
+!! 03/12/96 change the arg. list
+!! 15/12/00 change the reflectivity factor
+!! 01/07/02 (E.Richard) bug in reflectivity formula
+!! for graupeln when warmer than 0°C
+!! 19/12/00 (JP Pinty) change the hailstone reflectivity
+!! 19/05/04 (JP Pinty) add ZDR and KDP for raindops at 10.71 cm
+!! J.-P. Chaboureau 17/06/10 bug correction in reflectivity calculation of icy hydrometeors
+!! J.-P. Chaboureau 03/02/12 set undef values for radar reflectivities
+!! O. Caumont 09/04/14 correction of ZDR calculation
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_REF
+USE MODD_RAIN_ICE_DESCR, ONLY: XALPHAR_I=>XALPHAR,XNUR_I=>XNUR,XLBEXR_I=>XLBEXR,&
+ XLBR_I=>XLBR,XCCR_I=>XCCR,XBR_I=>XBR,XAR_I=>XAR,&
+ XALPHAC_I=>XALPHAC,XNUC_I=>XNUC,&
+ XLBC_I=>XLBC,XBC_I=>XBC,XAC_I=>XAC,&
+ XALPHAC2_I=>XALPHAC2,XNUC2_I=>XNUC2,&
+ XALPHAS_I=>XALPHAS,XNUS_I=>XNUS,XLBEXS_I=>XLBEXS,&
+ XLBS_I=>XLBS,XCCS_I=>XCCS,XAS_I=>XAS,XBS_I=>XBS,XCXS_I=>XCXS,&
+ XALPHAG_I=>XALPHAG,XNUG_I=>XNUG,XDG_I=>XDG,XLBEXG_I=>XLBEXG,&
+ XLBG_I=>XLBG,XCCG_I=>XCCG,XAG_I=>XAG,XBG_I=>XBG,XCXG_I=>XCXG,XCG_I=>XCG,&
+ XALPHAI_I=>XALPHAI,XNUI_I=>XNUI,XDI_I=>XDI,XLBEXI_I=>XLBEXI,&
+ XLBI_I=>XLBI,XAI_I=>XAI,XBI_I=>XBI,XC_I_I=>XC_I,XCS_I=>XCS,XDS_I=>XDS,&
+ XRTMIN_I=>XRTMIN,XCONC_LAND,XCONC_SEA,XCR_I=>XCR,XDR_I=>XDR,&
+ XAH_I=>XAH,XLBH_I=>XLBH,XLBEXH_I=>XLBEXH,XCCH_I=>XCCH,&
+ XALPHAH_I=>XALPHAH,XNUH_I=>XNUH,XCXH_I=>XCXH,XDH_I=>XDH,XCH_I=>XCH,XBH_I=>XBH
+USE MODD_PARAM_LIMA_WARM, ONLY: XLBEXR_L=>XLBEXR,XLBR_L=>XLBR,XBR_L=>XBR,XAR_L=>XAR,&
+ XBC_L=>XBC,XAC_L=>XAC,XCR_L=>XCR,XDR_L=>XDR
+USE MODD_PARAM_LIMA_COLD, ONLY: XDI_L=>XDI,XLBEXI_L=>XLBEXI,XLBI_L=>XLBI,XAI_L=>XAI,XBI_L=>XBI,XC_I_L=>XC_I,&
+ XLBEXS_L=>XLBEXS,XLBS_L=>XLBS,XCCS_L=>XCCS,&
+ XAS_L=>XAS,XBS_L=>XBS,XCXS_L=>XCXS,XCS_L=>XCS,XDS_L=>XDS
+
+USE MODD_PARAM_LIMA_MIXED, ONLY:XDG_L=>XDG,XLBEXG_L=>XLBEXG,XLBG_L=>XLBG,XCCG_L=>XCCG,&
+ XAG_L=>XAG,XBG_L=>XBG,XCXG_L=>XCXG,XCG_L=>XCG,&
+ XAH_L=>XAH,XLBH_L=>XLBH,XLBEXH_L=>XLBEXH,XCCH_L=>XCCH,&
+ XCXH_L=>XCXH,XDH_L=>XDH,XCH_L=>XCH,XALPHAH_L=>XALPHAH,XNUH_L=>XNUH,XBH_L=>XBH
+
+USE MODD_PARAM_LIMA, ONLY: XALPHAR_L=>XALPHAR,XNUR_L=>XNUR,XALPHAS_L=>XALPHAS,XNUS_L=>XNUS,&
+ XALPHAG_L=>XALPHAG,XNUG_L=>XNUG, XALPHAI_L=>XALPHAI,XNUI_L=>XNUI,&
+ XRTMIN_L=>XRTMIN,XALPHAC_L=>XALPHAC,XNUC_L=>XNUC
+USE MODD_PARAMETERS
+USE MODD_PARAM_n, ONLY : CCLOUD
+USE MODD_LUNIT
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+!
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! microphysical mix. ratios at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! pristine ice concentration at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! density of the ref. state
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTEMP ! air temperature
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRARE! radar reflectivity in dBZ
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PVDOP! radar Doppler fall speed
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRZDR! radar differential reflectivity
+ ! H-V in dBZ
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRKDP! radar differential phase shift
+ ! H-V in degree/km
+REAL, DIMENSION(:,:,:), INTENT(IN),OPTIONAL :: PCRT ! rain concentration at t
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IKB ! Coordinates of the first physical points along z
+INTEGER :: IND ! Number of interval to integrate the kernels
+REAL :: ZALPHA, ZNU, ZP ! Parameters to compute the value of the p_moment
+ ! of the generalized Gamma function
+REAL :: ZDINFTY ! Factor used to define the "infinite" diameter
+!
+REAL :: ZCXR=-1.0 ! for rain N ~ 1/N_0
+ ! (in Kessler parameterization)
+REAL :: ZSLOPE, ZINTERCEPT, ZEXPONENT ! parameters defining the mean axis ratio
+ ! functionnal
+REAL :: ZDMELT_FACT ! factor used to compute the equivalent
+ ! melted diameter
+REAL :: ZEQICE ! factor used to convert the ice crystals
+ ! reflectivity into an equivalent liquid
+ ! water reflectivity (from Smith, JCAM 84)
+REAL :: ZEXP ! anciliary parameter
+REAL :: ZRHO00 ! Surface reference air density
+!
+LOGICAL, DIMENSION(SIZE(PTEMP,1),SIZE(PTEMP,2),SIZE(PTEMP,3)) :: GRAIN
+REAL, DIMENSION(SIZE(PTEMP,1),SIZE(PTEMP,2),SIZE(PTEMP,3)) :: ZLBDA
+ ! slope distribution parameter
+REAL, DIMENSION(SIZE(PTEMP,1),SIZE(PTEMP,2),SIZE(PTEMP,3)) :: ZW
+REAL, DIMENSION(SIZE(PTEMP,1),SIZE(PTEMP,2),SIZE(PTEMP,3)) :: ZREFL_MELT_CONV
+INTEGER :: JLBDA
+REAL :: ZFRAC_WATER
+!
+LOGICAL :: GFLAG ! Logical flag for printing the constatnts on the output
+ ! listing
+!
+REAL :: ZR0, ZR1, ZR2 ! r(D) parameters
+!REAL :: ZREXP, ZSCALE ! parameters to compute Zhh from Zvv
+REAL :: Z1, Z2, Z3 ! expansion coefficients
+!
+INTEGER :: II, IJ, IK
+!
+!REAL :: ZA,ZB,ZCX,ZALPHA,ZNU,ZLB,ZLBEX,ZRHOHYD ! generic microphysical parameters
+!REAL,DIMENSION(:),ALLOCATABLE :: ZRTMIN ! local values for XRTMIN
+
+REAL, DIMENSION(SIZE(PTEMP,1),SIZE(PTEMP,2),SIZE(PTEMP,3)) :: ZLB_L
+REAL :: ZLB,ZLBEX , ZCC,ZCX,ZC,ZD
+
+!-------------------------------------------------------------------------------
+!
+!
+!* 1. FUNCTION STATEMENTS
+! -------------------
+!
+!
+!* 1.1 p_moment of the Generalized GAMMA function
+!
+! Recall that MOMG(ZALPHA,ZNU,ZP)=GAMMA(ZNU+ZP/ZALPHA)/GAMMA(ZNU)
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+! 2. INTIALIZE OUTPUT LISTING AND OTHER ARRAYS
+! -----------------------------------------
+!
+!
+PRARE(:,:,:) = 0.0 ! radar reflectivity
+PVDOP(:,:,:) = 0.0 ! radar Doppler fall speed
+PRZDR(:,:,:) = 0.0 ! radar differential reflectivity
+PRKDP(:,:,:) = 0.0 ! radar differential phase shift
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 3. RAINDROPS
+! ---------
+!
+IF (SIZE(PRT,4) >= 3) THEN
+ IND = 50
+ ZSLOPE = 0.62 ! the mean axis ratio function writes as r**ZEXPONENT
+ ZINTERCEPT = 1.03 ! with
+ ZEXPONENT = 7.0/3.0 ! r = ZSLOPE*D+ZINTERCEPT where D is the drop diameter
+ ZDINFTY = 20.0
+!
+! The raindrop aspect ratio is given by Andsager et al. (1999)
+! r(D) = ZR0 + ZR1*D + ZR2*D**2
+!
+ ZR0 = 1.012
+ ZR1 = -0.144E2
+ ZR2 = -1.03E4
+!
+! ZREXP = 7.0/3.0
+! ZSCALE = ZR0**ZREXP
+! Z1 = ZREXP*(ZR1/ZR0)
+! Z2 = ZREXP*(ZR2/ZR0)+ZREXP*(ZREXP-1.0)*0.5*(ZR1/ZR0)**2
+ Z1=.97
+ Z2=.64
+ Z3=7.8
+!
+ ZLBDA(:,:,:) = 0.0
+ IF (CCLOUD == 'LIMA') THEN
+ GRAIN(:,:,:) =( (PRT(:,:,:,3).GT.XRTMIN_L(3)).AND. PCRT(:,:,:).GT.0.0)
+ ZLBEX=1.0/(-XBR_L)
+ ZLB_L(:,:,:)=( XAR_L*PCRT(:,:,:)*PRHODREF(:,:,:)*MOMG(XALPHAR_L,XNUR_L,XBR_L) )**(-ZLBEX)
+ WHERE( GRAIN(:,:,:) )
+ ZLBDA(:,:,:) =ZLB_L(:,:,:) *( PRHODREF(:,:,:)*PRT(:,:,:,3) )**(ZLBEX)
+ PRARE(:,:,:) = 1.E18*PCRT(:,:,:)*PRHODREF(:,:,:)*(ZLBDA(:,:,:)**(-6.0))*MOMG(XALPHAR_L,XNUR_L,6.0)
+ PVDOP(:,:,:) = 1.E18*PCRT(:,:,:)*PRHODREF(:,:,:)*XCR_L*(ZLBDA(:,:,:)**(-6.0-XDR_L)) &
+ *MOMG(XALPHAR_L,XNUR_L,6.0+XDR_L)
+ PRZDR(:,:,:) = Z1+Z2*(PRHODREF(:,:,:)*PRT(:,:,:,3))**(-ZLBEX)+Z3*(PRHODREF(:,:,:)*PRT(:,:,:,3))**(-2.*ZLBEX)
+ PRZDR(:,:,:) = 10.0*LOG10( PRZDR(:,:,:) ) ! now in dBZ
+ PRKDP(:,:,:) = 6.7E3*( PRHODREF(:,:,:)*PRT(:,:,:,3) )* &
+ (-ZR1*(MOMG(XALPHAR_L,XNUR_L,4.0)/MOMG(XALPHAR_L,XNUR_L,3.0))*(1.0/ZLBDA(:,:,:)) &
+ -ZR2*(MOMG(XALPHAR_L,XNUR_L,5.0)/MOMG(XALPHAR_L,XNUR_L,3.0))*(1.0/ZLBDA(:,:,:)**2))
+ ! in degree/km
+ END WHERE
+ ELSE
+ IF( SIZE(PRT,4) == 3 ) THEN
+ GRAIN(:,:,:) = PRT(:,:,:,3).GT.1.0E-15
+ ZCC = 1.E7; ZLBEX = -0.25 ! Marshall-Palmer law
+ ZALPHA = 1.0; ZNU = 1.0 ! Marshall-Palmer law
+ ZC = 842.; ZD = 0.8 ! Raindrop fall-speed
+ ZLB = (XPI*XRHOLW*ZCC)**(-XLBEXR_I)
+ ELSE
+ ZLB=XLBR_I
+ ZLBEX=XLBEXR_I
+ ZCC=XCCR_I
+ ZALPHA=XALPHAR_I
+ ZNU=XNUR_I
+ ZC=XCR_I
+ ZD=XDR_I
+ GRAIN(:,:,:) = PRT(:,:,:,3).GT.XRTMIN_I(3)
+ END IF
+ WHERE( GRAIN(:,:,:) )
+ ZLBDA(:,:,:) = ZLB*( PRHODREF(:,:,:)*PRT(:,:,:,3) )**ZLBEX
+ PRARE(:,:,:) = 1.E18*ZCC*(ZLBDA(:,:,:)**(ZCXR-6.0))*MOMG(ZALPHA,ZNU,6.0)
+ PVDOP(:,:,:) = 1.E18*ZCC*ZC*(ZLBDA(:,:,:)**(ZCXR-6.0-ZD)) &
+ *MOMG(ZALPHA,ZNU,6.0+ZD)
+ PRZDR(:,:,:) = Z1+Z2*(PRHODREF(:,:,:)*PRT(:,:,:,3))**(-ZLBEX)+Z3*(PRHODREF(:,:,:)*PRT(:,:,:,3))**(-2.*ZLBEX)
+ PRZDR(:,:,:) = 10.0*LOG10( PRZDR(:,:,:) ) ! now in dBZ
+ PRKDP(:,:,:) = 6.7E3*( PRHODREF(:,:,:)*PRT(:,:,:,3) )* &
+ (-ZR1*(MOMG(ZALPHA,ZNU,4.0)/MOMG(ZALPHA,ZNU,3.0))*(1.0/ZLBDA(:,:,:)) &
+ -ZR2*(MOMG(ZALPHA,ZNU,5.0)/MOMG(ZALPHA,ZNU,3.0))*(1.0/ZLBDA(:,:,:)**2))
+ ! in degree/km
+ END WHERE
+ ENDIF
+
+END IF
+
+
+!
+!* 4. PRISTINE ICE
+! ------------
+!
+IF (SIZE(PRT,4) >= 4) THEN
+ ZEQICE = 0.224
+ IF (CCLOUD == 'LIMA') THEN
+ ZDMELT_FACT = ( (6.0*XAI_L)/(XPI*XRHOLW) )**(2.0)
+ ZEXP = 2.0*XBI_L
+ WHERE( PRT(:,:,:,4).GT.XRTMIN_L(4) .AND. PCIT(:,:,:).GT.0.0 )
+ ZLBDA(:,:,:) = XLBI_L**(XLBEXI_L)* (PRT(:,:,:,4)/PCIT(:,:,:))**(-XLBEXI_L)
+ ZW(:,:,:) = ZEQICE*ZDMELT_FACT *1.E18*PRHODREF(:,:,:)*PCIT(:,:,:)*(ZLBDA(:,:,:)**(-ZEXP))*MOMG(XALPHAI_L,XNUI_L,ZEXP)
+ PVDOP(:,:,:) = PVDOP(:,:,:)+ZEQICE*ZDMELT_FACT*MOMG(XALPHAI_L,XNUI_L,ZEXP+XDI_L) &
+ *1.E18*PRHODREF(:,:,:)*PCIT(:,:,:)*XC_I_L*(ZLBDA(:,:,:)**(-ZEXP-XDI_L))
+ PRARE(:,:,:) = PRARE(:,:,:) + ZW(:,:,:)
+ END WHERE
+ ELSE
+ ZDMELT_FACT = ( (6.0*XAI_I)/(XPI*XRHOLW) )**(2.0)
+ ZEXP = 2.0*XBI_I
+ WHERE( PRT(:,:,:,4).GT.XRTMIN_I(4) .AND. PCIT(:,:,:).GT.0.0 )
+ ZLBDA(:,:,:) = XLBI_I*( PRHODREF(:,:,:)*PRT(:,:,:,4)/PCIT(:,:,:) )**XLBEXI_I
+ ZW(:,:,:) = ZEQICE*ZDMELT_FACT*1.E18*PCIT(:,:,:)*(ZLBDA(:,:,:)**(-ZEXP))*MOMG(XALPHAI_I,XNUI_I,ZEXP)
+ PVDOP(:,:,:) = PVDOP(:,:,:)+ZEQICE*ZDMELT_FACT*MOMG(XALPHAI_I,XNUI_I,ZEXP+XDI_I) &
+ *1.E18*PCIT(:,:,:)*XC_I_I*(ZLBDA(:,:,:)**(-ZEXP-XDI_I))
+ PRARE(:,:,:) = PRARE(:,:,:) + ZW(:,:,:)
+ END WHERE
+ END IF
+END IF
+!
+!* 5. SNOW/AGGREGATES
+! ---------------
+!
+IF (SIZE(PRT,4) >= 5) THEN
+ IF (CCLOUD=='LIMA') THEN
+ ZDMELT_FACT = ( (6.0*XAS_L)/(XPI*XRHOLW) )**(2.0)
+ ZEXP = 2.0*XBS_L
+ WHERE( PRT(:,:,:,5).GT.XRTMIN_L(5) )
+ ZLBDA(:,:,:) = XLBS_L*( PRHODREF(:,:,:)*PRT(:,:,:,5) )**XLBEXS_L
+ ZW(:,:,:) = ZEQICE*ZDMELT_FACT &
+ *1.E18*XCCS_L*(ZLBDA(:,:,:)**(XCXS_L-ZEXP))*MOMG(XALPHAS_L,XNUS_L,ZEXP)
+ PVDOP(:,:,:) = PVDOP(:,:,:)+ZEQICE*ZDMELT_FACT*MOMG(XALPHAS_L,XNUS_L,ZEXP+XDS_L) &
+ *1.E18*XCCS_L*XCS_L*(ZLBDA(:,:,:)**(XCXS_L-ZEXP-XDS_L))
+ PRARE(:,:,:) = PRARE(:,:,:) + ZW(:,:,:)
+ END WHERE
+ ELSE
+ ZDMELT_FACT = ( (6.0*XAS_I)/(XPI*XRHOLW) )**(2.0)
+ ZEXP = 2.0*XBS_I
+ WHERE( PRT(:,:,:,5).GT.XRTMIN_I(5) )
+ ZLBDA(:,:,:) = XLBS_I*( PRHODREF(:,:,:)*PRT(:,:,:,5) )**XLBEXS_I
+ ZW(:,:,:) = ZEQICE*ZDMELT_FACT &
+ *1.E18*XCCS_I*(ZLBDA(:,:,:)**(XCXS_I-ZEXP))*MOMG(XALPHAS_I,XNUS_I,ZEXP)
+ PVDOP(:,:,:) = PVDOP(:,:,:)+ZEQICE*ZDMELT_FACT*MOMG(XALPHAS_I,XNUS_I,ZEXP+XDS_I) &
+ *1.E18*XCCS_I*XCS_I*(ZLBDA(:,:,:)**(XCXS_I-ZEXP-XDS_I))
+ PRARE(:,:,:) = PRARE(:,:,:) + ZW(:,:,:)
+ END WHERE
+ ENDIF
+END IF
+!
+!* 6. GRAUPELN
+! --------
+!
+IF (SIZE(PRT,4) >= 6) THEN
+ IF (CCLOUD=='LIMA') THEN
+ ZFRAC_WATER = 0.14
+ ZDMELT_FACT = ( (6.0*XAG_L)/(XPI*XRHOLW) )**(2.0)
+ WHERE( PTEMP(:,:,:).GT.XTT )
+ ZREFL_MELT_CONV(:,:,:) = ((1.0-ZFRAC_WATER)*ZEQICE+ZFRAC_WATER)*ZDMELT_FACT
+ ELSEWHERE
+ ZREFL_MELT_CONV(:,:,:) = ZEQICE*ZDMELT_FACT
+ END WHERE
+!
+ ZEXP = 2.0*XBG_L
+ WHERE( PRT(:,:,:,6).GT.XRTMIN_L(6) )
+ ZLBDA(:,:,:) = XLBG_L*( PRHODREF(:,:,:)*PRT(:,:,:,6) )**XLBEXG_L
+ ZW(:,:,:) = ZREFL_MELT_CONV(:,:,:)*1.E18*XCCG_L* &
+ (ZLBDA(:,:,:)**(XCXG_L-ZEXP))*MOMG(XALPHAG_L,XNUG_L,ZEXP)
+ PVDOP(:,:,:) = PVDOP(:,:,:) + &
+ ZREFL_MELT_CONV(:,:,:)*1.E18*XCCG_L*XCG_L* &
+ (ZLBDA(:,:,:)**(XCXG_L-ZEXP-XDG_L))*MOMG(XALPHAG_L,XNUG_L,ZEXP+XDG_L)
+ PRARE(:,:,:) = PRARE(:,:,:) + ZW(:,:,:)
+ END WHERE
+ ELSE
+ ZFRAC_WATER = 0.14
+ ZDMELT_FACT = ( (6.0*XAG_I)/(XPI*XRHOLW) )**(2.0)
+ WHERE( PTEMP(:,:,:).GT.XTT )
+ ZREFL_MELT_CONV(:,:,:) = ((1.0-ZFRAC_WATER)*ZEQICE+ZFRAC_WATER)*ZDMELT_FACT
+ ELSEWHERE
+ ZREFL_MELT_CONV(:,:,:) = ZEQICE*ZDMELT_FACT
+ END WHERE
+!
+ ZEXP = 2.0*XBG_I
+ WHERE( PRT(:,:,:,6).GT.XRTMIN_I(6) )
+ ZLBDA(:,:,:) = XLBG_I*( PRHODREF(:,:,:)*PRT(:,:,:,6) )**XLBEXG_I
+ ZW(:,:,:) = ZREFL_MELT_CONV(:,:,:)*1.E18*XCCG_I* &
+ (ZLBDA(:,:,:)**(XCXG_I-ZEXP))*MOMG(XALPHAG_I,XNUG_I,ZEXP)
+ PVDOP(:,:,:) = PVDOP(:,:,:) + &
+ ZREFL_MELT_CONV(:,:,:)*1.E18*XCCG_I*XCG_I* &
+ (ZLBDA(:,:,:)**(XCXG_I-ZEXP-XDG_I))*MOMG(XALPHAG_I,XNUG_I,ZEXP+XDG_I)
+ PRARE(:,:,:) = PRARE(:,:,:) + ZW(:,:,:)
+ END WHERE
+ ENDIF
+END IF
+!
+!* 7. HAILSTONES
+! ----------
+!²
+IF (SIZE(PRT,4) >= 7) THEN
+ IF (CCLOUD=='LIMA') THEN
+ ZFRAC_WATER = 1.
+ ZDMELT_FACT = ( (6.0*XAH_L)/(XPI*XRHOLW) )**(2.0)
+ ZREFL_MELT_CONV(:,:,:) = ((1.0-ZFRAC_WATER)*ZEQICE+ZFRAC_WATER)*ZDMELT_FACT
+!
+ ZEXP = 2.0*XBH_L
+ WHERE( PRT(:,:,:,7).GT.XRTMIN_L(7) )
+ ZLBDA(:,:,:) = XLBH_L*( PRHODREF(:,:,:)*PRT(:,:,:,7) )**XLBEXH_L
+ ZW(:,:,:) = ZREFL_MELT_CONV(:,:,:)*1.E18*XCCH_L* &
+ (ZLBDA(:,:,:)**(XCXH_L-ZEXP))*MOMG(XALPHAH_L,XNUH_L,ZEXP)
+ PVDOP(:,:,:) = PVDOP(:,:,:) + &
+ ZREFL_MELT_CONV(:,:,:)*1.E18*XCCH_L*XCH_L* &
+ (ZLBDA(:,:,:)**(XCXH_L-ZEXP-XDH_L))*MOMG(XALPHAH_L,XNUH_L,ZEXP+XDH_L)
+ PRARE(:,:,:) = PRARE(:,:,:) + ZW(:,:,:)
+ END WHERE
+ ELSE
+ ZFRAC_WATER = 1.
+ ZDMELT_FACT = ( (6.0*XAH_I)/(XPI*XRHOLW) )**(2.0)
+ ZREFL_MELT_CONV(:,:,:) = ((1.0-ZFRAC_WATER)*ZEQICE+ZFRAC_WATER)*ZDMELT_FACT
+!
+ ZEXP = 2.0*XBH_I
+ WHERE( PRT(:,:,:,7).GT.XRTMIN_I(7) )
+ ZLBDA(:,:,:) = XLBH_I*( PRHODREF(:,:,:)*PRT(:,:,:,7) )**XLBEXH_I
+ ZW(:,:,:) = ZREFL_MELT_CONV(:,:,:)*1.E18*XCCH_I* &
+ (ZLBDA(:,:,:)**(XCXH_I-ZEXP))*MOMG(XALPHAH_I,XNUH_I,ZEXP)
+ PVDOP(:,:,:) = PVDOP(:,:,:) + &
+ ZREFL_MELT_CONV(:,:,:)*1.E18*XCCH_I*XCH_I* &
+ (ZLBDA(:,:,:)**(XCXH_I-ZEXP-XDH_I))*MOMG(XALPHAH_I,XNUH_I,ZEXP+XDH_I)
+ PRARE(:,:,:) = PRARE(:,:,:) + ZW(:,:,:)
+ END WHERE
+ END IF
+END IF
+!
+!* 8. UNIT CONVERSION
+! ---------------
+!
+IKB = 1 + JPVEXT
+ZRHO00 = XP00/(XRD*XTHVREFZ(IKB))
+WHERE( PRARE(:,:,:) >= 1.0 )
+ PVDOP(:,:,:) = PVDOP(:,:,:)/PRARE(:,:,:) ! Doppler speed normalization in m/s
+ PVDOP(:,:,:) = PVDOP(:,:,:)*(ZRHO00/PRHODREF(:,:,:))**0.4
+ ! air density correction
+ELSEWHERE
+ PVDOP(:,:,:) = 0.0
+END WHERE
+!
+! MODIF FP FEB 2012
+!WHERE( PRARE(:,:,:) > 0.0 )
+WHERE( PRARE(:,:,:) > 1.E-3 )
+! END MODIF
+ PRARE(:,:,:) = 10.0*LOG10( PRARE(:,:,:) ) ! Z_equiv in dBZ
+ELSEWHERE
+ PRARE(:,:,:) = XUNDEF
+END WHERE
+
+
+!
+!-------------------------------------------------------------------------------
+!
+CONTAINS
+!
+ FUNCTION MOMG (PALPHA,PNU,PP) RESULT (PMOMG)
+!
+! auxiliary routine used to compute the Pth moment order of the generalized
+! gamma law
+!
+ USE MODI_GAMMA
+!
+ IMPLICIT NONE
+!
+ REAL :: PALPHA ! first shape parameter of the dimensionnal distribution
+ REAL :: PNU ! second shape parameter of the dimensionnal distribution
+ REAL :: PP ! order of the moment
+ REAL :: PMOMG ! result: moment of order ZP
+!
+!------------------------------------------------------------------------------
+!
+!
+ PMOMG = GAMMA(PNU+PP/PALPHA)/GAMMA(PNU)
+!
+ END FUNCTION MOMG
+!
+!------------------------------------------------------------------------------
+!
+END SUBROUTINE RADAR_RAIN_ICE
diff --git a/src/mesonh/micro/rain_c2r2_khko.f90 b/src/mesonh/micro/rain_c2r2_khko.f90
new file mode 100644
index 000000000..5708c0d4c
--- /dev/null
+++ b/src/mesonh/micro/rain_c2r2_khko.f90
@@ -0,0 +1,1957 @@
+!MNH_LIC Copyright 1996-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ######################
+ MODULE MODI_RAIN_C2R2_KHKO
+! ######################
+!
+INTERFACE
+ SUBROUTINE RAIN_C2R2_KHKO(HCLOUD,OACTIT, OSEDC, ORAIN, KSPLITR, PTSTEP, &
+ KMI,TPFILE, &
+ PZZ, PRHODJ, &
+ PRHODREF, PEXNREF, &
+ PPABST, PTHT, PRVT, PRCT, &
+ PRRT, PTHM, PRCM, PPABSM, &
+ PW_NU,PDTHRAD, PTHS, PRVS, PRCS, PRRS, &
+ PCNT, PCCT, PCRT, PCNS, PCCS, PCRS, &
+ PINPRC, PINPRR, PINPRR3D, PEVAP3D,PAEROT, &
+ PSOLORG, PMI, HACTCCN, &
+ PINDEP, PSUPSAT, PNACT )
+!
+USE MODD_IO, ONLY: TFILEDATA
+!
+CHARACTER(LEN=*), INTENT(IN) :: HCLOUD ! kind of cloud
+
+LOGICAL, INTENT(IN) :: OACTIT ! Switch to activate the
+ ! activation by radiative
+ ! tendency
+LOGICAL, INTENT(IN) :: OSEDC ! switch to activate the
+ ! cloud droplet sedimentation
+LOGICAL, INTENT(IN) :: ORAIN ! switch to activate the
+ ! rain formation by coalescence
+INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step
+ ! integration for rain sedimendation
+REAL, INTENT(IN) :: PTSTEP ! Time step :XTSTEP in namelist
+INTEGER, INTENT(IN) :: KMI ! Model index
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+!
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at time t-Dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Pressure time t-Dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCM ! Cloud water m.r. at time t-Dt
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
+ ! the nucleation param.
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD ! THeta RADiative Tendancy
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCNT ! Water vapor C. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCT ! Cloud water C. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCRT ! Rain water C. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCNS ! Water vapor C. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCS ! Cloud water C. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCRS ! Rain water C. source
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC ! Cloud instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINDEP ! Cloud instant deposition
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR ! Rain instant precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRR3D! Rain inst precip 3D
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D! Rain evap profile
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PAEROT ! Aerosol concentration
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSOLORG ![%] solubility fraction of soa
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PMI
+CHARACTER(LEN=4), INTENT(IN) :: HACTCCN ! kind of CCN activation scheme
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSUPSAT !sursat
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNACT !concentrtaion d'aérosols activés au temps t
+!
+END SUBROUTINE RAIN_C2R2_KHKO
+END INTERFACE
+END MODULE MODI_RAIN_C2R2_KHKO
+! ######################################################################
+ SUBROUTINE RAIN_C2R2_KHKO (HCLOUD,OACTIT, OSEDC, ORAIN, KSPLITR, PTSTEP, &
+ KMI, TPFILE, PZZ, PRHODJ, &
+ PRHODREF, PEXNREF, &
+ PPABST, PTHT, PRVT, PRCT, &
+ PRRT, PTHM, PRCM, PPABSM, &
+ PW_NU,PDTHRAD, PTHS, PRVS, PRCS, PRRS, &
+ PCNT, PCCT, PCRT, PCNS, PCCS, PCRS, &
+ PINPRC, PINPRR, PINPRR3D, PEVAP3D,PAEROT, &
+ PSOLORG, PMI, HACTCCN, &
+ PINDEP, PSUPSAT, PNACT )
+! ######################################################################
+!
+!!**** * - compute the explicit microphysical sources of cloud water and
+!! rain water concentrations and mixing ratios
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the microphysical sources
+!! for the two schemes C2R2 and KHKO
+!! For C2R2 the microphysical sources are :
+!! nucleation, sedimentation, autoconversion, accretion, self-collection
+!! and vaporisation which are parameterized according to Cohard and Pinty
+!! QJRMS, 2000
+!! For KHKO the microphysical sources are :
+!! drizzle drops sedimentation, autoconversion, accretion and vaporisation
+!! which are parameterized according to Khairoutdinov and Kogan 2000,
+!! nucleation and cloud droplets sedimentation which are parameterized
+!! according to Cohard and Pinty QJRMS, 2000
+!!
+!!** METHOD
+!! ------
+!! The activation of CCN is checked for quasi-saturated air parcels
+!! to update the cloud droplet number concentration. Then assuming a
+!! generalized gamma distribution law for the cloud droplets and the
+!! raindrops, the zeroth and third order moments tendencies are evaluated
+!! for all the coalescence terms by integrating the Stochastic Collection
+!! Equation. As autoconversion is a process that cannot be resolved
+!! analytically, the Berry-Reinhardt parameterisation is employed with
+!! modifications to initiate the raindrop spectrum mode. The integration
+!! of the raindrop evaporation of the raindrops below clouds is
+!! straightformward.
+!!
+!! The sedimentation rates are computed with a time spliting technique:
+!! an upstream scheme, written as a difference of non-advective fluxes.
+!! This source term is added to the next coming time step (split-implicit
+!! process).
+!!
+!! EXTERNAL
+!! --------
+!! None
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS
+!! JPHEXT : Horizontal external points number
+!! JPVEXT : Vertical external points number
+!! Module MODD_CONF :
+!! CCONF configuration of the model for the first time step
+!!
+!! Module MODD_CST
+!! XP00 ! Reference pressure
+!! XRD,XRV ! Gaz constant for dry air, vapor
+!! XMD,XMV ! Molecular weight for dry air, vapor
+!! XCPD ! Cpd (dry air)
+!! XCL ! Cl (liquid)
+!! XTT ! Triple point temperature
+!! XLVTT ! Vaporization heat constant
+!! XALPW,XBETAW,XGAMW ! Constants for saturation vapor pressure
+!! ! function over liquid water
+!! Module MODD_BUDGET:
+!! NBUMOD : model in which budget is calculated
+!! CBUTYPE : type of desired budget
+!! 'CART' for cartesian box configuration
+!! 'MASK' for budget zone defined by a mask
+!! 'NONE' ' for no budget
+!! LBU_RTH : logical for budget of RTH (potential temperature)
+!! .TRUE. = budget of RTH
+!! .FALSE. = no budget of RTH
+!! LBU_RRV : logical for budget of RRV (water vapor)
+!! .TRUE. = budget of RRV
+!! .FALSE. = no budget of RRV
+!! LBU_RRC : logical for budget of RRC (cloud water)
+!! .TRUE. = budget of RRC
+!! .FALSE. = no budget of RRC
+!! LBU_RRR : logical for budget of RRR (rain water)
+!! .TRUE. = budget of RRR
+!! .FALSE. = no budget of RRR
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Cohard, J.-M. and J.-P. Pinty, 2000: A comprehensive two-moment warm
+!! microphysical bulk scheme.
+!! Part I: Description and tests
+!! Part II: 2D experiments with a non-hydrostatic model
+!! Accepted for publication in Quart. J. Roy. Meteor. Soc.
+!! M. Khairoutdinov and Y. Kogan,"A new Cloud Physics Parametererization
+!! in a Large-Eddy Simulation Model of Marine Stratocumulus"
+!! Mon. Weather Rev.,128, 229-243-2000
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! O. Geoffroy * CNRM Meteo-France* : 07/2006
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 31/12/96
+!! Jean-Pierre PINTY 7/ 7/00 Code cleaning
+!! Jean-Pierre PINTY 27/ 5/01 Review of rain transfer to cloud droplets
+!! in the case of strong evaporation
+!! C.Lac 11/09 Distinction of the TSTEPs
+!! C.Lac, V.Masson 09/10 Corrections in sedimentation and
+!! evaporation for reproducibility
+!! C.Lac 06/14 C2R2_SEDIMENTATION replaced by
+!! KHKO_SEDIMENTATION because of instability
+!! G.Tanguy 07/14 FUSION C2R2 and KHKO
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! J.Escobar : 07/10/2015 , Bug in parallel run , => comment test on INUCT>1 containing GET_HALO
+!! M.Mazoyer : 04/2016 : Temperature radiative tendency used for
+!! activation by cooling (OACTIT : mis en commentaires)
+!! M.Mazoyer : 04/2016 : Add supersaturation diagnostics
+!! C.Lac : 07/2016 : Add droplet deposition
+!! C.Lac : 01/2017 : Correction on droplet deposition
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+use modd_budget, only: lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, NBUDGET_SV1, &
+ tbudgets
+USE MODD_CH_AEROSOL
+USE MODD_CONF
+USE MODD_CST
+USE MODD_DUST
+use modd_field, only: tfielddata, TYPEREAL
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_NSV, ONLY : NSV_C2R2BEG
+USE MODD_PARAM_C2R2
+USE MODD_PARAMETERS
+USE MODD_RAIN_C2R2_DESCR
+USE MODD_RAIN_C2R2_KHKO_PARAM
+USE MODD_SALT
+
+use mode_budget, only: Budget_store_init, Budget_store_end
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+USE MODE_ll
+use mode_tools, only: Countjv
+
+USE MODI_GAMMA
+
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+!
+!
+!
+CHARACTER(LEN=*), INTENT(IN) :: HCLOUD ! kind of cloud
+
+LOGICAL, INTENT(IN) :: OACTIT ! Switch to activate the
+ ! activation by radiative
+ ! tendency
+LOGICAL, INTENT(IN) :: OSEDC ! switch to activate the
+ ! cloud droplet sedimentation
+LOGICAL, INTENT(IN) :: ORAIN ! switch to activate the
+ ! rain formation by coalescence
+INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step
+ ! integration for rain sedimendation
+REAL, INTENT(IN) :: PTSTEP ! Time step :XTSTEP in namelist
+INTEGER, INTENT(IN) :: KMI ! Model index
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+!
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at time t-Dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Pressure time t-Dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCM ! Cloud water m.r. at time t-Dt
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
+ ! the nucleation param.
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD ! THeta RADiative Tendancy
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCNT ! Water vapor C. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCT ! Cloud water C. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCRT ! Rain water C. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCNS ! Water vapor C. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCS ! Cloud water C. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCRS ! Rain water C. source
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC ! Cloud instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINDEP ! Cloud instant deposition
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR ! Rain instant precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRR3D! Rain inst precip 3D
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D! Rain evap profile
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PAEROT ! Aerosol concentration
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSOLORG ![%] solubility fraction of soa
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PMI
+CHARACTER(LEN=4), INTENT(IN) :: HACTCCN ! kind of CCN activation scheme
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSUPSAT !sursat
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNACT !concentrtaion d'aérosols activés au temps t
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: JK ! Vertical loop index for the rain sedimentation
+INTEGER :: JKBIS ! For spectrum
+INTEGER :: JN ! Temporal loop index for the rain sedimentation
+INTEGER :: IIB ! Define the domain where is
+INTEGER :: IIE ! the microphysical sources have to be computed
+INTEGER :: IJB !
+INTEGER :: IJE !
+INTEGER :: IKB !
+INTEGER :: IKE !
+INTEGER :: ISIZE !
+!
+REAL :: ZTSPLITR ! Small time step for rain sedimentation
+REAL :: ZEPS ! molar mass ratio
+!
+LOGICAL :: GBU ! General condition prior calling any BUDGET routine
+!
+!
+INTEGER :: ISEDIM, INUCT, & ! Case number of sedimentation, nucleation,
+ IMICRO, IEVAP, & ! coalescence and rain_evaporation locations
+ ISELF, IACCR, ISCBU
+LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: GSEDIM ! Test where to compute the SED processes
+LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2)):: GDEP
+LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: GNUCT ! Test where to compute the HEN process
+LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: GMICRO ! Test where to compute coalescence proc.
+LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: GEVAP ! Test where to compute rain_evap. proc.
+INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC1 ! Vectors of indices for
+ ! interpolations
+REAL, DIMENSION(:), ALLOCATABLE :: ZVEC1 ! Work vectors for
+ ! interpolations
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: ZW ! work array
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: ZWSEDR, ZWSEDC, &! sedimentation fluxes
+ ZZW1LOG, & ! cloud sedimentation speed
+ ZWSEDLOGR, ZWSEDLOGC ! sedimentation fluxes
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: ZT, ZTM,ZTDT, ZDRC ! Temperature
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: ZZA,ZCHEN
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: ZRVSAT
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: ZLV !latent heat of vaporization
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: ZWLBDR,ZWLBDR3,ZWLBDC,ZWLBDC3, &
+ ZWLBDA, & !libre parcours moyen
+ ZRAY, & ! Mean volumic radius
+ ZCC ! Terminal vertical velocity
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: ZMVRR,ZVRR,ZVCR
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: ZPRCT, ZPCCT, ZPRRT, ZPCRT
+ ! For split sedimentation
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: ZMVRC !Cloud water mean volumic radius
+REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
+ :: ZPRRS,ZPCRS ! Rain and cloud source for sedim
+REAL, DIMENSION(:), ALLOCATABLE :: ZRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRRT ! Rain water m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZCNT ! nucleus conc. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZCCT ! cloud conc. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZCRT ! rain conc. at t
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZRVS ! Water vapor m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRCS ! Cloud water m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRRS ! Rain water m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZCNS ! nucleus conc. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZCCS ! cloud conc. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZTCC ! Corrective factor for Terminal velocity
+REAL, DIMENSION(:), ALLOCATABLE :: ZCRS ! rain conc. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZTHS ! Theta source
+!-------------------------------------------------------------------------------
+! Modification of XCHEN according to theta vertical gradient (J. Rangonio)
+!REAL, DIMENSION(:), ALLOCATABLE :: ZCHEN_TMP
+!REAL, DIMENSION(:), ALLOCATABLE :: ZCONC_CCN
+!-------------------------------------------------------------------------------
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZZVRR !terminal velocity for drop concentration
+REAL, DIMENSION(:), ALLOCATABLE :: ZZVCR !erminal velocity for rain water
+!
+LOGICAL, DIMENSION(:), ALLOCATABLE :: GSELF(:), GACCR(:), GSCBU(:)
+LOGICAL, DIMENSION(:), ALLOCATABLE :: GENABLE_ACCR_SCBU(:)
+REAL, DIMENSION(:), ALLOCATABLE :: &
+ ZRHODREF, & ! RHO Dry REFerence
+ ZZT, & ! Temperature
+ ZTDTBIS, & ! dT/dt
+ ZEXNREF, & ! EXNer Pressure REFerence
+ ZZW1, ZZW2, ZZW3, ZZW4, ZZW5, & ! Work array
+ ZZLV, & ! Latent heat of vaporization at T
+ ZSMAX, & ! Maximum supersaturation
+ ZSCBU, & ! optimisation mask
+ ZLBDC, ZLBDR, & ! Lambda parameter
+ ZLBDC3, ZLBDR3, & ! Lambda**3
+ ZKA, & ! Thermal conductivity of the air
+ ZDV, & ! Diffusivity of water vapor in the air
+ ZPABST, ZNCN, ZMCN
+REAL, DIMENSION(:), ALLOCATABLE :: ZDG3
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZAERO, ZAEROS, ZSOLORG, ZMI
+REAL :: ZFACT, JSV, ZMU, ZALPHA
+
+REAL, DIMENSION(:), ALLOCATABLE :: ZRTMIN
+REAL, DIMENSION(:), ALLOCATABLE :: ZCTMIN
+REAL :: ZTMP
+TYPE(TFIELDDATA) :: TZFIELD
+!
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTE THE SLOPE PARAMETERS ZLBDC,ZLBDR
+! ----------------------------------------
+!
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+IKB=1+JPVEXT
+IKE=SIZE(PZZ,3) - JPVEXT
+!
+ISIZE = SIZE(XRTMIN)
+ISIZE = SIZE(XCTMIN)
+ALLOCATE(ZCTMIN(ISIZE))
+ALLOCATE(ZRTMIN(ISIZE))
+ZRTMIN(:) = XRTMIN(:) / PTSTEP
+ZCTMIN(:) = XCTMIN(:) / PTSTEP
+!
+ZWLBDC3(:,:,:) = 1.E30
+ZWLBDC(:,:,:) = 1.E10
+!
+WHERE (PRCT(:,:,:)>XRTMIN(2) .AND. PCCT(:,:,:)>XCTMIN(2))
+ ZWLBDC3(:,:,:) = XLBC * PCCT(:,:,:) / (PRHODREF(:,:,:) * PRCT(:,:,:))
+ ZWLBDC(:,:,:) = ZWLBDC3(:,:,:)**XLBEXC
+END WHERE
+!
+IF (HCLOUD=='C2R2'.OR. HCLOUD=='C3R5' ) THEN
+ ZWLBDR3(:,:,:) = 1.E30
+ ZWLBDR(:,:,:) = 1.E10
+ WHERE (PRRT(:,:,:)>XRTMIN(3) .AND. PCRT(:,:,:)>XCTMIN(3))
+ ZWLBDR3(:,:,:) = XLBR * PCRT(:,:,:) / (PRHODREF(:,:,:) * PRRT(:,:,:))
+ ZWLBDR(:,:,:) = ZWLBDR3(:,:,:)**XLBEXR
+ END WHERE
+ENDIF
+!
+ZT(:,:,:) = PTHT(:,:,:) * (PPABST(:,:,:)/XP00)**(XRD/XCPD)
+
+!
+!* 2. COMPUTES THE NUCLEATION PROCESS SOURCES
+! --------------------------------------
+!
+IF ((HACTCCN == 'ABRK').AND.((LORILAM).OR.(LDUST).OR.(LSALT))) THEN
+ CALL AER_NUCLEATION
+ELSE
+ IF (.NOT. LSUPSAT) THEN
+ CALL C2R2_KHKO_NUCLEATION
+ ELSE
+ ZEPS= XMV / XMD
+ ZT(:,:,:) = PTHT(:,:,:) * (PPABST(:,:,:)/XP00)**(XRD/XCPD)
+!
+ ZRVSAT(:,:,:) = ZEPS / (PPABST(:,:,:) * &
+ EXP(-XALPW+XBETAW/ZT(:,:,:)+XGAMW*LOG(ZT(:,:,:))) - 1.0)
+ ENDIF
+ENDIF
+!
+!------------------------------------------------------------------------------
+!
+!* 3. COALESCENCE PROCESSES
+! ---------------------
+!
+IF (ORAIN) THEN
+!
+! optimization by looking for locations where
+! the microphysical fields are larger than a minimal value only !!!
+!
+ IF (HCLOUD=='C2R2'.OR. HCLOUD=='C3R5') THEN
+ CALL C2R2_COALESCENCE
+ ELSE ! KHKO
+ CALL KHKO_COALESCENCE
+ ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+! 4. EVAPORATION OF RAINDROPS
+! ------------------------
+!
+ CALL C2R2_KHKO_EVAPORATION
+!
+!-------------------------------------------------------------------------------
+!
+! 5. SPONTANEOUS BREAK-UP (NUMERICAL FILTER)
+! --------------------
+!
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 2), 'BRKU', pcrs(:, :, :) * prhodj(:, :, :) )
+
+ ZWLBDR(:,:,:) = 1.E10
+ WHERE (PRRS(:,:,:)>0.0.AND.PCRS(:,:,:)>0.0 )
+ ZWLBDR3(:,:,:) = XLBR * PCRS(:,:,:) / (PRHODREF(:,:,:) * PRRS(:,:,:))
+ ZWLBDR(:,:,:) = ZWLBDR3(:,:,:)**XLBEXR
+ END WHERE
+ WHERE (ZWLBDR(:,:,:)<(XACCR1/XSPONBUD1))
+ PCRS(:,:,:) = PCRS(:,:,:)*MAX((1.+XSPONCOEF2*(XACCR1/ZWLBDR(:,:,:)-XSPONBUD1)**2),&
+ (XACCR1/ZWLBDR(:,:,:)/XSPONBUD3)**3)
+ END WHERE
+
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 2), 'BRKU', pcrs(:, :, :) * prhodj(:, :, :) )
+ENDIF
+!-------------------------------------------------------------------------------
+!* 6. COMPUTE THE SEDIMENTATION (RS) SOURCE
+! -------------------------------------
+!
+!* 6.1 Calculation of the mean volumic radius (ZRAY) and
+! the terminal vertical velocity ZCC for precipitating clouds
+!
+ZTSPLITR = PTSTEP / REAL(KSPLITR) ! Small time step
+!
+!
+!* 6.2 compute the sedimentation velocities for rain
+! --------------------------------------------
+!
+ZMVRR(:,:,:) = 0.
+ZVRR(:,:,:) = 0.
+ZVCR(:,:,:) = 0.
+WHERE (PCRT(:,:,:) > XCTMIN(3) .and. PRRT(:,:,:)>XRTMIN(3) )
+ ZMVRR(:,:,:) = ((3. * PRHODREF(:,:,:)*PRRT(:,:,:))/ &
+ (4. * XPI *XRHOLW*PCRT(:,:,:)))**0.333 ! in m
+ ZVRR(:,:,:) = 0.012 * 1.0E6 * ZMVRR(:,:,:) - 0.2 ! velocity for mixing ratio
+ ZVCR(:,:,:) = 0.007 * 1.0E6 * ZMVRR(:,:,:) - 0.1 ! velocity for concentration
+END WHERE
+WHERE (ZVRR(:,:,:) .lt. 0.0 .OR. ZVCR(:,:,:) .lt. 0.0)
+ ZVRR(:,:,:) = 0.0
+ ZVCR(:,:,:) = 0.0
+END WHERE
+!
+CALL C2R2_KHKO_SEDIMENTATION
+!
+DEALLOCATE(ZRTMIN)
+DEALLOCATE(ZCTMIN)
+!
+!------------------------------------------------------------------------------
+!
+
+
+!------------------------------------------------------------------------------
+CONTAINS
+!-------------------------------------------------------------------------------
+!
+ SUBROUTINE C2R2_KHKO_NUCLEATION
+!
+!* 0. DECLARATIONS
+! ------------
+!JUAN
+USE MODI_GET_HALO
+!
+IMPLICIT NONE
+!
+!* 0.2 declaration of local variables
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZTCELSIUS
+INTEGER , DIMENSION(SIZE(GNUCT)) :: I1,I2,I3 ! Used to replace the COUNT
+INTEGER :: JL ! and PACK intrinsics
+INTEGER :: J1
+!
+!-------------------------------------------------------------------------------
+
+if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HENU', pths(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'HENU', prvs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'HENU', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg ), 'HENU', pcns(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'HENU', pccs(:, :, :) * prhodj(:, :, :) )
+end if
+
+! Modification of XCHEN according to theta vertical gradient (J. Rangonio)
+!ZZA(:,:,2) = 1.
+!DO JK=IKB,IKE-1
+! WHERE (PZZ(:,:,JK+1) >= XAERHEIGHT)
+! ZZA(:,:,JK+1) = ZZA(:,:,JK)
+! ELSEWHERE
+! ZZA(:,:,JK+1) = ZZA(:,:,JK)* &
+! EXP(MIN(0.,-XAERDIFF*(PTHT(:,:,JK+1)-PTHT(:,:,JK))/(PZZ(:,:,JK+1)-PZZ(:,:,JK))))
+! END WHERE
+! ZCHEN(:,:,JK) = XCHEN*ZZA(:,:,JK)
+!END DO
+!ZCHEN(:,:,IKE) = ZCHEN(:,:,IKE-1)
+!!
+!!
+! IF ( tpfile%lopened ) THEN
+! TZFIELD%CMNHNAME = 'ZCHEN'
+! TZFIELD%CSTDNAME = ''
+! TZFIELD%CLONGNAME = 'ZCHEN'
+! TZFIELD%CUNITS = ''
+! TZFIELD%CDIR = 'XY'
+! TZFIELD%CCOMMENT = 'X_Y_Z_ZCHEN'
+! TZFIELD%NGRID = 1
+! TZFIELD%NTYPE = TYPEREAL
+! TZFIELD%NDIMS = 3
+! TZFIELD%LTIMEDEP = .TRUE.
+! CALL IO_Field_write(TPFILE,TZFIELD,ZCHEN)
+! END IF
+!
+!-------------------------------------------------------------------------------
+!
+! compute the saturation vapor mixing ratio and
+! the radiative tendency and
+! the latent heat of vaporization Lv(T) and
+! the specific heat for moist air Cph
+!
+ZEPS= XMV / XMD
+ZRVSAT(:,:,:) = ZEPS / (PPABST(:,:,:) * &
+ EXP(-XALPW+XBETAW/ZT(:,:,:)+XGAMW*ALOG(ZT(:,:,:))) - 1.0)
+ZZW1LOG(:,:,:)= 0. ! supersaturation
+ZTDT(:,:,:) = 0.
+ZDRC(:,:,:) = 0.
+IF (OACTIT) THEN
+ ZTM(:,:,:) = PTHM(:,:,:) * (PPABSM(:,:,:)/XP00)**(XRD/XCPD)
+ ZTDT(:,:,:) = (ZT(:,:,:)-ZTM(:,:,:))/PTSTEP ! dT/dt
+ ZDRC(:,:,:) = (PRCT(:,:,:)-PRCM(:,:,:))/PTSTEP ! drc/dt
+! Modif M.Mazoyer
+! ZTDT(:,:,:) = PDTHRAD(:,:,:)*(PPABST(:,:,:)/XP00)**(XRD/XCPD)
+END IF
+!
+! optimization by looking for locations where
+! the updraft velocity is positive!!!
+!
+GNUCT(:,:,:) = .FALSE.
+IF( OACTIT ) THEN
+ GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) = (PW_NU(IIB:IIE,IJB:IJE,IKB:IKE)>XWMIN .OR. &
+ ZTDT(IIB:IIE,IJB:IJE,IKB:IKE)<XTMIN) .AND. &
+ PRVT(IIB:IIE,IJB:IJE,IKB:IKE)>(0.98*ZRVSAT(IIB:IIE,IJB:IJE,IKB:IKE))
+ELSE
+ GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) = PW_NU(IIB:IIE,IJB:IJE,IKB:IKE)>XWMIN .AND. &
+ PRVT(IIB:IIE,IJB:IJE,IKB:IKE)>(0.98*ZRVSAT(IIB:IIE,IJB:IJE,IKB:IKE))
+END IF
+INUCT = COUNTJV( GNUCT(:,:,:),I1(:),I2(:),I3(:))
+
+! IF( INUCT >= 1 ) THEN
+ ALLOCATE(ZRVT(INUCT))
+ ALLOCATE(ZRCT(INUCT))
+ ALLOCATE(ZRRT(INUCT))
+ ALLOCATE(ZCNS(INUCT))
+ ALLOCATE(ZCCS(INUCT))
+ ALLOCATE(ZZT(INUCT))
+ ALLOCATE(ZTDTBIS(INUCT))
+ ALLOCATE(ZZW1(INUCT))
+ ALLOCATE(ZZW2(INUCT))
+ ALLOCATE(ZZW3(INUCT))
+ ALLOCATE(ZZW4(INUCT))
+ ALLOCATE(ZZW5(INUCT))
+ ALLOCATE(ZVEC1(INUCT))
+ ALLOCATE(IVEC1(INUCT))
+ ALLOCATE(ZRHODREF(INUCT))
+ ALLOCATE(ZEXNREF(INUCT))
+!-------------------------------------------------------------------------------
+! Modification of XCHEN according to theta vertical gradient (J. Rangonio)
+! ALLOCATE(ZCHEN_TMP(INUCT))
+! ALLOCATE(ZCONC_CCN(INUCT))
+!-------------------------------------------------------------------------------
+ DO JL=1,INUCT
+ ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL))
+ ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
+ ZRRT(JL) = PRRT(I1(JL),I2(JL),I3(JL))
+ ZCNS(JL) = PCNS(I1(JL),I2(JL),I3(JL))
+ ZCCS(JL) = PCCS(I1(JL),I2(JL),I3(JL))
+ ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
+ ZZW1(JL) = ZRVSAT(I1(JL),I2(JL),I3(JL))
+ ZZW2(JL) = PW_NU(I1(JL),I2(JL),I3(JL))
+ ZTDTBIS(JL) = ZTDT(I1(JL),I2(JL),I3(JL))
+ ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
+ ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL))
+!-------------------------------------------------------------------------------
+! Modification of XCHEN according to theta vertical gradient (J. Rangonio)
+! ZCHEN_TMP(JL)= ZCHEN(I1(JL),I2(JL),I3(JL))
+!-------------------------------------------------------------------------------
+
+ ENDDO
+!-------------------------------------------------------------------------------
+! Modification of XCHEN according to theta vertical gradient (J. Rangonio)
+! ZCONC_CCN(:)=XCONC_CCN*ZCHEN_TMP(:)/XCHEN
+!-------------------------------------------------------------------------------
+ ZZW1(:) = 1.0/ZEPS + 1.0/ZZW1(:) &
+ + (((XLVTT+(XCPV-XCL)*(ZZT(:)-XTT))/ZZT(:))**2)/(XCPD*XRV) ! Psi2
+!
+!* 3.1 compute the heterogeneous nucleation source: RVHENC, CVHENC
+!
+!* 3.1.1 compute the constant term (ZZW3)
+!
+ ZVEC1(:) = MAX( 1.00001, MIN( REAL(NAHEN)-0.00001, &
+ XAHENINTP1 * ZZT(:) + XAHENINTP2 ) )
+ IVEC1(:) = INT( ZVEC1(:) )
+ ZVEC1(:) = ZVEC1(:) - REAL( IVEC1(:) )
+ ALLOCATE(ZSMAX(INUCT))
+!
+!
+ IF( HPARAM_CCN == 'TFH' ) THEN
+ ZZW2(:) = 100.*ZZW2(:) ! FH is in CGS units
+ ALLOCATE(ZTCELSIUS(INUCT)); ZTCELSIUS(:) = ZZT(:) - XTT
+ ZZW3(:) = XAHENF( IVEC1(:)+1 )* ZVEC1(:) &
+ - XAHENF( IVEC1(:) )*(ZVEC1(:) - 1.0) ! Cste*(Psi1/Gr)
+ ZZW3(:) = ZZW3(:)/ZZW2(:)**(XWCOEF_F1+ZTCELSIUS(:)* &
+ (XWCOEF_F2+XWCOEF_F3*ZTCELSIUS(:)))
+ ZZW3(:) = (ZZW3(:)/ZZW1(:)) * ZZW2(:) * ZRHODREF(:) ! R.H.S. of
+ ! Eq. (12) in FH92
+!
+!* 3.1.1.1 compute the maximum fo supersaturation
+!
+ ZSMAX(:) = ZZW3(:)**(1.0/(XKHEN+1.0)) ! first estimate (y_bar=0)
+!
+! 4 iterations to estimate S_max for the TFH parameterization
+!
+ ZZW1(:) = XAHENY( IVEC1(:)+1 )* ZVEC1(:) &
+ - XAHENY( IVEC1(:) )*(ZVEC1(:) - 1.0) ! y_bar
+ ZZW1(:) = ZZW1(:)*ZZW2(:)** (XWCOEF_Y1+ZTCELSIUS(:)* &
+ (XWCOEF_Y2+XWCOEF_Y3*ZTCELSIUS(:)))
+ DO J1 = 1,4
+ ZSMAX(:) = (ZZW1(:)*ZSMAX(:)**XKHEN + ZSMAX(:))**(1.0/(XKHEN+1.0))
+ END DO
+ DEALLOCATE(ZTCELSIUS)
+ ZZW3(:) = 1.0
+ ELSE
+ IF (OACTIT) THEN
+ ZZW4(:)=XPSI1( IVEC1(:)+1)*ZZW2(:)+XPSI3(IVEC1(:)+1)*ZTDTBIS(:)
+ ZZW5(:)=XPSI1( IVEC1(:))*ZZW2(:)+XPSI3(IVEC1(:))*ZTDTBIS(:)
+! Modif M.Mazoyer
+! ZZW4(:) =0.0
+! ZZW5(:) =0.0
+! WHERE (ZZW2(:)>= XWMIN .AND. ZTDTBIS(:) < XTMIN )
+! ZZW4(:)=XPSI1( IVEC1(:)+1)*ZZW2(:)+XPSI3(IVEC1(:)+1)*ZTDTBIS(:)
+! ZZW5(:)=XPSI1( IVEC1(:))*ZZW2(:)+XPSI3(IVEC1(:))*ZTDTBIS(:)
+! ELSEWHERE (ZZW2(:)< XWMIN .AND. ZTDTBIS(:) < XTMIN )
+! ZZW4(:)=XPSI3(IVEC1(:)+1)*ZTDTBIS(:)
+! ZZW5(:)=XPSI3(IVEC1(:))*ZTDTBIS(:)
+! ELSEWHERE (ZZW2(:)< XWMIN .AND. ZTDTBIS(:) >= XTMIN )
+! ZZW4(:)=0.0
+! ZZW5(:)=0.0
+! ELSEWHERE (ZZW2(:)>= XWMIN .AND. ZTDTBIS(:) >= XTMIN )
+! ZZW4(:)=XPSI1( IVEC1(:)+1)*ZZW2(:)
+! ZZW5(:)=XPSI1( IVEC1(:))*ZZW2(:)
+! END WHERE
+ WHERE (ZZW4(:) < 0. .OR. ZZW5(:) < 0.)
+ ZZW4(:) = 0.
+ ZZW5(:) = 0.
+ END WHERE
+ ZZW3(:) = XCHEN*XAHENG(IVEC1(:)+1)*(ZZW4(:)**1.5)*ZVEC1(:)/XCHEN &
+ - XCHEN*XAHENG( IVEC1(:))*(ZZW5(:)**1.5)*(ZVEC1(:) - 1.0)/XCHEN
+ ! Cste*((Psi1*w+Psi3*dT/dt)/(G))**1.5
+!-------------------------------------------------------------------------------
+! Modification of XCHEN according to theta vertical gradient (J. Rangonio)
+! ZZW3(:) = XCHEN*XAHENG(IVEC1(:)+1)*(ZZW4(:)**1.5)*ZVEC1(:)/ZCHEN_TMP(:) &
+! - XCHEN*XAHENG( IVEC1(:))*(ZZW5(:)**1.5)*(ZVEC1(:) - 1.0)/ZCHEN_TMP(:)
+! ! Cste*((Psi1*w+Psi3*dT/dt)/(G))**1.5
+!-------------------------------------------------------------------------------
+ ELSE
+ ZZW3(:) = XAHENG( IVEC1(:)+1)*((XPSI1( IVEC1(:)+1)*ZZW2(:))**1.5)* ZVEC1(:) &
+ - XAHENG( IVEC1(:))*((XPSI1(IVEC1(:))*ZZW2(:))**1.5)*(ZVEC1(:) - 1.0)
+ END IF
+ ZZW5(:) = 1.
+ ZZW3(:) = (ZZW3(:)/ZZW1(:))*ZRHODREF(:) ! R.H.S. of
+ ! Eq 9 of CPB 98
+ WHERE (ZZW3(:) == 0.)
+ ZZW5(:)= -1.
+ END WHERE
+!
+!* 3.1.2.1 compute the maximum fo supersaturation
+!
+ ZSMAX(:) = ZZW3(:)**(1.0/(XKHEN+2.0)) ! Smax has no unit
+!
+! 4 iterations to estimate S_max for the CPB98 parameterization
+!
+ IF( HPARAM_CCN == 'CPB' ) THEN
+ DO J1 = 1,4
+ WHERE (ZZW5(:) > 0.)
+ ZVEC1(:) = MAX( 1.00001, MIN( REAL(NHYP)-0.00001, &
+ XHYPINTP1*LOG(ZSMAX(:))+XHYPINTP2 ) )
+ IVEC1(:) = INT( ZVEC1(:) )
+ ZVEC1(:) = ZVEC1(:) - REAL( IVEC1(:) )
+ ZZW2(:) = XHYPF32( IVEC1(:)+1 )* ZVEC1(:) &
+ - XHYPF32( IVEC1(:) )*(ZVEC1(:) - 1.0)
+ ZSMAX(:) = (ZZW3(:)/ZZW2(:))**(1.0/(XKHEN+2.0))
+ ELSEWHERE
+ ZSMAX(:)=0.
+ END WHERE
+ END DO
+!
+!* 3.2 compute the nucleus source
+!
+! ZSMAX(:) is used in percent in the nucleation formula
+!
+ ZZW3(:) = XHYPF12( IVEC1(:)+1 )* ZVEC1(:) &
+ - XHYPF12( IVEC1(:) )*(ZVEC1(:) - 1.0)
+ ELSE
+ ZZW3(:) = 1.0
+ END IF
+ END IF
+ ZZW1LOG(:,:,:) = UNPACK( 100*ZSMAX(:),MASK=GNUCT(:,:,:),FIELD=0.0 )
+ PSUPSAT(:,:,:) = 0.0
+ PSUPSAT(:,:,:) = ZZW1LOG(:,:,:)
+!
+! the CCN spectra formula uses ZSMAX in percent
+!
+ IF (XCONC_CCN > 0) THEN
+ ZZW1(:) = MIN( XCONC_CCN,XCHEN * (100.0*ZSMAX(:))**XKHEN * ZZW3(:) ) / PTSTEP
+ ELSE
+ ZZW1(:) = XCHEN * (100.0*ZSMAX(:))**XKHEN * ZZW3(:) / PTSTEP
+ ENDIF
+!-------------------------------------------------------------------------------
+! Modification of XCHEN according to theta vertical gradient (J. Rangonio)
+! IF (XCONC_CCN > 0.) THEN
+! ZZW1(:) = MIN( ZCONC_CCN(:),ZCHEN_TMP(:) * (100.0*ZSMAX(:))**XKHEN * ZZW3(:) ) / PTSTEP
+! ELSE
+! ZZW1(:) = ZCHEN_TMP(:) * (100.0*ZSMAX(:))**XKHEN * ZZW3(:) / PTSTEP
+! ENDIF
+!-------------------------------------------------------------------------------
+ ZW(:,:,:) = PCNS(:,:,:)
+ PCNS(:,:,:) = UNPACK( MAX( ZZW1(:),ZCNS(:) ),MASK=GNUCT(:,:,:), &
+ FIELD=ZW(:,:,:) )
+!
+ DEALLOCATE(IVEC1)
+ DEALLOCATE(ZVEC1)
+!
+!* 3.3 compute the cloud water concentration and mixing ratio sources
+!
+ ZZW2(:) = MAX( (ZZW1(:)-ZCNS(:)),0.0 )
+
+ PNACT(:,:,:) = 0.0
+ PNACT(:,:,:) = UNPACK(ZZW2(:)*PTSTEP,MASK=GNUCT(:,:,:),FIELD=0.)
+
+ ZZW1(:)=0.
+ WHERE (ZZW5(:) > 0.)
+ ZZW1(:) = MIN( XCSTDCRIT * ZZW2(:) / ( ((ZZT(:)*ZSMAX(:))**3.)*ZRHODREF(:) ),&
+ 1.E-5 )
+ END WHERE
+ CALL GET_HALO(PRVS)
+ ZW(:,:,:) = MIN( UNPACK( ZZW1(:),MASK=GNUCT(:,:,:),FIELD=0.0 ),PRVS(:,:,:) )
+!
+ PRVS(:,:,:) = PRVS(:,:,:) - ZW(:,:,:)
+ PRCS(:,:,:) = PRCS(:,:,:) + ZW(:,:,:)
+ ZW(:,:,:) = ZW(:,:,:)*(XLVTT+(XCPV-XCL)*(ZT(:,:,:)-XTT))/ &
+ (PEXNREF(:,:,:)*( XCPD+XCPV*PRVT(:,:,:)+XCL*(PRCT(:,:,:)+PRRT(:,:,:))))
+ PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)
+!JUAN
+ CALL GET_HALO(PTHS)
+ CALL GET_HALO(PRCS)
+!
+ ZW(:,:,:) = PCCS(:,:,:)
+ PCCS(:,:,:) = UNPACK( ZZW2(:)+ZCCS(:),MASK=GNUCT(:,:,:),FIELD=ZW(:,:,:) )
+!
+!
+ DEALLOCATE(ZRVT)
+ DEALLOCATE(ZRCT)
+ DEALLOCATE(ZRRT)
+ DEALLOCATE(ZCNS)
+ DEALLOCATE(ZCCS)
+ DEALLOCATE(ZZT)
+ DEALLOCATE(ZSMAX)
+ DEALLOCATE(ZZW1)
+ DEALLOCATE(ZZW2)
+ DEALLOCATE(ZZW3)
+ DEALLOCATE(ZZW4)
+ DEALLOCATE(ZZW5)
+ DEALLOCATE(ZTDTBIS)
+ DEALLOCATE(ZRHODREF)
+ DEALLOCATE(ZEXNREF)
+!-------------------------------------------------------------------------------
+! Modification of XCHEN according to theta vertical gradient (J. Rangonio)
+! DEALLOCATE(ZCHEN_TMP)
+! DEALLOCATE(ZCONC_CCN)
+!-------------------------------------------------------------------------------
+! END IF
+!
+IF ( tpfile%lopened ) THEN
+ TZFIELD%CMNHNAME = 'SMAX'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'SMAX'
+ TZFIELD%CUNITS = '1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_SMAX'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZZW1LOG)
+END IF
+!
+!* 3.4 budget storage
+!
+if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HENU', pths(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'HENU', prvs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'HENU', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg ), 'HENU', pcns(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'HENU', pccs(:, :, :) * prhodj(:, :, :) )
+end if
+
+END SUBROUTINE C2R2_KHKO_NUCLEATION
+!
+!-------------------------------------------------------------------------------
+!
+ SUBROUTINE AER_NUCLEATION
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_NSV
+USE MODE_AERO_PSD
+USE MODI_CH_AER_ACTIVATION
+
+IMPLICIT NONE
+!
+!* 0.2 declaration of local variables
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZTCELSIUS
+INTEGER , DIMENSION(SIZE(GNUCT)) :: I1,I2,I3 ! Used to replace the COUNT
+INTEGER :: JL ! and PACK intrinsics
+INTEGER :: J1
+INTEGER :: JSV
+!
+!-------------------------------------------------------------------------------
+
+if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HENU', pths(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'HENU', prvs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'HENU', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg ), 'HENU', pcns(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'HENU', pccs(:, :, :) * prhodj(:, :, :) )
+end if
+!
+! compute the saturation vapor mixing ratio
+! the radiative tendency
+!
+ZEPS= XMV / XMD
+!
+!
+ZRVSAT(:,:,:) = ZEPS / (PPABST(:,:,:) * &
+ EXP(-XALPW+XBETAW/ZT(:,:,:)+XGAMW*ALOG(ZT(:,:,:))) - 1.0)
+ZZW1LOG(:,:,:)= 0. ! supersaturation
+ZTDT(:,:,:) = 0.
+ZDRC(:,:,:) = 0.
+IF (OACTIT) THEN
+ ZTM(:,:,:) = PTHM(:,:,:) * (PPABSM(:,:,:)/XP00)**(XRD/XCPD)
+ ZTDT(:,:,:) = (ZT(:,:,:)-ZTM(:,:,:))/PTSTEP ! dT/dt
+ ZDRC(:,:,:) = (PRCT(:,:,:)-PRCM(:,:,:))/PTSTEP ! drc/dt
+ ZTDT(:,:,:) = MIN(0.,ZTDT(:,:,:)+(XG*PW_NU(:,:,:))/XCPD- &
+ (XLVTT+(XCPV-XCL)*(ZT(:,:,:)-XTT))*ZDRC(:,:,:)/XCPD)
+! Modif M.Mazoyer
+! ZTDT(:,:,:) = PDTHRAD(:,:,:)*(PPABST(:,:,:)/XP00)**(XRD/XCPD)
+END IF
+!
+! optimization by looking for locations where
+! the updraft velocity is positive!!!
+!
+GNUCT(:,:,:) = .FALSE.
+IF( OACTIT ) THEN
+ GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) = (PW_NU(IIB:IIE,IJB:IJE,IKB:IKE)>XWMIN .OR. &
+ ZTDT(IIB:IIE,IJB:IJE,IKB:IKE)<XTMIN) .AND. &
+ PRVT(IIB:IIE,IJB:IJE,IKB:IKE)>(0.98*ZRVSAT(IIB:IIE,IJB:IJE,IKB:IKE))
+ELSE
+ GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) = PW_NU(IIB:IIE,IJB:IJE,IKB:IKE)>XWMIN .AND. &
+ PRVT(IIB:IIE,IJB:IJE,IKB:IKE)>(0.98*ZRVSAT(IIB:IIE,IJB:IJE,IKB:IKE))
+END IF
+!
+INUCT = COUNTJV(GNUCT(:,:,:),I1(:),I2(:),I3(:))
+
+IF( INUCT >= 1 ) THEN
+ ALLOCATE(ZRVT(INUCT))
+ ALLOCATE(ZRCT(INUCT))
+ ALLOCATE(ZRRT(INUCT))
+ ALLOCATE(ZZT(INUCT))
+ ALLOCATE(ZTDTBIS(INUCT))
+ ALLOCATE(ZZW1(INUCT))
+ ALLOCATE(ZZW2(INUCT))
+ ALLOCATE(ZZW3(INUCT))
+ ALLOCATE(ZZW4(INUCT))
+ ALLOCATE(ZZW5(INUCT))
+ ALLOCATE(ZDG3(INUCT))
+ ALLOCATE(ZCCS(INUCT))
+ ALLOCATE(ZCNS(INUCT))
+ ALLOCATE(ZRHODREF(INUCT))
+ ALLOCATE(ZEXNREF(INUCT))
+ ALLOCATE(ZPABST(INUCT))
+ ALLOCATE(ZNCN(INUCT))
+ ALLOCATE(ZMCN(INUCT))
+ ALLOCATE(ZSMAX(INUCT))
+ ALLOCATE(ZAERO(INUCT,SIZE(PAEROT,4)))
+ ALLOCATE(ZSOLORG(INUCT,SIZE(PSOLORG,4)))
+ ALLOCATE(ZMI(INUCT,SIZE(PMI,4)))
+ ALLOCATE(ZLBDC3(INUCT))
+
+ DO JL=1,INUCT
+ ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL))
+ ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
+ ZRRT(JL) = PRRT(I1(JL),I2(JL),I3(JL))
+ ZCCS(JL) = PCCS(I1(JL),I2(JL),I3(JL))
+ ZCNS(JL) = PCNS(I1(JL),I2(JL),I3(JL))
+ ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
+ ZZW1(JL) = ZRVSAT(I1(JL),I2(JL),I3(JL))
+ ZZW2(JL) = PW_NU(I1(JL),I2(JL),I3(JL))
+ ZTDTBIS(JL) = ZTDT(I1(JL),I2(JL),I3(JL))
+ ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
+ ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL))
+ ZPABST(JL) = PPABST(I1(JL),I2(JL),I3(JL))
+ ZAERO(JL,:) = PAEROT(I1(JL),I2(JL),I3(JL),:)
+ ZLBDC3(JL) = ZWLBDC3(I1(JL),I2(JL),I3(JL))
+
+ ENDDO
+!
+ ZSMAX(:) = 0.
+ IF (LORILAM) THEN
+ DO JL=1,INUCT
+ ZSOLORG(JL,:) = PSOLORG(I1(JL),I2(JL),I3(JL),:)
+ ZMI(JL,:) = PMI(I1(JL),I2(JL),I3(JL),:)
+ ENDDO
+ ELSE
+ ZSOLORG(:,:) = 0.
+ ZMI(:,:) = 0.
+ END IF
+
+ CALL CH_AER_ACTIVATION(ZAERO, ZZT, ZZW2, ZTDTBIS, ZRHODREF, ZPABST,&
+ ZNCN, ZMCN, ZSOLORG, ZMI, ZSMAX)
+
+! Nb de goutelettes activées
+
+!test
+ ZZW1(:) = MAX(ZNCN(:)/PTSTEP - ZCNS(:), 0.)
+!
+ ZW(:,:,:) = UNPACK( ZZW1(:),MASK=GNUCT(:,:,:),FIELD=0.0 )
+ PCNS(:,:,:) = PCNS(:,:,:) + ZW(:,:,:)
+!
+! Modification reservoir eau (gaz et liquide)
+!
+! valeur de petites goutelettes type brouillard (test)
+! ZALPHA=0.8
+! ZMU=3.
+! ZDG3(:) = 1./ZLBDC3(:) * GAMMA(ZMU + 3./ZALPHA) / GAMMA(ZMU) ! integrated cubic diameter
+! ZZW2(:) = ZZW1(:) + ZCCS(:)
+! ZZW1(:) = XPI/6. * ZDG3(:)**3 * (ZZW1(:)) * 1000. / ZRHODREF(:)
+! !
+! ZW(:,:,:) = MIN( UNPACK( ZZW1(:),MASK=GNUCT(:,:,:),FIELD=0.0 ),PRVS(:,:,:) )
+! !
+!
+! PRVS(:,:,:) = PRVS(:,:,:) - ZW(:,:,:)
+! PRCS(:,:,:) = PRCS(:,:,:) + ZW(:,:,:)
+! !
+! ! Modification temperature (diabatisme)
+! ZZW1(:) = ZZW1(:)*(XLVTT+(XCPV-XCL)*(ZZT(:)-XTT))/ &
+! (ZEXNREF(:)*( XCPD+XCPV*ZRVT(:)+XCL*(ZRCT(:)+ZRRT(:))))
+! !
+! ZW(:,:,:) = MIN( UNPACK( ZZW1(:),MASK=GNUCT(:,:,:),FIELD=0.0 ),PRVS(:,:,:) )
+! !
+! PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)
+! !
+! ! Modification gouttes nuages
+! ZW(:,:,:) = PCCS(:,:,:)
+! PCCS(:,:,:) = UNPACK(ZZW2(:),MASK=GNUCT(:,:,:),FIELD=ZW(:,:,:))
+ ZZW2(:) = MAX(ZNCN(:)/PTSTEP - ZCNS(:), 0.)
+ ZZW1(:)=0.
+ WHERE(ZZW2(:).gt.0.0)
+ ZZW1(:)=MIN(XCSTDCRIT * ZZW2(:) / ( ((ZZT(:)*ZSMAX(:))**3.)&
+ *ZRHODREF(:) ) , 1.E-5 )
+ END WHERE
+ ZW(:,:,:) = MIN( UNPACK( ZZW1(:),MASK=GNUCT(:,:,:),FIELD=0.0 ),PRVS(:,:,:) )
+ PRVS(:,:,:) = PRVS(:,:,:) - ZW(:,:,:)
+ PRCS(:,:,:) = PRCS(:,:,:) + ZW(:,:,:)
+!
+ DEALLOCATE(ZRVT)
+ DEALLOCATE(ZRCT)
+ DEALLOCATE(ZRRT)
+ DEALLOCATE(ZZT)
+ DEALLOCATE(ZTDTBIS)
+ DEALLOCATE(ZZW1)
+ DEALLOCATE(ZZW2)
+ DEALLOCATE(ZZW3)
+ DEALLOCATE(ZZW4)
+ DEALLOCATE(ZZW5)
+ DEALLOCATE(ZDG3)
+ DEALLOCATE(ZCCS)
+ DEALLOCATE(ZCNS)
+ DEALLOCATE(ZRHODREF)
+ DEALLOCATE(ZEXNREF)
+ DEALLOCATE(ZPABST)
+ DEALLOCATE(ZNCN)
+ DEALLOCATE(ZMCN)
+ DEALLOCATE(ZAERO)
+ DEALLOCATE(ZSMAX)
+ DEALLOCATE(ZSOLORG)
+ DEALLOCATE(ZMI)
+ DEALLOCATE(ZLBDC3)
+
+END IF
+!
+!
+!* budget storage
+!
+!
+if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HENU', pths(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'HENU', prvs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'HENU', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg ), 'HENU', pcns(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'HENU', pccs(:, :, :) * prhodj(:, :, :) )
+end if
+
+ END SUBROUTINE AER_NUCLEATION
+!
+!-------------------------------------------------------------------------------
+!
+ SUBROUTINE C2R2_COALESCENCE
+!
+!
+! ------------
+!
+IMPLICIT NONE
+!
+!* 0.2 declaration of local variables
+!
+INTEGER , DIMENSION(SIZE(GNUCT)) :: I1,I2,I3 ! Used to replace the COUNT
+INTEGER :: JL ! and PACK intrinsics
+!
+!-------------------------------------------------------------------------------
+!
+!
+GMICRO(:,:,:) = .FALSE.
+GMICRO(IIB:IIE,IJB:IJE,IKB:IKE) = &
+ PRCT(IIB:IIE,IJB:IJE,IKB:IKE)>XRTMIN(2) .OR. &
+ PRRT(IIB:IIE,IJB:IJE,IKB:IKE)>XRTMIN(3)
+IMICRO = COUNTJV( GMICRO(:,:,:),I1(:),I2(:),I3(:))
+IF( IMICRO >= 1 ) THEN
+ ALLOCATE(ZRCT(IMICRO))
+ ALLOCATE(ZRRT(IMICRO))
+ ALLOCATE(ZCCT(IMICRO))
+ ALLOCATE(ZCRT(IMICRO))
+!
+ ALLOCATE(ZRCS(IMICRO))
+ ALLOCATE(ZRRS(IMICRO))
+ ALLOCATE(ZCCS(IMICRO))
+ ALLOCATE(ZCRS(IMICRO))
+!
+ ALLOCATE(ZLBDC(IMICRO))
+ ALLOCATE(ZLBDC3(IMICRO))
+ ALLOCATE(ZLBDR(IMICRO))
+ ALLOCATE(ZLBDR3(IMICRO))
+!
+ ALLOCATE(ZRHODREF(IMICRO))
+!
+ DO JL=1,IMICRO
+ ZCCT(JL) = PCCT(I1(JL),I2(JL),I3(JL))
+ ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
+ ZRRT(JL) = PRRT(I1(JL),I2(JL),I3(JL))
+ ZCRT(JL) = PCRT(I1(JL),I2(JL),I3(JL))
+ ZCCS(JL) = PCCS(I1(JL),I2(JL),I3(JL))
+ ZRCS(JL) = PRCS(I1(JL),I2(JL),I3(JL))
+ ZRRS(JL) = PRRS(I1(JL),I2(JL),I3(JL))
+ ZCRS(JL) = PCRS(I1(JL),I2(JL),I3(JL))
+ ZLBDR(JL) = ZWLBDR(I1(JL),I2(JL),I3(JL))
+ ZLBDR3(JL) = ZWLBDR3(I1(JL),I2(JL),I3(JL))
+ ZLBDC(JL) = ZWLBDC(I1(JL),I2(JL),I3(JL))
+ ZLBDC3(JL) = ZWLBDC3(I1(JL),I2(JL),I3(JL))
+ ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
+ END DO
+!
+ ALLOCATE(GSELF(IMICRO))
+ ALLOCATE(GACCR(IMICRO))
+ ALLOCATE(GSCBU(IMICRO))
+ ALLOCATE(ZZW1(IMICRO))
+ ALLOCATE(ZZW2(IMICRO))
+ ALLOCATE(ZZW3(IMICRO))
+!
+!* 4.1 Self-collection of cloud droplets
+!
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'SELF', pccs(:, :, :) * prhodj(:, :, :) )
+
+ GSELF(:) = ZCCT(:)>XCTMIN(2)
+ ISELF = COUNT(GSELF(:))
+ IF( ISELF>0 ) THEN
+ ZZW1(:) = XSELFC*(ZCCT(:)/ZLBDC3(:))**2 ! analytical integration
+ WHERE( GSELF(:) )
+ ZCCS(:) = ZCCS(:) - MIN( ZCCS(:),ZZW1(:) )
+ END WHERE
+ END IF
+
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'SELF', &
+ Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
+!
+!* 4.2 Autoconversion of cloud droplets
+! using a Berry-Reinhardt parameterization
+!
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'AUTO', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RR), 'AUTO', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 2), 'AUTO', pcrs(:, :, :) * prhodj(:, :, :) )
+
+ ZZW2(:) = 0.0
+ ZZW1(:) = 0.0
+ WHERE( ZRCT(:)>XRTMIN(2) )
+ ZZW2(:) = MAX( 0.0,XLAUTR*ZRHODREF(:)*ZRCT(:)* &
+ (XAUTO1/ZLBDC(:)**4-XLAUTR_THRESHOLD) ) ! L
+!
+ ZZW3(:) = MIN( ZRCS(:), MAX( 0.0,XITAUTR*ZZW2(:)*ZRCT(:)* &
+ (XAUTO2/ZLBDC(:)-XITAUTR_THRESHOLD) ) ) ! L/tau
+!
+ ZRCS(:) = ZRCS(:) - ZZW3(:)
+ ZRRS(:) = ZRRS(:) + ZZW3(:)
+!
+ ZZW1(:) = MIN( MIN( 1.2E4,(XACCR4/ZLBDC(:)-XACCR5)/XACCR3), &
+ ZLBDR(:)/XACCR1 ) ! D**-1 threshold diameter for
+ ! switching the autoconversion regimes
+ ! min (80 microns, D_h, D_r)
+ ZZW3(:) = ZZW3(:) * ZRHODREF(:)**2 * MAX( 0.0,ZZW1(:) )**3 / XAC
+ ZCRS(:) = ZCRS(:) + ZZW3(:)
+ END WHERE
+
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'AUTO', &
+ Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'AUTO', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 2), 'AUTO', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+!
+!
+!* 4.3 Accretion sources
+!
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'ACCR', &
+ Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'ACCR', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'ACCR', &
+ Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
+!
+!* 4.31 test the criterium Df>Dh or Nr>Nrm
+!
+ GACCR(:) = ZRRT(:)>XRTMIN(3) .AND. ZCRT(:)>XCTMIN(3)
+ IACCR = COUNT(GACCR(:))
+ IF( IACCR>0 ) THEN
+ ALLOCATE(ZZW4(IMICRO)); ZZW4(:) = XACCR1/ZLBDR(:)
+ ALLOCATE(GENABLE_ACCR_SCBU(IMICRO))
+ GENABLE_ACCR_SCBU(:) = ZRRT(:)>1.2*ZZW2(:)/ZRHODREF(:) .OR. &
+ ZZW4(:)>=MAX( XACCR2,XACCR3/(XACCR4/ZLBDC(:)-XACCR5) )
+ GACCR(:) = GACCR(:) .AND. ZRCT(:)>XRTMIN(2) .AND. GENABLE_ACCR_SCBU(:)
+ END IF
+!
+ IACCR = COUNT(GACCR(:))
+ IF( IACCR>0 ) THEN
+ WHERE( GACCR(:).AND.(ZZW4(:)>1.E-4) ) ! Accretion for D>100 10-6 m
+ ZZW3(:) = ZLBDC3(:) / ZLBDR3(:)
+ ZZW1(:) = ZCCT(:)*ZCRT(:) / ZLBDC3(:)
+ ZZW2(:) = MIN( ZZW1(:)*(XACCR_CLARGE1+XACCR_CLARGE2*ZZW3(:)),ZCCS(:) )
+ ZCCS(:) = ZCCS(:) - ZZW2(:)
+!
+ ZZW1(:) = ZZW1(:) / ZLBDC3(:)
+ ZZW2(:) = MIN( ZZW1(:)*(XACCR_RLARGE1+XACCR_RLARGE2*ZZW3(:)) &
+ /ZRHODREF(:),ZRCS(:) )
+ ZRCS(:) = ZRCS(:) - ZZW2(:)
+ ZRRS(:) = ZRRS(:) + ZZW2(:)
+ END WHERE
+ WHERE( GACCR(:).AND.(ZZW4(:)<=1.E-4) ) ! Accretion for D<100 10-6 m
+ ZZW3(:) = ZLBDC3(:) / ZLBDR3(:)
+ ZZW1(:) = ZCCT(:)*ZCRT(:) / ZLBDC3(:)**2
+ ZZW3(:) = ZZW3(:)**2
+ ZZW2(:) = MIN( ZZW1(:)*(XACCR_CSMALL1+XACCR_CSMALL2*ZZW3(:)),ZCCS(:) )
+ ZCCS(:) = ZCCS(:) - ZZW2(:)
+!
+ ZZW1(:) = ZZW1(:) / ZLBDC3(:)
+ ZZW2(:) = MIN( ZZW1(:)*(XACCR_RSMALL1+XACCR_RSMALL2*ZZW3(:)) &
+ /ZRHODREF(:),ZRCS(:) )
+ ZRCS(:) = ZRCS(:) - ZZW2(:)
+ ZRRS(:) = ZRRS(:) + ZZW2(:)
+ END WHERE
+ END IF
+
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'ACCR', &
+ Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'ACCR', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'ACCR', &
+ Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
+!
+!* 4.4 Self collection - Coalescence/Break-up
+!
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 2), 'SCBU', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+
+ IF( IACCR>0 ) THEN
+ GSCBU(:) = ZCRT(:)>XCTMIN(3) .AND. GENABLE_ACCR_SCBU(:)
+ ISCBU = COUNT(GSCBU(:))
+ ELSE
+ ISCBU = 0.0
+ END IF
+ IF( ISCBU>0 ) THEN
+!
+!* 4.41 efficiencies
+!
+ IF (.NOT.ALLOCATED(ZZW4)) ALLOCATE(ZZW4(IMICRO))
+ ZZW4(:) = XACCR1 / ZLBDR(:) ! Mean diameter
+ ALLOCATE(ZSCBU(IMICRO))
+ ZSCBU(:) = 1.0
+ WHERE (ZZW4(:)>=XSCBU_EFF1 .AND. GSCBU(:)) ZSCBU(:) = & ! Coalescence
+ EXP(XSCBUEXP1*(ZZW4(:)-XSCBU_EFF1)) ! efficiency
+ WHERE (ZZW4(:)>=XSCBU_EFF2) ZSCBU(:) = 0.0 ! Break-up
+!
+!* 4.42 integration
+!
+ ZZW1(:) = 0.0
+ ZZW2(:) = 0.0
+ ZZW3(:) = 0.0
+ ZZW4(:) = XACCR1 / ZLBDR(:) ! Mean volume drop diameter
+ WHERE (GSCBU(:).AND.(ZZW4(:)>1.E-4)) ! analytical integration
+ ZZW1(:) = XSCBU2 * ZCRT(:)**2 / ZLBDR3(:) ! D>100 10-6 m
+ ZZW3(:) = ZZW1(:)*ZSCBU(:)
+ END WHERE
+ WHERE (GSCBU(:).AND.(ZZW4(:)<=1.E-4))
+ ZZW2(:) = XSCBU3 * (ZCRT(:) / ZLBDR3(:))**2 ! D<100 10-6 m
+ ZZW3(:) = ZZW2(:)
+ END WHERE
+ ZCRS(:) = ZCRS(:) - MIN( ZCRS(:),ZZW3(:) )
+ DEALLOCATE(ZSCBU)
+ END IF
+!
+!
+ ZW(:,:,:) = PRCS(:,:,:)
+ PRCS(:,:,:) = UNPACK( ZRCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PRRS(:,:,:)
+ PRRS(:,:,:) = UNPACK( ZRRS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PCCS(:,:,:)
+ PCCS(:,:,:) = UNPACK( ZCCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PCRS(:,:,:)
+ PCRS(:,:,:) = UNPACK( ZCRS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 2), 'SCBU', pcrs(:, :, :) * prhodj(:, :, :) )
+
+ DEALLOCATE(ZRCT)
+ DEALLOCATE(ZRRT)
+ DEALLOCATE(ZCCT)
+ DEALLOCATE(ZCRT)
+ DEALLOCATE(ZRCS)
+ DEALLOCATE(ZRRS)
+ DEALLOCATE(ZCRS)
+ DEALLOCATE(ZCCS)
+ DEALLOCATE(ZRHODREF)
+ DEALLOCATE(GSELF)
+ DEALLOCATE(GACCR)
+ DEALLOCATE(GSCBU)
+ IF( ALLOCATED(GENABLE_ACCR_SCBU) ) DEALLOCATE(GENABLE_ACCR_SCBU)
+ DEALLOCATE(ZZW1)
+ DEALLOCATE(ZZW2)
+ DEALLOCATE(ZZW3)
+ IF( ALLOCATED(ZZW4) ) DEALLOCATE(ZZW4)
+ DEALLOCATE(ZLBDR3)
+ DEALLOCATE(ZLBDC3)
+ DEALLOCATE(ZLBDR)
+ DEALLOCATE(ZLBDC)
+ IF( ALLOCATED(IVEC1) ) THEN
+ DEALLOCATE(IVEC1)
+ DEALLOCATE(ZVEC1)
+ END IF
+END IF
+!
+ END SUBROUTINE C2R2_COALESCENCE
+!
+!-------------------------------------------------------------------------------
+!
+SUBROUTINE KHKO_COALESCENCE
+!
+! ------------
+!
+IMPLICIT NONE
+!
+!* 0.2 declaration of local variables
+!
+INTEGER , DIMENSION(SIZE(GNUCT)) :: I1,I2,I3 ! Used to replace the COUNT
+INTEGER :: JL ! and PACK intrinsics
+!
+!-------------------------------------------------------------------------------
+!
+!
+GMICRO(:,:,:) = .FALSE.
+GMICRO(IIB:IIE,IJB:IJE,IKB:IKE) = &
+ PRCT(IIB:IIE,IJB:IJE,IKB:IKE)>XRTMIN(2) .OR. &
+ PRRT(IIB:IIE,IJB:IJE,IKB:IKE)>XRTMIN(3)
+IMICRO = COUNTJV( GMICRO(:,:,:),I1(:),I2(:),I3(:))
+IF( IMICRO >= 1 ) THEN
+ ALLOCATE(ZRCT(IMICRO))
+ ALLOCATE(ZRRT(IMICRO))
+ ALLOCATE(ZCCT(IMICRO))
+!
+ ALLOCATE(ZRCS(IMICRO))
+ ALLOCATE(ZRRS(IMICRO))
+ ALLOCATE(ZCCS(IMICRO))
+ ALLOCATE(ZCRS(IMICRO))
+!
+ ALLOCATE(ZRHODREF(IMICRO))
+!
+ DO JL=1,IMICRO
+ ZCCT(JL) = PCCT(I1(JL),I2(JL),I3(JL))
+ ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
+ ZRRT(JL) = PRRT(I1(JL),I2(JL),I3(JL))
+ ZCCS(JL) = PCCS(I1(JL),I2(JL),I3(JL))
+ ZRCS(JL) = PRCS(I1(JL),I2(JL),I3(JL))
+ ZRRS(JL) = PRRS(I1(JL),I2(JL),I3(JL))
+ ZCRS(JL) = PCRS(I1(JL),I2(JL),I3(JL))
+ ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
+ END DO
+!
+ ALLOCATE(ZZW1(IMICRO))
+!
+!* 4.1.1 autoconversion
+!
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'SELF', pccs(:, :, :) * prhodj(:, :, :) )
+
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'AUTO', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'AUTO', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 2), 'AUTO', pcrs(:, :, :) * prhodj(:, :, :) )
+
+ WHERE ( ZRCT(:) .GT. XRTMIN(2) .AND. ZCCT(:) .GT. XCTMIN(2) &
+ .AND. (ZRCS(:) .GT. 0.0) .AND. (ZCCS(:) .GT. 0.0))
+!
+ ZZW1(:)= 1350.0 * ZRCT(:)**(2.47) * (ZCCT(:)/1.0E6)**(-1.79) ! ZCCT in cm-3
+ ZZW1(:) = min (ZRCS(:), ZZW1(:))
+ ZRCS(:) = ZRCS(:) - ZZW1(:)
+ ZRRS(:) = ZRRS(:) + ZZW1(:)
+!
+ ZCRS(:) = ZCRS(:) + ZZW1(:) * 3. * ZRHODREF(:)/(4.*XPI*XRHOLW*(XR0)**(3.))
+!
+ ZZW1(:) = min ( ZCCS(:),ZZW1(:) * ZCCT(:) / ZRCT(:))
+ ZCCS(:) = ZCCS(:) - ZZW1(:)
+!
+ END WHERE
+!
+ ZW(:,:,:) = PRCS(:,:,:)
+ PRCS(:,:,:) = UNPACK( ZRCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PCCS(:,:,:)
+ PCCS(:,:,:) = UNPACK( ZCCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PRRS(:,:,:)
+ PRRS(:,:,:) = UNPACK( ZRRS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PCRS(:,:,:)
+ PCRS(:,:,:) = UNPACK( ZCRS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+!
+!* 4.1.2 budget storage
+!
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'SELF', pccs(:, :, :) * prhodj(:, :, :) )
+
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'AUTO', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'AUTO', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 2), 'AUTO', pcrs(:, :, :) * prhodj(:, :, :) )
+!
+!* 4.2.1 Accretion sources
+!
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'ACCR', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'ACCR', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'ACCR', pccs(:, :, :) * prhodj(:, :, :) )
+
+ WHERE ( (ZRCT(:) .GT. XRTMIN(2)) .AND. (ZRRT(:) .GT. XRTMIN(3)) &
+ .AND. (ZRCS(:) .GT. 0.0) .AND. (ZCCS(:) .GT. 0.0))
+
+ ZZW1(:) = 67.0 * ( ZRCT(:) * ZRRT(:) )**1.15
+ ZZW1(:) = MIN (ZRCS(:),ZZW1(:))
+ ZRCS(:) = ZRCS(:) - ZZW1(:)
+ ZRRS(:) = ZRRS(:) + ZZW1(:)
+!
+ ZZW1(:) = MIN (ZCCS(:),ZZW1(:) * ZCCT(:) / ZRCT(:))
+ ZCCS(:) = ZCCS(:) - ZZW1(:)
+!
+ END WHERE
+!
+ ZW(:,:,:) = PRCS(:,:,:)
+ PRCS(:,:,:) = UNPACK( ZRCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PCCS(:,:,:)
+ PCCS(:,:,:) = UNPACK( ZCCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PRRS(:,:,:)
+ PRRS(:,:,:) = UNPACK( ZRRS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+!
+ DEALLOCATE(ZRCT)
+ DEALLOCATE(ZRRT)
+ DEALLOCATE(ZCCT)
+ DEALLOCATE(ZRCS)
+ DEALLOCATE(ZRRS)
+ DEALLOCATE(ZCRS)
+ DEALLOCATE(ZCCS)
+ DEALLOCATE(ZRHODREF)
+ DEALLOCATE(ZZW1)
+!
+!* 4.2.2 budget storage
+!
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'ACCR', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'ACCR', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'ACCR', pccs(:, :, :) * prhodj(:, :, :) )
+END IF
+!
+ END SUBROUTINE KHKO_COALESCENCE
+!
+!------------------------------------------------------------------------------
+!
+ SUBROUTINE C2R2_KHKO_EVAPORATION
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!* 0.2 declaration of local variables
+!
+INTEGER , DIMENSION(SIZE(GNUCT)) :: I1,I2,I3 ! Used to replace the COUNT
+INTEGER :: JL ! and PACK intrinsics
+!
+!-------------------------------------------------------------------------------
+
+if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'REVA', pths(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'REVA', prvs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'REVA', prrs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 2), 'REVA', pcrs(:, :, :) * prhodj(:, :, :) )
+!
+! optimization by looking for locations where
+! the raindrop mixing ratio is non-zero
+!
+ZW(:,:,:) = 0.0
+ZLV(:,:,:) = XLVTT + (XCPV-XCL)*(ZT(:,:,:)-XTT) !!!latent heat of vaporization
+!
+GEVAP(:,:,:) = .FALSE.
+IF (HCLOUD=='C2R2'.OR. HCLOUD=='C3R5') THEN
+ GEVAP(IIB:IIE,IJB:IJE,IKB:IKE) = &
+ PRRS(IIB:IIE,IJB:IJE,IKB:IKE)> 0.0 .AND. &
+ PRVT(IIB:IIE,IJB:IJE,IKB:IKE)<ZRVSAT(IIB:IIE,IJB:IJE,IKB:IKE)
+ELSE ! KHKO
+ GEVAP(IIB:IIE,IJB:IJE,IKB:IKE) = &
+ PRRS(IIB:IIE,IJB:IJE,IKB:IKE)> 0.0 .AND. &
+ PCRS(IIB:IIE,IJB:IJE,IKB:IKE)> 0.0 .AND. &
+ PRRT(IIB:IIE,IJB:IJE,IKB:IKE)> 0.0 .AND. &
+ PCRT(IIB:IIE,IJB:IJE,IKB:IKE)> 0.0 .AND. &
+ PRVT(IIB:IIE,IJB:IJE,IKB:IKE)<ZRVSAT(IIB:IIE,IJB:IJE,IKB:IKE)
+ENDIF
+IEVAP = COUNTJV( GEVAP(:,:,:),I1(:),I2(:),I3(:))
+
+IF( IEVAP >= 1 ) THEN
+ ALLOCATE(ZRVT(IEVAP))
+ ALLOCATE(ZRCT(IEVAP))
+ ALLOCATE(ZRRT(IEVAP))
+ ALLOCATE(ZCRT(IEVAP))
+ ALLOCATE(ZRVS(IEVAP))
+ ALLOCATE(ZRRS(IEVAP))
+ ALLOCATE(ZCRS(IEVAP))
+ ALLOCATE(ZTHS(IEVAP))
+ ALLOCATE(ZLBDR(IEVAP))
+ ALLOCATE(ZRHODREF(IEVAP))
+ ALLOCATE(ZEXNREF(IEVAP))
+ ALLOCATE(ZZT(IEVAP))
+ ALLOCATE(ZZLV(IEVAP))
+ ALLOCATE(ZZW1(IEVAP))
+ ALLOCATE(ZZW2(IEVAP))
+ ALLOCATE(ZZW3(IEVAP))
+!
+ DO JL=1,IEVAP
+ ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL))
+ ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
+ ZRRT(JL) = PRRT(I1(JL),I2(JL),I3(JL))
+ ZCRT(JL) = PCRT(I1(JL),I2(JL),I3(JL))
+ ZRRS(JL) = PRRS(I1(JL),I2(JL),I3(JL))
+ ZRVS(JL) = PRVS(I1(JL),I2(JL),I3(JL))
+ ZTHS(JL) = PTHS(I1(JL),I2(JL),I3(JL))
+ ZCRS(JL) = PCRS(I1(JL),I2(JL),I3(JL))
+ ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
+ ZZW1(JL) = ZRVSAT(I1(JL),I2(JL),I3(JL))
+ ZLBDR(JL) = ZWLBDR(I1(JL),I2(JL),I3(JL))
+ ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
+ ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL))
+ ZZLV(JL) = ZLV(I1(JL),I2(JL),I3(JL))
+ END DO
+!
+!* 5.1 Compute the intermediate supersaturation mixing ratio
+!
+ ZZW3(:) = MAX((1.0 - ZRVT(:)/ZZW1(:)),0.0) ! Subsaturation
+!
+!* 5.2 Compute the function G(T)
+!
+ ZZW2(:) = 1. / ( XRHOLW*((((ZZLV(:)/ZZT(:))**2)/(XTHCO*XRV)) + & ! G
+ (XRV*ZZT(:))/(XDIVA*EXP(XALPW-XBETAW/ZZT(:)-XGAMW*ALOG(ZZT(:))))))
+!
+!* 5.3 Compute the evaporation tendency
+!
+ IF (HCLOUD =='C2R2'.OR. HCLOUD=='C3R5') THEN
+ ZZW2(:) = MIN( ZZW2(:) * ZZW3(:) * ZRRT(:) * &
+ (X0EVAR*ZLBDR(:)**XEX0EVAR + X1EVAR*ZRHODREF(:)**XEX2EVAR* &
+ ZLBDR(:)**XEX1EVAR),ZRRS(:) )
+ ZZW2(:) = MAX(ZZW2(:),0.0)
+ ELSE
+ ZZW2(:) = 3.0 * XCEVAP * ZZW2(:) * (4.*XPI*XRHOLW/(3.*ZRHODREF(:)))**(2./3.) * &
+ (ZRRT(:))**(1./3.) * (ZCRT(:))**(2./3.) * ZZW3(:)
+ ZZW2(:) = MIN(ZZW2(:),ZRRS(:))
+ ENDIF
+!
+!* 5.4 Adjust sources
+!
+ ZRVS(:) = ZRVS(:) + ZZW2(:)
+ ZRRS(:) = ZRRS(:) - ZZW2(:)
+ ZTHS(:) = ZTHS(:) - ZZW2(:) * ZZLV(:) / &
+ ( ZEXNREF(:)*(XCPD + XCPV*ZRVT(:) + XCL*(ZRCT(:) + ZRRT(:)) ) )
+!
+ ZW(:,:,:) = PRVS(:,:,:)
+ PRVS(:,:,:) = UNPACK( ZRVS(:),MASK=GEVAP(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PRRS(:,:,:)
+ PRRS(:,:,:) = UNPACK( ZRRS(:),MASK=GEVAP(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PTHS(:,:,:)
+ PTHS(:,:,:) = UNPACK( ZTHS(:),MASK=GEVAP(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:)= PEVAP3D(:,:,:)
+ PEVAP3D(:,:,:) = UNPACK( ZZW2(:),MASK=GEVAP(:,:,:),FIELD=ZW(:,:,:) )
+!
+ IF (HCLOUD == 'KHKO') THEN
+ ZZW2(:) = MIN(ZZW2(:) * ZCRT(:)/ZRRT(:),ZCRS(:))
+ ZCRS(:) = ZCRS(:) - ZZW2(:)
+ ZW(:,:,:) = PCRS(:,:,:)
+ PCRS(:,:,:) = UNPACK( ZCRS(:),MASK=GEVAP(:,:,:),FIELD=ZW(:,:,:) )
+ ENDIF
+ DEALLOCATE(ZRCT)
+ DEALLOCATE(ZRRT)
+ DEALLOCATE(ZRVT)
+ DEALLOCATE(ZCRT)
+ DEALLOCATE(ZRVS)
+ DEALLOCATE(ZRRS)
+ DEALLOCATE(ZTHS)
+ DEALLOCATE(ZCRS)
+ DEALLOCATE(ZZLV)
+ DEALLOCATE(ZZT)
+ DEALLOCATE(ZRHODREF)
+ DEALLOCATE(ZEXNREF)
+ DEALLOCATE(ZZW1)
+ DEALLOCATE(ZZW2)
+ DEALLOCATE(ZZW3)
+ DEALLOCATE(ZLBDR)
+!
+END IF
+
+IF (HCLOUD == 'C2R2'.OR. HCLOUD=='C3R5') THEN
+!* 5.5 Update Nr if: 80 microns < Dr < D_h
+!
+ GEVAP(:,:,:) = PRRS(:,:,:)>ZRTMIN(3) .AND. PCRS(:,:,:)>ZCTMIN(3) .AND. &
+ PRCS(:,:,:)>ZRTMIN(2) .AND. PCCS(:,:,:)>ZCTMIN(2)
+ WHERE (GEVAP(:,:,:))
+ ZWLBDR3(:,:,:) = XLBR * PCRS(:,:,:) / (PRHODREF(:,:,:) * PRRS(:,:,:))
+ ZWLBDR(:,:,:) = ZWLBDR3(:,:,:)**XLBEXR
+!
+ ZWLBDC3(:,:,:) = XLBC * PCCS(:,:,:) / (PRHODREF(:,:,:) * PRCS(:,:,:))
+ ZWLBDC(:,:,:) = ZWLBDC3(:,:,:)**XLBEXC
+ ZWLBDC3(:,:,:) = (XACCR1/XACCR3)*(XACCR4/ZWLBDC(:,:,:)-XACCR5)
+ ! "Lambda_h"
+ END WHERE
+!
+ GMICRO(:,:,:) = GEVAP(:,:,:) .AND. ZWLBDR(:,:,:)>ZWLBDC3(:,:,:)
+ ! the raindrops are too small, that is lower than D_h
+ ZFACT = 1.2E4*XACCR1
+ WHERE (GMICRO(:,:,:))
+ ZWLBDC(:,:,:) = XLBR / MIN( ZFACT,ZWLBDC3(:,:,:) )**3
+ ZW(:,:,:) = MIN( MAX( &
+ (PRHODREF(:,:,:)*PRRS(:,:,:) - ZWLBDC(:,:,:)*PCRS(:,:,:)) / &
+ (PRHODREF(:,:,:)*PRCS(:,:,:)/PCCS(:,:,:) - ZWLBDC(:,:,:)) , &
+ 0.0 ),PCRS(:,:,:), &
+ PCCS(:,:,:)*PRRS(:,:,:)/(PRHODREF(:,:,:)*PRCS(:,:,:)))
+!
+! Compute the percent (=1 if (ZWLBDR/XACCR1) >= 1.2E4
+! of transfer with (=0 if (ZWLBDR/XACCR1) <= (XACCR4/ZWLBDC-XACCR5)/XACCR3
+!
+ ZW(:,:,:) = ZW(:,:,:)*( (MIN(ZWLBDR(:,:,:),1.2E4*XACCR1)-ZWLBDC3(:,:,:)) / &
+ ( 1.2E4*XACCR1 -ZWLBDC3(:,:,:)) )
+!
+ ZWLBDC(:,:,:) = PCCS(:,:,:) !temporary storage
+ PCCS(:,:,:) = PCCS(:,:,:)+ZW(:,:,:)
+ PCRS(:,:,:) = PCRS(:,:,:)-ZW(:,:,:)
+ ZW(:,:,:) = ZW(:,:,:) * (PRHODREF(:,:,:)*PRCS(:,:,:)/ZWLBDC(:,:,:))
+ PRCS(:,:,:) = PRCS(:,:,:)+ZW(:,:,:)
+
+ PRRS(:,:,:) = PRRS(:,:,:)-ZW(:,:,:)
+ END WHERE
+!
+ GEVAP(:,:,:) = PRRS(:,:,:)<ZRTMIN(3) .OR. PCRS(:,:,:)<ZCTMIN(3)
+ WHERE (GEVAP(:,:,:))
+ PCRS(:,:,:) = 0.0
+ PRRS(:,:,:) = 0.0
+ END WHERE
+!
+
+ELSE ! KHKO
+!* correct negative values for rain
+! --------------------------------
+!
+ WHERE (PRRS(:,:,:)<0.)
+ PRCS(:,:,:) = PRCS(:,:,:)+PRRS(:,:,:)
+ PRRS(:,:,:) = 0.
+ PCRS(:,:,:) = 0.
+ END WHERE
+!
+!* REMOVES NON-PHYSICAL LOW VALUES
+ GEVAP(:,:,:) = PRRS(:,:,:)<ZRTMIN(3) .AND. PCRS(:,:,:)< ZCTMIN(3)
+ WHERE (GEVAP(:,:,:))
+ PRVS(:,:,:) = PRVS(:,:,:) + PRRS(:,:,:)
+ PTHS(:,:,:) = PTHS(:,:,:) - PRRS(:,:,:) * ZLV(:,:,:) / &
+ ( PEXNREF(:,:,:)*(XCPD + XCPV*PRVT(:,:,:) + XCL*(PRCT(:,:,:) + PRRT(:,:,:)) ) )
+ PCRS(:,:,:) = 0.0
+ PRRS(:,:,:) = 0.0
+ END WHERE
+ENDIF
+
+if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'REVA', pths(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'REVA', prvs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'REVA', prrs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 2), 'REVA', pcrs(:, :, :) * prhodj(:, :, :) )
+
+ END SUBROUTINE C2R2_KHKO_EVAPORATION
+!
+!-------------------------------------------------------------------------------
+!
+ SUBROUTINE C2R2_KHKO_SEDIMENTATION
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!* 0.2 declaration of local variables
+!
+!
+INTEGER , DIMENSION(SIZE(GSEDIM)) :: I1,I2,I3 ! Used to replace the COUNT
+INTEGER :: JL ! and PACK intrinsics
+!
+!-------------------------------------------------------------------------------
+
+if ( lbudget_rc .and. osedc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_sv ) then
+ if ( osedc ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'SEDI', pccs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 2), 'SEDI', pcrs(:, :, :) * prhodj(:, :, :) )
+end if
+!
+!* 2.1 compute the fluxes
+!
+! optimization by looking for locations where
+! the precipitating fields are larger than a minimal value only !!!
+!
+IF (OSEDC) PINPRC (:,:) = 0.
+IF (LDEPOC) PINDEP (:,:) = 0.
+!
+DO JN = 1 , KSPLITR
+ GSEDIM(:,:,:) = .FALSE.
+ IF( OSEDC ) THEN
+ GSEDIM(IIB:IIE,IJB:IJE,IKB:IKE) = &
+ PRCT(IIB:IIE,IJB:IJE,IKB:IKE)/PTSTEP>ZRTMIN(2) .OR. &
+ (PRRT(IIB:IIE,IJB:IJE,IKB:IKE)/PTSTEP>ZRTMIN(3) .AND. &
+ PCRT(IIB:IIE,IJB:IJE,IKB:IKE)/PTSTEP>ZCTMIN(3))
+ ELSE
+ GSEDIM(IIB:IIE,IJB:IJE,IKB:IKE) = &
+ PRRT(IIB:IIE,IJB:IJE,IKB:IKE)/PTSTEP>ZRTMIN(3) .AND. &
+ PCRT(IIB:IIE,IJB:IJE,IKB:IKE)/PTSTEP>ZCTMIN(3)
+ END IF
+!
+ ISEDIM = COUNTJV( GSEDIM(:,:,:),I1(:),I2(:),I3(:))
+!
+ IF( JN==1 ) THEN
+ IF( OSEDC ) THEN
+ ZPCCT(:,:,:) = PCCT(:,:,:)
+ ZPRCT(:,:,:) = PRCT(:,:,:)
+ PCCS(:,:,:) = PCCS(:,:,:) * PTSTEP - PCCT(:,:,:)
+ PRCS(:,:,:) = PRCS(:,:,:) * PTSTEP - PRCT(:,:,:)
+ END IF
+ ZPCRT(:,:,:) = PCRT(:,:,:)
+ ZPRRT(:,:,:) = PRRT(:,:,:)
+ PCRS(:,:,:) = PCRS(:,:,:) * PTSTEP - PCRT(:,:,:)
+ PRRS(:,:,:) = PRRS(:,:,:) * PTSTEP - PRRT(:,:,:)
+ DO JK = IKB , IKE
+ ZW(:,:,JK) = ZTSPLITR/(PZZ(:,:,JK+1) -PZZ(:,:,JK))
+ END DO
+ END IF
+!
+ ZWSEDR(:,:,:) = 0.0
+ ZWSEDC(:,:,:) = 0.0
+!
+ IF( ISEDIM >= 1 ) THEN
+!
+ ALLOCATE(ZRHODREF(ISEDIM))
+ DO JL = 1,ISEDIM
+ ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
+ END DO
+!
+ ALLOCATE(ZZW1(ISEDIM))
+ ALLOCATE(ZZW2(ISEDIM))
+ ALLOCATE(ZZW3(ISEDIM))
+!
+!* 2.21 for cloud
+!
+ ZZW1(:) = 0.0
+ ZZW2(:) = 0.0
+ ZZW3(:) = 0.0
+!
+ IF( OSEDC.AND.MAXVAL(PRCS(:,:,:))>0.0 ) THEN
+ ALLOCATE(ZRCT(ISEDIM))
+ ALLOCATE(ZCCT(ISEDIM))
+ ALLOCATE(ZLBDC(ISEDIM))
+ DO JL = 1,ISEDIM
+ ZRCT(JL) = ZPRCT(I1(JL),I2(JL),I3(JL))
+ ZCCT(JL) = ZPCCT(I1(JL),I2(JL),I3(JL))
+ ZLBDC(JL) = ZWLBDC(I1(JL),I2(JL),I3(JL))
+ END DO
+ WHERE( ZRCT(:)>XRTMIN(2) )
+ ZZW3(:) = ZRHODREF(:)**(-XCEXVT) * ZLBDC(:)**(-XDC)
+ ZZW1(:) = XFSEDRC * ZRCT(:) * ZZW3(:) * ZRHODREF(:)
+ ZZW2(:) = XFSEDCC * ZCCT(:) * ZZW3(:)
+ END WHERE
+ ZWSEDR(:,:,:) = UNPACK( ZZW1(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
+ ZWSEDC(:,:,:) = UNPACK( ZZW2(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
+ DEALLOCATE(ZRCT)
+ DEALLOCATE(ZCCT)
+ DEALLOCATE(ZLBDC)
+ END IF
+!
+ END IF
+!
+ IF( OSEDC ) THEN
+ DO JK = IKB , IKE
+ ZPRCT(:,:,JK) = ZPRCT(:,:,JK) + ZW(:,:,JK)* &
+ (ZWSEDR(:,:,JK+1)-ZWSEDR(:,:,JK))/PRHODREF(:,:,JK)
+ ZPCCT(:,:,JK) = ZPCCT(:,:,JK) + ZW(:,:,JK)* &
+ (ZWSEDC(:,:,JK+1)-ZWSEDC(:,:,JK))
+ END DO
+!
+ IF( JN.EQ.1 ) THEN
+ PINPRC(:,:) = ZWSEDR(:,:,IKB)/XRHOLW ! in m/s
+ END IF
+ END IF
+!
+!* 2.22 for drizzle
+!
+ ZWSEDR(:,:,:) = 0.0
+ ZWSEDC(:,:,:) = 0.0
+ IF( ISEDIM >= 1 ) THEN
+ ZZW1(:) = 0.0
+ ZZW2(:) = 0.0
+!
+ IF( MAXVAL(PRRS(:,:,:))>0.0 ) THEN
+ ALLOCATE(ZRRT(ISEDIM))
+ ALLOCATE(ZCRT(ISEDIM))
+ ALLOCATE(ZZVRR(ISEDIM))
+ ALLOCATE(ZZVCR(ISEDIM))
+ DO JL = 1,ISEDIM
+ ZRRT(JL) = ZPRRT(I1(JL),I2(JL),I3(JL))
+ ZCRT(JL) = ZPCRT(I1(JL),I2(JL),I3(JL))
+ ZZVRR(JL) = ZVRR(I1(JL),I2(JL),I3(JL))
+ ZZVCR(JL) = ZVCR(I1(JL),I2(JL),I3(JL))
+ END DO
+ WHERE (ZRRT(:)>XRTMIN(3) )
+ ZZW1(:) = ZZVRR(:) * ZRRT(:) * ZRHODREF(:)
+ ZZW2(:) = ZZVCR(:) * ZCRT(:)
+ END WHERE
+ ZWSEDR(:,:,:) = UNPACK( ZZW1(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
+ ZWSEDC(:,:,:) = UNPACK( ZZW2(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
+!
+ DEALLOCATE(ZRRT)
+ DEALLOCATE(ZCRT)
+ DEALLOCATE(ZZVRR)
+ DEALLOCATE(ZZVCR)
+!
+ END IF
+!
+ DEALLOCATE(ZRHODREF)
+ DEALLOCATE(ZZW1)
+ DEALLOCATE(ZZW2)
+ DEALLOCATE(ZZW3)
+!
+ END IF
+!
+!* 2.3 update the rain tendency
+!
+ DO JK = IKB , IKE
+ ZPRRT(:,:,JK) = ZPRRT(:,:,JK) + ZW(:,:,JK)* &
+ (ZWSEDR(:,:,JK+1)-ZWSEDR(:,:,JK))/PRHODREF(:,:,JK)
+ ZPCRT(:,:,JK) = ZPCRT(:,:,JK) + ZW(:,:,JK)* &
+ (ZWSEDC(:,:,JK+1)-ZWSEDC(:,:,JK))
+ END DO
+!
+!* 2.4 compute the explicit accumulated precipitations
+!
+ IF( JN.EQ.1 ) THEN
+ PINPRR(:,:) = ZWSEDR(:,:,IKB)/XRHOLW ! in m/s
+ PINPRR3D(:,:,:) = ZWSEDR(:,:,:)/XRHOLW ! in m/s
+ END IF
+!
+ IF( JN==KSPLITR ) THEN
+ IF( OSEDC ) THEN
+ PRCS(:,:,:) = ( PRCS(:,:,:) + ZPRCT(:,:,:) ) / PTSTEP
+ PCCS(:,:,:) = ( PCCS(:,:,:) + ZPCCT(:,:,:) ) / PTSTEP
+ END IF
+ PRRS(:,:,:) = ( PRRS(:,:,:) + ZPRRT(:,:,:) ) / PTSTEP
+ PCRS(:,:,:) = ( PCRS(:,:,:) + ZPCRT(:,:,:) ) / PTSTEP
+ END IF
+!
+ IF ( OSEDC .AND. tpfile%lopened ) THEN
+ TZFIELD%CMNHNAME = 'SEDFLUXC'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'SEDFLUXC'
+ TZFIELD%CUNITS = ''
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_SEDFLUXC'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWSEDC)
+ !
+ TZFIELD%CMNHNAME = 'SEDFLUXR'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'SEDFLUXR'
+ TZFIELD%CUNITS = ''
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_SEDFLUXR'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWSEDR)
+ END IF
+END DO
+!
+!* 2.5 budget storage
+!
+if ( lbudget_rc .and. osedc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_sv ) then
+ if ( osedc ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'SEDI', pccs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 2), 'SEDI', pcrs(:, :, :) * prhodj(:, :, :) )
+end if
+!
+!* 2.6 DROPLET DEPOSITION AT THE 1ST LEVEL ABOVE GROUND
+!
+IF (LDEPOC) THEN
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'DEPO', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'DEPO', pccs(:, :, :) * prhodj(:, :, :) )
+
+ GDEP(:,:) = .FALSE.
+ GDEP(IIB:IIE,IJB:IJE) = PRCS(IIB:IIE,IJB:IJE,2) >0 .AND. &
+ PCCS(IIB:IIE,IJB:IJE,2) >0
+ WHERE (GDEP)
+ PRCS(:,:,2) = PRCS(:,:,2) - XVDEPOC * PRCT(:,:,2) / ( PZZ(:,:,3) - PZZ(:,:,2))
+ PCCS(:,:,2) = PCCS(:,:,2) - XVDEPOC * PCCT(:,:,2) / ( PZZ(:,:,3) - PZZ(:,:,2))
+ PINPRC(:,:) = PINPRC(:,:) + XVDEPOC * PRCT(:,:,2) * PRHODREF(:,:,2) /XRHOLW
+ PINDEP(:,:) = XVDEPOC * PRCT(:,:,2) * PRHODREF(:,:,2) /XRHOLW
+ END WHERE
+
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'DEPO', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'DEPO', pccs(:, :, :) * prhodj(:, :, :) )
+END IF
+
+ END SUBROUTINE C2R2_KHKO_SEDIMENTATION
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE RAIN_C2R2_KHKO
diff --git a/src/mesonh/micro/rain_ice.f90 b/src/mesonh/micro/rain_ice.f90
new file mode 100644
index 000000000..d736f5a9c
--- /dev/null
+++ b/src/mesonh/micro/rain_ice.f90
@@ -0,0 +1,945 @@
+!MNH_LIC Copyright 1995-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ######spl
+ MODULE MODI_RAIN_ICE
+! ####################
+!
+INTERFACE
+ SUBROUTINE RAIN_ICE ( OSEDIC,HSEDIM, HSUBG_AUCV, OWARM, KKA, KKU, KKL, &
+ KSPLITR, PTSTEP, KRR, &
+ PDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, &
+ PRGT, PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
+ PINPRC,PINPRR, PINPRR3D, PEVAP3D, &
+ PINPRS, PINPRG, PSIGS, PINDEP, PRAINFR, PSEA, PTOWN, &
+ PRHT, PRHS, PINPRH, PFPR )
+!
+!
+LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
+CHARACTER(LEN=4), INTENT(IN) :: HSEDIM ! Sedimentation scheme
+CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV ! Switch for rc->rr Subgrid autoconversion
+ ! Kind of Subgrid autoconversion method
+LOGICAL, INTENT(IN) :: OWARM ! .TRUE. allows raindrops to
+ ! form by warm processes
+ ! (Kessler scheme)
+!
+INTEGER, INTENT(IN) :: KKA !near ground array index
+INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
+INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step
+ ! integration for rain sedimendation
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
+ ! (single if cold start)
+INTEGER, INTENT(IN) :: KRR ! Number of moist variable
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Layer thikness (m)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! absolute pressure at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! Cloud fraction
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRGS ! Graupel m.r. source
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC! Cloud instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINDEP ! Cloud instant deposition
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR! Rain instant precip
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PINPRR3D! Rain inst precip 3D
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D! Rain evap profile
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS! Snow instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG! Graupel instant precip
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRAINFR! Rain fraction
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN! Fraction that is town
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(INOUT) :: PINPRH! Hail instant precip
+REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
+!
+END SUBROUTINE RAIN_ICE
+END INTERFACE
+END MODULE MODI_RAIN_ICE
+! ######spl
+ SUBROUTINE RAIN_ICE ( OSEDIC,HSEDIM, HSUBG_AUCV, OWARM, KKA, KKU, KKL, &
+ KSPLITR, PTSTEP, KRR, &
+ PDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, &
+ PRGT, PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
+ PINPRC,PINPRR, PINPRR3D, PEVAP3D, &
+ PINPRS, PINPRG, PSIGS, PINDEP, PRAINFR, PSEA, PTOWN, &
+ PRHT, PRHS, PINPRH, PFPR )
+! ######################################################################
+!
+!!**** * - compute the explicit microphysical sources
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the slow microphysical sources
+!! which can be computed explicitly
+!!
+!!
+!!** METHOD
+!! ------
+!! The autoconversion computation follows Kessler (1969).
+!! The sedimentation rate is computed with a time spliting technique and
+!! an upstream scheme, written as a difference of non-advective fluxes. This
+!! source term is added to the future instant ( split-implicit process ).
+!! The others microphysical processes are evaluated at the central instant
+!! (split-explicit process ): autoconversion, accretion and rain evaporation.
+!! These last 3 terms are bounded in order not to create negative values
+!! for the water species at the future instant.
+!!
+!! EXTERNAL
+!! --------
+!! None
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS
+!! JPHEXT : Horizontal external points number
+!! JPVEXT : Vertical external points number
+!! Module MODD_CONF :
+!! CCONF configuration of the model for the first time step
+!! Module MODD_CST
+!! XP00 ! Reference pressure
+!! XRD,XRV ! Gaz constant for dry air, vapor
+!! XMD,XMV ! Molecular weight for dry air, vapor
+!! XCPD ! Cpd (dry air)
+!! XCL ! Cl (liquid)
+!! XCI ! Ci (solid)
+!! XTT ! Triple point temperature
+!! XLVTT ! Vaporization heat constant
+!! XALPW,XBETAW,XGAMW ! Constants for saturation vapor pressure
+!! function over liquid water
+!! XALPI,XBETAI,XGAMI ! Constants for saturation vapor pressure
+!! function over solid ice
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Book1 and Book2 of documentation ( routine RAIN_ICE )
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 02/11/95
+!! (J.Viviand) 04/02/97 debug accumulated prcipitation & convert
+!! precipitation rate in m/s
+!! (J.-P. Pinty) 17/02/97 add budget calls
+!! (J.-P. Pinty) 17/11/97 set ice sedim. for cirrus ice, reset RCHONI
+!! and RRHONG, reverse order for DEALLOCATE
+!! (J.-P. Pinty) 11/02/98 correction of the air dynamical viscosity and
+!! add advance of the budget calls
+!! (J.-P. Pinty) 18/05/98 correction of the air density in the RIAUTS
+!! process
+!! (J.-P. Pinty) 18/11/98 split the main routine
+!! (V. Masson) 18/11/98 bug in IVEC1 and IVEC2 upper limits
+!! (J. Escobar & J.-P. Pinty)
+!! 11/12/98 contains and rewrite count+pack
+!! (J. Stein & J.-P. Pinty)
+!! 14/10/99 correction for very small RIT
+!! (J. Escobar & J.-P. Pinty)
+!! 24/07/00 correction for very samll m.r. in
+!! the sedimentation subroutine
+!! (M. Tomasini) 11/05/01 Autoconversion of rc into rr modification to take
+!! into account the subgrid variance
+!! (cf Redelsperger & Sommeria JAS 86)
+!! (G. Molinie) 21/05/99 bug in RRCFRIG process, RHODREF**(-1) missing
+!! in RSRIMCG
+!! (G. Molinie & J.-P. Pinty)
+!! 21/06/99 bug in RACCS process
+!! (P. Jabouille) 27/05/04 safety test for case where esw/i(T)> pabs (~Z>40km)
+!! (J-.P. Chaboureau) 12/02/05 temperature depending ice-to-snow autocon-
+! version threshold (Chaboureau and Pinty GRL 2006)
+!! (J.-P. Pinty) 01/01/O1 add the hail category and correction of the
+!! wet growth rate of the graupeln
+!! (S.Remy & C.Lac) 06/06 Add the cloud sedimentation
+!! (S.Remy & C.Lac) 06/06 Sedimentation becoming the last process
+!! to settle the precipitating species created during the current time step
+!! (S.Remy & C.Lac) 06/06 Modification of the algorithm of sedimentation
+!! to settle n times the precipitating species created during Dt/n instead
+!! of Dt
+!! (C.Lac) 11/06 Optimization of the sedimentation loop for NEC
+!! (J.Escobar) 18/01/2008 Parallel Bug in Budget when IMICRO >= 1
+!! --> Path inhibit this test by IMICRO >= 0 allway true
+!! (Y.Seity) 03/2008 Add Statistic sedimentation
+!! (Y.Seity) 10/2009 Added condition for the raindrop accretion of the aggregates
+!! into graupeln process (5.2.6) to avoid negative graupel mixing ratio
+!! (V.Masson, C.Lac) 09/2010 Correction in split sedimentation for
+!! reproducibility
+!! (S. Riette) Oct 2010 Better vectorisation of RAIN_ICE_SEDIMENTATION_STAT
+!! (Y. Seity), 02-2012 add possibility to run with reversed vertical levels
+!! (L. Bengtsson), 02-2013 Passing in land/sea mask and town fraction in
+!! order to use different cloud droplet number conc. over
+!! land, sea and urban areas in the cloud sedimentation.
+!! (D. Degrauwe), 2013-11: Export upper-air precipitation fluxes PFPR.
+!! (S. Riette) Nov 2013 Protection against null sigma
+!! (C. Lac) FIT temporal scheme : instant M removed
+!! (JP Pinty), 01-2014 : ICE4 : partial reconversion of hail to graupel
+!! July, 2015 (O.Nuissier/F.Duffourg) Add microphysics diagnostic for
+!! aircraft, ballon and profiler
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! C.Lac : 10/2016 : add droplet deposition
+!! C.Lac : 01/2017 : correction on droplet deposition
+!! J.Escobar : 10/2017 : for real*4 , limit exp() in RAIN_ICE_SLOW with XMNH_HUGE_12_LOG
+!! (C. Abiven, Y. Léauté, V. Seigner, S. Riette) Phasing of Turner rain subgrid param
+!! J.Escobar : 8/2018 : for real*4 , bis => limit exp() in RAIN_ICE_SLOW with XMNH_HUGE_12_LOG
+!! P.Wautelet 01/02/2019: add missing initialization for PFPR
+!! 02/2019 C.Lac add rain fraction as an output field
+! P. Wautelet 25/02/2019: split rain_ice (cleaner and easier to maintain/debug)
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+! P. Wautelet 29/05/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
+! J. Escobar 09/07/2019: for reproductiblity MPPDB_CHECK, add missing LCHECK test in ZRHODJ de/allocate
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets (no more budget calls in this subroutine)
+!-----------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+use modd_budget, only: lbu_enable
+use MODD_CONF, only: LCHECK
+use MODD_CST, only: XCI, XCL, XCPD, XCPV, XLSTT, XLVTT, XTT, &
+ XALPI, XBETAI, XGAMI, XMD, XMV, XTT
+use MODD_LES, only: LLES_CALL
+use MODD_PARAMETERS, only: JPVEXT
+use MODD_PARAM_ICE, only: CSUBG_PR_PDF, LDEPOSC
+use MODD_RAIN_ICE_DESCR, only: XLBEXR, XLBR, XRTMIN
+use MODD_RAIN_ICE_PARAM, only: XCRIAUTC
+
+use MODE_MSG
+use MODE_RAIN_ICE_FAST_RG, only: RAIN_ICE_FAST_RG
+use MODE_RAIN_ICE_FAST_RH, only: RAIN_ICE_FAST_RH
+use MODE_RAIN_ICE_FAST_RI, only: RAIN_ICE_FAST_RI
+use MODE_RAIN_ICE_FAST_RS, only: RAIN_ICE_FAST_RS
+use MODE_RAIN_ICE_NUCLEATION, only: RAIN_ICE_NUCLEATION
+use MODE_RAIN_ICE_SEDIMENTATION_SPLIT, only: RAIN_ICE_SEDIMENTATION_SPLIT
+use MODE_RAIN_ICE_SEDIMENTATION_STAT, only: RAIN_ICE_SEDIMENTATION_STAT
+use MODE_RAIN_ICE_SLOW, only: RAIN_ICE_SLOW
+use MODE_RAIN_ICE_WARM, only: RAIN_ICE_WARM
+use mode_tools, only: Countjv
+use mode_tools_ll, only: GET_INDICE_ll
+
+USE MODI_ICE4_RAINFR_VERT
+
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+!
+!
+LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
+CHARACTER(LEN=4), INTENT(IN) :: HSEDIM ! Sedimentation scheme
+CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV ! Switch for rc->rr Subgrid autoconversion
+ ! Kind of Subgrid autoconversion method
+LOGICAL, INTENT(IN) :: OWARM ! .TRUE. allows raindrops to
+ ! form by warm processes
+ ! (Kessler scheme)
+!
+INTEGER, INTENT(IN) :: KKA !near ground array index
+INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
+INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step
+ ! integration for rain sedimendation
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
+ ! (single if cold start)
+INTEGER, INTENT(IN) :: KRR ! Number of moist variable
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Layer thikness (m)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! absolute pressure at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! Cloud fraction
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRGS ! Graupel m.r. source
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC! Cloud instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINDEP ! Cloud instant deposition
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR! Rain instant precip
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PINPRR3D! Rain inst precip 3D
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D! Rain evap profile
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS! Snow instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG! Graupel instant precip
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRAINFR! Rain fraction
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN! Fraction that is town
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(INOUT) :: PINPRH! Hail instant precip
+REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IIB ! Define the domain where is
+INTEGER :: IIE ! the microphysical sources have to be computed
+INTEGER :: IIT !
+INTEGER :: IJB !
+INTEGER :: IJE !
+INTEGER :: IJT !
+INTEGER :: IKB,IKTB,IKT !
+INTEGER :: IKE,IKTE !
+!
+INTEGER :: IMICRO
+INTEGER, DIMENSION(SIZE(PEXNREF)) :: I1,I2,I3 ! Used to replace the COUNT
+INTEGER :: JL ! and PACK intrinsics
+LOGICAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
+ :: GMICRO ! Test where to compute all processes
+REAL :: ZINVTSTEP
+REAL :: ZCOEFFRCM
+REAL, DIMENSION(:), ALLOCATABLE :: ZRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRRT ! Rain water m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRGT ! Graupel m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRHT ! Hail m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZCIT ! Pristine ice conc. at t
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZRVS ! Water vapor m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRCS ! Cloud water m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRRS ! Rain water m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRIS ! Pristine ice m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRSS ! Snow/aggregate m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRGS ! Graupel m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRHS ! Hail m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZTHS ! Theta source
+REAL, DIMENSION(:), ALLOCATABLE :: ZTHT ! Potential temperature
+REAL, DIMENSION(:), ALLOCATABLE :: ZTHLT ! Liquid potential temperature
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZRHODREF, & ! RHO Dry REFerence
+ ZRHODJ, & ! RHO times Jacobian
+ ZZT, & ! Temperature
+ ZPRES, & ! Pressure
+ ZEXNREF, & ! EXNer Pressure REFerence
+ ZZW, & ! Work array
+ ZLSFACT, & ! L_s/(Pi_ref*C_ph)
+ ZLVFACT, & ! L_v/(Pi_ref*C_ph)
+ ZUSW, & ! Undersaturation over water
+ ZSSI, & ! Supersaturation over ice
+ ZLBDAR, & ! Slope parameter of the raindrop distribution
+ ZLBDAR_RF,& ! Slope parameter of the raindrop distribution
+ ! for the Rain Fraction part
+ ZLBDAS, & ! Slope parameter of the aggregate distribution
+ ZLBDAG, & ! Slope parameter of the graupel distribution
+ ZLBDAH, & ! Slope parameter of the hail distribution
+ ZRDRYG, & ! Dry growth rate of the graupeln
+ ZRWETG, & ! Wet growth rate of the graupeln
+ ZAI, & ! Thermodynamical function
+ ZCJ, & ! Function to compute the ventilation coefficient
+ ZKA, & ! Thermal conductivity of the air
+ ZDV, & ! Diffusivity of water vapor in the air
+ ZSIGMA_RC,& ! Standard deviation of rc at time t
+ ZCF, & ! Cloud fraction
+ ZRF, & ! Rain fraction
+ ZHLC_HCF, & ! HLCLOUDS : fraction of High Cloud Fraction in grid
+ ZHLC_LCF, & ! HLCLOUDS : fraction of Low Cloud Fraction in grid
+ ! note that ZCF = ZHLC_HCF + ZHLC_LCF
+ ZHLC_HRC, & ! HLCLOUDS : LWC that is High LWC in grid
+ ZHLC_LRC, & ! HLCLOUDS : LWC that is Low LWC in grid
+ ! note that ZRC = ZHLC_HRC + ZHLC_LRC
+ ZHLC_RCMAX, & ! HLCLOUDS : maximum value for RC in distribution
+ ZRCRAUTC, & ! RC value to begin rain formation =XCRIAUTC/RHODREF
+ ZHLC_HRCLOCAL, & ! HLCLOUDS : LWC that is High LWC local in HCF
+ ZHLC_LRCLOCAL ! HLCLOUDS : LWC that is Low LWC local in LCF
+ ! note that ZRC/CF = ZHLC_HRCLOCAL+ ZHLC_LRCLOCAL
+ ! = ZHLC_HRC/HCF+ ZHLC_LRC/LCF
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZZW1 ! Work arrays
+REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
+ :: ZW ! work array
+REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
+ :: ZT ! Temperature
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTE THE LOOP BOUNDS
+! -----------------------
+!
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+IIT=SIZE(PDZZ,1)
+IJT=SIZE(PDZZ,2)
+IKB=KKA+JPVEXT*KKL
+IKE=KKU-JPVEXT*KKL
+IKT=SIZE(PDZZ,3)
+IKTB=1+JPVEXT
+IKTE=IKT-JPVEXT
+!
+!
+ZINVTSTEP=1./PTSTEP
+!
+!
+!* 2. COMPUTES THE SLOW COLD PROCESS SOURCES
+! --------------------------------------
+!
+CALL RAIN_ICE_NUCLEATION(IIB, IIE, IJB, IJE, IKTB, IKTE,KRR,PTSTEP,&
+ PTHT,PPABST,PRHODJ,PRHODREF,PRVT,PRCT,PRRT,PRIT,PRST,PRGT,&
+ PCIT,PEXNREF,PTHS,PRVS,PRIS,ZT,PRHT)
+!
+!
+! optimization by looking for locations where
+! the microphysical fields are larger than a minimal value only !!!
+!
+GMICRO(:,:,:) = .FALSE.
+
+ IF ( KRR == 7 ) THEN
+ GMICRO(IIB:IIE,IJB:IJE,IKTB:IKTE) = &
+ PRCT(IIB:IIE,IJB:IJE,IKTB:IKTE)>XRTMIN(2) .OR. &
+ PRRT(IIB:IIE,IJB:IJE,IKTB:IKTE)>XRTMIN(3) .OR. &
+ PRIT(IIB:IIE,IJB:IJE,IKTB:IKTE)>XRTMIN(4) .OR. &
+ PRST(IIB:IIE,IJB:IJE,IKTB:IKTE)>XRTMIN(5) .OR. &
+ PRGT(IIB:IIE,IJB:IJE,IKTB:IKTE)>XRTMIN(6) .OR. &
+ PRHT(IIB:IIE,IJB:IJE,IKTB:IKTE)>XRTMIN(7)
+ ELSE IF( KRR == 6 ) THEN
+ GMICRO(IIB:IIE,IJB:IJE,IKTB:IKTE) = &
+ PRCT(IIB:IIE,IJB:IJE,IKTB:IKTE)>XRTMIN(2) .OR. &
+ PRRT(IIB:IIE,IJB:IJE,IKTB:IKTE)>XRTMIN(3) .OR. &
+ PRIT(IIB:IIE,IJB:IJE,IKTB:IKTE)>XRTMIN(4) .OR. &
+ PRST(IIB:IIE,IJB:IJE,IKTB:IKTE)>XRTMIN(5) .OR. &
+ PRGT(IIB:IIE,IJB:IJE,IKTB:IKTE)>XRTMIN(6)
+ END IF
+
+IMICRO = COUNTJV( GMICRO(:,:,:),I1(:),I2(:),I3(:))
+IF( IMICRO >= 0 ) THEN
+ ALLOCATE(ZRVT(IMICRO))
+ ALLOCATE(ZRCT(IMICRO))
+ ALLOCATE(ZRRT(IMICRO))
+ ALLOCATE(ZRIT(IMICRO))
+ ALLOCATE(ZRST(IMICRO))
+ ALLOCATE(ZRGT(IMICRO))
+ IF ( KRR == 7 ) THEN
+ ALLOCATE(ZRHT(IMICRO))
+ ELSE
+ ALLOCATE(ZRHT(0))
+ END IF
+ ALLOCATE(ZCIT(IMICRO))
+ ALLOCATE(ZRVS(IMICRO))
+ ALLOCATE(ZRCS(IMICRO))
+ ALLOCATE(ZRRS(IMICRO))
+ ALLOCATE(ZRIS(IMICRO))
+ ALLOCATE(ZRSS(IMICRO))
+ ALLOCATE(ZRGS(IMICRO))
+ IF ( KRR == 7 ) THEN
+ ALLOCATE(ZRHS(IMICRO))
+ ELSE
+ ALLOCATE(ZRHS(0))
+ END IF
+ ALLOCATE(ZTHS(IMICRO))
+ ALLOCATE(ZTHT(IMICRO))
+ ALLOCATE(ZTHLT(IMICRO))
+ ALLOCATE(ZRHODREF(IMICRO))
+ ALLOCATE(ZZT(IMICRO))
+ ALLOCATE(ZPRES(IMICRO))
+ ALLOCATE(ZEXNREF(IMICRO))
+ ALLOCATE(ZSIGMA_RC(IMICRO))
+ ALLOCATE(ZCF(IMICRO))
+ ALLOCATE(ZRF(IMICRO))
+ ALLOCATE(ZHLC_HCF(IMICRO))
+ ALLOCATE(ZHLC_LCF(IMICRO))
+ ALLOCATE(ZHLC_HRC(IMICRO))
+ ALLOCATE(ZHLC_LRC(IMICRO))
+ ALLOCATE(ZHLC_RCMAX(IMICRO))
+ ALLOCATE(ZRCRAUTC(IMICRO))
+ ALLOCATE(ZHLC_HRCLOCAL(IMICRO))
+ ALLOCATE(ZHLC_LRCLOCAL(IMICRO))
+
+ DO JL=1,IMICRO
+ ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL))
+ ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
+ ZRRT(JL) = PRRT(I1(JL),I2(JL),I3(JL))
+ ZRIT(JL) = PRIT(I1(JL),I2(JL),I3(JL))
+ ZRST(JL) = PRST(I1(JL),I2(JL),I3(JL))
+ ZRGT(JL) = PRGT(I1(JL),I2(JL),I3(JL))
+ IF ( KRR == 7 ) ZRHT(JL) = PRHT(I1(JL),I2(JL),I3(JL))
+ ZCIT(JL) = PCIT(I1(JL),I2(JL),I3(JL))
+ ZCF(JL) = PCLDFR(I1(JL),I2(JL),I3(JL))
+ IF ( HSUBG_AUCV == 'PDF ' .AND. CSUBG_PR_PDF == 'SIGM' ) THEN
+ ZSIGMA_RC(JL) = PSIGS(I1(JL),I2(JL),I3(JL)) * 2.
+! ZSIGMA_RC(JL) = MAX(PSIGS(I1(JL),I2(JL),I3(JL)) * 2., 1.E-12)
+ END IF
+ ZRVS(JL) = PRVS(I1(JL),I2(JL),I3(JL))
+ ZRCS(JL) = PRCS(I1(JL),I2(JL),I3(JL))
+ ZRRS(JL) = PRRS(I1(JL),I2(JL),I3(JL))
+ ZRIS(JL) = PRIS(I1(JL),I2(JL),I3(JL))
+ ZRSS(JL) = PRSS(I1(JL),I2(JL),I3(JL))
+ ZRGS(JL) = PRGS(I1(JL),I2(JL),I3(JL))
+ IF ( KRR == 7 ) ZRHS(JL) = PRHS(I1(JL),I2(JL),I3(JL))
+ ZTHS(JL) = PTHS(I1(JL),I2(JL),I3(JL))
+!
+ ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
+ ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
+ ZTHT(JL) = PTHT(I1(JL),I2(JL),I3(JL))
+ ZTHLT(JL) = ZTHT(JL) - XLVTT * ZTHT(JL) / XCPD / ZZT(JL) * ZRCT(JL)
+ ZPRES(JL) = PPABST(I1(JL),I2(JL),I3(JL))
+ ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL))
+ ENDDO
+ ALLOCATE(ZZW(IMICRO))
+ ALLOCATE(ZLSFACT(IMICRO))
+ ALLOCATE(ZLVFACT(IMICRO))
+ ZZW(:) = ZEXNREF(:)*( XCPD+XCPV*ZRVT(:)+XCL*(ZRCT(:)+ZRRT(:)) &
+ +XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)) )
+ ZLSFACT(:) = (XLSTT+(XCPV-XCI)*(ZZT(:)-XTT))/ZZW(:) ! L_s/(Pi_ref*C_ph)
+ ZLVFACT(:) = (XLVTT+(XCPV-XCL)*(ZZT(:)-XTT))/ZZW(:) ! L_v/(Pi_ref*C_ph)
+ ALLOCATE(ZUSW(IMICRO))
+ ALLOCATE(ZSSI(IMICRO))
+ ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) )
+ ZSSI(:) = ZRVT(:)*( ZPRES(:)-ZZW(:) ) / ( (XMV/XMD) * ZZW(:) ) - 1.0
+ ! Supersaturation over ice
+!
+ ALLOCATE(ZLBDAR(IMICRO))
+ ALLOCATE(ZLBDAR_RF(IMICRO))
+ ALLOCATE(ZLBDAS(IMICRO))
+ ALLOCATE(ZLBDAG(IMICRO))
+ IF ( KRR == 7 ) THEN
+ ALLOCATE(ZLBDAH(IMICRO))
+ ELSE
+ ALLOCATE(ZLBDAH(0))
+ END IF
+ ALLOCATE(ZRDRYG(IMICRO))
+ ALLOCATE(ZRWETG(IMICRO))
+ ALLOCATE(ZAI(IMICRO))
+ ALLOCATE(ZCJ(IMICRO))
+ ALLOCATE(ZKA(IMICRO))
+ ALLOCATE(ZDV(IMICRO))
+!
+ IF ( KRR == 7 ) THEN
+ ALLOCATE(ZZW1(IMICRO,7))
+ ELSE IF( KRR == 6 ) THEN
+ ALLOCATE(ZZW1(IMICRO,6))
+ ENDIF
+!
+ IF (LBU_ENABLE .OR. LLES_CALL .OR. LCHECK ) THEN
+ ALLOCATE(ZRHODJ(IMICRO))
+ DO JL=1,IMICRO
+ ZRHODJ(JL) = PRHODJ(I1(JL),I2(JL),I3(JL))
+ END DO
+ ELSE
+ ALLOCATE(ZRHODJ(0))
+ END IF
+!
+
+ !Cloud water split between high and low content part is done here
+ !according to autoconversion option
+ ZRCRAUTC(:) = XCRIAUTC/ZRHODREF(:) ! Autoconversion rc threshold
+ IF (HSUBG_AUCV == 'NONE') THEN
+ !Cloud water is entirely in low or high part
+ WHERE (ZRCT(:) > ZRCRAUTC(:))
+ ZHLC_HCF(:) = 1.
+ ZHLC_LCF(:) = 0.0
+ ZHLC_HRC(:) = ZRCT(:)
+ ZHLC_LRC(:) = 0.0
+ ZRF(:) = 1.
+ ELSEWHERE (ZRCT(:) > XRTMIN(2))
+ ZHLC_HCF(:) = 0.0
+ ZHLC_LCF(:) = 1.
+ ZHLC_HRC(:) = 0.0
+ ZHLC_LRC(:) = ZRCT(:)
+ ZRF(:) = 0.
+ ELSEWHERE
+ ZHLC_HCF(:) = 0.0
+ ZHLC_LCF(:) = 0.0
+ ZHLC_HRC(:) = 0.0
+ ZHLC_LRC(:) = 0.0
+ ZRF(:) = 0.
+ END WHERE
+
+ ELSEIF (HSUBG_AUCV == 'CLFR') THEN
+ !Cloud water is only in the cloudy part and entirely in low or high part
+ WHERE (ZCF(:) > 0. .AND. ZRCT(:) > ZRCRAUTC(:)*ZCF(:))
+ ZHLC_HCF(:) = ZCF(:)
+ ZHLC_LCF(:) = 0.0
+ ZHLC_HRC(:) = ZRCT(:)
+ ZHLC_LRC(:) = 0.0
+ ZRF(:) = ZCF(:)
+ ELSEWHERE (ZCF(:) > 0. .AND. ZRCT(:) > XRTMIN(2))
+ ZHLC_HCF(:) = 0.0
+ ZHLC_LCF(:) = ZCF(:)
+ ZHLC_HRC(:) = 0.0
+ ZHLC_LRC(:) = ZRCT(:)
+ ZRF(:) = 0.
+ ELSEWHERE (ZCF(:) > 0.)
+ ZHLC_HCF(:) = 0.0
+ ZHLC_LCF(:) = 0.0
+ ZHLC_HRC(:) = 0.0
+ ZHLC_LRC(:) = 0.0
+ ZRF(:) = 0.
+ ELSEWHERE
+ ZHLC_HCF(:) = 0.0
+ ZHLC_LCF(:) = 0.0
+ ZHLC_HRC(:) = 0.0
+ ZHLC_LRC(:) = 0.0
+ ZRF(:) = 0.
+ END WHERE
+
+ ELSEIF (HSUBG_AUCV == 'PDF ') THEN
+ !Cloud water is split between high and low part according to a PDF
+ ! 'HLCRECTPDF' : rectangular PDF form
+ ! 'HLCTRIANGPDF' : triangular PDF form
+ ! 'HLCQUADRAPDF' : second order quadratic PDF form
+ ! 'HLCISOTRIPDF' : isocele triangular PDF
+ ! 'SIGM' : Redelsperger and Sommeria (1986)
+
+ IF ( CSUBG_PR_PDF == 'SIGM' ) THEN
+ ! Redelsperger and Sommeria (1986) but organised according to Turner (2011, 2012)
+ WHERE ( ZRCT(:) > ZRCRAUTC(:) + ZSIGMA_RC(:))
+ ZHLC_HCF(:) = 1.
+ ZHLC_LCF(:) = 0.0
+ ZHLC_HRC(:) = ZRCT(:)
+ ZHLC_LRC(:) = 0.0
+ ZRF(:) = 1.
+ ELSEWHERE ( ZRCT(:) > ( ZRCRAUTC(:) - ZSIGMA_RC(:) ) .AND. &
+ & ZRCT(:) <= ( ZRCRAUTC(:) + ZSIGMA_RC(:) ) )
+ ZHLC_HCF(:) = (ZRCT(:)+ZSIGMA_RC(:)-ZRCRAUTC(:))/ &
+ &(2.*ZSIGMA_RC(:))
+ ZHLC_LCF(:) = MAX(0., ZCF(:)-ZHLC_HCF(:))
+ ZHLC_HRC(:) = (ZRCT(:)+ZSIGMA_RC(:)-ZRCRAUTC(:))* &
+ &(ZRCT(:)+ZSIGMA_RC(:)+ZRCRAUTC(:))/ &
+ &(4.*ZSIGMA_RC(:))
+ ZHLC_LRC(:) = MAX(0., ZRCT(:)-ZHLC_HRC(:))
+ ZRF(:) = ZHLC_HCF(:)
+ ELSEWHERE ( ZRCT(:)>XRTMIN(2) .AND. ZCF(:)>0. )
+ ZHLC_LCF(:) = 0.0
+ ZHLC_LCF(:) = ZCF(:)
+ ZHLC_HRC(:) = 0.0
+ ZHLC_LRC(:) = ZRCT(:)
+ ZRF(:) = 0.
+ ELSEWHERE
+ ZHLC_HCF(:) = 0.0
+ ZHLC_LCF(:) = 0.0
+ ZHLC_HRC(:) = 0.0
+ ZHLC_LRC(:) = 0.0
+ ZRF(:) = 0.
+ END WHERE
+
+ ! Turner (2011, 2012)
+ ELSEIF ( CSUBG_PR_PDF== 'HLCRECTPDF' .OR. CSUBG_PR_PDF == 'HLCISOTRIPDF' .OR. &
+ & CSUBG_PR_PDF == 'HLCTRIANGPDF' .OR. CSUBG_PR_PDF == 'HLCQUADRAPDF' ) THEN
+ ! Calculate maximum value r_cM from PDF forms
+ IF ( CSUBG_PR_PDF == 'HLCRECTPDF' .OR. CSUBG_PR_PDF == 'HLCISOTRIPDF' ) THEN
+ ZCOEFFRCM = 2.0
+ ELSE IF ( CSUBG_PR_PDF == 'HLCTRIANGPDF' ) THEN
+ ZCOEFFRCM = 3.0
+ ELSE IF ( CSUBG_PR_PDF == 'HLCQUADRAPDF' ) THEN
+ ZCOEFFRCM = 4.0
+ END IF
+ WHERE (ZRCT(:).GT.0. .AND. ZCF(:).GT.0.)
+ ZHLC_RCMAX(:) = ZCOEFFRCM * ZRCT(:) / ZCF(:)
+ END WHERE
+
+ ! Split available water and cloud fraction in two parts
+ ! Calculate local mean values int he low and high parts for the 3 PDF forms:
+ IF ( CSUBG_PR_PDF == 'HLCRECTPDF' ) THEN
+ WHERE (ZRCT(:).GT.0. .AND. ZCF(:).GT.0. .AND. ZHLC_RCMAX(:).GT.ZRCRAUTC(:))
+ ZHLC_LRCLOCAL(:) = 0.5*ZRCRAUTC(:)
+ ZHLC_HRCLOCAL(:) = ( ZHLC_RCMAX(:) + ZRCRAUTC(:)) / 2.0
+ END WHERE
+ ELSE IF ( CSUBG_PR_PDF == 'HLCTRIANGPDF' ) THEN
+ WHERE (ZRCT(:).GT.0. .AND. ZCF(:).GT.0. .AND. ZHLC_RCMAX(:).GT.ZRCRAUTC(:))
+ ZHLC_LRCLOCAL(:) = ( ZRCRAUTC(:) *(3.0 * ZHLC_RCMAX(:) - 2.0 * ZRCRAUTC(:) ) ) &
+ / (3.0 * (2.0 * ZHLC_RCMAX(:) - ZRCRAUTC(:) ) )
+ ZHLC_HRCLOCAL(:) = (ZHLC_RCMAX(:) + 2.0*ZRCRAUTC(:)) / 3.0
+ END WHERE
+ ELSE IF ( CSUBG_PR_PDF == 'HLCQUADRAPDF' ) THEN
+ WHERE (ZRCT(:).GT.0. .AND. ZCF(:).GT.0. .AND. ZHLC_RCMAX(:).GT.ZRCRAUTC(:))
+ ZHLC_LRCLOCAL(:) = (3.0 *ZRCRAUTC(:)**3 - 8.0 *ZRCRAUTC(:)**2 * ZHLC_RCMAX(:) &
+ + 6.0*ZRCRAUTC(:) *ZHLC_RCMAX(:)**2 ) &
+ / &
+ (4.0* ZRCRAUTC(:)**2 -12.0*ZRCRAUTC(:) *ZHLC_RCMAX(:) &
+ + 12.0 * ZHLC_RCMAX(:)**2 )
+ ZHLC_HRCLOCAL(:) = (ZHLC_RCMAX(:) + 3.0*ZRCRAUTC(:)) / 4.0
+ END WHERE
+ ELSE IF ( CSUBG_PR_PDF == 'HLCISOTRIPDF' ) THEN
+ WHERE (ZRCT(:).GT.0. .AND. ZCF(:).GT.0. .AND. ZHLC_RCMAX(:).GT.ZRCRAUTC(:))
+ WHERE ( (ZRCT(:) / ZCF(:)).LE.ZRCRAUTC(:) )
+ ZHLC_LRCLOCAL(:) = ( (ZHLC_RCMAX(:))**3 &
+ - (12.0 * (ZHLC_RCMAX(:))*(ZRCRAUTC(:))**2) &
+ + (8.0 * ZRCRAUTC(:)**3) ) &
+ / ( (6.0 * (ZHLC_RCMAX(:))**2) &
+ - (24.0 * (ZHLC_RCMAX(:)) * ZRCRAUTC(:)) &
+ + (12.0 * ZRCRAUTC(:)**2) )
+ ZHLC_HRCLOCAL(:) = ( ZHLC_RCMAX(:) + 2.0 * ZRCRAUTC(:) ) / 3.0
+ ELSEWHERE
+ ZHLC_LRCLOCAL(:) = (2.0/3.0) * ZRCRAUTC(:)
+ ZHLC_HRCLOCAL(:) = (3.0*ZHLC_RCMAX(:)**3 - 8.0*ZRCRAUTC(:)**3) &
+ / (6.0 * ZHLC_RCMAX(:)**2 - 12.0*ZRCRAUTC(:)**2)
+ END WHERE
+ END WHERE
+ END IF
+
+ ! Compare r_cM to r_cR to know if cloud water content is high enough to split in two parts or not
+ WHERE (ZRCT(:).GT.0. .AND. ZCF(:).GT.0. .AND. ZHLC_RCMAX(:).GT.ZRCRAUTC(:))
+ ! Calculate final values for LCF and HCF:
+ ZHLC_LCF(:) = ZCF(:) &
+ * ( ZHLC_HRCLOCAL - &
+ ( ZRCT(:) / ZCF(:) ) ) &
+ / (ZHLC_HRCLOCAL - ZHLC_LRCLOCAL)
+ ZHLC_HCF(:) = MAX(0., ZCF(:) - ZHLC_LCF(:))
+ !
+ ! Calculate final values for LRC and HRC:
+ ZHLC_LRC(:) = ZHLC_LRCLOCAL * ZHLC_LCF(:)
+ ZHLC_HRC(:) = MAX(0., ZRCT(:) - ZHLC_LRC(:))
+ ELSEWHERE (ZRCT(:).GT.0. .AND. ZCF(:).GT.0. .AND. ZHLC_RCMAX(:).LE.ZRCRAUTC(:))
+ ! Put all available cloud water and his fraction in the low part
+ ZHLC_LCF(:) = ZCF(:)
+ ZHLC_HCF(:) = 0.0
+ ZHLC_LRC(:) = ZRCT(:)
+ ZHLC_HRC(:) = 0.0
+ ELSEWHERE
+ ZHLC_LCF(:) = 0.
+ ZHLC_HCF(:) = 0.0
+ ZHLC_LRC(:) = 0.
+ ZHLC_HRC(:) = 0.0
+ END WHERE
+
+ ZRF(:)=ZHLC_HCF(:) !Precipitation fraction
+
+ ELSE
+ !wrong CSUBG_PR_PDF case
+ WRITE(*,*) 'wrong CSUBG_PR_PDF case'
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','RAIN_ICE','')
+ ENDIF
+ ELSE
+ !wrong HSUBG_AUCV case
+ WRITE(*,*)'wrong HSUBG_AUCV case'
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','RAIN_ICE','')
+ ENDIF
+
+ !Diagnostic of precipitation fraction
+ PRAINFR(:,:,:) = 0.
+ DO JL=1,IMICRO
+ PRAINFR(I1(JL),I2(JL),I3(JL)) = ZRF(JL)
+ END DO
+ CALL ICE4_RAINFR_VERT( IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKT, KKL, PRAINFR, PRRT(:,:,:), &
+ RESHAPE( SOURCE = [ ( 0., JL = 1, SIZE( PRSS ) ) ], SHAPE = SHAPE( PRSS ) ), &
+ RESHAPE( SOURCE = [ ( 0., JL = 1, SIZE( PRGS ) ) ], SHAPE = SHAPE( PRGS ) ) )
+ DO JL=1,IMICRO
+ ZRF(JL)=PRAINFR(I1(JL),I2(JL),I3(JL))
+ END DO
+!
+ CALL RAIN_ICE_SLOW(GMICRO, ZINVTSTEP, ZRHODREF, &
+ ZRCT, ZRRT, ZRIT, ZRST, ZRGT, ZRHODJ, ZZT, ZPRES, &
+ ZLSFACT, ZLVFACT, ZSSI, &
+ ZRVS, ZRCS, ZRRS, ZRIS, ZRSS, ZRGS, ZTHS, &
+ ZAI, ZCJ, ZKA, ZDV, ZLBDAS, ZLBDAG)
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 3. COMPUTES THE SLOW WARM PROCESS SOURCES
+! --------------------------------------
+!
+!* 3.1 compute the slope parameter Lbda_r
+!
+ !ZLBDAR will be used when we consider rain diluted over the grid box
+ WHERE( ZRRT(:)>0.0 )
+ ZLBDAR(:) = XLBR*( ZRHODREF(:)*MAX( ZRRT(:),XRTMIN(3) ) )**XLBEXR
+ END WHERE
+ !ZLBDAR_RF will be used when we consider rain concentrated in its fraction
+ WHERE( ZRRT(:)>0.0 .AND. ZRF(:)>0.0 )
+ ZLBDAR_RF(:) = XLBR*( ZRHODREF(:) *MAX( ZRRT(:)/ZRF(:) , XRTMIN(3) ) )**XLBEXR
+ ELSEWHERE
+ ZLBDAR_RF(:) = 0.
+ END WHERE
+!
+ IF( OWARM ) THEN ! Check if the formation of the raindrops by the slow
+ ! warm processes is allowed
+ PEVAP3D(:,:,:)= 0.
+ CALL RAIN_ICE_WARM(GMICRO, IMICRO, I1, I2, I3, &
+ ZRHODREF, ZRVT, ZRCT, ZRRT, ZHLC_HCF, ZHLC_LCF, ZHLC_HRC, ZHLC_LRC, &
+ ZRHODJ, ZPRES, ZZT, ZLBDAR, ZLBDAR_RF, ZLVFACT, ZCJ, ZKA, ZDV, ZRF, ZCF, ZTHT, ZTHLT, &
+ ZRVS, ZRCS, ZRRS, ZTHS, ZUSW, PEVAP3D)
+ END IF
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 4. COMPUTES THE FAST COLD PROCESS SOURCES FOR r_s
+! ----------------------------------------------
+!
+ CALL RAIN_ICE_FAST_RS(PTSTEP, GMICRO, ZRHODREF, ZRVT, ZRCT, ZRRT, ZRST, ZRHODJ, ZPRES, ZZT, &
+ ZLBDAR, ZLBDAS, ZLSFACT, ZLVFACT, ZCJ, ZKA, ZDV, &
+ ZRCS, ZRRS, ZRSS, ZRGS, ZTHS)
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 5. COMPUTES THE FAST COLD PROCESS SOURCES FOR r_g
+! ----------------------------------------------
+!
+ CALL RAIN_ICE_FAST_RG(KRR, GMICRO, ZRHODREF, ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, ZCIT, &
+ ZRHODJ, ZPRES, ZZT, ZLBDAR, ZLBDAS, ZLBDAG, ZLSFACT, ZLVFACT, &
+ ZCJ, ZKA, ZDV, &
+ ZRCS, ZRRS, ZRIS, ZRSS, ZRGS, ZRHS, ZTHS, &
+ ZUSW, ZRDRYG, ZRWETG)
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 6. COMPUTES THE FAST COLD PROCESS SOURCES FOR r_h
+! ----------------------------------------------
+!
+ IF ( KRR == 7 ) THEN
+ CALL RAIN_ICE_FAST_RH(GMICRO, ZRHODREF, ZRVT, ZRCT, ZRIT, ZRST, ZRGT, ZRHT, ZRHODJ, ZPRES, &
+ ZZT, ZLBDAS, ZLBDAG, ZLBDAH, ZLSFACT, ZLVFACT, ZCJ, ZKA, ZDV, &
+ ZRCS, ZRRS, ZRIS, ZRSS, ZRGS, ZRHS, ZTHS, ZUSW)
+ END IF
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 7. COMPUTES SPECIFIC SOURCES OF THE WARM AND COLD CLOUDY SPECIES
+! -------------------------------------------------------------
+!
+ CALL RAIN_ICE_FAST_RI(GMICRO, ZRHODREF, ZRIT, ZRHODJ, ZZT, ZSSI, ZLSFACT, ZLVFACT, &
+ ZAI, ZCJ, ZCIT, ZRCS, ZRIS, ZTHS)
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!
+ DO JL=1,IMICRO
+ PRVS(I1(JL),I2(JL),I3(JL)) = ZRVS(JL)
+ PRCS(I1(JL),I2(JL),I3(JL)) = ZRCS(JL)
+ PRRS(I1(JL),I2(JL),I3(JL)) = ZRRS(JL)
+ PRIS(I1(JL),I2(JL),I3(JL)) = ZRIS(JL)
+ PRSS(I1(JL),I2(JL),I3(JL)) = ZRSS(JL)
+ PRGS(I1(JL),I2(JL),I3(JL)) = ZRGS(JL)
+ PTHS(I1(JL),I2(JL),I3(JL)) = ZTHS(JL)
+ PCIT(I1(JL),I2(JL),I3(JL)) = ZCIT(JL)
+ !
+ PRAINFR(I1(JL),I2(JL),I3(JL)) = ZRF(JL)
+ END DO
+ IF ( KRR == 7 ) THEN
+ DO JL=1,IMICRO
+ PRHS(I1(JL),I2(JL),I3(JL)) = ZRHS(JL)
+ END DO
+ END IF
+!
+!
+!
+ DEALLOCATE(ZZW1)
+ DEALLOCATE(ZDV)
+ DEALLOCATE(ZCJ)
+ DEALLOCATE(ZRDRYG)
+ DEALLOCATE(ZRWETG)
+ DEALLOCATE(ZLBDAG)
+ DEALLOCATE(ZLBDAH)
+ DEALLOCATE(ZLBDAS)
+ DEALLOCATE(ZLBDAR)
+ DEALLOCATE(ZLBDAR_RF)
+ DEALLOCATE(ZSSI)
+ DEALLOCATE(ZUSW)
+ DEALLOCATE(ZLVFACT)
+ DEALLOCATE(ZLSFACT)
+ DEALLOCATE(ZZW)
+ DEALLOCATE(ZEXNREF)
+ DEALLOCATE(ZPRES)
+ DEALLOCATE(ZRHODREF)
+ DEALLOCATE(ZZT)
+ IF(LBU_ENABLE .OR. LLES_CALL .OR. LCHECK ) DEALLOCATE(ZRHODJ)
+ DEALLOCATE(ZTHS)
+ DEALLOCATE(ZTHT)
+ DEALLOCATE(ZTHLT)
+ DEALLOCATE(ZRHS)
+ DEALLOCATE(ZRGS)
+ DEALLOCATE(ZRSS)
+ DEALLOCATE(ZRIS)
+ DEALLOCATE(ZRRS)
+ DEALLOCATE(ZRCS)
+ DEALLOCATE(ZRVS)
+ DEALLOCATE(ZCIT)
+ DEALLOCATE(ZRGT)
+ DEALLOCATE(ZRHT)
+ DEALLOCATE(ZRST)
+ DEALLOCATE(ZRIT)
+ DEALLOCATE(ZRRT)
+ DEALLOCATE(ZAI)
+ DEALLOCATE(ZRCT)
+ DEALLOCATE(ZKA)
+ DEALLOCATE(ZRVT)
+ DEALLOCATE(ZSIGMA_RC)
+ DEALLOCATE(ZCF)
+ DEALLOCATE(ZRF)
+ DEALLOCATE(ZHLC_HCF)
+ DEALLOCATE(ZHLC_LCF)
+ DEALLOCATE(ZHLC_HRC)
+ DEALLOCATE(ZHLC_LRC)
+ DEALLOCATE(ZHLC_RCMAX)
+ DEALLOCATE(ZRCRAUTC)
+ DEALLOCATE(ZHLC_HRCLOCAL)
+ DEALLOCATE(ZHLC_LRCLOCAL)
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 8. COMPUTE THE SEDIMENTATION (RS) SOURCE
+! -------------------------------------
+!
+!* 8.1 time splitting loop initialization
+!
+!
+!
+IF (HSEDIM == 'STAT') THEN
+ CALL RAIN_ICE_SEDIMENTATION_STAT( IIB, IIE, IJB, IJE, IKB, IKE, IKTB, IKTE, IKT, KKL, KRR, &
+ PTSTEP, OSEDIC, PINPRC, PINDEP, &
+ PINPRR, PINPRS, PINPRG, PDZZ, PRHODREF, PPABST, PTHT, PRHODJ, PINPRR3D, &
+ PRCS, PRCT, PRRS, PRRT, PRIS, PRSS, PRST, PRGS, PRGT, &
+ PSEA, PTOWN, PINPRH, PRHS, PRHT, PFPR )
+ELSEIF (HSEDIM == 'SPLI') THEN
+ CALL RAIN_ICE_SEDIMENTATION_SPLIT(IIB, IIE, IJB, IJE, IKB, IKE, IKTB, IKTE, IKT, KKL,&
+ KSPLITR,PTSTEP, &
+ KRR,OSEDIC,LDEPOSC,PINPRC,PINDEP,PINPRR,PINPRS,PINPRG,PDZZ,PRHODREF,PPABST,PTHT,PRHODJ,&
+ PINPRR3D,PRCS,PRCT,PRRS,PRRT,PRIS,PRIT,PRSS,PRST,PRGS,PRGT,PSEA,PTOWN,PINPRH,PRHS,PRHT,PFPR)
+ELSE
+ call Print_msg( NVERB_FATAL, 'GEN', 'RAIN_ICE', 'no sedimentation scheme for HSEDIM='//HSEDIM )
+END IF
+!sedimentation of rain fraction
+CALL ICE4_RAINFR_VERT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKT, KKL, PRAINFR, PRRS(:,:,:)*PTSTEP, &
+ PRSS(:,:,:)*PTSTEP, PRGS(:,:,:)*PTSTEP)
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE RAIN_ICE
diff --git a/src/mesonh/micro/rain_ice_elec.f90 b/src/mesonh/micro/rain_ice_elec.f90
new file mode 100644
index 000000000..69721492d
--- /dev/null
+++ b/src/mesonh/micro/rain_ice_elec.f90
@@ -0,0 +1,5849 @@
+!MNH_LIC Copyright 2002-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! #########################
+ MODULE MODI_RAIN_ICE_ELEC
+! #########################
+!
+INTERFACE
+ SUBROUTINE RAIN_ICE_ELEC (OSEDIC, HSUBG_AUCV, OWARM, &
+ KSPLITR, PTSTEP, KMI, KRR, &
+ PZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, &
+ PRGT, PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
+ PINPRC, PINPRR, PINPRR3D, PEVAP3D, &
+ PINPRS, PINPRG, PSIGS, &
+ PQPIT, PQCT, PQRT, PQIT, PQST, PQGT, PQNIT, &
+ PQPIS, PQCS, PQRS, PQIS, PQSS, PQGS, PQNIS, &
+ PSEA, PTOWN, &
+ PRHT, PRHS, PINPRH, PQHT, PQHS )
+!
+!
+LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
+CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV
+ ! Kind of Subgrid autoconversion method
+LOGICAL, INTENT(IN) :: OWARM ! .TRUE. allows raindrops to
+ ! form by warm processes
+ ! (Kessler scheme)
+!
+INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step
+ ! integration for rain sedimendation
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
+ ! (single if cold start)
+INTEGER, INTENT(IN) :: KMI ! Model index
+INTEGER, INTENT(IN) :: KRR ! Number of moist variable
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! absolute pressure at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! Cloud fraction
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRGS ! Graupel m.r. source
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC ! Cloud instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR ! Rain instant precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRR3D ! Rain inst precip 3D
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D ! Rain evap profile
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS ! Snow instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG ! Graupel instant precip
+!
+! Charge Mixing Ratio (CMR) (C/kg)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PQPIT ! Positive ion (Nb/kg) at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PQNIT ! Negative ion (Nb/kg) at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PQCT ! Cloud water CMR at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PQRT ! Rain water CMR at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PQIT ! Pristine ice CMR at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PQST ! Snow/aggregate CMR at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PQGT ! Graupel CMR at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQPIS ! Positive ion source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQNIS ! Negative ion source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQCS ! Cloud water CMR source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQRS ! Rain water CMR source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQIS ! Pristine ice CMR source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQSS ! Snow/aggregate CMR source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQGS ! Graupel CMR source
+!
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(INOUT) :: PINPRH ! Hail instant precip
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PQHT ! Hail CMR at t
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: PQHS ! Hail CMR source
+!
+END SUBROUTINE RAIN_ICE_ELEC
+END INTERFACE
+END MODULE MODI_RAIN_ICE_ELEC
+!
+! ######spl
+ SUBROUTINE RAIN_ICE_ELEC (OSEDIC, HSUBG_AUCV, OWARM, &
+ KSPLITR, PTSTEP, KMI, KRR, &
+ PZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, &
+ PRGT, PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
+ PINPRC, PINPRR, PINPRR3D, PEVAP3D, &
+ PINPRS, PINPRG, PSIGS, &
+ PQPIT, PQCT, PQRT, PQIT, PQST, PQGT, PQNIT, &
+ PQPIS, PQCS, PQRS, PQIS, PQSS, PQGS, PQNIS, &
+ PSEA, PTOWN, &
+ PRHT, PRHS, PINPRH, PQHT, PQHS )
+! ######################################################################
+!
+!!**** * - compute the explicit microphysical sources
+!! and the cloud electrification
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the slow microphysical sources
+!! which can be computed explicitly
+!!
+!!
+!!** METHOD
+!! ------
+!! The autoconversion computation follows Kessler (1969).
+!! The sedimentation rate is computed with a time spliting technique and
+!! an upstream scheme, written as a difference of non-advective fluxes. This
+!! source term is added to the future instant ( split-implicit process ).
+!! The others microphysical processes are evaluated at the central instant
+!! (split-explicit process ): autoconversion, accretion and rain evaporation.
+!! These last 3 terms are bounded in order not to create negative values
+!! for the water species at the future instant.
+!!
+!! EXTERNAL
+!! --------
+!! None
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS
+!! JPHEXT : Horizontal external points number
+!! JPVEXT : Vertical external points number
+!! Module MODD_CONF :
+!! CCONF configuration of the model for the first time step
+!! Module MODD_CST
+!! XP00 ! Reference pressure
+!! XRD,XRV ! Gaz constant for dry air, vapor
+!! XMD,XMV ! Molecular weight for dry air, vapor
+!! XCPD ! Cpd (dry air)
+!! XCL ! Cl (liquid)
+!! XCI ! Ci (solid)
+!! XTT ! Triple point temperature
+!! XLVTT ! Vaporization heat constant
+!! XALPW,XBETAW,XGAMW ! Constants for saturation vapor pressure
+!! function over liquid water
+!! XALPI,XBETAI,XGAMI ! Constants for saturation vapor pressure
+!! function over solid ice
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!!
+!! AUTHOR
+!! ------
+!! C. Barthe, G. Molinie, J.-P. Pinty * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 2002
+!! Modifications
+!! C. Barthe (LACy) Nov. 2009 : update to V4.8.1
+!! M. Chong 26/01/10 Add Small ions parameters
+!! J-P Pinty 31/03/11 Add hail
+!! C. Lac 2011 : Adaptation to FIT temporal scheme
+!! B. Tsenova June 2012 Add new NI parameterizations
+!! C. Barthe June 2012 Dependance of RAR on the RELATIVE terminal velocity
+!! M. Chong 06/08/13 Add "Beard" effect (ELEC=>MICROPHYSICS)
+!! J-P Pinty 21/08/13 Correction of the process limitation algo.
+!! SIGN(MIN(ABS ...
+!! Correction in elec_update_qd
+!! Correction of hail charge transfer
+!! Add hail growth charging processes
+!! J-P Pinty 26/08/13 Add "Beard" effect control (ELEC=>MICROPHYS)
+!! for sedimentation
+!! J-P Pinty 26/09/13 Add tabulated treatment of SAUN1 and SAUN2
+!! J-P Pinty 30/09/13 Remove call to MOMG function
+!! J-P Pinty 25/10/13 Add "Latham" effect for aggregation process
+!! M. Chong 31/10/13 Add other tabulated treatment and recode
+!! M. Chong 15/11/13 Bug in the computation of RGWETH (wrong sign)
+!! J-P Pinty 25/04/14 Many bugs with ZWQ1(:,...) = 0.0
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! J.Escobar : 10/2017 : for real*4 , limit exp() in RAIN_ICE_ELEC_SLOW with XMNH_HUGE_12_LOG
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+! P. Wautelet 03/2020: use the new data structures and subroutines for budgets
+! P .Wautelet 09/03/2020: add missing budgets for electricity
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+use modd_budget, only: lbu_enable, &
+ lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, lbudget_ri, &
+ lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, &
+ NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1, &
+ tbudgets
+USE MODD_CONF
+USE MODD_CST
+USE MODD_ELEC_DESCR
+USE MODD_ELEC_n
+USE MODD_ELEC_PARAM
+USE MODD_LES
+USE MODE_ll
+USE MODD_NSV, ONLY: NSV_ELECBEG, NSV_ELECEND ! Scalar variables for budgets
+USE MODD_PARAMETERS
+USE MODD_PARAM_ICE
+USE MODD_RAIN_ICE_DESCR
+USE MODD_RAIN_ICE_PARAM
+USE MODD_REF, ONLY: XTHVREFZ
+
+use mode_budget, only: Budget_store_add, Budget_store_init, Budget_store_end
+#ifdef MNH_PGI
+USE MODE_PACK_PGI
+#endif
+use mode_tools, only: Countjv
+
+USE MODI_MOMG
+
+IMPLICIT NONE
+!
+!
+!* 0.1 Declarations of dummy arguments :
+!
+LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
+CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV
+ ! Kind of Subgrid autoconversion method
+LOGICAL, INTENT(IN) :: OWARM ! .TRUE. allows raindrops to
+ ! form by warm processes
+ ! (Kessler scheme)
+!
+INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step
+ ! integration for rain sedimendation
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
+ ! (single if cold start)
+INTEGER, INTENT(IN) :: KMI ! Model index
+INTEGER, INTENT(IN) :: KRR ! Number of moist variable
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! absolute pressure at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR! Convective Mass Flux Cloud fraction
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRGS ! Graupel m.r. source
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC ! Cloud instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR ! Rain instant precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRR3D ! Rain inst precip 3D
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D ! Rain evap profile
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS ! Snow instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG ! Graupel instant precip
+!
+! Charge Mixing Ratio (CMR) (C/kg)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PQPIT ! Positive ion (Nb/kg) at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PQNIT ! Negative ion (Nb/kg) at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PQCT ! Cloud water CMR at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PQRT ! Rain water CMR at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PQIT ! Pristine ice CMR at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PQST ! Snow/aggregate CMR at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PQGT ! Graupel CMR at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQPIS ! Positive ion source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQNIS ! Negative ion source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQCS ! Cloud water CMR source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQRS ! Rain water CMR source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQIS ! Pristine ice CMR source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQSS ! Snow/aggregate CMR source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQGS ! Graupel CMR source
+!
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(INOUT) :: PINPRH ! Hail instant precip
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PQHT ! Hail CMR at t
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: PQHS ! Hail CMR source
+!
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: JK ! Vertical loop index for the rain sedimentation
+INTEGER :: JN ! Temporal loop index for the rain sedimentation
+INTEGER :: JJ ! Loop index for the interpolation
+INTEGER :: JI ! Loop index for the interpolation
+INTEGER :: IIB ! Define the domain where is
+INTEGER :: IIE ! the microphysical sources have to be computed
+INTEGER :: IJB !
+INTEGER :: IJE !
+INTEGER :: IKB !
+INTEGER :: IKE !
+!
+REAL :: ZTSPLITR ! Small time step for rain sedimentation
+!
+!
+INTEGER :: ISEDIMR,ISEDIMC, ISEDIMI, ISEDIMS, ISEDIMG, ISEDIMH, &
+ INEGT, IMICRO ! Case number of sedimentation, T>0 (for HEN)
+ ! and r_x>0 locations
+INTEGER :: IGRIM, IGACC, IGDRY ! Case number of riming, accretion and dry growth
+ ! locations
+INTEGER :: IGWET, IHAIL ! wet growth locations and case number
+!
+LOGICAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
+ :: GSEDIMR, GSEDIMC, GSEDIMI, GSEDIMS, GSEDIMG, GSEDIMH ! Test where to compute the SED processes
+LOGICAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
+ :: GNEGT ! Test where to compute the HEN process
+LOGICAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
+ :: GMICRO ! Test where to compute all processes
+LOGICAL, DIMENSION(:), ALLOCATABLE :: GRIM ! Test where to compute riming
+LOGICAL, DIMENSION(:), ALLOCATABLE :: GACC ! Test where to compute accretion
+LOGICAL, DIMENSION(:), ALLOCATABLE :: GDRY ! Test where to compute dry growth
+LOGICAL, DIMENSION(:), ALLOCATABLE :: GWET ! Test where to compute wet growth
+LOGICAL, DIMENSION(:), ALLOCATABLE :: GHAIL ! Test where to compute hail growth
+!
+INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC1,IVEC2 ! Vectors of indices for
+ ! interpolations
+REAL, DIMENSION(:), ALLOCATABLE :: ZVEC1,ZVEC2,ZVEC3 ! Work vectors for
+ ! interpolations
+REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
+ :: ZW ! work array
+REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
+ :: ZPRCS, ZPRRS, ZPRSS, ZPRGS, ZPRHS ! Mixing ratios created during the time step
+REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
+ :: ZWSED ! sedimentation fluxes
+REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
+ :: ZWSEDW1 ! sedimentation speed
+REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
+ :: ZWSEDW2 ! sedimentation speed
+REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2)) &
+ :: ZCONC_TMP ! Weighted concentration
+REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
+ :: ZT ! Temperature
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: &
+ ZRAY, & ! Cloud Mean radius
+ ZLBC, & ! XLBC weighted by sea fraction
+ ZFSEDC
+REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
+ :: ZPQRS, ZPQSS, ZPQGS, ZPQHS ! Charge Mixing ratios created during the time step
+REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
+ :: ZWSEDQ ! sedimentation fluxes for charge
+REAL, DIMENSION(:), ALLOCATABLE :: ZRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRRT ! Rain water m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRGT ! Graupel m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRHT ! Hail m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZCIT ! Pristine ice conc. at t
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZRVS ! Water vapor m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRCS ! Cloud water m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRRS ! Rain water m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRIS ! Pristine ice m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRSS ! Snow/aggregate m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRGS ! Graupel m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRHS ! Hail m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZTHS ! Theta source
+REAL, DIMENSION(:), ALLOCATABLE :: ZCRIAUTI ! Snow-to-ice autoconversion thres.
+!
+REAL, DIMENSION(:), ALLOCATABLE &
+ :: ZRHODREF, & ! RHO Dry REFerence
+ ZRHODREFC,& ! RHO Dry REFerence
+ ZRHODREFR,& ! RHO Dry REFerence
+ ZRHODREFI,& ! RHO Dry REFerence
+ ZRHODREFS,& ! RHO Dry REFerence
+ ZRHODREFG,& ! RHO Dry REFerence
+ ZRHODREFH,& ! RHO Dry REFerence
+ ZRHODJ, & ! RHO times Jacobian
+ ZZT, & ! Temperature
+ ZPRES, & ! Pressure
+ ZEXNREF, & ! EXNer Pressure REFerence
+ ZZW, & ! Work array
+ ZLSFACT, & ! L_s/(Pi_ref*C_ph)
+ ZLVFACT, & ! L_v/(Pi_ref*C_ph)
+ ZUSW, & ! Undersaturation over water
+ ZSSI, & ! Supersaturation over ice
+ ZLBDAI, & ! Slope parameter of the pristine ice distribution
+ ZLBDAR, & ! Slope parameter of the raindrop distribution
+ ZLBDAS, & ! Slope parameter of the aggregate distribution
+ ZLBDAG, & ! Slope parameter of the graupel distribution
+ ZLBDAH, & ! Slope parameter of the hail distribution
+ ZRDRYG, & ! Dry growth rate of the graupeln
+ ZRWETG, & ! Wet growth rate of the graupeln
+ ZAI, & ! Thermodynamical function
+ ZCJ, & ! Function to compute the ventilation coefficient
+ ZKA, & ! Thermal conductivity of the air
+ ZDV, & ! Diffusivity of water vapor in the air
+ ZSIGMA_RC,& ! Standard deviation of rc at time t
+ ZCF, & ! Cloud fraction
+ ZCC, & ! terminal velocity
+ ZFSEDC1D, & ! For cloud sedimentation
+ ZWLBDC, & ! Slope parameter of the droplet distribution
+ ZCONC, & ! Concentration des aérosols
+ ZRAY1D, & ! Mean radius
+ ZWLBDA ! Libre parcours moyen
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZZW1 ! Work arrays
+REAL :: ZTIMAUTIC
+REAL, DIMENSION(SIZE(XRTMIN)) :: ZRTMIN
+!
+INTEGER , DIMENSION(SIZE(GMICRO)) :: I1,I2,I3 ! Used to replace the COUNT
+INTEGER :: JL ! and PACK intrinsics
+!
+LOGICAL, DIMENSION(:,:),ALLOCATABLE :: GELEC ! Logical of work for elec
+REAL, DIMENSION(:), ALLOCATABLE :: ZRSMIN_ELEC ! Limit value of ZRXS where charge is available
+REAL, DIMENSION(:), ALLOCATABLE :: ZVECQ4, & ! Work
+ ZVECQ5, & ! vectors for
+ ZVECQ6, & ! interpolations
+ ZVECQ7 ! (electrification)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZWQ1 ! Work array for electrification
+REAL, DIMENSION(:), ALLOCATABLE :: ZWQ3,ZWQ4 ! Work arrays for electrification
+
+REAL, DIMENSION(:), ALLOCATABLE :: ZQPIT ! Positive ion (kg^-1) at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZQNIT ! Negative ion (kg^-1) at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZQCT ! Cloud water CMR at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZQRT ! Rain water m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZQIT ! Pristine ice CMR at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZQST ! Snow/aggregate CMR at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZQGT ! Graupel CMR at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZQHT ! Hail CMR at t
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZQPIS ! Positive ion source
+REAL, DIMENSION(:), ALLOCATABLE :: ZQNIS ! Negative ion source
+REAL, DIMENSION(:), ALLOCATABLE :: ZQCS ! Cloud water CMR source
+REAL, DIMENSION(:), ALLOCATABLE :: ZQRS ! Rain water CMR source
+REAL, DIMENSION(:), ALLOCATABLE :: ZQIS ! Pristine ice CMR source
+REAL, DIMENSION(:), ALLOCATABLE :: ZQSS ! Snow/aggregate CMR source
+REAL, DIMENSION(:), ALLOCATABLE :: ZQGS ! Graupel CMR source
+REAL, DIMENSION(:), ALLOCATABLE :: ZQHS ! Hail CMR source
+!
+! Charge diameter relation
+REAL, DIMENSION(:), ALLOCATABLE :: ZECT ! Cloud water at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZERT ! Rain water at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZEIT ! Pristine ice at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZEST ! Snow/aggregate at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZEGT ! Graupel at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZEHT ! Hail at t
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZECS ! Cloud water at t+dt
+REAL, DIMENSION(:), ALLOCATABLE :: ZERS ! Rain water at t+dt
+REAL, DIMENSION(:), ALLOCATABLE :: ZEIS ! Pristine ice at t+dt
+REAL, DIMENSION(:), ALLOCATABLE :: ZESS ! Snow/aggregate at t+dt
+REAL, DIMENSION(:), ALLOCATABLE :: ZEGS ! Graupel at t+dt
+REAL, DIMENSION(:), ALLOCATABLE :: ZEHS ! Hail at t+dt
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZDELTALWC ! Gap between LWC and a critical LWC
+REAL, DIMENSION(:), ALLOCATABLE :: ZLWCC ! Critical LWC in NI charging
+REAL, DIMENSION(:), ALLOCATABLE :: ZFT ! Fct depending on temperature
+!
+! Non-inductive charging process following Saunders et al. (1991) / EW
+REAL, DIMENSION(:), ALLOCATABLE :: ZEW ! Effective liquid water content
+REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNSK ! constant B _______________________
+REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNIM ! d_i exponent ____________________
+REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNIN ! v_g/s-v_i________________________
+REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNSM ! d_s exponent ____________________
+REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNSN ! v_g-v_s _________________________
+REAL, DIMENSION(:), ALLOCATABLE :: ZFQIAGGS, ZFQIDRYGBS
+REAL, DIMENSION(:), ALLOCATABLE :: ZLBQSDRYGB1S, ZLBQSDRYGB2S, ZLBQSDRYGB3S
+!
+! Non-inductive charging process following Saunders and Peck (1998) / RAR
+REAL, DIMENSION(:), ALLOCATABLE :: ZVGMEAN ! Mean velocity of graupel
+REAL, DIMENSION(:), ALLOCATABLE :: ZVSMEAN ! Mean velocity of snow
+REAL, DIMENSION(:), ALLOCATABLE :: ZRHOCOR ! Density correction for fallspeed
+REAL, DIMENSION(:), ALLOCATABLE :: ZRAR ! Rime accretion rate
+REAL, DIMENSION(:), ALLOCATABLE :: ZRAR_CRIT ! Critical RAR
+REAL, DIMENSION(:), ALLOCATABLE :: ZDQRAR_IS ! q= f(RAR,T) in Saunders and Peck's equation
+REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNIM_IS ! d_i exponent ____________________
+REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNIN_IS ! v_g/s-v_i________________________
+REAL, DIMENSION(:), ALLOCATABLE :: ZDQRAR_IG ! q= f(RAR,T) in Saunders and Peck's equation
+REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNIM_IG ! d_i exponent ____________________
+REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNIN_IG ! v_g/s-v_i________________________
+REAL, DIMENSION(:), ALLOCATABLE :: ZDQRAR_SG ! q= f(RAR,T) in Saunders and Peck's equation
+REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNSK_SG ! constant B _______________________
+REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNSM_SG ! d_s exponent ____________________
+REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNSN_SG ! v_g-v_s _________________________
+!
+! Non-inductive charging process following Takahashi (1978)
+INTEGER :: IGTAKA ! Case number of charge separation for Takahashi param.
+LOGICAL, DIMENSION(:), ALLOCATABLE :: GTAKA ! Test where to compute charge
+ ! separation for Takahashi param.
+REAL, DIMENSION(:), ALLOCATABLE :: ZDQTAKA_OPT ! Optimized array of separated charge
+!
+INTEGER :: IGSAUN ! Case number of charge separation for Saunders param.
+LOGICAL, DIMENSION(:), ALLOCATABLE :: GSAUN ! Test where to compute charge
+ ! separation for Saunders param.
+REAL, DIMENSION(:), ALLOCATABLE :: ZDQLWC_OPT ! Optimized array of separated charge
+REAL, DIMENSION(:), ALLOCATABLE :: ZDQLWC ! q=f(LWC,T)
+!
+! Inductive charging process (Ziegler et al., 1991)
+INTEGER :: IIND ! Case number of inductive process
+LOGICAL, DIMENSION(:), ALLOCATABLE :: GIND ! Test where to compute inductive process
+REAL, DIMENSION(:), ALLOCATABLE :: ZRATE_IND ! Charge transfer rate during inductive process
+REAL, DIMENSION(:), ALLOCATABLE :: ZEFIELDW ! Vertical component of the electric field
+!
+! Latham's effect
+REAL, DIMENSION(:), ALLOCATABLE :: ZLATHAMIAGGS ! E Function to simulate
+ ! enhancement of IAGGS
+REAL, DIMENSION(:), ALLOCATABLE :: ZEFIELDU ! Horiz. component of the electric field
+REAL, DIMENSION(:), ALLOCATABLE :: ZEFIELDV ! Horiz. component of the electric field
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZLIMIT, ZAUX, ZAUX1
+REAL, DIMENSION(:), ALLOCATABLE :: ZCOLIS ! Collection efficiency between ice and snow
+REAL, DIMENSION(:), ALLOCATABLE :: ZCOLIG ! Collection efficiency between ice and graupeln
+REAL, DIMENSION(:), ALLOCATABLE :: ZCOLSG ! Collection efficiency between snow and graupeln
+REAL :: ZRHO00, ZCOR00 ! Surface reference air density
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTE THE LOOP BOUNDS
+! -----------------------
+!
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+IKB = 1 + JPVEXT
+IKE = SIZE(PZZ,3) - JPVEXT
+!
+ZRHO00 = XP00 / (XRD * XTHVREFZ(IKB))
+ZCOR00 = ZRHO00**XCEXVT
+!
+!
+!* 2. COMPUTES THE SLOW COLD PROCESS SOURCES
+! --------------------------------------
+!
+!* 2.1 compute the ice nucleation
+!
+CALL RAIN_ICE_ELEC_NUCLEATION
+!
+!
+!* 2.2 allocations
+!
+! optimization by looking for locations where
+! the microphysical fields are larger than a minimal value only !!!
+!
+GMICRO(:,:,:) = .FALSE.
+
+IF ( KRR == 7 ) THEN
+ GMICRO(IIB:IIE,IJB:IJE,IKB:IKE) = &
+ PRCT(IIB:IIE,IJB:IJE,IKB:IKE) > XRTMIN(2) .OR. &
+ PRRT(IIB:IIE,IJB:IJE,IKB:IKE) > XRTMIN(3) .OR. &
+ PRIT(IIB:IIE,IJB:IJE,IKB:IKE) > XRTMIN(4) .OR. &
+ PRST(IIB:IIE,IJB:IJE,IKB:IKE) > XRTMIN(5) .OR. &
+ PRGT(IIB:IIE,IJB:IJE,IKB:IKE) > XRTMIN(6) .OR. &
+ PRHT(IIB:IIE,IJB:IJE,IKB:IKE) > XRTMIN(7)
+ELSE IF( KRR == 6 ) THEN
+ GMICRO(IIB:IIE,IJB:IJE,IKB:IKE) = &
+ PRCT(IIB:IIE,IJB:IJE,IKB:IKE) > XRTMIN(2) .OR. &
+ PRRT(IIB:IIE,IJB:IJE,IKB:IKE) > XRTMIN(3) .OR. &
+ PRIT(IIB:IIE,IJB:IJE,IKB:IKE) > XRTMIN(4) .OR. &
+ PRST(IIB:IIE,IJB:IJE,IKB:IKE) > XRTMIN(5) .OR. &
+ PRGT(IIB:IIE,IJB:IJE,IKB:IKE) > XRTMIN(6)
+END IF
+
+IMICRO = COUNTJV( GMICRO(:,:,:),I1(:),I2(:),I3(:))
+!
+IF (IMICRO > 0) THEN
+ ALLOCATE(ZRVT(IMICRO))
+ ALLOCATE(ZRCT(IMICRO))
+ ALLOCATE(ZRRT(IMICRO))
+ ALLOCATE(ZRIT(IMICRO))
+ ALLOCATE(ZRST(IMICRO))
+ ALLOCATE(ZRGT(IMICRO))
+ IF (KRR == 7) ALLOCATE(ZRHT(IMICRO))
+ ALLOCATE(ZCIT(IMICRO))
+ ALLOCATE(ZRVS(IMICRO))
+ ALLOCATE(ZRCS(IMICRO))
+ ALLOCATE(ZRRS(IMICRO))
+ ALLOCATE(ZRIS(IMICRO))
+ ALLOCATE(ZRSS(IMICRO))
+ ALLOCATE(ZRGS(IMICRO))
+ IF (KRR == 7) ALLOCATE(ZRHS(IMICRO))
+ ALLOCATE(ZTHS(IMICRO))
+ ALLOCATE(ZRHODREF(IMICRO))
+ ALLOCATE(ZZT(IMICRO))
+ ALLOCATE(ZPRES(IMICRO))
+ ALLOCATE(ZEXNREF(IMICRO))
+ ALLOCATE(ZSIGMA_RC(IMICRO))
+ ALLOCATE(ZCF(IMICRO))
+ DO JL = 1, IMICRO
+ ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL))
+ ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
+ ZRRT(JL) = PRRT(I1(JL),I2(JL),I3(JL))
+ ZRIT(JL) = PRIT(I1(JL),I2(JL),I3(JL))
+ ZRST(JL) = PRST(I1(JL),I2(JL),I3(JL))
+ ZRGT(JL) = PRGT(I1(JL),I2(JL),I3(JL))
+ IF (KRR == 7) ZRHT(JL) = PRHT(I1(JL),I2(JL),I3(JL))
+ ZCIT(JL) = PCIT(I1(JL),I2(JL),I3(JL))
+ IF (HSUBG_AUCV == 'SIGM') THEN
+ ZSIGMA_RC(JL) = PSIGS(I1(JL),I2(JL),I3(JL)) * 2.
+ ELSE IF (HSUBG_AUCV == 'CLFR') THEN
+ ZCF(JL) = PCLDFR(I1(JL),I2(JL),I3(JL))
+ END IF
+!
+ ZRVS(JL) = PRVS(I1(JL),I2(JL),I3(JL))
+ ZRCS(JL) = PRCS(I1(JL),I2(JL),I3(JL))
+ ZRRS(JL) = PRRS(I1(JL),I2(JL),I3(JL))
+ ZRIS(JL) = PRIS(I1(JL),I2(JL),I3(JL))
+ ZRSS(JL) = PRSS(I1(JL),I2(JL),I3(JL))
+ ZRGS(JL) = PRGS(I1(JL),I2(JL),I3(JL))
+ IF (KRR == 7) ZRHS(JL) = PRHS(I1(JL),I2(JL),I3(JL))
+ ZTHS(JL) = PTHS(I1(JL),I2(JL),I3(JL))
+!
+ ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
+ ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
+ ZPRES(JL) = PPABST(I1(JL),I2(JL),I3(JL))
+ ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL))
+ ENDDO
+!
+ ALLOCATE(ZRHOCOR(IMICRO))
+ ZRHOCOR(:) = (ZRHO00 / ZRHODREF(:))**XCEXVT
+!
+ ALLOCATE(ZZW(IMICRO))
+ ALLOCATE(ZLSFACT(IMICRO))
+ ALLOCATE(ZLVFACT(IMICRO))
+!
+ ZZW(:) = ZEXNREF(:)*( XCPD+XCPV*ZRVT(:)+XCL*(ZRCT(:)+ZRRT(:)) &
+ +XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)) )
+ ZLSFACT(:) = (XLSTT+(XCPV-XCI)*(ZZT(:)-XTT))/ZZW(:) ! L_s/(Pi_ref*C_ph)
+ ZLVFACT(:) = (XLVTT+(XCPV-XCL)*(ZZT(:)-XTT))/ZZW(:) ! L_v/(Pi_ref*C_ph)
+!
+ ALLOCATE(ZUSW(IMICRO))
+ ALLOCATE(ZSSI(IMICRO))
+!
+ ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) )
+ ZSSI(:) = ZRVT(:)*( ZPRES(:)-ZZW(:) ) / ( (XMV/XMD) * ZZW(:) ) - 1.0
+ ! Supersaturation over ice
+!
+ IF (KRR == 7) THEN
+ ALLOCATE(ZRSMIN_ELEC(7))
+ ELSE
+ ALLOCATE(ZRSMIN_ELEC(6))
+ END IF
+ ZRSMIN_ELEC(:) = XRTMIN_ELEC(:) / PTSTEP
+!
+ ALLOCATE(ZLBDAR(IMICRO))
+ ALLOCATE(ZLBDAS(IMICRO))
+ ALLOCATE(ZLBDAG(IMICRO))
+ IF (KRR == 7) ALLOCATE(ZLBDAH(IMICRO))
+ ALLOCATE(ZRDRYG(IMICRO))
+ ALLOCATE(ZRWETG(IMICRO))
+ ALLOCATE(ZAI(IMICRO))
+ ALLOCATE(ZCJ(IMICRO))
+ ALLOCATE(ZKA(IMICRO))
+ ALLOCATE(ZDV(IMICRO))
+!
+ IF (KRR == 7) THEN
+ ALLOCATE(ZZW1(IMICRO,7))
+ ELSE IF(KRR == 6) THEN
+ ALLOCATE(ZZW1(IMICRO,6))
+ ENDIF
+!
+ IF (LBU_ENABLE .OR. LLES_CALL) THEN
+ ALLOCATE(ZRHODJ(IMICRO))
+ DO JL=1,IMICRO
+ ZRHODJ(JL) = PRHODJ(I1(JL),I2(JL),I3(JL))
+ END DO
+ END IF
+!
+ ALLOCATE( ZECT(IMICRO) )
+ ALLOCATE( ZERT(IMICRO) )
+ ALLOCATE( ZEIT(IMICRO) )
+ ALLOCATE( ZEST(IMICRO) )
+ ALLOCATE( ZEGT(IMICRO) )
+ IF ( KRR == 7 ) ALLOCATE(ZEHT(IMICRO))
+ ALLOCATE( ZECS(IMICRO) )
+ ALLOCATE( ZERS(IMICRO) )
+ ALLOCATE( ZEIS(IMICRO) )
+ ALLOCATE( ZESS(IMICRO) )
+ ALLOCATE( ZEGS(IMICRO) )
+ IF ( KRR == 7 ) ALLOCATE(ZEHS(IMICRO))
+ ALLOCATE( ZQPIT(IMICRO) )
+ ALLOCATE( ZQNIT(IMICRO) )
+ ALLOCATE( ZQCT(IMICRO) )
+ ALLOCATE( ZQRT(IMICRO) )
+ ALLOCATE( ZQIT(IMICRO) )
+ ALLOCATE( ZQST(IMICRO) )
+ ALLOCATE( ZQGT(IMICRO) )
+ IF ( KRR == 7 ) ALLOCATE(ZQHT(IMICRO))
+ ALLOCATE( ZQPIS(IMICRO) )
+ ALLOCATE( ZQNIS(IMICRO) )
+ ALLOCATE( ZQCS(IMICRO) )
+ ALLOCATE( ZQRS(IMICRO) )
+ ALLOCATE( ZQIS(IMICRO) )
+ ALLOCATE( ZQSS(IMICRO) )
+ ALLOCATE( ZQGS(IMICRO) )
+ IF ( KRR == 7 ) ALLOCATE(ZQHS(IMICRO))
+!
+ IF (CNI_CHARGING == 'GARDI') THEN
+ ALLOCATE( ZDELTALWC(IMICRO) )
+ ALLOCATE( ZFT(IMICRO) )
+ END IF
+!
+ IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2' .OR. &
+ CNI_CHARGING == 'TAKAH' .OR. &
+ CNI_CHARGING == 'BSMP1' .OR. CNI_CHARGING == 'BSMP2' .OR. &
+ CNI_CHARGING == 'TEEWC' .OR. CNI_CHARGING == 'TERAR') THEN
+ ALLOCATE( ZEW(IMICRO) )
+ END IF
+
+ IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2') THEN
+ ALLOCATE( ZLWCC(IMICRO) )
+ END IF
+!
+ IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2' .OR. &
+ CNI_CHARGING == 'TAKAH' .OR. CNI_CHARGING == 'TEEWC') THEN
+ ALLOCATE( ZDQLWC(IMICRO) )
+ END IF
+!
+ IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2' .OR. &
+ CNI_CHARGING == 'TEEWC' ) THEN
+ ALLOCATE( ZSAUNSK(IMICRO) )
+ ALLOCATE( ZSAUNIM(IMICRO) )
+ ALLOCATE( ZSAUNIN(IMICRO) )
+ ALLOCATE( ZSAUNSM(IMICRO) )
+ ALLOCATE( ZSAUNSN(IMICRO) )
+ END IF
+!
+ IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2' .OR. &
+ CNI_CHARGING == 'SAP98' .OR. &
+ CNI_CHARGING == 'BSMP1' .OR. CNI_CHARGING == 'BSMP2' .OR. &
+ CNI_CHARGING == 'TEEWC' .OR. CNI_CHARGING == 'TERAR') THEN
+ ALLOCATE( ZFQIAGGS(IMICRO) )
+ ALLOCATE( ZFQIDRYGBS(IMICRO) )
+ ALLOCATE( ZLBQSDRYGB1S(IMICRO) )
+ ALLOCATE( ZLBQSDRYGB2S(IMICRO) )
+ ALLOCATE( ZLBQSDRYGB3S(IMICRO) )
+ END IF
+!
+ IF (CNI_CHARGING == 'SAP98' .OR. &
+ CNI_CHARGING == 'BSMP1' .OR. CNI_CHARGING == 'BSMP2') THEN
+ ALLOCATE( ZRAR_CRIT(IMICRO) )
+ END IF
+!
+ IF (CNI_CHARGING == 'SAP98' .OR. CNI_CHARGING == 'TERAR' .OR. &
+ CNI_CHARGING == 'BSMP1' .OR. CNI_CHARGING == 'BSMP2') THEN
+ ALLOCATE( ZVGMEAN(IMICRO) )
+ ALLOCATE( ZVSMEAN(IMICRO) )
+ ALLOCATE( ZRAR(IMICRO) )
+ ALLOCATE( ZDQRAR_IS(IMICRO) )
+ ALLOCATE( ZDQRAR_IG(IMICRO) )
+ ALLOCATE( ZDQRAR_SG(IMICRO) )
+ ALLOCATE( ZSAUNIM_IS(IMICRO) )
+ ALLOCATE( ZSAUNIN_IS(IMICRO) )
+ ALLOCATE( ZSAUNIM_IG(IMICRO) )
+ ALLOCATE( ZSAUNIN_IG(IMICRO) )
+ ALLOCATE( ZSAUNSK_SG(IMICRO) )
+ ALLOCATE( ZSAUNSM_SG(IMICRO) )
+ ALLOCATE( ZSAUNSN_SG(IMICRO) )
+ END IF
+!
+ IF (CNI_CHARGING == 'TAKAH' .OR. CNI_CHARGING == 'SAP98' .OR. &
+ CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2' .OR. &
+ CNI_CHARGING == 'GARDI' .OR. CNI_CHARGING == 'BSMP1' .OR. &
+ CNI_CHARGING == 'BSMP2' .OR. CNI_CHARGING == 'TEEWC' .OR. &
+ CNI_CHARGING == 'TERAR') THEN
+ ALLOCATE( ZAUX1(IMICRO) )
+ ALLOCATE( ZLIMIT(IMICRO) )
+ END IF
+!
+ IF (LINDUCTIVE) THEN
+ ALLOCATE( ZEFIELDW(IMICRO) )
+ ALLOCATE( ZRATE_IND(IMICRO) )
+ ALLOCATE( GIND(IMICRO) )
+ END IF
+!
+ IF (LIAGGS_LATHAM) THEN
+ ALLOCATE( ZEFIELDU(IMICRO) )
+ ALLOCATE( ZEFIELDV(IMICRO) )
+ IF (.NOT.ALLOCATED(ZEFIELDW)) ALLOCATE( ZEFIELDW(IMICRO) )
+ END IF
+ ALLOCATE( ZLATHAMIAGGS(IMICRO) )
+!
+ ALLOCATE( ZWQ1(IMICRO,10) )
+ ALLOCATE( ZWQ3(IMICRO) )
+ ALLOCATE( ZWQ4(IMICRO) )
+ ALLOCATE( ZCOLIS(IMICRO) )
+ ALLOCATE( ZCOLIG(IMICRO) )
+ ALLOCATE( ZCOLSG(IMICRO) )
+ ALLOCATE( GELEC(IMICRO,4) )
+ GELEC(:,:) = .FALSE.
+!
+ DO JL = 1, IMICRO
+ IF (LINDUCTIVE) ZEFIELDW(JL) = XEFIELDW(I1(JL), I2(JL), I3(JL))
+ IF (LIAGGS_LATHAM) THEN
+ ZEFIELDU(JL) = XEFIELDU(I1(JL), I2(JL), I3(JL))
+ ZEFIELDV(JL) = XEFIELDV(I1(JL), I2(JL), I3(JL))
+ IF (.NOT.LINDUCTIVE ) ZEFIELDW(JL) = XEFIELDW(I1(JL), I2(JL), I3(JL))
+ END IF
+!
+ ZQPIT(JL) = PQPIT(I1(JL), I2(JL), I3(JL))
+ ZQNIT(JL) = PQNIT(I1(JL), I2(JL), I3(JL))
+ ZQCT(JL) = PQCT(I1(JL), I2(JL), I3(JL))
+ ZQRT(JL) = PQRT(I1(JL), I2(JL), I3(JL))
+ ZQIT(JL) = PQIT(I1(JL), I2(JL), I3(JL))
+ ZQST(JL) = PQST(I1(JL), I2(JL), I3(JL))
+ ZQGT(JL) = PQGT(I1(JL), I2(JL), I3(JL))
+ IF (KRR == 7) ZQHT(JL) = PQHT(I1(JL), I2(JL), I3(JL))
+!
+ ZQPIS(JL) = PQPIS(I1(JL), I2(JL), I3(JL))
+ ZQNIS(JL) = PQNIS(I1(JL), I2(JL), I3(JL))
+ ZQCS(JL) = PQCS(I1(JL), I2(JL), I3(JL))
+ ZQRS(JL) = PQRS(I1(JL), I2(JL), I3(JL))
+ ZQIS(JL) = PQIS(I1(JL), I2(JL), I3(JL))
+ ZQSS(JL) = PQSS(I1(JL), I2(JL), I3(JL))
+ ZQGS(JL) = PQGS(I1(JL), I2(JL), I3(JL))
+ IF (KRR == 7) ZQHS(JL) = PQHS(I1(JL), I2(JL), I3(JL))
+ ENDDO
+!
+!
+!* 2.3 Update the parameter e in the charge-diameter relation
+!
+ IF (KRR == 7) THEN
+ CALL COMPUTE_LBDA(ZRRT, ZRST, ZRGT, ZRH=ZRHT)
+ ZTSPLITR = 1.
+ CALL ELEC_UPDATE_QD(ZTSPLITR, ZERT, ZEIT, ZEST, ZEGT, ZQRT, ZQIT, ZQST, ZQGT, &
+ ZRRT, ZRIT, ZRST, ZRGT, &
+ ZEH=ZEHT, ZQH=ZQHT, ZRH=ZRHT, ZEC=ZECT, ZQC=ZQCT, ZRC=ZRCT)
+ ZTSPLITR = PTSTEP
+ CALL ELEC_UPDATE_QD(ZTSPLITR, ZERS, ZEIS, ZESS, ZEGS, ZQRS, ZQIS, ZQSS, ZQGS, &
+ ZRRS, ZRIS, ZRSS, ZRGS, &
+ ZEH=ZEHS, ZQH=ZQHS, ZRH=ZRHS, ZEC=ZECS, ZQC=ZQCS, ZRC=ZRCS)
+ ELSE
+ CALL COMPUTE_LBDA(ZRRT, ZRST, ZRGT)
+ ZTSPLITR = 1.
+ CALL ELEC_UPDATE_QD(ZTSPLITR, ZERT, ZEIT, ZEST, ZEGT, ZQRT, ZQIT, ZQST, ZQGT, &
+ ZRRT, ZRIT, ZRST, ZRGT, ZEC=ZECT, ZQC=ZQCT, ZRC=ZRCT)
+ ZTSPLITR = PTSTEP
+ CALL ELEC_UPDATE_QD(ZTSPLITR, ZERS, ZEIS, ZESS, ZEGS, ZQRS, ZQIS, ZQSS, ZQGS, &
+ ZRRS, ZRIS, ZRSS, ZRGS, ZEC=ZECS, ZQC=ZQCS, ZRC=ZRCS)
+ END IF
+!
+!
+!* 2.4 Initialization for the non-inductive charging process
+!
+ CALL ELEC_INI_NI_PROCESS
+!
+!
+!* 2.5 Compute the slow cold process sources
+!
+ CALL RAIN_ICE_ELEC_SLOW
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. COMPUTES THE SLOW WARM PROCESS SOURCES
+! --------------------------------------
+!
+ IF( OWARM ) THEN ! Check if the formation of the raindrops by the slow
+ ! warm processes is allowed
+ PEVAP3D(:,:,:)= 0.
+ CALL RAIN_ICE_ELEC_WARM
+ END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 4. COMPUTES THE FAST COLD PROCESS SOURCES FOR r_s
+! ----------------------------------------------
+!
+ CALL RAIN_ICE_ELEC_FAST_RS
+!
+!-------------------------------------------------------------------------------
+!
+!* 5. COMPUTES THE FAST COLD PROCESS SOURCES FOR r_g
+! ----------------------------------------------
+!
+ CALL RAIN_ICE_ELEC_FAST_RG
+!
+!-------------------------------------------------------------------------------
+!
+!* 6. COMPUTES THE FAST COLD PROCESS SOURCES FOR r_h
+! ----------------------------------------------
+!
+ IF ( KRR == 7 ) THEN
+ CALL RAIN_ICE_ELEC_FAST_RH
+ END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 7. COMPUTES SPECIFIC SOURCES OF THE WARM AND COLD CLOUDY SPECIES
+! -------------------------------------------------------------
+!
+ CALL RAIN_ICE_ELEC_FAST_RI
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 8. UPDATE MIXING 3D RATIOS AND VOLUMETRIC CHARGE CONCENTRATIONS
+! ------------------------------------------------------------
+!
+!* 8.1 Update the mixing ratio
+!
+ DO JL=1,IMICRO
+ PRVS(I1(JL),I2(JL),I3(JL)) = ZRVS(JL)
+ PRCS(I1(JL),I2(JL),I3(JL)) = ZRCS(JL)
+ PRRS(I1(JL),I2(JL),I3(JL)) = ZRRS(JL)
+ PRIS(I1(JL),I2(JL),I3(JL)) = ZRIS(JL)
+ PRSS(I1(JL),I2(JL),I3(JL)) = ZRSS(JL)
+ PRGS(I1(JL),I2(JL),I3(JL)) = ZRGS(JL)
+ PTHS(I1(JL),I2(JL),I3(JL)) = ZTHS(JL)
+ PCIT(I1(JL),I2(JL),I3(JL)) = ZCIT(JL)
+ END DO
+ IF ( KRR == 7 ) THEN
+ DO JL=1,IMICRO
+ PRHS(I1(JL),I2(JL),I3(JL)) = ZRHS(JL)
+ END DO
+ END IF
+!
+!
+!* 8.2 Compute the volumetric charge concentration
+!
+ DO JL=1,IMICRO
+ PQPIS(I1(JL),I2(JL),I3(JL)) = ZQPIS(JL)
+ PQNIS(I1(JL),I2(JL),I3(JL)) = ZQNIS(JL)
+ PQCS (I1(JL),I2(JL),I3(JL)) = ZQCS(JL)
+ PQRS (I1(JL),I2(JL),I3(JL)) = ZQRS(JL)
+ PQIS (I1(JL),I2(JL),I3(JL)) = ZQIS(JL)
+ PQSS (I1(JL),I2(JL),I3(JL)) = ZQSS(JL)
+ PQGS (I1(JL),I2(JL),I3(JL)) = ZQGS(JL)
+ END DO
+ IF ( KRR == 7 ) THEN
+ DO JL=1,IMICRO
+ PQHS(I1(JL),I2(JL),I3(JL)) = ZQHS(JL)
+ END DO
+ END IF
+!
+!
+!* 8.3 Deallocate
+!
+ DEALLOCATE(ZZW1)
+ DEALLOCATE(ZDV)
+ DEALLOCATE(ZCJ)
+ DEALLOCATE(ZRDRYG)
+ DEALLOCATE(ZRWETG)
+ DEALLOCATE(ZLBDAG)
+ IF ( KRR == 7 ) DEALLOCATE(ZLBDAH)
+ DEALLOCATE(ZLBDAS)
+ DEALLOCATE(ZLBDAR)
+ DEALLOCATE(ZSSI)
+ DEALLOCATE(ZUSW)
+ DEALLOCATE(ZLVFACT)
+ DEALLOCATE(ZLSFACT)
+ DEALLOCATE(ZZW)
+ DEALLOCATE(ZEXNREF)
+ DEALLOCATE(ZPRES)
+ DEALLOCATE(ZRHODREF)
+ DEALLOCATE(ZRHOCOR)
+ DEALLOCATE(ZZT)
+ IF(LBU_ENABLE .OR. LLES_CALL) DEALLOCATE(ZRHODJ)
+ DEALLOCATE(ZTHS)
+ IF ( KRR == 7 ) DEALLOCATE(ZRHS)
+ DEALLOCATE(ZRGS)
+ DEALLOCATE(ZRSS)
+ DEALLOCATE(ZRIS)
+ DEALLOCATE(ZRRS)
+ DEALLOCATE(ZRCS)
+ DEALLOCATE(ZRVS)
+ DEALLOCATE(ZCIT)
+ DEALLOCATE(ZRGT)
+ IF ( KRR == 7 ) DEALLOCATE(ZRHT)
+ DEALLOCATE(ZRST)
+ DEALLOCATE(ZRIT)
+ DEALLOCATE(ZRRT)
+ DEALLOCATE(ZAI)
+ DEALLOCATE(ZRCT)
+ DEALLOCATE(ZKA)
+ DEALLOCATE(ZRVT)
+ DEALLOCATE(ZSIGMA_RC)
+ DEALLOCATE(ZCF)
+!
+ DEALLOCATE( ZECT )
+ DEALLOCATE( ZERT )
+ DEALLOCATE( ZEIT )
+ DEALLOCATE( ZEST )
+ DEALLOCATE( ZEGT )
+ IF ( KRR == 7 ) DEALLOCATE(ZEHT)
+ DEALLOCATE( ZECS )
+ DEALLOCATE( ZERS )
+ DEALLOCATE( ZEIS )
+ DEALLOCATE( ZESS )
+ DEALLOCATE( ZEGS )
+ IF ( KRR == 7 ) DEALLOCATE(ZEHS)
+ DEALLOCATE( ZQPIT )
+ DEALLOCATE( ZQNIT )
+ DEALLOCATE( ZQCT )
+ DEALLOCATE( ZQRT )
+ DEALLOCATE( ZQIT )
+ DEALLOCATE( ZQST )
+ DEALLOCATE( ZQGT )
+ IF ( KRR == 7 ) DEALLOCATE(ZQHT)
+ DEALLOCATE( ZQPIS )
+ DEALLOCATE( ZQNIS )
+ DEALLOCATE( ZQCS )
+ DEALLOCATE( ZQRS )
+ DEALLOCATE( ZQIS )
+ DEALLOCATE( ZQSS )
+ DEALLOCATE( ZQGS )
+ IF ( KRR == 7 ) DEALLOCATE(ZQHS)
+ DEALLOCATE( ZWQ1 )
+ DEALLOCATE( ZWQ3 )
+ DEALLOCATE( ZWQ4 )
+ DEALLOCATE( ZCOLIS )
+ DEALLOCATE( ZCOLIG )
+ DEALLOCATE( ZCOLSG )
+ DEALLOCATE( ZRSMIN_ELEC)
+ DEALLOCATE( GELEC )
+ IF (ALLOCATED( ZDELTALWC )) DEALLOCATE( ZDELTALWC )
+ IF (ALLOCATED( ZLWCC )) DEALLOCATE( ZLWCC )
+ IF (ALLOCATED( ZFT )) DEALLOCATE( ZFT )
+ IF (ALLOCATED( ZEW )) DEALLOCATE( ZEW )
+ IF (ALLOCATED( ZSAUNSK )) DEALLOCATE( ZSAUNSK )
+ IF (ALLOCATED( ZSAUNIM )) DEALLOCATE( ZSAUNIM )
+ IF (ALLOCATED( ZSAUNIN )) DEALLOCATE( ZSAUNIN )
+ IF (ALLOCATED( ZSAUNSM )) DEALLOCATE( ZSAUNSM )
+ IF (ALLOCATED( ZSAUNSN )) DEALLOCATE( ZSAUNSN )
+ IF (ALLOCATED( ZVGMEAN )) DEALLOCATE( ZVGMEAN )
+ IF (ALLOCATED( ZRAR )) DEALLOCATE( ZRAR )
+ IF (ALLOCATED( ZRAR_CRIT )) DEALLOCATE( ZRAR_CRIT )
+ IF (ALLOCATED( ZSAUNIM_IS )) DEALLOCATE( ZSAUNIM_IS )
+ IF (ALLOCATED( ZSAUNIN_IS )) DEALLOCATE( ZSAUNIN_IS )
+ IF (ALLOCATED( ZFQIAGGS )) DEALLOCATE( ZFQIAGGS )
+ IF (ALLOCATED( ZFQIDRYGBS )) DEALLOCATE( ZFQIDRYGBS )
+ IF (ALLOCATED( ZLBQSDRYGB1S )) DEALLOCATE( ZLBQSDRYGB1S )
+ IF (ALLOCATED( ZLBQSDRYGB2S )) DEALLOCATE( ZLBQSDRYGB2S )
+ IF (ALLOCATED( ZLBQSDRYGB3S )) DEALLOCATE( ZLBQSDRYGB3S )
+ IF (ALLOCATED( ZSAUNIM_IG )) DEALLOCATE( ZSAUNIM_IG )
+ IF (ALLOCATED( ZSAUNIN_IG )) DEALLOCATE( ZSAUNIN_IG )
+ IF (ALLOCATED( ZSAUNSK_SG )) DEALLOCATE( ZSAUNSK_SG )
+ IF (ALLOCATED( ZSAUNSM_SG )) DEALLOCATE( ZSAUNSM_SG )
+ IF (ALLOCATED( ZSAUNSN_SG )) DEALLOCATE( ZSAUNSN_SG )
+ IF (ALLOCATED( ZDQLWC )) DEALLOCATE( ZDQLWC )
+ IF (ALLOCATED( ZDQRAR_IS )) DEALLOCATE( ZDQRAR_IS )
+ IF (ALLOCATED( ZDQRAR_IG )) DEALLOCATE( ZDQRAR_IG )
+ IF (ALLOCATED( ZDQRAR_SG )) DEALLOCATE( ZDQRAR_SG )
+ IF (ALLOCATED( ZAUX1 )) DEALLOCATE( ZAUX1 )
+ IF (ALLOCATED( ZLIMIT )) DEALLOCATE( ZLIMIT )
+ IF (ALLOCATED( ZEFIELDW )) DEALLOCATE( ZEFIELDW )
+ IF (ALLOCATED( ZRATE_IND )) DEALLOCATE( ZRATE_IND )
+ IF (ALLOCATED( GIND )) DEALLOCATE( GIND )
+ IF (ALLOCATED( ZEFIELDU )) DEALLOCATE( ZEFIELDU )
+ IF (ALLOCATED( ZEFIELDV )) DEALLOCATE( ZEFIELDV )
+ DEALLOCATE( ZLATHAMIAGGS )
+!
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 8. COMPUTE THE SEDIMENTATION (RS) SOURCE
+! -------------------------------------
+!
+!* 8.1 time splitting loop initialization
+!
+ZTSPLITR = PTSTEP / REAL(KSPLITR)
+!
+!
+IF (CSEDIM == 'STAT') THEN
+! not yet developped for electricity !!!
+ CALL RAIN_ICE_SEDIMENTATION_STAT
+ELSE
+ CALL RAIN_ICE_ELEC_SEDIMENTATION_SPLIT
+END IF
+!
+!
+!-------------------------------------------------------------------------------
+!
+CONTAINS
+!
+!-------------------------------------------------------------------------------
+!
+ SUBROUTINE RAIN_ICE_ELEC_SEDIMENTATION_SPLIT
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!* 0.2 declaration of local variables
+!
+INTEGER , DIMENSION(SIZE(GSEDIMC)) :: IC1,IC2,IC3 ! Used to replace the COUNT
+INTEGER , DIMENSION(SIZE(GSEDIMR)) :: IR1,IR2,IR3 ! Used to replace the COUNT
+INTEGER , DIMENSION(SIZE(GSEDIMI)) :: II1,II2,II3 ! Used to replace the COUNT
+INTEGER , DIMENSION(SIZE(GSEDIMS)) :: IS1,IS2,IS3 ! Used to replace the COUNT
+INTEGER , DIMENSION(SIZE(GSEDIMG)) :: IG1,IG2,IG3 ! Used to replace the COUNT
+INTEGER , DIMENSION(SIZE(GSEDIMH)) :: IH1,IH2,IH3 ! Used to replace the COUNT
+INTEGER :: ILENALLOCC,ILENALLOCR,ILENALLOCI,ILENALLOCS,ILENALLOCG,ILENALLOCH
+INTEGER :: ILISTLENC,ILISTLENR,ILISTLENI,ILISTLENS,ILISTLENG,ILISTLENH
+INTEGER, ALLOCATABLE :: ILISTR(:),ILISTC(:),ILISTI(:),ILISTS(:),ILISTG(:),ILISTH(:)
+! Optimization for NEC
+!INTEGER, SAVE :: IOLDALLOCC = SIZE(PEXNREF,1)*SIZE(PEXNREF,2)*SIZE(PEXNREF,3)/10
+!INTEGER, SAVE :: IOLDALLOCR = SIZE(PEXNREF,1)*SIZE(PEXNREF,2)*SIZE(PEXNREF,3)/10
+!INTEGER, SAVE :: IOLDALLOCI = SIZE(PEXNREF,1)*SIZE(PEXNREF,2)*SIZE(PEXNREF,3)/10
+!INTEGER, SAVE :: IOLDALLOCS = SIZE(PEXNREF,1)*SIZE(PEXNREF,2)*SIZE(PEXNREF,3)/10
+!INTEGER, SAVE :: IOLDALLOCG = SIZE(PEXNREF,1)*SIZE(PEXNREF,2)*SIZE(PEXNREF,3)/10
+!INTEGER, SAVE :: IOLDALLOCH = SIZE(PEXNREF,1)*SIZE(PEXNREF,2)*SIZE(PEXNREF,3)/10
+INTEGER, SAVE :: IOLDALLOCC = 6000
+INTEGER, SAVE :: IOLDALLOCR = 6000
+INTEGER, SAVE :: IOLDALLOCI = 6000
+INTEGER, SAVE :: IOLDALLOCS = 6000
+INTEGER, SAVE :: IOLDALLOCG = 6000
+INTEGER, SAVE :: IOLDALLOCH = 6000
+!
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: ZCONC3D ! droplet condensation
+INTEGER, DIMENSION(:), ALLOCATABLE :: ZCIS
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: ZF0, ZF1, ZCOR
+REAL :: ZBEARDCOEFR, ZBEARDCOEFI, ZBEARDCOEFS, ZBEARDCOEFG
+REAL :: ZVR, ZVI, ZVS, ZVG, ZETA0, ZK, ZRE0
+! For rain, ice, snow and graupel particles, Take into account the
+! effects of altitude and electrical force on terminal fallspeed
+! (from Beard, JAS 1980, 37,1363-1374)
+!
+!-------------------------------------------------------------------------------
+!
+! O. Initialization for sedimentation
+!
+ if ( lbudget_rc .and. osedic ) &
+ call Budget_store_init( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ if ( osedic ) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'SEDI', pqcs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'SEDI', pqrs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'SEDI', pqis(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'SEDI', pqss(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'SEDI', pqgs(:, :, :) * prhodj(:, :, :) )
+ if ( krr == 7 ) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 6 ), 'SEDI', pqhs(:, :, :) * prhodj(:, :, :) )
+ end if
+
+ IF (OSEDIC) PINPRC (:,:) = 0.
+ PINPRR (:,:) = 0.
+ PINPRR3D (:,:,:) = 0.
+ PINPRS (:,:) = 0.
+ PINPRG (:,:) = 0.
+ IF ( KRR == 7 ) PINPRH (:,:) = 0.
+!
+ ZT (:,:,:) = ZT (:,:,:) - XTT !ZT from RAIN_ICE_ELEC_NUCLEATION
+ ZETA0 = (1.718 + 0.0049*(XTHVREFZ(IKB) -XTT))
+ WHERE (ZT (:,:,:) >= 0.0)
+ ZF0(:,:,:) = ZETA0 / (1.718 + 0.0049*ZT(:,:,:))
+ ELSEWHERE
+ ZF0(:,:,:) = ZETA0 / (1.718 + 0.0049*ZT(:,:,:) - 1.2E-5*ZT(:,:,:)*ZT(:,:,:))
+ END WHERE
+!
+ ZF1(:,:,:) = SQRT(ZRHO00/PRHODREF(:,:,:))
+ ZCOR(:,:,:) = (PRHODREF(:,:,:)/ZRHO00)**XCEXVT ! to eliminate Foote-duToit correction
+!
+ ZVR = (ZRHO00/ZETA0) * XCR * MOMG(XALPHAR,XNUR,XBR+XDR) / MOMG(XALPHAR,XNUR,XBR)
+ ZVI = (ZRHO00/ZETA0) * 2.1E5 * MOMG(XALPHAI,XNUI,3.285) / MOMG(XALPHAI,XNUI,1.7) ! Columns
+ ZVS = (ZRHO00/ZETA0) * XCS * MOMG(XALPHAS,XNUS,XBS+XDS) / MOMG(XALPHAS,XNUS,XBS)
+ ZVG = (ZRHO00/ZETA0) * XCG * MOMG(XALPHAG,XNUG,XBG+XDG) / MOMG(XALPHAG,XNUG,XBG)
+!
+!* 1. Parameters for cloud sedimentation
+!
+ IF (OSEDIC) THEN
+ ZRAY(:,:,:) = 0.
+ ZLBC(:,:,:) = XLBC(1)
+ ZFSEDC(:,:,:) = XFSEDC(1)
+ ZCONC3D(:,:,:) = XCONC_LAND
+ ZCONC_TMP(:,:) = XCONC_LAND
+ IF (PRESENT(PSEA)) THEN
+ ZCONC_TMP(:,:) = PSEA(:,:) * XCONC_SEA + (1. - PSEA(:,:)) * XCONC_LAND
+ DO JK = IKB, IKE
+ ZLBC(:,:,JK) = PSEA(:,:) * XLBC(2) + (1. - PSEA(:,:)) * XLBC(1)
+ ZFSEDC(:,:,JK) = PSEA(:,:) * XFSEDC(2) + (1. - PSEA(:,:)) * XFSEDC(1)
+ ZFSEDC(:,:,JK) = MAX(MIN(XFSEDC(1),XFSEDC(2)),ZFSEDC(:,:,JK))
+ ZCONC3D(:,:,JK) = (1. - PTOWN(:,:)) * ZCONC_TMP(:,:) + PTOWN(:,:) * XCONC_URBAN
+ ZRAY(:,:,JK) = 0.5 * ((1. - PSEA(:,:)) * MOMG(XALPHAC, XNUC, 1.0) + &
+ PSEA(:,:) * MOMG(XALPHAC2, XNUC2, 1.0) )
+ END DO
+ ELSE
+ ZCONC3D(:,:,:) = XCONC_LAND
+ ZRAY(:,:,:) = 0.5 * MOMG(XALPHAC, XNUC, 1.0)
+ END IF
+ ZRAY(:,:,:) = MAX(1.,ZRAY(:,:,:))
+ ZLBC(:,:,:) = MAX(MIN(XLBC(1),XLBC(2)),ZLBC(:,:,:))
+ ENDIF
+!
+!* 2. compute the fluxes
+!
+! optimization by looking for locations where
+! the precipitating fields are larger than a minimal value only !!!
+! For optimization we consider each variable separately
+
+ ZRTMIN(:) = XRTMIN(:) / PTSTEP
+ IF (OSEDIC) GSEDIMC(:,:,:) = .FALSE.
+ GSEDIMR(:,:,:) = .FALSE.
+ GSEDIMI(:,:,:) = .FALSE.
+ GSEDIMS(:,:,:) = .FALSE.
+ GSEDIMG(:,:,:) = .FALSE.
+ IF (KRR == 7) GSEDIMH(:,:,:) = .FALSE.
+!
+ IF (OSEDIC) ILENALLOCC = 0
+ ILENALLOCR = 0
+ ILENALLOCI = 0
+ ILENALLOCS = 0
+ ILENALLOCG = 0
+ IF ( KRR == 7 ) ILENALLOCH = 0
+!
+! ZPiS = Specie i source creating during the current time step
+! PRiS = Source of the previous time step
+!
+ IF (OSEDIC) THEN
+ ZPRCS(:,:,:) = 0.0
+ ZPRCS(:,:,:) = PRCS(:,:,:) - PRCT(:,:,:) / PTSTEP
+ PRCS(:,:,:) = PRCT(:,:,:) / PTSTEP
+ END IF
+ ZPRRS(:,:,:) = 0.0
+ ZPRSS(:,:,:) = 0.0
+ ZPRGS(:,:,:) = 0.0
+ IF (KRR == 7) ZPRHS(:,:,:) = 0.0
+!
+ ZPRRS(:,:,:) = PRRS(:,:,:) - PRRT(:,:,:) / PTSTEP
+ ZPRSS(:,:,:) = PRSS(:,:,:) - PRST(:,:,:) / PTSTEP
+ ZPRGS(:,:,:) = PRGS(:,:,:) - PRGT(:,:,:) / PTSTEP
+ IF (KRR == 7) ZPRHS(:,:,:) = PRHS(:,:,:) - PRHT(:,:,:) / PTSTEP
+ PRRS(:,:,:) = PRRT(:,:,:) / PTSTEP
+ PRSS(:,:,:) = PRST(:,:,:) / PTSTEP
+ PRGS(:,:,:) = PRGT(:,:,:) / PTSTEP
+ IF (KRR == 7) PRHS(:,:,:) = PRHT(:,:,:) / PTSTEP
+ ZPQRS(:,:,:) = 0.0
+ ZPQSS(:,:,:) = 0.0
+ ZPQGS(:,:,:) = 0.0
+ IF (KRR == 7) ZPQHS(:,:,:) = 0.0
+!
+ ZPQRS(:,:,:) = PQRS(:,:,:) - PQRT(:,:,:) / PTSTEP
+ ZPQSS(:,:,:) = PQSS(:,:,:) - PQST(:,:,:) / PTSTEP
+ ZPQGS(:,:,:) = PQGS(:,:,:) - PQGT(:,:,:) / PTSTEP
+ IF (KRR == 7) ZPQHS(:,:,:) = PQHS(:,:,:) - PQHT(:,:,:) / PTSTEP
+ PQRS(:,:,:) = PQRT(:,:,:) / PTSTEP
+ PQSS(:,:,:) = PQST(:,:,:) / PTSTEP
+ PQGS(:,:,:) = PQGT(:,:,:) / PTSTEP
+ IF (KRR == 7) PQHS(:,:,:) = PQHT(:,:,:) / PTSTEP
+!
+! PRiS = Source of the previous time step + source created during the subtime
+! step
+!
+ DO JN = 1, KSPLITR
+ IF(JN == 1) THEN
+ IF (OSEDIC) PRCS(:,:,:) = PRCS(:,:,:) + ZPRCS(:,:,:) / KSPLITR
+ PRRS(:,:,:) = PRRS(:,:,:) + ZPRRS(:,:,:) / KSPLITR
+ PRSS(:,:,:) = PRSS(:,:,:) + ZPRSS(:,:,:) / KSPLITR
+ PRGS(:,:,:) = PRGS(:,:,:) + ZPRGS(:,:,:) / KSPLITR
+ IF (KRR == 7) PRHS(:,:,:) = PRHS(:,:,:) + ZPRHS(:,:,:) / KSPLITR
+ PQRS(:,:,:) = PQRS(:,:,:) + ZPQRS(:,:,:) / KSPLITR
+ PQSS(:,:,:) = PQSS(:,:,:) + ZPQSS(:,:,:) / KSPLITR
+ PQGS(:,:,:) = PQGS(:,:,:) + ZPQGS(:,:,:) / KSPLITR
+ IF (KRR == 7) PQHS(:,:,:) = PQHS(:,:,:) + ZPQHS(:,:,:) / KSPLITR
+ DO JK = IKB, IKE
+ ZW(:,:,JK) = ZTSPLITR / (PRHODREF(:,:,JK) * (PZZ(:,:,JK+1) - PZZ(:,:,JK)))
+ END DO
+ ELSE
+ IF (OSEDIC) PRCS(:,:,:) = PRCS(:,:,:) + ZPRCS(:,:,:) * ZTSPLITR
+ PRRS(:,:,:) = PRRS(:,:,:) + ZPRRS(:,:,:) * ZTSPLITR
+ PRSS(:,:,:) = PRSS(:,:,:) + ZPRSS(:,:,:) * ZTSPLITR
+ PRGS(:,:,:) = PRGS(:,:,:) + ZPRGS(:,:,:) * ZTSPLITR
+ IF (KRR == 7) PRHS(:,:,:) = PRHS(:,:,:) + ZPRHS(:,:,:) * ZTSPLITR
+ PQRS(:,:,:) = PQRS(:,:,:) + ZPQRS(:,:,:) * ZTSPLITR
+ PQSS(:,:,:) = PQSS(:,:,:) + ZPQSS(:,:,:) * ZTSPLITR
+ PQGS(:,:,:) = PQGS(:,:,:) + ZPQGS(:,:,:) * ZTSPLITR
+ IF (KRR == 7) PQHS(:,:,:) = PQHS(:,:,:) + ZPQHS(:,:,:) * ZTSPLITR
+ END IF
+ !
+ IF (OSEDIC) GSEDIMC(IIB:IIE,IJB:IJE,IKB:IKE) = &
+ PRCS(IIB:IIE,IJB:IJE,IKB:IKE) > ZRTMIN(2)
+ GSEDIMR(IIB:IIE,IJB:IJE,IKB:IKE) = &
+ PRRS(IIB:IIE,IJB:IJE,IKB:IKE) > ZRTMIN(3)
+ GSEDIMI(IIB:IIE,IJB:IJE,IKB:IKE) = &
+ PRIS(IIB:IIE,IJB:IJE,IKB:IKE) > ZRTMIN(4)
+ GSEDIMS(IIB:IIE,IJB:IJE,IKB:IKE) = &
+ PRSS(IIB:IIE,IJB:IJE,IKB:IKE) > ZRTMIN(5)
+ GSEDIMG(IIB:IIE,IJB:IJE,IKB:IKE) = &
+ PRGS(IIB:IIE,IJB:IJE,IKB:IKE) > ZRTMIN(6)
+ IF (KRR == 7) GSEDIMH(IIB:IIE,IJB:IJE,IKB:IKE) = &
+ PRHS(IIB:IIE,IJB:IJE,IKB:IKE) > ZRTMIN(7)
+!
+ IF (OSEDIC) ISEDIMC = COUNTJV( GSEDIMC(:,:,:),IC1(:),IC2(:),IC3(:))
+ ISEDIMR = COUNTJV( GSEDIMR(:,:,:),IR1(:),IR2(:),IR3(:))
+ ISEDIMI = COUNTJV( GSEDIMI(:,:,:),II1(:),II2(:),II3(:))
+ ISEDIMS = COUNTJV( GSEDIMS(:,:,:),IS1(:),IS2(:),IS3(:))
+ ISEDIMG = COUNTJV( GSEDIMG(:,:,:),IG1(:),IG2(:),IG3(:))
+ IF (KRR == 7) ISEDIMH = COUNTJV( GSEDIMH(:,:,:),IH1(:),IH2(:),IH3(:))
+!
+!* 2.1 for cloud
+!
+ IF (OSEDIC) THEN
+ ZWSED(:,:,:) = 0.
+ IF( JN==1 ) PRCS(:,:,:) = PRCS(:,:,:) * PTSTEP
+ IF(ISEDIMC >= 1) THEN
+ IF (ISEDIMC .GT. ILENALLOCC) THEN
+ IF (ILENALLOCC .GT. 0) THEN
+ DEALLOCATE (ZRCS, ZRHODREFC, ILISTC, ZWLBDC, ZCONC, ZRCT, &
+ ZZT, ZPRES, ZRAY1D, ZFSEDC1D, ZWLBDA, ZCC )
+ END IF
+ ILENALLOCC = MAX (IOLDALLOCC, 2*ISEDIMC )
+ IOLDALLOCC = ILENALLOCC
+ ALLOCATE(ZRCS(ILENALLOCC), ZRHODREFC(ILENALLOCC), ILISTC(ILENALLOCC), &
+ ZWLBDC(ILENALLOCC), ZCONC(ILENALLOCC), ZRCT(ILENALLOCC), ZZT(ILENALLOCC), &
+ ZPRES(ILENALLOCC), ZRAY1D(ILENALLOCC), ZFSEDC1D(ILENALLOCC), &
+ ZWLBDA(ILENALLOCC), ZCC(ILENALLOCC))
+ END IF
+!
+ DO JL = 1, ISEDIMC
+ ZRCS(JL) = PRCS(IC1(JL),IC2(JL),IC3(JL))
+ ZRHODREFC(JL) = PRHODREF(IC1(JL),IC2(JL),IC3(JL))
+ ZWLBDC(JL) = ZLBC(IC1(JL),IC2(JL),IC3(JL))
+ ZCONC(JL) = ZCONC3D(IC1(JL),IC2(JL),IC3(JL))
+ ZRCT(JL) = PRCT(IC1(JL),IC2(JL),IC3(JL))
+ ZZT(JL) = PTHT(IC1(JL),IC2(JL),IC3(JL))
+ ZPRES(JL) = PPABST(IC1(JL),IC2(JL),IC3(JL))
+ ZRAY1D(JL) = ZRAY(IC1(JL),IC2(JL),IC3(JL))
+ ZFSEDC1D(JL) = ZFSEDC(IC1(JL),IC2(JL),IC3(JL))
+ END DO
+!
+ ILISTLENC = 0
+ DO JL = 1, ISEDIMC
+ IF(ZRCS(JL) .GT. ZRTMIN(2)) THEN
+ ILISTLENC = ILISTLENC + 1
+ ILISTC(ILISTLENC) = JL
+ END IF
+ END DO
+ DO JJ = 1, ILISTLENC
+ JL = ILISTC(JJ)
+ IF (ZRCS(JL) .GT. ZRTMIN(2) .AND. ZRCT(JL) .GT. XRTMIN(2)) THEN
+ ZWLBDC(JL) = ZWLBDC(JL) * ZCONC(JL) / (ZRHODREFC(JL) * ZRCT(JL))
+ ZWLBDC(JL) = ZWLBDC(JL)**XLBEXC
+ ZRAY1D(JL) = ZRAY1D(JL) / ZWLBDC(JL) !! ZRAY : mean diameter=M(1)/2
+ ZZT(JL) = ZZT(JL) * (ZPRES(JL) / XP00)**(XRD/XCPD)
+ ZWLBDA(JL) = 6.6E-8 * (101325. / ZPRES(JL)) * (ZZT(JL) / 293.15)
+ ZCC(JL) = XCC * (1. + 1.26 * ZWLBDA(JL) / ZRAY1D(JL)) !! XCC modified for cloud
+ ZWSED (IC1(JL),IC2(JL),IC3(JL)) = ZRHODREFC(JL)**(-XCEXVT +1 ) * &
+ ZWLBDC(JL)**(-XDC) * ZCC(JL) * ZFSEDC1D(JL) * ZRCS(JL)
+ END IF
+ END DO
+ END IF
+ DO JK = IKB, IKE
+ PRCS(:,:,JK) = PRCS(:,:,JK) + ZW(:,:,JK) * (ZWSED(:,:,JK+1) - ZWSED(:,:,JK))
+ END DO
+ PINPRC(:,:) = PINPRC(:,:) + ZWSED(:,:,IKB) / XRHOLW / KSPLITR
+ IF(JN == KSPLITR) THEN
+ PRCS(:,:,:) = PRCS(:,:,:) / PTSTEP
+ END IF
+ END IF
+!
+!* 2.2 for rain
+!
+ IF( JN==1 ) PRRS(:,:,:) = PRRS(:,:,:) * PTSTEP
+ IF (JN == 1) PQRS(:,:,:) = PQRS(:,:,:) * PTSTEP
+ ZWSED(:,:,:) = 0.
+ ZWSEDQ(:,:,:) = 0.
+ IF( ISEDIMR >= 1 ) THEN
+ IF ( ISEDIMR .GT. ILENALLOCR ) THEN
+ IF ( ILENALLOCR .GT. 0 ) THEN
+ DEALLOCATE (ZRRS, ZRHODREFR, ILISTR)
+ DEALLOCATE (ZQRS, ZLBDAR, ZERS)
+ END IF
+ ILENALLOCR = MAX (IOLDALLOCR, 2*ISEDIMR )
+ IOLDALLOCR = ILENALLOCR
+ ALLOCATE(ZRRS(ILENALLOCR), ZRHODREFR(ILENALLOCR), ILISTR(ILENALLOCR))
+ ALLOCATE(ZQRS(ILENALLOCR), ZLBDAR(ILENALLOCR), ZERS(ILENALLOCR))
+ END IF
+ ZERS(:) = 0.
+!
+ DO JL = 1, ISEDIMR
+ ZRRS(JL) = PRRS(IR1(JL),IR2(JL),IR3(JL))
+ ZRHODREFR(JL) = PRHODREF(IR1(JL),IR2(JL),IR3(JL))
+ ZQRS(JL) = PQRS(IR1(JL),IR2(JL),IR3(JL))
+! compute lambda_r and e_r
+ IF (ZRRS(JL) > 0.) THEN
+ ZLBDAR(JL) = XLBR * (ZRHODREFR(JL) * MAX(ZRRS(JL), ZRTMIN(3)))**XLBEXR
+ END IF
+ IF (ZRRS(JL) > ZRTMIN(3) .AND. ZLBDAR(JL) > 0.) THEN
+ ZERS(JL) = ZRHODREFR(JL) * ZQRS(JL) / (XFQUPDR * ZLBDAR(JL)**(XCXR - XFR))
+ ZERS(JL) = SIGN( MIN(ABS(ZERS(JL)), XERMAX), ZERS(JL))
+ END IF
+ END DO
+!
+ ILISTLENR = 0
+ DO JL = 1, ISEDIMR
+ IF(ZRRS(JL) .GT. ZRTMIN(3)) THEN
+ ILISTLENR = ILISTLENR + 1
+ ILISTR(ILISTLENR) = JL
+ END IF
+ END DO
+ DO JJ = 1, ILISTLENR
+ JL = ILISTR(JJ)
+ IF (ZRRS(JL) > 0. .AND. LSEDIM_BEARD) THEN
+ ZK = 1. - ZQRS(JL) * XEFIELDW(IR1(JL),IR2(JL),IR3(JL)) / (ZRRS(JL)*XG)
+ IF (ZK <= 0.0) THEN
+ ZBEARDCOEFR = 0.
+ ELSE
+ ZRE0 = ZVR / ZLBDAR(JL)**(1.+XDR)
+ IF (ZRE0 <= 0.2) THEN
+ ZBEARDCOEFR = ZF0(IR1(JL),IR2(JL),IR3(JL)) * ZK
+ ELSE IF (ZRE0 >= 1000.) THEN
+ ZBEARDCOEFR = ZF1(IR1(JL),IR2(JL),IR3(JL)) * SQRT(ZK)
+ ELSE
+ ZBEARDCOEFR = ZF0(IR1(JL),IR2(JL),IR3(JL)) * ZK + &
+ (ZF1(IR1(JL),IR2(JL),IR3(JL)) * &
+ SQRT(ZK)-ZF0(IR1(JL),IR2(JL),IR3(JL))*ZK) * &
+ (1.61+LOG(ZRE0)) / 8.52
+ END IF
+ ZBEARDCOEFR = ZBEARDCOEFR * ZCOR(IR1(JL),IR2(JL),IR3(JL))
+ END IF
+ ELSE
+ ZBEARDCOEFR = 1.0 ! No "Beard" effect
+ END IF
+!
+ ZWSED(IR1(JL),IR2(JL),IR3(JL)) = ZBEARDCOEFR * &
+ XFSEDR * ZRRS(JL)**XEXSEDR * &
+ ZRHODREFR(JL)**(XEXSEDR-XCEXVT)
+!
+ IF (ZRRS(JL) > ZRTMIN(3) .AND. ABS(ZERS(JL)) > XERMIN) THEN
+ ZWSEDQ(IR1(JL),IR2(JL),IR3(JL)) = ZBEARDCOEFR * &
+ XFQSEDR * ZERS(JL) * &
+ ZRRS(JL)**XEXQSEDR * &
+ ZRHODREFR(JL)**(XEXQSEDR-XCEXVT)
+ END IF
+ END DO
+ END IF
+ DO JK = IKB , IKE
+ PRRS(:,:,JK) = PRRS(:,:,JK) + ZW(:,:,JK) * (ZWSED(:,:,JK+1) - ZWSED(:,:,JK))
+ PQRS(:,:,JK) = PQRS(:,:,JK) + ZW(:,:,JK) * (ZWSEDQ(:,:,JK+1) - ZWSEDQ(:,:,JK))
+ END DO
+ PINPRR(:,:) = PINPRR(:,:) + ZWSED(:,:,IKB) / XRHOLW / KSPLITR
+ PINPRR3D(:,:,:) = PINPRR3D(:,:,:) + ZWSED(:,:,:) / XRHOLW / KSPLITR
+ IF (JN == KSPLITR) THEN
+ PRRS(:,:,:) = PRRS(:,:,:) / PTSTEP
+ PQRS(:,:,:) = PQRS(:,:,:) / PTSTEP
+ END IF
+!
+!
+!* 2.3 for pristine ice
+!
+ IF (JN == 1) PRIS(:,:,:) = PRIS(:,:,:) * PTSTEP
+ IF (JN == 1) PQIS(:,:,:) = PQIS(:,:,:) * PTSTEP
+ ZWSED(:,:,:) = 0.
+ ZWSEDQ(:,:,:) = 0.
+ IF( ISEDIMI >= 1 ) THEN
+ IF ( ISEDIMI .GT. ILENALLOCI ) THEN
+ IF ( ILENALLOCI .GT. 0 ) THEN
+ DEALLOCATE (ZRIS, ZRHODREFI, ILISTI)
+ DEALLOCATE (ZQIS, ZEIS, ZCIT, ZCIS, ZLBDAI)
+ END IF
+ ILENALLOCI = MAX (IOLDALLOCI, 2*ISEDIMI )
+ IOLDALLOCI = ILENALLOCI
+ ALLOCATE(ZRIS(ILENALLOCI), ZRHODREFI(ILENALLOCI), ILISTI(ILENALLOCI))
+ ALLOCATE(ZQIS(ILENALLOCI), &
+ ZEIS(ILENALLOCI), &
+ ZCIT(ILENALLOCI), &
+ ZCIS(ILENALLOCI), &
+ ZLBDAI(ILENALLOCI))
+ END IF
+!
+ DO JL = 1, ISEDIMI
+ ZRIS(JL) = PRIS(II1(JL),II2(JL),II3(JL))
+ ZRHODREFI(JL) = PRHODREF(II1(JL),II2(JL),II3(JL))
+ ZQIS(JL) = PQIS(II1(JL),II2(JL),II3(JL))
+ ZCIT(JL) = PCIT(II1(JL),II2(JL),II3(JL))
+ ZEIS(JL) = 0.
+! compute e_i
+ IF (ZRIS(JL) > ZRTMIN(4) .AND. ZCIT(JL) > 0.0) THEN
+ ZEIS(JL) = ZRHODREFI(JL) * ZQIS(JL) / ((ZCIT(JL)**(1 - XEXFQUPDI)) * &
+ XFQUPDI * (ZRHODREFI(JL) * ZRIS(JL))**XEXFQUPDI)
+ ZEIS(JL) = SIGN( MIN(ABS(ZEIS(JL)), XEIMAX), ZEIS(JL))
+ ZCIS(JL) = XFCI * ZRHODREFI(JL) * ZRIS(JL) * &
+ MAX(0.05E6, &
+ -0.15319E6 - 0.021454E6 * ALOG(ZRHODREFI(JL) * ZRIS(JL)))**3
+ ZLBDAI(JL) = (2.14E-3 * MOMG(XALPHAI,XNUI,1.7) * &
+ ZCIS(JL) / (ZRHODREFI(JL) * ZRIS(JL)))**0.588235
+ END IF
+ END DO
+!
+ ILISTLENI = 0
+ DO JL = 1, ISEDIMI
+ IF (ZRIS(JL) .GT. MAX(ZRTMIN(4),1.0E-7 )) THEN ! limitation of the McF&H formula
+ ILISTLENI = ILISTLENI + 1
+ ILISTI(ILISTLENI) = JL
+ END IF
+ END DO
+ DO JJ = 1, ILISTLENI
+ JL = ILISTI(JJ)
+ IF (ZRIS(JL) > ZRTMIN(4) .AND. ZCIT(JL) > 0.0 .AND. LSEDIM_BEARD) THEN
+ ZK = 1. - ZQIS(JL) * XEFIELDW(II1(JL),II2(JL),II3(JL)) / (ZRIS(JL)*XG)
+ IF (ZK <= 0.0) THEN
+ ZBEARDCOEFI = 0.
+ ELSE
+ ZRE0 = ZVI / ZLBDAI(JL)**2.585
+ IF (ZRE0 <= 0.2) THEN
+ ZBEARDCOEFI = ZF0(II1(JL),II2(JL),II3(JL)) * ZK
+ ELSE IF (ZRE0 >= 1000.) THEN
+ ZBEARDCOEFI = ZF1(II1(JL),II2(JL),II3(JL)) * SQRT(ZK)
+ ELSE
+ ZBEARDCOEFI = ZF0(II1(JL),II2(JL),II3(JL)) * ZK + &
+ (ZF1(II1(JL),II2(JL),II3(JL)) * &
+ SQRT(ZK) - ZF0(II1(JL),II2(JL),II3(JL)) * ZK) * &
+ (1.61 + LOG(ZRE0)) / 8.52
+ END IF
+ ZBEARDCOEFI = ZBEARDCOEFI * ZCOR(II1(JL),II2(JL),II3(JL))
+ END IF
+ ELSE
+ ZBEARDCOEFI = 1.0 ! No "Beard" effect
+ END IF
+!
+ ZWSED(II1(JL),II2(JL),II3(JL))= ZBEARDCOEFI * &
+ XFSEDI * ZRIS(JL) * &
+ ZRHODREFI(JL)**(1.0-XCEXVT) * & ! McF&H
+ MAX( 0.05E6,-0.15319E6-0.021454E6* &
+ ALOG(ZRHODREFI(JL)*ZRIS(JL)) )**XEXCSEDI
+ IF (ZRIS(JL) .GT. MAX(ZRTMIN(4),1.0E-7) .AND. ABS(ZEIS(JL)) .GT. XEIMIN .AND. &
+ ZCIT(JL) .GT. 0. ) THEN
+ ZWSEDQ(II1(JL),II2(JL),II3(JL)) = ZBEARDCOEFI * &
+ ZCIS(JL)**(1 - XEXQSEDI) * XFQSEDI * &
+ ZRIS(JL)**XEXQSEDI * ZRHODREFI(JL)**(XEXQSEDI - XCEXVT) * &
+ ZEIS(JL) * (ZCIT(JL) / ZCIS(JL))**(1.-XFI/XBI)
+ END IF
+ END DO
+ END IF
+ DO JK = IKB, IKE
+ PRIS(:,:,JK) = PRIS(:,:,JK) + ZW(:,:,JK) * (ZWSED(:,:,JK+1) - ZWSED(:,:,JK))
+ PQIS(:,:,JK) = PQIS(:,:,JK) + ZW(:,:,JK) * (ZWSEDQ(:,:,JK+1) - ZWSEDQ(:,:,JK))
+ END DO
+ IF (JN == KSPLITR) THEN
+ PRIS(:,:,:) = PRIS(:,:,:) / PTSTEP
+ PQIS(:,:,:) = PQIS(:,:,:) / PTSTEP
+ END IF
+!
+!
+!* 2.4 for aggregates/snow
+!
+ IF( JN==1 ) PRSS(:,:,:) = PRSS(:,:,:) * PTSTEP
+ IF (JN == 1) PQSS(:,:,:) = PQSS(:,:,:) * PTSTEP
+ ZWSED(:,:,:) = 0.
+ ZWSEDQ(:,:,:) = 0.
+ IF( ISEDIMS >= 1 ) THEN
+ IF ( ISEDIMS .GT. ILENALLOCS ) THEN
+ IF ( ILENALLOCS .GT. 0 ) THEN
+ DEALLOCATE (ZRSS, ZRHODREFS, ILISTS)
+ DEALLOCATE (ZQSS, ZESS, ZLBDAS)
+ END IF
+ ILENALLOCS = MAX(IOLDALLOCS, 2*ISEDIMS )
+ IOLDALLOCS = ILENALLOCS
+ ALLOCATE(ZRSS(ILENALLOCS), ZRHODREFS(ILENALLOCS), ILISTS(ILENALLOCS))
+ ALLOCATE(ZQSS(ILENALLOCS), ZESS(ILENALLOCS), ZLBDAS(ILENALLOCS))
+ END IF
+!
+ DO JL = 1, ISEDIMS
+ ZRSS(JL) = PRSS(IS1(JL),IS2(JL),IS3(JL))
+ ZRHODREFS(JL) = PRHODREF(IS1(JL),IS2(JL),IS3(JL))
+ ZQSS(JL) = PQSS(IS1(JL),IS2(JL),IS3(JL))
+ ZESS(JL) = 0.
+! compute lambda_s and e_s
+ IF (ZRSS(JL) > 0.) THEN
+ ZLBDAS(JL) = MIN(XLBDAS_MAX, &
+ XLBS * (ZRHODREFS(JL) * MAX(ZRSS(JL), ZRTMIN(5)))**XLBEXS)
+ END IF
+ IF (ZRSS(JL) > ZRTMIN(5) .AND. ZLBDAS(JL) > 0.) THEN
+ ZESS(JL) = ZRHODREFS(JL) * ZQSS(JL) / (XFQUPDS * ZLBDAS(JL)**(XCXS - XFS))
+ ZESS(JL) = SIGN( MIN(ABS(ZESS(JL)), XESMAX), ZESS(JL))
+ END IF
+ END DO
+!
+ ILISTLENS = 0
+ DO JL = 1, ISEDIMS
+ IF (ZRSS(JL) .GT. ZRTMIN(5)) THEN
+ ILISTLENS = ILISTLENS + 1
+ ILISTS(ILISTLENS) = JL
+ END IF
+ END DO
+ DO JJ = 1, ILISTLENS
+ JL = ILISTS(JJ)
+ IF (ZRSS(JL) > 0. .AND. LSEDIM_BEARD) THEN
+ ZK = 1. - ZQSS(JL) * XEFIELDW(IS1(JL),IS2(JL),IS3(JL)) / (ZRSS(JL)*XG)
+ IF (ZK <= 0.0) THEN
+ ZBEARDCOEFS = 0.
+ ELSE
+ ZRE0 = ZVS / ZLBDAS(JL)**(1.+XDS)
+ IF (ZRE0 <= 0.2) THEN
+ ZBEARDCOEFS = ZF0(IS1(JL),IS2(JL),IS3(JL)) * ZK
+ ELSE IF (ZRE0 >= 1000.) THEN
+ ZBEARDCOEFS = ZF1(IS1(JL),IS2(JL),IS3(JL)) * SQRT(ZK)
+ ELSE
+ ZBEARDCOEFS = ZF0(IS1(JL),IS2(JL),IS3(JL)) * ZK + &
+ (ZF1(IS1(JL),IS2(JL),IS3(JL)) * &
+ SQRT(ZK) -ZF0(IS1(JL),IS2(JL),IS3(JL)) * ZK) * &
+ (1.61 + LOG(ZRE0)) / 8.52
+ END IF
+ ZBEARDCOEFS = ZBEARDCOEFS * ZCOR(IS1(JL),IS2(JL),IS3(JL))
+ END IF
+ ELSE
+ ZBEARDCOEFS = 1.0 ! No "Beard" effect
+ END IF
+!
+ ZWSED (IS1(JL),IS2(JL),IS3(JL)) = ZBEARDCOEFS * &
+ XFSEDS * ZRSS(JL)**XEXSEDS * &
+ ZRHODREFS(JL)**(XEXSEDS-XCEXVT)
+ IF (ZRSS(JL) .GT. ZRTMIN(5) .AND. ABS(ZESS(JL)) > XESMIN) THEN
+ ZWSEDQ(IS1(JL),IS2(JL),IS3(JL)) = ZBEARDCOEFS * &
+ XFQSEDS * ZESS(JL) * &
+ ZRSS(JL)**XEXQSEDS * &
+ ZRHODREFS(JL)**(XEXQSEDS - XCEXVT)
+ END IF
+ END DO
+ END IF
+ DO JK = IKB, IKE
+ PRSS(:,:,JK) = PRSS(:,:,JK) + ZW(:,:,JK) * (ZWSED(:,:,JK+1) - ZWSED(:,:,JK))
+ PQSS(:,:,JK) = PQSS(:,:,JK) + ZW(:,:,JK) * (ZWSEDQ(:,:,JK+1) - ZWSEDQ(:,:,JK))
+ END DO
+ PINPRS(:,:) = PINPRS(:,:) + ZWSED(:,:,IKB) / XRHOLW / KSPLITR
+ IF (JN == KSPLITR) THEN
+ PRSS(:,:,:) = PRSS(:,:,:) / PTSTEP
+ PQSS(:,:,:) = PQSS(:,:,:) / PTSTEP
+ END IF
+!
+!
+!* 2.5 for graupeln
+!
+ ZWSED(:,:,:) = 0.
+ ZWSEDQ(:,:,:) = 0.
+ IF( JN==1 ) PRGS(:,:,:) = PRGS(:,:,:) * PTSTEP
+ IF (JN == 1) PQGS(:,:,:) = PQGS(:,:,:) * PTSTEP
+ IF( ISEDIMG >= 1 ) THEN
+ IF ( ISEDIMG .GT. ILENALLOCG ) THEN
+ IF ( ILENALLOCG .GT. 0 ) THEN
+ DEALLOCATE (ZRGS, ZRHODREFG, ILISTG)
+ DEALLOCATE (ZQGS, ZEGS, ZLBDAG)
+ END IF
+ ILENALLOCG = MAX (IOLDALLOCG, 2*ISEDIMG )
+ IOLDALLOCG = ILENALLOCG
+ ALLOCATE(ZRGS(ILENALLOCG), ZRHODREFG(ILENALLOCG), ILISTG(ILENALLOCG))
+ ALLOCATE(ZQGS(ILENALLOCG), ZEGS(ILENALLOCG), ZLBDAG(ILENALLOCG))
+ END IF
+!
+ DO JL = 1, ISEDIMG
+ ZRGS(JL) = PRGS(IG1(JL),IG2(JL),IG3(JL))
+ ZRHODREFG(JL) = PRHODREF(IG1(JL),IG2(JL),IG3(JL))
+ ZQGS(JL) = PQGS(IG1(JL),IG2(JL),IG3(JL))
+ ZEGS(JL) = 0.
+! compute lambda_g and e_g
+ IF (ZRGS(JL) > 0.) THEN
+ ZLBDAG(JL) = XLBG * (ZRHODREFG(JL) * MAX(ZRGS(JL), ZRTMIN(6)))**XLBEXG
+ END IF
+ IF (ZRGS(JL) > ZRTMIN(6) .AND. ZLBDAG(JL) > 0.) THEN
+ ZEGS(JL) = ZRHODREFG(JL) * ZQGS(JL) / (XFQUPDG * ZLBDAG(JL)**(XCXG - XFG))
+ ZEGS(JL) = SIGN( MIN(ABS(ZEGS(JL)), XEGMAX), ZEGS(JL))
+ END IF
+ END DO
+!
+ ILISTLENG = 0
+ DO JL = 1, ISEDIMG
+ IF (ZRGS(JL) .GT. ZRTMIN(6)) THEN
+ ILISTLENG = ILISTLENG + 1
+ ILISTG(ILISTLENG) = JL
+ END IF
+ END DO
+ DO JJ = 1, ILISTLENG
+ JL = ILISTG(JJ)
+ IF (ZRGS(JL) > 0. .AND. LSEDIM_BEARD) THEN
+ ZK = 1. - ZQGS(JL) * XEFIELDW(IG1(JL),IG2(JL),IG3(JL)) / (ZRGS(JL)*XG)
+ IF (ZK <= 0.0) THEN
+ ZBEARDCOEFG = 0.
+ ELSE
+ ZRE0 = ZVG / ZLBDAG(JL)**(1.+XDG)
+ IF (ZRE0 <= 0.2) THEN
+ ZBEARDCOEFG = ZF0(IG1(JL),IG2(JL),IG3(JL)) * ZK
+ ELSE IF (ZRE0 >= 1000.) THEN
+ ZBEARDCOEFG = ZF1(IG1(JL),IG2(JL),IG3(JL)) * SQRT(ZK)
+ ELSE
+ ZBEARDCOEFG = ZF0(IG1(JL),IG2(JL),IG3(JL)) * ZK + &
+ (ZF1(IG1(JL),IG2(JL),IG3(JL)) * &
+ SQRT(ZK) - ZF0(IG1(JL),IG2(JL),IG3(JL)) * ZK) * &
+ (1.61 + LOG(ZRE0)) / 8.52
+ END IF
+ ZBEARDCOEFG = ZBEARDCOEFG * ZCOR(IG1(JL),IG2(JL),IG3(JL))
+ END IF
+ ELSE
+ ZBEARDCOEFG = 1.0 ! No "Beard" effect
+ END IF
+!
+ ZWSED (IG1(JL),IG2(JL),IG3(JL))= ZBEARDCOEFG * &
+ XFSEDG * ZRGS(JL)**XEXSEDG * &
+ ZRHODREFG(JL)**(XEXSEDG-XCEXVT)
+ IF (ZRGS(JL) .GT. ZRTMIN(6) .AND. ABS(ZEGS(JL)) > XEGMIN) THEN
+ ZWSEDQ(IG1(JL),IG2(JL),IG3(JL)) = ZBEARDCOEFG * &
+ XFQSEDG * ZEGS(JL) * &
+ ZRGS(JL)**XEXQSEDG * &
+ ZRHODREFG(JL)**(XEXQSEDG - XCEXVT)
+ END IF
+ END DO
+ END IF
+ DO JK = IKB, IKE
+ PRGS(:,:,JK) = PRGS(:,:,JK) + ZW(:,:,JK) * (ZWSED(:,:,JK+1) - ZWSED(:,:,JK))
+ PQGS(:,:,JK) = PQGS(:,:,JK) + ZW(:,:,JK) * (ZWSEDQ(:,:,JK+1) - ZWSEDQ(:,:,JK))
+ END DO
+ PINPRG(:,:) = PINPRG(:,:) + ZWSED(:,:,IKB) / XRHOLW / KSPLITR
+ IF (JN == KSPLITR) THEN
+ PRGS(:,:,:) = PRGS(:,:,:) / PTSTEP
+ PQGS(:,:,:) = PQGS(:,:,:) / PTSTEP
+ END IF
+!
+!
+!* 2.6 for hail
+!
+ IF ( KRR == 7 ) THEN
+ IF( JN==1 ) PRHS(:,:,:) = PRHS(:,:,:) * PTSTEP
+ IF (JN == 1) PQHS(:,:,:) = PQHS(:,:,:) * PTSTEP
+ ZWSED(:,:,:) = 0.
+ ZWSEDQ(:,:,:) = 0.
+ IF( ISEDIMH >= 1 ) THEN
+ IF ( ISEDIMH .GT. ILENALLOCH ) THEN
+ IF ( ILENALLOCH .GT. 0 ) THEN
+ DEALLOCATE (ZRHS, ZRHODREFH, ILISTH)
+ DEALLOCATE (ZQHS, ZEHS, ZLBDAH)
+ END IF
+ ILENALLOCH = MAX(IOLDALLOCH, 2*ISEDIMH )
+ IOLDALLOCH = ILENALLOCH
+ ALLOCATE(ZRHS(ILENALLOCH), ZRHODREFH(ILENALLOCH), ILISTH(ILENALLOCH))
+ ALLOCATE(ZQHS(ILENALLOCH), ZLBDAH(ILENALLOCH), ZEHS(ILENALLOCH))
+ END IF
+!
+ DO JL = 1, ISEDIMH
+ ZRHS(JL) = PRHS(IH1(JL),IH2(JL),IH3(JL))
+ ZRHODREFH(JL) = PRHODREF(IH1(JL),IH2(JL),IH3(JL))
+ ZQHS(JL) = PQHS(IH1(JL),IH2(JL),IH3(JL))
+ ZEHS(JL) = 0.
+! compute lambda_h and e_h
+ IF (ZRHS(JL) > 0.) THEN
+ ZLBDAH(JL) = XLBH * (ZRHODREFH(JL) * MAX(ZRHS(JL), ZRTMIN(7)))**XLBEXH
+ END IF
+ IF (ZRHS(JL) > ZRTMIN(7) .AND. ZLBDAH(JL) > 0.) THEN
+ ZEHS(JL) = ZRHODREFH(JL) * ZQHS(JL) / (XFQUPDH * ZLBDAH(JL)**(XCXH - XFH))
+ ZEHS(JL) = SIGN( MIN(ABS(ZEHS(JL)), XEHMAX), ZEHS(JL))
+ END IF
+ END DO
+!
+ ILISTLENH = 0
+ DO JL = 1, ISEDIMH
+ IF (ZRHS(JL) .GT. ZRTMIN(7)) THEN
+ ILISTLENH = ILISTLENH + 1
+ ILISTH(ILISTLENH) = JL
+ END IF
+ END DO
+ DO JJ = 1, ILISTLENH
+ JL = ILISTH(JJ)
+ ZWSED (IH1(JL),IH2(JL),IH3(JL)) = XFSEDH * ZRHS(JL)**XEXSEDH * &
+ ZRHODREFH(JL)**(XEXSEDH-XCEXVT)
+ IF (ZRHS(JL) .GT. ZRTMIN(7) .AND. ABS(ZEHS(JL)) > XEHMIN) THEN
+ ZWSEDQ(IH1(JL),IH2(JL),IH3(JL)) = XFQSEDH * ZEHS(JL) * &
+ ZRHS(JL)**XEXQSEDH * &
+ ZRHODREFH(JL)**(XEXQSEDH - XCEXVT)
+ END IF
+ END DO
+ END IF
+ DO JK = IKB, IKE
+ PRHS(:,:,JK) = PRHS(:,:,JK) + ZW(:,:,JK) * (ZWSED(:,:,JK+1) - ZWSED(:,:,JK))
+ PQHS(:,:,JK) = PQHS(:,:,JK) + ZW(:,:,JK) * (ZWSEDQ(:,:,JK+1) - ZWSEDQ(:,:,JK))
+ END DO
+ PINPRH(:,:) = PINPRH(:,:) + ZWSED(:,:,IKB) / XRHOLW / KSPLITR
+ IF (JN == KSPLITR) THEN
+ PRHS(:,:,:) = PRHS(:,:,:) / PTSTEP
+ PQHS(:,:,:) = PQHS(:,:,:) / PTSTEP
+ END IF
+ END IF
+ END DO
+!
+ IF (OSEDIC) THEN
+ IF (ILENALLOCC .GT. 0) DEALLOCATE (ZRCS, ZRHODREFC, &
+ ILISTC,ZWLBDC,ZCONC,ZRCT, ZZT,ZPRES,ZRAY1D,ZFSEDC1D, ZWLBDA,ZCC)
+ END IF
+ IF (ILENALLOCR .GT. 0 ) DEALLOCATE(ZRHODREFR,ZRRS,ILISTR)
+ IF (ILENALLOCI .GT. 0 ) DEALLOCATE(ZRHODREFI,ZRIS,ILISTI)
+ IF (ILENALLOCS .GT. 0 ) DEALLOCATE(ZRHODREFS,ZRSS,ILISTS)
+ IF (ILENALLOCG .GT. 0 ) DEALLOCATE(ZRHODREFG,ZRGS,ILISTG)
+ IF (KRR == 7 .AND. (ILENALLOCH .GT. 0 )) DEALLOCATE(ZRHODREFH,ZRHS,ILISTH)
+!
+ IF (ILENALLOCR .GT. 0 ) DEALLOCATE(ZERS,ZQRS,ZLBDAR)
+ IF (ILENALLOCI .GT. 0 ) DEALLOCATE(ZEIS,ZQIS,ZCIS,ZCIT,ZLBDAI)
+ IF (ILENALLOCS .GT. 0 ) DEALLOCATE(ZESS,ZQSS,ZLBDAS)
+ IF (ILENALLOCG .GT. 0 ) DEALLOCATE(ZEGS,ZQGS,ZLBDAG)
+ IF (KRR == 7 .AND. (ILENALLOCH .GT. 0 )) DEALLOCATE(ZEHS,ZQHS,ZLBDAH)
+!
+!
+!* 2.3 budget storage
+!
+ if ( lbudget_rc .and. osedic ) &
+ call Budget_store_end( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ if ( osedic ) &
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'SEDI', pqcs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'SEDI', pqrs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'SEDI', pqis(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'SEDI', pqss(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'SEDI', pqgs(:, :, :) * prhodj(:, :, :) )
+ if ( krr == 7 ) &
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 6 ), 'SEDI', pqhs(:, :, :) * prhodj(:, :, :) )
+ end if
+!
+ END SUBROUTINE RAIN_ICE_ELEC_SEDIMENTATION_SPLIT
+!
+!-------------------------------------------------------------------------------
+!
+ SUBROUTINE RAIN_ICE_SEDIMENTATION_STAT
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!* 0.2 declaration of local variables
+!
+!
+
+REAL :: ZP1,ZP2,ZQP,ZH,ZZWLBDA,ZZWLBDC,ZZCC
+INTEGER :: JI,JJ,JK
+!
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: ZCONC3D ! droplet condensation
+!
+!-------------------------------------------------------------------------------
+ if ( lbudget_rc .and. osedic ) &
+ call Budget_store_init( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ if ( osedic ) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'SEDI', pqcs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'SEDI', pqrs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'SEDI', pqis(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'SEDI', pqss(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'SEDI', pqgs(:, :, :) * prhodj(:, :, :) )
+ if ( krr == 7 ) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 6 ), 'SEDI', pqhs(:, :, :) * prhodj(:, :, :) )
+ end if
+!
+!* 1. Parameters for cloud sedimentation
+!
+ IF (OSEDIC) THEN
+ ZRAY(:,:,:) = 0.
+ ZLBC(:,:,:) = XLBC(1)
+ ZFSEDC(:,:,:) = XFSEDC(1)
+ ZCONC3D(:,:,:) = XCONC_LAND
+ ZCONC_TMP(:,:) = XCONC_LAND
+ IF (PRESENT(PSEA)) THEN
+ ZCONC_TMP(:,:) = PSEA(:,:) * XCONC_SEA + (1. - PSEA(:,:)) * XCONC_LAND
+ DO JK = IKB, IKE
+ ZLBC(:,:,JK) = PSEA(:,:) * XLBC(2) + (1. - PSEA(:,:)) * XLBC(1)
+ ZFSEDC(:,:,JK) = (PSEA(:,:) * XFSEDC(2) + (1. - PSEA(:,:)) * XFSEDC(1))
+ ZFSEDC(:,:,JK) = MAX(MIN(XFSEDC(1),XFSEDC(2)),ZFSEDC(:,:,JK))
+ ZCONC3D(:,:,JK) = (1. - PTOWN(:,:)) * ZCONC_TMP(:,:) + PTOWN(:,:) * XCONC_URBAN
+ ZRAY(:,:,JK) = 0.5 * ((1. - PSEA(:,:)) * MOMG(XALPHAC, XNUC, 1.0) + &
+ PSEA(:,:) * MOMG(XALPHAC2, XNUC2, 1.0) )
+ END DO
+ ELSE
+ ZCONC3D(:,:,:) = XCONC_LAND
+ ZRAY(:,:,:) = 0.5 * MOMG(XALPHAC, XNUC, 1.0)
+ END IF
+ ZRAY(:,:,:) = MAX(1.,ZRAY(:,:,:))
+ ZLBC(:,:,:) = MAX(MIN(XLBC(1),XLBC(2)),ZLBC(:,:,:))
+ ENDIF
+!
+!
+!* 2. compute the fluxes
+!
+ ZRTMIN(:) = XRTMIN(:) / PTSTEP
+!
+ IF (OSEDIC) THEN
+ ZPRCS(:,:,:) = 0.0
+ ZPRCS(:,:,:) = PRCS(:,:,:) - PRCT(:,:,:) / PTSTEP
+ PRCS(:,:,:) = PRCT(:,:,:) / PTSTEP
+ END IF
+ ZPRRS(:,:,:) = 0.0
+ ZPRSS(:,:,:) = 0.0
+ ZPRGS(:,:,:) = 0.0
+ IF (KRR == 7) ZPRHS(:,:,:) = 0.0
+!
+ ZPRRS(:,:,:) = PRRS(:,:,:) - PRRT(:,:,:) / PTSTEP
+ ZPRSS(:,:,:) = PRSS(:,:,:) - PRST(:,:,:) / PTSTEP
+ ZPRGS(:,:,:) = PRGS(:,:,:) - PRGT(:,:,:) / PTSTEP
+ IF (KRR == 7) ZPRHS(:,:,:) = PRHS(:,:,:) - PRHT(:,:,:) / PTSTEP
+ PRRS(:,:,:) = PRRT(:,:,:) / PTSTEP
+ PRSS(:,:,:) = PRST(:,:,:) / PTSTEP
+ PRGS(:,:,:) = PRGT(:,:,:) / PTSTEP
+ IF (KRR == 7) PRHS(:,:,:) = PRHT(:,:,:) / PTSTEP
+!
+ IF (OSEDIC) PRCS(:,:,:) = PRCS(:,:,:) + ZPRCS(:,:,:)
+ PRRS(:,:,:) = PRRS(:,:,:) + ZPRRS(:,:,:)
+ PRSS(:,:,:) = PRSS(:,:,:) + ZPRSS(:,:,:)
+ PRGS(:,:,:) = PRGS(:,:,:) + ZPRGS(:,:,:)
+ IF (KRR == 7) PRHS(:,:,:) = PRHS(:,:,:) + ZPRHS(:,:,:)
+ DO JK = IKB, IKE
+ ZW(:,:,JK) = ZTSPLITR / (PRHODREF(:,:,JK) * (PZZ(:,:,JK+1) - PZZ(:,:,JK)))
+ END DO
+!
+!
+!* 2.1 for cloud
+!
+ IF (OSEDIC) THEN
+ PRCS(:,:,:) = PRCS(:,:,:) * PTSTEP
+ ZWSED(:,:,:) = 0.
+ ZWSEDW1(:,:,:) = 0.
+ ZWSEDW2(:,:,:) = 0.
+
+! calculation of P1, P2 and sedimentation flux
+ DO JK = IKE , IKB, -1
+ DO JJ = IJB, IJE
+ DO JI = IIB, IIE
+ ! estimation of q' taking into account incomming ZWSED
+ ZQP = ZWSED(JI,JJ,JK+1) * ZW(JI,JJ,JK)
+ ! calculation of w
+ ! mars 2009 : ajout d'un test
+ ! IF ( PRCS(JI,JJ,JK) > ZRTMIN(2) ) THEN
+ IF(PRCS(JI,JJ,JK) > ZRTMIN(2) .AND. PRCT(JI,JJ,JK) > ZRTMIN(2)) THEN
+ ZZWLBDA = 6.6E-8 * (101325. / PPABST(JI,JJ,JK)) * (PTHT(JI,JJ,JK) / 293.15)
+ ZZWLBDC = (ZLBC(JI,JJ,JK) * ZCONC3D(JI,JJ,JK) / &
+ (PRHODREF(JI,JJ,JK) * PRCT(JI,JJ,JK)))**XLBEXC
+ ZZCC = XCC * (1. + 1.26 * ZZWLBDA * ZZWLBDC / ZRAY(JI,JJ,JK)) ! ZCC: Fall speed
+ ZWSEDW1(JI,JJ,JK) = PRHODREF(JI,JJ,JK)**(-XCEXVT ) * &
+ ZZWLBDC**(-XDC) * ZZCC * ZFSEDC(JI,JJ,JK)
+ ENDIF
+ IF (ZQP > ZRTMIN(2)) THEN
+ ZZWLBDA = 6.6E-8 * (101325. / PPABST(JI,JJ,JK)) * (PTHT(JI,JJ,JK) / 293.15)
+ ZZWLBDC = (ZLBC(JI,JJ,JK) * ZCONC3D(JI,JJ,JK) / &
+ (PRHODREF(JI,JJ,JK) * ZQP))**XLBEXC
+ ZZCC = XCC * (1. + 1.26 * ZZWLBDA * ZZWLBDC / ZRAY(JI,JJ,JK)) ! ZCC: Fall speed
+ ZWSEDW2(JI,JJ,JK) = PRHODREF(JI,JJ,JK)**(-XCEXVT ) * &
+ ZZWLBDC**(-XDC) * ZZCC * ZFSEDC(JI,JJ,JK)
+ ENDIF
+ ENDDO
+ DO JI = IIB, IIE
+ ZH = PZZ(JI,JJ,JK+1) - PZZ(JI,JJ,JK)
+ ZP1 = MIN(1., ZWSEDW1(JI,JJ,JK) * PTSTEP / ZH)
+ ! mars 2009 : correction : ZWSEDW1 => ZWSEDW2
+ !IF (ZWSEDW1(JI,JJ,JK) /= 0.) THEN
+ IF (ZWSEDW2(JI,JJ,JK) /= 0.) THEN
+ ZP2 = MAX(0., 1. - ZH / (PTSTEP * ZWSEDW2(JI,JJ,JK)) )
+ ELSE
+ ZP2 = 0.
+ ENDIF
+ ZWSED(JI,JJ,JK) = ZP1 * PRHODREF(JI,JJ,JK) * &
+ (PZZ(JI,JJ,JK+1) - PZZ(JI,JJ,JK)) * PRCS(JI,JJ,JK) / &
+ PTSTEP + ZP2 * ZWSED (JI,JJ,JK+1)
+ ENDDO
+ ENDDO
+ ENDDO
+!
+ DO JK = IKB , IKE
+ PRCS(:,:,JK) = PRCS(:,:,JK) + ZW(:,:,JK) * (ZWSED(:,:,JK+1) - ZWSED(:,:,JK))
+ END DO
+
+ PINPRC(:,:) = ZWSED(:,:,IKB) / XRHOLW ! in m/s
+ PRCS(:,:,:) = PRCS(:,:,:) / PTSTEP
+ ENDIF
+!
+!
+!* 2.2 for rain
+!
+ PRRS(:,:,:) = PRRS(:,:,:) * PTSTEP
+ ZWSED(:,:,:) = 0.
+ ZWSEDW1(:,:,:) = 0.
+ ZWSEDW2(:,:,:) = 0.
+!
+! calculation of ZP1, ZP2 and sedimentation flux
+ DO JK = IKE , IKB, -1
+ DO JJ = IJB, IJE
+ DO JI = IIB, IIE
+ ! estimation of q' taking into account incomming ZWSED
+ ZQP = ZWSED(JI,JJ,JK+1) * ZW(JI,JJ,JK)
+ ! calculation of w
+ IF (PRRS(JI,JJ,JK) > ZRTMIN(3)) THEN
+ ZWSEDW1 (JI,JJ,JK) = XFSEDR * PRRS(JI,JJ,JK)**(XEXSEDR-1) * &
+ PRHODREF(JI,JJ,JK)**(XEXSEDR-XCEXVT-1)
+ ENDIF
+ IF (ZQP > ZRTMIN(3)) THEN
+ ZWSEDW2(JI,JJ,JK) = XFSEDR * (ZQP)**(XEXSEDR-1) * &
+ PRHODREF(JI,JJ,JK)**(XEXSEDR-XCEXVT-1)
+ ENDIF
+ ENDDO
+ DO JI = IIB, IIE
+ ZH = PZZ(JI,JJ,JK+1) - PZZ(JI,JJ,JK)
+ ZP1 = MIN(1., ZWSEDW1(JI,JJ,JK) * PTSTEP / ZH )
+ IF (ZWSEDW2(JI,JJ,JK) /= 0.) THEN
+ ZP2 = MAX(0., 1 - ZH / (PTSTEP * ZWSEDW2(JI,JJ,JK)) )
+ ELSE
+ ZP2 = 0.
+ ENDIF
+ ZWSED(JI,JJ,JK) = ZP1 * PRHODREF(JI,JJ,JK) * &
+ ZH * PRRS(JI,JJ,JK) / &
+ PTSTEP + ZP2 * ZWSED (JI,JJ,JK+1)
+ ENDDO
+ ENDDO
+ ENDDO
+
+ DO JK = IKB , IKE
+ PRRS(:,:,JK) = PRRS(:,:,JK) + ZW(:,:,JK) * (ZWSED(:,:,JK+1) - ZWSED(:,:,JK))
+ ENDDO
+ PINPRR(:,:) = ZWSED(:,:,IKB) / XRHOLW ! in m/s
+ PINPRR3D(:,:,:) = ZWSED(:,:,:) / XRHOLW ! in m/s
+ PRRS(:,:,:) = PRRS(:,:,:) / PTSTEP
+!
+!
+!* 2.3 for pristine ice
+!
+ PRIS(:,:,:) = PRIS(:,:,:) * PTSTEP
+ ZWSED(:,:,:) = 0.
+ ZWSEDW1(:,:,:) = 0.
+ ZWSEDW2(:,:,:) = 0.
+! calculation of ZP1, ZP2 and sedimentation flux
+ DO JK = IKE , IKB, -1
+ DO JJ = IJB, IJE
+ DO JI = IIB, IIE
+ ! estimation of q' taking into account incomming ZWSED
+ ZQP = ZWSED(JI,JJ,JK+1) * ZW(JI,JJ,JK)
+ ! calculation of w
+ IF (PRIS(JI,JJ,JK) > MAX(ZRTMIN(4),1.0E-7)) THEN
+ ZWSEDW1(JI,JJ,JK) = XFSEDI * &
+ PRHODREF(JI,JJ,JK)**(XCEXVT) * & ! McF&H
+ MAX(0.05E6,-0.15319E6-0.021454E6* &
+ ALOG(PRHODREF(JI,JJ,JK)*PRIS(JI,JJ,JK)))**XEXCSEDI
+ ENDIF
+ IF (ZQP > MAX(ZRTMIN(4),1.0E-7)) THEN
+ ZWSEDW2(JI,JJ,JK)= XFSEDI * &
+ PRHODREF(JI,JJ,JK)**(XCEXVT) * & ! McF&H
+ MAX( 0.05E6,-0.15319E6-0.021454E6* &
+ ALOG(PRHODREF(JI,JJ,JK)*ZQP) )**XEXCSEDI
+ ENDIF
+ ENDDO
+ DO JI = IIB, IIE
+ ZH = PZZ(JI,JJ,JK+1) - PZZ(JI,JJ,JK)
+ ZP1 = MIN(1., ZWSEDW1(JI,JJ,JK) * PTSTEP / ZH )
+ IF (ZWSEDW2(JI,JJ,JK) /= 0.) THEN
+ ZP2 = MAX(0.,1 - ZH / (PTSTEP * ZWSEDW2(JI,JJ,JK)))
+ ELSE
+ ZP2 = 0.
+ ENDIF
+ ZWSED(JI,JJ,JK) = ZP1 * PRHODREF(JI,JJ,JK) * &
+ (PZZ(JI,JJ,JK+1) - PZZ(JI,JJ,JK)) * PRIS(JI,JJ,JK) / &
+ PTSTEP + ZP2 * ZWSED(JI,JJ,JK+1)
+ ENDDO
+ ENDDO
+ ENDDO
+!
+ DO JK = IKB , IKE
+ PRIS(:,:,JK) = PRIS(:,:,JK) + ZW(:,:,JK) * (ZWSED(:,:,JK+1) - ZWSED(:,:,JK))
+ ENDDO
+!
+ PRIS(:,:,:) = PRIS(:,:,:) / PTSTEP
+!
+!
+!* 2.4 for aggregates/snow
+!
+ PRSS(:,:,:) = PRSS(:,:,:) * PTSTEP
+ ZWSED(:,:,:) = 0.
+ ZWSEDW1(:,:,:) = 0.
+ ZWSEDW2(:,:,:) = 0.
+
+! calculation of ZP1, ZP2 and sedimentation flux
+ DO JK = IKE , IKB, -1
+ DO JJ = IJB, IJE
+ DO JI = IIB, IIE
+ ! estimation of q' taking into account incomming ZWSED
+ ZQP = ZWSED(JI,JJ,JK+1) * ZW(JI,JJ,JK)
+ ! calculation of w
+ IF (PRSS(JI,JJ,JK) > ZRTMIN(5)) THEN
+ ZWSEDW1(JI,JJ,JK) = XFSEDS * (PRSS(JI,JJ,JK))**(XEXSEDS-1) * &
+ PRHODREF(JI,JJ,JK)**(XEXSEDS-XCEXVT-1)
+ ENDIF
+ IF (ZQP > ZRTMIN(5)) THEN
+ ZWSEDW2(JI,JJ,JK) = XFSEDS * (ZQP)**(XEXSEDS-1) * &
+ PRHODREF(JI,JJ,JK)**(XEXSEDS-XCEXVT-1)
+ ENDIF
+ ENDDO
+ DO JI = IIB, IIE
+ ZH = PZZ(JI,JJ,JK+1) - PZZ(JI,JJ,JK)
+ ZP1 = MIN(1., ZWSEDW1(JI,JJ,JK) * PTSTEP / ZH )
+ IF (ZWSEDW2(JI,JJ,JK) /= 0.) THEN
+ ZP2 = MAX(0.,1 - ZH / (PTSTEP * ZWSEDW2(JI,JJ,JK)) )
+ ELSE
+ ZP2 = 0.
+ ENDIF
+ ZWSED(JI,JJ,JK) = ZP1 * PRHODREF(JI,JJ,JK) * &
+ ZH * PRSS(JI,JJ,JK) / &
+ PTSTEP + ZP2 * ZWSED(JI,JJ,JK+1)
+ ENDDO
+ ENDDO
+ ENDDO
+!
+ DO JK = IKB , IKE
+ PRSS(:,:,JK) = PRSS(:,:,JK) + ZW(:,:,JK) * (ZWSED(:,:,JK+1) - ZWSED(:,:,JK))
+ ENDDO
+!
+ PINPRS(:,:) = ZWSED(:,:,IKB) / XRHOLW ! in m/s
+ PRSS(:,:,:) = PRSS(:,:,:) / PTSTEP
+!
+!
+!
+!* 2.5 for graupeln
+!
+ PRGS(:,:,:) = PRGS(:,:,:) * PTSTEP
+ ZWSED(:,:,:) = 0.
+ ZWSEDW1(:,:,:) = 0.
+ ZWSEDW2(:,:,:) = 0.
+
+! calculation of ZP1, ZP2 and sedimentation flux
+ DO JK = IKE , IKB, -1
+ DO JJ = IJB, IJE
+ DO JI = IIB, IIE
+ ! estimation of q' taking into account incomming ZWSED
+ ZQP = ZWSED(JI,JJ,JK+1) * ZW(JI,JJ,JK)
+ ! calculation of w
+ IF (PRGS(JI,JJ,JK) > ZRTMIN(6)) THEN
+ ZWSEDW1(JI,JJ,JK) = XFSEDG * (PRGS(JI,JJ,JK))**(XEXSEDG-1) * &
+ PRHODREF(JI,JJ,JK)**(XEXSEDG-XCEXVT-1)
+ ENDIF
+ IF (ZQP > ZRTMIN(6)) THEN
+ ZWSEDW2(JI,JJ,JK) = XFSEDG * (ZQP)**(XEXSEDG-1) * &
+ PRHODREF(JI,JJ,JK)**(XEXSEDG-XCEXVT-1)
+ ENDIF
+ ENDDO
+ DO JI = IIB, IIE
+ ZH = PZZ(JI,JJ,JK+1) - PZZ(JI,JJ,JK)
+ ZP1 = MIN(1., ZWSEDW1(JI,JJ,JK) * PTSTEP / ZH )
+ IF (ZWSEDW2(JI,JJ,JK) /= 0.) THEN
+ ZP2 = MAX(0.,1 - ZH / (PTSTEP * ZWSEDW2(JI,JJ,JK)) )
+ ELSE
+ ZP2 = 0.
+ ENDIF
+ ZWSED(JI,JJ,JK) = ZP1 * PRHODREF(JI,JJ,JK) * &
+ ZH * PRGS(JI,JJ,JK) / &
+ PTSTEP + ZP2 * ZWSED(JI,JJ,JK+1)
+ ENDDO
+ ENDDO
+ ENDDO
+!
+ DO JK = IKB , IKE
+ PRGS(:,:,JK) = PRGS(:,:,JK) + ZW(:,:,JK) * (ZWSED(:,:,JK+1) - ZWSED(:,:,JK))
+ ENDDO
+
+ PINPRG(:,:) = ZWSED(:,:,IKB) / XRHOLW ! in m/s
+ PRGS(:,:,:) = PRGS(:,:,:) / PTSTEP
+!
+!
+!* 2.6 for hail
+!
+ IF (KRR == 7) THEN
+ PRHS(:,:,:) = PRHS(:,:,:) * PTSTEP
+ ZWSED(:,:,:) = 0.
+ ZWSEDW1(:,:,:) = 0.
+ ZWSEDW2(:,:,:) = 0.
+! calculation of ZP1, ZP2 and sedimentation flux
+ DO JK = IKE , IKB, -1
+ DO JJ = IJB, IJE
+ DO JI = IIB, IIE
+ ! estimation of q' taking into account incomming ZWSED
+ ZQP = ZWSED(JI,JJ,JK+1) * ZW(JI,JJ,JK)
+ ! calculation of w
+ IF ((PRHS(JI,JJ,JK)+ZQP) > ZRTMIN(7) ) THEN
+ ZWSEDW1 (JI,JJ,JK) = XFSEDH * (PRHS(JI,JJ,JK))**(XEXSEDH-1) * &
+ PRHODREF(JI,JJ,JK)**(XEXSEDH-XCEXVT-1)
+ ENDIF
+ IF (ZQP > ZRTMIN(7)) THEN
+ ZWSEDW2(JI,JJ,JK) = XFSEDH * ZQP**(XEXSEDH-1) * &
+ PRHODREF(JI,JJ,JK)**(XEXSEDH-XCEXVT-1)
+ ENDIF
+ ENDDO
+ DO JI = IIB, IIE
+ ZH = PZZ(JI,JJ,JK+1) - PZZ(JI,JJ,JK)
+ ZP1 = MIN(1., ZWSEDW1(JI,JJ,JK) * PTSTEP / ZH)
+ IF (ZWSEDW2(JI,JJ,JK) /= 0.) THEN
+ ZP2 = MAX(0.,1 - ZH / (PTSTEP*ZWSEDW2(JI,JJ,JK)))
+ ELSE
+ ZP2 = 0.
+ ENDIF
+ ZWSED(JI,JJ,JK) = ZP1 * PRHODREF(JI,JJ,JK) * &
+ ZH * PRHS(JI,JJ,JK) / &
+ PTSTEP + ZP2 * ZWSED(JI,JJ,JK+1)
+ ENDDO
+ ENDDO
+ ENDDO
+!
+ DO JK = IKB , IKE
+ PRHS(:,:,JK) = PRHS(:,:,JK) + ZW(:,:,JK) * (ZWSED(:,:,JK+1) - ZWSED(:,:,JK))
+ ENDDO
+!
+ PINPRH(:,:) = ZWSED(:,:,IKB) / XRHOLW ! in m/s
+ PRHS(:,:,:) = PRHS(:,:,:) / PTSTEP
+ ENDIF
+!
+!
+!* 2.3 budget storage
+!
+ if ( lbudget_rc .and. osedic ) &
+ call Budget_store_end( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ if ( osedic ) &
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'SEDI', pqcs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'SEDI', pqrs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'SEDI', pqis(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'SEDI', pqss(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'SEDI', pqgs(:, :, :) * prhodj(:, :, :) )
+ if ( krr == 7 ) &
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 6 ), 'SEDI', pqhs(:, :, :) * prhodj(:, :, :) )
+ end if
+!
+ END SUBROUTINE RAIN_ICE_SEDIMENTATION_STAT
+!
+!-------------------------------------------------------------------------------
+!
+!
+ SUBROUTINE RAIN_ICE_ELEC_NUCLEATION
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!* 0.2 declaration of local variables
+!
+INTEGER , DIMENSION(SIZE(GNEGT)) :: I1,I2,I3 ! Used to replace the COUNT
+INTEGER :: JL ! and PACK intrinsics
+!
+!-------------------------------------------------------------------------------
+!
+! compute the temperature and the pressure
+!
+ZT(:,:,:) = PTHT(:,:,:) * (PPABST(:,:,:) / XP00) ** (XRD / XCPD)
+!
+! optimization by looking for locations where
+! the temperature is negative only !!!
+!
+GNEGT(:,:,:) = .FALSE.
+GNEGT(IIB:IIE,IJB:IJE,IKB:IKE) = ZT(IIB:IIE,IJB:IJE,IKB:IKE) < XTT
+INEGT = COUNTJV( GNEGT(:,:,:),I1(:),I2(:),I3(:))
+!
+IF( INEGT >= 1 ) THEN
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HENU', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'HENU', prvs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'HENU', pris(:, :, :) * prhodj(:, :, :) )
+
+ ALLOCATE(ZRVT(INEGT))
+ ALLOCATE(ZCIT(INEGT))
+ ALLOCATE(ZZT(INEGT))
+ ALLOCATE(ZPRES(INEGT))
+ DO JL = 1, INEGT
+ ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL))
+ ZCIT(JL) = PCIT(I1(JL),I2(JL),I3(JL))
+ ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
+ ZPRES(JL) = PPABST(I1(JL),I2(JL),I3(JL))
+ ENDDO
+ ALLOCATE(ZZW(INEGT))
+ ALLOCATE(ZUSW(INEGT))
+ ALLOCATE(ZSSI(INEGT))
+ ZZW(:) = EXP(XALPI - XBETAI / ZZT(:) - XGAMI * ALOG(ZZT(:))) ! es_i
+ ZZW(:) = MIN(ZPRES(:) / 2., ZZW(:)) ! safety limitation
+ ZSSI(:) = ZRVT(:) * (ZPRES(:) - ZZW(:)) / ((XMV / XMD) * ZZW(:)) - 1.0
+ ! Supersaturation over ice
+ ZUSW(:) = EXP(XALPW - XBETAW / ZZT(:) - XGAMW * ALOG(ZZT(:))) ! es_w
+ ZUSW(:) = MIN(ZPRES(:) / 2., ZUSW(:)) ! safety limitation
+ ZUSW(:) = (ZUSW(:) / ZZW(:)) * ((ZPRES(:) - ZZW(:)) / (ZPRES(:) - ZUSW(:))) - 1.0
+ ! Supersaturation of saturated water vapor over ice
+!
+!* 3.1 compute the heterogeneous nucleation source: RVHENI
+!
+!* 3.1.1 compute the cloud ice concentration
+!
+ ZZW(:) = 0.0
+ ZSSI(:) = MIN( ZSSI(:), ZUSW(:) ) ! limitation of SSi according to SSw=0
+!
+ WHERE ((ZZT(:) < XTT-5.0) .AND. (ZSSI(:) > 0.0))
+ ZZW(:) = XNU20 * EXP(XALPHA2 * ZSSI(:) - XBETA2)
+ END WHERE
+ WHERE ((ZZT(:) <= XTT-2.0) .AND. (ZZT(:) >= XTT-5.0) .AND. (ZSSI(:) > 0.0))
+ ZZW(:) = MAX(XNU20 * EXP(-XBETA2), XNU10 * EXP(-XBETA1 * (ZZT(:) - XTT)) * &
+ (ZSSI(:) / ZUSW(:))**XALPHA1 )
+ END WHERE
+ ZZW(:) = ZZW(:) - ZCIT(:)
+!
+ IF( MAXVAL(ZZW(:)) > 0.0 ) THEN
+!
+!* 3.1.2 update the r_i and r_v mixing ratios
+!
+ ZZW(:) = MIN(ZZW(:), 50.E3) ! limitation provisoire a 50 l^-1
+ ZW(:,:,:) = UNPACK(ZZW(:), MASK=GNEGT(:,:,:), FIELD=0.0)
+ ZW(:,:,:) = MAX(ZW(:,:,:), 0.0) * XMNU0 / (PRHODREF(:,:,:) * PTSTEP)
+ PRIS(:,:,:) = PRIS(:,:,:) + ZW(:,:,:)
+ PRVS(:,:,:) = PRVS(:,:,:) - ZW(:,:,:)
+ IF (KRR == 7) THEN
+ PTHS(:,:,:) = PTHS(:,:,:) + &
+ ZW(:,:,:) * (XLSTT + (XCPV - XCI) * (ZT(:,:,:) - XTT)) / &
+ ((XCPD + XCPV * PRVT(:,:,:) + XCL * (PRCT(:,:,:) + PRRT(:,:,:)) + &
+ XCI * (PRIT(:,:,:) + PRST(:,:,:) + PRGT(:,:,:) + PRHT(:,:,:))) * &
+ PEXNREF(:,:,:))
+ ELSE IF(KRR == 6) THEN
+ PTHS(:,:,:) = PTHS(:,:,:) + &
+ ZW(:,:,:) * (XLSTT + (XCPV - XCI) * (ZT(:,:,:) - XTT)) / &
+ ((XCPD + XCPV * PRVT(:,:,:) + XCL * (PRCT(:,:,:) + PRRT(:,:,:)) + &
+ XCI * (PRIT(:,:,:) + PRST(:,:,:) + PRGT(:,:,:))) * PEXNREF(:,:,:))
+ END IF
+! f(L_s*(RVHENI))
+ ZZW(:) = MAX( ZZW(:)+ZCIT(:),ZCIT(:) )
+ PCIT(:,:,:) = MAX( UNPACK( ZZW(:),MASK=GNEGT(:,:,:),FIELD=0.0 ) , &
+ PCIT(:,:,:) )
+ END IF
+ DEALLOCATE(ZSSI)
+ DEALLOCATE(ZUSW)
+ DEALLOCATE(ZZW)
+ DEALLOCATE(ZPRES)
+ DEALLOCATE(ZZT)
+ DEALLOCATE(ZCIT)
+ DEALLOCATE(ZRVT)
+
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HENU', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'HENU', prvs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'HENU', pris(:, :, :) * prhodj(:, :, :) )
+
+END IF
+
+ END SUBROUTINE RAIN_ICE_ELEC_NUCLEATION
+!
+!-------------------------------------------------------------------------------
+!
+ SUBROUTINE RAIN_ICE_ELEC_SLOW
+!
+!* 0. DECLARATIONS
+! ------------
+USE MODD_CST, ONLY : XMNH_HUGE_12_LOG
+!
+IMPLICIT NONE
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 3.5.1 compute the homogeneous nucleation source: RCHONI & QCHONI
+!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'HON', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'HON', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ ZZW(:) = 0.0
+ ZWQ1(:,1:7) = 0.0
+!
+ WHERE( ABS(ZECT(:)) <= XECMIN)
+ ZECT(:) = 0.
+ ENDWHERE
+!
+ WHERE( (ZZT(:)<XTT-35.0) .AND. (ZRCT(:)>XRTMIN(2)) .AND. (ZRCS(:)>0.) )
+ ZZW(:) = MIN( ZRCS(:),XHON*ZRHODREF(:)*ZRCT(:) &
+ *EXP( MIN(XMNH_HUGE_12_LOG,XALPHA3*(ZZT(:)-XTT)-XBETA3) ) )
+ ZRIS(:) = ZRIS(:) + ZZW(:)
+ ZRCS(:) = ZRCS(:) - ZZW(:)
+ ZTHS(:) = ZTHS(:) + ZZW(:)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(RCHONI))
+ ZWQ1(:,1) = XQHON * ZECT(:) * ZZW(:) ! QCHONI
+ ENDWHERE
+!
+ WHERE (ZZT(:) < (XTT - 35.) .AND. ZRIS(:) > ZRSMIN_ELEC(4) .AND. &
+ ZRCT(:) > XRTMIN_ELEC(2) .AND. ZRCS(:) > ZRSMIN_ELEC(2) .AND. &
+ ABS(ZQCS(:)) > XQTMIN(2) .AND. ABS(ZECT(:)) > XECMIN)
+ ZWQ1(:,1) = SIGN( MIN( ABS(ZQCS(:)),ABS(ZWQ1(:,1)) ),ZQCS(:) )
+ ZQIS(:) = ZQIS(:) + ZWQ1(:,1)
+ ZQCS(:) = ZQCS(:) - ZWQ1(:,1)
+ END WHERE
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HON', Unpack( zzw(:) * ( zlsfact(:) - zlvfact(:) ) &
+ * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'HON', &
+ Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HON', &
+ Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'HON', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'HON', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+!
+!* 3.5.2 compute the spontaneous freezing source: RRHONG & QRHONG
+!
+ ZZW(:) = 0.0
+!
+ WHERE( (ZZT(:)<XTT-35.0) .AND. (ZRRT(:)>XRTMIN(3)) .AND. (ZRRS(:)>0.) )
+ ZZW(:) = MIN( ZRRS(:),ZRRT(:)/PTSTEP )
+ ZRGS(:) = ZRGS(:) + ZZW(:)
+ ZRRS(:) = ZRRS(:) - ZZW(:)
+ ZTHS(:) = ZTHS(:) + ZZW(:)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(RRHONG))
+ ENDWHERE
+!
+ WHERE (ZZT(:) < (XTT - 35.) .AND. &
+ ZRRT(:) > XRTMIN_ELEC(3) .AND. ZRRS(:) > ZRSMIN_ELEC(3) .AND. &
+ ZRGS(:) > ZRSMIN_ELEC(6) .AND. ABS(ZQRT(:)) > XQTMIN(3))
+ ZWQ1(:,2) = SIGN( MIN( ABS(ZQRS(:)),ABS(ZQRT(:)/PTSTEP) ),ZQRS(:) ) ! QRHONG
+ ZQGS(:) = ZQGS(:) + ZWQ1(:,2)
+ ZQRS(:) = ZQRS(:) - ZWQ1(:,2)
+ ENDWHERE
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'SFR', Unpack( zzw(:) * ( zlsfact(:) - zlvfact(:) ) &
+ * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'SFR', &
+ Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'SFR', &
+ Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'SFR', &
+ Unpack( -zwq1(:, 2) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'SFR', &
+ Unpack( zwq1(:, 2) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+!
+!* 3.5.3 compute the deposition, aggregation and autoconversion sources
+!
+ ZKA(:) = 2.38E-2 + 0.0071E-2 * ( ZZT(:) - XTT ) ! k_a
+ ZDV(:) = 0.211E-4 * (ZZT(:)/XTT)**1.94 * (XP00/ZPRES(:)) ! D_v
+!
+!* 3.5.3.1 compute the thermodynamical function A_i(T,P)
+!* and the c^prime_j (in the ventilation factor)
+!
+ ZAI(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) ) ! es_i
+ ZAI(:) = ( XLSTT + (XCPV-XCI)*(ZZT(:)-XTT) )**2 / (ZKA(:)*XRV*ZZT(:)**2) &
+ + ( XRV*ZZT(:) ) / (ZDV(:)*ZAI(:))
+ ZCJ(:) = XSCFAC * ZRHODREF(:)**0.3 / SQRT( 1.718E-5+0.0049E-5*(ZZT(:)-XTT) )
+!
+!* 3.5.3.2 compute the riming-conversion of r_c for r_i production: RCAUTI
+!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'DEPS', &
+ Unpack( zqpis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'DEPS', &
+ Unpack( zqnis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'DEPS', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ ZZW(:) = 0.0
+!
+ WHERE ((ZRST(:) > XRTMIN(5)) .AND. (ZRSS(:) > 0.0))
+ ZZW(:) = ( ZSSI(:)/(ZRHODREF(:)*ZAI(:)) ) * &
+ ( X0DEPS*ZLBDAS(:)**XEX0DEPS + X1DEPS*ZCJ(:)*ZLBDAS(:)**XEX1DEPS )
+ ZZW(:) = MIN( ZRVS(:),ZZW(:) ) * (0.5 + SIGN(0.5,ZZW(:))) &
+ - MIN( ZRSS(:),ABS(ZZW(:)) ) * (0.5 - SIGN(0.5,ZZW(:)))
+ ZRSS(:) = ZRSS(:) + ZZW(:)
+ ZRVS(:) = ZRVS(:) - ZZW(:)
+ ZTHS(:) = ZTHS(:) + ZZW(:)*ZLSFACT(:)
+ ZWQ1(:,5) = XCOEF_RQ_S * ZQST(:) * (-ZZW(:)) / ZRST(:) ! sublimation
+ END WHERE
+!
+ WHERE (ZRST(:) > XRTMIN_ELEC(5) .AND. ZRSS(:) > ZRSMIN_ELEC(5) .AND. &
+ ZRVS(:) > ZRSMIN_ELEC(1) .AND. ABS(ZQST(:)) > XQTMIN(5) .AND. &
+ ZZW(:) < 0. .AND. (-ZZW(:) <= ZRSS(:)))
+ ZWQ1(:,5) = SIGN( MIN( ABS(ZQSS(:)),ABS(ZWQ1(:,5)) ),ZQSS(:) )
+ ZQSS(:) = ZQSS(:) - ZWQ1(:,5)
+ ZQPIS(:) = ZQPIS(:) + MAX( 0.0,ZWQ1(:,5)/XECHARGE )
+ ZQNIS(:) = ZQNIS(:) - MIN( 0.0,ZWQ1(:,5)/XECHARGE )
+ ENDWHERE
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'DEPS', Unpack( zzw(:) * zlsfact(:) &
+ * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'DEPS', &
+ Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'DEPS', &
+ Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'DEPS', &
+ Unpack( zqpis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'DEPS', &
+ Unpack( zqnis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'DEPS', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+!
+!* 3.5.3.4 compute the aggregation on r_s: RIAGGS & QIAGGS
+!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'AGGS', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'AGGS', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ ZZW(:) = 0.0
+ ZLATHAMIAGGS(:) = 1.0
+ IF (LIAGGS_LATHAM) THEN
+ ZLATHAMIAGGS(:) = 1.0 + 0.4E-10 * MIN( 2.25E10, &
+ ZEFIELDU(:)**2+ZEFIELDV(:)**2+ZEFIELDW(:)**2 )
+ ENDIF
+!
+ WHERE (ZRIT(:) > XRTMIN(4) .AND. ZRST(:) > XRTMIN(5) .AND. ZRIS(:) > 0.0)
+ ZZW(:) = MIN( ZRIS(:),XFIAGGS * EXP( XCOLEXIS*(ZZT(:)-XTT) ) &
+ * ZLATHAMIAGGS(:) &
+ * ZRIT(:) &
+ * ZLBDAS(:)**XEXIAGGS &
+ * ZRHOCOR(:) / ZCOR00 )
+ ZRSS(:) = ZRSS(:) + ZZW(:)
+ ZRIS(:) = ZRIS(:) - ZZW(:)
+ ZWQ1(:,3) = XCOEF_RQ_I * ZZW(:) * ZQIT(:) / ZRIT(:) ! QIAGGS_coal
+ END WHERE
+!
+ WHERE (ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRIS(:) > ZRSMIN_ELEC(4) .AND. &
+ ZRSS(:) > ZRSMIN_ELEC(5) .AND. ABS(ZQIT(:)) > XQTMIN(4))
+ ZWQ1(:,3) = SIGN( MIN( ABS(ZQIS(:)),ABS(ZWQ1(:,3)) ),ZQIS(:) )
+ ZQSS(:) = ZQSS(:) + ZWQ1(:,3)
+ ZQIS(:) = ZQIS(:) - ZWQ1(:,3)
+ END WHERE
+
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'AGGS', &
+ Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'AGGS', &
+ Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'AGGS', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'AGGS', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'NIIS', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'NIIS', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ CALL ELEC_IAGGS_B() ! QIAGGS_boun
+
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'NIIS', &
+ Unpack( zqis(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'NIIS', &
+ Unpack( zqss(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+! Save the NI charging rate for temporal series
+ XNI_IAGGS(:,:,:) = UNPACK(ZWQ1(:,7), MASK=GMICRO, FIELD=0.0)
+ XNI_IAGGS(:,:,:) = XNI_IAGGS(:,:,:) * PRHODREF(:,:,:) ! C/m3/s
+!
+!* 3.5.3.5 compute the autoconversion of r_i for r_s production:
+! RIAUTS & QIAUTS
+!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'AUTS', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'AUTS', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ ALLOCATE( ZCRIAUTI(IMICRO ))
+ ZCRIAUTI(:) = MIN(XCRIAUTI,10**(0.06*(ZZT(:)-XTT)-3.5))
+ ZZW(:) = 0.0
+!
+ WHERE ((ZRIT(:) > XRTMIN(4)) .AND. (ZRIS(:) > 0.0))
+ ZZW(:) = MIN( ZRIS(:),XTIMAUTI * EXP( XTEXAUTI*(ZZT(:)-XTT) ) &
+ * MAX( ZRIT(:)-ZCRIAUTI(:),0.0 ) )
+ ZRSS(:) = ZRSS(:) + ZZW(:)
+ ZRIS(:) = ZRIS(:) - ZZW(:)
+ ZWQ1(:,4) = XCOEF_RQ_I * ZQIT(:) * ZZW(:) / ZRIT(:) ! QIAUTS
+ END WHERE
+!
+ WHERE (ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRIS(:) > ZRSMIN_ELEC(4) .AND. &
+ ZRSS(:) > ZRSMIN_ELEC(5) .AND. ABS(ZQIT(:)) > XQTMIN(4))
+ ZWQ1(:,4) = SIGN( MIN( ABS(ZQIS(:)),ABS(ZWQ1(:,4)) ),ZQIS(:) )
+ ZQSS(:) = ZQSS(:) + ZWQ1(:,4)
+ ZQIS(:) = ZQIS(:) - ZWQ1(:,4)
+ END WHERE
+!
+ DEALLOCATE(ZCRIAUTI)
+
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'AUTS', &
+ Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'AUTS', &
+ Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'AUTS', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'AUTS', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+!
+!* 3.5.3.6 compute the deposition on r_g: RVDEPG & QVDEPG
+!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'DEPG', &
+ Unpack( zqpis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'DEPG', &
+ Unpack( zqnis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'DEPG', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ ZZW(:) = 0.0
+!
+ WHERE ((ZRGT(:) > XRTMIN(6)) .AND. (ZRGS(:) > 0.0))
+ ZZW(:) = (ZSSI(:) / (ZRHODREF(:) * ZAI(:))) * &
+ (X0DEPG * ZLBDAG(:)**XEX0DEPG + X1DEPG * ZCJ(:) * ZLBDAG(:)**XEX1DEPG)
+ ZZW(:) = MIN( ZRVS(:),ZZW(:) )*(0.5+SIGN(0.5,ZZW(:))) &
+ - MIN( ZRGS(:),ABS(ZZW(:)) )*(0.5-SIGN(0.5,ZZW(:)))
+ ZRGS(:) = ZRGS(:) + ZZW(:)
+ ZRVS(:) = ZRVS(:) - ZZW(:)
+ ZTHS(:) = ZTHS(:) + ZZW(:)*ZLSFACT(:)
+ ZWQ1(:,6) = XCOEF_RQ_G * ZQGT(:) * (-ZZW(:)) / ZRGT(:) ! sublimation
+ END WHERE
+!
+ WHERE (ZRGT(:) > XRTMIN_ELEC(6) .AND. ZRGS(:) > ZRSMIN_ELEC(6) .AND. &
+ ZRVS(:) > ZRSMIN_ELEC(1) .AND. ABS(ZQGT(:)) > XQTMIN(6) .AND. &
+ ZZW(:) < 0. .AND. (-ZZW(:)) <= ZRGS(:))
+ ZWQ1(:,6) = SIGN( MIN( ABS(ZQGS(:)),ABS(ZWQ1(:,6)) ),ZQGS(:) )
+ ZQGS(:) = ZQGS(:) - ZWQ1(:,6)
+ ZQPIS(:) = ZQPIS(:) + MAX( 0.0,ZWQ1(:,6)/XECHARGE )
+ ZQNIS(:) = ZQNIS(:) - MIN( 0.0,ZWQ1(:,6)/XECHARGE )
+ END WHERE
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'DEPG', Unpack( zzw(:) * zlsfact(:) &
+ * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'DEPG', &
+ Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'DEPG', &
+ Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'DEPG', &
+ Unpack( zqpis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'DEPG', &
+ Unpack( zqnis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'DEPG', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ END SUBROUTINE RAIN_ICE_ELEC_SLOW
+!
+!-------------------------------------------------------------------------------
+!
+!
+ SUBROUTINE RAIN_ICE_ELEC_WARM
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+REAL :: ZCRIAUTC ! Critical cloud mixing ratio
+!
+!-------------------------------------------------------------------------------
+!
+!* 4.1 compute the autoconversion of r_c for r_r production:
+! RCAUTR & QCAUTR
+!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'AUTO', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'AUTO', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ ZZW(:) = 0.0
+ ZWQ1(:,1:3) = 0.0
+!
+ IF ( HSUBG_AUCV == 'CLFR' ) THEN
+ WHERE ((ZRCT(:) > 0.0) .AND. (ZRCS(:) > 0.0) .AND. (ZCF(:) > 0.0))
+ ZZW(:) = XTIMAUTC * MAX( ZRCT(:)/(ZCF(:)) -XCRIAUTC/ZRHODREF(:),0.0)
+ ZZW(:) = MIN( ZRCS(:),(ZCF(:))*ZZW(:))
+ ZRCS(:) = ZRCS(:) - ZZW(:)
+ ZRRS(:) = ZRRS(:) + ZZW(:)
+ ZWQ1(:,1) = XCOEF_RQ_C * ZQCT(:) * ZZW(:) / ZRCT(:) ! QCAUTR
+ END WHERE
+ ELSE IF (HSUBG_AUCV == 'SIGM') THEN
+ DO JL = 1, IMICRO
+ IF (ZRCS(JL) > 0.0) THEN
+ ZCRIAUTC = XCRIAUTC / ZRHODREF(JL)
+ IF (ZRCT(JL) > (ZCRIAUTC + ZSIGMA_RC(JL))) THEN
+ ZZW(JL) = MIN( ZRCS(JL) , XTIMAUTC* ( ZRCT(JL)-ZCRIAUTC ) )
+ ELSEIF (ZRCT(JL) > (ZCRIAUTC - ZSIGMA_RC(JL)) .AND. &
+ ZRCT(JL) <= (ZCRIAUTC + ZSIGMA_RC(JL))) THEN
+ ZZW(JL) = MIN( ZRCS(JL) , XTIMAUTC*( ZRCT(JL)+ZSIGMA_RC(JL)-ZCRIAUTC )**2 &
+ /( 4. * ZSIGMA_RC(JL) ) )
+ ENDIF
+ ZRCS(JL) = ZRCS(JL) - ZZW(JL)
+ ZRRS(JL) = ZRRS(JL) + ZZW(JL)
+ IF (ZRCT(JL) > 0.) THEN
+ ZWQ1(JL,1) = XCOEF_RQ_C * ZQCT(JL) * ZZW(JL) / ZRCT(JL)
+ END IF
+ ENDIF
+ END DO
+ ELSE
+ WHERE ((ZRCT(:) > XRTMIN(2)) .AND. (ZRCS(:) > 0.0))
+ ZZW(:) = MIN( ZRCS(:),XTIMAUTC*MAX( ZRCT(:)-XCRIAUTC/ZRHODREF(:),0.0 ) )
+ ZRCS(:) = ZRCS(:) - ZZW(:)
+ ZRRS(:) = ZRRS(:) + ZZW(:)
+ ZWQ1(:,1) = XCOEF_RQ_C * ZQCT(:) * ZZW(:) / ZRCT(:) ! QCAUTR
+ END WHERE
+ END IF
+!
+ WHERE (ZRCT(:) > XRTMIN_ELEC(2) .AND. ZRCS(:) > ZRSMIN_ELEC(2) .AND. &
+ ZRRS(:) > ZRSMIN_ELEC(3) .AND. ABS(ZQCT(:)) > XQTMIN(2))
+ ZWQ1(:,1) = SIGN( MIN( ABS(ZQCS(:)),ABS(ZWQ1(:,1)) ),ZQCS(:) )
+ ZQCS(:) = ZQCS(:) - ZWQ1(:,1)
+ ZQRS(:) = ZQRS(:) + ZWQ1(:,1)
+ END WHERE
+
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'AUTO', &
+ Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'AUTO', &
+ Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'AUTO', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'AUTO', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+!
+!* 4.2 compute the accretion of r_c for r_r production: RCACCR & QCACCR
+!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'ACCR', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'ACCR', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ ZZW(:) = 0.0
+ WHERE ((ZRCT(:) > XRTMIN(2)) .AND. (ZRRT(:) > XRTMIN(3)) .AND. (ZRCS(:) > 0.0))
+ ZZW(:) = MIN( ZRCS(:),XFCACCR * ZRCT(:) &
+ * ZLBDAR(:)**XEXCACCR &
+ * ZRHOCOR(:)/ZCOR00 )
+ ZRCS(:) = ZRCS(:) - ZZW(:)
+ ZRRS(:) = ZRRS(:) + ZZW(:)
+ ZWQ1(:,2) = XCOEF_RQ_C * ZQCT(:) * ZZW(:) / ZRCT(:) ! QCACCR
+ END WHERE
+!
+ WHERE (ZRCT(:) > XRTMIN_ELEC(2) .AND. ZRRS(:) > ZRSMIN_ELEC(3) .AND. &
+ ZRCS(:) > ZRSMIN_ELEC(2) .AND. ABS(ZQCT(:)) > XQTMIN(2))
+ ZWQ1(:,2) = SIGN( MIN( ABS(ZQCS(:)),ABS(ZWQ1(:,2)) ),ZQCS(:) )
+ ZQCS(:) = ZQCS(:) - ZWQ1(:,2)
+ ZQRS(:) = ZQRS(:) + ZWQ1(:,2)
+ ENDWHERE
+
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'ACCR', &
+ Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'ACCR', &
+ Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'ACCR', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'ACCR', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+!
+!
+!* 4.3 compute the evaporation of r_r: RREVAV & QREVAV
+!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'REVA', &
+ Unpack( zqpis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'REVA', &
+ Unpack( zqnis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'REVA', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ ZZW(:) = 0.0
+ WHERE ((ZRRT(:) > XRTMIN(3)) .AND. (ZRCT(:) <= XRTMIN(2)))
+ ZZW(:) = EXP( XALPW - XBETAW/ZZT(:) - XGAMW*ALOG(ZZT(:) ) ) ! es_w
+ ZUSW(:) = 1.0 - ZRVT(:) * (ZPRES(:) - ZZW(:)) / ((XMV / XMD) * ZZW(:))
+ ! Undersaturation over water
+ ZZW(:) = (XLVTT + (XCPV - XCL) * (ZZT(:) - XTT) )**2 / &
+ (ZKA(:) * XRV * ZZT(:)**2) + &
+ (XRV * ZZT(:)) / (ZDV(:) * ZZW(:))
+ ZZW(:) = MIN( ZRRS(:),( MAX( 0.0,ZUSW(:) )/(ZRHODREF(:)*ZZW(:)) ) * &
+ ( X0EVAR*ZLBDAR(:)**XEX0EVAR+X1EVAR*ZCJ(:)*ZLBDAR(:)**XEX1EVAR ) )
+ ZRRS(:) = ZRRS(:) - ZZW(:)
+ ZRVS(:) = ZRVS(:) + ZZW(:)
+ ZTHS(:) = ZTHS(:) - ZZW(:)*ZLVFACT(:)
+ ZWQ1(:,3) = XCOEF_RQ_R * ZQRT(:) * ZZW(:) / ZRRT(:) ! QREVAV
+ END WHERE
+!
+ WHERE (ZRRT(:) > XRTMIN_ELEC(3) .AND. ZRRS(:) > ZRSMIN_ELEC(3) .AND. &
+ ZRVS(:) > ZRSMIN_ELEC(1) .AND. ZRCT(:) <= 0.0 .AND. &
+ ABS(ZQRT(:)) > XQTMIN(3))
+ ZWQ1(:,3) = SIGN( MIN( ABS(ZQRS(:)),ABS(ZWQ1(:,3)) ),ZQRS(:) )
+ ZQRS(:) = ZQRS(:) - ZWQ1(:,3)
+ ZQPIS(:) = ZQPIS(:) + MAX( 0.0,ZWQ1(:,3)/XECHARGE )
+ ZQNIS(:) = ZQNIS(:) - MIN( 0.0,ZWQ1(:,3)/XECHARGE )
+ ENDWHERE
+!
+ PEVAP3D(:,:,:)=UNPACK(ZZW(:),MASK=GMICRO(:,:,:),FIELD=PEVAP3D(:,:,:))
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'REVA', &
+ Unpack( -zzw(:) * zlvfact(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'REVA', &
+ Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'REVA', &
+ Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'REVA', &
+ Unpack( zqpis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'REVA', &
+ Unpack( zqnis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'REVA', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ END SUBROUTINE RAIN_ICE_ELEC_WARM
+!
+!-------------------------------------------------------------------------------
+!
+ SUBROUTINE RAIN_ICE_ELEC_FAST_RS
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!-------------------------------------------------------------------------------
+!
+!* 5.1 cloud droplet riming of the aggregates
+!
+ ZZW1(:,:) = 0.0
+ ZWQ1(:,1:7) = 0.0
+!
+ ALLOCATE( GRIM(IMICRO) )
+ GRIM(:) = (ZRCT(:) > XRTMIN(2)) .AND. (ZRST(:) > XRTMIN(5)) .AND. &
+ (ZRCS(:) > 0.0) .AND. (ZZT(:) < XTT)
+ IGRIM = COUNT( GRIM(:) )
+!
+ IF (IGRIM > 0) THEN
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'RIM', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'RIM', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'RIM', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+!
+! 5.1.0 allocations
+!
+ ALLOCATE( ZVEC1(IGRIM) )
+ ALLOCATE( ZVEC2(IGRIM) )
+ ALLOCATE( IVEC1(IGRIM) )
+ ALLOCATE( IVEC2(IGRIM) )
+!
+!* 5.1.1 select the ZLBDAS
+!
+ ZVEC1(:) = PACK( ZLBDAS(:),MASK=GRIM(:) )
+!
+!* 5.1.2 find the next lower indice for the ZLBDAS in the geometrical
+!* set of Lbda_s used to tabulate some moments of the incomplete
+! gamma function
+!
+ ZVEC2(1:IGRIM) = MAX( 1.00001, MIN( REAL(NGAMINC)-0.00001, &
+ XRIMINTP1 * LOG( ZVEC1(1:IGRIM) ) + XRIMINTP2 ) )
+ IVEC2(1:IGRIM) = INT( ZVEC2(1:IGRIM) )
+ ZVEC2(1:IGRIM) = ZVEC2(1:IGRIM) - REAL( IVEC2(1:IGRIM) )
+!
+!* 5.1.3 perform the linear interpolation of the normalized
+!* "2+XDS"-moment of the incomplete gamma function
+!
+ ZVEC1(1:IGRIM) = XGAMINC_RIM1( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) &
+ - XGAMINC_RIM1( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0)
+ ZZW(:) = UNPACK( VECTOR=ZVEC1(:),MASK=GRIM,FIELD=0.0 )
+!
+!* 5.1.4 riming of the small sized aggregates
+!
+ WHERE (GRIM(:) .AND. ZRCS(:) > 0.0)
+ ZZW1(:,1) = MIN( ZRCS(:), &
+ XCRIMSS * ZZW(:) * ZRCT(:) * & ! RCRIMSS
+ ZLBDAS(:)**XEXCRIMSS * ZRHOCOR(:)/ZCOR00 )
+ ZRCS(:) = ZRCS(:) - ZZW1(:,1)
+ ZRSS(:) = ZRSS(:) + ZZW1(:,1)
+ ZTHS(:) = ZTHS(:) + ZZW1(:,1) * (ZLSFACT(:) - ZLVFACT(:)) ! f(L_f*(RCRIMSS))
+ ZWQ1(:,1) = XCOEF_RQ_C * ZQCT(:) * ZZW1(:,1) / ZRCT(:) ! QCRIMSS
+ END WHERE
+!
+ WHERE (ZZT(:) < XTT .AND. &
+ ZRCT(:) > XRTMIN_ELEC(2) .AND. ZRSS(:) > ZRSMIN_ELEC(5) .AND. &
+ ABS(ZQCT(:)) > XQTMIN(2) .AND. ZRCS(:) > ZRSMIN_ELEC(2))
+ ZWQ1(:,1) = SIGN( MIN( ABS(ZQCS(:)),ABS(ZWQ1(:,1)) ),ZQCS(:) )
+ ZQCS(:) = ZQCS(:) - ZWQ1(:,1)
+ ZQSS(:) = ZQSS(:) + ZWQ1(:,1)
+ ENDWHERE
+!
+!* 5.1.5 perform the linear interpolation of the normalized
+!* "XBS"-moment of the incomplete gamma function
+!
+ ZVEC1(1:IGRIM) = XGAMINC_RIM2( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) &
+ - XGAMINC_RIM2( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0)
+ ZZW(:) = UNPACK( VECTOR=ZVEC1(:),MASK=GRIM,FIELD=0.0 )
+!
+!
+!* 5.1.6 perform the linear interpolation of the normalized
+!* "XFS"-moment of the incomplete gamma function
+!
+ ZVEC1(1:IGRIM) = XGAMINC_RIM3( IVEC2(1:IGRIM)+1 ) * ZVEC2(1:IGRIM) &
+ - XGAMINC_RIM3( IVEC2(1:IGRIM) ) * (ZVEC2(1:IGRIM) - 1.0)
+ ZWQ1(:,3) = UNPACK( VECTOR=ZVEC1(:), MASK=GRIM, FIELD=0.0 )
+!
+!* 5.1.7 riming-conversion of the large sized aggregates into graupeln:
+!* RSRIMCG & QSRIMCG and RCRIMSG & QCRIMSG
+!
+ WHERE (GRIM(:) .AND. ZRSS(:) > 0.0 .AND. ZRCS(:) > 0.0 .AND. ZZW(:) < 1.)
+ ZZW1(:,2) = MIN( ZRCS(:), &
+ XCRIMSG * ZRCT(:) & ! RCRIMSG
+ * ZLBDAS(:)**XEXCRIMSG &
+ * ZRHOCOR(:)/ZCOR00 - ZZW1(:,1) )
+ ZZW1(:,3) = MIN( ZRSS(:), &
+ XSRIMCG * ZLBDAS(:)**XEXSRIMCG & ! RSRIMCG
+ * (1.0 - ZZW(:) )/(PTSTEP*ZRHODREF(:)) )
+ ZRCS(:) = ZRCS(:) - ZZW1(:,2)
+ ZRSS(:) = ZRSS(:) - ZZW1(:,3)
+ ZRGS(:) = ZRGS(:) + ZZW1(:,2) + ZZW1(:,3)
+ ZTHS(:) = ZTHS(:) + ZZW1(:,2) * (ZLSFACT(:) - ZLVFACT(:)) ! f(L_f*(RCRIMSG))
+ ZWQ1(:,2) = XCOEF_RQ_C * ZQCT(:) * ZZW1(:,2) / ZRCT(:) ! QCRIMSG
+ ZWQ1(:,3) = XQSRIMCG * ZEST(:) * & ! QSRIMCG
+ ZLBDAS(:)**XEXQSRIMCG * (1. - ZWQ1(:,3)) / &
+ (PTSTEP * ZRHODREF(:))
+ END WHERE
+!
+ WHERE (ZRCT(:) > XRTMIN_ELEC(2) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. &
+ ZRSS(:) > ZRSMIN_ELEC(5) .AND. ZRCS(:) > ZRSMIN_ELEC(2) .AND. &
+ ZZT(:) < XTT .AND. ABS(ZQCT(:)) > XQTMIN(2))
+ ZWQ1(:,2) = SIGN( MIN( ABS(ZQCS(:)),ABS(ZWQ1(:,2)) ),ZQCS(:) )
+ ZQGS(:) = ZQGS(:) + ZWQ1(:,2)
+ ZQCS(:) = ZQCS(:) - ZWQ1(:,2)
+ ENDWHERE
+!
+ WHERE (ZRCT(:) > XRTMIN_ELEC(2) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. &
+ ZRSS(:) > ZRSMIN_ELEC(5) .AND. ZRCS(:) > ZRSMIN_ELEC(2) .AND. &
+ ZZT(:) < XTT .AND. ABS(ZQCT(:)) > XQTMIN(2) .AND. &
+ ABS(ZEST) > XESMIN)
+ ZWQ1(:,3) = SIGN( MIN( ABS(ZQSS(:)),ABS(ZWQ1(:,3)) ),ZQSS(:) )
+ ZQGS(:) = ZQGS(:) + ZWQ1(:,3)
+ ZQSS(:) = ZQSS(:) - ZWQ1(:,3)
+ ENDWHERE
+!
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(IVEC1)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(ZVEC1)
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'RIM', Unpack( ( zzw1(:,1) + zzw1(:,2) ) &
+ * ( zlsfact(:) - zlvfact(:) ) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'RIM', &
+ Unpack( ( -zzw1(:,1) - zzw1(:,2) ) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'RIM', &
+ Unpack( ( zzw1(:,1) - zzw1(:,3) ) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'RIM', &
+ Unpack( ( zzw1(:,2) + zzw1(:,3) ) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'RIM', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'RIM', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'RIM', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+ END IF
+!
+ DEALLOCATE(GRIM)
+!
+!
+!* 5.2 rain accretion onto the aggregates
+!
+ ZZW1(:,2:3) = 0.0
+ ZWQ4(:) = 0.0
+!
+ ALLOCATE(GACC(IMICRO))
+ GACC(:) = ZRRT(:)>XRTMIN(3) .AND. ZRST(:)>XRTMIN(5) .AND. &
+ ZRRS(:) > 0.0 .AND. ZZT(:) < XTT
+ IGACC = COUNT( GACC(:) )
+!
+ IF( IGACC>0 ) THEN
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'ACC', &
+ Unpack( zths(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'ACC', &
+ Unpack( zrrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'ACC', &
+ Unpack( zrss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'ACC', &
+ Unpack( zrgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'ACC', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'ACC', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'ACC', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+!
+! 5.2.0 allocations
+!
+ ALLOCATE(ZVEC1(IGACC))
+ ALLOCATE(ZVEC2(IGACC))
+ ALLOCATE(ZVEC3(IGACC))
+ ALLOCATE(IVEC1(IGACC))
+ ALLOCATE(IVEC2(IGACC))
+!
+ ALLOCATE( ZVECQ4(IGACC) )
+ ALLOCATE( ZVECQ5(IGACC) )
+ ALLOCATE( ZVECQ6(IGACC) )
+!
+!
+! 5.2.1 select the (ZLBDAS,ZLBDAR) couplet
+!
+ ZVEC1(:) = PACK( ZLBDAS(:),MASK=GACC(:) )
+ ZVEC2(:) = PACK( ZLBDAR(:),MASK=GACC(:) )
+!
+! 5.2.2 find the next lower indice for the ZLBDAS and for the ZLBDAR
+! in the geometrical set of (Lbda_s,Lbda_r) couplet use to
+! tabulate the RACCSS-kernel
+!
+ ZVEC1(1:IGACC) = MAX( 1.00001, MIN( REAL(NACCLBDAS)-0.00001, &
+ XACCINTP1S * LOG( ZVEC1(1:IGACC) ) + XACCINTP2S ) )
+ IVEC1(1:IGACC) = INT( ZVEC1(1:IGACC) )
+ ZVEC1(1:IGACC) = ZVEC1(1:IGACC) - REAL( IVEC1(1:IGACC) )
+!
+ ZVEC2(1:IGACC) = MAX( 1.00001, MIN( REAL(NACCLBDAR)-0.00001, &
+ XACCINTP1R * LOG( ZVEC2(1:IGACC) ) + XACCINTP2R ) )
+ IVEC2(1:IGACC) = INT( ZVEC2(1:IGACC) )
+ ZVEC2(1:IGACC) = ZVEC2(1:IGACC) - REAL( IVEC2(1:IGACC) )
+!
+! 5.2.3 perform the bilinear interpolation of the normalized
+! RACCSS-kernel
+!
+ ZVEC3(:) = BI_LIN_INTP_V(XKER_RACCSS, IVEC1, IVEC2, ZVEC1, ZVEC2, IGACC)
+ ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GACC,FIELD=0.0 )
+!
+ ZVECQ5(:) = BI_LIN_INTP_V(XKER_Q_RACCSS, IVEC1, IVEC2, ZVEC1, ZVEC2, IGACC)
+ ZWQ1(:,5) = UNPACK( VECTOR=ZVECQ5(:), MASK=GACC, FIELD=0.0 )
+!
+! 5.2.4 raindrop accretion on the small sized aggregates:
+! RRACCSS & QRACCSS
+!
+ WHERE ( GACC(:) )
+ ZZW1(:,2) = & !! coef of RRACCS
+ XFRACCSS*( ZLBDAS(:)**XCXS )*ZRHOCOR(:)/(ZCOR00* ZRHODREF(:)) &
+ *( XLBRACCS1/((ZLBDAS(:)**2) ) + &
+ XLBRACCS2/( ZLBDAS(:) * ZLBDAR(:) ) + &
+ XLBRACCS3/( (ZLBDAR(:)**2)) )/ZLBDAR(:)**4
+ ZZW1(:,4) = MIN( ZRRS(:),ZZW1(:,2)*ZZW(:) ) ! RRACCSS
+ ZRRS(:) = ZRRS(:) - ZZW1(:,4)
+ ZRSS(:) = ZRSS(:) + ZZW1(:,4)
+ ZTHS(:) = ZTHS(:) + ZZW1(:,4)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(RRACCSS))
+ ZWQ4(:) = XFQRACCS * ZERT(:) * ZRHOCOR(:)/(ZCOR00* ZRHODREF(:)) * &
+ ZLBDAR(:)**XCXR * ZLBDAS(:)**XCXS * &
+ (XLBQRACCS1 * ZLBDAR(:)**(-2.0 - XFR) + &
+ XLBQRACCS2 * ZLBDAR(:)**(-1.0 - XFR) * ZLBDAS(:)**(-1.0) + &
+ XLBQRACCS3 * ZLBDAR(:)**(-XFR) * ZLBDAS(:)**(-2.0))
+ ZWQ1(:,5) = ZWQ1(:,5) * ZWQ4(:) ! QRACCSS
+ END WHERE
+!
+ WHERE (ZRRT(:) > XRTMIN_ELEC(3) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. &
+ ZRRS(:) > ZRSMIN_ELEC(3) .AND. ZZT(:) < XTT .AND. &
+ ABS(ZQRS(:)) > XQTMIN(3) .AND. ABS(ZERT) > XERMIN)
+ ZWQ1(:,5) = SIGN( MIN( ABS(ZQRS(:)),ABS(ZWQ1(:,5)) ),ZQRS(:) )
+ ZQRS(:) = ZQRS(:) - ZWQ1(:,5)
+ ZQSS(:) = ZQSS(:) + ZWQ1(:,5)
+ ENDWHERE
+!
+! 5.2.5 perform the bilinear interpolation of the normalized
+! RACCS-kernel
+!
+ ZVEC3(:) = BI_LIN_INTP_V(XKER_RACCS, IVEC1, IVEC2, ZVEC1, ZVEC2, IGACC)
+ ZZW1(:,2) = ZZW1(:,2)*UNPACK( VECTOR=ZVEC3(:),MASK=GACC(:),FIELD=0.0 )
+ !! RRACCS!
+!
+ ZVECQ4(:) = BI_LIN_INTP_V(XKER_Q_RACCS, IVEC1, IVEC2, ZVEC1, ZVEC2, IGACC)
+ ZWQ1(:,4) = UNPACK( VECTOR=ZVECQ4(:), MASK=GACC, FIELD=0.0 )
+!
+! 5.2.6 perform the bilinear interpolation of the normalized
+! SACCRG-kernel
+!
+ ZVEC3(:) = BI_LIN_INTP_V(XKER_SACCRG, IVEC2, IVEC1, ZVEC2, ZVEC1, IGACC)
+ ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GACC,FIELD=0.0 )
+!
+ ZVECQ6(:) = BI_LIN_INTP_V(XKER_Q_SACCRG, IVEC2,IVEC1, ZVEC2, ZVEC1, IGACC)
+ ZWQ1(:,6) = UNPACK( VECTOR=ZVECQ6(:), MASK=GACC, FIELD=0.0 )
+ ZWQ1(:,4) = ZWQ1(:,4) * ZWQ4(:) ! QRACCS
+!
+! 5.2.7 raindrop accretion-conversion of the large sized aggregates
+! into graupeln: RRACCSG & QRACCSG and RSACCRG & QSACCRG
+!
+ WHERE ( GACC(:) .AND. (ZRSS(:)>0.0) )
+ ZZW1(:,2) = MIN( ZRRS(:),ZZW1(:,2)-ZZW1(:,4) ) ! RRACCSG
+ ZZW1(:,3) = MIN( ZRSS(:),XFSACCRG*ZZW(:)* & ! RSACCRG
+ ( ZLBDAS(:)**(XCXS-XBS) )*ZRHOCOR(:)/(ZCOR00* ZRHODREF(:)) &
+ *( XLBSACCR1/((ZLBDAR(:)**2) ) + &
+ XLBSACCR2/( ZLBDAR(:) * ZLBDAS(:) ) + &
+ XLBSACCR3/( (ZLBDAS(:)**2)) )/ZLBDAR(:) )
+ ZRRS(:) = ZRRS(:) - ZZW1(:,2)
+ ZRSS(:) = ZRSS(:) - ZZW1(:,3)
+ ZRGS(:) = ZRGS(:) + ZZW1(:,2)+ZZW1(:,3)
+ ZTHS(:) = ZTHS(:) + ZZW1(:,2)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(RRACCSG))
+ ZWQ1(:,4) = ZWQ1(:,4) - ZWQ1(:,5) ! QRACCSG
+ ZWQ1(:,6) = ZWQ1(:,6) * XFQRACCS * ZEST(:) * &
+ ZRHOCOR(:) / (ZCOR00 * ZRHODREF(:)) * &
+ ZLBDAR(:)**XCXR * ZLBDAS(:)**XCXS * &
+ (XLBQSACCRG1 * ZLBDAS(:)**(-2.0 - XFS) + &
+ XLBQSACCRG2 * ZLBDAS(:)**(-1.0 - XFS) * ZLBDAR(:)**(-1.0) + &
+ XLBQSACCRG3 * ZLBDAS(:)**(-XFS) * ZLBDAR(:)**(-2.0)) ! QSACCR
+ END WHERE
+!
+ WHERE (ZRRT(:) > XRTMIN_ELEC(3) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. &
+ ZRSS(:) > ZRSMIN_ELEC(5) .AND. ZRRS(:) > ZRSMIN_ELEC(3) .AND. &
+ ZZT(:) < XTT .AND. ABS(ZQGS(:)) > XQTMIN(6))
+ ZWQ1(:,4) = SIGN( MIN( ABS(ZQRS(:)),ABS(ZWQ1(:,4)) ),ZQRS(:) )
+ ZQRS(:) = ZQRS(:) - ZWQ1(:,4)
+ ZQGS(:) = ZQGS(:) + ZWQ1(:,4)
+ ENDWHERE
+!
+ WHERE (ZRRT(:) > XRTMIN_ELEC(3) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. &
+ ZRSS(:) > ZRSMIN_ELEC(5) .AND. ZRRS(:) > ZRSMIN_ELEC(3) .AND. &
+ ZZT(:) < XTT .AND. ABS(ZQGS(:)) > XQTMIN(6) .AND. &
+ ABS(ZEST) > XESMIN)
+ ZWQ1(:,6) = SIGN( MIN( ABS(ZQSS(:)),ABS(ZWQ1(:,6)) ),ZQSS(:) )
+ ZQSS(:) = ZQSS(:) - ZWQ1(:,6)
+ ZQGS(:) = ZQGS(:) + ZWQ1(:,6)
+ ENDWHERE
+!
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(IVEC1)
+ DEALLOCATE(ZVEC3)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(ZVEC1)
+ DEALLOCATE( ZVECQ4 )
+ DEALLOCATE( ZVECQ5 )
+ DEALLOCATE( ZVECQ6 )
+
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'ACC', &
+ Unpack( zths(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'ACC', &
+ Unpack( zrrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'ACC', &
+ Unpack( zrss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'ACC', &
+ Unpack( zrgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'ACC', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'ACC', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'ACC', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+ END IF
+
+ DEALLOCATE(GACC)
+!
+!* 5.3 Conversion-Melting of the aggregates: RSMLT & QSMLT
+!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'CMEL', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'CMEL', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ ZZW(:) = 0.0
+ WHERE ((ZRST(:) > XRTMIN(5)) .AND. (ZRSS(:) > 0.0) .AND. (ZZT(:) > XTT))
+ ZZW(:) = ZRVT(:) * ZPRES(:) / ((XMV / XMD) + ZRVT(:)) ! Vapor pressure
+ ZZW(:) = ZKA(:) * (XTT - ZZT(:)) + &
+ (ZDV(:) * (XLVTT + (XCPV - XCL) * (ZZT(:) - XTT)) * &
+ (XESTT - ZZW(:)) / (XRV * ZZT(:)))
+!
+! compute RSMLT
+!
+ ZZW(:) = MIN( ZRSS(:), XFSCVMG * MAX( 0.0,( -ZZW(:) * &
+ (X0DEPS * ZLBDAS(:)**XEX0DEPS + &
+ X1DEPS * ZCJ(:) * ZLBDAS(:)**XEX1DEPS ) - &
+ (ZZW1(:,1) + ZZW1(:,4)) * &
+ (ZRHODREF(:) * XCL * (XTT - ZZT(:)))) / &
+ (ZRHODREF(:) * XLMTT)))
+!
+! note that RSCVMG = RSMLT*XFSCVMG but no heat is exchanged (at the rate RSMLT)
+! because the graupeln produced by this process are still icy!!!
+!
+ ZRSS(:) = ZRSS(:) - ZZW(:)
+ ZRGS(:) = ZRGS(:) + ZZW(:)
+ ZWQ1(:,7) = XCOEF_RQ_S * ZQST(:) * ZZW(:) / ZRST(:) ! QSMLT
+ END WHERE
+!
+ WHERE (ZRST(:) > XRTMIN_ELEC(5) .AND. ZRSS(:) > ZRSMIN_ELEC(5) .AND. &
+ ZRGT(:) > XRTMIN_ELEC(6) .AND. ABS(ZQST(:)) > XQTMIN(5) .AND. &
+ ZZT(:) > XTT .AND. ZRHODREF(:)*XLMTT > 0.)
+ ZWQ1(:,7) = SIGN( MIN( ABS(ZQSS(:)),ABS(ZWQ1(:,7)) ),ZQSS(:) )
+ ZQGS(:) = ZQGS(:) + ZWQ1(:,7)
+ ZQSS(:) = ZQSS(:) - ZWQ1(:,7)
+ ENDWHERE
+
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'CMEL', &
+ Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'CMEL', &
+ Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'CMEL', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'CMEL', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ END SUBROUTINE RAIN_ICE_ELEC_FAST_RS
+!
+!-------------------------------------------------------------------------------
+!
+!
+ SUBROUTINE RAIN_ICE_ELEC_FAST_RG
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!-------------------------------------------------------------------------------
+!
+!* 6.1 rain contact freezing: RICFRRG & QICFRRG and RRCFRIG & QRCFRIG
+!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'CFRZ', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'CFRZ', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'CFRZ', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ ZZW1(:,3:4) = 0.0
+ ZWQ1(:,3:4) = 0.0
+ WHERE ((ZRIT(:) > XRTMIN(4)) .AND. (ZRRT(:) > XRTMIN(3)) .AND. &
+ (ZRIS(:) > 0.0) .AND. (ZRRS(:) > 0.0))
+ ZZW1(:,3) = MIN( ZRIS(:),XICFRR * ZRIT(:) & ! RICFRRG
+ * ZLBDAR(:)**XEXICFRR &
+ * ZRHOCOR(:) / ZCOR00 )
+ ZZW1(:,4) = MIN( ZRRS(:),XRCFRI * ZCIT(:) & ! RRCFRIG
+ * ZLBDAR(:)**XEXRCFRI &
+ * ZRHOCOR(:) / (ZCOR00 * ZRHODREF(:)) )
+ ZRIS(:) = ZRIS(:) - ZZW1(:,3)
+ ZRRS(:) = ZRRS(:) - ZZW1(:,4)
+ ZRGS(:) = ZRGS(:) + ZZW1(:,3) + ZZW1(:,4)
+ ZTHS(:) = ZTHS(:) + ZZW1(:,4) * (ZLSFACT(:) - ZLVFACT(:)) ! f(L_f*RRCFRIG)
+ ZWQ1(:,4) = XQRCFRIG * ZLBDAR(:)**XEXQRCFRIG * ZCIT(:) * &
+ ZERT(:) * ZRHOCOR(:) / (ZCOR00 * ZRHODREF(:)) ! QRCFRIG
+ ZWQ1(:,3) = XCOEF_RQ_I * ZQIT(:) * ZZW1(:,3) / ZRIT(:) ! QICFRRG
+ END WHERE
+!
+ WHERE (ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRRT(:) > XRTMIN_ELEC(3) .AND. &
+ ZRIS(:) > ZRSMIN_ELEC(4) .AND. ZRRS(:) > ZRSMIN_ELEC(3) .AND. &
+ ABS(ZERT) > XERMIN .AND. ABS(ZQRT(:)) > XQTMIN(3))
+ ZWQ1(:,4) = SIGN( MIN( ABS(ZQRS(:)),ABS(ZWQ1(:,4)) ),ZQRS(:) )
+ ZQGS(:) = ZQGS(:) + ZWQ1(:,4)
+ ZQRS(:) = ZQRS(:) - ZWQ1(:,4)
+ ENDWHERE
+!
+ WHERE (ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRRT(:) > XRTMIN_ELEC(3) .AND. &
+ ZRIS(:) > ZRSMIN_ELEC(4) .AND. ZRRS(:) > ZRSMIN_ELEC(3) .AND. &
+ ABS(ZQIT(:)) > XQTMIN(4))
+ ZWQ1(:,3) = SIGN( MIN( ABS(ZQIS(:)),ABS(ZWQ1(:,3)) ),ZQIS(:) )
+ ZQGS(:) = ZQGS(:) + ZWQ1(:,3)
+ ZQIS(:) = ZQIS(:) - ZWQ1(:,3)
+ ENDWHERE
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'CFRZ', Unpack( zzw1(:,4) * ( zlsfact(:) - zlvfact(:) ) &
+ * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'CFRZ', &
+ Unpack( -zzw1(:, 4) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'CFRZ', &
+ Unpack( -zzw1(:, 3) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'CFRZ', &
+ Unpack( ( zzw1(:, 3) + zzw1(:, 4) ) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'CFRZ', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'CFRZ', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'CFRZ', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+!
+!* 6.2 compute the Dry growth case
+!
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'WETG', &
+ Unpack( zths(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'WETG', &
+ Unpack( zrcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'WETG', &
+ Unpack( zrrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'WETG', &
+ Unpack( zris(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'WETG', &
+ Unpack( zrss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'WETG', &
+ Unpack( zrgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'WETG', &
+ Unpack( zrhs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'WETG', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'WETG', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'WETG', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'WETG', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'WETG', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( krr == 7 ) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'WETG', &
+ Unpack( zqhs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ ZZW1(:,:) = 0.0
+ ZWQ1(:,1:10) = 0.0
+ ZWQ3(:) = 0.0
+ ZWQ4(:) = 0.0
+!
+!* 6.2.1 compute RCDRYG & QCDRYG
+!
+ WHERE ((ZRGT(:) > XRTMIN(6)) .AND. ((ZRCT(:) > XRTMIN(2) .AND. ZRCS(:) > 0.0)))
+ ZZW(:) = ZLBDAG(:)**(XCXG-XDG-2.0) * ZRHOCOR(:) / ZCOR00
+ ZZW1(:,1) = MIN( ZRCS(:),XFCDRYG * ZRCT(:) * ZZW(:) ) ! RCDRYG
+ ZWQ1(:,1) = XCOEF_RQ_C * ZQCT(:) * ZZW1(:,1) / ZRCT(:) ! QCDRYG
+ END WHERE
+!
+ WHERE (ZRCT(:) > XRTMIN_ELEC(2) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ABS(ZQCT(:)) > XQTMIN(2) .AND. ZRCS(:) > ZRSMIN_ELEC(2))
+ ZWQ1(:,1) = SIGN( MIN( ABS(ZQCS(:)),ABS(ZWQ1(:,1)) ),ZQCS(:) )
+ ELSEWHERE
+ ZWQ1(:,1) = 0.
+ ENDWHERE
+!
+!* 6.2.2 compute RIDRYG & QIDRYG
+!
+ WHERE ((ZRGT(:) > XRTMIN(6)) .AND. ((ZRIT(:) > XRTMIN(4) .AND. ZRIS(:) > 0.0)) )
+ ZZW(:) = ZLBDAG(:)**(XCXG-XDG-2.0) * ZRHOCOR(:)/ZCOR00
+ ZZW1(:,2) = MIN( ZRIS(:),XFIDRYG * EXP( XCOLEXIG*(ZZT(:)-XTT) ) &
+ * ZRIT(:) * ZZW(:) ) ! RIDRYG
+ ZWQ1(:,2) = XCOEF_RQ_I * ZQIT(:) * ZZW1(:,2) / ZRIT(:) ! QIDRYG_coal
+ END WHERE
+!
+ WHERE (GELEC(:,2))
+ ZWQ1(:,2) = SIGN( MIN( ABS(ZQIS(:)),ABS(ZWQ1(:,2)) ),ZQIS(:) )
+ ELSEWHERE
+ ZWQ1(:,2) = 0.
+ ENDWHERE
+!
+ CALL ELEC_IDRYG_B() ! QIDRYG_boun
+!
+! Save the NI charging rate for temporal series
+ XNI_IDRYG(:,:,:) = UNPACK(ZWQ1(:,3), MASK=GMICRO, FIELD=0.0)
+ XNI_IDRYG(:,:,:) = XNI_IDRYG(:,:,:) * PRHODREF(:,:,:) ! C/m3/s
+!
+!* 6.2.3 accretion of aggregates on the graupeln
+!
+ ALLOCATE(GDRY(IMICRO))
+ GDRY(:) = (ZRST(:)>XRTMIN(5)) .AND. (ZRGT(:)>XRTMIN(6)) .AND. (ZRSS(:)>0.0)
+ IGDRY = COUNT( GDRY(:) )
+!
+ IF( IGDRY>0 ) THEN
+!
+! 6.2.3.1 allocations
+!
+ ALLOCATE(ZVEC1(IGDRY))
+ ALLOCATE(ZVEC2(IGDRY))
+ ALLOCATE(ZVEC3(IGDRY))
+ ALLOCATE(IVEC1(IGDRY))
+ ALLOCATE(IVEC2(IGDRY))
+!
+ ALLOCATE( ZVECQ4(IGDRY) )
+ ALLOCATE( ZVECQ5(IGDRY) )
+ ALLOCATE( ZVECQ6(IGDRY) )
+!
+ IF (CNI_CHARGING == 'TAKAH' .OR. CNI_CHARGING == 'SAUN1' .OR. &
+ CNI_CHARGING == 'SAUN2' .OR. CNI_CHARGING == 'SAP98' .OR. &
+ CNI_CHARGING == 'BSMP1' .OR. CNI_CHARGING == 'BSMP2' .OR. &
+ CNI_CHARGING == 'TEEWC' .OR. CNI_CHARGING == 'TERAR' .OR. &
+ CNI_CHARGING == 'GARDI') &
+!
+ ALLOCATE( ZAUX(IGDRY) )
+!
+! 6.2.3.2 select the (ZLBDAG,ZLBDAS) couplet
+!
+ ZVEC1(:) = PACK( ZLBDAG(:),MASK=GDRY(:) )
+ ZVEC2(:) = PACK( ZLBDAS(:),MASK=GDRY(:) )
+!
+! 6.2.3.3 find the next lower indice for the ZLBDAG and for the ZLBDAS
+! in the geometrical set of (Lbda_g,Lbda_s) couplet use to
+! tabulate the SDRYG-kernel
+!
+ ZVEC1(1:IGDRY) = MAX( 1.00001, MIN( REAL(NDRYLBDAG)-0.00001, &
+ XDRYINTP1G * LOG( ZVEC1(1:IGDRY) ) + XDRYINTP2G ) )
+ IVEC1(1:IGDRY) = INT( ZVEC1(1:IGDRY) )
+ ZVEC1(1:IGDRY) = ZVEC1(1:IGDRY) - REAL( IVEC1(1:IGDRY) )
+!
+ ZVEC2(1:IGDRY) = MAX( 1.00001, MIN( REAL(NDRYLBDAS)-0.00001, &
+ XDRYINTP1S * LOG( ZVEC2(1:IGDRY) ) + XDRYINTP2S ) )
+ IVEC2(1:IGDRY) = INT( ZVEC2(1:IGDRY) )
+ ZVEC2(1:IGDRY) = ZVEC2(1:IGDRY) - REAL( IVEC2(1:IGDRY) )
+!
+! 6.2.3.4 perform the bilinear interpolation of the normalized
+! SDRYG-kernel
+!
+! normalized SDRYG-kernel
+ ZVEC3(:) = BI_LIN_INTP_V(XKER_SDRYG, IVEC1, IVEC2, ZVEC1, ZVEC2, IGDRY)
+ ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GDRY,FIELD=0.0 )
+!
+! normalized Q-SDRYG-kernel
+ ZVECQ4(:) = BI_LIN_INTP_V(XKER_Q_SDRYG, IVEC1, IVEC2, ZVEC1, ZVEC2, IGDRY)
+ ZWQ1(:,4) = UNPACK( VECTOR=ZVECQ4(:), MASK=GDRY, FIELD=0.0 )
+!
+! normalized Q-???-kernel
+ IF (CNI_CHARGING == 'TAKAH' .OR. CNI_CHARGING == 'SAUN1' .OR. &
+ CNI_CHARGING == 'SAUN2' .OR. CNI_CHARGING == 'SAP98' .OR. &
+ CNI_CHARGING == 'GARDI' .OR. &
+ CNI_CHARGING == 'BSMP1' .OR. CNI_CHARGING == 'BSMP2' .OR. &
+ CNI_CHARGING == 'TEEWC' .OR. CNI_CHARGING == 'TERAR') THEN
+ ZAUX(:) = BI_LIN_INTP_V(XKER_Q_LIMSG, IVEC1, IVEC2, ZVEC1, ZVEC2, IGDRY)
+ ZAUX1(:) = UNPACK( VECTOR=ZAUX(:), MASK=GDRY, FIELD=0.0 )
+ END IF
+!
+! normalized Q-SDRYG-bouncing kernel
+ IF (CNI_CHARGING == 'TAKAH' .OR. CNI_CHARGING == 'HELFA' .OR. &
+ CNI_CHARGING == 'GARDI') THEN
+ ZVECQ5(:) = BI_LIN_INTP_V(XKER_Q_SDRYGB,IVEC1,IVEC2,ZVEC1,ZVEC2,IGDRY)
+ ZWQ1(:,10) = UNPACK( VECTOR=ZVECQ5(:), MASK=GDRY, FIELD=0.0 )
+ ELSE
+ ZVECQ5(:) = BI_LIN_INTP_V(XKER_Q_SDRYGB1,IVEC1,IVEC2,ZVEC1,ZVEC2,IGDRY)
+ ZWQ3(:) = UNPACK( VECTOR=ZVECQ5(:), MASK=GDRY, FIELD=0.0 ) ! Dvqsgmn if charge>0
+ ZVECQ6(:) = BI_LIN_INTP_V(XKER_Q_SDRYGB2,IVEC1,IVEC2,ZVEC1,ZVEC2,IGDRY)
+ ZWQ4(:) = UNPACK( VECTOR=ZVECQ6(:), MASK=GDRY, FIELD=0.0 ) ! Dvqsgmn if charge<0
+ ENDIF
+!
+! 6.2.3.5 compute RSDRYG and QSDRYG = QSDRYG_coal + QSDRYG_boun
+!
+ WHERE( GDRY(:) )
+ ZZW1(:,3) = MIN( ZRSS(:),XFSDRYG*ZZW(:) & ! RSDRYG
+ * EXP( XCOLEXSG*(ZZT(:)-XTT) ) &
+ *( ZLBDAS(:)**(XCXS-XBS) )*( ZLBDAG(:)**XCXG ) &
+ * ZRHOCOR(:) / (ZCOR00 * ZRHODREF(:)) &
+ *( XLBSDRYG1/( ZLBDAG(:)**2 ) + &
+ XLBSDRYG2/( ZLBDAG(:) * ZLBDAS(:) ) + &
+ XLBSDRYG3/( ZLBDAS(:)**2) ) )
+ ZWQ1(:,4) = ZWQ1(:,4) * XFQSDRYG * &
+ XCOLSG * EXP(XCOLEXSG * (ZZT(:) - XTT)) * &
+ ZEST(:) * ZRHOCOR(:) / (ZCOR00 * ZRHODREF(:)) * &
+ ZLBDAG(:)**XCXG * ZLBDAS(:)**XCXS * &
+ (XLBQSDRYG1 * ZLBDAS(:)**(-2.0-XFS) + &
+ XLBQSDRYG2 * ZLBDAS(:)**(-1.0-XFS) * ZLBDAG(:)**(-1.0) + &
+ XLBQSDRYG3 * ZLBDAS(:)**(-XFS) * ZLBDAG(:)**(-2.0)) ! QSDRYG_coal
+ END WHERE
+!
+ WHERE (ZRSS(:) > ZRSMIN_ELEC(5) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. &
+ ZRGS(:) > ZRSMIN_ELEC(6) .AND. ABS(ZQST(:)) > XQTMIN(5) .AND. &
+ ABS(ZEST) > XESMIN)
+ ZWQ1(:,4) = SIGN( MIN( ABS(ZQSS(:)),ABS(ZWQ1(:,4)) ),ZQSS(:) )
+ ELSEWHERE
+ ZWQ1(:,4) = 0.
+ END WHERE
+!
+! QSDRYG_boun
+ CALL ELEC_SDRYG_B()
+!
+! save the NI charging rate for temporal series
+ XNI_SDRYG(:,:,:) = UNPACK(ZWQ1(:,5), MASK=GMICRO, FIELD=0.0)
+ XNI_SDRYG(:,:,:) = XNI_SDRYG(:,:,:) * PRHODREF(:,:,:) ! C/m3/
+!
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(IVEC1)
+ DEALLOCATE(ZVEC3)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(ZVEC1)
+!
+ DEALLOCATE( ZVECQ4 )
+ DEALLOCATE( ZVECQ5 )
+ DEALLOCATE( ZVECQ6 )
+ IF (ALLOCATED(ZAUX)) DEALLOCATE( ZAUX )
+ END IF
+!
+!
+!* 6.2.4 accretion of raindrops on the graupeln
+!
+ GDRY(:) = (ZRRT(:)>XRTMIN(3)) .AND. (ZRGT(:)>XRTMIN(6)) .AND. (ZRRS(:)>0.0)
+ IGDRY = COUNT( GDRY(:) )
+!
+ IF( IGDRY>0 ) THEN
+!
+! 6.2.4.1 allocations
+!
+ ALLOCATE(ZVEC1(IGDRY))
+ ALLOCATE(ZVEC2(IGDRY))
+ ALLOCATE(ZVEC3(IGDRY))
+ ALLOCATE(IVEC1(IGDRY))
+ ALLOCATE(IVEC2(IGDRY))
+ ALLOCATE(ZVECQ4(IGDRY))
+!
+! 6.2.4.2 select the (ZLBDAG,ZLBDAR) couplet
+!
+ ZVEC1(:) = PACK( ZLBDAG(:),MASK=GDRY(:) )
+ ZVEC2(:) = PACK( ZLBDAR(:),MASK=GDRY(:) )
+!
+! 6.2.4.3 find the next lower indice for the ZLBDAG and for the ZLBDAR
+! in the geometrical set of (Lbda_g,Lbda_r) couplet use to
+! tabulate the RDRYG-kernel
+!
+ ZVEC1(1:IGDRY) = MAX( 1.00001, MIN( REAL(NDRYLBDAG)-0.00001, &
+ XDRYINTP1G * LOG( ZVEC1(1:IGDRY) ) + XDRYINTP2G ) )
+ IVEC1(1:IGDRY) = INT( ZVEC1(1:IGDRY) )
+ ZVEC1(1:IGDRY) = ZVEC1(1:IGDRY) - REAL( IVEC1(1:IGDRY) )
+!
+ ZVEC2(1:IGDRY) = MAX( 1.00001, MIN( REAL(NDRYLBDAR)-0.00001, &
+ XDRYINTP1R * LOG( ZVEC2(1:IGDRY) ) + XDRYINTP2R ) )
+ IVEC2(1:IGDRY) = INT( ZVEC2(1:IGDRY) )
+ ZVEC2(1:IGDRY) = ZVEC2(1:IGDRY) - REAL( IVEC2(1:IGDRY) )
+!
+! 6.2.4.4 perform the bilinear interpolation of the normalized
+! RDRYG-kernel
+!
+ ZVEC3(:) = BI_LIN_INTP_V(XKER_RDRYG, IVEC1, IVEC2, ZVEC1, ZVEC2, IGDRY)
+ ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GDRY,FIELD=0.0 )
+!
+ ZVECQ4(:) = BI_LIN_INTP_V(XKER_Q_RDRYG, IVEC1, IVEC2, ZVEC1, ZVEC2, IGDRY)
+ ZWQ1(:,6) = UNPACK( VECTOR=ZVECQ4(:), MASK=GDRY, FIELD=0.0 )
+!
+! 6.2.4.5 compute RRDRYG and QRDRYG
+!
+ WHERE( GDRY(:) )
+ ZZW1(:,4) = MIN( ZRRS(:),XFRDRYG*ZZW(:) & ! RRDRYG
+ *( ZLBDAR(:)**(-4) )*( ZLBDAG(:)**XCXG ) &
+ * ZRHOCOR(:) / (ZCOR00 * ZRHODREF(:)) &
+ *( XLBRDRYG1/( ZLBDAG(:)**2 ) + &
+ XLBRDRYG2/( ZLBDAG(:) * ZLBDAR(:) ) + &
+ XLBRDRYG3/( ZLBDAR(:)**2) ) )
+ ZWQ1(:,6) = ZWQ1(:,6) * XFQRDRYG * &
+ ZRHOCOR(:) / (ZCOR00 * ZRHODREF(:)) * &
+ ZERT(:) * ZLBDAG(:)**XCXG * ZLBDAR(:)**XCXR * &
+ (XLBQRDRYG1 * ZLBDAR(:)**(-2.0 - XFR) + &
+ XLBQRDRYG2 * ZLBDAR(:)**(-1.0 - XFR) * ZLBDAG(:)**(-1.0) + &
+ XLBQRDRYG3 * ZLBDAR(:)**(-XFR) * ZLBDAG(:)**(-2.0)) ! QRDRYG
+ END WHERE
+!
+ WHERE (ZRRT(:) > XRTMIN_ELEC(3) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZRRS(:) > ZRSMIN_ELEC(3).AND. ABS(ZERT) > XERMIN .AND. &
+ ABS(ZQRT(:)) > XQTMIN(3))
+ ZWQ1(:,6) = SIGN( MIN( ABS(ZQRS(:)),ABS(ZWQ1(:,6)) ),ZQRS(:) )
+ ELSEWHERE
+ ZWQ1(:,6) = 0.
+ ENDWHERE
+!
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(IVEC1)
+ DEALLOCATE(ZVEC3)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(ZVEC1)
+ DEALLOCATE(ZVECQ4)
+ END IF
+!
+ ZRDRYG(:) = ZZW1(:,1) + ZZW1(:,2) + ZZW1(:,3) + ZZW1(:,4)
+ DEALLOCATE(GDRY)
+!
+!
+!* 6.3 compute the Wet growth case
+!
+ ZZW(:) = 0.0
+ ZRWETG(:) = 0.0
+ ZWQ1(:,7:9) = 0.0
+!
+ WHERE (ZRGT(:) > XRTMIN(6))
+ ZZW1(:,5) = MIN( ZRIS(:), &
+ ZZW1(:,2) / (XCOLIG*EXP(XCOLEXIG*(ZZT(:)-XTT)) ) ) ! RIWETG
+ ZZW1(:,6) = MIN( ZRSS(:), &
+ ZZW1(:,3) / (XCOLSG*EXP(XCOLEXSG*(ZZT(:)-XTT)) ) ) ! RSWETG
+!
+ ZZW(:) = ZRVT(:) * ZPRES(:) / ((XMV / XMD) + ZRVT(:)) ! Vapor pressure
+ ZZW(:) = ZKA(:) * (XTT - ZZT(:)) + &
+ (ZDV(:) * (XLVTT + (XCPV - XCL) * (ZZT(:) - XTT)) * &
+ (XESTT - ZZW(:)) / (XRV * ZZT(:)))
+!
+! compute RWETG
+!
+ ZRWETG(:) = MAX(0.0, &
+ (ZZW(:) * (X0DEPG * ZLBDAG(:)**XEX0DEPG + &
+ X1DEPG * ZCJ(:) * ZLBDAG(:)**XEX1DEPG) + &
+ (ZZW1(:,5) + ZZW1(:,6) ) * &
+ (ZRHODREF(:) * (XLMTT + (XCI - XCL) * (XTT - ZZT(:))))) / &
+ (ZRHODREF(:) * (XLMTT - XCL * (XTT - ZZT(:)))))
+ END WHERE
+!
+ WHERE (ZRGT(:) > 0.0 .AND. ZRIT(:) > 0. .AND. ZRST(:) > 0.)
+ ZWQ1(:,7) = XCOEF_RQ_I * ZZW1(:,5) * ZQIT(:) / ZRIT(:)
+ ZWQ1(:,8) = XCOEF_RQ_S * ZZW1(:,6) * ZQST(:) / ZRST(:)
+ END WHERE
+!
+ WHERE (ZRGT(:) > XRTMIN_ELEC(6) .AND. ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE)
+ ZWQ1(:,7) = SIGN( MIN( ABS(ZQIS(:)),ABS(ZWQ1(:,7)) ),ZQIS(:) )
+ ZWQ1(:,8) = SIGN( MIN( ABS(ZQSS(:)),ABS(ZWQ1(:,8)) ),ZQSS(:) )
+ ELSEWHERE
+ ZWQ1(:,7) = 0.
+ ZWQ1(:,8) = 0.
+ ENDWHERE
+!
+ WHERE (ZRGS(:) > ZRSMIN_ELEC(6) .AND. ABS(ZQRT(:)) > XQTMIN(3) .AND. &
+ ZRRT(:) > XRTMIN_ELEC(3))
+ ZWQ1(:,9) = XCOEF_RQ_R * ZQRT(:) * &
+ (ZRWETG(:) - ZZW1(:,5) - ZZW1(:,6) - ZZW1(:,1)) / ZRRT(:) ! QRWETG
+ ZWQ1(:,9) = SIGN( MIN( ABS(ZQRS(:)),ABS(ZWQ1(:,9)) ),ZQRS(:) )
+ ENDWHERE
+!
+!
+!* 6.4 Select Wet or Dry case
+!
+ ZZW(:) = 0.0
+ IF (KRR == 7) THEN
+ WHERE( ZRGT(:) > XRTMIN(6) .AND. ZZT(:) < XTT .AND. & ! Wet
+ ZRDRYG(:) >= ZRWETG(:) .AND. ZRWETG(:) > 0.0 ) ! case
+ ZZW(:) = ZRWETG(:) - ZZW1(:,5) - ZZW1(:,6) ! RCWETG+RRWETG
+!
+! limitation of the available rainwater mixing ratio (RRWETH < RRS !)
+!
+ ZZW1(:,7) = MAX( 0.0,MIN( ZZW(:),ZRRS(:)+ZZW1(:,1) ) )
+ ZUSW(:) = ZZW1(:,7) / ZZW(:)
+ ZZW1(:,5) = ZZW1(:,5) * ZUSW(:)
+ ZZW1(:,6) = ZZW1(:,6) * ZUSW(:)
+ ZRWETG(:) = ZZW1(:,7) + ZZW1(:,5) + ZZW1(:,6)
+!
+ ZRCS(:) = ZRCS(:) - ZZW1(:,1)
+ ZRIS(:) = ZRIS(:) - ZZW1(:,5)
+ ZRSS(:) = ZRSS(:) - ZZW1(:,6)
+!
+! assume a linear percent of conversion of graupel into hail
+!
+ ZRGS(:) = ZRGS(:) + ZRWETG(:) ! Wet growth
+ ZZW(:) = ZRGS(:) * ZRDRYG(:) / (ZRWETG(:) + ZRDRYG(:)) ! and
+ ZRGS(:) = ZRGS(:) - ZZW(:) ! partial conversion
+ ZRHS(:) = ZRHS(:) + ZZW(:) ! of the graupel into hail
+!
+ ZRRS(:) = MAX( 0.0,ZRRS(:) - ZZW1(:,7) + ZZW1(:,1) )
+ ZTHS(:) = ZTHS(:) + ZZW1(:,7)*(ZLSFACT(:)-ZLVFACT(:))
+ ! f(L_f*(RCWETG+RRWETG))
+!
+ ZQCS(:) = ZQCS(:) - ZWQ1(:,1) ! QCDRYG .equiv. QCWETG
+ ZQRS(:) = ZQRS(:) - ZWQ1(:,9)
+ ZQIS(:) = ZQIS(:) - ZWQ1(:,7)
+ ZQSS(:) = ZQSS(:) - ZWQ1(:,8)
+ ZQGS(:) = ZQGS(:) + ZWQ1(:,1) + ZWQ1(:,9) + ZWQ1(:,7) + ZWQ1(:,8)
+ ZZW(:) = ZQGS(:) * ZRDRYG(:) / (ZRWETG(:) + ZRDRYG(:)) ! partial graupel
+ ZQGS(:) = ZQGS(:) - ZZW(:) ! charge conversion
+ ZQHS(:) = ZQHS(:) + ZZW(:) ! into hail charge
+ END WHERE
+ ELSE IF( KRR == 6 ) THEN
+ WHERE (ZRGT(:) > XRTMIN(6) .AND. ZZT(:) < XTT .AND. & ! Wet
+ ZRDRYG(:) >= ZRWETG(:) .AND. ZRWETG(:) > 0.0) ! case
+ ZZW(:) = ZRWETG(:)
+ ZRCS(:) = ZRCS(:) - ZZW1(:,1)
+ ZRIS(:) = ZRIS(:) - ZZW1(:,5)
+ ZRSS(:) = ZRSS(:) - ZZW1(:,6)
+ ZRGS(:) = ZRGS(:) + ZZW(:)
+!
+ ZRRS(:) = ZRRS(:) - ZZW(:) + ZZW1(:,5) + ZZW1(:,6) + ZZW1(:,1)
+ ZTHS(:) = ZTHS(:) + (ZZW(:)-ZZW1(:,5)-ZZW1(:,6))*(ZLSFACT(:)-ZLVFACT(:))
+ ! f(L_f*(RCWETG+RRWETG))
+!
+ ZQCS(:) = ZQCS(:) - ZWQ1(:,1) ! QCDRYG .equiv. QCWETG
+ ZQRS(:) = ZQRS(:) - ZWQ1(:,9)
+ ZQIS(:) = ZQIS(:) - ZWQ1(:,7)
+ ZQSS(:) = ZQSS(:) - ZWQ1(:,8)
+ ZQGS(:) = ZQGS(:) + ZWQ1(:,1) + ZWQ1(:,9) + ZWQ1(:,7) + ZWQ1(:,8)
+ END WHERE
+ END IF
+
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'WETG', &
+ Unpack( zths(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'WETG', &
+ Unpack( zrcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'WETG', &
+ Unpack( zrrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'WETG', &
+ Unpack( zris(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'WETG', &
+ Unpack( zrss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'WETG', &
+ Unpack( zrgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'WETG', &
+ Unpack( zrhs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'WETG', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'WETG', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'WETG', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'WETG', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'WETG', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( krr == 7 ) &
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 6 ), 'WETG', &
+ Unpack( zqhs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'DRYG', &
+ Unpack( zths(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'DRYG', &
+ Unpack( zrcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'DRYG', &
+ Unpack( zrrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'DRYG', &
+ Unpack( zris(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'DRYG', &
+ Unpack( zrss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'DRYG', &
+ Unpack( zrgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'DRYG', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'DRYG', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'DRYG', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'DRYG', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'DRYG', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ WHERE (ZRGT(:) > XRTMIN(6) .AND. ZZT(:) < XTT .AND. & ! Dry
+ ZRDRYG(:) < ZRWETG(:) .AND. ZRDRYG(:) > 0.0) ! case
+ ZRCS(:) = ZRCS(:) - ZZW1(:,1)
+ ZRIS(:) = ZRIS(:) - ZZW1(:,2)
+ ZRSS(:) = ZRSS(:) - ZZW1(:,3)
+ ZRRS(:) = ZRRS(:) - ZZW1(:,4)
+ ZRGS(:) = ZRGS(:) + ZRDRYG(:)
+ ZTHS(:) = ZTHS(:) + (ZZW1(:,1) + ZZW1(:,4)) * (ZLSFACT(:) - ZLVFACT(:))
+ ! f(L_f*(RCDRYG+RRDRYG))
+!
+ ZQCS(:) = ZQCS(:) - ZWQ1(:,1)
+ ZQRS(:) = ZQRS(:) - ZWQ1(:,6)
+ ZQIS(:) = ZQIS(:) - ZWQ1(:,2) - ZWQ1(:,3)
+ ZQSS(:) = ZQSS(:) - ZWQ1(:,4) - ZWQ1(:,5)
+ ZQGS(:) = ZQGS(:) + ZWQ1(:,1) + ZWQ1(:,2) + ZWQ1(:,3) + ZWQ1(:,4) &
+ + ZWQ1(:,5) + ZWQ1(:,6)
+ END WHERE
+
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'DRYG', &
+ Unpack( zths(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'DRYG', &
+ Unpack( zrcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'DRYG', &
+ Unpack( zrrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'DRYG', &
+ Unpack( zris(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'DRYG', &
+ Unpack( zrss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'DRYG', &
+ Unpack( zrgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'DRYG', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'DRYG', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'DRYG', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'DRYG', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'DRYG', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+!
+! Inductive mecanism
+!
+ IF (LINDUCTIVE) THEN
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1), 'INCG', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'INCG', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ ZRATE_IND(:) = 0.
+ GIND(:) = ZRDRYG(:) > 0. .AND. ZRDRYG(:) < ZRWETG(:) .AND. ZZT(:) < XTT
+ IIND = COUNT(GIND(:))
+!
+ IF (IIND > 0) CALL INDUCTIVE_PROCESS
+!
+ XIND_RATE(:,:,:) = 0.
+ XIND_RATE(:,:,:) = UNPACK(ZRATE_IND(:), MASK=GMICRO, FIELD=0.0)
+ XIND_RATE(:,:,:) = XIND_RATE(:,:,:) * PRHODREF(:,:,:) ! C/m3/s
+
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1), 'INCG', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'INCG', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+ END IF
+!
+!* 6.5 Melting of the graupeln
+!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2), 'GMLT', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'GMLT', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ ZZW(:) = 0.0
+ ZWQ1(:,7) = 0.0
+ WHERE ((ZRGT(:) > XRTMIN(6)) .AND. (ZRGS(:) > 0.0) .AND. (ZZT(:) > XTT))
+ ZZW(:) = ZRVT(:) * ZPRES(:) / ((XMV / XMD) + ZRVT(:)) ! Vapor pressure
+ ZZW(:) = ZKA(:) * (XTT - ZZT(:)) + &
+ (ZDV(:) * (XLVTT + ( XCPV - XCL ) * (ZZT(:) - XTT)) * &
+ (XESTT - ZZW(:)) / (XRV * ZZT(:)))
+! compute RGMLTR
+ ZZW(:) = MIN(ZRGS(:), MAX(0.0, (-ZZW(:) * &
+ (X0DEPG * ZLBDAG(:)**XEX0DEPG + &
+ X1DEPG * ZCJ(:) * ZLBDAG(:)**XEX1DEPG) - &
+ (ZZW1(:,1) + ZZW1(:,4)) * &
+ (ZRHODREF(:) * XCL * (XTT - ZZT(:)))) / &
+ (ZRHODREF(:) * XLMTT)))
+ ZRRS(:) = ZRRS(:) + ZZW(:)
+ ZRGS(:) = ZRGS(:) - ZZW(:)
+ ZTHS(:) = ZTHS(:) - ZZW(:) * (ZLSFACT(:) - ZLVFACT(:)) ! f(L_f*(-RGMLTR))
+! compute QGMLTR
+ ZWQ1(:,7) = XCOEF_RQ_G * ZQGT(:) * ZZW(:) / ZRGT(:)
+ END WHERE
+!
+!
+ WHERE (ZRGT(:) > XRTMIN_ELEC(6) .AND. ZRGS(:) > ZRSMIN_ELEC(6) .AND. &
+ ZZT(:) > XTT .AND. ABS(ZQGT(:)) > XQTMIN(6))
+ ZWQ1(:,7) = SIGN( MIN( ABS(ZQGS(:)),ABS(ZWQ1(:,7)) ),ZQGS(:) )
+ ZQRS(:) = ZQRS(:) + ZWQ1(:,7)
+ ZQGS(:) = ZQGS(:) - ZWQ1(:,7)
+ ENDWHERE
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'GMLT', Unpack( -zzw(:) * ( zlsfact(:) - zlvfact(:) ) &
+ * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'GMLT', &
+ Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'GMLT', &
+ Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2), 'GMLT', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'GMLT', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ END SUBROUTINE RAIN_ICE_ELEC_FAST_RG
+!
+!-------------------------------------------------------------------------------
+!
+!
+ SUBROUTINE RAIN_ICE_ELEC_FAST_RH
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!-------------------------------------------------------------------------------
+!
+ ALLOCATE( GHAIL(IMICRO) )
+ GHAIL(:) = ZRHT(:) > XRTMIN(7)
+ IHAIL = COUNT(GHAIL(:))
+!
+ IF( IHAIL>0 ) THEN
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'WETH', &
+ Unpack( zths(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'WETH', &
+ Unpack( zrcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'WETH', &
+ Unpack( zrrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'WETH', &
+ Unpack( zris(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'WETH', &
+ Unpack( zrss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'WETH', &
+ Unpack( zrgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'WETH', &
+ Unpack( zrhs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+!
+!* 7.2 compute the Wet growth of hail
+!
+ WHERE (GHAIL(:))
+ ZLBDAH(:) = XLBH * (ZRHODREF(:) * MAX(ZRHT(:), XRTMIN(7)))**XLBEXH
+ END WHERE
+!
+ ZZW1(:,:) = 0.0
+ WHERE (GHAIL(:) .AND. ((ZRCT(:) > XRTMIN(2) .AND. ZRCS(:) > 0.0)))
+ ZZW(:) = ZLBDAH(:)**(XCXH-XDH-2.0) * ZRHOCOR(:) / ZCOR00
+ ZZW1(:,1) = MIN( ZRCS(:),XFWETH * ZRCT(:) * ZZW(:) ) ! RCWETH
+ END WHERE
+ WHERE (GHAIL(:) .AND. ((ZRIT(:) > XRTMIN(4) .AND. ZRIS(:) > 0.0)))
+ ZZW(:) = ZLBDAH(:)**(XCXH-XDH-2.0) * ZRHOCOR(:) / ZCOR00
+ ZZW1(:,2) = MIN( ZRIS(:),XFWETH * ZRIT(:) * ZZW(:) ) ! RIWETH
+ END WHERE
+!
+!* 7.2.1 accretion of aggregates on the hailstones
+!
+ ALLOCATE( GWET(IMICRO) )
+ GWET(:) = GHAIL(:) .AND. (ZRST(:) > XRTMIN(5) .AND. ZRSS(:) > 0.0)
+ IGWET = COUNT( GWET(:) )
+!
+ IF (IGWET > 0) THEN
+!
+!* 7.2.2 allocations
+!
+ ALLOCATE(ZVEC1(IGWET))
+ ALLOCATE(ZVEC2(IGWET))
+ ALLOCATE(ZVEC3(IGWET))
+ ALLOCATE(IVEC1(IGWET))
+ ALLOCATE(IVEC2(IGWET))
+!
+!* 7.2.3 select the (ZLBDAH,ZLBDAS) couplet
+!
+ ZVEC1(:) = PACK( ZLBDAH(:),MASK=GWET(:) )
+ ZVEC2(:) = PACK( ZLBDAS(:),MASK=GWET(:) )
+!
+!* 7.2.4 find the next lower indice for the ZLBDAG and for the ZLBDAS
+! in the geometrical set of (Lbda_h,Lbda_s) couplet use to
+! tabulate the SWETH-kernel
+!
+ ZVEC1(1:IGWET) = MAX( 1.00001, MIN( REAL(NWETLBDAH)-0.00001, &
+ XWETINTP1H * LOG( ZVEC1(1:IGWET) ) + XWETINTP2H ) )
+ IVEC1(1:IGWET) = INT( ZVEC1(1:IGWET) )
+ ZVEC1(1:IGWET) = ZVEC1(1:IGWET) - REAL( IVEC1(1:IGWET) )
+!
+ ZVEC2(1:IGWET) = MAX( 1.00001, MIN( REAL(NWETLBDAS)-0.00001, &
+ XWETINTP1S * LOG( ZVEC2(1:IGWET) ) + XWETINTP2S ) )
+ IVEC2(1:IGWET) = INT( ZVEC2(1:IGWET) )
+ ZVEC2(1:IGWET) = ZVEC2(1:IGWET) - REAL( IVEC2(1:IGWET) )
+!
+!* 7.2.5 perform the bilinear interpolation of the normalized
+! SWETH-kernel
+!
+ ZVEC3(:) = BI_LIN_INTP_V(XKER_SWETH, IVEC1, IVEC2, ZVEC1, ZVEC2, IGWET)
+ ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GWET,FIELD=0.0 )
+!
+ WHERE( GWET(:) )
+ ZZW1(:,3) = MIN( ZRSS(:), XFSWETH*ZZW(:) & ! RSWETH
+ *( ZLBDAS(:)**(XCXS-XBS) )*( ZLBDAH(:)**XCXH ) &
+ * ZRHOCOR(:)/(ZCOR00*ZRHODREF(:)) &
+ *( XLBSWETH1/( ZLBDAH(:)**2 ) + &
+ XLBSWETH2/( ZLBDAH(:) * ZLBDAS(:) ) + &
+ XLBSWETH3/( ZLBDAS(:)**2) ) )
+ END WHERE
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(IVEC1)
+ DEALLOCATE(ZVEC3)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(ZVEC1)
+ END IF
+!
+!* 7.2.6 accretion of graupeln on the hailstones
+!
+ GWET(:) = GHAIL(:) .AND. (ZRGT(:)>XRTMIN(6) .AND. ZRGS(:)>0.0)
+ IGWET = COUNT( GWET(:) )
+!
+ IF (IGWET > 0) THEN
+!
+!* 7.2.7 allocations
+!
+ ALLOCATE( ZVEC1(IGWET) )
+ ALLOCATE( ZVEC2(IGWET) )
+ ALLOCATE( ZVEC3(IGWET) )
+ ALLOCATE( IVEC1(IGWET) )
+ ALLOCATE( IVEC2(IGWET) )
+!
+!* 7.2.8 select the (ZLBDAH,ZLBDAG) couplet
+!
+ ZVEC1(:) = PACK( ZLBDAH(:),MASK=GWET(:) )
+ ZVEC2(:) = PACK( ZLBDAG(:),MASK=GWET(:) )
+!
+!* 7.2.9 find the next lower indice for the ZLBDAH and for the ZLBDAG
+! in the geometrical set of (Lbda_h,Lbda_g) couplet use to
+! tabulate the GWETH-kernel
+!
+ ZVEC1(1:IGWET) = MAX( 1.00001, MIN( REAL(NWETLBDAG)-0.00001, &
+ XWETINTP1H * LOG( ZVEC1(1:IGWET) ) + XWETINTP2H ) )
+ IVEC1(1:IGWET) = INT( ZVEC1(1:IGWET) )
+ ZVEC1(1:IGWET) = ZVEC1(1:IGWET) - REAL( IVEC1(1:IGWET) )
+!
+ ZVEC2(1:IGWET) = MAX( 1.00001, MIN( REAL(NWETLBDAG)-0.00001, &
+ XWETINTP1G * LOG( ZVEC2(1:IGWET) ) + XWETINTP2G ) )
+ IVEC2(1:IGWET) = INT( ZVEC2(1:IGWET) )
+ ZVEC2(1:IGWET) = ZVEC2(1:IGWET) - REAL( IVEC2(1:IGWET) )
+!
+!* 7.2.10 perform the bilinear interpolation of the normalized
+! GWETH-kernel
+!
+ ZVEC3(:) = BI_LIN_INTP_V(XKER_GWETH, IVEC1, IVEC2, ZVEC1, ZVEC2, IGWET)
+ ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GWET,FIELD=0.0 )
+!
+ WHERE (GWET(:))
+ ZZW1(:,5) = MIN( ZRGS(:),XFGWETH*ZZW(:) & ! RGWETH
+ *( ZLBDAG(:)**(XCXG-XBG) )*( ZLBDAH(:)**XCXH ) &
+ * ZRHOCOR(:) / (ZCOR00 * ZRHODREF(:)) &
+ *( XLBGWETH1/( ZLBDAH(:)**2 ) + &
+ XLBGWETH2/( ZLBDAH(:) * ZLBDAG(:) ) + &
+ XLBGWETH3/( ZLBDAG(:)**2) ) )
+ END WHERE
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(IVEC1)
+ DEALLOCATE(ZVEC3)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(ZVEC1)
+ END IF
+ DEALLOCATE(GWET)
+!
+!* 7.3 compute the Wet growth of hail
+!
+ ZZW(:) = 0.0
+ WHERE (GHAIL(:) .AND. ZZT(:) < XTT)
+ ZZW(:) = ZRVT(:) * ZPRES(:) / ((XMV / XMD) + ZRVT(:)) ! Vapor pressure
+ ZZW(:) = ZKA(:) * (XTT - ZZT(:)) + &
+ (ZDV(:) * (XLVTT + (XCPV - XCL) * (ZZT(:) - XTT)) * &
+ (XESTT - ZZW(:)) / (XRV * ZZT(:)))
+!
+! compute RWETH
+!
+ ZZW(:) = MAX(0., (ZZW(:) * (X0DEPH * ZLBDAH(:)**XEX0DEPH + &
+ X1DEPH * ZCJ(:) * ZLBDAH(:)**XEX1DEPH) + &
+ (ZZW1(:,2) + ZZW1(:,3) + ZZW1(:,5) ) * &
+ (ZRHODREF(:) * (XLMTT + (XCI - XCL) * (XTT - ZZT(:))))) / &
+ (ZRHODREF(:) * (XLMTT - XCL * (XTT - ZZT(:)))))
+!
+ ZZW1(:,6) = MAX( ZZW(:) - ZZW1(:,2) - ZZW1(:,3) - ZZW1(:,5), 0. ) ! RCWETH+RRWETH
+ END WHERE
+!
+ ZUSW(:) = 0.
+!
+ WHERE (GHAIL(:) .AND. ZZT(:) < XTT .AND. ZZW1(:,6) /= 0.0)
+!
+! limitation of the available rainwater mixing ratio (RRWETH < RRS !)
+!
+ ZZW1(:,4) = MAX( 0.0,MIN( ZZW1(:,6),ZRRS(:)+ZZW1(:,1) ) )
+ ZUSW(:) = ZZW1(:,4) / ZZW1(:,6)
+ ZZW1(:,2) = ZZW1(:,2)*ZUSW(:)
+ ZZW1(:,3) = ZZW1(:,3)*ZUSW(:)
+ ZZW1(:,5) = ZZW1(:,5)*ZUSW(:)
+ ZZW(:) = ZZW1(:,4) + ZZW1(:,2) + ZZW1(:,3) + ZZW1(:,5)
+!
+!* 7.1.6 integrate the Wet growth of hail
+!
+ ZRCS(:) = ZRCS(:) - ZZW1(:,1)
+ ZRIS(:) = ZRIS(:) - ZZW1(:,2)
+ ZRSS(:) = ZRSS(:) - ZZW1(:,3)
+ ZRGS(:) = ZRGS(:) - ZZW1(:,5)
+ ZRHS(:) = ZRHS(:) + ZZW(:)
+ ZRRS(:) = MAX( 0.0,ZRRS(:) - ZZW1(:,4) + ZZW1(:,1) )
+ ZRRS(:) = ZRRS(:) - ZZW1(:,4)
+ ZTHS(:) = ZTHS(:) + (ZZW1(:,4)+ZZW1(:,1))*(ZLSFACT(:)-ZLVFACT(:))
+ ! f(L_f*(RCWETH+RRWETH))
+ END WHERE
+!
+ ZWQ1(:,:) = 0.0
+ WHERE (GHAIL(:) .AND. ZZT(:) < XTT .AND. ZRCT(:) > XRTMIN_ELEC(2))
+ ZWQ1(:,1) = XCOEF_RQ_C * ZQCT(:) * ZZW1(:,1) / ZRCT(:)
+ ZWQ1(:,1) = SIGN( MIN( ABS(ZQCS(:)),ABS(ZWQ1(:,1)) ),ZQCS(:) )
+ END WHERE
+ WHERE (GHAIL(:) .AND. ZZT(:) < XTT .AND. ZRIT(:) > XRTMIN_ELEC(4))
+ ZWQ1(:,2) = XCOEF_RQ_I * ZQIT(:) * ZZW1(:,2) / ZRIT(:)
+ ZWQ1(:,2) = SIGN( MIN( ABS(ZQIS(:)),ABS(ZWQ1(:,2)) ),ZQIS(:) )
+ END WHERE
+ WHERE (GHAIL(:) .AND. ZZT(:) < XTT .AND. ZRST(:) > XRTMIN_ELEC(5))
+ ZWQ1(:,3) = XCOEF_RQ_S * ZQST(:) * ZZW1(:,3) / ZRST(:)
+ ZWQ1(:,3) = SIGN( MIN( ABS(ZQSS(:)),ABS(ZWQ1(:,3)) ),ZQSS(:) )
+ END WHERE
+ WHERE (GHAIL(:) .AND. ZZT(:) < XTT .AND. ZRGT(:) > XRTMIN_ELEC(6))
+ ZWQ1(:,5) = XCOEF_RQ_G * ZQGT(:) * ZZW1(:,5) / ZRGT(:)
+ ZWQ1(:,5) = SIGN( MIN( ABS(ZQGS(:)),ABS(ZWQ1(:,5)) ),ZQGS(:) )
+ END WHERE
+ WHERE (GHAIL(:) .AND. ZZT(:) < XTT .AND. ZRRT(:) > XRTMIN_ELEC(3))
+ ZWQ1(:,4) = XCOEF_RQ_R * ZQRT(:) * ZZW1(:,4) / ZRRT(:)
+ ZWQ1(:,4) = SIGN( MIN( ABS(ZQRS(:)),ABS(ZWQ1(:,4)) ),ZQRS(:) )
+ END WHERE
+!
+ ZQCS(:) = ZQCS(:) - ZWQ1(:,1)
+ ZQIS(:) = ZQIS(:) - ZWQ1(:,2)
+ ZQSS(:) = ZQSS(:) - ZWQ1(:,3)
+ ZQGS(:) = ZQGS(:) - ZWQ1(:,5)
+ ZQRS(:) = ZQRS(:) - ZWQ1(:,4)
+ ZQHS(:) = ZQHS(:) + ZWQ1(:,1) + ZWQ1(:,2) + ZWQ1(:,3) + ZWQ1(:,4) + ZWQ1(:,5)
+
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'WETH', &
+ Unpack( zths(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'WETH', &
+ Unpack( zrcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'WETH', &
+ Unpack( zrrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'WETH', &
+ Unpack( zris(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'WETH', &
+ Unpack( zrss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'WETH', &
+ Unpack( zrgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'WETH', &
+ Unpack( zrhs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'WETH', &
+ Unpack( -zwq1(:, 1) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'WETH', &
+ Unpack( -zwq1(:, 4) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'WETH', &
+ Unpack( -zwq1(:, 2) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'WETH', &
+ Unpack( -zwq1(:, 3) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'WETH', &
+ Unpack( -zwq1(:, 5) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 6 ), 'WETH', &
+ Unpack( ( zwq1(:, 1) + zwq1(:, 2) + zwq1(:, 3) + zwq1(:, 4) + zwq1(:, 5) ) &
+ * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+ END IF
+!
+ IF (IHAIL > 0) THEN
+!
+!* 7.5 Melting of the hailstones
+!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'HMLT', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 6 ), 'HMLT', &
+ Unpack( zqhs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ ZZW(:) = 0.0
+ ZWQ1(:,7) = 0.
+!
+ WHERE (GHAIL(:) .AND. (ZRHS(:) > 0.0) .AND. (ZZT(:) > XTT))
+ ZZW(:) = ZRVT(:) * ZPRES(:) / ((XMV / XMD) + ZRVT(:)) ! Vapor pressure
+ ZZW(:) = ZKA(:) * (XTT - ZZT(:)) + &
+ ( ZDV(:) * (XLVTT + (XCPV - XCL) * (ZZT(:) - XTT)) * &
+ (XESTT - ZZW(:)) / (XRV * ZZT(:)))
+!
+! compute RHMLTR
+!
+ ZZW(:) = MIN( ZRHS(:), MAX( 0.0,( -ZZW(:) * &
+ ( X0DEPH* ZLBDAH(:)**XEX0DEPH + &
+ X1DEPH*ZCJ(:)*ZLBDAH(:)**XEX1DEPH ) - &
+ ZZW1(:,6)*( ZRHODREF(:)*XCL*(XTT-ZZT(:))) ) / &
+ ( ZRHODREF(:)*XLMTT ) ) )
+ ZRRS(:) = ZRRS(:) + ZZW(:)
+ ZRHS(:) = ZRHS(:) - ZZW(:)
+! compute QHMLTR
+ ZWQ1(:,7) = XCOEF_RQ_H * ZQHT(:) * ZZW(:) / ZRHT(:)
+ ZTHS(:) = ZTHS(:) - ZZW(:) * (ZLSFACT(:) - ZLVFACT(:)) ! f(L_f*(-RHMLTR))
+ END WHERE
+!
+ WHERE (ZRHT(:) > XRTMIN_ELEC(7) .AND. ZRHS(:) > ZRSMIN_ELEC(7) .AND. &
+ ZZT(:) > XTT .AND. ABS(ZQHT(:)) > XQTMIN(7))
+ ZWQ1(:,7) = SIGN( MIN( ABS(ZQHS(:)),ABS(ZWQ1(:,7)) ),ZQHS(:) )
+ ZQRS(:) = ZQRS(:) + ZWQ1(:,7)
+ ZQHS(:) = ZQHS(:) - ZWQ1(:,7)
+ END WHERE
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HMLT', &
+ Unpack( -zzw(:) * ( zlsfact(:) - zlvfact(:) ) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'HMLT', &
+ Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rh ) call Budget_store_add( tbudgets(NBUDGET_RH), 'HMLT', &
+ Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'HMLT', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 6 ), 'HMLT', &
+ Unpack( zqhs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+ END IF
+!
+ DEALLOCATE(GHAIL)
+!
+ END SUBROUTINE RAIN_ICE_ELEC_FAST_RH
+!
+!-------------------------------------------------------------------------------
+!
+!
+ SUBROUTINE RAIN_ICE_ELEC_FAST_RI
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!-------------------------------------------------------------------------------
+!
+!* 7.1 cloud ice melting
+!
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'IMLT', &
+ Unpack( zths(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'IMLT', &
+ Unpack( zrcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'IMLT', &
+ Unpack( zris(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'IMLT', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'IMLT', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ ZZW(:) = 0.0
+ ZWQ1(:,1) = 0.0
+ WHERE ((ZRIS(:) > 0.0) .AND. (ZZT(:) > XTT))
+ ZZW(:) = ZRIS(:)
+ ZRCS(:) = ZRCS(:) + ZRIS(:)
+ ZTHS(:) = ZTHS(:) - ZRIS(:) * (ZLSFACT(:) - ZLVFACT(:)) ! f(L_f*(-RIMLTC))
+ ZRIS(:) = 0.0
+ ZCIT(:) = 0.0
+ ZQCS(:) = ZQCS(:) + ZQIS(:)
+ ZQIS(:) = 0.
+ END WHERE
+
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'IMLT', &
+ Unpack( zths(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'IMLT', &
+ Unpack( zrcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'IMLT', &
+ Unpack( zris(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'IMLT', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'IMLT', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+!
+!* 7.2 Bergeron-Findeisen effect: RCBERI
+!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'BERFI', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'BERFI', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ ZZW(:) = 0.0
+ ZWQ1(:,1) = 0.0
+ WHERE ((ZRCS(:) > 0.0) .AND. (ZSSI(:) > 0.0) .AND. &
+ (ZRIT(:) > XRTMIN(4)) .AND. (ZCIT(:) > 0.0) .AND. &
+ ZRCT(:) > 0.)
+ ZZW(:) = MIN(1.E8,XLBI*( ZRHODREF(:)*ZRIT(:)/ZCIT(:) )**XLBEXI) ! Lbda_i
+ ZZW(:) = MIN( ZRCS(:),( ZSSI(:) / (ZRHODREF(:)*ZAI(:)) ) * ZCIT(:) * &
+ ( X0DEPI/ZZW(:) + X2DEPI*ZCJ(:)*ZCJ(:)/ZZW(:)**(XDI+2.0) ) )
+ ZRCS(:) = ZRCS(:) - ZZW(:)
+ ZRIS(:) = ZRIS(:) + ZZW(:)
+ ZTHS(:) = ZTHS(:) + ZZW(:)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(RCBERI))
+!
+ ZWQ1(:,1) = XCOEF_RQ_C * ZQCT(:) * ZZW(:) / ZRCT(:)
+ END WHERE
+!
+ WHERE (ZRCS(:) > 0.0 .AND. ZSSI(:) > 0.0 .AND. &
+ ZRIT(:) > 0.0 .AND. ZCIT(:) > 0.0 .AND. &
+ ZRCT(:) > XRTMIN_ELEC(2) .AND. ABS(ZQCT(:)) > XQTMIN(2))
+ ZWQ1(:,1) = SIGN( MIN( ABS(ZQCS(:)),ABS(ZWQ1(:,1)) ),ZQCS(:) )
+ ZQIS(:) = ZQIS(:) + ZWQ1(:,1)
+ ZQCS(:) = ZQCS(:) - ZWQ1(:,1)
+ ENDWHERE
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'BERFI', &
+ Unpack( zzw(:) * ( zlsfact(:) - zlvfact(:) ) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'BERFI', &
+ Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'BERFI', &
+ Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'BERFI', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'BERFI', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ END SUBROUTINE RAIN_ICE_ELEC_FAST_RI
+!
+!-------------------------------------------------------------------------------
+!
+ SUBROUTINE COMPUTE_LBDA(ZRR, ZRS, ZRG, ZRH)
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+REAL, DIMENSION(:), INTENT(IN) :: ZRR, ZRS, ZRG
+REAL, DIMENSION(:), INTENT(IN), OPTIONAL :: ZRH
+!
+!
+!* 1. COMPUTE LAMBDA
+! --------------
+!
+ ZLBDAR(:) = 0.0
+ ZLBDAS(:) = 0.0
+ ZLBDAG(:) = 0.0
+!
+ WHERE( ZRR(:) > 0.0 )
+ ZLBDAR(:) = XLBR * (ZRHODREF(:) * MAX(ZRR(:), XRTMIN(3)))**XLBEXR
+ END WHERE
+!
+ WHERE ( ZRS(:) > 0.0 )
+ ZLBDAS(:) = MIN( XLBDAS_MAX, &
+ XLBS * (ZRHODREF(:) * MAX(ZRS(:), XRTMIN(5)))**XLBEXS )
+ END WHERE
+!
+ WHERE ( ZRG(:) > 0.0 )
+ ZLBDAG(:) = XLBG * (ZRHODREF(:) * MAX( ZRG(:), XRTMIN(6)))**XLBEXG
+ END WHERE
+!
+ IF (PRESENT(ZRH)) THEN
+ ZLBDAH(:) = 0.0
+ WHERE ( ZRH(:) > 0.0 )
+ ZLBDAH(:) = XLBH * (ZRHODREF(:) * MAX( ZRH(:), XRTMIN(7)))**XLBEXH
+ END WHERE
+ END IF
+!
+END SUBROUTINE COMPUTE_LBDA
+!
+!------------------------------------------------------------------------------
+!
+SUBROUTINE ELEC_UPDATE_QD(ZDUM, ZER, ZEI, ZES, ZEG, ZQR, ZQI, ZQS, ZQG, &
+ ZRR, ZRI, ZRS, ZRG, &
+ ZEH, ZQH, ZRH, ZEC, ZQC, ZRC)
+!
+! Purpose : update the parameter e_x in the relation q_x = e_x d**f_x
+! e_x = q_x/(N_x * M(f_x))
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+REAL, INTENT(IN) :: ZDUM ! =1. if mixing ratio
+ ! =timestep if source
+REAL, DIMENSION(:), INTENT(IN) :: ZQR, ZQI, ZQS, ZQG ! V. C.
+REAL, DIMENSION(:), INTENT(IN) :: ZRR, ZRI, ZRS, ZRG ! mixing ratio
+REAL, DIMENSION(:), INTENT(OUT) :: ZER, ZEI, ZES, ZEG ! Coef of the charge diameter relation
+REAL, DIMENSION(:), INTENT(IN), OPTIONAL :: ZQH ! hail
+REAL, DIMENSION(:), INTENT(IN), OPTIONAL :: ZRH ! hail
+REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: ZEH ! hail
+!
+REAL, DIMENSION(:), INTENT(IN), OPTIONAL :: ZQC ! V. C. for droplets
+REAL, DIMENSION(:), INTENT(IN), OPTIONAL :: ZRC ! mixing ration for droplets
+REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: ZEC ! Coef of the charge diameter relation for droplets
+REAL, DIMENSION(SIZE(XRTMIN)) :: ZRTMIN_E
+!
+!
+!* 1. UPDATE E_x
+! ----------
+!
+IF (PRESENT(ZEC)) ZEC(:) = 0.
+ZER(:) = 0.
+ZEI(:) = 0.
+ZES(:) = 0.
+ZEG(:) = 0.
+ZRTMIN_E(:) = XRTMIN(:) / ZDUM
+!
+!* 1.1 for cloud droplets
+!
+IF (PRESENT(ZEC) .AND. PRESENT(ZQC) .AND. PRESENT(ZRC)) THEN
+ WHERE (ZRC(:) > ZRTMIN_E(2))
+ ZEC(:) = ZDUM * ZRHODREF(:) * ZQC(:) / XFQUPDC
+ ZEC(:) = SIGN( MIN(ABS(ZEC(:)), XECMAX), ZEC(:))
+ ENDWHERE
+END IF
+!
+!* 1.2 for raindrops
+!
+WHERE (ZRR(:) > ZRTMIN_E(3) .AND. ZLBDAR(:) > 0.)
+ ZER(:) = ZDUM * ZRHODREF(:) * ZQR(:) / (XFQUPDR * ZLBDAR(:)**(XCXR - XFR))
+ ZER(:) = SIGN( MIN(ABS(ZER(:)), XERMAX), ZER(:))
+ENDWHERE
+!
+!* 1.3 for ice crystals
+!
+WHERE (ZRI(:) > ZRTMIN_E(4) .AND. ZCIT(:) > 0.0)
+ ZEI(:) = ZDUM * ZRHODREF(:) * ZQI(:) / &
+ ((ZCIT**(1 - XEXFQUPDI)) * XFQUPDI * (ZRHODREF(:) * &
+ ZDUM * ZRI(:))**XEXFQUPDI)
+ ZEI(:) = SIGN( MIN(ABS(ZEI(:)), XEIMAX), ZEI(:))
+ENDWHERE
+!
+!* 1.4 for snow
+!
+WHERE (ZRS(:) > ZRTMIN_E(5) .AND. ZLBDAS(:) > 0.)
+ ZES(:) = ZDUM * ZRHODREF(:) * ZQS(:) / (XFQUPDS * ZLBDAS(:)**(XCXS - XFS))
+ ZES(:) = SIGN( MIN(ABS(ZES(:)), XESMAX), ZES(:))
+ENDWHERE
+!
+!* 1.5 for graupel
+!
+WHERE (ZRG(:) > ZRTMIN_E(6).AND. ZLBDAG(:) > 0.)
+ ZEG(:) = ZDUM * ZRHODREF(:) * ZQG(:) / (XFQUPDG * ZLBDAG(:)**(XCXG - XFG))
+ ZEG(:) = SIGN( MIN(ABS(ZEG(:)), XEGMAX), ZEG(:))
+ENDWHERE
+!
+!* 1.6 for hail
+!
+IF (PRESENT(ZEH) .AND. PRESENT(ZQH) .AND. PRESENT(ZRH)) THEN
+ ZEH(:) = 0.
+ WHERE (ZRH(:) > ZRTMIN_E(7).AND. ZLBDAH(:) > 0.)
+ ZEH(:) = ZDUM * ZRHODREF(:) * ZQH(:) / (XFQUPDH * ZLBDAH(:)**(XCXH - XFH))
+ ZEH(:) = SIGN( MIN(ABS(ZEH(:)), XEHMAX), ZEH(:))
+ ENDWHERE
+END IF
+!
+END SUBROUTINE ELEC_UPDATE_QD
+!
+!-------------------------------------------------------------------------------
+!
+ SUBROUTINE ELEC_INI_NI_PROCESS
+!
+! Purpose : initialization for the non-inductive charging process
+!
+! GELEC(:,1) : logical variable for Ice-Snow process --> ELEC_IAGGS_B
+! from RAIN_ICE_ELEC_SLOW routine
+! GELEC(:,2) : logical variable for Ice-Graupel process --> ELEC_IDRYG_B
+! from RAIN_ICE_ELEC_FAST_RG
+! GELEC(:,3) : logical variable for Snow-Graupel process --> ELEC_SDRYG_B
+! from RAIN_ICE_ELEC_FAST_RG
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!
+!* 1. Gardiner et al. (1985)
+! ----------------------
+!
+ IF (CNI_CHARGING == 'GARDI') THEN
+ ZDELTALWC(:) = 0.
+ ZFT(:) = 0.
+!
+ GELEC(:,3) = ZZT(:) > (XTT - 40.) .AND. ZZT(:) < XTT
+ GELEC(:,1) = GELEC(:,3) .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. &
+ ZCIT(:) > 0.0 .AND. ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE
+ GELEC(:,2) = GELEC(:,3) .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZCIT(:) > 0.0 .AND. ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE
+ GELEC(:,3) = GELEC(:,3) .AND. &
+ ZRST(:) > XRTMIN_ELEC(5) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE .AND. &
+ ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE
+ GELEC(:,4) = GELEC(:,1) .OR. GELEC(:,2) .OR. GELEC(:,3)
+!
+ WHERE (GELEC(:,4))
+ ZFT(:) = - 1.7E-5 * ((-21 / (XQTC - XTT)) * (ZZT(:) - XTT))**3 &
+ - 0.003 * ((-21 / (XQTC - XTT)) * (ZZT(:) - XTT))**2 &
+ - 0.05 * ((-21 / (XQTC - XTT)) * (ZZT(:) - XTT)) &
+ + 0.13
+!
+ ZDELTALWC(:) = (ZRCT(:) * ZRHODREF(:) * 1.E3) - XLWCC ! (g m^-3)
+ ENDWHERE
+ ENDIF
+!
+!
+!* 2. Saunders et al. (1991)
+! ----------------------
+!
+!* 2.1 common to SAUN1 and SAUN2
+!
+ IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2') THEN
+ ZDQLWC(:) = 0.
+ ZEW(:) = 0.
+!
+! positive case is the default value
+ ZFQIAGGS(:) = XFQIAGGSP
+ ZFQIDRYGBS(:) = XFQIDRYGBSP
+ ZLBQSDRYGB1S(:) = XLBQSDRYGB1SP
+ ZLBQSDRYGB2S(:) = XLBQSDRYGB2SP
+ ZLBQSDRYGB3S(:) = XLBQSDRYGB3SP
+ ZSAUNIM(:) = XIMP !3.76
+ ZSAUNIN(:) = XINP !2.5
+ ZSAUNSK(:) = XSKP !52.8
+ ZSAUNSM(:) = XSMP !0.44
+ ZSAUNSN(:) = XSNP !2.5
+!
+! LWC_crit
+ ZLWCC(:) = MIN( MAX( -0.49 + 6.64E-2*(XTT-ZZT(:)),0.22 ),1.1 ) ! (g m^-3)
+!
+! Mansell et al. (2005, JGR): droplet collection efficiency of the graupel ~ 0.6-1.0
+ ZEW(:) = 0.8 * ZRCT(:) * ZRHODREF(:) * 1.E3 ! (g m^-3)
+!
+ GELEC(:,3) = ZZT(:) > (XTT - 40.) .AND. ZZT(:) <= XTT .AND. &
+ ZEW(:) >= 0.01 .AND. ZEW(:) <= 10.
+ GELEC(:,1) = GELEC(:,3) .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. &
+ ZCIT(:) > 0.0 .AND. ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE
+ GELEC(:,2) = GELEC(:,3) .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZCIT(:) > 0.0 .AND. ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE
+ GELEC(:,3) = GELEC(:,3) .AND. &
+ ZRST(:) > XRTMIN_ELEC(5) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE .AND. &
+ ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE
+!
+ ALLOCATE (GSAUN(IMICRO))
+ GSAUN(:) = .FALSE.
+!
+! For temperature lower than -30C and higher than -40C, value of q at -30C
+ GSAUN(:) = GELEC(:,1) .OR. GELEC(:,2) .OR. GELEC(:,3)
+ IGSAUN = COUNT (GSAUN(:))
+!
+ IF (IGSAUN > 0) THEN
+ CALL ELEC_INI_NI_SAUNQ(ZEW, ZDQLWC)
+!
+ WHERE (ZDQLWC(:) < 0.)
+ ZFQIAGGS(:) = XFQIAGGSN
+ ZFQIDRYGBS(:) = XFQIDRYGBSN
+ ZLBQSDRYGB1S(:) = XLBQSDRYGB1SN
+ ZLBQSDRYGB2S(:) = XLBQSDRYGB2SN
+ ZLBQSDRYGB3S(:) = XLBQSDRYGB3SN
+ ZSAUNIM(:) = XIMN !2.54
+ ZSAUNIN(:) = XINN !2.8
+ ZSAUNSK(:) = XSKN !24.
+ ZSAUNSM(:) = XSMN !0.5
+ ZSAUNSN(:) = XSNN !2.8
+ ENDWHERE
+ ENDIF
+!
+ DEALLOCATE( GSAUN )
+ END IF
+!
+!
+!* 3. Saunders and Peck (1998)
+!
+ IF (CNI_CHARGING == 'SAP98') THEN
+ ZRAR_CRIT(:) = 0.
+!
+! compute the critical rime accretion rate
+ WHERE (ZZT(:) <= XTT .AND. ZZT(:) >= (XTT - 23.7)) ! Original from SAP98
+ ZRAR_CRIT(:) = 1.0 + 7.93E-2 * (ZZT(:) - XTT) + &
+ 4.48E-2 * (ZZT(:) - XTT)**2 + &
+ 7.48E-3 * (ZZT(:) - XTT)**3 + &
+ 5.47E-4 * (ZZT(:) - XTT)**4 + &
+ 1.67E-5 * (ZZT(:) - XTT)**5 + &
+ 1.76E-7 * (ZZT(:) - XTT)**6
+ END WHERE
+!
+ WHERE (ZZT(:) < (XTT - 23.7) .AND. ZZT(:) > (XTT - 40.)) ! Added by Mansell
+ ZRAR_CRIT(:) = 3.4 * (1.0 - (ABS(ZZT(:) - XTT + 23.7) / & ! et al. (2005)
+ (-23.7 + 40.))**3.)
+ END WHERE
+!
+ GELEC(:,3) = ZZT(:) >= (XTT - 40.) .AND. ZZT(:) <= XTT
+ GELEC(:,1) = GELEC(:,3) .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. &
+ ZCIT(:) > 0.0 .AND. ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE
+ GELEC(:,2) = GELEC(:,3) .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZCIT(:) > 0.0 .AND. ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE
+ GELEC(:,3) = GELEC(:,3) .AND. &
+ ZRST(:) > XRTMIN_ELEC(5) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE .AND. &
+ ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE
+!
+!+++++++++ I - G collisions +++++++++
+ ZSAUNIM_IG(:) = 0.
+!
+! positive case is the default value
+ ZSAUNIM_IG(:) = XIMP
+ ZSAUNIN_IG(:) = XINP
+!
+! Compute the Rime Accretion Rate
+ ZRAR(:) = 0.
+ ZVGMEAN(:) = 0.
+ WHERE (ZLBDAG(:) > 0. .AND. ZRCT(:) > 0.)
+ ZVGMEAN(:) = XVGCOEF * ZRHOCOR(:) * ZLBDAG(:)**(-XDG)
+ ZRAR(:) = 0.8 * ZRHODREF(:) * ZRCT(:) * ZVGMEAN(:) * 1.E3
+ END WHERE
+!
+ GELEC(:,2) = GELEC(:,2) .AND. ZRAR(:) > 0.1
+ GELEC(:,4) = GELEC(:,2)
+!
+ IF (COUNT(GELEC(:,4)) .GT. 0) THEN
+!
+! compute the coefficients for I-G collisions
+ CALL ELEC_INI_NI_SAP98 (ZRAR, ZDQRAR_IG)
+!
+ WHERE (ZDQRAR_IG(:) < 0.)
+ ZSAUNIM_IG(:) = XIMN
+ ZSAUNIN_IG(:) = XINN
+ ENDWHERE
+ ENDIF
+!
+!+++++++++ I - S collisions +++++++++
+ ZDQRAR_IS(:) = 0.
+!
+! positive case is the default value
+ ZSAUNIM_IS(:) = XIMP
+ ZSAUNIN_IS(:) = XINP
+!
+! Compute the Rime Accretion Rate
+ ZRAR(:) = 0.
+ ZVSMEAN(:) = 0.
+!
+ WHERE (ZLBDAS(:) > 0. .AND. ZRCT(:) > 0.)
+ ZVSMEAN(:) = XVSCOEF * ZRHOCOR(:) * ZLBDAS(:)**(-XDS)
+ ZRAR(:) = 0.8 * ZRHODREF(:) * ZRCT(:) * ZVSMEAN(:) * 1.E3
+ END WHERE
+!
+ GELEC(:,1) = GELEC(:,1) .AND. ZRAR(:) > 0.1
+ GELEC(:,4) = GELEC(:,1)
+!
+ IF (COUNT(GELEC(:,4)) .GT. 0) THEN
+! compute the coefficients for I-S collisions
+ CALL ELEC_INI_NI_SAP98 (ZRAR, ZDQRAR_IS)
+!
+ WHERE (ZDQRAR_IS(:) < 0.)
+ ZSAUNIM_IS(:) = XIMN
+ ZSAUNIN_IS(:) = XINN
+ ENDWHERE
+ ENDIF
+!
+!+++++++++ S - G collisions +++++++++
+ ZDQRAR_SG(:) = 0.
+!
+! positive case is the default value
+ ZSAUNSK_SG(:) = XSKP
+ ZSAUNSM_SG(:) = XSMP
+ ZSAUNSN_SG(:) = XSNP
+!
+! Compute the Rime Accretion Rate
+ ZRAR(:) = 0.
+!
+ WHERE (ZVSMEAN(:) > 0. .AND. ZVGMEAN(:) > 0.)
+ ZRAR(:) = 0.8 * ZRHODREF(:) * ZRCT(:) * ABS(ZVGMEAN(:) - ZVSMEAN(:)) * 1.E3
+ END WHERE
+!
+ GELEC(:,3) = GELEC(:,3) .AND. ZRAR(:) > 0.1
+ GELEC(:,4) = GELEC(:,3)
+!
+ IF( COUNT(GELEC(:,4)) .GT. 0) THEN
+!
+! compute the coefficients for S-G collisions
+ CALL ELEC_INI_NI_SAP98 (ZRAR, ZDQRAR_SG)
+!
+ WHERE (ZDQRAR_SG(:) < 0.)
+ ZSAUNSK_SG(:) = XSKN
+ ZSAUNSM_SG(:) = XSMN
+ ZSAUNSN_SG(:) = XSNN
+ ENDWHERE
+ ENDIF
+ END IF
+!
+!* 4. Brooks et al. (1997) without / with anomalies
+!
+ IF (CNI_CHARGING == 'BSMP1' .OR. CNI_CHARGING == 'BSMP2') THEN
+
+ ALLOCATE (GSAUN(IMICRO))
+!
+! compute the critical rime accretion rate
+ WHERE (ZZT(:) > (XTT - 10.7))
+ ZRAR_CRIT(:) = 0.66
+ END WHERE
+ WHERE (ZZT(:) <= (XTT - 10.7) .AND. ZZT(:) >= (XTT - 23.7))
+ ZRAR_CRIT(:) = -1.47 - 0.2 * (ZZT(:) - XTT)
+ END WHERE
+ WHERE (ZZT(:) < (XTT - 23.7) .AND. ZZT(:) > (XTT - 40.))
+ ZRAR_CRIT(:) = 3.3
+ END WHERE
+!
+ GELEC(:,3) = ZZT(:) > (XTT - 40.) .AND. ZZT(:) <= XTT .AND. &
+ ZEW(:) >= 0.01 .AND. ZEW(:) <= 10.
+ GELEC(:,1) = GELEC(:,3) .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. &
+ ZCIT(:) > 0.0 .AND. ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE
+ GELEC(:,2) = GELEC(:,3) .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZCIT(:) > 0.0 .AND. ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE
+ GELEC(:,3) = GELEC(:,3) .AND. &
+ ZRST(:) > XRTMIN_ELEC(5) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE .AND. &
+ ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE
+!
+!+++++++++ I - S collisions +++++++++
+ ZDQRAR_IS(:) = 0.
+!
+! positive case is the default value
+ ZSAUNIM_IS(:) = XIMP
+ ZSAUNIN_IS(:) = XINP
+!
+ GSAUN(:) = .FALSE.
+!
+! Compute the Rime Accretion Rate
+ ZRAR(:) = 0.
+ ZVSMEAN(:) = 0.
+!
+ WHERE (ZLBDAS(:) > 0. .AND. ZRCT(:) > 0.)
+ ZVSMEAN(:) = XVSCOEF * ZRHOCOR(:) * ZLBDAS(:)**(-XDS)
+ ZRAR(:) = 0.8 * ZRHODREF(:) * ZRCT(:) * ZVSMEAN(:) * 1.E3
+ END WHERE
+!
+ GELEC(:,1) = GELEC(:,1) .AND. ZRAR(:) > 0.1
+ GSAUN(:) = GELEC(:,1)
+ IGSAUN = COUNT (GSAUN(:))
+!
+ IF (IGSAUN .GT. 0) THEN
+ ZEW(:) = ZRAR(:) / 3.
+!
+ CALL ELEC_INI_NI_SAUNQ (ZEW, ZDQRAR_IS)
+!
+ WHERE (ZDQRAR_IS(:) < 0.)
+ ZSAUNIM_IS(:) = XIMN
+ ZSAUNIN_IS(:) = XINN
+ ENDWHERE
+ ENDIF
+!
+!+++++++++ I - G collisions +++++++++
+ ZDQRAR_IG(:) = 0.
+!
+! positive case is the default value
+ ZSAUNIM_IG(:) = XIMP
+ ZSAUNIN_IG(:) = XINP
+!
+ GSAUN(:) = .FALSE.
+!
+! Compute the Rime Accretion Rate
+ ZRAR(:) = 0.
+ ZVGMEAN(:) = 0.
+!
+ WHERE (ZLBDAG(:) > 0. .AND. ZRCT(:) > 0.)
+ ZVGMEAN(:) = XVGCOEF * ZRHOCOR(:) * ZLBDAG(:)**(-XDG)
+ ZRAR(:) = 0.8 * ZRHODREF(:) * ZRCT(:) * ZVGMEAN(:) * 1.E3
+ END WHERE
+!
+ GELEC(:,2) = GELEC(:,2) .AND. ZRAR(:) > 0.1
+ GSAUN(:) = GELEC(:,2)
+ IGSAUN = COUNT (GSAUN(:))
+!
+ IF (IGSAUN .GT. 0) THEN
+ ZEW(:) = ZRAR(:) / 3.
+ CALL ELEC_INI_NI_SAUNQ (ZEW, ZDQRAR_IG)
+!
+ WHERE (ZDQRAR_IG(:) < 0.)
+ ZSAUNIM_IG(:) = XIMN
+ ZSAUNIN_IG(:) = XINN
+ ENDWHERE
+ ENDIF
+!
+!+++++++++ S - G collisions +++++++++
+ ZDQRAR_SG(:) = 0.
+!
+! positive case is the default value
+ ZSAUNSK_SG(:) = XSKP
+ ZSAUNSM_SG(:) = XSMP
+ ZSAUNSN_SG(:) = XSNP
+!
+ GSAUN(:) = .FALSE.
+!
+! Compute the Rime Accretion Rate
+ ZRAR(:) = 0.
+!
+ WHERE (ZVSMEAN(:) > 0. .AND. ZVGMEAN(:) > 0.)
+ ZRAR(:) = 0.8 * ZRHODREF(:) * ZRCT(:) * ABS(ZVGMEAN(:) - ZVSMEAN(:)) * 1.E3
+ END WHERE
+!
+ GELEC(:,3) = GELEC(:,3) .AND. ZRAR(:) > 0.1
+ GSAUN(:) = GELEC(:,3)
+ IGSAUN = COUNT (GSAUN(:))
+!
+ IF (IGSAUN .GT. 0) THEN
+ ZEW(:) = ZRAR(:) / 3.
+ CALL ELEC_INI_NI_SAUNQ (ZEW, ZDQRAR_SG)
+!
+ WHERE (ZDQRAR_SG(:) < 0.)
+ ZSAUNSK_SG(:) = XSKN
+ ZSAUNSM_SG(:) = XSMN
+ ZSAUNSN_SG(:) = XSNN
+ ENDWHERE
+ ENDIF
+!
+ DEALLOCATE( GSAUN )
+ END IF
+!
+!
+!* 5. Takahashi (1978)
+!
+ IF (CNI_CHARGING == 'TAKAH') THEN
+ ZDQLWC(:) = 0.
+!
+ ZEW(:) = ZRCT(:) * ZRHODREF(:) * 1.E3 ! (g m^-3)
+!
+ GELEC(:,3) = ZZT(:) > (XTT - 40.) .AND. ZZT(:) <= XTT .AND. &
+ ZEW(:) >= 0.01 .AND. ZEW(:) <= 10.
+ GELEC(:,1) = GELEC(:,3) .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. &
+ ZCIT(:) > 0.0 .AND. ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE
+ GELEC(:,2) = GELEC(:,3) .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZCIT(:) > 0.0 .AND. ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE
+ GELEC(:,3) = GELEC(:,3) .AND. &
+ ZRST(:) > XRTMIN_ELEC(5) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE .AND. &
+ ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE
+!
+ ALLOCATE (GTAKA(IMICRO))
+ GTAKA(:) = .FALSE.
+!
+! For temperature lower than -30C and higher than -40C, value of q at -30C
+ GTAKA(:) = GELEC(:,1) .OR. GELEC(:,2) .OR. GELEC(:,3)
+ IGTAKA = COUNT (GTAKA(:))
+!
+ IF (IGTAKA > 0) THEN
+ CALL ELEC_INI_NI_TAKAH(ZEW, ZDQLWC, XMANSELL)
+ ENDIF
+!
+ DEALLOCATE( GTAKA )
+ ENDIF
+!
+!
+!* 6. Takahashi with EW (Tsenova and Mitzeva, 2009)
+!
+ IF (CNI_CHARGING == 'TEEWC') THEN
+ ZDQLWC(:) = 0.
+!
+! positive case is the default value
+ ZFQIAGGS(:) = XFQIAGGSP_TAK
+ ZFQIDRYGBS(:) = XFQIDRYGBSP_TAK
+ ZLBQSDRYGB1S(:) = XLBQSDRYGB1SP
+ ZLBQSDRYGB2S(:) = XLBQSDRYGB2SP
+ ZLBQSDRYGB3S(:) = XLBQSDRYGB3SP
+ ZSAUNIM(:) = XIMP !3.76
+ ZSAUNIN(:) = XINP !2.5
+ ZSAUNSK(:) = XSKP_TAK !6.5
+ ZSAUNSM(:) = XSMP !0.44
+ ZSAUNSN(:) = XSNP !2.5
+!
+! Compute the effective water content
+ ZEW(:) = 0.
+!
+ WHERE (ZLBDAG(:) > 0. .AND. ZRCT(:) > 0.)
+ ZEW(:) = 0.8 * ZRHODREF(:) * ZRCT(:) * 1.E3
+ END WHERE
+!
+ GELEC(:,3) = ZZT(:) >= (XTT - 40.) .AND. ZZT(:) <= XTT .AND. &
+ ZEW(:) >= 0.01 .AND. ZEW(:) <= 10.
+ GELEC(:,1) = GELEC(:,3) .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. &
+ ZCIT(:) > 0.0 .AND. ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE
+ GELEC(:,2) = GELEC(:,3) .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZCIT(:) > 0.0 .AND. ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE
+ GELEC(:,3) = GELEC(:,3) .AND. &
+ ZRST(:) > XRTMIN_ELEC(5) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE .AND. &
+ ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE
+!
+ ALLOCATE (GTAKA(IMICRO))
+ GTAKA(:) = .FALSE.
+!
+! For temperature lower than -30C and higher than -40C, value of q at -30C
+ GTAKA(:) = GELEC(:,1) .OR. GELEC(:,2) .OR. GELEC(:,3)
+ IGTAKA = COUNT (GTAKA(:))
+!
+ IF (IGTAKA > 0) THEN
+ CALL ELEC_INI_NI_TAKAH(ZEW, ZDQLWC, XTAKA_TM)
+!
+ WHERE (ZDQLWC(:) < 0.)
+ ZFQIAGGS(:) = XFQIAGGSN_TAK
+ ZFQIDRYGBS(:) = XFQIDRYGBSN_TAK
+ ZLBQSDRYGB1S(:) = XLBQSDRYGB1SN
+ ZLBQSDRYGB2S(:) = XLBQSDRYGB2SN
+ ZLBQSDRYGB3S(:) = XLBQSDRYGB3SN
+ ZSAUNIM(:) = XIMN !2.54
+ ZSAUNIN(:) = XINN !2.8
+ ZSAUNSK(:) = XSKN_TAK !2.0
+ ZSAUNSM(:) = XSMN !0.5
+ ZSAUNSN(:) = XSNN !2.8
+ ENDWHERE
+ ENDIF
+!
+ DEALLOCATE( GTAKA )
+ ENDIF
+!
+!
+!* 7. Takahashi with RAR (Tsenova and Mitzeva, 2011)
+!
+ IF (CNI_CHARGING == 'TERAR') THEN
+!
+ ALLOCATE (GTAKA(IMICRO))
+!
+ GELEC(:,3) = ZZT(:) >= (XTT - 40.) .AND. ZZT(:) <= XTT
+ GELEC(:,1) = GELEC(:,3) .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. &
+ ZCIT(:) > 0.0 .AND. ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE
+ GELEC(:,2) = GELEC(:,3) .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZCIT(:) > 0.0 .AND. ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE
+ GELEC(:,3) = GELEC(:,3) .AND. &
+ ZRST(:) > XRTMIN_ELEC(5) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE .AND. &
+ ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE
+!
+!+++++++++ I - S collisions +++++++++
+ ZDQRAR_IS(:) = 0.
+!
+! positive case is the default value
+ ZSAUNIM_IS(:) = XIMP
+ ZSAUNIN_IS(:) = XINP
+!
+ GTAKA(:) = .FALSE.
+!
+! Compute the Rime Accretion Rate
+ ZRAR(:) = 0.
+ ZVSMEAN(:) = 0.
+!
+ WHERE (ZLBDAS(:) > 0. .AND. ZRCT(:) > 0.)
+ ZVSMEAN(:) = XVSCOEF * ZRHOCOR(:) * ZLBDAS(:)**(-XDS)
+ ZRAR(:) = 0.8 * ZRHODREF(:) * ZRCT(:) * ZVSMEAN(:) * 1.E3
+ END WHERE
+!
+ GELEC(:,1) = GELEC(:,1) .AND. ZRAR(:) > 0.01 .AND. ZRAR(:) <= 80.
+ GTAKA(:) = GELEC(:,1)
+!
+ IGTAKA = COUNT (GTAKA(:))
+!
+ IF (IGTAKA > 0) THEN
+ ZEW(:) = ZRAR(:) / 8.
+ CALL ELEC_INI_NI_TAKAH(ZEW, ZDQRAR_IS, XTAKA_TM)
+!
+ WHERE (ZDQRAR_IS(:) < 0.)
+ ZSAUNIM_IS(:) = XIMN
+ ZSAUNIN_IS(:) = XINN
+ ENDWHERE
+ END IF
+!
+!
+!+++++++++ I - G collisions +++++++++
+ ZDQRAR_IG(:) = 0.
+!
+! positive case is the default value
+ ZSAUNIM_IG(:) = XIMP
+ ZSAUNIN_IG(:) = XINP
+!
+ GTAKA(:) = .FALSE.
+!
+! Compute the Rime Accretion Rate
+ ZRAR(:) = 0.
+ ZVGMEAN(:) = 0.
+!
+ WHERE (ZLBDAG(:) > 0. .AND. ZRCT(:) > 0.)
+ ZVGMEAN(:) = XVGCOEF * ZRHOCOR(:) * ZLBDAG(:)**(-XDG)
+ ZRAR(:) = 0.8 * ZRHODREF(:) * ZRCT(:) * ZVGMEAN(:) * 1.E3
+ END WHERE
+!
+ GELEC(:,2) = GELEC(:,2) .AND. ZRAR(:) > 0.01 .AND. ZRAR(:) <= 80.
+ GTAKA(:) = GELEC(:,2)
+!
+ IGTAKA = COUNT (GTAKA(:))
+!
+ IF (IGTAKA > 0) THEN
+ ZEW(:) = ZRAR(:) / 8.
+ CALL ELEC_INI_NI_TAKAH(ZEW, ZDQRAR_IG, XTAKA_TM)
+!
+ WHERE (ZDQRAR_IG(:) < 0.)
+ ZSAUNIM_IG(:) = XIMN
+ ZSAUNIN_IG(:) = XINN
+ ENDWHERE
+ ENDIF
+!
+!+++++++++ S - G collisions +++++++++
+ ZDQRAR_SG(:) = 0.
+!
+! positive case is the default value
+ ZSAUNSK_SG(:) = XSKP_TAK
+ ZSAUNSM_SG(:) = XSMP
+ ZSAUNSN_SG(:) = XSNP
+!
+ GTAKA(:) = .FALSE.
+!
+! Compute the Rime Accretion Rate
+ ZRAR(:) = 0.
+!
+ WHERE (ZVSMEAN(:) > 0. .AND. ZVGMEAN(:) > 0.)
+ ZRAR(:) = 0.8 * ZRHODREF(:) * ZRCT(:) * ABS(ZVGMEAN(:) - ZVSMEAN(:)) * 1.E3
+ END WHERE
+!
+ GELEC(:,3) = GELEC(:,3) .AND. ZRAR(:) > 0.01 .AND. ZRAR(:) <= 80
+ GTAKA(:) = GELEC(:,3)
+ IGTAKA = COUNT (GTAKA(:))
+!
+ IF (IGTAKA > 0) THEN
+ ZEW(:) = ZRAR(:) / 8.
+ CALL ELEC_INI_NI_TAKAH(ZEW, ZDQRAR_SG, XTAKA_TM)
+!
+ WHERE (ZDQRAR_SG(:) < 0.)
+ ZSAUNSK_SG(:) = XSKN_TAK
+ ZSAUNSM_SG(:) = XSMN
+ ZSAUNSN_SG(:) = XSNN
+ ENDWHERE
+ ENDIF
+!
+ DEALLOCATE( GTAKA )
+ END IF
+!
+END SUBROUTINE ELEC_INI_NI_PROCESS
+!
+!-------------------------------------------------------------------------------
+!
+ SUBROUTINE ELEC_INI_NI_SAP98(ZRAR, ZDQRAR_AUX)
+!
+IMPLICIT NONE
+!
+REAL, DIMENSION(:), INTENT(IN) :: ZRAR
+REAL, DIMENSION(:), INTENT(INOUT) :: ZDQRAR_AUX ! q= f(RAR,T) in Saunders and
+ ! Peck's equation
+!
+ ZDQRAR_AUX(:) = 0.
+!
+! positive region : Mansell et al., 2005
+ WHERE (GELEC(:,4) .AND. ZRAR(:) > ZRAR_CRIT(:))
+ ZDQRAR_AUX(:) = MAX(0., 6.74 * (ZRAR(:) - ZRAR_CRIT(:)) * 1.E-15)
+ ENDWHERE
+!
+! negative region : Mansell et al. 2005
+ WHERE (GELEC(:,4) .AND. ZRAR(:) < ZRAR_CRIT(:))
+ ZDQRAR_AUX(:) = MIN(0., 3.9 * (ZRAR_CRIT(:) - 0.1) * &
+ (4.0 * ((ZRAR(:) - (ZRAR_CRIT(:) + 0.1) / 2.) / &
+ (ZRAR_CRIT(:) - 0.1))**2 - 1.) * 1.E-15)
+ ENDWHERE
+!
+END SUBROUTINE ELEC_INI_NI_SAP98
+!
+!-------------------------------------------------------------------------------
+!
+ SUBROUTINE ELEC_INI_NI_SAUNQ(ZEW, ZDQLWC_AUX)
+!
+IMPLICIT NONE
+!
+REAL, DIMENSION(:), INTENT(IN) :: ZEW
+REAL, DIMENSION(:), INTENT(INOUT) :: ZDQLWC_AUX ! q= f(RAR or EW,T) in Saunders
+ !... equation
+!
+! For temperature lower than -30C and higher than -40C, value of q at -30C
+!
+ ALLOCATE ( IVEC1(IGSAUN) )
+ ALLOCATE ( IVEC2(IGSAUN) )
+ ALLOCATE ( ZVEC1(IGSAUN) )
+ ALLOCATE ( ZVEC2(IGSAUN) )
+ ALLOCATE ( ZDQLWC_OPT(IGSAUN) )
+!
+ ZDQLWC_OPT(:) = 0.
+ IVEC1(:) = 0
+ IVEC2(:) = 0
+!
+ ZVEC1(:) = PACK( ZZT(:), MASK=GSAUN(:))
+ ZVEC2(:) = PACK( ZEW(:), MASK=GSAUN(:))
+ ZDQLWC_OPT(:) = PACK( ZDQLWC_AUX(:), MASK=GSAUN )
+!
+! Temperature index (0C --> -40C)
+ ZVEC1(1:IGSAUN) = MAX( 1.00001, MIN( REAL(NIND_TEMP)-0.00001, &
+ (ZVEC1(1:IGSAUN) - XTT - 1.)/(-1.) ) )
+ IVEC1(1:IGSAUN) = INT( ZVEC1(1:IGSAUN) )
+ ZVEC1(1:IGSAUN) = ZVEC1(1:IGSAUN) - REAL(IVEC1(1:IGSAUN))
+!
+! LWC index (0.01 g.m^-3 --> 10 g.m^-3)
+ WHERE (ZVEC2(:) >= 0.01 .AND. ZVEC2(:) < 0.1)
+ ZVEC2(:) = MAX( 1.00001, MIN( REAL(10)-0.00001, &
+ ZVEC2(:) * 100. ))
+ IVEC2(:) = INT(ZVEC2(:))
+ ZVEC2(:) = ZVEC2(:) - REAL(IVEC2(:))
+ ENDWHERE
+!
+ WHERE (ZVEC2(:) >= 0.1 .AND. ZVEC2(:) < 1. .AND. IVEC2(:) == 0)
+ ZVEC2(:) = MAX( 10.00001, MIN( REAL(19)-0.00001, &
+ ZVEC2(:) * 10. + 9. ) )
+ IVEC2(:) = INT(ZVEC2(:))
+ ZVEC2(:) = ZVEC2(:) - REAL(IVEC2(:))
+ ENDWHERE
+!
+ WHERE ((ZVEC2(:) >= 1.) .AND. ZVEC2(:) <= 10.)
+ ZVEC2(:) = MAX( 19.00001, MIN( REAL(NIND_LWC)-0.00001, &
+ ZVEC2(:) + 18. ) )
+ IVEC2(:) = INT(ZVEC2(:))
+ ZVEC2(:) = ZVEC2(:) - REAL(IVEC2(:))
+ ENDWHERE
+!
+! Interpolate XSAUNDER
+ ZDQLWC_OPT(:) = BI_LIN_INTP_V( XSAUNDER, IVEC2, IVEC1, ZVEC2, ZVEC1, &
+ IGSAUN )
+ ZDQLWC_AUX(:) = UNPACK( ZDQLWC_OPT(:), MASK=GSAUN, FIELD=0.0 )
+!
+ DEALLOCATE( IVEC1 )
+ DEALLOCATE( IVEC2 )
+ DEALLOCATE( ZVEC1 )
+ DEALLOCATE( ZVEC2 )
+ DEALLOCATE( ZDQLWC_OPT )
+!
+END SUBROUTINE ELEC_INI_NI_SAUNQ
+!
+!-------------------------------------------------------------------------------
+!
+ SUBROUTINE ELEC_INI_NI_TAKAH(ZEW, ZDQTAKA_AUX, XTAKA_AUX)
+!
+IMPLICIT NONE
+!
+REAL, DIMENSION(IMICRO) :: ZEW
+REAL, DIMENSION(IMICRO) :: ZDQTAKA_AUX
+REAL, DIMENSION(NIND_LWC+1,NIND_TEMP+1) :: XTAKA_AUX !XMANSELL or XTAKA_TM)
+!
+!
+ ALLOCATE ( IVEC1(IGTAKA) )
+ ALLOCATE ( IVEC2(IGTAKA) )
+ ALLOCATE ( ZVEC1(IGTAKA) )
+ ALLOCATE ( ZVEC2(IGTAKA) )
+ ALLOCATE ( ZDQTAKA_OPT(IGTAKA) )
+
+ ZDQTAKA_OPT(:) = 0.
+ IVEC1(:) = 0
+ IVEC2(:) = 0
+!
+ ZVEC1(:) = PACK( ZZT(:), MASK=GTAKA )
+ ZVEC2(:) = PACK( ZEW(:), MASK=GTAKA )
+ ZDQTAKA_OPT(:) = PACK( ZDQTAKA_AUX(:), MASK=GTAKA )
+!
+! Temperature index (0C --> -40C)
+ ZVEC1(1:IGTAKA) = MAX( 1.00001, MIN( REAL(NIND_TEMP)-0.00001, &
+ (ZVEC1(1:IGTAKA) - XTT - 1.)/(-1.) ) )
+ IVEC1(1:IGTAKA) = INT( ZVEC1(1:IGTAKA) )
+ ZVEC1(1:IGTAKA) = ZVEC1(1:IGTAKA) - REAL(IVEC1(1:IGTAKA))
+!
+! LWC index (0.01 g.m^-3 --> 10 g.m^-3)
+ WHERE (ZVEC2(:) >= 0.01 .AND. ZVEC2(:) < 0.1)
+ ZVEC2(:) = MAX( 1.00001, MIN( REAL(10)-0.00001, &
+ ZVEC2(:) * 100. ))
+ IVEC2(:) = INT(ZVEC2(:))
+ ZVEC2(:) = ZVEC2(:) - REAL(IVEC2(:))
+ ENDWHERE
+!
+ WHERE (ZVEC2(:) >= 0.1 .AND. ZVEC2(:) < 1. .AND. IVEC2(:) == 0)
+ ZVEC2(:) = MAX( 10.00001, MIN( REAL(19)-0.00001, &
+ ZVEC2(:) * 10. + 9. ) )
+ IVEC2(:) = INT(ZVEC2(:))
+ ZVEC2(:) = ZVEC2(:) - REAL(IVEC2(:))
+ ENDWHERE
+!
+ WHERE (ZVEC2(:) >= 1. .AND. ZVEC2(:) <= 10.)
+ ZVEC2(:) = MAX( 19.00001, MIN( REAL(NIND_LWC)-0.00001, &
+ ZVEC2(:) + 18. ) )
+ IVEC2(:) = INT(ZVEC2(:))
+ ZVEC2(:) = ZVEC2(:) - REAL(IVEC2(:))
+ ENDWHERE
+!
+! Interpolate XMANSELL or XTAKA_TM
+ ZDQTAKA_OPT(:) = BI_LIN_INTP_V( XTAKA_AUX, IVEC2, IVEC1, ZVEC2, ZVEC1, &
+ IGTAKA )
+ ZDQTAKA_AUX(:) = UNPACK( ZDQTAKA_OPT(:), MASK=GTAKA, FIELD=0.0 )
+!
+ DEALLOCATE( IVEC1 )
+ DEALLOCATE( IVEC2 )
+ DEALLOCATE( ZVEC1 )
+ DEALLOCATE( ZVEC2 )
+ DEALLOCATE( ZDQTAKA_OPT )
+!
+END SUBROUTINE ELEC_INI_NI_TAKAH
+!
+!-------------------------------------------------------------------------------
+!
+ SUBROUTINE ELEC_IAGGS_B()
+!
+! Purpose : compute charge separation process during the collision
+! between ice and snow
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!* 1. Collision efficiency
+!
+ ZCOLIS(:) = XCOLIS * EXP(XCOLEXIS * (ZZT(:) - XTT))
+!
+!* 2. Charging process following Helsdon and Farley (1987)
+!
+ IF (CNI_CHARGING == 'HELFA') THEN
+ ZWQ1(:,7) = 0.
+!
+ WHERE (ZRIS(:) > XRTMIN_ELEC(4) .AND. ZCIT(:) > 0.0 .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. &
+ ZRST(:) > XRTMIN_ELEC(5))
+ ZWQ1(:,7) = XFQIAGGSBH * ZZW(:) * ZCIT(:) / ZRIT(:)
+ ZWQ1(:,7) = ZWQ1(:,7) * (1. - ZCOLIS(:)) / ZCOLIS(:)
+!
+! Temperature dependance of the charge transferred
+ ZWQ1(:,7) = ZWQ1(:,7) * (ZZT(:) - XQTC) / ABS(ZZT(:) - XQTC)
+ ZWQ1(:,7) = ZWQ1(:,7) / ZRHODREF(:)
+!
+ ZQSS(:) = ZQSS(:) + ZWQ1(:,7)
+ ZQIS(:) = ZQIS(:) - ZWQ1(:,7)
+ END WHERE
+ END IF
+!
+!* 3. Charging process following Gardiner et al. (1985)
+!
+ IF (CNI_CHARGING == 'GARDI') THEN
+ ZWQ1(:,7) = 0.
+ WHERE (GELEC(:,1) .AND. ZDELTALWC(:) > 0. .AND. &
+ ZRIS(:) > ZRSMIN_ELEC(4) .AND. ZRSS(:) > ZRSMIN_ELEC(5))
+ ZWQ1(:,7) = XFQIAGGSBG * (1 - ZCOLIS(:)) * &
+ ZRHODREF(:)**(-4. * XCEXVT + 4. / XBI) * &
+ ZCIT(:)**(1 - 4. / XBI) * &
+ ZDELTALWC(:) * ZFT(:) * &
+ ZLBDAS(:)**(XCXS - 2. - 4. * XDS) * &
+ (XAI * MOMG(XALPHAI, XNUI, XBI) / &
+ ZRIT(:))**(-4 / XBI)
+!
+! Dq is limited to XLIM_NI_IS
+ ZLIMIT(:) = XLIM_NI_IS * ZZW(:) * ZCIT(:) * &
+ (1 - ZCOLIS(:)) / (ZRIT(:) * ZCOLIS(:))
+ ZWQ1(:,7) = SIGN( MIN( ABS(ZLIMIT(:)), ABS(ZWQ1(:,7)) ), ZWQ1(:,7) )
+ ZWQ1(:,7) = ZWQ1(:,7) / ZRHODREF(:)
+ ENDWHERE
+!
+! For temperatures lower than -30C --> linear interpolation
+ WHERE (ZWQ1(:,7) /= 0. .AND. ZZT(:) < (XTT-30.) .AND. ZZT(:) >= (XTT-40.))
+ ZWQ1(:,7) = ZWQ1(:,7) * (ZZT(:) - XTT + 40.) / 10.
+ ENDWHERE
+!
+ ZQSS(:) = ZQSS(:) + ZWQ1(:,7)
+ ZQIS(:) = ZQIS(:) - ZWQ1(:,7)
+ END IF
+!
+!* 4. Charging process based on EW: SAUN1/SAUN2, TEEWC
+!* following Saunders et al. (1991), Takahashi via Tsenova and Mitzeva (2009)
+!
+ IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2' .OR. &
+ CNI_CHARGING == 'TEEWC') THEN
+ ZWQ1(:,7) = 0.
+!
+ WHERE (GELEC(:,1) .AND. ZRIS(:) > ZRSMIN_ELEC(4) .AND. &
+ ZRSS(:) > ZRSMIN_ELEC(5) .AND. ZDQLWC(:) /= 0.)
+ ZWQ1(:,7) = XFQIAGGSBS * (1 - ZCOLIS(:)) * &
+ ZRHOCOR(:)**(1 + ZSAUNIN(:)) * &
+ ZFQIAGGS(:) * ZDQLWC(:) * &
+ ZCIT(:)**(1 - ZSAUNIM(:) / XBI) * &
+ ZLBDAS(:)**(XCXS - 2.- XDS * (1. + ZSAUNIN(:))) * &
+ (ZRHODREF(:) * ZRIT(:) / XAIGAMMABI)**(ZSAUNIM(:) / XBI)
+!
+! Dq is limited to XLIM_NI_IS
+ ZLIMIT(:) = XLIM_NI_IS * ZZW(:) * ZCIT(:) * &
+ (1 - ZCOLIS(:)) / (ZRIT(:) * ZCOLIS(:))
+ ZWQ1(:,7) = SIGN( MIN( ABS(ZLIMIT(:)), ABS(ZWQ1(:,7)) ), ZWQ1(:,7) )
+ ZWQ1(:,7) = ZWQ1(:,7) / ZRHODREF(:)
+ ENDWHERE
+!
+! For temperatures lower than -30C --> linear interpolation
+ WHERE (ZWQ1(:,7) /= 0. .AND. ZZT(:) < (XTT-30.) .AND. ZZT(:) >= (XTT-40.))
+ ZWQ1(:,7) = ZWQ1(:,7) * (ZZT(:) - XTT + 40.) / 10.
+ ENDWHERE
+!
+ ZQSS(:) = ZQSS(:) + ZWQ1(:,7)
+ ZQIS(:) = ZQIS(:) - ZWQ1(:,7)
+!
+ END IF
+!
+!* 5. Charging process based on RAR (=EW*V): SAP98, BSMP1/BSMP2, TERAR
+!* following Saunders and Peck (1998) or
+!* Brooks et al., 1997 (with/out anomalies) or
+!* Takahashi via Tsenova and Mitzeva (2011)
+!
+ IF (CNI_CHARGING == 'SAP98' .OR. CNI_CHARGING == 'BSMP1' .OR. &
+ CNI_CHARGING == 'BSMP2' .OR. CNI_CHARGING == 'TERAR') THEN
+!
+ IF (CNI_CHARGING /= 'TERAR') THEN
+ ZFQIAGGS(:) = XFQIAGGSP
+ WHERE (ZDQRAR_IS(:) < 0.)
+ ZFQIAGGS(:) = XFQIAGGSN
+ ENDWHERE
+ ELSE
+ ZFQIAGGS(:) = XFQIAGGSP_TAK
+ WHERE (ZDQRAR_IS(:) <0.)
+ ZFQIAGGS(:) = XFQIAGGSN_TAK
+ ENDWHERE
+ ENDIF
+!
+ ZWQ1(:,7) = 0.
+!
+ WHERE (GELEC(:,1) .AND. ZDQRAR_IS(:) /= 0. .AND. &
+ ZRIS(:) > ZRSMIN_ELEC(4) .AND. ZRSS(:) > ZRSMIN_ELEC(5))
+ ZWQ1(:,7) = XFQIAGGSBS * (1 - ZCOLIS(:)) * &
+ ZRHOCOR(:)**(1 + ZSAUNIN_IS(:)) * &
+ ZFQIAGGS(:) * ZDQRAR_IS(:) * &
+ ZCIT(:)**(1 - ZSAUNIM_IS(:) / XBI) * &
+ ZLBDAS(:)**(XCXS - 2.- XDS * (1. + ZSAUNIN_IS(:))) * &
+ (ZRHODREF(:) * ZRIT(:)/XAIGAMMABI)**(ZSAUNIM_IS(:) / XBI)
+!
+! Dq is limited to XLIM_NI_IS
+ ZLIMIT(:) = XLIM_NI_IS * ZZW(:) * ZCIT(:) * &
+ (1 - ZCOLIS(:)) / (ZRIT(:) * ZCOLIS(:))
+ ZWQ1(:,7) = SIGN( MIN( ABS(ZLIMIT(:)), ABS(ZWQ1(:,7)) ), ZWQ1(:,7) )
+ ZWQ1(:,7) = ZWQ1(:,7) / ZRHODREF(:)
+ ENDWHERE
+!
+! For temperatures lower than -30C --> linear interpolation
+ WHERE (ZWQ1(:,7) /= 0. .AND. ZZT(:) < (XTT-30.) .AND. ZZT(:) >= (XTT-40.))
+ ZWQ1(:,7) = ZWQ1(:,7) * (ZZT(:) - XTT + 40.) / 10.
+ ENDWHERE
+!
+ ZQSS(:) = ZQSS(:) + ZWQ1(:,7)
+ ZQIS(:) = ZQIS(:) - ZWQ1(:,7)
+ END IF
+!
+!* 6. Charging process following Takahashi (1978)
+!
+ IF (CNI_CHARGING == 'TAKAH') THEN
+ ZWQ1(:,7) = 0.
+ ZLIMIT(:) = 0.
+!
+ WHERE (GELEC(:,1) .AND. ZRIS(:) > ZRSMIN_ELEC(4) .AND. &
+ ZRSS(:) > ZRSMIN_ELEC(5) .AND. ZDQLWC(:) /= 0.)
+ ZWQ1(:,7) = XFQIAGGSBT1 * (1.0 - ZCOLIS(:)) * ZRHOCOR(:) * &
+ ZCIT(:) * ZLBDAS(:)**XCXS * ZDQLWC(:) * &
+ MIN( XFQIAGGSBT2 / (ZLBDAS(:)**(2. + XDS)) , &
+ XFQIAGGSBT3 * ZRHOCOR(:) * ZRHODREF(:)**(2./XBI) * &
+ ZRIT(:)**(2. / XBI) / &
+ (ZCIT(:)**(2. / XBI) * ZLBDAS(:)**(2. + 2. * XDS)))
+!
+! Dq is limited to XLIM_NI_IS
+ ZLIMIT(:) = XLIM_NI_IS * ZZW(:) * ZCIT(:) * &
+ (1 - ZCOLIS(:)) / (ZRIT(:) * ZCOLIS(:))
+ ZWQ1(:,7) = SIGN( MIN( ABS(ZLIMIT(:)), ABS(ZWQ1(:,7)) ), ZWQ1(:,7) )
+ ZWQ1(:,7) = ZWQ1(:,7) / ZRHODREF(:)
+ ENDWHERE
+!
+! For temperatures lower than -30C --> linear interpolation
+ WHERE (ZWQ1(:,7) /= 0. .AND. ZZT(:) < (XTT-30.) .AND. ZZT(:) >= (XTT-40.))
+ ZWQ1(:,7) = ZWQ1(:,7) * (ZZT(:) - XTT + 40.) / 10.
+ ENDWHERE
+!
+ ZQSS(:) = ZQSS(:) + ZWQ1(:,7)
+ ZQIS(:) = ZQIS(:) - ZWQ1(:,7)
+ END IF
+!
+!
+END SUBROUTINE ELEC_IAGGS_B
+!
+!-------------------------------------------------------------------------------
+!
+ SUBROUTINE ELEC_IDRYG_B()
+!
+! Purpose : compute charge separation process during the dry collision
+! between ice and graupeln
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!
+!* 1. COMPUTE THE COLLECTION EFFICIENCY
+! ---------------------------------
+!
+ ZCOLIG(:) = XCOLIG * EXP(XCOLEXIG * (ZZT(:) - XTT))
+!
+!* 2. COMPUTE THE CHARGE SEPARATION DURING IDRYG_BOUN
+! -----------------------------------------------
+!
+!* 2.1 Helsdon and Farley (1987)
+!
+ IF (CNI_CHARGING == 'HELFA') THEN
+ ZWQ1(:,3) = 0.
+ WHERE (ZRIS(:) > ZRSMIN_ELEC(4) .AND. ZCIT(:) > 0.0 .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZRGS(:) > ZRSMIN_ELEC(6))
+ ZWQ1(:,3) = XHIDRYG * ZZW1(:,2) * ZCIT(:) / ZRIT(:)
+ ZWQ1(:,3) = ZWQ1(:,3) * (1. - ZCOLIG(:)) / ZCOLIG(:) ! QIDRYG_boun
+!
+! Temperature dependance of the charge transfered
+ ZWQ1(:,3) = ZWQ1(:,3) * (ZZT(:) - XQTC) / ABS(ZZT(:) - XQTC)
+ ZWQ1(:,3) = ZWQ1(:,3) / ZRHODREF(:)
+ END WHERE
+ END IF
+!
+!
+!* 2.2 Gardiner et al. (1985)
+!
+ IF (CNI_CHARGING == 'GARDI') THEN
+ ZWQ1(:,3) = 0.
+!
+ WHERE (GELEC(:,2) .AND. ZRIS(:) > ZRSMIN_ELEC(4) .AND. &
+ ZRGS(:) > ZRSMIN_ELEC(6) .AND. ZDELTALWC(:) > 0.)
+ ZWQ1(:,3) = XFQIDRYGBG * XLBQIDRYGBG * (1 - ZCOLIG) * &
+ ZRHODREF(:)**(-4. * XCEXVT + 4. / XBI) * &
+ ZCIT(:)**(1 - 4. / XBI) * &
+ ZDELTALWC(:) * ZFT(:) * &
+ ZLBDAG(:)**(XCXG - 2. - 4. * XDG) * &
+ (XAI * MOMG(XALPHAI, XNUI, XBI) / &
+ ZRIT(:))**(-4 / XBI)
+!
+! Dq limited to XLIM_NI_IG
+ ZLIMIT(:) = XLIM_NI_IG * ZZW1(:,2) * ZCIT(:) * (1 - ZCOLIG(:)) / &
+ (ZRIT(:) * ZCOLIG(:))
+ ZWQ1(:,3) = SIGN( MIN( ABS(ZLIMIT(:)), ABS(ZWQ1(:,3)) ), ZWQ1(:,3) )
+ ZWQ1(:,3) = ZWQ1(:,3) / ZRHODREF(:)
+ ENDWHERE
+!
+! For temperatures lower than -30C --> linear interpolation
+!
+ WHERE (ZWQ1(:,3) /= 0. .AND. ZZT(:) < (XTT-30.) .AND. ZZT(:) >= (XTT-40.))
+ ZWQ1(:,3) = ZWQ1(:,3) * (ZZT(:) - XTT + 40.) / 10.
+ ENDWHERE
+!
+ END IF
+!
+!
+!* 2.3 Charging process based on EW: SAUN1/SAUN2, TEEWC
+!* following Saunders et al. (1991), Takahashi via Tsenova and Mitzeva(2009)
+!
+ IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2' .OR. &
+ CNI_CHARGING == 'TEEWC') THEN
+ ZWQ1(:,3) = 0.
+!
+ WHERE (GELEC(:,2) .AND. ZRIS(:) > ZRSMIN_ELEC(4) .AND. &
+ ZRGS(:) > ZRSMIN_ELEC(6) .AND. ZDQLWC(:) /= 0.)
+ ZWQ1(:,3) = XFQIDRYGBS * (1. - ZCOLIG(:)) * &
+ ZRHOCOR(:)**(1. + ZSAUNIN(:)) * &
+ ZFQIDRYGBS(:) * ZDQLWC(:) * &
+ ZCIT(:)**(1. - ZSAUNIM(:) / XBI) * &
+ ZLBDAG(:)**(XCXG - 2. - XDG * (1. + ZSAUNIN(:))) * &
+ (ZRHODREF(:) * ZRIT(:)/XAIGAMMABI)**(ZSAUNIM(:) / XBI)
+!
+! Dq is limited to XLIM_NI_IG
+ ZLIMIT(:) = XLIM_NI_IG * ZZW1(:,2) * ZCIT(:) * (1 - ZCOLIG(:)) / &
+ (ZRIT(:) * ZCOLIG(:))
+ ZWQ1(:,3) = SIGN( MIN( ABS(ZLIMIT(:)), ABS(ZWQ1(:,3)) ), ZWQ1(:,3) )
+ ZWQ1(:,3) = ZWQ1(:,3) / ZRHODREF(:)
+ ENDWHERE
+!
+! For temperatures lower than -30C --> linear interpolation
+ WHERE (ZWQ1(:,3) /= 0. .AND. ZZT(:) < (XTT-30.) .AND. ZZT(:) >= (XTT-40.))
+ ZWQ1(:,3) = ZWQ1(:,3) * (ZZT(:) - XTT + 40.) / 10.
+ ENDWHERE
+!
+ END IF
+!
+!
+!* 2.4 Charging process based on RAR (=EW*V): SAP98, BSMP1/BSMP2, TERAR
+!* following Saunders and Peck (1998) or
+!* Brooks et al., 1997 (with/out anomalies) or
+!* Takahashi via Tsenova and Mitzeva (2011)
+!
+ IF (CNI_CHARGING == 'SAP98' .OR. CNI_CHARGING == 'BSMP1' .OR. &
+ CNI_CHARGING == 'BSMP2' .OR. CNI_CHARGING == 'TERAR') THEN
+!
+ IF (CNI_CHARGING /= 'TERAR') THEN
+ ZFQIDRYGBS(:) = XFQIDRYGBSP
+ WHERE (ZDQRAR_IG(:) < 0.)
+ ZFQIDRYGBS(:) = XFQIDRYGBSN
+ ENDWHERE
+ ELSE
+ ZFQIDRYGBS(:) = XFQIDRYGBSP_TAK
+ WHERE (ZDQRAR_IG(:) <0.)
+ ZFQIDRYGBS(:) = XFQIDRYGBSN_TAK
+ ENDWHERE
+ END IF
+!
+ ZWQ1(:,3) = 0.
+!
+ WHERE (GELEC(:,2) .AND. ZDQRAR_IG(:) /= 0. .AND. &
+ ZRIS(:) > ZRSMIN_ELEC(4) .AND. ZRGS(:) > ZRSMIN_ELEC(6))
+ ZWQ1(:,3) = XFQIDRYGBS * (1. - ZCOLIG(:)) * &
+ ZRHOCOR(:)**(1 + ZSAUNIN_IG(:)) * &
+ ZFQIDRYGBS(:) * ZDQRAR_IG(:) * &
+ ZCIT(:)**(1 - ZSAUNIM_IG(:) / XBI) * &
+ ZLBDAG(:)**(XCXG - 2. - XDG * (1. + ZSAUNIN_IG(:))) * &
+ (ZRHODREF(:) * ZRIT(:)/XAIGAMMABI)**(ZSAUNIM_IG(:) / XBI)
+!
+! Dq is limited to XLIM_NI_IG
+ ZLIMIT(:) = XLIM_NI_IG * ZZW1(:,2) * ZCIT(:) * (1 - ZCOLIG(:)) / &
+ (ZRIT(:) * ZCOLIG(:))
+ ZWQ1(:,3) = SIGN( MIN( ABS(ZLIMIT(:)), ABS(ZWQ1(:,3)) ), ZWQ1(:,3) )
+ ZWQ1(:,3) = ZWQ1(:,3) / ZRHODREF(:)
+ ENDWHERE
+!
+! For temperatures lower than -30C --> linear interpolation
+ WHERE (ZWQ1(:,3) /= 0. .AND. ZZT(:) < (XTT-30.) .AND. ZZT(:) >= (XTT-40.))
+ ZWQ1(:,3) = ZWQ1(:,3) * (ZZT(:) - XTT + 40.) / 10.
+ ENDWHERE
+ END IF
+!
+!
+!* 2.5 Takahashi (1978)
+!
+ IF (CNI_CHARGING == 'TAKAH') THEN
+ ZWQ1(:,3) = 0.
+ ZLIMIT(:) = 0.
+!
+ WHERE (GELEC(:,2) .AND. ZRIS(:) > ZRSMIN_ELEC(4) .AND. &
+ ZRGS(:) > ZRSMIN_ELEC(6) .AND. ZDQLWC(:) /= 0.)
+ ZWQ1(:,3) = XFQIDRYGBT1 * (1. - ZCOLIG(:)) * ZRHOCOR(:) * &
+ ZCIT(:) * ZLBDAG(:)**XCXG * ZDQLWC(:) * &
+ MIN( XFQIDRYGBT2 / (ZLBDAG(:)**(2. + XDG)), &
+ XFQIDRYGBT3 * ZRHOCOR(:) * ZRHODREF(:)**(2./XBI) * &
+ ZRIT(:)**(2. / XBI) / (ZCIT(:)**(2. / XBI) * &
+ ZLBDAG(:)**(2. + 2. * XDG)) )
+!
+! Dq is limited to XLIM_NI_IG
+ ZLIMIT(:) = XLIM_NI_IG * ZZW1(:,2) * ZCIT(:) * (1 - ZCOLIG(:)) / &
+ (ZRIT(:) * ZCOLIG(:))
+ ZWQ1(:,3) = SIGN( MIN( ABS(ZLIMIT(:)), ABS(ZWQ1(:,3)) ), ZWQ1(:,3) )
+ ZWQ1(:,3) = ZWQ1(:,3) / ZRHODREF(:)
+ ENDWHERE
+!
+! For temperatures lower than -30C --> linear interpolation
+ WHERE (ZWQ1(:,3) /= 0. .AND. ZZT(:) < (XTT-30.) .AND. ZZT(:) >= (XTT-40.))
+ ZWQ1(:,3) = ZWQ1(:,3) * (ZZT(:) - XTT + 40.) / 10.
+ ENDWHERE
+ END IF
+!
+!
+END SUBROUTINE ELEC_IDRYG_B
+!
+!-------------------------------------------------------------------------------
+!
+ SUBROUTINE ELEC_SDRYG_B()
+!
+! Purpose : compute the charge separation during the dry collision
+! between snow and graupeln
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!
+!* 1. COMPUTE THE COLLECTION EFFICIENCY
+! ---------------------------------
+!
+ ZCOLSG(:) = XCOLSG * EXP (XCOLEXSG * (ZZT(:) - XTT))
+!
+!* 2. COMPUTE THE CHARGE SEPARATION DURING SDRYG_BOUN
+! -----------------------------------------------
+!
+!* 2.1 Helsdon and Farley (1987)
+!
+ IF (CNI_CHARGING == 'HELFA') THEN
+ ZWQ1(:,5) = 0.
+!
+ WHERE (ZRGT(:) > XRTMIN_ELEC(6) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. &
+ ZRGS(:) > ZRSMIN_ELEC(6) .AND. ZRSS(:) > ZRSMIN_ELEC(5) .AND. &
+ ZLBDAS(:) > 0. .AND. ZLBDAG(:) > 0.)
+ ZWQ1(:,5) = ZWQ1(:,10) * XFQSDRYGBH * ZRHODREF(:)**(-XCEXVT) * &
+ (1. - ZCOLSG(:)) * &
+ ZLBDAS(:)**(XCXS) * ZLBDAG(:)**(XCXG) * &
+ (XLBQSDRYGB4H * ZLBDAS(:)**(-2.) + &
+ XLBQSDRYGB5H * ZLBDAS(:)**(-1.) * ZLBDAG(:)**(-1.) + &
+ XLBQSDRYGB6H * ZLBDAG(:)**(-2.))
+!
+! Temperature dependance of the charge transfered
+ ZWQ1(:,5) = ZWQ1(:,5) * (ZZT(:) - XQTC) / ABS(ZZT(:) - XQTC)
+ ZWQ1(:,5) = ZWQ1(:,5) / ZRHODREF(:)
+ ENDWHERE
+ ENDIF
+!
+!
+!* 2.2 Gardiner et al. (1985)
+!
+ IF (CNI_CHARGING == 'GARDI') THEN
+ ZWQ1(:,5) = 0.
+ ZLIMIT(:) = 0.
+!
+ WHERE (GELEC(:,3) .AND. ZRGS(:) > ZRSMIN_ELEC(6) .AND. &
+ ZRSS(:) > ZRSMIN_ELEC(5) .AND. ZDELTALWC(:) > 0.)
+ ZWQ1(:,5) = XFQSDRYGBG * (1. - ZCOLSG(:)) * &
+ ZRHODREF(:)**(-4. * XCEXVT) * &
+ ZFT(:) * ZDELTALWC(:) * &
+ ZLBDAG(:)**XCXG * ZLBDAS(:)**XCXS * &
+ (XLBQSDRYGB4G * ZLBDAS(:)**(-4.) * ZLBDAG(:)**(-2.) + &
+ XLBQSDRYGB5G * ZLBDAS(:)**(-5.) * ZLBDAG(:)**(-1.) + &
+ XLBQSDRYGB6G * ZLBDAS(:)**(-6.)) * &
+ ZWQ1(:,10)
+!
+! Dq is limited to XLIM_NI_SG
+ ZLIMIT(:) = XLIM_NI_SG * ZAUX1(:) * XAUX_LIM * &
+ ZRHOCOR(:) * (1. - ZCOLSG(:)) * &
+ ZLBDAS(:)**(XCXS) * ZLBDAG(:)**(XCXG) * &
+ (XAUX_LIM1 * ZLBDAS(:)**(-2.) + &
+ XAUX_LIM2 * ZLBDAS(:)**(-1.) * ZLBDAG(:)**(-1.) + &
+ XAUX_LIM3 * ZLBDAG(:)**(-2.))
+ ZWQ1(:,5) = SIGN( MIN( ABS(ZLIMIT(:)), ABS(ZWQ1(:,5)) ), ZWQ1(:,5))
+ ZWQ1(:,5) = ZWQ1(:,5) / ZRHODREF(:)
+ ENDWHERE
+!
+! For temperatures lower than -30C --> linear interpolation
+ WHERE (ZWQ1(:,5) /= 0. .AND. ZZT(:) < (XTT-30.) .AND. ZZT(:) >= (XTT-40.))
+ ZWQ1(:,5) = ZWQ1(:,5) * (ZZT(:) - XTT + 40.) / 10.
+ ENDWHERE
+ END IF
+!
+!* 2.3 Charging process based on EW: SAUN1/SAUN2, TEEWC
+!* following Saunders et al. (1991), Takahashi via Tsenova and Mitzeva(2009)
+!
+ IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2' .OR. &
+ CNI_CHARGING == 'TEEWC') THEN
+!
+ ZWQ1(:,5) = 0.
+ ZLIMIT(:) = 0.
+!
+ WHERE (GELEC(:,3) .AND. ZRGS(:) > ZRSMIN_ELEC(6) .AND. &
+ ZRSS(:) > ZRSMIN_ELEC(5) .AND. ZDQLWC(:) /= 0.)
+!
+! ZWQ1(:,5) = ZWQ3(:) If graupel gains positive charge ZDQLWC(:) > 0.
+! ZWQ1(:,5) = ZWQ4(:) If graupel gains negative charge ZDQLWC(:) < 0.
+ ZWQ1(:,5) = ZWQ3(:) * (0.5 + SIGN(0.5,ZDQLWC(:))) + &
+ ZWQ4(:) * (0.5 - SIGN(0.5,ZDQLWC(:)))
+!
+ ZWQ1(:,5) = ZWQ1(:,5) * XFQSDRYGBS * (1. - ZCOLSG(:)) * &
+ ZRHOCOR(:)**(1. + ZSAUNSN(:)) * &
+ ZSAUNSK(:) * ZDQLWC(:) * &
+ ZLBDAG(:)**XCXG * ZLBDAS(:)**XCXS * &
+ ( ZLBQSDRYGB1S(:) / (ZLBDAS(:)**ZSAUNSM(:) *ZLBDAG(:)**2) + &
+ ZLBQSDRYGB2S(:) / (ZLBDAS(:)**( 1.+ZSAUNSM(:))*ZLBDAG(:)) + &
+ ZLBQSDRYGB3S(:) / ZLBDAS(:)**(2.+ZSAUNSM(:)) )
+!
+! Dq is limited to XLIM_NI_SG
+ ZLIMIT(:) = XLIM_NI_SG * ZAUX1(:) * XAUX_LIM * &
+ ZRHOCOR(:) * (1. - ZCOLSG(:)) * &
+ ZLBDAS(:)**(XCXS) * ZLBDAG(:)**(XCXG) * &
+ ( XAUX_LIM1 / ZLBDAS(:)**2 + &
+ XAUX_LIM2 /(ZLBDAS(:) * ZLBDAG(:)) + &
+ XAUX_LIM3 / ZLBDAG(:)**2 )
+ ZWQ1(:,5) = SIGN( MIN( ABS(ZLIMIT(:)), ABS(ZWQ1(:,5)) ), ZWQ1(:,5))
+ ZWQ1(:,5) = ZWQ1(:,5) / ZRHODREF(:)
+ ENDWHERE
+!
+! For temperatures lower than -30C --> linear interpolation
+ WHERE (ZWQ1(:,5) /= 0. .AND. ZZT(:) < (XTT-30.) .AND. ZZT(:) >= (XTT-40.))
+ ZWQ1(:,5) = ZWQ1(:,5) * (ZZT(:) - XTT + 40.) / 10.
+ ENDWHERE
+!
+ END IF
+!
+!
+!* 2.4 Charging process based on RAR (=EW*V): SAP98, BSMP1/BSMP2, TERAR
+!* following Saunders and Peck (1998) or
+!* Brooks et al., 1997 (with/out anomalies) or
+!* Takahashi via Tsenova and Mitzeva (2011)
+!
+ IF (CNI_CHARGING == 'SAP98' .OR. CNI_CHARGING == 'BSMP1' .OR. &
+ CNI_CHARGING == 'BSMP2' .OR. CNI_CHARGING == 'TERAR') THEN
+!
+ ZLBQSDRYGB1S(:) = XLBQSDRYGB1SP
+ ZLBQSDRYGB2S(:) = XLBQSDRYGB2SP
+ ZLBQSDRYGB3S(:) = XLBQSDRYGB3SP
+ WHERE (ZDQRAR_SG(:) < 0.)
+ ZLBQSDRYGB1S(:) = XLBQSDRYGB1SN
+ ZLBQSDRYGB2S(:) = XLBQSDRYGB2SN
+ ZLBQSDRYGB3S(:) = XLBQSDRYGB3SN
+ ENDWHERE
+!
+ ZWQ1(:,5) = 0.
+ ZLIMIT(:) = 0.
+!
+ WHERE (GELEC(:,3) .AND. ZDQRAR_SG(:) /= 0. .AND. &
+ ZRGS(:) > ZRSMIN_ELEC(6) .AND. ZRSS(:) > ZRSMIN_ELEC(5))
+ ZWQ1(:,5) = ZWQ3(:) * (0.5+SIGN(0.5,ZDQRAR_SG(:))) + &
+ ZWQ4(:) * (0.5-SIGN(0.5,ZDQRAR_SG(:)))
+!
+ ZWQ1(:,5) = ZWQ1(:,5) * XFQSDRYGBS * (1. - ZCOLSG(:)) * &
+ ZRHOCOR(:)**(1. + ZSAUNSN_SG(:)) * &
+ ZSAUNSK_SG(:) * ZDQRAR_SG(:) * &
+ ZLBDAG(:)**XCXG * ZLBDAS(:)**XCXS * &
+ (ZLBQSDRYGB1S(:)/(ZLBDAS(:)**ZSAUNSM_SG(:) * ZLBDAG(:)**2) + &
+ ZLBQSDRYGB2S(:)/(ZLBDAS(:)**(1.+ZSAUNSM_SG(:))*ZLBDAG(:)) + &
+ ZLBQSDRYGB3S(:)/ ZLBDAS(:)**(2.+ZSAUNSM_SG(:)) )
+!
+!
+! Dq is limited to XLIM_NI_SG
+ ZLIMIT(:) = XLIM_NI_SG * ZAUX1(:) * XAUX_LIM * &
+ ZRHOCOR(:) * (1. - ZCOLSG(:)) * &
+ ZLBDAS(:)**(XCXS) * ZLBDAG(:)**(XCXG) * &
+ ( XAUX_LIM1 / ZLBDAS(:)**2 + &
+ XAUX_LIM2 /(ZLBDAS(:) * ZLBDAG(:)) + &
+ XAUX_LIM3 / ZLBDAG(:)**2 )
+ ZWQ1(:,5) = SIGN( MIN( ABS(ZLIMIT(:)), ABS(ZWQ1(:,5)) ), ZWQ1(:,5))
+ ZWQ1(:,5) = ZWQ1(:,5) / ZRHODREF(:)
+ ENDWHERE
+!
+! For temperature lower than -30C --> linear interpolation
+ WHERE (ZWQ1(:,5) /= 0. .AND. ZZT(:) < (XTT-30.) .AND. ZZT(:) >= (XTT-40.))
+ ZWQ1(:,5) = ZWQ1(:,5) * (ZZT(:) - XTT + 40.) / 10.
+ ENDWHERE
+ END IF
+!
+!
+!* 2.5 Takahashi (1978)
+!
+ IF (CNI_CHARGING == 'TAKAH') THEN
+ ZWQ1(:,5) = 0.
+ ZLIMIT(:) = 0.
+!
+ WHERE (GELEC(:,3) .AND. ZRGS(:) > ZRSMIN_ELEC(6) .AND. &
+ ZRSS(:) > ZRSMIN_ELEC(5) .AND. ZDQLWC(:) /= 0.)
+ ZWQ1(:,5) = XFQSDRYGBT1 * (1. - ZCOLSG(:)) * ZRHOCOR(:) * &
+ ZLBDAG(:)**XCXG * ZLBDAS(:)**XCXS * ZDQLWC(:) * &
+ MIN(10. * ( &
+ ABS(XFQSDRYGBT2 / (ZLBDAG(:)**XDG * ZLBDAS(:)**2.) - &
+ XFQSDRYGBT3 / (ZLBDAS(:)**(2. + XDS))) + &
+ ABS(XFQSDRYGBT4 / (ZLBDAG(:)**(2.+XDG)) - &
+ XFQSDRYGBT5 / (ZLBDAS(:)**XDS * ZLBDAG(:)**2.)) + &
+ ABS(XFQSDRYGBT6 / (ZLBDAG(:)**(1. + XDG) * ZLBDAS(:)) - &
+ XFQSDRYGBT7 / (ZLBDAS(:)**(1. + XDS) * ZLBDAG(:)))), &
+ XFQSDRYGBT8 * ZRHOCOR(:) * ZWQ1(:,10) * &
+ (XFQSDRYGBT9 / (ZLBDAS(:)**2. * ZLBDAG(:)**2.) + &
+ XFQSDRYGBT10 / (ZLBDAS(:)**4.) + &
+ XFQSDRYGBT11 / (ZLBDAS(:)**3. * ZLBDAG(:))))
+!
+! Dq is limited to XLIM_NI_SG
+ ZLIMIT(:) = XLIM_NI_SG * ZAUX1(:) * XAUX_LIM * &
+ ZRHOCOR(:) * (1. - ZCOLSG(:)) * &
+ ZLBDAS(:)**(XCXS) * ZLBDAG(:)**(XCXG) * &
+ ( XAUX_LIM1 / ZLBDAS(:)**2 + &
+ XAUX_LIM2 /(ZLBDAS(:) * ZLBDAG(:)) + &
+ XAUX_LIM3 / ZLBDAG(:)**2 )
+ ZWQ1(:,5) = SIGN( MIN( ABS(ZLIMIT(:)), ABS(ZWQ1(:,5)) ), ZWQ1(:,5))
+ ZWQ1(:,5) = ZWQ1(:,5) / ZRHODREF(:)
+ ENDWHERE
+!
+! For temperature lower than -30C --> linear interpolation
+ WHERE (ZWQ1(:,5) /= 0. .AND. ZZT(:) < (XTT-30.) .AND. ZZT(:) >= (XTT-40.))
+ ZWQ1(:,5) = ZWQ1(:,5) * (ZZT(:) - XTT + 40.) / 10.
+ ENDWHERE
+ END IF
+!
+!
+END SUBROUTINE ELEC_SDRYG_B
+!
+!------------------------------------------------------------------------------
+!
+ SUBROUTINE INDUCTIVE_PROCESS
+!
+! Computation of the charge transfer rate during inductive mechanism
+! Only the bouncing droplet-graupel collision when the graupel is in the dry
+! growth mode is considered
+! The electric field is limited to 100 kV/m
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!
+!* 1. COMPUTE THE CHARGING RATE
+! -------------------------
+!
+ ZRATE_IND(:) = 0.
+!
+ WHERE (GIND(:) .AND. &
+ ZEFIELDW(:) /= 0. .AND. ABS(ZEGS(:)) > XEGMIN .AND. &
+ ZLBDAG(:) > 0. .AND. &
+ ZRGT(:) > XRTMIN_ELEC(6) .AND. ZRGS(:) > ZRSMIN_ELEC(6) .AND. &
+ ZRCT(:) > XRTMIN_ELEC(2) .AND. ZRCS(:) > ZRSMIN_ELEC(2))
+ ZRATE_IND(:) = XIND1 * ZLBDAG(:)**XCXG * ZRHOCOR(:) * &
+ (XIND2 * SIGN(MIN(100.E3, ABS(ZEFIELDW(:))), ZEFIELDW(:)) * &
+ ZLBDAG(:) **(-2.-XDG) - &
+ XIND3 * ZEGS(:) * ZLBDAG(:)**(-XFG-XDG))
+ ZRATE_IND(:) = ZRATE_IND(:) / ZRHODREF(:)
+ ZQGS(:) = ZQGS(:) + ZRATE_IND(:)
+ ZQCS(:) = ZQCS(:) - ZRATE_IND(:)
+ END WHERE
+!
+END SUBROUTINE INDUCTIVE_PROCESS
+!
+!------------------------------------------------------------------------------
+!
+!
+ FUNCTION BI_LIN_INTP_V(ZT, KI, KJ, PDX, PDY, KN) RESULT(Y)
+!
+! | |
+! ZT(KI(1),KJ(2))-|-------------------|-ZT(KI(2),KJ(2))
+! | |
+! | |
+! x2-|-------|y(x1,x2) |
+! | | |
+! PDY| | |
+! | | |
+! | | |
+!ZT( KI(1),KJ(1))-|-------------------|-ZT(KI(2),KJ(1))
+! | PDX |x1 |
+! | |
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!* 0.2 Declaration of local variables
+!
+INTEGER :: KN ! Size of the result vector
+INTEGER, DIMENSION(KN) :: KI ! Tabulated coordinate
+INTEGER, DIMENSION(KN) :: KJ ! Tabulated coordinate
+REAL, INTENT(IN), DIMENSION(:,:) :: ZT ! Tabulated data
+REAL, INTENT(IN), DIMENSION(KN) :: PDX, PDY !
+REAL, DIMENSION(KN) :: Y ! Interpolated value
+!
+INTEGER :: JJ ! Loop index
+!
+!* 1. INTERPOLATION
+! -------------
+!
+DO JJ = 1, KN
+ Y(JJ) = (1.0 - PDX(JJ)) * (1.0 - PDY(JJ)) * ZT(KI(JJ), KJ(JJ)) + &
+ PDX(JJ) * (1.0 - PDY(JJ)) * ZT(KI(JJ)+1,KJ(JJ)) + &
+ PDX(JJ) * PDY(JJ) * ZT(KI(JJ)+1,KJ(JJ)+1) + &
+ (1.0 - PDX(JJ)) * PDY(JJ) * ZT(KI(JJ) ,KJ(JJ)+1)
+ENDDO
+!
+END FUNCTION BI_LIN_INTP_V
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE RAIN_ICE_ELEC
diff --git a/src/mesonh/micro/rain_ice_fast_rg.f90 b/src/mesonh/micro/rain_ice_fast_rg.f90
new file mode 100644
index 000000000..c3366b66a
--- /dev/null
+++ b/src/mesonh/micro/rain_ice_fast_rg.f90
@@ -0,0 +1,455 @@
+!MNH_LIC Copyright 1995-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! Modifications:
+! P. Wautelet 25/02/2019: split rain_ice (cleaner and easier to maintain/debug)
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 03/06/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
+! P. Wautelet 05/06/2019: optimisations
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
+!-----------------------------------------------------------------
+MODULE MODE_RAIN_ICE_FAST_RG
+
+ IMPLICIT NONE
+
+ PRIVATE
+
+ PUBLIC :: RAIN_ICE_FAST_RG
+
+CONTAINS
+
+SUBROUTINE RAIN_ICE_FAST_RG(KRR, OMICRO, PRHODREF, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PCIT, &
+ PRHODJ, PPRES, PZT, PLBDAR, PLBDAS, PLBDAG, PLSFACT, PLVFACT, &
+ PCJ, PKA, PDV, &
+ PRCS, PRRS, PRIS, PRSS, PRGS, PRHS, PTHS, &
+ PUSW, PRDRYG, PRWETG)
+
+!
+!* 0. DECLARATIONS
+! ------------
+!
+use modd_budget, only: lbudget_th, lbudget_rc, lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, &
+ NBUDGET_TH, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, &
+ tbudgets
+use MODD_CST, only: XCI, XCL, XCPV, XESTT, XLMTT, XLVTT, XMD, XMV, XRV, XTT
+use MODD_RAIN_ICE_DESCR, only: XBS, XCEXVT, XCXG, XCXS, XDG, XRTMIN
+use MODD_RAIN_ICE_PARAM, only: NDRYLBDAG, NDRYLBDAR, NDRYLBDAS, X0DEPG, X1DEPG, XCOLEXIG, XCOLEXSG, XCOLIG, XCOLSG, XDRYINTP1G, &
+ XDRYINTP1R, XDRYINTP1S, XDRYINTP2G, XDRYINTP2R, XDRYINTP2S, XEX0DEPG, XEX1DEPG, XEXICFRR, &
+ XEXRCFRI, XFCDRYG, XFIDRYG, XFRDRYG, XFSDRYG, XICFRR, XKER_RDRYG, XKER_SDRYG, XLBRDRYG1, &
+ XLBRDRYG2, XLBRDRYG3, XLBSDRYG1, XLBSDRYG2, XLBSDRYG3, XRCFRI
+
+use mode_budget, only: Budget_store_add, Budget_store_end, Budget_store_init
+
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+LOGICAL, DIMENSION(:,:,:), intent(in) :: OMICRO ! Test where to compute all processes
+REAL, DIMENSION(:), intent(in) :: PRHODREF ! RHO Dry REFerence
+REAL, DIMENSION(:), intent(in) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:), intent(in) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:), intent(in) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:), intent(in) :: PRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(:), intent(in) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:), intent(in) :: PRGT ! Graupel m.r. at t
+REAL, DIMENSION(:), intent(in) :: PCIT ! Pristine ice conc. at t
+REAL, DIMENSION(:), intent(in) :: PRHODJ ! RHO times Jacobian
+REAL, DIMENSION(:), intent(in) :: PPRES ! Pressure
+REAL, DIMENSION(:), intent(in) :: PZT ! Temperature
+REAL, DIMENSION(:), intent(in) :: PLBDAR ! Slope parameter of the raindrop distribution
+REAL, DIMENSION(:), intent(in) :: PLBDAS ! Slope parameter of the aggregate distribution
+REAL, DIMENSION(:), intent(in) :: PLBDAG ! Slope parameter of the graupel distribution
+REAL, DIMENSION(:), intent(in) :: PLSFACT ! L_s/(Pi_ref*C_ph)
+REAL, DIMENSION(:), intent(in) :: PLVFACT ! L_v/(Pi_ref*C_ph)
+REAL, DIMENSION(:), intent(in) :: PCJ ! Function to compute the ventilation coefficient
+REAL, DIMENSION(:), intent(in) :: PKA ! Thermal conductivity of the air
+REAL, DIMENSION(:), intent(in) :: PDV ! Diffusivity of water vapor in the air
+REAL, DIMENSION(:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: PRGS ! Graupel m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: PRHS ! Hail m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:), intent(inout) :: PUSW ! Undersaturation over water
+REAL, DIMENSION(:), intent(out) :: PRDRYG ! Dry growth rate of the graupeln
+REAL, DIMENSION(:), intent(out) :: PRWETG ! Wet growth rate of the graupeln
+!
+!* 0.2 declaration of local variables
+!
+INTEGER :: IGDRY
+INTEGER :: JJ, JL
+INTEGER, DIMENSION(size(PRHODREF)) :: I1
+INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC1, IVEC2 ! Vectors of indices for interpolations
+REAL, DIMENSION(size(PRHODREF)) :: ZZW ! Work array
+REAL, DIMENSION(:), ALLOCATABLE :: ZVEC1,ZVEC2,ZVEC3 ! Work vectors for interpolations
+REAL, DIMENSION(:), ALLOCATABLE :: ZVECLBDAG, ZVECLBDAR, ZVECLBDAS
+REAL, DIMENSION(size(PRHODREF),7) :: ZZW1 ! Work arrays
+!
+!-------------------------------------------------------------------------------
+!
+!* 6.1 rain contact freezing
+!
+ ZZW1(:,:) = 0.0
+ WHERE( (PRIT(:)>XRTMIN(4)) .AND. (PRRT(:)>XRTMIN(3)) .AND. &
+ (PRIS(:)>0.0) .AND. (PRRS(:)>0.0) )
+ ZZW1(:,3) = MIN( PRIS(:),XICFRR * PRIT(:) & ! RICFRRG
+ * PLBDAR(:)**XEXICFRR &
+ * PRHODREF(:)**(-XCEXVT) )
+ ZZW1(:,4) = MIN( PRRS(:),XRCFRI * PCIT(:) & ! RRCFRIG
+ * PLBDAR(:)**XEXRCFRI &
+ * PRHODREF(:)**(-XCEXVT-1.) )
+ PRIS(:) = PRIS(:) - ZZW1(:,3)
+ PRRS(:) = PRRS(:) - ZZW1(:,4)
+ PRGS(:) = PRGS(:) + ZZW1(:,3)+ZZW1(:,4)
+ PTHS(:) = PTHS(:) + ZZW1(:,4)*(PLSFACT(:)-PLVFACT(:)) ! f(L_f*RRCFRIG)
+ END WHERE
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'CFRZ', Unpack ( zzw1(:, 4) * ( plsfact(:) - plvfact(:) ) &
+ * prhodj(:), mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'CFRZ', Unpack ( -zzw1(:, 4) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'CFRZ', Unpack ( -zzw1(:, 3) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'CFRZ', Unpack ( ( zzw1(:,3) + zzw1(:,4) ) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+
+!PW:used init/end instead of add because zzw1 is produced with a where(...) and is used with other where(...)
+! => can not use directly zzw1 in Budget_store_add
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'WETG', Unpack ( pths(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'WETG', Unpack ( prcs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'WETG', Unpack ( prrs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'WETG', Unpack ( pris(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'WETG', Unpack ( prss(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'WETG', Unpack ( prgs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'WETG', Unpack ( prhs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+!
+!* 6.2 compute the Dry growth case
+!
+ ZZW1(:,:) = 0.0
+ WHERE( PRGT(:)>XRTMIN(6) .AND. PRCT(:)>XRTMIN(2) .AND. PRCS(:)>0.0 )
+ ZZW(:) = PLBDAG(:)**(XCXG-XDG-2.0) * PRHODREF(:)**(-XCEXVT)
+ ZZW1(:,1) = MIN( PRCS(:),XFCDRYG * PRCT(:) * ZZW(:) ) ! RCDRYG
+ END WHERE
+ WHERE( (PRGT(:)>XRTMIN(6)) .AND. PRIT(:)>XRTMIN(4) .AND. PRIS(:)>0.0 )
+ ZZW(:) = PLBDAG(:)**(XCXG-XDG-2.0) * PRHODREF(:)**(-XCEXVT)
+ ZZW1(:,2) = MIN( PRIS(:),XFIDRYG * EXP( XCOLEXIG*(PZT(:)-XTT) ) &
+ * PRIT(:) * ZZW(:) ) ! RIDRYG
+ END WHERE
+!
+!* 6.2.1 accretion of aggregates on the graupeln
+!
+ IGDRY = 0
+ DO JJ = 1, SIZE(PRST)
+ IF ( PRST(JJ)>XRTMIN(5) .AND. PRGT(JJ)>XRTMIN(6) .AND. PRSS(JJ)>0.0 ) THEN
+ IGDRY = IGDRY + 1
+ I1(IGDRY) = JJ
+ END IF
+ END DO
+
+ IF( IGDRY>0 ) THEN
+!
+!* 6.2.2 allocations
+!
+ ALLOCATE(ZVECLBDAG(IGDRY))
+ ALLOCATE(ZVECLBDAS(IGDRY))
+ ALLOCATE(ZVEC1(IGDRY))
+ ALLOCATE(ZVEC2(IGDRY))
+ ALLOCATE(ZVEC3(IGDRY))
+ ALLOCATE(IVEC1(IGDRY))
+ ALLOCATE(IVEC2(IGDRY))
+!
+!* 6.2.3 select the (PLBDAG,PLBDAS) couplet
+!
+ ZVECLBDAG(1:IGDRY) = PLBDAG(I1(1:IGDRY))
+ ZVECLBDAS(1:IGDRY) = PLBDAS(I1(1:IGDRY))
+!
+!* 6.2.4 find the next lower indice for the PLBDAG and for the PLBDAS
+! in the geometrical set of (Lbda_g,Lbda_s) couplet use to
+! tabulate the SDRYG-kernel
+!
+ ZVEC1(1:IGDRY) = MAX( 1.00001, MIN( REAL(NDRYLBDAG)-0.00001, &
+ XDRYINTP1G * LOG( ZVECLBDAG(1:IGDRY) ) + XDRYINTP2G ) )
+ IVEC1(1:IGDRY) = INT( ZVEC1(1:IGDRY) )
+ ZVEC1(1:IGDRY) = ZVEC1(1:IGDRY) - REAL( IVEC1(1:IGDRY) )
+!
+ ZVEC2(1:IGDRY) = MAX( 1.00001, MIN( REAL(NDRYLBDAS)-0.00001, &
+ XDRYINTP1S * LOG( ZVECLBDAS(1:IGDRY) ) + XDRYINTP2S ) )
+ IVEC2(1:IGDRY) = INT( ZVEC2(1:IGDRY) )
+ ZVEC2(1:IGDRY) = ZVEC2(1:IGDRY) - REAL( IVEC2(1:IGDRY) )
+!
+!* 6.2.5 perform the bilinear interpolation of the normalized
+! SDRYG-kernel
+!
+ DO JJ = 1,IGDRY
+ ZVEC3(JJ) = ( XKER_SDRYG(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_SDRYG(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * ZVEC1(JJ) &
+ - ( XKER_SDRYG(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_SDRYG(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * (ZVEC1(JJ) - 1.0)
+ END DO
+!
+ DO JJ = 1, IGDRY
+ JL = I1(JJ)
+ ZZW1(JL,3) = MIN( PRSS(JL),XFSDRYG*ZVEC3(JJ) & ! RSDRYG
+ * EXP( XCOLEXSG*(PZT(JL)-XTT) ) &
+ *( ZVECLBDAS(JJ)**(XCXS-XBS) )*( ZVECLBDAG(JJ)**XCXG ) &
+ *( PRHODREF(JL)**(-XCEXVT-1.) ) &
+ *( XLBSDRYG1/( ZVECLBDAG(JJ)**2 ) + &
+ XLBSDRYG2/( ZVECLBDAG(JJ) * ZVECLBDAS(JJ) ) + &
+ XLBSDRYG3/( ZVECLBDAS(JJ)**2) ) )
+ END DO
+ DEALLOCATE(ZVECLBDAS)
+ DEALLOCATE(ZVECLBDAG)
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(IVEC1)
+ DEALLOCATE(ZVEC3)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(ZVEC1)
+ END IF
+!
+!* 6.2.6 accretion of raindrops on the graupeln
+!
+ IGDRY = 0
+ DO JJ = 1, SIZE(PRRT)
+ IF ( PRRT(JJ)>XRTMIN(3) .AND. PRGT(JJ)>XRTMIN(6) .AND. PRRS(JJ)>0.0 ) THEN
+ IGDRY = IGDRY + 1
+ I1(IGDRY) = JJ
+ END IF
+ END DO
+!
+ IF( IGDRY>0 ) THEN
+!
+!* 6.2.7 allocations
+!
+ ALLOCATE(ZVECLBDAG(IGDRY))
+ ALLOCATE(ZVECLBDAR(IGDRY))
+ ALLOCATE(ZVEC1(IGDRY))
+ ALLOCATE(ZVEC2(IGDRY))
+ ALLOCATE(ZVEC3(IGDRY))
+ ALLOCATE(IVEC1(IGDRY))
+ ALLOCATE(IVEC2(IGDRY))
+!
+!* 6.2.8 select the (PLBDAG,PLBDAR) couplet
+!
+ ZVECLBDAG(1:IGDRY) = PLBDAG(I1(1:IGDRY))
+ ZVECLBDAR(1:IGDRY) = PLBDAR(I1(1:IGDRY))
+!
+!* 6.2.9 find the next lower indice for the PLBDAG and for the PLBDAR
+! in the geometrical set of (Lbda_g,Lbda_r) couplet use to
+! tabulate the RDRYG-kernel
+!
+ ZVEC1(1:IGDRY) = MAX( 1.00001, MIN( REAL(NDRYLBDAG)-0.00001, &
+ XDRYINTP1G * LOG( ZVECLBDAG(1:IGDRY) ) + XDRYINTP2G ) )
+ IVEC1(1:IGDRY) = INT( ZVEC1(1:IGDRY) )
+ ZVEC1(1:IGDRY) = ZVEC1(1:IGDRY) - REAL( IVEC1(1:IGDRY) )
+!
+ ZVEC2(1:IGDRY) = MAX( 1.00001, MIN( REAL(NDRYLBDAR)-0.00001, &
+ XDRYINTP1R * LOG( ZVECLBDAR(1:IGDRY) ) + XDRYINTP2R ) )
+ IVEC2(1:IGDRY) = INT( ZVEC2(1:IGDRY) )
+ ZVEC2(1:IGDRY) = ZVEC2(1:IGDRY) - REAL( IVEC2(1:IGDRY) )
+!
+!* 6.2.10 perform the bilinear interpolation of the normalized
+! RDRYG-kernel
+!
+ DO JJ = 1,IGDRY
+ ZVEC3(JJ) = ( XKER_RDRYG(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_RDRYG(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * ZVEC1(JJ) &
+ - ( XKER_RDRYG(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_RDRYG(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * (ZVEC1(JJ) - 1.0)
+ END DO
+!
+ DO JJ = 1, IGDRY
+ JL = I1(JJ)
+ ZZW1(JL,4) = MIN( PRRS(JL),XFRDRYG*ZVEC3(JJ) & ! RRDRYG
+ *( ZVECLBDAR(JJ)**(-4) )*( ZVECLBDAG(JJ)**XCXG ) &
+ *( PRHODREF(JL)**(-XCEXVT-1.) ) &
+ *( XLBRDRYG1/( ZVECLBDAG(JJ)**2 ) + &
+ XLBRDRYG2/( ZVECLBDAG(JJ) * ZVECLBDAR(JJ) ) + &
+ XLBRDRYG3/( ZVECLBDAR(JJ)**2) ) )
+ END DO
+ DEALLOCATE(ZVECLBDAR)
+ DEALLOCATE(ZVECLBDAG)
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(IVEC1)
+ DEALLOCATE(ZVEC3)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(ZVEC1)
+ END IF
+!
+ PRDRYG(:) = ZZW1(:,1) + ZZW1(:,2) + ZZW1(:,3) + ZZW1(:,4)
+!
+!* 6.3 compute the Wet growth case
+!
+ PRWETG(:) = 0.0
+ WHERE( PRGT(:)>XRTMIN(6) )
+ ZZW1(:,5) = MIN( PRIS(:), &
+ ZZW1(:,2) / (XCOLIG*EXP(XCOLEXIG*(PZT(:)-XTT)) ) ) ! RIWETG
+ ZZW1(:,6) = MIN( PRSS(:), &
+ ZZW1(:,3) / (XCOLSG*EXP(XCOLEXSG*(PZT(:)-XTT)) ) ) ! RSWETG
+!
+ ZZW(:) = PRVT(:)*PPRES(:)/((XMV/XMD)+PRVT(:)) ! Vapor pressure
+ ZZW(:) = PKA(:)*(XTT-PZT(:)) + &
+ ( PDV(:)*(XLVTT + ( XCPV - XCL ) * ( PZT(:) - XTT )) &
+ *(XESTT-ZZW(:))/(XRV*PZT(:)) )
+!
+! compute RWETG
+!
+ PRWETG(:)=MAX( 0.0, &
+ ( ZZW(:) * ( X0DEPG* PLBDAG(:)**XEX0DEPG + &
+ X1DEPG*PCJ(:)*PLBDAG(:)**XEX1DEPG ) + &
+ ( ZZW1(:,5)+ZZW1(:,6) ) * &
+ ( PRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-PZT(:))) ) ) / &
+ ( PRHODREF(:)*(XLMTT-XCL*(XTT-PZT(:))) ) )
+ END WHERE
+!
+!* 6.4 Select Wet or Dry case
+!
+ IF ( KRR == 7 ) THEN
+ WHERE( PRGT(:)>XRTMIN(6) .AND. PZT(:)<XTT &
+ .AND. & ! Wet
+ PRDRYG(:)>=PRWETG(:) .AND. PRWETG(:)>0.0 ) ! case
+ ZZW(:) = PRWETG(:) - ZZW1(:,5) - ZZW1(:,6) ! RCWETG+RRWETG
+!
+! limitation of the available rainwater mixing ratio (RRWETH < RRS !)
+!
+ ZZW1(:,7) = MAX( 0.0,MIN( ZZW(:),PRRS(:)+ZZW1(:,1) ) )
+ PUSW(:) = ZZW1(:,7) / ZZW(:)
+ ZZW1(:,5) = ZZW1(:,5)*PUSW(:)
+ ZZW1(:,6) = ZZW1(:,6)*PUSW(:)
+ PRWETG(:) = ZZW1(:,7) + ZZW1(:,5) + ZZW1(:,6)
+!
+ PRCS(:) = PRCS(:) - ZZW1(:,1)
+ PRIS(:) = PRIS(:) - ZZW1(:,5)
+ PRSS(:) = PRSS(:) - ZZW1(:,6)
+!
+! assume a linear percent of conversion of graupel into hail
+!
+ PRGS(:) = PRGS(:) + PRWETG(:) ! Wet growth
+ ZZW(:) = PRGS(:)*PRDRYG(:)/(PRWETG(:)+PRDRYG(:)) ! and
+ PRGS(:) = PRGS(:) - ZZW(:) ! partial conversion
+ PRHS(:) = PRHS(:) + ZZW(:) ! of the graupel into hail
+!
+ PRRS(:) = MAX( 0.0,PRRS(:) - ZZW1(:,7) + ZZW1(:,1) )
+ PTHS(:) = PTHS(:) + ZZW1(:,7)*(PLSFACT(:)-PLVFACT(:))
+ ! f(L_f*(RCWETG+RRWETG))
+ END WHERE
+ ELSE IF( KRR == 6 ) THEN
+ WHERE( PRGT(:)>XRTMIN(6) .AND. PZT(:)<XTT &
+ .AND. & ! Wet
+ PRDRYG(:)>=PRWETG(:) .AND. PRWETG(:)>0.0 ) ! case
+ PRCS(:) = PRCS(:) - ZZW1(:,1)
+ PRIS(:) = PRIS(:) - ZZW1(:,5)
+ PRSS(:) = PRSS(:) - ZZW1(:,6)
+ PRGS(:) = PRGS(:) + PRWETG(:)
+!
+ PRRS(:) = PRRS(:) - PRWETG(:) + ZZW1(:,5) + ZZW1(:,6) + ZZW1(:,1)
+ PTHS(:) = PTHS(:) + (PRWETG(:)-ZZW1(:,5)-ZZW1(:,6))*(PLSFACT(:)-PLVFACT(:))
+ ! f(L_f*(RCWETG+RRWETG))
+ END WHERE
+ END IF
+
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'WETG', Unpack ( pths(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'WETG', Unpack ( prcs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'WETG', Unpack ( prrs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'WETG', Unpack ( pris(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'WETG', Unpack ( prss(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'WETG', Unpack ( prgs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'WETG', Unpack ( prhs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+
+!PW:used init/end instead of add because zzw1 is produced with a where(...) and is used with other where(...)
+! => can not use directly zzw1 in Budget_store_add
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'DRYG', Unpack ( pths(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'DRYG', Unpack ( prcs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'DRYG', Unpack ( prrs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'DRYG', Unpack ( pris(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'DRYG', Unpack ( prss(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'DRYG', Unpack ( prgs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+
+ WHERE( PRGT(:)>XRTMIN(6) .AND. PZT(:)<XTT &
+ .AND. &
+ PRDRYG(:)<PRWETG(:) .AND. PRDRYG(:)>0.0 ) ! Dry
+ PRCS(:) = PRCS(:) - ZZW1(:,1)
+ PRIS(:) = PRIS(:) - ZZW1(:,2)
+ PRSS(:) = PRSS(:) - ZZW1(:,3)
+ PRRS(:) = PRRS(:) - ZZW1(:,4)
+ PRGS(:) = PRGS(:) + PRDRYG(:)
+ PTHS(:) = PTHS(:) + (ZZW1(:,1)+ZZW1(:,4))*(PLSFACT(:)-PLVFACT(:)) !
+ ! f(L_f*(RCDRYG+RRDRYG))
+ END WHERE
+
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'DRYG', Unpack ( pths(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'DRYG', Unpack ( prcs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'DRYG', Unpack ( prrs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'DRYG', Unpack ( pris(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'DRYG', Unpack ( prss(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'DRYG', Unpack ( prgs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+!
+! WHERE ( PZT(:) > XTT ) ! RSWETG case only
+! PRSS(:) = PRSS(:) - ZZW1(:,6)
+! PRGS(:) = PRGS(:) + ZZW1(:,6)
+! END WHERE
+!
+!* 6.5 Melting of the graupeln
+!
+ zzw(:) = 0. !initialization necessary (for budgets)
+ WHERE( PRGT(:)>XRTMIN(6) .AND. PRGS(:)>0.0 .AND. PZT(:)>XTT )
+ ZZW(:) = PRVT(:)*PPRES(:)/((XMV/XMD)+PRVT(:)) ! Vapor pressure
+ ZZW(:) = PKA(:)*(XTT-PZT(:)) + &
+ ( PDV(:)*(XLVTT + ( XCPV - XCL ) * ( PZT(:) - XTT )) &
+ *(XESTT-ZZW(:))/(XRV*PZT(:)) )
+!
+! compute RGMLTR
+!
+ ZZW(:) = MIN( PRGS(:), MAX( 0.0,( -ZZW(:) * &
+ ( X0DEPG* PLBDAG(:)**XEX0DEPG + &
+ X1DEPG*PCJ(:)*PLBDAG(:)**XEX1DEPG ) - &
+ ( ZZW1(:,1)+ZZW1(:,4) ) * &
+ ( PRHODREF(:)*XCL*(XTT-PZT(:))) ) / &
+ ( PRHODREF(:)*XLMTT ) ) )
+ PRRS(:) = PRRS(:) + ZZW(:)
+ PRGS(:) = PRGS(:) - ZZW(:)
+ PTHS(:) = PTHS(:) - ZZW(:)*(PLSFACT(:)-PLVFACT(:)) ! f(L_f*(-RGMLTR))
+ END WHERE
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'GMLT', Unpack ( -zzw(:) * ( plsfact(:) - plvfact(:) ) &
+ * prhodj(:), mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'GMLT', Unpack ( zzw(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'GMLT', Unpack ( -zzw(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+END SUBROUTINE RAIN_ICE_FAST_RG
+
+END MODULE MODE_RAIN_ICE_FAST_RG
diff --git a/src/mesonh/micro/rain_ice_fast_rh.f90 b/src/mesonh/micro/rain_ice_fast_rh.f90
new file mode 100644
index 000000000..1710f8b15
--- /dev/null
+++ b/src/mesonh/micro/rain_ice_fast_rh.f90
@@ -0,0 +1,403 @@
+!MNH_LIC Copyright 1995-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! Modifications:
+! P. Wautelet 25/02/2019: split rain_ice (cleaner and easier to maintain/debug)
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 03/06/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
+! P. Wautelet 05/06/2019: optimisations
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
+!-----------------------------------------------------------------
+MODULE MODE_RAIN_ICE_FAST_RH
+
+ IMPLICIT NONE
+
+ PRIVATE
+
+ PUBLIC :: RAIN_ICE_FAST_RH
+
+CONTAINS
+
+SUBROUTINE RAIN_ICE_FAST_RH(OMICRO, PRHODREF, PRVT, PRCT, PRIT, PRST, PRGT, PRHT, PRHODJ, PPRES, &
+ PZT, PLBDAS, PLBDAG, PLBDAH, PLSFACT, PLVFACT, PCJ, PKA, PDV, &
+ PRCS, PRRS, PRIS, PRSS, PRGS, PRHS, PTHS, PUSW)
+!
+!* 0. DECLARATIONS
+! ------------
+!
+use modd_budget, only: lbudget_th, lbudget_rc, lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, &
+ NBUDGET_TH, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, &
+ tbudgets
+use MODD_CST, only: XCI, XCL, XCPV, XESTT, XLMTT, XLVTT, XMD, XMV, XRV, XTT
+use MODD_RAIN_ICE_DESCR, only: XBG, XBS, XCEXVT, XCXG, XCXH, XCXS, XDH, XLBEXH, XLBH, XRTMIN
+use MODD_RAIN_ICE_PARAM, only: NWETLBDAG, NWETLBDAH, NWETLBDAS, X0DEPH, X1DEPH, &
+ XEX0DEPH, XEX1DEPH, XFGWETH, XFSWETH, XFWETH, XKER_GWETH, XKER_SWETH, &
+ XLBGWETH1, XLBGWETH2, XLBGWETH3, XLBSWETH1, XLBSWETH2, XLBSWETH3, &
+ XWETINTP1G, XWETINTP1H, XWETINTP1S, XWETINTP2G, XWETINTP2H, XWETINTP2S
+
+use mode_budget, only: Budget_store_add, Budget_store_end, Budget_store_init
+
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+LOGICAL, DIMENSION(:,:,:), intent(in) :: OMICRO ! Test where to compute all processes
+REAL, DIMENSION(:), intent(in) :: PRHODREF ! RHO Dry REFerence
+REAL, DIMENSION(:), intent(in) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:), intent(in) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:), intent(in) :: PRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(:), intent(in) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:), intent(in) :: PRGT ! Graupel m.r. at t
+REAL, DIMENSION(:), intent(in) :: PRHT ! Hail m.r. at t
+REAL, DIMENSION(:), intent(in) :: PRHODJ ! RHO times Jacobian
+REAL, DIMENSION(:), intent(in) :: PPRES ! Pressure
+REAL, DIMENSION(:), intent(in) :: PZT ! Temperature
+REAL, DIMENSION(:), intent(in) :: PLBDAS ! Slope parameter of the aggregate distribution
+REAL, DIMENSION(:), intent(in) :: PLBDAG ! Slope parameter of the graupel distribution
+REAL, DIMENSION(:), intent(inout) :: PLBDAH ! Slope parameter of the hail distribution
+REAL, DIMENSION(:), intent(in) :: PLSFACT ! L_s/(Pi_ref*C_ph)
+REAL, DIMENSION(:), intent(in) :: PLVFACT ! L_v/(Pi_ref*C_ph)
+REAL, DIMENSION(:), intent(in) :: PCJ ! Function to compute the ventilation coefficient
+REAL, DIMENSION(:), intent(in) :: PKA ! Thermal conductivity of the air
+REAL, DIMENSION(:), intent(in) :: PDV ! Diffusivity of water vapor in the air
+REAL, DIMENSION(:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: PRGS ! Graupel m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: PRHS ! Hail m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:), intent(inout) :: PUSW ! Undersaturation over water
+!
+!* 0.2 declaration of local variables
+!
+INTEGER :: IHAIL, IGWET
+INTEGER :: JJ, JL
+INTEGER, DIMENSION(size(PRHODREF)) :: I1H, I1W
+INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC1, IVEC2 ! Vectors of indices for interpolations
+REAL, DIMENSION(:), ALLOCATABLE :: ZVEC1,ZVEC2,ZVEC3 ! Work vectors for interpolations
+REAL, DIMENSION(:), ALLOCATABLE :: ZVECLBDAG, ZVECLBDAH, ZVECLBDAS
+REAL, DIMENSION(size(PRHODREF)) :: ZZW ! Work array
+REAL, DIMENSION(size(PRHODREF),6) :: ZZW1 ! Work arrays
+!
+!-------------------------------------------------------------------------------
+!
+ IHAIL = 0
+ DO JJ = 1, SIZE(PRHT)
+ IF ( PRHT(JJ)>XRTMIN(7) ) THEN
+ IHAIL = IHAIL + 1
+ I1H(IHAIL) = JJ
+ END IF
+ END DO
+!
+ IF( IHAIL>0 ) THEN
+!PW:used init/end instead of add because zzw1 is produced and used with different conditions
+! => can not use directly zzw1 in Budget_store_add
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'WETH', Unpack ( pths(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'WETH', Unpack ( prcs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'WETH', Unpack ( prrs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'WETH', Unpack ( pris(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'WETH', Unpack ( prss(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'WETH', Unpack ( prgs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'WETH', Unpack ( prhs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+!
+!* 7.2 compute the Wet growth of hail
+!
+ ZZW1(:,:) = 0.0
+!
+ DO JJ = 1, IHAIL
+ JL = I1H(JJ)
+ PLBDAH(JL) = XLBH * ( PRHODREF(JL) * MAX( PRHT(JL), XRTMIN(7) ) )**XLBEXH
+
+ IF ( PRCT(JL)>XRTMIN(2) .AND. PRCS(JL)>0.0 ) THEN
+ ZZW(JL) = PLBDAH(JL)**(XCXH-XDH-2.0) * PRHODREF(JL)**(-XCEXVT)
+ ZZW1(JL,1) = MIN( PRCS(JL),XFWETH * PRCT(JL) * ZZW(JL) ) ! RCWETH
+ END IF
+
+ IF ( PRIT(JL)>XRTMIN(4) .AND. PRIS(JL)>0.0 ) THEN
+ ZZW(JL) = PLBDAH(JL)**(XCXH-XDH-2.0) * PRHODREF(JL)**(-XCEXVT)
+ ZZW1(JL,2) = MIN( PRIS(JL),XFWETH * PRIT(JL) * ZZW(JL) ) ! RIWETH
+ END IF
+ END DO
+!
+!* 7.2.1 accretion of aggregates on the hailstones
+!
+ IGWET = 0
+ DO JJ = 1, IHAIL
+ JL = I1H(JJ)
+ IF ( PRST(JL)>XRTMIN(5) .AND. PRSS(JL)>0.0 ) THEN
+ IGWET = IGWET + 1
+ I1W(IGWET) = JL
+ END IF
+ END DO
+!
+ IF( IGWET>0 ) THEN
+!
+!* 7.2.2 allocations
+!
+ ALLOCATE(ZVECLBDAH(IGWET))
+ ALLOCATE(ZVECLBDAS(IGWET))
+ ALLOCATE(ZVEC1(IGWET))
+ ALLOCATE(ZVEC2(IGWET))
+ ALLOCATE(ZVEC3(IGWET))
+ ALLOCATE(IVEC1(IGWET))
+ ALLOCATE(IVEC2(IGWET))
+!
+!* 7.2.3 select the (PLBDAH,PLBDAS) couplet
+!
+ ZVECLBDAH(1:IGWET) = PLBDAH(I1W(1:IGWET))
+ ZVECLBDAS(1:IGWET) = PLBDAS(I1W(1:IGWET))
+!
+!* 7.2.4 find the next lower indice for the PLBDAG and for the PLBDAS
+! in the geometrical set of (Lbda_h,Lbda_s) couplet use to
+! tabulate the SWETH-kernel
+!
+ ZVEC1(1:IGWET) = MAX( 1.00001, MIN( REAL(NWETLBDAH)-0.00001, &
+ XWETINTP1H * LOG( ZVECLBDAH(1:IGWET) ) + XWETINTP2H ) )
+ IVEC1(1:IGWET) = INT( ZVEC1(1:IGWET) )
+ ZVEC1(1:IGWET) = ZVEC1(1:IGWET) - REAL( IVEC1(1:IGWET) )
+!
+ ZVEC2(1:IGWET) = MAX( 1.00001, MIN( REAL(NWETLBDAS)-0.00001, &
+ XWETINTP1S * LOG( ZVECLBDAS(1:IGWET) ) + XWETINTP2S ) )
+ IVEC2(1:IGWET) = INT( ZVEC2(1:IGWET) )
+ ZVEC2(1:IGWET) = ZVEC2(1:IGWET) - REAL( IVEC2(1:IGWET) )
+!
+!* 7.2.5 perform the bilinear interpolation of the normalized
+! SWETH-kernel
+!
+ DO JJ = 1,IGWET
+ ZVEC3(JJ) = ( XKER_SWETH(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_SWETH(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * ZVEC1(JJ) &
+ - ( XKER_SWETH(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_SWETH(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * (ZVEC1(JJ) - 1.0)
+ END DO
+!
+ DO JJ = 1, IGWET
+ JL = I1W(JJ)
+ ZZW1(JL,3) = MIN( PRSS(JL),XFSWETH*ZVEC3(JJ) & ! RSWETH
+ *( ZVECLBDAS(JJ)**(XCXS-XBS) )*( ZVECLBDAH(JJ)**XCXH ) &
+ *( PRHODREF(JL)**(-XCEXVT-1.) ) &
+ *( XLBSWETH1/( ZVECLBDAH(JJ)**2 ) + &
+ XLBSWETH2/( ZVECLBDAH(JJ) * ZVECLBDAS(JJ) ) + &
+ XLBSWETH3/( ZVECLBDAS(JJ)**2) ) )
+ END DO
+ DEALLOCATE(ZVECLBDAS)
+ DEALLOCATE(ZVECLBDAH)
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(IVEC1)
+ DEALLOCATE(ZVEC3)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(ZVEC1)
+ END IF
+!
+!* 7.2.6 accretion of graupeln on the hailstones
+!
+ IGWET = 0
+ DO JJ = 1, IHAIL
+ JL = I1H(JJ)
+ IF ( PRGT(JL)>XRTMIN(6) .AND. PRGS(JL)>0.0 ) THEN
+ IGWET = IGWET + 1
+ I1W(IGWET) = JL
+ END IF
+ END DO
+!
+ IF( IGWET>0 ) THEN
+!
+!* 7.2.7 allocations
+!
+ ALLOCATE(ZVECLBDAG(IGWET))
+ ALLOCATE(ZVECLBDAH(IGWET))
+ ALLOCATE(ZVEC1(IGWET))
+ ALLOCATE(ZVEC2(IGWET))
+ ALLOCATE(ZVEC3(IGWET))
+ ALLOCATE(IVEC1(IGWET))
+ ALLOCATE(IVEC2(IGWET))
+!
+!* 7.2.8 select the (PLBDAH,PLBDAG) couplet
+!
+ ZVECLBDAG(1:IGWET) = PLBDAG(I1W(1:IGWET))
+ ZVECLBDAH(1:IGWET) = PLBDAH(I1W(1:IGWET))
+!
+!* 7.2.9 find the next lower indice for the PLBDAH and for the PLBDAG
+! in the geometrical set of (Lbda_h,Lbda_g) couplet use to
+! tabulate the GWETH-kernel
+!
+ ZVEC1(1:IGWET) = MAX( 1.00001, MIN( REAL(NWETLBDAG)-0.00001, &
+ XWETINTP1H * LOG( ZVECLBDAH(1:IGWET) ) + XWETINTP2H ) )
+ IVEC1(1:IGWET) = INT( ZVEC1(1:IGWET) )
+ ZVEC1(1:IGWET) = ZVEC1(1:IGWET) - REAL( IVEC1(1:IGWET) )
+!
+ ZVEC2(1:IGWET) = MAX( 1.00001, MIN( REAL(NWETLBDAG)-0.00001, &
+ XWETINTP1G * LOG( ZVECLBDAG(1:IGWET) ) + XWETINTP2G ) )
+ IVEC2(1:IGWET) = INT( ZVEC2(1:IGWET) )
+ ZVEC2(1:IGWET) = ZVEC2(1:IGWET) - REAL( IVEC2(1:IGWET) )
+!
+!* 7.2.10 perform the bilinear interpolation of the normalized
+! GWETH-kernel
+!
+ DO JJ = 1,IGWET
+ ZVEC3(JJ) = ( XKER_GWETH(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_GWETH(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * ZVEC1(JJ) &
+ - ( XKER_GWETH(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_GWETH(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * (ZVEC1(JJ) - 1.0)
+ END DO
+!
+ DO JJ = 1, IGWET
+ JL = I1W(JJ)
+ ZZW1(JL,5) = MAX(MIN( PRGS(JL),XFGWETH*ZVEC3(JJ) & ! RGWETH
+ *( ZVECLBDAG(JJ)**(XCXG-XBG) )*( ZVECLBDAH(JJ)**XCXH ) &
+ *( PRHODREF(JL)**(-XCEXVT-1.) ) &
+ *( XLBGWETH1/( ZVECLBDAH(JJ)**2 ) + &
+ XLBGWETH2/( ZVECLBDAH(JJ) * ZVECLBDAG(JJ) ) + &
+ XLBGWETH3/( ZVECLBDAG(JJ)**2) ) ),0. )
+ END DO
+ DEALLOCATE(ZVECLBDAH)
+ DEALLOCATE(ZVECLBDAG)
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(IVEC1)
+ DEALLOCATE(ZVEC3)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(ZVEC1)
+ END IF
+!
+!* 7.3 compute the Wet growth of hail
+!
+ DO JJ = 1, IHAIL
+ JL = I1H(JJ)
+ IF ( PZT(JL)<XTT ) THEN
+ ZZW(JL) = PRVT(JL)*PPRES(JL)/((XMV/XMD)+PRVT(JL)) ! Vapor pressure
+ ZZW(JL) = PKA(JL)*(XTT-PZT(JL)) + &
+ ( PDV(JL)*(XLVTT + ( XCPV - XCL ) * ( PZT(JL) - XTT )) &
+ *(XESTT-ZZW(JL))/(XRV*PZT(JL)) )
+!
+! compute RWETH
+!
+ ZZW(JL) = MAX(0., ( ZZW(JL) * ( X0DEPH* PLBDAH(JL)**XEX0DEPH + &
+ X1DEPH*PCJ(JL)*PLBDAH(JL)**XEX1DEPH ) + &
+ ( ZZW1(JL,2)+ZZW1(JL,3)+ZZW1(JL,5) ) * &
+ ( PRHODREF(JL)*(XLMTT+(XCI-XCL)*(XTT-PZT(JL))) ) ) / &
+ ( PRHODREF(JL)*(XLMTT-XCL*(XTT-PZT(JL))) ) )
+!
+ ZZW1(JL,6) = MAX( ZZW(JL) - ZZW1(JL,2) - ZZW1(JL,3) - ZZW1(JL,5),0.) ! RCWETH+RRWETH
+ IF ( ZZW1(JL,6)/=0.) THEN
+!
+! limitation of the available rainwater mixing ratio (RRWETH < RRS !)
+!
+ ZZW1(JL,4) = MAX( 0.0,MIN( ZZW1(JL,6),PRRS(JL)+ZZW1(JL,1) ) )
+ PUSW(JL) = ZZW1(JL,4) / ZZW1(JL,6)
+ ZZW1(JL,2) = ZZW1(JL,2)*PUSW(JL)
+ ZZW1(JL,3) = ZZW1(JL,3)*PUSW(JL)
+ ZZW1(JL,5) = ZZW1(JL,5)*PUSW(JL)
+ ZZW(JL) = ZZW1(JL,4) + ZZW1(JL,2) + ZZW1(JL,3) + ZZW1(JL,5)
+!
+!* 7.1.6 integrate the Wet growth of hail
+!
+ PRCS(JL) = PRCS(JL) - ZZW1(JL,1)
+ PRIS(JL) = PRIS(JL) - ZZW1(JL,2)
+ PRSS(JL) = PRSS(JL) - ZZW1(JL,3)
+ PRGS(JL) = PRGS(JL) - ZZW1(JL,5)
+ PRHS(JL) = PRHS(JL) + ZZW(JL)
+ PRRS(JL) = MAX( 0.0,PRRS(JL) - ZZW1(JL,4) + ZZW1(JL,1) )
+ PTHS(JL) = PTHS(JL) + ZZW1(JL,4)*(PLSFACT(JL)-PLVFACT(JL))
+ ! f(L_f*(RCWETH+RRWETH))
+ END IF
+ END IF
+ END DO
+
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'WETH', Unpack ( pths(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'WETH', Unpack ( prcs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'WETH', Unpack ( prrs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'WETH', Unpack ( pris(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'WETH', Unpack ( prss(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'WETH', Unpack ( prgs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'WETH', Unpack ( prhs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+!
+!
+! ici LRECONVH et un flag pour autoriser une reconversion partielle de
+!la grele en gresil
+!
+! IF( IHAIL>0 ) THEN
+!
+!UPG_CD
+!
+!
+!* 7.45 Conversion of the hailstones into graupel
+!
+! XDUMMY6=0.01E-3
+! XDUMMY7=0.001E-3
+! WHERE( PRHT(:)<XDUMMY6 .AND. PRCT(:)<XDUMMY7 .AND. PZT(:)<XTT )
+! ZZW(:) = MIN( 1.0,MAX( 0.0,1.0-(PRCT(:)/XDUMMY7) ) )
+!
+! assume a linear percent conversion rate of hail into graupel
+!
+! ZZW(:) = PRHS(:)*ZZW(:)
+! PRGS(:) = PRGS(:) + ZZW(:) ! partial conversion
+! PRHS(:) = PRHS(:) - ZZW(:) ! of hail into graupel
+!
+! END WHERE
+! END IF
+
+
+
+
+!
+!* 7.5 Melting of the hailstones
+!
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HMLT', Unpack ( pths(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'HMLT', Unpack ( prrs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'HMLT', Unpack ( prhs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+
+ DO JJ = 1, IHAIL
+ JL = I1H(JJ)
+ IF( PRHS(JL)>0.0 .AND. PZT(JL)>XTT ) THEN
+ ZZW(JL) = PRVT(JL)*PPRES(JL)/((XMV/XMD)+PRVT(JL)) ! Vapor pressure
+ ZZW(JL) = PKA(JL)*(XTT-PZT(JL)) + &
+ ( PDV(JL)*(XLVTT + ( XCPV - XCL ) * ( PZT(JL) - XTT )) &
+ *(XESTT-ZZW(JL))/(XRV*PZT(JL)) )
+!
+! compute RHMLTR
+!
+ ZZW(JL) = MIN( PRHS(JL), MAX( 0.0,( -ZZW(JL) * &
+ ( X0DEPH* PLBDAH(JL)**XEX0DEPH + &
+ X1DEPH*PCJ(JL)*PLBDAH(JL)**XEX1DEPH ) ) / &
+ ( PRHODREF(JL)*XLMTT ) ) )
+ PRRS(JL) = PRRS(JL) + ZZW(JL)
+ PRHS(JL) = PRHS(JL) - ZZW(JL)
+ PTHS(JL) = PTHS(JL) - ZZW(JL)*(PLSFACT(JL)-PLVFACT(JL)) ! f(L_f*(-RHMLTR))
+ END IF
+ END DO
+
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HMLT', Unpack ( pths(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'HMLT', Unpack ( prrs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'HMLT', Unpack ( prhs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ END IF
+!
+END SUBROUTINE RAIN_ICE_FAST_RH
+
+END MODULE MODE_RAIN_ICE_FAST_RH
diff --git a/src/mesonh/micro/rain_ice_fast_ri.f90 b/src/mesonh/micro/rain_ice_fast_ri.f90
new file mode 100644
index 000000000..edb36a38b
--- /dev/null
+++ b/src/mesonh/micro/rain_ice_fast_ri.f90
@@ -0,0 +1,103 @@
+!MNH_LIC Copyright 1995-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! Modifications:
+! P. Wautelet 25/02/2019: split rain_ice (cleaner and easier to maintain/debug)
+! P. Wautelet 05/06/2019: optimisations
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
+!-----------------------------------------------------------------
+MODULE MODE_RAIN_ICE_FAST_RI
+
+ IMPLICIT NONE
+
+ PRIVATE
+
+ PUBLIC :: RAIN_ICE_FAST_RI
+
+CONTAINS
+
+SUBROUTINE RAIN_ICE_FAST_RI(OMICRO, PRHODREF, PRIT, PRHODJ, PZT, PSSI, PLSFACT, PLVFACT, &
+ PAI, PCJ, PCIT, PRCS, PRIS, PTHS)
+!
+!* 0. DECLARATIONS
+! ------------
+!
+use modd_budget, only: lbudget_th, lbudget_rc, lbudget_ri, &
+ NBUDGET_TH, NBUDGET_RC, NBUDGET_RI, &
+ tbudgets
+use MODD_CST, only: XTT
+use MODD_RAIN_ICE_DESCR, only: XDI, XLBEXI, XLBI, XRTMIN
+use MODD_RAIN_ICE_PARAM, only: X0DEPI, X2DEPI
+
+use mode_budget, only: Budget_store_add, Budget_store_end, Budget_store_init
+
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+LOGICAL, DIMENSION(:,:,:), intent(in) :: OMICRO ! Test where to compute all processes
+REAL, DIMENSION(:), intent(in) :: PRHODREF ! RHO Dry REFerence
+REAL, DIMENSION(:), intent(in) :: PRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(:), intent(in) :: PRHODJ ! RHO times Jacobian
+REAL, DIMENSION(:), intent(in) :: PZT ! Temperature
+REAL, DIMENSION(:), intent(in) :: PSSI ! Supersaturation over ice
+REAL, DIMENSION(:), intent(in) :: PLSFACT ! L_s/(Pi_ref*C_ph)
+REAL, DIMENSION(:), intent(in) :: PLVFACT ! L_v/(Pi_ref*C_ph)
+REAL, DIMENSION(:), intent(in) :: PAI ! Thermodynamical function
+REAL, DIMENSION(:), intent(in) :: PCJ ! Function to compute the ventilation coefficient
+REAL, DIMENSION(:), intent(inout) :: PCIT ! Pristine ice conc. at t
+REAL, DIMENSION(:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: PTHS ! Theta source
+!
+!* 0.2 declaration of local variables
+!
+REAL, DIMENSION(size(PRHODREF)) :: ZZW ! Work array
+!-------------------------------------------------------------------------------
+!
+!* 7.1 cloud ice melting
+!
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'IMLT', Unpack ( pths(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'IMLT', Unpack ( prcs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'IMLT', Unpack ( pris(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+
+ WHERE( PRIS(:)>0.0 .AND. PZT(:)>XTT )
+ PRCS(:) = PRCS(:) + PRIS(:)
+ PTHS(:) = PTHS(:) - PRIS(:)*(PLSFACT(:)-PLVFACT(:)) ! f(L_f*(-RIMLTC))
+ PRIS(:) = 0.0
+ PCIT(:) = 0.0
+ END WHERE
+
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'IMLT', Unpack ( pths(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'IMLT', Unpack ( prcs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'IMLT', Unpack ( pris(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+!
+!* 7.2 Bergeron-Findeisen effect: RCBERI
+!
+ zzw(:) = 0.
+ WHERE( PRCS(:)>0.0 .AND. PSSI(:)>0.0 .AND. PRIT(:)>XRTMIN(4) .AND. PCIT(:)>0.0 )
+ ZZW(:) = MIN(1.E8,XLBI*( PRHODREF(:)*PRIT(:)/PCIT(:) )**XLBEXI) ! Lbda_i
+ ZZW(:) = MIN( PRCS(:),( PSSI(:) / (PRHODREF(:)*PAI(:)) ) * PCIT(:) * &
+ ( X0DEPI/ZZW(:) + X2DEPI*PCJ(:)*PCJ(:)/ZZW(:)**(XDI+2.0) ) )
+ PRCS(:) = PRCS(:) - ZZW(:)
+ PRIS(:) = PRIS(:) + ZZW(:)
+ PTHS(:) = PTHS(:) + ZZW(:)*(PLSFACT(:)-PLVFACT(:)) ! f(L_f*(RCBERI))
+ END WHERE
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'BERFI', Unpack ( zzw(:) * ( plsfact(:) - plvfact(:) ) &
+ * prhodj(:), mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'BERFI', Unpack ( -zzw(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'BERFI', Unpack ( zzw(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+END SUBROUTINE RAIN_ICE_FAST_RI
+
+END MODULE MODE_RAIN_ICE_FAST_RI
diff --git a/src/mesonh/micro/rain_ice_fast_rs.f90 b/src/mesonh/micro/rain_ice_fast_rs.f90
new file mode 100644
index 000000000..a4750d01d
--- /dev/null
+++ b/src/mesonh/micro/rain_ice_fast_rs.f90
@@ -0,0 +1,375 @@
+!MNH_LIC Copyright 1995-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! Modifications:
+! P. Wautelet 25/02/2019: split rain_ice (cleaner and easier to maintain/debug)
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 03/06/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
+! P. Wautelet 05/06/2019: optimisations
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
+! P. Wautelet 19/02/2021: bugfix: RIM and ACC terms for budgets are now correctly stored
+!-----------------------------------------------------------------
+MODULE MODE_RAIN_ICE_FAST_RS
+
+ IMPLICIT NONE
+
+ PRIVATE
+
+ PUBLIC :: RAIN_ICE_FAST_RS
+
+CONTAINS
+
+SUBROUTINE RAIN_ICE_FAST_RS(PTSTEP, OMICRO, PRHODREF, PRVT, PRCT, PRRT, PRST, PRHODJ, PPRES, PZT, &
+ PLBDAR, PLBDAS, PLSFACT, PLVFACT, PCJ, PKA, PDV, &
+ PRCS, PRRS, PRSS, PRGS, PTHS)
+!
+!* 0. DECLARATIONS
+! ------------
+!
+use modd_budget, only: lbudget_th, lbudget_rc, lbudget_rr, lbudget_rs, lbudget_rg, &
+ NBUDGET_TH, NBUDGET_RC, NBUDGET_RR, NBUDGET_RS, NBUDGET_RG, &
+ tbudgets
+use MODD_CST, only: XCL, XCPV, XESTT, XLMTT, XLVTT, XMD, XMV, XRV, XTT
+use MODD_RAIN_ICE_DESCR, only: XBS, XCEXVT, XCXS, XRTMIN
+use MODD_RAIN_ICE_PARAM, only: NACCLBDAR, NACCLBDAS, NGAMINC, X0DEPS, X1DEPS, XACCINTP1R, XACCINTP1S, XACCINTP2R, XACCINTP2S, &
+ XCRIMSG, XCRIMSS, XEX0DEPS, XEX1DEPS, XEXCRIMSG, XEXCRIMSS, XEXSRIMCG, XFRACCSS, &
+ XFSACCRG, XFSCVMG, XGAMINC_RIM1, XGAMINC_RIM1, XGAMINC_RIM2, XKER_RACCS, &
+ XKER_RACCSS, XKER_SACCRG, XLBRACCS1, XLBRACCS2, XLBRACCS3, XLBSACCR1, XLBSACCR2, XLBSACCR3, &
+ XRIMINTP1, XRIMINTP2, XSRIMCG
+
+use mode_budget, only: Budget_store_add, Budget_store_end, Budget_store_init
+
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, intent(in) :: PTSTEP ! Double Time step
+ ! (single if cold start)
+LOGICAL, DIMENSION(:,:,:), intent(in) :: OMICRO ! Test where to compute all processes
+REAL, DIMENSION(:), intent(in) :: PRHODREF ! RHO Dry REFerence
+REAL, DIMENSION(:), intent(in) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:), intent(in) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:), intent(in) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:), intent(in) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:), intent(in) :: PRHODJ ! RHO times Jacobian
+REAL, DIMENSION(:), intent(in) :: PPRES ! Pressure
+REAL, DIMENSION(:), intent(in) :: PZT ! Temperature
+REAL, DIMENSION(:), intent(in) :: PLBDAR ! Slope parameter of the raindrop distribution
+REAL, DIMENSION(:), intent(in) :: PLBDAS ! Slope parameter of the aggregate distribution
+REAL, DIMENSION(:), intent(in) :: PLSFACT ! L_s/(Pi_ref*C_ph)
+REAL, DIMENSION(:), intent(in) :: PLVFACT ! L_v/(Pi_ref*C_ph)
+REAL, DIMENSION(:), intent(in) :: PCJ ! Function to compute the ventilation coefficient
+REAL, DIMENSION(:), intent(in) :: PKA ! Thermal conductivity of the air
+REAL, DIMENSION(:), intent(in) :: PDV ! Diffusivity of water vapor in the air
+REAL, DIMENSION(:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: PRGS ! Graupel m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: PTHS ! Theta source
+!
+!* 0.2 declaration of local variables
+!
+INTEGER :: IGRIM, IGACC
+INTEGER :: JJ, JL
+INTEGER, DIMENSION(size(PRHODREF)) :: I1
+INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC1, IVEC2 ! Vectors of indices for interpolations
+REAL, DIMENSION(size(PRHODREF)) :: ZZW ! Work array
+REAL, DIMENSION(:), ALLOCATABLE :: ZVEC1,ZVEC2,ZVEC3 ! Work vectors for interpolations
+REAL, DIMENSION(:), ALLOCATABLE :: ZVECLBDAR, ZVECLBDAS
+REAL, DIMENSION(:), ALLOCATABLE :: ZZW1, ZZW2, ZZW3, ZZW4 ! Work arrays
+!-------------------------------------------------------------------------------
+!
+!* 5.1 cloud droplet riming of the aggregates
+!
+ IGRIM = 0
+ DO JJ = 1, SIZE(PRCT)
+ IF ( PRCT(JJ)>XRTMIN(2) .AND. PRST(JJ)>XRTMIN(5) .AND. PRCS(JJ)>0.0 .AND. PZT(JJ)<XTT ) THEN
+ IGRIM = IGRIM + 1
+ I1(IGRIM) = JJ
+ END IF
+ END DO
+ !
+ IF( IGRIM>0 ) THEN
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'RIM', Unpack ( pths(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'RIM', Unpack ( prcs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'RIM', Unpack ( prss(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'RIM', Unpack ( prgs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+
+!
+! 5.1.0 allocations
+!
+ ALLOCATE(ZVECLBDAS(IGRIM))
+ ALLOCATE(ZVEC1(IGRIM))
+ ALLOCATE(ZVEC2(IGRIM))
+ ALLOCATE(IVEC2(IGRIM))
+ ALLOCATE(ZZW1(IGRIM))
+ ALLOCATE(ZZW2(IGRIM))
+ ALLOCATE(ZZW3(IGRIM))
+!
+! 5.1.1 select the PLBDAS
+!
+ ZVECLBDAS(1:IGRIM) = PLBDAS(I1(1:IGRIM))
+!
+! 5.1.2 find the next lower indice for the PLBDAS in the geometrical
+! set of Lbda_s used to tabulate some moments of the incomplete
+! gamma function
+!
+ ZVEC2(1:IGRIM) = MAX( 1.00001, MIN( REAL(NGAMINC)-0.00001, &
+ XRIMINTP1 * LOG( ZVECLBDAS(1:IGRIM) ) + XRIMINTP2 ) )
+ IVEC2(1:IGRIM) = INT( ZVEC2(1:IGRIM) )
+ ZVEC2(1:IGRIM) = ZVEC2(1:IGRIM) - REAL( IVEC2(1:IGRIM) )
+!
+! 5.1.3 perform the linear interpolation of the normalized
+! "2+XDS"-moment of the incomplete gamma function
+!
+ ZVEC1(1:IGRIM) = XGAMINC_RIM1( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) &
+ - XGAMINC_RIM1( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0)
+!
+! 5.1.4 riming of the small sized aggregates
+!
+ DO JJ = 1, IGRIM
+ JL = I1(JJ)
+ ZZW1(JJ) = MIN( PRCS(JL), &
+ XCRIMSS * ZVEC1(JJ) * PRCT(JL) & ! RCRIMSS
+ * ZVECLBDAS(JJ)**XEXCRIMSS &
+ * PRHODREF(JL)**(-XCEXVT) )
+ PRCS(JL) = PRCS(JL) - ZZW1(JJ)
+ PRSS(JL) = PRSS(JL) + ZZW1(JJ)
+ PTHS(JL) = PTHS(JL) + ZZW1(JJ)*(PLSFACT(JL)-PLVFACT(JL)) ! f(L_f*(RCRIMSS))
+ END DO
+!
+! 5.1.5 perform the linear interpolation of the normalized
+! "XBS"-moment of the incomplete gamma function
+!
+ ZVEC1(1:IGRIM) = XGAMINC_RIM2( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) &
+ - XGAMINC_RIM2( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0)
+!
+! 5.1.6 riming-conversion of the large sized aggregates into graupeln
+!
+!
+ DO JJ = 1, IGRIM
+ JL = I1(JJ)
+ IF ( PRSS(JL) > 0.0 ) THEN
+ ZZW2(JJ) = MIN( PRCS(JL), &
+ XCRIMSG * PRCT(JL) & ! RCRIMSG
+ * ZVECLBDAS(JJ)**XEXCRIMSG &
+ * PRHODREF(JL)**(-XCEXVT) &
+ - ZZW1(JJ) )
+ ZZW3(JJ) = MIN( PRSS(JL), &
+ XSRIMCG * ZVECLBDAS(JJ)**XEXSRIMCG & ! RSRIMCG
+ * (1.0 - ZVEC1(JJ) )/(PTSTEP*PRHODREF(JL)) )
+ PRCS(JL) = PRCS(JL) - ZZW2(JJ)
+ PRSS(JL) = PRSS(JL) - ZZW3(JJ)
+ PRGS(JL) = PRGS(JL) + ZZW2(JJ)+ZZW3(JJ)
+ PTHS(JL) = PTHS(JL) + ZZW2(JJ)*(PLSFACT(JL)-PLVFACT(JL)) ! f(L_f*(RCRIMSG))
+ END IF
+ END DO
+
+ !Remark: not possible to use Budget_store_add here
+ ! because variables modified a second time but with a if on prss + jl/=jj
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'RIM', Unpack ( pths(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'RIM', Unpack ( prcs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'RIM', Unpack ( prss(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'RIM', Unpack ( prgs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+
+ DEALLOCATE(ZZW3)
+ DEALLOCATE(ZZW2)
+ DEALLOCATE(ZZW1)
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(ZVEC1)
+ DEALLOCATE(ZVECLBDAS)
+ END IF
+!
+!* 5.2 rain accretion onto the aggregates
+!
+ IGACC = 0
+ DO JJ = 1, SIZE(PRRT)
+ IF ( PRRT(JJ)>XRTMIN(3) .AND. PRST(JJ)>XRTMIN(5) .AND. PRRS(JJ)>0.0 .AND. PZT(JJ)<XTT ) THEN
+ IGACC = IGACC + 1
+ I1(IGACC) = JJ
+ END IF
+ END DO
+ !
+ IF( IGACC>0 ) THEN
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'ACC', Unpack ( pths(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'ACC', Unpack ( prrs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'ACC', Unpack ( prss(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'ACC', Unpack ( prgs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+!
+! 5.2.0 allocations
+!
+ ALLOCATE(ZVECLBDAR(IGACC))
+ ALLOCATE(ZVECLBDAS(IGACC))
+ ALLOCATE(ZVEC1(IGACC))
+ ALLOCATE(ZVEC2(IGACC))
+ ALLOCATE(ZVEC3(IGACC))
+ ALLOCATE(IVEC1(IGACC))
+ ALLOCATE(IVEC2(IGACC))
+ ALLOCATE(ZZW2(IGACC))
+ ALLOCATE(ZZW3(IGACC))
+ ALLOCATE(ZZW4(IGACC))
+!
+! 5.2.1 select the (PLBDAS,PLBDAR) couplet
+!
+ ZVECLBDAS(1:IGACC) = PLBDAS(I1(1:IGACC))
+ ZVECLBDAR(1:IGACC) = PLBDAR(I1(1:IGACC))
+!
+! 5.2.2 find the next lower indice for the PLBDAS and for the PLBDAR
+! in the geometrical set of (Lbda_s,Lbda_r) couplet use to
+! tabulate the RACCSS-kernel
+!
+ ZVEC1(1:IGACC) = MAX( 1.00001, MIN( REAL(NACCLBDAS)-0.00001, &
+ XACCINTP1S * LOG( ZVECLBDAS(1:IGACC) ) + XACCINTP2S ) )
+ IVEC1(1:IGACC) = INT( ZVEC1(1:IGACC) )
+ ZVEC1(1:IGACC) = ZVEC1(1:IGACC) - REAL( IVEC1(1:IGACC) )
+!
+ ZVEC2(1:IGACC) = MAX( 1.00001, MIN( REAL(NACCLBDAR)-0.00001, &
+ XACCINTP1R * LOG( ZVECLBDAR(1:IGACC) ) + XACCINTP2R ) )
+ IVEC2(1:IGACC) = INT( ZVEC2(1:IGACC) )
+ ZVEC2(1:IGACC) = ZVEC2(1:IGACC) - REAL( IVEC2(1:IGACC) )
+!
+! 5.2.3 perform the bilinear interpolation of the normalized
+! RACCSS-kernel
+!
+ DO JJ = 1,IGACC
+ ZVEC3(JJ) = ( XKER_RACCSS(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_RACCSS(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * ZVEC1(JJ) &
+ - ( XKER_RACCSS(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_RACCSS(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * (ZVEC1(JJ) - 1.0)
+ END DO
+!
+! 5.2.4 raindrop accretion on the small sized aggregates
+!
+ DO JJ = 1, IGACC
+ JL = I1(JJ)
+ ZZW2(JJ) = & !! coef of RRACCS
+ XFRACCSS*( ZVECLBDAS(JJ)**XCXS )*( PRHODREF(JL)**(-XCEXVT-1.) ) &
+ *( XLBRACCS1/((ZVECLBDAS(JJ)**2) ) + &
+ XLBRACCS2/( ZVECLBDAS(JJ) * ZVECLBDAR(JJ) ) + &
+ XLBRACCS3/( (ZVECLBDAR(JJ)**2)) )/ZVECLBDAR(JJ)**4
+ ZZW4(JJ) = MIN( PRRS(JL),ZZW2(JJ)*ZVEC3(JJ) ) ! RRACCSS
+ PRRS(JL) = PRRS(JL) - ZZW4(JJ)
+ PRSS(JL) = PRSS(JL) + ZZW4(JJ)
+ PTHS(JL) = PTHS(JL) + ZZW4(JJ)*(PLSFACT(JL)-PLVFACT(JL)) ! f(L_f*(RRACCSS))
+ END DO
+!
+! 5.2.4b perform the bilinear interpolation of the normalized
+! RACCS-kernel
+!
+ DO JJ = 1,IGACC
+ ZVEC3(JJ) = ( XKER_RACCS(IVEC2(JJ)+1,IVEC1(JJ)+1)* ZVEC1(JJ) &
+ - XKER_RACCS(IVEC2(JJ)+1,IVEC1(JJ) )*(ZVEC1(JJ) - 1.0) ) &
+ * ZVEC2(JJ) &
+ - ( XKER_RACCS(IVEC2(JJ) ,IVEC1(JJ)+1)* ZVEC1(JJ) &
+ - XKER_RACCS(IVEC2(JJ) ,IVEC1(JJ) )*(ZVEC1(JJ) - 1.0) ) &
+ * (ZVEC2(JJ) - 1.0)
+ END DO
+ DO JJ = 1, IGACC
+ ZZW2(JJ) = ZZW2(JJ) * ZVEC3(JJ)
+ END DO
+ !! RRACCS!
+! 5.2.5 perform the bilinear interpolation of the normalized
+! SACCRG-kernel
+!
+ DO JJ = 1,IGACC
+ ZVEC3(JJ) = ( XKER_SACCRG(IVEC2(JJ)+1,IVEC1(JJ)+1)* ZVEC1(JJ) &
+ - XKER_SACCRG(IVEC2(JJ)+1,IVEC1(JJ) )*(ZVEC1(JJ) - 1.0) ) &
+ * ZVEC2(JJ) &
+ - ( XKER_SACCRG(IVEC2(JJ) ,IVEC1(JJ)+1)* ZVEC1(JJ) &
+ - XKER_SACCRG(IVEC2(JJ) ,IVEC1(JJ) )*(ZVEC1(JJ) - 1.0) ) &
+ * (ZVEC2(JJ) - 1.0)
+ END DO
+!
+! 5.2.6 raindrop accretion-conversion of the large sized aggregates
+! into graupeln
+!
+ DO JJ = 1, IGACC
+ JL = I1(JJ)
+ IF ( PRSS(JL) > 0.0 ) THEN
+ ZZW2(JJ) = MAX( MIN( PRRS(JL),ZZW2(JJ)-ZZW4(JJ) ),0.0 ) ! RRACCSG
+ IF ( ZZW2(JJ) > 0.0 ) THEN
+ ZZW3(JJ) = MIN( PRSS(JL),XFSACCRG*ZVEC3(JJ)* & ! RSACCRG
+ ( ZVECLBDAS(JJ)**(XCXS-XBS) )*( PRHODREF(JL)**(-XCEXVT-1.) ) &
+ *( XLBSACCR1/((ZVECLBDAR(JJ)**2) ) + &
+ XLBSACCR2/( ZVECLBDAR(JJ) * ZVECLBDAS(JJ) ) + &
+ XLBSACCR3/( (ZVECLBDAS(JJ)**2)) )/ZVECLBDAR(JJ) )
+ PRRS(JL) = PRRS(JL) - ZZW2(JJ)
+ PRSS(JL) = PRSS(JL) - ZZW3(JJ)
+ PRGS(JL) = PRGS(JL) + ZZW2(JJ)+ZZW3(JJ)
+ PTHS(JL) = PTHS(JL) + ZZW2(JJ)*(PLSFACT(JL)-PLVFACT(JL)) !
+ ! f(L_f*(RRACCSG))
+ END IF
+ END IF
+ END DO
+
+ !Remark: not possible to use Budget_store_add here
+ ! because variables modified a second time but with a if on prss + jl/=jj
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'ACC', Unpack ( pths(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'ACC', Unpack ( prrs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'ACC', Unpack ( prss(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'ACC', Unpack ( prgs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+
+ DEALLOCATE(ZZW4)
+ DEALLOCATE(ZZW3)
+ DEALLOCATE(ZZW2)
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(IVEC1)
+ DEALLOCATE(ZVEC3)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(ZVEC1)
+ DEALLOCATE(ZVECLBDAS)
+ DEALLOCATE(ZVECLBDAR)
+ END IF
+!
+!* 5.3 Conversion-Melting of the aggregates
+!
+ zzw(:) = 0.
+ WHERE( PRST(:)>XRTMIN(5) .AND. PRSS(:)>0.0 .AND. PZT(:)>XTT )
+ ZZW(:) = PRVT(:)*PPRES(:)/((XMV/XMD)+PRVT(:)) ! Vapor pressure
+ ZZW(:) = PKA(:)*(XTT-PZT(:)) + &
+ ( PDV(:)*(XLVTT + ( XCPV - XCL ) * ( PZT(:) - XTT )) &
+ *(XESTT-ZZW(:))/(XRV*PZT(:)) )
+!
+! compute RSMLT
+!
+ ZZW(:) = MIN( PRSS(:), XFSCVMG*MAX( 0.0,( -ZZW(:) * &
+ ( X0DEPS* PLBDAS(:)**XEX0DEPS + &
+ X1DEPS*PCJ(:)*PLBDAS(:)**XEX1DEPS ) ) / &
+ ( PRHODREF(:)*XLMTT ) ) )
+!
+! note that RSCVMG = RSMLT*XFSCVMG but no heat is exchanged (at the rate RSMLT)
+! because the graupeln produced by this process are still icy!!!
+!
+ PRSS(:) = PRSS(:) - ZZW(:)
+ PRGS(:) = PRGS(:) + ZZW(:)
+ END WHERE
+
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'CMEL', &
+ Unpack ( -zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'CMEL', &
+ Unpack ( zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0. ) )
+
+END SUBROUTINE RAIN_ICE_FAST_RS
+
+END MODULE MODE_RAIN_ICE_FAST_RS
diff --git a/src/mesonh/micro/rain_ice_nucleation.f90 b/src/mesonh/micro/rain_ice_nucleation.f90
new file mode 100644
index 000000000..97bfaf1f8
--- /dev/null
+++ b/src/mesonh/micro/rain_ice_nucleation.f90
@@ -0,0 +1,180 @@
+!MNH_LIC Copyright 1995-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! Modifications:
+! P. Wautelet 25/02/2019: split rain_ice (cleaner and easier to maintain/debug)
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+! P. Wautelet 29/05/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
+!-----------------------------------------------------------------
+MODULE MODE_RAIN_ICE_NUCLEATION
+
+ IMPLICIT NONE
+
+ PRIVATE
+
+ PUBLIC RAIN_ICE_NUCLEATION
+
+CONTAINS
+
+SUBROUTINE RAIN_ICE_NUCLEATION(KIB, KIE, KJB, KJE, KKTB, KKTE,KRR,PTSTEP,&
+ PTHT,PPABST,PRHODJ,PRHODREF,PRVT,PRCT,PRRT,PRIT,PRST,PRGT,&
+ PCIT,PEXNREF,PTHS,PRVS,PRIS,PT,PRHT)
+!
+!* 0. DECLARATIONS
+! ------------
+!
+use modd_budget, only: lbudget_th, lbudget_rv, lbudget_ri, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RI, &
+ tbudgets
+use MODD_CST, only: XALPI, XALPW, XBETAI, XBETAW, XCI, XCL, XCPD, XCPV, XGAMI, XGAMW, &
+ XLSTT, XMD, XMV, XP00, XRD, XTT
+use MODD_RAIN_ICE_PARAM, only: XALPHA1, XALPHA2, XBETA1, XBETA2, XMNU0, XNU10, XNU20
+
+use mode_budget, only: Budget_store_init, Budget_store_end
+use mode_tools, only: Countjv
+
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KIB, KIE, KJB, KJE, KKTB, KKTE
+INTEGER, INTENT(IN) :: KRR ! Number of moist variable
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
+ ! (single if cold start)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! absolute pressure at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PT ! Temperature
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
+!
+!* 0.2 declaration of local variables
+!
+INTEGER :: INEGT
+INTEGER :: JL ! and PACK intrinsics
+INTEGER, DIMENSION(SIZE(PEXNREF)) :: I1,I2,I3 ! Used to replace the COUNT
+LOGICAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
+ :: GNEGT ! Test where to compute the HEN process
+REAL, DIMENSION(:), ALLOCATABLE :: ZRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZCIT ! Pristine ice conc. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZZT, & ! Temperature
+ ZPRES, & ! Pressure
+ ZZW, & ! Work array
+ ZUSW, & ! Undersaturation over water
+ ZSSI ! Supersaturation over ice
+REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
+ :: ZW ! work array
+!
+!-------------------------------------------------------------------------------
+
+if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HENU', pths(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'HENU', prvs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'HENU', pris(:, :, :) * prhodj(:, :, :) )
+!
+! compute the temperature and the pressure
+!
+PT(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:) / XP00 ) ** (XRD/XCPD)
+!
+! optimization by looking for locations where
+! the temperature is negative only !!!
+!
+GNEGT(:,:,:) = .FALSE.
+GNEGT(KIB:KIE,KJB:KJE,KKTB:KKTE) = PT(KIB:KIE,KJB:KJE,KKTB:KKTE)<XTT
+INEGT = COUNTJV( GNEGT(:,:,:),I1(:),I2(:),I3(:))
+IF( INEGT >= 1 ) THEN
+ ALLOCATE(ZRVT(INEGT)) ;
+ ALLOCATE(ZCIT(INEGT)) ;
+ ALLOCATE(ZZT(INEGT)) ;
+ ALLOCATE(ZPRES(INEGT));
+ DO JL=1,INEGT
+ ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL))
+ ZCIT(JL) = PCIT(I1(JL),I2(JL),I3(JL))
+ ZZT(JL) = PT(I1(JL),I2(JL),I3(JL))
+ ZPRES(JL) = PPABST(I1(JL),I2(JL),I3(JL))
+ ENDDO
+ ALLOCATE(ZZW(INEGT))
+ ALLOCATE(ZUSW(INEGT))
+ ALLOCATE(ZSSI(INEGT))
+ ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) ) ! es_i
+ ZZW(:) = MIN(ZPRES(:)/2., ZZW(:)) ! safety limitation
+ ZSSI(:) = ZRVT(:)*( ZPRES(:)-ZZW(:) ) / ( (XMV/XMD) * ZZW(:) ) - 1.0
+ ! Supersaturation over ice
+ ZUSW(:) = EXP( XALPW - XBETAW/ZZT(:) - XGAMW*ALOG(ZZT(:) ) ) ! es_w
+ ZUSW(:) = MIN(ZPRES(:)/2.,ZUSW(:)) ! safety limitation
+ ZUSW(:) = ( ZUSW(:)/ZZW(:) )*( (ZPRES(:)-ZZW(:))/(ZPRES(:)-ZUSW(:)) ) - 1.0
+ ! Supersaturation of saturated water vapor over ice
+!
+!* 3.1 compute the heterogeneous nucleation source: RVHENI
+!
+!* 3.1.1 compute the cloud ice concentration
+!
+ ZZW(:) = 0.0
+ ZSSI(:) = MIN( ZSSI(:), ZUSW(:) ) ! limitation of SSi according to SSw=0
+ WHERE( (ZZT(:)<XTT-5.0) .AND. (ZSSI(:)>0.0) )
+ ZZW(:) = XNU20 * EXP( XALPHA2*ZSSI(:)-XBETA2 )
+ END WHERE
+ WHERE( (ZZT(:)<=XTT-2.0) .AND. (ZZT(:)>=XTT-5.0) .AND. (ZSSI(:)>0.0) )
+ ZZW(:) = MAX( XNU20 * EXP( -XBETA2 ),XNU10 * EXP( -XBETA1*(ZZT(:)-XTT) ) * &
+ ( ZSSI(:)/ZUSW(:) )**XALPHA1 )
+ END WHERE
+ ZZW(:) = ZZW(:) - ZCIT(:)
+ IF( MAXVAL(ZZW(:)) > 0.0 ) THEN
+!
+!* 3.1.2 update the r_i and r_v mixing ratios
+!
+ ZZW(:) = MIN( ZZW(:),50.E3 ) ! limitation provisoire a 50 l^-1
+ ZW(:,:,:) = 0.0
+ DO JL=1, INEGT
+ ZW(I1(JL), I2(JL), I3(JL)) = ZZW( JL )
+ END DO
+ ZW(:,:,:) = MAX( ZW(:,:,:) ,0.0 ) *XMNU0/(PRHODREF(:,:,:)*PTSTEP)
+ PRIS(:,:,:) = PRIS(:,:,:) + ZW(:,:,:)
+ PRVS(:,:,:) = PRVS(:,:,:) - ZW(:,:,:)
+ IF ( KRR == 7 ) THEN
+ PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(XLSTT+(XCPV-XCI)*(PT(:,:,:)-XTT)) &
+ /( (XCPD + XCPV*PRVT(:,:,:) + XCL*(PRCT(:,:,:)+PRRT(:,:,:)) &
+ + XCI*(PRIT(:,:,:)+PRST(:,:,:)+PRGT(:,:,:)+PRHT(:,:,:)))*PEXNREF(:,:,:) )
+ ELSE IF( KRR == 6 ) THEN
+ PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(XLSTT+(XCPV-XCI)*(PT(:,:,:)-XTT)) &
+ /( (XCPD + XCPV*PRVT(:,:,:) + XCL*(PRCT(:,:,:)+PRRT(:,:,:)) &
+ + XCI*(PRIT(:,:,:)+PRST(:,:,:)+PRGT(:,:,:)))*PEXNREF(:,:,:) )
+ END IF
+ ! f(L_s*(RVHENI))
+ ZZW(:) = MAX( ZZW(:)+ZCIT(:),ZCIT(:) )
+ PCIT(:,:,:) = MAX( PCIT(:,:,:), 0.0 )
+ DO JL=1, INEGT
+ PCIT(I1(JL), I2(JL), I3(JL)) = MAX( ZZW( JL ), PCIT(I1(JL), I2(JL), I3(JL)), 0.0 )
+ END DO
+ END IF
+ DEALLOCATE(ZSSI)
+ DEALLOCATE(ZUSW)
+ DEALLOCATE(ZZW)
+ DEALLOCATE(ZPRES)
+ DEALLOCATE(ZZT)
+ DEALLOCATE(ZCIT)
+ DEALLOCATE(ZRVT)
+END IF
+!
+!* 3.1.3 budget storage
+!
+if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HENU', pths(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'HENU', prvs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'HENU', pris(:, :, :) * prhodj(:, :, :) )
+
+END SUBROUTINE RAIN_ICE_NUCLEATION
+
+END MODULE MODE_RAIN_ICE_NUCLEATION
diff --git a/src/mesonh/micro/rain_ice_red.f90 b/src/mesonh/micro/rain_ice_red.f90
new file mode 100644
index 000000000..241632665
--- /dev/null
+++ b/src/mesonh/micro/rain_ice_red.f90
@@ -0,0 +1,1882 @@
+!MNH_LIC Copyright 1995-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ######spl
+ MODULE MODI_RAIN_ICE_RED
+! ########################
+!
+INTERFACE
+ SUBROUTINE RAIN_ICE_RED ( KIT, KJT, KKT, KSIZE, &
+ OSEDIC, HSEDIM, HSUBG_AUCV_RC, HSUBG_AUCV_RI, &
+ OWARM, KKA, KKU, KKL, &
+ PTSTEP, KRR, ODMICRO, PEXN, &
+ PDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
+ PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF,&
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, &
+ PRGT, PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
+ PINPRC,PINPRR, PINPRR3D, PEVAP3D, &
+ PINPRS, PINPRG, PINDEP, PRAINFR, PSIGS, PSEA, PTOWN, &
+ PRHT, PRHS, PINPRH, PFPR )
+!
+!
+INTEGER, INTENT(IN) :: KIT, KJT, KKT ! arrays size
+INTEGER, INTENT(IN) :: KSIZE
+LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
+CHARACTER(LEN=4), INTENT(IN) :: HSEDIM ! Sedimentation scheme
+CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV_RC ! Switch for rc->rr Subgrid autoconversion
+ ! Kind of Subgrid autoconversion method
+CHARACTER(LEN=80), INTENT(IN) :: HSUBG_AUCV_RI ! Switch for ri->rs Subgrid autoconversion
+ ! Kind of Subgrid autoconversion method
+LOGICAL, INTENT(IN) :: OWARM ! .TRUE. allows raindrops to
+ ! form by warm processes
+ ! (Kessler scheme)
+!
+INTEGER, INTENT(IN) :: KKA !near ground array index
+INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
+ ! (single if cold start)
+INTEGER, INTENT(IN) :: KRR ! Number of moist variable
+LOGICAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: ODMICRO ! mask to limit computation
+!
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PEXN ! Exner function
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t
+!
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PCLDFR ! Cloud fraction
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PHLC_HRC
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PHLC_HCF
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PHLI_HRI
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PHLI_HCF
+!
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
+!
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source
+
+!
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRC! Cloud instant precip
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRR! Rain instant precip
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PINPRR3D! Rain inst precip 3D
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PEVAP3D! Rain evap profile
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRS! Snow instant precip
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRG! Graupel instant precip
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINDEP ! Cloud instant deposition
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PRAINFR
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at t
+REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
+REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PTOWN! Fraction that is town
+REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
+REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(OUT) :: PINPRH! Hail instant precip
+REAL, DIMENSION(KIT,KJT,KKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
+!
+END SUBROUTINE RAIN_ICE_RED
+END INTERFACE
+END MODULE MODI_RAIN_ICE_RED
+! ######spl
+ SUBROUTINE RAIN_ICE_RED ( KIT, KJT, KKT, KSIZE, &
+ OSEDIC, HSEDIM, HSUBG_AUCV_RC, HSUBG_AUCV_RI, &
+ OWARM,KKA,KKU,KKL,&
+ PTSTEP, KRR, ODMICRO, PEXN, &
+ PDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
+ PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, &
+ PRGT, PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
+ PINPRC,PINPRR, PINPRR3D, PEVAP3D, &
+ PINPRS, PINPRG, PINDEP, PRAINFR, PSIGS, PSEA, PTOWN, &
+ PRHT, PRHS, PINPRH, PFPR )
+! ######################################################################
+!
+!!**** * - compute the explicit microphysical sources
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the slow microphysical sources
+!! which can be computed explicitly
+!!
+!!
+!!** METHOD
+!! ------
+!! The autoconversion computation follows Kessler (1969).
+!! The sedimentation rate is computed with a time spliting technique and
+!! an upstream scheme, written as a difference of non-advective fluxes. This
+!! source term is added to the future instant ( split-implicit process ).
+!! The others microphysical processes are evaluated at the central instant
+!! (split-explicit process ): autoconversion, accretion and rain evaporation.
+!! These last 3 terms are bounded in order not to create negative values
+!! for the water species at the future instant.
+!!
+!! EXTERNAL
+!! --------
+!! None
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS
+!! JPHEXT : Horizontal external points number
+!! JPVEXT : Vertical external points number
+!! Module MODD_CONF :
+!! CCONF configuration of the model for the first time step
+!! Module MODD_CST
+!! XP00 ! Reference pressure
+!! XRD,XRV ! Gaz constant for dry air, vapor
+!! XMD,XMV ! Molecular weight for dry air, vapor
+!! XCPD ! Cpd (dry air)
+!! XCL ! Cl (liquid)
+!! XCI ! Ci (solid)
+!! XTT ! Triple point temperature
+!! XLVTT ! Vaporization heat constant
+!! XALPW,XBETAW,XGAMW ! Constants for saturation vapor pressure
+!! function over liquid water
+!! XALPI,XBETAI,XGAMI ! Constants for saturation vapor pressure
+!! function over solid ice
+!! Module MODD_BUDGET:
+!! NBUMOD : model in which budget is calculated
+!! CBUTYPE : type of desired budget
+!! 'CART' for cartesian box configuration
+!! 'MASK' for budget zone defined by a mask
+!! 'NONE' ' for no budget
+!! LBU_RTH : logical for budget of RTH (potential temperature)
+!! .TRUE. = budget of RTH
+!! .FALSE. = no budget of RTH
+!! LBU_RRV : logical for budget of RRV (water vapor)
+!! .TRUE. = budget of RRV
+!! .FALSE. = no budget of RRV
+!! LBU_RRC : logical for budget of RRC (cloud water)
+!! .TRUE. = budget of RRC
+!! .FALSE. = no budget of RRC
+!! LBU_RRI : logical for budget of RRI (cloud ice)
+!! .TRUE. = budget of RRI
+!! .FALSE. = no budget of RRI
+!! LBU_RRR : logical for budget of RRR (rain water)
+!! .TRUE. = budget of RRR
+!! .FALSE. = no budget of RRR
+!! LBU_RRS : logical for budget of RRS (aggregates)
+!! .TRUE. = budget of RRS
+!! .FALSE. = no budget of RRS
+!! LBU_RRG : logical for budget of RRG (graupeln)
+!! .TRUE. = budget of RRG
+!! .FALSE. = no budget of RRG
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Book1 and Book2 of documentation ( routine RAIN_ICE )
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 02/11/95
+!! (J.Viviand) 04/02/97 debug accumulated prcipitation & convert
+!! precipitation rate in m/s
+!! (J.-P. Pinty) 17/02/97 add budget calls
+!! (J.-P. Pinty) 17/11/97 set ice sedim. for cirrus ice, reset RCHONI
+!! and RRHONG, reverse order for DEALLOCATE
+!! (J.-P. Pinty) 11/02/98 correction of the air dynamical viscosity and
+!! add advance of the budget calls
+!! (J.-P. Pinty) 18/05/98 correction of the air density in the RIAUTS
+!! process
+!! (J.-P. Pinty) 18/11/98 split the main routine
+!! (V. Masson) 18/11/98 bug in IVEC1 and IVEC2 upper limits
+!! (J. Escobar & J.-P. Pinty)
+!! 11/12/98 contains and rewrite count+pack
+!! (J. Stein & J.-P. Pinty)
+!! 14/10/99 correction for very small RIT
+!! (J. Escobar & J.-P. Pinty)
+!! 24/07/00 correction for very samll m.r. in
+!! the sedimentation subroutine
+!! (M. Tomasini) 11/05/01 Autoconversion of rc into rr modification to take
+!! into account the subgrid variance
+!! (cf Redelsperger & Sommeria JAS 86)
+!! (G. Molinie) 21/05/99 bug in RRCFRIG process, RHODREF**(-1) missing
+!! in RSRIMCG
+!! (G. Molinie & J.-P. Pinty)
+!! 21/06/99 bug in RACCS process
+!! (P. Jabouille) 27/05/04 safety test for case where esw/i(T)> pabs (~Z>40km)
+!! (J-.P. Chaboureau) 12/02/05 temperature depending ice-to-snow autocon-
+! version threshold (Chaboureau and Pinty GRL 2006)
+!! (J.-P. Pinty) 01/01/O1 add the hail category and correction of the
+!! wet growth rate of the graupeln
+!! (S.Remy & C.Lac) 06/06 Add the cloud sedimentation
+!! (S.Remy & C.Lac) 06/06 Sedimentation becoming the last process
+!! to settle the precipitating species created during the current time step
+!! (S.Remy & C.Lac) 06/06 Modification of the algorithm of sedimentation
+!! to settle n times the precipitating species created during Dt/n instead
+!! of Dt
+!! (C.Lac) 11/06 Optimization of the sedimentation loop for NEC
+!! (J.Escobar) 18/01/2008 Parallel Bug in Budget when IMICRO >= 1
+!! --> Path inhibit this test by IMICRO >= 0 allway true
+!! (Y.Seity) 03/2008 Add Statistic sedimentation
+!! (Y.Seity) 10/2009 Added condition for the raindrop accretion of the aggregates
+!! into graupeln process (5.2.6) to avoid negative graupel mixing ratio
+!! (V.Masson, C.Lac) 09/2010 Correction in split sedimentation for
+!! reproducibility
+!! (S. Riette) Oct 2010 Better vectorisation of RAIN_ICE_SEDIMENTATION_STAT
+!! (Y. Seity), 02-2012 add possibility to run with reversed vertical levels
+!! (L. Bengtsson), 02-2013 Passing in land/sea mask and town fraction in
+!! order to use different cloud droplet number conc. over
+!! land, sea and urban areas in the cloud sedimentation.
+!! (D. Degrauwe), 2013-11: Export upper-air precipitation fluxes PFPR.
+!! (S. Riette) Nov 2013 Protection against null sigma
+!! (C. Lac) FIT temporal scheme : instant M removed
+!! (JP Pinty), 01-2014 : ICE4 : partial reconversion of hail to graupel
+!! July, 2015 (O.Nuissier/F.Duffourg) Add microphysics diagnostic for
+!! aircraft, ballon and profiler
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! C.Lac : 10/2016 : add droplet deposition
+!! C.Lac : 01/2017 : correction on droplet deposition
+!! J.Escobar : 10/2017 : for real*4 , limit exp() in RAIN_ICE_SLOW with XMNH_HUGE_12_LOG
+!! (C. Abiven, Y. Léauté, V. Seigner, S. Riette) Phasing of Turner rain subgrid param
+!! (S. Riette) Source code split into several files
+!! 02/2019 C.Lac add rain fraction as an output field
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+! P. Wautelet 29/05/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
+! P. Wautelet 17/01/2020: move Quicksort to tools.f90
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
+! P. Wautelet 25/02/2020: bugfix: add missing budget: WETH_BU_RRG
+!-----------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+
+use modd_budget, only: lbu_enable, &
+ lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, &
+ tbudgets
+USE MODD_CST, ONLY: XCI,XCL,XCPD,XCPV,XLSTT,XLVTT,XTT
+USE MODD_PARAMETERS, ONLY: JPVEXT,XUNDEF
+USE MODD_PARAM_ICE, ONLY: CSUBG_PR_PDF,CSUBG_RC_RR_ACCR,CSUBG_RR_EVAP,LDEPOSC,LFEEDBACKT,LSEDIM_AFTER, &
+ NMAXITER,XMRSTEP,XTSTEP_TS,XVDEPOSC
+USE MODD_RAIN_ICE_DESCR, ONLY: XRTMIN
+USE MODD_VAR_ll, ONLY: IP
+
+use mode_budget, only: Budget_store_add, Budget_store_init, Budget_store_end
+USE MODE_ll
+USE MODE_MSG
+use mode_tools, only: Countjv
+
+USE MODI_ICE4_NUCLEATION_WRAPPER
+USE MODI_ICE4_RAINFR_VERT
+USE MODI_ICE4_SEDIMENTATION_STAT
+USE MODI_ICE4_SEDIMENTATION_SPLIT
+USE MODI_ICE4_TENDENCIES
+
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+!
+!
+INTEGER, INTENT(IN) :: KIT, KJT, KKT ! arrays size
+INTEGER, INTENT(IN) :: KSIZE
+LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
+CHARACTER(LEN=4), INTENT(IN) :: HSEDIM ! Sedimentation scheme
+CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV_RC ! Kind of Subgrid autoconversion method
+CHARACTER(LEN=80), INTENT(IN) :: HSUBG_AUCV_RI ! Kind of Subgrid autoconversion method
+LOGICAL, INTENT(IN) :: OWARM ! .TRUE. allows raindrops to
+ ! form by warm processes
+ ! (Kessler scheme)
+INTEGER, INTENT(IN) :: KKA !near ground array index
+INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
+REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
+INTEGER, INTENT(IN) :: KRR ! Number of moist variable
+LOGICAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: ODMICRO ! mask to limit computation
+!
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PEXN ! Exner function
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t
+!
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PCLDFR ! Convective Mass Flux Cloud fraction
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PHLC_HRC
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PHLC_HCF
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PHLI_HRI
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PHLI_HCF
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
+!
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source
+!
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRC! Cloud instant precip
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRR! Rain instant precip
+REAL, DIMENSION(KIT,KJT,KKT),INTENT(OUT) :: PINPRR3D! Rain inst precip 3D
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PEVAP3D! Rain evap profile
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRS! Snow instant precip
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRG! Graupel instant precip
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINDEP ! Cloud instant deposition
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PRAINFR
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at t
+REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
+REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PTOWN! Fraction that is town
+REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
+REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(OUT) :: PINPRH! Hail instant precip
+REAL, DIMENSION(KIT,KJT,KKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IIB ! Define the domain where is
+INTEGER :: IIE ! the microphysical sources have to be computed
+INTEGER :: IJB !
+INTEGER :: IJE !
+INTEGER :: IKB, IKTB !
+INTEGER :: IKE, IKTE !
+!
+INTEGER :: JI, JJ, JK
+!
+!For packing
+INTEGER :: IMICRO ! Case r_x>0 locations
+INTEGER, DIMENSION(KSIZE) :: I1,I2,I3 ! Used to replace the COUNT
+INTEGER :: JL ! and PACK intrinsics
+!
+!Arrays for nucleation call outisde of LDMICRO points
+REAL, DIMENSION(KIT, KJT, KKT) :: ZW ! work array
+REAL, DIMENSION(KIT, KJT, KKT) :: ZT ! Temperature
+REAL, DIMENSION(KIT, KJT, KKT) :: &
+ & ZZ_RVHENI_MR, & ! heterogeneous nucleation mixing ratio change
+ & ZZ_RVHENI ! heterogeneous nucleation
+real, dimension(:,:,:), allocatable :: zw1, zw2, zw3, zw4, zw5, zw6 !Work arrays
+real, dimension(:,:,:), allocatable :: zz_diff
+REAL, DIMENSION(KIT, KJT, KKT) :: ZZ_LVFACT, ZZ_LSFACT
+!
+!Diagnostics
+REAL, DIMENSION(KIT, KJT, KKT) :: &
+ & ZHLC_HCF3D,& ! HLCLOUDS cloud fraction in high water content part
+ & ZHLC_LCF3D,& ! HLCLOUDS cloud fraction in low water content part
+ & ZHLC_HRC3D,& ! HLCLOUDS cloud water content in high water content
+ & ZHLC_LRC3D,& ! HLCLOUDS cloud water content in low water content
+ & ZHLI_HCF3D,& ! HLCLOUDS cloud fraction in high ice content part
+ & ZHLI_LCF3D,& ! HLCLOUDS cloud fraction in low ice content part
+ & ZHLI_HRI3D,& ! HLCLOUDS cloud water content in high ice content
+ & ZHLI_LRI3D ! HLCLOUDS cloud water content in high ice content
+
+REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2)) :: ZINPRI ! Pristine ice instant precip
+!
+!Packed variables
+REAL, DIMENSION(KSIZE) :: ZRVT, & ! Water vapor m.r. at t
+ & ZRCT, & ! Cloud water m.r. at t
+ & ZRRT, & ! Rain water m.r. at t
+ & ZRIT, & ! Pristine ice m.r. at t
+ & ZRST, & ! Snow/aggregate m.r. at t
+ & ZRGT, & ! Graupel m.r. at t
+ & ZRHT, & ! Hail m.r. at t
+ & ZCIT, & ! Pristine ice conc. at t
+ & ZTHT, & ! Potential temperature
+ & ZRHODREF, & ! RHO Dry REFerence
+ & ZZT, & ! Temperature
+ & ZPRES, & ! Pressure
+ & ZEXN, & ! EXNer Pressure
+ & ZLSFACT, & ! L_s/(Pi*C_ph)
+ & ZLVFACT, & ! L_v/(Pi*C_ph)
+ & ZSIGMA_RC,& ! Standard deviation of rc at time t
+ & ZCF, & ! Cloud fraction
+ & ZHLC_HCF, & ! HLCLOUDS : fraction of High Cloud Fraction in grid
+ & ZHLC_LCF, & ! HLCLOUDS : fraction of Low Cloud Fraction in grid
+ ! note that ZCF = ZHLC_HCF + ZHLC_LCF
+ & ZHLC_HRC, & ! HLCLOUDS : LWC that is High LWC in grid
+ & ZHLC_LRC, & ! HLCLOUDS : LWC that is Low LWC in grid
+ ! note that ZRC = ZHLC_HRC + ZHLC_LRC
+ & ZHLI_HCF, &
+ & ZHLI_LCF, &
+ & ZHLI_HRI, &
+ & ZHLI_LRI, &
+ & ZFRAC
+!
+!Output packed tendencies (for budgets only)
+REAL, DIMENSION(KSIZE) :: ZRVHENI_MR, & ! heterogeneous nucleation mixing ratio change
+ & ZRCHONI, & ! Homogeneous nucleation
+ & ZRRHONG_MR, & ! Spontaneous freezing mixing ratio change
+ & ZRVDEPS, & ! Deposition on r_s,
+ & ZRIAGGS, & ! Aggregation on r_s
+ & ZRIAUTS, & ! Autoconversion of r_i for r_s production
+ & ZRVDEPG, & ! Deposition on r_g
+ & ZRCAUTR, & ! Autoconversion of r_c for r_r production
+ & ZRCACCR, & ! Accretion of r_c for r_r production
+ & ZRREVAV, & ! Evaporation of r_r
+ & ZRIMLTC_MR, & ! Cloud ice melting mixing ratio change
+ & ZRCBERI, & ! Bergeron-Findeisen effect
+ & ZRHMLTR, & ! Melting of the hailstones
+ & ZRSMLTG, & ! Conversion-Melting of the aggregates
+ & ZRCMLTSR, & ! Cloud droplet collection onto aggregates by positive temperature
+ & ZRRACCSS, ZRRACCSG, ZRSACCRG, & ! Rain accretion onto the aggregates
+ & ZRCRIMSS, ZRCRIMSG, ZRSRIMCG, ZRSRIMCG_MR, & ! Cloud droplet riming of the aggregates
+ & ZRICFRRG, ZRRCFRIG, ZRICFRR, & ! Rain contact freezing
+ & ZRCWETG, ZRIWETG, ZRRWETG, ZRSWETG, & ! Graupel wet growth
+ & ZRCDRYG, ZRIDRYG, ZRRDRYG, ZRSDRYG, & ! Graupel dry growth
+ & ZRWETGH, & ! Conversion of graupel into hail
+ & ZRWETGH_MR, & ! Conversion of graupel into hail, mr change
+ & ZRGMLTR, & ! Melting of the graupel
+ & ZRCWETH, ZRIWETH, ZRSWETH, ZRGWETH, ZRRWETH, & ! Dry growth of hailstone
+ & ZRCDRYH, ZRIDRYH, ZRSDRYH, ZRRDRYH, ZRGDRYH, & ! Wet growth of hailstone
+ & ZRDRYHG ! Conversion of hailstone into graupel
+!
+!Output packed total mixing ratio change (for budgets only)
+REAL, DIMENSION(KSIZE) :: ZTOT_RVHENI, & ! heterogeneous nucleation mixing ratio change
+ & ZTOT_RCHONI, & ! Homogeneous nucleation
+ & ZTOT_RRHONG, & ! Spontaneous freezing mixing ratio change
+ & ZTOT_RVDEPS, & ! Deposition on r_s,
+ & ZTOT_RIAGGS, & ! Aggregation on r_s
+ & ZTOT_RIAUTS, & ! Autoconversion of r_i for r_s production
+ & ZTOT_RVDEPG, & ! Deposition on r_g
+ & ZTOT_RCAUTR, & ! Autoconversion of r_c for r_r production
+ & ZTOT_RCACCR, & ! Accretion of r_c for r_r production
+ & ZTOT_RREVAV, & ! Evaporation of r_r
+ & ZTOT_RCRIMSS, ZTOT_RCRIMSG, ZTOT_RSRIMCG, & ! Cloud droplet riming of the aggregates
+ & ZTOT_RIMLTC, & ! Cloud ice melting mixing ratio change
+ & ZTOT_RCBERI, & ! Bergeron-Findeisen effect
+ & ZTOT_RHMLTR, & ! Melting of the hailstones
+ & ZTOT_RSMLTG, & ! Conversion-Melting of the aggregates
+ & ZTOT_RCMLTSR, & ! Cloud droplet collection onto aggregates by positive temperature
+ & ZTOT_RRACCSS, ZTOT_RRACCSG, ZTOT_RSACCRG, & ! Rain accretion onto the aggregates
+ & ZTOT_RICFRRG, ZTOT_RRCFRIG, ZTOT_RICFRR, & ! Rain contact freezing
+ & ZTOT_RCWETG, ZTOT_RIWETG, ZTOT_RRWETG, ZTOT_RSWETG, & ! Graupel wet growth
+ & ZTOT_RCDRYG, ZTOT_RIDRYG, ZTOT_RRDRYG, ZTOT_RSDRYG, & ! Graupel dry growth
+ & ZTOT_RWETGH, & ! Conversion of graupel into hail
+ & ZTOT_RGMLTR, & ! Melting of the graupel
+ & ZTOT_RCWETH, ZTOT_RIWETH, ZTOT_RSWETH, ZTOT_RGWETH, ZTOT_RRWETH, & ! Dry growth of hailstone
+ & ZTOT_RCDRYH, ZTOT_RIDRYH, ZTOT_RSDRYH, ZTOT_RRDRYH, ZTOT_RGDRYH, & ! Wet growth of hailstone
+ & ZTOT_RDRYHG ! Conversion of hailstone into graupel
+!
+!For time- or mixing-ratio- splitting
+REAL, DIMENSION(KSIZE) :: Z0RVT, & ! Water vapor m.r. at the beginig of the current loop
+ & Z0RCT, & ! Cloud water m.r. at the beginig of the current loop
+ & Z0RRT, & ! Rain water m.r. at the beginig of the current loop
+ & Z0RIT, & ! Pristine ice m.r. at the beginig of the current loop
+ & Z0RST, & ! Snow/aggregate m.r. at the beginig of the current loop
+ & Z0RGT, & ! Graupel m.r. at the beginig of the current loop
+ & Z0RHT, & ! Hail m.r. at the beginig of the current loop
+ & ZA_TH, ZA_RV, ZA_RC, ZA_RR, ZA_RI, ZA_RS, ZA_RG, ZA_RH, &
+ & ZB_TH, ZB_RV, ZB_RC, ZB_RR, ZB_RI, ZB_RS, ZB_RG, ZB_RH
+!
+!To take into acount external tendencies inside the splitting
+REAL, DIMENSION(KSIZE) :: ZEXT_RV, & ! External tendencie for rv
+ & ZEXT_RC, & ! External tendencie for rc
+ & ZEXT_RR, & ! External tendencie for rr
+ & ZEXT_RI, & ! External tendencie for ri
+ & ZEXT_RS, & ! External tendencie for rs
+ & ZEXT_RG, & ! External tendencie for rg
+ & ZEXT_RH, & ! External tendencie for rh
+ & ZEXT_TH, & ! External tendencie for th
+ & ZEXT_WW ! Working array
+LOGICAL :: GEXT_TEND
+!
+INTEGER, DIMENSION(KSIZE) :: IITER ! Number of iterations done (with real tendencies computation)
+INTEGER :: INB_ITER_MAX ! Maximum number of iterations (with real tendencies computation)
+REAL, DIMENSION(KSIZE) :: ZTIME, & ! Current integration time (starts with 0 and ends with PTSTEP)
+ & ZMAXTIME, & ! Time on which we can apply the current tendencies
+ & ZTIME_THRESHOLD, & ! Time to reach threshold
+ & ZTIME_LASTCALL ! Integration time when last tendecies call has been done
+REAL, DIMENSION(KSIZE) :: ZW1D
+REAL, DIMENSION(KSIZE) :: ZCOMPUTE ! 1. for points where we must compute tendencies, 0. elsewhere
+LOGICAL :: LSOFT ! Must we really compute tendencies or only adjust them to new T variables
+LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2)):: GDEP
+REAL :: ZTSTEP ! length of sub-timestep in case of time splitting
+REAL :: ZINV_TSTEP ! Inverse ov PTSTEP
+REAL, DIMENSION(KSIZE, 8) :: ZRS_TEND
+REAL, DIMENSION(KSIZE, 8) :: ZRG_TEND
+REAL, DIMENSION(KSIZE, 10) :: ZRH_TEND
+REAL, DIMENSION(KSIZE) :: ZSSI
+!
+!For total tendencies computation
+REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: &
+ &ZW_RVS, ZW_RCS, ZW_RRS, ZW_RIS, ZW_RSS, ZW_RGS, ZW_RHS, ZW_THS
+!
+!-------------------------------------------------------------------------------
+if ( lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HENU', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'HENU', prvs(:, :, :) * prhodj(:, :, :) )
+end if
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTE THE LOOP BOUNDS
+! -----------------------
+!
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+IKB=KKA+JPVEXT*KKL
+IKE=KKU-JPVEXT*KKL
+IKTB=1+JPVEXT
+IKTE=KKT-JPVEXT
+!
+ZINV_TSTEP=1./PTSTEP
+GEXT_TEND=.TRUE.
+!
+! LSFACT and LVFACT without exner
+IF(KRR==7) THEN
+ DO JK = 1, KKT
+ DO JJ = 1, KJT
+ DO JI = 1, KIT
+ ZT(JI,JJ,JK) = PTHT(JI,JJ,JK) * PEXN(JI,JJ,JK)
+ ZZ_LSFACT(JI,JJ,JK)=(XLSTT+(XCPV-XCI)*(ZT(JI,JJ,JK)-XTT)) &
+ /( XCPD + XCPV*PRVT(JI,JJ,JK) + XCL*(PRCT(JI,JJ,JK)+PRRT(JI,JJ,JK)) &
+ + XCI*(PRIT(JI,JJ,JK)+PRST(JI,JJ,JK)+PRGT(JI,JJ,JK)+PRHT(JI,JJ,JK)))
+ ZZ_LVFACT(JI,JJ,JK)=(XLVTT+(XCPV-XCL)*(ZT(JI,JJ,JK)-XTT)) &
+ /( XCPD + XCPV*PRVT(JI,JJ,JK) + XCL*(PRCT(JI,JJ,JK)+PRRT(JI,JJ,JK)) &
+ + XCI*(PRIT(JI,JJ,JK)+PRST(JI,JJ,JK)+PRGT(JI,JJ,JK)+PRHT(JI,JJ,JK)))
+ ENDDO
+ ENDDO
+ ENDDO
+ELSE
+ DO JK = 1, KKT
+ DO JJ = 1, KJT
+ DO JI = 1, KIT
+ ZT(JI,JJ,JK) = PTHT(JI,JJ,JK) * PEXN(JI,JJ,JK)
+ ZZ_LSFACT(JI,JJ,JK)=(XLSTT+(XCPV-XCI)*(ZT(JI,JJ,JK)-XTT)) &
+ /( XCPD + XCPV*PRVT(JI,JJ,JK) + XCL*(PRCT(JI,JJ,JK)+PRRT(JI,JJ,JK)) &
+ + XCI*(PRIT(JI,JJ,JK)+PRST(JI,JJ,JK)+PRGT(JI,JJ,JK)))
+ ZZ_LVFACT(JI,JJ,JK)=(XLVTT+(XCPV-XCL)*(ZT(JI,JJ,JK)-XTT)) &
+ /( XCPD + XCPV*PRVT(JI,JJ,JK) + XCL*(PRCT(JI,JJ,JK)+PRRT(JI,JJ,JK)) &
+ + XCI*(PRIT(JI,JJ,JK)+PRST(JI,JJ,JK)+PRGT(JI,JJ,JK)))
+ ENDDO
+ ENDDO
+ ENDDO
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. COMPUTE THE SEDIMENTATION (RS) SOURCE
+! -------------------------------------
+!
+IF(.NOT. LSEDIM_AFTER) THEN
+ !
+ !* 2.1 sedimentation
+ !
+ if ( lbudget_rc .and. osedic ) call Budget_store_init( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
+
+ !Init only if not osedic (to prevent crash with double init)
+ !Remark: the 2 source terms SEDI and DEPO could be mixed and stored in the same source term (SEDI)
+ ! if osedic=T and ldeposc=T (a warning is printed in ini_budget in that case)
+ if ( lbudget_rc .and. ldeposc .and. .not.osedic ) &
+ call Budget_store_init( tbudgets(NBUDGET_RC), 'DEPO', prcs(:, :, :) * prhodj(:, :, :) )
+
+ IF(HSEDIM=='STAT') THEN
+ !SR: It *seems* that we must have two separate calls for ifort
+ IF(KRR==7) THEN
+ CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
+ &PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, &
+ &PRHODREF, PPABST, PTHT, PRHODJ, &
+ &PRCS, PRCS*PTSTEP, PRRS, PRRS*PTSTEP, PRIS, PRIS*PTSTEP,&
+ &PRSS, PRSS*PTSTEP, PRGS, PRGS*PTSTEP,&
+ &PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, &
+ &PSEA=PSEA, PTOWN=PTOWN, &
+ &PINPRH=PINPRH, PRHT=PRHS*PTSTEP, PRHS=PRHS, PFPR=PFPR)
+ ELSE
+ CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
+ &PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, &
+ &PRHODREF, PPABST, PTHT, PRHODJ, &
+ &PRCS, PRCS*PTSTEP, PRRS, PRRS*PTSTEP, PRIS, PRIS*PTSTEP,&
+ &PRSS, PRSS*PTSTEP, PRGS, PRGS*PTSTEP,&
+ &PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, &
+ &PSEA=PSEA, PTOWN=PTOWN, &
+ &PFPR=PFPR)
+ ENDIF
+ PINPRS(:,:) = PINPRS(:,:) + ZINPRI(:,:)
+ !No negativity correction here as we apply sedimentation on PR.S*PTSTEP variables
+ ELSEIF(HSEDIM=='SPLI') THEN
+ !SR: It *seems* that we must have two separate calls for ifort
+ IF(KRR==7) THEN
+ CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
+ &PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, &
+ &PRHODREF, PPABST, PTHT, PRHODJ, &
+ &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
+ &PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, &
+ &PSEA=PSEA, PTOWN=PTOWN, &
+ &PINPRH=PINPRH, PRHT=PRHT, PRHS=PRHS, PFPR=PFPR)
+ ELSE
+ CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
+ &PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, &
+ &PRHODREF, PPABST, PTHT, PRHODJ, &
+ &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
+ &PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, &
+ &PSEA=PSEA, PTOWN=PTOWN, &
+ &PFPR=PFPR)
+ ENDIF
+ PINPRS(:,:) = PINPRS(:,:) + ZINPRI(:,:)
+ !We correct negativities with conservation
+ !SPLI algorith uses a time-splitting. Inside the loop a temporary m.r. is used.
+ ! It is initialized with the m.r. at T and is modified by two tendencies:
+ ! sedimentation tendency and an external tendency which represents all other
+ ! processes (mainly advection and microphysical processes). If both tendencies
+ ! are negative, sedimentation can remove a specie at a given sub-timestep. From
+ ! this point sedimentation stops for the remaining sub-timesteps but the other tendency
+ ! will be still active and will lead to negative values.
+ ! We could prevent the algorithm to not consume too much a specie, instead we apply
+ ! a correction here.
+ CALL CORRECT_NEGATIVITIES(KIT, KJT, KKT, KRR, PRVS, PRCS, PRRS, &
+ &PRIS, PRSS, PRGS, &
+ &PTHS, ZZ_LVFACT, ZZ_LSFACT, PRHS)
+ ELSEIF(HSEDIM=='NONE') THEN
+ ELSE
+ call Print_msg( NVERB_FATAL, 'GEN', 'RAIN_ICE_RED', 'no sedimentation scheme for HSEDIM='//HSEDIM )
+ END IF
+ !
+ !* 2.2 budget storage
+ !
+ if ( lbudget_rc .and. osedic ) call Budget_store_end( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
+
+ !If osedic=T and ldeposc=T, DEPO is in fact mixed and stored with the SEDI source term
+ !(a warning is printed in ini_budget in that case)
+ if ( lbudget_rc .and. ldeposc .and. .not.osedic) &
+ call Budget_store_end( tbudgets(NBUDGET_RC), 'DEPO', prcs(:, :, :) * prhodj(:, :, :) )
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. PACKING
+! --------
+! optimization by looking for locations where
+! the microphysical fields are larger than a minimal value only !!!
+!
+IMICRO=0
+IF(KSIZE/=0) IMICRO=COUNTJV(ODMICRO(:,:,:), I1(:), I2(:), I3(:))
+!Packing
+IF(IMICRO>0) THEN
+ DO JL=1, IMICRO
+ ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL))
+ ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
+ ZRRT(JL) = PRRT(I1(JL),I2(JL),I3(JL))
+ ZRIT(JL) = PRIT(I1(JL),I2(JL),I3(JL))
+ ZRST(JL) = PRST(I1(JL),I2(JL),I3(JL))
+ ZRGT(JL) = PRGT(I1(JL),I2(JL),I3(JL))
+ ZCIT(JL) = PCIT(I1(JL),I2(JL),I3(JL))
+ ZCF(JL) = PCLDFR(I1(JL),I2(JL),I3(JL))
+ ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
+ ZTHT(JL) = PTHT(I1(JL),I2(JL),I3(JL))
+ ZPRES(JL) = PPABST(I1(JL),I2(JL),I3(JL))
+ ZEXN(JL) = PEXN(I1(JL),I2(JL),I3(JL))
+ ZHLC_HCF(JL) = PHLC_HCF(I1(JL),I2(JL),I3(JL))
+ ZHLC_HRC(JL) = PHLC_HRC(I1(JL),I2(JL),I3(JL))
+ ZHLC_LRC(JL) = ZRCT(JL) - ZHLC_HRC(JL)
+ ZHLI_HCF(JL) = PHLI_HCF(I1(JL),I2(JL),I3(JL))
+ ZHLI_HRI(JL) = PHLI_HRI(I1(JL),I2(JL),I3(JL))
+ ZHLI_LRI(JL) = ZRIT(JL) - ZHLI_HRI(JL)
+ IF(ZRCT(JL)>0.) THEN
+ ZHLC_LCF(JL) = ZCF(JL)- ZHLC_HCF(JL)
+ ELSE
+ ZHLC_LCF(JL)=0.
+ ENDIF
+ IF(ZRIT(JL)>0.) THEN
+ ZHLI_LCF(JL) = ZCF(JL)- ZHLI_HCF(JL)
+ ELSE
+ ZHLI_LCF(JL)=0.
+ ENDIF
+ ENDDO
+ IF(GEXT_TEND) THEN
+ DO JL=1, IMICRO
+ ZEXT_RV(JL) = PRVS(I1(JL),I2(JL),I3(JL)) - ZRVT(JL)*ZINV_TSTEP
+ ZEXT_RC(JL) = PRCS(I1(JL),I2(JL),I3(JL)) - ZRCT(JL)*ZINV_TSTEP
+ ZEXT_RR(JL) = PRRS(I1(JL),I2(JL),I3(JL)) - ZRRT(JL)*ZINV_TSTEP
+ ZEXT_RI(JL) = PRIS(I1(JL),I2(JL),I3(JL)) - ZRIT(JL)*ZINV_TSTEP
+ ZEXT_RS(JL) = PRSS(I1(JL),I2(JL),I3(JL)) - ZRST(JL)*ZINV_TSTEP
+ ZEXT_RG(JL) = PRGS(I1(JL),I2(JL),I3(JL)) - ZRGT(JL)*ZINV_TSTEP
+ ZEXT_TH(JL) = PTHS(I1(JL),I2(JL),I3(JL)) - ZTHT(JL)*ZINV_TSTEP
+ !The th tendency is not related to a mixing ratio change, there is no exn/exnref issue here
+ ENDDO
+ ENDIF
+ IF(HSUBG_AUCV_RC=='PDF ' .AND. CSUBG_PR_PDF=='SIGM') THEN
+ DO JL=1, IMICRO
+ ZSIGMA_RC(JL) = PSIGS(I1(JL),I2(JL),I3(JL))*2.
+ ENDDO
+ ENDIF
+ IF(KRR==7) THEN
+ DO JL=1, IMICRO
+ ZRHT(JL) = PRHT(I1(JL),I2(JL),I3(JL))
+ ENDDO
+ IF(GEXT_TEND) THEN
+ DO JL=1, IMICRO
+ ZEXT_RH(JL) = PRHS(I1(JL),I2(JL),I3(JL)) - ZRHT(JL)*ZINV_TSTEP
+ ENDDO
+ ENDIF
+ ELSE
+ ZRHT(:)=0.
+ IF(GEXT_TEND) ZEXT_RH(:)=0.
+ ENDIF
+ IF(LBU_ENABLE) THEN
+ ZTOT_RVHENI(:)=0.
+ ZTOT_RCHONI(:)=0.
+ ZTOT_RRHONG(:)=0.
+ ZTOT_RVDEPS(:)=0.
+ ZTOT_RIAGGS(:)=0.
+ ZTOT_RIAUTS(:)=0.
+ ZTOT_RVDEPG(:)=0.
+ ZTOT_RCAUTR(:)=0.
+ ZTOT_RCACCR(:)=0.
+ ZTOT_RREVAV(:)=0.
+ ZTOT_RCRIMSS(:)=0.
+ ZTOT_RCRIMSG(:)=0.
+ ZTOT_RSRIMCG(:)=0.
+ ZTOT_RIMLTC(:)=0.
+ ZTOT_RCBERI(:)=0.
+ ZTOT_RHMLTR(:)=0.
+ ZTOT_RSMLTG(:)=0.
+ ZTOT_RCMLTSR(:)=0.
+ ZTOT_RRACCSS(:)=0.
+ ZTOT_RRACCSG(:)=0.
+ ZTOT_RSACCRG(:)=0.
+ ZTOT_RICFRRG(:)=0.
+ ZTOT_RRCFRIG(:)=0.
+ ZTOT_RICFRR(:)=0.
+ ZTOT_RCWETG(:)=0.
+ ZTOT_RIWETG(:)=0.
+ ZTOT_RRWETG(:)=0.
+ ZTOT_RSWETG(:)=0.
+ ZTOT_RCDRYG(:)=0.
+ ZTOT_RIDRYG(:)=0.
+ ZTOT_RRDRYG(:)=0.
+ ZTOT_RSDRYG(:)=0.
+ ZTOT_RWETGH(:)=0.
+ ZTOT_RGMLTR(:)=0.
+ ZTOT_RCWETH(:)=0.
+ ZTOT_RIWETH(:)=0.
+ ZTOT_RSWETH(:)=0.
+ ZTOT_RGWETH(:)=0.
+ ZTOT_RRWETH(:)=0.
+ ZTOT_RCDRYH(:)=0.
+ ZTOT_RIDRYH(:)=0.
+ ZTOT_RSDRYH(:)=0.
+ ZTOT_RRDRYH(:)=0.
+ ZTOT_RGDRYH(:)=0.
+ ZTOT_RDRYHG(:)=0.
+ ENDIF
+ENDIF
+!-------------------------------------------------------------------------------
+!
+!* 4. LOOP
+! ----
+!
+!Maximum number of iterations
+!We only count real iterations (those for which we *compute* tendencies)
+INB_ITER_MAX=NMAXITER
+IF(XTSTEP_TS/=0.)THEN
+ INB_ITER_MAX=MAX(1, INT(PTSTEP/XTSTEP_TS)) !At least the number of iterations needed for the time-splitting
+ ZTSTEP=PTSTEP/INB_ITER_MAX
+ INB_ITER_MAX=MAX(NMAXITER, INB_ITER_MAX) !For the case XMRSTEP/=0. at the same time
+ENDIF
+IITER(:)=0
+ZTIME(:)=0. ! Current integration time (all points may have a different integration time)
+DO WHILE(ANY(ZTIME(:)<PTSTEP)) ! Loop to *really* compute tendencies
+ IF(XMRSTEP/=0.) THEN
+ ! In this case we need to remember the mixing ratios used to compute the tendencies
+ ! because when mixing ratio has evolved more than a threshold, we must re-compute tendecies
+ DO JL=1, IMICRO
+ Z0RVT(JL)=ZRVT(JL)
+ Z0RCT(JL)=ZRCT(JL)
+ Z0RRT(JL)=ZRRT(JL)
+ Z0RIT(JL)=ZRIT(JL)
+ Z0RST(JL)=ZRST(JL)
+ Z0RGT(JL)=ZRGT(JL)
+ Z0RHT(JL)=ZRHT(JL)
+ ENDDO
+ ENDIF
+ IF(XTSTEP_TS/=0.) THEN
+ ! In this case we need to remember the time when tendencies were computed
+ ! because when time has evolved more than a limit, we must re-compute tendecies
+ ZTIME_LASTCALL(:)=ZTIME(:)
+ ENDIF
+ ZCOMPUTE(:)=MAX(0., -SIGN(1., ZTIME(:)-PTSTEP)) ! Compuation (1.) only for points for which integration time has not reached the timestep
+ LSOFT=.FALSE. ! We *really* compute the tendencies
+ IITER(:)=IITER(:)+INT(ZCOMPUTE(:))
+ DO WHILE(SUM(ZCOMPUTE(:))>0.) ! Loop to adjust tendencies when we cross the 0°C or when a specie disappears
+ IF(KRR==7) THEN
+ DO JL=1, IMICRO
+ ZZT(JL) = ZTHT(JL) * ZEXN(JL)
+ ZLSFACT(JL)=(XLSTT+(XCPV-XCI)*(ZZT(JL)-XTT)) &
+ &/( (XCPD + XCPV*ZRVT(JL) + XCL*(ZRCT(JL)+ZRRT(JL)) &
+ &+ XCI*(ZRIT(JL)+ZRST(JL)+ZRGT(JL)+ZRHT(JL)))*ZEXN(JL) )
+ ZLVFACT(JL)=(XLVTT+(XCPV-XCL)*(ZZT(JL)-XTT)) &
+ &/( (XCPD + XCPV*ZRVT(JL) + XCL*(ZRCT(JL)+ZRRT(JL)) &
+ &+ XCI*(ZRIT(JL)+ZRST(JL)+ZRGT(JL)+ZRHT(JL)))*ZEXN(JL) )
+ ENDDO
+ ELSE
+ DO JL=1, IMICRO
+ ZZT(JL) = ZTHT(JL) * ZEXN(JL)
+ ZLSFACT(JL)=(XLSTT+(XCPV-XCI)*(ZZT(JL)-XTT)) &
+ &/( (XCPD + XCPV*ZRVT(JL) + XCL*(ZRCT(JL)+ZRRT(JL)) &
+ &+ XCI*(ZRIT(JL)+ZRST(JL)+ZRGT(JL)))*ZEXN(JL) )
+ ZLVFACT(JL)=(XLVTT+(XCPV-XCL)*(ZZT(JL)-XTT)) &
+ &/( (XCPD + XCPV*ZRVT(JL) + XCL*(ZRCT(JL)+ZRRT(JL)) &
+ &+ XCI*(ZRIT(JL)+ZRST(JL)+ZRGT(JL)))*ZEXN(JL) )
+ ENDDO
+ ENDIF
+ !
+ !*** 4.1 Tendecies computation
+ !
+ ! Tendencies are *really* computed when LSOFT==.FALSE. and only adjusted otherwise
+ CALL ICE4_TENDENCIES(IMICRO, IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, KKT, KKL, &
+ &KRR, LSOFT, ZCOMPUTE, &
+ &OWARM, CSUBG_RC_RR_ACCR, CSUBG_RR_EVAP, &
+ &HSUBG_AUCV_RC, HSUBG_AUCV_RI, CSUBG_PR_PDF, &
+ &ZEXN, ZRHODREF, ZLVFACT, ZLSFACT, I1, I2, I3, &
+ &ZPRES, ZCF, ZSIGMA_RC,&
+ &ZCIT, &
+ &ZZT, ZTHT, &
+ &ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, ZRHT, &
+ &ZRVHENI_MR, ZRRHONG_MR, ZRIMLTC_MR, ZRSRIMCG_MR, &
+ &ZRCHONI, ZRVDEPS, ZRIAGGS, ZRIAUTS, ZRVDEPG, &
+ &ZRCAUTR, ZRCACCR, ZRREVAV, &
+ &ZRCRIMSS, ZRCRIMSG, ZRSRIMCG, ZRRACCSS, ZRRACCSG, ZRSACCRG, ZRSMLTG, ZRCMLTSR, &
+ &ZRICFRRG, ZRRCFRIG, ZRICFRR, ZRCWETG, ZRIWETG, ZRRWETG, ZRSWETG, &
+ &ZRCDRYG, ZRIDRYG, ZRRDRYG, ZRSDRYG, ZRWETGH, ZRWETGH_MR, ZRGMLTR, &
+ &ZRCWETH, ZRIWETH, ZRSWETH, ZRGWETH, ZRRWETH, &
+ &ZRCDRYH, ZRIDRYH, ZRSDRYH, ZRRDRYH, ZRGDRYH, ZRDRYHG, ZRHMLTR, &
+ &ZRCBERI, &
+ &ZRS_TEND, ZRG_TEND, ZRH_TEND, ZSSI, &
+ &ZA_TH, ZA_RV, ZA_RC, ZA_RR, ZA_RI, ZA_RS, ZA_RG, ZA_RH, &
+ &ZB_TH, ZB_RV, ZB_RC, ZB_RR, ZB_RI, ZB_RS, ZB_RG, ZB_RH, &
+ &ZHLC_HCF, ZHLC_LCF, ZHLC_HRC, ZHLC_LRC, &
+ &ZHLI_HCF, ZHLI_LCF, ZHLI_HRI, ZHLI_LRI, PRAINFR)
+ ! External tendencies
+ IF(GEXT_TEND) THEN
+ DO JL=1, IMICRO
+ ZA_TH(JL) = ZA_TH(JL) + ZEXT_TH(JL)
+ ZA_RV(JL) = ZA_RV(JL) + ZEXT_RV(JL)
+ ZA_RC(JL) = ZA_RC(JL) + ZEXT_RC(JL)
+ ZA_RR(JL) = ZA_RR(JL) + ZEXT_RR(JL)
+ ZA_RI(JL) = ZA_RI(JL) + ZEXT_RI(JL)
+ ZA_RS(JL) = ZA_RS(JL) + ZEXT_RS(JL)
+ ZA_RG(JL) = ZA_RG(JL) + ZEXT_RG(JL)
+ ZA_RH(JL) = ZA_RH(JL) + ZEXT_RH(JL)
+ ENDDO
+ ENDIF
+ !
+ !*** 4.2 Integration time
+ !
+ ! If we can, we will use these tendencies until the end of the timestep
+ ZMAXTIME(:)=ZCOMPUTE(:) * (PTSTEP-ZTIME(:)) ! Remaining time until the end of the timestep
+
+ !We need to adjust tendencies when temperature reaches 0
+ IF(LFEEDBACKT) THEN
+ DO JL=1, IMICRO
+ !Is ZB_TH enough to change temperature sign?
+ ZW1D(JL)=(ZTHT(JL) - XTT/ZEXN(JL)) * (ZTHT(JL) + ZB_TH(JL) - XTT/ZEXN(JL))
+ ZMAXTIME(JL)=ZMAXTIME(JL)*MAX(0., SIGN(1., ZW1D(JL)))
+ !Can ZA_TH make temperature change of sign?
+ ZW1D(JL)=MAX(0., -SIGN(1., 1.E-20 - ABS(ZA_TH(JL)))) ! WHERE(ABS(ZA_TH(:))>1.E-20)
+ ZTIME_THRESHOLD(JL)=(1. - ZW1D(JL))*(-1.) + &
+ ZW1D(JL) * &
+ (XTT/ZEXN(JL) - ZB_TH(JL) - ZTHT(JL))/ &
+ SIGN(MAX(ABS(ZA_TH(JL)), 1.E-20), ZA_TH(JL))
+ ZW1D(JL)=MAX(0., -SIGN(1., 1.E-20 - ZTIME_THRESHOLD(JL))) ! WHERE(ZTIME_THRESHOLD(:)>1.E-20)
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ ZW1D(JL) * MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
+ ENDDO
+ ENDIF
+
+ !We need to adjust tendencies when a specy disappears
+ !When a species is missing, only the external tendencies can be negative (and we must keep track of it)
+ DO JL=1, IMICRO
+ ZW1D(JL)=MAX(0., -SIGN(1., ZA_RV(JL)+1.E-20)) * & ! WHERE(ZA_RV(:)<-1.E-20)
+ &MAX(0., -SIGN(1., XRTMIN(1)-ZRVT(JL))) ! WHERE(ZRVT(:)>XRTMIN(1))
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL) * MIN(ZMAXTIME(JL), -(ZB_RV(JL)+ZRVT(JL))/MIN(ZA_RV(JL), -1.E-20))
+
+ ZW1D(JL)=MAX(0., -SIGN(1., ZA_RC(JL)+1.E-20)) * & ! WHERE(ZA_RC(:)<-1.E-20)
+ &MAX(0., -SIGN(1., XRTMIN(2)-ZRCT(JL))) ! WHERE(ZRCT(:)>XRTMIN(2))
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL) * MIN(ZMAXTIME(JL), -(ZB_RC(JL)+ZRCT(JL))/MIN(ZA_RC(JL), -1.E-20))
+
+ ZW1D(JL)=MAX(0., -SIGN(1., ZA_RR(JL)+1.E-20)) * & ! WHERE(ZA_RR(:)<-1.E-20)
+ &MAX(0., -SIGN(1., XRTMIN(3)-ZRRT(JL))) ! WHERE(ZRRT(:)>XRTMIN(3))
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL) * MIN(ZMAXTIME(JL), -(ZB_RR(JL)+ZRRT(JL))/MIN(ZA_RR(JL), -1.E-20))
+
+ ZW1D(JL)=MAX(0., -SIGN(1., ZA_RI(JL)+1.E-20)) * & ! WHERE(ZI_RV(:)<-1.E-20)
+ &MAX(0., -SIGN(1., XRTMIN(4)-ZRIT(JL))) ! WHERE(ZRIT(:)>XRTMIN(4))
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL) * MIN(ZMAXTIME(JL), -(ZB_RI(JL)+ZRIT(JL))/MIN(ZA_RI(JL), -1.E-20))
+
+ ZW1D(JL)=MAX(0., -SIGN(1., ZA_RS(JL)+1.E-20)) * & ! WHERE(ZA_RS(:)<-1.E-20)
+ &MAX(0., -SIGN(1., XRTMIN(5)-ZRST(JL))) ! WHERE(ZRST(:)>XRTMIN(5))
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL) * MIN(ZMAXTIME(JL), -(ZB_RS(JL)+ZRST(JL))/MIN(ZA_RS(JL), -1.E-20))
+
+ ZW1D(JL)=MAX(0., -SIGN(1., ZA_RG(JL)+1.E-20)) * & ! WHERE(ZA_RG(:)<-1.E-20)
+ &MAX(0., -SIGN(1., XRTMIN(6)-ZRGT(JL))) ! WHERE(ZRGT(:)>XRTMIN(6))
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL) * MIN(ZMAXTIME(JL), -(ZB_RG(JL)+ZRGT(JL))/MIN(ZA_RG(JL), -1.E-20))
+ ENDDO
+
+ IF(KRR==7) THEN
+ DO JL=1, IMICRO
+ ZW1D(JL)=MAX(0., -SIGN(1., ZA_RH(JL)+1.E-20)) * & ! WHERE(ZA_RH(:)<-1.E-20)
+ &MAX(0., -SIGN(1., XRTMIN(7)-ZRHT(JL))) ! WHERE(ZRHT(:)>XRTMIN(7))
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL) * MIN(ZMAXTIME(JL), -(ZB_RH(JL)+ZRHT(JL))/MIN(ZA_RH(JL), -1.E-20))
+ ENDDO
+ ENDIF
+
+ !We stop when the end of the timestep is reached
+ ZCOMPUTE(:)=ZCOMPUTE(:) * MAX(0., -SIGN(1., ZTIME(:)+ZMAXTIME(:)-PTSTEP))
+
+ !We must recompute tendencies when the end of the sub-timestep is reached
+ IF(XTSTEP_TS/=0.) THEN
+ DO JL=1, IMICRO
+ ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
+ &MAX(0., -SIGN(1., ZTIME_LASTCALL(JL)+ZTSTEP-ZTIME(JL)-ZMAXTIME(JL))) ! WHERE(ZTIME(:)+ZMAXTIME(:)>ZTIME_LASTCALL(:)+ZTSTEP)
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL) * (ZTIME_LASTCALL(JL)-ZTIME(JL)+ZTSTEP)
+ ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
+ ENDDO
+ ENDIF
+
+ !We must recompute tendencies when the maximum allowed change is reached
+ !When a specy is missing, only the external tendencies can be active and we do not want to recompute
+ !the microphysical tendencies when external tendencies are negative (results won't change because specy was already missing)
+ IF(XMRSTEP/=0.) THEN
+ DO JL=1, IMICRO
+ ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
+ &MAX(0., -SIGN(1., 1.E-20-ABS(ZA_RV(JL)))) ! WHERE(ABS(ZA_RV(:))>1.E-20)
+ ZTIME_THRESHOLD(JL)=(1.-ZW1D(JL))*(-1.) + &
+ &ZW1D(JL)*(SIGN(1., ZA_RV(JL))*XMRSTEP+Z0RVT(JL)-ZRVT(JL)-ZB_RV(JL))/ &
+ &SIGN(MAX(ABS(ZA_RV(JL)), 1.E-20), ZA_RV(JL))
+ ZW1D(JL)=MAX(0., SIGN(1., ZTIME_THRESHOLD(JL))) * & !WHERE(ZTIME_THRESHOLD(:)>=0.)
+ &MAX(0., -SIGN(1., ZTIME_THRESHOLD(JL)-ZMAXTIME(JL))) * & !WHERE(ZTIME_THRESHOLD(:)<ZMAXTIME(:))
+ &MIN(1., MAX(0., -SIGN(1., XRTMIN(6)-ZRVT(JL))) + & !WHERE(ZRVT(:)>XRTMIN(6)) .OR.
+ &MAX(0., -SIGN(1., -ZA_RV(JL)))) !WHERE(ZA_RV(:)>0.)
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL)*MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
+ ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
+
+ ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
+ &MAX(0., -SIGN(1., 1.E-20-ABS(ZA_RC(JL)))) ! WHERE(ABS(ZA_RC(:))>1.E-20)
+ ZTIME_THRESHOLD(JL)=(1.-ZW1D(JL))*(-1.) + &
+ &ZW1D(JL)*(SIGN(1., ZA_RC(JL))*XMRSTEP+Z0RCT(JL)-ZRCT(JL)-ZB_RC(JL))/ &
+ &SIGN(MAX(ABS(ZA_RC(JL)), 1.E-20), ZA_RC(JL))
+ ZW1D(JL)=MAX(0., SIGN(1., ZTIME_THRESHOLD(JL))) * & !WHERE(ZTIME_THRESHOLD(:)>=0.)
+ &MAX(0., -SIGN(1., ZTIME_THRESHOLD(JL)-ZMAXTIME(JL))) * & !WHERE(ZTIME_THRESHOLD(:)<ZMAXTIME(:))
+ &MIN(1., MAX(0., -SIGN(1., XRTMIN(6)-ZRCT(JL))) + & !WHERE(ZRCT(:)>XRTMIN(6)) .OR.
+ &MAX(0., -SIGN(1., -ZA_RC(JL)))) !WHERE(ZA_RC(:)>0.)
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL)*MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
+ ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
+
+ ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
+ &MAX(0., -SIGN(1., 1.E-20-ABS(ZA_RR(JL)))) ! WHERE(ABS(ZA_RR(:))>1.E-20)
+ ZTIME_THRESHOLD(JL)=(1.-ZW1D(JL))*(-1.) + &
+ &ZW1D(JL)*(SIGN(1., ZA_RR(JL))*XMRSTEP+Z0RRT(JL)-ZRRT(JL)-ZB_RR(JL))/ &
+ &SIGN(MAX(ABS(ZA_RR(JL)), 1.E-20), ZA_RR(JL))
+ ZW1D(JL)=MAX(0., SIGN(1., ZTIME_THRESHOLD(JL))) * & !WHERE(ZTIME_THRESHOLD(:)>=0.)
+ &MAX(0., -SIGN(1., ZTIME_THRESHOLD(JL)-ZMAXTIME(JL))) * & !WHERE(ZTIME_THRESHOLD(:)<ZMAXTIME(:))
+ &MIN(1., MAX(0., -SIGN(1., XRTMIN(6)-ZRRT(JL))) + & !WHERE(ZRRT(:)>XRTMIN(6)) .OR.
+ &MAX(0., -SIGN(1., -ZA_RR(JL)))) !WHERE(ZA_RR(:)>0.)
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL)*MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
+ ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
+
+ ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
+ &MAX(0., -SIGN(1., 1.E-20-ABS(ZA_RI(JL)))) ! WHERE(ABS(ZA_RI(:))>1.E-20)
+ ZTIME_THRESHOLD(JL)=(1.-ZW1D(JL))*(-1.) + &
+ &ZW1D(JL)*(SIGN(1., ZA_RI(JL))*XMRSTEP+Z0RIT(JL)-ZRIT(JL)-ZB_RI(JL))/ &
+ &SIGN(MAX(ABS(ZA_RI(JL)), 1.E-20), ZA_RI(JL))
+ ZW1D(JL)=MAX(0., SIGN(1., ZTIME_THRESHOLD(JL))) * & !WHERE(ZTIME_THRESHOLD(:)>=0.)
+ &MAX(0., -SIGN(1., ZTIME_THRESHOLD(JL)-ZMAXTIME(JL))) * & !WHERE(ZTIME_THRESHOLD(:)<ZMAXTIME(:))
+ &MIN(1., MAX(0., -SIGN(1., XRTMIN(6)-ZRIT(JL))) + & !WHERE(ZRIT(:)>XRTMIN(6)) .OR.
+ &MAX(0., -SIGN(1., -ZA_RI(JL)))) !WHERE(ZA_RI(:)>0.)
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL)*MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
+ ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
+
+ ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
+ &MAX(0., -SIGN(1., 1.E-20-ABS(ZA_RS(JL)))) ! WHERE(ABS(ZA_RS(:))>1.E-20)
+ ZTIME_THRESHOLD(JL)=(1.-ZW1D(JL))*(-1.) + &
+ &ZW1D(JL)*(SIGN(1., ZA_RS(JL))*XMRSTEP+Z0RST(JL)-ZRST(JL)-ZB_RS(JL))/ &
+ &SIGN(MAX(ABS(ZA_RS(JL)), 1.E-20), ZA_RS(JL))
+ ZW1D(JL)=MAX(0., SIGN(1., ZTIME_THRESHOLD(JL))) * & !WHERE(ZTIME_THRESHOLD(:)>=0.)
+ &MAX(0., -SIGN(1., ZTIME_THRESHOLD(JL)-ZMAXTIME(JL))) * & !WHERE(ZTIME_THRESHOLD(:)<ZMAXTIME(:))
+ &MIN(1., MAX(0., -SIGN(1., XRTMIN(6)-ZRST(JL))) + & !WHERE(ZRST(:)>XRTMIN(6)) .OR.
+ &MAX(0., -SIGN(1., -ZA_RS(JL)))) !WHERE(ZA_RS(:)>0.)
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL)*MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
+ ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
+
+ ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
+ &MAX(0., -SIGN(1., 1.E-20-ABS(ZA_RG(JL)))) ! WHERE(ABS(ZA_RG(:))>1.E-20)
+ ZTIME_THRESHOLD(JL)=(1.-ZW1D(JL))*(-1.) + &
+ &ZW1D(JL)*(SIGN(1., ZA_RG(JL))*XMRSTEP+Z0RGT(JL)-ZRGT(JL)-ZB_RG(JL))/ &
+ &SIGN(MAX(ABS(ZA_RG(JL)), 1.E-20), ZA_RG(JL))
+ ZW1D(JL)=MAX(0., SIGN(1., ZTIME_THRESHOLD(JL))) * & !WHERE(ZTIME_THRESHOLD(:)>=0.)
+ &MAX(0., -SIGN(1., ZTIME_THRESHOLD(JL)-ZMAXTIME(JL))) * & !WHERE(ZTIME_THRESHOLD(:)<ZMAXTIME(:))
+ &MIN(1., MAX(0., -SIGN(1., XRTMIN(6)-ZRGT(JL))) + & !WHERE(ZRGT(:)>XRTMIN(6)) .OR.
+ &MAX(0., -SIGN(1., -ZA_RG(JL)))) !WHERE(ZA_RG(:)>0.)
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL)*MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
+ ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
+ ENDDO
+
+ IF(KRR==7) THEN
+ DO JL=1, IMICRO
+ ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
+ &MAX(0., -SIGN(1., 1.E-20-ABS(ZA_RH(JL)))) ! WHERE(ABS(ZA_RH(:))>1.E-20)
+ ZTIME_THRESHOLD(JL)=(1.-ZW1D(JL))*(-1.) + &
+ &ZW1D(JL)*(SIGN(1., ZA_RH(JL))*XMRSTEP+Z0RHT(JL)-ZRHT(JL)-ZB_RH(JL))/ &
+ &SIGN(MAX(ABS(ZA_RH(JL)), 1.E-20), ZA_RH(JL))
+ ZW1D(JL)=MAX(0., SIGN(1., ZTIME_THRESHOLD(JL))) * & !WHERE(ZTIME_THRESHOLD(:)>=0.)
+ &MAX(0., -SIGN(1., ZTIME_THRESHOLD(JL)-ZMAXTIME(JL))) * & !WHERE(ZTIME_THRESHOLD(:)<ZMAXTIME(:))
+ &MIN(1., MAX(0., -SIGN(1., XRTMIN(6)-ZRHT(JL))) + & !WHERE(ZRHT(:)>XRTMIN(6)) .OR.
+ &MAX(0., -SIGN(1., -ZA_RH(JL)))) !WHERE(ZA_RH(:)>0.)
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL)*MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
+ ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
+ ENDDO
+ ENDIF
+
+ DO JL=1, IMICRO
+ ZW1D(JL)=MAX(ABS(ZB_RV(JL)), ABS(ZB_RC(JL)), ABS(ZB_RR(JL)), ABS(ZB_RI(JL)), &
+ &ABS(ZB_RS(JL)), ABS(ZB_RG(JL)), ABS(ZB_RH(JL)))
+ ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & !WHERE(IITER(:)<INB_ITER_MAX)
+ &MAX(0., -SIGN(1., XMRSTEP-ZW1D(JL))) !WHERE(ZW1D(:)>XMRSTEP)
+ ZMAXTIME(JL)=(1.-ZW1D(JL))*ZMAXTIME(JL)
+ ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
+ ENDDO
+ ENDIF
+ !
+ !*** 4.3 New values of variables for next iteration
+ !
+ DO JL=1, IMICRO
+ ZTHT(JL)=ZTHT(JL)+ZA_TH(JL)*ZMAXTIME(JL)+ZB_TH(JL)
+ ZRVT(JL)=ZRVT(JL)+ZA_RV(JL)*ZMAXTIME(JL)+ZB_RV(JL)
+ ZRCT(JL)=ZRCT(JL)+ZA_RC(JL)*ZMAXTIME(JL)+ZB_RC(JL)
+ ZRRT(JL)=ZRRT(JL)+ZA_RR(JL)*ZMAXTIME(JL)+ZB_RR(JL)
+ ZRIT(JL)=ZRIT(JL)+ZA_RI(JL)*ZMAXTIME(JL)+ZB_RI(JL)
+ ZRST(JL)=ZRST(JL)+ZA_RS(JL)*ZMAXTIME(JL)+ZB_RS(JL)
+ ZRGT(JL)=ZRGT(JL)+ZA_RG(JL)*ZMAXTIME(JL)+ZB_RG(JL)
+ ZCIT(JL)=ZCIT(JL) * MAX(0., -SIGN(1., -ZRIT(JL))) ! WHERE(ZRIT(:)==0.) ZCIT(:) = 0.
+ ENDDO
+ IF(KRR==7) ZRHT(:)=ZRHT(:)+ZA_RH(:)*ZMAXTIME(:)+ZB_RH(:)
+ !
+ !*** 4.4 Mixing ratio change due to each process
+ !
+ IF(LBU_ENABLE) THEN
+ ZTOT_RVHENI(:)= ZTOT_RVHENI(:) +ZRVHENI_MR(:)
+ ZTOT_RCHONI(:)= ZTOT_RCHONI(:) +ZRCHONI(:) *ZMAXTIME(:)
+ ZTOT_RRHONG(:)= ZTOT_RRHONG(:) +ZRRHONG_MR(:)
+ ZTOT_RVDEPS(:)= ZTOT_RVDEPS(:) +ZRVDEPS(:) *ZMAXTIME(:)
+ ZTOT_RIAGGS(:)= ZTOT_RIAGGS(:) +ZRIAGGS(:) *ZMAXTIME(:)
+ ZTOT_RIAUTS(:)= ZTOT_RIAUTS(:) +ZRIAUTS(:) *ZMAXTIME(:)
+ ZTOT_RVDEPG(:)= ZTOT_RVDEPG(:) +ZRVDEPG(:) *ZMAXTIME(:)
+ ZTOT_RCAUTR(:)= ZTOT_RCAUTR(:) +ZRCAUTR(:) *ZMAXTIME(:)
+ ZTOT_RCACCR(:)= ZTOT_RCACCR(:) +ZRCACCR(:) *ZMAXTIME(:)
+ ZTOT_RREVAV(:)= ZTOT_RREVAV(:) +ZRREVAV(:) *ZMAXTIME(:)
+ ZTOT_RCRIMSS(:)=ZTOT_RCRIMSS(:)+ZRCRIMSS(:)*ZMAXTIME(:)
+ ZTOT_RCRIMSG(:)=ZTOT_RCRIMSG(:)+ZRCRIMSG(:)*ZMAXTIME(:)
+ ZTOT_RSRIMCG(:)=ZTOT_RSRIMCG(:)+ZRSRIMCG(:)*ZMAXTIME(:)+ZRSRIMCG_MR(:)
+ ZTOT_RRACCSS(:)=ZTOT_RRACCSS(:)+ZRRACCSS(:)*ZMAXTIME(:)
+ ZTOT_RRACCSG(:)=ZTOT_RRACCSG(:)+ZRRACCSG(:)*ZMAXTIME(:)
+ ZTOT_RSACCRG(:)=ZTOT_RSACCRG(:)+ZRSACCRG(:)*ZMAXTIME(:)
+ ZTOT_RSMLTG(:)= ZTOT_RSMLTG(:) +ZRSMLTG(:) *ZMAXTIME(:)
+ ZTOT_RCMLTSR(:)=ZTOT_RCMLTSR(:)+ZRCMLTSR(:) *ZMAXTIME(:)
+ ZTOT_RICFRRG(:)=ZTOT_RICFRRG(:)+ZRICFRRG(:)*ZMAXTIME(:)
+ ZTOT_RRCFRIG(:)=ZTOT_RRCFRIG(:)+ZRRCFRIG(:)*ZMAXTIME(:)
+ ZTOT_RICFRR(:)= ZTOT_RICFRR(:) +ZRICFRR(:) *ZMAXTIME(:)
+ ZTOT_RCWETG(:)= ZTOT_RCWETG(:) +ZRCWETG(:) *ZMAXTIME(:)
+ ZTOT_RIWETG(:)= ZTOT_RIWETG(:) +ZRIWETG(:) *ZMAXTIME(:)
+ ZTOT_RRWETG(:)= ZTOT_RRWETG(:) +ZRRWETG(:) *ZMAXTIME(:)
+ ZTOT_RSWETG(:)= ZTOT_RSWETG(:) +ZRSWETG(:) *ZMAXTIME(:)
+ ZTOT_RWETGH(:)= ZTOT_RWETGH(:) +ZRWETGH(:) *ZMAXTIME(:)+ZRWETGH_MR(:)
+ ZTOT_RCDRYG(:)= ZTOT_RCDRYG(:) +ZRCDRYG(:) *ZMAXTIME(:)
+ ZTOT_RIDRYG(:)= ZTOT_RIDRYG(:) +ZRIDRYG(:) *ZMAXTIME(:)
+ ZTOT_RRDRYG(:)= ZTOT_RRDRYG(:) +ZRRDRYG(:) *ZMAXTIME(:)
+ ZTOT_RSDRYG(:)= ZTOT_RSDRYG(:) +ZRSDRYG(:) *ZMAXTIME(:)
+ ZTOT_RGMLTR(:)= ZTOT_RGMLTR(:) +ZRGMLTR(:) *ZMAXTIME(:)
+ ZTOT_RCWETH(:)= ZTOT_RCWETH(:) +ZRCWETH(:) *ZMAXTIME(:)
+ ZTOT_RIWETH(:)= ZTOT_RIWETH(:) +ZRIWETH(:) *ZMAXTIME(:)
+ ZTOT_RSWETH(:)= ZTOT_RSWETH(:) +ZRSWETH(:) *ZMAXTIME(:)
+ ZTOT_RGWETH(:)= ZTOT_RGWETH(:) +ZRGWETH(:) *ZMAXTIME(:)
+ ZTOT_RRWETH(:)= ZTOT_RRWETH(:) +ZRRWETH(:) *ZMAXTIME(:)
+ ZTOT_RCDRYH(:)= ZTOT_RCDRYH(:) +ZRCDRYH(:) *ZMAXTIME(:)
+ ZTOT_RIDRYH(:)= ZTOT_RIDRYH(:) +ZRIDRYH(:) *ZMAXTIME(:)
+ ZTOT_RSDRYH(:)= ZTOT_RSDRYH(:) +ZRSDRYH(:) *ZMAXTIME(:)
+ ZTOT_RRDRYH(:)= ZTOT_RRDRYH(:) +ZRRDRYH(:) *ZMAXTIME(:)
+ ZTOT_RGDRYH(:)= ZTOT_RGDRYH(:) +ZRGDRYH(:) *ZMAXTIME(:)
+ ZTOT_RDRYHG(:)= ZTOT_RDRYHG(:) +ZRDRYHG(:) *ZMAXTIME(:)
+ ZTOT_RHMLTR(:)= ZTOT_RHMLTR(:) +ZRHMLTR(:) *ZMAXTIME(:)
+ ZTOT_RIMLTC(:)= ZTOT_RIMLTC(:) +ZRIMLTC_MR(:)
+ ZTOT_RCBERI(:)= ZTOT_RCBERI(:) +ZRCBERI(:) *ZMAXTIME(:)
+ ENDIF
+ !
+ !*** 4.5 Next loop
+ !
+ LSOFT=.TRUE. ! We try to adjust tendencies (inner while loop)
+ ZTIME(:)=ZTIME(:)+ZMAXTIME(:)
+ ENDDO
+ENDDO
+!-------------------------------------------------------------------------------
+!
+!* 5. UNPACKING DIAGNOSTICS
+! ---------------------
+!
+IF(IMICRO>0) THEN
+ ZHLC_HCF3D(:,:,:)=0.
+ ZHLC_LCF3D(:,:,:)=0.
+ ZHLC_HRC3D(:,:,:)=0.
+ ZHLC_LRC3D(:,:,:)=0.
+ ZHLI_HCF3D(:,:,:)=0.
+ ZHLI_LCF3D(:,:,:)=0.
+ ZHLI_HRI3D(:,:,:)=0.
+ ZHLI_LRI3D(:,:,:)=0.
+ DO JL=1,IMICRO
+ ZHLC_HCF3D(I1(JL), I2(JL), I3(JL)) = ZHLC_HCF(JL)
+ ZHLC_LCF3D(I1(JL), I2(JL), I3(JL)) = ZHLC_LCF(JL)
+ ZHLC_HRC3D(I1(JL), I2(JL), I3(JL)) = ZHLC_HRC(JL)
+ ZHLC_LRC3D(I1(JL), I2(JL), I3(JL)) = ZHLC_LRC(JL)
+ ZHLI_LCF3D(I1(JL), I2(JL), I3(JL)) = ZHLI_LCF(JL)
+ ZHLI_HCF3D(I1(JL), I2(JL), I3(JL)) = ZHLI_HCF(JL)
+ ZHLI_HRI3D(I1(JL), I2(JL), I3(JL)) = ZHLI_HRI(JL)
+ ZHLI_LRI3D(I1(JL), I2(JL), I3(JL)) = ZHLI_LRI(JL)
+ PCIT(I1(JL), I2(JL), I3(JL)) = ZCIT(JL)
+ END DO
+ELSE
+ PRAINFR(:,:,:)=0.
+ ZHLC_HCF3D(:,:,:)=0.
+ ZHLC_LCF3D(:,:,:)=0.
+ ZHLC_HRC3D(:,:,:)=0.
+ ZHLC_LRC3D(:,:,:)=0.
+ ZHLI_HCF3D(:,:,:)=0.
+ ZHLI_LCF3D(:,:,:)=0.
+ ZHLI_HRI3D(:,:,:)=0.
+ ZHLI_LRI3D(:,:,:)=0.
+ PCIT(:,:,:) = 0.
+ENDIF
+IF(OWARM) THEN
+ PEVAP3D(:,:,:) = 0.
+ DO JL=1,IMICRO
+ PEVAP3D(I1(JL), I2(JL), I3(JL)) = ZRREVAV(JL)
+ END DO
+ENDIF
+!
+!
+!* 6. COMPUTES THE SLOW COLD PROCESS SOURCES OUTSIDE OF ODMICRO POINTS
+! ----------------------------------------------------------------
+!
+CALL ICE4_NUCLEATION_WRAPPER(KIT, KJT, KKT, .NOT. ODMICRO, &
+ PTHT, PPABST, PRHODREF, PEXN, ZZ_LSFACT/PEXN, ZT, &
+ PRVT, &
+ PCIT, ZZ_RVHENI_MR)
+DO JK = 1, KKT
+ DO JJ = 1, KJT
+ DO JI = 1, KIT
+ ZZ_LSFACT(JI,JJ,JK)=ZZ_LSFACT(JI,JJ,JK)/PEXNREF(JI,JJ,JK)
+ ZZ_LVFACT(JI,JJ,JK)=ZZ_LVFACT(JI,JJ,JK)/PEXNREF(JI,JJ,JK)
+ ZZ_RVHENI(JI,JJ,JK) = MIN(PRVS(JI,JJ,JK), ZZ_RVHENI_MR(JI,JJ,JK)/PTSTEP)
+ PRIS(JI,JJ,JK)=PRIS(JI,JJ,JK)+ZZ_RVHENI(JI,JJ,JK)
+ PRVS(JI,JJ,JK)=PRVS(JI,JJ,JK)-ZZ_RVHENI(JI,JJ,JK)
+ PTHS(JI,JJ,JK)=PTHS(JI,JJ,JK) + ZZ_RVHENI(JI,JJ,JK)*ZZ_LSFACT(JI,JJ,JK)
+ ENDDO
+ ENDDO
+ENDDO
+!
+if ( lbu_enable ) then
+ !Note: there is an other contribution for HENU later
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HENU', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'HENU', prvs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HENU', zz_rvheni(:, :, :) * prhodj(:, :, :) )
+end if
+!-------------------------------------------------------------------------------
+!
+!* 7. UNPACKING AND TOTAL TENDENCIES
+! ------------------------------
+!
+!
+!*** 7.1 total tendencies limited by available species
+!
+! ZW_??S variables will contain the new S variables values
+!
+IF(GEXT_TEND) THEN
+ !Z..T variables contain the exeternal tendency, we substract it
+ DO JL=1, IMICRO
+ ZRVT(JL) = ZRVT(JL) - ZEXT_RV(JL) * PTSTEP
+ ZRCT(JL) = ZRCT(JL) - ZEXT_RC(JL) * PTSTEP
+ ZRRT(JL) = ZRRT(JL) - ZEXT_RR(JL) * PTSTEP
+ ZRIT(JL) = ZRIT(JL) - ZEXT_RI(JL) * PTSTEP
+ ZRST(JL) = ZRST(JL) - ZEXT_RS(JL) * PTSTEP
+ ZRGT(JL) = ZRGT(JL) - ZEXT_RG(JL) * PTSTEP
+ ZTHT(JL) = ZTHT(JL) - ZEXT_TH(JL) * PTSTEP
+ ENDDO
+ IF (KRR==7) ZRHT(:) = ZRHT(:) - ZEXT_RH(:) * PTSTEP
+ENDIF
+!Tendencies computed from difference between old state and new state (can be negative)
+ ZW_RVS(:,:,:) = 0.
+ ZW_RCS(:,:,:) = 0.
+ ZW_RRS(:,:,:) = 0.
+ ZW_RIS(:,:,:) = 0.
+ ZW_RSS(:,:,:) = 0.
+ ZW_RGS(:,:,:) = 0.
+ ZW_RHS(:,:,:) = 0.
+ DO JL=1,IMICRO
+ ZW_RVS(I1(JL), I2(JL), I3(JL)) = ( ZRVT(JL) - PRVT(I1(JL), I2(JL), I3(JL)) ) * ZINV_TSTEP
+ ZW_RCS(I1(JL), I2(JL), I3(JL)) = ( ZRCT(JL) - PRCT(I1(JL), I2(JL), I3(JL)) ) * ZINV_TSTEP
+ ZW_RRS(I1(JL), I2(JL), I3(JL)) = ( ZRRT(JL) - PRRT(I1(JL), I2(JL), I3(JL)) ) * ZINV_TSTEP
+ ZW_RIS(I1(JL), I2(JL), I3(JL)) = ( ZRIT(JL) - PRIT(I1(JL), I2(JL), I3(JL)) ) * ZINV_TSTEP
+ ZW_RSS(I1(JL), I2(JL), I3(JL)) = ( ZRST(JL) - PRST(I1(JL), I2(JL), I3(JL)) ) * ZINV_TSTEP
+ ZW_RGS(I1(JL), I2(JL), I3(JL)) = ( ZRGT(JL) - PRGT(I1(JL), I2(JL), I3(JL)) ) * ZINV_TSTEP
+ END DO
+ IF(KRR==7) THEN
+ DO JL=1,IMICRO
+ ZW_RHS(I1(JL), I2(JL), I3(JL)) = ( ZRHT(JL) - PRHT(I1(JL), I2(JL), I3(JL)) ) * ZINV_TSTEP
+ END DO
+END IF
+ZW_THS(:,:,:) = (ZW_RCS(:,:,:)+ZW_RRS(:,:,:) )*ZZ_LVFACT(:,:,:) + &
+ & (ZW_RIS(:,:,:)+ZW_RSS(:,:,:)+ZW_RGS(:,:,:)+ZW_RHS(:,:,:))*ZZ_LSFACT(:,:,:)
+!We apply these tendencies to the S variables
+ZW_RVS(:,:,:) = PRVS(:,:,:) + ZW_RVS(:,:,:)
+ZW_RCS(:,:,:) = PRCS(:,:,:) + ZW_RCS(:,:,:)
+ZW_RRS(:,:,:) = PRRS(:,:,:) + ZW_RRS(:,:,:)
+ZW_RIS(:,:,:) = PRIS(:,:,:) + ZW_RIS(:,:,:)
+ZW_RSS(:,:,:) = PRSS(:,:,:) + ZW_RSS(:,:,:)
+ZW_RGS(:,:,:) = PRGS(:,:,:) + ZW_RGS(:,:,:)
+IF(KRR==7) ZW_RHS(:,:,:) = PRHS(:,:,:) + ZW_RHS(:,:,:)
+ZW_THS(:,:,:) = PTHS(:,:,:) + ZW_THS(:,:,:)
+
+if ( lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'CORR', zw_ths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'CORR', zw_rvs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'CORR', zw_rcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'CORR', zw_rrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'CORR', zw_ris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'CORR', zw_rss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'CORR', zw_rgs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'CORR', zw_rhs(:, :, :) * prhodj(:, :, :) )
+end if
+
+!We correct negativities with conservation
+CALL CORRECT_NEGATIVITIES(KIT, KJT, KKT, KRR, ZW_RVS, ZW_RCS, ZW_RRS, &
+ &ZW_RIS, ZW_RSS, ZW_RGS, &
+ &ZW_THS, ZZ_LVFACT, ZZ_LSFACT, ZW_RHS)
+
+if ( lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'CORR', zw_ths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'CORR', zw_rvs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'CORR', zw_rcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'CORR', zw_rrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'CORR', zw_ris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'CORR', zw_rss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'CORR', zw_rgs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'CORR', zw_rhs(:, :, :) * prhodj(:, :, :) )
+end if
+!
+!*** 7.2 LBU_ENABLE case
+!
+IF(LBU_ENABLE) THEN
+ allocate( zw1( size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
+ allocate( zw2( size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
+ allocate( zw3( size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
+ allocate( zw4( size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
+ if ( krr == 7 ) then
+ allocate( zw5( size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
+ allocate( zw6( size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
+ end if
+
+ if ( lbudget_th ) then
+ allocate( zz_diff( size( zz_lsfact, 1 ), size( zz_lsfact, 2 ), size( zz_lsfact, 3 ) ) )
+ zz_diff(:, :, :) = zz_lsfact(:, :, :) - zz_lvfact(:, :, :)
+ end if
+
+ ZW(:,:,:) = 0.
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RVHENI(JL) * ZINV_TSTEP
+ END DO
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HENU', zw(:, :, :) * zz_lsfact(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'HENU', -zw(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HENU', zw(:, :, :) * prhodj(:, :, :) )
+
+ ZW(:,:,:) = 0.
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RCHONI(JL) * ZINV_TSTEP
+ END DO
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HON', zw(:, :, :) * zz_diff(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'HON', -zw(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HON', zw(:, :, :) * prhodj(:, :, :) )
+
+ ZW(:,:,:) = 0.
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RRHONG(JL) * ZINV_TSTEP
+ END DO
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'SFR', zw(:, :, :) * zz_diff(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'SFR', -zw(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'SFR', zw(:, :, :) * prhodj(:, :, :) )
+
+ ZW(:,:,:) = 0.
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RVDEPS(JL) * ZINV_TSTEP
+ END DO
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'DEPS', zw(:, :, :) * zz_lsfact(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'DEPS', -zw(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'DEPS', zw(:, :, :) * prhodj(:, :, :) )
+
+ ZW(:,:,:) = 0.
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RIAGGS(JL) * ZINV_TSTEP
+ END DO
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'AGGS', -zw(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'AGGS', zw(:, :, :) * prhodj(:, :, :) )
+
+ ZW(:,:,:) = 0.
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RIAUTS(JL) * ZINV_TSTEP
+ END DO
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'AUTS', -zw(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'AUTS', zw(:, :, :) * prhodj(:, :, :) )
+
+ ZW(:,:,:) = 0.
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RVDEPG(JL) * ZINV_TSTEP
+ END DO
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'DEPG', zw(:, :, :) * zz_lsfact(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'DEPG', -zw(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'DEPG', zw(:, :, :) * prhodj(:, :, :) )
+
+ IF(OWARM) THEN
+ ZW(:,:,:) = 0.
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RCAUTR(JL) * ZINV_TSTEP
+ END DO
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'AUTO', -zw(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'AUTO', zw(:, :, :) * prhodj(:, :, :) )
+
+ ZW(:,:,:) = 0.
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RCACCR(JL) * ZINV_TSTEP
+ END DO
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'ACCR', -zw(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'ACCR', zw(:, :, :) * prhodj(:, :, :) )
+
+ ZW(:,:,:) = 0.
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RREVAV(JL) * ZINV_TSTEP
+ END DO
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'REVA', -zw(:, :, :) * zz_lvfact(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'REVA', zw(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'REVA', -zw(:, :, :) * prhodj(:, :, :) )
+ ENDIF
+
+ ZW1(:,:,:) = 0.
+ DO JL=1,IMICRO
+ ZW1(I1(JL), I2(JL), I3(JL)) = ZTOT_RCRIMSS(JL) * ZINV_TSTEP
+ END DO
+ ZW2(:,:,:) = 0.
+ DO JL=1,IMICRO
+ ZW2(I1(JL), I2(JL), I3(JL)) = ZTOT_RCRIMSG(JL) * ZINV_TSTEP
+ END DO
+ ZW3(:,:,:) = 0.
+ DO JL=1,IMICRO
+ ZW3(I1(JL), I2(JL), I3(JL)) = ZTOT_RSRIMCG(JL) * ZINV_TSTEP
+ END DO
+ if ( lbudget_th ) &
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'RIM', ( zw1(:, :, :) + zw2(:, :, :) ) * zz_diff(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'RIM', ( -zw1(:, :, :) - zw2(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'RIM', ( zw1(:, :, :) - zw3(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'RIM', ( zw2(:, :, :) + zw3(:, :, :) ) * prhodj(:, :, :) )
+
+ ZW1(:,:,:) = 0.
+ DO JL=1,IMICRO
+ ZW1(I1(JL), I2(JL), I3(JL)) = ZTOT_RRACCSS(JL) * ZINV_TSTEP
+ END DO
+ ZW2(:,:,:) = 0.
+ DO JL=1,IMICRO
+ ZW2(I1(JL), I2(JL), I3(JL)) = ZTOT_RRACCSG(JL) * ZINV_TSTEP
+ END DO
+ ZW3(:,:,:) = 0.
+ DO JL=1,IMICRO
+ ZW3(I1(JL), I2(JL), I3(JL)) = ZTOT_RSACCRG(JL) * ZINV_TSTEP
+ END DO
+ if ( lbudget_th ) &
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'ACC', ( zw1(:, :, :) + zw2(:, :, :) ) * zz_diff(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'ACC', ( -zw1(:, :, :) - zw2(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'ACC', ( zw1(:, :, :) - zw3(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'ACC', ( zw2(:, :, :) + zw3(:, :, :) ) * prhodj(:, :, :) )
+
+ ZW(:,:,:) = 0.
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RSMLTG(JL) * ZINV_TSTEP
+ END DO
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'CMEL', -zw(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'CMEL', zw(:, :, :) * prhodj(:, :, :) )
+ ZW(:,:,:) = 0.
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RCMLTSR(JL) * ZINV_TSTEP
+ END DO
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'CMEL', -zw(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'CMEL', zw(:, :, :) * prhodj(:, :, :) )
+
+ ZW1(:,:,:) = 0.
+ DO JL=1,IMICRO
+ ZW1(I1(JL), I2(JL), I3(JL)) = ZTOT_RICFRRG(JL) * ZINV_TSTEP
+ END DO
+ ZW2(:,:,:) = 0.
+ DO JL=1,IMICRO
+ ZW2(I1(JL), I2(JL), I3(JL)) = ZTOT_RRCFRIG(JL) * ZINV_TSTEP
+ END DO
+ ZW3(:,:,:) = 0.
+ DO JL=1,IMICRO
+ ZW3(I1(JL), I2(JL), I3(JL)) = ZTOT_RICFRR(JL) * ZINV_TSTEP
+ END DO
+ if ( lbudget_th ) &
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'CFRZ', zw2(:, :, :) * zz_diff(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'CFRZ', ( -zw2(:, :, :) + zw3(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'CFRZ', ( -zw1(:, :, :) - zw3(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'CFRZ', ( zw1(:, :, :) + zw2(:, :, :) ) * prhodj(:, :, :) )
+
+ ZW1(:,:,:) = 0.
+ DO JL=1,IMICRO
+ ZW1(I1(JL), I2(JL), I3(JL)) = ZTOT_RCWETG(JL) * ZINV_TSTEP
+ END DO
+ ZW2(:,:,:) = 0.
+ DO JL=1,IMICRO
+ ZW2(I1(JL), I2(JL), I3(JL)) = ZTOT_RRWETG(JL) * ZINV_TSTEP
+ END DO
+ ZW3(:,:,:) = 0.
+ DO JL=1,IMICRO
+ ZW3(I1(JL), I2(JL), I3(JL)) = ZTOT_RIWETG(JL) * ZINV_TSTEP
+ END DO
+ ZW4(:,:,:) = 0.
+ DO JL=1,IMICRO
+ ZW4(I1(JL), I2(JL), I3(JL)) = ZTOT_RSWETG(JL) * ZINV_TSTEP
+ END DO
+ if ( lbudget_th ) &
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'WETG', ( zw1(:, :, :) + zw2(:, :, :) ) * zz_diff(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'WETG', -zw1(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'WETG', -zw2(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'WETG', -zw3(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'WETG', -zw4(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'WETG', ( zw1(:, :, :) + zw2(:, :, :) &
+ + zw3(:, :, :) + zw4(:, :, :) ) &
+ * prhodj(:, :, :) )
+
+ IF(KRR==7) THEN
+ ZW(:,:,:) = 0.
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RWETGH(JL) * ZINV_TSTEP
+ END DO
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'GHCV', -zw(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_add( tbudgets(NBUDGET_RH), 'GHCV', zw(:, :, :) * prhodj(:, :, :) )
+ END IF
+
+ ZW1(:,:,:) = 0.
+ DO JL=1,IMICRO
+ ZW1(I1(JL), I2(JL), I3(JL)) = ZTOT_RCDRYG(JL) * ZINV_TSTEP
+ END DO
+ ZW2(:,:,:) = 0.
+ DO JL=1,IMICRO
+ ZW2(I1(JL), I2(JL), I3(JL)) = ZTOT_RRDRYG(JL) * ZINV_TSTEP
+ END DO
+ ZW3(:,:,:) = 0.
+ DO JL=1,IMICRO
+ ZW3(I1(JL), I2(JL), I3(JL)) = ZTOT_RIDRYG(JL) * ZINV_TSTEP
+ END DO
+ ZW4(:,:,:) = 0.
+ DO JL=1,IMICRO
+ ZW4(I1(JL), I2(JL), I3(JL)) = ZTOT_RSDRYG(JL) * ZINV_TSTEP
+ END DO
+ if ( lbudget_th ) &
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'DRYG', ( zw1(:, :, :) + zw2(:, :, :) ) * zz_diff(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'DRYG', -zw1(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'DRYG', -zw2(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'DRYG', -zw3(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'DRYG', -zw4(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'DRYG', ( zw1(:, :, :) + zw2(:, :, :) &
+ + zw3(:, :, :) + zw4(:, :, :) ) &
+ * prhodj(:, :, :) )
+
+ ZW(:,:,:) = 0.
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RGMLTR(JL) * ZINV_TSTEP
+ END DO
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'GMLT', -zw(:, :, :) * zz_diff(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'GMLT', zw(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'GMLT', -zw(:, :, :) * prhodj(:, :, :) )
+
+ IF(KRR==7) THEN
+ ZW1(:,:,:) = 0.
+ DO JL=1,IMICRO
+ ZW1(I1(JL), I2(JL), I3(JL)) = ZTOT_RCWETH(JL) * ZINV_TSTEP
+ END DO
+ ZW2(:,:,:) = 0.
+ DO JL=1,IMICRO
+ ZW2(I1(JL), I2(JL), I3(JL)) = ZTOT_RRWETH(JL) * ZINV_TSTEP
+ END DO
+ ZW3(:,:,:) = 0.
+ DO JL=1,IMICRO
+ ZW3(I1(JL), I2(JL), I3(JL)) = ZTOT_RIWETH(JL) * ZINV_TSTEP
+ END DO
+ ZW4(:,:,:) = 0.
+ DO JL=1,IMICRO
+ ZW4(I1(JL), I2(JL), I3(JL)) = ZTOT_RSWETH(JL) * ZINV_TSTEP
+ END DO
+ ZW5(:,:,:) = 0.
+ DO JL=1,IMICRO
+ ZW5(I1(JL), I2(JL), I3(JL)) = ZTOT_RGWETH(JL) * ZINV_TSTEP
+ END DO
+ if ( lbudget_th ) &
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'WETH', ( zw1(:, :, :) + zw2(:, :, :) ) * zz_diff(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'WETH', -zw1(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'WETH', -zw2(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'WETH', -zw3(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'WETH', -zw4(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'WETH', -zw5(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_add( tbudgets(NBUDGET_RH), 'WETH', ( zw1(:, :, :) + zw2(:, :, :) + zw3(:, :, :) &
+ + zw4(:, :, :) + zw5(:, :, : ) ) &
+ * prhodj(:, :, :) )
+
+ ZW(:,:,:) = 0.
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RGWETH(JL) * ZINV_TSTEP
+ END DO
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'HGCV', -zw(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_add( tbudgets(NBUDGET_RH), 'HGCV', zw(:, :, :) * prhodj(:, :, :) )
+
+ ZW1(:,:,:) = 0.
+ DO JL=1,IMICRO
+ ZW1(I1(JL), I2(JL), I3(JL)) = ZTOT_RCDRYH(JL) * ZINV_TSTEP
+ END DO
+ ZW2(:,:,:) = 0.
+ DO JL=1,IMICRO
+ ZW2(I1(JL), I2(JL), I3(JL)) = ZTOT_RRDRYH(JL) * ZINV_TSTEP
+ END DO
+ ZW3(:,:,:) = 0.
+ DO JL=1,IMICRO
+ ZW3(I1(JL), I2(JL), I3(JL)) = ZTOT_RIDRYH(JL) * ZINV_TSTEP
+ END DO
+ ZW4(:,:,:) = 0.
+ DO JL=1,IMICRO
+ ZW4(I1(JL), I2(JL), I3(JL)) = ZTOT_RSDRYH(JL) * ZINV_TSTEP
+ END DO
+ ZW5(:,:,:) = 0.
+ DO JL=1,IMICRO
+ ZW5(I1(JL), I2(JL), I3(JL)) = ZTOT_RGDRYH(JL) * ZINV_TSTEP
+ END DO
+ ZW6(:,:,:) = 0.
+ DO JL=1,IMICRO
+ ZW6(I1(JL), I2(JL), I3(JL)) = ZTOT_RDRYHG(JL) * ZINV_TSTEP
+ END DO
+ if ( lbudget_th ) &
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'DRYH', ( zw1(:, :, :) + zw2(:, :, :) ) * zz_diff(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'DRYH', -zw1(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'DRYH', -zw2(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'DRYH', -zw3(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'DRYH', -zw4(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'DRYH', ( -zw5(:, :, :) + zw6(:, :, : ) ) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_add( tbudgets(NBUDGET_RH), 'DRYH', ( zw1(:, :, :) + zw2(:, :, :) + zw3(:, :, :) &
+ + zw4(:, :, :) + zw5(:, :, : )- zw6(:, :, :) ) &
+ * prhodj(:, :, :) )
+
+ ZW(:,:,:) = 0.
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RHMLTR(JL) * ZINV_TSTEP
+ END DO
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HMLT', -zw(:, :, :) * zz_diff(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'HMLT', zw(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_add( tbudgets(NBUDGET_RH), 'HMLT', -zw(:, :, :) * prhodj(:, :, :) )
+ ENDIF
+
+ ZW(:,:,:) = 0.
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RIMLTC(JL) * ZINV_TSTEP
+ END DO
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'IMLT', -zw(:, :, :) * zz_diff(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'IMLT', zw(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'IMLT', -zw(:, :, :) * prhodj(:, :, :) )
+
+ ZW(:,:,:) = 0.
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RCBERI(JL) * ZINV_TSTEP
+ END DO
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'BERFI', zw(:, :, :) * zz_diff(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'BERFI', -zw(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'BERFI', zw(:, :, :) * prhodj(:, :, :) )
+
+ deallocate( zw1, zw2, zw3, zw4 )
+ if ( krr == 7 ) deallocate( zw5, zw6 )
+ if ( lbudget_th ) deallocate( zz_diff )
+ENDIF
+!
+!*** 7.3 Final tendencies
+!
+DO JK = 1, KKT
+ DO JJ = 1, KJT
+ DO JI = 1, KIT
+ PRVS(JI,JJ,JK) = ZW_RVS(JI,JJ,JK)
+ PRCS(JI,JJ,JK) = ZW_RCS(JI,JJ,JK)
+ PRRS(JI,JJ,JK) = ZW_RRS(JI,JJ,JK)
+ PRIS(JI,JJ,JK) = ZW_RIS(JI,JJ,JK)
+ PRSS(JI,JJ,JK) = ZW_RSS(JI,JJ,JK)
+ PRGS(JI,JJ,JK) = ZW_RGS(JI,JJ,JK)
+ PTHS(JI,JJ,JK) = ZW_THS(JI,JJ,JK)
+ ENDDO
+ ENDDO
+ENDDO
+IF (KRR==7) PRHS(:,:,:) = ZW_RHS(:,:,:)
+!
+!-------------------------------------------------------------------------------
+!
+!* 8. COMPUTE THE SEDIMENTATION (RS) SOURCE
+! -------------------------------------
+!
+IF(LSEDIM_AFTER) THEN
+ !
+ !* 8.1 sedimentation
+ !
+ if ( lbudget_rc .and. osedic ) call Budget_store_init( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
+
+ !Init only if not osedic (to prevent crash with double init)
+ !Remark: the 2 source terms SEDI and DEPO could be mixed and stored in the same source term (SEDI)
+ ! if osedic=T and ldeposc=T (a warning is printed in ini_budget in that case)
+ if ( lbudget_rc .and. ldeposc .and. .not.osedic ) &
+ call Budget_store_init( tbudgets(NBUDGET_RC), 'DEPO', prcs(:, :, :) * prhodj(:, :, :) )
+
+ IF(HSEDIM=='STAT') THEN
+ !SR: It *seems* that we must have two separate calls for ifort
+ IF(KRR==7) THEN
+ CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
+ &PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, &
+ &PRHODREF, PPABST, PTHT, PRHODJ, &
+ &PRCS, PRCS*PTSTEP, PRRS, PRRS*PTSTEP, PRIS, PRIS*PTSTEP,&
+ &PRSS, PRSS*PTSTEP, PRGS, PRGS*PTSTEP,&
+ &PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, &
+ &PSEA=PSEA, PTOWN=PTOWN, &
+ &PINPRH=PINPRH, PRHT=PRHS*PTSTEP, PRHS=PRHS, PFPR=PFPR)
+ ELSE
+ CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
+ &PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ,&
+ &PRHODREF, PPABST, PTHT, PRHODJ, &
+ &PRCS, PRCS*PTSTEP, PRRS, PRRS*PTSTEP, PRIS, PRIS*PTSTEP,&
+ &PRSS, PRSS*PTSTEP, PRGS, PRGS*PTSTEP,&
+ &PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, &
+ &PSEA=PSEA, PTOWN=PTOWN, &
+ &PFPR=PFPR)
+ ENDIF
+ PINPRS(:,:) = PINPRS(:,:) + ZINPRI(:,:)
+ !No negativity correction here as we apply sedimentation on PR.S*PTSTEP variables
+ ELSEIF(HSEDIM=='SPLI') THEN
+ !SR: It *seems* that we must have two separate calls for ifort
+ IF(KRR==7) THEN
+ CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
+ &PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, &
+ &PRHODREF, PPABST, PTHT, PRHODJ, &
+ &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
+ &PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, &
+ &PSEA=PSEA, PTOWN=PTOWN, &
+ &PINPRH=PINPRH, PRHT=PRHT, PRHS=PRHS, PFPR=PFPR)
+ ELSE
+ CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
+ &PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, &
+ &PRHODREF, PPABST, PTHT, PRHODJ, &
+ &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
+ &PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, &
+ &PSEA=PSEA, PTOWN=PTOWN, &
+ &PFPR=PFPR)
+ ENDIF
+ PINPRS(:,:) = PINPRS(:,:) + ZINPRI(:,:)
+ !We correct negativities with conservation
+ !SPLI algorith uses a time-splitting. Inside the loop a temporary m.r. is used.
+ ! It is initialized with the m.r. at T and is modified by two tendencies:
+ ! sedimentation tendency and an external tendency which represents all other
+ ! processes (mainly advection and microphysical processes). If both tendencies
+ ! are negative, sedimentation can remove a specie at a given sub-timestep. From
+ ! this point sedimentation stops for the remaining sub-timesteps but the other tendency
+ ! will be still active and will lead to negative values.
+ ! We could prevent the algorithm to not consume too much a specie, instead we apply
+ ! a correction here.
+ CALL CORRECT_NEGATIVITIES(KIT, KJT, KKT, KRR, PRVS, PRCS, PRRS, &
+ &PRIS, PRSS, PRGS, &
+ &PTHS, ZZ_LVFACT, ZZ_LSFACT, PRHS)
+ ELSE
+ call Print_msg( NVERB_FATAL, 'GEN', 'RAIN_ICE_RED', 'no sedimentation scheme for HSEDIM='//HSEDIM )
+ END IF
+ !
+ !* 8.2 budget storage
+ !
+ if ( lbudget_rc .and. osedic ) call Budget_store_end( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
+
+ !If osedic=T and ldeposc=T, DEPO is in fact mixed and stored with the SEDI source term
+ !(a warning is printed in ini_budget in that case)
+ if ( lbudget_rc .and. ldeposc .and. .not.osedic) &
+ call Budget_store_end( tbudgets(NBUDGET_RC), 'DEPO', prcs(:, :, :) * prhodj(:, :, :) )
+
+ !sedimentation of rain fraction
+ IF (PRESENT(PRHS)) THEN
+ CALL ICE4_RAINFR_VERT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, KKT, KKL, PRAINFR, PRRS(:,:,:)*PTSTEP, &
+ &PRSS(:,:,:)*PTSTEP, PRGS(:,:,:)*PTSTEP, PRHS(:,:,:)*PTSTEP)
+ ELSE
+ CALL ICE4_RAINFR_VERT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, KKT, KKL, PRAINFR, PRRS(:,:,:)*PTSTEP, &
+ &PRSS(:,:,:)*PTSTEP, PRGS(:,:,:)*PTSTEP)
+ ENDIF
+ENDIF
+!
+!
+CONTAINS
+ !
+ SUBROUTINE CORRECT_NEGATIVITIES(KIT, KJT, KKT, KRR, PRV, PRC, PRR, &
+ &PRI, PRS, PRG, &
+ &PTH, PLVFACT, PLSFACT, PRH)
+ !
+ IMPLICIT NONE
+ !
+ INTEGER, INTENT(IN) :: KIT, KJT, KKT, KRR
+ REAL, DIMENSION(KIT, KJT, KKT), INTENT(INOUT) :: PRV, PRC, PRR, PRI, PRS, PRG, PTH
+ REAL, DIMENSION(KIT, KJT, KKT), INTENT(IN) :: PLVFACT, PLSFACT
+ REAL, DIMENSION(KIT, KJT, KKT), OPTIONAL, INTENT(INOUT) :: PRH
+ !
+ REAL, DIMENSION(KIT, KJT, KKT) :: ZW
+ INTEGER :: JI, JJ, JK
+ !
+ !
+ !We correct negativities with conservation
+ ! 1) deal with negative values for mixing ratio, except for vapor
+ DO JK = 1, KKT
+ DO JJ = 1, KJT
+ DO JI = 1, KIT
+ ZW(JI,JJ,JK) =PRC(JI,JJ,JK)-MAX(PRC(JI,JJ,JK), 0.)
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLVFACT(JI,JJ,JK)
+ PRC(JI,JJ,JK)=PRC(JI,JJ,JK)-ZW(JI,JJ,JK)
+
+ ZW(JI,JJ,JK) =PRR(JI,JJ,JK)-MAX(PRR(JI,JJ,JK), 0.)
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLVFACT(JI,JJ,JK)
+ PRR(JI,JJ,JK)=PRR(JI,JJ,JK)-ZW(JI,JJ,JK)
+
+ ZW(JI,JJ,JK) =PRI(JI,JJ,JK)-MAX(PRI(JI,JJ,JK), 0.)
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLSFACT(JI,JJ,JK)
+ PRI(JI,JJ,JK)=PRI(JI,JJ,JK)-ZW(JI,JJ,JK)
+
+ ZW(JI,JJ,JK) =PRS(JI,JJ,JK)-MAX(PRS(JI,JJ,JK), 0.)
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLSFACT(JI,JJ,JK)
+ PRS(JI,JJ,JK)=PRS(JI,JJ,JK)-ZW(JI,JJ,JK)
+
+ ZW(JI,JJ,JK) =PRG(JI,JJ,JK)-MAX(PRG(JI,JJ,JK), 0.)
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLSFACT(JI,JJ,JK)
+ PRG(JI,JJ,JK)=PRG(JI,JJ,JK)-ZW(JI,JJ,JK)
+ ENDDO
+ ENDDO
+ ENDDO
+
+ IF(KRR==7) THEN
+ DO JK = 1, KKT
+ DO JJ = 1, KJT
+ DO JI = 1, KIT
+ ZW(JI,JJ,JK) =PRH(JI,JJ,JK)-MAX(PRH(JI,JJ,JK), 0.)
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLSFACT(JI,JJ,JK)
+ PRH(JI,JJ,JK)=PRH(JI,JJ,JK)-ZW(JI,JJ,JK)
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDIF
+
+ ! 2) deal with negative vapor mixing ratio
+
+ DO JK = 1, KKT
+ DO JJ = 1, KJT
+ DO JI = 1, KIT
+ ! for rc and ri, we keep ice fraction constant
+ ZW(JI,JJ,JK)=MIN(1., MAX(XRTMIN(1)-PRV(JI,JJ,JK), 0.) / &
+ &MAX(PRC(JI,JJ,JK)+PRI(JI,JJ,JK), 1.E-20)) ! Proportion of rc+ri to convert into rv
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)* &
+ &(PRC(JI,JJ,JK)*PLVFACT(JI,JJ,JK)+PRI(JI,JJ,JK)*PLSFACT(JI,JJ,JK))
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)*(PRC(JI,JJ,JK)+PRI(JI,JJ,JK))
+ PRC(JI,JJ,JK)=(1.-ZW(JI,JJ,JK))*PRC(JI,JJ,JK)
+ PRI(JI,JJ,JK)=(1.-ZW(JI,JJ,JK))*PRI(JI,JJ,JK)
+
+ ZW(JI,JJ,JK)=MIN(MAX(PRR(JI,JJ,JK), 0.), &
+ &MAX(XRTMIN(1)-PRV(JI,JJ,JK), 0.)) ! Quantity of rr to convert into rv
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
+ PRR(JI,JJ,JK)=PRR(JI,JJ,JK)-ZW(JI,JJ,JK)
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLVFACT(JI,JJ,JK)
+
+ ZW(JI,JJ,JK)=MIN(MAX(PRS(JI,JJ,JK), 0.), &
+ &MAX(XRTMIN(1)-PRV(JI,JJ,JK), 0.)) ! Quantity of rs to convert into rv
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
+ PRS(JI,JJ,JK)=PRS(JI,JJ,JK)-ZW(JI,JJ,JK)
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLSFACT(JI,JJ,JK)
+
+ ZW(JI,JJ,JK)=MIN(MAX(PRG(JI,JJ,JK), 0.), &
+ &MAX(XRTMIN(1)-PRV(JI,JJ,JK), 0.)) ! Quantity of rg to convert into rv
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
+ PRG(JI,JJ,JK)=PRG(JI,JJ,JK)-ZW(JI,JJ,JK)
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLSFACT(JI,JJ,JK)
+ ENDDO
+ ENDDO
+ ENDDO
+
+ IF(KRR==7) THEN
+ DO JK = 1, KKT
+ DO JJ = 1, KJT
+ DO JI = 1, KIT
+ ZW(JI,JJ,JK)=MIN(MAX(PRH(JI,JJ,JK), 0.), &
+ &MAX(XRTMIN(1)-PRV(JI,JJ,JK), 0.)) ! Quantity of rh to convert into rv
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
+ PRH(JI,JJ,JK)=PRH(JI,JJ,JK)-ZW(JI,JJ,JK)
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLSFACT(JI,JJ,JK)
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDIF
+ !
+ !
+ END SUBROUTINE CORRECT_NEGATIVITIES
+
+!
+END SUBROUTINE RAIN_ICE_RED
diff --git a/src/mesonh/micro/rain_ice_sedimentation_split.f90 b/src/mesonh/micro/rain_ice_sedimentation_split.f90
new file mode 100644
index 000000000..370cc07ef
--- /dev/null
+++ b/src/mesonh/micro/rain_ice_sedimentation_split.f90
@@ -0,0 +1,617 @@
+!MNH_LIC Copyright 1995-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! Modifications:
+! P. Wautelet 25/02/2019: split rain_ice (cleaner and easier to maintain/debug)
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
+!-----------------------------------------------------------------
+MODULE MODE_RAIN_ICE_SEDIMENTATION_SPLIT
+
+ IMPLICIT NONE
+
+ PRIVATE
+
+ PUBLIC RAIN_ICE_SEDIMENTATION_SPLIT
+
+CONTAINS
+
+SUBROUTINE RAIN_ICE_SEDIMENTATION_SPLIT(KIB, KIE, KJB, KJE, KKB, KKE, KKTB, KKTE, KKT, KKL,&
+ KSPLITR,PTSTEP, &
+ KRR,OSEDIC,ODEPOSC,PINPRC,PINDEP,PINPRR,PINPRS,PINPRG,PDZZ,PRHODREF,PPABST,PTHT,PRHODJ,&
+ PINPRR3D,PRCS,PRCT,PRRS,PRRT,PRIS,PRIT,PRSS,PRST,PRGS,PRGT,PSEA,PTOWN,PINPRH,PRHS,PRHT,PFPR)
+!
+!* 0. DECLARATIONS
+! ------------
+!
+use modd_budget, only: lbudget_rc, lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, &
+ NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, &
+ tbudgets
+use MODD_CST, only: XCPD, XP00, XRD, XRHOLW
+use MODD_PARAM_ICE, only: XVDEPOSC
+use MODD_RAIN_ICE_DESCR, only: XCC, XCONC_LAND, xconc_sea, xconc_urban, XDC, XCEXVT, &
+ XALPHAC, XNUC, XALPHAC2, XNUC2, XLBEXC, XRTMIN, XLBEXC, XLBC
+use MODD_RAIN_ICE_PARAM, only: XEXSEDG, XEXSEDH, XEXCSEDI, XEXSEDR, XEXSEDS, &
+ XFSEDG, XFSEDH, XFSEDI, XFSEDR, XFSEDS, XFSEDC
+
+use mode_budget, only: Budget_store_init, Budget_store_end
+use mode_tools, only: Countjv
+
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KIB, KIE, KJB, KJE, KKB, KKE, KKTB, KKTE, KKT
+INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
+INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step
+ ! integration for rain sedimendation
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
+ ! (single if cold start)
+INTEGER, INTENT(IN) :: KRR ! Number of moist variable
+LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
+LOGICAL, INTENT(IN) :: ODEPOSC ! Switch for droplet depos.
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC ! Cloud instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINDEP ! Cloud instant deposition
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRR ! Rain instant precip
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRS ! Snow instant precip
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRG ! Graupel instant precip
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Layer thikness (m)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! absolute pressure at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PINPRR3D! Rain inst precip 3D
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRGS ! Graupel m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! Fraction that is town
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PINPRH ! Hail instant precip
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
+REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
+!
+!* 0.2 declaration of local variables
+!
+!
+INTEGER, SAVE :: IOLDALLOCC = 6000
+INTEGER, SAVE :: IOLDALLOCR = 6000
+INTEGER, SAVE :: IOLDALLOCI = 6000
+INTEGER, SAVE :: IOLDALLOCS = 6000
+INTEGER, SAVE :: IOLDALLOCG = 6000
+INTEGER, SAVE :: IOLDALLOCH = 6000
+INTEGER :: ILENALLOCC,ILENALLOCR,ILENALLOCI,ILENALLOCS,ILENALLOCG,ILENALLOCH
+INTEGER :: ILISTLENC,ILISTLENR,ILISTLENI,ILISTLENS,ILISTLENG,ILISTLENH
+INTEGER :: ISEDIMR,ISEDIMC, ISEDIMI, ISEDIMS, ISEDIMG, ISEDIMH
+INTEGER :: JK ! Vertical loop index for the rain sedimentation
+INTEGER :: JN ! Temporal loop index for the rain sedimentation
+INTEGER :: JJ ! Loop index for the interpolation
+INTEGER :: JL
+INTEGER, DIMENSION(SIZE(PRCS)) :: IC1,IC2,IC3 ! Used to replace the COUNT
+INTEGER, DIMENSION(SIZE(PRCS)) :: IR1,IR2,IR3 ! Used to replace the COUNT
+INTEGER, DIMENSION(SIZE(PRCS)) :: IS1,IS2,IS3 ! Used to replace the COUNT
+INTEGER, DIMENSION(SIZE(PRCS)) :: II1,II2,II3 ! Used to replace the COUNT
+INTEGER, DIMENSION(SIZE(PRCS)) :: IG1,IG2,IG3 ! Used to replace the COUNT
+INTEGER, DIMENSION(SIZE(PRCS)) :: IH1,IH2,IH3 ! Used to replace the COUNT
+INTEGER, DIMENSION(:), ALLOCATABLE :: ILISTR,ILISTC,ILISTI,ILISTS,ILISTG,ILISTH
+LOGICAL, DIMENSION(SIZE(PRCS,1),SIZE(PRCS,2)):: GDEP
+LOGICAL, DIMENSION(SIZE(PRCS,1),SIZE(PRCS,2),SIZE(PRCS,3)) &
+ :: GSEDIMR,GSEDIMC, GSEDIMI, GSEDIMS, GSEDIMG, GSEDIMH ! Test where to compute the SED processes
+REAL :: ZINVTSTEP
+REAL :: ZTSPLITR ! Small time step for rain sedimentation
+REAL, DIMENSION(SIZE(XRTMIN)) :: ZRTMIN
+! XRTMIN = Minimum value for the mixing ratio
+! ZRTMIN = Minimum value for the source (tendency)
+REAL, DIMENSION(:), ALLOCATABLE :: ZRCS ! Cloud water m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRRS ! Rain water m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRIS ! Pristine ice m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRSS ! Snow/aggregate m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRGS ! Graupel m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRHS ! Hail m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRHODREFC,& ! RHO Dry REFerence
+ ZRHODREFR,& ! RHO Dry REFerence
+ ZRHODREFI,& ! RHO Dry REFerence
+ ZRHODREFS,& ! RHO Dry REFerence
+ ZRHODREFG,& ! RHO Dry REFerence
+ ZRHODREFH,& ! RHO Dry REFerence
+ ZCC, & ! terminal velocity
+ ZFSEDC1D, & ! For cloud sedimentation
+ ZWLBDC, & ! Slope parameter of the droplet distribution
+ ZCONC, & ! Concentration des aerosols
+ ZRAY1D, & ! Mean radius
+ ZWLBDA, & ! Libre parcours moyen
+ ZZT, & ! Temperature
+ ZPRES ! Pressure
+REAL, DIMENSION(SIZE(PRCS,1),SIZE(PRCS,2)) &
+ :: ZCONC_TMP ! Weighted concentration
+REAL, DIMENSION(SIZE(PRCS,1),SIZE(PRCS,2),SIZE(PRCS,3)) :: ZCONC3D ! droplet condensation
+REAL, DIMENSION(SIZE(PRCS,1),SIZE(PRCS,2),SIZE(PRCS,3)) :: &
+ ZRAY, & ! Cloud Mean radius
+ ZLBC, & ! XLBC weighted by sea fraction
+ ZFSEDC
+REAL, DIMENSION(SIZE(PRCS,1),SIZE(PRCS,2),SIZE(PRCS,3)) &
+ :: ZPRCS,ZPRRS,ZPRSS,ZPRGS,ZPRHS ! Mixing ratios created during the time step
+REAL, DIMENSION(SIZE(PRCS,1),SIZE(PRCS,2),SIZE(PRCS,3)) &
+ :: ZW ! work array
+REAL, DIMENSION(SIZE(PRCS,1),SIZE(PRCS,2),0:SIZE(PRCS,3)+1) &
+ :: ZWSED ! sedimentation fluxes
+!-------------------------------------------------------------------------------
+
+if ( lbudget_rc .and. osedic ) call Budget_store_init( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
+!
+! O. Initialization of for sedimentation
+!
+ZINVTSTEP=1./PTSTEP
+ZTSPLITR= PTSTEP / REAL(KSPLITR)
+!
+IF (OSEDIC) PINPRC (:,:) = 0.
+IF (ODEPOSC) PINDEP (:,:) = 0.
+PINPRR (:,:) = 0.
+PINPRR3D (:,:,:) = 0.
+PINPRS (:,:) = 0.
+PINPRG (:,:) = 0.
+IF ( KRR == 7 ) PINPRH (:,:) = 0.
+IF (PRESENT(PFPR)) PFPR(:,:,:,:) = 0.
+!
+!* 1. Parameters for cloud sedimentation
+!
+ IF (OSEDIC) THEN
+ ZRAY(:,:,:) = 0.
+ ZLBC(:,:,:) = XLBC(1)
+ ZFSEDC(:,:,:) = XFSEDC(1)
+ ZCONC3D(:,:,:)= XCONC_LAND
+ ZCONC_TMP(:,:)= XCONC_LAND
+ IF (PRESENT(PSEA)) THEN
+ ZCONC_TMP(:,:)=PSEA(:,:)*XCONC_SEA+(1.-PSEA(:,:))*XCONC_LAND
+
+ DO JK=KKTB,KKTE
+ ZLBC(:,:,JK) = PSEA(:,:)*XLBC(2)+(1.-PSEA(:,:))*XLBC(1)
+ ZFSEDC(:,:,JK) = (PSEA(:,:)*XFSEDC(2)+(1.-PSEA(:,:))*XFSEDC(1))
+ ZFSEDC(:,:,JK) = MAX(MIN(XFSEDC(1),XFSEDC(2)),ZFSEDC(:,:,JK))
+ ZCONC3D(:,:,JK)= (1.-PTOWN(:,:))*ZCONC_TMP(:,:)+PTOWN(:,:)*XCONC_URBAN
+ ZRAY(:,:,JK) = 0.5*((1.-PSEA(:,:))*GAMMA(XNUC+1.0/XALPHAC)/(GAMMA(XNUC)) + &
+ PSEA(:,:)*GAMMA(XNUC2+1.0/XALPHAC2)/(GAMMA(XNUC2)))
+ END DO
+ ELSE
+ ZCONC3D(:,:,:) = XCONC_LAND
+ ZRAY(:,:,:) = 0.5*(GAMMA(XNUC+1.0/XALPHAC)/(GAMMA(XNUC)))
+ END IF
+ ZRAY(:,:,:) = MAX(1.,ZRAY(:,:,:))
+ ZLBC(:,:,:) = MAX(MIN(XLBC(1),XLBC(2)),ZLBC(:,:,:))
+ ENDIF
+!
+!* 2. compute the fluxes
+!
+! optimization by looking for locations where
+! the precipitating fields are larger than a minimal value only !!!
+! For optimization we consider each variable separately
+
+ZRTMIN(:) = XRTMIN(:) * ZINVTSTEP
+IF (OSEDIC) GSEDIMC(:,:,:) = .FALSE.
+GSEDIMR(:,:,:) = .FALSE.
+GSEDIMI(:,:,:) = .FALSE.
+GSEDIMS(:,:,:) = .FALSE.
+GSEDIMG(:,:,:) = .FALSE.
+IF ( KRR == 7 ) GSEDIMH(:,:,:) = .FALSE.
+!
+ILENALLOCR = 0
+IF (OSEDIC) ILENALLOCC = 0
+ILENALLOCI = 0
+ILENALLOCS = 0
+ILENALLOCG = 0
+IF ( KRR == 7 ) ILENALLOCH = 0
+!
+! ZPiS = Specie i source creating during the current time step
+! PRiS = Source of the previous time step
+!
+IF (OSEDIC) THEN
+ ZPRCS(:,:,:) = 0.0
+ ZPRCS(:,:,:) = PRCS(:,:,:)-PRCT(:,:,:)* ZINVTSTEP
+ PRCS(:,:,:) = PRCT(:,:,:)* ZINVTSTEP
+END IF
+ZPRRS(:,:,:) = 0.0
+ZPRSS(:,:,:) = 0.0
+ZPRGS(:,:,:) = 0.0
+IF ( KRR == 7 ) ZPRHS(:,:,:) = 0.0
+!
+ZPRRS(:,:,:) = PRRS(:,:,:)-PRRT(:,:,:)* ZINVTSTEP
+ZPRSS(:,:,:) = PRSS(:,:,:)-PRST(:,:,:)* ZINVTSTEP
+ZPRGS(:,:,:) = PRGS(:,:,:)-PRGT(:,:,:)* ZINVTSTEP
+IF ( KRR == 7 ) ZPRHS(:,:,:) = PRHS(:,:,:)-PRHT(:,:,:)* ZINVTSTEP
+PRRS(:,:,:) = PRRT(:,:,:)* ZINVTSTEP
+PRSS(:,:,:) = PRST(:,:,:)* ZINVTSTEP
+PRGS(:,:,:) = PRGT(:,:,:)* ZINVTSTEP
+IF ( KRR == 7 ) PRHS(:,:,:) = PRHT(:,:,:)* ZINVTSTEP
+!
+! PRiS = Source of the previous time step + source created during the subtime
+! step
+!
+DO JN = 1 , KSPLITR
+ IF( JN==1 ) THEN
+ IF (OSEDIC) PRCS(:,:,:) = PRCS(:,:,:) + ZPRCS(:,:,:)/KSPLITR
+ PRRS(:,:,:) = PRRS(:,:,:) + ZPRRS(:,:,:)/KSPLITR
+ PRSS(:,:,:) = PRSS(:,:,:) + ZPRSS(:,:,:)/KSPLITR
+ PRGS(:,:,:) = PRGS(:,:,:) + ZPRGS(:,:,:)/KSPLITR
+ IF ( KRR == 7 ) PRHS(:,:,:) = PRHS(:,:,:) + ZPRHS(:,:,:)/KSPLITR
+ DO JK = KKTB , KKTE
+ ZW(:,:,JK) =ZTSPLITR/(PRHODREF(:,:,JK)* PDZZ(:,:,JK))
+ END DO
+ ELSE
+ IF (OSEDIC) PRCS(:,:,:) = PRCS(:,:,:) + ZPRCS(:,:,:)*ZTSPLITR
+ PRRS(:,:,:) = PRRS(:,:,:) + ZPRRS(:,:,:)*ZTSPLITR
+ PRSS(:,:,:) = PRSS(:,:,:) + ZPRSS(:,:,:)*ZTSPLITR
+ PRGS(:,:,:) = PRGS(:,:,:) + ZPRGS(:,:,:)*ZTSPLITR
+ IF ( KRR == 7 ) PRHS(:,:,:) = PRHS(:,:,:) + ZPRHS(:,:,:)*ZTSPLITR
+ END IF
+ !
+ IF (OSEDIC) GSEDIMC(KIB:KIE,KJB:KJE,KKTB:KKTE) = &
+ PRCS(KIB:KIE,KJB:KJE,KKTB:KKTE)>ZRTMIN(2)
+ GSEDIMR(KIB:KIE,KJB:KJE,KKTB:KKTE) = &
+ PRRS(KIB:KIE,KJB:KJE,KKTB:KKTE)>ZRTMIN(3)
+ GSEDIMI(KIB:KIE,KJB:KJE,KKTB:KKTE) = &
+ PRIS(KIB:KIE,KJB:KJE,KKTB:KKTE)>ZRTMIN(4)
+ GSEDIMS(KIB:KIE,KJB:KJE,KKTB:KKTE) = &
+ PRSS(KIB:KIE,KJB:KJE,KKTB:KKTE)>ZRTMIN(5)
+ GSEDIMG(KIB:KIE,KJB:KJE,KKTB:KKTE) = &
+ PRGS(KIB:KIE,KJB:KJE,KKTB:KKTE)>ZRTMIN(6)
+ IF ( KRR == 7 ) GSEDIMH(KIB:KIE,KJB:KJE,KKTB:KKTE) = &
+ PRHS(KIB:KIE,KJB:KJE,KKTB:KKTE)>ZRTMIN(7)
+!
+ IF (OSEDIC) ISEDIMC = COUNTJV( GSEDIMC(:,:,:),IC1(:),IC2(:),IC3(:))
+ ISEDIMR = COUNTJV( GSEDIMR(:,:,:),IR1(:),IR2(:),IR3(:))
+ ISEDIMI = COUNTJV( GSEDIMI(:,:,:),II1(:),II2(:),II3(:))
+ ISEDIMS = COUNTJV( GSEDIMS(:,:,:),IS1(:),IS2(:),IS3(:))
+ ISEDIMG = COUNTJV( GSEDIMG(:,:,:),IG1(:),IG2(:),IG3(:))
+ IF ( KRR == 7 ) ISEDIMH = COUNTJV( GSEDIMH(:,:,:),IH1(:),IH2(:),IH3(:))
+!
+!* 2.1 for cloud
+!
+ IF (OSEDIC) THEN
+ ZWSED(:,:,:) = 0.
+ IF( JN==1 ) PRCS(:,:,:) = PRCS(:,:,:) * PTSTEP
+ IF( ISEDIMC >= 1 ) THEN
+ IF ( ISEDIMC .GT. ILENALLOCC ) THEN
+ IF ( ILENALLOCC .GT. 0 ) THEN
+ DEALLOCATE (ZRCS, ZRHODREFC, ILISTC,ZWLBDC,ZCONC,ZRCT, &
+ ZZT,ZPRES,ZRAY1D,ZFSEDC1D,ZWLBDA,ZCC )
+ END IF
+ ILENALLOCC = MAX (IOLDALLOCC, 2*ISEDIMC )
+ IOLDALLOCC = ILENALLOCC
+ ALLOCATE(ZRCS(ILENALLOCC), ZRHODREFC(ILENALLOCC), ILISTC(ILENALLOCC), &
+ ZWLBDC(ILENALLOCC), ZCONC(ILENALLOCC), ZRCT(ILENALLOCC), ZZT(ILENALLOCC), &
+ ZPRES(ILENALLOCC), ZRAY1D(ILENALLOCC), ZFSEDC1D(ILENALLOCC), &
+ ZWLBDA(ILENALLOCC), ZCC(ILENALLOCC) )
+ END IF
+!
+ DO JL=1,ISEDIMC
+ ZRCS(JL) = PRCS(IC1(JL),IC2(JL),IC3(JL))
+ ZRHODREFC(JL) = PRHODREF(IC1(JL),IC2(JL),IC3(JL))
+ ZWLBDC(JL) = ZLBC(IC1(JL),IC2(JL),IC3(JL))
+ ZCONC(JL) = ZCONC3D(IC1(JL),IC2(JL),IC3(JL))
+ ZRCT(JL) = PRCT(IC1(JL),IC2(JL),IC3(JL))
+ ZZT(JL) = PTHT(IC1(JL),IC2(JL),IC3(JL))
+ ZPRES(JL) = PPABST(IC1(JL),IC2(JL),IC3(JL))
+ ZRAY1D(JL) = ZRAY(IC1(JL),IC2(JL),IC3(JL))
+ ZFSEDC1D(JL) = ZFSEDC(IC1(JL),IC2(JL),IC3(JL))
+ END DO
+!
+ ILISTLENC = 0
+ DO JL=1,ISEDIMC
+ IF( ZRCS(JL) .GT. ZRTMIN(2) ) THEN
+ ILISTLENC = ILISTLENC + 1
+ ILISTC(ILISTLENC) = JL
+ END IF
+ END DO
+ DO JJ = 1, ILISTLENC
+ JL = ILISTC(JJ)
+ IF (ZRCS(JL) .GT. ZRTMIN(2) .AND. ZRCT(JL) .GT. XRTMIN(2)) THEN
+ ZWLBDC(JL) = ZWLBDC(JL) * ZCONC(JL) / (ZRHODREFC(JL) * ZRCT(JL))
+ ZWLBDC(JL) = ZWLBDC(JL)**XLBEXC
+ ZRAY1D(JL) = ZRAY1D(JL) / ZWLBDC(JL) !! ZRAY : mean diameter=M(1)/2
+ ZZT(JL) = ZZT(JL) * (ZPRES(JL)/XP00)**(XRD/XCPD)
+ ZWLBDA(JL) = 6.6E-8*(101325./ZPRES(JL))*(ZZT(JL)/293.15)
+ ZCC(JL) = XCC*(1.+1.26*ZWLBDA(JL)/ZRAY1D(JL)) !! XCC modified for cloud
+ ZWSED (IC1(JL),IC2(JL),IC3(JL))= ZRHODREFC(JL)**(-XCEXVT +1 ) * &
+ ZWLBDC(JL)**(-XDC)*ZCC(JL)*ZFSEDC1D(JL) * ZRCS(JL)
+ END IF
+ END DO
+ END IF
+ DO JK = KKTB , KKTE
+ PRCS(:,:,JK) = PRCS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
+ END DO
+ IF (PRESENT(PFPR)) THEN
+ DO JK = KKTB , KKTE
+ PFPR(:,:,JK,2)=ZWSED(:,:,JK)
+ ENDDO
+ ENDIF
+ PINPRC(:,:) = PINPRC(:,:) + ZWSED(:,:,KKB) / XRHOLW / KSPLITR
+ IF( JN==KSPLITR ) THEN
+ PRCS(:,:,:) = PRCS(:,:,:) * ZINVTSTEP
+ END IF
+ END IF
+!
+!* 2.2 for rain
+!
+ IF( JN==1 ) PRRS(:,:,:) = PRRS(:,:,:) * PTSTEP
+ ZWSED(:,:,:) = 0.
+ IF( ISEDIMR >= 1 ) THEN
+ IF ( ISEDIMR .GT. ILENALLOCR ) THEN
+ IF ( ILENALLOCR .GT. 0 ) THEN
+ DEALLOCATE (ZRRS, ZRHODREFR, ILISTR)
+ END IF
+ ILENALLOCR = MAX (IOLDALLOCR, 2*ISEDIMR )
+ IOLDALLOCR = ILENALLOCR
+ ALLOCATE(ZRRS(ILENALLOCR), ZRHODREFR(ILENALLOCR), ILISTR(ILENALLOCR))
+ END IF
+!
+ DO JL=1,ISEDIMR
+ ZRRS(JL) = PRRS(IR1(JL),IR2(JL),IR3(JL))
+ ZRHODREFR(JL) = PRHODREF(IR1(JL),IR2(JL),IR3(JL))
+ END DO
+!
+ ILISTLENR = 0
+ DO JL=1,ISEDIMR
+ IF( ZRRS(JL) .GT. ZRTMIN(3) ) THEN
+ ILISTLENR = ILISTLENR + 1
+ ILISTR(ILISTLENR) = JL
+ END IF
+ END DO
+ DO JJ = 1, ILISTLENR
+ JL = ILISTR(JJ)
+ ZWSED (IR1(JL),IR2(JL),IR3(JL))= XFSEDR * ZRRS(JL)**XEXSEDR * &
+ ZRHODREFR(JL)**(XEXSEDR-XCEXVT)
+ END DO
+ END IF
+ DO JK = KKTB , KKTE
+ PRRS(:,:,JK) = PRRS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
+ END DO
+ IF (PRESENT(PFPR)) THEN
+ DO JK = KKTB , KKTE
+ PFPR(:,:,JK,3)=ZWSED(:,:,JK)
+ ENDDO
+ ENDIF
+ PINPRR(:,:) = PINPRR(:,:) + ZWSED(:,:,KKB)/XRHOLW/KSPLITR
+ PINPRR3D(:,:,:) = PINPRR3D(:,:,:) + ZWSED(:,:,1:KKT)/XRHOLW/KSPLITR
+ IF( JN==KSPLITR ) THEN
+ PRRS(:,:,:) = PRRS(:,:,:) * ZINVTSTEP
+ END IF
+!
+!* 2.3 for pristine ice
+!
+ IF( JN==1 ) PRIS(:,:,:) = PRIS(:,:,:) * PTSTEP
+ ZWSED(:,:,:) = 0.
+ IF( ISEDIMI >= 1 ) THEN
+ IF ( ISEDIMI .GT. ILENALLOCI ) THEN
+ IF ( ILENALLOCI .GT. 0 ) THEN
+ DEALLOCATE (ZRIS, ZRHODREFI, ILISTI)
+ END IF
+ ILENALLOCI = MAX (IOLDALLOCI, 2*ISEDIMI )
+ IOLDALLOCI = ILENALLOCI
+ ALLOCATE(ZRIS(ILENALLOCI), ZRHODREFI(ILENALLOCI), ILISTI(ILENALLOCI))
+ END IF
+!
+ DO JL=1,ISEDIMI
+ ZRIS(JL) = PRIS(II1(JL),II2(JL),II3(JL))
+ ZRHODREFI(JL) = PRHODREF(II1(JL),II2(JL),II3(JL))
+ END DO
+!
+ ILISTLENI = 0
+ DO JL=1,ISEDIMI
+ IF( ZRIS(JL) .GT. MAX(ZRTMIN(4),1.0E-7 )) THEN ! limitation of the McF&H formula
+ ILISTLENI = ILISTLENI + 1
+ ILISTI(ILISTLENI) = JL
+ END IF
+ END DO
+ DO JJ = 1, ILISTLENI
+ JL = ILISTI(JJ)
+ ZWSED (II1(JL),II2(JL),II3(JL))= XFSEDI * ZRIS(JL) * &
+ ZRHODREFI(JL)**(1.0-XCEXVT) * & ! McF&H
+ MAX( 0.05E6,-0.15319E6-0.021454E6* &
+ ALOG(ZRHODREFI(JL)*ZRIS(JL)) )**XEXCSEDI
+ END DO
+ END IF
+ DO JK = KKTB , KKTE
+ PRIS(:,:,JK) = PRIS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
+ END DO
+ IF (PRESENT(PFPR)) THEN
+ DO JK = KKTB , KKTE
+ PFPR(:,:,JK,4)=ZWSED(:,:,JK)
+ ENDDO
+ ENDIF
+ IF( JN==KSPLITR ) THEN
+ PRIS(:,:,:) = PRIS(:,:,:) * ZINVTSTEP
+ END IF
+!
+!* 2.4 for aggregates/snow
+!
+ IF( JN==1 ) PRSS(:,:,:) = PRSS(:,:,:) * PTSTEP
+ ZWSED(:,:,:) = 0.
+ IF( ISEDIMS >= 1 ) THEN
+ IF ( ISEDIMS .GT. ILENALLOCS ) THEN
+ IF ( ILENALLOCS .GT. 0 ) THEN
+ DEALLOCATE (ZRSS, ZRHODREFS, ILISTS)
+ END IF
+ ILENALLOCS = MAX (IOLDALLOCS, 2*ISEDIMS )
+ IOLDALLOCS = ILENALLOCS
+ ALLOCATE(ZRSS(ILENALLOCS), ZRHODREFS(ILENALLOCS), ILISTS(ILENALLOCS))
+ END IF
+!
+ DO JL=1,ISEDIMS
+ ZRSS(JL) = PRSS(IS1(JL),IS2(JL),IS3(JL))
+ ZRHODREFS(JL) = PRHODREF(IS1(JL),IS2(JL),IS3(JL))
+ END DO
+!
+ ILISTLENS = 0
+ DO JL=1,ISEDIMS
+ IF( ZRSS(JL) .GT. ZRTMIN(5) ) THEN
+ ILISTLENS = ILISTLENS + 1
+ ILISTS(ILISTLENS) = JL
+ END IF
+ END DO
+ DO JJ = 1, ILISTLENS
+ JL = ILISTS(JJ)
+ ZWSED (IS1(JL),IS2(JL),IS3(JL))= XFSEDS * ZRSS(JL)**XEXSEDS * &
+ ZRHODREFS(JL)**(XEXSEDS-XCEXVT)
+ END DO
+ END IF
+ DO JK = KKTB , KKTE
+ PRSS(:,:,JK) = PRSS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
+ END DO
+ IF (PRESENT(PFPR)) THEN
+ DO JK = KKTB , KKTE
+ PFPR(:,:,JK,5)=ZWSED(:,:,JK)
+ ENDDO
+ ENDIF
+ PINPRS(:,:) = PINPRS(:,:) + ZWSED(:,:,KKB)/XRHOLW/KSPLITR
+ IF( JN==KSPLITR ) THEN
+ PRSS(:,:,:) = PRSS(:,:,:) * ZINVTSTEP
+ END IF
+!
+!* 2.5 for graupeln
+!
+ ZWSED(:,:,:) = 0.
+ IF( JN==1 ) PRGS(:,:,:) = PRGS(:,:,:) * PTSTEP
+ IF( ISEDIMG >= 1 ) THEN
+ IF ( ISEDIMG .GT. ILENALLOCG ) THEN
+ IF ( ILENALLOCG .GT. 0 ) THEN
+ DEALLOCATE (ZRGS, ZRHODREFG, ILISTG)
+ END IF
+ ILENALLOCG = MAX (IOLDALLOCG, 2*ISEDIMG )
+ IOLDALLOCG = ILENALLOCG
+ ALLOCATE(ZRGS(ILENALLOCG), ZRHODREFG(ILENALLOCG), ILISTG(ILENALLOCG))
+ END IF
+!
+ DO JL=1,ISEDIMG
+ ZRGS(JL) = PRGS(IG1(JL),IG2(JL),IG3(JL))
+ ZRHODREFG(JL) = PRHODREF(IG1(JL),IG2(JL),IG3(JL))
+ END DO
+!
+ ILISTLENG = 0
+ DO JL=1,ISEDIMG
+ IF( ZRGS(JL) .GT. ZRTMIN(6) ) THEN
+ ILISTLENG = ILISTLENG + 1
+ ILISTG(ILISTLENG) = JL
+ END IF
+ END DO
+ DO JJ = 1, ILISTLENG
+ JL = ILISTG(JJ)
+ ZWSED (IG1(JL),IG2(JL),IG3(JL))= XFSEDG * ZRGS(JL)**XEXSEDG * &
+ ZRHODREFG(JL)**(XEXSEDG-XCEXVT)
+ END DO
+END IF
+ DO JK = KKTB , KKTE
+ PRGS(:,:,JK) = PRGS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
+ END DO
+ IF (PRESENT(PFPR)) THEN
+ DO JK = KKTB , KKTE
+ PFPR(:,:,JK,6)=ZWSED(:,:,JK)
+ ENDDO
+ ENDIF
+ PINPRG(:,:) = PINPRG(:,:) + ZWSED(:,:,KKB)/XRHOLW/KSPLITR
+ IF( JN==KSPLITR ) THEN
+ PRGS(:,:,:) = PRGS(:,:,:) * ZINVTSTEP
+ END IF
+!
+!* 2.6 for hail
+!
+ IF ( KRR == 7 ) THEN
+ IF( JN==1 ) PRHS(:,:,:) = PRHS(:,:,:) * PTSTEP
+ ZWSED(:,:,:) = 0.
+ IF( ISEDIMH >= 1 ) THEN
+ IF ( ISEDIMH .GT. ILENALLOCH ) THEN
+ IF ( ILENALLOCH .GT. 0 ) THEN
+ DEALLOCATE (ZRHS, ZRHODREFH, ILISTH)
+ END IF
+ ILENALLOCH = MAX (IOLDALLOCH, 2*ISEDIMH )
+ IOLDALLOCH = ILENALLOCH
+ ALLOCATE(ZRHS(ILENALLOCH), ZRHODREFH(ILENALLOCH), ILISTH(ILENALLOCH))
+ END IF
+!
+ DO JL=1,ISEDIMH
+ ZRHS(JL) = PRHS(IH1(JL),IH2(JL),IH3(JL))
+ ZRHODREFH(JL) = PRHODREF(IH1(JL),IH2(JL),IH3(JL))
+ END DO
+!
+ ILISTLENH = 0
+ DO JL=1,ISEDIMH
+ IF( ZRHS(JL) .GT. ZRTMIN(7) ) THEN
+ ILISTLENH = ILISTLENH + 1
+ ILISTH(ILISTLENH) = JL
+ END IF
+ END DO
+ DO JJ = 1, ILISTLENH
+ JL = ILISTH(JJ)
+ ZWSED (IH1(JL),IH2(JL),IH3(JL))= XFSEDH * ZRHS(JL)**XEXSEDH * &
+ ZRHODREFH(JL)**(XEXSEDH-XCEXVT)
+ END DO
+ END IF
+ DO JK = KKTB , KKTE
+ PRHS(:,:,JK) = PRHS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
+ END DO
+ IF (PRESENT(PFPR)) THEN
+ DO JK = KKTB , KKTE
+ PFPR(:,:,JK,7)=ZWSED(:,:,JK)
+ ENDDO
+ ENDIF
+ PINPRH(:,:) = PINPRH(:,:) + ZWSED(:,:,KKB)/XRHOLW/KSPLITR
+ IF( JN==KSPLITR ) THEN
+ PRHS(:,:,:) = PRHS(:,:,:) * ZINVTSTEP
+ END IF
+ END IF
+!
+END DO
+!
+IF (OSEDIC) THEN
+ IF (ILENALLOCC .GT. 0) DEALLOCATE (ZRCS, ZRHODREFC, &
+ ILISTC,ZWLBDC,ZCONC,ZRCT, ZZT,ZPRES,ZRAY1D,ZFSEDC1D, ZWLBDA,ZCC)
+END IF
+IF (ILENALLOCR .GT. 0 ) DEALLOCATE(ZRHODREFR,ZRRS,ILISTR)
+IF (ILENALLOCI .GT. 0 ) DEALLOCATE(ZRHODREFI,ZRIS,ILISTI)
+IF (ILENALLOCS .GT. 0 ) DEALLOCATE(ZRHODREFS,ZRSS,ILISTS)
+IF (ILENALLOCG .GT. 0 ) DEALLOCATE(ZRHODREFG,ZRGS,ILISTG)
+IF (KRR == 7 .AND. (ILENALLOCH .GT. 0 )) DEALLOCATE(ZRHODREFH,ZRHS,ILISTH)
+!
+!* 2.3 budget storage
+!
+if ( lbudget_rc .and. osedic ) call Budget_store_end( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
+!
+!* 2.4 DROPLET DEPOSITION AT THE 1ST LEVEL ABOVE GROUND
+!
+IF (ODEPOSC) THEN
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'DEPO', prcs(:, :, :) * prhodj(:, :, :) )
+
+ GDEP(:,:) = .FALSE.
+ GDEP(KIB:KIE,KJB:KJE) = PRCS(KIB:KIE,KJB:KJE,KKB) >0
+ WHERE (GDEP)
+ PRCS(:,:,KKB) = PRCS(:,:,KKB) - XVDEPOSC * PRCT(:,:,KKB) / PDZZ(:,:,KKB)
+ PINPRC(:,:) = PINPRC(:,:) + XVDEPOSC * PRCT(:,:,KKB) * PRHODREF(:,:,KKB) /XRHOLW
+ PINDEP(:,:) = XVDEPOSC * PRCT(:,:,KKB) * PRHODREF(:,:,KKB) /XRHOLW
+ END WHERE
+
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'DEPO', prcs(:, :, :) * prhodj(:, :, :) )
+END IF
+
+END SUBROUTINE RAIN_ICE_SEDIMENTATION_SPLIT
+
+END MODULE MODE_RAIN_ICE_SEDIMENTATION_SPLIT
diff --git a/src/mesonh/micro/rain_ice_sedimentation_stat.f90 b/src/mesonh/micro/rain_ice_sedimentation_stat.f90
new file mode 100644
index 000000000..68eff90a2
--- /dev/null
+++ b/src/mesonh/micro/rain_ice_sedimentation_stat.f90
@@ -0,0 +1,582 @@
+!MNH_LIC Copyright 1995-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! Modifications:
+! P. Wautelet 25/02/2019: split rain_ice (cleaner and easier to maintain/debug)
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
+!-----------------------------------------------------------------
+MODULE MODE_RAIN_ICE_SEDIMENTATION_STAT
+
+ IMPLICIT NONE
+
+ PRIVATE
+
+ PUBLIC :: RAIN_ICE_SEDIMENTATION_STAT
+
+CONTAINS
+
+SUBROUTINE RAIN_ICE_SEDIMENTATION_STAT( KIB, KIE, KJB, KJE, KKB, KKE, KKTB, KKTE, KKT, KKL, KRR, &
+ PTSTEP, OSEDIC, PINPRC, PINDEP, &
+ PINPRR, PINPRS, PINPRG, PDZZ, PRHODREF, PPABST, PTHT, PRHODJ, PINPRR3D, &
+ PRCS, PRCT, PRRS, PRRT, PRIS, PRSS, PRST, PRGS, PRGT, &
+ PSEA, PTOWN, PINPRH, PRHS, PRHT, PFPR )
+!
+!* 0. DECLARATIONS
+! ------------
+!
+use modd_budget, only: lbudget_rc, lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, &
+ NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, &
+ tbudgets
+use MODD_CST, only: XRHOLW
+use MODD_PARAM_ICE, only: LDEPOSC, XVDEPOSC
+use MODD_RAIN_ICE_PARAM, only: XEXSEDG, XEXSEDH, XEXCSEDI, XEXSEDR, XEXSEDS, &
+ XFSEDC, XFSEDG, XFSEDH, XFSEDI, XFSEDR, XFSEDS
+use MODD_RAIN_ICE_DESCR, only: XALPHAC, XALPHAC2, XCC, XCEXVT, XCONC_LAND, XCONC_SEA, XCONC_URBAN, &
+ XDC, XLBC, XLBEXC, XNUC, XNUC2, XRTMIN
+
+use mode_budget, only: Budget_store_init, Budget_store_end
+use mode_tools, only: Countjv
+
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KIB, KIE, KJB, KJE, KKB, KKE, KKTB, KKTE, KKT
+INTEGER, INTENT(IN) :: KKL ! vert. levels type 1=MNH -1=ARO
+INTEGER, INTENT(IN) :: KRR ! Number of moist variable
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
+ ! (single if cold start)
+LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC ! Cloud instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINDEP ! Cloud instant deposition
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR ! Rain instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS ! Snow instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG ! Graupel instant precip
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Layer thikness (m)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! absolute pressure at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PINPRR3D! Rain inst precip 3D
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRGS ! Graupel m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! Fraction that is town
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(INOUT) :: PINPRH ! Hail instant precip
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
+REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
+!
+!* 0.2 declaration of local variables
+!
+INTEGER :: JI,JJ,JK
+INTEGER :: JCOUNT, JL
+INTEGER, DIMENSION(SIZE(PRHODREF,1)*SIZE(PRHODREF,2)) :: I1, I2
+LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2)) :: GDEP
+REAL :: ZINVTSTEP
+REAL :: ZP1,ZP2,ZH,ZZWLBDA,ZZWLBDC,ZZCC
+REAL, DIMENSION(SIZE(XRTMIN)) :: ZRTMIN
+! XRTMIN = Minimum value for the mixing ratio
+! ZRTMIN = Minimum value for the source (tendency)
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2)) :: ZQP
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2)) &
+ :: ZCONC_TMP ! Weighted concentration
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: ZPRCS,ZPRRS,ZPRSS,ZPRGS,ZPRHS ! Mixing ratios created during the time step
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: ZCONC3D ! droplet condensation
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: &
+ ZRAY, & ! Cloud Mean radius
+ ZLBC, & ! XLBC weighted by sea fraction
+ ZFSEDC
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: ZW ! work array
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),0:SIZE(PRHODREF,3)+1) &
+ :: ZWSED ! sedimentation fluxes
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),0:SIZE(PRHODREF,3)+1) &
+ :: ZWSEDW1 ! sedimentation speed
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),0:SIZE(PRHODREF,3)+1) &
+ :: ZWSEDW2 ! sedimentation speed
+!-------------------------------------------------------------------------------
+
+if ( lbudget_rc .and. osedic ) call Budget_store_init( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
+
+ZINVTSTEP=1./PTSTEP
+!
+!* 1. Parameters for cloud sedimentation
+!
+ IF (OSEDIC) THEN
+ ZRAY(:,:,:) = 0.
+ ZLBC(:,:,:) = XLBC(1)
+ ZFSEDC(:,:,:) = XFSEDC(1)
+ ZCONC3D(:,:,:)= XCONC_LAND
+ ZCONC_TMP(:,:)= XCONC_LAND
+ IF (PRESENT(PSEA)) THEN
+ ZCONC_TMP(:,:)=PSEA(:,:)*XCONC_SEA+(1.-PSEA(:,:))*XCONC_LAND
+
+ DO JK=KKTB,KKTE
+ ZLBC(:,:,JK) = PSEA(:,:)*XLBC(2)+(1.-PSEA(:,:))*XLBC(1)
+ ZFSEDC(:,:,JK) = (PSEA(:,:)*XFSEDC(2)+(1.-PSEA(:,:))*XFSEDC(1))
+ ZFSEDC(:,:,JK) = MAX(MIN(XFSEDC(1),XFSEDC(2)),ZFSEDC(:,:,JK))
+ ZCONC3D(:,:,JK)= (1.-PTOWN(:,:))*ZCONC_TMP(:,:)+PTOWN(:,:)*XCONC_URBAN
+ ZRAY(:,:,JK) = 0.5*((1.-PSEA(:,:))*GAMMA(XNUC+1.0/XALPHAC)/(GAMMA(XNUC)) + &
+ PSEA(:,:)*GAMMA(XNUC2+1.0/XALPHAC2)/(GAMMA(XNUC2)))
+ END DO
+ ELSE
+ ZCONC3D(:,:,:) = XCONC_LAND
+ ZRAY(:,:,:) = 0.5*(GAMMA(XNUC+1.0/XALPHAC)/(GAMMA(XNUC)))
+ END IF
+ ZRAY(:,:,:) = MAX(1.,ZRAY(:,:,:))
+ ZLBC(:,:,:) = MAX(MIN(XLBC(1),XLBC(2)),ZLBC(:,:,:))
+ ENDIF
+ IF (LDEPOSC) PINDEP (:,:) = 0.
+!
+!* 2. compute the fluxes
+!
+
+
+ZRTMIN(:) = XRTMIN(:) * ZINVTSTEP
+!
+IF (OSEDIC) THEN
+ ZPRCS(:,:,:) = 0.0
+ ZPRCS(:,:,:) = PRCS(:,:,:)-PRCT(:,:,:)* ZINVTSTEP
+ PRCS(:,:,:) = PRCT(:,:,:)* ZINVTSTEP
+END IF
+ZPRRS(:,:,:) = 0.0
+ZPRSS(:,:,:) = 0.0
+ZPRGS(:,:,:) = 0.0
+IF ( KRR == 7 ) ZPRHS(:,:,:) = 0.0
+!
+ZPRRS(:,:,:) = PRRS(:,:,:)-PRRT(:,:,:)* ZINVTSTEP
+ZPRSS(:,:,:) = PRSS(:,:,:)-PRST(:,:,:)* ZINVTSTEP
+ZPRGS(:,:,:) = PRGS(:,:,:)-PRGT(:,:,:)* ZINVTSTEP
+IF ( KRR == 7 ) ZPRHS(:,:,:) = PRHS(:,:,:)-PRHT(:,:,:)* ZINVTSTEP
+PRRS(:,:,:) = PRRT(:,:,:)* ZINVTSTEP
+PRSS(:,:,:) = PRST(:,:,:)* ZINVTSTEP
+PRGS(:,:,:) = PRGT(:,:,:)* ZINVTSTEP
+IF ( KRR == 7 ) PRHS(:,:,:) = PRHT(:,:,:)* ZINVTSTEP
+!
+IF (OSEDIC) PRCS(:,:,:) = PRCS(:,:,:) + ZPRCS(:,:,:)
+PRRS(:,:,:) = PRRS(:,:,:) + ZPRRS(:,:,:)
+PRSS(:,:,:) = PRSS(:,:,:) + ZPRSS(:,:,:)
+PRGS(:,:,:) = PRGS(:,:,:) + ZPRGS(:,:,:)
+IF ( KRR == 7 ) PRHS(:,:,:) = PRHS(:,:,:) + ZPRHS(:,:,:)
+IF (PRESENT(PFPR)) PFPR(:,:,:,:) = 0.
+DO JK = KKTB , KKTE
+ ZW(:,:,JK) =PTSTEP/(PRHODREF(:,:,JK)* PDZZ(:,:,JK) )
+END DO
+PINPRR3D (:,:,:) = 0.
+
+!
+!* 2.1 for cloud
+!
+ IF (OSEDIC) THEN
+ PRCS(:,:,:) = PRCS(:,:,:) * PTSTEP
+ ZWSED(:,:,:) = 0.
+ ZWSEDW1(:,:,:) = 0.
+ ZWSEDW2(:,:,:) = 0.
+
+! calculation of P1, P2 and sedimentation flux
+ DO JK = KKE , KKB, -1*KKL
+ !estimation of q' taking into account incomming ZWSED
+ ZQP(:,:)=ZWSED(:,:,JK+KKL)*ZW(:,:,JK)
+
+ JCOUNT=COUNTJV((PRCS(:,:,JK) > ZRTMIN(2) .AND. PRCT(:,:,JK) > ZRTMIN(2)) .OR. &
+ (ZQP(:,:) > ZRTMIN(2)),I1(:),I2(:))
+ DO JL=1, JCOUNT
+ JI=I1(JL)
+ JJ=I2(JL)
+ !calculation of w
+ ! mars 2009 : ajout d'un test
+ !IF ( PRCS(JI,JJ,JK) > ZRTMIN(2) ) THEN
+ IF(PRCS(JI,JJ,JK) > ZRTMIN(2) .AND. PRCT(JI,JJ,JK) > ZRTMIN(2)) THEN
+ ZZWLBDA=6.6E-8*(101325./PPABST(JI,JJ,JK))*(PTHT(JI,JJ,JK)/293.15)
+ ZZWLBDC=(ZLBC(JI,JJ,JK)*ZCONC3D(JI,JJ,JK) &
+ &/(PRHODREF(JI,JJ,JK)*PRCT(JI,JJ,JK)))**XLBEXC
+ ZZCC=XCC*(1.+1.26*ZZWLBDA*ZZWLBDC/ZRAY(JI,JJ,JK)) !! ZCC : Fall speed
+ ZWSEDW1 (JI,JJ,JK)=PRHODREF(JI,JJ,JK)**(-XCEXVT ) * &
+ & ZZWLBDC**(-XDC)*ZZCC*ZFSEDC(JI,JJ,JK)
+ ENDIF
+ IF ( ZQP(JI,JJ) > ZRTMIN(2) ) THEN
+ ZZWLBDA=6.6E-8*(101325./PPABST(JI,JJ,JK))*(PTHT(JI,JJ,JK)/293.15)
+ ZZWLBDC=(ZLBC(JI,JJ,JK)*ZCONC3D(JI,JJ,JK) &
+ &/(PRHODREF(JI,JJ,JK)*ZQP(JI,JJ)))**XLBEXC
+ ZZCC=XCC*(1.+1.26*ZZWLBDA*ZZWLBDC/ZRAY(JI,JJ,JK)) !! ZCC : Fall speed
+ ZWSEDW2 (JI,JJ,JK)=PRHODREF(JI,JJ,JK)**(-XCEXVT ) * &
+ & ZZWLBDC**(-XDC)*ZZCC*ZFSEDC(JI,JJ,JK)
+ ENDIF
+ ENDDO
+
+ DO JJ = KJB, KJE
+ DO JI = KIB, KIE
+ ZH=PDZZ(JI,JJ,JK)
+ ZP1 = MIN(1., ZWSEDW1(JI,JJ,JK) * PTSTEP / ZH)
+ ! mars 2009 : correction : ZWSEDW1 => ZWSEDW2
+ !IF (ZWSEDW1(JI,JJ,JK) /= 0.) THEN
+ IF (ZWSEDW2(JI,JJ,JK) /= 0.) THEN
+ ZP2 = MAX(0.,1 - ZH &
+ & / (PTSTEP*ZWSEDW2(JI,JJ,JK)) )
+ ELSE
+ ZP2 = 0.
+ ENDIF
+ ZWSED (JI,JJ,JK)=ZP1*PRHODREF(JI,JJ,JK)*&
+ &ZH*PRCS(JI,JJ,JK)&
+ &* ZINVTSTEP+ ZP2 * ZWSED (JI,JJ,JK+KKL)
+ ENDDO
+ ENDDO
+ ENDDO
+
+ DO JK = KKTB , KKTE
+ PRCS(:,:,JK) = PRCS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
+ END DO
+ IF (PRESENT(PFPR)) THEN
+ DO JK = KKTB , KKTE
+ PFPR(:,:,JK,2)=ZWSED(:,:,JK)
+ ENDDO
+ ENDIF
+
+ PINPRC(:,:) = ZWSED(:,:,KKB)/XRHOLW ! in m/s
+ PRCS(:,:,:) = PRCS(:,:,:) * ZINVTSTEP
+ ENDIF
+
+!
+!* 2.2 for rain
+!
+
+ PRRS(:,:,:) = PRRS(:,:,:) * PTSTEP
+ ZWSED(:,:,:) = 0.
+ ZWSEDW1(:,:,:) = 0.
+ ZWSEDW2(:,:,:) = 0.
+
+! calculation of ZP1, ZP2 and sedimentation flux
+ DO JK = KKE , KKB, -1*KKL
+ !estimation of q' taking into account incomming ZWSED
+ ZQP(:,:)=ZWSED(:,:,JK+KKL)*ZW(:,:,JK)
+
+ JCOUNT=COUNTJV((PRRS(:,:,JK) > ZRTMIN(3)) .OR. &
+ (ZQP(:,:) > ZRTMIN(3)),I1(:),I2(:))
+ DO JL=1, JCOUNT
+ JI=I1(JL)
+ JJ=I2(JL)
+ !calculation of w
+ IF ( PRRS(JI,JJ,JK) > ZRTMIN(3) ) THEN
+ ZWSEDW1 (JI,JJ,JK)= XFSEDR *PRRS(JI,JJ,JK)**(XEXSEDR-1)* &
+ PRHODREF(JI,JJ,JK)**(XEXSEDR-XCEXVT-1)
+ ENDIF
+ IF ( ZQP(JI,JJ) > ZRTMIN(3) ) THEN
+ ZWSEDW2 (JI,JJ,JK)= XFSEDR *(ZQP(JI,JJ))**(XEXSEDR-1)* &
+ PRHODREF(JI,JJ,JK)**(XEXSEDR-XCEXVT-1)
+ ENDIF
+ ENDDO
+ DO JJ = KJB, KJE
+ DO JI = KIB, KIE
+ ZH=PDZZ(JI,JJ,JK)
+ ZP1 = MIN(1., ZWSEDW1(JI,JJ,JK) * PTSTEP / ZH )
+ IF (ZWSEDW2(JI,JJ,JK) /= 0.) THEN
+ ZP2 = MAX(0.,1 - ZH &
+ & / (PTSTEP*ZWSEDW2(JI,JJ,JK)) )
+ ELSE
+ ZP2 = 0.
+ ENDIF
+ ZWSED (JI,JJ,JK)=ZP1*PRHODREF(JI,JJ,JK)*&
+ &ZH*PRRS(JI,JJ,JK)&
+ &* ZINVTSTEP+ ZP2 * ZWSED (JI,JJ,JK+KKL)
+ ENDDO
+ ENDDO
+ ENDDO
+
+ DO JK = KKTB , KKTE
+ PRRS(:,:,JK) = PRRS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
+ ENDDO
+ IF (PRESENT(PFPR)) THEN
+ DO JK = KKTB , KKTE
+ PFPR(:,:,JK,3)=ZWSED(:,:,JK)
+ ENDDO
+ ENDIF
+ PINPRR(:,:) = ZWSED(:,:,KKB)/XRHOLW ! in m/s
+ PINPRR3D(:,:,:) = ZWSED(:,:,1:KKT)/XRHOLW ! in m/s
+ PRRS(:,:,:) = PRRS(:,:,:) * ZINVTSTEP
+
+!
+!* 2.3 for pristine ice
+!
+
+ PRIS(:,:,:) = PRIS(:,:,:) * PTSTEP
+ ZWSED(:,:,:) = 0.
+ ZWSEDW1(:,:,:) = 0.
+ ZWSEDW2(:,:,:) = 0.
+! calculation of ZP1, ZP2 and sedimentation flux
+ DO JK = KKE , KKB, -1*KKL
+ !estimation of q' taking into account incomming ZWSED
+ ZQP(:,:)=ZWSED(:,:,JK+KKL)*ZW(:,:,JK)
+
+ JCOUNT=COUNTJV((PRIS(:,:,JK) > MAX(ZRTMIN(4),1.0E-7 )) .OR. &
+ (ZQP(:,:) > MAX(ZRTMIN(4),1.0E-7 )),I1(:),I2(:))
+ DO JL=1, JCOUNT
+ JI=I1(JL)
+ JJ=I2(JL)
+ !calculation of w
+ IF ( PRIS(JI,JJ,JK) > MAX(ZRTMIN(4),1.0E-7 ) ) THEN
+ ZWSEDW1 (JI,JJ,JK)= XFSEDI * &
+ & PRHODREF(JI,JJ,JK)**(XCEXVT) * & ! McF&H
+ & MAX( 0.05E6,-0.15319E6-0.021454E6* &
+ & ALOG(PRHODREF(JI,JJ,JK)*PRIS(JI,JJ,JK)) )**XEXCSEDI
+ ENDIF
+ IF ( ZQP(JI,JJ) > MAX(ZRTMIN(4),1.0E-7 ) ) THEN
+ ZWSEDW2 (JI,JJ,JK)= XFSEDI * &
+ & PRHODREF(JI,JJ,JK)**(XCEXVT) * & ! McF&H
+ & MAX( 0.05E6,-0.15319E6-0.021454E6* &
+ & ALOG(PRHODREF(JI,JJ,JK)*ZQP(JI,JJ)) )**XEXCSEDI
+ ENDIF
+ ENDDO
+ DO JJ = KJB, KJE
+ DO JI = KIB, KIE
+ ZH=PDZZ(JI,JJ,JK)
+ ZP1 = MIN(1., ZWSEDW1(JI,JJ,JK) * PTSTEP / ZH )
+ IF (ZWSEDW2(JI,JJ,JK) /= 0.) THEN
+ ZP2 = MAX(0.,1 - ZH &
+ & / (PTSTEP*ZWSEDW2(JI,JJ,JK)) )
+ ELSE
+ ZP2 = 0.
+ ENDIF
+ ZWSED (JI,JJ,JK)=ZP1*PRHODREF(JI,JJ,JK)*&
+ &ZH*PRIS(JI,JJ,JK)&
+ &* ZINVTSTEP+ ZP2 * ZWSED (JI,JJ,JK+KKL)
+ ENDDO
+ ENDDO
+ ENDDO
+
+ DO JK = KKTB , KKTE
+ PRIS(:,:,JK) = PRIS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
+ ENDDO
+ IF (PRESENT(PFPR)) THEN
+ DO JK = KKTB , KKTE
+ PFPR(:,:,JK,4)=ZWSED(:,:,JK)
+ ENDDO
+ ENDIF
+
+ PRIS(:,:,:) = PRIS(:,:,:) * ZINVTSTEP
+
+
+!
+!* 2.4 for aggregates/snow
+!
+
+ PRSS(:,:,:) = PRSS(:,:,:) * PTSTEP
+ ZWSED(:,:,:) = 0.
+ ZWSEDW1(:,:,:) = 0.
+ ZWSEDW2(:,:,:) = 0.
+
+! calculation of ZP1, ZP2 and sedimentation flux
+ DO JK = KKE , KKB, -1*KKL
+ !estimation of q' taking into account incomming ZWSED
+ ZQP(:,:)=ZWSED(:,:,JK+KKL)*ZW(:,:,JK)
+
+ JCOUNT=COUNTJV((PRSS(:,:,JK) > ZRTMIN(5)) .OR. &
+ (ZQP(:,:) > ZRTMIN(5)),I1(:),I2(:))
+ DO JL=1, JCOUNT
+ JI=I1(JL)
+ JJ=I2(JL)
+ !calculation of w
+ IF (PRSS(JI,JJ,JK) > ZRTMIN(5) ) THEN
+ ZWSEDW1(JI,JJ,JK)=XFSEDS*(PRSS(JI,JJ,JK))**(XEXSEDS-1)*&
+ PRHODREF(JI,JJ,JK)**(XEXSEDS-XCEXVT-1)
+ ENDIF
+ IF ( ZQP(JI,JJ) > ZRTMIN(5) ) THEN
+ ZWSEDW2(JI,JJ,JK)=XFSEDS*(ZQP(JI,JJ))**(XEXSEDS-1)*&
+ PRHODREF(JI,JJ,JK)**(XEXSEDS-XCEXVT-1)
+ ENDIF
+ ENDDO
+ DO JJ = KJB, KJE
+ DO JI = KIB, KIE
+ ZH=PDZZ(JI,JJ,JK)
+ ZP1 = MIN(1., ZWSEDW1(JI,JJ,JK) * PTSTEP / ZH )
+ IF (ZWSEDW2(JI,JJ,JK) /= 0.) THEN
+ ZP2 = MAX(0.,1 - ZH&
+ / (PTSTEP*ZWSEDW2(JI,JJ,JK)) )
+ ELSE
+ ZP2 = 0.
+ ENDIF
+ ZWSED (JI,JJ,JK)=ZP1*PRHODREF(JI,JJ,JK)*&
+ &ZH*PRSS(JI,JJ,JK)&
+ &* ZINVTSTEP+ ZP2 * ZWSED (JI,JJ,JK+KKL)
+ ENDDO
+ ENDDO
+ ENDDO
+
+ DO JK = KKTB , KKTE
+ PRSS(:,:,JK) = PRSS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
+ ENDDO
+ IF (PRESENT(PFPR)) THEN
+ DO JK = KKTB , KKTE
+ PFPR(:,:,JK,5)=ZWSED(:,:,JK)
+ ENDDO
+ ENDIF
+
+ PINPRS(:,:) = ZWSED(:,:,KKB)/XRHOLW ! in m/s
+
+ PRSS(:,:,:) = PRSS(:,:,:) * ZINVTSTEP
+
+
+!
+!* 2.5 for graupeln
+!
+
+ PRGS(:,:,:) = PRGS(:,:,:) * PTSTEP
+ ZWSED(:,:,:) = 0.
+ ZWSEDW1(:,:,:) = 0.
+ ZWSEDW2(:,:,:) = 0.
+
+! calculation of ZP1, ZP2 and sedimentation flux
+ DO JK = KKE, KKB, -1*KKL
+ !estimation of q' taking into account incomming ZWSED
+ ZQP(:,:)=ZWSED(:,:,JK+KKL)*ZW(:,:,JK)
+
+ JCOUNT=COUNTJV((PRGS(:,:,JK) > ZRTMIN(6)) .OR. &
+ (ZQP(:,:) > ZRTMIN(6)),I1(:),I2(:))
+ DO JL=1, JCOUNT
+ JI=I1(JL)
+ JJ=I2(JL)
+ !calculation of w
+ IF ( PRGS(JI,JJ,JK) > ZRTMIN(6) ) THEN
+ ZWSEDW1 (JI,JJ,JK)= XFSEDG*(PRGS(JI,JJ,JK))**(XEXSEDG-1) * &
+ PRHODREF(JI,JJ,JK)**(XEXSEDG-XCEXVT-1)
+ ENDIF
+ IF ( ZQP(JI,JJ) > ZRTMIN(6) ) THEN
+ ZWSEDW2 (JI,JJ,JK)= XFSEDG*(ZQP(JI,JJ))**(XEXSEDG-1) * &
+ PRHODREF(JI,JJ,JK)**(XEXSEDG-XCEXVT-1)
+ ENDIF
+ ENDDO
+ DO JJ = KJB, KJE
+ DO JI = KIB, KIE
+ ZH=PDZZ(JI,JJ,JK)
+ ZP1 = MIN(1., ZWSEDW1(JI,JJ,JK) * PTSTEP / ZH )
+ IF (ZWSEDW2(JI,JJ,JK) /= 0.) THEN
+ ZP2 = MAX(0.,1 - ZH &
+ & / (PTSTEP*ZWSEDW2(JI,JJ,JK)) )
+ ELSE
+ ZP2 = 0.
+ ENDIF
+ ZWSED (JI,JJ,JK)=ZP1*PRHODREF(JI,JJ,JK)*&
+ &ZH*PRGS(JI,JJ,JK)&
+ &* ZINVTSTEP+ ZP2 * ZWSED (JI,JJ,JK+KKL)
+ ENDDO
+ ENDDO
+ ENDDO
+
+ DO JK = KKTB , KKTE
+ PRGS(:,:,JK) = PRGS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
+ ENDDO
+ IF (PRESENT(PFPR)) THEN
+ DO JK = KKTB , KKTE
+ PFPR(:,:,JK,6)=ZWSED(:,:,JK)
+ ENDDO
+ ENDIF
+
+ PINPRG(:,:) = ZWSED(:,:,KKB)/XRHOLW ! in m/s
+
+ PRGS(:,:,:) = PRGS(:,:,:) * ZINVTSTEP
+
+!
+!* 2.6 for hail
+!
+ IF ( KRR == 7 ) THEN
+ PRHS(:,:,:) = PRHS(:,:,:) * PTSTEP
+ ZWSED(:,:,:) = 0.
+ ZWSEDW1(:,:,:) = 0.
+ ZWSEDW2(:,:,:) = 0.
+! calculation of ZP1, ZP2 and sedimentation flux
+ DO JK = KKE , KKB, -1*KKL
+ !estimation of q' taking into account incomming ZWSED
+ ZQP(:,:)=ZWSED(:,:,JK+KKL)*ZW(:,:,JK)
+
+ JCOUNT=COUNTJV((PRHS(:,:,JK)+ZQP(JI,JJ) > ZRTMIN(7)) .OR. &
+ (ZQP(:,:) > ZRTMIN(7)),I1(:),I2(:))
+ DO JL=1, JCOUNT
+ JI=I1(JL)
+ JJ=I2(JL)
+ !calculation of w
+ IF ((PRHS(JI,JJ,JK)+ZQP(JI,JJ)) > ZRTMIN(7) ) THEN
+ ZWSEDW1 (JI,JJ,JK)= XFSEDH * (PRHS(JI,JJ,JK))**(XEXSEDH-1) * &
+ PRHODREF(JI,JJ,JK)**(XEXSEDH-XCEXVT-1)
+ ENDIF
+ IF ( ZQP(JI,JJ) > ZRTMIN(7) ) THEN
+ ZWSEDW2 (JI,JJ,JK)= XFSEDH * ZQP(JI,JJ)**(XEXSEDH-1) * &
+ PRHODREF(JI,JJ,JK)**(XEXSEDH-XCEXVT-1)
+ ENDIF
+ ENDDO
+ DO JJ = KJB, KJE
+ DO JI = KIB, KIE
+ ZH=PDZZ(JI,JJ,JK)
+ ZP1 = MIN(1., ZWSEDW1(JI,JJ,JK) * PTSTEP / ZH)
+ IF (ZWSEDW2(JI,JJ,JK) /= 0.) THEN
+ ZP2 = MAX(0.,1 - ZH &
+ & / (PTSTEP*ZWSEDW2(JI,JJ,JK)) )
+ ELSE
+ ZP2 = 0.
+ ENDIF
+ ZWSED (JI,JJ,JK)=ZP1*PRHODREF(JI,JJ,JK)*&
+ &ZH*PRHS(JI,JJ,JK)&
+ &* ZINVTSTEP+ ZP2 * ZWSED (JI,JJ,JK+KKL)
+ ENDDO
+ ENDDO
+ ENDDO
+
+ DO JK = KKTB , KKTE
+ PRHS(:,:,JK) = PRHS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
+ ENDDO
+ IF (PRESENT(PFPR)) THEN
+ DO JK = KKTB , KKTE
+ PFPR(:,:,JK,7)=ZWSED(:,:,JK)
+ ENDDO
+ ENDIF
+
+ PINPRH(:,:) = ZWSED(:,:,KKB)/XRHOLW ! in m/s
+
+ PRHS(:,:,:) = PRHS(:,:,:) * ZINVTSTEP
+
+ ENDIF
+!
+!* 2.3 budget storage
+!
+if ( lbudget_rc .and. osedic ) call Budget_store_end( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
+!
+!
+!* 2.4 DROPLET DEPOSITION AT THE 1ST LEVEL ABOVE GROUND
+!
+IF (LDEPOSC) THEN
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'DEPO', prcs(:, :, :) * prhodj(:, :, :) )
+
+ GDEP(:,:) = .FALSE.
+ GDEP(KIB:KIE,KJB:KJE) = PRCS(KIB:KIE,KJB:KJE,KKB) >0
+ WHERE (GDEP)
+ PRCS(:,:,KKB) = PRCS(:,:,KKB) - XVDEPOSC * PRCT(:,:,KKB) / PDZZ(:,:,KKB)
+ PINPRC(:,:) = PINPRC(:,:) + XVDEPOSC * PRCT(:,:,KKB) * PRHODREF(:,:,KKB) /XRHOLW
+ PINDEP(:,:) = XVDEPOSC * PRCT(:,:,KKB) * PRHODREF(:,:,KKB) /XRHOLW
+ END WHERE
+
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'DEPO', prcs(:, :, :) * prhodj(:, :, :) )
+END IF
+
+END SUBROUTINE RAIN_ICE_SEDIMENTATION_STAT
+
+END MODULE MODE_RAIN_ICE_SEDIMENTATION_STAT
diff --git a/src/mesonh/micro/rain_ice_slow.f90 b/src/mesonh/micro/rain_ice_slow.f90
new file mode 100644
index 000000000..8ed0b10ac
--- /dev/null
+++ b/src/mesonh/micro/rain_ice_slow.f90
@@ -0,0 +1,225 @@
+!MNH_LIC Copyright 1995-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! Modifications:
+! P. Wautelet 25/02/2019: split rain_ice (cleaner and easier to maintain/debug)
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
+!-----------------------------------------------------------------
+MODULE MODE_RAIN_ICE_SLOW
+
+ IMPLICIT NONE
+
+ PRIVATE
+
+ PUBLIC :: RAIN_ICE_SLOW
+
+CONTAINS
+
+SUBROUTINE RAIN_ICE_SLOW(OMICRO, PINVTSTEP, PRHODREF, &
+ PRCT, PRRT, PRIT, PRST, PRGT, PRHODJ, PZT, PPRES, &
+ PLSFACT, PLVFACT, PSSI, &
+ PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, PTHS, &
+ PAI, PCJ, PKA, PDV, PLBDAS, PLBDAG)
+!
+!* 0. DECLARATIONS
+! ------------
+!
+use modd_budget, only: lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, &
+ tbudgets
+use MODD_CST, only: XALPI, XBETAI, XCI, XCPV, XGAMI, XLSTT, XMNH_HUGE_12_LOG, XP00, XRV, XTT
+use MODD_RAIN_ICE_DESCR, only: XCEXVT, XLBDAS_MAX, XLBEXG, XLBEXS, XLBG, XLBS, XRTMIN
+use MODD_RAIN_ICE_PARAM, only: X0DEPG, X0DEPS, X1DEPG, X1DEPS, XACRIAUTI, XALPHA3, XBCRIAUTI, XBETA3, XCOLEXIS, XCRIAUTI, &
+ XEX0DEPG, XEX0DEPS, XEX1DEPG, XEX1DEPS, XEXIAGGS, XFIAGGS, XHON, XSCFAC, XTEXAUTI, XTIMAUTI
+
+use mode_budget, only: Budget_store_add
+
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+LOGICAL, DIMENSION(:,:,:), intent(in) :: OMICRO ! Test where to compute all processes
+REAL, intent(in) :: PINVTSTEP
+REAL, DIMENSION(:), intent(in) :: PRHODREF ! RHO Dry REFerence
+REAL, DIMENSION(:), intent(in) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:), intent(in) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:), intent(in) :: PRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(:), intent(in) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:), intent(in) :: PRGT ! Graupel m.r. at t
+REAL, DIMENSION(:), intent(in) :: PRHODJ ! RHO times Jacobian
+REAL, DIMENSION(:), intent(in) :: PZT ! Temperature
+REAL, DIMENSION(:), intent(in) :: PPRES ! Pressure
+REAL, DIMENSION(:), intent(in) :: PLSFACT ! L_s/(Pi_ref*C_ph)
+REAL, DIMENSION(:), intent(in) :: PLVFACT ! L_v/(Pi_ref*C_ph)
+REAL, DIMENSION(:), intent(in) :: PSSI ! Supersaturation over ice
+REAL, DIMENSION(:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: PRGS ! Graupel m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:), intent(OUT) :: PAI ! Thermodynamical function
+REAL, DIMENSION(:), intent(OUT) :: PCJ ! Function to compute the ventilation coefficient
+REAL, DIMENSION(:), intent(OUT) :: PKA ! Thermal conductivity of the air
+REAL, DIMENSION(:), intent(OUT) :: PDV ! Diffusivity of water vapor in the air
+REAL, DIMENSION(:), intent(OUT) :: PLBDAS ! Slope parameter of the aggregate distribution
+REAL, DIMENSION(:), intent(OUT) :: PLBDAG ! Slope parameter of the graupel distribution
+!
+!* 0.2 declaration of local variables
+!
+REAL, DIMENSION(size(PRHODREF)) :: ZZW ! Work array
+REAL, DIMENSION(size(PRHODREF)) :: ZCRIAUTI ! Snow-to-ice autoconversion thres.
+real, dimension(size(plsfact)) :: zz_diff
+!
+!-------------------------------------------------------------------------------
+ zz_diff(:) = plsfact(:) - plvfact(:)
+!
+!
+!* 3.2 compute the homogeneous nucleation source: RCHONI
+!
+ ZZW(:) = 0.0
+ WHERE( (PZT(:)<XTT-35.0) .AND. (PRCT(:)>XRTMIN(2)) .AND. (PRCS(:)>0.) )
+ ZZW(:) = MIN( PRCS(:),XHON*PRHODREF(:)*PRCT(:) &
+ *EXP( MIN(XMNH_HUGE_12_LOG,XALPHA3*(PZT(:)-XTT)-XBETA3) ) )
+ ! *EXP( XALPHA3*(PZT(:)-XTT)-XBETA3 ) )
+ PRIS(:) = PRIS(:) + ZZW(:)
+ PRCS(:) = PRCS(:) - ZZW(:)
+ PTHS(:) = PTHS(:) + ZZW(:) * zz_diff(:) ! f(L_f*(RCHONI))
+ ENDWHERE
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HON', &
+ Unpack( zzw(:) * zz_diff(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'HON', &
+ Unpack( -zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HON', &
+ Unpack( zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
+!
+!* 3.3 compute the spontaneous freezing source: RRHONG
+!
+ ZZW(:) = 0.0
+ WHERE( (PZT(:)<XTT-35.0) .AND. (PRRT(:)>XRTMIN(3)) .AND. (PRRS(:)>0.) )
+ ZZW(:) = MIN( PRRS(:),PRRT(:)* PINVTSTEP )
+ PRGS(:) = PRGS(:) + ZZW(:)
+ PRRS(:) = PRRS(:) - ZZW(:)
+ PTHS(:) = PTHS(:) + ZZW(:) * zz_diff(:) ! f(L_f*(RRHONG))
+ ENDWHERE
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'SFR', &
+ Unpack( zzw(:) * zz_diff(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'SFR', &
+ Unpack( -zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'SFR', &
+ Unpack( zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
+!
+!* 3.4 compute the deposition, aggregation and autoconversion sources
+!
+ PKA(:) = 2.38E-2 + 0.0071E-2 * ( PZT(:) - XTT ) ! k_a
+ PDV(:) = 0.211E-4 * (PZT(:)/XTT)**1.94 * (XP00/PPRES(:)) ! D_v
+!
+!* 3.4.1 compute the thermodynamical function A_i(T,P)
+!* and the c^prime_j (in the ventilation factor)
+!
+
+ PAI(:) = EXP( XALPI - XBETAI/PZT(:) - XGAMI*ALOG(PZT(:) ) ) ! es_i
+ PAI(:) = ( XLSTT + (XCPV-XCI)*(PZT(:)-XTT) )**2 / (PKA(:)*XRV*PZT(:)**2) &
+ + ( XRV*PZT(:) ) / (PDV(:)*PAI(:))
+ PCJ(:) = XSCFAC * PRHODREF(:)**0.3 / SQRT( 1.718E-5+0.0049E-5*(PZT(:)-XTT) )
+!
+!* 3.4.2 compute the riming-conversion of r_c for r_i production: RCAUTI
+!
+! ZZW(:) = 0.0
+! ZTIMAUTIC = SQRT( XTIMAUTI*XTIMAUTC )
+! WHERE ( (PRCT(:)>0.0) .AND. (PRIT(:)>0.0) .AND. (PRCS(:)>0.0) )
+! ZZW(:) = MIN( PRCS(:),ZTIMAUTIC * MAX( SQRT( PRIT(:)*PRCT(:) ),0.0 ) )
+! PRIS(:) = PRIS(:) + ZZW(:)
+! PRCS(:) = PRCS(:) - ZZW(:)
+! PTHS(:) = PTHS(:) + ZZW(:) * zz_diff(:) ! f(L_f*(RCAUTI))
+! END WHERE
+!
+!* 3.4.3 compute the deposition on r_s: RVDEPS
+!
+ WHERE ( PRST(:)>0.0 )
+ PLBDAS(:) = MIN( XLBDAS_MAX, &
+ XLBS*( PRHODREF(:)*MAX( PRST(:),XRTMIN(5) ) )**XLBEXS )
+ END WHERE
+ ZZW(:) = 0.0
+ WHERE ( (PRST(:)>XRTMIN(5)) .AND. (PRSS(:)>0.0) )
+ ZZW(:) = ( PSSI(:)/(PRHODREF(:)*PAI(:)) ) * &
+ ( X0DEPS*PLBDAS(:)**XEX0DEPS + X1DEPS*PCJ(:)*PLBDAS(:)**XEX1DEPS )
+ ZZW(:) = MIN( PRVS(:),ZZW(:) )*(0.5+SIGN(0.5,ZZW(:))) &
+ - MIN( PRSS(:),ABS(ZZW(:)) )*(0.5-SIGN(0.5,ZZW(:)))
+ PRSS(:) = PRSS(:) + ZZW(:)
+ PRVS(:) = PRVS(:) - ZZW(:)
+ PTHS(:) = PTHS(:) + ZZW(:)*PLSFACT(:)
+ END WHERE
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'DEPS', &
+ Unpack( zzw(:) * plsfact(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
+ if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'DEPS', &
+ Unpack( -zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'DEPS', &
+ Unpack( zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
+!
+!* 3.4.4 compute the aggregation on r_s: RIAGGS
+!
+ ZZW(:) = 0.0
+ WHERE ( (PRIT(:)>XRTMIN(4)) .AND. (PRST(:)>XRTMIN(5)) .AND. (PRIS(:)>0.0) )
+ ZZW(:) = MIN( PRIS(:),XFIAGGS * EXP( XCOLEXIS*(PZT(:)-XTT) ) &
+ * PRIT(:) &
+ * PLBDAS(:)**XEXIAGGS &
+ * PRHODREF(:)**(-XCEXVT) )
+ PRSS(:) = PRSS(:) + ZZW(:)
+ PRIS(:) = PRIS(:) - ZZW(:)
+ END WHERE
+
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'AGGS', &
+ Unpack( -zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'AGGS', &
+ Unpack( zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
+!
+!* 3.4.5 compute the autoconversion of r_i for r_s production: RIAUTS
+!
+! ZCRIAUTI(:)=MIN(XCRIAUTI,10**(0.06*(PZT(:)-XTT)-3.5))
+ ZCRIAUTI(:)=MIN(XCRIAUTI,10**(XACRIAUTI*(PZT(:)-XTT)+XBCRIAUTI))
+ ZZW(:) = 0.0
+ WHERE ( (PRIT(:)>XRTMIN(4)) .AND. (PRIS(:)>0.0) )
+ ZZW(:) = MIN( PRIS(:),XTIMAUTI * EXP( XTEXAUTI*(PZT(:)-XTT) ) &
+ * MAX( PRIT(:)-ZCRIAUTI(:),0.0 ) )
+ PRSS(:) = PRSS(:) + ZZW(:)
+ PRIS(:) = PRIS(:) - ZZW(:)
+ END WHERE
+
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'AUTS', &
+ Unpack( -zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'AUTS', &
+ Unpack( zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
+!
+!* 3.4.6 compute the deposition on r_g: RVDEPG
+!
+!
+ WHERE ( PRGT(:)>0.0 )
+ PLBDAG(:) = XLBG*( PRHODREF(:)*MAX( PRGT(:),XRTMIN(6) ) )**XLBEXG
+ END WHERE
+ ZZW(:) = 0.0
+ WHERE ( (PRGT(:)>XRTMIN(6)) .AND. (PRGS(:)>0.0) )
+ ZZW(:) = ( PSSI(:)/(PRHODREF(:)*PAI(:)) ) * &
+ ( X0DEPG*PLBDAG(:)**XEX0DEPG + X1DEPG*PCJ(:)*PLBDAG(:)**XEX1DEPG )
+ ZZW(:) = MIN( PRVS(:),ZZW(:) )*(0.5+SIGN(0.5,ZZW(:))) &
+ - MIN( PRGS(:),ABS(ZZW(:)) )*(0.5-SIGN(0.5,ZZW(:)))
+ PRGS(:) = PRGS(:) + ZZW(:)
+ PRVS(:) = PRVS(:) - ZZW(:)
+ PTHS(:) = PTHS(:) + ZZW(:)*PLSFACT(:)
+ END WHERE
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'DEPG', &
+ Unpack( zzw(:) * plsfact(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
+ if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'DEPG', &
+ Unpack( -zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'DEPG', &
+ Unpack( zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
+END SUBROUTINE RAIN_ICE_SLOW
+
+END MODULE MODE_RAIN_ICE_SLOW
diff --git a/src/mesonh/micro/rain_ice_warm.f90 b/src/mesonh/micro/rain_ice_warm.f90
new file mode 100644
index 000000000..133dc888b
--- /dev/null
+++ b/src/mesonh/micro/rain_ice_warm.f90
@@ -0,0 +1,235 @@
+!MNH_LIC Copyright 1995-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! Modifications:
+! P. Wautelet 25/02/2019: split rain_ice (cleaner and easier to maintain/debug)
+! P. Wautelet 03/06/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
+!-----------------------------------------------------------------
+MODULE MODE_RAIN_ICE_WARM
+
+ IMPLICIT NONE
+
+ PRIVATE
+
+ PUBLIC :: RAIN_ICE_WARM
+
+CONTAINS
+
+SUBROUTINE RAIN_ICE_WARM(OMICRO, KMICRO, K1, K2, K3, &
+ PRHODREF, PRVT, PRCT, PRRT, PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, &
+ PRHODJ, PPRES, PZT, PLBDAR, PLBDAR_RF, PLVFACT, PCJ, PKA, PDV, PRF, PCF, PTHT, PTHLT, &
+ PRVS, PRCS, PRRS, PTHS, PUSW, PEVAP3D)
+!
+!* 0. DECLARATIONS
+! ------------
+!
+use modd_budget, only: lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, &
+ tbudgets
+use MODD_CST, only: XALPW, XBETAW, XCL, XCPV, XGAMW, XLVTT, XMD, XMV, XRV, XTT
+use MODD_PARAM_ICE, only: CSUBG_RC_RR_ACCR, CSUBG_RR_EVAP
+use MODD_RAIN_ICE_DESCR, only: XCEXVT, XRTMIN
+use MODD_RAIN_ICE_PARAM, only: X0EVAR, X1EVAR, XCRIAUTC, XEX0EVAR, XEX1EVAR, XEXCACCR, XFCACCR, XTIMAUTC
+
+use mode_budget, only: Budget_store_add
+use MODE_MSG
+
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+LOGICAL, DIMENSION(:,:,:), intent(in) :: OMICRO ! Test where to compute all processes
+INTEGER, intent(in) :: KMICRO
+INTEGER, DIMENSION(:), intent(in) :: K1
+INTEGER, DIMENSION(:), intent(in) :: K2
+INTEGER, DIMENSION(:), intent(in) :: K3
+REAL, DIMENSION(:), intent(in) :: PRHODREF ! RHO Dry REFerence
+REAL, DIMENSION(:), intent(in) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:), intent(in) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:), intent(in) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:), intent(in) :: PHLC_HCF ! HLCLOUDS : fraction of High Cloud Fraction in grid
+REAL, DIMENSION(:), intent(in) :: PHLC_LCF ! HLCLOUDS : fraction of Low Cloud Fraction in grid
+REAL, DIMENSION(:), intent(in) :: PHLC_HRC ! HLCLOUDS : LWC that is High LWC in grid
+REAL, DIMENSION(:), intent(in) :: PHLC_LRC ! HLCLOUDS : LWC that is Low LWC in grid
+REAL, DIMENSION(:), intent(in) :: PRHODJ ! RHO times Jacobian
+REAL, DIMENSION(:), intent(in) :: PPRES ! Pressure
+REAL, DIMENSION(:), intent(in) :: PZT ! Temperature
+REAL, DIMENSION(:), intent(in) :: PLBDAR ! Slope parameter of the raindrop distribution
+REAL, DIMENSION(:), intent(in) :: PLBDAR_RF! Slope parameter of the raindrop distribution
+ ! for the Rain Fraction part
+REAL, DIMENSION(:), intent(in) :: PLVFACT ! L_v/(Pi_ref*C_ph)
+REAL, DIMENSION(:), intent(in) :: PCJ ! Function to compute the ventilation coefficient
+REAL, DIMENSION(:), intent(in) :: PKA ! Thermal conductivity of the air
+REAL, DIMENSION(:), intent(in) :: PDV ! Diffusivity of water vapor in the air
+REAL, DIMENSION(:), intent(in) :: PRF ! Rain fraction
+REAL, DIMENSION(:), intent(in) :: PCF ! Cloud fraction
+REAL, DIMENSION(:), intent(in) :: PTHT ! Potential temperature
+REAL, DIMENSION(:), intent(in) :: PTHLT ! Liquid potential temperature
+REAL, DIMENSION(:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: PTHS ! Theta source
+!PW: PUSW could be a purely local variable?
+REAL, DIMENSION(:), INTENT(INOUT) :: PUSW ! Undersaturation over water
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D ! Rain evap profile
+!
+!* 0.2 declaration of local variables
+!
+INTEGER :: JL
+REAL, DIMENSION(size(PRHODREF)) :: ZZW ! Work array
+REAL, DIMENSION(size(PRHODREF)) :: ZZW2 ! Work array
+REAL, DIMENSION(size(PRHODREF)) :: ZZW3 ! Work array
+REAL, DIMENSION(size(PRHODREF)) :: ZZW4 ! Work array
+!
+!-------------------------------------------------------------------------------
+!
+!* 4.2 compute the autoconversion of r_c for r_r production: RCAUTR
+!
+ zzw(:) = 0.
+ WHERE( PRCS(:)>0.0 .AND. PHLC_HCF(:).GT.0.0 )
+ ZZW(:) = XTIMAUTC*MAX( PHLC_HRC(:)/PHLC_HCF(:) - XCRIAUTC/PRHODREF(:),0.0)
+ ZZW(:) = MIN( PRCS(:),PHLC_HCF(:)*ZZW(:))
+ PRCS(:) = PRCS(:) - ZZW(:)
+ PRRS(:) = PRRS(:) + ZZW(:)
+ END WHERE
+
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'AUTO', &
+ Unpack( -zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'AUTO', &
+ Unpack( zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
+!
+!* 4.3 compute the accretion of r_c for r_r production: RCACCR
+!
+ zzw(:) = 0.
+ IF (CSUBG_RC_RR_ACCR=='NONE') THEN
+ !CLoud water and rain are diluted over the grid box
+ WHERE( PRCT(:)>XRTMIN(2) .AND. PRRT(:)>XRTMIN(3) .AND. PRCS(:)>0.0 )
+ ZZW(:) = MIN( PRCS(:), XFCACCR * PRCT(:) &
+ * PLBDAR(:)**XEXCACCR &
+ * PRHODREF(:)**(-XCEXVT) )
+ PRCS(:) = PRCS(:) - ZZW(:)
+ PRRS(:) = PRRS(:) + ZZW(:)
+ END WHERE
+
+ ELSEIF (CSUBG_RC_RR_ACCR=='PRFR') THEN
+ !Cloud water is concentrated over its fraction with possibly to parts with high and low content as set for autoconversion
+ !Rain is concnetrated over its fraction
+ !Rain in high content area fraction: PHLC_HCF
+ !Rain in low content area fraction:
+ ! if PRF<PCF (rain is entirely falling in cloud): PRF-PHLC_HCF
+ ! if PRF>PCF (rain is falling in cloud and in clear sky): PCF-PHLC_HCF
+ ! => min(PCF, PRF)-PHLC_HCF
+ WHERE( PHLC_HRC(:)>XRTMIN(2) .AND. PRRT(:)>XRTMIN(3) .AND. PRCS(:)>0.0 &
+ .AND. PHLC_HCF(:)>0 )
+ !Accretion due to rain falling in high cloud content
+ ZZW(:) = XFCACCR * ( PHLC_HRC(:)/PHLC_HCF(:) ) &
+ * PLBDAR_RF(:)**XEXCACCR &
+ * PRHODREF(:)**(-XCEXVT) &
+ * PHLC_HCF
+ END WHERE
+ WHERE( PHLC_LRC(:)>XRTMIN(2) .AND. PRRT(:)>XRTMIN(3) .AND. PRCS(:)>0.0 &
+ .AND. PHLC_LCF(:)>0 )
+ !We add acrretion due to rain falling in low cloud content
+ ZZW(:) = ZZW(:) + XFCACCR * ( PHLC_LRC(:)/PHLC_LCF(:) ) &
+ * PLBDAR_RF(:)**XEXCACCR &
+ * PRHODREF(:)**(-XCEXVT) &
+ * (MIN(PCF(:), PRF(:))-PHLC_HCF(:))
+ END WHERE
+ ZZW(:)=MIN(PRCS(:), ZZW(:))
+ PRCS(:) = PRCS(:) - ZZW(:)
+ PRRS(:) = PRRS(:) + ZZW(:)
+
+ ELSE
+ call Print_msg( NVERB_FATAL, 'GEN', 'RAIN_ICE_WARM', 'invalid CSUBG_RC_RR_ACCR value: '//Trim(csubg_rc_rr_accr) )
+ ENDIF
+
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'ACCR', &
+ Unpack( -zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'ACCR', &
+ Unpack( zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
+!
+!* 4.4 compute the evaporation of r_r: RREVAV
+!
+ ZZW(:) = 0.0
+
+ IF (CSUBG_RR_EVAP=='NONE') THEN
+ !Evaporation only when there's no cloud (RC must be 0)
+ WHERE( (PRRT(:)>XRTMIN(3)) .AND. (PRCT(:)<=XRTMIN(2)) )
+ ZZW(:) = EXP( XALPW - XBETAW/PZT(:) - XGAMW*ALOG(PZT(:) ) ) ! es_w
+ PUSW(:) = 1.0 - PRVT(:)*( PPRES(:)-ZZW(:) ) / ( (XMV/XMD) * ZZW(:) )
+ ! Undersaturation over water
+ ZZW(:) = ( XLVTT+(XCPV-XCL)*(PZT(:)-XTT) )**2 / ( PKA(:)*XRV*PZT(:)**2 ) &
+ + ( XRV*PZT(:) ) / ( PDV(:)*ZZW(:) )
+ ZZW(:) = MIN( PRRS(:),( MAX( 0.0,PUSW(:) )/(PRHODREF(:)*ZZW(:)) ) * &
+ ( X0EVAR*PLBDAR(:)**XEX0EVAR+X1EVAR*PCJ(:)*PLBDAR(:)**XEX1EVAR ) )
+ PRRS(:) = PRRS(:) - ZZW(:)
+ PRVS(:) = PRVS(:) + ZZW(:)
+ PTHS(:) = PTHS(:) - ZZW(:)*PLVFACT(:)
+ END WHERE
+
+ ELSEIF (CSUBG_RR_EVAP=='CLFR' .OR. CSUBG_RR_EVAP=='PRFR') THEN
+ !Evaporation in clear sky part
+ !With CLFR, rain is diluted over the grid box
+ !With PRFR, rain is concentrated in its fraction
+ !Use temperature and humidity in clear sky part like Bechtold et al. (1993)
+ IF (CSUBG_RR_EVAP=='CLFR') THEN
+ ZZW4(:)=1. !Precipitation fraction
+ ZZW3(:)=PLBDAR(:)
+ ELSE
+ ZZW4(:)=PRF(:) !Precipitation fraction
+ ZZW3(:)=PLBDAR_RF(:)
+ ENDIF
+
+ !ATTENTION
+ !Il faudrait recalculer les variables PKA, PDV, PCJ en tenant compte de la température T^u
+ !Ces variables devraient être sorties de rain_ice_slow et on mettrait le calcul de T^u, T^s
+ !et plusieurs versions (comme actuellement, en ciel clair, en ciel nuageux) de PKA, PDV, PCJ dans rain_ice
+ !On utiliserait la bonne version suivant l'option NONE, CLFR... dans l'évaporation et ailleurs
+
+ WHERE( (PRRT(:)>XRTMIN(3)) .AND. ( ZZW4(:) > PCF(:) ) )
+ ! outside the cloud (environment) the use of T^u (unsaturated) instead of T
+ ! Bechtold et al. 1993
+ !
+ ! T^u = T_l = theta_l * (T/theta)
+ ZZW2(:) = PTHLT(:) * PZT(:) / PTHT(:)
+ !
+ ! es_w with new T^u
+ ZZW(:) = EXP( XALPW - XBETAW/ZZW2(:) - XGAMW*ALOG(ZZW2(:) ) )
+ !
+ ! S, Undersaturation over water (with new theta^u)
+ PUSW(:) = 1.0 - PRVT(:)*( PPRES(:)-ZZW(:) ) / ( (XMV/XMD) * ZZW(:) )
+ !
+ ZZW(:) = ( XLVTT+(XCPV-XCL)*(ZZW2(:)-XTT) )**2 / ( PKA(:)*XRV*ZZW2(:)**2 ) &
+ + ( XRV*ZZW2(:) ) / ( PDV(:)*ZZW(:) )
+ !
+ ZZW(:) = MAX( 0.0,PUSW(:) )/(PRHODREF(:)*ZZW(:)) * &
+ ( X0EVAR*ZZW3(:)**XEX0EVAR+X1EVAR*PCJ(:)*ZZW3(:)**XEX1EVAR )
+ !
+ ZZW(:) = MIN( PRRS(:), ZZW(:) *( ZZW4(:) - PCF(:) ) )
+ !
+ PRRS(:) = PRRS(:) - ZZW(:)
+ PRVS(:) = PRVS(:) + ZZW(:)
+ PTHS(:) = PTHS(:) - ZZW(:)*PLVFACT(:)
+ END WHERE
+
+ ELSE
+ call Print_msg( NVERB_FATAL, 'GEN', 'RAIN_ICE_WARM', 'invalid CSUBG_RR_EVAP value: '//Trim( csubg_rr_evap ) )
+ END IF
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'REVA', &
+ Unpack( -zzw(:) * plvfact(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
+ if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'REVA', &
+ Unpack( zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'REVA', &
+ Unpack( -zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
+
+ DO JL = 1, KMICRO
+ PEVAP3D(K1(JL), K2(JL), K3(JL)) = ZZW( JL )
+ END DO
+!
+ END SUBROUTINE RAIN_ICE_WARM
+
+END MODULE MODE_RAIN_ICE_WARM
diff --git a/src/mesonh/micro/read_xker_gweth.f90 b/src/mesonh/micro/read_xker_gweth.f90
new file mode 100644
index 000000000..c8f3fe40d
--- /dev/null
+++ b/src/mesonh/micro/read_xker_gweth.f90
@@ -0,0 +1,1737 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 microph 2006/05/18 13:07:25
+!-----------------------------------------------------------------
+! ###########################
+ MODULE MODI_READ_XKER_GWETH
+! ###########################
+!
+INTERFACE
+ SUBROUTINE READ_XKER_GWETH (KWETLBDAH,KWETLBDAG,KND, &
+ PALPHAH,PNUH,PALPHAG,PNUG,PEHG,PBG,PCH,PDH,PCG,PDG, &
+ PWETLBDAH_MAX,PWETLBDAG_MAX,PWETLBDAH_MIN,PWETLBDAG_MIN, &
+ PFDINFTY,PKER_GWETH )
+!
+INTEGER, INTENT(OUT) :: KND,KWETLBDAH,KWETLBDAG
+REAL, INTENT(OUT) :: PALPHAH
+REAL, INTENT(OUT) :: PNUH
+REAL, INTENT(OUT) :: PALPHAG
+REAL, INTENT(OUT) :: PNUG
+REAL, INTENT(OUT) :: PEHG
+REAL, INTENT(OUT) :: PBG
+REAL, INTENT(OUT) :: PCH
+REAL, INTENT(OUT) :: PDH
+REAL, INTENT(OUT) :: PCG
+REAL, INTENT(OUT) :: PDG
+REAL, INTENT(OUT) :: PWETLBDAH_MAX
+REAL, INTENT(OUT) :: PWETLBDAG_MAX
+REAL, INTENT(OUT) :: PWETLBDAH_MIN
+REAL, INTENT(OUT) :: PWETLBDAG_MIN
+REAL, INTENT(OUT) :: PFDINFTY
+REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_GWETH
+!
+END SUBROUTINE
+!
+END INTERFACE
+!
+END MODULE MODI_READ_XKER_GWETH
+! ########################################################################
+ SUBROUTINE READ_XKER_GWETH (KWETLBDAH,KWETLBDAG,KND, &
+ PALPHAH,PNUH,PALPHAG,PNUG,PEHG,PBG,PCH,PDH,PCG,PDG, &
+ PWETLBDAH_MAX,PWETLBDAG_MAX,PWETLBDAH_MIN,PWETLBDAG_MIN, &
+ PFDINFTY,PKER_GWETH )
+! ########################################################################
+!
+!!**** * * - initialize the kernels for the graupel-hail wet growth process
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to initialize the kernels PKER_GWETH
+!! prepared from a previous run of the routine INI_RAIN_ICE. The reading
+!! of the kernels is optional after checking for the dimensions of the
+!! arrays.
+!!
+!!** METHOD
+!! ------
+!!
+!!
+!! EXTERNAL
+!! --------
+!! None
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation ( routine READ_XKER_GWETH )
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 19/04/97
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!* 0.2 Declarations of local variables :
+!
+!
+INTEGER, INTENT(OUT) :: KND,KWETLBDAH,KWETLBDAG
+REAL, INTENT(OUT) :: PALPHAH
+REAL, INTENT(OUT) :: PNUH
+REAL, INTENT(OUT) :: PALPHAG
+REAL, INTENT(OUT) :: PNUG
+REAL, INTENT(OUT) :: PEHG
+REAL, INTENT(OUT) :: PBG
+REAL, INTENT(OUT) :: PCH
+REAL, INTENT(OUT) :: PDH
+REAL, INTENT(OUT) :: PCG
+REAL, INTENT(OUT) :: PDG
+REAL, INTENT(OUT) :: PWETLBDAH_MAX
+REAL, INTENT(OUT) :: PWETLBDAG_MAX
+REAL, INTENT(OUT) :: PWETLBDAH_MIN
+REAL, INTENT(OUT) :: PWETLBDAG_MIN
+REAL, INTENT(OUT) :: PFDINFTY
+REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_GWETH
+!
+! ########################################################################
+! #INSERT HERE THE OUTPUT OF INI_RAIN_ICE_HAIL IF THE KERNELS ARE UPDATED#
+! ########################################################################
+!
+KND= 50
+KWETLBDAH= 40
+KWETLBDAG= 40
+PALPHAH= 0.100000E+01
+PNUH= 0.800000E+01
+PALPHAG= 0.100000E+01
+PNUG= 0.100000E+01
+PEHG= 0.100000E+01
+PBG= 0.280000E+01
+PCH= 0.207000E+03
+PDH= 0.640000E+00
+PCG= 0.124000E+03
+PDG= 0.660000E+00
+PWETLBDAH_MAX= 0.100000E+08
+PWETLBDAG_MAX= 0.100000E+08
+PWETLBDAH_MIN= 0.100000E+04
+PWETLBDAG_MIN= 0.100000E+04
+PFDINFTY= 0.200000E+02
+!
+IF( PRESENT(PKER_GWETH) ) THEN
+ PKER_GWETH( 1, 1) = 0.687148E+01
+ PKER_GWETH( 1, 2) = 0.747813E+01
+ PKER_GWETH( 1, 3) = 0.798959E+01
+ PKER_GWETH( 1, 4) = 0.841881E+01
+ PKER_GWETH( 1, 5) = 0.877841E+01
+ PKER_GWETH( 1, 6) = 0.907960E+01
+ PKER_GWETH( 1, 7) = 0.933201E+01
+ PKER_GWETH( 1, 8) = 0.954375E+01
+ PKER_GWETH( 1, 9) = 0.972162E+01
+ PKER_GWETH( 1, 10) = 0.987126E+01
+ PKER_GWETH( 1, 11) = 0.999733E+01
+ PKER_GWETH( 1, 12) = 0.101037E+02
+ PKER_GWETH( 1, 13) = 0.101936E+02
+ PKER_GWETH( 1, 14) = 0.102696E+02
+ PKER_GWETH( 1, 15) = 0.103340E+02
+ PKER_GWETH( 1, 16) = 0.103886E+02
+ PKER_GWETH( 1, 17) = 0.104350E+02
+ PKER_GWETH( 1, 18) = 0.104743E+02
+ PKER_GWETH( 1, 19) = 0.105077E+02
+ PKER_GWETH( 1, 20) = 0.105362E+02
+ PKER_GWETH( 1, 21) = 0.105604E+02
+ PKER_GWETH( 1, 22) = 0.105810E+02
+ PKER_GWETH( 1, 23) = 0.105985E+02
+ PKER_GWETH( 1, 24) = 0.106135E+02
+ PKER_GWETH( 1, 25) = 0.106262E+02
+ PKER_GWETH( 1, 26) = 0.106371E+02
+ PKER_GWETH( 1, 27) = 0.106464E+02
+ PKER_GWETH( 1, 28) = 0.106543E+02
+ PKER_GWETH( 1, 29) = 0.106610E+02
+ PKER_GWETH( 1, 30) = 0.106668E+02
+ PKER_GWETH( 1, 31) = 0.106717E+02
+ PKER_GWETH( 1, 32) = 0.106759E+02
+ PKER_GWETH( 1, 33) = 0.106795E+02
+ PKER_GWETH( 1, 34) = 0.106825E+02
+ PKER_GWETH( 1, 35) = 0.106851E+02
+ PKER_GWETH( 1, 36) = 0.106874E+02
+ PKER_GWETH( 1, 37) = 0.106893E+02
+ PKER_GWETH( 1, 38) = 0.106909E+02
+ PKER_GWETH( 1, 39) = 0.106923E+02
+ PKER_GWETH( 1, 40) = 0.106935E+02
+ PKER_GWETH( 2, 1) = 0.531200E+01
+ PKER_GWETH( 2, 2) = 0.592117E+01
+ PKER_GWETH( 2, 3) = 0.644064E+01
+ PKER_GWETH( 2, 4) = 0.687856E+01
+ PKER_GWETH( 2, 5) = 0.724606E+01
+ PKER_GWETH( 2, 6) = 0.755396E+01
+ PKER_GWETH( 2, 7) = 0.781184E+01
+ PKER_GWETH( 2, 8) = 0.802795E+01
+ PKER_GWETH( 2, 9) = 0.820924E+01
+ PKER_GWETH( 2, 10) = 0.836153E+01
+ PKER_GWETH( 2, 11) = 0.848964E+01
+ PKER_GWETH( 2, 12) = 0.859758E+01
+ PKER_GWETH( 2, 13) = 0.868865E+01
+ PKER_GWETH( 2, 14) = 0.876559E+01
+ PKER_GWETH( 2, 15) = 0.883069E+01
+ PKER_GWETH( 2, 16) = 0.888581E+01
+ PKER_GWETH( 2, 17) = 0.893255E+01
+ PKER_GWETH( 2, 18) = 0.897221E+01
+ PKER_GWETH( 2, 19) = 0.900589E+01
+ PKER_GWETH( 2, 20) = 0.903451E+01
+ PKER_GWETH( 2, 21) = 0.905885E+01
+ PKER_GWETH( 2, 22) = 0.907956E+01
+ PKER_GWETH( 2, 23) = 0.909719E+01
+ PKER_GWETH( 2, 24) = 0.911221E+01
+ PKER_GWETH( 2, 25) = 0.912500E+01
+ PKER_GWETH( 2, 26) = 0.913591E+01
+ PKER_GWETH( 2, 27) = 0.914521E+01
+ PKER_GWETH( 2, 28) = 0.915314E+01
+ PKER_GWETH( 2, 29) = 0.915990E+01
+ PKER_GWETH( 2, 30) = 0.916568E+01
+ PKER_GWETH( 2, 31) = 0.917060E+01
+ PKER_GWETH( 2, 32) = 0.917481E+01
+ PKER_GWETH( 2, 33) = 0.917840E+01
+ PKER_GWETH( 2, 34) = 0.918147E+01
+ PKER_GWETH( 2, 35) = 0.918409E+01
+ PKER_GWETH( 2, 36) = 0.918633E+01
+ PKER_GWETH( 2, 37) = 0.918824E+01
+ PKER_GWETH( 2, 38) = 0.918987E+01
+ PKER_GWETH( 2, 39) = 0.919127E+01
+ PKER_GWETH( 2, 40) = 0.919246E+01
+ PKER_GWETH( 3, 1) = 0.398480E+01
+ PKER_GWETH( 3, 2) = 0.458041E+01
+ PKER_GWETH( 3, 3) = 0.510220E+01
+ PKER_GWETH( 3, 4) = 0.554702E+01
+ PKER_GWETH( 3, 5) = 0.592198E+01
+ PKER_GWETH( 3, 6) = 0.623664E+01
+ PKER_GWETH( 3, 7) = 0.650027E+01
+ PKER_GWETH( 3, 8) = 0.672107E+01
+ PKER_GWETH( 3, 9) = 0.690610E+01
+ PKER_GWETH( 3, 10) = 0.706132E+01
+ PKER_GWETH( 3, 11) = 0.719170E+01
+ PKER_GWETH( 3, 12) = 0.730139E+01
+ PKER_GWETH( 3, 13) = 0.739379E+01
+ PKER_GWETH( 3, 14) = 0.747176E+01
+ PKER_GWETH( 3, 15) = 0.753763E+01
+ PKER_GWETH( 3, 16) = 0.759335E+01
+ PKER_GWETH( 3, 17) = 0.764054E+01
+ PKER_GWETH( 3, 18) = 0.768055E+01
+ PKER_GWETH( 3, 19) = 0.771450E+01
+ PKER_GWETH( 3, 20) = 0.774332E+01
+ PKER_GWETH( 3, 21) = 0.776782E+01
+ PKER_GWETH( 3, 22) = 0.778866E+01
+ PKER_GWETH( 3, 23) = 0.780638E+01
+ PKER_GWETH( 3, 24) = 0.782147E+01
+ PKER_GWETH( 3, 25) = 0.783433E+01
+ PKER_GWETH( 3, 26) = 0.784528E+01
+ PKER_GWETH( 3, 27) = 0.785461E+01
+ PKER_GWETH( 3, 28) = 0.786257E+01
+ PKER_GWETH( 3, 29) = 0.786935E+01
+ PKER_GWETH( 3, 30) = 0.787514E+01
+ PKER_GWETH( 3, 31) = 0.788008E+01
+ PKER_GWETH( 3, 32) = 0.788430E+01
+ PKER_GWETH( 3, 33) = 0.788790E+01
+ PKER_GWETH( 3, 34) = 0.789098E+01
+ PKER_GWETH( 3, 35) = 0.789360E+01
+ PKER_GWETH( 3, 36) = 0.789584E+01
+ PKER_GWETH( 3, 37) = 0.789776E+01
+ PKER_GWETH( 3, 38) = 0.789939E+01
+ PKER_GWETH( 3, 39) = 0.790079E+01
+ PKER_GWETH( 3, 40) = 0.790199E+01
+ PKER_GWETH( 4, 1) = 0.288960E+01
+ PKER_GWETH( 4, 2) = 0.343887E+01
+ PKER_GWETH( 4, 3) = 0.394949E+01
+ PKER_GWETH( 4, 4) = 0.439644E+01
+ PKER_GWETH( 4, 5) = 0.477733E+01
+ PKER_GWETH( 4, 6) = 0.509838E+01
+ PKER_GWETH( 4, 7) = 0.536780E+01
+ PKER_GWETH( 4, 8) = 0.559352E+01
+ PKER_GWETH( 4, 9) = 0.578258E+01
+ PKER_GWETH( 4, 10) = 0.594100E+01
+ PKER_GWETH( 4, 11) = 0.607390E+01
+ PKER_GWETH( 4, 12) = 0.618553E+01
+ PKER_GWETH( 4, 13) = 0.627943E+01
+ PKER_GWETH( 4, 14) = 0.635854E+01
+ PKER_GWETH( 4, 15) = 0.642529E+01
+ PKER_GWETH( 4, 16) = 0.648168E+01
+ PKER_GWETH( 4, 17) = 0.652938E+01
+ PKER_GWETH( 4, 18) = 0.656978E+01
+ PKER_GWETH( 4, 19) = 0.660403E+01
+ PKER_GWETH( 4, 20) = 0.663308E+01
+ PKER_GWETH( 4, 21) = 0.665776E+01
+ PKER_GWETH( 4, 22) = 0.667873E+01
+ PKER_GWETH( 4, 23) = 0.669656E+01
+ PKER_GWETH( 4, 24) = 0.671173E+01
+ PKER_GWETH( 4, 25) = 0.672465E+01
+ PKER_GWETH( 4, 26) = 0.673565E+01
+ PKER_GWETH( 4, 27) = 0.674502E+01
+ PKER_GWETH( 4, 28) = 0.675301E+01
+ PKER_GWETH( 4, 29) = 0.675982E+01
+ PKER_GWETH( 4, 30) = 0.676563E+01
+ PKER_GWETH( 4, 31) = 0.677058E+01
+ PKER_GWETH( 4, 32) = 0.677481E+01
+ PKER_GWETH( 4, 33) = 0.677842E+01
+ PKER_GWETH( 4, 34) = 0.678150E+01
+ PKER_GWETH( 4, 35) = 0.678413E+01
+ PKER_GWETH( 4, 36) = 0.678638E+01
+ PKER_GWETH( 4, 37) = 0.678830E+01
+ PKER_GWETH( 4, 38) = 0.678994E+01
+ PKER_GWETH( 4, 39) = 0.679134E+01
+ PKER_GWETH( 4, 40) = 0.679253E+01
+ PKER_GWETH( 5, 1) = 0.204551E+01
+ PKER_GWETH( 5, 2) = 0.249578E+01
+ PKER_GWETH( 5, 3) = 0.296766E+01
+ PKER_GWETH( 5, 4) = 0.340540E+01
+ PKER_GWETH( 5, 5) = 0.378824E+01
+ PKER_GWETH( 5, 6) = 0.411440E+01
+ PKER_GWETH( 5, 7) = 0.438929E+01
+ PKER_GWETH( 5, 8) = 0.461997E+01
+ PKER_GWETH( 5, 9) = 0.481324E+01
+ PKER_GWETH( 5, 10) = 0.497511E+01
+ PKER_GWETH( 5, 11) = 0.511076E+01
+ PKER_GWETH( 5, 12) = 0.522454E+01
+ PKER_GWETH( 5, 13) = 0.532011E+01
+ PKER_GWETH( 5, 14) = 0.540051E+01
+ PKER_GWETH( 5, 15) = 0.546824E+01
+ PKER_GWETH( 5, 16) = 0.552538E+01
+ PKER_GWETH( 5, 17) = 0.557366E+01
+ PKER_GWETH( 5, 18) = 0.561449E+01
+ PKER_GWETH( 5, 19) = 0.564907E+01
+ PKER_GWETH( 5, 20) = 0.567839E+01
+ PKER_GWETH( 5, 21) = 0.570326E+01
+ PKER_GWETH( 5, 22) = 0.572438E+01
+ PKER_GWETH( 5, 23) = 0.574233E+01
+ PKER_GWETH( 5, 24) = 0.575759E+01
+ PKER_GWETH( 5, 25) = 0.577058E+01
+ PKER_GWETH( 5, 26) = 0.578163E+01
+ PKER_GWETH( 5, 27) = 0.579105E+01
+ PKER_GWETH( 5, 28) = 0.579907E+01
+ PKER_GWETH( 5, 29) = 0.580591E+01
+ PKER_GWETH( 5, 30) = 0.581173E+01
+ PKER_GWETH( 5, 31) = 0.581671E+01
+ PKER_GWETH( 5, 32) = 0.582095E+01
+ PKER_GWETH( 5, 33) = 0.582457E+01
+ PKER_GWETH( 5, 34) = 0.582765E+01
+ PKER_GWETH( 5, 35) = 0.583029E+01
+ PKER_GWETH( 5, 36) = 0.583254E+01
+ PKER_GWETH( 5, 37) = 0.583446E+01
+ PKER_GWETH( 5, 38) = 0.583611E+01
+ PKER_GWETH( 5, 39) = 0.583751E+01
+ PKER_GWETH( 5, 40) = 0.583871E+01
+ PKER_GWETH( 6, 1) = 0.147885E+01
+ PKER_GWETH( 6, 2) = 0.176736E+01
+ PKER_GWETH( 6, 3) = 0.215562E+01
+ PKER_GWETH( 6, 4) = 0.256096E+01
+ PKER_GWETH( 6, 5) = 0.293621E+01
+ PKER_GWETH( 6, 6) = 0.326413E+01
+ PKER_GWETH( 6, 7) = 0.354342E+01
+ PKER_GWETH( 6, 8) = 0.377879E+01
+ PKER_GWETH( 6, 9) = 0.397630E+01
+ PKER_GWETH( 6, 10) = 0.414178E+01
+ PKER_GWETH( 6, 11) = 0.428038E+01
+ PKER_GWETH( 6, 12) = 0.439652E+01
+ PKER_GWETH( 6, 13) = 0.449394E+01
+ PKER_GWETH( 6, 14) = 0.457577E+01
+ PKER_GWETH( 6, 15) = 0.464460E+01
+ PKER_GWETH( 6, 16) = 0.470259E+01
+ PKER_GWETH( 6, 17) = 0.475151E+01
+ PKER_GWETH( 6, 18) = 0.479283E+01
+ PKER_GWETH( 6, 19) = 0.482779E+01
+ PKER_GWETH( 6, 20) = 0.485739E+01
+ PKER_GWETH( 6, 21) = 0.488249E+01
+ PKER_GWETH( 6, 22) = 0.490378E+01
+ PKER_GWETH( 6, 23) = 0.492186E+01
+ PKER_GWETH( 6, 24) = 0.493722E+01
+ PKER_GWETH( 6, 25) = 0.495028E+01
+ PKER_GWETH( 6, 26) = 0.496140E+01
+ PKER_GWETH( 6, 27) = 0.497086E+01
+ PKER_GWETH( 6, 28) = 0.497892E+01
+ PKER_GWETH( 6, 29) = 0.498578E+01
+ PKER_GWETH( 6, 30) = 0.499163E+01
+ PKER_GWETH( 6, 31) = 0.499662E+01
+ PKER_GWETH( 6, 32) = 0.500088E+01
+ PKER_GWETH( 6, 33) = 0.500450E+01
+ PKER_GWETH( 6, 34) = 0.500760E+01
+ PKER_GWETH( 6, 35) = 0.501024E+01
+ PKER_GWETH( 6, 36) = 0.501250E+01
+ PKER_GWETH( 6, 37) = 0.501443E+01
+ PKER_GWETH( 6, 38) = 0.501607E+01
+ PKER_GWETH( 6, 39) = 0.501748E+01
+ PKER_GWETH( 6, 40) = 0.501868E+01
+ PKER_GWETH( 7, 1) = 0.119724E+01
+ PKER_GWETH( 7, 2) = 0.127547E+01
+ PKER_GWETH( 7, 3) = 0.152697E+01
+ PKER_GWETH( 7, 4) = 0.186178E+01
+ PKER_GWETH( 7, 5) = 0.220994E+01
+ PKER_GWETH( 7, 6) = 0.253163E+01
+ PKER_GWETH( 7, 7) = 0.281250E+01
+ PKER_GWETH( 7, 8) = 0.305164E+01
+ PKER_GWETH( 7, 9) = 0.325317E+01
+ PKER_GWETH( 7, 10) = 0.342229E+01
+ PKER_GWETH( 7, 11) = 0.356398E+01
+ PKER_GWETH( 7, 12) = 0.368265E+01
+ PKER_GWETH( 7, 13) = 0.378209E+01
+ PKER_GWETH( 7, 14) = 0.386550E+01
+ PKER_GWETH( 7, 15) = 0.393556E+01
+ PKER_GWETH( 7, 16) = 0.399449E+01
+ PKER_GWETH( 7, 17) = 0.404413E+01
+ PKER_GWETH( 7, 18) = 0.408601E+01
+ PKER_GWETH( 7, 19) = 0.412139E+01
+ PKER_GWETH( 7, 20) = 0.415132E+01
+ PKER_GWETH( 7, 21) = 0.417666E+01
+ PKER_GWETH( 7, 22) = 0.419814E+01
+ PKER_GWETH( 7, 23) = 0.421636E+01
+ PKER_GWETH( 7, 24) = 0.423184E+01
+ PKER_GWETH( 7, 25) = 0.424499E+01
+ PKER_GWETH( 7, 26) = 0.425617E+01
+ PKER_GWETH( 7, 27) = 0.426568E+01
+ PKER_GWETH( 7, 28) = 0.427378E+01
+ PKER_GWETH( 7, 29) = 0.428068E+01
+ PKER_GWETH( 7, 30) = 0.428655E+01
+ PKER_GWETH( 7, 31) = 0.429156E+01
+ PKER_GWETH( 7, 32) = 0.429583E+01
+ PKER_GWETH( 7, 33) = 0.429947E+01
+ PKER_GWETH( 7, 34) = 0.430258E+01
+ PKER_GWETH( 7, 35) = 0.430523E+01
+ PKER_GWETH( 7, 36) = 0.430749E+01
+ PKER_GWETH( 7, 37) = 0.430942E+01
+ PKER_GWETH( 7, 38) = 0.431107E+01
+ PKER_GWETH( 7, 39) = 0.431248E+01
+ PKER_GWETH( 7, 40) = 0.431368E+01
+ PKER_GWETH( 8, 1) = 0.116924E+01
+ PKER_GWETH( 8, 2) = 0.102801E+01
+ PKER_GWETH( 8, 3) = 0.110019E+01
+ PKER_GWETH( 8, 4) = 0.131921E+01
+ PKER_GWETH( 8, 5) = 0.160796E+01
+ PKER_GWETH( 8, 6) = 0.190699E+01
+ PKER_GWETH( 8, 7) = 0.218275E+01
+ PKER_GWETH( 8, 8) = 0.242331E+01
+ PKER_GWETH( 8, 9) = 0.262809E+01
+ PKER_GWETH( 8, 10) = 0.280064E+01
+ PKER_GWETH( 8, 11) = 0.294545E+01
+ PKER_GWETH( 8, 12) = 0.306676E+01
+ PKER_GWETH( 8, 13) = 0.316837E+01
+ PKER_GWETH( 8, 14) = 0.325351E+01
+ PKER_GWETH( 8, 15) = 0.332493E+01
+ PKER_GWETH( 8, 16) = 0.338491E+01
+ PKER_GWETH( 8, 17) = 0.343537E+01
+ PKER_GWETH( 8, 18) = 0.347787E+01
+ PKER_GWETH( 8, 19) = 0.351372E+01
+ PKER_GWETH( 8, 20) = 0.354401E+01
+ PKER_GWETH( 8, 21) = 0.356963E+01
+ PKER_GWETH( 8, 22) = 0.359132E+01
+ PKER_GWETH( 8, 23) = 0.360971E+01
+ PKER_GWETH( 8, 24) = 0.362531E+01
+ PKER_GWETH( 8, 25) = 0.363856E+01
+ PKER_GWETH( 8, 26) = 0.364981E+01
+ PKER_GWETH( 8, 27) = 0.365938E+01
+ PKER_GWETH( 8, 28) = 0.366752E+01
+ PKER_GWETH( 8, 29) = 0.367446E+01
+ PKER_GWETH( 8, 30) = 0.368036E+01
+ PKER_GWETH( 8, 31) = 0.368539E+01
+ PKER_GWETH( 8, 32) = 0.368967E+01
+ PKER_GWETH( 8, 33) = 0.369333E+01
+ PKER_GWETH( 8, 34) = 0.369644E+01
+ PKER_GWETH( 8, 35) = 0.369910E+01
+ PKER_GWETH( 8, 36) = 0.370137E+01
+ PKER_GWETH( 8, 37) = 0.370330E+01
+ PKER_GWETH( 8, 38) = 0.370496E+01
+ PKER_GWETH( 8, 39) = 0.370637E+01
+ PKER_GWETH( 8, 40) = 0.370757E+01
+ PKER_GWETH( 9, 1) = 0.132655E+01
+ PKER_GWETH( 9, 2) = 0.998897E+00
+ PKER_GWETH( 9, 3) = 0.882830E+00
+ PKER_GWETH( 9, 4) = 0.949046E+00
+ PKER_GWETH( 9, 5) = 0.113967E+01
+ PKER_GWETH( 9, 6) = 0.138873E+01
+ PKER_GWETH( 9, 7) = 0.164554E+01
+ PKER_GWETH( 9, 8) = 0.188191E+01
+ PKER_GWETH( 9, 9) = 0.208795E+01
+ PKER_GWETH( 9, 10) = 0.226330E+01
+ PKER_GWETH( 9, 11) = 0.241104E+01
+ PKER_GWETH( 9, 12) = 0.253503E+01
+ PKER_GWETH( 9, 13) = 0.263890E+01
+ PKER_GWETH( 9, 14) = 0.272590E+01
+ PKER_GWETH( 9, 15) = 0.279880E+01
+ PKER_GWETH( 9, 16) = 0.285995E+01
+ PKER_GWETH( 9, 17) = 0.291131E+01
+ PKER_GWETH( 9, 18) = 0.295450E+01
+ PKER_GWETH( 9, 19) = 0.299089E+01
+ PKER_GWETH( 9, 20) = 0.302159E+01
+ PKER_GWETH( 9, 21) = 0.304751E+01
+ PKER_GWETH( 9, 22) = 0.306944E+01
+ PKER_GWETH( 9, 23) = 0.308801E+01
+ PKER_GWETH( 9, 24) = 0.310375E+01
+ PKER_GWETH( 9, 25) = 0.311711E+01
+ PKER_GWETH( 9, 26) = 0.312845E+01
+ PKER_GWETH( 9, 27) = 0.313808E+01
+ PKER_GWETH( 9, 28) = 0.314627E+01
+ PKER_GWETH( 9, 29) = 0.315324E+01
+ PKER_GWETH( 9, 30) = 0.315917E+01
+ PKER_GWETH( 9, 31) = 0.316423E+01
+ PKER_GWETH( 9, 32) = 0.316853E+01
+ PKER_GWETH( 9, 33) = 0.317220E+01
+ PKER_GWETH( 9, 34) = 0.317532E+01
+ PKER_GWETH( 9, 35) = 0.317799E+01
+ PKER_GWETH( 9, 36) = 0.318027E+01
+ PKER_GWETH( 9, 37) = 0.318221E+01
+ PKER_GWETH( 9, 38) = 0.318386E+01
+ PKER_GWETH( 9, 39) = 0.318528E+01
+ PKER_GWETH( 9, 40) = 0.318648E+01
+ PKER_GWETH( 10, 1) = 0.158836E+01
+ PKER_GWETH( 10, 2) = 0.112991E+01
+ PKER_GWETH( 10, 3) = 0.853387E+00
+ PKER_GWETH( 10, 4) = 0.758257E+00
+ PKER_GWETH( 10, 5) = 0.818751E+00
+ PKER_GWETH( 10, 6) = 0.984521E+00
+ PKER_GWETH( 10, 7) = 0.119936E+01
+ PKER_GWETH( 10, 8) = 0.141989E+01
+ PKER_GWETH( 10, 9) = 0.162250E+01
+ PKER_GWETH( 10, 10) = 0.179897E+01
+ PKER_GWETH( 10, 11) = 0.194912E+01
+ PKER_GWETH( 10, 12) = 0.207563E+01
+ PKER_GWETH( 10, 13) = 0.218178E+01
+ PKER_GWETH( 10, 14) = 0.227073E+01
+ PKER_GWETH( 10, 15) = 0.234522E+01
+ PKER_GWETH( 10, 16) = 0.240764E+01
+ PKER_GWETH( 10, 17) = 0.245999E+01
+ PKER_GWETH( 10, 18) = 0.250396E+01
+ PKER_GWETH( 10, 19) = 0.254094E+01
+ PKER_GWETH( 10, 20) = 0.257210E+01
+ PKER_GWETH( 10, 21) = 0.259837E+01
+ PKER_GWETH( 10, 22) = 0.262057E+01
+ PKER_GWETH( 10, 23) = 0.263934E+01
+ PKER_GWETH( 10, 24) = 0.265524E+01
+ PKER_GWETH( 10, 25) = 0.266871E+01
+ PKER_GWETH( 10, 26) = 0.268015E+01
+ PKER_GWETH( 10, 27) = 0.268985E+01
+ PKER_GWETH( 10, 28) = 0.269810E+01
+ PKER_GWETH( 10, 29) = 0.270511E+01
+ PKER_GWETH( 10, 30) = 0.271107E+01
+ PKER_GWETH( 10, 31) = 0.271615E+01
+ PKER_GWETH( 10, 32) = 0.272048E+01
+ PKER_GWETH( 10, 33) = 0.272416E+01
+ PKER_GWETH( 10, 34) = 0.272730E+01
+ PKER_GWETH( 10, 35) = 0.272997E+01
+ PKER_GWETH( 10, 36) = 0.273226E+01
+ PKER_GWETH( 10, 37) = 0.273420E+01
+ PKER_GWETH( 10, 38) = 0.273586E+01
+ PKER_GWETH( 10, 39) = 0.273728E+01
+ PKER_GWETH( 10, 40) = 0.273849E+01
+ PKER_GWETH( 11, 1) = 0.188694E+01
+ PKER_GWETH( 11, 2) = 0.135228E+01
+ PKER_GWETH( 11, 3) = 0.962427E+00
+ PKER_GWETH( 11, 4) = 0.729069E+00
+ PKER_GWETH( 11, 5) = 0.651362E+00
+ PKER_GWETH( 11, 6) = 0.706379E+00
+ PKER_GWETH( 11, 7) = 0.850482E+00
+ PKER_GWETH( 11, 8) = 0.103579E+01
+ PKER_GWETH( 11, 9) = 0.122516E+01
+ PKER_GWETH( 11, 10) = 0.139882E+01
+ PKER_GWETH( 11, 11) = 0.154997E+01
+ PKER_GWETH( 11, 12) = 0.167854E+01
+ PKER_GWETH( 11, 13) = 0.178685E+01
+ PKER_GWETH( 11, 14) = 0.187775E+01
+ PKER_GWETH( 11, 15) = 0.195391E+01
+ PKER_GWETH( 11, 16) = 0.201769E+01
+ PKER_GWETH( 11, 17) = 0.207113E+01
+ PKER_GWETH( 11, 18) = 0.211596E+01
+ PKER_GWETH( 11, 19) = 0.215360E+01
+ PKER_GWETH( 11, 20) = 0.218527E+01
+ PKER_GWETH( 11, 21) = 0.221194E+01
+ PKER_GWETH( 11, 22) = 0.223444E+01
+ PKER_GWETH( 11, 23) = 0.225344E+01
+ PKER_GWETH( 11, 24) = 0.226951E+01
+ PKER_GWETH( 11, 25) = 0.228312E+01
+ PKER_GWETH( 11, 26) = 0.229465E+01
+ PKER_GWETH( 11, 27) = 0.230444E+01
+ PKER_GWETH( 11, 28) = 0.231274E+01
+ PKER_GWETH( 11, 29) = 0.231980E+01
+ PKER_GWETH( 11, 30) = 0.232580E+01
+ PKER_GWETH( 11, 31) = 0.233091E+01
+ PKER_GWETH( 11, 32) = 0.233526E+01
+ PKER_GWETH( 11, 33) = 0.233896E+01
+ PKER_GWETH( 11, 34) = 0.234211E+01
+ PKER_GWETH( 11, 35) = 0.234479E+01
+ PKER_GWETH( 11, 36) = 0.234709E+01
+ PKER_GWETH( 11, 37) = 0.234904E+01
+ PKER_GWETH( 11, 38) = 0.235070E+01
+ PKER_GWETH( 11, 39) = 0.235213E+01
+ PKER_GWETH( 11, 40) = 0.235334E+01
+ PKER_GWETH( 12, 1) = 0.217933E+01
+ PKER_GWETH( 12, 2) = 0.160747E+01
+ PKER_GWETH( 12, 3) = 0.115129E+01
+ PKER_GWETH( 12, 4) = 0.819805E+00
+ PKER_GWETH( 12, 5) = 0.622854E+00
+ PKER_GWETH( 12, 6) = 0.559616E+00
+ PKER_GWETH( 12, 7) = 0.609490E+00
+ PKER_GWETH( 12, 8) = 0.734782E+00
+ PKER_GWETH( 12, 9) = 0.894511E+00
+ PKER_GWETH( 12, 10) = 0.105711E+01
+ PKER_GWETH( 12, 11) = 0.120596E+01
+ PKER_GWETH( 12, 12) = 0.133541E+01
+ PKER_GWETH( 12, 13) = 0.144550E+01
+ PKER_GWETH( 12, 14) = 0.153825E+01
+ PKER_GWETH( 12, 15) = 0.161608E+01
+ PKER_GWETH( 12, 16) = 0.168128E+01
+ PKER_GWETH( 12, 17) = 0.173589E+01
+ PKER_GWETH( 12, 18) = 0.178165E+01
+ PKER_GWETH( 12, 19) = 0.182003E+01
+ PKER_GWETH( 12, 20) = 0.185227E+01
+ PKER_GWETH( 12, 21) = 0.187938E+01
+ PKER_GWETH( 12, 22) = 0.190221E+01
+ PKER_GWETH( 12, 23) = 0.192147E+01
+ PKER_GWETH( 12, 24) = 0.193774E+01
+ PKER_GWETH( 12, 25) = 0.195150E+01
+ PKER_GWETH( 12, 26) = 0.196315E+01
+ PKER_GWETH( 12, 27) = 0.197302E+01
+ PKER_GWETH( 12, 28) = 0.198139E+01
+ PKER_GWETH( 12, 29) = 0.198850E+01
+ PKER_GWETH( 12, 30) = 0.199455E+01
+ PKER_GWETH( 12, 31) = 0.199968E+01
+ PKER_GWETH( 12, 32) = 0.200405E+01
+ PKER_GWETH( 12, 33) = 0.200777E+01
+ PKER_GWETH( 12, 34) = 0.201094E+01
+ PKER_GWETH( 12, 35) = 0.201364E+01
+ PKER_GWETH( 12, 36) = 0.201594E+01
+ PKER_GWETH( 12, 37) = 0.201790E+01
+ PKER_GWETH( 12, 38) = 0.201957E+01
+ PKER_GWETH( 12, 39) = 0.202100E+01
+ PKER_GWETH( 12, 40) = 0.202221E+01
+ PKER_GWETH( 13, 1) = 0.244503E+01
+ PKER_GWETH( 13, 2) = 0.185806E+01
+ PKER_GWETH( 13, 3) = 0.136933E+01
+ PKER_GWETH( 13, 4) = 0.980154E+00
+ PKER_GWETH( 13, 5) = 0.698393E+00
+ PKER_GWETH( 13, 6) = 0.532193E+00
+ PKER_GWETH( 13, 7) = 0.480863E+00
+ PKER_GWETH( 13, 8) = 0.525928E+00
+ PKER_GWETH( 13, 9) = 0.634867E+00
+ PKER_GWETH( 13, 10) = 0.772493E+00
+ PKER_GWETH( 13, 11) = 0.912096E+00
+ PKER_GWETH( 13, 12) = 0.103966E+01
+ PKER_GWETH( 13, 13) = 0.115054E+01
+ PKER_GWETH( 13, 14) = 0.124481E+01
+ PKER_GWETH( 13, 15) = 0.132422E+01
+ PKER_GWETH( 13, 16) = 0.139086E+01
+ PKER_GWETH( 13, 17) = 0.144669E+01
+ PKER_GWETH( 13, 18) = 0.149345E+01
+ PKER_GWETH( 13, 19) = 0.153263E+01
+ PKER_GWETH( 13, 20) = 0.156549E+01
+ PKER_GWETH( 13, 21) = 0.159309E+01
+ PKER_GWETH( 13, 22) = 0.161630E+01
+ PKER_GWETH( 13, 23) = 0.163585E+01
+ PKER_GWETH( 13, 24) = 0.165234E+01
+ PKER_GWETH( 13, 25) = 0.166626E+01
+ PKER_GWETH( 13, 26) = 0.167804E+01
+ PKER_GWETH( 13, 27) = 0.168801E+01
+ PKER_GWETH( 13, 28) = 0.169647E+01
+ PKER_GWETH( 13, 29) = 0.170364E+01
+ PKER_GWETH( 13, 30) = 0.170972E+01
+ PKER_GWETH( 13, 31) = 0.171489E+01
+ PKER_GWETH( 13, 32) = 0.171929E+01
+ PKER_GWETH( 13, 33) = 0.172303E+01
+ PKER_GWETH( 13, 34) = 0.172621E+01
+ PKER_GWETH( 13, 35) = 0.172893E+01
+ PKER_GWETH( 13, 36) = 0.173123E+01
+ PKER_GWETH( 13, 37) = 0.173320E+01
+ PKER_GWETH( 13, 38) = 0.173488E+01
+ PKER_GWETH( 13, 39) = 0.173631E+01
+ PKER_GWETH( 13, 40) = 0.173753E+01
+ PKER_GWETH( 14, 1) = 0.267774E+01
+ PKER_GWETH( 14, 2) = 0.208611E+01
+ PKER_GWETH( 14, 3) = 0.158411E+01
+ PKER_GWETH( 14, 4) = 0.116642E+01
+ PKER_GWETH( 14, 5) = 0.834444E+00
+ PKER_GWETH( 14, 6) = 0.594946E+00
+ PKER_GWETH( 14, 7) = 0.454936E+00
+ PKER_GWETH( 14, 8) = 0.413271E+00
+ PKER_GWETH( 14, 9) = 0.453847E+00
+ PKER_GWETH( 14, 10) = 0.548545E+00
+ PKER_GWETH( 14, 11) = 0.667103E+00
+ PKER_GWETH( 14, 12) = 0.786952E+00
+ PKER_GWETH( 14, 13) = 0.896286E+00
+ PKER_GWETH( 14, 14) = 0.991246E+00
+ PKER_GWETH( 14, 15) = 0.107196E+01
+ PKER_GWETH( 14, 16) = 0.113996E+01
+ PKER_GWETH( 14, 17) = 0.119702E+01
+ PKER_GWETH( 14, 18) = 0.124482E+01
+ PKER_GWETH( 14, 19) = 0.128486E+01
+ PKER_GWETH( 14, 20) = 0.131841E+01
+ PKER_GWETH( 14, 21) = 0.134655E+01
+ PKER_GWETH( 14, 22) = 0.137017E+01
+ PKER_GWETH( 14, 23) = 0.139005E+01
+ PKER_GWETH( 14, 24) = 0.140678E+01
+ PKER_GWETH( 14, 25) = 0.142090E+01
+ PKER_GWETH( 14, 26) = 0.143282E+01
+ PKER_GWETH( 14, 27) = 0.144291E+01
+ PKER_GWETH( 14, 28) = 0.145144E+01
+ PKER_GWETH( 14, 29) = 0.145868E+01
+ PKER_GWETH( 14, 30) = 0.146481E+01
+ PKER_GWETH( 14, 31) = 0.147002E+01
+ PKER_GWETH( 14, 32) = 0.147445E+01
+ PKER_GWETH( 14, 33) = 0.147821E+01
+ PKER_GWETH( 14, 34) = 0.148142E+01
+ PKER_GWETH( 14, 35) = 0.148414E+01
+ PKER_GWETH( 14, 36) = 0.148646E+01
+ PKER_GWETH( 14, 37) = 0.148844E+01
+ PKER_GWETH( 14, 38) = 0.149012E+01
+ PKER_GWETH( 14, 39) = 0.149156E+01
+ PKER_GWETH( 14, 40) = 0.149278E+01
+ PKER_GWETH( 15, 1) = 0.287818E+01
+ PKER_GWETH( 15, 2) = 0.228600E+01
+ PKER_GWETH( 15, 3) = 0.177984E+01
+ PKER_GWETH( 15, 4) = 0.135050E+01
+ PKER_GWETH( 15, 5) = 0.993561E+00
+ PKER_GWETH( 15, 6) = 0.710380E+00
+ PKER_GWETH( 15, 7) = 0.506846E+00
+ PKER_GWETH( 15, 8) = 0.388946E+00
+ PKER_GWETH( 15, 9) = 0.355232E+00
+ PKER_GWETH( 15, 10) = 0.391683E+00
+ PKER_GWETH( 15, 11) = 0.473950E+00
+ PKER_GWETH( 15, 12) = 0.576074E+00
+ PKER_GWETH( 15, 13) = 0.678964E+00
+ PKER_GWETH( 15, 14) = 0.772666E+00
+ PKER_GWETH( 15, 15) = 0.853994E+00
+ PKER_GWETH( 15, 16) = 0.923111E+00
+ PKER_GWETH( 15, 17) = 0.981331E+00
+ PKER_GWETH( 15, 18) = 0.103019E+01
+ PKER_GWETH( 15, 19) = 0.107112E+01
+ PKER_GWETH( 15, 20) = 0.110540E+01
+ PKER_GWETH( 15, 21) = 0.113413E+01
+ PKER_GWETH( 15, 22) = 0.115822E+01
+ PKER_GWETH( 15, 23) = 0.117845E+01
+ PKER_GWETH( 15, 24) = 0.119546E+01
+ PKER_GWETH( 15, 25) = 0.120979E+01
+ PKER_GWETH( 15, 26) = 0.122188E+01
+ PKER_GWETH( 15, 27) = 0.123208E+01
+ PKER_GWETH( 15, 28) = 0.124072E+01
+ PKER_GWETH( 15, 29) = 0.124802E+01
+ PKER_GWETH( 15, 30) = 0.125422E+01
+ PKER_GWETH( 15, 31) = 0.125947E+01
+ PKER_GWETH( 15, 32) = 0.126393E+01
+ PKER_GWETH( 15, 33) = 0.126772E+01
+ PKER_GWETH( 15, 34) = 0.127094E+01
+ PKER_GWETH( 15, 35) = 0.127368E+01
+ PKER_GWETH( 15, 36) = 0.127601E+01
+ PKER_GWETH( 15, 37) = 0.127800E+01
+ PKER_GWETH( 15, 38) = 0.127969E+01
+ PKER_GWETH( 15, 39) = 0.128113E+01
+ PKER_GWETH( 15, 40) = 0.128236E+01
+ PKER_GWETH( 16, 1) = 0.304968E+01
+ PKER_GWETH( 16, 2) = 0.245823E+01
+ PKER_GWETH( 16, 3) = 0.195153E+01
+ PKER_GWETH( 16, 4) = 0.151851E+01
+ PKER_GWETH( 16, 5) = 0.115132E+01
+ PKER_GWETH( 16, 6) = 0.846334E+00
+ PKER_GWETH( 16, 7) = 0.604763E+00
+ PKER_GWETH( 16, 8) = 0.431831E+00
+ PKER_GWETH( 16, 9) = 0.332538E+00
+ PKER_GWETH( 16, 10) = 0.305365E+00
+ PKER_GWETH( 16, 11) = 0.338047E+00
+ PKER_GWETH( 16, 12) = 0.409488E+00
+ PKER_GWETH( 16, 13) = 0.497462E+00
+ PKER_GWETH( 16, 14) = 0.585781E+00
+ PKER_GWETH( 16, 15) = 0.666083E+00
+ PKER_GWETH( 16, 16) = 0.735737E+00
+ PKER_GWETH( 16, 17) = 0.794919E+00
+ PKER_GWETH( 16, 18) = 0.844770E+00
+ PKER_GWETH( 16, 19) = 0.886603E+00
+ PKER_GWETH( 16, 20) = 0.921652E+00
+ PKER_GWETH( 16, 21) = 0.951006E+00
+ PKER_GWETH( 16, 22) = 0.975601E+00
+ PKER_GWETH( 16, 23) = 0.996228E+00
+ PKER_GWETH( 16, 24) = 0.101355E+01
+ PKER_GWETH( 16, 25) = 0.102812E+01
+ PKER_GWETH( 16, 26) = 0.104038E+01
+ PKER_GWETH( 16, 27) = 0.105073E+01
+ PKER_GWETH( 16, 28) = 0.105947E+01
+ PKER_GWETH( 16, 29) = 0.106686E+01
+ PKER_GWETH( 16, 30) = 0.107311E+01
+ PKER_GWETH( 16, 31) = 0.107841E+01
+ PKER_GWETH( 16, 32) = 0.108291E+01
+ PKER_GWETH( 16, 33) = 0.108673E+01
+ PKER_GWETH( 16, 34) = 0.108997E+01
+ PKER_GWETH( 16, 35) = 0.109273E+01
+ PKER_GWETH( 16, 36) = 0.109507E+01
+ PKER_GWETH( 16, 37) = 0.109707E+01
+ PKER_GWETH( 16, 38) = 0.109877E+01
+ PKER_GWETH( 16, 39) = 0.110022E+01
+ PKER_GWETH( 16, 40) = 0.110145E+01
+ PKER_GWETH( 17, 1) = 0.319611E+01
+ PKER_GWETH( 17, 2) = 0.260561E+01
+ PKER_GWETH( 17, 3) = 0.209952E+01
+ PKER_GWETH( 17, 4) = 0.166598E+01
+ PKER_GWETH( 17, 5) = 0.129552E+01
+ PKER_GWETH( 17, 6) = 0.981487E+00
+ PKER_GWETH( 17, 7) = 0.720900E+00
+ PKER_GWETH( 17, 8) = 0.514861E+00
+ PKER_GWETH( 17, 9) = 0.367926E+00
+ PKER_GWETH( 17, 10) = 0.284324E+00
+ PKER_GWETH( 17, 11) = 0.262515E+00
+ PKER_GWETH( 17, 12) = 0.291778E+00
+ PKER_GWETH( 17, 13) = 0.353788E+00
+ PKER_GWETH( 17, 14) = 0.429565E+00
+ PKER_GWETH( 17, 15) = 0.505375E+00
+ PKER_GWETH( 17, 16) = 0.574193E+00
+ PKER_GWETH( 17, 17) = 0.633847E+00
+ PKER_GWETH( 17, 18) = 0.684523E+00
+ PKER_GWETH( 17, 19) = 0.727207E+00
+ PKER_GWETH( 17, 20) = 0.763026E+00
+ PKER_GWETH( 17, 21) = 0.793037E+00
+ PKER_GWETH( 17, 22) = 0.818171E+00
+ PKER_GWETH( 17, 23) = 0.839230E+00
+ PKER_GWETH( 17, 24) = 0.856891E+00
+ PKER_GWETH( 17, 25) = 0.871722E+00
+ PKER_GWETH( 17, 26) = 0.884193E+00
+ PKER_GWETH( 17, 27) = 0.894696E+00
+ PKER_GWETH( 17, 28) = 0.903554E+00
+ PKER_GWETH( 17, 29) = 0.911035E+00
+ PKER_GWETH( 17, 30) = 0.917361E+00
+ PKER_GWETH( 17, 31) = 0.922716E+00
+ PKER_GWETH( 17, 32) = 0.927254E+00
+ PKER_GWETH( 17, 33) = 0.931104E+00
+ PKER_GWETH( 17, 34) = 0.934371E+00
+ PKER_GWETH( 17, 35) = 0.937147E+00
+ PKER_GWETH( 17, 36) = 0.939507E+00
+ PKER_GWETH( 17, 37) = 0.941515E+00
+ PKER_GWETH( 17, 38) = 0.943223E+00
+ PKER_GWETH( 17, 39) = 0.944678E+00
+ PKER_GWETH( 17, 40) = 0.945917E+00
+ PKER_GWETH( 18, 1) = 0.332109E+01
+ PKER_GWETH( 18, 2) = 0.273146E+01
+ PKER_GWETH( 18, 3) = 0.222618E+01
+ PKER_GWETH( 18, 4) = 0.179314E+01
+ PKER_GWETH( 18, 5) = 0.142219E+01
+ PKER_GWETH( 18, 6) = 0.110525E+01
+ PKER_GWETH( 18, 7) = 0.836701E+00
+ PKER_GWETH( 18, 8) = 0.614031E+00
+ PKER_GWETH( 18, 9) = 0.438335E+00
+ PKER_GWETH( 18, 10) = 0.313497E+00
+ PKER_GWETH( 18, 11) = 0.243130E+00
+ PKER_GWETH( 18, 12) = 0.225766E+00
+ PKER_GWETH( 18, 13) = 0.251859E+00
+ PKER_GWETH( 18, 14) = 0.305663E+00
+ PKER_GWETH( 18, 15) = 0.370929E+00
+ PKER_GWETH( 18, 16) = 0.435996E+00
+ PKER_GWETH( 18, 17) = 0.494970E+00
+ PKER_GWETH( 18, 18) = 0.546059E+00
+ PKER_GWETH( 18, 19) = 0.589452E+00
+ PKER_GWETH( 18, 20) = 0.626000E+00
+ PKER_GWETH( 18, 21) = 0.656670E+00
+ PKER_GWETH( 18, 22) = 0.682367E+00
+ PKER_GWETH( 18, 23) = 0.703888E+00
+ PKER_GWETH( 18, 24) = 0.721919E+00
+ PKER_GWETH( 18, 25) = 0.737041E+00
+ PKER_GWETH( 18, 26) = 0.749739E+00
+ PKER_GWETH( 18, 27) = 0.760417E+00
+ PKER_GWETH( 18, 28) = 0.769409E+00
+ PKER_GWETH( 18, 29) = 0.776992E+00
+ PKER_GWETH( 18, 30) = 0.783397E+00
+ PKER_GWETH( 18, 31) = 0.788812E+00
+ PKER_GWETH( 18, 32) = 0.793397E+00
+ PKER_GWETH( 18, 33) = 0.797281E+00
+ PKER_GWETH( 18, 34) = 0.800576E+00
+ PKER_GWETH( 18, 35) = 0.803373E+00
+ PKER_GWETH( 18, 36) = 0.805750E+00
+ PKER_GWETH( 18, 37) = 0.807770E+00
+ PKER_GWETH( 18, 38) = 0.809488E+00
+ PKER_GWETH( 18, 39) = 0.810950E+00
+ PKER_GWETH( 18, 40) = 0.812195E+00
+ PKER_GWETH( 19, 1) = 0.342781E+01
+ PKER_GWETH( 19, 2) = 0.283888E+01
+ PKER_GWETH( 19, 3) = 0.233434E+01
+ PKER_GWETH( 19, 4) = 0.190199E+01
+ PKER_GWETH( 19, 5) = 0.153145E+01
+ PKER_GWETH( 19, 6) = 0.121405E+01
+ PKER_GWETH( 19, 7) = 0.942909E+00
+ PKER_GWETH( 19, 8) = 0.713251E+00
+ PKER_GWETH( 19, 9) = 0.522990E+00
+ PKER_GWETH( 19, 10) = 0.373179E+00
+ PKER_GWETH( 19, 11) = 0.267136E+00
+ PKER_GWETH( 19, 12) = 0.207939E+00
+ PKER_GWETH( 19, 13) = 0.194168E+00
+ PKER_GWETH( 19, 14) = 0.217411E+00
+ PKER_GWETH( 19, 15) = 0.264085E+00
+ PKER_GWETH( 19, 16) = 0.320289E+00
+ PKER_GWETH( 19, 17) = 0.376133E+00
+ PKER_GWETH( 19, 18) = 0.426670E+00
+ PKER_GWETH( 19, 19) = 0.470424E+00
+ PKER_GWETH( 19, 20) = 0.507580E+00
+ PKER_GWETH( 19, 21) = 0.538874E+00
+ PKER_GWETH( 19, 22) = 0.565135E+00
+ PKER_GWETH( 19, 23) = 0.587138E+00
+ PKER_GWETH( 19, 24) = 0.605565E+00
+ PKER_GWETH( 19, 25) = 0.621004E+00
+ PKER_GWETH( 19, 26) = 0.633952E+00
+ PKER_GWETH( 19, 27) = 0.644824E+00
+ PKER_GWETH( 19, 28) = 0.653966E+00
+ PKER_GWETH( 19, 29) = 0.661665E+00
+ PKER_GWETH( 19, 30) = 0.668158E+00
+ PKER_GWETH( 19, 31) = 0.673640E+00
+ PKER_GWETH( 19, 32) = 0.678276E+00
+ PKER_GWETH( 19, 33) = 0.682201E+00
+ PKER_GWETH( 19, 34) = 0.685526E+00
+ PKER_GWETH( 19, 35) = 0.688347E+00
+ PKER_GWETH( 19, 36) = 0.690741E+00
+ PKER_GWETH( 19, 37) = 0.692775E+00
+ PKER_GWETH( 19, 38) = 0.694504E+00
+ PKER_GWETH( 19, 39) = 0.695975E+00
+ PKER_GWETH( 19, 40) = 0.697226E+00
+ PKER_GWETH( 20, 1) = 0.351898E+01
+ PKER_GWETH( 20, 2) = 0.293060E+01
+ PKER_GWETH( 20, 3) = 0.242666E+01
+ PKER_GWETH( 20, 4) = 0.199494E+01
+ PKER_GWETH( 20, 5) = 0.162499E+01
+ PKER_GWETH( 20, 6) = 0.130793E+01
+ PKER_GWETH( 20, 7) = 0.103636E+01
+ PKER_GWETH( 20, 8) = 0.804397E+00
+ PKER_GWETH( 20, 9) = 0.607997E+00
+ PKER_GWETH( 20, 10) = 0.445440E+00
+ PKER_GWETH( 20, 11) = 0.317694E+00
+ PKER_GWETH( 20, 12) = 0.227641E+00
+ PKER_GWETH( 20, 13) = 0.177870E+00
+ PKER_GWETH( 20, 14) = 0.166997E+00
+ PKER_GWETH( 20, 15) = 0.187688E+00
+ PKER_GWETH( 20, 16) = 0.228164E+00
+ PKER_GWETH( 20, 17) = 0.276557E+00
+ PKER_GWETH( 20, 18) = 0.324482E+00
+ PKER_GWETH( 20, 19) = 0.367788E+00
+ PKER_GWETH( 20, 20) = 0.405260E+00
+ PKER_GWETH( 20, 21) = 0.437075E+00
+ PKER_GWETH( 20, 22) = 0.463871E+00
+ PKER_GWETH( 20, 23) = 0.486357E+00
+ PKER_GWETH( 20, 24) = 0.505197E+00
+ PKER_GWETH( 20, 25) = 0.520975E+00
+ PKER_GWETH( 20, 26) = 0.534195E+00
+ PKER_GWETH( 20, 27) = 0.545281E+00
+ PKER_GWETH( 20, 28) = 0.554590E+00
+ PKER_GWETH( 20, 29) = 0.562417E+00
+ PKER_GWETH( 20, 30) = 0.569008E+00
+ PKER_GWETH( 20, 31) = 0.574567E+00
+ PKER_GWETH( 20, 32) = 0.579261E+00
+ PKER_GWETH( 20, 33) = 0.583229E+00
+ PKER_GWETH( 20, 34) = 0.586589E+00
+ PKER_GWETH( 20, 35) = 0.589436E+00
+ PKER_GWETH( 20, 36) = 0.591850E+00
+ PKER_GWETH( 20, 37) = 0.593899E+00
+ PKER_GWETH( 20, 38) = 0.595640E+00
+ PKER_GWETH( 20, 39) = 0.597120E+00
+ PKER_GWETH( 20, 40) = 0.598379E+00
+ PKER_GWETH( 21, 1) = 0.359692E+01
+ PKER_GWETH( 21, 2) = 0.300896E+01
+ PKER_GWETH( 21, 3) = 0.250550E+01
+ PKER_GWETH( 21, 4) = 0.207429E+01
+ PKER_GWETH( 21, 5) = 0.170488E+01
+ PKER_GWETH( 21, 6) = 0.138832E+01
+ PKER_GWETH( 21, 7) = 0.111703E+01
+ PKER_GWETH( 21, 8) = 0.884662E+00
+ PKER_GWETH( 21, 9) = 0.686219E+00
+ PKER_GWETH( 21, 10) = 0.518262E+00
+ PKER_GWETH( 21, 11) = 0.379381E+00
+ PKER_GWETH( 21, 12) = 0.270445E+00
+ PKER_GWETH( 21, 13) = 0.194001E+00
+ PKER_GWETH( 21, 14) = 0.152170E+00
+ PKER_GWETH( 21, 15) = 0.143663E+00
+ PKER_GWETH( 21, 16) = 0.162036E+00
+ PKER_GWETH( 21, 17) = 0.197129E+00
+ PKER_GWETH( 21, 18) = 0.238790E+00
+ PKER_GWETH( 21, 19) = 0.279917E+00
+ PKER_GWETH( 21, 20) = 0.317026E+00
+ PKER_GWETH( 21, 21) = 0.349117E+00
+ PKER_GWETH( 21, 22) = 0.376360E+00
+ PKER_GWETH( 21, 23) = 0.399304E+00
+ PKER_GWETH( 21, 24) = 0.418558E+00
+ PKER_GWETH( 21, 25) = 0.434689E+00
+ PKER_GWETH( 21, 26) = 0.448200E+00
+ PKER_GWETH( 21, 27) = 0.459519E+00
+ PKER_GWETH( 21, 28) = 0.469011E+00
+ PKER_GWETH( 21, 29) = 0.476981E+00
+ PKER_GWETH( 21, 30) = 0.483683E+00
+ PKER_GWETH( 21, 31) = 0.489326E+00
+ PKER_GWETH( 21, 32) = 0.494085E+00
+ PKER_GWETH( 21, 33) = 0.498103E+00
+ PKER_GWETH( 21, 34) = 0.501501E+00
+ PKER_GWETH( 21, 35) = 0.504377E+00
+ PKER_GWETH( 21, 36) = 0.506814E+00
+ PKER_GWETH( 21, 37) = 0.508880E+00
+ PKER_GWETH( 21, 38) = 0.510635E+00
+ PKER_GWETH( 21, 39) = 0.512125E+00
+ PKER_GWETH( 21, 40) = 0.513392E+00
+ PKER_GWETH( 22, 1) = 0.366359E+01
+ PKER_GWETH( 22, 2) = 0.307596E+01
+ PKER_GWETH( 22, 3) = 0.257285E+01
+ PKER_GWETH( 22, 4) = 0.214205E+01
+ PKER_GWETH( 22, 5) = 0.177308E+01
+ PKER_GWETH( 22, 6) = 0.145698E+01
+ PKER_GWETH( 22, 7) = 0.118611E+01
+ PKER_GWETH( 22, 8) = 0.953972E+00
+ PKER_GWETH( 22, 9) = 0.755156E+00
+ PKER_GWETH( 22, 10) = 0.585390E+00
+ PKER_GWETH( 22, 11) = 0.441762E+00
+ PKER_GWETH( 22, 12) = 0.323113E+00
+ PKER_GWETH( 22, 13) = 0.230215E+00
+ PKER_GWETH( 22, 14) = 0.165338E+00
+ PKER_GWETH( 22, 15) = 0.130201E+00
+ PKER_GWETH( 22, 16) = 0.123605E+00
+ PKER_GWETH( 22, 17) = 0.139899E+00
+ PKER_GWETH( 22, 18) = 0.170314E+00
+ PKER_GWETH( 22, 19) = 0.206177E+00
+ PKER_GWETH( 22, 20) = 0.241468E+00
+ PKER_GWETH( 22, 21) = 0.273265E+00
+ PKER_GWETH( 22, 22) = 0.300749E+00
+ PKER_GWETH( 22, 23) = 0.324076E+00
+ PKER_GWETH( 22, 24) = 0.343721E+00
+ PKER_GWETH( 22, 25) = 0.360208E+00
+ PKER_GWETH( 22, 26) = 0.374020E+00
+ PKER_GWETH( 22, 27) = 0.385589E+00
+ PKER_GWETH( 22, 28) = 0.395281E+00
+ PKER_GWETH( 22, 29) = 0.403408E+00
+ PKER_GWETH( 22, 30) = 0.410232E+00
+ PKER_GWETH( 22, 31) = 0.415970E+00
+ PKER_GWETH( 22, 32) = 0.420802E+00
+ PKER_GWETH( 22, 33) = 0.424876E+00
+ PKER_GWETH( 22, 34) = 0.428316E+00
+ PKER_GWETH( 22, 35) = 0.431225E+00
+ PKER_GWETH( 22, 36) = 0.433687E+00
+ PKER_GWETH( 22, 37) = 0.435773E+00
+ PKER_GWETH( 22, 38) = 0.437542E+00
+ PKER_GWETH( 22, 39) = 0.439043E+00
+ PKER_GWETH( 22, 40) = 0.440319E+00
+ PKER_GWETH( 23, 1) = 0.372064E+01
+ PKER_GWETH( 23, 2) = 0.313326E+01
+ PKER_GWETH( 23, 3) = 0.263044E+01
+ PKER_GWETH( 23, 4) = 0.219994E+01
+ PKER_GWETH( 23, 5) = 0.183132E+01
+ PKER_GWETH( 23, 6) = 0.151560E+01
+ PKER_GWETH( 23, 7) = 0.124512E+01
+ PKER_GWETH( 23, 8) = 0.101334E+01
+ PKER_GWETH( 23, 9) = 0.814709E+00
+ PKER_GWETH( 23, 10) = 0.644598E+00
+ PKER_GWETH( 23, 11) = 0.499364E+00
+ PKER_GWETH( 23, 12) = 0.376545E+00
+ PKER_GWETH( 23, 13) = 0.275183E+00
+ PKER_GWETH( 23, 14) = 0.195998E+00
+ PKER_GWETH( 23, 15) = 0.140922E+00
+ PKER_GWETH( 23, 16) = 0.111420E+00
+ PKER_GWETH( 23, 17) = 0.106360E+00
+ PKER_GWETH( 23, 18) = 0.120791E+00
+ PKER_GWETH( 23, 19) = 0.147147E+00
+ PKER_GWETH( 23, 20) = 0.178014E+00
+ PKER_GWETH( 23, 21) = 0.208295E+00
+ PKER_GWETH( 23, 22) = 0.235541E+00
+ PKER_GWETH( 23, 23) = 0.259078E+00
+ PKER_GWETH( 23, 24) = 0.279052E+00
+ PKER_GWETH( 23, 25) = 0.295874E+00
+ PKER_GWETH( 23, 26) = 0.309990E+00
+ PKER_GWETH( 23, 27) = 0.321818E+00
+ PKER_GWETH( 23, 28) = 0.331723E+00
+ PKER_GWETH( 23, 29) = 0.340022E+00
+ PKER_GWETH( 23, 30) = 0.346981E+00
+ PKER_GWETH( 23, 31) = 0.352824E+00
+ PKER_GWETH( 23, 32) = 0.357736E+00
+ PKER_GWETH( 23, 33) = 0.361873E+00
+ PKER_GWETH( 23, 34) = 0.365361E+00
+ PKER_GWETH( 23, 35) = 0.368306E+00
+ PKER_GWETH( 23, 36) = 0.370796E+00
+ PKER_GWETH( 23, 37) = 0.372904E+00
+ PKER_GWETH( 23, 38) = 0.374689E+00
+ PKER_GWETH( 23, 39) = 0.376204E+00
+ PKER_GWETH( 23, 40) = 0.377489E+00
+ PKER_GWETH( 24, 1) = 0.376949E+01
+ PKER_GWETH( 24, 2) = 0.318230E+01
+ PKER_GWETH( 24, 3) = 0.267969E+01
+ PKER_GWETH( 24, 4) = 0.224944E+01
+ PKER_GWETH( 24, 5) = 0.188108E+01
+ PKER_GWETH( 24, 6) = 0.156565E+01
+ PKER_GWETH( 24, 7) = 0.129550E+01
+ PKER_GWETH( 24, 8) = 0.106406E+01
+ PKER_GWETH( 24, 9) = 0.865729E+00
+ PKER_GWETH( 24, 10) = 0.695767E+00
+ PKER_GWETH( 24, 11) = 0.550217E+00
+ PKER_GWETH( 24, 12) = 0.425970E+00
+ PKER_GWETH( 24, 13) = 0.320948E+00
+ PKER_GWETH( 24, 14) = 0.234359E+00
+ PKER_GWETH( 24, 15) = 0.166867E+00
+ PKER_GWETH( 24, 16) = 0.120117E+00
+ PKER_GWETH( 24, 17) = 0.953615E-01
+ PKER_GWETH( 24, 18) = 0.915330E-01
+ PKER_GWETH( 24, 19) = 0.104298E+00
+ PKER_GWETH( 24, 20) = 0.127130E+00
+ PKER_GWETH( 24, 21) = 0.153694E+00
+ PKER_GWETH( 24, 22) = 0.179676E+00
+ PKER_GWETH( 24, 23) = 0.203021E+00
+ PKER_GWETH( 24, 24) = 0.223178E+00
+ PKER_GWETH( 24, 25) = 0.240281E+00
+ PKER_GWETH( 24, 26) = 0.254685E+00
+ PKER_GWETH( 24, 27) = 0.266772E+00
+ PKER_GWETH( 24, 28) = 0.276900E+00
+ PKER_GWETH( 24, 29) = 0.285381E+00
+ PKER_GWETH( 24, 30) = 0.292487E+00
+ PKER_GWETH( 24, 31) = 0.298445E+00
+ PKER_GWETH( 24, 32) = 0.303448E+00
+ PKER_GWETH( 24, 33) = 0.307654E+00
+ PKER_GWETH( 24, 34) = 0.311196E+00
+ PKER_GWETH( 24, 35) = 0.314182E+00
+ PKER_GWETH( 24, 36) = 0.316704E+00
+ PKER_GWETH( 24, 37) = 0.318835E+00
+ PKER_GWETH( 24, 38) = 0.320640E+00
+ PKER_GWETH( 24, 39) = 0.322168E+00
+ PKER_GWETH( 24, 40) = 0.323465E+00
+ PKER_GWETH( 25, 1) = 0.381133E+01
+ PKER_GWETH( 25, 2) = 0.322429E+01
+ PKER_GWETH( 25, 3) = 0.272184E+01
+ PKER_GWETH( 25, 4) = 0.229177E+01
+ PKER_GWETH( 25, 5) = 0.192362E+01
+ PKER_GWETH( 25, 6) = 0.160842E+01
+ PKER_GWETH( 25, 7) = 0.133852E+01
+ PKER_GWETH( 25, 8) = 0.110735E+01
+ PKER_GWETH( 25, 9) = 0.909315E+00
+ PKER_GWETH( 25, 10) = 0.739612E+00
+ PKER_GWETH( 25, 11) = 0.594182E+00
+ PKER_GWETH( 25, 12) = 0.469647E+00
+ PKER_GWETH( 25, 13) = 0.363358E+00
+ PKER_GWETH( 25, 14) = 0.273552E+00
+ PKER_GWETH( 25, 15) = 0.199585E+00
+ PKER_GWETH( 25, 16) = 0.142061E+00
+ PKER_GWETH( 25, 17) = 0.102393E+00
+ PKER_GWETH( 25, 18) = 0.816292E-01
+ PKER_GWETH( 25, 19) = 0.787840E-01
+ PKER_GWETH( 25, 20) = 0.900615E-01
+ PKER_GWETH( 25, 21) = 0.109835E+00
+ PKER_GWETH( 25, 22) = 0.132694E+00
+ PKER_GWETH( 25, 23) = 0.154985E+00
+ PKER_GWETH( 25, 24) = 0.174988E+00
+ PKER_GWETH( 25, 25) = 0.192250E+00
+ PKER_GWETH( 25, 26) = 0.206895E+00
+ PKER_GWETH( 25, 27) = 0.219228E+00
+ PKER_GWETH( 25, 28) = 0.229578E+00
+ PKER_GWETH( 25, 29) = 0.238250E+00
+ PKER_GWETH( 25, 30) = 0.245512E+00
+ PKER_GWETH( 25, 31) = 0.251597E+00
+ PKER_GWETH( 25, 32) = 0.256699E+00
+ PKER_GWETH( 25, 33) = 0.260982E+00
+ PKER_GWETH( 25, 34) = 0.264583E+00
+ PKER_GWETH( 25, 35) = 0.267616E+00
+ PKER_GWETH( 25, 36) = 0.270172E+00
+ PKER_GWETH( 25, 37) = 0.272331E+00
+ PKER_GWETH( 25, 38) = 0.274156E+00
+ PKER_GWETH( 25, 39) = 0.275700E+00
+ PKER_GWETH( 25, 40) = 0.277009E+00
+ PKER_GWETH( 26, 1) = 0.384717E+01
+ PKER_GWETH( 26, 2) = 0.326025E+01
+ PKER_GWETH( 26, 3) = 0.275793E+01
+ PKER_GWETH( 26, 4) = 0.232801E+01
+ PKER_GWETH( 26, 5) = 0.196001E+01
+ PKER_GWETH( 26, 6) = 0.164499E+01
+ PKER_GWETH( 26, 7) = 0.137528E+01
+ PKER_GWETH( 26, 8) = 0.114433E+01
+ PKER_GWETH( 26, 9) = 0.946529E+00
+ PKER_GWETH( 26, 10) = 0.777072E+00
+ PKER_GWETH( 26, 11) = 0.631861E+00
+ PKER_GWETH( 26, 12) = 0.507422E+00
+ PKER_GWETH( 26, 13) = 0.400869E+00
+ PKER_GWETH( 26, 14) = 0.309943E+00
+ PKER_GWETH( 26, 15) = 0.233150E+00
+ PKER_GWETH( 26, 16) = 0.169969E+00
+ PKER_GWETH( 26, 17) = 0.120938E+00
+ PKER_GWETH( 26, 18) = 0.872884E-01
+ PKER_GWETH( 26, 19) = 0.698854E-01
+ PKER_GWETH( 26, 20) = 0.678184E-01
+ PKER_GWETH( 26, 21) = 0.777723E-01
+ PKER_GWETH( 26, 22) = 0.948930E-01
+ PKER_GWETH( 26, 23) = 0.114561E+00
+ PKER_GWETH( 26, 24) = 0.133685E+00
+ PKER_GWETH( 26, 25) = 0.150823E+00
+ PKER_GWETH( 26, 26) = 0.165606E+00
+ PKER_GWETH( 26, 27) = 0.178146E+00
+ PKER_GWETH( 26, 28) = 0.188706E+00
+ PKER_GWETH( 26, 29) = 0.197569E+00
+ PKER_GWETH( 26, 30) = 0.204994E+00
+ PKER_GWETH( 26, 31) = 0.211213E+00
+ PKER_GWETH( 26, 32) = 0.216422E+00
+ PKER_GWETH( 26, 33) = 0.220791E+00
+ PKER_GWETH( 26, 34) = 0.224458E+00
+ PKER_GWETH( 26, 35) = 0.227542E+00
+ PKER_GWETH( 26, 36) = 0.230138E+00
+ PKER_GWETH( 26, 37) = 0.232327E+00
+ PKER_GWETH( 26, 38) = 0.234175E+00
+ PKER_GWETH( 26, 39) = 0.235737E+00
+ PKER_GWETH( 26, 40) = 0.237059E+00
+ PKER_GWETH( 27, 1) = 0.387789E+01
+ PKER_GWETH( 27, 2) = 0.329106E+01
+ PKER_GWETH( 27, 3) = 0.278885E+01
+ PKER_GWETH( 27, 4) = 0.235903E+01
+ PKER_GWETH( 27, 5) = 0.199115E+01
+ PKER_GWETH( 27, 6) = 0.167627E+01
+ PKER_GWETH( 27, 7) = 0.140671E+01
+ PKER_GWETH( 27, 8) = 0.117593E+01
+ PKER_GWETH( 27, 9) = 0.978311E+00
+ PKER_GWETH( 27, 10) = 0.809056E+00
+ PKER_GWETH( 27, 11) = 0.664056E+00
+ PKER_GWETH( 27, 12) = 0.539803E+00
+ PKER_GWETH( 27, 13) = 0.433325E+00
+ PKER_GWETH( 27, 14) = 0.342157E+00
+ PKER_GWETH( 27, 15) = 0.264373E+00
+ PKER_GWETH( 27, 16) = 0.198711E+00
+ PKER_GWETH( 27, 17) = 0.144743E+00
+ PKER_GWETH( 27, 18) = 0.102957E+00
+ PKER_GWETH( 27, 19) = 0.744189E-01
+ PKER_GWETH( 27, 20) = 0.598398E-01
+ PKER_GWETH( 27, 21) = 0.583871E-01
+ PKER_GWETH( 27, 22) = 0.671630E-01
+ PKER_GWETH( 27, 23) = 0.819825E-01
+ PKER_GWETH( 27, 24) = 0.989033E-01
+ PKER_GWETH( 27, 25) = 0.115309E+00
+ PKER_GWETH( 27, 26) = 0.129993E+00
+ PKER_GWETH( 27, 27) = 0.142653E+00
+ PKER_GWETH( 27, 28) = 0.153391E+00
+ PKER_GWETH( 27, 29) = 0.162433E+00
+ PKER_GWETH( 27, 30) = 0.170021E+00
+ PKER_GWETH( 27, 31) = 0.176379E+00
+ PKER_GWETH( 27, 32) = 0.181704E+00
+ PKER_GWETH( 27, 33) = 0.186165E+00
+ PKER_GWETH( 27, 34) = 0.189906E+00
+ PKER_GWETH( 27, 35) = 0.193046E+00
+ PKER_GWETH( 27, 36) = 0.195686E+00
+ PKER_GWETH( 27, 37) = 0.197908E+00
+ PKER_GWETH( 27, 38) = 0.199782E+00
+ PKER_GWETH( 27, 39) = 0.201365E+00
+ PKER_GWETH( 27, 40) = 0.202702E+00
+ PKER_GWETH( 28, 1) = 0.390423E+01
+ PKER_GWETH( 28, 2) = 0.331747E+01
+ PKER_GWETH( 28, 3) = 0.281533E+01
+ PKER_GWETH( 28, 4) = 0.238560E+01
+ PKER_GWETH( 28, 5) = 0.201782E+01
+ PKER_GWETH( 28, 6) = 0.170303E+01
+ PKER_GWETH( 28, 7) = 0.143359E+01
+ PKER_GWETH( 28, 8) = 0.120294E+01
+ PKER_GWETH( 28, 9) = 0.100547E+01
+ PKER_GWETH( 28, 10) = 0.836373E+00
+ PKER_GWETH( 28, 11) = 0.691546E+00
+ PKER_GWETH( 28, 12) = 0.567472E+00
+ PKER_GWETH( 28, 13) = 0.461152E+00
+ PKER_GWETH( 28, 14) = 0.370043E+00
+ PKER_GWETH( 28, 15) = 0.292039E+00
+ PKER_GWETH( 28, 16) = 0.225499E+00
+ PKER_GWETH( 28, 17) = 0.169354E+00
+ PKER_GWETH( 28, 18) = 0.123260E+00
+ PKER_GWETH( 28, 19) = 0.876511E-01
+ PKER_GWETH( 28, 20) = 0.634500E-01
+ PKER_GWETH( 28, 21) = 0.512448E-01
+ PKER_GWETH( 28, 22) = 0.502738E-01
+ PKER_GWETH( 28, 23) = 0.580041E-01
+ PKER_GWETH( 28, 24) = 0.708282E-01
+ PKER_GWETH( 28, 25) = 0.853839E-01
+ PKER_GWETH( 28, 26) = 0.994571E-01
+ PKER_GWETH( 28, 27) = 0.112038E+00
+ PKER_GWETH( 28, 28) = 0.122879E+00
+ PKER_GWETH( 28, 29) = 0.132074E+00
+ PKER_GWETH( 28, 30) = 0.139816E+00
+ PKER_GWETH( 28, 31) = 0.146314E+00
+ PKER_GWETH( 28, 32) = 0.151758E+00
+ PKER_GWETH( 28, 33) = 0.156318E+00
+ PKER_GWETH( 28, 34) = 0.160137E+00
+ PKER_GWETH( 28, 35) = 0.163340E+00
+ PKER_GWETH( 28, 36) = 0.166029E+00
+ PKER_GWETH( 28, 37) = 0.168289E+00
+ PKER_GWETH( 28, 38) = 0.170192E+00
+ PKER_GWETH( 28, 39) = 0.171797E+00
+ PKER_GWETH( 28, 40) = 0.173151E+00
+ PKER_GWETH( 29, 1) = 0.392682E+01
+ PKER_GWETH( 29, 2) = 0.334011E+01
+ PKER_GWETH( 29, 3) = 0.283803E+01
+ PKER_GWETH( 29, 4) = 0.240837E+01
+ PKER_GWETH( 29, 5) = 0.204066E+01
+ PKER_GWETH( 29, 6) = 0.172596E+01
+ PKER_GWETH( 29, 7) = 0.145660E+01
+ PKER_GWETH( 29, 8) = 0.122605E+01
+ PKER_GWETH( 29, 9) = 0.102869E+01
+ PKER_GWETH( 29, 10) = 0.859716E+00
+ PKER_GWETH( 29, 11) = 0.715025E+00
+ PKER_GWETH( 29, 12) = 0.591099E+00
+ PKER_GWETH( 29, 13) = 0.484932E+00
+ PKER_GWETH( 29, 14) = 0.393957E+00
+ PKER_GWETH( 29, 15) = 0.315999E+00
+ PKER_GWETH( 29, 16) = 0.249258E+00
+ PKER_GWETH( 29, 17) = 0.192336E+00
+ PKER_GWETH( 29, 18) = 0.144330E+00
+ PKER_GWETH( 29, 19) = 0.104963E+00
+ PKER_GWETH( 29, 20) = 0.746220E-01
+ PKER_GWETH( 29, 21) = 0.541032E-01
+ PKER_GWETH( 29, 22) = 0.438920E-01
+ PKER_GWETH( 29, 23) = 0.432926E-01
+ PKER_GWETH( 29, 24) = 0.500966E-01
+ PKER_GWETH( 29, 25) = 0.611908E-01
+ PKER_GWETH( 29, 26) = 0.737100E-01
+ PKER_GWETH( 29, 27) = 0.857825E-01
+ PKER_GWETH( 29, 28) = 0.965608E-01
+ PKER_GWETH( 29, 29) = 0.105845E+00
+ PKER_GWETH( 29, 30) = 0.113718E+00
+ PKER_GWETH( 29, 31) = 0.120348E+00
+ PKER_GWETH( 29, 32) = 0.125912E+00
+ PKER_GWETH( 29, 33) = 0.130574E+00
+ PKER_GWETH( 29, 34) = 0.134478E+00
+ PKER_GWETH( 29, 35) = 0.137748E+00
+ PKER_GWETH( 29, 36) = 0.140491E+00
+ PKER_GWETH( 29, 37) = 0.142793E+00
+ PKER_GWETH( 29, 38) = 0.144728E+00
+ PKER_GWETH( 29, 39) = 0.146357E+00
+ PKER_GWETH( 29, 40) = 0.147731E+00
+ PKER_GWETH( 30, 1) = 0.394620E+01
+ PKER_GWETH( 30, 2) = 0.335953E+01
+ PKER_GWETH( 30, 3) = 0.285750E+01
+ PKER_GWETH( 30, 4) = 0.242788E+01
+ PKER_GWETH( 30, 5) = 0.206023E+01
+ PKER_GWETH( 30, 6) = 0.174559E+01
+ PKER_GWETH( 30, 7) = 0.147631E+01
+ PKER_GWETH( 30, 8) = 0.124583E+01
+ PKER_GWETH( 30, 9) = 0.104855E+01
+ PKER_GWETH( 30, 10) = 0.879674E+00
+ PKER_GWETH( 30, 11) = 0.735088E+00
+ PKER_GWETH( 30, 12) = 0.611279E+00
+ PKER_GWETH( 30, 13) = 0.505239E+00
+ PKER_GWETH( 30, 14) = 0.414395E+00
+ PKER_GWETH( 30, 15) = 0.336549E+00
+ PKER_GWETH( 30, 16) = 0.269844E+00
+ PKER_GWETH( 30, 17) = 0.212740E+00
+ PKER_GWETH( 30, 18) = 0.164047E+00
+ PKER_GWETH( 30, 19) = 0.123002E+00
+ PKER_GWETH( 30, 20) = 0.893792E-01
+ PKER_GWETH( 30, 21) = 0.635301E-01
+ PKER_GWETH( 30, 22) = 0.461363E-01
+ PKER_GWETH( 30, 23) = 0.375986E-01
+ PKER_GWETH( 30, 24) = 0.372861E-01
+ PKER_GWETH( 30, 25) = 0.432687E-01
+ PKER_GWETH( 30, 26) = 0.528642E-01
+ PKER_GWETH( 30, 27) = 0.636312E-01
+ PKER_GWETH( 30, 28) = 0.739863E-01
+ PKER_GWETH( 30, 29) = 0.832206E-01
+ PKER_GWETH( 30, 30) = 0.911715E-01
+ PKER_GWETH( 30, 31) = 0.979130E-01
+ PKER_GWETH( 30, 32) = 0.103590E+00
+ PKER_GWETH( 30, 33) = 0.108354E+00
+ PKER_GWETH( 30, 34) = 0.112346E+00
+ PKER_GWETH( 30, 35) = 0.115689E+00
+ PKER_GWETH( 30, 36) = 0.118489E+00
+ PKER_GWETH( 30, 37) = 0.120837E+00
+ PKER_GWETH( 30, 38) = 0.122808E+00
+ PKER_GWETH( 30, 39) = 0.124466E+00
+ PKER_GWETH( 30, 40) = 0.125860E+00
+ PKER_GWETH( 31, 1) = 0.396282E+01
+ PKER_GWETH( 31, 2) = 0.337618E+01
+ PKER_GWETH( 31, 3) = 0.287419E+01
+ PKER_GWETH( 31, 4) = 0.244461E+01
+ PKER_GWETH( 31, 5) = 0.207700E+01
+ PKER_GWETH( 31, 6) = 0.176241E+01
+ PKER_GWETH( 31, 7) = 0.149318E+01
+ PKER_GWETH( 31, 8) = 0.126277E+01
+ PKER_GWETH( 31, 9) = 0.106555E+01
+ PKER_GWETH( 31, 10) = 0.896748E+00
+ PKER_GWETH( 31, 11) = 0.752243E+00
+ PKER_GWETH( 31, 12) = 0.628524E+00
+ PKER_GWETH( 31, 13) = 0.522584E+00
+ PKER_GWETH( 31, 14) = 0.431848E+00
+ PKER_GWETH( 31, 15) = 0.354114E+00
+ PKER_GWETH( 31, 16) = 0.287504E+00
+ PKER_GWETH( 31, 17) = 0.230428E+00
+ PKER_GWETH( 31, 18) = 0.181570E+00
+ PKER_GWETH( 31, 19) = 0.139916E+00
+ PKER_GWETH( 31, 20) = 0.104822E+00
+ PKER_GWETH( 31, 21) = 0.761078E-01
+ PKER_GWETH( 31, 22) = 0.540869E-01
+ PKER_GWETH( 31, 23) = 0.393467E-01
+ PKER_GWETH( 31, 24) = 0.322138E-01
+ PKER_GWETH( 31, 25) = 0.321164E-01
+ PKER_GWETH( 31, 26) = 0.373726E-01
+ PKER_GWETH( 31, 27) = 0.456700E-01
+ PKER_GWETH( 31, 28) = 0.549298E-01
+ PKER_GWETH( 31, 29) = 0.638108E-01
+ PKER_GWETH( 31, 30) = 0.717222E-01
+ PKER_GWETH( 31, 31) = 0.785310E-01
+ PKER_GWETH( 31, 32) = 0.843036E-01
+ PKER_GWETH( 31, 33) = 0.891644E-01
+ PKER_GWETH( 31, 34) = 0.932438E-01
+ PKER_GWETH( 31, 35) = 0.966619E-01
+ PKER_GWETH( 31, 36) = 0.995245E-01
+ PKER_GWETH( 31, 37) = 0.101922E+00
+ PKER_GWETH( 31, 38) = 0.103933E+00
+ PKER_GWETH( 31, 39) = 0.105621E+00
+ PKER_GWETH( 31, 40) = 0.107040E+00
+ PKER_GWETH( 32, 1) = 0.397708E+01
+ PKER_GWETH( 32, 2) = 0.339047E+01
+ PKER_GWETH( 32, 3) = 0.288850E+01
+ PKER_GWETH( 32, 4) = 0.245896E+01
+ PKER_GWETH( 32, 5) = 0.209138E+01
+ PKER_GWETH( 32, 6) = 0.177683E+01
+ PKER_GWETH( 32, 7) = 0.150764E+01
+ PKER_GWETH( 32, 8) = 0.127727E+01
+ PKER_GWETH( 32, 9) = 0.108011E+01
+ PKER_GWETH( 32, 10) = 0.911361E+00
+ PKER_GWETH( 32, 11) = 0.766918E+00
+ PKER_GWETH( 32, 12) = 0.643269E+00
+ PKER_GWETH( 32, 13) = 0.537406E+00
+ PKER_GWETH( 32, 14) = 0.446756E+00
+ PKER_GWETH( 32, 15) = 0.369116E+00
+ PKER_GWETH( 32, 16) = 0.302601E+00
+ PKER_GWETH( 32, 17) = 0.245604E+00
+ PKER_GWETH( 32, 18) = 0.196766E+00
+ PKER_GWETH( 32, 19) = 0.154963E+00
+ PKER_GWETH( 32, 20) = 0.119332E+00
+ PKER_GWETH( 32, 21) = 0.893267E-01
+ PKER_GWETH( 32, 22) = 0.648070E-01
+ PKER_GWETH( 32, 23) = 0.460486E-01
+ PKER_GWETH( 32, 24) = 0.335588E-01
+ PKER_GWETH( 32, 25) = 0.276040E-01
+ PKER_GWETH( 32, 26) = 0.276657E-01
+ PKER_GWETH( 32, 27) = 0.322804E-01
+ PKER_GWETH( 32, 28) = 0.394546E-01
+ PKER_GWETH( 32, 29) = 0.474167E-01
+ PKER_GWETH( 32, 30) = 0.550336E-01
+ PKER_GWETH( 32, 31) = 0.618114E-01
+ PKER_GWETH( 32, 32) = 0.676423E-01
+ PKER_GWETH( 32, 33) = 0.725852E-01
+ PKER_GWETH( 32, 34) = 0.767473E-01
+ PKER_GWETH( 32, 35) = 0.802405E-01
+ PKER_GWETH( 32, 36) = 0.831673E-01
+ PKER_GWETH( 32, 37) = 0.856184E-01
+ PKER_GWETH( 32, 38) = 0.876718E-01
+ PKER_GWETH( 32, 39) = 0.893933E-01
+ PKER_GWETH( 32, 40) = 0.908384E-01
+ PKER_GWETH( 33, 1) = 0.398932E+01
+ PKER_GWETH( 33, 2) = 0.340273E+01
+ PKER_GWETH( 33, 3) = 0.290079E+01
+ PKER_GWETH( 33, 4) = 0.247127E+01
+ PKER_GWETH( 33, 5) = 0.210372E+01
+ PKER_GWETH( 33, 6) = 0.178919E+01
+ PKER_GWETH( 33, 7) = 0.152004E+01
+ PKER_GWETH( 33, 8) = 0.128970E+01
+ PKER_GWETH( 33, 9) = 0.109258E+01
+ PKER_GWETH( 33, 10) = 0.923874E+00
+ PKER_GWETH( 33, 11) = 0.779479E+00
+ PKER_GWETH( 33, 12) = 0.655884E+00
+ PKER_GWETH( 33, 13) = 0.550080E+00
+ PKER_GWETH( 33, 14) = 0.459496E+00
+ PKER_GWETH( 33, 15) = 0.381929E+00
+ PKER_GWETH( 33, 16) = 0.315494E+00
+ PKER_GWETH( 33, 17) = 0.258578E+00
+ PKER_GWETH( 33, 18) = 0.209808E+00
+ PKER_GWETH( 33, 19) = 0.168020E+00
+ PKER_GWETH( 33, 20) = 0.132253E+00
+ PKER_GWETH( 33, 21) = 0.101773E+00
+ PKER_GWETH( 33, 22) = 0.761204E-01
+ PKER_GWETH( 33, 23) = 0.551820E-01
+ PKER_GWETH( 33, 24) = 0.392049E-01
+ PKER_GWETH( 33, 25) = 0.286250E-01
+ PKER_GWETH( 33, 26) = 0.236572E-01
+ PKER_GWETH( 33, 27) = 0.238365E-01
+ PKER_GWETH( 33, 28) = 0.278819E-01
+ PKER_GWETH( 33, 29) = 0.340844E-01
+ PKER_GWETH( 33, 30) = 0.409301E-01
+ PKER_GWETH( 33, 31) = 0.474629E-01
+ PKER_GWETH( 33, 32) = 0.532693E-01
+ PKER_GWETH( 33, 33) = 0.582626E-01
+ PKER_GWETH( 33, 34) = 0.624951E-01
+ PKER_GWETH( 33, 35) = 0.660590E-01
+ PKER_GWETH( 33, 36) = 0.690501E-01
+ PKER_GWETH( 33, 37) = 0.715563E-01
+ PKER_GWETH( 33, 38) = 0.736552E-01
+ PKER_GWETH( 33, 39) = 0.754134E-01
+ PKER_GWETH( 33, 40) = 0.768875E-01
+ PKER_GWETH( 34, 1) = 0.399983E+01
+ PKER_GWETH( 34, 2) = 0.341326E+01
+ PKER_GWETH( 34, 3) = 0.291133E+01
+ PKER_GWETH( 34, 4) = 0.248183E+01
+ PKER_GWETH( 34, 5) = 0.211430E+01
+ PKER_GWETH( 34, 6) = 0.179980E+01
+ PKER_GWETH( 34, 7) = 0.153067E+01
+ PKER_GWETH( 34, 8) = 0.130036E+01
+ PKER_GWETH( 34, 9) = 0.110326E+01
+ PKER_GWETH( 34, 10) = 0.934592E+00
+ PKER_GWETH( 34, 11) = 0.790235E+00
+ PKER_GWETH( 34, 12) = 0.666681E+00
+ PKER_GWETH( 34, 13) = 0.560923E+00
+ PKER_GWETH( 34, 14) = 0.470390E+00
+ PKER_GWETH( 34, 15) = 0.392879E+00
+ PKER_GWETH( 34, 16) = 0.326507E+00
+ PKER_GWETH( 34, 17) = 0.269660E+00
+ PKER_GWETH( 34, 18) = 0.220959E+00
+ PKER_GWETH( 34, 19) = 0.179227E+00
+ PKER_GWETH( 34, 20) = 0.143471E+00
+ PKER_GWETH( 34, 21) = 0.112870E+00
+ PKER_GWETH( 34, 22) = 0.867966E-01
+ PKER_GWETH( 34, 23) = 0.648649E-01
+ PKER_GWETH( 34, 24) = 0.469859E-01
+ PKER_GWETH( 34, 25) = 0.333789E-01
+ PKER_GWETH( 34, 26) = 0.244190E-01
+ PKER_GWETH( 34, 27) = 0.202775E-01
+ PKER_GWETH( 34, 28) = 0.205384E-01
+ PKER_GWETH( 34, 29) = 0.240824E-01
+ PKER_GWETH( 34, 30) = 0.294450E-01
+ PKER_GWETH( 34, 31) = 0.353303E-01
+ PKER_GWETH( 34, 32) = 0.409329E-01
+ PKER_GWETH( 34, 33) = 0.459069E-01
+ PKER_GWETH( 34, 34) = 0.501829E-01
+ PKER_GWETH( 34, 35) = 0.538071E-01
+ PKER_GWETH( 34, 36) = 0.568588E-01
+ PKER_GWETH( 34, 37) = 0.594200E-01
+ PKER_GWETH( 34, 38) = 0.615661E-01
+ PKER_GWETH( 34, 39) = 0.633633E-01
+ PKER_GWETH( 34, 40) = 0.648688E-01
+ PKER_GWETH( 35, 1) = 0.400885E+01
+ PKER_GWETH( 35, 2) = 0.342229E+01
+ PKER_GWETH( 35, 3) = 0.292037E+01
+ PKER_GWETH( 35, 4) = 0.249089E+01
+ PKER_GWETH( 35, 5) = 0.212337E+01
+ PKER_GWETH( 35, 6) = 0.180889E+01
+ PKER_GWETH( 35, 7) = 0.153978E+01
+ PKER_GWETH( 35, 8) = 0.130949E+01
+ PKER_GWETH( 35, 9) = 0.111242E+01
+ PKER_GWETH( 35, 10) = 0.943777E+00
+ PKER_GWETH( 35, 11) = 0.799449E+00
+ PKER_GWETH( 35, 12) = 0.675926E+00
+ PKER_GWETH( 35, 13) = 0.570204E+00
+ PKER_GWETH( 35, 14) = 0.479710E+00
+ PKER_GWETH( 35, 15) = 0.402243E+00
+ PKER_GWETH( 35, 16) = 0.335919E+00
+ PKER_GWETH( 35, 17) = 0.279126E+00
+ PKER_GWETH( 35, 18) = 0.230483E+00
+ PKER_GWETH( 35, 19) = 0.188811E+00
+ PKER_GWETH( 35, 20) = 0.153102E+00
+ PKER_GWETH( 35, 21) = 0.122507E+00
+ PKER_GWETH( 35, 22) = 0.963249E-01
+ PKER_GWETH( 35, 23) = 0.740223E-01
+ PKER_GWETH( 35, 24) = 0.552721E-01
+ PKER_GWETH( 35, 25) = 0.400067E-01
+ PKER_GWETH( 35, 26) = 0.284193E-01
+ PKER_GWETH( 35, 27) = 0.208328E-01
+ PKER_GWETH( 35, 28) = 0.173845E-01
+ PKER_GWETH( 35, 29) = 0.176984E-01
+ PKER_GWETH( 35, 30) = 0.208008E-01
+ PKER_GWETH( 35, 31) = 0.254366E-01
+ PKER_GWETH( 35, 32) = 0.304959E-01
+ PKER_GWETH( 35, 33) = 0.353005E-01
+ PKER_GWETH( 35, 34) = 0.395615E-01
+ PKER_GWETH( 35, 35) = 0.432232E-01
+ PKER_GWETH( 35, 36) = 0.463265E-01
+ PKER_GWETH( 35, 37) = 0.489396E-01
+ PKER_GWETH( 35, 38) = 0.511328E-01
+ PKER_GWETH( 35, 39) = 0.529704E-01
+ PKER_GWETH( 35, 40) = 0.545093E-01
+ PKER_GWETH( 36, 1) = 0.401659E+01
+ PKER_GWETH( 36, 2) = 0.343004E+01
+ PKER_GWETH( 36, 3) = 0.292814E+01
+ PKER_GWETH( 36, 4) = 0.249866E+01
+ PKER_GWETH( 36, 5) = 0.213116E+01
+ PKER_GWETH( 36, 6) = 0.181669E+01
+ PKER_GWETH( 36, 7) = 0.154760E+01
+ PKER_GWETH( 36, 8) = 0.131733E+01
+ PKER_GWETH( 36, 9) = 0.112028E+01
+ PKER_GWETH( 36, 10) = 0.951650E+00
+ PKER_GWETH( 36, 11) = 0.807344E+00
+ PKER_GWETH( 36, 12) = 0.683846E+00
+ PKER_GWETH( 36, 13) = 0.578151E+00
+ PKER_GWETH( 36, 14) = 0.487687E+00
+ PKER_GWETH( 36, 15) = 0.410254E+00
+ PKER_GWETH( 36, 16) = 0.343967E+00
+ PKER_GWETH( 36, 17) = 0.287216E+00
+ PKER_GWETH( 36, 18) = 0.238619E+00
+ PKER_GWETH( 36, 19) = 0.196997E+00
+ PKER_GWETH( 36, 20) = 0.161339E+00
+ PKER_GWETH( 36, 21) = 0.130784E+00
+ PKER_GWETH( 36, 22) = 0.104605E+00
+ PKER_GWETH( 36, 23) = 0.822039E-01
+ PKER_GWETH( 36, 24) = 0.631264E-01
+ PKER_GWETH( 36, 25) = 0.470971E-01
+ PKER_GWETH( 36, 26) = 0.340633E-01
+ PKER_GWETH( 36, 27) = 0.241971E-01
+ PKER_GWETH( 36, 28) = 0.177747E-01
+ PKER_GWETH( 36, 29) = 0.149054E-01
+ PKER_GWETH( 36, 30) = 0.152534E-01
+ PKER_GWETH( 36, 31) = 0.179676E-01
+ PKER_GWETH( 36, 32) = 0.219736E-01
+ PKER_GWETH( 36, 33) = 0.263223E-01
+ PKER_GWETH( 36, 34) = 0.304424E-01
+ PKER_GWETH( 36, 35) = 0.340925E-01
+ PKER_GWETH( 36, 36) = 0.372283E-01
+ PKER_GWETH( 36, 37) = 0.398856E-01
+ PKER_GWETH( 36, 38) = 0.421231E-01
+ PKER_GWETH( 36, 39) = 0.440011E-01
+ PKER_GWETH( 36, 40) = 0.455746E-01
+ PKER_GWETH( 37, 1) = 0.402324E+01
+ PKER_GWETH( 37, 2) = 0.343670E+01
+ PKER_GWETH( 37, 3) = 0.293480E+01
+ PKER_GWETH( 37, 4) = 0.250534E+01
+ PKER_GWETH( 37, 5) = 0.213785E+01
+ PKER_GWETH( 37, 6) = 0.182339E+01
+ PKER_GWETH( 37, 7) = 0.155431E+01
+ PKER_GWETH( 37, 8) = 0.132405E+01
+ PKER_GWETH( 37, 9) = 0.112701E+01
+ PKER_GWETH( 37, 10) = 0.958401E+00
+ PKER_GWETH( 37, 11) = 0.814112E+00
+ PKER_GWETH( 37, 12) = 0.690632E+00
+ PKER_GWETH( 37, 13) = 0.584959E+00
+ PKER_GWETH( 37, 14) = 0.494518E+00
+ PKER_GWETH( 37, 15) = 0.417111E+00
+ PKER_GWETH( 37, 16) = 0.350853E+00
+ PKER_GWETH( 37, 17) = 0.294134E+00
+ PKER_GWETH( 37, 18) = 0.245573E+00
+ PKER_GWETH( 37, 19) = 0.203990E+00
+ PKER_GWETH( 37, 20) = 0.168374E+00
+ PKER_GWETH( 37, 21) = 0.137863E+00
+ PKER_GWETH( 37, 22) = 0.111718E+00
+ PKER_GWETH( 37, 23) = 0.893180E-01
+ PKER_GWETH( 37, 24) = 0.701520E-01
+ PKER_GWETH( 37, 25) = 0.538333E-01
+ PKER_GWETH( 37, 26) = 0.401301E-01
+ PKER_GWETH( 37, 27) = 0.290025E-01
+ PKER_GWETH( 37, 28) = 0.206023E-01
+ PKER_GWETH( 37, 29) = 0.151665E-01
+ PKER_GWETH( 37, 30) = 0.127824E-01
+ PKER_GWETH( 37, 31) = 0.131471E-01
+ PKER_GWETH( 37, 32) = 0.155224E-01
+ PKER_GWETH( 37, 33) = 0.189819E-01
+ PKER_GWETH( 37, 34) = 0.227194E-01
+ PKER_GWETH( 37, 35) = 0.262523E-01
+ PKER_GWETH( 37, 36) = 0.293792E-01
+ PKER_GWETH( 37, 37) = 0.320645E-01
+ PKER_GWETH( 37, 38) = 0.343398E-01
+ PKER_GWETH( 37, 39) = 0.362558E-01
+ PKER_GWETH( 37, 40) = 0.378639E-01
+ PKER_GWETH( 38, 1) = 0.402895E+01
+ PKER_GWETH( 38, 2) = 0.344242E+01
+ PKER_GWETH( 38, 3) = 0.294053E+01
+ PKER_GWETH( 38, 4) = 0.251107E+01
+ PKER_GWETH( 38, 5) = 0.214359E+01
+ PKER_GWETH( 38, 6) = 0.182914E+01
+ PKER_GWETH( 38, 7) = 0.156006E+01
+ PKER_GWETH( 38, 8) = 0.132981E+01
+ PKER_GWETH( 38, 9) = 0.113279E+01
+ PKER_GWETH( 38, 10) = 0.964190E+00
+ PKER_GWETH( 38, 11) = 0.819914E+00
+ PKER_GWETH( 38, 12) = 0.696450E+00
+ PKER_GWETH( 38, 13) = 0.590792E+00
+ PKER_GWETH( 38, 14) = 0.500370E+00
+ PKER_GWETH( 38, 15) = 0.422983E+00
+ PKER_GWETH( 38, 16) = 0.356747E+00
+ PKER_GWETH( 38, 17) = 0.300052E+00
+ PKER_GWETH( 38, 18) = 0.251519E+00
+ PKER_GWETH( 38, 19) = 0.209967E+00
+ PKER_GWETH( 38, 20) = 0.174385E+00
+ PKER_GWETH( 38, 21) = 0.143910E+00
+ PKER_GWETH( 38, 22) = 0.117802E+00
+ PKER_GWETH( 38, 23) = 0.954303E-01
+ PKER_GWETH( 38, 24) = 0.762638E-01
+ PKER_GWETH( 38, 25) = 0.598658E-01
+ PKER_GWETH( 38, 26) = 0.459071E-01
+ PKER_GWETH( 38, 27) = 0.341928E-01
+ PKER_GWETH( 38, 28) = 0.246931E-01
+ PKER_GWETH( 38, 29) = 0.175423E-01
+ PKER_GWETH( 38, 30) = 0.129417E-01
+ PKER_GWETH( 38, 31) = 0.109632E-01
+ PKER_GWETH( 38, 32) = 0.113331E-01
+ PKER_GWETH( 38, 33) = 0.134114E-01
+ PKER_GWETH( 38, 34) = 0.163971E-01
+ PKER_GWETH( 38, 35) = 0.196092E-01
+ PKER_GWETH( 38, 36) = 0.226384E-01
+ PKER_GWETH( 38, 37) = 0.253171E-01
+ PKER_GWETH( 38, 38) = 0.276166E-01
+ PKER_GWETH( 38, 39) = 0.295649E-01
+ PKER_GWETH( 38, 40) = 0.312055E-01
+ PKER_GWETH( 39, 1) = 0.403386E+01
+ PKER_GWETH( 39, 2) = 0.344733E+01
+ PKER_GWETH( 39, 3) = 0.294544E+01
+ PKER_GWETH( 39, 4) = 0.251599E+01
+ PKER_GWETH( 39, 5) = 0.214851E+01
+ PKER_GWETH( 39, 6) = 0.183407E+01
+ PKER_GWETH( 39, 7) = 0.156500E+01
+ PKER_GWETH( 39, 8) = 0.133476E+01
+ PKER_GWETH( 39, 9) = 0.113775E+01
+ PKER_GWETH( 39, 10) = 0.969156E+00
+ PKER_GWETH( 39, 11) = 0.824891E+00
+ PKER_GWETH( 39, 12) = 0.701438E+00
+ PKER_GWETH( 39, 13) = 0.595793E+00
+ PKER_GWETH( 39, 14) = 0.505385E+00
+ PKER_GWETH( 39, 15) = 0.428013E+00
+ PKER_GWETH( 39, 16) = 0.361794E+00
+ PKER_GWETH( 39, 17) = 0.305119E+00
+ PKER_GWETH( 39, 18) = 0.256606E+00
+ PKER_GWETH( 39, 19) = 0.215077E+00
+ PKER_GWETH( 39, 20) = 0.179522E+00
+ PKER_GWETH( 39, 21) = 0.149076E+00
+ PKER_GWETH( 39, 22) = 0.122999E+00
+ PKER_GWETH( 39, 23) = 0.100659E+00
+ PKER_GWETH( 39, 24) = 0.815164E-01
+ PKER_GWETH( 39, 25) = 0.651166E-01
+ PKER_GWETH( 39, 26) = 0.510868E-01
+ PKER_GWETH( 39, 27) = 0.391471E-01
+ PKER_GWETH( 39, 28) = 0.291332E-01
+ PKER_GWETH( 39, 29) = 0.210237E-01
+ PKER_GWETH( 39, 30) = 0.149369E-01
+ PKER_GWETH( 39, 31) = 0.110445E-01
+ PKER_GWETH( 39, 32) = 0.940454E-02
+ PKER_GWETH( 39, 33) = 0.977022E-02
+ PKER_GWETH( 39, 34) = 0.115877E-01
+ PKER_GWETH( 39, 35) = 0.141642E-01
+ PKER_GWETH( 39, 36) = 0.169244E-01
+ PKER_GWETH( 39, 37) = 0.195216E-01
+ PKER_GWETH( 39, 38) = 0.218162E-01
+ PKER_GWETH( 39, 39) = 0.237854E-01
+ PKER_GWETH( 39, 40) = 0.254537E-01
+ PKER_GWETH( 40, 1) = 0.403807E+01
+ PKER_GWETH( 40, 2) = 0.345154E+01
+ PKER_GWETH( 40, 3) = 0.294966E+01
+ PKER_GWETH( 40, 4) = 0.252021E+01
+ PKER_GWETH( 40, 5) = 0.215274E+01
+ PKER_GWETH( 40, 6) = 0.183830E+01
+ PKER_GWETH( 40, 7) = 0.156924E+01
+ PKER_GWETH( 40, 8) = 0.133901E+01
+ PKER_GWETH( 40, 9) = 0.114200E+01
+ PKER_GWETH( 40, 10) = 0.973417E+00
+ PKER_GWETH( 40, 11) = 0.829160E+00
+ PKER_GWETH( 40, 12) = 0.705716E+00
+ PKER_GWETH( 40, 13) = 0.600081E+00
+ PKER_GWETH( 40, 14) = 0.509684E+00
+ PKER_GWETH( 40, 15) = 0.432323E+00
+ PKER_GWETH( 40, 16) = 0.366118E+00
+ PKER_GWETH( 40, 17) = 0.309457E+00
+ PKER_GWETH( 40, 18) = 0.260961E+00
+ PKER_GWETH( 40, 19) = 0.219450E+00
+ PKER_GWETH( 40, 20) = 0.183915E+00
+ PKER_GWETH( 40, 21) = 0.153491E+00
+ PKER_GWETH( 40, 22) = 0.127439E+00
+ PKER_GWETH( 40, 23) = 0.105126E+00
+ PKER_GWETH( 40, 24) = 0.860101E-01
+ PKER_GWETH( 40, 25) = 0.696304E-01
+ PKER_GWETH( 40, 26) = 0.555979E-01
+ PKER_GWETH( 40, 27) = 0.435944E-01
+ PKER_GWETH( 40, 28) = 0.333818E-01
+ PKER_GWETH( 40, 29) = 0.248216E-01
+ PKER_GWETH( 40, 30) = 0.178993E-01
+ PKER_GWETH( 40, 31) = 0.127187E-01
+ PKER_GWETH( 40, 32) = 0.942720E-02
+ PKER_GWETH( 40, 33) = 0.806858E-02
+ PKER_GWETH( 40, 34) = 0.842367E-02
+ PKER_GWETH( 40, 35) = 0.100117E-01
+ PKER_GWETH( 40, 36) = 0.122351E-01
+ PKER_GWETH( 40, 37) = 0.146068E-01
+ PKER_GWETH( 40, 38) = 0.168337E-01
+ PKER_GWETH( 40, 39) = 0.187992E-01
+ PKER_GWETH( 40, 40) = 0.204855E-01
+END IF
+!
+END SUBROUTINE READ_XKER_GWETH
diff --git a/src/mesonh/micro/read_xker_raccs.f90 b/src/mesonh/micro/read_xker_raccs.f90
new file mode 100644
index 000000000..c7a7253cc
--- /dev/null
+++ b/src/mesonh/micro/read_xker_raccs.f90
@@ -0,0 +1,4950 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 init 2006/05/18 13:07:25
+!-----------------------------------------------------------------
+! ###########################
+ MODULE MODI_READ_XKER_RACCS
+! ###########################
+!
+INTERFACE
+ SUBROUTINE READ_XKER_RACCS (KACCLBDAS,KACCLBDAR,KND, &
+ PALPHAS,PNUS,PALPHAR,PNUR,PESR,PBS,PBR,PCS,PDS,PCR,PDR, &
+ PACCLBDAS_MAX,PACCLBDAR_MAX,PACCLBDAS_MIN,PACCLBDAR_MIN, &
+ PFDINFTY,PKER_RACCSS,PKER_RACCS,PKER_SACCRG )
+!
+INTEGER, INTENT(OUT) :: KND,KACCLBDAS,KACCLBDAR
+REAL, INTENT(OUT) :: PALPHAS
+REAL, INTENT(OUT) :: PNUS
+REAL, INTENT(OUT) :: PALPHAR
+REAL, INTENT(OUT) :: PNUR
+REAL, INTENT(OUT) :: PESR
+REAL, INTENT(OUT) :: PBS
+REAL, INTENT(OUT) :: PBR
+REAL, INTENT(OUT) :: PCS
+REAL, INTENT(OUT) :: PDS
+REAL, INTENT(OUT) :: PCR
+REAL, INTENT(OUT) :: PDR
+REAL, INTENT(OUT) :: PACCLBDAS_MAX
+REAL, INTENT(OUT) :: PACCLBDAR_MAX
+REAL, INTENT(OUT) :: PACCLBDAS_MIN
+REAL, INTENT(OUT) :: PACCLBDAR_MIN
+REAL, INTENT(OUT) :: PFDINFTY
+REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_RACCSS
+REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_RACCS
+REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_SACCRG
+!
+END SUBROUTINE
+!
+END INTERFACE
+!
+END MODULE MODI_READ_XKER_RACCS
+! ##########################################################################
+ SUBROUTINE READ_XKER_RACCS (KACCLBDAS,KACCLBDAR,KND, &
+ PALPHAS,PNUS,PALPHAR,PNUR,PESR,PBS,PBR,PCS,PDS,PCR,PDR, &
+ PACCLBDAS_MAX,PACCLBDAR_MAX,PACCLBDAS_MIN,PACCLBDAR_MIN, &
+ PFDINFTY,PKER_RACCSS,PKER_RACCS,PKER_SACCRG )
+! ##########################################################################
+!
+!!**** * * - initialize the kernels for the rain-snow accretion process
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to initialize the kernels PKER_RACCSS,
+!! PKER_RACCS and PKER_SACCRG prepared from a previous run of the routine
+!! INI_RAIN_ICE. The reading of the kernels is optional after checking for
+!! the dimensions of the arrays.
+!!
+!!** METHOD
+!! ------
+!!
+!!
+!! EXTERNAL
+!! --------
+!! None
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation ( routine READ_XKER_RACCS )
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 09/04/96
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!* 0.2 Declarations of local variables :
+!
+!
+INTEGER, INTENT(OUT) :: KND,KACCLBDAS,KACCLBDAR
+REAL, INTENT(OUT) :: PALPHAS
+REAL, INTENT(OUT) :: PNUS
+REAL, INTENT(OUT) :: PALPHAR
+REAL, INTENT(OUT) :: PNUR
+REAL, INTENT(OUT) :: PESR
+REAL, INTENT(OUT) :: PBS
+REAL, INTENT(OUT) :: PBR
+REAL, INTENT(OUT) :: PCS
+REAL, INTENT(OUT) :: PDS
+REAL, INTENT(OUT) :: PCR
+REAL, INTENT(OUT) :: PDR
+REAL, INTENT(OUT) :: PACCLBDAS_MAX
+REAL, INTENT(OUT) :: PACCLBDAR_MAX
+REAL, INTENT(OUT) :: PACCLBDAS_MIN
+REAL, INTENT(OUT) :: PACCLBDAR_MIN
+REAL, INTENT(OUT) :: PFDINFTY
+REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_RACCSS
+REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_RACCS
+REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_SACCRG
+!
+! ###################################################################
+! #INSERT HERE THE OUTPUT OF INI_RAIN_ICE IF THE KERNELS ARE UPDATED#
+! ###################################################################
+!
+KND= 50
+KACCLBDAS= 40
+KACCLBDAR= 40
+PALPHAS= 0.100000E+01
+PNUS= 0.100000E+01
+PALPHAR= 0.100000E+01
+PNUR= 0.100000E+01
+PESR= 0.100000E+01
+PBS= 0.190000E+01
+PBR= 0.300000E+01
+PCS= 0.510000E+01
+PDS= 0.270000E+00
+PCR= 0.842000E+03
+PDR= 0.800000E+00
+PACCLBDAS_MAX= 0.500000E+06
+PACCLBDAR_MAX= 0.100000E+08
+PACCLBDAS_MIN= 0.500000E+02
+PACCLBDAR_MIN= 0.100000E+04
+PFDINFTY= 0.200000E+02
+!
+IF( PRESENT(PKER_RACCSS) ) THEN
+ PKER_RACCSS( 1, 1) = 0.778513E+01
+ PKER_RACCSS( 1, 2) = 0.611693E+01
+ PKER_RACCSS( 1, 3) = 0.469673E+01
+ PKER_RACCSS( 1, 4) = 0.351291E+01
+ PKER_RACCSS( 1, 5) = 0.255165E+01
+ PKER_RACCSS( 1, 6) = 0.180370E+01
+ PKER_RACCSS( 1, 7) = 0.126294E+01
+ PKER_RACCSS( 1, 8) = 0.924202E+00
+ PKER_RACCSS( 1, 9) = 0.775231E+00
+ PKER_RACCSS( 1, 10) = 0.787292E+00
+ PKER_RACCSS( 1, 11) = 0.911536E+00
+ PKER_RACCSS( 1, 12) = 0.109094E+01
+ PKER_RACCSS( 1, 13) = 0.127926E+01
+ PKER_RACCSS( 1, 14) = 0.145083E+01
+ PKER_RACCSS( 1, 15) = 0.159745E+01
+ PKER_RACCSS( 1, 16) = 0.171978E+01
+ PKER_RACCSS( 1, 17) = 0.182114E+01
+ PKER_RACCSS( 1, 18) = 0.190501E+01
+ PKER_RACCSS( 1, 19) = 0.197441E+01
+ PKER_RACCSS( 1, 20) = 0.203184E+01
+ PKER_RACCSS( 1, 21) = 0.207937E+01
+ PKER_RACCSS( 1, 22) = 0.211870E+01
+ PKER_RACCSS( 1, 23) = 0.215125E+01
+ PKER_RACCSS( 1, 24) = 0.217819E+01
+ PKER_RACCSS( 1, 25) = 0.220049E+01
+ PKER_RACCSS( 1, 26) = 0.221895E+01
+ PKER_RACCSS( 1, 27) = 0.223423E+01
+ PKER_RACCSS( 1, 28) = 0.224687E+01
+ PKER_RACCSS( 1, 29) = 0.225734E+01
+ PKER_RACCSS( 1, 30) = 0.226601E+01
+ PKER_RACCSS( 1, 31) = 0.227318E+01
+ PKER_RACCSS( 1, 32) = 0.227911E+01
+ PKER_RACCSS( 1, 33) = 0.228403E+01
+ PKER_RACCSS( 1, 34) = 0.228810E+01
+ PKER_RACCSS( 1, 35) = 0.229146E+01
+ PKER_RACCSS( 1, 36) = 0.229425E+01
+ PKER_RACCSS( 1, 37) = 0.229656E+01
+ PKER_RACCSS( 1, 38) = 0.229847E+01
+ PKER_RACCSS( 1, 39) = 0.230005E+01
+ PKER_RACCSS( 1, 40) = 0.230136E+01
+ PKER_RACCSS( 2, 1) = 0.777519E+01
+ PKER_RACCSS( 2, 2) = 0.620120E+01
+ PKER_RACCSS( 2, 3) = 0.482130E+01
+ PKER_RACCSS( 2, 4) = 0.365151E+01
+ PKER_RACCSS( 2, 5) = 0.268556E+01
+ PKER_RACCSS( 2, 6) = 0.191605E+01
+ PKER_RACCSS( 2, 7) = 0.134047E+01
+ PKER_RACCSS( 2, 8) = 0.956677E+00
+ PKER_RACCSS( 2, 9) = 0.757265E+00
+ PKER_RACCSS( 2, 10) = 0.720633E+00
+ PKER_RACCSS( 2, 11) = 0.806882E+00
+ PKER_RACCSS( 2, 12) = 0.963181E+00
+ PKER_RACCSS( 2, 13) = 0.114076E+01
+ PKER_RACCSS( 2, 14) = 0.130870E+01
+ PKER_RACCSS( 2, 15) = 0.145451E+01
+ PKER_RACCSS( 2, 16) = 0.157680E+01
+ PKER_RACCSS( 2, 17) = 0.167825E+01
+ PKER_RACCSS( 2, 18) = 0.176221E+01
+ PKER_RACCSS( 2, 19) = 0.183168E+01
+ PKER_RACCSS( 2, 20) = 0.188915E+01
+ PKER_RACCSS( 2, 21) = 0.193671E+01
+ PKER_RACCSS( 2, 22) = 0.197607E+01
+ PKER_RACCSS( 2, 23) = 0.200864E+01
+ PKER_RACCSS( 2, 24) = 0.203559E+01
+ PKER_RACCSS( 2, 25) = 0.205790E+01
+ PKER_RACCSS( 2, 26) = 0.207637E+01
+ PKER_RACCSS( 2, 27) = 0.209165E+01
+ PKER_RACCSS( 2, 28) = 0.210430E+01
+ PKER_RACCSS( 2, 29) = 0.211478E+01
+ PKER_RACCSS( 2, 30) = 0.212344E+01
+ PKER_RACCSS( 2, 31) = 0.213062E+01
+ PKER_RACCSS( 2, 32) = 0.213656E+01
+ PKER_RACCSS( 2, 33) = 0.214147E+01
+ PKER_RACCSS( 2, 34) = 0.214554E+01
+ PKER_RACCSS( 2, 35) = 0.214891E+01
+ PKER_RACCSS( 2, 36) = 0.215170E+01
+ PKER_RACCSS( 2, 37) = 0.215401E+01
+ PKER_RACCSS( 2, 38) = 0.215592E+01
+ PKER_RACCSS( 2, 39) = 0.215750E+01
+ PKER_RACCSS( 2, 40) = 0.215881E+01
+ PKER_RACCSS( 3, 1) = 0.762215E+01
+ PKER_RACCSS( 3, 2) = 0.621106E+01
+ PKER_RACCSS( 3, 3) = 0.490698E+01
+ PKER_RACCSS( 3, 4) = 0.376761E+01
+ PKER_RACCSS( 3, 5) = 0.280896E+01
+ PKER_RACCSS( 3, 6) = 0.202903E+01
+ PKER_RACCSS( 3, 7) = 0.142689E+01
+ PKER_RACCSS( 3, 8) = 0.100388E+01
+ PKER_RACCSS( 3, 9) = 0.757013E+00
+ PKER_RACCSS( 3, 10) = 0.673206E+00
+ PKER_RACCSS( 3, 11) = 0.719335E+00
+ PKER_RACCSS( 3, 12) = 0.849040E+00
+ PKER_RACCSS( 3, 13) = 0.101307E+01
+ PKER_RACCSS( 3, 14) = 0.117592E+01
+ PKER_RACCSS( 3, 15) = 0.132041E+01
+ PKER_RACCSS( 3, 16) = 0.144256E+01
+ PKER_RACCSS( 3, 17) = 0.154410E+01
+ PKER_RACCSS( 3, 18) = 0.162816E+01
+ PKER_RACCSS( 3, 19) = 0.169770E+01
+ PKER_RACCSS( 3, 20) = 0.175523E+01
+ PKER_RACCSS( 3, 21) = 0.180284E+01
+ PKER_RACCSS( 3, 22) = 0.184222E+01
+ PKER_RACCSS( 3, 23) = 0.187482E+01
+ PKER_RACCSS( 3, 24) = 0.190179E+01
+ PKER_RACCSS( 3, 25) = 0.192411E+01
+ PKER_RACCSS( 3, 26) = 0.194259E+01
+ PKER_RACCSS( 3, 27) = 0.195788E+01
+ PKER_RACCSS( 3, 28) = 0.197054E+01
+ PKER_RACCSS( 3, 29) = 0.198101E+01
+ PKER_RACCSS( 3, 30) = 0.198968E+01
+ PKER_RACCSS( 3, 31) = 0.199686E+01
+ PKER_RACCSS( 3, 32) = 0.200280E+01
+ PKER_RACCSS( 3, 33) = 0.200772E+01
+ PKER_RACCSS( 3, 34) = 0.201179E+01
+ PKER_RACCSS( 3, 35) = 0.201516E+01
+ PKER_RACCSS( 3, 36) = 0.201795E+01
+ PKER_RACCSS( 3, 37) = 0.202026E+01
+ PKER_RACCSS( 3, 38) = 0.202217E+01
+ PKER_RACCSS( 3, 39) = 0.202375E+01
+ PKER_RACCSS( 3, 40) = 0.202506E+01
+ PKER_RACCSS( 4, 1) = 0.726688E+01
+ PKER_RACCSS( 4, 2) = 0.610352E+01
+ PKER_RACCSS( 4, 3) = 0.493154E+01
+ PKER_RACCSS( 4, 4) = 0.385226E+01
+ PKER_RACCSS( 4, 5) = 0.291497E+01
+ PKER_RACCSS( 4, 6) = 0.213576E+01
+ PKER_RACCSS( 4, 7) = 0.151726E+01
+ PKER_RACCSS( 4, 8) = 0.106239E+01
+ PKER_RACCSS( 4, 9) = 0.773458E+00
+ PKER_RACCSS( 4, 10) = 0.643197E+00
+ PKER_RACCSS( 4, 11) = 0.648455E+00
+ PKER_RACCSS( 4, 12) = 0.748702E+00
+ PKER_RACCSS( 4, 13) = 0.896286E+00
+ PKER_RACCSS( 4, 14) = 0.105225E+01
+ PKER_RACCSS( 4, 15) = 0.119469E+01
+ PKER_RACCSS( 4, 16) = 0.131651E+01
+ PKER_RACCSS( 4, 17) = 0.141813E+01
+ PKER_RACCSS( 4, 18) = 0.150231E+01
+ PKER_RACCSS( 4, 19) = 0.157195E+01
+ PKER_RACCSS( 4, 20) = 0.162955E+01
+ PKER_RACCSS( 4, 21) = 0.167720E+01
+ PKER_RACCSS( 4, 22) = 0.171662E+01
+ PKER_RACCSS( 4, 23) = 0.174924E+01
+ PKER_RACCSS( 4, 24) = 0.177624E+01
+ PKER_RACCSS( 4, 25) = 0.179858E+01
+ PKER_RACCSS( 4, 26) = 0.181706E+01
+ PKER_RACCSS( 4, 27) = 0.183237E+01
+ PKER_RACCSS( 4, 28) = 0.184503E+01
+ PKER_RACCSS( 4, 29) = 0.185551E+01
+ PKER_RACCSS( 4, 30) = 0.186419E+01
+ PKER_RACCSS( 4, 31) = 0.187137E+01
+ PKER_RACCSS( 4, 32) = 0.187731E+01
+ PKER_RACCSS( 4, 33) = 0.188223E+01
+ PKER_RACCSS( 4, 34) = 0.188630E+01
+ PKER_RACCSS( 4, 35) = 0.188967E+01
+ PKER_RACCSS( 4, 36) = 0.189246E+01
+ PKER_RACCSS( 4, 37) = 0.189477E+01
+ PKER_RACCSS( 4, 38) = 0.189668E+01
+ PKER_RACCSS( 4, 39) = 0.189826E+01
+ PKER_RACCSS( 4, 40) = 0.189957E+01
+ PKER_RACCSS( 5, 1) = 0.666156E+01
+ PKER_RACCSS( 5, 2) = 0.583010E+01
+ PKER_RACCSS( 5, 3) = 0.485991E+01
+ PKER_RACCSS( 5, 4) = 0.388726E+01
+ PKER_RACCSS( 5, 5) = 0.299622E+01
+ PKER_RACCSS( 5, 6) = 0.223002E+01
+ PKER_RACCSS( 5, 7) = 0.160523E+01
+ PKER_RACCSS( 5, 8) = 0.112806E+01
+ PKER_RACCSS( 5, 9) = 0.803444E+00
+ PKER_RACCSS( 5, 10) = 0.630781E+00
+ PKER_RACCSS( 5, 11) = 0.594728E+00
+ PKER_RACCSS( 5, 12) = 0.662791E+00
+ PKER_RACCSS( 5, 13) = 0.790719E+00
+ PKER_RACCSS( 5, 14) = 0.937530E+00
+ PKER_RACCSS( 5, 15) = 0.107695E+01
+ PKER_RACCSS( 5, 16) = 0.119816E+01
+ PKER_RACCSS( 5, 17) = 0.129982E+01
+ PKER_RACCSS( 5, 18) = 0.138414E+01
+ PKER_RACCSS( 5, 19) = 0.145388E+01
+ PKER_RACCSS( 5, 20) = 0.151157E+01
+ PKER_RACCSS( 5, 21) = 0.155928E+01
+ PKER_RACCSS( 5, 22) = 0.159875E+01
+ PKER_RACCSS( 5, 23) = 0.163140E+01
+ PKER_RACCSS( 5, 24) = 0.165842E+01
+ PKER_RACCSS( 5, 25) = 0.168078E+01
+ PKER_RACCSS( 5, 26) = 0.169928E+01
+ PKER_RACCSS( 5, 27) = 0.171459E+01
+ PKER_RACCSS( 5, 28) = 0.172727E+01
+ PKER_RACCSS( 5, 29) = 0.173775E+01
+ PKER_RACCSS( 5, 30) = 0.174643E+01
+ PKER_RACCSS( 5, 31) = 0.175362E+01
+ PKER_RACCSS( 5, 32) = 0.175957E+01
+ PKER_RACCSS( 5, 33) = 0.176449E+01
+ PKER_RACCSS( 5, 34) = 0.176856E+01
+ PKER_RACCSS( 5, 35) = 0.177193E+01
+ PKER_RACCSS( 5, 36) = 0.177472E+01
+ PKER_RACCSS( 5, 37) = 0.177703E+01
+ PKER_RACCSS( 5, 38) = 0.177895E+01
+ PKER_RACCSS( 5, 39) = 0.178053E+01
+ PKER_RACCSS( 5, 40) = 0.178184E+01
+ PKER_RACCSS( 6, 1) = 0.579411E+01
+ PKER_RACCSS( 6, 2) = 0.535171E+01
+ PKER_RACCSS( 6, 3) = 0.465234E+01
+ PKER_RACCSS( 6, 4) = 0.384358E+01
+ PKER_RACCSS( 6, 5) = 0.303756E+01
+ PKER_RACCSS( 6, 6) = 0.230559E+01
+ PKER_RACCSS( 6, 7) = 0.168583E+01
+ PKER_RACCSS( 6, 8) = 0.119580E+01
+ PKER_RACCSS( 6, 9) = 0.843934E+00
+ PKER_RACCSS( 6, 10) = 0.633155E+00
+ PKER_RACCSS( 6, 11) = 0.557339E+00
+ PKER_RACCSS( 6, 12) = 0.591240E+00
+ PKER_RACCSS( 6, 13) = 0.696457E+00
+ PKER_RACCSS( 6, 14) = 0.831746E+00
+ PKER_RACCSS( 6, 15) = 0.966879E+00
+ PKER_RACCSS( 6, 16) = 0.108705E+01
+ PKER_RACCSS( 6, 17) = 0.118868E+01
+ PKER_RACCSS( 6, 18) = 0.127314E+01
+ PKER_RACCSS( 6, 19) = 0.134302E+01
+ PKER_RACCSS( 6, 20) = 0.140081E+01
+ PKER_RACCSS( 6, 21) = 0.144859E+01
+ PKER_RACCSS( 6, 22) = 0.148812E+01
+ PKER_RACCSS( 6, 23) = 0.152081E+01
+ PKER_RACCSS( 6, 24) = 0.154786E+01
+ PKER_RACCSS( 6, 25) = 0.157025E+01
+ PKER_RACCSS( 6, 26) = 0.158876E+01
+ PKER_RACCSS( 6, 27) = 0.160409E+01
+ PKER_RACCSS( 6, 28) = 0.161677E+01
+ PKER_RACCSS( 6, 29) = 0.162727E+01
+ PKER_RACCSS( 6, 30) = 0.163595E+01
+ PKER_RACCSS( 6, 31) = 0.164314E+01
+ PKER_RACCSS( 6, 32) = 0.164909E+01
+ PKER_RACCSS( 6, 33) = 0.165402E+01
+ PKER_RACCSS( 6, 34) = 0.165809E+01
+ PKER_RACCSS( 6, 35) = 0.166147E+01
+ PKER_RACCSS( 6, 36) = 0.166426E+01
+ PKER_RACCSS( 6, 37) = 0.166657E+01
+ PKER_RACCSS( 6, 38) = 0.166848E+01
+ PKER_RACCSS( 6, 39) = 0.167007E+01
+ PKER_RACCSS( 6, 40) = 0.167138E+01
+ PKER_RACCSS( 7, 1) = 0.471256E+01
+ PKER_RACCSS( 7, 2) = 0.465839E+01
+ PKER_RACCSS( 7, 3) = 0.427722E+01
+ PKER_RACCSS( 7, 4) = 0.368892E+01
+ PKER_RACCSS( 7, 5) = 0.301520E+01
+ PKER_RACCSS( 7, 6) = 0.234970E+01
+ PKER_RACCSS( 7, 7) = 0.175327E+01
+ PKER_RACCSS( 7, 8) = 0.126056E+01
+ PKER_RACCSS( 7, 9) = 0.889610E+00
+ PKER_RACCSS( 7, 10) = 0.648011E+00
+ PKER_RACCSS( 7, 11) = 0.534534E+00
+ PKER_RACCSS( 7, 12) = 0.533743E+00
+ PKER_RACCSS( 7, 13) = 0.613806E+00
+ PKER_RACCSS( 7, 14) = 0.735010E+00
+ PKER_RACCSS( 7, 15) = 0.864301E+00
+ PKER_RACCSS( 7, 16) = 0.982807E+00
+ PKER_RACCSS( 7, 17) = 0.108425E+01
+ PKER_RACCSS( 7, 18) = 0.116886E+01
+ PKER_RACCSS( 7, 19) = 0.123890E+01
+ PKER_RACCSS( 7, 20) = 0.129681E+01
+ PKER_RACCSS( 7, 21) = 0.134469E+01
+ PKER_RACCSS( 7, 22) = 0.138428E+01
+ PKER_RACCSS( 7, 23) = 0.141702E+01
+ PKER_RACCSS( 7, 24) = 0.144411E+01
+ PKER_RACCSS( 7, 25) = 0.146652E+01
+ PKER_RACCSS( 7, 26) = 0.148506E+01
+ PKER_RACCSS( 7, 27) = 0.150040E+01
+ PKER_RACCSS( 7, 28) = 0.151309E+01
+ PKER_RACCSS( 7, 29) = 0.152360E+01
+ PKER_RACCSS( 7, 30) = 0.153229E+01
+ PKER_RACCSS( 7, 31) = 0.153949E+01
+ PKER_RACCSS( 7, 32) = 0.154544E+01
+ PKER_RACCSS( 7, 33) = 0.155037E+01
+ PKER_RACCSS( 7, 34) = 0.155445E+01
+ PKER_RACCSS( 7, 35) = 0.155782E+01
+ PKER_RACCSS( 7, 36) = 0.156062E+01
+ PKER_RACCSS( 7, 37) = 0.156293E+01
+ PKER_RACCSS( 7, 38) = 0.156484E+01
+ PKER_RACCSS( 7, 39) = 0.156643E+01
+ PKER_RACCSS( 7, 40) = 0.156774E+01
+ PKER_RACCSS( 8, 1) = 0.353255E+01
+ PKER_RACCSS( 8, 2) = 0.378953E+01
+ PKER_RACCSS( 8, 3) = 0.372636E+01
+ PKER_RACCSS( 8, 4) = 0.339746E+01
+ PKER_RACCSS( 8, 5) = 0.290255E+01
+ PKER_RACCSS( 8, 6) = 0.234259E+01
+ PKER_RACCSS( 8, 7) = 0.179670E+01
+ PKER_RACCSS( 8, 8) = 0.131725E+01
+ PKER_RACCSS( 8, 9) = 0.936217E+00
+ PKER_RACCSS( 8, 10) = 0.670685E+00
+ PKER_RACCSS( 8, 11) = 0.525055E+00
+ PKER_RACCSS( 8, 12) = 0.490553E+00
+ PKER_RACCSS( 8, 13) = 0.543364E+00
+ PKER_RACCSS( 8, 14) = 0.647682E+00
+ PKER_RACCSS( 8, 15) = 0.769109E+00
+ PKER_RACCSS( 8, 16) = 0.885089E+00
+ PKER_RACCSS( 8, 17) = 0.986107E+00
+ PKER_RACCSS( 8, 18) = 0.107085E+01
+ PKER_RACCSS( 8, 19) = 0.114108E+01
+ PKER_RACCSS( 8, 20) = 0.119914E+01
+ PKER_RACCSS( 8, 21) = 0.124712E+01
+ PKER_RACCSS( 8, 22) = 0.128680E+01
+ PKER_RACCSS( 8, 23) = 0.131960E+01
+ PKER_RACCSS( 8, 24) = 0.134673E+01
+ PKER_RACCSS( 8, 25) = 0.136917E+01
+ PKER_RACCSS( 8, 26) = 0.138774E+01
+ PKER_RACCSS( 8, 27) = 0.140310E+01
+ PKER_RACCSS( 8, 28) = 0.141581E+01
+ PKER_RACCSS( 8, 29) = 0.142633E+01
+ PKER_RACCSS( 8, 30) = 0.143503E+01
+ PKER_RACCSS( 8, 31) = 0.144223E+01
+ PKER_RACCSS( 8, 32) = 0.144819E+01
+ PKER_RACCSS( 8, 33) = 0.145312E+01
+ PKER_RACCSS( 8, 34) = 0.145720E+01
+ PKER_RACCSS( 8, 35) = 0.146058E+01
+ PKER_RACCSS( 8, 36) = 0.146338E+01
+ PKER_RACCSS( 8, 37) = 0.146569E+01
+ PKER_RACCSS( 8, 38) = 0.146761E+01
+ PKER_RACCSS( 8, 39) = 0.146919E+01
+ PKER_RACCSS( 8, 40) = 0.147050E+01
+ PKER_RACCSS( 9, 1) = 0.240807E+01
+ PKER_RACCSS( 9, 2) = 0.283932E+01
+ PKER_RACCSS( 9, 3) = 0.303178E+01
+ PKER_RACCSS( 9, 4) = 0.296265E+01
+ PKER_RACCSS( 9, 5) = 0.267871E+01
+ PKER_RACCSS( 9, 6) = 0.226276E+01
+ PKER_RACCSS( 9, 7) = 0.179979E+01
+ PKER_RACCSS( 9, 8) = 0.135674E+01
+ PKER_RACCSS( 9, 9) = 0.979933E+00
+ PKER_RACCSS( 9, 10) = 0.698320E+00
+ PKER_RACCSS( 9, 11) = 0.525242E+00
+ PKER_RACCSS( 9, 12) = 0.460033E+00
+ PKER_RACCSS( 9, 13) = 0.484763E+00
+ PKER_RACCSS( 9, 14) = 0.569735E+00
+ PKER_RACCSS( 9, 15) = 0.681283E+00
+ PKER_RACCSS( 9, 16) = 0.793641E+00
+ PKER_RACCSS( 9, 17) = 0.893878E+00
+ PKER_RACCSS( 9, 18) = 0.978690E+00
+ PKER_RACCSS( 9, 19) = 0.104914E+01
+ PKER_RACCSS( 9, 20) = 0.110738E+01
+ PKER_RACCSS( 9, 21) = 0.115550E+01
+ PKER_RACCSS( 9, 22) = 0.119527E+01
+ PKER_RACCSS( 9, 23) = 0.122815E+01
+ PKER_RACCSS( 9, 24) = 0.125533E+01
+ PKER_RACCSS( 9, 25) = 0.127782E+01
+ PKER_RACCSS( 9, 26) = 0.129641E+01
+ PKER_RACCSS( 9, 27) = 0.131179E+01
+ PKER_RACCSS( 9, 28) = 0.132452E+01
+ PKER_RACCSS( 9, 29) = 0.133505E+01
+ PKER_RACCSS( 9, 30) = 0.134376E+01
+ PKER_RACCSS( 9, 31) = 0.135097E+01
+ PKER_RACCSS( 9, 32) = 0.135694E+01
+ PKER_RACCSS( 9, 33) = 0.136188E+01
+ PKER_RACCSS( 9, 34) = 0.136596E+01
+ PKER_RACCSS( 9, 35) = 0.136934E+01
+ PKER_RACCSS( 9, 36) = 0.137214E+01
+ PKER_RACCSS( 9, 37) = 0.137446E+01
+ PKER_RACCSS( 9, 38) = 0.137637E+01
+ PKER_RACCSS( 9, 39) = 0.137796E+01
+ PKER_RACCSS( 9, 40) = 0.137927E+01
+ PKER_RACCSS( 10, 1) = 0.147671E+01
+ PKER_RACCSS( 10, 2) = 0.193328E+01
+ PKER_RACCSS( 10, 3) = 0.227014E+01
+ PKER_RACCSS( 10, 4) = 0.241054E+01
+ PKER_RACCSS( 10, 5) = 0.233821E+01
+ PKER_RACCSS( 10, 6) = 0.209295E+01
+ PKER_RACCSS( 10, 7) = 0.174482E+01
+ PKER_RACCSS( 10, 8) = 0.136525E+01
+ PKER_RACCSS( 10, 9) = 0.101239E+01
+ PKER_RACCSS( 10, 10) = 0.726741E+00
+ PKER_RACCSS( 10, 11) = 0.533079E+00
+ PKER_RACCSS( 10, 12) = 0.439515E+00
+ PKER_RACCSS( 10, 13) = 0.437071E+00
+ PKER_RACCSS( 10, 14) = 0.501385E+00
+ PKER_RACCSS( 10, 15) = 0.600980E+00
+ PKER_RACCSS( 10, 16) = 0.708337E+00
+ PKER_RACCSS( 10, 17) = 0.807233E+00
+ PKER_RACCSS( 10, 18) = 0.892004E+00
+ PKER_RACCSS( 10, 19) = 0.962681E+00
+ PKER_RACCSS( 10, 20) = 0.102114E+01
+ PKER_RACCSS( 10, 21) = 0.106943E+01
+ PKER_RACCSS( 10, 22) = 0.110932E+01
+ PKER_RACCSS( 10, 23) = 0.114228E+01
+ PKER_RACCSS( 10, 24) = 0.116953E+01
+ PKER_RACCSS( 10, 25) = 0.119207E+01
+ PKER_RACCSS( 10, 26) = 0.121070E+01
+ PKER_RACCSS( 10, 27) = 0.122611E+01
+ PKER_RACCSS( 10, 28) = 0.123886E+01
+ PKER_RACCSS( 10, 29) = 0.124940E+01
+ PKER_RACCSS( 10, 30) = 0.125813E+01
+ PKER_RACCSS( 10, 31) = 0.126535E+01
+ PKER_RACCSS( 10, 32) = 0.127132E+01
+ PKER_RACCSS( 10, 33) = 0.127626E+01
+ PKER_RACCSS( 10, 34) = 0.128035E+01
+ PKER_RACCSS( 10, 35) = 0.128374E+01
+ PKER_RACCSS( 10, 36) = 0.128654E+01
+ PKER_RACCSS( 10, 37) = 0.128886E+01
+ PKER_RACCSS( 10, 38) = 0.129077E+01
+ PKER_RACCSS( 10, 39) = 0.129236E+01
+ PKER_RACCSS( 10, 40) = 0.129368E+01
+ PKER_RACCSS( 11, 1) = 0.808661E+00
+ PKER_RACCSS( 11, 2) = 0.118349E+01
+ PKER_RACCSS( 11, 3) = 0.154344E+01
+ PKER_RACCSS( 11, 4) = 0.180338E+01
+ PKER_RACCSS( 11, 5) = 0.190224E+01
+ PKER_RACCSS( 11, 6) = 0.182880E+01
+ PKER_RACCSS( 11, 7) = 0.161765E+01
+ PKER_RACCSS( 11, 8) = 0.132833E+01
+ PKER_RACCSS( 11, 9) = 0.102209E+01
+ PKER_RACCSS( 11, 10) = 0.749176E+00
+ PKER_RACCSS( 11, 11) = 0.544780E+00
+ PKER_RACCSS( 11, 12) = 0.428018E+00
+ PKER_RACCSS( 11, 13) = 0.399615E+00
+ PKER_RACCSS( 11, 14) = 0.442486E+00
+ PKER_RACCSS( 11, 15) = 0.528291E+00
+ PKER_RACCSS( 11, 16) = 0.629068E+00
+ PKER_RACCSS( 11, 17) = 0.725892E+00
+ PKER_RACCSS( 11, 18) = 0.810425E+00
+ PKER_RACCSS( 11, 19) = 0.881336E+00
+ PKER_RACCSS( 11, 20) = 0.940053E+00
+ PKER_RACCSS( 11, 21) = 0.988540E+00
+ PKER_RACCSS( 11, 22) = 0.102858E+01
+ PKER_RACCSS( 11, 23) = 0.106165E+01
+ PKER_RACCSS( 11, 24) = 0.108898E+01
+ PKER_RACCSS( 11, 25) = 0.111157E+01
+ PKER_RACCSS( 11, 26) = 0.113025E+01
+ PKER_RACCSS( 11, 27) = 0.114569E+01
+ PKER_RACCSS( 11, 28) = 0.115847E+01
+ PKER_RACCSS( 11, 29) = 0.116903E+01
+ PKER_RACCSS( 11, 30) = 0.117777E+01
+ PKER_RACCSS( 11, 31) = 0.118500E+01
+ PKER_RACCSS( 11, 32) = 0.119098E+01
+ PKER_RACCSS( 11, 33) = 0.119593E+01
+ PKER_RACCSS( 11, 34) = 0.120003E+01
+ PKER_RACCSS( 11, 35) = 0.120342E+01
+ PKER_RACCSS( 11, 36) = 0.120622E+01
+ PKER_RACCSS( 11, 37) = 0.120854E+01
+ PKER_RACCSS( 11, 38) = 0.121046E+01
+ PKER_RACCSS( 11, 39) = 0.121205E+01
+ PKER_RACCSS( 11, 40) = 0.121337E+01
+ PKER_RACCSS( 12, 1) = 0.394253E+00
+ PKER_RACCSS( 12, 2) = 0.646179E+00
+ PKER_RACCSS( 12, 3) = 0.942558E+00
+ PKER_RACCSS( 12, 4) = 0.122389E+01
+ PKER_RACCSS( 12, 5) = 0.142127E+01
+ PKER_RACCSS( 12, 6) = 0.148735E+01
+ PKER_RACCSS( 12, 7) = 0.141473E+01
+ PKER_RACCSS( 12, 8) = 0.123412E+01
+ PKER_RACCSS( 12, 9) = 0.996999E+00
+ PKER_RACCSS( 12, 10) = 0.756208E+00
+ PKER_RACCSS( 12, 11) = 0.555253E+00
+ PKER_RACCSS( 12, 12) = 0.422862E+00
+ PKER_RACCSS( 12, 13) = 0.371247E+00
+ PKER_RACCSS( 12, 14) = 0.392052E+00
+ PKER_RACCSS( 12, 15) = 0.462634E+00
+ PKER_RACCSS( 12, 16) = 0.555651E+00
+ PKER_RACCSS( 12, 17) = 0.649618E+00
+ PKER_RACCSS( 12, 18) = 0.733630E+00
+ PKER_RACCSS( 12, 19) = 0.804744E+00
+ PKER_RACCSS( 12, 20) = 0.863761E+00
+ PKER_RACCSS( 12, 21) = 0.912491E+00
+ PKER_RACCSS( 12, 22) = 0.952708E+00
+ PKER_RACCSS( 12, 23) = 0.985912E+00
+ PKER_RACCSS( 12, 24) = 0.101334E+01
+ PKER_RACCSS( 12, 25) = 0.103600E+01
+ PKER_RACCSS( 12, 26) = 0.105473E+01
+ PKER_RACCSS( 12, 27) = 0.107022E+01
+ PKER_RACCSS( 12, 28) = 0.108302E+01
+ PKER_RACCSS( 12, 29) = 0.109361E+01
+ PKER_RACCSS( 12, 30) = 0.110236E+01
+ PKER_RACCSS( 12, 31) = 0.110961E+01
+ PKER_RACCSS( 12, 32) = 0.111560E+01
+ PKER_RACCSS( 12, 33) = 0.112056E+01
+ PKER_RACCSS( 12, 34) = 0.112466E+01
+ PKER_RACCSS( 12, 35) = 0.112805E+01
+ PKER_RACCSS( 12, 36) = 0.113086E+01
+ PKER_RACCSS( 12, 37) = 0.113319E+01
+ PKER_RACCSS( 12, 38) = 0.113511E+01
+ PKER_RACCSS( 12, 39) = 0.113670E+01
+ PKER_RACCSS( 12, 40) = 0.113802E+01
+ PKER_RACCSS( 13, 1) = 0.171360E+00
+ PKER_RACCSS( 13, 2) = 0.313975E+00
+ PKER_RACCSS( 13, 3) = 0.512870E+00
+ PKER_RACCSS( 13, 4) = 0.744995E+00
+ PKER_RACCSS( 13, 5) = 0.962081E+00
+ PKER_RACCSS( 13, 6) = 0.110931E+01
+ PKER_RACCSS( 13, 7) = 0.114976E+01
+ PKER_RACCSS( 13, 8) = 0.107985E+01
+ PKER_RACCSS( 13, 9) = 0.927521E+00
+ PKER_RACCSS( 13, 10) = 0.737617E+00
+ PKER_RACCSS( 13, 11) = 0.556237E+00
+ PKER_RACCSS( 13, 12) = 0.420066E+00
+ PKER_RACCSS( 13, 13) = 0.350230E+00
+ PKER_RACCSS( 13, 14) = 0.349906E+00
+ PKER_RACCSS( 13, 15) = 0.404063E+00
+ PKER_RACCSS( 13, 16) = 0.487780E+00
+ PKER_RACCSS( 13, 17) = 0.578111E+00
+ PKER_RACCSS( 13, 18) = 0.661299E+00
+ PKER_RACCSS( 13, 19) = 0.732568E+00
+ PKER_RACCSS( 13, 20) = 0.791923E+00
+ PKER_RACCSS( 13, 21) = 0.840945E+00
+ PKER_RACCSS( 13, 22) = 0.881381E+00
+ PKER_RACCSS( 13, 23) = 0.914745E+00
+ PKER_RACCSS( 13, 24) = 0.942288E+00
+ PKER_RACCSS( 13, 25) = 0.965037E+00
+ PKER_RACCSS( 13, 26) = 0.983832E+00
+ PKER_RACCSS( 13, 27) = 0.999365E+00
+ PKER_RACCSS( 13, 28) = 0.101221E+01
+ PKER_RACCSS( 13, 29) = 0.102282E+01
+ PKER_RACCSS( 13, 30) = 0.103160E+01
+ PKER_RACCSS( 13, 31) = 0.103886E+01
+ PKER_RACCSS( 13, 32) = 0.104487E+01
+ PKER_RACCSS( 13, 33) = 0.104983E+01
+ PKER_RACCSS( 13, 34) = 0.105394E+01
+ PKER_RACCSS( 13, 35) = 0.105734E+01
+ PKER_RACCSS( 13, 36) = 0.106016E+01
+ PKER_RACCSS( 13, 37) = 0.106248E+01
+ PKER_RACCSS( 13, 38) = 0.106441E+01
+ PKER_RACCSS( 13, 39) = 0.106600E+01
+ PKER_RACCSS( 13, 40) = 0.106732E+01
+ PKER_RACCSS( 14, 1) = 0.880495E-01
+ PKER_RACCSS( 14, 2) = 0.175611E+00
+ PKER_RACCSS( 14, 3) = 0.247975E+00
+ PKER_RACCSS( 14, 4) = 0.403566E+00
+ PKER_RACCSS( 14, 5) = 0.583307E+00
+ PKER_RACCSS( 14, 6) = 0.748280E+00
+ PKER_RACCSS( 14, 7) = 0.855344E+00
+ PKER_RACCSS( 14, 8) = 0.876333E+00
+ PKER_RACCSS( 14, 9) = 0.811263E+00
+ PKER_RACCSS( 14, 10) = 0.685718E+00
+ PKER_RACCSS( 14, 11) = 0.539707E+00
+ PKER_RACCSS( 14, 12) = 0.412364E+00
+ PKER_RACCSS( 14, 13) = 0.333785E+00
+ PKER_RACCSS( 14, 14) = 0.315877E+00
+ PKER_RACCSS( 14, 15) = 0.352939E+00
+ PKER_RACCSS( 14, 16) = 0.425537E+00
+ PKER_RACCSS( 14, 17) = 0.511002E+00
+ PKER_RACCSS( 14, 18) = 0.593027E+00
+ PKER_RACCSS( 14, 19) = 0.664451E+00
+ PKER_RACCSS( 14, 20) = 0.724208E+00
+ PKER_RACCSS( 14, 21) = 0.773584E+00
+ PKER_RACCSS( 14, 22) = 0.814286E+00
+ PKER_RACCSS( 14, 23) = 0.847845E+00
+ PKER_RACCSS( 14, 24) = 0.875531E+00
+ PKER_RACCSS( 14, 25) = 0.898385E+00
+ PKER_RACCSS( 14, 26) = 0.917258E+00
+ PKER_RACCSS( 14, 27) = 0.932850E+00
+ PKER_RACCSS( 14, 28) = 0.945734E+00
+ PKER_RACCSS( 14, 29) = 0.956384E+00
+ PKER_RACCSS( 14, 30) = 0.965189E+00
+ PKER_RACCSS( 14, 31) = 0.972469E+00
+ PKER_RACCSS( 14, 32) = 0.978490E+00
+ PKER_RACCSS( 14, 33) = 0.983469E+00
+ PKER_RACCSS( 14, 34) = 0.987588E+00
+ PKER_RACCSS( 14, 35) = 0.990995E+00
+ PKER_RACCSS( 14, 36) = 0.993813E+00
+ PKER_RACCSS( 14, 37) = 0.996145E+00
+ PKER_RACCSS( 14, 38) = 0.998074E+00
+ PKER_RACCSS( 14, 39) = 0.999670E+00
+ PKER_RACCSS( 14, 40) = 0.100099E+01
+ PKER_RACCSS( 15, 1) = 0.315291E-01
+ PKER_RACCSS( 15, 2) = 0.693241E-01
+ PKER_RACCSS( 15, 3) = 0.137798E+00
+ PKER_RACCSS( 15, 4) = 0.193925E+00
+ PKER_RACCSS( 15, 5) = 0.314161E+00
+ PKER_RACCSS( 15, 6) = 0.451226E+00
+ PKER_RACCSS( 15, 7) = 0.574319E+00
+ PKER_RACCSS( 15, 8) = 0.649498E+00
+ PKER_RACCSS( 15, 9) = 0.656529E+00
+ PKER_RACCSS( 15, 10) = 0.598237E+00
+ PKER_RACCSS( 15, 11) = 0.499202E+00
+ PKER_RACCSS( 15, 12) = 0.394122E+00
+ PKER_RACCSS( 15, 13) = 0.316374E+00
+ PKER_RACCSS( 15, 14) = 0.287121E+00
+ PKER_RACCSS( 15, 15) = 0.308960E+00
+ PKER_RACCSS( 15, 16) = 0.369539E+00
+ PKER_RACCSS( 15, 17) = 0.448627E+00
+ PKER_RACCSS( 15, 18) = 0.528619E+00
+ PKER_RACCSS( 15, 19) = 0.600043E+00
+ PKER_RACCSS( 15, 20) = 0.660278E+00
+ PKER_RACCSS( 15, 21) = 0.710095E+00
+ PKER_RACCSS( 15, 22) = 0.751124E+00
+ PKER_RACCSS( 15, 23) = 0.784920E+00
+ PKER_RACCSS( 15, 24) = 0.812780E+00
+ PKER_RACCSS( 15, 25) = 0.835762E+00
+ PKER_RACCSS( 15, 26) = 0.854730E+00
+ PKER_RACCSS( 15, 27) = 0.870393E+00
+ PKER_RACCSS( 15, 28) = 0.883331E+00
+ PKER_RACCSS( 15, 29) = 0.894022E+00
+ PKER_RACCSS( 15, 30) = 0.902857E+00
+ PKER_RACCSS( 15, 31) = 0.910161E+00
+ PKER_RACCSS( 15, 32) = 0.916200E+00
+ PKER_RACCSS( 15, 33) = 0.921193E+00
+ PKER_RACCSS( 15, 34) = 0.925323E+00
+ PKER_RACCSS( 15, 35) = 0.928738E+00
+ PKER_RACCSS( 15, 36) = 0.931563E+00
+ PKER_RACCSS( 15, 37) = 0.933900E+00
+ PKER_RACCSS( 15, 38) = 0.935833E+00
+ PKER_RACCSS( 15, 39) = 0.937432E+00
+ PKER_RACCSS( 15, 40) = 0.938755E+00
+ PKER_RACCSS( 16, 1) = 0.360358E+01
+ PKER_RACCSS( 16, 2) = 0.281969E+01
+ PKER_RACCSS( 16, 3) = 0.219170E+01
+ PKER_RACCSS( 16, 4) = 0.170588E+01
+ PKER_RACCSS( 16, 5) = 0.135069E+01
+ PKER_RACCSS( 16, 6) = 0.110996E+01
+ PKER_RACCSS( 16, 7) = 0.957328E+00
+ PKER_RACCSS( 16, 8) = 0.855867E+00
+ PKER_RACCSS( 16, 9) = 0.767727E+00
+ PKER_RACCSS( 16, 10) = 0.667811E+00
+ PKER_RACCSS( 16, 11) = 0.551774E+00
+ PKER_RACCSS( 16, 12) = 0.434001E+00
+ PKER_RACCSS( 16, 13) = 0.338225E+00
+ PKER_RACCSS( 16, 14) = 0.285601E+00
+ PKER_RACCSS( 16, 15) = 0.284136E+00
+ PKER_RACCSS( 16, 16) = 0.326430E+00
+ PKER_RACCSS( 16, 17) = 0.394397E+00
+ PKER_RACCSS( 16, 18) = 0.469502E+00
+ PKER_RACCSS( 16, 19) = 0.539605E+00
+ PKER_RACCSS( 16, 20) = 0.599949E+00
+ PKER_RACCSS( 16, 21) = 0.650193E+00
+ PKER_RACCSS( 16, 22) = 0.691608E+00
+ PKER_RACCSS( 16, 23) = 0.725693E+00
+ PKER_RACCSS( 16, 24) = 0.753765E+00
+ PKER_RACCSS( 16, 25) = 0.776902E+00
+ PKER_RACCSS( 16, 26) = 0.795985E+00
+ PKER_RACCSS( 16, 27) = 0.811734E+00
+ PKER_RACCSS( 16, 28) = 0.824737E+00
+ PKER_RACCSS( 16, 29) = 0.835476E+00
+ PKER_RACCSS( 16, 30) = 0.844348E+00
+ PKER_RACCSS( 16, 31) = 0.851681E+00
+ PKER_RACCSS( 16, 32) = 0.857741E+00
+ PKER_RACCSS( 16, 33) = 0.862751E+00
+ PKER_RACCSS( 16, 34) = 0.866894E+00
+ PKER_RACCSS( 16, 35) = 0.870319E+00
+ PKER_RACCSS( 16, 36) = 0.873152E+00
+ PKER_RACCSS( 16, 37) = 0.875495E+00
+ PKER_RACCSS( 16, 38) = 0.877433E+00
+ PKER_RACCSS( 16, 39) = 0.879036E+00
+ PKER_RACCSS( 16, 40) = 0.880362E+00
+ PKER_RACCSS( 17, 1) = 0.472676E+01
+ PKER_RACCSS( 17, 2) = 0.370797E+01
+ PKER_RACCSS( 17, 3) = 0.231793E+01
+ PKER_RACCSS( 17, 4) = 0.179758E+01
+ PKER_RACCSS( 17, 5) = 0.139358E+01
+ PKER_RACCSS( 17, 6) = 0.109574E+01
+ PKER_RACCSS( 17, 7) = 0.890250E+00
+ PKER_RACCSS( 17, 8) = 0.755210E+00
+ PKER_RACCSS( 17, 9) = 0.661386E+00
+ PKER_RACCSS( 17, 10) = 0.579824E+00
+ PKER_RACCSS( 17, 11) = 0.493157E+00
+ PKER_RACCSS( 17, 12) = 0.401316E+00
+ PKER_RACCSS( 17, 13) = 0.318099E+00
+ PKER_RACCSS( 17, 14) = 0.264075E+00
+ PKER_RACCSS( 17, 15) = 0.252206E+00
+ PKER_RACCSS( 17, 16) = 0.282309E+00
+ PKER_RACCSS( 17, 17) = 0.341880E+00
+ PKER_RACCSS( 17, 18) = 0.413082E+00
+ PKER_RACCSS( 17, 19) = 0.482222E+00
+ PKER_RACCSS( 17, 20) = 0.542813E+00
+ PKER_RACCSS( 17, 21) = 0.593576E+00
+ PKER_RACCSS( 17, 22) = 0.635456E+00
+ PKER_RACCSS( 17, 23) = 0.669894E+00
+ PKER_RACCSS( 17, 24) = 0.698224E+00
+ PKER_RACCSS( 17, 25) = 0.721550E+00
+ PKER_RACCSS( 17, 26) = 0.740773E+00
+ PKER_RACCSS( 17, 27) = 0.756626E+00
+ PKER_RACCSS( 17, 28) = 0.769706E+00
+ PKER_RACCSS( 17, 29) = 0.780504E+00
+ PKER_RACCSS( 17, 30) = 0.789421E+00
+ PKER_RACCSS( 17, 31) = 0.796788E+00
+ PKER_RACCSS( 17, 32) = 0.802874E+00
+ PKER_RACCSS( 17, 33) = 0.807905E+00
+ PKER_RACCSS( 17, 34) = 0.812063E+00
+ PKER_RACCSS( 17, 35) = 0.815500E+00
+ PKER_RACCSS( 17, 36) = 0.818342E+00
+ PKER_RACCSS( 17, 37) = 0.820693E+00
+ PKER_RACCSS( 17, 38) = 0.822636E+00
+ PKER_RACCSS( 17, 39) = 0.824244E+00
+ PKER_RACCSS( 17, 40) = 0.825573E+00
+ PKER_RACCSS( 18, 1) = 0.603863E+01
+ PKER_RACCSS( 18, 2) = 0.389316E+01
+ PKER_RACCSS( 18, 3) = 0.305031E+01
+ PKER_RACCSS( 18, 4) = 0.236338E+01
+ PKER_RACCSS( 18, 5) = 0.147231E+01
+ PKER_RACCSS( 18, 6) = 0.113620E+01
+ PKER_RACCSS( 18, 7) = 0.886115E+00
+ PKER_RACCSS( 18, 8) = 0.710209E+00
+ PKER_RACCSS( 18, 9) = 0.590674E+00
+ PKER_RACCSS( 18, 10) = 0.504703E+00
+ PKER_RACCSS( 18, 11) = 0.431038E+00
+ PKER_RACCSS( 18, 12) = 0.358809E+00
+ PKER_RACCSS( 18, 13) = 0.290844E+00
+ PKER_RACCSS( 18, 14) = 0.240768E+00
+ PKER_RACCSS( 18, 15) = 0.223220E+00
+ PKER_RACCSS( 18, 16) = 0.243218E+00
+ PKER_RACCSS( 18, 17) = 0.293836E+00
+ PKER_RACCSS( 18, 18) = 0.360151E+00
+ PKER_RACCSS( 18, 19) = 0.427795E+00
+ PKER_RACCSS( 18, 20) = 0.488580E+00
+ PKER_RACCSS( 18, 21) = 0.539954E+00
+ PKER_RACCSS( 18, 22) = 0.582396E+00
+ PKER_RACCSS( 18, 23) = 0.617263E+00
+ PKER_RACCSS( 18, 24) = 0.645906E+00
+ PKER_RACCSS( 18, 25) = 0.669463E+00
+ PKER_RACCSS( 18, 26) = 0.688855E+00
+ PKER_RACCSS( 18, 27) = 0.704834E+00
+ PKER_RACCSS( 18, 28) = 0.718008E+00
+ PKER_RACCSS( 18, 29) = 0.728877E+00
+ PKER_RACCSS( 18, 30) = 0.737848E+00
+ PKER_RACCSS( 18, 31) = 0.745255E+00
+ PKER_RACCSS( 18, 32) = 0.751373E+00
+ PKER_RACCSS( 18, 33) = 0.756428E+00
+ PKER_RACCSS( 18, 34) = 0.760604E+00
+ PKER_RACCSS( 18, 35) = 0.764056E+00
+ PKER_RACCSS( 18, 36) = 0.766910E+00
+ PKER_RACCSS( 18, 37) = 0.769269E+00
+ PKER_RACCSS( 18, 38) = 0.771219E+00
+ PKER_RACCSS( 18, 39) = 0.772832E+00
+ PKER_RACCSS( 18, 40) = 0.774166E+00
+ PKER_RACCSS( 19, 1) = 0.795385E+01
+ PKER_RACCSS( 19, 2) = 0.638846E+01
+ PKER_RACCSS( 19, 3) = 0.434595E+01
+ PKER_RACCSS( 19, 4) = 0.343549E+01
+ PKER_RACCSS( 19, 5) = 0.268818E+01
+ PKER_RACCSS( 19, 6) = 0.208133E+01
+ PKER_RACCSS( 19, 7) = 0.159740E+01
+ PKER_RACCSS( 19, 8) = 0.122163E+01
+ PKER_RACCSS( 19, 9) = 0.938335E+00
+ PKER_RACCSS( 19, 10) = 0.728285E+00
+ PKER_RACCSS( 19, 11) = 0.570145E+00
+ PKER_RACCSS( 19, 12) = 0.445027E+00
+ PKER_RACCSS( 19, 13) = 0.343893E+00
+ PKER_RACCSS( 19, 14) = 0.268248E+00
+ PKER_RACCSS( 19, 15) = 0.226350E+00
+ PKER_RACCSS( 19, 16) = 0.224325E+00
+ PKER_RACCSS( 19, 17) = 0.257856E+00
+ PKER_RACCSS( 19, 18) = 0.313989E+00
+ PKER_RACCSS( 19, 19) = 0.377472E+00
+ PKER_RACCSS( 19, 20) = 0.437368E+00
+ PKER_RACCSS( 19, 21) = 0.489118E+00
+ PKER_RACCSS( 19, 22) = 0.532165E+00
+ PKER_RACCSS( 19, 23) = 0.567544E+00
+ PKER_RACCSS( 19, 24) = 0.596569E+00
+ PKER_RACCSS( 19, 25) = 0.620406E+00
+ PKER_RACCSS( 19, 26) = 0.640004E+00
+ PKER_RACCSS( 19, 27) = 0.656135E+00
+ PKER_RACCSS( 19, 28) = 0.669424E+00
+ PKER_RACCSS( 19, 29) = 0.680378E+00
+ PKER_RACCSS( 19, 30) = 0.689414E+00
+ PKER_RACCSS( 19, 31) = 0.696870E+00
+ PKER_RACCSS( 19, 32) = 0.703026E+00
+ PKER_RACCSS( 19, 33) = 0.708109E+00
+ PKER_RACCSS( 19, 34) = 0.712308E+00
+ PKER_RACCSS( 19, 35) = 0.715777E+00
+ PKER_RACCSS( 19, 36) = 0.718644E+00
+ PKER_RACCSS( 19, 37) = 0.721014E+00
+ PKER_RACCSS( 19, 38) = 0.722972E+00
+ PKER_RACCSS( 19, 39) = 0.724592E+00
+ PKER_RACCSS( 19, 40) = 0.725930E+00
+ PKER_RACCSS( 20, 1) = 0.634781E+01
+ PKER_RACCSS( 20, 2) = 0.508413E+01
+ PKER_RACCSS( 20, 3) = 0.328893E+01
+ PKER_RACCSS( 20, 4) = 0.259197E+01
+ PKER_RACCSS( 20, 5) = 0.161527E+01
+ PKER_RACCSS( 20, 6) = 0.125279E+01
+ PKER_RACCSS( 20, 7) = 0.963381E+00
+ PKER_RACCSS( 20, 8) = 0.738949E+00
+ PKER_RACCSS( 20, 9) = 0.571583E+00
+ PKER_RACCSS( 20, 10) = 0.451257E+00
+ PKER_RACCSS( 20, 11) = 0.365125E+00
+ PKER_RACCSS( 20, 12) = 0.299475E+00
+ PKER_RACCSS( 20, 13) = 0.245596E+00
+ PKER_RACCSS( 20, 14) = 0.203304E+00
+ PKER_RACCSS( 20, 15) = 0.180537E+00
+ PKER_RACCSS( 20, 16) = 0.185574E+00
+ PKER_RACCSS( 20, 17) = 0.220030E+00
+ PKER_RACCSS( 20, 18) = 0.275495E+00
+ PKER_RACCSS( 20, 19) = 0.338734E+00
+ PKER_RACCSS( 20, 20) = 0.398970E+00
+ PKER_RACCSS( 20, 21) = 0.450959E+00
+ PKER_RACCSS( 20, 22) = 0.493976E+00
+ PKER_RACCSS( 20, 23) = 0.529200E+00
+ PKER_RACCSS( 20, 24) = 0.558067E+00
+ PKER_RACCSS( 20, 25) = 0.581769E+00
+ PKER_RACCSS( 20, 26) = 0.601256E+00
+ PKER_RACCSS( 20, 27) = 0.617297E+00
+ PKER_RACCSS( 20, 28) = 0.630511E+00
+ PKER_RACCSS( 20, 29) = 0.641405E+00
+ PKER_RACCSS( 20, 30) = 0.650392E+00
+ PKER_RACCSS( 20, 31) = 0.657810E+00
+ PKER_RACCSS( 20, 32) = 0.663934E+00
+ PKER_RACCSS( 20, 33) = 0.668992E+00
+ PKER_RACCSS( 20, 34) = 0.673171E+00
+ PKER_RACCSS( 20, 35) = 0.676624E+00
+ PKER_RACCSS( 20, 36) = 0.679478E+00
+ PKER_RACCSS( 20, 37) = 0.681837E+00
+ PKER_RACCSS( 20, 38) = 0.683788E+00
+ PKER_RACCSS( 20, 39) = 0.685401E+00
+ PKER_RACCSS( 20, 40) = 0.686734E+00
+ PKER_RACCSS( 21, 1) = 0.102443E+02
+ PKER_RACCSS( 21, 2) = 0.752283E+01
+ PKER_RACCSS( 21, 3) = 0.532770E+01
+ PKER_RACCSS( 21, 4) = 0.425873E+01
+ PKER_RACCSS( 21, 5) = 0.288056E+01
+ PKER_RACCSS( 21, 6) = 0.226207E+01
+ PKER_RACCSS( 21, 7) = 0.175652E+01
+ PKER_RACCSS( 21, 8) = 0.134803E+01
+ PKER_RACCSS( 21, 9) = 0.102375E+01
+ PKER_RACCSS( 21, 10) = 0.771986E+00
+ PKER_RACCSS( 21, 11) = 0.580680E+00
+ PKER_RACCSS( 21, 12) = 0.436943E+00
+ PKER_RACCSS( 21, 13) = 0.328804E+00
+ PKER_RACCSS( 21, 14) = 0.249300E+00
+ PKER_RACCSS( 21, 15) = 0.198560E+00
+ PKER_RACCSS( 21, 16) = 0.180676E+00
+ PKER_RACCSS( 21, 17) = 0.196350E+00
+ PKER_RACCSS( 21, 18) = 0.238922E+00
+ PKER_RACCSS( 21, 19) = 0.295536E+00
+ PKER_RACCSS( 21, 20) = 0.353574E+00
+ PKER_RACCSS( 21, 21) = 0.405455E+00
+ PKER_RACCSS( 21, 22) = 0.448988E+00
+ PKER_RACCSS( 21, 23) = 0.484753E+00
+ PKER_RACCSS( 21, 24) = 0.514042E+00
+ PKER_RACCSS( 21, 25) = 0.538053E+00
+ PKER_RACCSS( 21, 26) = 0.557767E+00
+ PKER_RACCSS( 21, 27) = 0.573974E+00
+ PKER_RACCSS( 21, 28) = 0.587311E+00
+ PKER_RACCSS( 21, 29) = 0.598297E+00
+ PKER_RACCSS( 21, 30) = 0.607353E+00
+ PKER_RACCSS( 21, 31) = 0.614822E+00
+ PKER_RACCSS( 21, 32) = 0.620985E+00
+ PKER_RACCSS( 21, 33) = 0.626073E+00
+ PKER_RACCSS( 21, 34) = 0.630275E+00
+ PKER_RACCSS( 21, 35) = 0.633746E+00
+ PKER_RACCSS( 21, 36) = 0.636613E+00
+ PKER_RACCSS( 21, 37) = 0.638983E+00
+ PKER_RACCSS( 21, 38) = 0.640942E+00
+ PKER_RACCSS( 21, 39) = 0.642561E+00
+ PKER_RACCSS( 21, 40) = 0.643900E+00
+ PKER_RACCSS( 22, 1) = 0.115320E+02
+ PKER_RACCSS( 22, 2) = 0.885714E+01
+ PKER_RACCSS( 22, 3) = 0.661944E+01
+ PKER_RACCSS( 22, 4) = 0.533800E+01
+ PKER_RACCSS( 22, 5) = 0.383246E+01
+ PKER_RACCSS( 22, 6) = 0.304296E+01
+ PKER_RACCSS( 22, 7) = 0.239235E+01
+ PKER_RACCSS( 22, 8) = 0.185899E+01
+ PKER_RACCSS( 22, 9) = 0.142556E+01
+ PKER_RACCSS( 22, 10) = 0.107781E+01
+ PKER_RACCSS( 22, 11) = 0.803526E+00
+ PKER_RACCSS( 22, 12) = 0.590905E+00
+ PKER_RACCSS( 22, 13) = 0.429091E+00
+ PKER_RACCSS( 22, 14) = 0.309341E+00
+ PKER_RACCSS( 22, 15) = 0.227914E+00
+ PKER_RACCSS( 22, 16) = 0.184487E+00
+ PKER_RACCSS( 22, 17) = 0.179339E+00
+ PKER_RACCSS( 22, 18) = 0.207043E+00
+ PKER_RACCSS( 22, 19) = 0.255369E+00
+ PKER_RACCSS( 22, 20) = 0.310362E+00
+ PKER_RACCSS( 22, 21) = 0.362024E+00
+ PKER_RACCSS( 22, 22) = 0.406192E+00
+ PKER_RACCSS( 22, 23) = 0.442617E+00
+ PKER_RACCSS( 22, 24) = 0.472415E+00
+ PKER_RACCSS( 22, 25) = 0.496799E+00
+ PKER_RACCSS( 22, 26) = 0.516786E+00
+ PKER_RACCSS( 22, 27) = 0.533194E+00
+ PKER_RACCSS( 22, 28) = 0.546679E+00
+ PKER_RACCSS( 22, 29) = 0.557776E+00
+ PKER_RACCSS( 22, 30) = 0.566914E+00
+ PKER_RACCSS( 22, 31) = 0.574445E+00
+ PKER_RACCSS( 22, 32) = 0.580656E+00
+ PKER_RACCSS( 22, 33) = 0.585779E+00
+ PKER_RACCSS( 22, 34) = 0.590009E+00
+ PKER_RACCSS( 22, 35) = 0.593501E+00
+ PKER_RACCSS( 22, 36) = 0.596384E+00
+ PKER_RACCSS( 22, 37) = 0.598767E+00
+ PKER_RACCSS( 22, 38) = 0.600735E+00
+ PKER_RACCSS( 22, 39) = 0.602362E+00
+ PKER_RACCSS( 22, 40) = 0.603707E+00
+ PKER_RACCSS( 23, 1) = 0.120552E+02
+ PKER_RACCSS( 23, 2) = 0.943853E+01
+ PKER_RACCSS( 23, 3) = 0.723099E+01
+ PKER_RACCSS( 23, 4) = 0.538764E+01
+ PKER_RACCSS( 23, 5) = 0.432828E+01
+ PKER_RACCSS( 23, 6) = 0.309359E+01
+ PKER_RACCSS( 23, 7) = 0.244279E+01
+ PKER_RACCSS( 23, 8) = 0.190778E+01
+ PKER_RACCSS( 23, 9) = 0.147059E+01
+ PKER_RACCSS( 23, 10) = 0.111661E+01
+ PKER_RACCSS( 23, 11) = 0.833900E+00
+ PKER_RACCSS( 23, 12) = 0.611721E+00
+ PKER_RACCSS( 23, 13) = 0.440899E+00
+ PKER_RACCSS( 23, 14) = 0.313483E+00
+ PKER_RACCSS( 23, 15) = 0.225201E+00
+ PKER_RACCSS( 23, 16) = 0.175156E+00
+ PKER_RACCSS( 23, 17) = 0.163153E+00
+ PKER_RACCSS( 23, 18) = 0.185306E+00
+ PKER_RACCSS( 23, 19) = 0.230283E+00
+ PKER_RACCSS( 23, 20) = 0.284175E+00
+ PKER_RACCSS( 23, 21) = 0.335712E+00
+ PKER_RACCSS( 23, 22) = 0.379840E+00
+ PKER_RACCSS( 23, 23) = 0.416119E+00
+ PKER_RACCSS( 23, 24) = 0.445741E+00
+ PKER_RACCSS( 23, 25) = 0.469966E+00
+ PKER_RACCSS( 23, 26) = 0.489818E+00
+ PKER_RACCSS( 23, 27) = 0.506111E+00
+ PKER_RACCSS( 23, 28) = 0.519502E+00
+ PKER_RACCSS( 23, 29) = 0.530519E+00
+ PKER_RACCSS( 23, 30) = 0.539593E+00
+ PKER_RACCSS( 23, 31) = 0.547072E+00
+ PKER_RACCSS( 23, 32) = 0.553240E+00
+ PKER_RACCSS( 23, 33) = 0.558330E+00
+ PKER_RACCSS( 23, 34) = 0.562532E+00
+ PKER_RACCSS( 23, 35) = 0.566002E+00
+ PKER_RACCSS( 23, 36) = 0.568868E+00
+ PKER_RACCSS( 23, 37) = 0.571236E+00
+ PKER_RACCSS( 23, 38) = 0.573194E+00
+ PKER_RACCSS( 23, 39) = 0.574812E+00
+ PKER_RACCSS( 23, 40) = 0.576149E+00
+ PKER_RACCSS( 24, 1) = 0.129576E+02
+ PKER_RACCSS( 24, 2) = 0.102975E+02
+ PKER_RACCSS( 24, 3) = 0.818920E+01
+ PKER_RACCSS( 24, 4) = 0.640995E+01
+ PKER_RACCSS( 24, 5) = 0.491149E+01
+ PKER_RACCSS( 24, 6) = 0.394577E+01
+ PKER_RACCSS( 24, 7) = 0.291637E+01
+ PKER_RACCSS( 24, 8) = 0.230081E+01
+ PKER_RACCSS( 24, 9) = 0.179410E+01
+ PKER_RACCSS( 24, 10) = 0.137900E+01
+ PKER_RACCSS( 24, 11) = 0.104163E+01
+ PKER_RACCSS( 24, 12) = 0.770431E+00
+ PKER_RACCSS( 24, 13) = 0.556107E+00
+ PKER_RACCSS( 24, 14) = 0.391190E+00
+ PKER_RACCSS( 24, 15) = 0.270786E+00
+ PKER_RACCSS( 24, 16) = 0.192864E+00
+ PKER_RACCSS( 24, 17) = 0.156677E+00
+ PKER_RACCSS( 24, 18) = 0.159396E+00
+ PKER_RACCSS( 24, 19) = 0.191937E+00
+ PKER_RACCSS( 24, 20) = 0.240898E+00
+ PKER_RACCSS( 24, 21) = 0.292797E+00
+ PKER_RACCSS( 24, 22) = 0.339207E+00
+ PKER_RACCSS( 24, 23) = 0.377404E+00
+ PKER_RACCSS( 24, 24) = 0.408063E+00
+ PKER_RACCSS( 24, 25) = 0.432806E+00
+ PKER_RACCSS( 24, 26) = 0.452971E+00
+ PKER_RACCSS( 24, 27) = 0.469485E+00
+ PKER_RACCSS( 24, 28) = 0.483037E+00
+ PKER_RACCSS( 24, 29) = 0.494174E+00
+ PKER_RACCSS( 24, 30) = 0.503336E+00
+ PKER_RACCSS( 24, 31) = 0.510880E+00
+ PKER_RACCSS( 24, 32) = 0.517096E+00
+ PKER_RACCSS( 24, 33) = 0.522223E+00
+ PKER_RACCSS( 24, 34) = 0.526452E+00
+ PKER_RACCSS( 24, 35) = 0.529943E+00
+ PKER_RACCSS( 24, 36) = 0.532826E+00
+ PKER_RACCSS( 24, 37) = 0.535207E+00
+ PKER_RACCSS( 24, 38) = 0.537174E+00
+ PKER_RACCSS( 24, 39) = 0.538799E+00
+ PKER_RACCSS( 24, 40) = 0.540142E+00
+ PKER_RACCSS( 25, 1) = 0.131514E+02
+ PKER_RACCSS( 25, 2) = 0.106419E+02
+ PKER_RACCSS( 25, 3) = 0.845868E+01
+ PKER_RACCSS( 25, 4) = 0.672282E+01
+ PKER_RACCSS( 25, 5) = 0.526076E+01
+ PKER_RACCSS( 25, 6) = 0.423970E+01
+ PKER_RACCSS( 25, 7) = 0.322433E+01
+ PKER_RACCSS( 25, 8) = 0.255677E+01
+ PKER_RACCSS( 25, 9) = 0.200589E+01
+ PKER_RACCSS( 25, 10) = 0.155266E+01
+ PKER_RACCSS( 25, 11) = 0.118171E+01
+ PKER_RACCSS( 25, 12) = 0.880334E+00
+ PKER_RACCSS( 25, 13) = 0.638726E+00
+ PKER_RACCSS( 25, 14) = 0.449351E+00
+ PKER_RACCSS( 25, 15) = 0.307558E+00
+ PKER_RACCSS( 25, 16) = 0.211438E+00
+ PKER_RACCSS( 25, 17) = 0.160608E+00
+ PKER_RACCSS( 25, 18) = 0.152419E+00
+ PKER_RACCSS( 25, 19) = 0.178285E+00
+ PKER_RACCSS( 25, 20) = 0.223628E+00
+ PKER_RACCSS( 25, 21) = 0.273609E+00
+ PKER_RACCSS( 25, 22) = 0.318759E+00
+ PKER_RACCSS( 25, 23) = 0.356134E+00
+ PKER_RACCSS( 25, 24) = 0.386398E+00
+ PKER_RACCSS( 25, 25) = 0.410983E+00
+ PKER_RACCSS( 25, 26) = 0.431059E+00
+ PKER_RACCSS( 25, 27) = 0.447500E+00
+ PKER_RACCSS( 25, 28) = 0.460986E+00
+ PKER_RACCSS( 25, 29) = 0.472065E+00
+ PKER_RACCSS( 25, 30) = 0.481178E+00
+ PKER_RACCSS( 25, 31) = 0.488681E+00
+ PKER_RACCSS( 25, 32) = 0.494864E+00
+ PKER_RACCSS( 25, 33) = 0.499963E+00
+ PKER_RACCSS( 25, 34) = 0.504169E+00
+ PKER_RACCSS( 25, 35) = 0.507642E+00
+ PKER_RACCSS( 25, 36) = 0.510510E+00
+ PKER_RACCSS( 25, 37) = 0.512879E+00
+ PKER_RACCSS( 25, 38) = 0.514836E+00
+ PKER_RACCSS( 25, 39) = 0.516454E+00
+ PKER_RACCSS( 25, 40) = 0.517791E+00
+ PKER_RACCSS( 26, 1) = 0.132742E+02
+ PKER_RACCSS( 26, 2) = 0.108337E+02
+ PKER_RACCSS( 26, 3) = 0.872586E+01
+ PKER_RACCSS( 26, 4) = 0.703900E+01
+ PKER_RACCSS( 26, 5) = 0.562634E+01
+ PKER_RACCSS( 26, 6) = 0.444059E+01
+ PKER_RACCSS( 26, 7) = 0.356562E+01
+ PKER_RACCSS( 26, 8) = 0.274250E+01
+ PKER_RACCSS( 26, 9) = 0.216207E+01
+ PKER_RACCSS( 26, 10) = 0.168328E+01
+ PKER_RACCSS( 26, 11) = 0.128971E+01
+ PKER_RACCSS( 26, 12) = 0.967844E+00
+ PKER_RACCSS( 26, 13) = 0.707228E+00
+ PKER_RACCSS( 26, 14) = 0.499963E+00
+ PKER_RACCSS( 26, 15) = 0.341292E+00
+ PKER_RACCSS( 26, 16) = 0.229353E+00
+ PKER_RACCSS( 26, 17) = 0.164063E+00
+ PKER_RACCSS( 26, 18) = 0.143754E+00
+ PKER_RACCSS( 26, 19) = 0.160834E+00
+ PKER_RACCSS( 26, 20) = 0.201345E+00
+ PKER_RACCSS( 26, 21) = 0.249884E+00
+ PKER_RACCSS( 26, 22) = 0.295670E+00
+ PKER_RACCSS( 26, 23) = 0.334320E+00
+ PKER_RACCSS( 26, 24) = 0.365515E+00
+ PKER_RACCSS( 26, 25) = 0.390474E+00
+ PKER_RACCSS( 26, 26) = 0.410622E+00
+ PKER_RACCSS( 26, 27) = 0.427051E+00
+ PKER_RACCSS( 26, 28) = 0.440513E+00
+ PKER_RACCSS( 26, 29) = 0.451566E+00
+ PKER_RACCSS( 26, 30) = 0.460654E+00
+ PKER_RACCSS( 26, 31) = 0.468135E+00
+ PKER_RACCSS( 26, 32) = 0.474298E+00
+ PKER_RACCSS( 26, 33) = 0.479380E+00
+ PKER_RACCSS( 26, 34) = 0.483572E+00
+ PKER_RACCSS( 26, 35) = 0.487033E+00
+ PKER_RACCSS( 26, 36) = 0.489891E+00
+ PKER_RACCSS( 26, 37) = 0.492252E+00
+ PKER_RACCSS( 26, 38) = 0.494203E+00
+ PKER_RACCSS( 26, 39) = 0.495815E+00
+ PKER_RACCSS( 26, 40) = 0.497148E+00
+ PKER_RACCSS( 27, 1) = 0.133097E+02
+ PKER_RACCSS( 27, 2) = 0.109011E+02
+ PKER_RACCSS( 27, 3) = 0.888269E+01
+ PKER_RACCSS( 27, 4) = 0.719362E+01
+ PKER_RACCSS( 27, 5) = 0.580985E+01
+ PKER_RACCSS( 27, 6) = 0.465501E+01
+ PKER_RACCSS( 27, 7) = 0.374781E+01
+ PKER_RACCSS( 27, 8) = 0.294825E+01
+ PKER_RACCSS( 27, 9) = 0.233507E+01
+ PKER_RACCSS( 27, 10) = 0.182826E+01
+ PKER_RACCSS( 27, 11) = 0.141027E+01
+ PKER_RACCSS( 27, 12) = 0.106668E+01
+ PKER_RACCSS( 27, 13) = 0.786260E+00
+ PKER_RACCSS( 27, 14) = 0.560532E+00
+ PKER_RACCSS( 27, 15) = 0.384455E+00
+ PKER_RACCSS( 27, 16) = 0.256127E+00
+ PKER_RACCSS( 27, 17) = 0.176040E+00
+ PKER_RACCSS( 27, 18) = 0.143310E+00
+ PKER_RACCSS( 27, 19) = 0.151524E+00
+ PKER_RACCSS( 27, 20) = 0.186916E+00
+ PKER_RACCSS( 27, 21) = 0.233004E+00
+ PKER_RACCSS( 27, 22) = 0.277474E+00
+ PKER_RACCSS( 27, 23) = 0.315252E+00
+ PKER_RACCSS( 27, 24) = 0.345942E+00
+ PKER_RACCSS( 27, 25) = 0.370729E+00
+ PKER_RACCSS( 27, 26) = 0.390865E+00
+ PKER_RACCSS( 27, 27) = 0.407311E+00
+ PKER_RACCSS( 27, 28) = 0.420780E+00
+ PKER_RACCSS( 27, 29) = 0.431832E+00
+ PKER_RACCSS( 27, 30) = 0.440914E+00
+ PKER_RACCSS( 27, 31) = 0.448386E+00
+ PKER_RACCSS( 27, 32) = 0.454540E+00
+ PKER_RACCSS( 27, 33) = 0.459613E+00
+ PKER_RACCSS( 27, 34) = 0.463798E+00
+ PKER_RACCSS( 27, 35) = 0.467251E+00
+ PKER_RACCSS( 27, 36) = 0.470104E+00
+ PKER_RACCSS( 27, 37) = 0.472459E+00
+ PKER_RACCSS( 27, 38) = 0.474406E+00
+ PKER_RACCSS( 27, 39) = 0.476015E+00
+ PKER_RACCSS( 27, 40) = 0.477346E+00
+ PKER_RACCSS( 28, 1) = 0.133115E+02
+ PKER_RACCSS( 28, 2) = 0.109156E+02
+ PKER_RACCSS( 28, 3) = 0.892137E+01
+ PKER_RACCSS( 28, 4) = 0.726595E+01
+ PKER_RACCSS( 28, 5) = 0.588073E+01
+ PKER_RACCSS( 28, 6) = 0.474162E+01
+ PKER_RACCSS( 28, 7) = 0.379341E+01
+ PKER_RACCSS( 28, 8) = 0.303518E+01
+ PKER_RACCSS( 28, 9) = 0.240761E+01
+ PKER_RACCSS( 28, 10) = 0.188860E+01
+ PKER_RACCSS( 28, 11) = 0.146011E+01
+ PKER_RACCSS( 28, 12) = 0.110727E+01
+ PKER_RACCSS( 28, 13) = 0.818541E+00
+ PKER_RACCSS( 28, 14) = 0.585150E+00
+ PKER_RACCSS( 28, 15) = 0.401892E+00
+ PKER_RACCSS( 28, 16) = 0.266865E+00
+ PKER_RACCSS( 28, 17) = 0.180994E+00
+ PKER_RACCSS( 28, 18) = 0.143621E+00
+ PKER_RACCSS( 28, 19) = 0.148709E+00
+ PKER_RACCSS( 28, 20) = 0.182192E+00
+ PKER_RACCSS( 28, 21) = 0.227050E+00
+ PKER_RACCSS( 28, 22) = 0.270562E+00
+ PKER_RACCSS( 28, 23) = 0.307571E+00
+ PKER_RACCSS( 28, 24) = 0.337783E+00
+ PKER_RACCSS( 28, 25) = 0.362333E+00
+ PKER_RACCSS( 28, 26) = 0.382340E+00
+ PKER_RACCSS( 28, 27) = 0.398692E+00
+ PKER_RACCSS( 28, 28) = 0.412083E+00
+ PKER_RACCSS( 28, 29) = 0.423069E+00
+ PKER_RACCSS( 28, 30) = 0.432097E+00
+ PKER_RACCSS( 28, 31) = 0.439525E+00
+ PKER_RACCSS( 28, 32) = 0.445643E+00
+ PKER_RACCSS( 28, 33) = 0.450687E+00
+ PKER_RACCSS( 28, 34) = 0.454848E+00
+ PKER_RACCSS( 28, 35) = 0.458283E+00
+ PKER_RACCSS( 28, 36) = 0.461119E+00
+ PKER_RACCSS( 28, 37) = 0.463463E+00
+ PKER_RACCSS( 28, 38) = 0.465400E+00
+ PKER_RACCSS( 28, 39) = 0.467002E+00
+ PKER_RACCSS( 28, 40) = 0.468326E+00
+ PKER_RACCSS( 29, 1) = 0.133215E+02
+ PKER_RACCSS( 29, 2) = 0.109289E+02
+ PKER_RACCSS( 29, 3) = 0.894604E+01
+ PKER_RACCSS( 29, 4) = 0.730119E+01
+ PKER_RACCSS( 29, 5) = 0.593124E+01
+ PKER_RACCSS( 29, 6) = 0.480144E+01
+ PKER_RACCSS( 29, 7) = 0.386406E+01
+ PKER_RACCSS( 29, 8) = 0.309611E+01
+ PKER_RACCSS( 29, 9) = 0.246034E+01
+ PKER_RACCSS( 29, 10) = 0.193432E+01
+ PKER_RACCSS( 29, 11) = 0.149394E+01
+ PKER_RACCSS( 29, 12) = 0.113665E+01
+ PKER_RACCSS( 29, 13) = 0.843665E+00
+ PKER_RACCSS( 29, 14) = 0.605916E+00
+ PKER_RACCSS( 29, 15) = 0.417943E+00
+ PKER_RACCSS( 29, 16) = 0.277581E+00
+ PKER_RACCSS( 29, 17) = 0.185747E+00
+ PKER_RACCSS( 29, 18) = 0.142370E+00
+ PKER_RACCSS( 29, 19) = 0.142343E+00
+ PKER_RACCSS( 29, 20) = 0.172458E+00
+ PKER_RACCSS( 29, 21) = 0.215669E+00
+ PKER_RACCSS( 29, 22) = 0.258726E+00
+ PKER_RACCSS( 29, 23) = 0.295879E+00
+ PKER_RACCSS( 29, 24) = 0.326452E+00
+ PKER_RACCSS( 29, 25) = 0.351334E+00
+ PKER_RACCSS( 29, 26) = 0.371529E+00
+ PKER_RACCSS( 29, 27) = 0.387939E+00
+ PKER_RACCSS( 29, 28) = 0.401329E+00
+ PKER_RACCSS( 29, 29) = 0.412300E+00
+ PKER_RACCSS( 29, 30) = 0.421310E+00
+ PKER_RACCSS( 29, 31) = 0.428722E+00
+ PKER_RACCSS( 29, 32) = 0.434825E+00
+ PKER_RACCSS( 29, 33) = 0.439856E+00
+ PKER_RACCSS( 29, 34) = 0.444007E+00
+ PKER_RACCSS( 29, 35) = 0.447433E+00
+ PKER_RACCSS( 29, 36) = 0.450262E+00
+ PKER_RACCSS( 29, 37) = 0.452600E+00
+ PKER_RACCSS( 29, 38) = 0.454532E+00
+ PKER_RACCSS( 29, 39) = 0.456130E+00
+ PKER_RACCSS( 29, 40) = 0.457451E+00
+ PKER_RACCSS( 30, 1) = 0.133375E+02
+ PKER_RACCSS( 30, 2) = 0.109457E+02
+ PKER_RACCSS( 30, 3) = 0.896468E+01
+ PKER_RACCSS( 30, 4) = 0.732350E+01
+ PKER_RACCSS( 30, 5) = 0.596323E+01
+ PKER_RACCSS( 30, 6) = 0.483579E+01
+ PKER_RACCSS( 30, 7) = 0.390254E+01
+ PKER_RACCSS( 30, 8) = 0.313132E+01
+ PKER_RACCSS( 30, 9) = 0.249276E+01
+ PKER_RACCSS( 30, 10) = 0.196278E+01
+ PKER_RACCSS( 30, 11) = 0.152606E+01
+ PKER_RACCSS( 30, 12) = 0.116570E+01
+ PKER_RACCSS( 30, 13) = 0.869566E+00
+ PKER_RACCSS( 30, 14) = 0.628357E+00
+ PKER_RACCSS( 30, 15) = 0.436329E+00
+ PKER_RACCSS( 30, 16) = 0.290939E+00
+ PKER_RACCSS( 30, 17) = 0.192920E+00
+ PKER_RACCSS( 30, 18) = 0.142864E+00
+ PKER_RACCSS( 30, 19) = 0.136857E+00
+ PKER_RACCSS( 30, 20) = 0.162977E+00
+ PKER_RACCSS( 30, 21) = 0.204357E+00
+ PKER_RACCSS( 30, 22) = 0.246873E+00
+ PKER_RACCSS( 30, 23) = 0.283849E+00
+ PKER_RACCSS( 30, 24) = 0.314229E+00
+ PKER_RACCSS( 30, 25) = 0.338918E+00
+ PKER_RACCSS( 30, 26) = 0.359002E+00
+ PKER_RACCSS( 30, 27) = 0.375384E+00
+ PKER_RACCSS( 30, 28) = 0.388781E+00
+ PKER_RACCSS( 30, 29) = 0.399761E+00
+ PKER_RACCSS( 30, 30) = 0.408775E+00
+ PKER_RACCSS( 30, 31) = 0.416186E+00
+ PKER_RACCSS( 30, 32) = 0.422287E+00
+ PKER_RACCSS( 30, 33) = 0.427315E+00
+ PKER_RACCSS( 30, 34) = 0.431462E+00
+ PKER_RACCSS( 30, 35) = 0.434884E+00
+ PKER_RACCSS( 30, 36) = 0.437711E+00
+ PKER_RACCSS( 30, 37) = 0.440046E+00
+ PKER_RACCSS( 30, 38) = 0.441975E+00
+ PKER_RACCSS( 30, 39) = 0.443571E+00
+ PKER_RACCSS( 30, 40) = 0.444890E+00
+ PKER_RACCSS( 31, 1) = 0.133457E+02
+ PKER_RACCSS( 31, 2) = 0.109540E+02
+ PKER_RACCSS( 31, 3) = 0.897333E+01
+ PKER_RACCSS( 31, 4) = 0.733289E+01
+ PKER_RACCSS( 31, 5) = 0.597403E+01
+ PKER_RACCSS( 31, 6) = 0.484844E+01
+ PKER_RACCSS( 31, 7) = 0.391622E+01
+ PKER_RACCSS( 31, 8) = 0.314409E+01
+ PKER_RACCSS( 31, 9) = 0.250503E+01
+ PKER_RACCSS( 31, 10) = 0.197608E+01
+ PKER_RACCSS( 31, 11) = 0.153866E+01
+ PKER_RACCSS( 31, 12) = 0.117759E+01
+ PKER_RACCSS( 31, 13) = 0.880647E+00
+ PKER_RACCSS( 31, 14) = 0.638378E+00
+ PKER_RACCSS( 31, 15) = 0.444889E+00
+ PKER_RACCSS( 31, 16) = 0.297371E+00
+ PKER_RACCSS( 31, 17) = 0.196420E+00
+ PKER_RACCSS( 31, 18) = 0.142908E+00
+ PKER_RACCSS( 31, 19) = 0.133631E+00
+ PKER_RACCSS( 31, 20) = 0.157422E+00
+ PKER_RACCSS( 31, 21) = 0.197662E+00
+ PKER_RACCSS( 31, 22) = 0.239819E+00
+ PKER_RACCSS( 31, 23) = 0.276723E+00
+ PKER_RACCSS( 31, 24) = 0.307082E+00
+ PKER_RACCSS( 31, 25) = 0.331764E+00
+ PKER_RACCSS( 31, 26) = 0.351849E+00
+ PKER_RACCSS( 31, 27) = 0.368231E+00
+ PKER_RACCSS( 31, 28) = 0.381625E+00
+ PKER_RACCSS( 31, 29) = 0.392598E+00
+ PKER_RACCSS( 31, 30) = 0.401604E+00
+ PKER_RACCSS( 31, 31) = 0.409008E+00
+ PKER_RACCSS( 31, 32) = 0.415101E+00
+ PKER_RACCSS( 31, 33) = 0.420122E+00
+ PKER_RACCSS( 31, 34) = 0.424262E+00
+ PKER_RACCSS( 31, 35) = 0.427680E+00
+ PKER_RACCSS( 31, 36) = 0.430501E+00
+ PKER_RACCSS( 31, 37) = 0.432833E+00
+ PKER_RACCSS( 31, 38) = 0.434760E+00
+ PKER_RACCSS( 31, 39) = 0.436352E+00
+ PKER_RACCSS( 31, 40) = 0.437670E+00
+ PKER_RACCSS( 32, 1) = 0.133505E+02
+ PKER_RACCSS( 32, 2) = 0.109589E+02
+ PKER_RACCSS( 32, 3) = 0.897836E+01
+ PKER_RACCSS( 32, 4) = 0.733809E+01
+ PKER_RACCSS( 32, 5) = 0.597956E+01
+ PKER_RACCSS( 32, 6) = 0.485431E+01
+ PKER_RACCSS( 32, 7) = 0.392231E+01
+ PKER_RACCSS( 32, 8) = 0.315042E+01
+ PKER_RACCSS( 32, 9) = 0.251126E+01
+ PKER_RACCSS( 32, 10) = 0.198225E+01
+ PKER_RACCSS( 32, 11) = 0.154473E+01
+ PKER_RACCSS( 32, 12) = 0.118355E+01
+ PKER_RACCSS( 32, 13) = 0.886389E+00
+ PKER_RACCSS( 32, 14) = 0.643737E+00
+ PKER_RACCSS( 32, 15) = 0.449607E+00
+ PKER_RACCSS( 32, 16) = 0.300995E+00
+ PKER_RACCSS( 32, 17) = 0.198415E+00
+ PKER_RACCSS( 32, 18) = 0.142843E+00
+ PKER_RACCSS( 32, 19) = 0.131565E+00
+ PKER_RACCSS( 32, 20) = 0.153886E+00
+ PKER_RACCSS( 32, 21) = 0.193406E+00
+ PKER_RACCSS( 32, 22) = 0.235356E+00
+ PKER_RACCSS( 32, 23) = 0.272245E+00
+ PKER_RACCSS( 32, 24) = 0.302622E+00
+ PKER_RACCSS( 32, 25) = 0.327315E+00
+ PKER_RACCSS( 32, 26) = 0.347401E+00
+ PKER_RACCSS( 32, 27) = 0.363781E+00
+ PKER_RACCSS( 32, 28) = 0.377168E+00
+ PKER_RACCSS( 32, 29) = 0.388134E+00
+ PKER_RACCSS( 32, 30) = 0.397132E+00
+ PKER_RACCSS( 32, 31) = 0.404527E+00
+ PKER_RACCSS( 32, 32) = 0.410614E+00
+ PKER_RACCSS( 32, 33) = 0.415629E+00
+ PKER_RACCSS( 32, 34) = 0.419764E+00
+ PKER_RACCSS( 32, 35) = 0.423177E+00
+ PKER_RACCSS( 32, 36) = 0.425995E+00
+ PKER_RACCSS( 32, 37) = 0.428323E+00
+ PKER_RACCSS( 32, 38) = 0.430248E+00
+ PKER_RACCSS( 32, 39) = 0.431839E+00
+ PKER_RACCSS( 32, 40) = 0.433154E+00
+ PKER_RACCSS( 33, 1) = 0.133549E+02
+ PKER_RACCSS( 33, 2) = 0.109634E+02
+ PKER_RACCSS( 33, 3) = 0.898293E+01
+ PKER_RACCSS( 33, 4) = 0.734275E+01
+ PKER_RACCSS( 33, 5) = 0.598430E+01
+ PKER_RACCSS( 33, 6) = 0.485916E+01
+ PKER_RACCSS( 33, 7) = 0.392725E+01
+ PKER_RACCSS( 33, 8) = 0.315543E+01
+ PKER_RACCSS( 33, 9) = 0.251634E+01
+ PKER_RACCSS( 33, 10) = 0.198734E+01
+ PKER_RACCSS( 33, 11) = 0.154980E+01
+ PKER_RACCSS( 33, 12) = 0.118857E+01
+ PKER_RACCSS( 33, 13) = 0.891252E+00
+ PKER_RACCSS( 33, 14) = 0.648304E+00
+ PKER_RACCSS( 33, 15) = 0.453668E+00
+ PKER_RACCSS( 33, 16) = 0.304190E+00
+ PKER_RACCSS( 33, 17) = 0.200247E+00
+ PKER_RACCSS( 33, 18) = 0.142958E+00
+ PKER_RACCSS( 33, 19) = 0.129943E+00
+ PKER_RACCSS( 33, 20) = 0.150972E+00
+ PKER_RACCSS( 33, 21) = 0.189862E+00
+ PKER_RACCSS( 33, 22) = 0.231629E+00
+ PKER_RACCSS( 33, 23) = 0.268519E+00
+ PKER_RACCSS( 33, 24) = 0.298923E+00
+ PKER_RACCSS( 33, 25) = 0.323635E+00
+ PKER_RACCSS( 33, 26) = 0.343732E+00
+ PKER_RACCSS( 33, 27) = 0.360115E+00
+ PKER_RACCSS( 33, 28) = 0.373503E+00
+ PKER_RACCSS( 33, 29) = 0.384466E+00
+ PKER_RACCSS( 33, 30) = 0.393460E+00
+ PKER_RACCSS( 33, 31) = 0.400852E+00
+ PKER_RACCSS( 33, 32) = 0.406935E+00
+ PKER_RACCSS( 33, 33) = 0.411946E+00
+ PKER_RACCSS( 33, 34) = 0.416078E+00
+ PKER_RACCSS( 33, 35) = 0.419488E+00
+ PKER_RACCSS( 33, 36) = 0.422304E+00
+ PKER_RACCSS( 33, 37) = 0.424631E+00
+ PKER_RACCSS( 33, 38) = 0.426553E+00
+ PKER_RACCSS( 33, 39) = 0.428143E+00
+ PKER_RACCSS( 33, 40) = 0.429458E+00
+ PKER_RACCSS( 34, 1) = 0.133545E+02
+ PKER_RACCSS( 34, 2) = 0.109630E+02
+ PKER_RACCSS( 34, 3) = 0.898249E+01
+ PKER_RACCSS( 34, 4) = 0.734231E+01
+ PKER_RACCSS( 34, 5) = 0.598387E+01
+ PKER_RACCSS( 34, 6) = 0.485874E+01
+ PKER_RACCSS( 34, 7) = 0.392685E+01
+ PKER_RACCSS( 34, 8) = 0.315505E+01
+ PKER_RACCSS( 34, 9) = 0.251599E+01
+ PKER_RACCSS( 34, 10) = 0.198703E+01
+ PKER_RACCSS( 34, 11) = 0.154953E+01
+ PKER_RACCSS( 34, 12) = 0.118835E+01
+ PKER_RACCSS( 34, 13) = 0.891084E+00
+ PKER_RACCSS( 34, 14) = 0.648191E+00
+ PKER_RACCSS( 34, 15) = 0.453598E+00
+ PKER_RACCSS( 34, 16) = 0.304088E+00
+ PKER_RACCSS( 34, 17) = 0.200150E+00
+ PKER_RACCSS( 34, 18) = 0.142751E+00
+ PKER_RACCSS( 34, 19) = 0.129699E+00
+ PKER_RACCSS( 34, 20) = 0.150660E+00
+ PKER_RACCSS( 34, 21) = 0.189538E+00
+ PKER_RACCSS( 34, 22) = 0.231282E+00
+ PKER_RACCSS( 34, 23) = 0.268145E+00
+ PKER_RACCSS( 34, 24) = 0.298523E+00
+ PKER_RACCSS( 34, 25) = 0.323213E+00
+ PKER_RACCSS( 34, 26) = 0.343290E+00
+ PKER_RACCSS( 34, 27) = 0.359658E+00
+ PKER_RACCSS( 34, 28) = 0.373032E+00
+ PKER_RACCSS( 34, 29) = 0.383985E+00
+ PKER_RACCSS( 34, 30) = 0.392971E+00
+ PKER_RACCSS( 34, 31) = 0.400356E+00
+ PKER_RACCSS( 34, 32) = 0.406433E+00
+ PKER_RACCSS( 34, 33) = 0.411440E+00
+ PKER_RACCSS( 34, 34) = 0.415568E+00
+ PKER_RACCSS( 34, 35) = 0.418976E+00
+ PKER_RACCSS( 34, 36) = 0.421789E+00
+ PKER_RACCSS( 34, 37) = 0.424114E+00
+ PKER_RACCSS( 34, 38) = 0.426035E+00
+ PKER_RACCSS( 34, 39) = 0.427624E+00
+ PKER_RACCSS( 34, 40) = 0.428937E+00
+ PKER_RACCSS( 35, 1) = 0.133588E+02
+ PKER_RACCSS( 35, 2) = 0.109673E+02
+ PKER_RACCSS( 35, 3) = 0.898695E+01
+ PKER_RACCSS( 35, 4) = 0.734684E+01
+ PKER_RACCSS( 35, 5) = 0.598848E+01
+ PKER_RACCSS( 35, 6) = 0.486341E+01
+ PKER_RACCSS( 35, 7) = 0.393158E+01
+ PKER_RACCSS( 35, 8) = 0.315983E+01
+ PKER_RACCSS( 35, 9) = 0.252079E+01
+ PKER_RACCSS( 35, 10) = 0.199184E+01
+ PKER_RACCSS( 35, 11) = 0.155430E+01
+ PKER_RACCSS( 35, 12) = 0.119306E+01
+ PKER_RACCSS( 35, 13) = 0.895641E+00
+ PKER_RACCSS( 35, 14) = 0.652461E+00
+ PKER_RACCSS( 35, 15) = 0.457402E+00
+ PKER_RACCSS( 35, 16) = 0.307153E+00
+ PKER_RACCSS( 35, 17) = 0.201981E+00
+ PKER_RACCSS( 35, 18) = 0.143041E+00
+ PKER_RACCSS( 35, 19) = 0.128393E+00
+ PKER_RACCSS( 35, 20) = 0.148145E+00
+ PKER_RACCSS( 35, 21) = 0.186428E+00
+ PKER_RACCSS( 35, 22) = 0.228006E+00
+ PKER_RACCSS( 35, 23) = 0.264882E+00
+ PKER_RACCSS( 35, 24) = 0.295301E+00
+ PKER_RACCSS( 35, 25) = 0.320021E+00
+ PKER_RACCSS( 35, 26) = 0.340118E+00
+ PKER_RACCSS( 35, 27) = 0.356498E+00
+ PKER_RACCSS( 35, 28) = 0.369879E+00
+ PKER_RACCSS( 35, 29) = 0.380835E+00
+ PKER_RACCSS( 35, 30) = 0.389822E+00
+ PKER_RACCSS( 35, 31) = 0.397206E+00
+ PKER_RACCSS( 35, 32) = 0.403283E+00
+ PKER_RACCSS( 35, 33) = 0.408288E+00
+ PKER_RACCSS( 35, 34) = 0.412416E+00
+ PKER_RACCSS( 35, 35) = 0.415822E+00
+ PKER_RACCSS( 35, 36) = 0.418634E+00
+ PKER_RACCSS( 35, 37) = 0.420958E+00
+ PKER_RACCSS( 35, 38) = 0.422879E+00
+ PKER_RACCSS( 35, 39) = 0.424467E+00
+ PKER_RACCSS( 35, 40) = 0.425780E+00
+ PKER_RACCSS( 36, 1) = 0.133693E+02
+ PKER_RACCSS( 36, 2) = 0.109781E+02
+ PKER_RACCSS( 36, 3) = 0.899787E+01
+ PKER_RACCSS( 36, 4) = 0.735793E+01
+ PKER_RACCSS( 36, 5) = 0.599972E+01
+ PKER_RACCSS( 36, 6) = 0.487480E+01
+ PKER_RACCSS( 36, 7) = 0.394309E+01
+ PKER_RACCSS( 36, 8) = 0.317142E+01
+ PKER_RACCSS( 36, 9) = 0.253243E+01
+ PKER_RACCSS( 36, 10) = 0.200346E+01
+ PKER_RACCSS( 36, 11) = 0.156582E+01
+ PKER_RACCSS( 36, 12) = 0.120440E+01
+ PKER_RACCSS( 36, 13) = 0.906578E+00
+ PKER_RACCSS( 36, 14) = 0.662698E+00
+ PKER_RACCSS( 36, 15) = 0.466524E+00
+ PKER_RACCSS( 36, 16) = 0.314682E+00
+ PKER_RACCSS( 36, 17) = 0.206574E+00
+ PKER_RACCSS( 36, 18) = 0.144245E+00
+ PKER_RACCSS( 36, 19) = 0.125763E+00
+ PKER_RACCSS( 36, 20) = 0.142684E+00
+ PKER_RACCSS( 36, 21) = 0.179440E+00
+ PKER_RACCSS( 36, 22) = 0.220596E+00
+ PKER_RACCSS( 36, 23) = 0.257524E+00
+ PKER_RACCSS( 36, 24) = 0.288068E+00
+ PKER_RACCSS( 36, 25) = 0.312888E+00
+ PKER_RACCSS( 36, 26) = 0.333055E+00
+ PKER_RACCSS( 36, 27) = 0.349481E+00
+ PKER_RACCSS( 36, 28) = 0.362892E+00
+ PKER_RACCSS( 36, 29) = 0.373867E+00
+ PKER_RACCSS( 36, 30) = 0.382866E+00
+ PKER_RACCSS( 36, 31) = 0.390258E+00
+ PKER_RACCSS( 36, 32) = 0.396339E+00
+ PKER_RACCSS( 36, 33) = 0.401346E+00
+ PKER_RACCSS( 36, 34) = 0.405475E+00
+ PKER_RACCSS( 36, 35) = 0.408881E+00
+ PKER_RACCSS( 36, 36) = 0.411694E+00
+ PKER_RACCSS( 36, 37) = 0.414017E+00
+ PKER_RACCSS( 36, 38) = 0.415937E+00
+ PKER_RACCSS( 36, 39) = 0.417525E+00
+ PKER_RACCSS( 36, 40) = 0.418837E+00
+ PKER_RACCSS( 37, 1) = 0.000000E+00
+ PKER_RACCSS( 37, 2) = 0.000000E+00
+ PKER_RACCSS( 37, 3) = 0.000000E+00
+ PKER_RACCSS( 37, 4) = 0.000000E+00
+ PKER_RACCSS( 37, 5) = 0.000000E+00
+ PKER_RACCSS( 37, 6) = 0.000000E+00
+ PKER_RACCSS( 37, 7) = 0.000000E+00
+ PKER_RACCSS( 37, 8) = 0.000000E+00
+ PKER_RACCSS( 37, 9) = 0.000000E+00
+ PKER_RACCSS( 37, 10) = 0.000000E+00
+ PKER_RACCSS( 37, 11) = 0.000000E+00
+ PKER_RACCSS( 37, 12) = 0.000000E+00
+ PKER_RACCSS( 37, 13) = 0.000000E+00
+ PKER_RACCSS( 37, 14) = 0.000000E+00
+ PKER_RACCSS( 37, 15) = 0.000000E+00
+ PKER_RACCSS( 37, 16) = 0.000000E+00
+ PKER_RACCSS( 37, 17) = 0.000000E+00
+ PKER_RACCSS( 37, 18) = 0.000000E+00
+ PKER_RACCSS( 37, 19) = 0.000000E+00
+ PKER_RACCSS( 37, 20) = 0.000000E+00
+ PKER_RACCSS( 37, 21) = 0.000000E+00
+ PKER_RACCSS( 37, 22) = 0.000000E+00
+ PKER_RACCSS( 37, 23) = 0.000000E+00
+ PKER_RACCSS( 37, 24) = 0.000000E+00
+ PKER_RACCSS( 37, 25) = 0.000000E+00
+ PKER_RACCSS( 37, 26) = 0.000000E+00
+ PKER_RACCSS( 37, 27) = 0.000000E+00
+ PKER_RACCSS( 37, 28) = 0.000000E+00
+ PKER_RACCSS( 37, 29) = 0.000000E+00
+ PKER_RACCSS( 37, 30) = 0.000000E+00
+ PKER_RACCSS( 37, 31) = 0.000000E+00
+ PKER_RACCSS( 37, 32) = 0.000000E+00
+ PKER_RACCSS( 37, 33) = 0.000000E+00
+ PKER_RACCSS( 37, 34) = 0.000000E+00
+ PKER_RACCSS( 37, 35) = 0.000000E+00
+ PKER_RACCSS( 37, 36) = 0.000000E+00
+ PKER_RACCSS( 37, 37) = 0.000000E+00
+ PKER_RACCSS( 37, 38) = 0.000000E+00
+ PKER_RACCSS( 37, 39) = 0.000000E+00
+ PKER_RACCSS( 37, 40) = 0.000000E+00
+ PKER_RACCSS( 38, 1) = 0.000000E+00
+ PKER_RACCSS( 38, 2) = 0.000000E+00
+ PKER_RACCSS( 38, 3) = 0.000000E+00
+ PKER_RACCSS( 38, 4) = 0.000000E+00
+ PKER_RACCSS( 38, 5) = 0.000000E+00
+ PKER_RACCSS( 38, 6) = 0.000000E+00
+ PKER_RACCSS( 38, 7) = 0.000000E+00
+ PKER_RACCSS( 38, 8) = 0.000000E+00
+ PKER_RACCSS( 38, 9) = 0.000000E+00
+ PKER_RACCSS( 38, 10) = 0.000000E+00
+ PKER_RACCSS( 38, 11) = 0.000000E+00
+ PKER_RACCSS( 38, 12) = 0.000000E+00
+ PKER_RACCSS( 38, 13) = 0.000000E+00
+ PKER_RACCSS( 38, 14) = 0.000000E+00
+ PKER_RACCSS( 38, 15) = 0.000000E+00
+ PKER_RACCSS( 38, 16) = 0.000000E+00
+ PKER_RACCSS( 38, 17) = 0.000000E+00
+ PKER_RACCSS( 38, 18) = 0.000000E+00
+ PKER_RACCSS( 38, 19) = 0.000000E+00
+ PKER_RACCSS( 38, 20) = 0.000000E+00
+ PKER_RACCSS( 38, 21) = 0.000000E+00
+ PKER_RACCSS( 38, 22) = 0.000000E+00
+ PKER_RACCSS( 38, 23) = 0.000000E+00
+ PKER_RACCSS( 38, 24) = 0.000000E+00
+ PKER_RACCSS( 38, 25) = 0.000000E+00
+ PKER_RACCSS( 38, 26) = 0.000000E+00
+ PKER_RACCSS( 38, 27) = 0.000000E+00
+ PKER_RACCSS( 38, 28) = 0.000000E+00
+ PKER_RACCSS( 38, 29) = 0.000000E+00
+ PKER_RACCSS( 38, 30) = 0.000000E+00
+ PKER_RACCSS( 38, 31) = 0.000000E+00
+ PKER_RACCSS( 38, 32) = 0.000000E+00
+ PKER_RACCSS( 38, 33) = 0.000000E+00
+ PKER_RACCSS( 38, 34) = 0.000000E+00
+ PKER_RACCSS( 38, 35) = 0.000000E+00
+ PKER_RACCSS( 38, 36) = 0.000000E+00
+ PKER_RACCSS( 38, 37) = 0.000000E+00
+ PKER_RACCSS( 38, 38) = 0.000000E+00
+ PKER_RACCSS( 38, 39) = 0.000000E+00
+ PKER_RACCSS( 38, 40) = 0.000000E+00
+ PKER_RACCSS( 39, 1) = 0.000000E+00
+ PKER_RACCSS( 39, 2) = 0.000000E+00
+ PKER_RACCSS( 39, 3) = 0.000000E+00
+ PKER_RACCSS( 39, 4) = 0.000000E+00
+ PKER_RACCSS( 39, 5) = 0.000000E+00
+ PKER_RACCSS( 39, 6) = 0.000000E+00
+ PKER_RACCSS( 39, 7) = 0.000000E+00
+ PKER_RACCSS( 39, 8) = 0.000000E+00
+ PKER_RACCSS( 39, 9) = 0.000000E+00
+ PKER_RACCSS( 39, 10) = 0.000000E+00
+ PKER_RACCSS( 39, 11) = 0.000000E+00
+ PKER_RACCSS( 39, 12) = 0.000000E+00
+ PKER_RACCSS( 39, 13) = 0.000000E+00
+ PKER_RACCSS( 39, 14) = 0.000000E+00
+ PKER_RACCSS( 39, 15) = 0.000000E+00
+ PKER_RACCSS( 39, 16) = 0.000000E+00
+ PKER_RACCSS( 39, 17) = 0.000000E+00
+ PKER_RACCSS( 39, 18) = 0.000000E+00
+ PKER_RACCSS( 39, 19) = 0.000000E+00
+ PKER_RACCSS( 39, 20) = 0.000000E+00
+ PKER_RACCSS( 39, 21) = 0.000000E+00
+ PKER_RACCSS( 39, 22) = 0.000000E+00
+ PKER_RACCSS( 39, 23) = 0.000000E+00
+ PKER_RACCSS( 39, 24) = 0.000000E+00
+ PKER_RACCSS( 39, 25) = 0.000000E+00
+ PKER_RACCSS( 39, 26) = 0.000000E+00
+ PKER_RACCSS( 39, 27) = 0.000000E+00
+ PKER_RACCSS( 39, 28) = 0.000000E+00
+ PKER_RACCSS( 39, 29) = 0.000000E+00
+ PKER_RACCSS( 39, 30) = 0.000000E+00
+ PKER_RACCSS( 39, 31) = 0.000000E+00
+ PKER_RACCSS( 39, 32) = 0.000000E+00
+ PKER_RACCSS( 39, 33) = 0.000000E+00
+ PKER_RACCSS( 39, 34) = 0.000000E+00
+ PKER_RACCSS( 39, 35) = 0.000000E+00
+ PKER_RACCSS( 39, 36) = 0.000000E+00
+ PKER_RACCSS( 39, 37) = 0.000000E+00
+ PKER_RACCSS( 39, 38) = 0.000000E+00
+ PKER_RACCSS( 39, 39) = 0.000000E+00
+ PKER_RACCSS( 39, 40) = 0.000000E+00
+ PKER_RACCSS( 40, 1) = 0.000000E+00
+ PKER_RACCSS( 40, 2) = 0.000000E+00
+ PKER_RACCSS( 40, 3) = 0.000000E+00
+ PKER_RACCSS( 40, 4) = 0.000000E+00
+ PKER_RACCSS( 40, 5) = 0.000000E+00
+ PKER_RACCSS( 40, 6) = 0.000000E+00
+ PKER_RACCSS( 40, 7) = 0.000000E+00
+ PKER_RACCSS( 40, 8) = 0.000000E+00
+ PKER_RACCSS( 40, 9) = 0.000000E+00
+ PKER_RACCSS( 40, 10) = 0.000000E+00
+ PKER_RACCSS( 40, 11) = 0.000000E+00
+ PKER_RACCSS( 40, 12) = 0.000000E+00
+ PKER_RACCSS( 40, 13) = 0.000000E+00
+ PKER_RACCSS( 40, 14) = 0.000000E+00
+ PKER_RACCSS( 40, 15) = 0.000000E+00
+ PKER_RACCSS( 40, 16) = 0.000000E+00
+ PKER_RACCSS( 40, 17) = 0.000000E+00
+ PKER_RACCSS( 40, 18) = 0.000000E+00
+ PKER_RACCSS( 40, 19) = 0.000000E+00
+ PKER_RACCSS( 40, 20) = 0.000000E+00
+ PKER_RACCSS( 40, 21) = 0.000000E+00
+ PKER_RACCSS( 40, 22) = 0.000000E+00
+ PKER_RACCSS( 40, 23) = 0.000000E+00
+ PKER_RACCSS( 40, 24) = 0.000000E+00
+ PKER_RACCSS( 40, 25) = 0.000000E+00
+ PKER_RACCSS( 40, 26) = 0.000000E+00
+ PKER_RACCSS( 40, 27) = 0.000000E+00
+ PKER_RACCSS( 40, 28) = 0.000000E+00
+ PKER_RACCSS( 40, 29) = 0.000000E+00
+ PKER_RACCSS( 40, 30) = 0.000000E+00
+ PKER_RACCSS( 40, 31) = 0.000000E+00
+ PKER_RACCSS( 40, 32) = 0.000000E+00
+ PKER_RACCSS( 40, 33) = 0.000000E+00
+ PKER_RACCSS( 40, 34) = 0.000000E+00
+ PKER_RACCSS( 40, 35) = 0.000000E+00
+ PKER_RACCSS( 40, 36) = 0.000000E+00
+ PKER_RACCSS( 40, 37) = 0.000000E+00
+ PKER_RACCSS( 40, 38) = 0.000000E+00
+ PKER_RACCSS( 40, 39) = 0.000000E+00
+ PKER_RACCSS( 40, 40) = 0.000000E+00
+END IF
+!
+IF( PRESENT(PKER_RACCS ) ) THEN
+ PKER_RACCS ( 1, 1) = 0.810035E+01
+ PKER_RACCS ( 1, 2) = 0.624606E+01
+ PKER_RACCS ( 1, 3) = 0.474070E+01
+ PKER_RACCS ( 1, 4) = 0.352376E+01
+ PKER_RACCS ( 1, 5) = 0.255333E+01
+ PKER_RACCS ( 1, 6) = 0.180384E+01
+ PKER_RACCS ( 1, 7) = 0.126294E+01
+ PKER_RACCS ( 1, 8) = 0.924202E+00
+ PKER_RACCS ( 1, 9) = 0.775231E+00
+ PKER_RACCS ( 1, 10) = 0.787292E+00
+ PKER_RACCS ( 1, 11) = 0.911536E+00
+ PKER_RACCS ( 1, 12) = 0.109094E+01
+ PKER_RACCS ( 1, 13) = 0.127926E+01
+ PKER_RACCS ( 1, 14) = 0.145083E+01
+ PKER_RACCS ( 1, 15) = 0.159745E+01
+ PKER_RACCS ( 1, 16) = 0.171978E+01
+ PKER_RACCS ( 1, 17) = 0.182114E+01
+ PKER_RACCS ( 1, 18) = 0.190501E+01
+ PKER_RACCS ( 1, 19) = 0.197441E+01
+ PKER_RACCS ( 1, 20) = 0.203184E+01
+ PKER_RACCS ( 1, 21) = 0.207937E+01
+ PKER_RACCS ( 1, 22) = 0.211870E+01
+ PKER_RACCS ( 1, 23) = 0.215125E+01
+ PKER_RACCS ( 1, 24) = 0.217819E+01
+ PKER_RACCS ( 1, 25) = 0.220049E+01
+ PKER_RACCS ( 1, 26) = 0.221895E+01
+ PKER_RACCS ( 1, 27) = 0.223423E+01
+ PKER_RACCS ( 1, 28) = 0.224687E+01
+ PKER_RACCS ( 1, 29) = 0.225734E+01
+ PKER_RACCS ( 1, 30) = 0.226601E+01
+ PKER_RACCS ( 1, 31) = 0.227318E+01
+ PKER_RACCS ( 1, 32) = 0.227911E+01
+ PKER_RACCS ( 1, 33) = 0.228403E+01
+ PKER_RACCS ( 1, 34) = 0.228810E+01
+ PKER_RACCS ( 1, 35) = 0.229146E+01
+ PKER_RACCS ( 1, 36) = 0.229425E+01
+ PKER_RACCS ( 1, 37) = 0.229656E+01
+ PKER_RACCS ( 1, 38) = 0.229847E+01
+ PKER_RACCS ( 1, 39) = 0.230005E+01
+ PKER_RACCS ( 1, 40) = 0.230136E+01
+ PKER_RACCS ( 2, 1) = 0.835048E+01
+ PKER_RACCS ( 2, 2) = 0.645953E+01
+ PKER_RACCS ( 2, 3) = 0.492716E+01
+ PKER_RACCS ( 2, 4) = 0.368761E+01
+ PKER_RACCS ( 2, 5) = 0.269450E+01
+ PKER_RACCS ( 2, 6) = 0.191744E+01
+ PKER_RACCS ( 2, 7) = 0.134059E+01
+ PKER_RACCS ( 2, 8) = 0.956675E+00
+ PKER_RACCS ( 2, 9) = 0.757265E+00
+ PKER_RACCS ( 2, 10) = 0.720633E+00
+ PKER_RACCS ( 2, 11) = 0.806882E+00
+ PKER_RACCS ( 2, 12) = 0.963181E+00
+ PKER_RACCS ( 2, 13) = 0.114076E+01
+ PKER_RACCS ( 2, 14) = 0.130870E+01
+ PKER_RACCS ( 2, 15) = 0.145451E+01
+ PKER_RACCS ( 2, 16) = 0.157680E+01
+ PKER_RACCS ( 2, 17) = 0.167825E+01
+ PKER_RACCS ( 2, 18) = 0.176221E+01
+ PKER_RACCS ( 2, 19) = 0.183168E+01
+ PKER_RACCS ( 2, 20) = 0.188915E+01
+ PKER_RACCS ( 2, 21) = 0.193671E+01
+ PKER_RACCS ( 2, 22) = 0.197607E+01
+ PKER_RACCS ( 2, 23) = 0.200864E+01
+ PKER_RACCS ( 2, 24) = 0.203559E+01
+ PKER_RACCS ( 2, 25) = 0.205790E+01
+ PKER_RACCS ( 2, 26) = 0.207637E+01
+ PKER_RACCS ( 2, 27) = 0.209165E+01
+ PKER_RACCS ( 2, 28) = 0.210430E+01
+ PKER_RACCS ( 2, 29) = 0.211478E+01
+ PKER_RACCS ( 2, 30) = 0.212344E+01
+ PKER_RACCS ( 2, 31) = 0.213062E+01
+ PKER_RACCS ( 2, 32) = 0.213656E+01
+ PKER_RACCS ( 2, 33) = 0.214147E+01
+ PKER_RACCS ( 2, 34) = 0.214554E+01
+ PKER_RACCS ( 2, 35) = 0.214891E+01
+ PKER_RACCS ( 2, 36) = 0.215170E+01
+ PKER_RACCS ( 2, 37) = 0.215401E+01
+ PKER_RACCS ( 2, 38) = 0.215592E+01
+ PKER_RACCS ( 2, 39) = 0.215750E+01
+ PKER_RACCS ( 2, 40) = 0.215881E+01
+ PKER_RACCS ( 3, 1) = 0.861642E+01
+ PKER_RACCS ( 3, 2) = 0.668233E+01
+ PKER_RACCS ( 3, 3) = 0.511848E+01
+ PKER_RACCS ( 3, 4) = 0.385427E+01
+ PKER_RACCS ( 3, 5) = 0.283858E+01
+ PKER_RACCS ( 3, 6) = 0.203643E+01
+ PKER_RACCS ( 3, 7) = 0.142806E+01
+ PKER_RACCS ( 3, 8) = 0.100397E+01
+ PKER_RACCS ( 3, 9) = 0.757020E+00
+ PKER_RACCS ( 3, 10) = 0.673206E+00
+ PKER_RACCS ( 3, 11) = 0.719335E+00
+ PKER_RACCS ( 3, 12) = 0.849040E+00
+ PKER_RACCS ( 3, 13) = 0.101307E+01
+ PKER_RACCS ( 3, 14) = 0.117592E+01
+ PKER_RACCS ( 3, 15) = 0.132041E+01
+ PKER_RACCS ( 3, 16) = 0.144256E+01
+ PKER_RACCS ( 3, 17) = 0.154410E+01
+ PKER_RACCS ( 3, 18) = 0.162816E+01
+ PKER_RACCS ( 3, 19) = 0.169770E+01
+ PKER_RACCS ( 3, 20) = 0.175523E+01
+ PKER_RACCS ( 3, 21) = 0.180284E+01
+ PKER_RACCS ( 3, 22) = 0.184222E+01
+ PKER_RACCS ( 3, 23) = 0.187482E+01
+ PKER_RACCS ( 3, 24) = 0.190179E+01
+ PKER_RACCS ( 3, 25) = 0.192411E+01
+ PKER_RACCS ( 3, 26) = 0.194259E+01
+ PKER_RACCS ( 3, 27) = 0.195788E+01
+ PKER_RACCS ( 3, 28) = 0.197054E+01
+ PKER_RACCS ( 3, 29) = 0.198101E+01
+ PKER_RACCS ( 3, 30) = 0.198968E+01
+ PKER_RACCS ( 3, 31) = 0.199686E+01
+ PKER_RACCS ( 3, 32) = 0.200280E+01
+ PKER_RACCS ( 3, 33) = 0.200772E+01
+ PKER_RACCS ( 3, 34) = 0.201179E+01
+ PKER_RACCS ( 3, 35) = 0.201516E+01
+ PKER_RACCS ( 3, 36) = 0.201795E+01
+ PKER_RACCS ( 3, 37) = 0.202026E+01
+ PKER_RACCS ( 3, 38) = 0.202217E+01
+ PKER_RACCS ( 3, 39) = 0.202375E+01
+ PKER_RACCS ( 3, 40) = 0.202506E+01
+ PKER_RACCS ( 4, 1) = 0.890193E+01
+ PKER_RACCS ( 4, 2) = 0.691781E+01
+ PKER_RACCS ( 4, 3) = 0.531713E+01
+ PKER_RACCS ( 4, 4) = 0.402519E+01
+ PKER_RACCS ( 4, 5) = 0.298590E+01
+ PKER_RACCS ( 4, 6) = 0.216006E+01
+ PKER_RACCS ( 4, 7) = 0.152334E+01
+ PKER_RACCS ( 4, 8) = 0.106334E+01
+ PKER_RACCS ( 4, 9) = 0.773535E+00
+ PKER_RACCS ( 4, 10) = 0.643200E+00
+ PKER_RACCS ( 4, 11) = 0.648455E+00
+ PKER_RACCS ( 4, 12) = 0.748702E+00
+ PKER_RACCS ( 4, 13) = 0.896286E+00
+ PKER_RACCS ( 4, 14) = 0.105225E+01
+ PKER_RACCS ( 4, 15) = 0.119469E+01
+ PKER_RACCS ( 4, 16) = 0.131651E+01
+ PKER_RACCS ( 4, 17) = 0.141813E+01
+ PKER_RACCS ( 4, 18) = 0.150231E+01
+ PKER_RACCS ( 4, 19) = 0.157195E+01
+ PKER_RACCS ( 4, 20) = 0.162955E+01
+ PKER_RACCS ( 4, 21) = 0.167720E+01
+ PKER_RACCS ( 4, 22) = 0.171662E+01
+ PKER_RACCS ( 4, 23) = 0.174924E+01
+ PKER_RACCS ( 4, 24) = 0.177624E+01
+ PKER_RACCS ( 4, 25) = 0.179858E+01
+ PKER_RACCS ( 4, 26) = 0.181706E+01
+ PKER_RACCS ( 4, 27) = 0.183237E+01
+ PKER_RACCS ( 4, 28) = 0.184503E+01
+ PKER_RACCS ( 4, 29) = 0.185551E+01
+ PKER_RACCS ( 4, 30) = 0.186419E+01
+ PKER_RACCS ( 4, 31) = 0.187137E+01
+ PKER_RACCS ( 4, 32) = 0.187731E+01
+ PKER_RACCS ( 4, 33) = 0.188223E+01
+ PKER_RACCS ( 4, 34) = 0.188630E+01
+ PKER_RACCS ( 4, 35) = 0.188967E+01
+ PKER_RACCS ( 4, 36) = 0.189246E+01
+ PKER_RACCS ( 4, 37) = 0.189477E+01
+ PKER_RACCS ( 4, 38) = 0.189668E+01
+ PKER_RACCS ( 4, 39) = 0.189826E+01
+ PKER_RACCS ( 4, 40) = 0.189957E+01
+ PKER_RACCS ( 5, 1) = 0.920977E+01
+ PKER_RACCS ( 5, 2) = 0.716900E+01
+ PKER_RACCS ( 5, 3) = 0.552588E+01
+ PKER_RACCS ( 5, 4) = 0.420224E+01
+ PKER_RACCS ( 5, 5) = 0.313744E+01
+ PKER_RACCS ( 5, 6) = 0.228804E+01
+ PKER_RACCS ( 5, 7) = 0.162515E+01
+ PKER_RACCS ( 5, 8) = 0.113305E+01
+ PKER_RACCS ( 5, 9) = 0.804245E+00
+ PKER_RACCS ( 5, 10) = 0.630831E+00
+ PKER_RACCS ( 5, 11) = 0.594727E+00
+ PKER_RACCS ( 5, 12) = 0.662791E+00
+ PKER_RACCS ( 5, 13) = 0.790719E+00
+ PKER_RACCS ( 5, 14) = 0.937530E+00
+ PKER_RACCS ( 5, 15) = 0.107695E+01
+ PKER_RACCS ( 5, 16) = 0.119816E+01
+ PKER_RACCS ( 5, 17) = 0.129982E+01
+ PKER_RACCS ( 5, 18) = 0.138414E+01
+ PKER_RACCS ( 5, 19) = 0.145388E+01
+ PKER_RACCS ( 5, 20) = 0.151157E+01
+ PKER_RACCS ( 5, 21) = 0.155928E+01
+ PKER_RACCS ( 5, 22) = 0.159875E+01
+ PKER_RACCS ( 5, 23) = 0.163140E+01
+ PKER_RACCS ( 5, 24) = 0.165842E+01
+ PKER_RACCS ( 5, 25) = 0.168078E+01
+ PKER_RACCS ( 5, 26) = 0.169928E+01
+ PKER_RACCS ( 5, 27) = 0.171459E+01
+ PKER_RACCS ( 5, 28) = 0.172727E+01
+ PKER_RACCS ( 5, 29) = 0.173775E+01
+ PKER_RACCS ( 5, 30) = 0.174643E+01
+ PKER_RACCS ( 5, 31) = 0.175362E+01
+ PKER_RACCS ( 5, 32) = 0.175957E+01
+ PKER_RACCS ( 5, 33) = 0.176449E+01
+ PKER_RACCS ( 5, 34) = 0.176856E+01
+ PKER_RACCS ( 5, 35) = 0.177193E+01
+ PKER_RACCS ( 5, 36) = 0.177472E+01
+ PKER_RACCS ( 5, 37) = 0.177703E+01
+ PKER_RACCS ( 5, 38) = 0.177895E+01
+ PKER_RACCS ( 5, 39) = 0.178053E+01
+ PKER_RACCS ( 5, 40) = 0.178184E+01
+ PKER_RACCS ( 6, 1) = 0.954082E+01
+ PKER_RACCS ( 6, 2) = 0.743810E+01
+ PKER_RACCS ( 6, 3) = 0.574728E+01
+ PKER_RACCS ( 6, 4) = 0.438753E+01
+ PKER_RACCS ( 6, 5) = 0.329456E+01
+ PKER_RACCS ( 6, 6) = 0.242082E+01
+ PKER_RACCS ( 6, 7) = 0.173320E+01
+ PKER_RACCS ( 6, 8) = 0.121220E+01
+ PKER_RACCS ( 6, 9) = 0.848100E+00
+ PKER_RACCS ( 6, 10) = 0.633831E+00
+ PKER_RACCS ( 6, 11) = 0.557416E+00
+ PKER_RACCS ( 6, 12) = 0.591242E+00
+ PKER_RACCS ( 6, 13) = 0.696457E+00
+ PKER_RACCS ( 6, 14) = 0.831746E+00
+ PKER_RACCS ( 6, 15) = 0.966879E+00
+ PKER_RACCS ( 6, 16) = 0.108705E+01
+ PKER_RACCS ( 6, 17) = 0.118868E+01
+ PKER_RACCS ( 6, 18) = 0.127314E+01
+ PKER_RACCS ( 6, 19) = 0.134302E+01
+ PKER_RACCS ( 6, 20) = 0.140081E+01
+ PKER_RACCS ( 6, 21) = 0.144859E+01
+ PKER_RACCS ( 6, 22) = 0.148812E+01
+ PKER_RACCS ( 6, 23) = 0.152081E+01
+ PKER_RACCS ( 6, 24) = 0.154786E+01
+ PKER_RACCS ( 6, 25) = 0.157025E+01
+ PKER_RACCS ( 6, 26) = 0.158876E+01
+ PKER_RACCS ( 6, 27) = 0.160409E+01
+ PKER_RACCS ( 6, 28) = 0.161677E+01
+ PKER_RACCS ( 6, 29) = 0.162727E+01
+ PKER_RACCS ( 6, 30) = 0.163595E+01
+ PKER_RACCS ( 6, 31) = 0.164314E+01
+ PKER_RACCS ( 6, 32) = 0.164909E+01
+ PKER_RACCS ( 6, 33) = 0.165402E+01
+ PKER_RACCS ( 6, 34) = 0.165809E+01
+ PKER_RACCS ( 6, 35) = 0.166147E+01
+ PKER_RACCS ( 6, 36) = 0.166426E+01
+ PKER_RACCS ( 6, 37) = 0.166657E+01
+ PKER_RACCS ( 6, 38) = 0.166848E+01
+ PKER_RACCS ( 6, 39) = 0.167007E+01
+ PKER_RACCS ( 6, 40) = 0.167138E+01
+ PKER_RACCS ( 7, 1) = 0.989299E+01
+ PKER_RACCS ( 7, 2) = 0.772578E+01
+ PKER_RACCS ( 7, 3) = 0.598316E+01
+ PKER_RACCS ( 7, 4) = 0.458298E+01
+ PKER_RACCS ( 7, 5) = 0.345874E+01
+ PKER_RACCS ( 7, 6) = 0.255904E+01
+ PKER_RACCS ( 7, 7) = 0.184707E+01
+ PKER_RACCS ( 7, 8) = 0.129931E+01
+ PKER_RACCS ( 7, 9) = 0.903048E+00
+ PKER_RACCS ( 7, 10) = 0.651461E+00
+ PKER_RACCS ( 7, 11) = 0.535102E+00
+ PKER_RACCS ( 7, 12) = 0.533793E+00
+ PKER_RACCS ( 7, 13) = 0.613816E+00
+ PKER_RACCS ( 7, 14) = 0.735010E+00
+ PKER_RACCS ( 7, 15) = 0.864301E+00
+ PKER_RACCS ( 7, 16) = 0.982807E+00
+ PKER_RACCS ( 7, 17) = 0.108425E+01
+ PKER_RACCS ( 7, 18) = 0.116886E+01
+ PKER_RACCS ( 7, 19) = 0.123890E+01
+ PKER_RACCS ( 7, 20) = 0.129681E+01
+ PKER_RACCS ( 7, 21) = 0.134469E+01
+ PKER_RACCS ( 7, 22) = 0.138428E+01
+ PKER_RACCS ( 7, 23) = 0.141702E+01
+ PKER_RACCS ( 7, 24) = 0.144411E+01
+ PKER_RACCS ( 7, 25) = 0.146652E+01
+ PKER_RACCS ( 7, 26) = 0.148506E+01
+ PKER_RACCS ( 7, 27) = 0.150040E+01
+ PKER_RACCS ( 7, 28) = 0.151309E+01
+ PKER_RACCS ( 7, 29) = 0.152360E+01
+ PKER_RACCS ( 7, 30) = 0.153229E+01
+ PKER_RACCS ( 7, 31) = 0.153949E+01
+ PKER_RACCS ( 7, 32) = 0.154544E+01
+ PKER_RACCS ( 7, 33) = 0.155037E+01
+ PKER_RACCS ( 7, 34) = 0.155445E+01
+ PKER_RACCS ( 7, 35) = 0.155782E+01
+ PKER_RACCS ( 7, 36) = 0.156062E+01
+ PKER_RACCS ( 7, 37) = 0.156293E+01
+ PKER_RACCS ( 7, 38) = 0.156484E+01
+ PKER_RACCS ( 7, 39) = 0.156643E+01
+ PKER_RACCS ( 7, 40) = 0.156774E+01
+ PKER_RACCS ( 8, 1) = 0.102606E+02
+ PKER_RACCS ( 8, 2) = 0.803025E+01
+ PKER_RACCS ( 8, 3) = 0.623398E+01
+ PKER_RACCS ( 8, 4) = 0.479013E+01
+ PKER_RACCS ( 8, 5) = 0.363141E+01
+ PKER_RACCS ( 8, 6) = 0.270370E+01
+ PKER_RACCS ( 8, 7) = 0.196690E+01
+ PKER_RACCS ( 8, 8) = 0.139353E+01
+ PKER_RACCS ( 8, 9) = 0.967762E+00
+ PKER_RACCS ( 8, 10) = 0.681746E+00
+ PKER_RACCS ( 8, 11) = 0.527901E+00
+ PKER_RACCS ( 8, 12) = 0.491036E+00
+ PKER_RACCS ( 8, 13) = 0.543394E+00
+ PKER_RACCS ( 8, 14) = 0.647673E+00
+ PKER_RACCS ( 8, 15) = 0.769109E+00
+ PKER_RACCS ( 8, 16) = 0.885089E+00
+ PKER_RACCS ( 8, 17) = 0.986107E+00
+ PKER_RACCS ( 8, 18) = 0.107085E+01
+ PKER_RACCS ( 8, 19) = 0.114108E+01
+ PKER_RACCS ( 8, 20) = 0.119914E+01
+ PKER_RACCS ( 8, 21) = 0.124712E+01
+ PKER_RACCS ( 8, 22) = 0.128680E+01
+ PKER_RACCS ( 8, 23) = 0.131960E+01
+ PKER_RACCS ( 8, 24) = 0.134673E+01
+ PKER_RACCS ( 8, 25) = 0.136917E+01
+ PKER_RACCS ( 8, 26) = 0.138774E+01
+ PKER_RACCS ( 8, 27) = 0.140310E+01
+ PKER_RACCS ( 8, 28) = 0.141581E+01
+ PKER_RACCS ( 8, 29) = 0.142633E+01
+ PKER_RACCS ( 8, 30) = 0.143503E+01
+ PKER_RACCS ( 8, 31) = 0.144223E+01
+ PKER_RACCS ( 8, 32) = 0.144819E+01
+ PKER_RACCS ( 8, 33) = 0.145312E+01
+ PKER_RACCS ( 8, 34) = 0.145720E+01
+ PKER_RACCS ( 8, 35) = 0.146058E+01
+ PKER_RACCS ( 8, 36) = 0.146338E+01
+ PKER_RACCS ( 8, 37) = 0.146569E+01
+ PKER_RACCS ( 8, 38) = 0.146761E+01
+ PKER_RACCS ( 8, 39) = 0.146919E+01
+ PKER_RACCS ( 8, 40) = 0.147050E+01
+ PKER_RACCS ( 9, 1) = 0.106345E+02
+ PKER_RACCS ( 9, 2) = 0.834678E+01
+ PKER_RACCS ( 9, 3) = 0.649814E+01
+ PKER_RACCS ( 9, 4) = 0.500932E+01
+ PKER_RACCS ( 9, 5) = 0.381363E+01
+ PKER_RACCS ( 9, 6) = 0.285581E+01
+ PKER_RACCS ( 9, 7) = 0.209316E+01
+ PKER_RACCS ( 9, 8) = 0.149490E+01
+ PKER_RACCS ( 9, 9) = 0.104191E+01
+ PKER_RACCS ( 9, 10) = 0.724098E+00
+ PKER_RACCS ( 9, 11) = 0.534431E+00
+ PKER_RACCS ( 9, 12) = 0.462476E+00
+ PKER_RACCS ( 9, 13) = 0.485184E+00
+ PKER_RACCS ( 9, 14) = 0.569779E+00
+ PKER_RACCS ( 9, 15) = 0.681282E+00
+ PKER_RACCS ( 9, 16) = 0.793641E+00
+ PKER_RACCS ( 9, 17) = 0.893878E+00
+ PKER_RACCS ( 9, 18) = 0.978690E+00
+ PKER_RACCS ( 9, 19) = 0.104914E+01
+ PKER_RACCS ( 9, 20) = 0.110738E+01
+ PKER_RACCS ( 9, 21) = 0.115550E+01
+ PKER_RACCS ( 9, 22) = 0.119527E+01
+ PKER_RACCS ( 9, 23) = 0.122815E+01
+ PKER_RACCS ( 9, 24) = 0.125533E+01
+ PKER_RACCS ( 9, 25) = 0.127782E+01
+ PKER_RACCS ( 9, 26) = 0.129641E+01
+ PKER_RACCS ( 9, 27) = 0.131179E+01
+ PKER_RACCS ( 9, 28) = 0.132452E+01
+ PKER_RACCS ( 9, 29) = 0.133505E+01
+ PKER_RACCS ( 9, 30) = 0.134376E+01
+ PKER_RACCS ( 9, 31) = 0.135097E+01
+ PKER_RACCS ( 9, 32) = 0.135694E+01
+ PKER_RACCS ( 9, 33) = 0.136188E+01
+ PKER_RACCS ( 9, 34) = 0.136596E+01
+ PKER_RACCS ( 9, 35) = 0.136934E+01
+ PKER_RACCS ( 9, 36) = 0.137214E+01
+ PKER_RACCS ( 9, 37) = 0.137446E+01
+ PKER_RACCS ( 9, 38) = 0.137637E+01
+ PKER_RACCS ( 9, 39) = 0.137796E+01
+ PKER_RACCS ( 9, 40) = 0.137927E+01
+ PKER_RACCS ( 10, 1) = 0.110031E+02
+ PKER_RACCS ( 10, 2) = 0.866775E+01
+ PKER_RACCS ( 10, 3) = 0.677164E+01
+ PKER_RACCS ( 10, 4) = 0.523918E+01
+ PKER_RACCS ( 10, 5) = 0.400557E+01
+ PKER_RACCS ( 10, 6) = 0.301605E+01
+ PKER_RACCS ( 10, 7) = 0.222631E+01
+ PKER_RACCS ( 10, 8) = 0.160312E+01
+ PKER_RACCS ( 10, 9) = 0.112426E+01
+ PKER_RACCS ( 10, 10) = 0.776925E+00
+ PKER_RACCS ( 10, 11) = 0.554023E+00
+ PKER_RACCS ( 10, 12) = 0.447142E+00
+ PKER_RACCS ( 10, 13) = 0.439159E+00
+ PKER_RACCS ( 10, 14) = 0.501788E+00
+ PKER_RACCS ( 10, 15) = 0.601002E+00
+ PKER_RACCS ( 10, 16) = 0.708335E+00
+ PKER_RACCS ( 10, 17) = 0.807233E+00
+ PKER_RACCS ( 10, 18) = 0.892004E+00
+ PKER_RACCS ( 10, 19) = 0.962681E+00
+ PKER_RACCS ( 10, 20) = 0.102114E+01
+ PKER_RACCS ( 10, 21) = 0.106943E+01
+ PKER_RACCS ( 10, 22) = 0.110932E+01
+ PKER_RACCS ( 10, 23) = 0.114228E+01
+ PKER_RACCS ( 10, 24) = 0.116953E+01
+ PKER_RACCS ( 10, 25) = 0.119207E+01
+ PKER_RACCS ( 10, 26) = 0.121070E+01
+ PKER_RACCS ( 10, 27) = 0.122611E+01
+ PKER_RACCS ( 10, 28) = 0.123886E+01
+ PKER_RACCS ( 10, 29) = 0.124940E+01
+ PKER_RACCS ( 10, 30) = 0.125813E+01
+ PKER_RACCS ( 10, 31) = 0.126535E+01
+ PKER_RACCS ( 10, 32) = 0.127132E+01
+ PKER_RACCS ( 10, 33) = 0.127626E+01
+ PKER_RACCS ( 10, 34) = 0.128035E+01
+ PKER_RACCS ( 10, 35) = 0.128374E+01
+ PKER_RACCS ( 10, 36) = 0.128654E+01
+ PKER_RACCS ( 10, 37) = 0.128886E+01
+ PKER_RACCS ( 10, 38) = 0.129077E+01
+ PKER_RACCS ( 10, 39) = 0.129236E+01
+ PKER_RACCS ( 10, 40) = 0.129368E+01
+ PKER_RACCS ( 11, 1) = 0.113549E+02
+ PKER_RACCS ( 11, 2) = 0.898364E+01
+ PKER_RACCS ( 11, 3) = 0.704811E+01
+ PKER_RACCS ( 11, 4) = 0.547629E+01
+ PKER_RACCS ( 11, 5) = 0.420604E+01
+ PKER_RACCS ( 11, 6) = 0.318436E+01
+ PKER_RACCS ( 11, 7) = 0.236670E+01
+ PKER_RACCS ( 11, 8) = 0.171835E+01
+ PKER_RACCS ( 11, 9) = 0.121434E+01
+ PKER_RACCS ( 11, 10) = 0.839328E+00
+ PKER_RACCS ( 11, 11) = 0.585308E+00
+ PKER_RACCS ( 11, 12) = 0.445062E+00
+ PKER_RACCS ( 11, 13) = 0.405828E+00
+ PKER_RACCS ( 11, 14) = 0.444237E+00
+ PKER_RACCS ( 11, 15) = 0.528618E+00
+ PKER_RACCS ( 11, 16) = 0.629105E+00
+ PKER_RACCS ( 11, 17) = 0.725893E+00
+ PKER_RACCS ( 11, 18) = 0.810425E+00
+ PKER_RACCS ( 11, 19) = 0.881336E+00
+ PKER_RACCS ( 11, 20) = 0.940053E+00
+ PKER_RACCS ( 11, 21) = 0.988540E+00
+ PKER_RACCS ( 11, 22) = 0.102858E+01
+ PKER_RACCS ( 11, 23) = 0.106165E+01
+ PKER_RACCS ( 11, 24) = 0.108898E+01
+ PKER_RACCS ( 11, 25) = 0.111157E+01
+ PKER_RACCS ( 11, 26) = 0.113025E+01
+ PKER_RACCS ( 11, 27) = 0.114569E+01
+ PKER_RACCS ( 11, 28) = 0.115847E+01
+ PKER_RACCS ( 11, 29) = 0.116903E+01
+ PKER_RACCS ( 11, 30) = 0.117777E+01
+ PKER_RACCS ( 11, 31) = 0.118500E+01
+ PKER_RACCS ( 11, 32) = 0.119098E+01
+ PKER_RACCS ( 11, 33) = 0.119593E+01
+ PKER_RACCS ( 11, 34) = 0.120003E+01
+ PKER_RACCS ( 11, 35) = 0.120342E+01
+ PKER_RACCS ( 11, 36) = 0.120622E+01
+ PKER_RACCS ( 11, 37) = 0.120854E+01
+ PKER_RACCS ( 11, 38) = 0.121046E+01
+ PKER_RACCS ( 11, 39) = 0.121205E+01
+ PKER_RACCS ( 11, 40) = 0.121337E+01
+ PKER_RACCS ( 12, 1) = 0.116799E+02
+ PKER_RACCS ( 12, 2) = 0.928469E+01
+ PKER_RACCS ( 12, 3) = 0.731960E+01
+ PKER_RACCS ( 12, 4) = 0.571522E+01
+ PKER_RACCS ( 12, 5) = 0.441213E+01
+ PKER_RACCS ( 12, 6) = 0.335956E+01
+ PKER_RACCS ( 12, 7) = 0.251408E+01
+ PKER_RACCS ( 12, 8) = 0.184047E+01
+ PKER_RACCS ( 12, 9) = 0.131203E+01
+ PKER_RACCS ( 12, 10) = 0.911145E+00
+ PKER_RACCS ( 12, 11) = 0.627927E+00
+ PKER_RACCS ( 12, 12) = 0.455629E+00
+ PKER_RACCS ( 12, 13) = 0.385139E+00
+ PKER_RACCS ( 12, 14) = 0.397299E+00
+ PKER_RACCS ( 12, 15) = 0.464231E+00
+ PKER_RACCS ( 12, 16) = 0.555964E+00
+ PKER_RACCS ( 12, 17) = 0.649649E+00
+ PKER_RACCS ( 12, 18) = 0.733631E+00
+ PKER_RACCS ( 12, 19) = 0.804744E+00
+ PKER_RACCS ( 12, 20) = 0.863761E+00
+ PKER_RACCS ( 12, 21) = 0.912491E+00
+ PKER_RACCS ( 12, 22) = 0.952708E+00
+ PKER_RACCS ( 12, 23) = 0.985912E+00
+ PKER_RACCS ( 12, 24) = 0.101334E+01
+ PKER_RACCS ( 12, 25) = 0.103600E+01
+ PKER_RACCS ( 12, 26) = 0.105473E+01
+ PKER_RACCS ( 12, 27) = 0.107022E+01
+ PKER_RACCS ( 12, 28) = 0.108302E+01
+ PKER_RACCS ( 12, 29) = 0.109361E+01
+ PKER_RACCS ( 12, 30) = 0.110236E+01
+ PKER_RACCS ( 12, 31) = 0.110961E+01
+ PKER_RACCS ( 12, 32) = 0.111560E+01
+ PKER_RACCS ( 12, 33) = 0.112056E+01
+ PKER_RACCS ( 12, 34) = 0.112466E+01
+ PKER_RACCS ( 12, 35) = 0.112805E+01
+ PKER_RACCS ( 12, 36) = 0.113086E+01
+ PKER_RACCS ( 12, 37) = 0.113319E+01
+ PKER_RACCS ( 12, 38) = 0.113511E+01
+ PKER_RACCS ( 12, 39) = 0.113670E+01
+ PKER_RACCS ( 12, 40) = 0.113802E+01
+ PKER_RACCS ( 13, 1) = 0.119715E+02
+ PKER_RACCS ( 13, 2) = 0.956269E+01
+ PKER_RACCS ( 13, 3) = 0.757802E+01
+ PKER_RACCS ( 13, 4) = 0.594935E+01
+ PKER_RACCS ( 13, 5) = 0.461927E+01
+ PKER_RACCS ( 13, 6) = 0.353911E+01
+ PKER_RACCS ( 13, 7) = 0.266730E+01
+ PKER_RACCS ( 13, 8) = 0.196897E+01
+ PKER_RACCS ( 13, 9) = 0.141674E+01
+ PKER_RACCS ( 13, 10) = 0.991267E+00
+ PKER_RACCS ( 13, 11) = 0.680645E+00
+ PKER_RACCS ( 13, 12) = 0.478159E+00
+ PKER_RACCS ( 13, 13) = 0.376423E+00
+ PKER_RACCS ( 13, 14) = 0.361128E+00
+ PKER_RACCS ( 13, 15) = 0.408438E+00
+ PKER_RACCS ( 13, 16) = 0.489166E+00
+ PKER_RACCS ( 13, 17) = 0.578426E+00
+ PKER_RACCS ( 13, 18) = 0.661345E+00
+ PKER_RACCS ( 13, 19) = 0.732571E+00
+ PKER_RACCS ( 13, 20) = 0.791923E+00
+ PKER_RACCS ( 13, 21) = 0.840945E+00
+ PKER_RACCS ( 13, 22) = 0.881381E+00
+ PKER_RACCS ( 13, 23) = 0.914745E+00
+ PKER_RACCS ( 13, 24) = 0.942288E+00
+ PKER_RACCS ( 13, 25) = 0.965037E+00
+ PKER_RACCS ( 13, 26) = 0.983832E+00
+ PKER_RACCS ( 13, 27) = 0.999365E+00
+ PKER_RACCS ( 13, 28) = 0.101221E+01
+ PKER_RACCS ( 13, 29) = 0.102282E+01
+ PKER_RACCS ( 13, 30) = 0.103160E+01
+ PKER_RACCS ( 13, 31) = 0.103886E+01
+ PKER_RACCS ( 13, 32) = 0.104487E+01
+ PKER_RACCS ( 13, 33) = 0.104983E+01
+ PKER_RACCS ( 13, 34) = 0.105394E+01
+ PKER_RACCS ( 13, 35) = 0.105734E+01
+ PKER_RACCS ( 13, 36) = 0.106016E+01
+ PKER_RACCS ( 13, 37) = 0.106248E+01
+ PKER_RACCS ( 13, 38) = 0.106441E+01
+ PKER_RACCS ( 13, 39) = 0.106600E+01
+ PKER_RACCS ( 13, 40) = 0.106732E+01
+ PKER_RACCS ( 14, 1) = 0.122269E+02
+ PKER_RACCS ( 14, 2) = 0.981222E+01
+ PKER_RACCS ( 14, 3) = 0.781657E+01
+ PKER_RACCS ( 14, 4) = 0.617190E+01
+ PKER_RACCS ( 14, 5) = 0.482183E+01
+ PKER_RACCS ( 14, 6) = 0.371915E+01
+ PKER_RACCS ( 14, 7) = 0.282402E+01
+ PKER_RACCS ( 14, 8) = 0.210269E+01
+ PKER_RACCS ( 14, 9) = 0.152785E+01
+ PKER_RACCS ( 14, 10) = 0.107897E+01
+ PKER_RACCS ( 14, 11) = 0.742682E+00
+ PKER_RACCS ( 14, 12) = 0.511717E+00
+ PKER_RACCS ( 14, 13) = 0.379723E+00
+ PKER_RACCS ( 14, 14) = 0.336223E+00
+ PKER_RACCS ( 14, 15) = 0.361708E+00
+ PKER_RACCS ( 14, 16) = 0.429063E+00
+ PKER_RACCS ( 14, 17) = 0.512196E+00
+ PKER_RACCS ( 14, 18) = 0.593334E+00
+ PKER_RACCS ( 14, 19) = 0.664504E+00
+ PKER_RACCS ( 14, 20) = 0.724213E+00
+ PKER_RACCS ( 14, 21) = 0.773584E+00
+ PKER_RACCS ( 14, 22) = 0.814286E+00
+ PKER_RACCS ( 14, 23) = 0.847845E+00
+ PKER_RACCS ( 14, 24) = 0.875531E+00
+ PKER_RACCS ( 14, 25) = 0.898385E+00
+ PKER_RACCS ( 14, 26) = 0.917258E+00
+ PKER_RACCS ( 14, 27) = 0.932850E+00
+ PKER_RACCS ( 14, 28) = 0.945734E+00
+ PKER_RACCS ( 14, 29) = 0.956384E+00
+ PKER_RACCS ( 14, 30) = 0.965189E+00
+ PKER_RACCS ( 14, 31) = 0.972469E+00
+ PKER_RACCS ( 14, 32) = 0.978490E+00
+ PKER_RACCS ( 14, 33) = 0.983469E+00
+ PKER_RACCS ( 14, 34) = 0.987588E+00
+ PKER_RACCS ( 14, 35) = 0.990995E+00
+ PKER_RACCS ( 14, 36) = 0.993813E+00
+ PKER_RACCS ( 14, 37) = 0.996145E+00
+ PKER_RACCS ( 14, 38) = 0.998074E+00
+ PKER_RACCS ( 14, 39) = 0.999670E+00
+ PKER_RACCS ( 14, 40) = 0.100099E+01
+ PKER_RACCS ( 15, 1) = 0.124464E+02
+ PKER_RACCS ( 15, 2) = 0.100310E+02
+ PKER_RACCS ( 15, 3) = 0.803077E+01
+ PKER_RACCS ( 15, 4) = 0.637725E+01
+ PKER_RACCS ( 15, 5) = 0.501415E+01
+ PKER_RACCS ( 15, 6) = 0.389492E+01
+ PKER_RACCS ( 15, 7) = 0.298087E+01
+ PKER_RACCS ( 15, 8) = 0.223947E+01
+ PKER_RACCS ( 15, 9) = 0.164395E+01
+ PKER_RACCS ( 15, 10) = 0.117348E+01
+ PKER_RACCS ( 15, 11) = 0.813603E+00
+ PKER_RACCS ( 15, 12) = 0.555940E+00
+ PKER_RACCS ( 15, 13) = 0.394860E+00
+ PKER_RACCS ( 15, 14) = 0.322907E+00
+ PKER_RACCS ( 15, 15) = 0.324503E+00
+ PKER_RACCS ( 15, 16) = 0.375896E+00
+ PKER_RACCS ( 15, 17) = 0.451039E+00
+ PKER_RACCS ( 15, 18) = 0.529435E+00
+ PKER_RACCS ( 15, 19) = 0.600261E+00
+ PKER_RACCS ( 15, 20) = 0.660320E+00
+ PKER_RACCS ( 15, 21) = 0.710100E+00
+ PKER_RACCS ( 15, 22) = 0.751124E+00
+ PKER_RACCS ( 15, 23) = 0.784920E+00
+ PKER_RACCS ( 15, 24) = 0.812780E+00
+ PKER_RACCS ( 15, 25) = 0.835762E+00
+ PKER_RACCS ( 15, 26) = 0.854730E+00
+ PKER_RACCS ( 15, 27) = 0.870393E+00
+ PKER_RACCS ( 15, 28) = 0.883331E+00
+ PKER_RACCS ( 15, 29) = 0.894022E+00
+ PKER_RACCS ( 15, 30) = 0.902857E+00
+ PKER_RACCS ( 15, 31) = 0.910161E+00
+ PKER_RACCS ( 15, 32) = 0.916200E+00
+ PKER_RACCS ( 15, 33) = 0.921193E+00
+ PKER_RACCS ( 15, 34) = 0.925323E+00
+ PKER_RACCS ( 15, 35) = 0.928738E+00
+ PKER_RACCS ( 15, 36) = 0.931563E+00
+ PKER_RACCS ( 15, 37) = 0.933900E+00
+ PKER_RACCS ( 15, 38) = 0.935833E+00
+ PKER_RACCS ( 15, 39) = 0.937432E+00
+ PKER_RACCS ( 15, 40) = 0.938755E+00
+ PKER_RACCS ( 16, 1) = 0.126327E+02
+ PKER_RACCS ( 16, 2) = 0.102194E+02
+ PKER_RACCS ( 16, 3) = 0.821876E+01
+ PKER_RACCS ( 16, 4) = 0.656171E+01
+ PKER_RACCS ( 16, 5) = 0.519153E+01
+ PKER_RACCS ( 16, 6) = 0.406164E+01
+ PKER_RACCS ( 16, 7) = 0.313379E+01
+ PKER_RACCS ( 16, 8) = 0.237630E+01
+ PKER_RACCS ( 16, 9) = 0.176301E+01
+ PKER_RACCS ( 16, 10) = 0.127321E+01
+ PKER_RACCS ( 16, 11) = 0.891908E+00
+ PKER_RACCS ( 16, 12) = 0.609619E+00
+ PKER_RACCS ( 16, 13) = 0.421108E+00
+ PKER_RACCS ( 16, 14) = 0.320728E+00
+ PKER_RACCS ( 16, 15) = 0.297097E+00
+ PKER_RACCS ( 16, 16) = 0.330361E+00
+ PKER_RACCS ( 16, 17) = 0.395280E+00
+ PKER_RACCS ( 16, 18) = 0.469630E+00
+ PKER_RACCS ( 16, 19) = 0.539613E+00
+ PKER_RACCS ( 16, 20) = 0.599949E+00
+ PKER_RACCS ( 16, 21) = 0.650193E+00
+ PKER_RACCS ( 16, 22) = 0.691608E+00
+ PKER_RACCS ( 16, 23) = 0.725693E+00
+ PKER_RACCS ( 16, 24) = 0.753765E+00
+ PKER_RACCS ( 16, 25) = 0.776902E+00
+ PKER_RACCS ( 16, 26) = 0.795985E+00
+ PKER_RACCS ( 16, 27) = 0.811734E+00
+ PKER_RACCS ( 16, 28) = 0.824737E+00
+ PKER_RACCS ( 16, 29) = 0.835476E+00
+ PKER_RACCS ( 16, 30) = 0.844348E+00
+ PKER_RACCS ( 16, 31) = 0.851681E+00
+ PKER_RACCS ( 16, 32) = 0.857741E+00
+ PKER_RACCS ( 16, 33) = 0.862751E+00
+ PKER_RACCS ( 16, 34) = 0.866894E+00
+ PKER_RACCS ( 16, 35) = 0.870319E+00
+ PKER_RACCS ( 16, 36) = 0.873152E+00
+ PKER_RACCS ( 16, 37) = 0.875495E+00
+ PKER_RACCS ( 16, 38) = 0.877433E+00
+ PKER_RACCS ( 16, 39) = 0.879036E+00
+ PKER_RACCS ( 16, 40) = 0.880362E+00
+ PKER_RACCS ( 17, 1) = 0.127896E+02
+ PKER_RACCS ( 17, 2) = 0.103796E+02
+ PKER_RACCS ( 17, 3) = 0.838093E+01
+ PKER_RACCS ( 17, 4) = 0.672380E+01
+ PKER_RACCS ( 17, 5) = 0.535093E+01
+ PKER_RACCS ( 17, 6) = 0.421538E+01
+ PKER_RACCS ( 17, 7) = 0.327875E+01
+ PKER_RACCS ( 17, 8) = 0.250965E+01
+ PKER_RACCS ( 17, 9) = 0.188231E+01
+ PKER_RACCS ( 17, 10) = 0.137624E+01
+ PKER_RACCS ( 17, 11) = 0.976041E+00
+ PKER_RACCS ( 17, 12) = 0.671601E+00
+ PKER_RACCS ( 17, 13) = 0.457610E+00
+ PKER_RACCS ( 17, 14) = 0.329677E+00
+ PKER_RACCS ( 17, 15) = 0.280046E+00
+ PKER_RACCS ( 17, 16) = 0.292981E+00
+ PKER_RACCS ( 17, 17) = 0.345338E+00
+ PKER_RACCS ( 17, 18) = 0.413953E+00
+ PKER_RACCS ( 17, 19) = 0.482373E+00
+ PKER_RACCS ( 17, 20) = 0.542827E+00
+ PKER_RACCS ( 17, 21) = 0.593577E+00
+ PKER_RACCS ( 17, 22) = 0.635456E+00
+ PKER_RACCS ( 17, 23) = 0.669894E+00
+ PKER_RACCS ( 17, 24) = 0.698224E+00
+ PKER_RACCS ( 17, 25) = 0.721550E+00
+ PKER_RACCS ( 17, 26) = 0.740773E+00
+ PKER_RACCS ( 17, 27) = 0.756626E+00
+ PKER_RACCS ( 17, 28) = 0.769706E+00
+ PKER_RACCS ( 17, 29) = 0.780504E+00
+ PKER_RACCS ( 17, 30) = 0.789421E+00
+ PKER_RACCS ( 17, 31) = 0.796788E+00
+ PKER_RACCS ( 17, 32) = 0.802874E+00
+ PKER_RACCS ( 17, 33) = 0.807905E+00
+ PKER_RACCS ( 17, 34) = 0.812063E+00
+ PKER_RACCS ( 17, 35) = 0.815500E+00
+ PKER_RACCS ( 17, 36) = 0.818342E+00
+ PKER_RACCS ( 17, 37) = 0.820693E+00
+ PKER_RACCS ( 17, 38) = 0.822636E+00
+ PKER_RACCS ( 17, 39) = 0.824244E+00
+ PKER_RACCS ( 17, 40) = 0.825573E+00
+ PKER_RACCS ( 18, 1) = 0.129213E+02
+ PKER_RACCS ( 18, 2) = 0.105149E+02
+ PKER_RACCS ( 18, 3) = 0.851921E+01
+ PKER_RACCS ( 18, 4) = 0.686389E+01
+ PKER_RACCS ( 18, 5) = 0.549117E+01
+ PKER_RACCS ( 18, 6) = 0.435362E+01
+ PKER_RACCS ( 18, 7) = 0.341243E+01
+ PKER_RACCS ( 18, 8) = 0.263602E+01
+ PKER_RACCS ( 18, 9) = 0.199868E+01
+ PKER_RACCS ( 18, 10) = 0.147991E+01
+ PKER_RACCS ( 18, 11) = 0.106410E+01
+ PKER_RACCS ( 18, 12) = 0.740604E+00
+ PKER_RACCS ( 18, 13) = 0.503591E+00
+ PKER_RACCS ( 18, 14) = 0.349646E+00
+ PKER_RACCS ( 18, 15) = 0.273846E+00
+ PKER_RACCS ( 18, 16) = 0.264450E+00
+ PKER_RACCS ( 18, 17) = 0.301632E+00
+ PKER_RACCS ( 18, 18) = 0.362584E+00
+ PKER_RACCS ( 18, 19) = 0.428436E+00
+ PKER_RACCS ( 18, 20) = 0.488711E+00
+ PKER_RACCS ( 18, 21) = 0.539973E+00
+ PKER_RACCS ( 18, 22) = 0.582398E+00
+ PKER_RACCS ( 18, 23) = 0.617263E+00
+ PKER_RACCS ( 18, 24) = 0.645906E+00
+ PKER_RACCS ( 18, 25) = 0.669463E+00
+ PKER_RACCS ( 18, 26) = 0.688855E+00
+ PKER_RACCS ( 18, 27) = 0.704834E+00
+ PKER_RACCS ( 18, 28) = 0.718008E+00
+ PKER_RACCS ( 18, 29) = 0.728877E+00
+ PKER_RACCS ( 18, 30) = 0.737848E+00
+ PKER_RACCS ( 18, 31) = 0.745255E+00
+ PKER_RACCS ( 18, 32) = 0.751373E+00
+ PKER_RACCS ( 18, 33) = 0.756428E+00
+ PKER_RACCS ( 18, 34) = 0.760604E+00
+ PKER_RACCS ( 18, 35) = 0.764056E+00
+ PKER_RACCS ( 18, 36) = 0.766910E+00
+ PKER_RACCS ( 18, 37) = 0.769269E+00
+ PKER_RACCS ( 18, 38) = 0.771219E+00
+ PKER_RACCS ( 18, 39) = 0.772832E+00
+ PKER_RACCS ( 18, 40) = 0.774166E+00
+ PKER_RACCS ( 19, 1) = 0.130318E+02
+ PKER_RACCS ( 19, 2) = 0.106289E+02
+ PKER_RACCS ( 19, 3) = 0.863636E+01
+ PKER_RACCS ( 19, 4) = 0.698365E+01
+ PKER_RACCS ( 19, 5) = 0.561261E+01
+ PKER_RACCS ( 19, 6) = 0.447539E+01
+ PKER_RACCS ( 19, 7) = 0.353272E+01
+ PKER_RACCS ( 19, 8) = 0.275260E+01
+ PKER_RACCS ( 19, 9) = 0.210907E+01
+ PKER_RACCS ( 19, 10) = 0.158135E+01
+ PKER_RACCS ( 19, 11) = 0.115350E+01
+ PKER_RACCS ( 19, 12) = 0.814363E+00
+ PKER_RACCS ( 19, 13) = 0.557360E+00
+ PKER_RACCS ( 19, 14) = 0.379586E+00
+ PKER_RACCS ( 19, 15) = 0.278114E+00
+ PKER_RACCS ( 19, 16) = 0.245146E+00
+ PKER_RACCS ( 19, 17) = 0.264975E+00
+ PKER_RACCS ( 19, 18) = 0.315944E+00
+ PKER_RACCS ( 19, 19) = 0.377850E+00
+ PKER_RACCS ( 19, 20) = 0.437417E+00
+ PKER_RACCS ( 19, 21) = 0.489121E+00
+ PKER_RACCS ( 19, 22) = 0.532165E+00
+ PKER_RACCS ( 19, 23) = 0.567544E+00
+ PKER_RACCS ( 19, 24) = 0.596569E+00
+ PKER_RACCS ( 19, 25) = 0.620406E+00
+ PKER_RACCS ( 19, 26) = 0.640004E+00
+ PKER_RACCS ( 19, 27) = 0.656135E+00
+ PKER_RACCS ( 19, 28) = 0.669424E+00
+ PKER_RACCS ( 19, 29) = 0.680378E+00
+ PKER_RACCS ( 19, 30) = 0.689414E+00
+ PKER_RACCS ( 19, 31) = 0.696870E+00
+ PKER_RACCS ( 19, 32) = 0.703026E+00
+ PKER_RACCS ( 19, 33) = 0.708109E+00
+ PKER_RACCS ( 19, 34) = 0.712308E+00
+ PKER_RACCS ( 19, 35) = 0.715777E+00
+ PKER_RACCS ( 19, 36) = 0.718644E+00
+ PKER_RACCS ( 19, 37) = 0.721014E+00
+ PKER_RACCS ( 19, 38) = 0.722972E+00
+ PKER_RACCS ( 19, 39) = 0.724592E+00
+ PKER_RACCS ( 19, 40) = 0.725930E+00
+ PKER_RACCS ( 20, 1) = 0.131249E+02
+ PKER_RACCS ( 20, 2) = 0.107250E+02
+ PKER_RACCS ( 20, 3) = 0.873538E+01
+ PKER_RACCS ( 20, 4) = 0.708543E+01
+ PKER_RACCS ( 20, 5) = 0.571670E+01
+ PKER_RACCS ( 20, 6) = 0.458105E+01
+ PKER_RACCS ( 20, 7) = 0.363884E+01
+ PKER_RACCS ( 20, 8) = 0.285761E+01
+ PKER_RACCS ( 20, 9) = 0.221101E+01
+ PKER_RACCS ( 20, 10) = 0.167782E+01
+ PKER_RACCS ( 20, 11) = 0.124159E+01
+ PKER_RACCS ( 20, 12) = 0.890407E+00
+ PKER_RACCS ( 20, 13) = 0.616977E+00
+ PKER_RACCS ( 20, 14) = 0.418242E+00
+ PKER_RACCS ( 20, 15) = 0.292524E+00
+ PKER_RACCS ( 20, 16) = 0.235581E+00
+ PKER_RACCS ( 20, 17) = 0.235983E+00
+ PKER_RACCS ( 20, 18) = 0.274591E+00
+ PKER_RACCS ( 20, 19) = 0.330763E+00
+ PKER_RACCS ( 20, 20) = 0.388819E+00
+ PKER_RACCS ( 20, 21) = 0.440784E+00
+ PKER_RACCS ( 20, 22) = 0.484500E+00
+ PKER_RACCS ( 20, 23) = 0.520487E+00
+ PKER_RACCS ( 20, 24) = 0.549976E+00
+ PKER_RACCS ( 20, 25) = 0.574153E+00
+ PKER_RACCS ( 20, 26) = 0.594001E+00
+ PKER_RACCS ( 20, 27) = 0.610317E+00
+ PKER_RACCS ( 20, 28) = 0.623744E+00
+ PKER_RACCS ( 20, 29) = 0.634801E+00
+ PKER_RACCS ( 20, 30) = 0.643915E+00
+ PKER_RACCS ( 20, 31) = 0.651431E+00
+ PKER_RACCS ( 20, 32) = 0.657631E+00
+ PKER_RACCS ( 20, 33) = 0.662749E+00
+ PKER_RACCS ( 20, 34) = 0.666975E+00
+ PKER_RACCS ( 20, 35) = 0.670465E+00
+ PKER_RACCS ( 20, 36) = 0.673348E+00
+ PKER_RACCS ( 20, 37) = 0.675730E+00
+ PKER_RACCS ( 20, 38) = 0.677698E+00
+ PKER_RACCS ( 20, 39) = 0.679325E+00
+ PKER_RACCS ( 20, 40) = 0.680670E+00
+ PKER_RACCS ( 21, 1) = 0.132036E+02
+ PKER_RACCS ( 21, 2) = 0.108062E+02
+ PKER_RACCS ( 21, 3) = 0.881918E+01
+ PKER_RACCS ( 21, 4) = 0.717177E+01
+ PKER_RACCS ( 21, 5) = 0.580546E+01
+ PKER_RACCS ( 21, 6) = 0.467187E+01
+ PKER_RACCS ( 21, 7) = 0.373113E+01
+ PKER_RACCS ( 21, 8) = 0.295042E+01
+ PKER_RACCS ( 21, 9) = 0.230297E+01
+ PKER_RACCS ( 21, 10) = 0.176711E+01
+ PKER_RACCS ( 21, 11) = 0.132575E+01
+ PKER_RACCS ( 21, 12) = 0.966211E+00
+ PKER_RACCS ( 21, 13) = 0.680246E+00
+ PKER_RACCS ( 21, 14) = 0.464064E+00
+ PKER_RACCS ( 21, 15) = 0.316605E+00
+ PKER_RACCS ( 21, 16) = 0.236157E+00
+ PKER_RACCS ( 21, 17) = 0.215485E+00
+ PKER_RACCS ( 21, 18) = 0.239150E+00
+ PKER_RACCS ( 21, 19) = 0.287499E+00
+ PKER_RACCS ( 21, 20) = 0.342900E+00
+ PKER_RACCS ( 21, 21) = 0.394764E+00
+ PKER_RACCS ( 21, 22) = 0.439154E+00
+ PKER_RACCS ( 21, 23) = 0.475848E+00
+ PKER_RACCS ( 21, 24) = 0.505894E+00
+ PKER_RACCS ( 21, 25) = 0.530484E+00
+ PKER_RACCS ( 21, 26) = 0.550636E+00
+ PKER_RACCS ( 21, 27) = 0.567176E+00
+ PKER_RACCS ( 21, 28) = 0.580769E+00
+ PKER_RACCS ( 21, 29) = 0.591952E+00
+ PKER_RACCS ( 21, 30) = 0.601159E+00
+ PKER_RACCS ( 21, 31) = 0.608746E+00
+ PKER_RACCS ( 21, 32) = 0.615001E+00
+ PKER_RACCS ( 21, 33) = 0.620161E+00
+ PKER_RACCS ( 21, 34) = 0.624418E+00
+ PKER_RACCS ( 21, 35) = 0.627933E+00
+ PKER_RACCS ( 21, 36) = 0.630835E+00
+ PKER_RACCS ( 21, 37) = 0.633232E+00
+ PKER_RACCS ( 21, 38) = 0.635212E+00
+ PKER_RACCS ( 21, 39) = 0.636848E+00
+ PKER_RACCS ( 21, 40) = 0.638199E+00
+ PKER_RACCS ( 22, 1) = 0.132706E+02
+ PKER_RACCS ( 22, 2) = 0.108752E+02
+ PKER_RACCS ( 22, 3) = 0.889034E+01
+ PKER_RACCS ( 22, 4) = 0.724514E+01
+ PKER_RACCS ( 22, 5) = 0.588103E+01
+ PKER_RACCS ( 22, 6) = 0.474956E+01
+ PKER_RACCS ( 22, 7) = 0.381066E+01
+ PKER_RACCS ( 22, 8) = 0.303131E+01
+ PKER_RACCS ( 22, 9) = 0.238440E+01
+ PKER_RACCS ( 22, 10) = 0.184783E+01
+ PKER_RACCS ( 22, 11) = 0.140395E+01
+ PKER_RACCS ( 22, 12) = 0.103925E+01
+ PKER_RACCS ( 22, 13) = 0.744489E+00
+ PKER_RACCS ( 22, 14) = 0.514665E+00
+ PKER_RACCS ( 22, 15) = 0.348618E+00
+ PKER_RACCS ( 22, 16) = 0.246213E+00
+ PKER_RACCS ( 22, 17) = 0.203810E+00
+ PKER_RACCS ( 22, 18) = 0.210527E+00
+ PKER_RACCS ( 22, 19) = 0.248639E+00
+ PKER_RACCS ( 22, 20) = 0.299821E+00
+ PKER_RACCS ( 22, 21) = 0.350944E+00
+ PKER_RACCS ( 22, 22) = 0.395903E+00
+ PKER_RACCS ( 22, 23) = 0.433386E+00
+ PKER_RACCS ( 22, 24) = 0.464095E+00
+ PKER_RACCS ( 22, 25) = 0.489182E+00
+ PKER_RACCS ( 22, 26) = 0.509702E+00
+ PKER_RACCS ( 22, 27) = 0.526514E+00
+ PKER_RACCS ( 22, 28) = 0.540309E+00
+ PKER_RACCS ( 22, 29) = 0.551642E+00
+ PKER_RACCS ( 22, 30) = 0.560963E+00
+ PKER_RACCS ( 22, 31) = 0.568636E+00
+ PKER_RACCS ( 22, 32) = 0.574956E+00
+ PKER_RACCS ( 22, 33) = 0.580166E+00
+ PKER_RACCS ( 22, 34) = 0.584462E+00
+ PKER_RACCS ( 22, 35) = 0.588006E+00
+ PKER_RACCS ( 22, 36) = 0.590931E+00
+ PKER_RACCS ( 22, 37) = 0.593346E+00
+ PKER_RACCS ( 22, 38) = 0.595339E+00
+ PKER_RACCS ( 22, 39) = 0.596986E+00
+ PKER_RACCS ( 22, 40) = 0.598346E+00
+ PKER_RACCS ( 23, 1) = 0.133280E+02
+ PKER_RACCS ( 23, 2) = 0.109343E+02
+ PKER_RACCS ( 23, 3) = 0.895109E+01
+ PKER_RACCS ( 23, 4) = 0.730772E+01
+ PKER_RACCS ( 23, 5) = 0.594552E+01
+ PKER_RACCS ( 23, 6) = 0.481597E+01
+ PKER_RACCS ( 23, 7) = 0.387893E+01
+ PKER_RACCS ( 23, 8) = 0.310124E+01
+ PKER_RACCS ( 23, 9) = 0.245555E+01
+ PKER_RACCS ( 23, 10) = 0.191949E+01
+ PKER_RACCS ( 23, 11) = 0.147491E+01
+ PKER_RACCS ( 23, 12) = 0.110760E+01
+ PKER_RACCS ( 23, 13) = 0.807248E+00
+ PKER_RACCS ( 23, 14) = 0.567629E+00
+ PKER_RACCS ( 23, 15) = 0.386696E+00
+ PKER_RACCS ( 23, 16) = 0.264772E+00
+ PKER_RACCS ( 23, 17) = 0.201168E+00
+ PKER_RACCS ( 23, 18) = 0.189359E+00
+ PKER_RACCS ( 23, 19) = 0.214892E+00
+ PKER_RACCS ( 23, 20) = 0.259902E+00
+ PKER_RACCS ( 23, 21) = 0.309296E+00
+ PKER_RACCS ( 23, 22) = 0.354562E+00
+ PKER_RACCS ( 23, 23) = 0.392871E+00
+ PKER_RACCS ( 23, 24) = 0.424352E+00
+ PKER_RACCS ( 23, 25) = 0.450037E+00
+ PKER_RACCS ( 23, 26) = 0.471000E+00
+ PKER_RACCS ( 23, 27) = 0.488140E+00
+ PKER_RACCS ( 23, 28) = 0.502179E+00
+ PKER_RACCS ( 23, 29) = 0.513695E+00
+ PKER_RACCS ( 23, 30) = 0.523153E+00
+ PKER_RACCS ( 23, 31) = 0.530929E+00
+ PKER_RACCS ( 23, 32) = 0.537328E+00
+ PKER_RACCS ( 23, 33) = 0.542597E+00
+ PKER_RACCS ( 23, 34) = 0.546939E+00
+ PKER_RACCS ( 23, 35) = 0.550519E+00
+ PKER_RACCS ( 23, 36) = 0.553471E+00
+ PKER_RACCS ( 23, 37) = 0.555907E+00
+ PKER_RACCS ( 23, 38) = 0.557917E+00
+ PKER_RACCS ( 23, 39) = 0.559577E+00
+ PKER_RACCS ( 23, 40) = 0.560947E+00
+ PKER_RACCS ( 24, 1) = 0.133776E+02
+ PKER_RACCS ( 24, 2) = 0.109851E+02
+ PKER_RACCS ( 24, 3) = 0.900330E+01
+ PKER_RACCS ( 24, 4) = 0.736141E+01
+ PKER_RACCS ( 24, 5) = 0.600078E+01
+ PKER_RACCS ( 24, 6) = 0.487288E+01
+ PKER_RACCS ( 24, 7) = 0.393752E+01
+ PKER_RACCS ( 24, 8) = 0.316146E+01
+ PKER_RACCS ( 24, 9) = 0.251726E+01
+ PKER_RACCS ( 24, 10) = 0.198229E+01
+ PKER_RACCS ( 24, 11) = 0.153812E+01
+ PKER_RACCS ( 24, 12) = 0.116995E+01
+ PKER_RACCS ( 24, 13) = 0.866612E+00
+ PKER_RACCS ( 24, 14) = 0.620643E+00
+ PKER_RACCS ( 24, 15) = 0.428690E+00
+ PKER_RACCS ( 24, 16) = 0.290707E+00
+ PKER_RACCS ( 24, 17) = 0.207519E+00
+ PKER_RACCS ( 24, 18) = 0.176401E+00
+ PKER_RACCS ( 24, 19) = 0.187072E+00
+ PKER_RACCS ( 24, 20) = 0.223666E+00
+ PKER_RACCS ( 24, 21) = 0.269955E+00
+ PKER_RACCS ( 24, 22) = 0.315007E+00
+ PKER_RACCS ( 24, 23) = 0.354096E+00
+ PKER_RACCS ( 24, 24) = 0.386445E+00
+ PKER_RACCS ( 24, 25) = 0.412837E+00
+ PKER_RACCS ( 24, 26) = 0.434333E+00
+ PKER_RACCS ( 24, 27) = 0.451869E+00
+ PKER_RACCS ( 24, 28) = 0.466202E+00
+ PKER_RACCS ( 24, 29) = 0.477938E+00
+ PKER_RACCS ( 24, 30) = 0.487561E+00
+ PKER_RACCS ( 24, 31) = 0.495462E+00
+ PKER_RACCS ( 24, 32) = 0.501955E+00
+ PKER_RACCS ( 24, 33) = 0.507296E+00
+ PKER_RACCS ( 24, 34) = 0.511693E+00
+ PKER_RACCS ( 24, 35) = 0.515315E+00
+ PKER_RACCS ( 24, 36) = 0.518300E+00
+ PKER_RACCS ( 24, 37) = 0.520762E+00
+ PKER_RACCS ( 24, 38) = 0.522792E+00
+ PKER_RACCS ( 24, 39) = 0.524467E+00
+ PKER_RACCS ( 24, 40) = 0.525849E+00
+ PKER_RACCS ( 25, 1) = 0.134206E+02
+ PKER_RACCS ( 25, 2) = 0.110292E+02
+ PKER_RACCS ( 25, 3) = 0.904847E+01
+ PKER_RACCS ( 25, 4) = 0.740776E+01
+ PKER_RACCS ( 25, 5) = 0.604841E+01
+ PKER_RACCS ( 25, 6) = 0.492186E+01
+ PKER_RACCS ( 25, 7) = 0.398793E+01
+ PKER_RACCS ( 25, 8) = 0.321335E+01
+ PKER_RACCS ( 25, 9) = 0.257059E+01
+ PKER_RACCS ( 25, 10) = 0.203693E+01
+ PKER_RACCS ( 25, 11) = 0.159370E+01
+ PKER_RACCS ( 25, 12) = 0.122575E+01
+ PKER_RACCS ( 25, 13) = 0.921214E+00
+ PKER_RACCS ( 25, 14) = 0.671617E+00
+ PKER_RACCS ( 25, 15) = 0.472110E+00
+ PKER_RACCS ( 25, 16) = 0.321676E+00
+ PKER_RACCS ( 25, 17) = 0.221561E+00
+ PKER_RACCS ( 25, 18) = 0.171605E+00
+ PKER_RACCS ( 25, 19) = 0.166038E+00
+ PKER_RACCS ( 25, 20) = 0.191877E+00
+ PKER_RACCS ( 25, 21) = 0.233259E+00
+ PKER_RACCS ( 25, 22) = 0.277238E+00
+ PKER_RACCS ( 25, 23) = 0.316894E+00
+ PKER_RACCS ( 25, 24) = 0.350169E+00
+ PKER_RACCS ( 25, 25) = 0.377379E+00
+ PKER_RACCS ( 25, 26) = 0.399506E+00
+ PKER_RACCS ( 25, 27) = 0.417517E+00
+ PKER_RACCS ( 25, 28) = 0.432204E+00
+ PKER_RACCS ( 25, 29) = 0.444205E+00
+ PKER_RACCS ( 25, 30) = 0.454027E+00
+ PKER_RACCS ( 25, 31) = 0.462077E+00
+ PKER_RACCS ( 25, 32) = 0.468684E+00
+ PKER_RACCS ( 25, 33) = 0.474112E+00
+ PKER_RACCS ( 25, 34) = 0.478576E+00
+ PKER_RACCS ( 25, 35) = 0.482249E+00
+ PKER_RACCS ( 25, 36) = 0.485273E+00
+ PKER_RACCS ( 25, 37) = 0.487764E+00
+ PKER_RACCS ( 25, 38) = 0.489818E+00
+ PKER_RACCS ( 25, 39) = 0.491511E+00
+ PKER_RACCS ( 25, 40) = 0.492908E+00
+ PKER_RACCS ( 26, 1) = 0.134583E+02
+ PKER_RACCS ( 26, 2) = 0.110677E+02
+ PKER_RACCS ( 26, 3) = 0.908784E+01
+ PKER_RACCS ( 26, 4) = 0.744807E+01
+ PKER_RACCS ( 26, 5) = 0.608972E+01
+ PKER_RACCS ( 26, 6) = 0.496427E+01
+ PKER_RACCS ( 26, 7) = 0.403151E+01
+ PKER_RACCS ( 26, 8) = 0.325817E+01
+ PKER_RACCS ( 26, 9) = 0.261671E+01
+ PKER_RACCS ( 26, 10) = 0.208432E+01
+ PKER_RACCS ( 26, 11) = 0.164223E+01
+ PKER_RACCS ( 26, 12) = 0.127505E+01
+ PKER_RACCS ( 26, 13) = 0.970445E+00
+ PKER_RACCS ( 26, 14) = 0.719103E+00
+ PKER_RACCS ( 26, 15) = 0.514960E+00
+ PKER_RACCS ( 26, 16) = 0.355619E+00
+ PKER_RACCS ( 26, 17) = 0.241696E+00
+ PKER_RACCS ( 26, 18) = 0.174597E+00
+ PKER_RACCS ( 26, 19) = 0.152207E+00
+ PKER_RACCS ( 26, 20) = 0.165325E+00
+ PKER_RACCS ( 26, 21) = 0.199742E+00
+ PKER_RACCS ( 26, 22) = 0.241398E+00
+ PKER_RACCS ( 26, 23) = 0.281177E+00
+ PKER_RACCS ( 26, 24) = 0.315343E+00
+ PKER_RACCS ( 26, 25) = 0.343466E+00
+ PKER_RACCS ( 26, 26) = 0.366332E+00
+ PKER_RACCS ( 26, 27) = 0.384904E+00
+ PKER_RACCS ( 26, 28) = 0.400015E+00
+ PKER_RACCS ( 26, 29) = 0.412334E+00
+ PKER_RACCS ( 26, 30) = 0.422395E+00
+ PKER_RACCS ( 26, 31) = 0.430626E+00
+ PKER_RACCS ( 26, 32) = 0.437370E+00
+ PKER_RACCS ( 26, 33) = 0.442902E+00
+ PKER_RACCS ( 26, 34) = 0.447445E+00
+ PKER_RACCS ( 26, 35) = 0.451179E+00
+ PKER_RACCS ( 26, 36) = 0.454250E+00
+ PKER_RACCS ( 26, 37) = 0.456778E+00
+ PKER_RACCS ( 26, 38) = 0.458860E+00
+ PKER_RACCS ( 26, 39) = 0.460575E+00
+ PKER_RACCS ( 26, 40) = 0.461988E+00
+ PKER_RACCS ( 27, 1) = 0.134916E+02
+ PKER_RACCS ( 27, 2) = 0.111016E+02
+ PKER_RACCS ( 27, 3) = 0.912241E+01
+ PKER_RACCS ( 27, 4) = 0.748337E+01
+ PKER_RACCS ( 27, 5) = 0.612582E+01
+ PKER_RACCS ( 27, 6) = 0.500123E+01
+ PKER_RACCS ( 27, 7) = 0.406942E+01
+ PKER_RACCS ( 27, 8) = 0.329710E+01
+ PKER_RACCS ( 27, 9) = 0.265672E+01
+ PKER_RACCS ( 27, 10) = 0.212547E+01
+ PKER_RACCS ( 27, 11) = 0.168449E+01
+ PKER_RACCS ( 27, 12) = 0.131827E+01
+ PKER_RACCS ( 27, 13) = 0.101419E+01
+ PKER_RACCS ( 27, 14) = 0.762350E+00
+ PKER_RACCS ( 27, 15) = 0.555726E+00
+ PKER_RACCS ( 27, 16) = 0.390561E+00
+ PKER_RACCS ( 27, 17) = 0.266359E+00
+ PKER_RACCS ( 27, 18) = 0.184682E+00
+ PKER_RACCS ( 27, 19) = 0.145925E+00
+ PKER_RACCS ( 27, 20) = 0.144842E+00
+ PKER_RACCS ( 27, 21) = 0.170126E+00
+ PKER_RACCS ( 27, 22) = 0.207837E+00
+ PKER_RACCS ( 27, 23) = 0.246960E+00
+ PKER_RACCS ( 27, 24) = 0.281834E+00
+ PKER_RACCS ( 27, 25) = 0.310921E+00
+ PKER_RACCS ( 27, 26) = 0.334627E+00
+ PKER_RACCS ( 27, 27) = 0.353857E+00
+ PKER_RACCS ( 27, 28) = 0.369470E+00
+ PKER_RACCS ( 27, 29) = 0.382168E+00
+ PKER_RACCS ( 27, 30) = 0.392516E+00
+ PKER_RACCS ( 27, 31) = 0.400964E+00
+ PKER_RACCS ( 27, 32) = 0.407872E+00
+ PKER_RACCS ( 27, 33) = 0.413529E+00
+ PKER_RACCS ( 27, 34) = 0.418167E+00
+ PKER_RACCS ( 27, 35) = 0.421974E+00
+ PKER_RACCS ( 27, 36) = 0.425101E+00
+ PKER_RACCS ( 27, 37) = 0.427673E+00
+ PKER_RACCS ( 27, 38) = 0.429788E+00
+ PKER_RACCS ( 27, 39) = 0.431529E+00
+ PKER_RACCS ( 27, 40) = 0.432963E+00
+ PKER_RACCS ( 28, 1) = 0.135212E+02
+ PKER_RACCS ( 28, 2) = 0.111316E+02
+ PKER_RACCS ( 28, 3) = 0.915297E+01
+ PKER_RACCS ( 28, 4) = 0.751450E+01
+ PKER_RACCS ( 28, 5) = 0.615758E+01
+ PKER_RACCS ( 28, 6) = 0.503368E+01
+ PKER_RACCS ( 28, 7) = 0.410261E+01
+ PKER_RACCS ( 28, 8) = 0.333111E+01
+ PKER_RACCS ( 28, 9) = 0.269162E+01
+ PKER_RACCS ( 28, 10) = 0.216132E+01
+ PKER_RACCS ( 28, 11) = 0.172133E+01
+ PKER_RACCS ( 28, 12) = 0.135607E+01
+ PKER_RACCS ( 28, 13) = 0.105274E+01
+ PKER_RACCS ( 28, 14) = 0.801085E+00
+ PKER_RACCS ( 28, 15) = 0.593401E+00
+ PKER_RACCS ( 28, 16) = 0.424717E+00
+ PKER_RACCS ( 28, 17) = 0.293277E+00
+ PKER_RACCS ( 28, 18) = 0.200068E+00
+ PKER_RACCS ( 28, 19) = 0.146527E+00
+ PKER_RACCS ( 28, 20) = 0.130912E+00
+ PKER_RACCS ( 28, 21) = 0.145240E+00
+ PKER_RACCS ( 28, 22) = 0.177100E+00
+ PKER_RACCS ( 28, 23) = 0.214430E+00
+ PKER_RACCS ( 28, 24) = 0.249591E+00
+ PKER_RACCS ( 28, 25) = 0.279602E+00
+ PKER_RACCS ( 28, 26) = 0.304226E+00
+ PKER_RACCS ( 28, 27) = 0.324208E+00
+ PKER_RACCS ( 28, 28) = 0.340405E+00
+ PKER_RACCS ( 28, 29) = 0.353552E+00
+ PKER_RACCS ( 28, 30) = 0.364242E+00
+ PKER_RACCS ( 28, 31) = 0.372949E+00
+ PKER_RACCS ( 28, 32) = 0.380054E+00
+ PKER_RACCS ( 28, 33) = 0.385860E+00
+ PKER_RACCS ( 28, 34) = 0.390613E+00
+ PKER_RACCS ( 28, 35) = 0.394508E+00
+ PKER_RACCS ( 28, 36) = 0.397703E+00
+ PKER_RACCS ( 28, 37) = 0.400326E+00
+ PKER_RACCS ( 28, 38) = 0.402482E+00
+ PKER_RACCS ( 28, 39) = 0.404254E+00
+ PKER_RACCS ( 28, 40) = 0.405713E+00
+ PKER_RACCS ( 29, 1) = 0.135476E+02
+ PKER_RACCS ( 29, 2) = 0.111584E+02
+ PKER_RACCS ( 29, 3) = 0.918018E+01
+ PKER_RACCS ( 29, 4) = 0.754216E+01
+ PKER_RACCS ( 29, 5) = 0.618572E+01
+ PKER_RACCS ( 29, 6) = 0.506235E+01
+ PKER_RACCS ( 29, 7) = 0.413187E+01
+ PKER_RACCS ( 29, 8) = 0.336101E+01
+ PKER_RACCS ( 29, 9) = 0.272223E+01
+ PKER_RACCS ( 29, 10) = 0.219271E+01
+ PKER_RACCS ( 29, 11) = 0.175356E+01
+ PKER_RACCS ( 29, 12) = 0.138915E+01
+ PKER_RACCS ( 29, 13) = 0.108662E+01
+ PKER_RACCS ( 29, 14) = 0.835482E+00
+ PKER_RACCS ( 29, 15) = 0.627544E+00
+ PKER_RACCS ( 29, 16) = 0.457003E+00
+ PKER_RACCS ( 29, 17) = 0.320871E+00
+ PKER_RACCS ( 29, 18) = 0.218993E+00
+ PKER_RACCS ( 29, 19) = 0.153040E+00
+ PKER_RACCS ( 29, 20) = 0.123480E+00
+ PKER_RACCS ( 29, 21) = 0.125714E+00
+ PKER_RACCS ( 29, 22) = 0.149873E+00
+ PKER_RACCS ( 29, 23) = 0.183944E+00
+ PKER_RACCS ( 29, 24) = 0.218688E+00
+ PKER_RACCS ( 29, 25) = 0.249424E+00
+ PKER_RACCS ( 29, 26) = 0.274989E+00
+ PKER_RACCS ( 29, 27) = 0.295803E+00
+ PKER_RACCS ( 29, 28) = 0.312668E+00
+ PKER_RACCS ( 29, 29) = 0.326337E+00
+ PKER_RACCS ( 29, 30) = 0.337429E+00
+ PKER_RACCS ( 29, 31) = 0.346444E+00
+ PKER_RACCS ( 29, 32) = 0.353785E+00
+ PKER_RACCS ( 29, 33) = 0.359771E+00
+ PKER_RACCS ( 29, 34) = 0.364661E+00
+ PKER_RACCS ( 29, 35) = 0.368660E+00
+ PKER_RACCS ( 29, 36) = 0.371936E+00
+ PKER_RACCS ( 29, 37) = 0.374622E+00
+ PKER_RACCS ( 29, 38) = 0.376826E+00
+ PKER_RACCS ( 29, 39) = 0.378635E+00
+ PKER_RACCS ( 29, 40) = 0.380123E+00
+ PKER_RACCS ( 30, 1) = 0.135713E+02
+ PKER_RACCS ( 30, 2) = 0.111824E+02
+ PKER_RACCS ( 30, 3) = 0.920455E+01
+ PKER_RACCS ( 30, 4) = 0.756688E+01
+ PKER_RACCS ( 30, 5) = 0.621082E+01
+ PKER_RACCS ( 30, 6) = 0.508787E+01
+ PKER_RACCS ( 30, 7) = 0.415784E+01
+ PKER_RACCS ( 30, 8) = 0.338749E+01
+ PKER_RACCS ( 30, 9) = 0.274927E+01
+ PKER_RACCS ( 30, 10) = 0.222037E+01
+ PKER_RACCS ( 30, 11) = 0.178189E+01
+ PKER_RACCS ( 30, 12) = 0.141821E+01
+ PKER_RACCS ( 30, 13) = 0.111641E+01
+ PKER_RACCS ( 30, 14) = 0.865882E+00
+ PKER_RACCS ( 30, 15) = 0.658144E+00
+ PKER_RACCS ( 30, 16) = 0.486803E+00
+ PKER_RACCS ( 30, 17) = 0.347889E+00
+ PKER_RACCS ( 30, 18) = 0.240079E+00
+ PKER_RACCS ( 30, 19) = 0.164371E+00
+ PKER_RACCS ( 30, 20) = 0.122278E+00
+ PKER_RACCS ( 30, 21) = 0.112067E+00
+ PKER_RACCS ( 30, 22) = 0.126909E+00
+ PKER_RACCS ( 30, 23) = 0.156066E+00
+ PKER_RACCS ( 30, 24) = 0.189340E+00
+ PKER_RACCS ( 30, 25) = 0.220392E+00
+ PKER_RACCS ( 30, 26) = 0.246822E+00
+ PKER_RACCS ( 30, 27) = 0.268510E+00
+ PKER_RACCS ( 30, 28) = 0.286117E+00
+ PKER_RACCS ( 30, 29) = 0.300380E+00
+ PKER_RACCS ( 30, 30) = 0.311940E+00
+ PKER_RACCS ( 30, 31) = 0.321318E+00
+ PKER_RACCS ( 30, 32) = 0.328937E+00
+ PKER_RACCS ( 30, 33) = 0.335137E+00
+ PKER_RACCS ( 30, 34) = 0.340191E+00
+ PKER_RACCS ( 30, 35) = 0.344317E+00
+ PKER_RACCS ( 30, 36) = 0.347689E+00
+ PKER_RACCS ( 30, 37) = 0.350449E+00
+ PKER_RACCS ( 30, 38) = 0.352711E+00
+ PKER_RACCS ( 30, 39) = 0.354565E+00
+ PKER_RACCS ( 30, 40) = 0.356087E+00
+ PKER_RACCS ( 31, 1) = 0.135928E+02
+ PKER_RACCS ( 31, 2) = 0.112041E+02
+ PKER_RACCS ( 31, 3) = 0.922651E+01
+ PKER_RACCS ( 31, 4) = 0.758911E+01
+ PKER_RACCS ( 31, 5) = 0.623334E+01
+ PKER_RACCS ( 31, 6) = 0.511071E+01
+ PKER_RACCS ( 31, 7) = 0.418105E+01
+ PKER_RACCS ( 31, 8) = 0.341109E+01
+ PKER_RACCS ( 31, 9) = 0.277330E+01
+ PKER_RACCS ( 31, 10) = 0.224489E+01
+ PKER_RACCS ( 31, 11) = 0.180695E+01
+ PKER_RACCS ( 31, 12) = 0.144386E+01
+ PKER_RACCS ( 31, 13) = 0.114268E+01
+ PKER_RACCS ( 31, 14) = 0.892748E+00
+ PKER_RACCS ( 31, 15) = 0.685391E+00
+ PKER_RACCS ( 31, 16) = 0.513859E+00
+ PKER_RACCS ( 31, 17) = 0.373398E+00
+ PKER_RACCS ( 31, 18) = 0.261665E+00
+ PKER_RACCS ( 31, 19) = 0.178785E+00
+ PKER_RACCS ( 31, 20) = 0.126188E+00
+ PKER_RACCS ( 31, 21) = 0.104190E+00
+ PKER_RACCS ( 31, 22) = 0.108781E+00
+ PKER_RACCS ( 31, 23) = 0.131410E+00
+ PKER_RACCS ( 31, 24) = 0.161929E+00
+ PKER_RACCS ( 31, 25) = 0.192628E+00
+ PKER_RACCS ( 31, 26) = 0.219702E+00
+ PKER_RACCS ( 31, 27) = 0.242240E+00
+ PKER_RACCS ( 31, 28) = 0.260630E+00
+ PKER_RACCS ( 31, 29) = 0.275551E+00
+ PKER_RACCS ( 31, 30) = 0.287642E+00
+ PKER_RACCS ( 31, 31) = 0.297440E+00
+ PKER_RACCS ( 31, 32) = 0.305387E+00
+ PKER_RACCS ( 31, 33) = 0.311841E+00
+ PKER_RACCS ( 31, 34) = 0.317090E+00
+ PKER_RACCS ( 31, 35) = 0.321366E+00
+ PKER_RACCS ( 31, 36) = 0.324854E+00
+ PKER_RACCS ( 31, 37) = 0.327703E+00
+ PKER_RACCS ( 31, 38) = 0.330033E+00
+ PKER_RACCS ( 31, 39) = 0.331941E+00
+ PKER_RACCS ( 31, 40) = 0.333505E+00
+ PKER_RACCS ( 32, 1) = 0.136123E+02
+ PKER_RACCS ( 32, 2) = 0.112238E+02
+ PKER_RACCS ( 32, 3) = 0.924639E+01
+ PKER_RACCS ( 32, 4) = 0.760920E+01
+ PKER_RACCS ( 32, 5) = 0.625367E+01
+ PKER_RACCS ( 32, 6) = 0.513129E+01
+ PKER_RACCS ( 32, 7) = 0.420190E+01
+ PKER_RACCS ( 32, 8) = 0.343225E+01
+ PKER_RACCS ( 32, 9) = 0.279481E+01
+ PKER_RACCS ( 32, 10) = 0.226677E+01
+ PKER_RACCS ( 32, 11) = 0.182926E+01
+ PKER_RACCS ( 32, 12) = 0.146664E+01
+ PKER_RACCS ( 32, 13) = 0.116597E+01
+ PKER_RACCS ( 32, 14) = 0.916557E+00
+ PKER_RACCS ( 32, 15) = 0.709637E+00
+ PKER_RACCS ( 32, 16) = 0.538201E+00
+ PKER_RACCS ( 32, 17) = 0.397009E+00
+ PKER_RACCS ( 32, 18) = 0.282874E+00
+ PKER_RACCS ( 32, 19) = 0.194862E+00
+ PKER_RACCS ( 32, 20) = 0.133999E+00
+ PKER_RACCS ( 32, 21) = 0.101519E+00
+ PKER_RACCS ( 32, 22) = 0.957088E-01
+ PKER_RACCS ( 32, 23) = 0.110579E+00
+ PKER_RACCS ( 32, 24) = 0.136947E+00
+ PKER_RACCS ( 32, 25) = 0.166392E+00
+ PKER_RACCS ( 32, 26) = 0.193693E+00
+ PKER_RACCS ( 32, 27) = 0.216957E+00
+ PKER_RACCS ( 32, 28) = 0.236123E+00
+ PKER_RACCS ( 32, 29) = 0.251739E+00
+ PKER_RACCS ( 32, 30) = 0.264414E+00
+ PKER_RACCS ( 32, 31) = 0.274689E+00
+ PKER_RACCS ( 32, 32) = 0.283015E+00
+ PKER_RACCS ( 32, 33) = 0.289766E+00
+ PKER_RACCS ( 32, 34) = 0.295246E+00
+ PKER_RACCS ( 32, 35) = 0.299700E+00
+ PKER_RACCS ( 32, 36) = 0.303326E+00
+ PKER_RACCS ( 32, 37) = 0.306282E+00
+ PKER_RACCS ( 32, 38) = 0.308695E+00
+ PKER_RACCS ( 32, 39) = 0.310666E+00
+ PKER_RACCS ( 32, 40) = 0.312279E+00
+ PKER_RACCS ( 33, 1) = 0.136301E+02
+ PKER_RACCS ( 33, 2) = 0.112418E+02
+ PKER_RACCS ( 33, 3) = 0.926449E+01
+ PKER_RACCS ( 33, 4) = 0.762746E+01
+ PKER_RACCS ( 33, 5) = 0.627211E+01
+ PKER_RACCS ( 33, 6) = 0.514993E+01
+ PKER_RACCS ( 33, 7) = 0.422075E+01
+ PKER_RACCS ( 33, 8) = 0.345134E+01
+ PKER_RACCS ( 33, 9) = 0.281416E+01
+ PKER_RACCS ( 33, 10) = 0.228641E+01
+ PKER_RACCS ( 33, 11) = 0.184923E+01
+ PKER_RACCS ( 33, 12) = 0.148699E+01
+ PKER_RACCS ( 33, 13) = 0.118672E+01
+ PKER_RACCS ( 33, 14) = 0.937747E+00
+ PKER_RACCS ( 33, 15) = 0.731237E+00
+ PKER_RACCS ( 33, 16) = 0.560038E+00
+ PKER_RACCS ( 33, 17) = 0.418590E+00
+ PKER_RACCS ( 33, 18) = 0.303093E+00
+ PKER_RACCS ( 33, 19) = 0.211735E+00
+ PKER_RACCS ( 33, 20) = 0.144709E+00
+ PKER_RACCS ( 33, 21) = 0.103389E+00
+ PKER_RACCS ( 33, 22) = 0.876948E-01
+ PKER_RACCS ( 33, 23) = 0.940326E-01
+ PKER_RACCS ( 33, 24) = 0.114972E+00
+ PKER_RACCS ( 33, 25) = 0.142046E+00
+ PKER_RACCS ( 33, 26) = 0.168966E+00
+ PKER_RACCS ( 33, 27) = 0.192699E+00
+ PKER_RACCS ( 33, 28) = 0.212559E+00
+ PKER_RACCS ( 33, 29) = 0.228864E+00
+ PKER_RACCS ( 33, 30) = 0.242156E+00
+ PKER_RACCS ( 33, 31) = 0.252953E+00
+ PKER_RACCS ( 33, 32) = 0.261707E+00
+ PKER_RACCS ( 33, 33) = 0.268801E+00
+ PKER_RACCS ( 33, 34) = 0.274551E+00
+ PKER_RACCS ( 33, 35) = 0.279216E+00
+ PKER_RACCS ( 33, 36) = 0.283006E+00
+ PKER_RACCS ( 33, 37) = 0.286089E+00
+ PKER_RACCS ( 33, 38) = 0.288600E+00
+ PKER_RACCS ( 33, 39) = 0.290648E+00
+ PKER_RACCS ( 33, 40) = 0.292320E+00
+ PKER_RACCS ( 34, 1) = 0.136464E+02
+ PKER_RACCS ( 34, 2) = 0.112582E+02
+ PKER_RACCS ( 34, 3) = 0.928102E+01
+ PKER_RACCS ( 34, 4) = 0.764412E+01
+ PKER_RACCS ( 34, 5) = 0.628891E+01
+ PKER_RACCS ( 34, 6) = 0.516688E+01
+ PKER_RACCS ( 34, 7) = 0.423787E+01
+ PKER_RACCS ( 34, 8) = 0.346865E+01
+ PKER_RACCS ( 34, 9) = 0.283167E+01
+ PKER_RACCS ( 34, 10) = 0.230415E+01
+ PKER_RACCS ( 34, 11) = 0.186723E+01
+ PKER_RACCS ( 34, 12) = 0.150527E+01
+ PKER_RACCS ( 34, 13) = 0.120533E+01
+ PKER_RACCS ( 34, 14) = 0.956703E+00
+ PKER_RACCS ( 34, 15) = 0.750546E+00
+ PKER_RACCS ( 34, 16) = 0.579618E+00
+ PKER_RACCS ( 34, 17) = 0.438164E+00
+ PKER_RACCS ( 34, 18) = 0.321920E+00
+ PKER_RACCS ( 34, 19) = 0.228381E+00
+ PKER_RACCS ( 34, 20) = 0.157004E+00
+ PKER_RACCS ( 34, 21) = 0.108653E+00
+ PKER_RACCS ( 34, 22) = 0.841812E-01
+ PKER_RACCS ( 34, 23) = 0.818931E-01
+ PKER_RACCS ( 34, 24) = 0.964120E-01
+ PKER_RACCS ( 34, 25) = 0.120012E+00
+ PKER_RACCS ( 34, 26) = 0.145780E+00
+ PKER_RACCS ( 34, 27) = 0.169586E+00
+ PKER_RACCS ( 34, 28) = 0.189966E+00
+ PKER_RACCS ( 34, 29) = 0.206893E+00
+ PKER_RACCS ( 34, 30) = 0.220793E+00
+ PKER_RACCS ( 34, 31) = 0.232137E+00
+ PKER_RACCS ( 34, 32) = 0.241360E+00
+ PKER_RACCS ( 34, 33) = 0.248841E+00
+ PKER_RACCS ( 34, 34) = 0.254902E+00
+ PKER_RACCS ( 34, 35) = 0.259814E+00
+ PKER_RACCS ( 34, 36) = 0.263797E+00
+ PKER_RACCS ( 34, 37) = 0.267030E+00
+ PKER_RACCS ( 34, 38) = 0.269658E+00
+ PKER_RACCS ( 34, 39) = 0.271797E+00
+ PKER_RACCS ( 34, 40) = 0.273540E+00
+ PKER_RACCS ( 35, 1) = 0.136614E+02
+ PKER_RACCS ( 35, 2) = 0.112733E+02
+ PKER_RACCS ( 35, 3) = 0.929618E+01
+ PKER_RACCS ( 35, 4) = 0.765939E+01
+ PKER_RACCS ( 35, 5) = 0.630429E+01
+ PKER_RACCS ( 35, 6) = 0.518237E+01
+ PKER_RACCS ( 35, 7) = 0.425350E+01
+ PKER_RACCS ( 35, 8) = 0.348441E+01
+ PKER_RACCS ( 35, 9) = 0.284759E+01
+ PKER_RACCS ( 35, 10) = 0.232025E+01
+ PKER_RACCS ( 35, 11) = 0.188353E+01
+ PKER_RACCS ( 35, 12) = 0.152179E+01
+ PKER_RACCS ( 35, 13) = 0.122210E+01
+ PKER_RACCS ( 35, 14) = 0.973753E+00
+ PKER_RACCS ( 35, 15) = 0.767890E+00
+ PKER_RACCS ( 35, 16) = 0.597225E+00
+ PKER_RACCS ( 35, 17) = 0.455867E+00
+ PKER_RACCS ( 35, 18) = 0.339275E+00
+ PKER_RACCS ( 35, 19) = 0.244416E+00
+ PKER_RACCS ( 35, 20) = 0.169957E+00
+ PKER_RACCS ( 35, 21) = 0.116255E+00
+ PKER_RACCS ( 35, 22) = 0.843838E-01
+ PKER_RACCS ( 35, 23) = 0.739429E-01
+ PKER_RACCS ( 35, 24) = 0.815390E-01
+ PKER_RACCS ( 35, 25) = 0.100685E+00
+ PKER_RACCS ( 35, 26) = 0.124455E+00
+ PKER_RACCS ( 35, 27) = 0.147808E+00
+ PKER_RACCS ( 35, 28) = 0.168434E+00
+ PKER_RACCS ( 35, 29) = 0.185847E+00
+ PKER_RACCS ( 35, 30) = 0.200294E+00
+ PKER_RACCS ( 35, 31) = 0.212176E+00
+ PKER_RACCS ( 35, 32) = 0.221887E+00
+ PKER_RACCS ( 35, 33) = 0.229789E+00
+ PKER_RACCS ( 35, 34) = 0.236201E+00
+ PKER_RACCS ( 35, 35) = 0.241396E+00
+ PKER_RACCS ( 35, 36) = 0.245605E+00
+ PKER_RACCS ( 35, 37) = 0.249015E+00
+ PKER_RACCS ( 35, 38) = 0.251782E+00
+ PKER_RACCS ( 35, 39) = 0.254029E+00
+ PKER_RACCS ( 35, 40) = 0.255856E+00
+ PKER_RACCS ( 36, 1) = 0.136752E+02
+ PKER_RACCS ( 36, 2) = 0.112871E+02
+ PKER_RACCS ( 36, 3) = 0.931013E+01
+ PKER_RACCS ( 36, 4) = 0.767342E+01
+ PKER_RACCS ( 36, 5) = 0.631840E+01
+ PKER_RACCS ( 36, 6) = 0.519658E+01
+ PKER_RACCS ( 36, 7) = 0.426781E+01
+ PKER_RACCS ( 36, 8) = 0.349883E+01
+ PKER_RACCS ( 36, 9) = 0.286213E+01
+ PKER_RACCS ( 36, 10) = 0.233493E+01
+ PKER_RACCS ( 36, 11) = 0.189836E+01
+ PKER_RACCS ( 36, 12) = 0.153679E+01
+ PKER_RACCS ( 36, 13) = 0.123730E+01
+ PKER_RACCS ( 36, 14) = 0.989170E+00
+ PKER_RACCS ( 36, 15) = 0.783542E+00
+ PKER_RACCS ( 36, 16) = 0.613107E+00
+ PKER_RACCS ( 36, 17) = 0.471895E+00
+ PKER_RACCS ( 36, 18) = 0.355181E+00
+ PKER_RACCS ( 36, 19) = 0.259564E+00
+ PKER_RACCS ( 36, 20) = 0.183119E+00
+ PKER_RACCS ( 36, 21) = 0.125501E+00
+ PKER_RACCS ( 36, 22) = 0.876130E-01
+ PKER_RACCS ( 36, 23) = 0.698509E-01
+ PKER_RACCS ( 36, 24) = 0.704131E-01
+ PKER_RACCS ( 36, 25) = 0.843947E-01
+ PKER_RACCS ( 36, 26) = 0.105303E+00
+ PKER_RACCS ( 36, 27) = 0.127595E+00
+ PKER_RACCS ( 36, 28) = 0.148112E+00
+ PKER_RACCS ( 36, 29) = 0.165804E+00
+ PKER_RACCS ( 36, 30) = 0.180678E+00
+ PKER_RACCS ( 36, 31) = 0.193038E+00
+ PKER_RACCS ( 36, 32) = 0.203226E+00
+ PKER_RACCS ( 36, 33) = 0.211566E+00
+ PKER_RACCS ( 36, 34) = 0.218358E+00
+ PKER_RACCS ( 36, 35) = 0.223872E+00
+ PKER_RACCS ( 36, 36) = 0.228339E+00
+ PKER_RACCS ( 36, 37) = 0.231956E+00
+ PKER_RACCS ( 36, 38) = 0.234886E+00
+ PKER_RACCS ( 36, 39) = 0.237261E+00
+ PKER_RACCS ( 36, 40) = 0.239188E+00
+ PKER_RACCS ( 37, 1) = 0.136880E+02
+ PKER_RACCS ( 37, 2) = 0.113000E+02
+ PKER_RACCS ( 37, 3) = 0.932301E+01
+ PKER_RACCS ( 37, 4) = 0.768635E+01
+ PKER_RACCS ( 37, 5) = 0.633140E+01
+ PKER_RACCS ( 37, 6) = 0.520966E+01
+ PKER_RACCS ( 37, 7) = 0.428096E+01
+ PKER_RACCS ( 37, 8) = 0.351207E+01
+ PKER_RACCS ( 37, 9) = 0.287547E+01
+ PKER_RACCS ( 37, 10) = 0.234837E+01
+ PKER_RACCS ( 37, 11) = 0.191192E+01
+ PKER_RACCS ( 37, 12) = 0.155048E+01
+ PKER_RACCS ( 37, 13) = 0.125114E+01
+ PKER_RACCS ( 37, 14) = 0.100318E+01
+ PKER_RACCS ( 37, 15) = 0.797739E+00
+ PKER_RACCS ( 37, 16) = 0.627493E+00
+ PKER_RACCS ( 37, 17) = 0.486429E+00
+ PKER_RACCS ( 37, 18) = 0.369711E+00
+ PKER_RACCS ( 37, 19) = 0.273656E+00
+ PKER_RACCS ( 37, 20) = 0.195887E+00
+ PKER_RACCS ( 37, 21) = 0.135541E+00
+ PKER_RACCS ( 37, 22) = 0.929713E-01
+ PKER_RACCS ( 37, 23) = 0.689449E-01
+ PKER_RACCS ( 37, 24) = 0.628067E-01
+ PKER_RACCS ( 37, 25) = 0.712146E-01
+ PKER_RACCS ( 37, 26) = 0.885642E-01
+ PKER_RACCS ( 37, 27) = 0.109176E+00
+ PKER_RACCS ( 37, 28) = 0.129175E+00
+ PKER_RACCS ( 37, 29) = 0.146887E+00
+ PKER_RACCS ( 37, 30) = 0.162013E+00
+ PKER_RACCS ( 37, 31) = 0.174742E+00
+ PKER_RACCS ( 37, 32) = 0.185350E+00
+ PKER_RACCS ( 37, 33) = 0.194114E+00
+ PKER_RACCS ( 37, 34) = 0.201300E+00
+ PKER_RACCS ( 37, 35) = 0.207158E+00
+ PKER_RACCS ( 37, 36) = 0.211915E+00
+ PKER_RACCS ( 37, 37) = 0.215769E+00
+ PKER_RACCS ( 37, 38) = 0.218888E+00
+ PKER_RACCS ( 37, 39) = 0.221414E+00
+ PKER_RACCS ( 37, 40) = 0.223459E+00
+ PKER_RACCS ( 38, 1) = 0.136998E+02
+ PKER_RACCS ( 38, 2) = 0.113118E+02
+ PKER_RACCS ( 38, 3) = 0.933491E+01
+ PKER_RACCS ( 38, 4) = 0.769831E+01
+ PKER_RACCS ( 38, 5) = 0.634341E+01
+ PKER_RACCS ( 38, 6) = 0.522172E+01
+ PKER_RACCS ( 38, 7) = 0.429308E+01
+ PKER_RACCS ( 38, 8) = 0.352426E+01
+ PKER_RACCS ( 38, 9) = 0.288774E+01
+ PKER_RACCS ( 38, 10) = 0.236072E+01
+ PKER_RACCS ( 38, 11) = 0.192436E+01
+ PKER_RACCS ( 38, 12) = 0.156302E+01
+ PKER_RACCS ( 38, 13) = 0.126380E+01
+ PKER_RACCS ( 38, 14) = 0.101597E+01
+ PKER_RACCS ( 38, 15) = 0.810672E+00
+ PKER_RACCS ( 38, 16) = 0.640582E+00
+ PKER_RACCS ( 38, 17) = 0.499655E+00
+ PKER_RACCS ( 38, 18) = 0.382979E+00
+ PKER_RACCS ( 38, 19) = 0.286703E+00
+ PKER_RACCS ( 38, 20) = 0.208118E+00
+ PKER_RACCS ( 38, 21) = 0.145802E+00
+ PKER_RACCS ( 38, 22) = 0.996958E-01
+ PKER_RACCS ( 38, 23) = 0.705180E-01
+ PKER_RACCS ( 38, 24) = 0.583121E-01
+ PKER_RACCS ( 38, 25) = 0.611067E-01
+ PKER_RACCS ( 38, 26) = 0.743784E-01
+ PKER_RACCS ( 38, 27) = 0.927345E-01
+ PKER_RACCS ( 38, 28) = 0.111788E+00
+ PKER_RACCS ( 38, 29) = 0.129236E+00
+ PKER_RACCS ( 38, 30) = 0.144407E+00
+ PKER_RACCS ( 38, 31) = 0.157347E+00
+ PKER_RACCS ( 38, 32) = 0.168273E+00
+ PKER_RACCS ( 38, 33) = 0.177407E+00
+ PKER_RACCS ( 38, 34) = 0.184972E+00
+ PKER_RACCS ( 38, 35) = 0.191185E+00
+ PKER_RACCS ( 38, 36) = 0.196255E+00
+ PKER_RACCS ( 38, 37) = 0.200374E+00
+ PKER_RACCS ( 38, 38) = 0.203711E+00
+ PKER_RACCS ( 38, 39) = 0.206411E+00
+ PKER_RACCS ( 38, 40) = 0.208595E+00
+ PKER_RACCS ( 39, 1) = 0.137108E+02
+ PKER_RACCS ( 39, 2) = 0.113228E+02
+ PKER_RACCS ( 39, 3) = 0.934595E+01
+ PKER_RACCS ( 39, 4) = 0.770939E+01
+ PKER_RACCS ( 39, 5) = 0.635453E+01
+ PKER_RACCS ( 39, 6) = 0.523288E+01
+ PKER_RACCS ( 39, 7) = 0.430429E+01
+ PKER_RACCS ( 39, 8) = 0.353552E+01
+ PKER_RACCS ( 39, 9) = 0.289905E+01
+ PKER_RACCS ( 39, 10) = 0.237210E+01
+ PKER_RACCS ( 39, 11) = 0.193581E+01
+ PKER_RACCS ( 39, 12) = 0.157455E+01
+ PKER_RACCS ( 39, 13) = 0.127542E+01
+ PKER_RACCS ( 39, 14) = 0.102769E+01
+ PKER_RACCS ( 39, 15) = 0.822505E+00
+ PKER_RACCS ( 39, 16) = 0.652537E+00
+ PKER_RACCS ( 39, 17) = 0.511728E+00
+ PKER_RACCS ( 39, 18) = 0.395120E+00
+ PKER_RACCS ( 39, 19) = 0.298748E+00
+ PKER_RACCS ( 39, 20) = 0.219673E+00
+ PKER_RACCS ( 39, 21) = 0.156076E+00
+ PKER_RACCS ( 39, 22) = 0.107363E+00
+ PKER_RACCS ( 39, 23) = 0.740476E-01
+ PKER_RACCS ( 39, 24) = 0.565449E-01
+ PKER_RACCS ( 39, 25) = 0.539031E-01
+ PKER_RACCS ( 39, 26) = 0.628068E-01
+ PKER_RACCS ( 39, 27) = 0.783909E-01
+ PKER_RACCS ( 39, 28) = 0.960758E-01
+ PKER_RACCS ( 39, 29) = 0.112978E+00
+ PKER_RACCS ( 39, 30) = 0.127980E+00
+ PKER_RACCS ( 39, 31) = 0.140952E+00
+ PKER_RACCS ( 39, 32) = 0.152050E+00
+ PKER_RACCS ( 39, 33) = 0.161459E+00
+ PKER_RACCS ( 39, 34) = 0.169352E+00
+ PKER_RACCS ( 39, 35) = 0.175905E+00
+ PKER_RACCS ( 39, 36) = 0.181296E+00
+ PKER_RACCS ( 39, 37) = 0.185700E+00
+ PKER_RACCS ( 39, 38) = 0.189279E+00
+ PKER_RACCS ( 39, 39) = 0.192179E+00
+ PKER_RACCS ( 39, 40) = 0.194525E+00
+ PKER_RACCS ( 40, 1) = 0.137209E+02
+ PKER_RACCS ( 40, 2) = 0.113330E+02
+ PKER_RACCS ( 40, 3) = 0.935620E+01
+ PKER_RACCS ( 40, 4) = 0.771967E+01
+ PKER_RACCS ( 40, 5) = 0.636484E+01
+ PKER_RACCS ( 40, 6) = 0.524323E+01
+ PKER_RACCS ( 40, 7) = 0.431468E+01
+ PKER_RACCS ( 40, 8) = 0.354595E+01
+ PKER_RACCS ( 40, 9) = 0.290952E+01
+ PKER_RACCS ( 40, 10) = 0.238262E+01
+ PKER_RACCS ( 40, 11) = 0.194638E+01
+ PKER_RACCS ( 40, 12) = 0.158519E+01
+ PKER_RACCS ( 40, 13) = 0.128612E+01
+ PKER_RACCS ( 40, 14) = 0.103847E+01
+ PKER_RACCS ( 40, 15) = 0.833372E+00
+ PKER_RACCS ( 40, 16) = 0.663500E+00
+ PKER_RACCS ( 40, 17) = 0.522788E+00
+ PKER_RACCS ( 40, 18) = 0.406248E+00
+ PKER_RACCS ( 40, 19) = 0.309849E+00
+ PKER_RACCS ( 40, 20) = 0.230469E+00
+ PKER_RACCS ( 40, 21) = 0.165985E+00
+ PKER_RACCS ( 40, 22) = 0.115455E+00
+ PKER_RACCS ( 40, 23) = 0.789238E-01
+ PKER_RACCS ( 40, 24) = 0.569440E-01
+ PKER_RACCS ( 40, 25) = 0.492680E-01
+ PKER_RACCS ( 40, 26) = 0.537042E-01
+ PKER_RACCS ( 40, 27) = 0.661559E-01
+ PKER_RACCS ( 40, 28) = 0.821048E-01
+ PKER_RACCS ( 40, 29) = 0.981944E-01
+ PKER_RACCS ( 40, 30) = 0.112835E+00
+ PKER_RACCS ( 40, 31) = 0.125662E+00
+ PKER_RACCS ( 40, 32) = 0.136771E+00
+ PKER_RACCS ( 40, 33) = 0.146319E+00
+ PKER_RACCS ( 40, 34) = 0.154449E+00
+ PKER_RACCS ( 40, 35) = 0.161294E+00
+ PKER_RACCS ( 40, 36) = 0.166991E+00
+ PKER_RACCS ( 40, 37) = 0.171687E+00
+ PKER_RACCS ( 40, 38) = 0.175527E+00
+ PKER_RACCS ( 40, 39) = 0.178649E+00
+ PKER_RACCS ( 40, 40) = 0.181179E+00
+END IF
+!
+IF( PRESENT(PKER_SACCRG) ) THEN
+ PKER_SACCRG( 1, 1) = 0.438311E-02
+ PKER_SACCRG( 1, 2) = 0.641932E-02
+ PKER_SACCRG( 1, 3) = 0.104323E-01
+ PKER_SACCRG( 1, 4) = 0.135168E-01
+ PKER_SACCRG( 1, 5) = 0.186190E-01
+ PKER_SACCRG( 1, 6) = 0.326141E-01
+ PKER_SACCRG( 1, 7) = 0.629897E-01
+ PKER_SACCRG( 1, 8) = 0.120410E+00
+ PKER_SACCRG( 1, 9) = 0.232733E+00
+ PKER_SACCRG( 1, 10) = 0.430353E+00
+ PKER_SACCRG( 1, 11) = 0.742288E+00
+ PKER_SACCRG( 1, 12) = 0.118527E+01
+ PKER_SACCRG( 1, 13) = 0.175377E+01
+ PKER_SACCRG( 1, 14) = 0.241509E+01
+ PKER_SACCRG( 1, 15) = 0.311676E+01
+ PKER_SACCRG( 1, 16) = 0.380271E+01
+ PKER_SACCRG( 1, 17) = 0.442968E+01
+ PKER_SACCRG( 1, 18) = 0.497509E+01
+ PKER_SACCRG( 1, 19) = 0.543503E+01
+ PKER_SACCRG( 1, 20) = 0.579503E+01
+ PKER_SACCRG( 1, 21) = 0.611243E+01
+ PKER_SACCRG( 1, 22) = 0.637529E+01
+ PKER_SACCRG( 1, 23) = 0.655579E+01
+ PKER_SACCRG( 1, 24) = 0.674119E+01
+ PKER_SACCRG( 1, 25) = 0.685610E+01
+ PKER_SACCRG( 1, 26) = 0.695045E+01
+ PKER_SACCRG( 1, 27) = 0.703114E+01
+ PKER_SACCRG( 1, 28) = 0.706922E+01
+ PKER_SACCRG( 1, 29) = 0.710917E+01
+ PKER_SACCRG( 1, 30) = 0.715122E+01
+ PKER_SACCRG( 1, 31) = 0.717481E+01
+ PKER_SACCRG( 1, 32) = 0.718927E+01
+ PKER_SACCRG( 1, 33) = 0.720073E+01
+ PKER_SACCRG( 1, 34) = 0.720264E+01
+ PKER_SACCRG( 1, 35) = 0.721205E+01
+ PKER_SACCRG( 1, 36) = 0.723197E+01
+ PKER_SACCRG( 1, 37) = 0.000000E+00
+ PKER_SACCRG( 1, 38) = 0.000000E+00
+ PKER_SACCRG( 1, 39) = 0.000000E+00
+ PKER_SACCRG( 1, 40) = 0.000000E+00
+ PKER_SACCRG( 2, 1) = 0.277360E-02
+ PKER_SACCRG( 2, 2) = 0.359904E-02
+ PKER_SACCRG( 2, 3) = 0.526623E-02
+ PKER_SACCRG( 2, 4) = 0.855403E-02
+ PKER_SACCRG( 2, 5) = 0.110798E-01
+ PKER_SACCRG( 2, 6) = 0.152575E-01
+ PKER_SACCRG( 2, 7) = 0.267157E-01
+ PKER_SACCRG( 2, 8) = 0.515725E-01
+ PKER_SACCRG( 2, 9) = 0.985371E-01
+ PKER_SACCRG( 2, 10) = 0.190336E+00
+ PKER_SACCRG( 2, 11) = 0.351702E+00
+ PKER_SACCRG( 2, 12) = 0.606144E+00
+ PKER_SACCRG( 2, 13) = 0.967078E+00
+ PKER_SACCRG( 2, 14) = 0.142977E+01
+ PKER_SACCRG( 2, 15) = 0.196754E+01
+ PKER_SACCRG( 2, 16) = 0.253781E+01
+ PKER_SACCRG( 2, 17) = 0.309551E+01
+ PKER_SACCRG( 2, 18) = 0.360619E+01
+ PKER_SACCRG( 2, 19) = 0.405195E+01
+ PKER_SACCRG( 2, 20) = 0.441025E+01
+ PKER_SACCRG( 2, 21) = 0.472710E+01
+ PKER_SACCRG( 2, 22) = 0.499143E+01
+ PKER_SACCRG( 2, 23) = 0.517586E+01
+ PKER_SACCRG( 2, 24) = 0.536386E+01
+ PKER_SACCRG( 2, 25) = 0.548206E+01
+ PKER_SACCRG( 2, 26) = 0.557912E+01
+ PKER_SACCRG( 2, 27) = 0.566202E+01
+ PKER_SACCRG( 2, 28) = 0.570152E+01
+ PKER_SACCRG( 2, 29) = 0.574264E+01
+ PKER_SACCRG( 2, 30) = 0.578573E+01
+ PKER_SACCRG( 2, 31) = 0.580997E+01
+ PKER_SACCRG( 2, 32) = 0.582483E+01
+ PKER_SACCRG( 2, 33) = 0.583658E+01
+ PKER_SACCRG( 2, 34) = 0.583857E+01
+ PKER_SACCRG( 2, 35) = 0.584821E+01
+ PKER_SACCRG( 2, 36) = 0.586858E+01
+ PKER_SACCRG( 2, 37) = 0.000000E+00
+ PKER_SACCRG( 2, 38) = 0.000000E+00
+ PKER_SACCRG( 2, 39) = 0.000000E+00
+ PKER_SACCRG( 2, 40) = 0.000000E+00
+ PKER_SACCRG( 3, 1) = 0.213410E-02
+ PKER_SACCRG( 3, 2) = 0.228042E-02
+ PKER_SACCRG( 3, 3) = 0.295439E-02
+ PKER_SACCRG( 3, 4) = 0.431810E-02
+ PKER_SACCRG( 3, 5) = 0.700935E-02
+ PKER_SACCRG( 3, 6) = 0.907613E-02
+ PKER_SACCRG( 3, 7) = 0.124938E-01
+ PKER_SACCRG( 3, 8) = 0.218668E-01
+ PKER_SACCRG( 3, 9) = 0.421887E-01
+ PKER_SACCRG( 3, 10) = 0.805544E-01
+ PKER_SACCRG( 3, 11) = 0.155474E+00
+ PKER_SACCRG( 3, 12) = 0.287036E+00
+ PKER_SACCRG( 3, 13) = 0.494206E+00
+ PKER_SACCRG( 3, 14) = 0.787675E+00
+ PKER_SACCRG( 3, 15) = 0.116334E+01
+ PKER_SACCRG( 3, 16) = 0.159943E+01
+ PKER_SACCRG( 3, 17) = 0.206153E+01
+ PKER_SACCRG( 3, 18) = 0.251365E+01
+ PKER_SACCRG( 3, 19) = 0.292842E+01
+ PKER_SACCRG( 3, 20) = 0.327509E+01
+ PKER_SACCRG( 3, 21) = 0.358546E+01
+ PKER_SACCRG( 3, 22) = 0.384740E+01
+ PKER_SACCRG( 3, 23) = 0.403374E+01
+ PKER_SACCRG( 3, 24) = 0.422232E+01
+ PKER_SACCRG( 3, 25) = 0.434292E+01
+ PKER_SACCRG( 3, 26) = 0.444208E+01
+ PKER_SACCRG( 3, 27) = 0.452673E+01
+ PKER_SACCRG( 3, 28) = 0.456755E+01
+ PKER_SACCRG( 3, 29) = 0.460968E+01
+ PKER_SACCRG( 3, 30) = 0.465368E+01
+ PKER_SACCRG( 3, 31) = 0.467850E+01
+ PKER_SACCRG( 3, 32) = 0.469374E+01
+ PKER_SACCRG( 3, 33) = 0.470577E+01
+ PKER_SACCRG( 3, 34) = 0.470785E+01
+ PKER_SACCRG( 3, 35) = 0.471769E+01
+ PKER_SACCRG( 3, 36) = 0.473846E+01
+ PKER_SACCRG( 3, 37) = 0.000000E+00
+ PKER_SACCRG( 3, 38) = 0.000000E+00
+ PKER_SACCRG( 3, 39) = 0.000000E+00
+ PKER_SACCRG( 3, 40) = 0.000000E+00
+ PKER_SACCRG( 4, 1) = 0.295930E-03
+ PKER_SACCRG( 4, 2) = 0.175883E-02
+ PKER_SACCRG( 4, 3) = 0.187537E-02
+ PKER_SACCRG( 4, 4) = 0.242497E-02
+ PKER_SACCRG( 4, 5) = 0.353954E-02
+ PKER_SACCRG( 4, 6) = 0.574121E-02
+ PKER_SACCRG( 4, 7) = 0.743054E-02
+ PKER_SACCRG( 4, 8) = 0.102239E-01
+ PKER_SACCRG( 4, 9) = 0.178843E-01
+ PKER_SACCRG( 4, 10) = 0.344817E-01
+ PKER_SACCRG( 4, 11) = 0.657827E-01
+ PKER_SACCRG( 4, 12) = 0.126844E+00
+ PKER_SACCRG( 4, 13) = 0.233919E+00
+ PKER_SACCRG( 4, 14) = 0.402255E+00
+ PKER_SACCRG( 4, 15) = 0.640286E+00
+ PKER_SACCRG( 4, 16) = 0.944426E+00
+ PKER_SACCRG( 4, 17) = 0.129689E+01
+ PKER_SACCRG( 4, 18) = 0.167004E+01
+ PKER_SACCRG( 4, 19) = 0.203514E+01
+ PKER_SACCRG( 4, 20) = 0.235706E+01
+ PKER_SACCRG( 4, 21) = 0.265244E+01
+ PKER_SACCRG( 4, 22) = 0.290663E+01
+ PKER_SACCRG( 4, 23) = 0.309194E+01
+ PKER_SACCRG( 4, 24) = 0.327835E+01
+ PKER_SACCRG( 4, 25) = 0.339993E+01
+ PKER_SACCRG( 4, 26) = 0.350021E+01
+ PKER_SACCRG( 4, 27) = 0.358586E+01
+ PKER_SACCRG( 4, 28) = 0.362775E+01
+ PKER_SACCRG( 4, 29) = 0.367067E+01
+ PKER_SACCRG( 4, 30) = 0.371533E+01
+ PKER_SACCRG( 4, 31) = 0.374064E+01
+ PKER_SACCRG( 4, 32) = 0.375621E+01
+ PKER_SACCRG( 4, 33) = 0.376848E+01
+ PKER_SACCRG( 4, 34) = 0.377064E+01
+ PKER_SACCRG( 4, 35) = 0.378066E+01
+ PKER_SACCRG( 4, 36) = 0.380174E+01
+ PKER_SACCRG( 4, 37) = 0.000000E+00
+ PKER_SACCRG( 4, 38) = 0.000000E+00
+ PKER_SACCRG( 4, 39) = 0.000000E+00
+ PKER_SACCRG( 4, 40) = 0.000000E+00
+ PKER_SACCRG( 5, 1) = 0.258805E-03
+ PKER_SACCRG( 5, 2) = 0.244750E-03
+ PKER_SACCRG( 5, 3) = 0.145106E-02
+ PKER_SACCRG( 5, 4) = 0.154319E-02
+ PKER_SACCRG( 5, 5) = 0.199078E-02
+ PKER_SACCRG( 5, 6) = 0.290099E-02
+ PKER_SACCRG( 5, 7) = 0.470103E-02
+ PKER_SACCRG( 5, 8) = 0.608063E-02
+ PKER_SACCRG( 5, 9) = 0.836193E-02
+ PKER_SACCRG( 5, 10) = 0.146173E-01
+ PKER_SACCRG( 5, 11) = 0.281586E-01
+ PKER_SACCRG( 5, 12) = 0.536650E-01
+ PKER_SACCRG( 5, 13) = 0.103352E+00
+ PKER_SACCRG( 5, 14) = 0.190326E+00
+ PKER_SACCRG( 5, 15) = 0.326791E+00
+ PKER_SACCRG( 5, 16) = 0.519290E+00
+ PKER_SACCRG( 5, 17) = 0.764650E+00
+ PKER_SACCRG( 5, 18) = 0.104842E+01
+ PKER_SACCRG( 5, 19) = 0.134831E+01
+ PKER_SACCRG( 5, 20) = 0.163103E+01
+ PKER_SACCRG( 5, 21) = 0.190095E+01
+ PKER_SACCRG( 5, 22) = 0.214036E+01
+ PKER_SACCRG( 5, 23) = 0.232046E+01
+ PKER_SACCRG( 5, 24) = 0.250112E+01
+ PKER_SACCRG( 5, 25) = 0.262167E+01
+ PKER_SACCRG( 5, 26) = 0.272160E+01
+ PKER_SACCRG( 5, 27) = 0.280712E+01
+ PKER_SACCRG( 5, 28) = 0.284966E+01
+ PKER_SACCRG( 5, 29) = 0.289298E+01
+ PKER_SACCRG( 5, 30) = 0.293794E+01
+ PKER_SACCRG( 5, 31) = 0.296358E+01
+ PKER_SACCRG( 5, 32) = 0.297938E+01
+ PKER_SACCRG( 5, 33) = 0.299183E+01
+ PKER_SACCRG( 5, 34) = 0.299407E+01
+ PKER_SACCRG( 5, 35) = 0.300421E+01
+ PKER_SACCRG( 5, 36) = 0.302549E+01
+ PKER_SACCRG( 5, 37) = 0.000000E+00
+ PKER_SACCRG( 5, 38) = 0.000000E+00
+ PKER_SACCRG( 5, 39) = 0.000000E+00
+ PKER_SACCRG( 5, 40) = 0.000000E+00
+ PKER_SACCRG( 6, 1) = 0.113399E-04
+ PKER_SACCRG( 6, 2) = 0.215064E-03
+ PKER_SACCRG( 6, 3) = 0.202732E-03
+ PKER_SACCRG( 6, 4) = 0.119915E-02
+ PKER_SACCRG( 6, 5) = 0.127127E-02
+ PKER_SACCRG( 6, 6) = 0.163527E-02
+ PKER_SACCRG( 6, 7) = 0.237805E-02
+ PKER_SACCRG( 6, 8) = 0.384847E-02
+ PKER_SACCRG( 6, 9) = 0.497431E-02
+ PKER_SACCRG( 6, 10) = 0.683637E-02
+ PKER_SACCRG( 6, 11) = 0.119405E-01
+ PKER_SACCRG( 6, 12) = 0.229776E-01
+ PKER_SACCRG( 6, 13) = 0.437340E-01
+ PKER_SACCRG( 6, 14) = 0.840961E-01
+ PKER_SACCRG( 6, 15) = 0.154590E+00
+ PKER_SACCRG( 6, 16) = 0.264896E+00
+ PKER_SACCRG( 6, 17) = 0.420012E+00
+ PKER_SACCRG( 6, 18) = 0.617142E+00
+ PKER_SACCRG( 6, 19) = 0.844302E+00
+ PKER_SACCRG( 6, 20) = 0.107600E+01
+ PKER_SACCRG( 6, 21) = 0.130965E+01
+ PKER_SACCRG( 6, 22) = 0.152596E+01
+ PKER_SACCRG( 6, 23) = 0.169541E+01
+ PKER_SACCRG( 6, 24) = 0.186600E+01
+ PKER_SACCRG( 6, 25) = 0.198276E+01
+ PKER_SACCRG( 6, 26) = 0.208029E+01
+ PKER_SACCRG( 6, 27) = 0.216408E+01
+ PKER_SACCRG( 6, 28) = 0.220656E+01
+ PKER_SACCRG( 6, 29) = 0.224971E+01
+ PKER_SACCRG( 6, 30) = 0.229446E+01
+ PKER_SACCRG( 6, 31) = 0.232020E+01
+ PKER_SACCRG( 6, 32) = 0.233613E+01
+ PKER_SACCRG( 6, 33) = 0.234866E+01
+ PKER_SACCRG( 6, 34) = 0.235098E+01
+ PKER_SACCRG( 6, 35) = 0.236115E+01
+ PKER_SACCRG( 6, 36) = 0.238249E+01
+ PKER_SACCRG( 6, 37) = 0.000000E+00
+ PKER_SACCRG( 6, 38) = 0.000000E+00
+ PKER_SACCRG( 6, 39) = 0.000000E+00
+ PKER_SACCRG( 6, 40) = 0.000000E+00
+ PKER_SACCRG( 7, 1) = 0.140987E-06
+ PKER_SACCRG( 7, 2) = 0.947184E-05
+ PKER_SACCRG( 7, 3) = 0.179369E-03
+ PKER_SACCRG( 7, 4) = 0.168563E-03
+ PKER_SACCRG( 7, 5) = 0.993006E-03
+ PKER_SACCRG( 7, 6) = 0.104915E-02
+ PKER_SACCRG( 7, 7) = 0.134474E-02
+ PKER_SACCRG( 7, 8) = 0.195051E-02
+ PKER_SACCRG( 7, 9) = 0.315182E-02
+ PKER_SACCRG( 7, 10) = 0.406997E-02
+ PKER_SACCRG( 7, 11) = 0.558802E-02
+ PKER_SACCRG( 7, 12) = 0.975020E-02
+ PKER_SACCRG( 7, 13) = 0.187363E-01
+ PKER_SACCRG( 7, 14) = 0.356024E-01
+ PKER_SACCRG( 7, 15) = 0.683270E-01
+ PKER_SACCRG( 7, 16) = 0.125305E+00
+ PKER_SACCRG( 7, 17) = 0.214147E+00
+ PKER_SACCRG( 7, 18) = 0.338617E+00
+ PKER_SACCRG( 7, 19) = 0.495951E+00
+ PKER_SACCRG( 7, 20) = 0.671057E+00
+ PKER_SACCRG( 7, 21) = 0.860119E+00
+ PKER_SACCRG( 7, 22) = 0.104532E+01
+ PKER_SACCRG( 7, 23) = 0.119790E+01
+ PKER_SACCRG( 7, 24) = 0.135335E+01
+ PKER_SACCRG( 7, 25) = 0.146305E+01
+ PKER_SACCRG( 7, 26) = 0.155556E+01
+ PKER_SACCRG( 7, 27) = 0.163553E+01
+ PKER_SACCRG( 7, 28) = 0.167695E+01
+ PKER_SACCRG( 7, 29) = 0.171904E+01
+ PKER_SACCRG( 7, 30) = 0.176289E+01
+ PKER_SACCRG( 7, 31) = 0.178841E+01
+ PKER_SACCRG( 7, 32) = 0.180429E+01
+ PKER_SACCRG( 7, 33) = 0.181678E+01
+ PKER_SACCRG( 7, 34) = 0.181916E+01
+ PKER_SACCRG( 7, 35) = 0.182927E+01
+ PKER_SACCRG( 7, 36) = 0.185045E+01
+ PKER_SACCRG( 7, 37) = 0.000000E+00
+ PKER_SACCRG( 7, 38) = 0.000000E+00
+ PKER_SACCRG( 7, 39) = 0.000000E+00
+ PKER_SACCRG( 7, 40) = 0.000000E+00
+ PKER_SACCRG( 8, 1) = 0.000000E+00
+ PKER_SACCRG( 8, 2) = 0.120931E-06
+ PKER_SACCRG( 8, 3) = 0.796677E-05
+ PKER_SACCRG( 8, 4) = 0.150232E-03
+ PKER_SACCRG( 8, 5) = 0.140781E-03
+ PKER_SACCRG( 8, 6) = 0.825725E-03
+ PKER_SACCRG( 8, 7) = 0.867958E-03
+ PKER_SACCRG( 8, 8) = 0.110764E-02
+ PKER_SACCRG( 8, 9) = 0.160165E-02
+ PKER_SACCRG( 8, 10) = 0.258288E-02
+ PKER_SACCRG( 8, 11) = 0.333132E-02
+ PKER_SACCRG( 8, 12) = 0.456846E-02
+ PKER_SACCRG( 8, 13) = 0.795989E-02
+ PKER_SACCRG( 8, 14) = 0.152680E-01
+ PKER_SACCRG( 8, 15) = 0.289527E-01
+ PKER_SACCRG( 8, 16) = 0.554343E-01
+ PKER_SACCRG( 8, 17) = 0.101328E+00
+ PKER_SACCRG( 8, 18) = 0.172576E+00
+ PKER_SACCRG( 8, 19) = 0.271870E+00
+ PKER_SACCRG( 8, 20) = 0.392855E+00
+ PKER_SACCRG( 8, 21) = 0.534703E+00
+ PKER_SACCRG( 8, 22) = 0.683665E+00
+ PKER_SACCRG( 8, 23) = 0.814385E+00
+ PKER_SACCRG( 8, 24) = 0.950462E+00
+ PKER_SACCRG( 8, 25) = 0.105116E+01
+ PKER_SACCRG( 8, 26) = 0.113664E+01
+ PKER_SACCRG( 8, 27) = 0.121103E+01
+ PKER_SACCRG( 8, 28) = 0.125059E+01
+ PKER_SACCRG( 8, 29) = 0.128945E+01
+ PKER_SACCRG( 8, 30) = 0.132965E+01
+ PKER_SACCRG( 8, 31) = 0.135316E+01
+ PKER_SACCRG( 8, 32) = 0.136781E+01
+ PKER_SACCRG( 8, 33) = 0.137937E+01
+ PKER_SACCRG( 8, 34) = 0.138153E+01
+ PKER_SACCRG( 8, 35) = 0.139094E+01
+ PKER_SACCRG( 8, 36) = 0.141107E+01
+ PKER_SACCRG( 8, 37) = 0.000000E+00
+ PKER_SACCRG( 8, 38) = 0.000000E+00
+ PKER_SACCRG( 8, 39) = 0.000000E+00
+ PKER_SACCRG( 8, 40) = 0.000000E+00
+ PKER_SACCRG( 9, 1) = 0.000000E+00
+ PKER_SACCRG( 9, 2) = 0.000000E+00
+ PKER_SACCRG( 9, 3) = 0.104997E-06
+ PKER_SACCRG( 9, 4) = 0.675258E-05
+ PKER_SACCRG( 9, 5) = 0.126824E-03
+ PKER_SACCRG( 9, 6) = 0.118316E-03
+ PKER_SACCRG( 9, 7) = 0.690238E-03
+ PKER_SACCRG( 9, 8) = 0.721206E-03
+ PKER_SACCRG( 9, 9) = 0.915100E-03
+ PKER_SACCRG( 9, 10) = 0.131754E-02
+ PKER_SACCRG( 9, 11) = 0.143784E-02
+ PKER_SACCRG( 9, 12) = 0.272855E-02
+ PKER_SACCRG( 9, 13) = 0.373587E-02
+ PKER_SACCRG( 9, 14) = 0.649562E-02
+ PKER_SACCRG( 9, 15) = 0.120098E-01
+ PKER_SACCRG( 9, 16) = 0.235379E-01
+ PKER_SACCRG( 9, 17) = 0.448605E-01
+ PKER_SACCRG( 9, 18) = 0.816757E-01
+ PKER_SACCRG( 9, 19) = 0.138586E+00
+ PKER_SACCRG( 9, 20) = 0.214609E+00
+ PKER_SACCRG( 9, 21) = 0.312274E+00
+ PKER_SACCRG( 9, 22) = 0.423436E+00
+ PKER_SACCRG( 9, 23) = 0.528300E+00
+ PKER_SACCRG( 9, 24) = 0.641806E+00
+ PKER_SACCRG( 9, 25) = 0.730809E+00
+ PKER_SACCRG( 9, 26) = 0.808021E+00
+ PKER_SACCRG( 9, 27) = 0.875899E+00
+ PKER_SACCRG( 9, 28) = 0.913416E+00
+ PKER_SACCRG( 9, 29) = 0.949497E+00
+ PKER_SACCRG( 9, 30) = 0.986085E+00
+ PKER_SACCRG( 9, 31) = 0.100768E+01
+ PKER_SACCRG( 9, 32) = 0.102123E+01
+ PKER_SACCRG( 9, 33) = 0.103190E+01
+ PKER_SACCRG( 9, 34) = 0.103403E+01
+ PKER_SACCRG( 9, 35) = 0.104270E+01
+ PKER_SACCRG( 9, 36) = 0.106096E+01
+ PKER_SACCRG( 9, 37) = 0.000000E+00
+ PKER_SACCRG( 9, 38) = 0.000000E+00
+ PKER_SACCRG( 9, 39) = 0.000000E+00
+ PKER_SACCRG( 9, 40) = 0.000000E+00
+ PKER_SACCRG( 10, 1) = 0.000000E+00
+ PKER_SACCRG( 10, 2) = 0.000000E+00
+ PKER_SACCRG( 10, 3) = 0.000000E+00
+ PKER_SACCRG( 10, 4) = 0.925928E-07
+ PKER_SACCRG( 10, 5) = 0.578353E-05
+ PKER_SACCRG( 10, 6) = 0.108100E-03
+ PKER_SACCRG( 10, 7) = 0.100301E-03
+ PKER_SACCRG( 10, 8) = 0.581236E-03
+ PKER_SACCRG( 10, 9) = 0.602709E-03
+ PKER_SACCRG( 10, 10) = 0.759037E-03
+ PKER_SACCRG( 10, 11) = 0.108651E-02
+ PKER_SACCRG( 10, 12) = 0.118139E-02
+ PKER_SACCRG( 10, 13) = 0.223637E-02
+ PKER_SACCRG( 10, 14) = 0.305413E-02
+ PKER_SACCRG( 10, 15) = 0.529953E-02
+ PKER_SACCRG( 10, 16) = 0.980986E-02
+ PKER_SACCRG( 10, 17) = 0.190727E-01
+ PKER_SACCRG( 10, 18) = 0.361040E-01
+ PKER_SACCRG( 10, 19) = 0.657489E-01
+ PKER_SACCRG( 10, 20) = 0.108973E+00
+ PKER_SACCRG( 10, 21) = 0.170419E+00
+ PKER_SACCRG( 10, 22) = 0.246769E+00
+ PKER_SACCRG( 10, 23) = 0.324574E+00
+ PKER_SACCRG( 10, 24) = 0.413749E+00
+ PKER_SACCRG( 10, 25) = 0.487749E+00
+ PKER_SACCRG( 10, 26) = 0.555040E+00
+ PKER_SACCRG( 10, 27) = 0.614174E+00
+ PKER_SACCRG( 10, 28) = 0.647730E+00
+ PKER_SACCRG( 10, 29) = 0.679592E+00
+ PKER_SACCRG( 10, 30) = 0.711627E+00
+ PKER_SACCRG( 10, 31) = 0.730757E+00
+ PKER_SACCRG( 10, 32) = 0.742853E+00
+ PKER_SACCRG( 10, 33) = 0.752426E+00
+ PKER_SACCRG( 10, 34) = 0.754388E+00
+ PKER_SACCRG( 10, 35) = 0.762180E+00
+ PKER_SACCRG( 10, 36) = 0.778605E+00
+ PKER_SACCRG( 10, 37) = 0.000000E+00
+ PKER_SACCRG( 10, 38) = 0.000000E+00
+ PKER_SACCRG( 10, 39) = 0.000000E+00
+ PKER_SACCRG( 10, 40) = 0.000000E+00
+ PKER_SACCRG( 11, 1) = 0.000000E+00
+ PKER_SACCRG( 11, 2) = 0.000000E+00
+ PKER_SACCRG( 11, 3) = 0.000000E+00
+ PKER_SACCRG( 11, 4) = 0.000000E+00
+ PKER_SACCRG( 11, 5) = 0.832906E-07
+ PKER_SACCRG( 11, 6) = 0.502409E-05
+ PKER_SACCRG( 11, 7) = 0.933604E-04
+ PKER_SACCRG( 11, 8) = 0.860483E-04
+ PKER_SACCRG( 11, 9) = 0.494464E-03
+ PKER_SACCRG( 11, 10) = 0.507648E-03
+ PKER_SACCRG( 11, 11) = 0.632846E-03
+ PKER_SACCRG( 11, 12) = 0.898351E-03
+ PKER_SACCRG( 11, 13) = 0.971535E-03
+ PKER_SACCRG( 11, 14) = 0.183107E-02
+ PKER_SACCRG( 11, 15) = 0.249471E-02
+ PKER_SACCRG( 11, 16) = 0.439233E-02
+ PKER_SACCRG( 11, 17) = 0.797693E-02
+ PKER_SACCRG( 11, 18) = 0.152441E-01
+ PKER_SACCRG( 11, 19) = 0.293789E-01
+ PKER_SACCRG( 11, 20) = 0.515725E-01
+ PKER_SACCRG( 11, 21) = 0.871846E-01
+ PKER_SACCRG( 11, 22) = 0.135867E+00
+ PKER_SACCRG( 11, 23) = 0.189869E+00
+ PKER_SACCRG( 11, 24) = 0.256544E+00
+ PKER_SACCRG( 11, 25) = 0.317064E+00
+ PKER_SACCRG( 11, 26) = 0.373502E+00
+ PKER_SACCRG( 11, 27) = 0.424161E+00
+ PKER_SACCRG( 11, 28) = 0.454262E+00
+ PKER_SACCRG( 11, 29) = 0.480107E+00
+ PKER_SACCRG( 11, 30) = 0.504244E+00
+ PKER_SACCRG( 11, 31) = 0.518345E+00
+ PKER_SACCRG( 11, 32) = 0.527147E+00
+ PKER_SACCRG( 11, 33) = 0.534136E+00
+ PKER_SACCRG( 11, 34) = 0.535557E+00
+ PKER_SACCRG( 11, 35) = 0.541319E+00
+ PKER_SACCRG( 11, 36) = 0.553653E+00
+ PKER_SACCRG( 11, 37) = 0.000000E+00
+ PKER_SACCRG( 11, 38) = 0.000000E+00
+ PKER_SACCRG( 11, 39) = 0.000000E+00
+ PKER_SACCRG( 11, 40) = 0.000000E+00
+ PKER_SACCRG( 12, 1) = 0.000000E+00
+ PKER_SACCRG( 12, 2) = 0.000000E+00
+ PKER_SACCRG( 12, 3) = 0.000000E+00
+ PKER_SACCRG( 12, 4) = 0.000000E+00
+ PKER_SACCRG( 12, 5) = 0.000000E+00
+ PKER_SACCRG( 12, 6) = 0.773960E-07
+ PKER_SACCRG( 12, 7) = 0.444316E-05
+ PKER_SACCRG( 12, 8) = 0.820904E-04
+ PKER_SACCRG( 12, 9) = 0.749946E-04
+ PKER_SACCRG( 12, 10) = 0.426372E-03
+ PKER_SACCRG( 12, 11) = 0.431983E-03
+ PKER_SACCRG( 12, 12) = 0.530818E-03
+ PKER_SACCRG( 12, 13) = 0.743872E-03
+ PKER_SACCRG( 12, 14) = 0.796002E-03
+ PKER_SACCRG( 12, 15) = 0.116910E-02
+ PKER_SACCRG( 12, 16) = 0.216714E-02
+ PKER_SACCRG( 12, 17) = 0.358946E-02
+ PKER_SACCRG( 12, 18) = 0.644847E-02
+ PKER_SACCRG( 12, 19) = 0.128412E-01
+ PKER_SACCRG( 12, 20) = 0.229402E-01
+ PKER_SACCRG( 12, 21) = 0.422368E-01
+ PKER_SACCRG( 12, 22) = 0.714492E-01
+ PKER_SACCRG( 12, 23) = 0.106564E+00
+ PKER_SACCRG( 12, 24) = 0.153890E+00
+ PKER_SACCRG( 12, 25) = 0.202266E+00
+ PKER_SACCRG( 12, 26) = 0.249410E+00
+ PKER_SACCRG( 12, 27) = 0.293259E+00
+ PKER_SACCRG( 12, 28) = 0.320617E+00
+ PKER_SACCRG( 12, 29) = 0.341855E+00
+ PKER_SACCRG( 12, 30) = 0.359983E+00
+ PKER_SACCRG( 12, 31) = 0.370284E+00
+ PKER_SACCRG( 12, 32) = 0.376667E+00
+ PKER_SACCRG( 12, 33) = 0.381816E+00
+ PKER_SACCRG( 12, 34) = 0.382869E+00
+ PKER_SACCRG( 12, 35) = 0.387206E+00
+ PKER_SACCRG( 12, 36) = 0.396588E+00
+ PKER_SACCRG( 12, 37) = 0.000000E+00
+ PKER_SACCRG( 12, 38) = 0.000000E+00
+ PKER_SACCRG( 12, 39) = 0.000000E+00
+ PKER_SACCRG( 12, 40) = 0.000000E+00
+ PKER_SACCRG( 13, 1) = 0.000000E+00
+ PKER_SACCRG( 13, 2) = 0.000000E+00
+ PKER_SACCRG( 13, 3) = 0.000000E+00
+ PKER_SACCRG( 13, 4) = 0.000000E+00
+ PKER_SACCRG( 13, 5) = 0.000000E+00
+ PKER_SACCRG( 13, 6) = 0.000000E+00
+ PKER_SACCRG( 13, 7) = 0.735833E-07
+ PKER_SACCRG( 13, 8) = 0.403716E-05
+ PKER_SACCRG( 13, 9) = 0.739090E-04
+ PKER_SACCRG( 13, 10) = 0.668732E-04
+ PKER_SACCRG( 13, 11) = 0.374752E-03
+ PKER_SACCRG( 13, 12) = 0.372451E-03
+ PKER_SACCRG( 13, 13) = 0.447074E-03
+ PKER_SACCRG( 13, 14) = 0.610717E-03
+ PKER_SACCRG( 13, 15) = 0.641614E-03
+ PKER_SACCRG( 13, 16) = 0.119058E-02
+ PKER_SACCRG( 13, 17) = 0.179867E-02
+ PKER_SACCRG( 13, 18) = 0.291204E-02
+ PKER_SACCRG( 13, 19) = 0.606676E-02
+ PKER_SACCRG( 13, 20) = 0.100429E-01
+ PKER_SACCRG( 13, 21) = 0.203541E-01
+ PKER_SACCRG( 13, 22) = 0.377872E-01
+ PKER_SACCRG( 13, 23) = 0.606389E-01
+ PKER_SACCRG( 13, 24) = 0.937549E-01
+ PKER_SACCRG( 13, 25) = 0.133605E+00
+ PKER_SACCRG( 13, 26) = 0.174990E+00
+ PKER_SACCRG( 13, 27) = 0.214629E+00
+ PKER_SACCRG( 13, 28) = 0.241011E+00
+ PKER_SACCRG( 13, 29) = 0.258073E+00
+ PKER_SACCRG( 13, 30) = 0.269310E+00
+ PKER_SACCRG( 13, 31) = 0.274592E+00
+ PKER_SACCRG( 13, 32) = 0.277413E+00
+ PKER_SACCRG( 13, 33) = 0.279664E+00
+ PKER_SACCRG( 13, 34) = 0.280055E+00
+ PKER_SACCRG( 13, 35) = 0.282059E+00
+ PKER_SACCRG( 13, 36) = 0.286665E+00
+ PKER_SACCRG( 13, 37) = 0.000000E+00
+ PKER_SACCRG( 13, 38) = 0.000000E+00
+ PKER_SACCRG( 13, 39) = 0.000000E+00
+ PKER_SACCRG( 13, 40) = 0.000000E+00
+ PKER_SACCRG( 14, 1) = 0.000000E+00
+ PKER_SACCRG( 14, 2) = 0.000000E+00
+ PKER_SACCRG( 14, 3) = 0.000000E+00
+ PKER_SACCRG( 14, 4) = 0.000000E+00
+ PKER_SACCRG( 14, 5) = 0.000000E+00
+ PKER_SACCRG( 14, 6) = 0.000000E+00
+ PKER_SACCRG( 14, 7) = 0.000000E+00
+ PKER_SACCRG( 14, 8) = 0.728176E-07
+ PKER_SACCRG( 14, 9) = 0.379948E-05
+ PKER_SACCRG( 14, 10) = 0.688582E-04
+ PKER_SACCRG( 14, 11) = 0.614350E-04
+ PKER_SACCRG( 14, 12) = 0.337324E-03
+ PKER_SACCRG( 14, 13) = 0.324899E-03
+ PKER_SACCRG( 14, 14) = 0.371520E-03
+ PKER_SACCRG( 14, 15) = 0.478804E-03
+ PKER_SACCRG( 14, 16) = 0.101697E-02
+ PKER_SACCRG( 14, 17) = 0.102728E-02
+ PKER_SACCRG( 14, 18) = 0.147349E-02
+ PKER_SACCRG( 14, 19) = 0.368922E-02
+ PKER_SACCRG( 14, 20) = 0.484994E-02
+ PKER_SACCRG( 14, 21) = 0.109319E-01
+ PKER_SACCRG( 14, 22) = 0.222066E-01
+ PKER_SACCRG( 14, 23) = 0.380174E-01
+ PKER_SACCRG( 14, 24) = 0.622359E-01
+ PKER_SACCRG( 14, 25) = 0.978747E-01
+ PKER_SACCRG( 14, 26) = 0.135839E+00
+ PKER_SACCRG( 14, 27) = 0.174342E+00
+ PKER_SACCRG( 14, 28) = 0.201882E+00
+ PKER_SACCRG( 14, 29) = 0.216326E+00
+ PKER_SACCRG( 14, 30) = 0.222044E+00
+ PKER_SACCRG( 14, 31) = 0.222867E+00
+ PKER_SACCRG( 14, 32) = 0.222379E+00
+ PKER_SACCRG( 14, 33) = 0.221925E+00
+ PKER_SACCRG( 14, 34) = 0.221667E+00
+ PKER_SACCRG( 14, 35) = 0.221502E+00
+ PKER_SACCRG( 14, 36) = 0.221629E+00
+ PKER_SACCRG( 14, 37) = 0.000000E+00
+ PKER_SACCRG( 14, 38) = 0.000000E+00
+ PKER_SACCRG( 14, 39) = 0.000000E+00
+ PKER_SACCRG( 14, 40) = 0.000000E+00
+ PKER_SACCRG( 15, 1) = 0.000000E+00
+ PKER_SACCRG( 15, 2) = 0.000000E+00
+ PKER_SACCRG( 15, 3) = 0.000000E+00
+ PKER_SACCRG( 15, 4) = 0.000000E+00
+ PKER_SACCRG( 15, 5) = 0.000000E+00
+ PKER_SACCRG( 15, 6) = 0.000000E+00
+ PKER_SACCRG( 15, 7) = 0.000000E+00
+ PKER_SACCRG( 15, 8) = 0.000000E+00
+ PKER_SACCRG( 15, 9) = 0.759585E-07
+ PKER_SACCRG( 15, 10) = 0.374710E-05
+ PKER_SACCRG( 15, 11) = 0.671091E-04
+ PKER_SACCRG( 15, 12) = 0.588014E-04
+ PKER_SACCRG( 15, 13) = 0.311989E-03
+ PKER_SACCRG( 15, 14) = 0.280346E-03
+ PKER_SACCRG( 15, 15) = 0.278888E-03
+ PKER_SACCRG( 15, 16) = 0.181122E-02
+ PKER_SACCRG( 15, 17) = 0.951550E-03
+ PKER_SACCRG( 15, 18) = 0.874685E-03
+ PKER_SACCRG( 15, 19) = 0.341647E-02
+ PKER_SACCRG( 15, 20) = 0.313074E-02
+ PKER_SACCRG( 15, 21) = 0.790628E-02
+ PKER_SACCRG( 15, 22) = 0.167408E-01
+ PKER_SACCRG( 15, 23) = 0.292368E-01
+ PKER_SACCRG( 15, 24) = 0.493019E-01
+ PKER_SACCRG( 15, 25) = 0.846089E-01
+ PKER_SACCRG( 15, 26) = 0.122848E+00
+ PKER_SACCRG( 15, 27) = 0.164348E+00
+ PKER_SACCRG( 15, 28) = 0.195653E+00
+ PKER_SACCRG( 15, 29) = 0.209699E+00
+ PKER_SACCRG( 15, 30) = 0.212297E+00
+ PKER_SACCRG( 15, 31) = 0.209959E+00
+ PKER_SACCRG( 15, 32) = 0.206919E+00
+ PKER_SACCRG( 15, 33) = 0.204381E+00
+ PKER_SACCRG( 15, 34) = 0.203587E+00
+ PKER_SACCRG( 15, 35) = 0.201798E+00
+ PKER_SACCRG( 15, 36) = 0.198561E+00
+ PKER_SACCRG( 15, 37) = 0.000000E+00
+ PKER_SACCRG( 15, 38) = 0.000000E+00
+ PKER_SACCRG( 15, 39) = 0.000000E+00
+ PKER_SACCRG( 15, 40) = 0.000000E+00
+ PKER_SACCRG( 16, 1) = 0.000000E+00
+ PKER_SACCRG( 16, 2) = 0.000000E+00
+ PKER_SACCRG( 16, 3) = 0.000000E+00
+ PKER_SACCRG( 16, 4) = 0.000000E+00
+ PKER_SACCRG( 16, 5) = 0.000000E+00
+ PKER_SACCRG( 16, 6) = 0.000000E+00
+ PKER_SACCRG( 16, 7) = 0.000000E+00
+ PKER_SACCRG( 16, 8) = 0.000000E+00
+ PKER_SACCRG( 16, 9) = 0.000000E+00
+ PKER_SACCRG( 16, 10) = 0.844481E-07
+ PKER_SACCRG( 16, 11) = 0.394811E-05
+ PKER_SACCRG( 16, 12) = 0.696323E-04
+ PKER_SACCRG( 16, 13) = 0.591332E-04
+ PKER_SACCRG( 16, 14) = 0.289674E-03
+ PKER_SACCRG( 16, 15) = 0.202537E-03
+ PKER_SACCRG( 16, 16) = 0.336844E-02
+ PKER_SACCRG( 16, 17) = 0.178312E-02
+ PKER_SACCRG( 16, 18) = 0.868492E-03
+ PKER_SACCRG( 16, 19) = 0.435445E-02
+ PKER_SACCRG( 16, 20) = 0.306476E-02
+ PKER_SACCRG( 16, 21) = 0.776119E-02
+ PKER_SACCRG( 16, 22) = 0.161954E-01
+ PKER_SACCRG( 16, 23) = 0.276331E-01
+ PKER_SACCRG( 16, 24) = 0.458394E-01
+ PKER_SACCRG( 16, 25) = 0.831396E-01
+ PKER_SACCRG( 16, 26) = 0.123760E+00
+ PKER_SACCRG( 16, 27) = 0.170508E+00
+ PKER_SACCRG( 16, 28) = 0.207373E+00
+ PKER_SACCRG( 16, 29) = 0.222851E+00
+ PKER_SACCRG( 16, 30) = 0.224550E+00
+ PKER_SACCRG( 16, 31) = 0.220359E+00
+ PKER_SACCRG( 16, 32) = 0.215498E+00
+ PKER_SACCRG( 16, 33) = 0.211386E+00
+ PKER_SACCRG( 16, 34) = 0.210132E+00
+ PKER_SACCRG( 16, 35) = 0.207094E+00
+ PKER_SACCRG( 16, 36) = 0.201428E+00
+ PKER_SACCRG( 16, 37) = 0.000000E+00
+ PKER_SACCRG( 16, 38) = 0.000000E+00
+ PKER_SACCRG( 16, 39) = 0.000000E+00
+ PKER_SACCRG( 16, 40) = 0.000000E+00
+ PKER_SACCRG( 17, 1) = 0.000000E+00
+ PKER_SACCRG( 17, 2) = 0.000000E+00
+ PKER_SACCRG( 17, 3) = 0.000000E+00
+ PKER_SACCRG( 17, 4) = 0.000000E+00
+ PKER_SACCRG( 17, 5) = 0.000000E+00
+ PKER_SACCRG( 17, 6) = 0.000000E+00
+ PKER_SACCRG( 17, 7) = 0.000000E+00
+ PKER_SACCRG( 17, 8) = 0.000000E+00
+ PKER_SACCRG( 17, 9) = 0.000000E+00
+ PKER_SACCRG( 17, 10) = 0.000000E+00
+ PKER_SACCRG( 17, 11) = 0.102418E-06
+ PKER_SACCRG( 17, 12) = 0.455940E-05
+ PKER_SACCRG( 17, 13) = 0.784312E-04
+ PKER_SACCRG( 17, 14) = 0.614879E-04
+ PKER_SACCRG( 17, 15) = 0.207160E-03
+ PKER_SACCRG( 17, 16) = 0.889438E-02
+ PKER_SACCRG( 17, 17) = 0.339624E-02
+ PKER_SACCRG( 17, 18) = 0.106437E-02
+ PKER_SACCRG( 17, 19) = 0.779689E-02
+ PKER_SACCRG( 17, 20) = 0.404959E-02
+ PKER_SACCRG( 17, 21) = 0.101250E-01
+ PKER_SACCRG( 17, 22) = 0.196042E-01
+ PKER_SACCRG( 17, 23) = 0.307730E-01
+ PKER_SACCRG( 17, 24) = 0.480533E-01
+ PKER_SACCRG( 17, 25) = 0.885797E-01
+ PKER_SACCRG( 17, 26) = 0.132905E+00
+ PKER_SACCRG( 17, 27) = 0.187039E+00
+ PKER_SACCRG( 17, 28) = 0.231099E+00
+ PKER_SACCRG( 17, 29) = 0.249500E+00
+ PKER_SACCRG( 17, 30) = 0.252291E+00
+ PKER_SACCRG( 17, 31) = 0.247487E+00
+ PKER_SACCRG( 17, 32) = 0.241587E+00
+ PKER_SACCRG( 17, 33) = 0.236485E+00
+ PKER_SACCRG( 17, 34) = 0.234962E+00
+ PKER_SACCRG( 17, 35) = 0.231075E+00
+ PKER_SACCRG( 17, 36) = 0.223581E+00
+ PKER_SACCRG( 17, 37) = 0.000000E+00
+ PKER_SACCRG( 17, 38) = 0.000000E+00
+ PKER_SACCRG( 17, 39) = 0.000000E+00
+ PKER_SACCRG( 17, 40) = 0.000000E+00
+ PKER_SACCRG( 18, 1) = 0.000000E+00
+ PKER_SACCRG( 18, 2) = 0.000000E+00
+ PKER_SACCRG( 18, 3) = 0.000000E+00
+ PKER_SACCRG( 18, 4) = 0.000000E+00
+ PKER_SACCRG( 18, 5) = 0.000000E+00
+ PKER_SACCRG( 18, 6) = 0.000000E+00
+ PKER_SACCRG( 18, 7) = 0.000000E+00
+ PKER_SACCRG( 18, 8) = 0.000000E+00
+ PKER_SACCRG( 18, 9) = 0.000000E+00
+ PKER_SACCRG( 18, 10) = 0.000000E+00
+ PKER_SACCRG( 18, 11) = 0.000000E+00
+ PKER_SACCRG( 18, 12) = 0.140103E-06
+ PKER_SACCRG( 18, 13) = 0.596643E-05
+ PKER_SACCRG( 18, 14) = 0.955662E-04
+ PKER_SACCRG( 18, 15) = 0.467666E-04
+ PKER_SACCRG( 18, 16) = 0.950209E-02
+ PKER_SACCRG( 18, 17) = 0.886291E-02
+ PKER_SACCRG( 18, 18) = 0.338287E-02
+ PKER_SACCRG( 18, 19) = 0.122056E-01
+ PKER_SACCRG( 18, 20) = 0.719648E-02
+ PKER_SACCRG( 18, 21) = 0.173349E-01
+ PKER_SACCRG( 18, 22) = 0.268718E-01
+ PKER_SACCRG( 18, 23) = 0.384549E-01
+ PKER_SACCRG( 18, 24) = 0.531665E-01
+ PKER_SACCRG( 18, 25) = 0.967650E-01
+ PKER_SACCRG( 18, 26) = 0.143690E+00
+ PKER_SACCRG( 18, 27) = 0.205036E+00
+ PKER_SACCRG( 18, 28) = 0.256245E+00
+ PKER_SACCRG( 18, 29) = 0.278068E+00
+ PKER_SACCRG( 18, 30) = 0.283239E+00
+ PKER_SACCRG( 18, 31) = 0.278809E+00
+ PKER_SACCRG( 18, 32) = 0.272567E+00
+ PKER_SACCRG( 18, 33) = 0.267046E+00
+ PKER_SACCRG( 18, 34) = 0.265383E+00
+ PKER_SACCRG( 18, 35) = 0.261124E+00
+ PKER_SACCRG( 18, 36) = 0.252857E+00
+ PKER_SACCRG( 18, 37) = 0.000000E+00
+ PKER_SACCRG( 18, 38) = 0.000000E+00
+ PKER_SACCRG( 18, 39) = 0.000000E+00
+ PKER_SACCRG( 18, 40) = 0.000000E+00
+ PKER_SACCRG( 19, 1) = 0.000000E+00
+ PKER_SACCRG( 19, 2) = 0.000000E+00
+ PKER_SACCRG( 19, 3) = 0.000000E+00
+ PKER_SACCRG( 19, 4) = 0.000000E+00
+ PKER_SACCRG( 19, 5) = 0.000000E+00
+ PKER_SACCRG( 19, 6) = 0.000000E+00
+ PKER_SACCRG( 19, 7) = 0.000000E+00
+ PKER_SACCRG( 19, 8) = 0.000000E+00
+ PKER_SACCRG( 19, 9) = 0.000000E+00
+ PKER_SACCRG( 19, 10) = 0.000000E+00
+ PKER_SACCRG( 19, 11) = 0.000000E+00
+ PKER_SACCRG( 19, 12) = 0.000000E+00
+ PKER_SACCRG( 19, 13) = 0.227778E-06
+ PKER_SACCRG( 19, 14) = 0.900623E-05
+ PKER_SACCRG( 19, 15) = 0.841460E-04
+ PKER_SACCRG( 19, 16) = 0.386383E-01
+ PKER_SACCRG( 19, 17) = 0.931861E-02
+ PKER_SACCRG( 19, 18) = 0.873078E-02
+ PKER_SACCRG( 19, 19) = 0.212263E-01
+ PKER_SACCRG( 19, 20) = 0.110801E-01
+ PKER_SACCRG( 19, 21) = 0.233312E-01
+ PKER_SACCRG( 19, 22) = 0.377998E-01
+ PKER_SACCRG( 19, 23) = 0.473076E-01
+ PKER_SACCRG( 19, 24) = 0.634436E-01
+ PKER_SACCRG( 19, 25) = 0.108864E+00
+ PKER_SACCRG( 19, 26) = 0.154870E+00
+ PKER_SACCRG( 19, 27) = 0.221137E+00
+ PKER_SACCRG( 19, 28) = 0.278289E+00
+ PKER_SACCRG( 19, 29) = 0.303277E+00
+ PKER_SACCRG( 19, 30) = 0.311313E+00
+ PKER_SACCRG( 19, 31) = 0.307763E+00
+ PKER_SACCRG( 19, 32) = 0.301613E+00
+ PKER_SACCRG( 19, 33) = 0.296055E+00
+ PKER_SACCRG( 19, 34) = 0.294365E+00
+ PKER_SACCRG( 19, 35) = 0.290056E+00
+ PKER_SACCRG( 19, 36) = 0.281642E+00
+ PKER_SACCRG( 19, 37) = 0.000000E+00
+ PKER_SACCRG( 19, 38) = 0.000000E+00
+ PKER_SACCRG( 19, 39) = 0.000000E+00
+ PKER_SACCRG( 19, 40) = 0.000000E+00
+ PKER_SACCRG( 20, 1) = 0.000000E+00
+ PKER_SACCRG( 20, 2) = 0.000000E+00
+ PKER_SACCRG( 20, 3) = 0.000000E+00
+ PKER_SACCRG( 20, 4) = 0.000000E+00
+ PKER_SACCRG( 20, 5) = 0.000000E+00
+ PKER_SACCRG( 20, 6) = 0.000000E+00
+ PKER_SACCRG( 20, 7) = 0.000000E+00
+ PKER_SACCRG( 20, 8) = 0.000000E+00
+ PKER_SACCRG( 20, 9) = 0.000000E+00
+ PKER_SACCRG( 20, 10) = 0.000000E+00
+ PKER_SACCRG( 20, 11) = 0.000000E+00
+ PKER_SACCRG( 20, 12) = 0.000000E+00
+ PKER_SACCRG( 20, 13) = 0.129560E-08
+ PKER_SACCRG( 20, 14) = 0.461750E-06
+ PKER_SACCRG( 20, 15) = 0.991868E-05
+ PKER_SACCRG( 20, 16) = 0.404619E-01
+ PKER_SACCRG( 20, 17) = 0.376740E-01
+ PKER_SACCRG( 20, 18) = 0.912299E-02
+ PKER_SACCRG( 20, 19) = 0.431984E-01
+ PKER_SACCRG( 20, 20) = 0.191703E-01
+ PKER_SACCRG( 20, 21) = 0.492406E-01
+ PKER_SACCRG( 20, 22) = 0.618254E-01
+ PKER_SACCRG( 20, 23) = 0.738280E-01
+ PKER_SACCRG( 20, 24) = 0.817314E-01
+ PKER_SACCRG( 20, 25) = 0.125224E+00
+ PKER_SACCRG( 20, 26) = 0.171144E+00
+ PKER_SACCRG( 20, 27) = 0.237848E+00
+ PKER_SACCRG( 20, 28) = 0.298348E+00
+ PKER_SACCRG( 20, 29) = 0.325776E+00
+ PKER_SACCRG( 20, 30) = 0.336589E+00
+ PKER_SACCRG( 20, 31) = 0.333991E+00
+ PKER_SACCRG( 20, 32) = 0.328042E+00
+ PKER_SACCRG( 20, 33) = 0.322558E+00
+ PKER_SACCRG( 20, 34) = 0.320859E+00
+ PKER_SACCRG( 20, 35) = 0.316600E+00
+ PKER_SACCRG( 20, 36) = 0.308313E+00
+ PKER_SACCRG( 20, 37) = 0.000000E+00
+ PKER_SACCRG( 20, 38) = 0.000000E+00
+ PKER_SACCRG( 20, 39) = 0.000000E+00
+ PKER_SACCRG( 20, 40) = 0.000000E+00
+ PKER_SACCRG( 21, 1) = 0.000000E+00
+ PKER_SACCRG( 21, 2) = 0.000000E+00
+ PKER_SACCRG( 21, 3) = 0.000000E+00
+ PKER_SACCRG( 21, 4) = 0.000000E+00
+ PKER_SACCRG( 21, 5) = 0.000000E+00
+ PKER_SACCRG( 21, 6) = 0.000000E+00
+ PKER_SACCRG( 21, 7) = 0.000000E+00
+ PKER_SACCRG( 21, 8) = 0.000000E+00
+ PKER_SACCRG( 21, 9) = 0.000000E+00
+ PKER_SACCRG( 21, 10) = 0.000000E+00
+ PKER_SACCRG( 21, 11) = 0.000000E+00
+ PKER_SACCRG( 21, 12) = 0.000000E+00
+ PKER_SACCRG( 21, 13) = 0.000000E+00
+ PKER_SACCRG( 21, 14) = 0.944456E-08
+ PKER_SACCRG( 21, 15) = 0.743621E-06
+ PKER_SACCRG( 21, 16) = 0.442453E+00
+ PKER_SACCRG( 21, 17) = 0.391188E-01
+ PKER_SACCRG( 21, 18) = 0.365342E-01
+ PKER_SACCRG( 21, 19) = 0.111999E+00
+ PKER_SACCRG( 21, 20) = 0.388643E-01
+ PKER_SACCRG( 21, 21) = 0.848382E-01
+ PKER_SACCRG( 21, 22) = 0.875713E-01
+ PKER_SACCRG( 21, 23) = 0.938496E-01
+ PKER_SACCRG( 21, 24) = 0.107423E+00
+ PKER_SACCRG( 21, 25) = 0.155062E+00
+ PKER_SACCRG( 21, 26) = 0.191831E+00
+ PKER_SACCRG( 21, 27) = 0.256278E+00
+ PKER_SACCRG( 21, 28) = 0.316744E+00
+ PKER_SACCRG( 21, 29) = 0.344380E+00
+ PKER_SACCRG( 21, 30) = 0.357297E+00
+ PKER_SACCRG( 21, 31) = 0.355528E+00
+ PKER_SACCRG( 21, 32) = 0.349787E+00
+ PKER_SACCRG( 21, 33) = 0.344401E+00
+ PKER_SACCRG( 21, 34) = 0.342705E+00
+ PKER_SACCRG( 21, 35) = 0.338523E+00
+ PKER_SACCRG( 21, 36) = 0.330421E+00
+ PKER_SACCRG( 21, 37) = 0.000000E+00
+ PKER_SACCRG( 21, 38) = 0.000000E+00
+ PKER_SACCRG( 21, 39) = 0.000000E+00
+ PKER_SACCRG( 21, 40) = 0.000000E+00
+ PKER_SACCRG( 22, 1) = 0.000000E+00
+ PKER_SACCRG( 22, 2) = 0.000000E+00
+ PKER_SACCRG( 22, 3) = 0.000000E+00
+ PKER_SACCRG( 22, 4) = 0.000000E+00
+ PKER_SACCRG( 22, 5) = 0.000000E+00
+ PKER_SACCRG( 22, 6) = 0.000000E+00
+ PKER_SACCRG( 22, 7) = 0.000000E+00
+ PKER_SACCRG( 22, 8) = 0.000000E+00
+ PKER_SACCRG( 22, 9) = 0.000000E+00
+ PKER_SACCRG( 22, 10) = 0.000000E+00
+ PKER_SACCRG( 22, 11) = 0.000000E+00
+ PKER_SACCRG( 22, 12) = 0.000000E+00
+ PKER_SACCRG( 22, 13) = 0.000000E+00
+ PKER_SACCRG( 22, 14) = 0.000000E+00
+ PKER_SACCRG( 22, 15) = 0.301594E-07
+ PKER_SACCRG( 22, 16) = 0.458593E+00
+ PKER_SACCRG( 22, 17) = 0.425018E+00
+ PKER_SACCRG( 22, 18) = 0.376611E-01
+ PKER_SACCRG( 22, 19) = 0.115562E+00
+ PKER_SACCRG( 22, 20) = 0.101686E+00
+ PKER_SACCRG( 22, 21) = 0.171258E+00
+ PKER_SACCRG( 22, 22) = 0.133854E+00
+ PKER_SACCRG( 22, 23) = 0.170618E+00
+ PKER_SACCRG( 22, 24) = 0.159301E+00
+ PKER_SACCRG( 22, 25) = 0.195009E+00
+ PKER_SACCRG( 22, 26) = 0.229057E+00
+ PKER_SACCRG( 22, 27) = 0.279005E+00
+ PKER_SACCRG( 22, 28) = 0.335986E+00
+ PKER_SACCRG( 22, 29) = 0.360465E+00
+ PKER_SACCRG( 22, 30) = 0.374161E+00
+ PKER_SACCRG( 22, 31) = 0.372873E+00
+ PKER_SACCRG( 22, 32) = 0.367297E+00
+ PKER_SACCRG( 22, 33) = 0.361988E+00
+ PKER_SACCRG( 22, 34) = 0.360293E+00
+ PKER_SACCRG( 22, 35) = 0.356173E+00
+ PKER_SACCRG( 22, 36) = 0.348226E+00
+ PKER_SACCRG( 22, 37) = 0.000000E+00
+ PKER_SACCRG( 22, 38) = 0.000000E+00
+ PKER_SACCRG( 22, 39) = 0.000000E+00
+ PKER_SACCRG( 22, 40) = 0.000000E+00
+ PKER_SACCRG( 23, 1) = 0.000000E+00
+ PKER_SACCRG( 23, 2) = 0.000000E+00
+ PKER_SACCRG( 23, 3) = 0.000000E+00
+ PKER_SACCRG( 23, 4) = 0.000000E+00
+ PKER_SACCRG( 23, 5) = 0.000000E+00
+ PKER_SACCRG( 23, 6) = 0.000000E+00
+ PKER_SACCRG( 23, 7) = 0.000000E+00
+ PKER_SACCRG( 23, 8) = 0.000000E+00
+ PKER_SACCRG( 23, 9) = 0.000000E+00
+ PKER_SACCRG( 23, 10) = 0.000000E+00
+ PKER_SACCRG( 23, 11) = 0.000000E+00
+ PKER_SACCRG( 23, 12) = 0.000000E+00
+ PKER_SACCRG( 23, 13) = 0.000000E+00
+ PKER_SACCRG( 23, 14) = 0.000000E+00
+ PKER_SACCRG( 23, 15) = 0.474816E-09
+ PKER_SACCRG( 23, 16) = 0.471716E+00
+ PKER_SACCRG( 23, 17) = 0.438382E+00
+ PKER_SACCRG( 23, 18) = 0.385478E-01
+ PKER_SACCRG( 23, 19) = 0.460661E+00
+ PKER_SACCRG( 23, 20) = 0.104389E+00
+ PKER_SACCRG( 23, 21) = 0.175908E+00
+ PKER_SACCRG( 23, 22) = 0.228218E+00
+ PKER_SACCRG( 23, 23) = 0.262318E+00
+ PKER_SACCRG( 23, 24) = 0.210313E+00
+ PKER_SACCRG( 23, 25) = 0.229302E+00
+ PKER_SACCRG( 23, 26) = 0.277715E+00
+ PKER_SACCRG( 23, 27) = 0.316637E+00
+ PKER_SACCRG( 23, 28) = 0.358767E+00
+ PKER_SACCRG( 23, 29) = 0.376353E+00
+ PKER_SACCRG( 23, 30) = 0.388397E+00
+ PKER_SACCRG( 23, 31) = 0.386871E+00
+ PKER_SACCRG( 23, 32) = 0.381361E+00
+ PKER_SACCRG( 23, 33) = 0.376104E+00
+ PKER_SACCRG( 23, 34) = 0.374406E+00
+ PKER_SACCRG( 23, 35) = 0.370329E+00
+ PKER_SACCRG( 23, 36) = 0.362490E+00
+ PKER_SACCRG( 23, 37) = 0.000000E+00
+ PKER_SACCRG( 23, 38) = 0.000000E+00
+ PKER_SACCRG( 23, 39) = 0.000000E+00
+ PKER_SACCRG( 23, 40) = 0.000000E+00
+ PKER_SACCRG( 24, 1) = 0.000000E+00
+ PKER_SACCRG( 24, 2) = 0.000000E+00
+ PKER_SACCRG( 24, 3) = 0.000000E+00
+ PKER_SACCRG( 24, 4) = 0.000000E+00
+ PKER_SACCRG( 24, 5) = 0.000000E+00
+ PKER_SACCRG( 24, 6) = 0.000000E+00
+ PKER_SACCRG( 24, 7) = 0.000000E+00
+ PKER_SACCRG( 24, 8) = 0.000000E+00
+ PKER_SACCRG( 24, 9) = 0.000000E+00
+ PKER_SACCRG( 24, 10) = 0.000000E+00
+ PKER_SACCRG( 24, 11) = 0.000000E+00
+ PKER_SACCRG( 24, 12) = 0.000000E+00
+ PKER_SACCRG( 24, 13) = 0.000000E+00
+ PKER_SACCRG( 24, 14) = 0.000000E+00
+ PKER_SACCRG( 24, 15) = 0.000000E+00
+ PKER_SACCRG( 24, 16) = 0.482421E+00
+ PKER_SACCRG( 24, 17) = 0.449246E+00
+ PKER_SACCRG( 24, 18) = 0.418021E+00
+ PKER_SACCRG( 24, 19) = 0.471528E+00
+ PKER_SACCRG( 24, 20) = 0.106574E+00
+ PKER_SACCRG( 24, 21) = 0.457583E+00
+ PKER_SACCRG( 24, 22) = 0.457441E+00
+ PKER_SACCRG( 24, 23) = 0.268282E+00
+ PKER_SACCRG( 24, 24) = 0.295154E+00
+ PKER_SACCRG( 24, 25) = 0.277246E+00
+ PKER_SACCRG( 24, 26) = 0.318509E+00
+ PKER_SACCRG( 24, 27) = 0.341083E+00
+ PKER_SACCRG( 24, 28) = 0.383566E+00
+ PKER_SACCRG( 24, 29) = 0.393965E+00
+ PKER_SACCRG( 24, 30) = 0.400814E+00
+ PKER_SACCRG( 24, 31) = 0.398325E+00
+ PKER_SACCRG( 24, 32) = 0.392699E+00
+ PKER_SACCRG( 24, 33) = 0.387475E+00
+ PKER_SACCRG( 24, 34) = 0.385773E+00
+ PKER_SACCRG( 24, 35) = 0.381723E+00
+ PKER_SACCRG( 24, 36) = 0.373956E+00
+ PKER_SACCRG( 24, 37) = 0.000000E+00
+ PKER_SACCRG( 24, 38) = 0.000000E+00
+ PKER_SACCRG( 24, 39) = 0.000000E+00
+ PKER_SACCRG( 24, 40) = 0.000000E+00
+ PKER_SACCRG( 25, 1) = 0.000000E+00
+ PKER_SACCRG( 25, 2) = 0.000000E+00
+ PKER_SACCRG( 25, 3) = 0.000000E+00
+ PKER_SACCRG( 25, 4) = 0.000000E+00
+ PKER_SACCRG( 25, 5) = 0.000000E+00
+ PKER_SACCRG( 25, 6) = 0.000000E+00
+ PKER_SACCRG( 25, 7) = 0.000000E+00
+ PKER_SACCRG( 25, 8) = 0.000000E+00
+ PKER_SACCRG( 25, 9) = 0.000000E+00
+ PKER_SACCRG( 25, 10) = 0.000000E+00
+ PKER_SACCRG( 25, 11) = 0.000000E+00
+ PKER_SACCRG( 25, 12) = 0.000000E+00
+ PKER_SACCRG( 25, 13) = 0.000000E+00
+ PKER_SACCRG( 25, 14) = 0.000000E+00
+ PKER_SACCRG( 25, 15) = 0.000000E+00
+ PKER_SACCRG( 25, 16) = 0.493305E+00
+ PKER_SACCRG( 25, 17) = 0.460084E+00
+ PKER_SACCRG( 25, 18) = 0.428847E+00
+ PKER_SACCRG( 25, 19) = 0.482480E+00
+ PKER_SACCRG( 25, 20) = 0.457996E+00
+ PKER_SACCRG( 25, 21) = 0.468489E+00
+ PKER_SACCRG( 25, 22) = 0.468385E+00
+ PKER_SACCRG( 25, 23) = 0.465913E+00
+ PKER_SACCRG( 25, 24) = 0.302045E+00
+ PKER_SACCRG( 25, 25) = 0.349681E+00
+ PKER_SACCRG( 25, 26) = 0.375849E+00
+ PKER_SACCRG( 25, 27) = 0.372009E+00
+ PKER_SACCRG( 25, 28) = 0.404973E+00
+ PKER_SACCRG( 25, 29) = 0.408427E+00
+ PKER_SACCRG( 25, 30) = 0.413563E+00
+ PKER_SACCRG( 25, 31) = 0.409638E+00
+ PKER_SACCRG( 25, 32) = 0.403614E+00
+ PKER_SACCRG( 25, 33) = 0.398367E+00
+ PKER_SACCRG( 25, 34) = 0.396652E+00
+ PKER_SACCRG( 25, 35) = 0.392598E+00
+ PKER_SACCRG( 25, 36) = 0.384841E+00
+ PKER_SACCRG( 25, 37) = 0.000000E+00
+ PKER_SACCRG( 25, 38) = 0.000000E+00
+ PKER_SACCRG( 25, 39) = 0.000000E+00
+ PKER_SACCRG( 25, 40) = 0.000000E+00
+ PKER_SACCRG( 26, 1) = 0.000000E+00
+ PKER_SACCRG( 26, 2) = 0.000000E+00
+ PKER_SACCRG( 26, 3) = 0.000000E+00
+ PKER_SACCRG( 26, 4) = 0.000000E+00
+ PKER_SACCRG( 26, 5) = 0.000000E+00
+ PKER_SACCRG( 26, 6) = 0.000000E+00
+ PKER_SACCRG( 26, 7) = 0.000000E+00
+ PKER_SACCRG( 26, 8) = 0.000000E+00
+ PKER_SACCRG( 26, 9) = 0.000000E+00
+ PKER_SACCRG( 26, 10) = 0.000000E+00
+ PKER_SACCRG( 26, 11) = 0.000000E+00
+ PKER_SACCRG( 26, 12) = 0.000000E+00
+ PKER_SACCRG( 26, 13) = 0.000000E+00
+ PKER_SACCRG( 26, 14) = 0.000000E+00
+ PKER_SACCRG( 26, 15) = 0.000000E+00
+ PKER_SACCRG( 26, 16) = 0.498360E+00
+ PKER_SACCRG( 26, 17) = 0.465358E+00
+ PKER_SACCRG( 26, 18) = 0.434351E+00
+ PKER_SACCRG( 26, 19) = 0.487671E+00
+ PKER_SACCRG( 26, 20) = 0.463284E+00
+ PKER_SACCRG( 26, 21) = 0.473752E+00
+ PKER_SACCRG( 26, 22) = 0.473679E+00
+ PKER_SACCRG( 26, 23) = 0.471200E+00
+ PKER_SACCRG( 26, 24) = 0.305321E+00
+ PKER_SACCRG( 26, 25) = 0.460272E+00
+ PKER_SACCRG( 26, 26) = 0.380186E+00
+ PKER_SACCRG( 26, 27) = 0.407235E+00
+ PKER_SACCRG( 26, 28) = 0.425703E+00
+ PKER_SACCRG( 26, 29) = 0.419464E+00
+ PKER_SACCRG( 26, 30) = 0.420713E+00
+ PKER_SACCRG( 26, 31) = 0.415965E+00
+ PKER_SACCRG( 26, 32) = 0.409433E+00
+ PKER_SACCRG( 26, 33) = 0.404156E+00
+ PKER_SACCRG( 26, 34) = 0.402444E+00
+ PKER_SACCRG( 26, 35) = 0.398420E+00
+ PKER_SACCRG( 26, 36) = 0.390729E+00
+ PKER_SACCRG( 26, 37) = 0.000000E+00
+ PKER_SACCRG( 26, 38) = 0.000000E+00
+ PKER_SACCRG( 26, 39) = 0.000000E+00
+ PKER_SACCRG( 26, 40) = 0.000000E+00
+ PKER_SACCRG( 27, 1) = 0.000000E+00
+ PKER_SACCRG( 27, 2) = 0.000000E+00
+ PKER_SACCRG( 27, 3) = 0.000000E+00
+ PKER_SACCRG( 27, 4) = 0.000000E+00
+ PKER_SACCRG( 27, 5) = 0.000000E+00
+ PKER_SACCRG( 27, 6) = 0.000000E+00
+ PKER_SACCRG( 27, 7) = 0.000000E+00
+ PKER_SACCRG( 27, 8) = 0.000000E+00
+ PKER_SACCRG( 27, 9) = 0.000000E+00
+ PKER_SACCRG( 27, 10) = 0.000000E+00
+ PKER_SACCRG( 27, 11) = 0.000000E+00
+ PKER_SACCRG( 27, 12) = 0.000000E+00
+ PKER_SACCRG( 27, 13) = 0.000000E+00
+ PKER_SACCRG( 27, 14) = 0.000000E+00
+ PKER_SACCRG( 27, 15) = 0.000000E+00
+ PKER_SACCRG( 27, 16) = 0.504260E+00
+ PKER_SACCRG( 27, 17) = 0.471302E+00
+ PKER_SACCRG( 27, 18) = 0.440353E+00
+ PKER_SACCRG( 27, 19) = 0.493636E+00
+ PKER_SACCRG( 27, 20) = 0.469232E+00
+ PKER_SACCRG( 27, 21) = 0.479719E+00
+ PKER_SACCRG( 27, 22) = 0.479669E+00
+ PKER_SACCRG( 27, 23) = 0.477177E+00
+ PKER_SACCRG( 27, 24) = 0.464189E+00
+ PKER_SACCRG( 27, 25) = 0.466286E+00
+ PKER_SACCRG( 27, 26) = 0.385058E+00
+ PKER_SACCRG( 27, 27) = 0.412596E+00
+ PKER_SACCRG( 27, 28) = 0.452611E+00
+ PKER_SACCRG( 27, 29) = 0.433046E+00
+ PKER_SACCRG( 27, 30) = 0.428880E+00
+ PKER_SACCRG( 27, 31) = 0.422050E+00
+ PKER_SACCRG( 27, 32) = 0.415579E+00
+ PKER_SACCRG( 27, 33) = 0.410255E+00
+ PKER_SACCRG( 27, 34) = 0.408538E+00
+ PKER_SACCRG( 27, 35) = 0.404518E+00
+ PKER_SACCRG( 27, 36) = 0.396847E+00
+ PKER_SACCRG( 27, 37) = 0.000000E+00
+ PKER_SACCRG( 27, 38) = 0.000000E+00
+ PKER_SACCRG( 27, 39) = 0.000000E+00
+ PKER_SACCRG( 27, 40) = 0.000000E+00
+ PKER_SACCRG( 28, 1) = 0.000000E+00
+ PKER_SACCRG( 28, 2) = 0.000000E+00
+ PKER_SACCRG( 28, 3) = 0.000000E+00
+ PKER_SACCRG( 28, 4) = 0.000000E+00
+ PKER_SACCRG( 28, 5) = 0.000000E+00
+ PKER_SACCRG( 28, 6) = 0.000000E+00
+ PKER_SACCRG( 28, 7) = 0.000000E+00
+ PKER_SACCRG( 28, 8) = 0.000000E+00
+ PKER_SACCRG( 28, 9) = 0.000000E+00
+ PKER_SACCRG( 28, 10) = 0.000000E+00
+ PKER_SACCRG( 28, 11) = 0.000000E+00
+ PKER_SACCRG( 28, 12) = 0.000000E+00
+ PKER_SACCRG( 28, 13) = 0.000000E+00
+ PKER_SACCRG( 28, 14) = 0.000000E+00
+ PKER_SACCRG( 28, 15) = 0.000000E+00
+ PKER_SACCRG( 28, 16) = 0.511289E+00
+ PKER_SACCRG( 28, 17) = 0.478218E+00
+ PKER_SACCRG( 28, 18) = 0.447169E+00
+ PKER_SACCRG( 28, 19) = 0.500667E+00
+ PKER_SACCRG( 28, 20) = 0.476141E+00
+ PKER_SACCRG( 28, 21) = 0.486690E+00
+ PKER_SACCRG( 28, 22) = 0.486657E+00
+ PKER_SACCRG( 28, 23) = 0.484143E+00
+ PKER_SACCRG( 28, 24) = 0.471128E+00
+ PKER_SACCRG( 28, 25) = 0.473232E+00
+ PKER_SACCRG( 28, 26) = 0.467330E+00
+ PKER_SACCRG( 28, 27) = 0.462303E+00
+ PKER_SACCRG( 28, 28) = 0.459518E+00
+ PKER_SACCRG( 28, 29) = 0.439730E+00
+ PKER_SACCRG( 28, 30) = 0.435663E+00
+ PKER_SACCRG( 28, 31) = 0.429350E+00
+ PKER_SACCRG( 28, 32) = 0.422348E+00
+ PKER_SACCRG( 28, 33) = 0.417002E+00
+ PKER_SACCRG( 28, 34) = 0.415273E+00
+ PKER_SACCRG( 28, 35) = 0.411238E+00
+ PKER_SACCRG( 28, 36) = 0.403544E+00
+ PKER_SACCRG( 28, 37) = 0.000000E+00
+ PKER_SACCRG( 28, 38) = 0.000000E+00
+ PKER_SACCRG( 28, 39) = 0.000000E+00
+ PKER_SACCRG( 28, 40) = 0.000000E+00
+ PKER_SACCRG( 29, 1) = 0.000000E+00
+ PKER_SACCRG( 29, 2) = 0.000000E+00
+ PKER_SACCRG( 29, 3) = 0.000000E+00
+ PKER_SACCRG( 29, 4) = 0.000000E+00
+ PKER_SACCRG( 29, 5) = 0.000000E+00
+ PKER_SACCRG( 29, 6) = 0.000000E+00
+ PKER_SACCRG( 29, 7) = 0.000000E+00
+ PKER_SACCRG( 29, 8) = 0.000000E+00
+ PKER_SACCRG( 29, 9) = 0.000000E+00
+ PKER_SACCRG( 29, 10) = 0.000000E+00
+ PKER_SACCRG( 29, 11) = 0.000000E+00
+ PKER_SACCRG( 29, 12) = 0.000000E+00
+ PKER_SACCRG( 29, 13) = 0.000000E+00
+ PKER_SACCRG( 29, 14) = 0.000000E+00
+ PKER_SACCRG( 29, 15) = 0.000000E+00
+ PKER_SACCRG( 29, 16) = 0.515299E+00
+ PKER_SACCRG( 29, 17) = 0.482248E+00
+ PKER_SACCRG( 29, 18) = 0.451226E+00
+ PKER_SACCRG( 29, 19) = 0.504714E+00
+ PKER_SACCRG( 29, 20) = 0.480173E+00
+ PKER_SACCRG( 29, 21) = 0.490737E+00
+ PKER_SACCRG( 29, 22) = 0.490717E+00
+ PKER_SACCRG( 29, 23) = 0.488194E+00
+ PKER_SACCRG( 29, 24) = 0.475202E+00
+ PKER_SACCRG( 29, 25) = 0.477303E+00
+ PKER_SACCRG( 29, 26) = 0.471406E+00
+ PKER_SACCRG( 29, 27) = 0.466391E+00
+ PKER_SACCRG( 29, 28) = 0.463606E+00
+ PKER_SACCRG( 29, 29) = 0.443703E+00
+ PKER_SACCRG( 29, 30) = 0.442690E+00
+ PKER_SACCRG( 29, 31) = 0.433456E+00
+ PKER_SACCRG( 29, 32) = 0.426527E+00
+ PKER_SACCRG( 29, 33) = 0.421106E+00
+ PKER_SACCRG( 29, 34) = 0.419373E+00
+ PKER_SACCRG( 29, 35) = 0.415340E+00
+ PKER_SACCRG( 29, 36) = 0.407653E+00
+ PKER_SACCRG( 29, 37) = 0.000000E+00
+ PKER_SACCRG( 29, 38) = 0.000000E+00
+ PKER_SACCRG( 29, 39) = 0.000000E+00
+ PKER_SACCRG( 29, 40) = 0.000000E+00
+ PKER_SACCRG( 30, 1) = 0.000000E+00
+ PKER_SACCRG( 30, 2) = 0.000000E+00
+ PKER_SACCRG( 30, 3) = 0.000000E+00
+ PKER_SACCRG( 30, 4) = 0.000000E+00
+ PKER_SACCRG( 30, 5) = 0.000000E+00
+ PKER_SACCRG( 30, 6) = 0.000000E+00
+ PKER_SACCRG( 30, 7) = 0.000000E+00
+ PKER_SACCRG( 30, 8) = 0.000000E+00
+ PKER_SACCRG( 30, 9) = 0.000000E+00
+ PKER_SACCRG( 30, 10) = 0.000000E+00
+ PKER_SACCRG( 30, 11) = 0.000000E+00
+ PKER_SACCRG( 30, 12) = 0.000000E+00
+ PKER_SACCRG( 30, 13) = 0.000000E+00
+ PKER_SACCRG( 30, 14) = 0.000000E+00
+ PKER_SACCRG( 30, 15) = 0.000000E+00
+ PKER_SACCRG( 30, 16) = 0.518606E+00
+ PKER_SACCRG( 30, 17) = 0.485568E+00
+ PKER_SACCRG( 30, 18) = 0.454563E+00
+ PKER_SACCRG( 30, 19) = 0.508049E+00
+ PKER_SACCRG( 30, 20) = 0.483494E+00
+ PKER_SACCRG( 30, 21) = 0.494070E+00
+ PKER_SACCRG( 30, 22) = 0.494061E+00
+ PKER_SACCRG( 30, 23) = 0.491531E+00
+ PKER_SACCRG( 30, 24) = 0.478555E+00
+ PKER_SACCRG( 30, 25) = 0.480655E+00
+ PKER_SACCRG( 30, 26) = 0.474762E+00
+ PKER_SACCRG( 30, 27) = 0.469755E+00
+ PKER_SACCRG( 30, 28) = 0.466968E+00
+ PKER_SACCRG( 30, 29) = 0.457637E+00
+ PKER_SACCRG( 30, 30) = 0.446063E+00
+ PKER_SACCRG( 30, 31) = 0.436830E+00
+ PKER_SACCRG( 30, 32) = 0.429899E+00
+ PKER_SACCRG( 30, 33) = 0.424476E+00
+ PKER_SACCRG( 30, 34) = 0.422741E+00
+ PKER_SACCRG( 30, 35) = 0.418708E+00
+ PKER_SACCRG( 30, 36) = 0.411026E+00
+ PKER_SACCRG( 30, 37) = 0.000000E+00
+ PKER_SACCRG( 30, 38) = 0.000000E+00
+ PKER_SACCRG( 30, 39) = 0.000000E+00
+ PKER_SACCRG( 30, 40) = 0.000000E+00
+ PKER_SACCRG( 31, 1) = 0.000000E+00
+ PKER_SACCRG( 31, 2) = 0.000000E+00
+ PKER_SACCRG( 31, 3) = 0.000000E+00
+ PKER_SACCRG( 31, 4) = 0.000000E+00
+ PKER_SACCRG( 31, 5) = 0.000000E+00
+ PKER_SACCRG( 31, 6) = 0.000000E+00
+ PKER_SACCRG( 31, 7) = 0.000000E+00
+ PKER_SACCRG( 31, 8) = 0.000000E+00
+ PKER_SACCRG( 31, 9) = 0.000000E+00
+ PKER_SACCRG( 31, 10) = 0.000000E+00
+ PKER_SACCRG( 31, 11) = 0.000000E+00
+ PKER_SACCRG( 31, 12) = 0.000000E+00
+ PKER_SACCRG( 31, 13) = 0.000000E+00
+ PKER_SACCRG( 31, 14) = 0.000000E+00
+ PKER_SACCRG( 31, 15) = 0.000000E+00
+ PKER_SACCRG( 31, 16) = 0.521335E+00
+ PKER_SACCRG( 31, 17) = 0.488306E+00
+ PKER_SACCRG( 31, 18) = 0.457313E+00
+ PKER_SACCRG( 31, 19) = 0.510799E+00
+ PKER_SACCRG( 31, 20) = 0.486233E+00
+ PKER_SACCRG( 31, 21) = 0.496818E+00
+ PKER_SACCRG( 31, 22) = 0.496818E+00
+ PKER_SACCRG( 31, 23) = 0.494282E+00
+ PKER_SACCRG( 31, 24) = 0.481318E+00
+ PKER_SACCRG( 31, 25) = 0.483417E+00
+ PKER_SACCRG( 31, 26) = 0.477526E+00
+ PKER_SACCRG( 31, 27) = 0.472527E+00
+ PKER_SACCRG( 31, 28) = 0.469738E+00
+ PKER_SACCRG( 31, 29) = 0.460409E+00
+ PKER_SACCRG( 31, 30) = 0.448841E+00
+ PKER_SACCRG( 31, 31) = 0.439607E+00
+ PKER_SACCRG( 31, 32) = 0.432673E+00
+ PKER_SACCRG( 31, 33) = 0.427249E+00
+ PKER_SACCRG( 31, 34) = 0.425511E+00
+ PKER_SACCRG( 31, 35) = 0.421478E+00
+ PKER_SACCRG( 31, 36) = 0.413798E+00
+ PKER_SACCRG( 31, 37) = 0.000000E+00
+ PKER_SACCRG( 31, 38) = 0.000000E+00
+ PKER_SACCRG( 31, 39) = 0.000000E+00
+ PKER_SACCRG( 31, 40) = 0.000000E+00
+ PKER_SACCRG( 32, 1) = 0.000000E+00
+ PKER_SACCRG( 32, 2) = 0.000000E+00
+ PKER_SACCRG( 32, 3) = 0.000000E+00
+ PKER_SACCRG( 32, 4) = 0.000000E+00
+ PKER_SACCRG( 32, 5) = 0.000000E+00
+ PKER_SACCRG( 32, 6) = 0.000000E+00
+ PKER_SACCRG( 32, 7) = 0.000000E+00
+ PKER_SACCRG( 32, 8) = 0.000000E+00
+ PKER_SACCRG( 32, 9) = 0.000000E+00
+ PKER_SACCRG( 32, 10) = 0.000000E+00
+ PKER_SACCRG( 32, 11) = 0.000000E+00
+ PKER_SACCRG( 32, 12) = 0.000000E+00
+ PKER_SACCRG( 32, 13) = 0.000000E+00
+ PKER_SACCRG( 32, 14) = 0.000000E+00
+ PKER_SACCRG( 32, 15) = 0.000000E+00
+ PKER_SACCRG( 32, 16) = 0.521382E+00
+ PKER_SACCRG( 32, 17) = 0.488500E+00
+ PKER_SACCRG( 32, 18) = 0.457646E+00
+ PKER_SACCRG( 32, 19) = 0.510908E+00
+ PKER_SACCRG( 32, 20) = 0.486436E+00
+ PKER_SACCRG( 32, 21) = 0.496984E+00
+ PKER_SACCRG( 32, 22) = 0.496990E+00
+ PKER_SACCRG( 32, 23) = 0.494461E+00
+ PKER_SACCRG( 32, 24) = 0.481561E+00
+ PKER_SACCRG( 32, 25) = 0.483650E+00
+ PKER_SACCRG( 32, 26) = 0.477787E+00
+ PKER_SACCRG( 32, 27) = 0.472813E+00
+ PKER_SACCRG( 32, 28) = 0.470036E+00
+ PKER_SACCRG( 32, 29) = 0.460747E+00
+ PKER_SACCRG( 32, 30) = 0.449232E+00
+ PKER_SACCRG( 32, 31) = 0.440036E+00
+ PKER_SACCRG( 32, 32) = 0.433130E+00
+ PKER_SACCRG( 32, 33) = 0.427727E+00
+ PKER_SACCRG( 32, 34) = 0.425995E+00
+ PKER_SACCRG( 32, 35) = 0.421979E+00
+ PKER_SACCRG( 32, 36) = 0.414334E+00
+ PKER_SACCRG( 32, 37) = 0.000000E+00
+ PKER_SACCRG( 32, 38) = 0.000000E+00
+ PKER_SACCRG( 32, 39) = 0.000000E+00
+ PKER_SACCRG( 32, 40) = 0.000000E+00
+ PKER_SACCRG( 33, 1) = 0.000000E+00
+ PKER_SACCRG( 33, 2) = 0.000000E+00
+ PKER_SACCRG( 33, 3) = 0.000000E+00
+ PKER_SACCRG( 33, 4) = 0.000000E+00
+ PKER_SACCRG( 33, 5) = 0.000000E+00
+ PKER_SACCRG( 33, 6) = 0.000000E+00
+ PKER_SACCRG( 33, 7) = 0.000000E+00
+ PKER_SACCRG( 33, 8) = 0.000000E+00
+ PKER_SACCRG( 33, 9) = 0.000000E+00
+ PKER_SACCRG( 33, 10) = 0.000000E+00
+ PKER_SACCRG( 33, 11) = 0.000000E+00
+ PKER_SACCRG( 33, 12) = 0.000000E+00
+ PKER_SACCRG( 33, 13) = 0.000000E+00
+ PKER_SACCRG( 33, 14) = 0.000000E+00
+ PKER_SACCRG( 33, 15) = 0.000000E+00
+ PKER_SACCRG( 33, 16) = 0.523239E+00
+ PKER_SACCRG( 33, 17) = 0.490361E+00
+ PKER_SACCRG( 33, 18) = 0.459511E+00
+ PKER_SACCRG( 33, 19) = 0.512778E+00
+ PKER_SACCRG( 33, 20) = 0.488297E+00
+ PKER_SACCRG( 33, 21) = 0.498852E+00
+ PKER_SACCRG( 33, 22) = 0.498864E+00
+ PKER_SACCRG( 33, 23) = 0.496331E+00
+ PKER_SACCRG( 33, 24) = 0.483437E+00
+ PKER_SACCRG( 33, 25) = 0.485525E+00
+ PKER_SACCRG( 33, 26) = 0.479663E+00
+ PKER_SACCRG( 33, 27) = 0.474693E+00
+ PKER_SACCRG( 33, 28) = 0.471915E+00
+ PKER_SACCRG( 33, 29) = 0.462627E+00
+ PKER_SACCRG( 33, 30) = 0.451113E+00
+ PKER_SACCRG( 33, 31) = 0.441917E+00
+ PKER_SACCRG( 33, 32) = 0.435008E+00
+ PKER_SACCRG( 33, 33) = 0.429604E+00
+ PKER_SACCRG( 33, 34) = 0.427870E+00
+ PKER_SACCRG( 33, 35) = 0.423853E+00
+ PKER_SACCRG( 33, 36) = 0.416209E+00
+ PKER_SACCRG( 33, 37) = 0.000000E+00
+ PKER_SACCRG( 33, 38) = 0.000000E+00
+ PKER_SACCRG( 33, 39) = 0.000000E+00
+ PKER_SACCRG( 33, 40) = 0.000000E+00
+ PKER_SACCRG( 34, 1) = 0.000000E+00
+ PKER_SACCRG( 34, 2) = 0.000000E+00
+ PKER_SACCRG( 34, 3) = 0.000000E+00
+ PKER_SACCRG( 34, 4) = 0.000000E+00
+ PKER_SACCRG( 34, 5) = 0.000000E+00
+ PKER_SACCRG( 34, 6) = 0.000000E+00
+ PKER_SACCRG( 34, 7) = 0.000000E+00
+ PKER_SACCRG( 34, 8) = 0.000000E+00
+ PKER_SACCRG( 34, 9) = 0.000000E+00
+ PKER_SACCRG( 34, 10) = 0.000000E+00
+ PKER_SACCRG( 34, 11) = 0.000000E+00
+ PKER_SACCRG( 34, 12) = 0.000000E+00
+ PKER_SACCRG( 34, 13) = 0.000000E+00
+ PKER_SACCRG( 34, 14) = 0.000000E+00
+ PKER_SACCRG( 34, 15) = 0.000000E+00
+ PKER_SACCRG( 34, 16) = 0.526989E+00
+ PKER_SACCRG( 34, 17) = 0.493974E+00
+ PKER_SACCRG( 34, 18) = 0.462996E+00
+ PKER_SACCRG( 34, 19) = 0.516493E+00
+ PKER_SACCRG( 34, 20) = 0.491901E+00
+ PKER_SACCRG( 34, 21) = 0.502507E+00
+ PKER_SACCRG( 34, 22) = 0.502522E+00
+ PKER_SACCRG( 34, 23) = 0.499975E+00
+ PKER_SACCRG( 34, 24) = 0.487032E+00
+ PKER_SACCRG( 34, 25) = 0.489128E+00
+ PKER_SACCRG( 34, 26) = 0.483242E+00
+ PKER_SACCRG( 34, 27) = 0.478253E+00
+ PKER_SACCRG( 34, 28) = 0.475463E+00
+ PKER_SACCRG( 34, 29) = 0.466135E+00
+ PKER_SACCRG( 34, 30) = 0.454574E+00
+ PKER_SACCRG( 34, 31) = 0.445337E+00
+ PKER_SACCRG( 34, 32) = 0.438397E+00
+ PKER_SACCRG( 34, 33) = 0.432968E+00
+ PKER_SACCRG( 34, 34) = 0.431225E+00
+ PKER_SACCRG( 34, 35) = 0.427191E+00
+ PKER_SACCRG( 34, 36) = 0.419515E+00
+ PKER_SACCRG( 34, 37) = 0.000000E+00
+ PKER_SACCRG( 34, 38) = 0.000000E+00
+ PKER_SACCRG( 34, 39) = 0.000000E+00
+ PKER_SACCRG( 34, 40) = 0.000000E+00
+ PKER_SACCRG( 35, 1) = 0.000000E+00
+ PKER_SACCRG( 35, 2) = 0.000000E+00
+ PKER_SACCRG( 35, 3) = 0.000000E+00
+ PKER_SACCRG( 35, 4) = 0.000000E+00
+ PKER_SACCRG( 35, 5) = 0.000000E+00
+ PKER_SACCRG( 35, 6) = 0.000000E+00
+ PKER_SACCRG( 35, 7) = 0.000000E+00
+ PKER_SACCRG( 35, 8) = 0.000000E+00
+ PKER_SACCRG( 35, 9) = 0.000000E+00
+ PKER_SACCRG( 35, 10) = 0.000000E+00
+ PKER_SACCRG( 35, 11) = 0.000000E+00
+ PKER_SACCRG( 35, 12) = 0.000000E+00
+ PKER_SACCRG( 35, 13) = 0.000000E+00
+ PKER_SACCRG( 35, 14) = 0.000000E+00
+ PKER_SACCRG( 35, 15) = 0.000000E+00
+ PKER_SACCRG( 35, 16) = 0.526044E+00
+ PKER_SACCRG( 35, 17) = 0.493170E+00
+ PKER_SACCRG( 35, 18) = 0.462325E+00
+ PKER_SACCRG( 35, 19) = 0.515600E+00
+ PKER_SACCRG( 35, 20) = 0.491106E+00
+ PKER_SACCRG( 35, 21) = 0.501671E+00
+ PKER_SACCRG( 35, 22) = 0.501689E+00
+ PKER_SACCRG( 35, 23) = 0.499151E+00
+ PKER_SACCRG( 35, 24) = 0.486266E+00
+ PKER_SACCRG( 35, 25) = 0.488354E+00
+ PKER_SACCRG( 35, 26) = 0.482493E+00
+ PKER_SACCRG( 35, 27) = 0.477528E+00
+ PKER_SACCRG( 35, 28) = 0.474748E+00
+ PKER_SACCRG( 35, 29) = 0.465460E+00
+ PKER_SACCRG( 35, 30) = 0.453949E+00
+ PKER_SACCRG( 35, 31) = 0.444750E+00
+ PKER_SACCRG( 35, 32) = 0.437837E+00
+ PKER_SACCRG( 35, 33) = 0.432431E+00
+ PKER_SACCRG( 35, 34) = 0.430694E+00
+ PKER_SACCRG( 35, 35) = 0.426676E+00
+ PKER_SACCRG( 35, 36) = 0.419033E+00
+ PKER_SACCRG( 35, 37) = 0.000000E+00
+ PKER_SACCRG( 35, 38) = 0.000000E+00
+ PKER_SACCRG( 35, 39) = 0.000000E+00
+ PKER_SACCRG( 35, 40) = 0.000000E+00
+ PKER_SACCRG( 36, 1) = 0.000000E+00
+ PKER_SACCRG( 36, 2) = 0.000000E+00
+ PKER_SACCRG( 36, 3) = 0.000000E+00
+ PKER_SACCRG( 36, 4) = 0.000000E+00
+ PKER_SACCRG( 36, 5) = 0.000000E+00
+ PKER_SACCRG( 36, 6) = 0.000000E+00
+ PKER_SACCRG( 36, 7) = 0.000000E+00
+ PKER_SACCRG( 36, 8) = 0.000000E+00
+ PKER_SACCRG( 36, 9) = 0.000000E+00
+ PKER_SACCRG( 36, 10) = 0.000000E+00
+ PKER_SACCRG( 36, 11) = 0.000000E+00
+ PKER_SACCRG( 36, 12) = 0.000000E+00
+ PKER_SACCRG( 36, 13) = 0.000000E+00
+ PKER_SACCRG( 36, 14) = 0.000000E+00
+ PKER_SACCRG( 36, 15) = 0.000000E+00
+ PKER_SACCRG( 36, 16) = 0.527094E+00
+ PKER_SACCRG( 36, 17) = 0.494221E+00
+ PKER_SACCRG( 36, 18) = 0.463377E+00
+ PKER_SACCRG( 36, 19) = 0.516656E+00
+ PKER_SACCRG( 36, 20) = 0.492157E+00
+ PKER_SACCRG( 36, 21) = 0.502726E+00
+ PKER_SACCRG( 36, 22) = 0.502746E+00
+ PKER_SACCRG( 36, 23) = 0.500207E+00
+ PKER_SACCRG( 36, 24) = 0.487324E+00
+ PKER_SACCRG( 36, 25) = 0.489412E+00
+ PKER_SACCRG( 36, 26) = 0.483551E+00
+ PKER_SACCRG( 36, 27) = 0.478587E+00
+ PKER_SACCRG( 36, 28) = 0.475807E+00
+ PKER_SACCRG( 36, 29) = 0.466519E+00
+ PKER_SACCRG( 36, 30) = 0.455008E+00
+ PKER_SACCRG( 36, 31) = 0.445809E+00
+ PKER_SACCRG( 36, 32) = 0.438895E+00
+ PKER_SACCRG( 36, 33) = 0.433487E+00
+ PKER_SACCRG( 36, 34) = 0.431749E+00
+ PKER_SACCRG( 36, 35) = 0.427731E+00
+ PKER_SACCRG( 36, 36) = 0.420087E+00
+ PKER_SACCRG( 36, 37) = 0.000000E+00
+ PKER_SACCRG( 36, 38) = 0.000000E+00
+ PKER_SACCRG( 36, 39) = 0.000000E+00
+ PKER_SACCRG( 36, 40) = 0.000000E+00
+ PKER_SACCRG( 37, 1) = 0.000000E+00
+ PKER_SACCRG( 37, 2) = 0.000000E+00
+ PKER_SACCRG( 37, 3) = 0.000000E+00
+ PKER_SACCRG( 37, 4) = 0.000000E+00
+ PKER_SACCRG( 37, 5) = 0.000000E+00
+ PKER_SACCRG( 37, 6) = 0.000000E+00
+ PKER_SACCRG( 37, 7) = 0.000000E+00
+ PKER_SACCRG( 37, 8) = 0.000000E+00
+ PKER_SACCRG( 37, 9) = 0.000000E+00
+ PKER_SACCRG( 37, 10) = 0.000000E+00
+ PKER_SACCRG( 37, 11) = 0.000000E+00
+ PKER_SACCRG( 37, 12) = 0.000000E+00
+ PKER_SACCRG( 37, 13) = 0.000000E+00
+ PKER_SACCRG( 37, 14) = 0.000000E+00
+ PKER_SACCRG( 37, 15) = 0.000000E+00
+ PKER_SACCRG( 37, 16) = 0.527963E+00
+ PKER_SACCRG( 37, 17) = 0.495090E+00
+ PKER_SACCRG( 37, 18) = 0.464247E+00
+ PKER_SACCRG( 37, 19) = 0.517529E+00
+ PKER_SACCRG( 37, 20) = 0.493026E+00
+ PKER_SACCRG( 37, 21) = 0.503598E+00
+ PKER_SACCRG( 37, 22) = 0.503620E+00
+ PKER_SACCRG( 37, 23) = 0.501079E+00
+ PKER_SACCRG( 37, 24) = 0.488199E+00
+ PKER_SACCRG( 37, 25) = 0.490286E+00
+ PKER_SACCRG( 37, 26) = 0.484426E+00
+ PKER_SACCRG( 37, 27) = 0.479463E+00
+ PKER_SACCRG( 37, 28) = 0.476683E+00
+ PKER_SACCRG( 37, 29) = 0.467394E+00
+ PKER_SACCRG( 37, 30) = 0.455884E+00
+ PKER_SACCRG( 37, 31) = 0.446684E+00
+ PKER_SACCRG( 37, 32) = 0.439768E+00
+ PKER_SACCRG( 37, 33) = 0.434360E+00
+ PKER_SACCRG( 37, 34) = 0.432621E+00
+ PKER_SACCRG( 37, 35) = 0.428603E+00
+ PKER_SACCRG( 37, 36) = 0.420959E+00
+ PKER_SACCRG( 37, 37) = 0.000000E+00
+ PKER_SACCRG( 37, 38) = 0.000000E+00
+ PKER_SACCRG( 37, 39) = 0.000000E+00
+ PKER_SACCRG( 37, 40) = 0.000000E+00
+ PKER_SACCRG( 38, 1) = 0.000000E+00
+ PKER_SACCRG( 38, 2) = 0.000000E+00
+ PKER_SACCRG( 38, 3) = 0.000000E+00
+ PKER_SACCRG( 38, 4) = 0.000000E+00
+ PKER_SACCRG( 38, 5) = 0.000000E+00
+ PKER_SACCRG( 38, 6) = 0.000000E+00
+ PKER_SACCRG( 38, 7) = 0.000000E+00
+ PKER_SACCRG( 38, 8) = 0.000000E+00
+ PKER_SACCRG( 38, 9) = 0.000000E+00
+ PKER_SACCRG( 38, 10) = 0.000000E+00
+ PKER_SACCRG( 38, 11) = 0.000000E+00
+ PKER_SACCRG( 38, 12) = 0.000000E+00
+ PKER_SACCRG( 38, 13) = 0.000000E+00
+ PKER_SACCRG( 38, 14) = 0.000000E+00
+ PKER_SACCRG( 38, 15) = 0.000000E+00
+ PKER_SACCRG( 38, 16) = 0.530904E+00
+ PKER_SACCRG( 38, 17) = 0.497893E+00
+ PKER_SACCRG( 38, 18) = 0.466921E+00
+ PKER_SACCRG( 38, 19) = 0.520430E+00
+ PKER_SACCRG( 38, 20) = 0.495821E+00
+ PKER_SACCRG( 38, 21) = 0.506439E+00
+ PKER_SACCRG( 38, 22) = 0.506463E+00
+ PKER_SACCRG( 38, 23) = 0.503910E+00
+ PKER_SACCRG( 38, 24) = 0.490978E+00
+ PKER_SACCRG( 38, 25) = 0.493073E+00
+ PKER_SACCRG( 38, 26) = 0.487189E+00
+ PKER_SACCRG( 38, 27) = 0.482206E+00
+ PKER_SACCRG( 38, 28) = 0.479414E+00
+ PKER_SACCRG( 38, 29) = 0.470086E+00
+ PKER_SACCRG( 38, 30) = 0.458527E+00
+ PKER_SACCRG( 38, 31) = 0.449287E+00
+ PKER_SACCRG( 38, 32) = 0.442342E+00
+ PKER_SACCRG( 38, 33) = 0.436910E+00
+ PKER_SACCRG( 38, 34) = 0.435164E+00
+ PKER_SACCRG( 38, 35) = 0.431128E+00
+ PKER_SACCRG( 38, 36) = 0.423452E+00
+ PKER_SACCRG( 38, 37) = 0.000000E+00
+ PKER_SACCRG( 38, 38) = 0.000000E+00
+ PKER_SACCRG( 38, 39) = 0.000000E+00
+ PKER_SACCRG( 38, 40) = 0.000000E+00
+ PKER_SACCRG( 39, 1) = 0.000000E+00
+ PKER_SACCRG( 39, 2) = 0.000000E+00
+ PKER_SACCRG( 39, 3) = 0.000000E+00
+ PKER_SACCRG( 39, 4) = 0.000000E+00
+ PKER_SACCRG( 39, 5) = 0.000000E+00
+ PKER_SACCRG( 39, 6) = 0.000000E+00
+ PKER_SACCRG( 39, 7) = 0.000000E+00
+ PKER_SACCRG( 39, 8) = 0.000000E+00
+ PKER_SACCRG( 39, 9) = 0.000000E+00
+ PKER_SACCRG( 39, 10) = 0.000000E+00
+ PKER_SACCRG( 39, 11) = 0.000000E+00
+ PKER_SACCRG( 39, 12) = 0.000000E+00
+ PKER_SACCRG( 39, 13) = 0.000000E+00
+ PKER_SACCRG( 39, 14) = 0.000000E+00
+ PKER_SACCRG( 39, 15) = 0.000000E+00
+ PKER_SACCRG( 39, 16) = 0.531500E+00
+ PKER_SACCRG( 39, 17) = 0.498490E+00
+ PKER_SACCRG( 39, 18) = 0.467518E+00
+ PKER_SACCRG( 39, 19) = 0.521029E+00
+ PKER_SACCRG( 39, 20) = 0.496417E+00
+ PKER_SACCRG( 39, 21) = 0.507037E+00
+ PKER_SACCRG( 39, 22) = 0.507063E+00
+ PKER_SACCRG( 39, 23) = 0.504509E+00
+ PKER_SACCRG( 39, 24) = 0.491577E+00
+ PKER_SACCRG( 39, 25) = 0.493673E+00
+ PKER_SACCRG( 39, 26) = 0.487788E+00
+ PKER_SACCRG( 39, 27) = 0.482807E+00
+ PKER_SACCRG( 39, 28) = 0.480014E+00
+ PKER_SACCRG( 39, 29) = 0.470686E+00
+ PKER_SACCRG( 39, 30) = 0.459128E+00
+ PKER_SACCRG( 39, 31) = 0.449887E+00
+ PKER_SACCRG( 39, 32) = 0.442941E+00
+ PKER_SACCRG( 39, 33) = 0.437508E+00
+ PKER_SACCRG( 39, 34) = 0.435762E+00
+ PKER_SACCRG( 39, 35) = 0.431726E+00
+ PKER_SACCRG( 39, 36) = 0.424049E+00
+ PKER_SACCRG( 39, 37) = 0.000000E+00
+ PKER_SACCRG( 39, 38) = 0.000000E+00
+ PKER_SACCRG( 39, 39) = 0.000000E+00
+ PKER_SACCRG( 39, 40) = 0.000000E+00
+ PKER_SACCRG( 40, 1) = 0.000000E+00
+ PKER_SACCRG( 40, 2) = 0.000000E+00
+ PKER_SACCRG( 40, 3) = 0.000000E+00
+ PKER_SACCRG( 40, 4) = 0.000000E+00
+ PKER_SACCRG( 40, 5) = 0.000000E+00
+ PKER_SACCRG( 40, 6) = 0.000000E+00
+ PKER_SACCRG( 40, 7) = 0.000000E+00
+ PKER_SACCRG( 40, 8) = 0.000000E+00
+ PKER_SACCRG( 40, 9) = 0.000000E+00
+ PKER_SACCRG( 40, 10) = 0.000000E+00
+ PKER_SACCRG( 40, 11) = 0.000000E+00
+ PKER_SACCRG( 40, 12) = 0.000000E+00
+ PKER_SACCRG( 40, 13) = 0.000000E+00
+ PKER_SACCRG( 40, 14) = 0.000000E+00
+ PKER_SACCRG( 40, 15) = 0.000000E+00
+ PKER_SACCRG( 40, 16) = 0.531993E+00
+ PKER_SACCRG( 40, 17) = 0.498983E+00
+ PKER_SACCRG( 40, 18) = 0.468012E+00
+ PKER_SACCRG( 40, 19) = 0.521524E+00
+ PKER_SACCRG( 40, 20) = 0.496911E+00
+ PKER_SACCRG( 40, 21) = 0.507532E+00
+ PKER_SACCRG( 40, 22) = 0.507558E+00
+ PKER_SACCRG( 40, 23) = 0.505004E+00
+ PKER_SACCRG( 40, 24) = 0.492073E+00
+ PKER_SACCRG( 40, 25) = 0.494169E+00
+ PKER_SACCRG( 40, 26) = 0.488284E+00
+ PKER_SACCRG( 40, 27) = 0.483303E+00
+ PKER_SACCRG( 40, 28) = 0.480510E+00
+ PKER_SACCRG( 40, 29) = 0.471182E+00
+ PKER_SACCRG( 40, 30) = 0.459624E+00
+ PKER_SACCRG( 40, 31) = 0.450383E+00
+ PKER_SACCRG( 40, 32) = 0.443437E+00
+ PKER_SACCRG( 40, 33) = 0.438004E+00
+ PKER_SACCRG( 40, 34) = 0.436256E+00
+ PKER_SACCRG( 40, 35) = 0.432220E+00
+ PKER_SACCRG( 40, 36) = 0.424544E+00
+ PKER_SACCRG( 40, 37) = 0.000000E+00
+ PKER_SACCRG( 40, 38) = 0.000000E+00
+ PKER_SACCRG( 40, 39) = 0.000000E+00
+ PKER_SACCRG( 40, 40) = 0.000000E+00
+END IF
+!
+END SUBROUTINE READ_XKER_RACCS
diff --git a/src/mesonh/micro/read_xker_rdryg.f90 b/src/mesonh/micro/read_xker_rdryg.f90
new file mode 100644
index 000000000..e0c67b505
--- /dev/null
+++ b/src/mesonh/micro/read_xker_rdryg.f90
@@ -0,0 +1,1736 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 init 2006/05/18 13:07:25
+!-----------------------------------------------------------------
+! ###########################
+ MODULE MODI_READ_XKER_RDRYG
+! ###########################
+!
+INTERFACE
+ SUBROUTINE READ_XKER_RDRYG (KDRYLBDAG,KDRYLBDAR,KND, &
+ PALPHAG,PNUG,PALPHAR,PNUR,PEGR,PBR,PCG,PDG,PCR,PDR, &
+ PDRYLBDAG_MAX,PDRYLBDAR_MAX,PDRYLBDAG_MIN,PDRYLBDAR_MIN, &
+ PFDINFTY,PKER_RDRYG )
+!
+INTEGER, INTENT(OUT) :: KND,KDRYLBDAG,KDRYLBDAR
+REAL, INTENT(OUT) :: PALPHAG
+REAL, INTENT(OUT) :: PNUG
+REAL, INTENT(OUT) :: PALPHAR
+REAL, INTENT(OUT) :: PNUR
+REAL, INTENT(OUT) :: PEGR
+REAL, INTENT(OUT) :: PBR
+REAL, INTENT(OUT) :: PCG
+REAL, INTENT(OUT) :: PDG
+REAL, INTENT(OUT) :: PCR
+REAL, INTENT(OUT) :: PDR
+REAL, INTENT(OUT) :: PDRYLBDAG_MAX
+REAL, INTENT(OUT) :: PDRYLBDAR_MAX
+REAL, INTENT(OUT) :: PDRYLBDAG_MIN
+REAL, INTENT(OUT) :: PDRYLBDAR_MIN
+REAL, INTENT(OUT) :: PFDINFTY
+REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_RDRYG
+!
+END SUBROUTINE
+!
+END INTERFACE
+!
+END MODULE MODI_READ_XKER_RDRYG
+! ########################################################################
+ SUBROUTINE READ_XKER_RDRYG (KDRYLBDAG,KDRYLBDAR,KND, &
+ PALPHAG,PNUG,PALPHAR,PNUR,PEGR,PBR,PCG,PDG,PCR,PDR, &
+ PDRYLBDAG_MAX,PDRYLBDAR_MAX,PDRYLBDAG_MIN,PDRYLBDAR_MIN, &
+ PFDINFTY,PKER_RDRYG )
+! ########################################################################
+!
+!!**** * * - initialize the kernels for the snow-graupel dry growth process
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to initialize the kernels PKER_RDRYG
+!! prepared from a previous run of the routine INI_RAIN_ICE. The reading of
+!! the kernels is optional after checking for the dimensions of the arrays.
+!!
+!!** METHOD
+!! ------
+!!
+!!
+!! EXTERNAL
+!! --------
+!! None
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation ( routine READ_XKER_RDRYG )
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 09/04/96
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!* 0.2 Declarations of local variables :
+!
+!
+INTEGER, INTENT(OUT) :: KND,KDRYLBDAG,KDRYLBDAR
+REAL, INTENT(OUT) :: PALPHAG
+REAL, INTENT(OUT) :: PNUG
+REAL, INTENT(OUT) :: PALPHAR
+REAL, INTENT(OUT) :: PNUR
+REAL, INTENT(OUT) :: PEGR
+REAL, INTENT(OUT) :: PBR
+REAL, INTENT(OUT) :: PCG
+REAL, INTENT(OUT) :: PDG
+REAL, INTENT(OUT) :: PCR
+REAL, INTENT(OUT) :: PDR
+REAL, INTENT(OUT) :: PDRYLBDAG_MAX
+REAL, INTENT(OUT) :: PDRYLBDAR_MAX
+REAL, INTENT(OUT) :: PDRYLBDAG_MIN
+REAL, INTENT(OUT) :: PDRYLBDAR_MIN
+REAL, INTENT(OUT) :: PFDINFTY
+REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_RDRYG
+!
+! ###################################################################
+! #INSERT HERE THE OUTPUT OF INI_RAIN_ICE IF THE KERNELS ARE UPDATED#
+! ###################################################################
+!
+KND= 50
+KDRYLBDAG= 40
+KDRYLBDAR= 40
+PALPHAG= 0.100000E+01
+PNUG= 0.100000E+01
+PALPHAR= 0.100000E+01
+PNUR= 0.100000E+01
+PEGR= 0.100000E+01
+PBR= 0.300000E+01
+PCG= 0.124000E+03
+PDG= 0.660000E+00
+PCR= 0.842000E+03
+PDR= 0.800000E+00
+PDRYLBDAG_MAX= 0.100000E+08
+PDRYLBDAR_MAX= 0.100000E+08
+PDRYLBDAG_MIN= 0.100000E+04
+PDRYLBDAR_MIN= 0.100000E+04
+PFDINFTY= 0.200000E+02
+!
+IF( PRESENT(PKER_RDRYG) ) THEN
+ PKER_RDRYG( 1, 1) = 0.113429E+02
+ PKER_RDRYG( 1, 2) = 0.888532E+01
+ PKER_RDRYG( 1, 3) = 0.684777E+01
+ PKER_RDRYG( 1, 4) = 0.517128E+01
+ PKER_RDRYG( 1, 5) = 0.381554E+01
+ PKER_RDRYG( 1, 6) = 0.275614E+01
+ PKER_RDRYG( 1, 7) = 0.197831E+01
+ PKER_RDRYG( 1, 8) = 0.146495E+01
+ PKER_RDRYG( 1, 9) = 0.118865E+01
+ PKER_RDRYG( 1, 10) = 0.110504E+01
+ PKER_RDRYG( 1, 11) = 0.115718E+01
+ PKER_RDRYG( 1, 12) = 0.128948E+01
+ PKER_RDRYG( 1, 13) = 0.145623E+01
+ PKER_RDRYG( 1, 14) = 0.162671E+01
+ PKER_RDRYG( 1, 15) = 0.178400E+01
+ PKER_RDRYG( 1, 16) = 0.192135E+01
+ PKER_RDRYG( 1, 17) = 0.203766E+01
+ PKER_RDRYG( 1, 18) = 0.213454E+01
+ PKER_RDRYG( 1, 19) = 0.221453E+01
+ PKER_RDRYG( 1, 20) = 0.228027E+01
+ PKER_RDRYG( 1, 21) = 0.233424E+01
+ PKER_RDRYG( 1, 22) = 0.237855E+01
+ PKER_RDRYG( 1, 23) = 0.241497E+01
+ PKER_RDRYG( 1, 24) = 0.244492E+01
+ PKER_RDRYG( 1, 25) = 0.246956E+01
+ PKER_RDRYG( 1, 26) = 0.248985E+01
+ PKER_RDRYG( 1, 27) = 0.250656E+01
+ PKER_RDRYG( 1, 28) = 0.252033E+01
+ PKER_RDRYG( 1, 29) = 0.253168E+01
+ PKER_RDRYG( 1, 30) = 0.254104E+01
+ PKER_RDRYG( 1, 31) = 0.254875E+01
+ PKER_RDRYG( 1, 32) = 0.255512E+01
+ PKER_RDRYG( 1, 33) = 0.256037E+01
+ PKER_RDRYG( 1, 34) = 0.256470E+01
+ PKER_RDRYG( 1, 35) = 0.256828E+01
+ PKER_RDRYG( 1, 36) = 0.257123E+01
+ PKER_RDRYG( 1, 37) = 0.257367E+01
+ PKER_RDRYG( 1, 38) = 0.257568E+01
+ PKER_RDRYG( 1, 39) = 0.257735E+01
+ PKER_RDRYG( 1, 40) = 0.257872E+01
+ PKER_RDRYG( 2, 1) = 0.117927E+02
+ PKER_RDRYG( 2, 2) = 0.934446E+01
+ PKER_RDRYG( 2, 3) = 0.730889E+01
+ PKER_RDRYG( 2, 4) = 0.562152E+01
+ PKER_RDRYG( 2, 5) = 0.423473E+01
+ PKER_RDRYG( 2, 6) = 0.311610E+01
+ PKER_RDRYG( 2, 7) = 0.224696E+01
+ PKER_RDRYG( 2, 8) = 0.161553E+01
+ PKER_RDRYG( 2, 9) = 0.120734E+01
+ PKER_RDRYG( 2, 10) = 0.997308E+00
+ PKER_RDRYG( 2, 11) = 0.945330E+00
+ PKER_RDRYG( 2, 12) = 0.100270E+01
+ PKER_RDRYG( 2, 13) = 0.112265E+01
+ PKER_RDRYG( 2, 14) = 0.126742E+01
+ PKER_RDRYG( 2, 15) = 0.141245E+01
+ PKER_RDRYG( 2, 16) = 0.154497E+01
+ PKER_RDRYG( 2, 17) = 0.165998E+01
+ PKER_RDRYG( 2, 18) = 0.175705E+01
+ PKER_RDRYG( 2, 19) = 0.183773E+01
+ PKER_RDRYG( 2, 20) = 0.190425E+01
+ PKER_RDRYG( 2, 21) = 0.195889E+01
+ PKER_RDRYG( 2, 22) = 0.200372E+01
+ PKER_RDRYG( 2, 23) = 0.204054E+01
+ PKER_RDRYG( 2, 24) = 0.207079E+01
+ PKER_RDRYG( 2, 25) = 0.209566E+01
+ PKER_RDRYG( 2, 26) = 0.211612E+01
+ PKER_RDRYG( 2, 27) = 0.213297E+01
+ PKER_RDRYG( 2, 28) = 0.214684E+01
+ PKER_RDRYG( 2, 29) = 0.215827E+01
+ PKER_RDRYG( 2, 30) = 0.216769E+01
+ PKER_RDRYG( 2, 31) = 0.217545E+01
+ PKER_RDRYG( 2, 32) = 0.218186E+01
+ PKER_RDRYG( 2, 33) = 0.218714E+01
+ PKER_RDRYG( 2, 34) = 0.219150E+01
+ PKER_RDRYG( 2, 35) = 0.219509E+01
+ PKER_RDRYG( 2, 36) = 0.219806E+01
+ PKER_RDRYG( 2, 37) = 0.220051E+01
+ PKER_RDRYG( 2, 38) = 0.220253E+01
+ PKER_RDRYG( 2, 39) = 0.220420E+01
+ PKER_RDRYG( 2, 40) = 0.220558E+01
+ PKER_RDRYG( 3, 1) = 0.121617E+02
+ PKER_RDRYG( 3, 2) = 0.972447E+01
+ PKER_RDRYG( 3, 3) = 0.769669E+01
+ PKER_RDRYG( 3, 4) = 0.601068E+01
+ PKER_RDRYG( 3, 5) = 0.461358E+01
+ PKER_RDRYG( 3, 6) = 0.346650E+01
+ PKER_RDRYG( 3, 7) = 0.254421E+01
+ PKER_RDRYG( 3, 8) = 0.183189E+01
+ PKER_RDRYG( 3, 9) = 0.131969E+01
+ PKER_RDRYG( 3, 10) = 0.997188E+00
+ PKER_RDRYG( 3, 11) = 0.839117E+00
+ PKER_RDRYG( 3, 12) = 0.810553E+00
+ PKER_RDRYG( 3, 13) = 0.869949E+00
+ PKER_RDRYG( 3, 14) = 0.977509E+00
+ PKER_RDRYG( 3, 15) = 0.110267E+01
+ PKER_RDRYG( 3, 16) = 0.122591E+01
+ PKER_RDRYG( 3, 17) = 0.133742E+01
+ PKER_RDRYG( 3, 18) = 0.143367E+01
+ PKER_RDRYG( 3, 19) = 0.151464E+01
+ PKER_RDRYG( 3, 20) = 0.158182E+01
+ PKER_RDRYG( 3, 21) = 0.163714E+01
+ PKER_RDRYG( 3, 22) = 0.168256E+01
+ PKER_RDRYG( 3, 23) = 0.171982E+01
+ PKER_RDRYG( 3, 24) = 0.175040E+01
+ PKER_RDRYG( 3, 25) = 0.177553E+01
+ PKER_RDRYG( 3, 26) = 0.179619E+01
+ PKER_RDRYG( 3, 27) = 0.181318E+01
+ PKER_RDRYG( 3, 28) = 0.182717E+01
+ PKER_RDRYG( 3, 29) = 0.183869E+01
+ PKER_RDRYG( 3, 30) = 0.184817E+01
+ PKER_RDRYG( 3, 31) = 0.185599E+01
+ PKER_RDRYG( 3, 32) = 0.186244E+01
+ PKER_RDRYG( 3, 33) = 0.186775E+01
+ PKER_RDRYG( 3, 34) = 0.187213E+01
+ PKER_RDRYG( 3, 35) = 0.187575E+01
+ PKER_RDRYG( 3, 36) = 0.187873E+01
+ PKER_RDRYG( 3, 37) = 0.188119E+01
+ PKER_RDRYG( 3, 38) = 0.188322E+01
+ PKER_RDRYG( 3, 39) = 0.188490E+01
+ PKER_RDRYG( 3, 40) = 0.188628E+01
+ PKER_RDRYG( 4, 1) = 0.124632E+02
+ PKER_RDRYG( 4, 2) = 0.100363E+02
+ PKER_RDRYG( 4, 3) = 0.801781E+01
+ PKER_RDRYG( 4, 4) = 0.633828E+01
+ PKER_RDRYG( 4, 5) = 0.494183E+01
+ PKER_RDRYG( 4, 6) = 0.378510E+01
+ PKER_RDRYG( 4, 7) = 0.283672E+01
+ PKER_RDRYG( 4, 8) = 0.207666E+01
+ PKER_RDRYG( 4, 9) = 0.149363E+01
+ PKER_RDRYG( 4, 10) = 0.108052E+01
+ PKER_RDRYG( 4, 11) = 0.825432E+00
+ PKER_RDRYG( 4, 12) = 0.708049E+00
+ PKER_RDRYG( 4, 13) = 0.696559E+00
+ PKER_RDRYG( 4, 14) = 0.755465E+00
+ PKER_RDRYG( 4, 15) = 0.851164E+00
+ PKER_RDRYG( 4, 16) = 0.958922E+00
+ PKER_RDRYG( 4, 17) = 0.106351E+01
+ PKER_RDRYG( 4, 18) = 0.115725E+01
+ PKER_RDRYG( 4, 19) = 0.123777E+01
+ PKER_RDRYG( 4, 20) = 0.130532E+01
+ PKER_RDRYG( 4, 21) = 0.136125E+01
+ PKER_RDRYG( 4, 22) = 0.140726E+01
+ PKER_RDRYG( 4, 23) = 0.144501E+01
+ PKER_RDRYG( 4, 24) = 0.147597E+01
+ PKER_RDRYG( 4, 25) = 0.150139E+01
+ PKER_RDRYG( 4, 26) = 0.152226E+01
+ PKER_RDRYG( 4, 27) = 0.153942E+01
+ PKER_RDRYG( 4, 28) = 0.155353E+01
+ PKER_RDRYG( 4, 29) = 0.156515E+01
+ PKER_RDRYG( 4, 30) = 0.157471E+01
+ PKER_RDRYG( 4, 31) = 0.158259E+01
+ PKER_RDRYG( 4, 32) = 0.158908E+01
+ PKER_RDRYG( 4, 33) = 0.159443E+01
+ PKER_RDRYG( 4, 34) = 0.159884E+01
+ PKER_RDRYG( 4, 35) = 0.160248E+01
+ PKER_RDRYG( 4, 36) = 0.160548E+01
+ PKER_RDRYG( 4, 37) = 0.160795E+01
+ PKER_RDRYG( 4, 38) = 0.160999E+01
+ PKER_RDRYG( 4, 39) = 0.161168E+01
+ PKER_RDRYG( 4, 40) = 0.161307E+01
+ PKER_RDRYG( 5, 1) = 0.127090E+02
+ PKER_RDRYG( 5, 2) = 0.102910E+02
+ PKER_RDRYG( 5, 3) = 0.828132E+01
+ PKER_RDRYG( 5, 4) = 0.660967E+01
+ PKER_RDRYG( 5, 5) = 0.521858E+01
+ PKER_RDRYG( 5, 6) = 0.406200E+01
+ PKER_RDRYG( 5, 7) = 0.310443E+01
+ PKER_RDRYG( 5, 8) = 0.232064E+01
+ PKER_RDRYG( 5, 9) = 0.169464E+01
+ PKER_RDRYG( 5, 10) = 0.121813E+01
+ PKER_RDRYG( 5, 11) = 0.885289E+00
+ PKER_RDRYG( 5, 12) = 0.684884E+00
+ PKER_RDRYG( 5, 13) = 0.598972E+00
+ PKER_RDRYG( 5, 14) = 0.599848E+00
+ PKER_RDRYG( 5, 15) = 0.656194E+00
+ PKER_RDRYG( 5, 16) = 0.740930E+00
+ PKER_RDRYG( 5, 17) = 0.833644E+00
+ PKER_RDRYG( 5, 18) = 0.922189E+00
+ PKER_RDRYG( 5, 19) = 0.100097E+01
+ PKER_RDRYG( 5, 20) = 0.106830E+01
+ PKER_RDRYG( 5, 21) = 0.112462E+01
+ PKER_RDRYG( 5, 22) = 0.117119E+01
+ PKER_RDRYG( 5, 23) = 0.120946E+01
+ PKER_RDRYG( 5, 24) = 0.124084E+01
+ PKER_RDRYG( 5, 25) = 0.126657E+01
+ PKER_RDRYG( 5, 26) = 0.128769E+01
+ PKER_RDRYG( 5, 27) = 0.130503E+01
+ PKER_RDRYG( 5, 28) = 0.131929E+01
+ PKER_RDRYG( 5, 29) = 0.133101E+01
+ PKER_RDRYG( 5, 30) = 0.134066E+01
+ PKER_RDRYG( 5, 31) = 0.134860E+01
+ PKER_RDRYG( 5, 32) = 0.135514E+01
+ PKER_RDRYG( 5, 33) = 0.136053E+01
+ PKER_RDRYG( 5, 34) = 0.136497E+01
+ PKER_RDRYG( 5, 35) = 0.136863E+01
+ PKER_RDRYG( 5, 36) = 0.137165E+01
+ PKER_RDRYG( 5, 37) = 0.137413E+01
+ PKER_RDRYG( 5, 38) = 0.137619E+01
+ PKER_RDRYG( 5, 39) = 0.137788E+01
+ PKER_RDRYG( 5, 40) = 0.137928E+01
+ PKER_RDRYG( 6, 1) = 0.129097E+02
+ PKER_RDRYG( 6, 2) = 0.104988E+02
+ PKER_RDRYG( 6, 3) = 0.849661E+01
+ PKER_RDRYG( 6, 4) = 0.683241E+01
+ PKER_RDRYG( 6, 5) = 0.544798E+01
+ PKER_RDRYG( 6, 6) = 0.429580E+01
+ PKER_RDRYG( 6, 7) = 0.333794E+01
+ PKER_RDRYG( 6, 8) = 0.254535E+01
+ PKER_RDRYG( 6, 9) = 0.189760E+01
+ PKER_RDRYG( 6, 10) = 0.138256E+01
+ PKER_RDRYG( 6, 11) = 0.993749E+00
+ PKER_RDRYG( 6, 12) = 0.725579E+00
+ PKER_RDRYG( 6, 13) = 0.569771E+00
+ PKER_RDRYG( 6, 14) = 0.508215E+00
+ PKER_RDRYG( 6, 15) = 0.517364E+00
+ PKER_RDRYG( 6, 16) = 0.570603E+00
+ PKER_RDRYG( 6, 17) = 0.645018E+00
+ PKER_RDRYG( 6, 18) = 0.724433E+00
+ PKER_RDRYG( 6, 19) = 0.799323E+00
+ PKER_RDRYG( 6, 20) = 0.865437E+00
+ PKER_RDRYG( 6, 21) = 0.921727E+00
+ PKER_RDRYG( 6, 22) = 0.968693E+00
+ PKER_RDRYG( 6, 23) = 0.100746E+01
+ PKER_RDRYG( 6, 24) = 0.103929E+01
+ PKER_RDRYG( 6, 25) = 0.106538E+01
+ PKER_RDRYG( 6, 26) = 0.108677E+01
+ PKER_RDRYG( 6, 27) = 0.110432E+01
+ PKER_RDRYG( 6, 28) = 0.111873E+01
+ PKER_RDRYG( 6, 29) = 0.113057E+01
+ PKER_RDRYG( 6, 30) = 0.114031E+01
+ PKER_RDRYG( 6, 31) = 0.114832E+01
+ PKER_RDRYG( 6, 32) = 0.115492E+01
+ PKER_RDRYG( 6, 33) = 0.116035E+01
+ PKER_RDRYG( 6, 34) = 0.116482E+01
+ PKER_RDRYG( 6, 35) = 0.116851E+01
+ PKER_RDRYG( 6, 36) = 0.117155E+01
+ PKER_RDRYG( 6, 37) = 0.117405E+01
+ PKER_RDRYG( 6, 38) = 0.117612E+01
+ PKER_RDRYG( 6, 39) = 0.117782E+01
+ PKER_RDRYG( 6, 40) = 0.117923E+01
+ PKER_RDRYG( 7, 1) = 0.130737E+02
+ PKER_RDRYG( 7, 2) = 0.106684E+02
+ PKER_RDRYG( 7, 3) = 0.867226E+01
+ PKER_RDRYG( 7, 4) = 0.701442E+01
+ PKER_RDRYG( 7, 5) = 0.563630E+01
+ PKER_RDRYG( 7, 6) = 0.448972E+01
+ PKER_RDRYG( 7, 7) = 0.353543E+01
+ PKER_RDRYG( 7, 8) = 0.274218E+01
+ PKER_RDRYG( 7, 9) = 0.208626E+01
+ PKER_RDRYG( 7, 10) = 0.155134E+01
+ PKER_RDRYG( 7, 11) = 0.112782E+01
+ PKER_RDRYG( 7, 12) = 0.810984E+00
+ PKER_RDRYG( 7, 13) = 0.596204E+00
+ PKER_RDRYG( 7, 14) = 0.475108E+00
+ PKER_RDRYG( 7, 15) = 0.432596E+00
+ PKER_RDRYG( 7, 16) = 0.446915E+00
+ PKER_RDRYG( 7, 17) = 0.496175E+00
+ PKER_RDRYG( 7, 18) = 0.561308E+00
+ PKER_RDRYG( 7, 19) = 0.629230E+00
+ PKER_RDRYG( 7, 20) = 0.692507E+00
+ PKER_RDRYG( 7, 21) = 0.747991E+00
+ PKER_RDRYG( 7, 22) = 0.795023E+00
+ PKER_RDRYG( 7, 23) = 0.834178E+00
+ PKER_RDRYG( 7, 24) = 0.866452E+00
+ PKER_RDRYG( 7, 25) = 0.892928E+00
+ PKER_RDRYG( 7, 26) = 0.914619E+00
+ PKER_RDRYG( 7, 27) = 0.932399E+00
+ PKER_RDRYG( 7, 28) = 0.946986E+00
+ PKER_RDRYG( 7, 29) = 0.958962E+00
+ PKER_RDRYG( 7, 30) = 0.968803E+00
+ PKER_RDRYG( 7, 31) = 0.976894E+00
+ PKER_RDRYG( 7, 32) = 0.983549E+00
+ PKER_RDRYG( 7, 33) = 0.989027E+00
+ PKER_RDRYG( 7, 34) = 0.993537E+00
+ PKER_RDRYG( 7, 35) = 0.997252E+00
+ PKER_RDRYG( 7, 36) = 0.100031E+01
+ PKER_RDRYG( 7, 37) = 0.100283E+01
+ PKER_RDRYG( 7, 38) = 0.100491E+01
+ PKER_RDRYG( 7, 39) = 0.100663E+01
+ PKER_RDRYG( 7, 40) = 0.100804E+01
+ PKER_RDRYG( 8, 1) = 0.132082E+02
+ PKER_RDRYG( 8, 2) = 0.108071E+02
+ PKER_RDRYG( 8, 3) = 0.881568E+01
+ PKER_RDRYG( 8, 4) = 0.716294E+01
+ PKER_RDRYG( 8, 5) = 0.579021E+01
+ PKER_RDRYG( 8, 6) = 0.464898E+01
+ PKER_RDRYG( 8, 7) = 0.369939E+01
+ PKER_RDRYG( 8, 8) = 0.290901E+01
+ PKER_RDRYG( 8, 9) = 0.225210E+01
+ PKER_RDRYG( 8, 10) = 0.170938E+01
+ PKER_RDRYG( 8, 11) = 0.126773E+01
+ PKER_RDRYG( 8, 12) = 0.919865E+00
+ PKER_RDRYG( 8, 13) = 0.661937E+00
+ PKER_RDRYG( 8, 14) = 0.490415E+00
+ PKER_RDRYG( 8, 15) = 0.397339E+00
+ PKER_RDRYG( 8, 16) = 0.368774E+00
+ PKER_RDRYG( 8, 17) = 0.386541E+00
+ PKER_RDRYG( 8, 18) = 0.431586E+00
+ PKER_RDRYG( 8, 19) = 0.488388E+00
+ PKER_RDRYG( 8, 20) = 0.546326E+00
+ PKER_RDRYG( 8, 21) = 0.599722E+00
+ PKER_RDRYG( 8, 22) = 0.646234E+00
+ PKER_RDRYG( 8, 23) = 0.685535E+00
+ PKER_RDRYG( 8, 24) = 0.718173E+00
+ PKER_RDRYG( 8, 25) = 0.745040E+00
+ PKER_RDRYG( 8, 26) = 0.767064E+00
+ PKER_RDRYG( 8, 27) = 0.785101E+00
+ PKER_RDRYG( 8, 28) = 0.799883E+00
+ PKER_RDRYG( 8, 29) = 0.812008E+00
+ PKER_RDRYG( 8, 30) = 0.821962E+00
+ PKER_RDRYG( 8, 31) = 0.830140E+00
+ PKER_RDRYG( 8, 32) = 0.836862E+00
+ PKER_RDRYG( 8, 33) = 0.842391E+00
+ PKER_RDRYG( 8, 34) = 0.846941E+00
+ PKER_RDRYG( 8, 35) = 0.850687E+00
+ PKER_RDRYG( 8, 36) = 0.853771E+00
+ PKER_RDRYG( 8, 37) = 0.856313E+00
+ PKER_RDRYG( 8, 38) = 0.858406E+00
+ PKER_RDRYG( 8, 39) = 0.860132E+00
+ PKER_RDRYG( 8, 40) = 0.861555E+00
+ PKER_RDRYG( 9, 1) = 0.133186E+02
+ PKER_RDRYG( 9, 2) = 0.109208E+02
+ PKER_RDRYG( 9, 3) = 0.893300E+01
+ PKER_RDRYG( 9, 4) = 0.728424E+01
+ PKER_RDRYG( 9, 5) = 0.591582E+01
+ PKER_RDRYG( 9, 6) = 0.477915E+01
+ PKER_RDRYG( 9, 7) = 0.383409E+01
+ PKER_RDRYG( 9, 8) = 0.304764E+01
+ PKER_RDRYG( 9, 9) = 0.239303E+01
+ PKER_RDRYG( 9, 10) = 0.184909E+01
+ PKER_RDRYG( 9, 11) = 0.140008E+01
+ PKER_RDRYG( 9, 12) = 0.103570E+01
+ PKER_RDRYG( 9, 13) = 0.750184E+00
+ PKER_RDRYG( 9, 14) = 0.540583E+00
+ PKER_RDRYG( 9, 15) = 0.404171E+00
+ PKER_RDRYG( 9, 16) = 0.333201E+00
+ PKER_RDRYG( 9, 17) = 0.315421E+00
+ PKER_RDRYG( 9, 18) = 0.334832E+00
+ PKER_RDRYG( 9, 19) = 0.375550E+00
+ PKER_RDRYG( 9, 20) = 0.424785E+00
+ PKER_RDRYG( 9, 21) = 0.474129E+00
+ PKER_RDRYG( 9, 22) = 0.519143E+00
+ PKER_RDRYG( 9, 23) = 0.558133E+00
+ PKER_RDRYG( 9, 24) = 0.590954E+00
+ PKER_RDRYG( 9, 25) = 0.618160E+00
+ PKER_RDRYG( 9, 26) = 0.640526E+00
+ PKER_RDRYG( 9, 27) = 0.658847E+00
+ PKER_RDRYG( 9, 28) = 0.673848E+00
+ PKER_RDRYG( 9, 29) = 0.686139E+00
+ PKER_RDRYG( 9, 30) = 0.696219E+00
+ PKER_RDRYG( 9, 31) = 0.704493E+00
+ PKER_RDRYG( 9, 32) = 0.711289E+00
+ PKER_RDRYG( 9, 33) = 0.716875E+00
+ PKER_RDRYG( 9, 34) = 0.721469E+00
+ PKER_RDRYG( 9, 35) = 0.725249E+00
+ PKER_RDRYG( 9, 36) = 0.728360E+00
+ PKER_RDRYG( 9, 37) = 0.730922E+00
+ PKER_RDRYG( 9, 38) = 0.733032E+00
+ PKER_RDRYG( 9, 39) = 0.734770E+00
+ PKER_RDRYG( 9, 40) = 0.736203E+00
+ PKER_RDRYG( 10, 1) = 0.134097E+02
+ PKER_RDRYG( 10, 2) = 0.110143E+02
+ PKER_RDRYG( 10, 3) = 0.902922E+01
+ PKER_RDRYG( 10, 4) = 0.738349E+01
+ PKER_RDRYG( 10, 5) = 0.601843E+01
+ PKER_RDRYG( 10, 6) = 0.488542E+01
+ PKER_RDRYG( 10, 7) = 0.394421E+01
+ PKER_RDRYG( 10, 8) = 0.316159E+01
+ PKER_RDRYG( 10, 9) = 0.251025E+01
+ PKER_RDRYG( 10, 10) = 0.196809E+01
+ PKER_RDRYG( 10, 11) = 0.151773E+01
+ PKER_RDRYG( 10, 12) = 0.114640E+01
+ PKER_RDRYG( 10, 13) = 0.845862E+00
+ PKER_RDRYG( 10, 14) = 0.611819E+00
+ PKER_RDRYG( 10, 15) = 0.442230E+00
+ PKER_RDRYG( 10, 16) = 0.333761E+00
+ PKER_RDRYG( 10, 17) = 0.280176E+00
+ PKER_RDRYG( 10, 18) = 0.270205E+00
+ PKER_RDRYG( 10, 19) = 0.290267E+00
+ PKER_RDRYG( 10, 20) = 0.326785E+00
+ PKER_RDRYG( 10, 21) = 0.369349E+00
+ PKER_RDRYG( 10, 22) = 0.411304E+00
+ PKER_RDRYG( 10, 23) = 0.449213E+00
+ PKER_RDRYG( 10, 24) = 0.481873E+00
+ PKER_RDRYG( 10, 25) = 0.509282E+00
+ PKER_RDRYG( 10, 26) = 0.531958E+00
+ PKER_RDRYG( 10, 27) = 0.550577E+00
+ PKER_RDRYG( 10, 28) = 0.565820E+00
+ PKER_RDRYG( 10, 29) = 0.578297E+00
+ PKER_RDRYG( 10, 30) = 0.588518E+00
+ PKER_RDRYG( 10, 31) = 0.596899E+00
+ PKER_RDRYG( 10, 32) = 0.603778E+00
+ PKER_RDRYG( 10, 33) = 0.609427E+00
+ PKER_RDRYG( 10, 34) = 0.614069E+00
+ PKER_RDRYG( 10, 35) = 0.617886E+00
+ PKER_RDRYG( 10, 36) = 0.621027E+00
+ PKER_RDRYG( 10, 37) = 0.623611E+00
+ PKER_RDRYG( 10, 38) = 0.625739E+00
+ PKER_RDRYG( 10, 39) = 0.627491E+00
+ PKER_RDRYG( 10, 40) = 0.628935E+00
+ PKER_RDRYG( 11, 1) = 0.134850E+02
+ PKER_RDRYG( 11, 2) = 0.110914E+02
+ PKER_RDRYG( 11, 3) = 0.910837E+01
+ PKER_RDRYG( 11, 4) = 0.746493E+01
+ PKER_RDRYG( 11, 5) = 0.610242E+01
+ PKER_RDRYG( 11, 6) = 0.497224E+01
+ PKER_RDRYG( 11, 7) = 0.403413E+01
+ PKER_RDRYG( 11, 8) = 0.325477E+01
+ PKER_RDRYG( 11, 9) = 0.260666E+01
+ PKER_RDRYG( 11, 10) = 0.206723E+01
+ PKER_RDRYG( 11, 11) = 0.161821E+01
+ PKER_RDRYG( 11, 12) = 0.124536E+01
+ PKER_RDRYG( 11, 13) = 0.938357E+00
+ PKER_RDRYG( 11, 14) = 0.690647E+00
+ PKER_RDRYG( 11, 15) = 0.499022E+00
+ PKER_RDRYG( 11, 16) = 0.361814E+00
+ PKER_RDRYG( 11, 17) = 0.276145E+00
+ PKER_RDRYG( 11, 18) = 0.236136E+00
+ PKER_RDRYG( 11, 19) = 0.232058E+00
+ PKER_RDRYG( 11, 20) = 0.251803E+00
+ PKER_RDRYG( 11, 21) = 0.284322E+00
+ PKER_RDRYG( 11, 22) = 0.321029E+00
+ PKER_RDRYG( 11, 23) = 0.356649E+00
+ PKER_RDRYG( 11, 24) = 0.388551E+00
+ PKER_RDRYG( 11, 25) = 0.415898E+00
+ PKER_RDRYG( 11, 26) = 0.438783E+00
+ PKER_RDRYG( 11, 27) = 0.457681E+00
+ PKER_RDRYG( 11, 28) = 0.473182E+00
+ PKER_RDRYG( 11, 29) = 0.485865E+00
+ PKER_RDRYG( 11, 30) = 0.496243E+00
+ PKER_RDRYG( 11, 31) = 0.504744E+00
+ PKER_RDRYG( 11, 32) = 0.511714E+00
+ PKER_RDRYG( 11, 33) = 0.517433E+00
+ PKER_RDRYG( 11, 34) = 0.522129E+00
+ PKER_RDRYG( 11, 35) = 0.525987E+00
+ PKER_RDRYG( 11, 36) = 0.529160E+00
+ PKER_RDRYG( 11, 37) = 0.531769E+00
+ PKER_RDRYG( 11, 38) = 0.533916E+00
+ PKER_RDRYG( 11, 39) = 0.535683E+00
+ PKER_RDRYG( 11, 40) = 0.537138E+00
+ PKER_RDRYG( 12, 1) = 0.135474E+02
+ PKER_RDRYG( 12, 2) = 0.111552E+02
+ PKER_RDRYG( 12, 3) = 0.917366E+01
+ PKER_RDRYG( 12, 4) = 0.753194E+01
+ PKER_RDRYG( 12, 5) = 0.617136E+01
+ PKER_RDRYG( 12, 6) = 0.504334E+01
+ PKER_RDRYG( 12, 7) = 0.410762E+01
+ PKER_RDRYG( 12, 8) = 0.333087E+01
+ PKER_RDRYG( 12, 9) = 0.268553E+01
+ PKER_RDRYG( 12, 10) = 0.214881E+01
+ PKER_RDRYG( 12, 11) = 0.170205E+01
+ PKER_RDRYG( 12, 12) = 0.133020E+01
+ PKER_RDRYG( 12, 13) = 0.102155E+01
+ PKER_RDRYG( 12, 14) = 0.767749E+00
+ PKER_RDRYG( 12, 15) = 0.563744E+00
+ PKER_RDRYG( 12, 16) = 0.407094E+00
+ PKER_RDRYG( 12, 17) = 0.296271E+00
+ PKER_RDRYG( 12, 18) = 0.229046E+00
+ PKER_RDRYG( 12, 19) = 0.199698E+00
+ PKER_RDRYG( 12, 20) = 0.199640E+00
+ PKER_RDRYG( 12, 21) = 0.218639E+00
+ PKER_RDRYG( 12, 22) = 0.247374E+00
+ PKER_RDRYG( 12, 23) = 0.278945E+00
+ PKER_RDRYG( 12, 24) = 0.309121E+00
+ PKER_RDRYG( 12, 25) = 0.335948E+00
+ PKER_RDRYG( 12, 26) = 0.358842E+00
+ PKER_RDRYG( 12, 27) = 0.377946E+00
+ PKER_RDRYG( 12, 28) = 0.393696E+00
+ PKER_RDRYG( 12, 29) = 0.406601E+00
+ PKER_RDRYG( 12, 30) = 0.417155E+00
+ PKER_RDRYG( 12, 31) = 0.425790E+00
+ PKER_RDRYG( 12, 32) = 0.432861E+00
+ PKER_RDRYG( 12, 33) = 0.438657E+00
+ PKER_RDRYG( 12, 34) = 0.443413E+00
+ PKER_RDRYG( 12, 35) = 0.447317E+00
+ PKER_RDRYG( 12, 36) = 0.450524E+00
+ PKER_RDRYG( 12, 37) = 0.453161E+00
+ PKER_RDRYG( 12, 38) = 0.455329E+00
+ PKER_RDRYG( 12, 39) = 0.457113E+00
+ PKER_RDRYG( 12, 40) = 0.458581E+00
+ PKER_RDRYG( 13, 1) = 0.135992E+02
+ PKER_RDRYG( 13, 2) = 0.112081E+02
+ PKER_RDRYG( 13, 3) = 0.922768E+01
+ PKER_RDRYG( 13, 4) = 0.758724E+01
+ PKER_RDRYG( 13, 5) = 0.622811E+01
+ PKER_RDRYG( 13, 6) = 0.510171E+01
+ PKER_RDRYG( 13, 7) = 0.416780E+01
+ PKER_RDRYG( 13, 8) = 0.339309E+01
+ PKER_RDRYG( 13, 9) = 0.274995E+01
+ PKER_RDRYG( 13, 10) = 0.221557E+01
+ PKER_RDRYG( 13, 11) = 0.177110E+01
+ PKER_RDRYG( 13, 12) = 0.140110E+01
+ PKER_RDRYG( 13, 13) = 0.109315E+01
+ PKER_RDRYG( 13, 14) = 0.837695E+00
+ PKER_RDRYG( 13, 15) = 0.628007E+00
+ PKER_RDRYG( 13, 16) = 0.460064E+00
+ PKER_RDRYG( 13, 17) = 0.332147E+00
+ PKER_RDRYG( 13, 18) = 0.242993E+00
+ PKER_RDRYG( 13, 19) = 0.190382E+00
+ PKER_RDRYG( 13, 20) = 0.169340E+00
+ PKER_RDRYG( 13, 21) = 0.172021E+00
+ PKER_RDRYG( 13, 22) = 0.189920E+00
+ PKER_RDRYG( 13, 23) = 0.215196E+00
+ PKER_RDRYG( 13, 24) = 0.242255E+00
+ PKER_RDRYG( 13, 25) = 0.267812E+00
+ PKER_RDRYG( 13, 26) = 0.290361E+00
+ PKER_RDRYG( 13, 27) = 0.309517E+00
+ PKER_RDRYG( 13, 28) = 0.325465E+00
+ PKER_RDRYG( 13, 29) = 0.338590E+00
+ PKER_RDRYG( 13, 30) = 0.349335E+00
+ PKER_RDRYG( 13, 31) = 0.358118E+00
+ PKER_RDRYG( 13, 32) = 0.365303E+00
+ PKER_RDRYG( 13, 33) = 0.371186E+00
+ PKER_RDRYG( 13, 34) = 0.376007E+00
+ PKER_RDRYG( 13, 35) = 0.379962E+00
+ PKER_RDRYG( 13, 36) = 0.383208E+00
+ PKER_RDRYG( 13, 37) = 0.385875E+00
+ PKER_RDRYG( 13, 38) = 0.388066E+00
+ PKER_RDRYG( 13, 39) = 0.389868E+00
+ PKER_RDRYG( 13, 40) = 0.391351E+00
+ PKER_RDRYG( 14, 1) = 0.136424E+02
+ PKER_RDRYG( 14, 2) = 0.112520E+02
+ PKER_RDRYG( 14, 3) = 0.927249E+01
+ PKER_RDRYG( 14, 4) = 0.763302E+01
+ PKER_RDRYG( 14, 5) = 0.627497E+01
+ PKER_RDRYG( 14, 6) = 0.514978E+01
+ PKER_RDRYG( 14, 7) = 0.421724E+01
+ PKER_RDRYG( 14, 8) = 0.344405E+01
+ PKER_RDRYG( 14, 9) = 0.280263E+01
+ PKER_RDRYG( 14, 10) = 0.227012E+01
+ PKER_RDRYG( 14, 11) = 0.182762E+01
+ PKER_RDRYG( 14, 12) = 0.145954E+01
+ PKER_RDRYG( 14, 13) = 0.115311E+01
+ PKER_RDRYG( 14, 14) = 0.898099E+00
+ PKER_RDRYG( 14, 15) = 0.686697E+00
+ PKER_RDRYG( 14, 16) = 0.513492E+00
+ PKER_RDRYG( 14, 17) = 0.375385E+00
+ PKER_RDRYG( 14, 18) = 0.270975E+00
+ PKER_RDRYG( 14, 19) = 0.199521E+00
+ PKER_RDRYG( 14, 20) = 0.158655E+00
+ PKER_RDRYG( 14, 21) = 0.143819E+00
+ PKER_RDRYG( 14, 22) = 0.148448E+00
+ PKER_RDRYG( 14, 23) = 0.165031E+00
+ PKER_RDRYG( 14, 24) = 0.187175E+00
+ PKER_RDRYG( 14, 25) = 0.210331E+00
+ PKER_RDRYG( 14, 26) = 0.231936E+00
+ PKER_RDRYG( 14, 27) = 0.250868E+00
+ PKER_RDRYG( 14, 28) = 0.266895E+00
+ PKER_RDRYG( 14, 29) = 0.280204E+00
+ PKER_RDRYG( 14, 30) = 0.291143E+00
+ PKER_RDRYG( 14, 31) = 0.300090E+00
+ PKER_RDRYG( 14, 32) = 0.307401E+00
+ PKER_RDRYG( 14, 33) = 0.313380E+00
+ PKER_RDRYG( 14, 34) = 0.318275E+00
+ PKER_RDRYG( 14, 35) = 0.322286E+00
+ PKER_RDRYG( 14, 36) = 0.325575E+00
+ PKER_RDRYG( 14, 37) = 0.328275E+00
+ PKER_RDRYG( 14, 38) = 0.330492E+00
+ PKER_RDRYG( 14, 39) = 0.332314E+00
+ PKER_RDRYG( 14, 40) = 0.333811E+00
+ PKER_RDRYG( 15, 1) = 0.136784E+02
+ PKER_RDRYG( 15, 2) = 0.112886E+02
+ PKER_RDRYG( 15, 3) = 0.930976E+01
+ PKER_RDRYG( 15, 4) = 0.767102E+01
+ PKER_RDRYG( 15, 5) = 0.631377E+01
+ PKER_RDRYG( 15, 6) = 0.518948E+01
+ PKER_RDRYG( 15, 7) = 0.425797E+01
+ PKER_RDRYG( 15, 8) = 0.348593E+01
+ PKER_RDRYG( 15, 9) = 0.284580E+01
+ PKER_RDRYG( 15, 10) = 0.231474E+01
+ PKER_RDRYG( 15, 11) = 0.187382E+01
+ PKER_RDRYG( 15, 12) = 0.150740E+01
+ PKER_RDRYG( 15, 13) = 0.120258E+01
+ PKER_RDRYG( 15, 14) = 0.948799E+00
+ PKER_RDRYG( 15, 15) = 0.737641E+00
+ PKER_RDRYG( 15, 16) = 0.562720E+00
+ PKER_RDRYG( 15, 17) = 0.419730E+00
+ PKER_RDRYG( 15, 18) = 0.306247E+00
+ PKER_RDRYG( 15, 19) = 0.221265E+00
+ PKER_RDRYG( 15, 20) = 0.164088E+00
+ PKER_RDRYG( 15, 21) = 0.132562E+00
+ PKER_RDRYG( 15, 22) = 0.122598E+00
+ PKER_RDRYG( 15, 23) = 0.128315E+00
+ PKER_RDRYG( 15, 24) = 0.143469E+00
+ PKER_RDRYG( 15, 25) = 0.162742E+00
+ PKER_RDRYG( 15, 26) = 0.182528E+00
+ PKER_RDRYG( 15, 27) = 0.200775E+00
+ PKER_RDRYG( 15, 28) = 0.216671E+00
+ PKER_RDRYG( 15, 29) = 0.230077E+00
+ PKER_RDRYG( 15, 30) = 0.241184E+00
+ PKER_RDRYG( 15, 31) = 0.250299E+00
+ PKER_RDRYG( 15, 32) = 0.257750E+00
+ PKER_RDRYG( 15, 33) = 0.263837E+00
+ PKER_RDRYG( 15, 34) = 0.268813E+00
+ PKER_RDRYG( 15, 35) = 0.272887E+00
+ PKER_RDRYG( 15, 36) = 0.276224E+00
+ PKER_RDRYG( 15, 37) = 0.278960E+00
+ PKER_RDRYG( 15, 38) = 0.281205E+00
+ PKER_RDRYG( 15, 39) = 0.283049E+00
+ PKER_RDRYG( 15, 40) = 0.284564E+00
+ PKER_RDRYG( 16, 1) = 0.137085E+02
+ PKER_RDRYG( 16, 2) = 0.113192E+02
+ PKER_RDRYG( 16, 3) = 0.934083E+01
+ PKER_RDRYG( 16, 4) = 0.770263E+01
+ PKER_RDRYG( 16, 5) = 0.634599E+01
+ PKER_RDRYG( 16, 6) = 0.522238E+01
+ PKER_RDRYG( 16, 7) = 0.429162E+01
+ PKER_RDRYG( 16, 8) = 0.352045E+01
+ PKER_RDRYG( 16, 9) = 0.288129E+01
+ PKER_RDRYG( 16, 10) = 0.235131E+01
+ PKER_RDRYG( 16, 11) = 0.191162E+01
+ PKER_RDRYG( 16, 12) = 0.154654E+01
+ PKER_RDRYG( 16, 13) = 0.124312E+01
+ PKER_RDRYG( 16, 14) = 0.990681E+00
+ PKER_RDRYG( 16, 15) = 0.780510E+00
+ PKER_RDRYG( 16, 16) = 0.605678E+00
+ PKER_RDRYG( 16, 17) = 0.460987E+00
+ PKER_RDRYG( 16, 18) = 0.342972E+00
+ PKER_RDRYG( 16, 19) = 0.249819E+00
+ PKER_RDRYG( 16, 20) = 0.180844E+00
+ PKER_RDRYG( 16, 21) = 0.135165E+00
+ PKER_RDRYG( 16, 22) = 0.111031E+00
+ PKER_RDRYG( 16, 23) = 0.104672E+00
+ PKER_RDRYG( 16, 24) = 0.110998E+00
+ PKER_RDRYG( 16, 25) = 0.124724E+00
+ PKER_RDRYG( 16, 26) = 0.141478E+00
+ PKER_RDRYG( 16, 27) = 0.158331E+00
+ PKER_RDRYG( 16, 28) = 0.173737E+00
+ PKER_RDRYG( 16, 29) = 0.187074E+00
+ PKER_RDRYG( 16, 30) = 0.198283E+00
+ PKER_RDRYG( 16, 31) = 0.207552E+00
+ PKER_RDRYG( 16, 32) = 0.215149E+00
+ PKER_RDRYG( 16, 33) = 0.221354E+00
+ PKER_RDRYG( 16, 34) = 0.226422E+00
+ PKER_RDRYG( 16, 35) = 0.230565E+00
+ PKER_RDRYG( 16, 36) = 0.233955E+00
+ PKER_RDRYG( 16, 37) = 0.236732E+00
+ PKER_RDRYG( 16, 38) = 0.239008E+00
+ PKER_RDRYG( 16, 39) = 0.240876E+00
+ PKER_RDRYG( 16, 40) = 0.242409E+00
+ PKER_RDRYG( 17, 1) = 0.137338E+02
+ PKER_RDRYG( 17, 2) = 0.113448E+02
+ PKER_RDRYG( 17, 3) = 0.936679E+01
+ PKER_RDRYG( 17, 4) = 0.772900E+01
+ PKER_RDRYG( 17, 5) = 0.637281E+01
+ PKER_RDRYG( 17, 6) = 0.524971E+01
+ PKER_RDRYG( 17, 7) = 0.431952E+01
+ PKER_RDRYG( 17, 8) = 0.354898E+01
+ PKER_RDRYG( 17, 9) = 0.291054E+01
+ PKER_RDRYG( 17, 10) = 0.238139E+01
+ PKER_RDRYG( 17, 11) = 0.194261E+01
+ PKER_RDRYG( 17, 12) = 0.157857E+01
+ PKER_RDRYG( 17, 13) = 0.127628E+01
+ PKER_RDRYG( 17, 14) = 0.102502E+01
+ PKER_RDRYG( 17, 15) = 0.815970E+00
+ PKER_RDRYG( 17, 16) = 0.641917E+00
+ PKER_RDRYG( 17, 17) = 0.497171E+00
+ PKER_RDRYG( 17, 18) = 0.377507E+00
+ PKER_RDRYG( 17, 19) = 0.280172E+00
+ PKER_RDRYG( 17, 20) = 0.203787E+00
+ PKER_RDRYG( 17, 21) = 0.147769E+00
+ PKER_RDRYG( 17, 22) = 0.111528E+00
+ PKER_RDRYG( 17, 23) = 0.932152E-01
+ PKER_RDRYG( 17, 24) = 0.895799E-01
+ PKER_RDRYG( 17, 25) = 0.961438E-01
+ PKER_RDRYG( 17, 26) = 0.108454E+00
+ PKER_RDRYG( 17, 27) = 0.122945E+00
+ PKER_RDRYG( 17, 28) = 0.137295E+00
+ PKER_RDRYG( 17, 29) = 0.150279E+00
+ PKER_RDRYG( 17, 30) = 0.161465E+00
+ PKER_RDRYG( 17, 31) = 0.170838E+00
+ PKER_RDRYG( 17, 32) = 0.178572E+00
+ PKER_RDRYG( 17, 33) = 0.184904E+00
+ PKER_RDRYG( 17, 34) = 0.190073E+00
+ PKER_RDRYG( 17, 35) = 0.194293E+00
+ PKER_RDRYG( 17, 36) = 0.197742E+00
+ PKER_RDRYG( 17, 37) = 0.200564E+00
+ PKER_RDRYG( 17, 38) = 0.202875E+00
+ PKER_RDRYG( 17, 39) = 0.204769E+00
+ PKER_RDRYG( 17, 40) = 0.206323E+00
+ PKER_RDRYG( 18, 1) = 0.137549E+02
+ PKER_RDRYG( 18, 2) = 0.113662E+02
+ PKER_RDRYG( 18, 3) = 0.938851E+01
+ PKER_RDRYG( 18, 4) = 0.775103E+01
+ PKER_RDRYG( 18, 5) = 0.639519E+01
+ PKER_RDRYG( 18, 6) = 0.527247E+01
+ PKER_RDRYG( 18, 7) = 0.434271E+01
+ PKER_RDRYG( 18, 8) = 0.357264E+01
+ PKER_RDRYG( 18, 9) = 0.293474E+01
+ PKER_RDRYG( 18, 10) = 0.240619E+01
+ PKER_RDRYG( 18, 11) = 0.196810E+01
+ PKER_RDRYG( 18, 12) = 0.160484E+01
+ PKER_RDRYG( 18, 13) = 0.130342E+01
+ PKER_RDRYG( 18, 14) = 0.105312E+01
+ PKER_RDRYG( 18, 15) = 0.845066E+00
+ PKER_RDRYG( 18, 16) = 0.671939E+00
+ PKER_RDRYG( 18, 17) = 0.527804E+00
+ PKER_RDRYG( 18, 18) = 0.407977E+00
+ PKER_RDRYG( 18, 19) = 0.309030E+00
+ PKER_RDRYG( 18, 20) = 0.228800E+00
+ PKER_RDRYG( 18, 21) = 0.166244E+00
+ PKER_RDRYG( 18, 22) = 0.120903E+00
+ PKER_RDRYG( 18, 23) = 0.922202E-01
+ PKER_RDRYG( 18, 24) = 0.785293E-01
+ PKER_RDRYG( 18, 25) = 0.768302E-01
+ PKER_RDRYG( 18, 26) = 0.833242E-01
+ PKER_RDRYG( 18, 27) = 0.942918E-01
+ PKER_RDRYG( 18, 28) = 0.106809E+00
+ PKER_RDRYG( 18, 29) = 0.119000E+00
+ PKER_RDRYG( 18, 30) = 0.129941E+00
+ PKER_RDRYG( 18, 31) = 0.139320E+00
+ PKER_RDRYG( 18, 32) = 0.147155E+00
+ PKER_RDRYG( 18, 33) = 0.153608E+00
+ PKER_RDRYG( 18, 34) = 0.158885E+00
+ PKER_RDRYG( 18, 35) = 0.163191E+00
+ PKER_RDRYG( 18, 36) = 0.166706E+00
+ PKER_RDRYG( 18, 37) = 0.169578E+00
+ PKER_RDRYG( 18, 38) = 0.171928E+00
+ PKER_RDRYG( 18, 39) = 0.173851E+00
+ PKER_RDRYG( 18, 40) = 0.175428E+00
+ PKER_RDRYG( 19, 1) = 0.137727E+02
+ PKER_RDRYG( 19, 2) = 0.113842E+02
+ PKER_RDRYG( 19, 3) = 0.940672E+01
+ PKER_RDRYG( 19, 4) = 0.776948E+01
+ PKER_RDRYG( 19, 5) = 0.641390E+01
+ PKER_RDRYG( 19, 6) = 0.529147E+01
+ PKER_RDRYG( 19, 7) = 0.436202E+01
+ PKER_RDRYG( 19, 8) = 0.359232E+01
+ PKER_RDRYG( 19, 9) = 0.295481E+01
+ PKER_RDRYG( 19, 10) = 0.242671E+01
+ PKER_RDRYG( 19, 11) = 0.198914E+01
+ PKER_RDRYG( 19, 12) = 0.162645E+01
+ PKER_RDRYG( 19, 13) = 0.132569E+01
+ PKER_RDRYG( 19, 14) = 0.107613E+01
+ PKER_RDRYG( 19, 15) = 0.868883E+00
+ PKER_RDRYG( 19, 16) = 0.696595E+00
+ PKER_RDRYG( 19, 17) = 0.553222E+00
+ PKER_RDRYG( 19, 18) = 0.433861E+00
+ PKER_RDRYG( 19, 19) = 0.334680E+00
+ PKER_RDRYG( 19, 20) = 0.252894E+00
+ PKER_RDRYG( 19, 21) = 0.186794E+00
+ PKER_RDRYG( 19, 22) = 0.135613E+00
+ PKER_RDRYG( 19, 23) = 0.990001E-01
+ PKER_RDRYG( 19, 24) = 0.764111E-01
+ PKER_RDRYG( 19, 25) = 0.663036E-01
+ PKER_RDRYG( 19, 26) = 0.659987E-01
+ PKER_RDRYG( 19, 27) = 0.722775E-01
+ PKER_RDRYG( 19, 28) = 0.819918E-01
+ PKER_RDRYG( 19, 29) = 0.927520E-01
+ PKER_RDRYG( 19, 30) = 0.103099E+00
+ PKER_RDRYG( 19, 31) = 0.112313E+00
+ PKER_RDRYG( 19, 32) = 0.120174E+00
+ PKER_RDRYG( 19, 33) = 0.126723E+00
+ PKER_RDRYG( 19, 34) = 0.132108E+00
+ PKER_RDRYG( 19, 35) = 0.136507E+00
+ PKER_RDRYG( 19, 36) = 0.140095E+00
+ PKER_RDRYG( 19, 37) = 0.143023E+00
+ PKER_RDRYG( 19, 38) = 0.145415E+00
+ PKER_RDRYG( 19, 39) = 0.147371E+00
+ PKER_RDRYG( 19, 40) = 0.148972E+00
+ PKER_RDRYG( 20, 1) = 0.137877E+02
+ PKER_RDRYG( 20, 2) = 0.113993E+02
+ PKER_RDRYG( 20, 3) = 0.942201E+01
+ PKER_RDRYG( 20, 4) = 0.778496E+01
+ PKER_RDRYG( 20, 5) = 0.642957E+01
+ PKER_RDRYG( 20, 6) = 0.530736E+01
+ PKER_RDRYG( 20, 7) = 0.437816E+01
+ PKER_RDRYG( 20, 8) = 0.360871E+01
+ PKER_RDRYG( 20, 9) = 0.297151E+01
+ PKER_RDRYG( 20, 10) = 0.244375E+01
+ PKER_RDRYG( 20, 11) = 0.200655E+01
+ PKER_RDRYG( 20, 12) = 0.164429E+01
+ PKER_RDRYG( 20, 13) = 0.134402E+01
+ PKER_RDRYG( 20, 14) = 0.109502E+01
+ PKER_RDRYG( 20, 15) = 0.888391E+00
+ PKER_RDRYG( 20, 16) = 0.716785E+00
+ PKER_RDRYG( 20, 17) = 0.574115E+00
+ PKER_RDRYG( 20, 18) = 0.455384E+00
+ PKER_RDRYG( 20, 19) = 0.356548E+00
+ PKER_RDRYG( 20, 20) = 0.274459E+00
+ PKER_RDRYG( 20, 21) = 0.206882E+00
+ PKER_RDRYG( 20, 22) = 0.152466E+00
+ PKER_RDRYG( 20, 23) = 0.110601E+00
+ PKER_RDRYG( 20, 24) = 0.811506E-01
+ PKER_RDRYG( 20, 25) = 0.634503E-01
+ PKER_RDRYG( 20, 26) = 0.561009E-01
+ PKER_RDRYG( 20, 27) = 0.568033E-01
+ PKER_RDRYG( 20, 28) = 0.627284E-01
+ PKER_RDRYG( 20, 29) = 0.712830E-01
+ PKER_RDRYG( 20, 30) = 0.805234E-01
+ PKER_RDRYG( 20, 31) = 0.892920E-01
+ PKER_RDRYG( 20, 32) = 0.970435E-01
+ PKER_RDRYG( 20, 33) = 0.103629E+00
+ PKER_RDRYG( 20, 34) = 0.109103E+00
+ PKER_RDRYG( 20, 35) = 0.113596E+00
+ PKER_RDRYG( 20, 36) = 0.117263E+00
+ PKER_RDRYG( 20, 37) = 0.120253E+00
+ PKER_RDRYG( 20, 38) = 0.122692E+00
+ PKER_RDRYG( 20, 39) = 0.124685E+00
+ PKER_RDRYG( 20, 40) = 0.126314E+00
+ PKER_RDRYG( 21, 1) = 0.138003E+02
+ PKER_RDRYG( 21, 2) = 0.114121E+02
+ PKER_RDRYG( 21, 3) = 0.943487E+01
+ PKER_RDRYG( 21, 4) = 0.779796E+01
+ PKER_RDRYG( 21, 5) = 0.644273E+01
+ PKER_RDRYG( 21, 6) = 0.532068E+01
+ PKER_RDRYG( 21, 7) = 0.439166E+01
+ PKER_RDRYG( 21, 8) = 0.362242E+01
+ PKER_RDRYG( 21, 9) = 0.298543E+01
+ PKER_RDRYG( 21, 10) = 0.245792E+01
+ PKER_RDRYG( 21, 11) = 0.202101E+01
+ PKER_RDRYG( 21, 12) = 0.165907E+01
+ PKER_RDRYG( 21, 13) = 0.135916E+01
+ PKER_RDRYG( 21, 14) = 0.111057E+01
+ PKER_RDRYG( 21, 15) = 0.904409E+00
+ PKER_RDRYG( 21, 16) = 0.733329E+00
+ PKER_RDRYG( 21, 17) = 0.591235E+00
+ PKER_RDRYG( 21, 18) = 0.473092E+00
+ PKER_RDRYG( 21, 19) = 0.374768E+00
+ PKER_RDRYG( 21, 20) = 0.292928E+00
+ PKER_RDRYG( 21, 21) = 0.224999E+00
+ PKER_RDRYG( 21, 22) = 0.169182E+00
+ PKER_RDRYG( 21, 23) = 0.124421E+00
+ PKER_RDRYG( 21, 24) = 0.902987E-01
+ PKER_RDRYG( 21, 25) = 0.666035E-01
+ PKER_RDRYG( 21, 26) = 0.528135E-01
+ PKER_RDRYG( 21, 27) = 0.476163E-01
+ PKER_RDRYG( 21, 28) = 0.489721E-01
+ PKER_RDRYG( 21, 29) = 0.544680E-01
+ PKER_RDRYG( 21, 30) = 0.619547E-01
+ PKER_RDRYG( 21, 31) = 0.698776E-01
+ PKER_RDRYG( 21, 32) = 0.772992E-01
+ PKER_RDRYG( 21, 33) = 0.838194E-01
+ PKER_RDRYG( 21, 34) = 0.893378E-01
+ PKER_RDRYG( 21, 35) = 0.939116E-01
+ PKER_RDRYG( 21, 36) = 0.976604E-01
+ PKER_RDRYG( 21, 37) = 0.100718E+00
+ PKER_RDRYG( 21, 38) = 0.103210E+00
+ PKER_RDRYG( 21, 39) = 0.105243E+00
+ PKER_RDRYG( 21, 40) = 0.106903E+00
+ PKER_RDRYG( 22, 1) = 0.138109E+02
+ PKER_RDRYG( 22, 2) = 0.114228E+02
+ PKER_RDRYG( 22, 3) = 0.944570E+01
+ PKER_RDRYG( 22, 4) = 0.780889E+01
+ PKER_RDRYG( 22, 5) = 0.645378E+01
+ PKER_RDRYG( 22, 6) = 0.533186E+01
+ PKER_RDRYG( 22, 7) = 0.440297E+01
+ PKER_RDRYG( 22, 8) = 0.363389E+01
+ PKER_RDRYG( 22, 9) = 0.299707E+01
+ PKER_RDRYG( 22, 10) = 0.246974E+01
+ PKER_RDRYG( 22, 11) = 0.203304E+01
+ PKER_RDRYG( 22, 12) = 0.167134E+01
+ PKER_RDRYG( 22, 13) = 0.137170E+01
+ PKER_RDRYG( 22, 14) = 0.112341E+01
+ PKER_RDRYG( 22, 15) = 0.917601E+00
+ PKER_RDRYG( 22, 16) = 0.746917E+00
+ PKER_RDRYG( 22, 17) = 0.605268E+00
+ PKER_RDRYG( 22, 18) = 0.487610E+00
+ PKER_RDRYG( 22, 19) = 0.389777E+00
+ PKER_RDRYG( 22, 20) = 0.308353E+00
+ PKER_RDRYG( 22, 21) = 0.240593E+00
+ PKER_RDRYG( 22, 22) = 0.184395E+00
+ PKER_RDRYG( 22, 23) = 0.138304E+00
+ PKER_RDRYG( 22, 24) = 0.101518E+00
+ PKER_RDRYG( 22, 25) = 0.737400E-01
+ PKER_RDRYG( 22, 26) = 0.547362E-01
+ PKER_RDRYG( 22, 27) = 0.440552E-01
+ PKER_RDRYG( 22, 28) = 0.405040E-01
+ PKER_RDRYG( 22, 29) = 0.422514E-01
+ PKER_RDRYG( 22, 30) = 0.472981E-01
+ PKER_RDRYG( 22, 31) = 0.538448E-01
+ PKER_RDRYG( 22, 32) = 0.606126E-01
+ PKER_RDRYG( 22, 33) = 0.668945E-01
+ PKER_RDRYG( 22, 34) = 0.723746E-01
+ PKER_RDRYG( 22, 35) = 0.769958E-01
+ PKER_RDRYG( 22, 36) = 0.808177E-01
+ PKER_RDRYG( 22, 37) = 0.839459E-01
+ PKER_RDRYG( 22, 38) = 0.864957E-01
+ PKER_RDRYG( 22, 39) = 0.885730E-01
+ PKER_RDRYG( 22, 40) = 0.902671E-01
+ PKER_RDRYG( 23, 1) = 0.138199E+02
+ PKER_RDRYG( 23, 2) = 0.114318E+02
+ PKER_RDRYG( 23, 3) = 0.945483E+01
+ PKER_RDRYG( 23, 4) = 0.781810E+01
+ PKER_RDRYG( 23, 5) = 0.646308E+01
+ PKER_RDRYG( 23, 6) = 0.534126E+01
+ PKER_RDRYG( 23, 7) = 0.441248E+01
+ PKER_RDRYG( 23, 8) = 0.364351E+01
+ PKER_RDRYG( 23, 9) = 0.300682E+01
+ PKER_RDRYG( 23, 10) = 0.247963E+01
+ PKER_RDRYG( 23, 11) = 0.204308E+01
+ PKER_RDRYG( 23, 12) = 0.168156E+01
+ PKER_RDRYG( 23, 13) = 0.138212E+01
+ PKER_RDRYG( 23, 14) = 0.113405E+01
+ PKER_RDRYG( 23, 15) = 0.928502E+00
+ PKER_RDRYG( 23, 16) = 0.758112E+00
+ PKER_RDRYG( 23, 17) = 0.616797E+00
+ PKER_RDRYG( 23, 18) = 0.499515E+00
+ PKER_RDRYG( 23, 19) = 0.402091E+00
+ PKER_RDRYG( 23, 20) = 0.321077E+00
+ PKER_RDRYG( 23, 21) = 0.253650E+00
+ PKER_RDRYG( 23, 22) = 0.197550E+00
+ PKER_RDRYG( 23, 23) = 0.151060E+00
+ PKER_RDRYG( 23, 24) = 0.113025E+00
+ PKER_RDRYG( 23, 25) = 0.828239E-01
+ PKER_RDRYG( 23, 26) = 0.601986E-01
+ PKER_RDRYG( 23, 27) = 0.450509E-01
+ PKER_RDRYG( 23, 28) = 0.368416E-01
+ PKER_RDRYG( 23, 29) = 0.345321E-01
+ PKER_RDRYG( 23, 30) = 0.365251E-01
+ PKER_RDRYG( 23, 31) = 0.410970E-01
+ PKER_RDRYG( 23, 32) = 0.467824E-01
+ PKER_RDRYG( 23, 33) = 0.525608E-01
+ PKER_RDRYG( 23, 34) = 0.578657E-01
+ PKER_RDRYG( 23, 35) = 0.624713E-01
+ PKER_RDRYG( 23, 36) = 0.663413E-01
+ PKER_RDRYG( 23, 37) = 0.695349E-01
+ PKER_RDRYG( 23, 38) = 0.721454E-01
+ PKER_RDRYG( 23, 39) = 0.742719E-01
+ PKER_RDRYG( 23, 40) = 0.760039E-01
+ PKER_RDRYG( 24, 1) = 0.138275E+02
+ PKER_RDRYG( 24, 2) = 0.114395E+02
+ PKER_RDRYG( 24, 3) = 0.946253E+01
+ PKER_RDRYG( 24, 4) = 0.782587E+01
+ PKER_RDRYG( 24, 5) = 0.647092E+01
+ PKER_RDRYG( 24, 6) = 0.534917E+01
+ PKER_RDRYG( 24, 7) = 0.442047E+01
+ PKER_RDRYG( 24, 8) = 0.365159E+01
+ PKER_RDRYG( 24, 9) = 0.301500E+01
+ PKER_RDRYG( 24, 10) = 0.248792E+01
+ PKER_RDRYG( 24, 11) = 0.205149E+01
+ PKER_RDRYG( 24, 12) = 0.169009E+01
+ PKER_RDRYG( 24, 13) = 0.139080E+01
+ PKER_RDRYG( 24, 14) = 0.114290E+01
+ PKER_RDRYG( 24, 15) = 0.937539E+00
+ PKER_RDRYG( 24, 16) = 0.767365E+00
+ PKER_RDRYG( 24, 17) = 0.626299E+00
+ PKER_RDRYG( 24, 18) = 0.509299E+00
+ PKER_RDRYG( 24, 19) = 0.412192E+00
+ PKER_RDRYG( 24, 20) = 0.331522E+00
+ PKER_RDRYG( 24, 21) = 0.264435E+00
+ PKER_RDRYG( 24, 22) = 0.208600E+00
+ PKER_RDRYG( 24, 23) = 0.162158E+00
+ PKER_RDRYG( 24, 24) = 0.123712E+00
+ PKER_RDRYG( 24, 25) = 0.923382E-01
+ PKER_RDRYG( 24, 26) = 0.675660E-01
+ PKER_RDRYG( 24, 27) = 0.492121E-01
+ PKER_RDRYG( 24, 28) = 0.371392E-01
+ PKER_RDRYG( 24, 29) = 0.309059E-01
+ PKER_RDRYG( 24, 30) = 0.295040E-01
+ PKER_RDRYG( 24, 31) = 0.315887E-01
+ PKER_RDRYG( 24, 32) = 0.357033E-01
+ PKER_RDRYG( 24, 33) = 0.406336E-01
+ PKER_RDRYG( 24, 34) = 0.455581E-01
+ PKER_RDRYG( 24, 35) = 0.500391E-01
+ PKER_RDRYG( 24, 36) = 0.539067E-01
+ PKER_RDRYG( 24, 37) = 0.571467E-01
+ PKER_RDRYG( 24, 38) = 0.598152E-01
+ PKER_RDRYG( 24, 39) = 0.619938E-01
+ PKER_RDRYG( 24, 40) = 0.637676E-01
+ PKER_RDRYG( 25, 1) = 0.138339E+02
+ PKER_RDRYG( 25, 2) = 0.114460E+02
+ PKER_RDRYG( 25, 3) = 0.946904E+01
+ PKER_RDRYG( 25, 4) = 0.783243E+01
+ PKER_RDRYG( 25, 5) = 0.647753E+01
+ PKER_RDRYG( 25, 6) = 0.535584E+01
+ PKER_RDRYG( 25, 7) = 0.442721E+01
+ PKER_RDRYG( 25, 8) = 0.365839E+01
+ PKER_RDRYG( 25, 9) = 0.302187E+01
+ PKER_RDRYG( 25, 10) = 0.249487E+01
+ PKER_RDRYG( 25, 11) = 0.205853E+01
+ PKER_RDRYG( 25, 12) = 0.169723E+01
+ PKER_RDRYG( 25, 13) = 0.139805E+01
+ PKER_RDRYG( 25, 14) = 0.115028E+01
+ PKER_RDRYG( 25, 15) = 0.945054E+00
+ PKER_RDRYG( 25, 16) = 0.775040E+00
+ PKER_RDRYG( 25, 17) = 0.634156E+00
+ PKER_RDRYG( 25, 18) = 0.517365E+00
+ PKER_RDRYG( 25, 19) = 0.420497E+00
+ PKER_RDRYG( 25, 20) = 0.340095E+00
+ PKER_RDRYG( 25, 21) = 0.273296E+00
+ PKER_RDRYG( 25, 22) = 0.217743E+00
+ PKER_RDRYG( 25, 23) = 0.171507E+00
+ PKER_RDRYG( 25, 24) = 0.133065E+00
+ PKER_RDRYG( 25, 25) = 0.101277E+00
+ PKER_RDRYG( 25, 26) = 0.754131E-01
+ PKER_RDRYG( 25, 27) = 0.551078E-01
+ PKER_RDRYG( 25, 28) = 0.402423E-01
+ PKER_RDRYG( 25, 29) = 0.306784E-01
+ PKER_RDRYG( 25, 30) = 0.259723E-01
+ PKER_RDRYG( 25, 31) = 0.252571E-01
+ PKER_RDRYG( 25, 32) = 0.273487E-01
+ PKER_RDRYG( 25, 33) = 0.310247E-01
+ PKER_RDRYG( 25, 34) = 0.352825E-01
+ PKER_RDRYG( 25, 35) = 0.394738E-01
+ PKER_RDRYG( 25, 36) = 0.432539E-01
+ PKER_RDRYG( 25, 37) = 0.465023E-01
+ PKER_RDRYG( 25, 38) = 0.492145E-01
+ PKER_RDRYG( 25, 39) = 0.514441E-01
+ PKER_RDRYG( 25, 40) = 0.532625E-01
+ PKER_RDRYG( 26, 1) = 0.138394E+02
+ PKER_RDRYG( 26, 2) = 0.114514E+02
+ PKER_RDRYG( 26, 3) = 0.947455E+01
+ PKER_RDRYG( 26, 4) = 0.783798E+01
+ PKER_RDRYG( 26, 5) = 0.648312E+01
+ PKER_RDRYG( 26, 6) = 0.536147E+01
+ PKER_RDRYG( 26, 7) = 0.443289E+01
+ PKER_RDRYG( 26, 8) = 0.366412E+01
+ PKER_RDRYG( 26, 9) = 0.302766E+01
+ PKER_RDRYG( 26, 10) = 0.250072E+01
+ PKER_RDRYG( 26, 11) = 0.206444E+01
+ PKER_RDRYG( 26, 12) = 0.170322E+01
+ PKER_RDRYG( 26, 13) = 0.140412E+01
+ PKER_RDRYG( 26, 14) = 0.115644E+01
+ PKER_RDRYG( 26, 15) = 0.951320E+00
+ PKER_RDRYG( 26, 16) = 0.781424E+00
+ PKER_RDRYG( 26, 17) = 0.640674E+00
+ PKER_RDRYG( 26, 18) = 0.524038E+00
+ PKER_RDRYG( 26, 19) = 0.427346E+00
+ PKER_RDRYG( 26, 20) = 0.347145E+00
+ PKER_RDRYG( 26, 21) = 0.280573E+00
+ PKER_RDRYG( 26, 22) = 0.225261E+00
+ PKER_RDRYG( 26, 23) = 0.179259E+00
+ PKER_RDRYG( 26, 24) = 0.140975E+00
+ PKER_RDRYG( 26, 25) = 0.109155E+00
+ PKER_RDRYG( 26, 26) = 0.828827E-01
+ PKER_RDRYG( 26, 27) = 0.615721E-01
+ PKER_RDRYG( 26, 28) = 0.449413E-01
+ PKER_RDRYG( 26, 29) = 0.329364E-01
+ PKER_RDRYG( 26, 30) = 0.253888E-01
+ PKER_RDRYG( 26, 31) = 0.218916E-01
+ PKER_RDRYG( 26, 32) = 0.216696E-01
+ PKER_RDRYG( 26, 33) = 0.236986E-01
+ PKER_RDRYG( 26, 34) = 0.269569E-01
+ PKER_RDRYG( 26, 35) = 0.306269E-01
+ PKER_RDRYG( 26, 36) = 0.341888E-01
+ PKER_RDRYG( 26, 37) = 0.373771E-01
+ PKER_RDRYG( 26, 38) = 0.401030E-01
+ PKER_RDRYG( 26, 39) = 0.423733E-01
+ PKER_RDRYG( 26, 40) = 0.442362E-01
+ PKER_RDRYG( 27, 1) = 0.138440E+02
+ PKER_RDRYG( 27, 2) = 0.114560E+02
+ PKER_RDRYG( 27, 3) = 0.947921E+01
+ PKER_RDRYG( 27, 4) = 0.784267E+01
+ PKER_RDRYG( 27, 5) = 0.648784E+01
+ PKER_RDRYG( 27, 6) = 0.536623E+01
+ PKER_RDRYG( 27, 7) = 0.443768E+01
+ PKER_RDRYG( 27, 8) = 0.366895E+01
+ PKER_RDRYG( 27, 9) = 0.303253E+01
+ PKER_RDRYG( 27, 10) = 0.250564E+01
+ PKER_RDRYG( 27, 11) = 0.206942E+01
+ PKER_RDRYG( 27, 12) = 0.170825E+01
+ PKER_RDRYG( 27, 13) = 0.140921E+01
+ PKER_RDRYG( 27, 14) = 0.116160E+01
+ PKER_RDRYG( 27, 15) = 0.956558E+00
+ PKER_RDRYG( 27, 16) = 0.786749E+00
+ PKER_RDRYG( 27, 17) = 0.646098E+00
+ PKER_RDRYG( 27, 18) = 0.529575E+00
+ PKER_RDRYG( 27, 19) = 0.433014E+00
+ PKER_RDRYG( 27, 20) = 0.352962E+00
+ PKER_RDRYG( 27, 21) = 0.286560E+00
+ PKER_RDRYG( 27, 22) = 0.231439E+00
+ PKER_RDRYG( 27, 23) = 0.185639E+00
+ PKER_RDRYG( 27, 24) = 0.147545E+00
+ PKER_RDRYG( 27, 25) = 0.115846E+00
+ PKER_RDRYG( 27, 26) = 0.895139E-01
+ PKER_RDRYG( 27, 27) = 0.678043E-01
+ PKER_RDRYG( 27, 28) = 0.502589E-01
+ PKER_RDRYG( 27, 29) = 0.366803E-01
+ PKER_RDRYG( 27, 30) = 0.269840E-01
+ PKER_RDRYG( 27, 31) = 0.210536E-01
+ PKER_RDRYG( 27, 32) = 0.184920E-01
+ PKER_RDRYG( 27, 33) = 0.186221E-01
+ PKER_RDRYG( 27, 34) = 0.205486E-01
+ PKER_RDRYG( 27, 35) = 0.234200E-01
+ PKER_RDRYG( 27, 36) = 0.265772E-01
+ PKER_RDRYG( 27, 37) = 0.296001E-01
+ PKER_RDRYG( 27, 38) = 0.322869E-01
+ PKER_RDRYG( 27, 39) = 0.345747E-01
+ PKER_RDRYG( 27, 40) = 0.364748E-01
+ PKER_RDRYG( 28, 1) = 0.138479E+02
+ PKER_RDRYG( 28, 2) = 0.114600E+02
+ PKER_RDRYG( 28, 3) = 0.948316E+01
+ PKER_RDRYG( 28, 4) = 0.784664E+01
+ PKER_RDRYG( 28, 5) = 0.649184E+01
+ PKER_RDRYG( 28, 6) = 0.537025E+01
+ PKER_RDRYG( 28, 7) = 0.444173E+01
+ PKER_RDRYG( 28, 8) = 0.367304E+01
+ PKER_RDRYG( 28, 9) = 0.303665E+01
+ PKER_RDRYG( 28, 10) = 0.250979E+01
+ PKER_RDRYG( 28, 11) = 0.207361E+01
+ PKER_RDRYG( 28, 12) = 0.171248E+01
+ PKER_RDRYG( 28, 13) = 0.141349E+01
+ PKER_RDRYG( 28, 14) = 0.116593E+01
+ PKER_RDRYG( 28, 15) = 0.960947E+00
+ PKER_RDRYG( 28, 16) = 0.791203E+00
+ PKER_RDRYG( 28, 17) = 0.650625E+00
+ PKER_RDRYG( 28, 18) = 0.534185E+00
+ PKER_RDRYG( 28, 19) = 0.437719E+00
+ PKER_RDRYG( 28, 20) = 0.357777E+00
+ PKER_RDRYG( 28, 21) = 0.291501E+00
+ PKER_RDRYG( 28, 22) = 0.236523E+00
+ PKER_RDRYG( 28, 23) = 0.190884E+00
+ PKER_RDRYG( 28, 24) = 0.152959E+00
+ PKER_RDRYG( 28, 25) = 0.121415E+00
+ PKER_RDRYG( 28, 26) = 0.951696E-01
+ PKER_RDRYG( 28, 27) = 0.733827E-01
+ PKER_RDRYG( 28, 28) = 0.554501E-01
+ PKER_RDRYG( 28, 29) = 0.410159E-01
+ PKER_RDRYG( 28, 30) = 0.299322E-01
+ PKER_RDRYG( 28, 31) = 0.221290E-01
+ PKER_RDRYG( 28, 32) = 0.174911E-01
+ PKER_RDRYG( 28, 33) = 0.156662E-01
+ PKER_RDRYG( 28, 34) = 0.160216E-01
+ PKER_RDRYG( 28, 35) = 0.178216E-01
+ PKER_RDRYG( 28, 36) = 0.203456E-01
+ PKER_RDRYG( 28, 37) = 0.230543E-01
+ PKER_RDRYG( 28, 38) = 0.256182E-01
+ PKER_RDRYG( 28, 39) = 0.278812E-01
+ PKER_RDRYG( 28, 40) = 0.298004E-01
+ PKER_RDRYG( 29, 1) = 0.138512E+02
+ PKER_RDRYG( 29, 2) = 0.114633E+02
+ PKER_RDRYG( 29, 3) = 0.948650E+01
+ PKER_RDRYG( 29, 4) = 0.785000E+01
+ PKER_RDRYG( 29, 5) = 0.649522E+01
+ PKER_RDRYG( 29, 6) = 0.537366E+01
+ PKER_RDRYG( 29, 7) = 0.444516E+01
+ PKER_RDRYG( 29, 8) = 0.367649E+01
+ PKER_RDRYG( 29, 9) = 0.304013E+01
+ PKER_RDRYG( 29, 10) = 0.251330E+01
+ PKER_RDRYG( 29, 11) = 0.207714E+01
+ PKER_RDRYG( 29, 12) = 0.171605E+01
+ PKER_RDRYG( 29, 13) = 0.141709E+01
+ PKER_RDRYG( 29, 14) = 0.116957E+01
+ PKER_RDRYG( 29, 15) = 0.964632E+00
+ PKER_RDRYG( 29, 16) = 0.794935E+00
+ PKER_RDRYG( 29, 17) = 0.654412E+00
+ PKER_RDRYG( 29, 18) = 0.538034E+00
+ PKER_RDRYG( 29, 19) = 0.441637E+00
+ PKER_RDRYG( 29, 20) = 0.361775E+00
+ PKER_RDRYG( 29, 21) = 0.295592E+00
+ PKER_RDRYG( 29, 22) = 0.240721E+00
+ PKER_RDRYG( 29, 23) = 0.195203E+00
+ PKER_RDRYG( 29, 24) = 0.157413E+00
+ PKER_RDRYG( 29, 25) = 0.126010E+00
+ PKER_RDRYG( 29, 26) = 0.998897E-01
+ PKER_RDRYG( 29, 27) = 0.781613E-01
+ PKER_RDRYG( 29, 28) = 0.601349E-01
+ PKER_RDRYG( 29, 29) = 0.453296E-01
+ PKER_RDRYG( 29, 30) = 0.334668E-01
+ PKER_RDRYG( 29, 31) = 0.244241E-01
+ PKER_RDRYG( 29, 32) = 0.181733E-01
+ PKER_RDRYG( 29, 33) = 0.145718E-01
+ PKER_RDRYG( 29, 34) = 0.133001E-01
+ PKER_RDRYG( 29, 35) = 0.138127E-01
+ PKER_RDRYG( 29, 36) = 0.154662E-01
+ PKER_RDRYG( 29, 37) = 0.176729E-01
+ PKER_RDRYG( 29, 38) = 0.199915E-01
+ PKER_RDRYG( 29, 39) = 0.221631E-01
+ PKER_RDRYG( 29, 40) = 0.240688E-01
+ PKER_RDRYG( 30, 1) = 0.138540E+02
+ PKER_RDRYG( 30, 2) = 0.114661E+02
+ PKER_RDRYG( 30, 3) = 0.948934E+01
+ PKER_RDRYG( 30, 4) = 0.785286E+01
+ PKER_RDRYG( 30, 5) = 0.649809E+01
+ PKER_RDRYG( 30, 6) = 0.537654E+01
+ PKER_RDRYG( 30, 7) = 0.444806E+01
+ PKER_RDRYG( 30, 8) = 0.367941E+01
+ PKER_RDRYG( 30, 9) = 0.304307E+01
+ PKER_RDRYG( 30, 10) = 0.251626E+01
+ PKER_RDRYG( 30, 11) = 0.208013E+01
+ PKER_RDRYG( 30, 12) = 0.171906E+01
+ PKER_RDRYG( 30, 13) = 0.142013E+01
+ PKER_RDRYG( 30, 14) = 0.117264E+01
+ PKER_RDRYG( 30, 15) = 0.967730E+00
+ PKER_RDRYG( 30, 16) = 0.798070E+00
+ PKER_RDRYG( 30, 17) = 0.657587E+00
+ PKER_RDRYG( 30, 18) = 0.541254E+00
+ PKER_RDRYG( 30, 19) = 0.444909E+00
+ PKER_RDRYG( 30, 20) = 0.365106E+00
+ PKER_RDRYG( 30, 21) = 0.298991E+00
+ PKER_RDRYG( 30, 22) = 0.244198E+00
+ PKER_RDRYG( 30, 23) = 0.198769E+00
+ PKER_RDRYG( 30, 24) = 0.161082E+00
+ PKER_RDRYG( 30, 25) = 0.129793E+00
+ PKER_RDRYG( 30, 26) = 0.103790E+00
+ PKER_RDRYG( 30, 27) = 0.821610E-01
+ PKER_RDRYG( 30, 28) = 0.641734E-01
+ PKER_RDRYG( 30, 29) = 0.492644E-01
+ PKER_RDRYG( 30, 30) = 0.370449E-01
+ PKER_RDRYG( 30, 31) = 0.273020E-01
+ PKER_RDRYG( 30, 32) = 0.199464E-01
+ PKER_RDRYG( 30, 33) = 0.149418E-01
+ PKER_RDRYG( 30, 34) = 0.121711E-01
+ PKER_RDRYG( 30, 35) = 0.113170E-01
+ PKER_RDRYG( 30, 36) = 0.119183E-01
+ PKER_RDRYG( 30, 37) = 0.134237E-01
+ PKER_RDRYG( 30, 38) = 0.153458E-01
+ PKER_RDRYG( 30, 39) = 0.173290E-01
+ PKER_RDRYG( 30, 40) = 0.191677E-01
+ PKER_RDRYG( 31, 1) = 0.138564E+02
+ PKER_RDRYG( 31, 2) = 0.114685E+02
+ PKER_RDRYG( 31, 3) = 0.949175E+01
+ PKER_RDRYG( 31, 4) = 0.785528E+01
+ PKER_RDRYG( 31, 5) = 0.650052E+01
+ PKER_RDRYG( 31, 6) = 0.537899E+01
+ PKER_RDRYG( 31, 7) = 0.445052E+01
+ PKER_RDRYG( 31, 8) = 0.368188E+01
+ PKER_RDRYG( 31, 9) = 0.304556E+01
+ PKER_RDRYG( 31, 10) = 0.251877E+01
+ PKER_RDRYG( 31, 11) = 0.208265E+01
+ PKER_RDRYG( 31, 12) = 0.172160E+01
+ PKER_RDRYG( 31, 13) = 0.142269E+01
+ PKER_RDRYG( 31, 14) = 0.117522E+01
+ PKER_RDRYG( 31, 15) = 0.970340E+00
+ PKER_RDRYG( 31, 16) = 0.800707E+00
+ PKER_RDRYG( 31, 17) = 0.660255E+00
+ PKER_RDRYG( 31, 18) = 0.543956E+00
+ PKER_RDRYG( 31, 19) = 0.447649E+00
+ PKER_RDRYG( 31, 20) = 0.367889E+00
+ PKER_RDRYG( 31, 21) = 0.301823E+00
+ PKER_RDRYG( 31, 22) = 0.247087E+00
+ PKER_RDRYG( 31, 23) = 0.201725E+00
+ PKER_RDRYG( 31, 24) = 0.164114E+00
+ PKER_RDRYG( 31, 25) = 0.132910E+00
+ PKER_RDRYG( 31, 26) = 0.107003E+00
+ PKER_RDRYG( 31, 27) = 0.854709E-01
+ PKER_RDRYG( 31, 28) = 0.675620E-01
+ PKER_RDRYG( 31, 29) = 0.526723E-01
+ PKER_RDRYG( 31, 30) = 0.403428E-01
+ PKER_RDRYG( 31, 31) = 0.302637E-01
+ PKER_RDRYG( 31, 32) = 0.222653E-01
+ PKER_RDRYG( 31, 33) = 0.162939E-01
+ PKER_RDRYG( 31, 34) = 0.123058E-01
+ PKER_RDRYG( 31, 35) = 0.101795E-01
+ PKER_RDRYG( 31, 36) = 0.964983E-02
+ PKER_RDRYG( 31, 37) = 0.102948E-01
+ PKER_RDRYG( 31, 38) = 0.116552E-01
+ PKER_RDRYG( 31, 39) = 0.133239E-01
+ PKER_RDRYG( 31, 40) = 0.150165E-01
+ PKER_RDRYG( 32, 1) = 0.138584E+02
+ PKER_RDRYG( 32, 2) = 0.114706E+02
+ PKER_RDRYG( 32, 3) = 0.949379E+01
+ PKER_RDRYG( 32, 4) = 0.785733E+01
+ PKER_RDRYG( 32, 5) = 0.650259E+01
+ PKER_RDRYG( 32, 6) = 0.538106E+01
+ PKER_RDRYG( 32, 7) = 0.445260E+01
+ PKER_RDRYG( 32, 8) = 0.368398E+01
+ PKER_RDRYG( 32, 9) = 0.304766E+01
+ PKER_RDRYG( 32, 10) = 0.252089E+01
+ PKER_RDRYG( 32, 11) = 0.208479E+01
+ PKER_RDRYG( 32, 12) = 0.172375E+01
+ PKER_RDRYG( 32, 13) = 0.142486E+01
+ PKER_RDRYG( 32, 14) = 0.117741E+01
+ PKER_RDRYG( 32, 15) = 0.972542E+00
+ PKER_RDRYG( 32, 16) = 0.802930E+00
+ PKER_RDRYG( 32, 17) = 0.662499E+00
+ PKER_RDRYG( 32, 18) = 0.546226E+00
+ PKER_RDRYG( 32, 19) = 0.449948E+00
+ PKER_RDRYG( 32, 20) = 0.370220E+00
+ PKER_RDRYG( 32, 21) = 0.304190E+00
+ PKER_RDRYG( 32, 22) = 0.249496E+00
+ PKER_RDRYG( 32, 23) = 0.204181E+00
+ PKER_RDRYG( 32, 24) = 0.166626E+00
+ PKER_RDRYG( 32, 25) = 0.135487E+00
+ PKER_RDRYG( 32, 26) = 0.109652E+00
+ PKER_RDRYG( 32, 27) = 0.882004E-01
+ PKER_RDRYG( 32, 28) = 0.703714E-01
+ PKER_RDRYG( 32, 29) = 0.555429E-01
+ PKER_RDRYG( 32, 30) = 0.432184E-01
+ PKER_RDRYG( 32, 31) = 0.330257E-01
+ PKER_RDRYG( 32, 32) = 0.247158E-01
+ PKER_RDRYG( 32, 33) = 0.181591E-01
+ PKER_RDRYG( 32, 34) = 0.133191E-01
+ PKER_RDRYG( 32, 35) = 0.101524E-01
+ PKER_RDRYG( 32, 36) = 0.854593E-02
+ PKER_RDRYG( 32, 37) = 0.824929E-02
+ PKER_RDRYG( 32, 38) = 0.890385E-02
+ PKER_RDRYG( 32, 39) = 0.101193E-01
+ PKER_RDRYG( 32, 40) = 0.115645E-01
+ PKER_RDRYG( 33, 1) = 0.138601E+02
+ PKER_RDRYG( 33, 2) = 0.114723E+02
+ PKER_RDRYG( 33, 3) = 0.949553E+01
+ PKER_RDRYG( 33, 4) = 0.785908E+01
+ PKER_RDRYG( 33, 5) = 0.650434E+01
+ PKER_RDRYG( 33, 6) = 0.538282E+01
+ PKER_RDRYG( 33, 7) = 0.445437E+01
+ PKER_RDRYG( 33, 8) = 0.368576E+01
+ PKER_RDRYG( 33, 9) = 0.304945E+01
+ PKER_RDRYG( 33, 10) = 0.252268E+01
+ PKER_RDRYG( 33, 11) = 0.208659E+01
+ PKER_RDRYG( 33, 12) = 0.172557E+01
+ PKER_RDRYG( 33, 13) = 0.142669E+01
+ PKER_RDRYG( 33, 14) = 0.117925E+01
+ PKER_RDRYG( 33, 15) = 0.974401E+00
+ PKER_RDRYG( 33, 16) = 0.804805E+00
+ PKER_RDRYG( 33, 17) = 0.664392E+00
+ PKER_RDRYG( 33, 18) = 0.548137E+00
+ PKER_RDRYG( 33, 19) = 0.451880E+00
+ PKER_RDRYG( 33, 20) = 0.372176E+00
+ PKER_RDRYG( 33, 21) = 0.306173E+00
+ PKER_RDRYG( 33, 22) = 0.251510E+00
+ PKER_RDRYG( 33, 23) = 0.206230E+00
+ PKER_RDRYG( 33, 24) = 0.168715E+00
+ PKER_RDRYG( 33, 25) = 0.137623E+00
+ PKER_RDRYG( 33, 26) = 0.111843E+00
+ PKER_RDRYG( 33, 27) = 0.904523E-01
+ PKER_RDRYG( 33, 28) = 0.726902E-01
+ PKER_RDRYG( 33, 29) = 0.579273E-01
+ PKER_RDRYG( 33, 30) = 0.456499E-01
+ PKER_RDRYG( 33, 31) = 0.354504E-01
+ PKER_RDRYG( 33, 32) = 0.270255E-01
+ PKER_RDRYG( 33, 33) = 0.201789E-01
+ PKER_RDRYG( 33, 34) = 0.148159E-01
+ PKER_RDRYG( 33, 35) = 0.108951E-01
+ PKER_RDRYG( 33, 36) = 0.838982E-02
+ PKER_RDRYG( 33, 37) = 0.718623E-02
+ PKER_RDRYG( 33, 38) = 0.706271E-02
+ PKER_RDRYG( 33, 39) = 0.770543E-02
+ PKER_RDRYG( 33, 40) = 0.878717E-02
+ PKER_RDRYG( 34, 1) = 0.138616E+02
+ PKER_RDRYG( 34, 2) = 0.114738E+02
+ PKER_RDRYG( 34, 3) = 0.949701E+01
+ PKER_RDRYG( 34, 4) = 0.786056E+01
+ PKER_RDRYG( 34, 5) = 0.650583E+01
+ PKER_RDRYG( 34, 6) = 0.538432E+01
+ PKER_RDRYG( 34, 7) = 0.445588E+01
+ PKER_RDRYG( 34, 8) = 0.368726E+01
+ PKER_RDRYG( 34, 9) = 0.305097E+01
+ PKER_RDRYG( 34, 10) = 0.252421E+01
+ PKER_RDRYG( 34, 11) = 0.208813E+01
+ PKER_RDRYG( 34, 12) = 0.172711E+01
+ PKER_RDRYG( 34, 13) = 0.142824E+01
+ PKER_RDRYG( 34, 14) = 0.118081E+01
+ PKER_RDRYG( 34, 15) = 0.975973E+00
+ PKER_RDRYG( 34, 16) = 0.806389E+00
+ PKER_RDRYG( 34, 17) = 0.665989E+00
+ PKER_RDRYG( 34, 18) = 0.549748E+00
+ PKER_RDRYG( 34, 19) = 0.453507E+00
+ PKER_RDRYG( 34, 20) = 0.373821E+00
+ PKER_RDRYG( 34, 21) = 0.307838E+00
+ PKER_RDRYG( 34, 22) = 0.253197E+00
+ PKER_RDRYG( 34, 23) = 0.207944E+00
+ PKER_RDRYG( 34, 24) = 0.170458E+00
+ PKER_RDRYG( 34, 25) = 0.139400E+00
+ PKER_RDRYG( 34, 26) = 0.113659E+00
+ PKER_RDRYG( 34, 27) = 0.923147E-01
+ PKER_RDRYG( 34, 28) = 0.746045E-01
+ PKER_RDRYG( 34, 29) = 0.598974E-01
+ PKER_RDRYG( 34, 30) = 0.476733E-01
+ PKER_RDRYG( 34, 31) = 0.375085E-01
+ PKER_RDRYG( 34, 32) = 0.290687E-01
+ PKER_RDRYG( 34, 33) = 0.221077E-01
+ PKER_RDRYG( 34, 34) = 0.164706E-01
+ PKER_RDRYG( 34, 35) = 0.120829E-01
+ PKER_RDRYG( 34, 36) = 0.891924E-02
+ PKER_RDRYG( 34, 37) = 0.694498E-02
+ PKER_RDRYG( 34, 38) = 0.605978E-02
+ PKER_RDRYG( 34, 39) = 0.605815E-02
+ PKER_RDRYG( 34, 40) = 0.667329E-02
+ PKER_RDRYG( 35, 1) = 0.138628E+02
+ PKER_RDRYG( 35, 2) = 0.114750E+02
+ PKER_RDRYG( 35, 3) = 0.949827E+01
+ PKER_RDRYG( 35, 4) = 0.786182E+01
+ PKER_RDRYG( 35, 5) = 0.650709E+01
+ PKER_RDRYG( 35, 6) = 0.538559E+01
+ PKER_RDRYG( 35, 7) = 0.445715E+01
+ PKER_RDRYG( 35, 8) = 0.368855E+01
+ PKER_RDRYG( 35, 9) = 0.305226E+01
+ PKER_RDRYG( 35, 10) = 0.252550E+01
+ PKER_RDRYG( 35, 11) = 0.208943E+01
+ PKER_RDRYG( 35, 12) = 0.172842E+01
+ PKER_RDRYG( 35, 13) = 0.142955E+01
+ PKER_RDRYG( 35, 14) = 0.118213E+01
+ PKER_RDRYG( 35, 15) = 0.977304E+00
+ PKER_RDRYG( 35, 16) = 0.807728E+00
+ PKER_RDRYG( 35, 17) = 0.667338E+00
+ PKER_RDRYG( 35, 18) = 0.551109E+00
+ PKER_RDRYG( 35, 19) = 0.454880E+00
+ PKER_RDRYG( 35, 20) = 0.375207E+00
+ PKER_RDRYG( 35, 21) = 0.309239E+00
+ PKER_RDRYG( 35, 22) = 0.254615E+00
+ PKER_RDRYG( 35, 23) = 0.209380E+00
+ PKER_RDRYG( 35, 24) = 0.171916E+00
+ PKER_RDRYG( 35, 25) = 0.140883E+00
+ PKER_RDRYG( 35, 26) = 0.115171E+00
+ PKER_RDRYG( 35, 27) = 0.938600E-01
+ PKER_RDRYG( 35, 28) = 0.761883E-01
+ PKER_RDRYG( 35, 29) = 0.615248E-01
+ PKER_RDRYG( 35, 30) = 0.493472E-01
+ PKER_RDRYG( 35, 31) = 0.392256E-01
+ PKER_RDRYG( 35, 32) = 0.308103E-01
+ PKER_RDRYG( 35, 33) = 0.238270E-01
+ PKER_RDRYG( 35, 34) = 0.180779E-01
+ PKER_RDRYG( 35, 35) = 0.134407E-01
+ PKER_RDRYG( 35, 36) = 0.985642E-02
+ PKER_RDRYG( 35, 37) = 0.730986E-02
+ PKER_RDRYG( 35, 38) = 0.576437E-02
+ PKER_RDRYG( 35, 39) = 0.512255E-02
+ PKER_RDRYG( 35, 40) = 0.520497E-02
+ PKER_RDRYG( 36, 1) = 0.138639E+02
+ PKER_RDRYG( 36, 2) = 0.114761E+02
+ PKER_RDRYG( 36, 3) = 0.949934E+01
+ PKER_RDRYG( 36, 4) = 0.786289E+01
+ PKER_RDRYG( 36, 5) = 0.650817E+01
+ PKER_RDRYG( 36, 6) = 0.538667E+01
+ PKER_RDRYG( 36, 7) = 0.445824E+01
+ PKER_RDRYG( 36, 8) = 0.368964E+01
+ PKER_RDRYG( 36, 9) = 0.305335E+01
+ PKER_RDRYG( 36, 10) = 0.252660E+01
+ PKER_RDRYG( 36, 11) = 0.209053E+01
+ PKER_RDRYG( 36, 12) = 0.172953E+01
+ PKER_RDRYG( 36, 13) = 0.143067E+01
+ PKER_RDRYG( 36, 14) = 0.118326E+01
+ PKER_RDRYG( 36, 15) = 0.978431E+00
+ PKER_RDRYG( 36, 16) = 0.808862E+00
+ PKER_RDRYG( 36, 17) = 0.668480E+00
+ PKER_RDRYG( 36, 18) = 0.552259E+00
+ PKER_RDRYG( 36, 19) = 0.456039E+00
+ PKER_RDRYG( 36, 20) = 0.376376E+00
+ PKER_RDRYG( 36, 21) = 0.310419E+00
+ PKER_RDRYG( 36, 22) = 0.255807E+00
+ PKER_RDRYG( 36, 23) = 0.210587E+00
+ PKER_RDRYG( 36, 24) = 0.173139E+00
+ PKER_RDRYG( 36, 25) = 0.142124E+00
+ PKER_RDRYG( 36, 26) = 0.116433E+00
+ PKER_RDRYG( 36, 27) = 0.951462E-01
+ PKER_RDRYG( 36, 28) = 0.775028E-01
+ PKER_RDRYG( 36, 29) = 0.628718E-01
+ PKER_RDRYG( 36, 30) = 0.507309E-01
+ PKER_RDRYG( 36, 31) = 0.406479E-01
+ PKER_RDRYG( 36, 32) = 0.322672E-01
+ PKER_RDRYG( 36, 33) = 0.253008E-01
+ PKER_RDRYG( 36, 34) = 0.195243E-01
+ PKER_RDRYG( 36, 35) = 0.147772E-01
+ PKER_RDRYG( 36, 36) = 0.109648E-01
+ PKER_RDRYG( 36, 37) = 0.804278E-02
+ PKER_RDRYG( 36, 38) = 0.599708E-02
+ PKER_RDRYG( 36, 39) = 0.479430E-02
+ PKER_RDRYG( 36, 40) = 0.433950E-02
+ PKER_RDRYG( 37, 1) = 0.138648E+02
+ PKER_RDRYG( 37, 2) = 0.114770E+02
+ PKER_RDRYG( 37, 3) = 0.950025E+01
+ PKER_RDRYG( 37, 4) = 0.786381E+01
+ PKER_RDRYG( 37, 5) = 0.650909E+01
+ PKER_RDRYG( 37, 6) = 0.538759E+01
+ PKER_RDRYG( 37, 7) = 0.445916E+01
+ PKER_RDRYG( 37, 8) = 0.369056E+01
+ PKER_RDRYG( 37, 9) = 0.305428E+01
+ PKER_RDRYG( 37, 10) = 0.252753E+01
+ PKER_RDRYG( 37, 11) = 0.209147E+01
+ PKER_RDRYG( 37, 12) = 0.173047E+01
+ PKER_RDRYG( 37, 13) = 0.143161E+01
+ PKER_RDRYG( 37, 14) = 0.118421E+01
+ PKER_RDRYG( 37, 15) = 0.979386E+00
+ PKER_RDRYG( 37, 16) = 0.809823E+00
+ PKER_RDRYG( 37, 17) = 0.669447E+00
+ PKER_RDRYG( 37, 18) = 0.553232E+00
+ PKER_RDRYG( 37, 19) = 0.457019E+00
+ PKER_RDRYG( 37, 20) = 0.377364E+00
+ PKER_RDRYG( 37, 21) = 0.311415E+00
+ PKER_RDRYG( 37, 22) = 0.256813E+00
+ PKER_RDRYG( 37, 23) = 0.211602E+00
+ PKER_RDRYG( 37, 24) = 0.174166E+00
+ PKER_RDRYG( 37, 25) = 0.143165E+00
+ PKER_RDRYG( 37, 26) = 0.117489E+00
+ PKER_RDRYG( 37, 27) = 0.962203E-01
+ PKER_RDRYG( 37, 28) = 0.785973E-01
+ PKER_RDRYG( 37, 29) = 0.639902E-01
+ PKER_RDRYG( 37, 30) = 0.518768E-01
+ PKER_RDRYG( 37, 31) = 0.418245E-01
+ PKER_RDRYG( 37, 32) = 0.334758E-01
+ PKER_RDRYG( 37, 33) = 0.265367E-01
+ PKER_RDRYG( 37, 34) = 0.207701E-01
+ PKER_RDRYG( 37, 35) = 0.159926E-01
+ PKER_RDRYG( 37, 36) = 0.120751E-01
+ PKER_RDRYG( 37, 37) = 0.894122E-02
+ PKER_RDRYG( 37, 38) = 0.656445E-02
+ PKER_RDRYG( 37, 39) = 0.492634E-02
+ PKER_RDRYG( 37, 40) = 0.399357E-02
+ PKER_RDRYG( 38, 1) = 0.138656E+02
+ PKER_RDRYG( 38, 2) = 0.114778E+02
+ PKER_RDRYG( 38, 3) = 0.950102E+01
+ PKER_RDRYG( 38, 4) = 0.786459E+01
+ PKER_RDRYG( 38, 5) = 0.650987E+01
+ PKER_RDRYG( 38, 6) = 0.538837E+01
+ PKER_RDRYG( 38, 7) = 0.445994E+01
+ PKER_RDRYG( 38, 8) = 0.369135E+01
+ PKER_RDRYG( 38, 9) = 0.305507E+01
+ PKER_RDRYG( 38, 10) = 0.252833E+01
+ PKER_RDRYG( 38, 11) = 0.209226E+01
+ PKER_RDRYG( 38, 12) = 0.173127E+01
+ PKER_RDRYG( 38, 13) = 0.143242E+01
+ PKER_RDRYG( 38, 14) = 0.118501E+01
+ PKER_RDRYG( 38, 15) = 0.980197E+00
+ PKER_RDRYG( 38, 16) = 0.810638E+00
+ PKER_RDRYG( 38, 17) = 0.670266E+00
+ PKER_RDRYG( 38, 18) = 0.554056E+00
+ PKER_RDRYG( 38, 19) = 0.457849E+00
+ PKER_RDRYG( 38, 20) = 0.378199E+00
+ PKER_RDRYG( 38, 21) = 0.312257E+00
+ PKER_RDRYG( 38, 22) = 0.257661E+00
+ PKER_RDRYG( 38, 23) = 0.212459E+00
+ PKER_RDRYG( 38, 24) = 0.175032E+00
+ PKER_RDRYG( 38, 25) = 0.144040E+00
+ PKER_RDRYG( 38, 26) = 0.118376E+00
+ PKER_RDRYG( 38, 27) = 0.971196E-01
+ PKER_RDRYG( 38, 28) = 0.795116E-01
+ PKER_RDRYG( 38, 29) = 0.649218E-01
+ PKER_RDRYG( 38, 30) = 0.528285E-01
+ PKER_RDRYG( 38, 31) = 0.427994E-01
+ PKER_RDRYG( 38, 32) = 0.344764E-01
+ PKER_RDRYG( 38, 33) = 0.275637E-01
+ PKER_RDRYG( 38, 34) = 0.218184E-01
+ PKER_RDRYG( 38, 35) = 0.170452E-01
+ PKER_RDRYG( 38, 36) = 0.130949E-01
+ PKER_RDRYG( 38, 37) = 0.986356E-02
+ PKER_RDRYG( 38, 38) = 0.729306E-02
+ PKER_RDRYG( 38, 39) = 0.536046E-02
+ PKER_RDRYG( 38, 40) = 0.405286E-02
+ PKER_RDRYG( 39, 1) = 0.138662E+02
+ PKER_RDRYG( 39, 2) = 0.114784E+02
+ PKER_RDRYG( 39, 3) = 0.950168E+01
+ PKER_RDRYG( 39, 4) = 0.786525E+01
+ PKER_RDRYG( 39, 5) = 0.651053E+01
+ PKER_RDRYG( 39, 6) = 0.538904E+01
+ PKER_RDRYG( 39, 7) = 0.446061E+01
+ PKER_RDRYG( 39, 8) = 0.369202E+01
+ PKER_RDRYG( 39, 9) = 0.305574E+01
+ PKER_RDRYG( 39, 10) = 0.252900E+01
+ PKER_RDRYG( 39, 11) = 0.209294E+01
+ PKER_RDRYG( 39, 12) = 0.173195E+01
+ PKER_RDRYG( 39, 13) = 0.143310E+01
+ PKER_RDRYG( 39, 14) = 0.118570E+01
+ PKER_RDRYG( 39, 15) = 0.980885E+00
+ PKER_RDRYG( 39, 16) = 0.811330E+00
+ PKER_RDRYG( 39, 17) = 0.670961E+00
+ PKER_RDRYG( 39, 18) = 0.554755E+00
+ PKER_RDRYG( 39, 19) = 0.458552E+00
+ PKER_RDRYG( 39, 20) = 0.378906E+00
+ PKER_RDRYG( 39, 21) = 0.312969E+00
+ PKER_RDRYG( 39, 22) = 0.258379E+00
+ PKER_RDRYG( 39, 23) = 0.213182E+00
+ PKER_RDRYG( 39, 24) = 0.175762E+00
+ PKER_RDRYG( 39, 25) = 0.144777E+00
+ PKER_RDRYG( 39, 26) = 0.119121E+00
+ PKER_RDRYG( 39, 27) = 0.978744E-01
+ PKER_RDRYG( 39, 28) = 0.802773E-01
+ PKER_RDRYG( 39, 29) = 0.657001E-01
+ PKER_RDRYG( 39, 30) = 0.536215E-01
+ PKER_RDRYG( 39, 31) = 0.436093E-01
+ PKER_RDRYG( 39, 32) = 0.353058E-01
+ PKER_RDRYG( 39, 33) = 0.284146E-01
+ PKER_RDRYG( 39, 34) = 0.226909E-01
+ PKER_RDRYG( 39, 35) = 0.179343E-01
+ PKER_RDRYG( 39, 36) = 0.139841E-01
+ PKER_RDRYG( 39, 37) = 0.107183E-01
+ PKER_RDRYG( 39, 38) = 0.805446E-02
+ PKER_RDRYG( 39, 39) = 0.594845E-02
+ PKER_RDRYG( 39, 40) = 0.437943E-02
+ PKER_RDRYG( 40, 1) = 0.138668E+02
+ PKER_RDRYG( 40, 2) = 0.114790E+02
+ PKER_RDRYG( 40, 3) = 0.950225E+01
+ PKER_RDRYG( 40, 4) = 0.786581E+01
+ PKER_RDRYG( 40, 5) = 0.651110E+01
+ PKER_RDRYG( 40, 6) = 0.538960E+01
+ PKER_RDRYG( 40, 7) = 0.446118E+01
+ PKER_RDRYG( 40, 8) = 0.369259E+01
+ PKER_RDRYG( 40, 9) = 0.305631E+01
+ PKER_RDRYG( 40, 10) = 0.252958E+01
+ PKER_RDRYG( 40, 11) = 0.209352E+01
+ PKER_RDRYG( 40, 12) = 0.173253E+01
+ PKER_RDRYG( 40, 13) = 0.143368E+01
+ PKER_RDRYG( 40, 14) = 0.118628E+01
+ PKER_RDRYG( 40, 15) = 0.981470E+00
+ PKER_RDRYG( 40, 16) = 0.811917E+00
+ PKER_RDRYG( 40, 17) = 0.671551E+00
+ PKER_RDRYG( 40, 18) = 0.555348E+00
+ PKER_RDRYG( 40, 19) = 0.459148E+00
+ PKER_RDRYG( 40, 20) = 0.379506E+00
+ PKER_RDRYG( 40, 21) = 0.313572E+00
+ PKER_RDRYG( 40, 22) = 0.258986E+00
+ PKER_RDRYG( 40, 23) = 0.213794E+00
+ PKER_RDRYG( 40, 24) = 0.176378E+00
+ PKER_RDRYG( 40, 25) = 0.145399E+00
+ PKER_RDRYG( 40, 26) = 0.119749E+00
+ PKER_RDRYG( 40, 27) = 0.985094E-01
+ PKER_RDRYG( 40, 28) = 0.809202E-01
+ PKER_RDRYG( 40, 29) = 0.663522E-01
+ PKER_RDRYG( 40, 30) = 0.542842E-01
+ PKER_RDRYG( 40, 31) = 0.442844E-01
+ PKER_RDRYG( 40, 32) = 0.359952E-01
+ PKER_RDRYG( 40, 33) = 0.291205E-01
+ PKER_RDRYG( 40, 34) = 0.234148E-01
+ PKER_RDRYG( 40, 35) = 0.186756E-01
+ PKER_RDRYG( 40, 36) = 0.147376E-01
+ PKER_RDRYG( 40, 37) = 0.114686E-01
+ PKER_RDRYG( 40, 38) = 0.876977E-02
+ PKER_RDRYG( 40, 39) = 0.657521E-02
+ PKER_RDRYG( 40, 40) = 0.484891E-02
+END IF
+!
+END SUBROUTINE READ_XKER_RDRYG
diff --git a/src/mesonh/micro/read_xker_rweth.f90 b/src/mesonh/micro/read_xker_rweth.f90
new file mode 100644
index 000000000..8093eeb0d
--- /dev/null
+++ b/src/mesonh/micro/read_xker_rweth.f90
@@ -0,0 +1,1733 @@
+!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+! ######spl
+ MODULE MODI_READ_XKER_RWETH
+! ###########################
+!
+INTERFACE
+ SUBROUTINE READ_XKER_RWETH (KWETLBDAH,KWETLBDAR,KND, &
+ PALPHAH,PNUH,PALPHAR,PNUR,PEHR,PBR,PCH,PDH,PCR,PDR, &
+ PWETLBDAH_MAX,PWETLBDAR_MAX,PWETLBDAH_MIN,PWETLBDAR_MIN, &
+ PFDINFTY,PKER_RWETH )
+!
+IMPLICIT NONE
+INTEGER, INTENT(OUT) :: KND,KWETLBDAH,KWETLBDAR
+REAL, INTENT(OUT) :: PALPHAH
+REAL, INTENT(OUT) :: PNUH
+REAL, INTENT(OUT) :: PALPHAR
+REAL, INTENT(OUT) :: PNUR
+REAL, INTENT(OUT) :: PEHR
+REAL, INTENT(OUT) :: PBR
+REAL, INTENT(OUT) :: PCH
+REAL, INTENT(OUT) :: PDH
+REAL, INTENT(OUT) :: PCR
+REAL, INTENT(OUT) :: PDR
+REAL, INTENT(OUT) :: PWETLBDAH_MAX
+REAL, INTENT(OUT) :: PWETLBDAR_MAX
+REAL, INTENT(OUT) :: PWETLBDAH_MIN
+REAL, INTENT(OUT) :: PWETLBDAR_MIN
+REAL, INTENT(OUT) :: PFDINFTY
+REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_RWETH
+!
+END SUBROUTINE
+!
+END INTERFACE
+!
+END MODULE MODI_READ_XKER_RWETH
+! ######spl
+ SUBROUTINE READ_XKER_RWETH (KWETLBDAH,KWETLBDAR,KND, &
+ PALPHAH,PNUH,PALPHAR,PNUR,PEHR,PBR,PCH,PDH,PCR,PDR, &
+ PWETLBDAH_MAX,PWETLBDAR_MAX,PWETLBDAH_MIN,PWETLBDAR_MIN, &
+ PFDINFTY,PKER_RWETH )
+!DEC$ OPTIMIZE:0
+! ########################################################################
+!
+!!**** * * - initialize the kernels for the rain-hail wet growth process
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to initialize the kernels PKER_RWETH
+!! prepared from a previous run of the routine INI_RAIN_ICE. The reading of
+!! the kernels is optional after checking for the dimensions of the arrays.
+!!
+!!** METHOD
+!! ------
+!!
+!!
+!! EXTERNAL
+!! --------
+!! None
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation ( routine READ_XKER_RWETH )
+!!
+!! AUTHOR
+!! ------
+!! S. Riette
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 6 Mar 2015
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!* 0.2 Declarations of local variables :
+!
+!
+IMPLICIT NONE
+INTEGER, INTENT(OUT) :: KND,KWETLBDAH,KWETLBDAR
+REAL, INTENT(OUT) :: PALPHAH
+REAL, INTENT(OUT) :: PNUH
+REAL, INTENT(OUT) :: PALPHAR
+REAL, INTENT(OUT) :: PNUR
+REAL, INTENT(OUT) :: PEHR
+REAL, INTENT(OUT) :: PBR
+REAL, INTENT(OUT) :: PCH
+REAL, INTENT(OUT) :: PDH
+REAL, INTENT(OUT) :: PCR
+REAL, INTENT(OUT) :: PDR
+REAL, INTENT(OUT) :: PWETLBDAH_MAX
+REAL, INTENT(OUT) :: PWETLBDAR_MAX
+REAL, INTENT(OUT) :: PWETLBDAH_MIN
+REAL, INTENT(OUT) :: PWETLBDAR_MIN
+REAL, INTENT(OUT) :: PFDINFTY
+REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_RWETH
+!
+! ###################################################################
+! #INSERT HERE THE OUTPUT OF INI_RAIN_ICE IF THE KERNELS ARE UPDATED#
+! ###################################################################
+!
+KND= 50
+KWETLBDAH= 40
+KWETLBDAR= 40
+PALPHAH= 0.100000E+01
+PNUH= 0.800000E+01
+PALPHAR= 0.100000E+01
+PNUR= 0.100000E+01
+PEHR= 0.100000E+01
+PBR= 0.300000E+01
+PCH= 0.207000E+03
+PDH= 0.640000E+00
+PCR= 0.842000E+03
+PDR= 0.800000E+00
+PWETLBDAH_MAX= 0.100000E+08
+PWETLBDAR_MAX= 0.100000E+08
+PWETLBDAH_MIN= 0.100000E+04
+PWETLBDAR_MIN= 0.100000E+04
+PFDINFTY= 0.200000E+02
+!
+IF( PRESENT(PKER_RWETH) ) THEN
+ PKER_RWETH( 1, 1) = 0.402762E+01
+ PKER_RWETH( 1, 2) = 0.360940E+01
+ PKER_RWETH( 1, 3) = 0.394235E+01
+ PKER_RWETH( 1, 4) = 0.470822E+01
+ PKER_RWETH( 1, 5) = 0.561595E+01
+ PKER_RWETH( 1, 6) = 0.648059E+01
+ PKER_RWETH( 1, 7) = 0.722764E+01
+ PKER_RWETH( 1, 8) = 0.784765E+01
+ PKER_RWETH( 1, 9) = 0.835593E+01
+ PKER_RWETH( 1, 10) = 0.877187E+01
+ PKER_RWETH( 1, 11) = 0.911259E+01
+ PKER_RWETH( 1, 12) = 0.939210E+01
+ PKER_RWETH( 1, 13) = 0.962170E+01
+ PKER_RWETH( 1, 14) = 0.981053E+01
+ PKER_RWETH( 1, 15) = 0.996598E+01
+ PKER_RWETH( 1, 16) = 0.100940E+02
+ PKER_RWETH( 1, 17) = 0.101996E+02
+ PKER_RWETH( 1, 18) = 0.102867E+02
+ PKER_RWETH( 1, 19) = 0.103586E+02
+ PKER_RWETH( 1, 20) = 0.104179E+02
+ PKER_RWETH( 1, 21) = 0.104669E+02
+ PKER_RWETH( 1, 22) = 0.105074E+02
+ PKER_RWETH( 1, 23) = 0.105409E+02
+ PKER_RWETH( 1, 24) = 0.105685E+02
+ PKER_RWETH( 1, 25) = 0.105914E+02
+ PKER_RWETH( 1, 26) = 0.106103E+02
+ PKER_RWETH( 1, 27) = 0.106259E+02
+ PKER_RWETH( 1, 28) = 0.106388E+02
+ PKER_RWETH( 1, 29) = 0.106494E+02
+ PKER_RWETH( 1, 30) = 0.106583E+02
+ PKER_RWETH( 1, 31) = 0.106656E+02
+ PKER_RWETH( 1, 32) = 0.106716E+02
+ PKER_RWETH( 1, 33) = 0.106766E+02
+ PKER_RWETH( 1, 34) = 0.106807E+02
+ PKER_RWETH( 1, 35) = 0.106842E+02
+ PKER_RWETH( 1, 36) = 0.106870E+02
+ PKER_RWETH( 1, 37) = 0.106893E+02
+ PKER_RWETH( 1, 38) = 0.106913E+02
+ PKER_RWETH( 1, 39) = 0.106929E+02
+ PKER_RWETH( 1, 40) = 0.106942E+02
+ PKER_RWETH( 2, 1) = 0.438807E+01
+ PKER_RWETH( 2, 2) = 0.333752E+01
+ PKER_RWETH( 2, 3) = 0.311028E+01
+ PKER_RWETH( 2, 4) = 0.348499E+01
+ PKER_RWETH( 2, 5) = 0.418314E+01
+ PKER_RWETH( 2, 6) = 0.496720E+01
+ PKER_RWETH( 2, 7) = 0.569617E+01
+ PKER_RWETH( 2, 8) = 0.631912E+01
+ PKER_RWETH( 2, 9) = 0.683403E+01
+ PKER_RWETH( 2, 10) = 0.725566E+01
+ PKER_RWETH( 2, 11) = 0.760059E+01
+ PKER_RWETH( 2, 12) = 0.788312E+01
+ PKER_RWETH( 2, 13) = 0.811488E+01
+ PKER_RWETH( 2, 14) = 0.830526E+01
+ PKER_RWETH( 2, 15) = 0.846182E+01
+ PKER_RWETH( 2, 16) = 0.859069E+01
+ PKER_RWETH( 2, 17) = 0.869686E+01
+ PKER_RWETH( 2, 18) = 0.878439E+01
+ PKER_RWETH( 2, 19) = 0.885658E+01
+ PKER_RWETH( 2, 20) = 0.891616E+01
+ PKER_RWETH( 2, 21) = 0.896534E+01
+ PKER_RWETH( 2, 22) = 0.900596E+01
+ PKER_RWETH( 2, 23) = 0.903951E+01
+ PKER_RWETH( 2, 24) = 0.906722E+01
+ PKER_RWETH( 2, 25) = 0.909013E+01
+ PKER_RWETH( 2, 26) = 0.910906E+01
+ PKER_RWETH( 2, 27) = 0.912471E+01
+ PKER_RWETH( 2, 28) = 0.913765E+01
+ PKER_RWETH( 2, 29) = 0.914834E+01
+ PKER_RWETH( 2, 30) = 0.915719E+01
+ PKER_RWETH( 2, 31) = 0.916450E+01
+ PKER_RWETH( 2, 32) = 0.917055E+01
+ PKER_RWETH( 2, 33) = 0.917555E+01
+ PKER_RWETH( 2, 34) = 0.917969E+01
+ PKER_RWETH( 2, 35) = 0.918311E+01
+ PKER_RWETH( 2, 36) = 0.918594E+01
+ PKER_RWETH( 2, 37) = 0.918828E+01
+ PKER_RWETH( 2, 38) = 0.919022E+01
+ PKER_RWETH( 2, 39) = 0.919182E+01
+ PKER_RWETH( 2, 40) = 0.919315E+01
+ PKER_RWETH( 3, 1) = 0.511774E+01
+ PKER_RWETH( 3, 2) = 0.355317E+01
+ PKER_RWETH( 3, 3) = 0.278395E+01
+ PKER_RWETH( 3, 4) = 0.269701E+01
+ PKER_RWETH( 3, 5) = 0.308711E+01
+ PKER_RWETH( 3, 6) = 0.371510E+01
+ PKER_RWETH( 3, 7) = 0.438830E+01
+ PKER_RWETH( 3, 8) = 0.500120E+01
+ PKER_RWETH( 3, 9) = 0.552011E+01
+ PKER_RWETH( 3, 10) = 0.594762E+01
+ PKER_RWETH( 3, 11) = 0.629736E+01
+ PKER_RWETH( 3, 12) = 0.658342E+01
+ PKER_RWETH( 3, 13) = 0.681772E+01
+ PKER_RWETH( 3, 14) = 0.700990E+01
+ PKER_RWETH( 3, 15) = 0.716776E+01
+ PKER_RWETH( 3, 16) = 0.729757E+01
+ PKER_RWETH( 3, 17) = 0.740442E+01
+ PKER_RWETH( 3, 18) = 0.749244E+01
+ PKER_RWETH( 3, 19) = 0.756500E+01
+ PKER_RWETH( 3, 20) = 0.762484E+01
+ PKER_RWETH( 3, 21) = 0.767423E+01
+ PKER_RWETH( 3, 22) = 0.771499E+01
+ PKER_RWETH( 3, 23) = 0.774866E+01
+ PKER_RWETH( 3, 24) = 0.777646E+01
+ PKER_RWETH( 3, 25) = 0.779943E+01
+ PKER_RWETH( 3, 26) = 0.781841E+01
+ PKER_RWETH( 3, 27) = 0.783410E+01
+ PKER_RWETH( 3, 28) = 0.784707E+01
+ PKER_RWETH( 3, 29) = 0.785779E+01
+ PKER_RWETH( 3, 30) = 0.786665E+01
+ PKER_RWETH( 3, 31) = 0.787398E+01
+ PKER_RWETH( 3, 32) = 0.788004E+01
+ PKER_RWETH( 3, 33) = 0.788505E+01
+ PKER_RWETH( 3, 34) = 0.788919E+01
+ PKER_RWETH( 3, 35) = 0.789262E+01
+ PKER_RWETH( 3, 36) = 0.789545E+01
+ PKER_RWETH( 3, 37) = 0.789780E+01
+ PKER_RWETH( 3, 38) = 0.789974E+01
+ PKER_RWETH( 3, 39) = 0.790134E+01
+ PKER_RWETH( 3, 40) = 0.790267E+01
+ PKER_RWETH( 4, 1) = 0.603974E+01
+ PKER_RWETH( 4, 2) = 0.410879E+01
+ PKER_RWETH( 4, 3) = 0.288715E+01
+ PKER_RWETH( 4, 4) = 0.233851E+01
+ PKER_RWETH( 4, 5) = 0.235142E+01
+ PKER_RWETH( 4, 6) = 0.273888E+01
+ PKER_RWETH( 4, 7) = 0.329704E+01
+ PKER_RWETH( 4, 8) = 0.387228E+01
+ PKER_RWETH( 4, 9) = 0.438639E+01
+ PKER_RWETH( 4, 10) = 0.481827E+01
+ PKER_RWETH( 4, 11) = 0.517314E+01
+ PKER_RWETH( 4, 12) = 0.546325E+01
+ PKER_RWETH( 4, 13) = 0.570050E+01
+ PKER_RWETH( 4, 14) = 0.589481E+01
+ PKER_RWETH( 4, 15) = 0.605418E+01
+ PKER_RWETH( 4, 16) = 0.618508E+01
+ PKER_RWETH( 4, 17) = 0.629272E+01
+ PKER_RWETH( 4, 18) = 0.638131E+01
+ PKER_RWETH( 4, 19) = 0.645429E+01
+ PKER_RWETH( 4, 20) = 0.651445E+01
+ PKER_RWETH( 4, 21) = 0.656406E+01
+ PKER_RWETH( 4, 22) = 0.660500E+01
+ PKER_RWETH( 4, 23) = 0.663879E+01
+ PKER_RWETH( 4, 24) = 0.666669E+01
+ PKER_RWETH( 4, 25) = 0.668973E+01
+ PKER_RWETH( 4, 26) = 0.670877E+01
+ PKER_RWETH( 4, 27) = 0.672450E+01
+ PKER_RWETH( 4, 28) = 0.673750E+01
+ PKER_RWETH( 4, 29) = 0.674825E+01
+ PKER_RWETH( 4, 30) = 0.675713E+01
+ PKER_RWETH( 4, 31) = 0.676447E+01
+ PKER_RWETH( 4, 32) = 0.677054E+01
+ PKER_RWETH( 4, 33) = 0.677556E+01
+ PKER_RWETH( 4, 34) = 0.677972E+01
+ PKER_RWETH( 4, 35) = 0.678315E+01
+ PKER_RWETH( 4, 36) = 0.678599E+01
+ PKER_RWETH( 4, 37) = 0.678834E+01
+ PKER_RWETH( 4, 38) = 0.679028E+01
+ PKER_RWETH( 4, 39) = 0.679189E+01
+ PKER_RWETH( 4, 40) = 0.679321E+01
+ PKER_RWETH( 5, 1) = 0.701523E+01
+ PKER_RWETH( 5, 2) = 0.485290E+01
+ PKER_RWETH( 5, 3) = 0.330114E+01
+ PKER_RWETH( 5, 4) = 0.235568E+01
+ PKER_RWETH( 5, 5) = 0.197832E+01
+ PKER_RWETH( 5, 6) = 0.205971E+01
+ PKER_RWETH( 5, 7) = 0.243216E+01
+ PKER_RWETH( 5, 8) = 0.292372E+01
+ PKER_RWETH( 5, 9) = 0.341291E+01
+ PKER_RWETH( 5, 10) = 0.384329E+01
+ PKER_RWETH( 5, 11) = 0.420248E+01
+ PKER_RWETH( 5, 12) = 0.449701E+01
+ PKER_RWETH( 5, 13) = 0.473767E+01
+ PKER_RWETH( 5, 14) = 0.493445E+01
+ PKER_RWETH( 5, 15) = 0.509560E+01
+ PKER_RWETH( 5, 16) = 0.522777E+01
+ PKER_RWETH( 5, 17) = 0.533633E+01
+ PKER_RWETH( 5, 18) = 0.542559E+01
+ PKER_RWETH( 5, 19) = 0.549905E+01
+ PKER_RWETH( 5, 20) = 0.555956E+01
+ PKER_RWETH( 5, 21) = 0.560943E+01
+ PKER_RWETH( 5, 22) = 0.565056E+01
+ PKER_RWETH( 5, 23) = 0.568450E+01
+ PKER_RWETH( 5, 24) = 0.571251E+01
+ PKER_RWETH( 5, 25) = 0.573564E+01
+ PKER_RWETH( 5, 26) = 0.575474E+01
+ PKER_RWETH( 5, 27) = 0.577052E+01
+ PKER_RWETH( 5, 28) = 0.578355E+01
+ PKER_RWETH( 5, 29) = 0.579433E+01
+ PKER_RWETH( 5, 30) = 0.580323E+01
+ PKER_RWETH( 5, 31) = 0.581059E+01
+ PKER_RWETH( 5, 32) = 0.581668E+01
+ PKER_RWETH( 5, 33) = 0.582171E+01
+ PKER_RWETH( 5, 34) = 0.582587E+01
+ PKER_RWETH( 5, 35) = 0.582931E+01
+ PKER_RWETH( 5, 36) = 0.583215E+01
+ PKER_RWETH( 5, 37) = 0.583450E+01
+ PKER_RWETH( 5, 38) = 0.583645E+01
+ PKER_RWETH( 5, 39) = 0.583806E+01
+ PKER_RWETH( 5, 40) = 0.583939E+01
+ PKER_RWETH( 6, 1) = 0.795455E+01
+ PKER_RWETH( 6, 2) = 0.566068E+01
+ PKER_RWETH( 6, 3) = 0.389662E+01
+ PKER_RWETH( 6, 4) = 0.265525E+01
+ PKER_RWETH( 6, 5) = 0.193212E+01
+ PKER_RWETH( 6, 6) = 0.168546E+01
+ PKER_RWETH( 6, 7) = 0.181153E+01
+ PKER_RWETH( 6, 8) = 0.216086E+01
+ PKER_RWETH( 6, 9) = 0.259008E+01
+ PKER_RWETH( 6, 10) = 0.300451E+01
+ PKER_RWETH( 6, 11) = 0.336420E+01
+ PKER_RWETH( 6, 12) = 0.366278E+01
+ PKER_RWETH( 6, 13) = 0.390721E+01
+ PKER_RWETH( 6, 14) = 0.410685E+01
+ PKER_RWETH( 6, 15) = 0.427007E+01
+ PKER_RWETH( 6, 16) = 0.440373E+01
+ PKER_RWETH( 6, 17) = 0.451336E+01
+ PKER_RWETH( 6, 18) = 0.460339E+01
+ PKER_RWETH( 6, 19) = 0.467741E+01
+ PKER_RWETH( 6, 20) = 0.473833E+01
+ PKER_RWETH( 6, 21) = 0.478850E+01
+ PKER_RWETH( 6, 22) = 0.482985E+01
+ PKER_RWETH( 6, 23) = 0.486395E+01
+ PKER_RWETH( 6, 24) = 0.489209E+01
+ PKER_RWETH( 6, 25) = 0.491531E+01
+ PKER_RWETH( 6, 26) = 0.493448E+01
+ PKER_RWETH( 6, 27) = 0.495031E+01
+ PKER_RWETH( 6, 28) = 0.496339E+01
+ PKER_RWETH( 6, 29) = 0.497420E+01
+ PKER_RWETH( 6, 30) = 0.498312E+01
+ PKER_RWETH( 6, 31) = 0.499050E+01
+ PKER_RWETH( 6, 32) = 0.499660E+01
+ PKER_RWETH( 6, 33) = 0.500165E+01
+ PKER_RWETH( 6, 34) = 0.500581E+01
+ PKER_RWETH( 6, 35) = 0.500926E+01
+ PKER_RWETH( 6, 36) = 0.501211E+01
+ PKER_RWETH( 6, 37) = 0.501447E+01
+ PKER_RWETH( 6, 38) = 0.501641E+01
+ PKER_RWETH( 6, 39) = 0.501803E+01
+ PKER_RWETH( 6, 40) = 0.501936E+01
+ PKER_RWETH( 7, 1) = 0.881081E+01
+ PKER_RWETH( 7, 2) = 0.644923E+01
+ PKER_RWETH( 7, 3) = 0.456302E+01
+ PKER_RWETH( 7, 4) = 0.312729E+01
+ PKER_RWETH( 7, 5) = 0.213937E+01
+ PKER_RWETH( 7, 6) = 0.159348E+01
+ PKER_RWETH( 7, 7) = 0.144580E+01
+ PKER_RWETH( 7, 8) = 0.159857E+01
+ PKER_RWETH( 7, 9) = 0.191990E+01
+ PKER_RWETH( 7, 10) = 0.229195E+01
+ PKER_RWETH( 7, 11) = 0.264196E+01
+ PKER_RWETH( 7, 12) = 0.294215E+01
+ PKER_RWETH( 7, 13) = 0.319025E+01
+ PKER_RWETH( 7, 14) = 0.339309E+01
+ PKER_RWETH( 7, 15) = 0.355870E+01
+ PKER_RWETH( 7, 16) = 0.369410E+01
+ PKER_RWETH( 7, 17) = 0.380497E+01
+ PKER_RWETH( 7, 18) = 0.389590E+01
+ PKER_RWETH( 7, 19) = 0.397057E+01
+ PKER_RWETH( 7, 20) = 0.403196E+01
+ PKER_RWETH( 7, 21) = 0.408248E+01
+ PKER_RWETH( 7, 22) = 0.412408E+01
+ PKER_RWETH( 7, 23) = 0.415837E+01
+ PKER_RWETH( 7, 24) = 0.418665E+01
+ PKER_RWETH( 7, 25) = 0.420997E+01
+ PKER_RWETH( 7, 26) = 0.422922E+01
+ PKER_RWETH( 7, 27) = 0.424512E+01
+ PKER_RWETH( 7, 28) = 0.425824E+01
+ PKER_RWETH( 7, 29) = 0.426908E+01
+ PKER_RWETH( 7, 30) = 0.427804E+01
+ PKER_RWETH( 7, 31) = 0.428544E+01
+ PKER_RWETH( 7, 32) = 0.429155E+01
+ PKER_RWETH( 7, 33) = 0.429661E+01
+ PKER_RWETH( 7, 34) = 0.430079E+01
+ PKER_RWETH( 7, 35) = 0.430424E+01
+ PKER_RWETH( 7, 36) = 0.430710E+01
+ PKER_RWETH( 7, 37) = 0.430946E+01
+ PKER_RWETH( 7, 38) = 0.431141E+01
+ PKER_RWETH( 7, 39) = 0.431302E+01
+ PKER_RWETH( 7, 40) = 0.431436E+01
+ PKER_RWETH( 8, 1) = 0.956627E+01
+ PKER_RWETH( 8, 2) = 0.717320E+01
+ PKER_RWETH( 8, 3) = 0.522361E+01
+ PKER_RWETH( 8, 4) = 0.367446E+01
+ PKER_RWETH( 8, 5) = 0.250914E+01
+ PKER_RWETH( 8, 6) = 0.172781E+01
+ PKER_RWETH( 8, 7) = 0.132243E+01
+ PKER_RWETH( 8, 8) = 0.124848E+01
+ PKER_RWETH( 8, 9) = 0.141419E+01
+ PKER_RWETH( 8, 10) = 0.170540E+01
+ PKER_RWETH( 8, 11) = 0.202584E+01
+ PKER_RWETH( 8, 12) = 0.232058E+01
+ PKER_RWETH( 8, 13) = 0.257083E+01
+ PKER_RWETH( 8, 14) = 0.277692E+01
+ PKER_RWETH( 8, 15) = 0.294524E+01
+ PKER_RWETH( 8, 16) = 0.308264E+01
+ PKER_RWETH( 8, 17) = 0.319496E+01
+ PKER_RWETH( 8, 18) = 0.328694E+01
+ PKER_RWETH( 8, 19) = 0.336236E+01
+ PKER_RWETH( 8, 20) = 0.342430E+01
+ PKER_RWETH( 8, 21) = 0.347521E+01
+ PKER_RWETH( 8, 22) = 0.351711E+01
+ PKER_RWETH( 8, 23) = 0.355161E+01
+ PKER_RWETH( 8, 24) = 0.358005E+01
+ PKER_RWETH( 8, 25) = 0.360349E+01
+ PKER_RWETH( 8, 26) = 0.362283E+01
+ PKER_RWETH( 8, 27) = 0.363879E+01
+ PKER_RWETH( 8, 28) = 0.365197E+01
+ PKER_RWETH( 8, 29) = 0.366285E+01
+ PKER_RWETH( 8, 30) = 0.367183E+01
+ PKER_RWETH( 8, 31) = 0.367926E+01
+ PKER_RWETH( 8, 32) = 0.368539E+01
+ PKER_RWETH( 8, 33) = 0.369046E+01
+ PKER_RWETH( 8, 34) = 0.369465E+01
+ PKER_RWETH( 8, 35) = 0.369811E+01
+ PKER_RWETH( 8, 36) = 0.370097E+01
+ PKER_RWETH( 8, 37) = 0.370334E+01
+ PKER_RWETH( 8, 38) = 0.370530E+01
+ PKER_RWETH( 8, 39) = 0.370691E+01
+ PKER_RWETH( 8, 40) = 0.370825E+01
+ PKER_RWETH( 9, 1) = 0.102200E+02
+ PKER_RWETH( 9, 2) = 0.781427E+01
+ PKER_RWETH( 9, 3) = 0.583508E+01
+ PKER_RWETH( 9, 4) = 0.422651E+01
+ PKER_RWETH( 9, 5) = 0.295601E+01
+ PKER_RWETH( 9, 6) = 0.201318E+01
+ PKER_RWETH( 9, 7) = 0.139951E+01
+ PKER_RWETH( 9, 8) = 0.110495E+01
+ PKER_RWETH( 9, 9) = 0.108447E+01
+ PKER_RWETH( 9, 10) = 0.125349E+01
+ PKER_RWETH( 9, 11) = 0.151396E+01
+ PKER_RWETH( 9, 12) = 0.178854E+01
+ PKER_RWETH( 9, 13) = 0.203611E+01
+ PKER_RWETH( 9, 14) = 0.224455E+01
+ PKER_RWETH( 9, 15) = 0.241570E+01
+ PKER_RWETH( 9, 16) = 0.255537E+01
+ PKER_RWETH( 9, 17) = 0.266938E+01
+ PKER_RWETH( 9, 18) = 0.276256E+01
+ PKER_RWETH( 9, 19) = 0.283887E+01
+ PKER_RWETH( 9, 20) = 0.290144E+01
+ PKER_RWETH( 9, 21) = 0.295281E+01
+ PKER_RWETH( 9, 22) = 0.299504E+01
+ PKER_RWETH( 9, 23) = 0.302979E+01
+ PKER_RWETH( 9, 24) = 0.305841E+01
+ PKER_RWETH( 9, 25) = 0.308199E+01
+ PKER_RWETH( 9, 26) = 0.310143E+01
+ PKER_RWETH( 9, 27) = 0.311747E+01
+ PKER_RWETH( 9, 28) = 0.313070E+01
+ PKER_RWETH( 9, 29) = 0.314162E+01
+ PKER_RWETH( 9, 30) = 0.315064E+01
+ PKER_RWETH( 9, 31) = 0.315809E+01
+ PKER_RWETH( 9, 32) = 0.316424E+01
+ PKER_RWETH( 9, 33) = 0.316933E+01
+ PKER_RWETH( 9, 34) = 0.317353E+01
+ PKER_RWETH( 9, 35) = 0.317700E+01
+ PKER_RWETH( 9, 36) = 0.317987E+01
+ PKER_RWETH( 9, 37) = 0.318224E+01
+ PKER_RWETH( 9, 38) = 0.318420E+01
+ PKER_RWETH( 9, 39) = 0.318582E+01
+ PKER_RWETH( 9, 40) = 0.318716E+01
+ PKER_RWETH( 10, 1) = 0.107794E+02
+ PKER_RWETH( 10, 2) = 0.837003E+01
+ PKER_RWETH( 10, 3) = 0.637887E+01
+ PKER_RWETH( 10, 4) = 0.474241E+01
+ PKER_RWETH( 10, 5) = 0.341615E+01
+ PKER_RWETH( 10, 6) = 0.237589E+01
+ PKER_RWETH( 10, 7) = 0.161585E+01
+ PKER_RWETH( 10, 8) = 0.113766E+01
+ PKER_RWETH( 10, 9) = 0.929743E+00
+ PKER_RWETH( 10, 10) = 0.946883E+00
+ PKER_RWETH( 10, 11) = 0.111245E+01
+ PKER_RWETH( 10, 12) = 0.134310E+01
+ PKER_RWETH( 10, 13) = 0.157719E+01
+ PKER_RWETH( 10, 14) = 0.178469E+01
+ PKER_RWETH( 10, 15) = 0.195816E+01
+ PKER_RWETH( 10, 16) = 0.210028E+01
+ PKER_RWETH( 10, 17) = 0.221619E+01
+ PKER_RWETH( 10, 18) = 0.231078E+01
+ PKER_RWETH( 10, 19) = 0.238810E+01
+ PKER_RWETH( 10, 20) = 0.245141E+01
+ PKER_RWETH( 10, 21) = 0.250332E+01
+ PKER_RWETH( 10, 22) = 0.254594E+01
+ PKER_RWETH( 10, 23) = 0.258097E+01
+ PKER_RWETH( 10, 24) = 0.260979E+01
+ PKER_RWETH( 10, 25) = 0.263353E+01
+ PKER_RWETH( 10, 26) = 0.265308E+01
+ PKER_RWETH( 10, 27) = 0.266921E+01
+ PKER_RWETH( 10, 28) = 0.268250E+01
+ PKER_RWETH( 10, 29) = 0.269348E+01
+ PKER_RWETH( 10, 30) = 0.270253E+01
+ PKER_RWETH( 10, 31) = 0.271001E+01
+ PKER_RWETH( 10, 32) = 0.271618E+01
+ PKER_RWETH( 10, 33) = 0.272129E+01
+ PKER_RWETH( 10, 34) = 0.272550E+01
+ PKER_RWETH( 10, 35) = 0.272898E+01
+ PKER_RWETH( 10, 36) = 0.273186E+01
+ PKER_RWETH( 10, 37) = 0.273424E+01
+ PKER_RWETH( 10, 38) = 0.273620E+01
+ PKER_RWETH( 10, 39) = 0.273783E+01
+ PKER_RWETH( 10, 40) = 0.273917E+01
+ PKER_RWETH( 11, 1) = 0.112547E+02
+ PKER_RWETH( 11, 2) = 0.884593E+01
+ PKER_RWETH( 11, 3) = 0.685131E+01
+ PKER_RWETH( 11, 4) = 0.520348E+01
+ PKER_RWETH( 11, 5) = 0.385081E+01
+ PKER_RWETH( 11, 6) = 0.275817E+01
+ PKER_RWETH( 11, 7) = 0.190805E+01
+ PKER_RWETH( 11, 8) = 0.129789E+01
+ PKER_RWETH( 11, 9) = 0.929130E+00
+ PKER_RWETH( 11, 10) = 0.787911E+00
+ PKER_RWETH( 11, 11) = 0.830555E+00
+ PKER_RWETH( 11, 12) = 0.988070E+00
+ PKER_RWETH( 11, 13) = 0.119042E+01
+ PKER_RWETH( 11, 14) = 0.138918E+01
+ PKER_RWETH( 11, 15) = 0.156279E+01
+ PKER_RWETH( 11, 16) = 0.170708E+01
+ PKER_RWETH( 11, 17) = 0.182507E+01
+ PKER_RWETH( 11, 18) = 0.192127E+01
+ PKER_RWETH( 11, 19) = 0.199976E+01
+ PKER_RWETH( 11, 20) = 0.206392E+01
+ PKER_RWETH( 11, 21) = 0.211645E+01
+ PKER_RWETH( 11, 22) = 0.215952E+01
+ PKER_RWETH( 11, 23) = 0.219488E+01
+ PKER_RWETH( 11, 24) = 0.222394E+01
+ PKER_RWETH( 11, 25) = 0.224785E+01
+ PKER_RWETH( 11, 26) = 0.226753E+01
+ PKER_RWETH( 11, 27) = 0.228375E+01
+ PKER_RWETH( 11, 28) = 0.229712E+01
+ PKER_RWETH( 11, 29) = 0.230815E+01
+ PKER_RWETH( 11, 30) = 0.231725E+01
+ PKER_RWETH( 11, 31) = 0.232476E+01
+ PKER_RWETH( 11, 32) = 0.233096E+01
+ PKER_RWETH( 11, 33) = 0.233608E+01
+ PKER_RWETH( 11, 34) = 0.234031E+01
+ PKER_RWETH( 11, 35) = 0.234380E+01
+ PKER_RWETH( 11, 36) = 0.234669E+01
+ PKER_RWETH( 11, 37) = 0.234907E+01
+ PKER_RWETH( 11, 38) = 0.235104E+01
+ PKER_RWETH( 11, 39) = 0.235267E+01
+ PKER_RWETH( 11, 40) = 0.235402E+01
+ PKER_RWETH( 12, 1) = 0.116571E+02
+ PKER_RWETH( 12, 2) = 0.925058E+01
+ PKER_RWETH( 12, 3) = 0.725629E+01
+ PKER_RWETH( 12, 4) = 0.560505E+01
+ PKER_RWETH( 12, 5) = 0.424152E+01
+ PKER_RWETH( 12, 6) = 0.312383E+01
+ PKER_RWETH( 12, 7) = 0.222456E+01
+ PKER_RWETH( 12, 8) = 0.153134E+01
+ PKER_RWETH( 12, 9) = 0.104379E+01
+ PKER_RWETH( 12, 10) = 0.762641E+00
+ PKER_RWETH( 12, 11) = 0.672444E+00
+ PKER_RWETH( 12, 12) = 0.731332E+00
+ PKER_RWETH( 12, 13) = 0.877846E+00
+ PKER_RWETH( 12, 14) = 0.105398E+01
+ PKER_RWETH( 12, 15) = 0.122217E+01
+ PKER_RWETH( 12, 16) = 0.136721E+01
+ PKER_RWETH( 12, 17) = 0.148718E+01
+ PKER_RWETH( 12, 18) = 0.158513E+01
+ PKER_RWETH( 12, 19) = 0.166497E+01
+ PKER_RWETH( 12, 20) = 0.173011E+01
+ PKER_RWETH( 12, 21) = 0.178335E+01
+ PKER_RWETH( 12, 22) = 0.182694E+01
+ PKER_RWETH( 12, 23) = 0.186268E+01
+ PKER_RWETH( 12, 24) = 0.189201E+01
+ PKER_RWETH( 12, 25) = 0.191613E+01
+ PKER_RWETH( 12, 26) = 0.193596E+01
+ PKER_RWETH( 12, 27) = 0.195229E+01
+ PKER_RWETH( 12, 28) = 0.196574E+01
+ PKER_RWETH( 12, 29) = 0.197683E+01
+ PKER_RWETH( 12, 30) = 0.198598E+01
+ PKER_RWETH( 12, 31) = 0.199352E+01
+ PKER_RWETH( 12, 32) = 0.199975E+01
+ PKER_RWETH( 12, 33) = 0.200489E+01
+ PKER_RWETH( 12, 34) = 0.200914E+01
+ PKER_RWETH( 12, 35) = 0.201264E+01
+ PKER_RWETH( 12, 36) = 0.201554E+01
+ PKER_RWETH( 12, 37) = 0.201793E+01
+ PKER_RWETH( 12, 38) = 0.201991E+01
+ PKER_RWETH( 12, 39) = 0.202154E+01
+ PKER_RWETH( 12, 40) = 0.202289E+01
+ PKER_RWETH( 13, 1) = 0.119970E+02
+ PKER_RWETH( 13, 2) = 0.959324E+01
+ PKER_RWETH( 13, 3) = 0.760081E+01
+ PKER_RWETH( 13, 4) = 0.594970E+01
+ PKER_RWETH( 13, 5) = 0.458280E+01
+ PKER_RWETH( 13, 6) = 0.345469E+01
+ PKER_RWETH( 13, 7) = 0.253159E+01
+ PKER_RWETH( 13, 8) = 0.179227E+01
+ PKER_RWETH( 13, 9) = 0.122838E+01
+ PKER_RWETH( 13, 10) = 0.841004E+00
+ PKER_RWETH( 13, 11) = 0.629650E+00
+ PKER_RWETH( 13, 12) = 0.577924E+00
+ PKER_RWETH( 13, 13) = 0.645898E+00
+ PKER_RWETH( 13, 14) = 0.779895E+00
+ PKER_RWETH( 13, 15) = 0.932147E+00
+ PKER_RWETH( 13, 16) = 0.107403E+01
+ PKER_RWETH( 13, 17) = 0.119506E+01
+ PKER_RWETH( 13, 18) = 0.129476E+01
+ PKER_RWETH( 13, 19) = 0.137609E+01
+ PKER_RWETH( 13, 20) = 0.144235E+01
+ PKER_RWETH( 13, 21) = 0.149642E+01
+ PKER_RWETH( 13, 22) = 0.154060E+01
+ PKER_RWETH( 13, 23) = 0.157677E+01
+ PKER_RWETH( 13, 24) = 0.160643E+01
+ PKER_RWETH( 13, 25) = 0.163077E+01
+ PKER_RWETH( 13, 26) = 0.165078E+01
+ PKER_RWETH( 13, 27) = 0.166723E+01
+ PKER_RWETH( 13, 28) = 0.168078E+01
+ PKER_RWETH( 13, 29) = 0.169194E+01
+ PKER_RWETH( 13, 30) = 0.170114E+01
+ PKER_RWETH( 13, 31) = 0.170872E+01
+ PKER_RWETH( 13, 32) = 0.171498E+01
+ PKER_RWETH( 13, 33) = 0.172014E+01
+ PKER_RWETH( 13, 34) = 0.172441E+01
+ PKER_RWETH( 13, 35) = 0.172792E+01
+ PKER_RWETH( 13, 36) = 0.173083E+01
+ PKER_RWETH( 13, 37) = 0.173323E+01
+ PKER_RWETH( 13, 38) = 0.173522E+01
+ PKER_RWETH( 13, 39) = 0.173685E+01
+ PKER_RWETH( 13, 40) = 0.173821E+01
+ PKER_RWETH( 14, 1) = 0.122839E+02
+ PKER_RWETH( 14, 2) = 0.988280E+01
+ PKER_RWETH( 14, 3) = 0.789268E+01
+ PKER_RWETH( 14, 4) = 0.624309E+01
+ PKER_RWETH( 14, 5) = 0.487613E+01
+ PKER_RWETH( 14, 6) = 0.374467E+01
+ PKER_RWETH( 14, 7) = 0.281151E+01
+ PKER_RWETH( 14, 8) = 0.204951E+01
+ PKER_RWETH( 14, 9) = 0.144246E+01
+ PKER_RWETH( 14, 10) = 0.985100E+00
+ PKER_RWETH( 14, 11) = 0.679232E+00
+ PKER_RWETH( 14, 12) = 0.523227E+00
+ PKER_RWETH( 14, 13) = 0.499857E+00
+ PKER_RWETH( 14, 14) = 0.571812E+00
+ PKER_RWETH( 14, 15) = 0.692570E+00
+ PKER_RWETH( 14, 16) = 0.823458E+00
+ PKER_RWETH( 14, 17) = 0.942830E+00
+ PKER_RWETH( 14, 18) = 0.104371E+01
+ PKER_RWETH( 14, 19) = 0.112656E+01
+ PKER_RWETH( 14, 20) = 0.119407E+01
+ PKER_RWETH( 14, 21) = 0.124908E+01
+ PKER_RWETH( 14, 22) = 0.129395E+01
+ PKER_RWETH( 14, 23) = 0.133063E+01
+ PKER_RWETH( 14, 24) = 0.136065E+01
+ PKER_RWETH( 14, 25) = 0.138526E+01
+ PKER_RWETH( 14, 26) = 0.140546E+01
+ PKER_RWETH( 14, 27) = 0.142206E+01
+ PKER_RWETH( 14, 28) = 0.143571E+01
+ PKER_RWETH( 14, 29) = 0.144695E+01
+ PKER_RWETH( 14, 30) = 0.145621E+01
+ PKER_RWETH( 14, 31) = 0.146384E+01
+ PKER_RWETH( 14, 32) = 0.147013E+01
+ PKER_RWETH( 14, 33) = 0.147532E+01
+ PKER_RWETH( 14, 34) = 0.147960E+01
+ PKER_RWETH( 14, 35) = 0.148314E+01
+ PKER_RWETH( 14, 36) = 0.148605E+01
+ PKER_RWETH( 14, 37) = 0.148846E+01
+ PKER_RWETH( 14, 38) = 0.149045E+01
+ PKER_RWETH( 14, 39) = 0.149210E+01
+ PKER_RWETH( 14, 40) = 0.149346E+01
+ PKER_RWETH( 15, 1) = 0.125259E+02
+ PKER_RWETH( 15, 2) = 0.101272E+02
+ PKER_RWETH( 15, 3) = 0.813939E+01
+ PKER_RWETH( 15, 4) = 0.649175E+01
+ PKER_RWETH( 15, 5) = 0.512603E+01
+ PKER_RWETH( 15, 6) = 0.399434E+01
+ PKER_RWETH( 15, 7) = 0.305783E+01
+ PKER_RWETH( 15, 8) = 0.228610E+01
+ PKER_RWETH( 15, 9) = 0.165747E+01
+ PKER_RWETH( 15, 10) = 0.115978E+01
+ PKER_RWETH( 15, 11) = 0.790048E+00
+ PKER_RWETH( 15, 12) = 0.550236E+00
+ PKER_RWETH( 15, 13) = 0.437781E+00
+ PKER_RWETH( 15, 14) = 0.434801E+00
+ PKER_RWETH( 15, 15) = 0.507067E+00
+ PKER_RWETH( 15, 16) = 0.614692E+00
+ PKER_RWETH( 15, 17) = 0.726597E+00
+ PKER_RWETH( 15, 18) = 0.826793E+00
+ PKER_RWETH( 15, 19) = 0.910816E+00
+ PKER_RWETH( 15, 20) = 0.979641E+00
+ PKER_RWETH( 15, 21) = 0.103570E+01
+ PKER_RWETH( 15, 22) = 0.108136E+01
+ PKER_RWETH( 15, 23) = 0.111861E+01
+ PKER_RWETH( 15, 24) = 0.114905E+01
+ PKER_RWETH( 15, 25) = 0.117397E+01
+ PKER_RWETH( 15, 26) = 0.119439E+01
+ PKER_RWETH( 15, 27) = 0.121116E+01
+ PKER_RWETH( 15, 28) = 0.122493E+01
+ PKER_RWETH( 15, 29) = 0.123626E+01
+ PKER_RWETH( 15, 30) = 0.124559E+01
+ PKER_RWETH( 15, 31) = 0.125327E+01
+ PKER_RWETH( 15, 32) = 0.125960E+01
+ PKER_RWETH( 15, 33) = 0.126482E+01
+ PKER_RWETH( 15, 34) = 0.126912E+01
+ PKER_RWETH( 15, 35) = 0.127267E+01
+ PKER_RWETH( 15, 36) = 0.127560E+01
+ PKER_RWETH( 15, 37) = 0.127802E+01
+ PKER_RWETH( 15, 38) = 0.128002E+01
+ PKER_RWETH( 15, 39) = 0.128167E+01
+ PKER_RWETH( 15, 40) = 0.128303E+01
+ PKER_RWETH( 16, 1) = 0.127300E+02
+ PKER_RWETH( 16, 2) = 0.103335E+02
+ PKER_RWETH( 16, 3) = 0.834773E+01
+ PKER_RWETH( 16, 4) = 0.670202E+01
+ PKER_RWETH( 16, 5) = 0.533793E+01
+ PKER_RWETH( 16, 6) = 0.420722E+01
+ PKER_RWETH( 16, 7) = 0.327032E+01
+ PKER_RWETH( 16, 8) = 0.249524E+01
+ PKER_RWETH( 16, 9) = 0.185719E+01
+ PKER_RWETH( 16, 10) = 0.133896E+01
+ PKER_RWETH( 16, 11) = 0.931613E+00
+ PKER_RWETH( 16, 12) = 0.633849E+00
+ PKER_RWETH( 16, 13) = 0.447566E+00
+ PKER_RWETH( 16, 14) = 0.368904E+00
+ PKER_RWETH( 16, 15) = 0.380168E+00
+ PKER_RWETH( 16, 16) = 0.450172E+00
+ PKER_RWETH( 16, 17) = 0.545119E+00
+ PKER_RWETH( 16, 18) = 0.640376E+00
+ PKER_RWETH( 16, 19) = 0.724315E+00
+ PKER_RWETH( 16, 20) = 0.794253E+00
+ PKER_RWETH( 16, 21) = 0.851423E+00
+ PKER_RWETH( 16, 22) = 0.897965E+00
+ PKER_RWETH( 16, 23) = 0.935873E+00
+ PKER_RWETH( 16, 24) = 0.966798E+00
+ PKER_RWETH( 16, 25) = 0.992069E+00
+ PKER_RWETH( 16, 26) = 0.101275E+01
+ PKER_RWETH( 16, 27) = 0.102971E+01
+ PKER_RWETH( 16, 28) = 0.104362E+01
+ PKER_RWETH( 16, 29) = 0.105506E+01
+ PKER_RWETH( 16, 30) = 0.106446E+01
+ PKER_RWETH( 16, 31) = 0.107219E+01
+ PKER_RWETH( 16, 32) = 0.107857E+01
+ PKER_RWETH( 16, 33) = 0.108382E+01
+ PKER_RWETH( 16, 34) = 0.108815E+01
+ PKER_RWETH( 16, 35) = 0.109172E+01
+ PKER_RWETH( 16, 36) = 0.109466E+01
+ PKER_RWETH( 16, 37) = 0.109709E+01
+ PKER_RWETH( 16, 38) = 0.109910E+01
+ PKER_RWETH( 16, 39) = 0.110076E+01
+ PKER_RWETH( 16, 40) = 0.110213E+01
+ PKER_RWETH( 17, 1) = 0.129024E+02
+ PKER_RWETH( 17, 2) = 0.105076E+02
+ PKER_RWETH( 17, 3) = 0.852362E+01
+ PKER_RWETH( 17, 4) = 0.687964E+01
+ PKER_RWETH( 17, 5) = 0.551717E+01
+ PKER_RWETH( 17, 6) = 0.438782E+01
+ PKER_RWETH( 17, 7) = 0.345170E+01
+ PKER_RWETH( 17, 8) = 0.267609E+01
+ PKER_RWETH( 17, 9) = 0.203468E+01
+ PKER_RWETH( 17, 10) = 0.150732E+01
+ PKER_RWETH( 17, 11) = 0.108047E+01
+ PKER_RWETH( 17, 12) = 0.747735E+00
+ PKER_RWETH( 17, 13) = 0.508950E+00
+ PKER_RWETH( 17, 14) = 0.365691E+00
+ PKER_RWETH( 17, 15) = 0.313111E+00
+ PKER_RWETH( 17, 16) = 0.333878E+00
+ PKER_RWETH( 17, 17) = 0.399897E+00
+ PKER_RWETH( 17, 18) = 0.482939E+00
+ PKER_RWETH( 17, 19) = 0.563733E+00
+ PKER_RWETH( 17, 20) = 0.633938E+00
+ PKER_RWETH( 17, 21) = 0.692122E+00
+ PKER_RWETH( 17, 22) = 0.739609E+00
+ PKER_RWETH( 17, 23) = 0.778254E+00
+ PKER_RWETH( 17, 24) = 0.809729E+00
+ PKER_RWETH( 17, 25) = 0.835404E+00
+ PKER_RWETH( 17, 26) = 0.856386E+00
+ PKER_RWETH( 17, 27) = 0.873558E+00
+ PKER_RWETH( 17, 28) = 0.887632E+00
+ PKER_RWETH( 17, 29) = 0.899182E+00
+ PKER_RWETH( 17, 30) = 0.908671E+00
+ PKER_RWETH( 17, 31) = 0.916474E+00
+ PKER_RWETH( 17, 32) = 0.922895E+00
+ PKER_RWETH( 17, 33) = 0.928182E+00
+ PKER_RWETH( 17, 34) = 0.932539E+00
+ PKER_RWETH( 17, 35) = 0.936130E+00
+ PKER_RWETH( 17, 36) = 0.939092E+00
+ PKER_RWETH( 17, 37) = 0.941535E+00
+ PKER_RWETH( 17, 38) = 0.943552E+00
+ PKER_RWETH( 17, 39) = 0.945216E+00
+ PKER_RWETH( 17, 40) = 0.946590E+00
+ PKER_RWETH( 18, 1) = 0.130481E+02
+ PKER_RWETH( 18, 2) = 0.106547E+02
+ PKER_RWETH( 18, 3) = 0.867216E+01
+ PKER_RWETH( 18, 4) = 0.702966E+01
+ PKER_RWETH( 18, 5) = 0.566864E+01
+ PKER_RWETH( 18, 6) = 0.454066E+01
+ PKER_RWETH( 18, 7) = 0.360566E+01
+ PKER_RWETH( 18, 8) = 0.283064E+01
+ PKER_RWETH( 18, 9) = 0.218857E+01
+ PKER_RWETH( 18, 10) = 0.165785E+01
+ PKER_RWETH( 18, 11) = 0.122215E+01
+ PKER_RWETH( 18, 12) = 0.870920E+00
+ PKER_RWETH( 18, 13) = 0.599738E+00
+ PKER_RWETH( 18, 14) = 0.409230E+00
+ PKER_RWETH( 18, 15) = 0.300399E+00
+ PKER_RWETH( 18, 16) = 0.267701E+00
+ PKER_RWETH( 18, 17) = 0.294269E+00
+ PKER_RWETH( 18, 18) = 0.355318E+00
+ PKER_RWETH( 18, 19) = 0.427404E+00
+ PKER_RWETH( 18, 20) = 0.495700E+00
+ PKER_RWETH( 18, 21) = 0.554339E+00
+ PKER_RWETH( 18, 22) = 0.602725E+00
+ PKER_RWETH( 18, 23) = 0.642169E+00
+ PKER_RWETH( 18, 24) = 0.674260E+00
+ PKER_RWETH( 18, 25) = 0.700395E+00
+ PKER_RWETH( 18, 26) = 0.721715E+00
+ PKER_RWETH( 18, 27) = 0.739136E+00
+ PKER_RWETH( 18, 28) = 0.753394E+00
+ PKER_RWETH( 18, 29) = 0.765078E+00
+ PKER_RWETH( 18, 30) = 0.774667E+00
+ PKER_RWETH( 18, 31) = 0.782543E+00
+ PKER_RWETH( 18, 32) = 0.789019E+00
+ PKER_RWETH( 18, 33) = 0.794348E+00
+ PKER_RWETH( 18, 34) = 0.798736E+00
+ PKER_RWETH( 18, 35) = 0.802351E+00
+ PKER_RWETH( 18, 36) = 0.805330E+00
+ PKER_RWETH( 18, 37) = 0.807788E+00
+ PKER_RWETH( 18, 38) = 0.809814E+00
+ PKER_RWETH( 18, 39) = 0.811487E+00
+ PKER_RWETH( 18, 40) = 0.812867E+00
+ PKER_RWETH( 19, 1) = 0.131712E+02
+ PKER_RWETH( 19, 2) = 0.107790E+02
+ PKER_RWETH( 19, 3) = 0.879768E+01
+ PKER_RWETH( 19, 4) = 0.715640E+01
+ PKER_RWETH( 19, 5) = 0.579662E+01
+ PKER_RWETH( 19, 6) = 0.466986E+01
+ PKER_RWETH( 19, 7) = 0.373600E+01
+ PKER_RWETH( 19, 8) = 0.296191E+01
+ PKER_RWETH( 19, 9) = 0.232027E+01
+ PKER_RWETH( 19, 10) = 0.178879E+01
+ PKER_RWETH( 19, 11) = 0.134972E+01
+ PKER_RWETH( 19, 12) = 0.989916E+00
+ PKER_RWETH( 19, 13) = 0.701233E+00
+ PKER_RWETH( 19, 14) = 0.480800E+00
+ PKER_RWETH( 19, 15) = 0.329665E+00
+ PKER_RWETH( 19, 16) = 0.248272E+00
+ PKER_RWETH( 19, 17) = 0.230434E+00
+ PKER_RWETH( 19, 18) = 0.260120E+00
+ PKER_RWETH( 19, 19) = 0.315632E+00
+ PKER_RWETH( 19, 20) = 0.377834E+00
+ PKER_RWETH( 19, 21) = 0.435396E+00
+ PKER_RWETH( 19, 22) = 0.484321E+00
+ PKER_RWETH( 19, 23) = 0.524549E+00
+ PKER_RWETH( 19, 24) = 0.557311E+00
+ PKER_RWETH( 19, 25) = 0.583962E+00
+ PKER_RWETH( 19, 26) = 0.605667E+00
+ PKER_RWETH( 19, 27) = 0.623372E+00
+ PKER_RWETH( 19, 28) = 0.637838E+00
+ PKER_RWETH( 19, 29) = 0.649677E+00
+ PKER_RWETH( 19, 30) = 0.659379E+00
+ PKER_RWETH( 19, 31) = 0.667339E+00
+ PKER_RWETH( 19, 32) = 0.673877E+00
+ PKER_RWETH( 19, 33) = 0.679253E+00
+ PKER_RWETH( 19, 34) = 0.683676E+00
+ PKER_RWETH( 19, 35) = 0.687317E+00
+ PKER_RWETH( 19, 36) = 0.690317E+00
+ PKER_RWETH( 19, 37) = 0.692790E+00
+ PKER_RWETH( 19, 38) = 0.694828E+00
+ PKER_RWETH( 19, 39) = 0.696510E+00
+ PKER_RWETH( 19, 40) = 0.697897E+00
+ PKER_RWETH( 20, 1) = 0.132755E+02
+ PKER_RWETH( 20, 2) = 0.108842E+02
+ PKER_RWETH( 20, 3) = 0.890381E+01
+ PKER_RWETH( 20, 4) = 0.726353E+01
+ PKER_RWETH( 20, 5) = 0.590477E+01
+ PKER_RWETH( 20, 6) = 0.477905E+01
+ PKER_RWETH( 20, 7) = 0.384623E+01
+ PKER_RWETH( 20, 8) = 0.307309E+01
+ PKER_RWETH( 20, 9) = 0.243222E+01
+ PKER_RWETH( 20, 10) = 0.190101E+01
+ PKER_RWETH( 20, 11) = 0.146109E+01
+ PKER_RWETH( 20, 12) = 0.109792E+01
+ PKER_RWETH( 20, 13) = 0.800957E+00
+ PKER_RWETH( 20, 14) = 0.564005E+00
+ PKER_RWETH( 20, 15) = 0.385366E+00
+ PKER_RWETH( 20, 16) = 0.266229E+00
+ PKER_RWETH( 20, 17) = 0.206550E+00
+ PKER_RWETH( 20, 18) = 0.199590E+00
+ PKER_RWETH( 20, 19) = 0.230425E+00
+ PKER_RWETH( 20, 20) = 0.280277E+00
+ PKER_RWETH( 20, 21) = 0.333630E+00
+ PKER_RWETH( 20, 22) = 0.382023E+00
+ PKER_RWETH( 20, 23) = 0.422805E+00
+ PKER_RWETH( 20, 24) = 0.456244E+00
+ PKER_RWETH( 20, 25) = 0.483458E+00
+ PKER_RWETH( 20, 26) = 0.505594E+00
+ PKER_RWETH( 20, 27) = 0.523620E+00
+ PKER_RWETH( 20, 28) = 0.538325E+00
+ PKER_RWETH( 20, 29) = 0.550339E+00
+ PKER_RWETH( 20, 30) = 0.560171E+00
+ PKER_RWETH( 20, 31) = 0.568227E+00
+ PKER_RWETH( 20, 32) = 0.574836E+00
+ PKER_RWETH( 20, 33) = 0.580265E+00
+ PKER_RWETH( 20, 34) = 0.584727E+00
+ PKER_RWETH( 20, 35) = 0.588398E+00
+ PKER_RWETH( 20, 36) = 0.591421E+00
+ PKER_RWETH( 20, 37) = 0.593910E+00
+ PKER_RWETH( 20, 38) = 0.595962E+00
+ PKER_RWETH( 20, 39) = 0.597653E+00
+ PKER_RWETH( 20, 40) = 0.599048E+00
+ PKER_RWETH( 21, 1) = 0.133638E+02
+ PKER_RWETH( 21, 2) = 0.109733E+02
+ PKER_RWETH( 21, 3) = 0.899363E+01
+ PKER_RWETH( 21, 4) = 0.735415E+01
+ PKER_RWETH( 21, 5) = 0.599624E+01
+ PKER_RWETH( 21, 6) = 0.487138E+01
+ PKER_RWETH( 21, 7) = 0.393943E+01
+ PKER_RWETH( 21, 8) = 0.316716E+01
+ PKER_RWETH( 21, 9) = 0.252708E+01
+ PKER_RWETH( 21, 10) = 0.199649E+01
+ PKER_RWETH( 21, 11) = 0.155673E+01
+ PKER_RWETH( 21, 12) = 0.119262E+01
+ PKER_RWETH( 21, 13) = 0.892302E+00
+ PKER_RWETH( 21, 14) = 0.647350E+00
+ PKER_RWETH( 21, 15) = 0.453162E+00
+ PKER_RWETH( 21, 16) = 0.308890E+00
+ PKER_RWETH( 21, 17) = 0.215757E+00
+ PKER_RWETH( 21, 18) = 0.173047E+00
+ PKER_RWETH( 21, 19) = 0.173871E+00
+ PKER_RWETH( 21, 20) = 0.204444E+00
+ PKER_RWETH( 21, 21) = 0.248705E+00
+ PKER_RWETH( 21, 22) = 0.294253E+00
+ PKER_RWETH( 21, 23) = 0.334851E+00
+ PKER_RWETH( 21, 24) = 0.368823E+00
+ PKER_RWETH( 21, 25) = 0.396614E+00
+ PKER_RWETH( 21, 26) = 0.419221E+00
+ PKER_RWETH( 21, 27) = 0.437608E+00
+ PKER_RWETH( 21, 28) = 0.452581E+00
+ PKER_RWETH( 21, 29) = 0.464795E+00
+ PKER_RWETH( 21, 30) = 0.474774E+00
+ PKER_RWETH( 21, 31) = 0.482940E+00
+ PKER_RWETH( 21, 32) = 0.489630E+00
+ PKER_RWETH( 21, 33) = 0.495118E+00
+ PKER_RWETH( 21, 34) = 0.499626E+00
+ PKER_RWETH( 21, 35) = 0.503331E+00
+ PKER_RWETH( 21, 36) = 0.506378E+00
+ PKER_RWETH( 21, 37) = 0.508887E+00
+ PKER_RWETH( 21, 38) = 0.510953E+00
+ PKER_RWETH( 21, 39) = 0.512656E+00
+ PKER_RWETH( 21, 40) = 0.514060E+00
+ PKER_RWETH( 22, 1) = 0.134387E+02
+ PKER_RWETH( 22, 2) = 0.110487E+02
+ PKER_RWETH( 22, 3) = 0.906972E+01
+ PKER_RWETH( 22, 4) = 0.743089E+01
+ PKER_RWETH( 22, 5) = 0.607364E+01
+ PKER_RWETH( 22, 6) = 0.494948E+01
+ PKER_RWETH( 22, 7) = 0.401825E+01
+ PKER_RWETH( 22, 8) = 0.324671E+01
+ PKER_RWETH( 22, 9) = 0.260736E+01
+ PKER_RWETH( 22, 10) = 0.207745E+01
+ PKER_RWETH( 22, 11) = 0.163817E+01
+ PKER_RWETH( 22, 12) = 0.127411E+01
+ PKER_RWETH( 22, 13) = 0.972782E+00
+ PKER_RWETH( 22, 14) = 0.724507E+00
+ PKER_RWETH( 22, 15) = 0.522622E+00
+ PKER_RWETH( 22, 16) = 0.363766E+00
+ PKER_RWETH( 22, 17) = 0.247703E+00
+ PKER_RWETH( 22, 18) = 0.175545E+00
+ PKER_RWETH( 22, 19) = 0.146034E+00
+ PKER_RWETH( 22, 20) = 0.152234E+00
+ PKER_RWETH( 22, 21) = 0.181564E+00
+ PKER_RWETH( 22, 22) = 0.220489E+00
+ PKER_RWETH( 22, 23) = 0.259220E+00
+ PKER_RWETH( 22, 24) = 0.293219E+00
+ PKER_RWETH( 22, 25) = 0.321501E+00
+ PKER_RWETH( 22, 26) = 0.344597E+00
+ PKER_RWETH( 22, 27) = 0.363378E+00
+ PKER_RWETH( 22, 28) = 0.378653E+00
+ PKER_RWETH( 22, 29) = 0.391092E+00
+ PKER_RWETH( 22, 30) = 0.401239E+00
+ PKER_RWETH( 22, 31) = 0.409528E+00
+ PKER_RWETH( 22, 32) = 0.416310E+00
+ PKER_RWETH( 22, 33) = 0.421867E+00
+ PKER_RWETH( 22, 34) = 0.426425E+00
+ PKER_RWETH( 22, 35) = 0.430168E+00
+ PKER_RWETH( 22, 36) = 0.433244E+00
+ PKER_RWETH( 22, 37) = 0.435774E+00
+ PKER_RWETH( 22, 38) = 0.437857E+00
+ PKER_RWETH( 22, 39) = 0.439572E+00
+ PKER_RWETH( 22, 40) = 0.440985E+00
+ PKER_RWETH( 23, 1) = 0.135023E+02
+ PKER_RWETH( 23, 2) = 0.111128E+02
+ PKER_RWETH( 23, 3) = 0.913424E+01
+ PKER_RWETH( 23, 4) = 0.749591E+01
+ PKER_RWETH( 23, 5) = 0.613920E+01
+ PKER_RWETH( 23, 6) = 0.501560E+01
+ PKER_RWETH( 23, 7) = 0.408496E+01
+ PKER_RWETH( 23, 8) = 0.331403E+01
+ PKER_RWETH( 23, 9) = 0.267529E+01
+ PKER_RWETH( 23, 10) = 0.214598E+01
+ PKER_RWETH( 23, 11) = 0.170727E+01
+ PKER_RWETH( 23, 12) = 0.134359E+01
+ PKER_RWETH( 23, 13) = 0.104222E+01
+ PKER_RWETH( 23, 14) = 0.792868E+00
+ PKER_RWETH( 23, 15) = 0.587692E+00
+ PKER_RWETH( 23, 16) = 0.421446E+00
+ PKER_RWETH( 23, 17) = 0.291760E+00
+ PKER_RWETH( 23, 18) = 0.198828E+00
+ PKER_RWETH( 23, 19) = 0.143521E+00
+ PKER_RWETH( 23, 20) = 0.124168E+00
+ PKER_RWETH( 23, 21) = 0.133847E+00
+ PKER_RWETH( 23, 22) = 0.161331E+00
+ PKER_RWETH( 23, 23) = 0.195282E+00
+ PKER_RWETH( 23, 24) = 0.228096E+00
+ PKER_RWETH( 23, 25) = 0.256525E+00
+ PKER_RWETH( 23, 26) = 0.280060E+00
+ PKER_RWETH( 23, 27) = 0.299255E+00
+ PKER_RWETH( 23, 28) = 0.314859E+00
+ PKER_RWETH( 23, 29) = 0.327550E+00
+ PKER_RWETH( 23, 30) = 0.337885E+00
+ PKER_RWETH( 23, 31) = 0.346315E+00
+ PKER_RWETH( 23, 32) = 0.353201E+00
+ PKER_RWETH( 23, 33) = 0.358835E+00
+ PKER_RWETH( 23, 34) = 0.363451E+00
+ PKER_RWETH( 23, 35) = 0.367237E+00
+ PKER_RWETH( 23, 36) = 0.370345E+00
+ PKER_RWETH( 23, 37) = 0.372900E+00
+ PKER_RWETH( 23, 38) = 0.375001E+00
+ PKER_RWETH( 23, 39) = 0.376730E+00
+ PKER_RWETH( 23, 40) = 0.378154E+00
+ PKER_RWETH( 24, 1) = 0.135563E+02
+ PKER_RWETH( 24, 2) = 0.111671E+02
+ PKER_RWETH( 24, 3) = 0.918899E+01
+ PKER_RWETH( 24, 4) = 0.755107E+01
+ PKER_RWETH( 24, 5) = 0.619478E+01
+ PKER_RWETH( 24, 6) = 0.507163E+01
+ PKER_RWETH( 24, 7) = 0.414145E+01
+ PKER_RWETH( 24, 8) = 0.337101E+01
+ PKER_RWETH( 24, 9) = 0.273279E+01
+ PKER_RWETH( 24, 10) = 0.220400E+01
+ PKER_RWETH( 24, 11) = 0.176579E+01
+ PKER_RWETH( 24, 12) = 0.140257E+01
+ PKER_RWETH( 24, 13) = 0.110150E+01
+ PKER_RWETH( 24, 14) = 0.852021E+00
+ PKER_RWETH( 24, 15) = 0.645715E+00
+ PKER_RWETH( 24, 16) = 0.476221E+00
+ PKER_RWETH( 24, 17) = 0.339467E+00
+ PKER_RWETH( 24, 18) = 0.233850E+00
+ PKER_RWETH( 24, 19) = 0.159822E+00
+ PKER_RWETH( 24, 20) = 0.118004E+00
+ PKER_RWETH( 24, 21) = 0.106334E+00
+ PKER_RWETH( 24, 22) = 0.118095E+00
+ PKER_RWETH( 24, 23) = 0.143353E+00
+ PKER_RWETH( 24, 24) = 0.172771E+00
+ PKER_RWETH( 24, 25) = 0.200484E+00
+ PKER_RWETH( 24, 26) = 0.224227E+00
+ PKER_RWETH( 24, 27) = 0.243806E+00
+ PKER_RWETH( 24, 28) = 0.259757E+00
+ PKER_RWETH( 24, 29) = 0.272723E+00
+ PKER_RWETH( 24, 30) = 0.283268E+00
+ PKER_RWETH( 24, 31) = 0.291856E+00
+ PKER_RWETH( 24, 32) = 0.298861E+00
+ PKER_RWETH( 24, 33) = 0.304583E+00
+ PKER_RWETH( 24, 34) = 0.309264E+00
+ PKER_RWETH( 24, 35) = 0.313098E+00
+ PKER_RWETH( 24, 36) = 0.316243E+00
+ PKER_RWETH( 24, 37) = 0.318825E+00
+ PKER_RWETH( 24, 38) = 0.320946E+00
+ PKER_RWETH( 24, 39) = 0.322691E+00
+ PKER_RWETH( 24, 40) = 0.324127E+00
+ PKER_RWETH( 25, 1) = 0.136022E+02
+ PKER_RWETH( 25, 2) = 0.112133E+02
+ PKER_RWETH( 25, 3) = 0.923550E+01
+ PKER_RWETH( 25, 4) = 0.759789E+01
+ PKER_RWETH( 25, 5) = 0.624194E+01
+ PKER_RWETH( 25, 6) = 0.511914E+01
+ PKER_RWETH( 25, 7) = 0.418934E+01
+ PKER_RWETH( 25, 8) = 0.341929E+01
+ PKER_RWETH( 25, 9) = 0.278148E+01
+ PKER_RWETH( 25, 10) = 0.225311E+01
+ PKER_RWETH( 25, 11) = 0.181534E+01
+ PKER_RWETH( 25, 12) = 0.145255E+01
+ PKER_RWETH( 25, 13) = 0.115185E+01
+ PKER_RWETH( 25, 14) = 0.902595E+00
+ PKER_RWETH( 25, 15) = 0.696094E+00
+ PKER_RWETH( 25, 16) = 0.525430E+00
+ PKER_RWETH( 25, 17) = 0.385484E+00
+ PKER_RWETH( 25, 18) = 0.273126E+00
+ PKER_RWETH( 25, 19) = 0.187350E+00
+ PKER_RWETH( 25, 20) = 0.128722E+00
+ PKER_RWETH( 25, 21) = 0.976342E-01
+ PKER_RWETH( 25, 22) = 0.916722E-01
+ PKER_RWETH( 25, 23) = 0.104476E+00
+ PKER_RWETH( 25, 24) = 0.127358E+00
+ PKER_RWETH( 25, 25) = 0.152684E+00
+ PKER_RWETH( 25, 26) = 0.176023E+00
+ PKER_RWETH( 25, 27) = 0.195832E+00
+ PKER_RWETH( 25, 28) = 0.212116E+00
+ PKER_RWETH( 25, 29) = 0.225373E+00
+ PKER_RWETH( 25, 30) = 0.236148E+00
+ PKER_RWETH( 25, 31) = 0.244912E+00
+ PKER_RWETH( 25, 32) = 0.252049E+00
+ PKER_RWETH( 25, 33) = 0.257870E+00
+ PKER_RWETH( 25, 34) = 0.262625E+00
+ PKER_RWETH( 25, 35) = 0.266514E+00
+ PKER_RWETH( 25, 36) = 0.269700E+00
+ PKER_RWETH( 25, 37) = 0.272313E+00
+ PKER_RWETH( 25, 38) = 0.274458E+00
+ PKER_RWETH( 25, 39) = 0.276220E+00
+ PKER_RWETH( 25, 40) = 0.277669E+00
+ PKER_RWETH( 26, 1) = 0.136413E+02
+ PKER_RWETH( 26, 2) = 0.112526E+02
+ PKER_RWETH( 26, 3) = 0.927503E+01
+ PKER_RWETH( 26, 4) = 0.763768E+01
+ PKER_RWETH( 26, 5) = 0.628200E+01
+ PKER_RWETH( 26, 6) = 0.515948E+01
+ PKER_RWETH( 26, 7) = 0.422997E+01
+ PKER_RWETH( 26, 8) = 0.346023E+01
+ PKER_RWETH( 26, 9) = 0.282275E+01
+ PKER_RWETH( 26, 10) = 0.229473E+01
+ PKER_RWETH( 26, 11) = 0.185731E+01
+ PKER_RWETH( 26, 12) = 0.149489E+01
+ PKER_RWETH( 26, 13) = 0.119454E+01
+ PKER_RWETH( 26, 14) = 0.945593E+00
+ PKER_RWETH( 26, 15) = 0.739243E+00
+ PKER_RWETH( 26, 16) = 0.568324E+00
+ PKER_RWETH( 26, 17) = 0.427174E+00
+ PKER_RWETH( 26, 18) = 0.311688E+00
+ PKER_RWETH( 26, 19) = 0.219506E+00
+ PKER_RWETH( 26, 20) = 0.150065E+00
+ PKER_RWETH( 26, 21) = 0.103983E+00
+ PKER_RWETH( 26, 22) = 0.813323E-01
+ PKER_RWETH( 26, 23) = 0.795339E-01
+ PKER_RWETH( 26, 24) = 0.926187E-01
+ PKER_RWETH( 26, 25) = 0.113085E+00
+ PKER_RWETH( 26, 26) = 0.134774E+00
+ PKER_RWETH( 26, 27) = 0.154384E+00
+ PKER_RWETH( 26, 28) = 0.170899E+00
+ PKER_RWETH( 26, 29) = 0.184441E+00
+ PKER_RWETH( 26, 30) = 0.195459E+00
+ PKER_RWETH( 26, 31) = 0.204415E+00
+ PKER_RWETH( 26, 32) = 0.211698E+00
+ PKER_RWETH( 26, 33) = 0.217630E+00
+ PKER_RWETH( 26, 34) = 0.222469E+00
+ PKER_RWETH( 26, 35) = 0.226420E+00
+ PKER_RWETH( 26, 36) = 0.229653E+00
+ PKER_RWETH( 26, 37) = 0.232300E+00
+ PKER_RWETH( 26, 38) = 0.234471E+00
+ PKER_RWETH( 26, 39) = 0.236253E+00
+ PKER_RWETH( 26, 40) = 0.237716E+00
+ PKER_RWETH( 27, 1) = 0.136746E+02
+ PKER_RWETH( 27, 2) = 0.112861E+02
+ PKER_RWETH( 27, 3) = 0.930868E+01
+ PKER_RWETH( 27, 4) = 0.767152E+01
+ PKER_RWETH( 27, 5) = 0.631604E+01
+ PKER_RWETH( 27, 6) = 0.519374E+01
+ PKER_RWETH( 27, 7) = 0.426447E+01
+ PKER_RWETH( 27, 8) = 0.349498E+01
+ PKER_RWETH( 27, 9) = 0.285775E+01
+ PKER_RWETH( 27, 10) = 0.233001E+01
+ PKER_RWETH( 27, 11) = 0.189288E+01
+ PKER_RWETH( 27, 12) = 0.153076E+01
+ PKER_RWETH( 27, 13) = 0.123072E+01
+ PKER_RWETH( 27, 14) = 0.982064E+00
+ PKER_RWETH( 27, 15) = 0.775961E+00
+ PKER_RWETH( 27, 16) = 0.605136E+00
+ PKER_RWETH( 27, 17) = 0.463679E+00
+ PKER_RWETH( 27, 18) = 0.346968E+00
+ PKER_RWETH( 27, 19) = 0.251737E+00
+ PKER_RWETH( 27, 20) = 0.176232E+00
+ PKER_RWETH( 27, 21) = 0.120216E+00
+ PKER_RWETH( 27, 22) = 0.842855E-01
+ PKER_RWETH( 27, 23) = 0.682432E-01
+ PKER_RWETH( 27, 24) = 0.693968E-01
+ PKER_RWETH( 27, 25) = 0.822195E-01
+ PKER_RWETH( 27, 26) = 0.100330E+00
+ PKER_RWETH( 27, 27) = 0.118826E+00
+ PKER_RWETH( 27, 28) = 0.135271E+00
+ PKER_RWETH( 27, 29) = 0.149030E+00
+ PKER_RWETH( 27, 30) = 0.160290E+00
+ PKER_RWETH( 27, 31) = 0.169449E+00
+ PKER_RWETH( 27, 32) = 0.176893E+00
+ PKER_RWETH( 27, 33) = 0.182947E+00
+ PKER_RWETH( 27, 34) = 0.187879E+00
+ PKER_RWETH( 27, 35) = 0.191900E+00
+ PKER_RWETH( 27, 36) = 0.195185E+00
+ PKER_RWETH( 27, 37) = 0.197872E+00
+ PKER_RWETH( 27, 38) = 0.200072E+00
+ PKER_RWETH( 27, 39) = 0.201876E+00
+ PKER_RWETH( 27, 40) = 0.203356E+00
+ PKER_RWETH( 28, 1) = 0.137029E+02
+ PKER_RWETH( 28, 2) = 0.113146E+02
+ PKER_RWETH( 28, 3) = 0.933732E+01
+ PKER_RWETH( 28, 4) = 0.770032E+01
+ PKER_RWETH( 28, 5) = 0.634501E+01
+ PKER_RWETH( 28, 6) = 0.522288E+01
+ PKER_RWETH( 28, 7) = 0.429379E+01
+ PKER_RWETH( 28, 8) = 0.352449E+01
+ PKER_RWETH( 28, 9) = 0.288747E+01
+ PKER_RWETH( 28, 10) = 0.235994E+01
+ PKER_RWETH( 28, 11) = 0.192305E+01
+ PKER_RWETH( 28, 12) = 0.156117E+01
+ PKER_RWETH( 28, 13) = 0.126138E+01
+ PKER_RWETH( 28, 14) = 0.101298E+01
+ PKER_RWETH( 28, 15) = 0.807124E+00
+ PKER_RWETH( 28, 16) = 0.636495E+00
+ PKER_RWETH( 28, 17) = 0.495081E+00
+ PKER_RWETH( 28, 18) = 0.378020E+00
+ PKER_RWETH( 28, 19) = 0.281548E+00
+ PKER_RWETH( 28, 20) = 0.203081E+00
+ PKER_RWETH( 28, 21) = 0.141353E+00
+ PKER_RWETH( 28, 22) = 0.963613E-01
+ PKER_RWETH( 28, 23) = 0.686158E-01
+ PKER_RWETH( 28, 24) = 0.577003E-01
+ PKER_RWETH( 28, 25) = 0.608435E-01
+ PKER_RWETH( 28, 26) = 0.730535E-01
+ PKER_RWETH( 28, 27) = 0.889343E-01
+ PKER_RWETH( 28, 28) = 0.104643E+00
+ PKER_RWETH( 28, 29) = 0.118411E+00
+ PKER_RWETH( 28, 30) = 0.129868E+00
+ PKER_RWETH( 28, 31) = 0.139231E+00
+ PKER_RWETH( 28, 32) = 0.146844E+00
+ PKER_RWETH( 28, 33) = 0.153033E+00
+ PKER_RWETH( 28, 34) = 0.158067E+00
+ PKER_RWETH( 28, 35) = 0.162167E+00
+ PKER_RWETH( 28, 36) = 0.165510E+00
+ PKER_RWETH( 28, 37) = 0.168241E+00
+ PKER_RWETH( 28, 38) = 0.170474E+00
+ PKER_RWETH( 28, 39) = 0.172303E+00
+ PKER_RWETH( 28, 40) = 0.173802E+00
+ PKER_RWETH( 29, 1) = 0.137271E+02
+ PKER_RWETH( 29, 2) = 0.113389E+02
+ PKER_RWETH( 29, 3) = 0.936173E+01
+ PKER_RWETH( 29, 4) = 0.772485E+01
+ PKER_RWETH( 29, 5) = 0.636967E+01
+ PKER_RWETH( 29, 6) = 0.524768E+01
+ PKER_RWETH( 29, 7) = 0.431873E+01
+ PKER_RWETH( 29, 8) = 0.354959E+01
+ PKER_RWETH( 29, 9) = 0.291273E+01
+ PKER_RWETH( 29, 10) = 0.238537E+01
+ PKER_RWETH( 29, 11) = 0.194865E+01
+ PKER_RWETH( 29, 12) = 0.158696E+01
+ PKER_RWETH( 29, 13) = 0.128738E+01
+ PKER_RWETH( 29, 14) = 0.103919E+01
+ PKER_RWETH( 29, 15) = 0.833552E+00
+ PKER_RWETH( 29, 16) = 0.663125E+00
+ PKER_RWETH( 29, 17) = 0.521865E+00
+ PKER_RWETH( 29, 18) = 0.404804E+00
+ PKER_RWETH( 29, 19) = 0.307944E+00
+ PKER_RWETH( 29, 20) = 0.228229E+00
+ PKER_RWETH( 29, 21) = 0.163636E+00
+ PKER_RWETH( 29, 22) = 0.113284E+00
+ PKER_RWETH( 29, 23) = 0.773180E-01
+ PKER_RWETH( 29, 24) = 0.561494E-01
+ PKER_RWETH( 29, 25) = 0.491502E-01
+ PKER_RWETH( 29, 26) = 0.535664E-01
+ PKER_RWETH( 29, 27) = 0.649274E-01
+ PKER_RWETH( 29, 28) = 0.787521E-01
+ PKER_RWETH( 29, 29) = 0.920477E-01
+ PKER_RWETH( 29, 30) = 0.103558E+00
+ PKER_RWETH( 29, 31) = 0.113095E+00
+ PKER_RWETH( 29, 32) = 0.120880E+00
+ PKER_RWETH( 29, 33) = 0.127210E+00
+ PKER_RWETH( 29, 34) = 0.132356E+00
+ PKER_RWETH( 29, 35) = 0.136542E+00
+ PKER_RWETH( 29, 36) = 0.139951E+00
+ PKER_RWETH( 29, 37) = 0.142731E+00
+ PKER_RWETH( 29, 38) = 0.145001E+00
+ PKER_RWETH( 29, 39) = 0.146858E+00
+ PKER_RWETH( 29, 40) = 0.148378E+00
+ PKER_RWETH( 30, 1) = 0.137477E+02
+ PKER_RWETH( 30, 2) = 0.113596E+02
+ PKER_RWETH( 30, 3) = 0.938254E+01
+ PKER_RWETH( 30, 4) = 0.774576E+01
+ PKER_RWETH( 30, 5) = 0.639068E+01
+ PKER_RWETH( 30, 6) = 0.526879E+01
+ PKER_RWETH( 30, 7) = 0.433996E+01
+ PKER_RWETH( 30, 8) = 0.357094E+01
+ PKER_RWETH( 30, 9) = 0.293420E+01
+ PKER_RWETH( 30, 10) = 0.240698E+01
+ PKER_RWETH( 30, 11) = 0.197041E+01
+ PKER_RWETH( 30, 12) = 0.160887E+01
+ PKER_RWETH( 30, 13) = 0.130945E+01
+ PKER_RWETH( 30, 14) = 0.106143E+01
+ PKER_RWETH( 30, 15) = 0.855966E+00
+ PKER_RWETH( 30, 16) = 0.685719E+00
+ PKER_RWETH( 30, 17) = 0.544626E+00
+ PKER_RWETH( 30, 18) = 0.427680E+00
+ PKER_RWETH( 30, 19) = 0.330783E+00
+ PKER_RWETH( 30, 20) = 0.250649E+00
+ PKER_RWETH( 30, 21) = 0.184810E+00
+ PKER_RWETH( 30, 22) = 0.131698E+00
+ PKER_RWETH( 30, 23) = 0.907310E-01
+ PKER_RWETH( 30, 24) = 0.621333E-01
+ PKER_RWETH( 30, 25) = 0.462193E-01
+ PKER_RWETH( 30, 26) = 0.421662E-01
+ PKER_RWETH( 30, 27) = 0.473138E-01
+ PKER_RWETH( 30, 28) = 0.577107E-01
+ PKER_RWETH( 30, 29) = 0.696596E-01
+ PKER_RWETH( 30, 30) = 0.808783E-01
+ PKER_RWETH( 30, 31) = 0.904907E-01
+ PKER_RWETH( 30, 32) = 0.984276E-01
+ PKER_RWETH( 30, 33) = 0.104901E+00
+ PKER_RWETH( 30, 34) = 0.110165E+00
+ PKER_RWETH( 30, 35) = 0.114443E+00
+ PKER_RWETH( 30, 36) = 0.117924E+00
+ PKER_RWETH( 30, 37) = 0.120759E+00
+ PKER_RWETH( 30, 38) = 0.123072E+00
+ PKER_RWETH( 30, 39) = 0.124960E+00
+ PKER_RWETH( 30, 40) = 0.126503E+00
+ PKER_RWETH( 31, 1) = 0.137654E+02
+ PKER_RWETH( 31, 2) = 0.113773E+02
+ PKER_RWETH( 31, 3) = 0.940030E+01
+ PKER_RWETH( 31, 4) = 0.776359E+01
+ PKER_RWETH( 31, 5) = 0.640859E+01
+ PKER_RWETH( 31, 6) = 0.528679E+01
+ PKER_RWETH( 31, 7) = 0.435805E+01
+ PKER_RWETH( 31, 8) = 0.358912E+01
+ PKER_RWETH( 31, 9) = 0.295248E+01
+ PKER_RWETH( 31, 10) = 0.242536E+01
+ PKER_RWETH( 31, 11) = 0.198890E+01
+ PKER_RWETH( 31, 12) = 0.162749E+01
+ PKER_RWETH( 31, 13) = 0.132819E+01
+ PKER_RWETH( 31, 14) = 0.108031E+01
+ PKER_RWETH( 31, 15) = 0.874986E+00
+ PKER_RWETH( 31, 16) = 0.704888E+00
+ PKER_RWETH( 31, 17) = 0.563945E+00
+ PKER_RWETH( 31, 18) = 0.447136E+00
+ PKER_RWETH( 31, 19) = 0.350322E+00
+ PKER_RWETH( 31, 20) = 0.270119E+00
+ PKER_RWETH( 31, 21) = 0.203836E+00
+ PKER_RWETH( 31, 22) = 0.149485E+00
+ PKER_RWETH( 31, 23) = 0.105870E+00
+ PKER_RWETH( 31, 24) = 0.726361E-01
+ PKER_RWETH( 31, 25) = 0.500546E-01
+ PKER_RWETH( 31, 26) = 0.382950E-01
+ PKER_RWETH( 31, 27) = 0.364238E-01
+ PKER_RWETH( 31, 28) = 0.419002E-01
+ PKER_RWETH( 31, 29) = 0.512768E-01
+ PKER_RWETH( 31, 30) = 0.615456E-01
+ PKER_RWETH( 31, 31) = 0.709877E-01
+ PKER_RWETH( 31, 32) = 0.790080E-01
+ PKER_RWETH( 31, 33) = 0.856118E-01
+ PKER_RWETH( 31, 34) = 0.909951E-01
+ PKER_RWETH( 31, 35) = 0.953723E-01
+ PKER_RWETH( 31, 36) = 0.989311E-01
+ PKER_RWETH( 31, 37) = 0.101826E+00
+ PKER_RWETH( 31, 38) = 0.104185E+00
+ PKER_RWETH( 31, 39) = 0.106108E+00
+ PKER_RWETH( 31, 40) = 0.107678E+00
+ PKER_RWETH( 32, 1) = 0.137804E+02
+ PKER_RWETH( 32, 2) = 0.113924E+02
+ PKER_RWETH( 32, 3) = 0.941546E+01
+ PKER_RWETH( 32, 4) = 0.777881E+01
+ PKER_RWETH( 32, 5) = 0.642387E+01
+ PKER_RWETH( 32, 6) = 0.530214E+01
+ PKER_RWETH( 32, 7) = 0.437346E+01
+ PKER_RWETH( 32, 8) = 0.360461E+01
+ PKER_RWETH( 32, 9) = 0.296805E+01
+ PKER_RWETH( 32, 10) = 0.244102E+01
+ PKER_RWETH( 32, 11) = 0.200464E+01
+ PKER_RWETH( 32, 12) = 0.164332E+01
+ PKER_RWETH( 32, 13) = 0.134412E+01
+ PKER_RWETH( 32, 14) = 0.109635E+01
+ PKER_RWETH( 32, 15) = 0.891139E+00
+ PKER_RWETH( 32, 16) = 0.721160E+00
+ PKER_RWETH( 32, 17) = 0.580341E+00
+ PKER_RWETH( 32, 18) = 0.463657E+00
+ PKER_RWETH( 32, 19) = 0.366953E+00
+ PKER_RWETH( 32, 20) = 0.286807E+00
+ PKER_RWETH( 32, 21) = 0.220427E+00
+ PKER_RWETH( 32, 22) = 0.165613E+00
+ PKER_RWETH( 32, 23) = 0.120775E+00
+ PKER_RWETH( 32, 24) = 0.850138E-01
+ PKER_RWETH( 32, 25) = 0.581425E-01
+ PKER_RWETH( 32, 26) = 0.404419E-01
+ PKER_RWETH( 32, 27) = 0.319552E-01
+ PKER_RWETH( 32, 28) = 0.316626E-01
+ PKER_RWETH( 32, 29) = 0.371741E-01
+ PKER_RWETH( 32, 30) = 0.455292E-01
+ PKER_RWETH( 32, 31) = 0.543130E-01
+ PKER_RWETH( 32, 32) = 0.622423E-01
+ PKER_RWETH( 32, 33) = 0.689293E-01
+ PKER_RWETH( 32, 34) = 0.744234E-01
+ PKER_RWETH( 32, 35) = 0.789005E-01
+ PKER_RWETH( 32, 36) = 0.825413E-01
+ PKER_RWETH( 32, 37) = 0.855015E-01
+ PKER_RWETH( 32, 38) = 0.879101E-01
+ PKER_RWETH( 32, 39) = 0.898719E-01
+ PKER_RWETH( 32, 40) = 0.914716E-01
+ PKER_RWETH( 33, 1) = 0.137933E+02
+ PKER_RWETH( 33, 2) = 0.114053E+02
+ PKER_RWETH( 33, 3) = 0.942841E+01
+ PKER_RWETH( 33, 4) = 0.779180E+01
+ PKER_RWETH( 33, 5) = 0.643691E+01
+ PKER_RWETH( 33, 6) = 0.531523E+01
+ PKER_RWETH( 33, 7) = 0.438661E+01
+ PKER_RWETH( 33, 8) = 0.361782E+01
+ PKER_RWETH( 33, 9) = 0.298132E+01
+ PKER_RWETH( 33, 10) = 0.245435E+01
+ PKER_RWETH( 33, 11) = 0.201805E+01
+ PKER_RWETH( 33, 12) = 0.165680E+01
+ PKER_RWETH( 33, 13) = 0.135768E+01
+ PKER_RWETH( 33, 14) = 0.110999E+01
+ PKER_RWETH( 33, 15) = 0.904867E+00
+ PKER_RWETH( 33, 16) = 0.734983E+00
+ PKER_RWETH( 33, 17) = 0.594264E+00
+ PKER_RWETH( 33, 18) = 0.477684E+00
+ PKER_RWETH( 33, 19) = 0.381084E+00
+ PKER_RWETH( 33, 20) = 0.301025E+00
+ PKER_RWETH( 33, 21) = 0.234678E+00
+ PKER_RWETH( 33, 22) = 0.179744E+00
+ PKER_RWETH( 33, 23) = 0.134427E+00
+ PKER_RWETH( 33, 24) = 0.974646E-01
+ PKER_RWETH( 33, 25) = 0.681937E-01
+ PKER_RWETH( 33, 26) = 0.465543E-01
+ PKER_RWETH( 33, 27) = 0.328007E-01
+ PKER_RWETH( 33, 28) = 0.268706E-01
+ PKER_RWETH( 33, 29) = 0.276742E-01
+ PKER_RWETH( 33, 30) = 0.330242E-01
+ PKER_RWETH( 33, 31) = 0.403935E-01
+ PKER_RWETH( 33, 32) = 0.478738E-01
+ PKER_RWETH( 33, 33) = 0.545206E-01
+ PKER_RWETH( 33, 34) = 0.600926E-01
+ PKER_RWETH( 33, 35) = 0.646634E-01
+ PKER_RWETH( 33, 36) = 0.683873E-01
+ PKER_RWETH( 33, 37) = 0.714159E-01
+ PKER_RWETH( 33, 38) = 0.738787E-01
+ PKER_RWETH( 33, 39) = 0.758827E-01
+ PKER_RWETH( 33, 40) = 0.775149E-01
+ PKER_RWETH( 34, 1) = 0.138043E+02
+ PKER_RWETH( 34, 2) = 0.114163E+02
+ PKER_RWETH( 34, 3) = 0.943947E+01
+ PKER_RWETH( 34, 4) = 0.780291E+01
+ PKER_RWETH( 34, 5) = 0.644805E+01
+ PKER_RWETH( 34, 6) = 0.532642E+01
+ PKER_RWETH( 34, 7) = 0.439784E+01
+ PKER_RWETH( 34, 8) = 0.362909E+01
+ PKER_RWETH( 34, 9) = 0.299264E+01
+ PKER_RWETH( 34, 10) = 0.246572E+01
+ PKER_RWETH( 34, 11) = 0.202947E+01
+ PKER_RWETH( 34, 12) = 0.166828E+01
+ PKER_RWETH( 34, 13) = 0.136922E+01
+ PKER_RWETH( 34, 14) = 0.112160E+01
+ PKER_RWETH( 34, 15) = 0.916545E+00
+ PKER_RWETH( 34, 16) = 0.746735E+00
+ PKER_RWETH( 34, 17) = 0.606095E+00
+ PKER_RWETH( 34, 18) = 0.489599E+00
+ PKER_RWETH( 34, 19) = 0.393086E+00
+ PKER_RWETH( 34, 20) = 0.313112E+00
+ PKER_RWETH( 34, 21) = 0.246834E+00
+ PKER_RWETH( 34, 22) = 0.191912E+00
+ PKER_RWETH( 34, 23) = 0.146456E+00
+ PKER_RWETH( 34, 24) = 0.109003E+00
+ PKER_RWETH( 34, 25) = 0.785586E-01
+ PKER_RWETH( 34, 26) = 0.546497E-01
+ PKER_RWETH( 34, 27) = 0.373003E-01
+ PKER_RWETH( 34, 28) = 0.267289E-01
+ PKER_RWETH( 34, 29) = 0.227683E-01
+ PKER_RWETH( 34, 30) = 0.243048E-01
+ PKER_RWETH( 34, 31) = 0.293552E-01
+ PKER_RWETH( 34, 32) = 0.358030E-01
+ PKER_RWETH( 34, 33) = 0.421486E-01
+ PKER_RWETH( 34, 34) = 0.477119E-01
+ PKER_RWETH( 34, 35) = 0.523530E-01
+ PKER_RWETH( 34, 36) = 0.561555E-01
+ PKER_RWETH( 34, 37) = 0.592533E-01
+ PKER_RWETH( 34, 38) = 0.617731E-01
+ PKER_RWETH( 34, 39) = 0.638224E-01
+ PKER_RWETH( 34, 40) = 0.654901E-01
+ PKER_RWETH( 35, 1) = 0.138137E+02
+ PKER_RWETH( 35, 2) = 0.114258E+02
+ PKER_RWETH( 35, 3) = 0.944893E+01
+ PKER_RWETH( 35, 4) = 0.781240E+01
+ PKER_RWETH( 35, 5) = 0.645758E+01
+ PKER_RWETH( 35, 6) = 0.533597E+01
+ PKER_RWETH( 35, 7) = 0.440743E+01
+ PKER_RWETH( 35, 8) = 0.363871E+01
+ PKER_RWETH( 35, 9) = 0.300230E+01
+ PKER_RWETH( 35, 10) = 0.247542E+01
+ PKER_RWETH( 35, 11) = 0.203922E+01
+ PKER_RWETH( 35, 12) = 0.167807E+01
+ PKER_RWETH( 35, 13) = 0.137906E+01
+ PKER_RWETH( 35, 14) = 0.113148E+01
+ PKER_RWETH( 35, 15) = 0.926485E+00
+ PKER_RWETH( 35, 16) = 0.756733E+00
+ PKER_RWETH( 35, 17) = 0.616156E+00
+ PKER_RWETH( 35, 18) = 0.499726E+00
+ PKER_RWETH( 35, 19) = 0.403283E+00
+ PKER_RWETH( 35, 20) = 0.323383E+00
+ PKER_RWETH( 35, 21) = 0.257174E+00
+ PKER_RWETH( 35, 22) = 0.202305E+00
+ PKER_RWETH( 35, 23) = 0.156843E+00
+ PKER_RWETH( 35, 24) = 0.119234E+00
+ PKER_RWETH( 35, 25) = 0.882933E-01
+ PKER_RWETH( 35, 26) = 0.632437E-01
+ PKER_RWETH( 35, 27) = 0.437614E-01
+ PKER_RWETH( 35, 28) = 0.299201E-01
+ PKER_RWETH( 35, 29) = 0.219008E-01
+ PKER_RWETH( 35, 30) = 0.194367E-01
+ PKER_RWETH( 35, 31) = 0.214285E-01
+ PKER_RWETH( 35, 32) = 0.261037E-01
+ PKER_RWETH( 35, 33) = 0.317007E-01
+ PKER_RWETH( 35, 34) = 0.370659E-01
+ PKER_RWETH( 35, 35) = 0.417162E-01
+ PKER_RWETH( 35, 36) = 0.455807E-01
+ PKER_RWETH( 35, 37) = 0.487442E-01
+ PKER_RWETH( 35, 38) = 0.513216E-01
+ PKER_RWETH( 35, 39) = 0.534183E-01
+ PKER_RWETH( 35, 40) = 0.551239E-01
+ PKER_RWETH( 36, 1) = 0.138217E+02
+ PKER_RWETH( 36, 2) = 0.114338E+02
+ PKER_RWETH( 36, 3) = 0.945703E+01
+ PKER_RWETH( 36, 4) = 0.782051E+01
+ PKER_RWETH( 36, 5) = 0.646572E+01
+ PKER_RWETH( 36, 6) = 0.534413E+01
+ PKER_RWETH( 36, 7) = 0.441562E+01
+ PKER_RWETH( 36, 8) = 0.364693E+01
+ PKER_RWETH( 36, 9) = 0.301055E+01
+ PKER_RWETH( 36, 10) = 0.248370E+01
+ PKER_RWETH( 36, 11) = 0.204753E+01
+ PKER_RWETH( 36, 12) = 0.168642E+01
+ PKER_RWETH( 36, 13) = 0.138744E+01
+ PKER_RWETH( 36, 14) = 0.113991E+01
+ PKER_RWETH( 36, 15) = 0.934954E+00
+ PKER_RWETH( 36, 16) = 0.765248E+00
+ PKER_RWETH( 36, 17) = 0.624718E+00
+ PKER_RWETH( 36, 18) = 0.508341E+00
+ PKER_RWETH( 36, 19) = 0.411953E+00
+ PKER_RWETH( 36, 20) = 0.332112E+00
+ PKER_RWETH( 36, 21) = 0.265964E+00
+ PKER_RWETH( 36, 22) = 0.211152E+00
+ PKER_RWETH( 36, 23) = 0.165729E+00
+ PKER_RWETH( 36, 24) = 0.128099E+00
+ PKER_RWETH( 36, 25) = 0.969879E-01
+ PKER_RWETH( 36, 26) = 0.714385E-01
+ PKER_RWETH( 36, 27) = 0.508527E-01
+ PKER_RWETH( 36, 28) = 0.350208E-01
+ PKER_RWETH( 36, 29) = 0.240492E-01
+ PKER_RWETH( 36, 30) = 0.180569E-01
+ PKER_RWETH( 36, 31) = 0.167148E-01
+ PKER_RWETH( 36, 32) = 0.189530E-01
+ PKER_RWETH( 36, 33) = 0.232085E-01
+ PKER_RWETH( 36, 34) = 0.280365E-01
+ PKER_RWETH( 36, 35) = 0.325598E-01
+ PKER_RWETH( 36, 36) = 0.364432E-01
+ PKER_RWETH( 36, 37) = 0.396603E-01
+ PKER_RWETH( 36, 38) = 0.422924E-01
+ PKER_RWETH( 36, 39) = 0.444370E-01
+ PKER_RWETH( 36, 40) = 0.461821E-01
+ PKER_RWETH( 37, 1) = 0.138286E+02
+ PKER_RWETH( 37, 2) = 0.114408E+02
+ PKER_RWETH( 37, 3) = 0.946395E+01
+ PKER_RWETH( 37, 4) = 0.782746E+01
+ PKER_RWETH( 37, 5) = 0.647268E+01
+ PKER_RWETH( 37, 6) = 0.535111E+01
+ PKER_RWETH( 37, 7) = 0.442262E+01
+ PKER_RWETH( 37, 8) = 0.365395E+01
+ PKER_RWETH( 37, 9) = 0.301760E+01
+ PKER_RWETH( 37, 10) = 0.249077E+01
+ PKER_RWETH( 37, 11) = 0.205463E+01
+ PKER_RWETH( 37, 12) = 0.169354E+01
+ PKER_RWETH( 37, 13) = 0.139460E+01
+ PKER_RWETH( 37, 14) = 0.114709E+01
+ PKER_RWETH( 37, 15) = 0.942174E+00
+ PKER_RWETH( 37, 16) = 0.772503E+00
+ PKER_RWETH( 37, 17) = 0.632012E+00
+ PKER_RWETH( 37, 18) = 0.515675E+00
+ PKER_RWETH( 37, 19) = 0.419331E+00
+ PKER_RWETH( 37, 20) = 0.339536E+00
+ PKER_RWETH( 37, 21) = 0.273438E+00
+ PKER_RWETH( 37, 22) = 0.218676E+00
+ PKER_RWETH( 37, 23) = 0.173299E+00
+ PKER_RWETH( 37, 24) = 0.135696E+00
+ PKER_RWETH( 37, 25) = 0.104551E+00
+ PKER_RWETH( 37, 26) = 0.788199E-01
+ PKER_RWETH( 37, 27) = 0.577354E-01
+ PKER_RWETH( 37, 28) = 0.408418E-01
+ PKER_RWETH( 37, 29) = 0.280163E-01
+ PKER_RWETH( 37, 30) = 0.193782E-01
+ PKER_RWETH( 37, 31) = 0.149908E-01
+ PKER_RWETH( 37, 32) = 0.144734E-01
+ PKER_RWETH( 37, 33) = 0.168026E-01
+ PKER_RWETH( 37, 34) = 0.206235E-01
+ PKER_RWETH( 37, 35) = 0.247667E-01
+ PKER_RWETH( 37, 36) = 0.285711E-01
+ PKER_RWETH( 37, 37) = 0.318112E-01
+ PKER_RWETH( 37, 38) = 0.344891E-01
+ PKER_RWETH( 37, 39) = 0.366792E-01
+ PKER_RWETH( 37, 40) = 0.384641E-01
+ PKER_RWETH( 38, 1) = 0.138345E+02
+ PKER_RWETH( 38, 2) = 0.114467E+02
+ PKER_RWETH( 38, 3) = 0.946988E+01
+ PKER_RWETH( 38, 4) = 0.783340E+01
+ PKER_RWETH( 38, 5) = 0.647863E+01
+ PKER_RWETH( 38, 6) = 0.535709E+01
+ PKER_RWETH( 38, 7) = 0.442861E+01
+ PKER_RWETH( 38, 8) = 0.365996E+01
+ PKER_RWETH( 38, 9) = 0.302362E+01
+ PKER_RWETH( 38, 10) = 0.249682E+01
+ PKER_RWETH( 38, 11) = 0.206069E+01
+ PKER_RWETH( 38, 12) = 0.169963E+01
+ PKER_RWETH( 38, 13) = 0.140071E+01
+ PKER_RWETH( 38, 14) = 0.115323E+01
+ PKER_RWETH( 38, 15) = 0.948333E+00
+ PKER_RWETH( 38, 16) = 0.778690E+00
+ PKER_RWETH( 38, 17) = 0.638228E+00
+ PKER_RWETH( 38, 18) = 0.521923E+00
+ PKER_RWETH( 38, 19) = 0.425613E+00
+ PKER_RWETH( 38, 20) = 0.345854E+00
+ PKER_RWETH( 38, 21) = 0.279795E+00
+ PKER_RWETH( 38, 22) = 0.225075E+00
+ PKER_RWETH( 38, 23) = 0.179739E+00
+ PKER_RWETH( 38, 24) = 0.142173E+00
+ PKER_RWETH( 38, 25) = 0.111044E+00
+ PKER_RWETH( 38, 26) = 0.852693E-01
+ PKER_RWETH( 38, 27) = 0.639938E-01
+ PKER_RWETH( 38, 28) = 0.466054E-01
+ PKER_RWETH( 38, 29) = 0.327645E-01
+ PKER_RWETH( 38, 30) = 0.224136E-01
+ PKER_RWETH( 38, 31) = 0.156672E-01
+ PKER_RWETH( 38, 32) = 0.125407E-01
+ PKER_RWETH( 38, 33) = 0.126088E-01
+ PKER_RWETH( 38, 34) = 0.149224E-01
+ PKER_RWETH( 38, 35) = 0.183139E-01
+ PKER_RWETH( 38, 36) = 0.218522E-01
+ PKER_RWETH( 38, 37) = 0.250453E-01
+ PKER_RWETH( 38, 38) = 0.277469E-01
+ PKER_RWETH( 38, 39) = 0.299758E-01
+ PKER_RWETH( 38, 40) = 0.317985E-01
+ PKER_RWETH( 39, 1) = 0.138396E+02
+ PKER_RWETH( 39, 2) = 0.114517E+02
+ PKER_RWETH( 39, 3) = 0.947496E+01
+ PKER_RWETH( 39, 4) = 0.783849E+01
+ PKER_RWETH( 39, 5) = 0.648373E+01
+ PKER_RWETH( 39, 6) = 0.536220E+01
+ PKER_RWETH( 39, 7) = 0.443373E+01
+ PKER_RWETH( 39, 8) = 0.366510E+01
+ PKER_RWETH( 39, 9) = 0.302877E+01
+ PKER_RWETH( 39, 10) = 0.250199E+01
+ PKER_RWETH( 39, 11) = 0.206588E+01
+ PKER_RWETH( 39, 12) = 0.170483E+01
+ PKER_RWETH( 39, 13) = 0.140593E+01
+ PKER_RWETH( 39, 14) = 0.115847E+01
+ PKER_RWETH( 39, 15) = 0.953590E+00
+ PKER_RWETH( 39, 16) = 0.783969E+00
+ PKER_RWETH( 39, 17) = 0.643530E+00
+ PKER_RWETH( 39, 18) = 0.527250E+00
+ PKER_RWETH( 39, 19) = 0.430966E+00
+ PKER_RWETH( 39, 20) = 0.351236E+00
+ PKER_RWETH( 39, 21) = 0.285208E+00
+ PKER_RWETH( 39, 22) = 0.230520E+00
+ PKER_RWETH( 39, 23) = 0.185219E+00
+ PKER_RWETH( 39, 24) = 0.147687E+00
+ PKER_RWETH( 39, 25) = 0.116587E+00
+ PKER_RWETH( 39, 26) = 0.908192E-01
+ PKER_RWETH( 39, 27) = 0.694900E-01
+ PKER_RWETH( 39, 28) = 0.519037E-01
+ PKER_RWETH( 39, 29) = 0.375752E-01
+ PKER_RWETH( 39, 30) = 0.262572E-01
+ PKER_RWETH( 39, 31) = 0.179379E-01
+ PKER_RWETH( 39, 32) = 0.127211E-01
+ PKER_RWETH( 39, 33) = 0.105726E-01
+ PKER_RWETH( 39, 34) = 0.110445E-01
+ PKER_RWETH( 39, 35) = 0.132652E-01
+ PKER_RWETH( 39, 36) = 0.162488E-01
+ PKER_RWETH( 39, 37) = 0.192576E-01
+ PKER_RWETH( 39, 38) = 0.219332E-01
+ PKER_RWETH( 39, 39) = 0.241847E-01
+ PKER_RWETH( 39, 40) = 0.260398E-01
+ PKER_RWETH( 40, 1) = 0.138439E+02
+ PKER_RWETH( 40, 2) = 0.114561E+02
+ PKER_RWETH( 40, 3) = 0.947930E+01
+ PKER_RWETH( 40, 4) = 0.784284E+01
+ PKER_RWETH( 40, 5) = 0.648810E+01
+ PKER_RWETH( 40, 6) = 0.536657E+01
+ PKER_RWETH( 40, 7) = 0.443812E+01
+ PKER_RWETH( 40, 8) = 0.366949E+01
+ PKER_RWETH( 40, 9) = 0.303318E+01
+ PKER_RWETH( 40, 10) = 0.250641E+01
+ PKER_RWETH( 40, 11) = 0.207031E+01
+ PKER_RWETH( 40, 12) = 0.170928E+01
+ PKER_RWETH( 40, 13) = 0.141039E+01
+ PKER_RWETH( 40, 14) = 0.116294E+01
+ PKER_RWETH( 40, 15) = 0.958081E+00
+ PKER_RWETH( 40, 16) = 0.788476E+00
+ PKER_RWETH( 40, 17) = 0.648056E+00
+ PKER_RWETH( 40, 18) = 0.531794E+00
+ PKER_RWETH( 40, 19) = 0.435532E+00
+ PKER_RWETH( 40, 20) = 0.355824E+00
+ PKER_RWETH( 40, 21) = 0.289819E+00
+ PKER_RWETH( 40, 22) = 0.235157E+00
+ PKER_RWETH( 40, 23) = 0.189883E+00
+ PKER_RWETH( 40, 24) = 0.152380E+00
+ PKER_RWETH( 40, 25) = 0.121308E+00
+ PKER_RWETH( 40, 26) = 0.955623E-01
+ PKER_RWETH( 40, 27) = 0.742324E-01
+ PKER_RWETH( 40, 28) = 0.565844E-01
+ PKER_RWETH( 40, 29) = 0.420531E-01
+ PKER_RWETH( 40, 30) = 0.302574E-01
+ PKER_RWETH( 40, 31) = 0.210233E-01
+ PKER_RWETH( 40, 32) = 0.143677E-01
+ PKER_RWETH( 40, 33) = 0.103816E-01
+ PKER_RWETH( 40, 34) = 0.898239E-02
+ PKER_RWETH( 40, 35) = 0.971795E-02
+ PKER_RWETH( 40, 36) = 0.118003E-01
+ PKER_RWETH( 40, 37) = 0.144020E-01
+ PKER_RWETH( 40, 38) = 0.169513E-01
+ PKER_RWETH( 40, 39) = 0.191899E-01
+ PKER_RWETH( 40, 40) = 0.210656E-01
+END IF
+!
+END SUBROUTINE READ_XKER_RWETH
diff --git a/src/mesonh/micro/read_xker_sdryg.f90 b/src/mesonh/micro/read_xker_sdryg.f90
new file mode 100644
index 000000000..0164c5736
--- /dev/null
+++ b/src/mesonh/micro/read_xker_sdryg.f90
@@ -0,0 +1,3337 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 init 2006/05/18 13:07:25
+!-----------------------------------------------------------------
+! ###########################
+ MODULE MODI_READ_XKER_SDRYG
+! ###########################
+!
+INTERFACE
+ SUBROUTINE READ_XKER_SDRYG (KDRYLBDAG,KDRYLBDAS,KND, &
+ PALPHAG,PNUG,PALPHAS,PNUS,PEGS,PBS,PCG,PDG,PCS,PDS, &
+ PDRYLBDAG_MAX,PDRYLBDAS_MAX,PDRYLBDAG_MIN,PDRYLBDAS_MIN, &
+ PFDINFTY,PKER_SDRYG )
+!
+INTEGER, INTENT(OUT) :: KND,KDRYLBDAG,KDRYLBDAS
+REAL, INTENT(OUT) :: PALPHAG
+REAL, INTENT(OUT) :: PNUG
+REAL, INTENT(OUT) :: PALPHAS
+REAL, INTENT(OUT) :: PNUS
+REAL, INTENT(OUT) :: PEGS
+REAL, INTENT(OUT) :: PBS
+REAL, INTENT(OUT) :: PCG
+REAL, INTENT(OUT) :: PDG
+REAL, INTENT(OUT) :: PCS
+REAL, INTENT(OUT) :: PDS
+REAL, INTENT(OUT) :: PDRYLBDAG_MAX
+REAL, INTENT(OUT) :: PDRYLBDAS_MAX
+REAL, INTENT(OUT) :: PDRYLBDAG_MIN
+REAL, INTENT(OUT) :: PDRYLBDAS_MIN
+REAL, INTENT(OUT) :: PFDINFTY
+REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_SDRYG
+!
+END SUBROUTINE
+!
+END INTERFACE
+!
+END MODULE MODI_READ_XKER_SDRYG
+! ########################################################################
+ SUBROUTINE READ_XKER_SDRYG (KDRYLBDAG,KDRYLBDAS,KND, &
+ PALPHAG,PNUG,PALPHAS,PNUS,PEGS,PBS,PCG,PDG,PCS,PDS, &
+ PDRYLBDAG_MAX,PDRYLBDAS_MAX,PDRYLBDAG_MIN,PDRYLBDAS_MIN, &
+ PFDINFTY,PKER_SDRYG )
+! ########################################################################
+!
+!!**** * * - initialize the kernels for the snow-graupel dry growth process
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to initialize the kernels PKER_SDRYG
+!! prepared from a previous run of the routine INI_RAIN_ICE. The reading
+!! of the kernels is optional after checking for the dimensions of the
+!! arrays.
+!!
+!!** METHOD
+!! ------
+!!
+!!
+!! EXTERNAL
+!! --------
+!! None
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation ( routine READ_XKER_SDRYG )
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 09/04/96
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!* 0.2 Declarations of local variables :
+!
+!
+INTEGER, INTENT(OUT) :: KND,KDRYLBDAG,KDRYLBDAS
+REAL, INTENT(OUT) :: PALPHAG
+REAL, INTENT(OUT) :: PNUG
+REAL, INTENT(OUT) :: PALPHAS
+REAL, INTENT(OUT) :: PNUS
+REAL, INTENT(OUT) :: PEGS
+REAL, INTENT(OUT) :: PBS
+REAL, INTENT(OUT) :: PCG
+REAL, INTENT(OUT) :: PDG
+REAL, INTENT(OUT) :: PCS
+REAL, INTENT(OUT) :: PDS
+REAL, INTENT(OUT) :: PDRYLBDAG_MAX
+REAL, INTENT(OUT) :: PDRYLBDAS_MAX
+REAL, INTENT(OUT) :: PDRYLBDAG_MIN
+REAL, INTENT(OUT) :: PDRYLBDAS_MIN
+REAL, INTENT(OUT) :: PFDINFTY
+REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_SDRYG
+!
+! ###################################################################
+! #INSERT HERE THE OUTPUT OF INI_RAIN_ICE IF THE KERNELS ARE UPDATED#
+! ###################################################################
+!
+KND= 50
+KDRYLBDAG= 40
+KDRYLBDAS= 80
+PALPHAG= 0.100000E+01
+PNUG= 0.100000E+01
+PALPHAS= 0.100000E+01
+PNUS= 0.100000E+01
+PEGS= 0.100000E+01
+PBS= 0.190000E+01
+PCG= 0.124000E+03
+PDG= 0.660000E+00
+PCS= 0.510000E+01
+PDS= 0.270000E+00
+PDRYLBDAG_MAX= 0.100000E+08
+PDRYLBDAS_MAX= 0.250000E+10
+PDRYLBDAG_MIN= 0.100000E+04
+PDRYLBDAS_MIN= 0.250000E+02
+PFDINFTY= 0.200000E+02
+!
+IF( PRESENT(PKER_SDRYG) ) THEN
+ PKER_SDRYG( 1, 1) = 0.185306E+01
+ PKER_SDRYG( 1, 2) = 0.166801E+01
+ PKER_SDRYG( 1, 3) = 0.149854E+01
+ PKER_SDRYG( 1, 4) = 0.134462E+01
+ PKER_SDRYG( 1, 5) = 0.120619E+01
+ PKER_SDRYG( 1, 6) = 0.108309E+01
+ PKER_SDRYG( 1, 7) = 0.975739E+00
+ PKER_SDRYG( 1, 8) = 0.883962E+00
+ PKER_SDRYG( 1, 9) = 0.807898E+00
+ PKER_SDRYG( 1, 10) = 0.748063E+00
+ PKER_SDRYG( 1, 11) = 0.704887E+00
+ PKER_SDRYG( 1, 12) = 0.678484E+00
+ PKER_SDRYG( 1, 13) = 0.670243E+00
+ PKER_SDRYG( 1, 14) = 0.680669E+00
+ PKER_SDRYG( 1, 15) = 0.710449E+00
+ PKER_SDRYG( 1, 16) = 0.760420E+00
+ PKER_SDRYG( 1, 17) = 0.829980E+00
+ PKER_SDRYG( 1, 18) = 0.918211E+00
+ PKER_SDRYG( 1, 19) = 0.102260E+01
+ PKER_SDRYG( 1, 20) = 0.113834E+01
+ PKER_SDRYG( 1, 21) = 0.125954E+01
+ PKER_SDRYG( 1, 22) = 0.138067E+01
+ PKER_SDRYG( 1, 23) = 0.149733E+01
+ PKER_SDRYG( 1, 24) = 0.160649E+01
+ PKER_SDRYG( 1, 25) = 0.170617E+01
+ PKER_SDRYG( 1, 26) = 0.179534E+01
+ PKER_SDRYG( 1, 27) = 0.187393E+01
+ PKER_SDRYG( 1, 28) = 0.194253E+01
+ PKER_SDRYG( 1, 29) = 0.200219E+01
+ PKER_SDRYG( 1, 30) = 0.205413E+01
+ PKER_SDRYG( 1, 31) = 0.209956E+01
+ PKER_SDRYG( 1, 32) = 0.213951E+01
+ PKER_SDRYG( 1, 33) = 0.217487E+01
+ PKER_SDRYG( 1, 34) = 0.220635E+01
+ PKER_SDRYG( 1, 35) = 0.223455E+01
+ PKER_SDRYG( 1, 36) = 0.225995E+01
+ PKER_SDRYG( 1, 37) = 0.228296E+01
+ PKER_SDRYG( 1, 38) = 0.230390E+01
+ PKER_SDRYG( 1, 39) = 0.232304E+01
+ PKER_SDRYG( 1, 40) = 0.234059E+01
+ PKER_SDRYG( 1, 41) = 0.235674E+01
+ PKER_SDRYG( 1, 42) = 0.237165E+01
+ PKER_SDRYG( 1, 43) = 0.238545E+01
+ PKER_SDRYG( 1, 44) = 0.239825E+01
+ PKER_SDRYG( 1, 45) = 0.241013E+01
+ PKER_SDRYG( 1, 46) = 0.242119E+01
+ PKER_SDRYG( 1, 47) = 0.243150E+01
+ PKER_SDRYG( 1, 48) = 0.244112E+01
+ PKER_SDRYG( 1, 49) = 0.245010E+01
+ PKER_SDRYG( 1, 50) = 0.245849E+01
+ PKER_SDRYG( 1, 51) = 0.246634E+01
+ PKER_SDRYG( 1, 52) = 0.247369E+01
+ PKER_SDRYG( 1, 53) = 0.248057E+01
+ PKER_SDRYG( 1, 54) = 0.248702E+01
+ PKER_SDRYG( 1, 55) = 0.249305E+01
+ PKER_SDRYG( 1, 56) = 0.249872E+01
+ PKER_SDRYG( 1, 57) = 0.250402E+01
+ PKER_SDRYG( 1, 58) = 0.250900E+01
+ PKER_SDRYG( 1, 59) = 0.251367E+01
+ PKER_SDRYG( 1, 60) = 0.251805E+01
+ PKER_SDRYG( 1, 61) = 0.252217E+01
+ PKER_SDRYG( 1, 62) = 0.252602E+01
+ PKER_SDRYG( 1, 63) = 0.252964E+01
+ PKER_SDRYG( 1, 64) = 0.253304E+01
+ PKER_SDRYG( 1, 65) = 0.253623E+01
+ PKER_SDRYG( 1, 66) = 0.253923E+01
+ PKER_SDRYG( 1, 67) = 0.254204E+01
+ PKER_SDRYG( 1, 68) = 0.254468E+01
+ PKER_SDRYG( 1, 69) = 0.254715E+01
+ PKER_SDRYG( 1, 70) = 0.254948E+01
+ PKER_SDRYG( 1, 71) = 0.255166E+01
+ PKER_SDRYG( 1, 72) = 0.255371E+01
+ PKER_SDRYG( 1, 73) = 0.255564E+01
+ PKER_SDRYG( 1, 74) = 0.255745E+01
+ PKER_SDRYG( 1, 75) = 0.255914E+01
+ PKER_SDRYG( 1, 76) = 0.256074E+01
+ PKER_SDRYG( 1, 77) = 0.256223E+01
+ PKER_SDRYG( 1, 78) = 0.256364E+01
+ PKER_SDRYG( 1, 79) = 0.256496E+01
+ PKER_SDRYG( 1, 80) = 0.256619E+01
+ PKER_SDRYG( 2, 1) = 0.203397E+01
+ PKER_SDRYG( 2, 2) = 0.184139E+01
+ PKER_SDRYG( 2, 3) = 0.166253E+01
+ PKER_SDRYG( 2, 4) = 0.149734E+01
+ PKER_SDRYG( 2, 5) = 0.134545E+01
+ PKER_SDRYG( 2, 6) = 0.120699E+01
+ PKER_SDRYG( 2, 7) = 0.108196E+01
+ PKER_SDRYG( 2, 8) = 0.970394E+00
+ PKER_SDRYG( 2, 9) = 0.872467E+00
+ PKER_SDRYG( 2, 10) = 0.788381E+00
+ PKER_SDRYG( 2, 11) = 0.718584E+00
+ PKER_SDRYG( 2, 12) = 0.663446E+00
+ PKER_SDRYG( 2, 13) = 0.623736E+00
+ PKER_SDRYG( 2, 14) = 0.600108E+00
+ PKER_SDRYG( 2, 15) = 0.593535E+00
+ PKER_SDRYG( 2, 16) = 0.605004E+00
+ PKER_SDRYG( 2, 17) = 0.635005E+00
+ PKER_SDRYG( 2, 18) = 0.683561E+00
+ PKER_SDRYG( 2, 19) = 0.749784E+00
+ PKER_SDRYG( 2, 20) = 0.831464E+00
+ PKER_SDRYG( 2, 21) = 0.925362E+00
+ PKER_SDRYG( 2, 22) = 0.102652E+01
+ PKER_SDRYG( 2, 23) = 0.112960E+01
+ PKER_SDRYG( 2, 24) = 0.122990E+01
+ PKER_SDRYG( 2, 25) = 0.132422E+01
+ PKER_SDRYG( 2, 26) = 0.141069E+01
+ PKER_SDRYG( 2, 27) = 0.148870E+01
+ PKER_SDRYG( 2, 28) = 0.155812E+01
+ PKER_SDRYG( 2, 29) = 0.161933E+01
+ PKER_SDRYG( 2, 30) = 0.167302E+01
+ PKER_SDRYG( 2, 31) = 0.172003E+01
+ PKER_SDRYG( 2, 32) = 0.176131E+01
+ PKER_SDRYG( 2, 33) = 0.179774E+01
+ PKER_SDRYG( 2, 34) = 0.183007E+01
+ PKER_SDRYG( 2, 35) = 0.185895E+01
+ PKER_SDRYG( 2, 36) = 0.188489E+01
+ PKER_SDRYG( 2, 37) = 0.190831E+01
+ PKER_SDRYG( 2, 38) = 0.192958E+01
+ PKER_SDRYG( 2, 39) = 0.194897E+01
+ PKER_SDRYG( 2, 40) = 0.196672E+01
+ PKER_SDRYG( 2, 41) = 0.198304E+01
+ PKER_SDRYG( 2, 42) = 0.199807E+01
+ PKER_SDRYG( 2, 43) = 0.201197E+01
+ PKER_SDRYG( 2, 44) = 0.202484E+01
+ PKER_SDRYG( 2, 45) = 0.203679E+01
+ PKER_SDRYG( 2, 46) = 0.204790E+01
+ PKER_SDRYG( 2, 47) = 0.205824E+01
+ PKER_SDRYG( 2, 48) = 0.206789E+01
+ PKER_SDRYG( 2, 49) = 0.207689E+01
+ PKER_SDRYG( 2, 50) = 0.208530E+01
+ PKER_SDRYG( 2, 51) = 0.209317E+01
+ PKER_SDRYG( 2, 52) = 0.210053E+01
+ PKER_SDRYG( 2, 53) = 0.210741E+01
+ PKER_SDRYG( 2, 54) = 0.211387E+01
+ PKER_SDRYG( 2, 55) = 0.211991E+01
+ PKER_SDRYG( 2, 56) = 0.212558E+01
+ PKER_SDRYG( 2, 57) = 0.213089E+01
+ PKER_SDRYG( 2, 58) = 0.213587E+01
+ PKER_SDRYG( 2, 59) = 0.214054E+01
+ PKER_SDRYG( 2, 60) = 0.214493E+01
+ PKER_SDRYG( 2, 61) = 0.214904E+01
+ PKER_SDRYG( 2, 62) = 0.215290E+01
+ PKER_SDRYG( 2, 63) = 0.215652E+01
+ PKER_SDRYG( 2, 64) = 0.215992E+01
+ PKER_SDRYG( 2, 65) = 0.216311E+01
+ PKER_SDRYG( 2, 66) = 0.216610E+01
+ PKER_SDRYG( 2, 67) = 0.216891E+01
+ PKER_SDRYG( 2, 68) = 0.217155E+01
+ PKER_SDRYG( 2, 69) = 0.217403E+01
+ PKER_SDRYG( 2, 70) = 0.217636E+01
+ PKER_SDRYG( 2, 71) = 0.217854E+01
+ PKER_SDRYG( 2, 72) = 0.218059E+01
+ PKER_SDRYG( 2, 73) = 0.218252E+01
+ PKER_SDRYG( 2, 74) = 0.218432E+01
+ PKER_SDRYG( 2, 75) = 0.218602E+01
+ PKER_SDRYG( 2, 76) = 0.218761E+01
+ PKER_SDRYG( 2, 77) = 0.218911E+01
+ PKER_SDRYG( 2, 78) = 0.219051E+01
+ PKER_SDRYG( 2, 79) = 0.219183E+01
+ PKER_SDRYG( 2, 80) = 0.219307E+01
+ PKER_SDRYG( 3, 1) = 0.219960E+01
+ PKER_SDRYG( 3, 2) = 0.200376E+01
+ PKER_SDRYG( 3, 3) = 0.182057E+01
+ PKER_SDRYG( 3, 4) = 0.164957E+01
+ PKER_SDRYG( 3, 5) = 0.149045E+01
+ PKER_SDRYG( 3, 6) = 0.134297E+01
+ PKER_SDRYG( 3, 7) = 0.120706E+01
+ PKER_SDRYG( 3, 8) = 0.108261E+01
+ PKER_SDRYG( 3, 9) = 0.969749E+00
+ PKER_SDRYG( 3, 10) = 0.868633E+00
+ PKER_SDRYG( 3, 11) = 0.779309E+00
+ PKER_SDRYG( 3, 12) = 0.702567E+00
+ PKER_SDRYG( 3, 13) = 0.638634E+00
+ PKER_SDRYG( 3, 14) = 0.588095E+00
+ PKER_SDRYG( 3, 15) = 0.552053E+00
+ PKER_SDRYG( 3, 16) = 0.531341E+00
+ PKER_SDRYG( 3, 17) = 0.526715E+00
+ PKER_SDRYG( 3, 18) = 0.539327E+00
+ PKER_SDRYG( 3, 19) = 0.569229E+00
+ PKER_SDRYG( 3, 20) = 0.615927E+00
+ PKER_SDRYG( 3, 21) = 0.677810E+00
+ PKER_SDRYG( 3, 22) = 0.751743E+00
+ PKER_SDRYG( 3, 23) = 0.834002E+00
+ PKER_SDRYG( 3, 24) = 0.920162E+00
+ PKER_SDRYG( 3, 25) = 0.100577E+01
+ PKER_SDRYG( 3, 26) = 0.108725E+01
+ PKER_SDRYG( 3, 27) = 0.116248E+01
+ PKER_SDRYG( 3, 28) = 0.123064E+01
+ PKER_SDRYG( 3, 29) = 0.129168E+01
+ PKER_SDRYG( 3, 30) = 0.134598E+01
+ PKER_SDRYG( 3, 31) = 0.139406E+01
+ PKER_SDRYG( 3, 32) = 0.143653E+01
+ PKER_SDRYG( 3, 33) = 0.147406E+01
+ PKER_SDRYG( 3, 34) = 0.150732E+01
+ PKER_SDRYG( 3, 35) = 0.153694E+01
+ PKER_SDRYG( 3, 36) = 0.156346E+01
+ PKER_SDRYG( 3, 37) = 0.158735E+01
+ PKER_SDRYG( 3, 38) = 0.160898E+01
+ PKER_SDRYG( 3, 39) = 0.162866E+01
+ PKER_SDRYG( 3, 40) = 0.164664E+01
+ PKER_SDRYG( 3, 41) = 0.166312E+01
+ PKER_SDRYG( 3, 42) = 0.167830E+01
+ PKER_SDRYG( 3, 43) = 0.169230E+01
+ PKER_SDRYG( 3, 44) = 0.170526E+01
+ PKER_SDRYG( 3, 45) = 0.171727E+01
+ PKER_SDRYG( 3, 46) = 0.172843E+01
+ PKER_SDRYG( 3, 47) = 0.173882E+01
+ PKER_SDRYG( 3, 48) = 0.174850E+01
+ PKER_SDRYG( 3, 49) = 0.175753E+01
+ PKER_SDRYG( 3, 50) = 0.176596E+01
+ PKER_SDRYG( 3, 51) = 0.177384E+01
+ PKER_SDRYG( 3, 52) = 0.178121E+01
+ PKER_SDRYG( 3, 53) = 0.178811E+01
+ PKER_SDRYG( 3, 54) = 0.179457E+01
+ PKER_SDRYG( 3, 55) = 0.180062E+01
+ PKER_SDRYG( 3, 56) = 0.180629E+01
+ PKER_SDRYG( 3, 57) = 0.181160E+01
+ PKER_SDRYG( 3, 58) = 0.181659E+01
+ PKER_SDRYG( 3, 59) = 0.182126E+01
+ PKER_SDRYG( 3, 60) = 0.182565E+01
+ PKER_SDRYG( 3, 61) = 0.182976E+01
+ PKER_SDRYG( 3, 62) = 0.183362E+01
+ PKER_SDRYG( 3, 63) = 0.183725E+01
+ PKER_SDRYG( 3, 64) = 0.184065E+01
+ PKER_SDRYG( 3, 65) = 0.184384E+01
+ PKER_SDRYG( 3, 66) = 0.184683E+01
+ PKER_SDRYG( 3, 67) = 0.184964E+01
+ PKER_SDRYG( 3, 68) = 0.185228E+01
+ PKER_SDRYG( 3, 69) = 0.185476E+01
+ PKER_SDRYG( 3, 70) = 0.185709E+01
+ PKER_SDRYG( 3, 71) = 0.185927E+01
+ PKER_SDRYG( 3, 72) = 0.186132E+01
+ PKER_SDRYG( 3, 73) = 0.186325E+01
+ PKER_SDRYG( 3, 74) = 0.186505E+01
+ PKER_SDRYG( 3, 75) = 0.186675E+01
+ PKER_SDRYG( 3, 76) = 0.186834E+01
+ PKER_SDRYG( 3, 77) = 0.186984E+01
+ PKER_SDRYG( 3, 78) = 0.187124E+01
+ PKER_SDRYG( 3, 79) = 0.187256E+01
+ PKER_SDRYG( 3, 80) = 0.187380E+01
+ PKER_SDRYG( 4, 1) = 0.234554E+01
+ PKER_SDRYG( 4, 2) = 0.214868E+01
+ PKER_SDRYG( 4, 3) = 0.196393E+01
+ PKER_SDRYG( 4, 4) = 0.179065E+01
+ PKER_SDRYG( 4, 5) = 0.162831E+01
+ PKER_SDRYG( 4, 6) = 0.147653E+01
+ PKER_SDRYG( 4, 7) = 0.133498E+01
+ PKER_SDRYG( 4, 8) = 0.120339E+01
+ PKER_SDRYG( 4, 9) = 0.108174E+01
+ PKER_SDRYG( 4, 10) = 0.969881E+00
+ PKER_SDRYG( 4, 11) = 0.868067E+00
+ PKER_SDRYG( 4, 12) = 0.776438E+00
+ PKER_SDRYG( 4, 13) = 0.695367E+00
+ PKER_SDRYG( 4, 14) = 0.625282E+00
+ PKER_SDRYG( 4, 15) = 0.566838E+00
+ PKER_SDRYG( 4, 16) = 0.521003E+00
+ PKER_SDRYG( 4, 17) = 0.488550E+00
+ PKER_SDRYG( 4, 18) = 0.470631E+00
+ PKER_SDRYG( 4, 19) = 0.468163E+00
+ PKER_SDRYG( 4, 20) = 0.481689E+00
+ PKER_SDRYG( 4, 21) = 0.511098E+00
+ PKER_SDRYG( 4, 22) = 0.555153E+00
+ PKER_SDRYG( 4, 23) = 0.611456E+00
+ PKER_SDRYG( 4, 24) = 0.676720E+00
+ PKER_SDRYG( 4, 25) = 0.747017E+00
+ PKER_SDRYG( 4, 26) = 0.818743E+00
+ PKER_SDRYG( 4, 27) = 0.888470E+00
+ PKER_SDRYG( 4, 28) = 0.953813E+00
+ PKER_SDRYG( 4, 29) = 0.101352E+01
+ PKER_SDRYG( 4, 30) = 0.106728E+01
+ PKER_SDRYG( 4, 31) = 0.111531E+01
+ PKER_SDRYG( 4, 32) = 0.115816E+01
+ PKER_SDRYG( 4, 33) = 0.119634E+01
+ PKER_SDRYG( 4, 34) = 0.123037E+01
+ PKER_SDRYG( 4, 35) = 0.126073E+01
+ PKER_SDRYG( 4, 36) = 0.128788E+01
+ PKER_SDRYG( 4, 37) = 0.131229E+01
+ PKER_SDRYG( 4, 38) = 0.133432E+01
+ PKER_SDRYG( 4, 39) = 0.135431E+01
+ PKER_SDRYG( 4, 40) = 0.137254E+01
+ PKER_SDRYG( 4, 41) = 0.138922E+01
+ PKER_SDRYG( 4, 42) = 0.140455E+01
+ PKER_SDRYG( 4, 43) = 0.141867E+01
+ PKER_SDRYG( 4, 44) = 0.143172E+01
+ PKER_SDRYG( 4, 45) = 0.144381E+01
+ PKER_SDRYG( 4, 46) = 0.145503E+01
+ PKER_SDRYG( 4, 47) = 0.146546E+01
+ PKER_SDRYG( 4, 48) = 0.147517E+01
+ PKER_SDRYG( 4, 49) = 0.148423E+01
+ PKER_SDRYG( 4, 50) = 0.149268E+01
+ PKER_SDRYG( 4, 51) = 0.150058E+01
+ PKER_SDRYG( 4, 52) = 0.150797E+01
+ PKER_SDRYG( 4, 53) = 0.151488E+01
+ PKER_SDRYG( 4, 54) = 0.152134E+01
+ PKER_SDRYG( 4, 55) = 0.152740E+01
+ PKER_SDRYG( 4, 56) = 0.153308E+01
+ PKER_SDRYG( 4, 57) = 0.153840E+01
+ PKER_SDRYG( 4, 58) = 0.154339E+01
+ PKER_SDRYG( 4, 59) = 0.154806E+01
+ PKER_SDRYG( 4, 60) = 0.155245E+01
+ PKER_SDRYG( 4, 61) = 0.155657E+01
+ PKER_SDRYG( 4, 62) = 0.156043E+01
+ PKER_SDRYG( 4, 63) = 0.156405E+01
+ PKER_SDRYG( 4, 64) = 0.156745E+01
+ PKER_SDRYG( 4, 65) = 0.157064E+01
+ PKER_SDRYG( 4, 66) = 0.157364E+01
+ PKER_SDRYG( 4, 67) = 0.157645E+01
+ PKER_SDRYG( 4, 68) = 0.157909E+01
+ PKER_SDRYG( 4, 69) = 0.158157E+01
+ PKER_SDRYG( 4, 70) = 0.158389E+01
+ PKER_SDRYG( 4, 71) = 0.158608E+01
+ PKER_SDRYG( 4, 72) = 0.158813E+01
+ PKER_SDRYG( 4, 73) = 0.159005E+01
+ PKER_SDRYG( 4, 74) = 0.159186E+01
+ PKER_SDRYG( 4, 75) = 0.159356E+01
+ PKER_SDRYG( 4, 76) = 0.159515E+01
+ PKER_SDRYG( 4, 77) = 0.159665E+01
+ PKER_SDRYG( 4, 78) = 0.159805E+01
+ PKER_SDRYG( 4, 79) = 0.159937E+01
+ PKER_SDRYG( 4, 80) = 0.160061E+01
+ PKER_SDRYG( 5, 1) = 0.247163E+01
+ PKER_SDRYG( 5, 2) = 0.227466E+01
+ PKER_SDRYG( 5, 3) = 0.208958E+01
+ PKER_SDRYG( 5, 4) = 0.191571E+01
+ PKER_SDRYG( 5, 5) = 0.175239E+01
+ PKER_SDRYG( 5, 6) = 0.159906E+01
+ PKER_SDRYG( 5, 7) = 0.145522E+01
+ PKER_SDRYG( 5, 8) = 0.132049E+01
+ PKER_SDRYG( 5, 9) = 0.119453E+01
+ PKER_SDRYG( 5, 10) = 0.107714E+01
+ PKER_SDRYG( 5, 11) = 0.968196E+00
+ PKER_SDRYG( 5, 12) = 0.867771E+00
+ PKER_SDRYG( 5, 13) = 0.775878E+00
+ PKER_SDRYG( 5, 14) = 0.692883E+00
+ PKER_SDRYG( 5, 15) = 0.619198E+00
+ PKER_SDRYG( 5, 16) = 0.555232E+00
+ PKER_SDRYG( 5, 17) = 0.502129E+00
+ PKER_SDRYG( 5, 18) = 0.460636E+00
+ PKER_SDRYG( 5, 19) = 0.431732E+00
+ PKER_SDRYG( 5, 20) = 0.416649E+00
+ PKER_SDRYG( 5, 21) = 0.416143E+00
+ PKER_SDRYG( 5, 22) = 0.430263E+00
+ PKER_SDRYG( 5, 23) = 0.458530E+00
+ PKER_SDRYG( 5, 24) = 0.499025E+00
+ PKER_SDRYG( 5, 25) = 0.549068E+00
+ PKER_SDRYG( 5, 26) = 0.605236E+00
+ PKER_SDRYG( 5, 27) = 0.664063E+00
+ PKER_SDRYG( 5, 28) = 0.722681E+00
+ PKER_SDRYG( 5, 29) = 0.778798E+00
+ PKER_SDRYG( 5, 30) = 0.830925E+00
+ PKER_SDRYG( 5, 31) = 0.878310E+00
+ PKER_SDRYG( 5, 32) = 0.920907E+00
+ PKER_SDRYG( 5, 33) = 0.959072E+00
+ PKER_SDRYG( 5, 34) = 0.993274E+00
+ PKER_SDRYG( 5, 35) = 0.102398E+01
+ PKER_SDRYG( 5, 36) = 0.105160E+01
+ PKER_SDRYG( 5, 37) = 0.107647E+01
+ PKER_SDRYG( 5, 38) = 0.109893E+01
+ PKER_SDRYG( 5, 39) = 0.111927E+01
+ PKER_SDRYG( 5, 40) = 0.113777E+01
+ PKER_SDRYG( 5, 41) = 0.115467E+01
+ PKER_SDRYG( 5, 42) = 0.117017E+01
+ PKER_SDRYG( 5, 43) = 0.118442E+01
+ PKER_SDRYG( 5, 44) = 0.119758E+01
+ PKER_SDRYG( 5, 45) = 0.120975E+01
+ PKER_SDRYG( 5, 46) = 0.122103E+01
+ PKER_SDRYG( 5, 47) = 0.123151E+01
+ PKER_SDRYG( 5, 48) = 0.124127E+01
+ PKER_SDRYG( 5, 49) = 0.125035E+01
+ PKER_SDRYG( 5, 50) = 0.125883E+01
+ PKER_SDRYG( 5, 51) = 0.126675E+01
+ PKER_SDRYG( 5, 52) = 0.127415E+01
+ PKER_SDRYG( 5, 53) = 0.128107E+01
+ PKER_SDRYG( 5, 54) = 0.128755E+01
+ PKER_SDRYG( 5, 55) = 0.129361E+01
+ PKER_SDRYG( 5, 56) = 0.129929E+01
+ PKER_SDRYG( 5, 57) = 0.130462E+01
+ PKER_SDRYG( 5, 58) = 0.130961E+01
+ PKER_SDRYG( 5, 59) = 0.131429E+01
+ PKER_SDRYG( 5, 60) = 0.131868E+01
+ PKER_SDRYG( 5, 61) = 0.132280E+01
+ PKER_SDRYG( 5, 62) = 0.132666E+01
+ PKER_SDRYG( 5, 63) = 0.133028E+01
+ PKER_SDRYG( 5, 64) = 0.133369E+01
+ PKER_SDRYG( 5, 65) = 0.133688E+01
+ PKER_SDRYG( 5, 66) = 0.133987E+01
+ PKER_SDRYG( 5, 67) = 0.134269E+01
+ PKER_SDRYG( 5, 68) = 0.134533E+01
+ PKER_SDRYG( 5, 69) = 0.134781E+01
+ PKER_SDRYG( 5, 70) = 0.135013E+01
+ PKER_SDRYG( 5, 71) = 0.135232E+01
+ PKER_SDRYG( 5, 72) = 0.135437E+01
+ PKER_SDRYG( 5, 73) = 0.135629E+01
+ PKER_SDRYG( 5, 74) = 0.135810E+01
+ PKER_SDRYG( 5, 75) = 0.135980E+01
+ PKER_SDRYG( 5, 76) = 0.136139E+01
+ PKER_SDRYG( 5, 77) = 0.136289E+01
+ PKER_SDRYG( 5, 78) = 0.136429E+01
+ PKER_SDRYG( 5, 79) = 0.136561E+01
+ PKER_SDRYG( 5, 80) = 0.136685E+01
+ PKER_SDRYG( 6, 1) = 0.257972E+01
+ PKER_SDRYG( 6, 2) = 0.238286E+01
+ PKER_SDRYG( 6, 3) = 0.219787E+01
+ PKER_SDRYG( 6, 4) = 0.202403E+01
+ PKER_SDRYG( 6, 5) = 0.186062E+01
+ PKER_SDRYG( 6, 6) = 0.170702E+01
+ PKER_SDRYG( 6, 7) = 0.156262E+01
+ PKER_SDRYG( 6, 8) = 0.142692E+01
+ PKER_SDRYG( 6, 9) = 0.129944E+01
+ PKER_SDRYG( 6, 10) = 0.117979E+01
+ PKER_SDRYG( 6, 11) = 0.106768E+01
+ PKER_SDRYG( 6, 12) = 0.962918E+00
+ PKER_SDRYG( 6, 13) = 0.865347E+00
+ PKER_SDRYG( 6, 14) = 0.775045E+00
+ PKER_SDRYG( 6, 15) = 0.692083E+00
+ PKER_SDRYG( 6, 16) = 0.616878E+00
+ PKER_SDRYG( 6, 17) = 0.549875E+00
+ PKER_SDRYG( 6, 18) = 0.491835E+00
+ PKER_SDRYG( 6, 19) = 0.443555E+00
+ PKER_SDRYG( 6, 20) = 0.406127E+00
+ PKER_SDRYG( 6, 21) = 0.380824E+00
+ PKER_SDRYG( 6, 22) = 0.368387E+00
+ PKER_SDRYG( 6, 23) = 0.369445E+00
+ PKER_SDRYG( 6, 24) = 0.383806E+00
+ PKER_SDRYG( 6, 25) = 0.410216E+00
+ PKER_SDRYG( 6, 26) = 0.446510E+00
+ PKER_SDRYG( 6, 27) = 0.489828E+00
+ PKER_SDRYG( 6, 28) = 0.537058E+00
+ PKER_SDRYG( 6, 29) = 0.585473E+00
+ PKER_SDRYG( 6, 30) = 0.632833E+00
+ PKER_SDRYG( 6, 31) = 0.677778E+00
+ PKER_SDRYG( 6, 32) = 0.719331E+00
+ PKER_SDRYG( 6, 33) = 0.757120E+00
+ PKER_SDRYG( 6, 34) = 0.791204E+00
+ PKER_SDRYG( 6, 35) = 0.821879E+00
+ PKER_SDRYG( 6, 36) = 0.849531E+00
+ PKER_SDRYG( 6, 37) = 0.874550E+00
+ PKER_SDRYG( 6, 38) = 0.897242E+00
+ PKER_SDRYG( 6, 39) = 0.917866E+00
+ PKER_SDRYG( 6, 40) = 0.936642E+00
+ PKER_SDRYG( 6, 41) = 0.953775E+00
+ PKER_SDRYG( 6, 42) = 0.969458E+00
+ PKER_SDRYG( 6, 43) = 0.983861E+00
+ PKER_SDRYG( 6, 44) = 0.997132E+00
+ PKER_SDRYG( 6, 45) = 0.100939E+01
+ PKER_SDRYG( 6, 46) = 0.102075E+01
+ PKER_SDRYG( 6, 47) = 0.103128E+01
+ PKER_SDRYG( 6, 48) = 0.104108E+01
+ PKER_SDRYG( 6, 49) = 0.105020E+01
+ PKER_SDRYG( 6, 50) = 0.105871E+01
+ PKER_SDRYG( 6, 51) = 0.106665E+01
+ PKER_SDRYG( 6, 52) = 0.107406E+01
+ PKER_SDRYG( 6, 53) = 0.108100E+01
+ PKER_SDRYG( 6, 54) = 0.108749E+01
+ PKER_SDRYG( 6, 55) = 0.109356E+01
+ PKER_SDRYG( 6, 56) = 0.109925E+01
+ PKER_SDRYG( 6, 57) = 0.110458E+01
+ PKER_SDRYG( 6, 58) = 0.110957E+01
+ PKER_SDRYG( 6, 59) = 0.111425E+01
+ PKER_SDRYG( 6, 60) = 0.111865E+01
+ PKER_SDRYG( 6, 61) = 0.112277E+01
+ PKER_SDRYG( 6, 62) = 0.112663E+01
+ PKER_SDRYG( 6, 63) = 0.113026E+01
+ PKER_SDRYG( 6, 64) = 0.113366E+01
+ PKER_SDRYG( 6, 65) = 0.113685E+01
+ PKER_SDRYG( 6, 66) = 0.113985E+01
+ PKER_SDRYG( 6, 67) = 0.114266E+01
+ PKER_SDRYG( 6, 68) = 0.114530E+01
+ PKER_SDRYG( 6, 69) = 0.114778E+01
+ PKER_SDRYG( 6, 70) = 0.115011E+01
+ PKER_SDRYG( 6, 71) = 0.115229E+01
+ PKER_SDRYG( 6, 72) = 0.115434E+01
+ PKER_SDRYG( 6, 73) = 0.115627E+01
+ PKER_SDRYG( 6, 74) = 0.115808E+01
+ PKER_SDRYG( 6, 75) = 0.115977E+01
+ PKER_SDRYG( 6, 76) = 0.116137E+01
+ PKER_SDRYG( 6, 77) = 0.116286E+01
+ PKER_SDRYG( 6, 78) = 0.116427E+01
+ PKER_SDRYG( 6, 79) = 0.116559E+01
+ PKER_SDRYG( 6, 80) = 0.116682E+01
+ PKER_SDRYG( 7, 1) = 0.267216E+01
+ PKER_SDRYG( 7, 2) = 0.247542E+01
+ PKER_SDRYG( 7, 3) = 0.229059E+01
+ PKER_SDRYG( 7, 4) = 0.211690E+01
+ PKER_SDRYG( 7, 5) = 0.195366E+01
+ PKER_SDRYG( 7, 6) = 0.180020E+01
+ PKER_SDRYG( 7, 7) = 0.165590E+01
+ PKER_SDRYG( 7, 8) = 0.152016E+01
+ PKER_SDRYG( 7, 9) = 0.139247E+01
+ PKER_SDRYG( 7, 10) = 0.127232E+01
+ PKER_SDRYG( 7, 11) = 0.115928E+01
+ PKER_SDRYG( 7, 12) = 0.105298E+01
+ PKER_SDRYG( 7, 13) = 0.953147E+00
+ PKER_SDRYG( 7, 14) = 0.859548E+00
+ PKER_SDRYG( 7, 15) = 0.772080E+00
+ PKER_SDRYG( 7, 16) = 0.690795E+00
+ PKER_SDRYG( 7, 17) = 0.615899E+00
+ PKER_SDRYG( 7, 18) = 0.547689E+00
+ PKER_SDRYG( 7, 19) = 0.486803E+00
+ PKER_SDRYG( 7, 20) = 0.434037E+00
+ PKER_SDRYG( 7, 21) = 0.390298E+00
+ PKER_SDRYG( 7, 22) = 0.356884E+00
+ PKER_SDRYG( 7, 23) = 0.334845E+00
+ PKER_SDRYG( 7, 24) = 0.324836E+00
+ PKER_SDRYG( 7, 25) = 0.327158E+00
+ PKER_SDRYG( 7, 26) = 0.341163E+00
+ PKER_SDRYG( 7, 27) = 0.365112E+00
+ PKER_SDRYG( 7, 28) = 0.396807E+00
+ PKER_SDRYG( 7, 29) = 0.433487E+00
+ PKER_SDRYG( 7, 30) = 0.472612E+00
+ PKER_SDRYG( 7, 31) = 0.511994E+00
+ PKER_SDRYG( 7, 32) = 0.550118E+00
+ PKER_SDRYG( 7, 33) = 0.586089E+00
+ PKER_SDRYG( 7, 34) = 0.619363E+00
+ PKER_SDRYG( 7, 35) = 0.649769E+00
+ PKER_SDRYG( 7, 36) = 0.677330E+00
+ PKER_SDRYG( 7, 37) = 0.702279E+00
+ PKER_SDRYG( 7, 38) = 0.724930E+00
+ PKER_SDRYG( 7, 39) = 0.745565E+00
+ PKER_SDRYG( 7, 40) = 0.764428E+00
+ PKER_SDRYG( 7, 41) = 0.781707E+00
+ PKER_SDRYG( 7, 42) = 0.797555E+00
+ PKER_SDRYG( 7, 43) = 0.812112E+00
+ PKER_SDRYG( 7, 44) = 0.825509E+00
+ PKER_SDRYG( 7, 45) = 0.837870E+00
+ PKER_SDRYG( 7, 46) = 0.849304E+00
+ PKER_SDRYG( 7, 47) = 0.859904E+00
+ PKER_SDRYG( 7, 48) = 0.869749E+00
+ PKER_SDRYG( 7, 49) = 0.878910E+00
+ PKER_SDRYG( 7, 50) = 0.887445E+00
+ PKER_SDRYG( 7, 51) = 0.895407E+00
+ PKER_SDRYG( 7, 52) = 0.902841E+00
+ PKER_SDRYG( 7, 53) = 0.909790E+00
+ PKER_SDRYG( 7, 54) = 0.916289E+00
+ PKER_SDRYG( 7, 55) = 0.922371E+00
+ PKER_SDRYG( 7, 56) = 0.928066E+00
+ PKER_SDRYG( 7, 57) = 0.933401E+00
+ PKER_SDRYG( 7, 58) = 0.938401E+00
+ PKER_SDRYG( 7, 59) = 0.943087E+00
+ PKER_SDRYG( 7, 60) = 0.947482E+00
+ PKER_SDRYG( 7, 61) = 0.951603E+00
+ PKER_SDRYG( 7, 62) = 0.955469E+00
+ PKER_SDRYG( 7, 63) = 0.959096E+00
+ PKER_SDRYG( 7, 64) = 0.962500E+00
+ PKER_SDRYG( 7, 65) = 0.965694E+00
+ PKER_SDRYG( 7, 66) = 0.968691E+00
+ PKER_SDRYG( 7, 67) = 0.971504E+00
+ PKER_SDRYG( 7, 68) = 0.974145E+00
+ PKER_SDRYG( 7, 69) = 0.976624E+00
+ PKER_SDRYG( 7, 70) = 0.978951E+00
+ PKER_SDRYG( 7, 71) = 0.981136E+00
+ PKER_SDRYG( 7, 72) = 0.983187E+00
+ PKER_SDRYG( 7, 73) = 0.985112E+00
+ PKER_SDRYG( 7, 74) = 0.986920E+00
+ PKER_SDRYG( 7, 75) = 0.988617E+00
+ PKER_SDRYG( 7, 76) = 0.990211E+00
+ PKER_SDRYG( 7, 77) = 0.991707E+00
+ PKER_SDRYG( 7, 78) = 0.993112E+00
+ PKER_SDRYG( 7, 79) = 0.994431E+00
+ PKER_SDRYG( 7, 80) = 0.995669E+00
+ PKER_SDRYG( 8, 1) = 0.275117E+01
+ PKER_SDRYG( 8, 2) = 0.255454E+01
+ PKER_SDRYG( 8, 3) = 0.236983E+01
+ PKER_SDRYG( 8, 4) = 0.219630E+01
+ PKER_SDRYG( 8, 5) = 0.203323E+01
+ PKER_SDRYG( 8, 6) = 0.187998E+01
+ PKER_SDRYG( 8, 7) = 0.173590E+01
+ PKER_SDRYG( 8, 8) = 0.160040E+01
+ PKER_SDRYG( 8, 9) = 0.147293E+01
+ PKER_SDRYG( 8, 10) = 0.135295E+01
+ PKER_SDRYG( 8, 11) = 0.123996E+01
+ PKER_SDRYG( 8, 12) = 0.113353E+01
+ PKER_SDRYG( 8, 13) = 0.103324E+01
+ PKER_SDRYG( 8, 14) = 0.938726E+00
+ PKER_SDRYG( 8, 15) = 0.849707E+00
+ PKER_SDRYG( 8, 16) = 0.765984E+00
+ PKER_SDRYG( 8, 17) = 0.687490E+00
+ PKER_SDRYG( 8, 18) = 0.614228E+00
+ PKER_SDRYG( 8, 19) = 0.546445E+00
+ PKER_SDRYG( 8, 20) = 0.484521E+00
+ PKER_SDRYG( 8, 21) = 0.429191E+00
+ PKER_SDRYG( 8, 22) = 0.381279E+00
+ PKER_SDRYG( 8, 23) = 0.341954E+00
+ PKER_SDRYG( 8, 24) = 0.312266E+00
+ PKER_SDRYG( 8, 25) = 0.293197E+00
+ PKER_SDRYG( 8, 26) = 0.285436E+00
+ PKER_SDRYG( 8, 27) = 0.288590E+00
+ PKER_SDRYG( 8, 28) = 0.301647E+00
+ PKER_SDRYG( 8, 29) = 0.322883E+00
+ PKER_SDRYG( 8, 30) = 0.349944E+00
+ PKER_SDRYG( 8, 31) = 0.380489E+00
+ PKER_SDRYG( 8, 32) = 0.412492E+00
+ PKER_SDRYG( 8, 33) = 0.444350E+00
+ PKER_SDRYG( 8, 34) = 0.475064E+00
+ PKER_SDRYG( 8, 35) = 0.503980E+00
+ PKER_SDRYG( 8, 36) = 0.530853E+00
+ PKER_SDRYG( 8, 37) = 0.555542E+00
+ PKER_SDRYG( 8, 38) = 0.578083E+00
+ PKER_SDRYG( 8, 39) = 0.598637E+00
+ PKER_SDRYG( 8, 40) = 0.617414E+00
+ PKER_SDRYG( 8, 41) = 0.634627E+00
+ PKER_SDRYG( 8, 42) = 0.650467E+00
+ PKER_SDRYG( 8, 43) = 0.665074E+00
+ PKER_SDRYG( 8, 44) = 0.678558E+00
+ PKER_SDRYG( 8, 45) = 0.691015E+00
+ PKER_SDRYG( 8, 46) = 0.702533E+00
+ PKER_SDRYG( 8, 47) = 0.713201E+00
+ PKER_SDRYG( 8, 48) = 0.723101E+00
+ PKER_SDRYG( 8, 49) = 0.732303E+00
+ PKER_SDRYG( 8, 50) = 0.740871E+00
+ PKER_SDRYG( 8, 51) = 0.748859E+00
+ PKER_SDRYG( 8, 52) = 0.756314E+00
+ PKER_SDRYG( 8, 53) = 0.763279E+00
+ PKER_SDRYG( 8, 54) = 0.769790E+00
+ PKER_SDRYG( 8, 55) = 0.775882E+00
+ PKER_SDRYG( 8, 56) = 0.781585E+00
+ PKER_SDRYG( 8, 57) = 0.786926E+00
+ PKER_SDRYG( 8, 58) = 0.791930E+00
+ PKER_SDRYG( 8, 59) = 0.796621E+00
+ PKER_SDRYG( 8, 60) = 0.801018E+00
+ PKER_SDRYG( 8, 61) = 0.805142E+00
+ PKER_SDRYG( 8, 62) = 0.809010E+00
+ PKER_SDRYG( 8, 63) = 0.812638E+00
+ PKER_SDRYG( 8, 64) = 0.816043E+00
+ PKER_SDRYG( 8, 65) = 0.819238E+00
+ PKER_SDRYG( 8, 66) = 0.822236E+00
+ PKER_SDRYG( 8, 67) = 0.825050E+00
+ PKER_SDRYG( 8, 68) = 0.827691E+00
+ PKER_SDRYG( 8, 69) = 0.830170E+00
+ PKER_SDRYG( 8, 70) = 0.832497E+00
+ PKER_SDRYG( 8, 71) = 0.834682E+00
+ PKER_SDRYG( 8, 72) = 0.836733E+00
+ PKER_SDRYG( 8, 73) = 0.838659E+00
+ PKER_SDRYG( 8, 74) = 0.840467E+00
+ PKER_SDRYG( 8, 75) = 0.842164E+00
+ PKER_SDRYG( 8, 76) = 0.843758E+00
+ PKER_SDRYG( 8, 77) = 0.845254E+00
+ PKER_SDRYG( 8, 78) = 0.846659E+00
+ PKER_SDRYG( 8, 79) = 0.847978E+00
+ PKER_SDRYG( 8, 80) = 0.849217E+00
+ PKER_SDRYG( 9, 1) = 0.281873E+01
+ PKER_SDRYG( 9, 2) = 0.262217E+01
+ PKER_SDRYG( 9, 3) = 0.243755E+01
+ PKER_SDRYG( 9, 4) = 0.226413E+01
+ PKER_SDRYG( 9, 5) = 0.210120E+01
+ PKER_SDRYG( 9, 6) = 0.194811E+01
+ PKER_SDRYG( 9, 7) = 0.180423E+01
+ PKER_SDRYG( 9, 8) = 0.166898E+01
+ PKER_SDRYG( 9, 9) = 0.154178E+01
+ PKER_SDRYG( 9, 10) = 0.142211E+01
+ PKER_SDRYG( 9, 11) = 0.130946E+01
+ PKER_SDRYG( 9, 12) = 0.120336E+01
+ PKER_SDRYG( 9, 13) = 0.110334E+01
+ PKER_SDRYG( 9, 14) = 0.100898E+01
+ PKER_SDRYG( 9, 15) = 0.919904E+00
+ PKER_SDRYG( 9, 16) = 0.835767E+00
+ PKER_SDRYG( 9, 17) = 0.756296E+00
+ PKER_SDRYG( 9, 18) = 0.681312E+00
+ PKER_SDRYG( 9, 19) = 0.610704E+00
+ PKER_SDRYG( 9, 20) = 0.544549E+00
+ PKER_SDRYG( 9, 21) = 0.483126E+00
+ PKER_SDRYG( 9, 22) = 0.426903E+00
+ PKER_SDRYG( 9, 23) = 0.376623E+00
+ PKER_SDRYG( 9, 24) = 0.333280E+00
+ PKER_SDRYG( 9, 25) = 0.297980E+00
+ PKER_SDRYG( 9, 26) = 0.271818E+00
+ PKER_SDRYG( 9, 27) = 0.255645E+00
+ PKER_SDRYG( 9, 28) = 0.249649E+00
+ PKER_SDRYG( 9, 29) = 0.253211E+00
+ PKER_SDRYG( 9, 30) = 0.265062E+00
+ PKER_SDRYG( 9, 31) = 0.283396E+00
+ PKER_SDRYG( 9, 32) = 0.306054E+00
+ PKER_SDRYG( 9, 33) = 0.331204E+00
+ PKER_SDRYG( 9, 34) = 0.357250E+00
+ PKER_SDRYG( 9, 35) = 0.383076E+00
+ PKER_SDRYG( 9, 36) = 0.407898E+00
+ PKER_SDRYG( 9, 37) = 0.431335E+00
+ PKER_SDRYG( 9, 38) = 0.453229E+00
+ PKER_SDRYG( 9, 39) = 0.473481E+00
+ PKER_SDRYG( 9, 40) = 0.492133E+00
+ PKER_SDRYG( 9, 41) = 0.509252E+00
+ PKER_SDRYG( 9, 42) = 0.524980E+00
+ PKER_SDRYG( 9, 43) = 0.539487E+00
+ PKER_SDRYG( 9, 44) = 0.552905E+00
+ PKER_SDRYG( 9, 45) = 0.565346E+00
+ PKER_SDRYG( 9, 46) = 0.576895E+00
+ PKER_SDRYG( 9, 47) = 0.587615E+00
+ PKER_SDRYG( 9, 48) = 0.597569E+00
+ PKER_SDRYG( 9, 49) = 0.606817E+00
+ PKER_SDRYG( 9, 50) = 0.615422E+00
+ PKER_SDRYG( 9, 51) = 0.623439E+00
+ PKER_SDRYG( 9, 52) = 0.630916E+00
+ PKER_SDRYG( 9, 53) = 0.637899E+00
+ PKER_SDRYG( 9, 54) = 0.644424E+00
+ PKER_SDRYG( 9, 55) = 0.650527E+00
+ PKER_SDRYG( 9, 56) = 0.656238E+00
+ PKER_SDRYG( 9, 57) = 0.661586E+00
+ PKER_SDRYG( 9, 58) = 0.666595E+00
+ PKER_SDRYG( 9, 59) = 0.671290E+00
+ PKER_SDRYG( 9, 60) = 0.675690E+00
+ PKER_SDRYG( 9, 61) = 0.679817E+00
+ PKER_SDRYG( 9, 62) = 0.683687E+00
+ PKER_SDRYG( 9, 63) = 0.687317E+00
+ PKER_SDRYG( 9, 64) = 0.690723E+00
+ PKER_SDRYG( 9, 65) = 0.693918E+00
+ PKER_SDRYG( 9, 66) = 0.696917E+00
+ PKER_SDRYG( 9, 67) = 0.699732E+00
+ PKER_SDRYG( 9, 68) = 0.702374E+00
+ PKER_SDRYG( 9, 69) = 0.704853E+00
+ PKER_SDRYG( 9, 70) = 0.707181E+00
+ PKER_SDRYG( 9, 71) = 0.709366E+00
+ PKER_SDRYG( 9, 72) = 0.711417E+00
+ PKER_SDRYG( 9, 73) = 0.713343E+00
+ PKER_SDRYG( 9, 74) = 0.715151E+00
+ PKER_SDRYG( 9, 75) = 0.716848E+00
+ PKER_SDRYG( 9, 76) = 0.718442E+00
+ PKER_SDRYG( 9, 77) = 0.719938E+00
+ PKER_SDRYG( 9, 78) = 0.721343E+00
+ PKER_SDRYG( 9, 79) = 0.722663E+00
+ PKER_SDRYG( 9, 80) = 0.723901E+00
+ PKER_SDRYG( 10, 1) = 0.287649E+01
+ PKER_SDRYG( 10, 2) = 0.267999E+01
+ PKER_SDRYG( 10, 3) = 0.249543E+01
+ PKER_SDRYG( 10, 4) = 0.232209E+01
+ PKER_SDRYG( 10, 5) = 0.215926E+01
+ PKER_SDRYG( 10, 6) = 0.200629E+01
+ PKER_SDRYG( 10, 7) = 0.186256E+01
+ PKER_SDRYG( 10, 8) = 0.172749E+01
+ PKER_SDRYG( 10, 9) = 0.160052E+01
+ PKER_SDRYG( 10, 10) = 0.148113E+01
+ PKER_SDRYG( 10, 11) = 0.136880E+01
+ PKER_SDRYG( 10, 12) = 0.126307E+01
+ PKER_SDRYG( 10, 13) = 0.116348E+01
+ PKER_SDRYG( 10, 14) = 0.106958E+01
+ PKER_SDRYG( 10, 15) = 0.980970E+00
+ PKER_SDRYG( 10, 16) = 0.897241E+00
+ PKER_SDRYG( 10, 17) = 0.818035E+00
+ PKER_SDRYG( 10, 18) = 0.743029E+00
+ PKER_SDRYG( 10, 19) = 0.671957E+00
+ PKER_SDRYG( 10, 20) = 0.604628E+00
+ PKER_SDRYG( 10, 21) = 0.540973E+00
+ PKER_SDRYG( 10, 22) = 0.481134E+00
+ PKER_SDRYG( 10, 23) = 0.425371E+00
+ PKER_SDRYG( 10, 24) = 0.374261E+00
+ PKER_SDRYG( 10, 25) = 0.328628E+00
+ PKER_SDRYG( 10, 26) = 0.289572E+00
+ PKER_SDRYG( 10, 27) = 0.258117E+00
+ PKER_SDRYG( 10, 28) = 0.235368E+00
+ PKER_SDRYG( 10, 29) = 0.221755E+00
+ PKER_SDRYG( 10, 30) = 0.217136E+00
+ PKER_SDRYG( 10, 31) = 0.220856E+00
+ PKER_SDRYG( 10, 32) = 0.231296E+00
+ PKER_SDRYG( 10, 33) = 0.246745E+00
+ PKER_SDRYG( 10, 34) = 0.265573E+00
+ PKER_SDRYG( 10, 35) = 0.286164E+00
+ PKER_SDRYG( 10, 36) = 0.307344E+00
+ PKER_SDRYG( 10, 37) = 0.328309E+00
+ PKER_SDRYG( 10, 38) = 0.348513E+00
+ PKER_SDRYG( 10, 39) = 0.367687E+00
+ PKER_SDRYG( 10, 40) = 0.385687E+00
+ PKER_SDRYG( 10, 41) = 0.402481E+00
+ PKER_SDRYG( 10, 42) = 0.418056E+00
+ PKER_SDRYG( 10, 43) = 0.432452E+00
+ PKER_SDRYG( 10, 44) = 0.445760E+00
+ PKER_SDRYG( 10, 45) = 0.458086E+00
+ PKER_SDRYG( 10, 46) = 0.469537E+00
+ PKER_SDRYG( 10, 47) = 0.480201E+00
+ PKER_SDRYG( 10, 48) = 0.490143E+00
+ PKER_SDRYG( 10, 49) = 0.499411E+00
+ PKER_SDRYG( 10, 50) = 0.508047E+00
+ PKER_SDRYG( 10, 51) = 0.516093E+00
+ PKER_SDRYG( 10, 52) = 0.523596E+00
+ PKER_SDRYG( 10, 53) = 0.530598E+00
+ PKER_SDRYG( 10, 54) = 0.537139E+00
+ PKER_SDRYG( 10, 55) = 0.543253E+00
+ PKER_SDRYG( 10, 56) = 0.548974E+00
+ PKER_SDRYG( 10, 57) = 0.554329E+00
+ PKER_SDRYG( 10, 58) = 0.559345E+00
+ PKER_SDRYG( 10, 59) = 0.564044E+00
+ PKER_SDRYG( 10, 60) = 0.568448E+00
+ PKER_SDRYG( 10, 61) = 0.572577E+00
+ PKER_SDRYG( 10, 62) = 0.576449E+00
+ PKER_SDRYG( 10, 63) = 0.580081E+00
+ PKER_SDRYG( 10, 64) = 0.583488E+00
+ PKER_SDRYG( 10, 65) = 0.586685E+00
+ PKER_SDRYG( 10, 66) = 0.589685E+00
+ PKER_SDRYG( 10, 67) = 0.592500E+00
+ PKER_SDRYG( 10, 68) = 0.595142E+00
+ PKER_SDRYG( 10, 69) = 0.597623E+00
+ PKER_SDRYG( 10, 70) = 0.599950E+00
+ PKER_SDRYG( 10, 71) = 0.602136E+00
+ PKER_SDRYG( 10, 72) = 0.604187E+00
+ PKER_SDRYG( 10, 73) = 0.606113E+00
+ PKER_SDRYG( 10, 74) = 0.607921E+00
+ PKER_SDRYG( 10, 75) = 0.609619E+00
+ PKER_SDRYG( 10, 76) = 0.611213E+00
+ PKER_SDRYG( 10, 77) = 0.612709E+00
+ PKER_SDRYG( 10, 78) = 0.614114E+00
+ PKER_SDRYG( 10, 79) = 0.615433E+00
+ PKER_SDRYG( 10, 80) = 0.616672E+00
+ PKER_SDRYG( 11, 1) = 0.292588E+01
+ PKER_SDRYG( 11, 2) = 0.272942E+01
+ PKER_SDRYG( 11, 3) = 0.254491E+01
+ PKER_SDRYG( 11, 4) = 0.237162E+01
+ PKER_SDRYG( 11, 5) = 0.220887E+01
+ PKER_SDRYG( 11, 6) = 0.205599E+01
+ PKER_SDRYG( 11, 7) = 0.191237E+01
+ PKER_SDRYG( 11, 8) = 0.177743E+01
+ PKER_SDRYG( 11, 9) = 0.165062E+01
+ PKER_SDRYG( 11, 10) = 0.153143E+01
+ PKER_SDRYG( 11, 11) = 0.141936E+01
+ PKER_SDRYG( 11, 12) = 0.131393E+01
+ PKER_SDRYG( 11, 13) = 0.121471E+01
+ PKER_SDRYG( 11, 14) = 0.112125E+01
+ PKER_SDRYG( 11, 15) = 0.103314E+01
+ PKER_SDRYG( 11, 16) = 0.949992E+00
+ PKER_SDRYG( 11, 17) = 0.871403E+00
+ PKER_SDRYG( 11, 18) = 0.797011E+00
+ PKER_SDRYG( 11, 19) = 0.726472E+00
+ PKER_SDRYG( 11, 20) = 0.659472E+00
+ PKER_SDRYG( 11, 21) = 0.595759E+00
+ PKER_SDRYG( 11, 22) = 0.535173E+00
+ PKER_SDRYG( 11, 23) = 0.477686E+00
+ PKER_SDRYG( 11, 24) = 0.423410E+00
+ PKER_SDRYG( 11, 25) = 0.372735E+00
+ PKER_SDRYG( 11, 26) = 0.326343E+00
+ PKER_SDRYG( 11, 27) = 0.285079E+00
+ PKER_SDRYG( 11, 28) = 0.250073E+00
+ PKER_SDRYG( 11, 29) = 0.222370E+00
+ PKER_SDRYG( 11, 30) = 0.202694E+00
+ PKER_SDRYG( 11, 31) = 0.191356E+00
+ PKER_SDRYG( 11, 32) = 0.187944E+00
+ PKER_SDRYG( 11, 33) = 0.191428E+00
+ PKER_SDRYG( 11, 34) = 0.200384E+00
+ PKER_SDRYG( 11, 35) = 0.213284E+00
+ PKER_SDRYG( 11, 36) = 0.228761E+00
+ PKER_SDRYG( 11, 37) = 0.245555E+00
+ PKER_SDRYG( 11, 38) = 0.262820E+00
+ PKER_SDRYG( 11, 39) = 0.279947E+00
+ PKER_SDRYG( 11, 40) = 0.296552E+00
+ PKER_SDRYG( 11, 41) = 0.312363E+00
+ PKER_SDRYG( 11, 42) = 0.327309E+00
+ PKER_SDRYG( 11, 43) = 0.341353E+00
+ PKER_SDRYG( 11, 44) = 0.354467E+00
+ PKER_SDRYG( 11, 45) = 0.366682E+00
+ PKER_SDRYG( 11, 46) = 0.378026E+00
+ PKER_SDRYG( 11, 47) = 0.388571E+00
+ PKER_SDRYG( 11, 48) = 0.398407E+00
+ PKER_SDRYG( 11, 49) = 0.407595E+00
+ PKER_SDRYG( 11, 50) = 0.416190E+00
+ PKER_SDRYG( 11, 51) = 0.424231E+00
+ PKER_SDRYG( 11, 52) = 0.431746E+00
+ PKER_SDRYG( 11, 53) = 0.438766E+00
+ PKER_SDRYG( 11, 54) = 0.445323E+00
+ PKER_SDRYG( 11, 55) = 0.451452E+00
+ PKER_SDRYG( 11, 56) = 0.457183E+00
+ PKER_SDRYG( 11, 57) = 0.462546E+00
+ PKER_SDRYG( 11, 58) = 0.467568E+00
+ PKER_SDRYG( 11, 59) = 0.472272E+00
+ PKER_SDRYG( 11, 60) = 0.476681E+00
+ PKER_SDRYG( 11, 61) = 0.480813E+00
+ PKER_SDRYG( 11, 62) = 0.484687E+00
+ PKER_SDRYG( 11, 63) = 0.488321E+00
+ PKER_SDRYG( 11, 64) = 0.491730E+00
+ PKER_SDRYG( 11, 65) = 0.494928E+00
+ PKER_SDRYG( 11, 66) = 0.497929E+00
+ PKER_SDRYG( 11, 67) = 0.500745E+00
+ PKER_SDRYG( 11, 68) = 0.503387E+00
+ PKER_SDRYG( 11, 69) = 0.505868E+00
+ PKER_SDRYG( 11, 70) = 0.508196E+00
+ PKER_SDRYG( 11, 71) = 0.510382E+00
+ PKER_SDRYG( 11, 72) = 0.512433E+00
+ PKER_SDRYG( 11, 73) = 0.514360E+00
+ PKER_SDRYG( 11, 74) = 0.516168E+00
+ PKER_SDRYG( 11, 75) = 0.517866E+00
+ PKER_SDRYG( 11, 76) = 0.519459E+00
+ PKER_SDRYG( 11, 77) = 0.520956E+00
+ PKER_SDRYG( 11, 78) = 0.522361E+00
+ PKER_SDRYG( 11, 79) = 0.523680E+00
+ PKER_SDRYG( 11, 80) = 0.524919E+00
+ PKER_SDRYG( 12, 1) = 0.296813E+01
+ PKER_SDRYG( 12, 2) = 0.277169E+01
+ PKER_SDRYG( 12, 3) = 0.258722E+01
+ PKER_SDRYG( 12, 4) = 0.241397E+01
+ PKER_SDRYG( 12, 5) = 0.225126E+01
+ PKER_SDRYG( 12, 6) = 0.209845E+01
+ PKER_SDRYG( 12, 7) = 0.195490E+01
+ PKER_SDRYG( 12, 8) = 0.182006E+01
+ PKER_SDRYG( 12, 9) = 0.169337E+01
+ PKER_SDRYG( 12, 10) = 0.157433E+01
+ PKER_SDRYG( 12, 11) = 0.146243E+01
+ PKER_SDRYG( 12, 12) = 0.135723E+01
+ PKER_SDRYG( 12, 13) = 0.125828E+01
+ PKER_SDRYG( 12, 14) = 0.116516E+01
+ PKER_SDRYG( 12, 15) = 0.107747E+01
+ PKER_SDRYG( 12, 16) = 0.994807E+00
+ PKER_SDRYG( 12, 17) = 0.916807E+00
+ PKER_SDRYG( 12, 18) = 0.843095E+00
+ PKER_SDRYG( 12, 19) = 0.773314E+00
+ PKER_SDRYG( 12, 20) = 0.707116E+00
+ PKER_SDRYG( 12, 21) = 0.644174E+00
+ PKER_SDRYG( 12, 22) = 0.584199E+00
+ PKER_SDRYG( 12, 23) = 0.526949E+00
+ PKER_SDRYG( 12, 24) = 0.472291E+00
+ PKER_SDRYG( 12, 25) = 0.420211E+00
+ PKER_SDRYG( 12, 26) = 0.370902E+00
+ PKER_SDRYG( 12, 27) = 0.324892E+00
+ PKER_SDRYG( 12, 28) = 0.282842E+00
+ PKER_SDRYG( 12, 29) = 0.245728E+00
+ PKER_SDRYG( 12, 30) = 0.214626E+00
+ PKER_SDRYG( 12, 31) = 0.190466E+00
+ PKER_SDRYG( 12, 32) = 0.173675E+00
+ PKER_SDRYG( 12, 33) = 0.164353E+00
+ PKER_SDRYG( 12, 34) = 0.161777E+00
+ PKER_SDRYG( 12, 35) = 0.164848E+00
+ PKER_SDRYG( 12, 36) = 0.172447E+00
+ PKER_SDRYG( 12, 37) = 0.183108E+00
+ PKER_SDRYG( 12, 38) = 0.195737E+00
+ PKER_SDRYG( 12, 39) = 0.209501E+00
+ PKER_SDRYG( 12, 40) = 0.223654E+00
+ PKER_SDRYG( 12, 41) = 0.237731E+00
+ PKER_SDRYG( 12, 42) = 0.251446E+00
+ PKER_SDRYG( 12, 43) = 0.264605E+00
+ PKER_SDRYG( 12, 44) = 0.277116E+00
+ PKER_SDRYG( 12, 45) = 0.288946E+00
+ PKER_SDRYG( 12, 46) = 0.300077E+00
+ PKER_SDRYG( 12, 47) = 0.310498E+00
+ PKER_SDRYG( 12, 48) = 0.320228E+00
+ PKER_SDRYG( 12, 49) = 0.329310E+00
+ PKER_SDRYG( 12, 50) = 0.337797E+00
+ PKER_SDRYG( 12, 51) = 0.345746E+00
+ PKER_SDRYG( 12, 52) = 0.353202E+00
+ PKER_SDRYG( 12, 53) = 0.360196E+00
+ PKER_SDRYG( 12, 54) = 0.366751E+00
+ PKER_SDRYG( 12, 55) = 0.372888E+00
+ PKER_SDRYG( 12, 56) = 0.378630E+00
+ PKER_SDRYG( 12, 57) = 0.384002E+00
+ PKER_SDRYG( 12, 58) = 0.389031E+00
+ PKER_SDRYG( 12, 59) = 0.393741E+00
+ PKER_SDRYG( 12, 60) = 0.398154E+00
+ PKER_SDRYG( 12, 61) = 0.402290E+00
+ PKER_SDRYG( 12, 62) = 0.406167E+00
+ PKER_SDRYG( 12, 63) = 0.409803E+00
+ PKER_SDRYG( 12, 64) = 0.413213E+00
+ PKER_SDRYG( 12, 65) = 0.416413E+00
+ PKER_SDRYG( 12, 66) = 0.419414E+00
+ PKER_SDRYG( 12, 67) = 0.422231E+00
+ PKER_SDRYG( 12, 68) = 0.424874E+00
+ PKER_SDRYG( 12, 69) = 0.427355E+00
+ PKER_SDRYG( 12, 70) = 0.429684E+00
+ PKER_SDRYG( 12, 71) = 0.431870E+00
+ PKER_SDRYG( 12, 72) = 0.433922E+00
+ PKER_SDRYG( 12, 73) = 0.435848E+00
+ PKER_SDRYG( 12, 74) = 0.437657E+00
+ PKER_SDRYG( 12, 75) = 0.439355E+00
+ PKER_SDRYG( 12, 76) = 0.440949E+00
+ PKER_SDRYG( 12, 77) = 0.442445E+00
+ PKER_SDRYG( 12, 78) = 0.443850E+00
+ PKER_SDRYG( 12, 79) = 0.445170E+00
+ PKER_SDRYG( 12, 80) = 0.446408E+00
+ PKER_SDRYG( 13, 1) = 0.300426E+01
+ PKER_SDRYG( 13, 2) = 0.280784E+01
+ PKER_SDRYG( 13, 3) = 0.262339E+01
+ PKER_SDRYG( 13, 4) = 0.245018E+01
+ PKER_SDRYG( 13, 5) = 0.228751E+01
+ PKER_SDRYG( 13, 6) = 0.213473E+01
+ PKER_SDRYG( 13, 7) = 0.199125E+01
+ PKER_SDRYG( 13, 8) = 0.185647E+01
+ PKER_SDRYG( 13, 9) = 0.172987E+01
+ PKER_SDRYG( 13, 10) = 0.161093E+01
+ PKER_SDRYG( 13, 11) = 0.149916E+01
+ PKER_SDRYG( 13, 12) = 0.139412E+01
+ PKER_SDRYG( 13, 13) = 0.129536E+01
+ PKER_SDRYG( 13, 14) = 0.120249E+01
+ PKER_SDRYG( 13, 15) = 0.111509E+01
+ PKER_SDRYG( 13, 16) = 0.103280E+01
+ PKER_SDRYG( 13, 17) = 0.955258E+00
+ PKER_SDRYG( 13, 18) = 0.882099E+00
+ PKER_SDRYG( 13, 19) = 0.812980E+00
+ PKER_SDRYG( 13, 20) = 0.747559E+00
+ PKER_SDRYG( 13, 21) = 0.685504E+00
+ PKER_SDRYG( 13, 22) = 0.626487E+00
+ PKER_SDRYG( 13, 23) = 0.570200E+00
+ PKER_SDRYG( 13, 24) = 0.516370E+00
+ PKER_SDRYG( 13, 25) = 0.464781E+00
+ PKER_SDRYG( 13, 26) = 0.415330E+00
+ PKER_SDRYG( 13, 27) = 0.368082E+00
+ PKER_SDRYG( 13, 28) = 0.323329E+00
+ PKER_SDRYG( 13, 29) = 0.281592E+00
+ PKER_SDRYG( 13, 30) = 0.243675E+00
+ PKER_SDRYG( 13, 31) = 0.210623E+00
+ PKER_SDRYG( 13, 32) = 0.183280E+00
+ PKER_SDRYG( 13, 33) = 0.162430E+00
+ PKER_SDRYG( 13, 34) = 0.148317E+00
+ PKER_SDRYG( 13, 35) = 0.140602E+00
+ PKER_SDRYG( 13, 36) = 0.138606E+00
+ PKER_SDRYG( 13, 37) = 0.141294E+00
+ PKER_SDRYG( 13, 38) = 0.147531E+00
+ PKER_SDRYG( 13, 39) = 0.156269E+00
+ PKER_SDRYG( 13, 40) = 0.166597E+00
+ PKER_SDRYG( 13, 41) = 0.177865E+00
+ PKER_SDRYG( 13, 42) = 0.189495E+00
+ PKER_SDRYG( 13, 43) = 0.201132E+00
+ PKER_SDRYG( 13, 44) = 0.212557E+00
+ PKER_SDRYG( 13, 45) = 0.223599E+00
+ PKER_SDRYG( 13, 46) = 0.234145E+00
+ PKER_SDRYG( 13, 47) = 0.244174E+00
+ PKER_SDRYG( 13, 48) = 0.253668E+00
+ PKER_SDRYG( 13, 49) = 0.262605E+00
+ PKER_SDRYG( 13, 50) = 0.270996E+00
+ PKER_SDRYG( 13, 51) = 0.278849E+00
+ PKER_SDRYG( 13, 52) = 0.286203E+00
+ PKER_SDRYG( 13, 53) = 0.293107E+00
+ PKER_SDRYG( 13, 54) = 0.299592E+00
+ PKER_SDRYG( 13, 55) = 0.305689E+00
+ PKER_SDRYG( 13, 56) = 0.311416E+00
+ PKER_SDRYG( 13, 57) = 0.316789E+00
+ PKER_SDRYG( 13, 58) = 0.321824E+00
+ PKER_SDRYG( 13, 59) = 0.326539E+00
+ PKER_SDRYG( 13, 60) = 0.330957E+00
+ PKER_SDRYG( 13, 61) = 0.335096E+00
+ PKER_SDRYG( 13, 62) = 0.338977E+00
+ PKER_SDRYG( 13, 63) = 0.342615E+00
+ PKER_SDRYG( 13, 64) = 0.346027E+00
+ PKER_SDRYG( 13, 65) = 0.349228E+00
+ PKER_SDRYG( 13, 66) = 0.352231E+00
+ PKER_SDRYG( 13, 67) = 0.355048E+00
+ PKER_SDRYG( 13, 68) = 0.357693E+00
+ PKER_SDRYG( 13, 69) = 0.360174E+00
+ PKER_SDRYG( 13, 70) = 0.362503E+00
+ PKER_SDRYG( 13, 71) = 0.364689E+00
+ PKER_SDRYG( 13, 72) = 0.366742E+00
+ PKER_SDRYG( 13, 73) = 0.368668E+00
+ PKER_SDRYG( 13, 74) = 0.370477E+00
+ PKER_SDRYG( 13, 75) = 0.372175E+00
+ PKER_SDRYG( 13, 76) = 0.373769E+00
+ PKER_SDRYG( 13, 77) = 0.375266E+00
+ PKER_SDRYG( 13, 78) = 0.376671E+00
+ PKER_SDRYG( 13, 79) = 0.377990E+00
+ PKER_SDRYG( 13, 80) = 0.379229E+00
+ PKER_SDRYG( 14, 1) = 0.303517E+01
+ PKER_SDRYG( 14, 2) = 0.283877E+01
+ PKER_SDRYG( 14, 3) = 0.265433E+01
+ PKER_SDRYG( 14, 4) = 0.248114E+01
+ PKER_SDRYG( 14, 5) = 0.231850E+01
+ PKER_SDRYG( 14, 6) = 0.216575E+01
+ PKER_SDRYG( 14, 7) = 0.202231E+01
+ PKER_SDRYG( 14, 8) = 0.188758E+01
+ PKER_SDRYG( 14, 9) = 0.176104E+01
+ PKER_SDRYG( 14, 10) = 0.164217E+01
+ PKER_SDRYG( 14, 11) = 0.153050E+01
+ PKER_SDRYG( 14, 12) = 0.142557E+01
+ PKER_SDRYG( 14, 13) = 0.132695E+01
+ PKER_SDRYG( 14, 14) = 0.123425E+01
+ PKER_SDRYG( 14, 15) = 0.114707E+01
+ PKER_SDRYG( 14, 16) = 0.106505E+01
+ PKER_SDRYG( 14, 17) = 0.987829E+00
+ PKER_SDRYG( 14, 18) = 0.915075E+00
+ PKER_SDRYG( 14, 19) = 0.846455E+00
+ PKER_SDRYG( 14, 20) = 0.781644E+00
+ PKER_SDRYG( 14, 21) = 0.720325E+00
+ PKER_SDRYG( 14, 22) = 0.662179E+00
+ PKER_SDRYG( 14, 23) = 0.606894E+00
+ PKER_SDRYG( 14, 24) = 0.554165E+00
+ PKER_SDRYG( 14, 25) = 0.503702E+00
+ PKER_SDRYG( 14, 26) = 0.455255E+00
+ PKER_SDRYG( 14, 27) = 0.408655E+00
+ PKER_SDRYG( 14, 28) = 0.363840E+00
+ PKER_SDRYG( 14, 29) = 0.320957E+00
+ PKER_SDRYG( 14, 30) = 0.280360E+00
+ PKER_SDRYG( 14, 31) = 0.242663E+00
+ PKER_SDRYG( 14, 32) = 0.208805E+00
+ PKER_SDRYG( 14, 33) = 0.179611E+00
+ PKER_SDRYG( 14, 34) = 0.155880E+00
+ PKER_SDRYG( 14, 35) = 0.138098E+00
+ PKER_SDRYG( 14, 36) = 0.126282E+00
+ PKER_SDRYG( 14, 37) = 0.119901E+00
+ PKER_SDRYG( 14, 38) = 0.118300E+00
+ PKER_SDRYG( 14, 39) = 0.120505E+00
+ PKER_SDRYG( 14, 40) = 0.125551E+00
+ PKER_SDRYG( 14, 41) = 0.132700E+00
+ PKER_SDRYG( 14, 42) = 0.141142E+00
+ PKER_SDRYG( 14, 43) = 0.150371E+00
+ PKER_SDRYG( 14, 44) = 0.159990E+00
+ PKER_SDRYG( 14, 45) = 0.169685E+00
+ PKER_SDRYG( 14, 46) = 0.179245E+00
+ PKER_SDRYG( 14, 47) = 0.188540E+00
+ PKER_SDRYG( 14, 48) = 0.197487E+00
+ PKER_SDRYG( 14, 49) = 0.206035E+00
+ PKER_SDRYG( 14, 50) = 0.214165E+00
+ PKER_SDRYG( 14, 51) = 0.221865E+00
+ PKER_SDRYG( 14, 52) = 0.229121E+00
+ PKER_SDRYG( 14, 53) = 0.235935E+00
+ PKER_SDRYG( 14, 54) = 0.242332E+00
+ PKER_SDRYG( 14, 55) = 0.248340E+00
+ PKER_SDRYG( 14, 56) = 0.253994E+00
+ PKER_SDRYG( 14, 57) = 0.259317E+00
+ PKER_SDRYG( 14, 58) = 0.264327E+00
+ PKER_SDRYG( 14, 59) = 0.269036E+00
+ PKER_SDRYG( 14, 60) = 0.273454E+00
+ PKER_SDRYG( 14, 61) = 0.277597E+00
+ PKER_SDRYG( 14, 62) = 0.281481E+00
+ PKER_SDRYG( 14, 63) = 0.285122E+00
+ PKER_SDRYG( 14, 64) = 0.288536E+00
+ PKER_SDRYG( 14, 65) = 0.291738E+00
+ PKER_SDRYG( 14, 66) = 0.294743E+00
+ PKER_SDRYG( 14, 67) = 0.297561E+00
+ PKER_SDRYG( 14, 68) = 0.300206E+00
+ PKER_SDRYG( 14, 69) = 0.302688E+00
+ PKER_SDRYG( 14, 70) = 0.305018E+00
+ PKER_SDRYG( 14, 71) = 0.307205E+00
+ PKER_SDRYG( 14, 72) = 0.309257E+00
+ PKER_SDRYG( 14, 73) = 0.311184E+00
+ PKER_SDRYG( 14, 74) = 0.312993E+00
+ PKER_SDRYG( 14, 75) = 0.314691E+00
+ PKER_SDRYG( 14, 76) = 0.316285E+00
+ PKER_SDRYG( 14, 77) = 0.317782E+00
+ PKER_SDRYG( 14, 78) = 0.319187E+00
+ PKER_SDRYG( 14, 79) = 0.320506E+00
+ PKER_SDRYG( 14, 80) = 0.321745E+00
+ PKER_SDRYG( 15, 1) = 0.306161E+01
+ PKER_SDRYG( 15, 2) = 0.286522E+01
+ PKER_SDRYG( 15, 3) = 0.268080E+01
+ PKER_SDRYG( 15, 4) = 0.250762E+01
+ PKER_SDRYG( 15, 5) = 0.234499E+01
+ PKER_SDRYG( 15, 6) = 0.219228E+01
+ PKER_SDRYG( 15, 7) = 0.204886E+01
+ PKER_SDRYG( 15, 8) = 0.191417E+01
+ PKER_SDRYG( 15, 9) = 0.178767E+01
+ PKER_SDRYG( 15, 10) = 0.166885E+01
+ PKER_SDRYG( 15, 11) = 0.155725E+01
+ PKER_SDRYG( 15, 12) = 0.145240E+01
+ PKER_SDRYG( 15, 13) = 0.135388E+01
+ PKER_SDRYG( 15, 14) = 0.126130E+01
+ PKER_SDRYG( 15, 15) = 0.117427E+01
+ PKER_SDRYG( 15, 16) = 0.109244E+01
+ PKER_SDRYG( 15, 17) = 0.101546E+01
+ PKER_SDRYG( 15, 18) = 0.942994E+00
+ PKER_SDRYG( 15, 19) = 0.874732E+00
+ PKER_SDRYG( 15, 20) = 0.810365E+00
+ PKER_SDRYG( 15, 21) = 0.749592E+00
+ PKER_SDRYG( 15, 22) = 0.692115E+00
+ PKER_SDRYG( 15, 23) = 0.637639E+00
+ PKER_SDRYG( 15, 24) = 0.585869E+00
+ PKER_SDRYG( 15, 25) = 0.536512E+00
+ PKER_SDRYG( 15, 26) = 0.489283E+00
+ PKER_SDRYG( 15, 27) = 0.443919E+00
+ PKER_SDRYG( 15, 28) = 0.400205E+00
+ PKER_SDRYG( 15, 29) = 0.358017E+00
+ PKER_SDRYG( 15, 30) = 0.317369E+00
+ PKER_SDRYG( 15, 31) = 0.278488E+00
+ PKER_SDRYG( 15, 32) = 0.241839E+00
+ PKER_SDRYG( 15, 33) = 0.208131E+00
+ PKER_SDRYG( 15, 34) = 0.178156E+00
+ PKER_SDRYG( 15, 35) = 0.152678E+00
+ PKER_SDRYG( 15, 36) = 0.132382E+00
+ PKER_SDRYG( 15, 37) = 0.117317E+00
+ PKER_SDRYG( 15, 38) = 0.107412E+00
+ PKER_SDRYG( 15, 39) = 0.102138E+00
+ PKER_SDRYG( 15, 40) = 0.100720E+00
+ PKER_SDRYG( 15, 41) = 0.102430E+00
+ PKER_SDRYG( 15, 42) = 0.106496E+00
+ PKER_SDRYG( 15, 43) = 0.112243E+00
+ PKER_SDRYG( 15, 44) = 0.119136E+00
+ PKER_SDRYG( 15, 45) = 0.126711E+00
+ PKER_SDRYG( 15, 46) = 0.134684E+00
+ PKER_SDRYG( 15, 47) = 0.142774E+00
+ PKER_SDRYG( 15, 48) = 0.150805E+00
+ PKER_SDRYG( 15, 49) = 0.158681E+00
+ PKER_SDRYG( 15, 50) = 0.166306E+00
+ PKER_SDRYG( 15, 51) = 0.173620E+00
+ PKER_SDRYG( 15, 52) = 0.180607E+00
+ PKER_SDRYG( 15, 53) = 0.187254E+00
+ PKER_SDRYG( 15, 54) = 0.193543E+00
+ PKER_SDRYG( 15, 55) = 0.199475E+00
+ PKER_SDRYG( 15, 56) = 0.205051E+00
+ PKER_SDRYG( 15, 57) = 0.210294E+00
+ PKER_SDRYG( 15, 58) = 0.215233E+00
+ PKER_SDRYG( 15, 59) = 0.219886E+00
+ PKER_SDRYG( 15, 60) = 0.224272E+00
+ PKER_SDRYG( 15, 61) = 0.228402E+00
+ PKER_SDRYG( 15, 62) = 0.232282E+00
+ PKER_SDRYG( 15, 63) = 0.235924E+00
+ PKER_SDRYG( 15, 64) = 0.239341E+00
+ PKER_SDRYG( 15, 65) = 0.242545E+00
+ PKER_SDRYG( 15, 66) = 0.245550E+00
+ PKER_SDRYG( 15, 67) = 0.248370E+00
+ PKER_SDRYG( 15, 68) = 0.251016E+00
+ PKER_SDRYG( 15, 69) = 0.253499E+00
+ PKER_SDRYG( 15, 70) = 0.255829E+00
+ PKER_SDRYG( 15, 71) = 0.258016E+00
+ PKER_SDRYG( 15, 72) = 0.260069E+00
+ PKER_SDRYG( 15, 73) = 0.261996E+00
+ PKER_SDRYG( 15, 74) = 0.263805E+00
+ PKER_SDRYG( 15, 75) = 0.265503E+00
+ PKER_SDRYG( 15, 76) = 0.267097E+00
+ PKER_SDRYG( 15, 77) = 0.268594E+00
+ PKER_SDRYG( 15, 78) = 0.270000E+00
+ PKER_SDRYG( 15, 79) = 0.271319E+00
+ PKER_SDRYG( 15, 80) = 0.272558E+00
+ PKER_SDRYG( 16, 1) = 0.308423E+01
+ PKER_SDRYG( 16, 2) = 0.288784E+01
+ PKER_SDRYG( 16, 3) = 0.270343E+01
+ PKER_SDRYG( 16, 4) = 0.253026E+01
+ PKER_SDRYG( 16, 5) = 0.236765E+01
+ PKER_SDRYG( 16, 6) = 0.221495E+01
+ PKER_SDRYG( 16, 7) = 0.207156E+01
+ PKER_SDRYG( 16, 8) = 0.193689E+01
+ PKER_SDRYG( 16, 9) = 0.181043E+01
+ PKER_SDRYG( 16, 10) = 0.169165E+01
+ PKER_SDRYG( 16, 11) = 0.158009E+01
+ PKER_SDRYG( 16, 12) = 0.147530E+01
+ PKER_SDRYG( 16, 13) = 0.137686E+01
+ PKER_SDRYG( 16, 14) = 0.128436E+01
+ PKER_SDRYG( 16, 15) = 0.119745E+01
+ PKER_SDRYG( 16, 16) = 0.111575E+01
+ PKER_SDRYG( 16, 17) = 0.103893E+01
+ PKER_SDRYG( 16, 18) = 0.966673E+00
+ PKER_SDRYG( 16, 19) = 0.898666E+00
+ PKER_SDRYG( 16, 20) = 0.834615E+00
+ PKER_SDRYG( 16, 21) = 0.774233E+00
+ PKER_SDRYG( 16, 22) = 0.717240E+00
+ PKER_SDRYG( 16, 23) = 0.663360E+00
+ PKER_SDRYG( 16, 24) = 0.612319E+00
+ PKER_SDRYG( 16, 25) = 0.563842E+00
+ PKER_SDRYG( 16, 26) = 0.517655E+00
+ PKER_SDRYG( 16, 27) = 0.473486E+00
+ PKER_SDRYG( 16, 28) = 0.431073E+00
+ PKER_SDRYG( 16, 29) = 0.390189E+00
+ PKER_SDRYG( 16, 30) = 0.350665E+00
+ PKER_SDRYG( 16, 31) = 0.312442E+00
+ PKER_SDRYG( 16, 32) = 0.275636E+00
+ PKER_SDRYG( 16, 33) = 0.240542E+00
+ PKER_SDRYG( 16, 34) = 0.207718E+00
+ PKER_SDRYG( 16, 35) = 0.177836E+00
+ PKER_SDRYG( 16, 36) = 0.151594E+00
+ PKER_SDRYG( 16, 37) = 0.129702E+00
+ PKER_SDRYG( 16, 38) = 0.112415E+00
+ PKER_SDRYG( 16, 39) = 0.997384E-01
+ PKER_SDRYG( 16, 40) = 0.914126E-01
+ PKER_SDRYG( 16, 41) = 0.869384E-01
+ PKER_SDRYG( 16, 42) = 0.856034E-01
+ PKER_SDRYG( 16, 43) = 0.868406E-01
+ PKER_SDRYG( 16, 44) = 0.900395E-01
+ PKER_SDRYG( 16, 45) = 0.946372E-01
+ PKER_SDRYG( 16, 46) = 0.100254E+00
+ PKER_SDRYG( 16, 47) = 0.106487E+00
+ PKER_SDRYG( 16, 48) = 0.113101E+00
+ PKER_SDRYG( 16, 49) = 0.119871E+00
+ PKER_SDRYG( 16, 50) = 0.126659E+00
+ PKER_SDRYG( 16, 51) = 0.133342E+00
+ PKER_SDRYG( 16, 52) = 0.139846E+00
+ PKER_SDRYG( 16, 53) = 0.146127E+00
+ PKER_SDRYG( 16, 54) = 0.152147E+00
+ PKER_SDRYG( 16, 55) = 0.157896E+00
+ PKER_SDRYG( 16, 56) = 0.163360E+00
+ PKER_SDRYG( 16, 57) = 0.168528E+00
+ PKER_SDRYG( 16, 58) = 0.173397E+00
+ PKER_SDRYG( 16, 59) = 0.177982E+00
+ PKER_SDRYG( 16, 60) = 0.182299E+00
+ PKER_SDRYG( 16, 61) = 0.186373E+00
+ PKER_SDRYG( 16, 62) = 0.190215E+00
+ PKER_SDRYG( 16, 63) = 0.193838E+00
+ PKER_SDRYG( 16, 64) = 0.197247E+00
+ PKER_SDRYG( 16, 65) = 0.200450E+00
+ PKER_SDRYG( 16, 66) = 0.203457E+00
+ PKER_SDRYG( 16, 67) = 0.206278E+00
+ PKER_SDRYG( 16, 68) = 0.208924E+00
+ PKER_SDRYG( 16, 69) = 0.211408E+00
+ PKER_SDRYG( 16, 70) = 0.213739E+00
+ PKER_SDRYG( 16, 71) = 0.215926E+00
+ PKER_SDRYG( 16, 72) = 0.217979E+00
+ PKER_SDRYG( 16, 73) = 0.219907E+00
+ PKER_SDRYG( 16, 74) = 0.221716E+00
+ PKER_SDRYG( 16, 75) = 0.223414E+00
+ PKER_SDRYG( 16, 76) = 0.225009E+00
+ PKER_SDRYG( 16, 77) = 0.226506E+00
+ PKER_SDRYG( 16, 78) = 0.227911E+00
+ PKER_SDRYG( 16, 79) = 0.229231E+00
+ PKER_SDRYG( 16, 80) = 0.230470E+00
+ PKER_SDRYG( 17, 1) = 0.310358E+01
+ PKER_SDRYG( 17, 2) = 0.290720E+01
+ PKER_SDRYG( 17, 3) = 0.272279E+01
+ PKER_SDRYG( 17, 4) = 0.254964E+01
+ PKER_SDRYG( 17, 5) = 0.238704E+01
+ PKER_SDRYG( 17, 6) = 0.223435E+01
+ PKER_SDRYG( 17, 7) = 0.209097E+01
+ PKER_SDRYG( 17, 8) = 0.195632E+01
+ PKER_SDRYG( 17, 9) = 0.182988E+01
+ PKER_SDRYG( 17, 10) = 0.171113E+01
+ PKER_SDRYG( 17, 11) = 0.159960E+01
+ PKER_SDRYG( 17, 12) = 0.149486E+01
+ PKER_SDRYG( 17, 13) = 0.139647E+01
+ PKER_SDRYG( 17, 14) = 0.130404E+01
+ PKER_SDRYG( 17, 15) = 0.121720E+01
+ PKER_SDRYG( 17, 16) = 0.113560E+01
+ PKER_SDRYG( 17, 17) = 0.105890E+01
+ PKER_SDRYG( 17, 18) = 0.986787E+00
+ PKER_SDRYG( 17, 19) = 0.918963E+00
+ PKER_SDRYG( 17, 20) = 0.855137E+00
+ PKER_SDRYG( 17, 21) = 0.795034E+00
+ PKER_SDRYG( 17, 22) = 0.738385E+00
+ PKER_SDRYG( 17, 23) = 0.684932E+00
+ PKER_SDRYG( 17, 24) = 0.634417E+00
+ PKER_SDRYG( 17, 25) = 0.586588E+00
+ PKER_SDRYG( 17, 26) = 0.541190E+00
+ PKER_SDRYG( 17, 27) = 0.497968E+00
+ PKER_SDRYG( 17, 28) = 0.456667E+00
+ PKER_SDRYG( 17, 29) = 0.417040E+00
+ PKER_SDRYG( 17, 30) = 0.378858E+00
+ PKER_SDRYG( 17, 31) = 0.341935E+00
+ PKER_SDRYG( 17, 32) = 0.306167E+00
+ PKER_SDRYG( 17, 33) = 0.271581E+00
+ PKER_SDRYG( 17, 34) = 0.238370E+00
+ PKER_SDRYG( 17, 35) = 0.206924E+00
+ PKER_SDRYG( 17, 36) = 0.177806E+00
+ PKER_SDRYG( 17, 37) = 0.151640E+00
+ PKER_SDRYG( 17, 38) = 0.129035E+00
+ PKER_SDRYG( 17, 39) = 0.110359E+00
+ PKER_SDRYG( 17, 40) = 0.956972E-01
+ PKER_SDRYG( 17, 41) = 0.850722E-01
+ PKER_SDRYG( 17, 42) = 0.779682E-01
+ PKER_SDRYG( 17, 43) = 0.740481E-01
+ PKER_SDRYG( 17, 44) = 0.727646E-01
+ PKER_SDRYG( 17, 45) = 0.735553E-01
+ PKER_SDRYG( 17, 46) = 0.759991E-01
+ PKER_SDRYG( 17, 47) = 0.796568E-01
+ PKER_SDRYG( 17, 48) = 0.841822E-01
+ PKER_SDRYG( 17, 49) = 0.893114E-01
+ PKER_SDRYG( 17, 50) = 0.947876E-01
+ PKER_SDRYG( 17, 51) = 0.100463E+00
+ PKER_SDRYG( 17, 52) = 0.106196E+00
+ PKER_SDRYG( 17, 53) = 0.111874E+00
+ PKER_SDRYG( 17, 54) = 0.117444E+00
+ PKER_SDRYG( 17, 55) = 0.122848E+00
+ PKER_SDRYG( 17, 56) = 0.128044E+00
+ PKER_SDRYG( 17, 57) = 0.133022E+00
+ PKER_SDRYG( 17, 58) = 0.137773E+00
+ PKER_SDRYG( 17, 59) = 0.142278E+00
+ PKER_SDRYG( 17, 60) = 0.146537E+00
+ PKER_SDRYG( 17, 61) = 0.150550E+00
+ PKER_SDRYG( 17, 62) = 0.154332E+00
+ PKER_SDRYG( 17, 63) = 0.157901E+00
+ PKER_SDRYG( 17, 64) = 0.161269E+00
+ PKER_SDRYG( 17, 65) = 0.164447E+00
+ PKER_SDRYG( 17, 66) = 0.167443E+00
+ PKER_SDRYG( 17, 67) = 0.170260E+00
+ PKER_SDRYG( 17, 68) = 0.172907E+00
+ PKER_SDRYG( 17, 69) = 0.175391E+00
+ PKER_SDRYG( 17, 70) = 0.177723E+00
+ PKER_SDRYG( 17, 71) = 0.179911E+00
+ PKER_SDRYG( 17, 72) = 0.181964E+00
+ PKER_SDRYG( 17, 73) = 0.183892E+00
+ PKER_SDRYG( 17, 74) = 0.185701E+00
+ PKER_SDRYG( 17, 75) = 0.187400E+00
+ PKER_SDRYG( 17, 76) = 0.188995E+00
+ PKER_SDRYG( 17, 77) = 0.190492E+00
+ PKER_SDRYG( 17, 78) = 0.191897E+00
+ PKER_SDRYG( 17, 79) = 0.193217E+00
+ PKER_SDRYG( 17, 80) = 0.194456E+00
+ PKER_SDRYG( 18, 1) = 0.312013E+01
+ PKER_SDRYG( 18, 2) = 0.292376E+01
+ PKER_SDRYG( 18, 3) = 0.273936E+01
+ PKER_SDRYG( 18, 4) = 0.256621E+01
+ PKER_SDRYG( 18, 5) = 0.240361E+01
+ PKER_SDRYG( 18, 6) = 0.225094E+01
+ PKER_SDRYG( 18, 7) = 0.210757E+01
+ PKER_SDRYG( 18, 8) = 0.197294E+01
+ PKER_SDRYG( 18, 9) = 0.184651E+01
+ PKER_SDRYG( 18, 10) = 0.172778E+01
+ PKER_SDRYG( 18, 11) = 0.161628E+01
+ PKER_SDRYG( 18, 12) = 0.151156E+01
+ PKER_SDRYG( 18, 13) = 0.141321E+01
+ PKER_SDRYG( 18, 14) = 0.132083E+01
+ PKER_SDRYG( 18, 15) = 0.123405E+01
+ PKER_SDRYG( 18, 16) = 0.115251E+01
+ PKER_SDRYG( 18, 17) = 0.107590E+01
+ PKER_SDRYG( 18, 18) = 0.100390E+01
+ PKER_SDRYG( 18, 19) = 0.936202E+00
+ PKER_SDRYG( 18, 20) = 0.872537E+00
+ PKER_SDRYG( 18, 21) = 0.812633E+00
+ PKER_SDRYG( 18, 22) = 0.756230E+00
+ PKER_SDRYG( 18, 23) = 0.703080E+00
+ PKER_SDRYG( 18, 24) = 0.652942E+00
+ PKER_SDRYG( 18, 25) = 0.605576E+00
+ PKER_SDRYG( 18, 26) = 0.560750E+00
+ PKER_SDRYG( 18, 27) = 0.518227E+00
+ PKER_SDRYG( 18, 28) = 0.477773E+00
+ PKER_SDRYG( 18, 29) = 0.439152E+00
+ PKER_SDRYG( 18, 30) = 0.402131E+00
+ PKER_SDRYG( 18, 31) = 0.366493E+00
+ PKER_SDRYG( 18, 32) = 0.332050E+00
+ PKER_SDRYG( 18, 33) = 0.298676E+00
+ PKER_SDRYG( 18, 34) = 0.266345E+00
+ PKER_SDRYG( 18, 35) = 0.235168E+00
+ PKER_SDRYG( 18, 36) = 0.205422E+00
+ PKER_SDRYG( 18, 37) = 0.177545E+00
+ PKER_SDRYG( 18, 38) = 0.152032E+00
+ PKER_SDRYG( 18, 39) = 0.129423E+00
+ PKER_SDRYG( 18, 40) = 0.110093E+00
+ PKER_SDRYG( 18, 41) = 0.942133E-01
+ PKER_SDRYG( 18, 42) = 0.818749E-01
+ PKER_SDRYG( 18, 43) = 0.728212E-01
+ PKER_SDRYG( 18, 44) = 0.667257E-01
+ PKER_SDRYG( 18, 45) = 0.632100E-01
+ PKER_SDRYG( 18, 46) = 0.618886E-01
+ PKER_SDRYG( 18, 47) = 0.622846E-01
+ PKER_SDRYG( 18, 48) = 0.640674E-01
+ PKER_SDRYG( 18, 49) = 0.669386E-01
+ PKER_SDRYG( 18, 50) = 0.705747E-01
+ PKER_SDRYG( 18, 51) = 0.747677E-01
+ PKER_SDRYG( 18, 52) = 0.793092E-01
+ PKER_SDRYG( 18, 53) = 0.840736E-01
+ PKER_SDRYG( 18, 54) = 0.889086E-01
+ PKER_SDRYG( 18, 55) = 0.937517E-01
+ PKER_SDRYG( 18, 56) = 0.985202E-01
+ PKER_SDRYG( 18, 57) = 0.103163E+00
+ PKER_SDRYG( 18, 58) = 0.107658E+00
+ PKER_SDRYG( 18, 59) = 0.111974E+00
+ PKER_SDRYG( 18, 60) = 0.116103E+00
+ PKER_SDRYG( 18, 61) = 0.120035E+00
+ PKER_SDRYG( 18, 62) = 0.123761E+00
+ PKER_SDRYG( 18, 63) = 0.127277E+00
+ PKER_SDRYG( 18, 64) = 0.130593E+00
+ PKER_SDRYG( 18, 65) = 0.133720E+00
+ PKER_SDRYG( 18, 66) = 0.136675E+00
+ PKER_SDRYG( 18, 67) = 0.139464E+00
+ PKER_SDRYG( 18, 68) = 0.142096E+00
+ PKER_SDRYG( 18, 69) = 0.144574E+00
+ PKER_SDRYG( 18, 70) = 0.146905E+00
+ PKER_SDRYG( 18, 71) = 0.149093E+00
+ PKER_SDRYG( 18, 72) = 0.151147E+00
+ PKER_SDRYG( 18, 73) = 0.153075E+00
+ PKER_SDRYG( 18, 74) = 0.154885E+00
+ PKER_SDRYG( 18, 75) = 0.156583E+00
+ PKER_SDRYG( 18, 76) = 0.158178E+00
+ PKER_SDRYG( 18, 77) = 0.159675E+00
+ PKER_SDRYG( 18, 78) = 0.161081E+00
+ PKER_SDRYG( 18, 79) = 0.162401E+00
+ PKER_SDRYG( 18, 80) = 0.163640E+00
+ PKER_SDRYG( 19, 1) = 0.313430E+01
+ PKER_SDRYG( 19, 2) = 0.293792E+01
+ PKER_SDRYG( 19, 3) = 0.275353E+01
+ PKER_SDRYG( 19, 4) = 0.258038E+01
+ PKER_SDRYG( 19, 5) = 0.241780E+01
+ PKER_SDRYG( 19, 6) = 0.226513E+01
+ PKER_SDRYG( 19, 7) = 0.212176E+01
+ PKER_SDRYG( 19, 8) = 0.198714E+01
+ PKER_SDRYG( 19, 9) = 0.186073E+01
+ PKER_SDRYG( 19, 10) = 0.174202E+01
+ PKER_SDRYG( 19, 11) = 0.163053E+01
+ PKER_SDRYG( 19, 12) = 0.152584E+01
+ PKER_SDRYG( 19, 13) = 0.142751E+01
+ PKER_SDRYG( 19, 14) = 0.133517E+01
+ PKER_SDRYG( 19, 15) = 0.124842E+01
+ PKER_SDRYG( 19, 16) = 0.116694E+01
+ PKER_SDRYG( 19, 17) = 0.109039E+01
+ PKER_SDRYG( 19, 18) = 0.101846E+01
+ PKER_SDRYG( 19, 19) = 0.950864E+00
+ PKER_SDRYG( 19, 20) = 0.887315E+00
+ PKER_SDRYG( 19, 21) = 0.827553E+00
+ PKER_SDRYG( 19, 22) = 0.771326E+00
+ PKER_SDRYG( 19, 23) = 0.718393E+00
+ PKER_SDRYG( 19, 24) = 0.668523E+00
+ PKER_SDRYG( 19, 25) = 0.621489E+00
+ PKER_SDRYG( 19, 26) = 0.577071E+00
+ PKER_SDRYG( 19, 27) = 0.535052E+00
+ PKER_SDRYG( 19, 28) = 0.495215E+00
+ PKER_SDRYG( 19, 29) = 0.457343E+00
+ PKER_SDRYG( 19, 30) = 0.421219E+00
+ PKER_SDRYG( 19, 31) = 0.386628E+00
+ PKER_SDRYG( 19, 32) = 0.353366E+00
+ PKER_SDRYG( 19, 33) = 0.321252E+00
+ PKER_SDRYG( 19, 34) = 0.290155E+00
+ PKER_SDRYG( 19, 35) = 0.260019E+00
+ PKER_SDRYG( 19, 36) = 0.230899E+00
+ PKER_SDRYG( 19, 37) = 0.202987E+00
+ PKER_SDRYG( 19, 38) = 0.176611E+00
+ PKER_SDRYG( 19, 39) = 0.152167E+00
+ PKER_SDRYG( 19, 40) = 0.130090E+00
+ PKER_SDRYG( 19, 41) = 0.110741E+00
+ PKER_SDRYG( 19, 42) = 0.943181E-01
+ PKER_SDRYG( 19, 43) = 0.809330E-01
+ PKER_SDRYG( 19, 44) = 0.704716E-01
+ PKER_SDRYG( 19, 45) = 0.626544E-01
+ PKER_SDRYG( 19, 46) = 0.573699E-01
+ PKER_SDRYG( 19, 47) = 0.541204E-01
+ PKER_SDRYG( 19, 48) = 0.527083E-01
+ PKER_SDRYG( 19, 49) = 0.527892E-01
+ PKER_SDRYG( 19, 50) = 0.540394E-01
+ PKER_SDRYG( 19, 51) = 0.562337E-01
+ PKER_SDRYG( 19, 52) = 0.591260E-01
+ PKER_SDRYG( 19, 53) = 0.625315E-01
+ PKER_SDRYG( 19, 54) = 0.662926E-01
+ PKER_SDRYG( 19, 55) = 0.702636E-01
+ PKER_SDRYG( 19, 56) = 0.743493E-01
+ PKER_SDRYG( 19, 57) = 0.784688E-01
+ PKER_SDRYG( 19, 58) = 0.825487E-01
+ PKER_SDRYG( 19, 59) = 0.865492E-01
+ PKER_SDRYG( 19, 60) = 0.904344E-01
+ PKER_SDRYG( 19, 61) = 0.941778E-01
+ PKER_SDRYG( 19, 62) = 0.977677E-01
+ PKER_SDRYG( 19, 63) = 0.101199E+00
+ PKER_SDRYG( 19, 64) = 0.104457E+00
+ PKER_SDRYG( 19, 65) = 0.107540E+00
+ PKER_SDRYG( 19, 66) = 0.110449E+00
+ PKER_SDRYG( 19, 67) = 0.113194E+00
+ PKER_SDRYG( 19, 68) = 0.115786E+00
+ PKER_SDRYG( 19, 69) = 0.118234E+00
+ PKER_SDRYG( 19, 70) = 0.120546E+00
+ PKER_SDRYG( 19, 71) = 0.122726E+00
+ PKER_SDRYG( 19, 72) = 0.124778E+00
+ PKER_SDRYG( 19, 73) = 0.126705E+00
+ PKER_SDRYG( 19, 74) = 0.128515E+00
+ PKER_SDRYG( 19, 75) = 0.130214E+00
+ PKER_SDRYG( 19, 76) = 0.131809E+00
+ PKER_SDRYG( 19, 77) = 0.133307E+00
+ PKER_SDRYG( 19, 78) = 0.134712E+00
+ PKER_SDRYG( 19, 79) = 0.136032E+00
+ PKER_SDRYG( 19, 80) = 0.137271E+00
+ PKER_SDRYG( 20, 1) = 0.314641E+01
+ PKER_SDRYG( 20, 2) = 0.295004E+01
+ PKER_SDRYG( 20, 3) = 0.276565E+01
+ PKER_SDRYG( 20, 4) = 0.259251E+01
+ PKER_SDRYG( 20, 5) = 0.242993E+01
+ PKER_SDRYG( 20, 6) = 0.227726E+01
+ PKER_SDRYG( 20, 7) = 0.213391E+01
+ PKER_SDRYG( 20, 8) = 0.199929E+01
+ PKER_SDRYG( 20, 9) = 0.187289E+01
+ PKER_SDRYG( 20, 10) = 0.175419E+01
+ PKER_SDRYG( 20, 11) = 0.164272E+01
+ PKER_SDRYG( 20, 12) = 0.153804E+01
+ PKER_SDRYG( 20, 13) = 0.143974E+01
+ PKER_SDRYG( 20, 14) = 0.134741E+01
+ PKER_SDRYG( 20, 15) = 0.126070E+01
+ PKER_SDRYG( 20, 16) = 0.117926E+01
+ PKER_SDRYG( 20, 17) = 0.110275E+01
+ PKER_SDRYG( 20, 18) = 0.103088E+01
+ PKER_SDRYG( 20, 19) = 0.963347E+00
+ PKER_SDRYG( 20, 20) = 0.899882E+00
+ PKER_SDRYG( 20, 21) = 0.840222E+00
+ PKER_SDRYG( 20, 22) = 0.784121E+00
+ PKER_SDRYG( 20, 23) = 0.731345E+00
+ PKER_SDRYG( 20, 24) = 0.681666E+00
+ PKER_SDRYG( 20, 25) = 0.634870E+00
+ PKER_SDRYG( 20, 26) = 0.590745E+00
+ PKER_SDRYG( 20, 27) = 0.549087E+00
+ PKER_SDRYG( 20, 28) = 0.509694E+00
+ PKER_SDRYG( 20, 29) = 0.472366E+00
+ PKER_SDRYG( 20, 30) = 0.436902E+00
+ PKER_SDRYG( 20, 31) = 0.403104E+00
+ PKER_SDRYG( 20, 32) = 0.370773E+00
+ PKER_SDRYG( 20, 33) = 0.339721E+00
+ PKER_SDRYG( 20, 34) = 0.309780E+00
+ PKER_SDRYG( 20, 35) = 0.280817E+00
+ PKER_SDRYG( 20, 36) = 0.252766E+00
+ PKER_SDRYG( 20, 37) = 0.225649E+00
+ PKER_SDRYG( 20, 38) = 0.199598E+00
+ PKER_SDRYG( 20, 39) = 0.174855E+00
+ PKER_SDRYG( 20, 40) = 0.151733E+00
+ PKER_SDRYG( 20, 41) = 0.130576E+00
+ PKER_SDRYG( 20, 42) = 0.111685E+00
+ PKER_SDRYG( 20, 43) = 0.952438E-01
+ PKER_SDRYG( 20, 44) = 0.813642E-01
+ PKER_SDRYG( 20, 45) = 0.700036E-01
+ PKER_SDRYG( 20, 46) = 0.610159E-01
+ PKER_SDRYG( 20, 47) = 0.542824E-01
+ PKER_SDRYG( 20, 48) = 0.495365E-01
+ PKER_SDRYG( 20, 49) = 0.465418E-01
+ PKER_SDRYG( 20, 50) = 0.450362E-01
+ PKER_SDRYG( 20, 51) = 0.448236E-01
+ PKER_SDRYG( 20, 52) = 0.456174E-01
+ PKER_SDRYG( 20, 53) = 0.472243E-01
+ PKER_SDRYG( 20, 54) = 0.495059E-01
+ PKER_SDRYG( 20, 55) = 0.522568E-01
+ PKER_SDRYG( 20, 56) = 0.553442E-01
+ PKER_SDRYG( 20, 57) = 0.586561E-01
+ PKER_SDRYG( 20, 58) = 0.621124E-01
+ PKER_SDRYG( 20, 59) = 0.656027E-01
+ PKER_SDRYG( 20, 60) = 0.690997E-01
+ PKER_SDRYG( 20, 61) = 0.725427E-01
+ PKER_SDRYG( 20, 62) = 0.758958E-01
+ PKER_SDRYG( 20, 63) = 0.791459E-01
+ PKER_SDRYG( 20, 64) = 0.822686E-01
+ PKER_SDRYG( 20, 65) = 0.852588E-01
+ PKER_SDRYG( 20, 66) = 0.881095E-01
+ PKER_SDRYG( 20, 67) = 0.908129E-01
+ PKER_SDRYG( 20, 68) = 0.933663E-01
+ PKER_SDRYG( 20, 69) = 0.957757E-01
+ PKER_SDRYG( 20, 70) = 0.980498E-01
+ PKER_SDRYG( 20, 71) = 0.100200E+00
+ PKER_SDRYG( 20, 72) = 0.102230E+00
+ PKER_SDRYG( 20, 73) = 0.104147E+00
+ PKER_SDRYG( 20, 74) = 0.105953E+00
+ PKER_SDRYG( 20, 75) = 0.107651E+00
+ PKER_SDRYG( 20, 76) = 0.109246E+00
+ PKER_SDRYG( 20, 77) = 0.110743E+00
+ PKER_SDRYG( 20, 78) = 0.112149E+00
+ PKER_SDRYG( 20, 79) = 0.113469E+00
+ PKER_SDRYG( 20, 80) = 0.114708E+00
+ PKER_SDRYG( 21, 1) = 0.315678E+01
+ PKER_SDRYG( 21, 2) = 0.296041E+01
+ PKER_SDRYG( 21, 3) = 0.277602E+01
+ PKER_SDRYG( 21, 4) = 0.260288E+01
+ PKER_SDRYG( 21, 5) = 0.244030E+01
+ PKER_SDRYG( 21, 6) = 0.228764E+01
+ PKER_SDRYG( 21, 7) = 0.214429E+01
+ PKER_SDRYG( 21, 8) = 0.200969E+01
+ PKER_SDRYG( 21, 9) = 0.188329E+01
+ PKER_SDRYG( 21, 10) = 0.176459E+01
+ PKER_SDRYG( 21, 11) = 0.165314E+01
+ PKER_SDRYG( 21, 12) = 0.154847E+01
+ PKER_SDRYG( 21, 13) = 0.145018E+01
+ PKER_SDRYG( 21, 14) = 0.135788E+01
+ PKER_SDRYG( 21, 15) = 0.127119E+01
+ PKER_SDRYG( 21, 16) = 0.118977E+01
+ PKER_SDRYG( 21, 17) = 0.111330E+01
+ PKER_SDRYG( 21, 18) = 0.104147E+01
+ PKER_SDRYG( 21, 19) = 0.973984E+00
+ PKER_SDRYG( 21, 20) = 0.910579E+00
+ PKER_SDRYG( 21, 21) = 0.850994E+00
+ PKER_SDRYG( 21, 22) = 0.794985E+00
+ PKER_SDRYG( 21, 23) = 0.742321E+00
+ PKER_SDRYG( 21, 24) = 0.692781E+00
+ PKER_SDRYG( 21, 25) = 0.646155E+00
+ PKER_SDRYG( 21, 26) = 0.602240E+00
+ PKER_SDRYG( 21, 27) = 0.560841E+00
+ PKER_SDRYG( 21, 28) = 0.521767E+00
+ PKER_SDRYG( 21, 29) = 0.484831E+00
+ PKER_SDRYG( 21, 30) = 0.449847E+00
+ PKER_SDRYG( 21, 31) = 0.416632E+00
+ PKER_SDRYG( 21, 32) = 0.385000E+00
+ PKER_SDRYG( 21, 33) = 0.354772E+00
+ PKER_SDRYG( 21, 34) = 0.325773E+00
+ PKER_SDRYG( 21, 35) = 0.297848E+00
+ PKER_SDRYG( 21, 36) = 0.270871E+00
+ PKER_SDRYG( 21, 37) = 0.244771E+00
+ PKER_SDRYG( 21, 38) = 0.219552E+00
+ PKER_SDRYG( 21, 39) = 0.195307E+00
+ PKER_SDRYG( 21, 40) = 0.172218E+00
+ PKER_SDRYG( 21, 41) = 0.150528E+00
+ PKER_SDRYG( 21, 42) = 0.130506E+00
+ PKER_SDRYG( 21, 43) = 0.112387E+00
+ PKER_SDRYG( 21, 44) = 0.963217E-01
+ PKER_SDRYG( 21, 45) = 0.824142E-01
+ PKER_SDRYG( 21, 46) = 0.706536E-01
+ PKER_SDRYG( 21, 47) = 0.609423E-01
+ PKER_SDRYG( 21, 48) = 0.532273E-01
+ PKER_SDRYG( 21, 49) = 0.473264E-01
+ PKER_SDRYG( 21, 50) = 0.429933E-01
+ PKER_SDRYG( 21, 51) = 0.402064E-01
+ PKER_SDRYG( 21, 52) = 0.386102E-01
+ PKER_SDRYG( 21, 53) = 0.381308E-01
+ PKER_SDRYG( 21, 54) = 0.385657E-01
+ PKER_SDRYG( 21, 55) = 0.397270E-01
+ PKER_SDRYG( 21, 56) = 0.414742E-01
+ PKER_SDRYG( 21, 57) = 0.436663E-01
+ PKER_SDRYG( 21, 58) = 0.461938E-01
+ PKER_SDRYG( 21, 59) = 0.489445E-01
+ PKER_SDRYG( 21, 60) = 0.518374E-01
+ PKER_SDRYG( 21, 61) = 0.548037E-01
+ PKER_SDRYG( 21, 62) = 0.577875E-01
+ PKER_SDRYG( 21, 63) = 0.607451E-01
+ PKER_SDRYG( 21, 64) = 0.636436E-01
+ PKER_SDRYG( 21, 65) = 0.664592E-01
+ PKER_SDRYG( 21, 66) = 0.691751E-01
+ PKER_SDRYG( 21, 67) = 0.717806E-01
+ PKER_SDRYG( 21, 68) = 0.742731E-01
+ PKER_SDRYG( 21, 69) = 0.766406E-01
+ PKER_SDRYG( 21, 70) = 0.788820E-01
+ PKER_SDRYG( 21, 71) = 0.809983E-01
+ PKER_SDRYG( 21, 72) = 0.829967E-01
+ PKER_SDRYG( 21, 73) = 0.848837E-01
+ PKER_SDRYG( 21, 74) = 0.866675E-01
+ PKER_SDRYG( 21, 75) = 0.883526E-01
+ PKER_SDRYG( 21, 76) = 0.899415E-01
+ PKER_SDRYG( 21, 77) = 0.914371E-01
+ PKER_SDRYG( 21, 78) = 0.928426E-01
+ PKER_SDRYG( 21, 79) = 0.941625E-01
+ PKER_SDRYG( 21, 80) = 0.954017E-01
+ PKER_SDRYG( 22, 1) = 0.316565E+01
+ PKER_SDRYG( 22, 2) = 0.296928E+01
+ PKER_SDRYG( 22, 3) = 0.278490E+01
+ PKER_SDRYG( 22, 4) = 0.261176E+01
+ PKER_SDRYG( 22, 5) = 0.244918E+01
+ PKER_SDRYG( 22, 6) = 0.229652E+01
+ PKER_SDRYG( 22, 7) = 0.215318E+01
+ PKER_SDRYG( 22, 8) = 0.201857E+01
+ PKER_SDRYG( 22, 9) = 0.189218E+01
+ PKER_SDRYG( 22, 10) = 0.177349E+01
+ PKER_SDRYG( 22, 11) = 0.166204E+01
+ PKER_SDRYG( 22, 12) = 0.155739E+01
+ PKER_SDRYG( 22, 13) = 0.145911E+01
+ PKER_SDRYG( 22, 14) = 0.136682E+01
+ PKER_SDRYG( 22, 15) = 0.128015E+01
+ PKER_SDRYG( 22, 16) = 0.119875E+01
+ PKER_SDRYG( 22, 17) = 0.112230E+01
+ PKER_SDRYG( 22, 18) = 0.105050E+01
+ PKER_SDRYG( 22, 19) = 0.983055E+00
+ PKER_SDRYG( 22, 20) = 0.919694E+00
+ PKER_SDRYG( 22, 21) = 0.860163E+00
+ PKER_SDRYG( 22, 22) = 0.804221E+00
+ PKER_SDRYG( 22, 23) = 0.751638E+00
+ PKER_SDRYG( 22, 24) = 0.702199E+00
+ PKER_SDRYG( 22, 25) = 0.655696E+00
+ PKER_SDRYG( 22, 26) = 0.611933E+00
+ PKER_SDRYG( 22, 27) = 0.570720E+00
+ PKER_SDRYG( 22, 28) = 0.531876E+00
+ PKER_SDRYG( 22, 29) = 0.495222E+00
+ PKER_SDRYG( 22, 30) = 0.460585E+00
+ PKER_SDRYG( 22, 31) = 0.427793E+00
+ PKER_SDRYG( 22, 32) = 0.396676E+00
+ PKER_SDRYG( 22, 33) = 0.367065E+00
+ PKER_SDRYG( 22, 34) = 0.338793E+00
+ PKER_SDRYG( 22, 35) = 0.311700E+00
+ PKER_SDRYG( 22, 36) = 0.285643E+00
+ PKER_SDRYG( 22, 37) = 0.260506E+00
+ PKER_SDRYG( 22, 38) = 0.236218E+00
+ PKER_SDRYG( 22, 39) = 0.212773E+00
+ PKER_SDRYG( 22, 40) = 0.190240E+00
+ PKER_SDRYG( 22, 41) = 0.168759E+00
+ PKER_SDRYG( 22, 42) = 0.148523E+00
+ PKER_SDRYG( 22, 43) = 0.129738E+00
+ PKER_SDRYG( 22, 44) = 0.112583E+00
+ PKER_SDRYG( 22, 45) = 0.971811E-01
+ PKER_SDRYG( 22, 46) = 0.835936E-01
+ PKER_SDRYG( 22, 47) = 0.718231E-01
+ PKER_SDRYG( 22, 48) = 0.618072E-01
+ PKER_SDRYG( 22, 49) = 0.534898E-01
+ PKER_SDRYG( 22, 50) = 0.467624E-01
+ PKER_SDRYG( 22, 51) = 0.414860E-01
+ PKER_SDRYG( 22, 52) = 0.375763E-01
+ PKER_SDRYG( 22, 53) = 0.348805E-01
+ PKER_SDRYG( 22, 54) = 0.332667E-01
+ PKER_SDRYG( 22, 55) = 0.325688E-01
+ PKER_SDRYG( 22, 56) = 0.326954E-01
+ PKER_SDRYG( 22, 57) = 0.334646E-01
+ PKER_SDRYG( 22, 58) = 0.347486E-01
+ PKER_SDRYG( 22, 59) = 0.364906E-01
+ PKER_SDRYG( 22, 60) = 0.385370E-01
+ PKER_SDRYG( 22, 61) = 0.408038E-01
+ PKER_SDRYG( 22, 62) = 0.432264E-01
+ PKER_SDRYG( 22, 63) = 0.457437E-01
+ PKER_SDRYG( 22, 64) = 0.482800E-01
+ PKER_SDRYG( 22, 65) = 0.508227E-01
+ PKER_SDRYG( 22, 66) = 0.533231E-01
+ PKER_SDRYG( 22, 67) = 0.557593E-01
+ PKER_SDRYG( 22, 68) = 0.581222E-01
+ PKER_SDRYG( 22, 69) = 0.603926E-01
+ PKER_SDRYG( 22, 70) = 0.625678E-01
+ PKER_SDRYG( 22, 71) = 0.646420E-01
+ PKER_SDRYG( 22, 72) = 0.666097E-01
+ PKER_SDRYG( 22, 73) = 0.684688E-01
+ PKER_SDRYG( 22, 74) = 0.702238E-01
+ PKER_SDRYG( 22, 75) = 0.718811E-01
+ PKER_SDRYG( 22, 76) = 0.734478E-01
+ PKER_SDRYG( 22, 77) = 0.749287E-01
+ PKER_SDRYG( 22, 78) = 0.763265E-01
+ PKER_SDRYG( 22, 79) = 0.776433E-01
+ PKER_SDRYG( 22, 80) = 0.788817E-01
+ PKER_SDRYG( 23, 1) = 0.317324E+01
+ PKER_SDRYG( 23, 2) = 0.297688E+01
+ PKER_SDRYG( 23, 3) = 0.279249E+01
+ PKER_SDRYG( 23, 4) = 0.261935E+01
+ PKER_SDRYG( 23, 5) = 0.245678E+01
+ PKER_SDRYG( 23, 6) = 0.230412E+01
+ PKER_SDRYG( 23, 7) = 0.216078E+01
+ PKER_SDRYG( 23, 8) = 0.202618E+01
+ PKER_SDRYG( 23, 9) = 0.189979E+01
+ PKER_SDRYG( 23, 10) = 0.178111E+01
+ PKER_SDRYG( 23, 11) = 0.166966E+01
+ PKER_SDRYG( 23, 12) = 0.156501E+01
+ PKER_SDRYG( 23, 13) = 0.146674E+01
+ PKER_SDRYG( 23, 14) = 0.137446E+01
+ PKER_SDRYG( 23, 15) = 0.128780E+01
+ PKER_SDRYG( 23, 16) = 0.120642E+01
+ PKER_SDRYG( 23, 17) = 0.112999E+01
+ PKER_SDRYG( 23, 18) = 0.105821E+01
+ PKER_SDRYG( 23, 19) = 0.990793E+00
+ PKER_SDRYG( 23, 20) = 0.927466E+00
+ PKER_SDRYG( 23, 21) = 0.867975E+00
+ PKER_SDRYG( 23, 22) = 0.812081E+00
+ PKER_SDRYG( 23, 23) = 0.759559E+00
+ PKER_SDRYG( 23, 24) = 0.710192E+00
+ PKER_SDRYG( 23, 25) = 0.663779E+00
+ PKER_SDRYG( 23, 26) = 0.620126E+00
+ PKER_SDRYG( 23, 27) = 0.579048E+00
+ PKER_SDRYG( 23, 28) = 0.540370E+00
+ PKER_SDRYG( 23, 29) = 0.503920E+00
+ PKER_SDRYG( 23, 30) = 0.469534E+00
+ PKER_SDRYG( 23, 31) = 0.437049E+00
+ PKER_SDRYG( 23, 32) = 0.406307E+00
+ PKER_SDRYG( 23, 33) = 0.377150E+00
+ PKER_SDRYG( 23, 34) = 0.349422E+00
+ PKER_SDRYG( 23, 35) = 0.322971E+00
+ PKER_SDRYG( 23, 36) = 0.297649E+00
+ PKER_SDRYG( 23, 37) = 0.273324E+00
+ PKER_SDRYG( 23, 38) = 0.249890E+00
+ PKER_SDRYG( 23, 39) = 0.227278E+00
+ PKER_SDRYG( 23, 40) = 0.205477E+00
+ PKER_SDRYG( 23, 41) = 0.184540E+00
+ PKER_SDRYG( 23, 42) = 0.164581E+00
+ PKER_SDRYG( 23, 43) = 0.145753E+00
+ PKER_SDRYG( 23, 44) = 0.128220E+00
+ PKER_SDRYG( 23, 45) = 0.112118E+00
+ PKER_SDRYG( 23, 46) = 0.975291E-01
+ PKER_SDRYG( 23, 47) = 0.844965E-01
+ PKER_SDRYG( 23, 48) = 0.730043E-01
+ PKER_SDRYG( 23, 49) = 0.629937E-01
+ PKER_SDRYG( 23, 50) = 0.544338E-01
+ PKER_SDRYG( 23, 51) = 0.472364E-01
+ PKER_SDRYG( 23, 52) = 0.413003E-01
+ PKER_SDRYG( 23, 53) = 0.366010E-01
+ PKER_SDRYG( 23, 54) = 0.330232E-01
+ PKER_SDRYG( 23, 55) = 0.304152E-01
+ PKER_SDRYG( 23, 56) = 0.287909E-01
+ PKER_SDRYG( 23, 57) = 0.279201E-01
+ PKER_SDRYG( 23, 58) = 0.277828E-01
+ PKER_SDRYG( 23, 59) = 0.282422E-01
+ PKER_SDRYG( 23, 60) = 0.291874E-01
+ PKER_SDRYG( 23, 61) = 0.305223E-01
+ PKER_SDRYG( 23, 62) = 0.321561E-01
+ PKER_SDRYG( 23, 63) = 0.340230E-01
+ PKER_SDRYG( 23, 64) = 0.360382E-01
+ PKER_SDRYG( 23, 65) = 0.381505E-01
+ PKER_SDRYG( 23, 66) = 0.403137E-01
+ PKER_SDRYG( 23, 67) = 0.424862E-01
+ PKER_SDRYG( 23, 68) = 0.446395E-01
+ PKER_SDRYG( 23, 69) = 0.467491E-01
+ PKER_SDRYG( 23, 70) = 0.487982E-01
+ PKER_SDRYG( 23, 71) = 0.507757E-01
+ PKER_SDRYG( 23, 72) = 0.526730E-01
+ PKER_SDRYG( 23, 73) = 0.544887E-01
+ PKER_SDRYG( 23, 74) = 0.562135E-01
+ PKER_SDRYG( 23, 75) = 0.578463E-01
+ PKER_SDRYG( 23, 76) = 0.593889E-01
+ PKER_SDRYG( 23, 77) = 0.608458E-01
+ PKER_SDRYG( 23, 78) = 0.622217E-01
+ PKER_SDRYG( 23, 79) = 0.635229E-01
+ PKER_SDRYG( 23, 80) = 0.647520E-01
+ PKER_SDRYG( 24, 1) = 0.317974E+01
+ PKER_SDRYG( 24, 2) = 0.298337E+01
+ PKER_SDRYG( 24, 3) = 0.279898E+01
+ PKER_SDRYG( 24, 4) = 0.262585E+01
+ PKER_SDRYG( 24, 5) = 0.246328E+01
+ PKER_SDRYG( 24, 6) = 0.231062E+01
+ PKER_SDRYG( 24, 7) = 0.216728E+01
+ PKER_SDRYG( 24, 8) = 0.203268E+01
+ PKER_SDRYG( 24, 9) = 0.190630E+01
+ PKER_SDRYG( 24, 10) = 0.178762E+01
+ PKER_SDRYG( 24, 11) = 0.167618E+01
+ PKER_SDRYG( 24, 12) = 0.157153E+01
+ PKER_SDRYG( 24, 13) = 0.147327E+01
+ PKER_SDRYG( 24, 14) = 0.138100E+01
+ PKER_SDRYG( 24, 15) = 0.129435E+01
+ PKER_SDRYG( 24, 16) = 0.121298E+01
+ PKER_SDRYG( 24, 17) = 0.113656E+01
+ PKER_SDRYG( 24, 18) = 0.106480E+01
+ PKER_SDRYG( 24, 19) = 0.997399E+00
+ PKER_SDRYG( 24, 20) = 0.934096E+00
+ PKER_SDRYG( 24, 21) = 0.874634E+00
+ PKER_SDRYG( 24, 22) = 0.818777E+00
+ PKER_SDRYG( 24, 23) = 0.766298E+00
+ PKER_SDRYG( 24, 24) = 0.716985E+00
+ PKER_SDRYG( 24, 25) = 0.670637E+00
+ PKER_SDRYG( 24, 26) = 0.627064E+00
+ PKER_SDRYG( 24, 27) = 0.586085E+00
+ PKER_SDRYG( 24, 28) = 0.547527E+00
+ PKER_SDRYG( 24, 29) = 0.511226E+00
+ PKER_SDRYG( 24, 30) = 0.477021E+00
+ PKER_SDRYG( 24, 31) = 0.444759E+00
+ PKER_SDRYG( 24, 32) = 0.414290E+00
+ PKER_SDRYG( 24, 33) = 0.385466E+00
+ PKER_SDRYG( 24, 34) = 0.358141E+00
+ PKER_SDRYG( 24, 35) = 0.332171E+00
+ PKER_SDRYG( 24, 36) = 0.307415E+00
+ PKER_SDRYG( 24, 37) = 0.283739E+00
+ PKER_SDRYG( 24, 38) = 0.261021E+00
+ PKER_SDRYG( 24, 39) = 0.239161E+00
+ PKER_SDRYG( 24, 40) = 0.218098E+00
+ PKER_SDRYG( 24, 41) = 0.197816E+00
+ PKER_SDRYG( 24, 42) = 0.178358E+00
+ PKER_SDRYG( 24, 43) = 0.159817E+00
+ PKER_SDRYG( 24, 44) = 0.142322E+00
+ PKER_SDRYG( 24, 45) = 0.126004E+00
+ PKER_SDRYG( 24, 46) = 0.110966E+00
+ PKER_SDRYG( 24, 47) = 0.972696E-01
+ PKER_SDRYG( 24, 48) = 0.849240E-01
+ PKER_SDRYG( 24, 49) = 0.739011E-01
+ PKER_SDRYG( 24, 50) = 0.641503E-01
+ PKER_SDRYG( 24, 51) = 0.556168E-01
+ PKER_SDRYG( 24, 52) = 0.482410E-01
+ PKER_SDRYG( 24, 53) = 0.419558E-01
+ PKER_SDRYG( 24, 54) = 0.367232E-01
+ PKER_SDRYG( 24, 55) = 0.324850E-01
+ PKER_SDRYG( 24, 56) = 0.291562E-01
+ PKER_SDRYG( 24, 57) = 0.266947E-01
+ PKER_SDRYG( 24, 58) = 0.250249E-01
+ PKER_SDRYG( 24, 59) = 0.240671E-01
+ PKER_SDRYG( 24, 60) = 0.237119E-01
+ PKER_SDRYG( 24, 61) = 0.239149E-01
+ PKER_SDRYG( 24, 62) = 0.245541E-01
+ PKER_SDRYG( 24, 63) = 0.255388E-01
+ PKER_SDRYG( 24, 64) = 0.268448E-01
+ PKER_SDRYG( 24, 65) = 0.283592E-01
+ PKER_SDRYG( 24, 66) = 0.300237E-01
+ PKER_SDRYG( 24, 67) = 0.317974E-01
+ PKER_SDRYG( 24, 68) = 0.336350E-01
+ PKER_SDRYG( 24, 69) = 0.354861E-01
+ PKER_SDRYG( 24, 70) = 0.373396E-01
+ PKER_SDRYG( 24, 71) = 0.391617E-01
+ PKER_SDRYG( 24, 72) = 0.409381E-01
+ PKER_SDRYG( 24, 73) = 0.426598E-01
+ PKER_SDRYG( 24, 74) = 0.443148E-01
+ PKER_SDRYG( 24, 75) = 0.459007E-01
+ PKER_SDRYG( 24, 76) = 0.474126E-01
+ PKER_SDRYG( 24, 77) = 0.488471E-01
+ PKER_SDRYG( 24, 78) = 0.502027E-01
+ PKER_SDRYG( 24, 79) = 0.514825E-01
+ PKER_SDRYG( 24, 80) = 0.526915E-01
+ PKER_SDRYG( 25, 1) = 0.318529E+01
+ PKER_SDRYG( 25, 2) = 0.298893E+01
+ PKER_SDRYG( 25, 3) = 0.280454E+01
+ PKER_SDRYG( 25, 4) = 0.263141E+01
+ PKER_SDRYG( 25, 5) = 0.246884E+01
+ PKER_SDRYG( 25, 6) = 0.231618E+01
+ PKER_SDRYG( 25, 7) = 0.217284E+01
+ PKER_SDRYG( 25, 8) = 0.203825E+01
+ PKER_SDRYG( 25, 9) = 0.191186E+01
+ PKER_SDRYG( 25, 10) = 0.179319E+01
+ PKER_SDRYG( 25, 11) = 0.168175E+01
+ PKER_SDRYG( 25, 12) = 0.157711E+01
+ PKER_SDRYG( 25, 13) = 0.147885E+01
+ PKER_SDRYG( 25, 14) = 0.138659E+01
+ PKER_SDRYG( 25, 15) = 0.129994E+01
+ PKER_SDRYG( 25, 16) = 0.121858E+01
+ PKER_SDRYG( 25, 17) = 0.114218E+01
+ PKER_SDRYG( 25, 18) = 0.107042E+01
+ PKER_SDRYG( 25, 19) = 0.100304E+01
+ PKER_SDRYG( 25, 20) = 0.939754E+00
+ PKER_SDRYG( 25, 21) = 0.880315E+00
+ PKER_SDRYG( 25, 22) = 0.824484E+00
+ PKER_SDRYG( 25, 23) = 0.772038E+00
+ PKER_SDRYG( 25, 24) = 0.722764E+00
+ PKER_SDRYG( 25, 25) = 0.676465E+00
+ PKER_SDRYG( 25, 26) = 0.632951E+00
+ PKER_SDRYG( 25, 27) = 0.592044E+00
+ PKER_SDRYG( 25, 28) = 0.553574E+00
+ PKER_SDRYG( 25, 29) = 0.517380E+00
+ PKER_SDRYG( 25, 30) = 0.483308E+00
+ PKER_SDRYG( 25, 31) = 0.451208E+00
+ PKER_SDRYG( 25, 32) = 0.420937E+00
+ PKER_SDRYG( 25, 33) = 0.392356E+00
+ PKER_SDRYG( 25, 34) = 0.365326E+00
+ PKER_SDRYG( 25, 35) = 0.339713E+00
+ PKER_SDRYG( 25, 36) = 0.315384E+00
+ PKER_SDRYG( 25, 37) = 0.292209E+00
+ PKER_SDRYG( 25, 38) = 0.270064E+00
+ PKER_SDRYG( 25, 39) = 0.248837E+00
+ PKER_SDRYG( 25, 40) = 0.228437E+00
+ PKER_SDRYG( 25, 41) = 0.208804E+00
+ PKER_SDRYG( 25, 42) = 0.189923E+00
+ PKER_SDRYG( 25, 43) = 0.171829E+00
+ PKER_SDRYG( 25, 44) = 0.154601E+00
+ PKER_SDRYG( 25, 45) = 0.138347E+00
+ PKER_SDRYG( 25, 46) = 0.123178E+00
+ PKER_SDRYG( 25, 47) = 0.109173E+00
+ PKER_SDRYG( 25, 48) = 0.963727E-01
+ PKER_SDRYG( 25, 49) = 0.847717E-01
+ PKER_SDRYG( 25, 50) = 0.743296E-01
+ PKER_SDRYG( 25, 51) = 0.649850E-01
+ PKER_SDRYG( 25, 52) = 0.566822E-01
+ PKER_SDRYG( 25, 53) = 0.493595E-01
+ PKER_SDRYG( 25, 54) = 0.429562E-01
+ PKER_SDRYG( 25, 55) = 0.374539E-01
+ PKER_SDRYG( 25, 56) = 0.328017E-01
+ PKER_SDRYG( 25, 57) = 0.289442E-01
+ PKER_SDRYG( 25, 58) = 0.258795E-01
+ PKER_SDRYG( 25, 59) = 0.235524E-01
+ PKER_SDRYG( 25, 60) = 0.218674E-01
+ PKER_SDRYG( 25, 61) = 0.208371E-01
+ PKER_SDRYG( 25, 62) = 0.203194E-01
+ PKER_SDRYG( 25, 63) = 0.203049E-01
+ PKER_SDRYG( 25, 64) = 0.206977E-01
+ PKER_SDRYG( 25, 65) = 0.214318E-01
+ PKER_SDRYG( 25, 66) = 0.224335E-01
+ PKER_SDRYG( 25, 67) = 0.236433E-01
+ PKER_SDRYG( 25, 68) = 0.250200E-01
+ PKER_SDRYG( 25, 69) = 0.264977E-01
+ PKER_SDRYG( 25, 70) = 0.280428E-01
+ PKER_SDRYG( 25, 71) = 0.296240E-01
+ PKER_SDRYG( 25, 72) = 0.312105E-01
+ PKER_SDRYG( 25, 73) = 0.327816E-01
+ PKER_SDRYG( 25, 74) = 0.343205E-01
+ PKER_SDRYG( 25, 75) = 0.358148E-01
+ PKER_SDRYG( 25, 76) = 0.372575E-01
+ PKER_SDRYG( 25, 77) = 0.386413E-01
+ PKER_SDRYG( 25, 78) = 0.399659E-01
+ PKER_SDRYG( 25, 79) = 0.412241E-01
+ PKER_SDRYG( 25, 80) = 0.424150E-01
+ PKER_SDRYG( 26, 1) = 0.319005E+01
+ PKER_SDRYG( 26, 2) = 0.299368E+01
+ PKER_SDRYG( 26, 3) = 0.280930E+01
+ PKER_SDRYG( 26, 4) = 0.263616E+01
+ PKER_SDRYG( 26, 5) = 0.247359E+01
+ PKER_SDRYG( 26, 6) = 0.232094E+01
+ PKER_SDRYG( 26, 7) = 0.217760E+01
+ PKER_SDRYG( 26, 8) = 0.204301E+01
+ PKER_SDRYG( 26, 9) = 0.191663E+01
+ PKER_SDRYG( 26, 10) = 0.179795E+01
+ PKER_SDRYG( 26, 11) = 0.168652E+01
+ PKER_SDRYG( 26, 12) = 0.158188E+01
+ PKER_SDRYG( 26, 13) = 0.148363E+01
+ PKER_SDRYG( 26, 14) = 0.139136E+01
+ PKER_SDRYG( 26, 15) = 0.130473E+01
+ PKER_SDRYG( 26, 16) = 0.122337E+01
+ PKER_SDRYG( 26, 17) = 0.114697E+01
+ PKER_SDRYG( 26, 18) = 0.107523E+01
+ PKER_SDRYG( 26, 19) = 0.100786E+01
+ PKER_SDRYG( 26, 20) = 0.944586E+00
+ PKER_SDRYG( 26, 21) = 0.885163E+00
+ PKER_SDRYG( 26, 22) = 0.829352E+00
+ PKER_SDRYG( 26, 23) = 0.776930E+00
+ PKER_SDRYG( 26, 24) = 0.727686E+00
+ PKER_SDRYG( 26, 25) = 0.681422E+00
+ PKER_SDRYG( 26, 26) = 0.637952E+00
+ PKER_SDRYG( 26, 27) = 0.597097E+00
+ PKER_SDRYG( 26, 28) = 0.558692E+00
+ PKER_SDRYG( 26, 29) = 0.522578E+00
+ PKER_SDRYG( 26, 30) = 0.488602E+00
+ PKER_SDRYG( 26, 31) = 0.456621E+00
+ PKER_SDRYG( 26, 32) = 0.426495E+00
+ PKER_SDRYG( 26, 33) = 0.398091E+00
+ PKER_SDRYG( 26, 34) = 0.371278E+00
+ PKER_SDRYG( 26, 35) = 0.345928E+00
+ PKER_SDRYG( 26, 36) = 0.321917E+00
+ PKER_SDRYG( 26, 37) = 0.299121E+00
+ PKER_SDRYG( 26, 38) = 0.277419E+00
+ PKER_SDRYG( 26, 39) = 0.256699E+00
+ PKER_SDRYG( 26, 40) = 0.236857E+00
+ PKER_SDRYG( 26, 41) = 0.217808E+00
+ PKER_SDRYG( 26, 42) = 0.199498E+00
+ PKER_SDRYG( 26, 43) = 0.181910E+00
+ PKER_SDRYG( 26, 44) = 0.165073E+00
+ PKER_SDRYG( 26, 45) = 0.149056E+00
+ PKER_SDRYG( 26, 46) = 0.133952E+00
+ PKER_SDRYG( 26, 47) = 0.119852E+00
+ PKER_SDRYG( 26, 48) = 0.106824E+00
+ PKER_SDRYG( 26, 49) = 0.948930E-01
+ PKER_SDRYG( 26, 50) = 0.840437E-01
+ PKER_SDRYG( 26, 51) = 0.742268E-01
+ PKER_SDRYG( 26, 52) = 0.653792E-01
+ PKER_SDRYG( 26, 53) = 0.574320E-01
+ PKER_SDRYG( 26, 54) = 0.503214E-01
+ PKER_SDRYG( 26, 55) = 0.439973E-01
+ PKER_SDRYG( 26, 56) = 0.384248E-01
+ PKER_SDRYG( 26, 57) = 0.335714E-01
+ PKER_SDRYG( 26, 58) = 0.294087E-01
+ PKER_SDRYG( 26, 59) = 0.259221E-01
+ PKER_SDRYG( 26, 60) = 0.230931E-01
+ PKER_SDRYG( 26, 61) = 0.208678E-01
+ PKER_SDRYG( 26, 62) = 0.192226E-01
+ PKER_SDRYG( 26, 63) = 0.181215E-01
+ PKER_SDRYG( 26, 64) = 0.175118E-01
+ PKER_SDRYG( 26, 65) = 0.173173E-01
+ PKER_SDRYG( 26, 66) = 0.175126E-01
+ PKER_SDRYG( 26, 67) = 0.180143E-01
+ PKER_SDRYG( 26, 68) = 0.187588E-01
+ PKER_SDRYG( 26, 69) = 0.197277E-01
+ PKER_SDRYG( 26, 70) = 0.208458E-01
+ PKER_SDRYG( 26, 71) = 0.220691E-01
+ PKER_SDRYG( 26, 72) = 0.233679E-01
+ PKER_SDRYG( 26, 73) = 0.247120E-01
+ PKER_SDRYG( 26, 74) = 0.260656E-01
+ PKER_SDRYG( 26, 75) = 0.274186E-01
+ PKER_SDRYG( 26, 76) = 0.287488E-01
+ PKER_SDRYG( 26, 77) = 0.300462E-01
+ PKER_SDRYG( 26, 78) = 0.313023E-01
+ PKER_SDRYG( 26, 79) = 0.325101E-01
+ PKER_SDRYG( 26, 80) = 0.336677E-01
+ PKER_SDRYG( 27, 1) = 0.319411E+01
+ PKER_SDRYG( 27, 2) = 0.299775E+01
+ PKER_SDRYG( 27, 3) = 0.281337E+01
+ PKER_SDRYG( 27, 4) = 0.264023E+01
+ PKER_SDRYG( 27, 5) = 0.247766E+01
+ PKER_SDRYG( 27, 6) = 0.232501E+01
+ PKER_SDRYG( 27, 7) = 0.218167E+01
+ PKER_SDRYG( 27, 8) = 0.204708E+01
+ PKER_SDRYG( 27, 9) = 0.192070E+01
+ PKER_SDRYG( 27, 10) = 0.180203E+01
+ PKER_SDRYG( 27, 11) = 0.169060E+01
+ PKER_SDRYG( 27, 12) = 0.158596E+01
+ PKER_SDRYG( 27, 13) = 0.148771E+01
+ PKER_SDRYG( 27, 14) = 0.139545E+01
+ PKER_SDRYG( 27, 15) = 0.130882E+01
+ PKER_SDRYG( 27, 16) = 0.122746E+01
+ PKER_SDRYG( 27, 17) = 0.115107E+01
+ PKER_SDRYG( 27, 18) = 0.107934E+01
+ PKER_SDRYG( 27, 19) = 0.101197E+01
+ PKER_SDRYG( 27, 20) = 0.948712E+00
+ PKER_SDRYG( 27, 21) = 0.889302E+00
+ PKER_SDRYG( 27, 22) = 0.833506E+00
+ PKER_SDRYG( 27, 23) = 0.781102E+00
+ PKER_SDRYG( 27, 24) = 0.731880E+00
+ PKER_SDRYG( 27, 25) = 0.685643E+00
+ PKER_SDRYG( 27, 26) = 0.642205E+00
+ PKER_SDRYG( 27, 27) = 0.601390E+00
+ PKER_SDRYG( 27, 28) = 0.563032E+00
+ PKER_SDRYG( 27, 29) = 0.526976E+00
+ PKER_SDRYG( 27, 30) = 0.493071E+00
+ PKER_SDRYG( 27, 31) = 0.461177E+00
+ PKER_SDRYG( 27, 32) = 0.431158E+00
+ PKER_SDRYG( 27, 33) = 0.402883E+00
+ PKER_SDRYG( 27, 34) = 0.376229E+00
+ PKER_SDRYG( 27, 35) = 0.351073E+00
+ PKER_SDRYG( 27, 36) = 0.327297E+00
+ PKER_SDRYG( 27, 37) = 0.304783E+00
+ PKER_SDRYG( 27, 38) = 0.283419E+00
+ PKER_SDRYG( 27, 39) = 0.263094E+00
+ PKER_SDRYG( 27, 40) = 0.243701E+00
+ PKER_SDRYG( 27, 41) = 0.225146E+00
+ PKER_SDRYG( 27, 42) = 0.207352E+00
+ PKER_SDRYG( 27, 43) = 0.190265E+00
+ PKER_SDRYG( 27, 44) = 0.173872E+00
+ PKER_SDRYG( 27, 45) = 0.158194E+00
+ PKER_SDRYG( 27, 46) = 0.143292E+00
+ PKER_SDRYG( 27, 47) = 0.129246E+00
+ PKER_SDRYG( 27, 48) = 0.116137E+00
+ PKER_SDRYG( 27, 49) = 0.104019E+00
+ PKER_SDRYG( 27, 50) = 0.929097E-01
+ PKER_SDRYG( 27, 51) = 0.827874E-01
+ PKER_SDRYG( 27, 52) = 0.735998E-01
+ PKER_SDRYG( 27, 53) = 0.652790E-01
+ PKER_SDRYG( 27, 54) = 0.577537E-01
+ PKER_SDRYG( 27, 55) = 0.509584E-01
+ PKER_SDRYG( 27, 56) = 0.448376E-01
+ PKER_SDRYG( 27, 57) = 0.393546E-01
+ PKER_SDRYG( 27, 58) = 0.344768E-01
+ PKER_SDRYG( 27, 59) = 0.301795E-01
+ PKER_SDRYG( 27, 60) = 0.264605E-01
+ PKER_SDRYG( 27, 61) = 0.233008E-01
+ PKER_SDRYG( 27, 62) = 0.206714E-01
+ PKER_SDRYG( 27, 63) = 0.185744E-01
+ PKER_SDRYG( 27, 64) = 0.169884E-01
+ PKER_SDRYG( 27, 65) = 0.158478E-01
+ PKER_SDRYG( 27, 66) = 0.151582E-01
+ PKER_SDRYG( 27, 67) = 0.148323E-01
+ PKER_SDRYG( 27, 68) = 0.148592E-01
+ PKER_SDRYG( 27, 69) = 0.151721E-01
+ PKER_SDRYG( 27, 70) = 0.157308E-01
+ PKER_SDRYG( 27, 71) = 0.164769E-01
+ PKER_SDRYG( 27, 72) = 0.173707E-01
+ PKER_SDRYG( 27, 73) = 0.183846E-01
+ PKER_SDRYG( 27, 74) = 0.194688E-01
+ PKER_SDRYG( 27, 75) = 0.206001E-01
+ PKER_SDRYG( 27, 76) = 0.217573E-01
+ PKER_SDRYG( 27, 77) = 0.229174E-01
+ PKER_SDRYG( 27, 78) = 0.240651E-01
+ PKER_SDRYG( 27, 79) = 0.251891E-01
+ PKER_SDRYG( 27, 80) = 0.262800E-01
+ PKER_SDRYG( 28, 1) = 0.319759E+01
+ PKER_SDRYG( 28, 2) = 0.300123E+01
+ PKER_SDRYG( 28, 3) = 0.281685E+01
+ PKER_SDRYG( 28, 4) = 0.264371E+01
+ PKER_SDRYG( 28, 5) = 0.248114E+01
+ PKER_SDRYG( 28, 6) = 0.232849E+01
+ PKER_SDRYG( 28, 7) = 0.218516E+01
+ PKER_SDRYG( 28, 8) = 0.205056E+01
+ PKER_SDRYG( 28, 9) = 0.192418E+01
+ PKER_SDRYG( 28, 10) = 0.180551E+01
+ PKER_SDRYG( 28, 11) = 0.169408E+01
+ PKER_SDRYG( 28, 12) = 0.158945E+01
+ PKER_SDRYG( 28, 13) = 0.149120E+01
+ PKER_SDRYG( 28, 14) = 0.139894E+01
+ PKER_SDRYG( 28, 15) = 0.131231E+01
+ PKER_SDRYG( 28, 16) = 0.123097E+01
+ PKER_SDRYG( 28, 17) = 0.115458E+01
+ PKER_SDRYG( 28, 18) = 0.108285E+01
+ PKER_SDRYG( 28, 19) = 0.101549E+01
+ PKER_SDRYG( 28, 20) = 0.952238E+00
+ PKER_SDRYG( 28, 21) = 0.892837E+00
+ PKER_SDRYG( 28, 22) = 0.837052E+00
+ PKER_SDRYG( 28, 23) = 0.784662E+00
+ PKER_SDRYG( 28, 24) = 0.735456E+00
+ PKER_SDRYG( 28, 25) = 0.689239E+00
+ PKER_SDRYG( 28, 26) = 0.645825E+00
+ PKER_SDRYG( 28, 27) = 0.605039E+00
+ PKER_SDRYG( 28, 28) = 0.566718E+00
+ PKER_SDRYG( 28, 29) = 0.530704E+00
+ PKER_SDRYG( 28, 30) = 0.496852E+00
+ PKER_SDRYG( 28, 31) = 0.465022E+00
+ PKER_SDRYG( 28, 32) = 0.435081E+00
+ PKER_SDRYG( 28, 33) = 0.406902E+00
+ PKER_SDRYG( 28, 34) = 0.380365E+00
+ PKER_SDRYG( 28, 35) = 0.355351E+00
+ PKER_SDRYG( 28, 36) = 0.331748E+00
+ PKER_SDRYG( 28, 37) = 0.309445E+00
+ PKER_SDRYG( 28, 38) = 0.288334E+00
+ PKER_SDRYG( 28, 39) = 0.268309E+00
+ PKER_SDRYG( 28, 40) = 0.249267E+00
+ PKER_SDRYG( 28, 41) = 0.231112E+00
+ PKER_SDRYG( 28, 42) = 0.213755E+00
+ PKER_SDRYG( 28, 43) = 0.197125E+00
+ PKER_SDRYG( 28, 44) = 0.181172E+00
+ PKER_SDRYG( 28, 45) = 0.165882E+00
+ PKER_SDRYG( 28, 46) = 0.151274E+00
+ PKER_SDRYG( 28, 47) = 0.137400E+00
+ PKER_SDRYG( 28, 48) = 0.124331E+00
+ PKER_SDRYG( 28, 49) = 0.112135E+00
+ PKER_SDRYG( 28, 50) = 0.100860E+00
+ PKER_SDRYG( 28, 51) = 0.905169E-01
+ PKER_SDRYG( 28, 52) = 0.810815E-01
+ PKER_SDRYG( 28, 53) = 0.725012E-01
+ PKER_SDRYG( 28, 54) = 0.647084E-01
+ PKER_SDRYG( 28, 55) = 0.576308E-01
+ PKER_SDRYG( 28, 56) = 0.512005E-01
+ PKER_SDRYG( 28, 57) = 0.453625E-01
+ PKER_SDRYG( 28, 58) = 0.400717E-01
+ PKER_SDRYG( 28, 59) = 0.352935E-01
+ PKER_SDRYG( 28, 60) = 0.310071E-01
+ PKER_SDRYG( 28, 61) = 0.272018E-01
+ PKER_SDRYG( 28, 62) = 0.238669E-01
+ PKER_SDRYG( 28, 63) = 0.209938E-01
+ PKER_SDRYG( 28, 64) = 0.185775E-01
+ PKER_SDRYG( 28, 65) = 0.166174E-01
+ PKER_SDRYG( 28, 66) = 0.150755E-01
+ PKER_SDRYG( 28, 67) = 0.139364E-01
+ PKER_SDRYG( 28, 68) = 0.131851E-01
+ PKER_SDRYG( 28, 69) = 0.127769E-01
+ PKER_SDRYG( 28, 70) = 0.126668E-01
+ PKER_SDRYG( 28, 71) = 0.128310E-01
+ PKER_SDRYG( 28, 72) = 0.132148E-01
+ PKER_SDRYG( 28, 73) = 0.137746E-01
+ PKER_SDRYG( 28, 74) = 0.144895E-01
+ PKER_SDRYG( 28, 75) = 0.153140E-01
+ PKER_SDRYG( 28, 76) = 0.162131E-01
+ PKER_SDRYG( 28, 77) = 0.171648E-01
+ PKER_SDRYG( 28, 78) = 0.181488E-01
+ PKER_SDRYG( 28, 79) = 0.191394E-01
+ PKER_SDRYG( 28, 80) = 0.201280E-01
+ PKER_SDRYG( 29, 1) = 0.320057E+01
+ PKER_SDRYG( 29, 2) = 0.300421E+01
+ PKER_SDRYG( 29, 3) = 0.281983E+01
+ PKER_SDRYG( 29, 4) = 0.264669E+01
+ PKER_SDRYG( 29, 5) = 0.248412E+01
+ PKER_SDRYG( 29, 6) = 0.233147E+01
+ PKER_SDRYG( 29, 7) = 0.218814E+01
+ PKER_SDRYG( 29, 8) = 0.205355E+01
+ PKER_SDRYG( 29, 9) = 0.192717E+01
+ PKER_SDRYG( 29, 10) = 0.180850E+01
+ PKER_SDRYG( 29, 11) = 0.169707E+01
+ PKER_SDRYG( 29, 12) = 0.159244E+01
+ PKER_SDRYG( 29, 13) = 0.149419E+01
+ PKER_SDRYG( 29, 14) = 0.140193E+01
+ PKER_SDRYG( 29, 15) = 0.131530E+01
+ PKER_SDRYG( 29, 16) = 0.123396E+01
+ PKER_SDRYG( 29, 17) = 0.115758E+01
+ PKER_SDRYG( 29, 18) = 0.108585E+01
+ PKER_SDRYG( 29, 19) = 0.101850E+01
+ PKER_SDRYG( 29, 20) = 0.955250E+00
+ PKER_SDRYG( 29, 21) = 0.895856E+00
+ PKER_SDRYG( 29, 22) = 0.840080E+00
+ PKER_SDRYG( 29, 23) = 0.787700E+00
+ PKER_SDRYG( 29, 24) = 0.738507E+00
+ PKER_SDRYG( 29, 25) = 0.692305E+00
+ PKER_SDRYG( 29, 26) = 0.648909E+00
+ PKER_SDRYG( 29, 27) = 0.608145E+00
+ PKER_SDRYG( 29, 28) = 0.569850E+00
+ PKER_SDRYG( 29, 29) = 0.533869E+00
+ PKER_SDRYG( 29, 30) = 0.500057E+00
+ PKER_SDRYG( 29, 31) = 0.468274E+00
+ PKER_SDRYG( 29, 32) = 0.438391E+00
+ PKER_SDRYG( 29, 33) = 0.410283E+00
+ PKER_SDRYG( 29, 34) = 0.383831E+00
+ PKER_SDRYG( 29, 35) = 0.358922E+00
+ PKER_SDRYG( 29, 36) = 0.335447E+00
+ PKER_SDRYG( 29, 37) = 0.313300E+00
+ PKER_SDRYG( 29, 38) = 0.292377E+00
+ PKER_SDRYG( 29, 39) = 0.272578E+00
+ PKER_SDRYG( 29, 40) = 0.253805E+00
+ PKER_SDRYG( 29, 41) = 0.235964E+00
+ PKER_SDRYG( 29, 42) = 0.218962E+00
+ PKER_SDRYG( 29, 43) = 0.202721E+00
+ PKER_SDRYG( 29, 44) = 0.187172E+00
+ PKER_SDRYG( 29, 45) = 0.172272E+00
+ PKER_SDRYG( 29, 46) = 0.158003E+00
+ PKER_SDRYG( 29, 47) = 0.144383E+00
+ PKER_SDRYG( 29, 48) = 0.131457E+00
+ PKER_SDRYG( 29, 49) = 0.119287E+00
+ PKER_SDRYG( 29, 50) = 0.107934E+00
+ PKER_SDRYG( 29, 51) = 0.974376E-01
+ PKER_SDRYG( 29, 52) = 0.878049E-01
+ PKER_SDRYG( 29, 53) = 0.790110E-01
+ PKER_SDRYG( 29, 54) = 0.710047E-01
+ PKER_SDRYG( 29, 55) = 0.637201E-01
+ PKER_SDRYG( 29, 56) = 0.570871E-01
+ PKER_SDRYG( 29, 57) = 0.510391E-01
+ PKER_SDRYG( 29, 58) = 0.455190E-01
+ PKER_SDRYG( 29, 59) = 0.404790E-01
+ PKER_SDRYG( 29, 60) = 0.358835E-01
+ PKER_SDRYG( 29, 61) = 0.317075E-01
+ PKER_SDRYG( 29, 62) = 0.279360E-01
+ PKER_SDRYG( 29, 63) = 0.245579E-01
+ PKER_SDRYG( 29, 64) = 0.215683E-01
+ PKER_SDRYG( 29, 65) = 0.189675E-01
+ PKER_SDRYG( 29, 66) = 0.167538E-01
+ PKER_SDRYG( 29, 67) = 0.149086E-01
+ PKER_SDRYG( 29, 68) = 0.134333E-01
+ PKER_SDRYG( 29, 69) = 0.123230E-01
+ PKER_SDRYG( 29, 70) = 0.115303E-01
+ PKER_SDRYG( 29, 71) = 0.110545E-01
+ PKER_SDRYG( 29, 72) = 0.108420E-01
+ PKER_SDRYG( 29, 73) = 0.108817E-01
+ PKER_SDRYG( 29, 74) = 0.111244E-01
+ PKER_SDRYG( 29, 75) = 0.115437E-01
+ PKER_SDRYG( 29, 76) = 0.120983E-01
+ PKER_SDRYG( 29, 77) = 0.127573E-01
+ PKER_SDRYG( 29, 78) = 0.135034E-01
+ PKER_SDRYG( 29, 79) = 0.142993E-01
+ PKER_SDRYG( 29, 80) = 0.151279E-01
+ PKER_SDRYG( 30, 1) = 0.320312E+01
+ PKER_SDRYG( 30, 2) = 0.300676E+01
+ PKER_SDRYG( 30, 3) = 0.282237E+01
+ PKER_SDRYG( 30, 4) = 0.264924E+01
+ PKER_SDRYG( 30, 5) = 0.248667E+01
+ PKER_SDRYG( 30, 6) = 0.233402E+01
+ PKER_SDRYG( 30, 7) = 0.219069E+01
+ PKER_SDRYG( 30, 8) = 0.205610E+01
+ PKER_SDRYG( 30, 9) = 0.192972E+01
+ PKER_SDRYG( 30, 10) = 0.181105E+01
+ PKER_SDRYG( 30, 11) = 0.169962E+01
+ PKER_SDRYG( 30, 12) = 0.159499E+01
+ PKER_SDRYG( 30, 13) = 0.149674E+01
+ PKER_SDRYG( 30, 14) = 0.140449E+01
+ PKER_SDRYG( 30, 15) = 0.131786E+01
+ PKER_SDRYG( 30, 16) = 0.123652E+01
+ PKER_SDRYG( 30, 17) = 0.116014E+01
+ PKER_SDRYG( 30, 18) = 0.108842E+01
+ PKER_SDRYG( 30, 19) = 0.102107E+01
+ PKER_SDRYG( 30, 20) = 0.957825E+00
+ PKER_SDRYG( 30, 21) = 0.898436E+00
+ PKER_SDRYG( 30, 22) = 0.842667E+00
+ PKER_SDRYG( 30, 23) = 0.790295E+00
+ PKER_SDRYG( 30, 24) = 0.741111E+00
+ PKER_SDRYG( 30, 25) = 0.694920E+00
+ PKER_SDRYG( 30, 26) = 0.651538E+00
+ PKER_SDRYG( 30, 27) = 0.610791E+00
+ PKER_SDRYG( 30, 28) = 0.572516E+00
+ PKER_SDRYG( 30, 29) = 0.536559E+00
+ PKER_SDRYG( 30, 30) = 0.502776E+00
+ PKER_SDRYG( 30, 31) = 0.471029E+00
+ PKER_SDRYG( 30, 32) = 0.441189E+00
+ PKER_SDRYG( 30, 33) = 0.413133E+00
+ PKER_SDRYG( 30, 34) = 0.386745E+00
+ PKER_SDRYG( 30, 35) = 0.361914E+00
+ PKER_SDRYG( 30, 36) = 0.338534E+00
+ PKER_SDRYG( 30, 37) = 0.316502E+00
+ PKER_SDRYG( 30, 38) = 0.295719E+00
+ PKER_SDRYG( 30, 39) = 0.276089E+00
+ PKER_SDRYG( 30, 40) = 0.257519E+00
+ PKER_SDRYG( 30, 41) = 0.239918E+00
+ PKER_SDRYG( 30, 42) = 0.223197E+00
+ PKER_SDRYG( 30, 43) = 0.207273E+00
+ PKER_SDRYG( 30, 44) = 0.192071E+00
+ PKER_SDRYG( 30, 45) = 0.177528E+00
+ PKER_SDRYG( 30, 46) = 0.163604E+00
+ PKER_SDRYG( 30, 47) = 0.150282E+00
+ PKER_SDRYG( 30, 48) = 0.137575E+00
+ PKER_SDRYG( 30, 49) = 0.125525E+00
+ PKER_SDRYG( 30, 50) = 0.114185E+00
+ PKER_SDRYG( 30, 51) = 0.103610E+00
+ PKER_SDRYG( 30, 52) = 0.938314E-01
+ PKER_SDRYG( 30, 53) = 0.848558E-01
+ PKER_SDRYG( 30, 54) = 0.766574E-01
+ PKER_SDRYG( 30, 55) = 0.691873E-01
+ PKER_SDRYG( 30, 56) = 0.623830E-01
+ PKER_SDRYG( 30, 57) = 0.561775E-01
+ PKER_SDRYG( 30, 58) = 0.505069E-01
+ PKER_SDRYG( 30, 59) = 0.453150E-01
+ PKER_SDRYG( 30, 60) = 0.405539E-01
+ PKER_SDRYG( 30, 61) = 0.361851E-01
+ PKER_SDRYG( 30, 62) = 0.321814E-01
+ PKER_SDRYG( 30, 63) = 0.285232E-01
+ PKER_SDRYG( 30, 64) = 0.251963E-01
+ PKER_SDRYG( 30, 65) = 0.221941E-01
+ PKER_SDRYG( 30, 66) = 0.195174E-01
+ PKER_SDRYG( 30, 67) = 0.171634E-01
+ PKER_SDRYG( 30, 68) = 0.151306E-01
+ PKER_SDRYG( 30, 69) = 0.134200E-01
+ PKER_SDRYG( 30, 70) = 0.120326E-01
+ PKER_SDRYG( 30, 71) = 0.109418E-01
+ PKER_SDRYG( 30, 72) = 0.101394E-01
+ PKER_SDRYG( 30, 73) = 0.961608E-02
+ PKER_SDRYG( 30, 74) = 0.933453E-02
+ PKER_SDRYG( 30, 75) = 0.927173E-02
+ PKER_SDRYG( 30, 76) = 0.940407E-02
+ PKER_SDRYG( 30, 77) = 0.969318E-02
+ PKER_SDRYG( 30, 78) = 0.101124E-01
+ PKER_SDRYG( 30, 79) = 0.106403E-01
+ PKER_SDRYG( 30, 80) = 0.112467E-01
+ PKER_SDRYG( 31, 1) = 0.320530E+01
+ PKER_SDRYG( 31, 2) = 0.300894E+01
+ PKER_SDRYG( 31, 3) = 0.282455E+01
+ PKER_SDRYG( 31, 4) = 0.265142E+01
+ PKER_SDRYG( 31, 5) = 0.248885E+01
+ PKER_SDRYG( 31, 6) = 0.233620E+01
+ PKER_SDRYG( 31, 7) = 0.219287E+01
+ PKER_SDRYG( 31, 8) = 0.205828E+01
+ PKER_SDRYG( 31, 9) = 0.193190E+01
+ PKER_SDRYG( 31, 10) = 0.181323E+01
+ PKER_SDRYG( 31, 11) = 0.170180E+01
+ PKER_SDRYG( 31, 12) = 0.159717E+01
+ PKER_SDRYG( 31, 13) = 0.149893E+01
+ PKER_SDRYG( 31, 14) = 0.140668E+01
+ PKER_SDRYG( 31, 15) = 0.132005E+01
+ PKER_SDRYG( 31, 16) = 0.123871E+01
+ PKER_SDRYG( 31, 17) = 0.116233E+01
+ PKER_SDRYG( 31, 18) = 0.109061E+01
+ PKER_SDRYG( 31, 19) = 0.102327E+01
+ PKER_SDRYG( 31, 20) = 0.960026E+00
+ PKER_SDRYG( 31, 21) = 0.900641E+00
+ PKER_SDRYG( 31, 22) = 0.844877E+00
+ PKER_SDRYG( 31, 23) = 0.792511E+00
+ PKER_SDRYG( 31, 24) = 0.743334E+00
+ PKER_SDRYG( 31, 25) = 0.697152E+00
+ PKER_SDRYG( 31, 26) = 0.653780E+00
+ PKER_SDRYG( 31, 27) = 0.613046E+00
+ PKER_SDRYG( 31, 28) = 0.574786E+00
+ PKER_SDRYG( 31, 29) = 0.538847E+00
+ PKER_SDRYG( 31, 30) = 0.505086E+00
+ PKER_SDRYG( 31, 31) = 0.473366E+00
+ PKER_SDRYG( 31, 32) = 0.443558E+00
+ PKER_SDRYG( 31, 33) = 0.415542E+00
+ PKER_SDRYG( 31, 34) = 0.389201E+00
+ PKER_SDRYG( 31, 35) = 0.364428E+00
+ PKER_SDRYG( 31, 36) = 0.341118E+00
+ PKER_SDRYG( 31, 37) = 0.319171E+00
+ PKER_SDRYG( 31, 38) = 0.298492E+00
+ PKER_SDRYG( 31, 39) = 0.278989E+00
+ PKER_SDRYG( 31, 40) = 0.260571E+00
+ PKER_SDRYG( 31, 41) = 0.243153E+00
+ PKER_SDRYG( 31, 42) = 0.226648E+00
+ PKER_SDRYG( 31, 43) = 0.210975E+00
+ PKER_SDRYG( 31, 44) = 0.196056E+00
+ PKER_SDRYG( 31, 45) = 0.181823E+00
+ PKER_SDRYG( 31, 46) = 0.168217E+00
+ PKER_SDRYG( 31, 47) = 0.155200E+00
+ PKER_SDRYG( 31, 48) = 0.142755E+00
+ PKER_SDRYG( 31, 49) = 0.130895E+00
+ PKER_SDRYG( 31, 50) = 0.119654E+00
+ PKER_SDRYG( 31, 51) = 0.109081E+00
+ PKER_SDRYG( 31, 52) = 0.992231E-01
+ PKER_SDRYG( 31, 53) = 0.901085E-01
+ PKER_SDRYG( 31, 54) = 0.817403E-01
+ PKER_SDRYG( 31, 55) = 0.740936E-01
+ PKER_SDRYG( 31, 56) = 0.671220E-01
+ PKER_SDRYG( 31, 57) = 0.607667E-01
+ PKER_SDRYG( 31, 58) = 0.549649E-01
+ PKER_SDRYG( 31, 59) = 0.496562E-01
+ PKER_SDRYG( 31, 60) = 0.447864E-01
+ PKER_SDRYG( 31, 61) = 0.403087E-01
+ PKER_SDRYG( 31, 62) = 0.361850E-01
+ PKER_SDRYG( 31, 63) = 0.323859E-01
+ PKER_SDRYG( 31, 64) = 0.288877E-01
+ PKER_SDRYG( 31, 65) = 0.256749E-01
+ PKER_SDRYG( 31, 66) = 0.227386E-01
+ PKER_SDRYG( 31, 67) = 0.200734E-01
+ PKER_SDRYG( 31, 68) = 0.176775E-01
+ PKER_SDRYG( 31, 69) = 0.155527E-01
+ PKER_SDRYG( 31, 70) = 0.136989E-01
+ PKER_SDRYG( 31, 71) = 0.121210E-01
+ PKER_SDRYG( 31, 72) = 0.108058E-01
+ PKER_SDRYG( 31, 73) = 0.975234E-02
+ PKER_SDRYG( 31, 74) = 0.896449E-02
+ PKER_SDRYG( 31, 75) = 0.840572E-02
+ PKER_SDRYG( 31, 76) = 0.807166E-02
+ PKER_SDRYG( 31, 77) = 0.793136E-02
+ PKER_SDRYG( 31, 78) = 0.797231E-02
+ PKER_SDRYG( 31, 79) = 0.815684E-02
+ PKER_SDRYG( 31, 80) = 0.847058E-02
+ PKER_SDRYG( 32, 1) = 0.320717E+01
+ PKER_SDRYG( 32, 2) = 0.301080E+01
+ PKER_SDRYG( 32, 3) = 0.282642E+01
+ PKER_SDRYG( 32, 4) = 0.265329E+01
+ PKER_SDRYG( 32, 5) = 0.249072E+01
+ PKER_SDRYG( 32, 6) = 0.233807E+01
+ PKER_SDRYG( 32, 7) = 0.219474E+01
+ PKER_SDRYG( 32, 8) = 0.206015E+01
+ PKER_SDRYG( 32, 9) = 0.193377E+01
+ PKER_SDRYG( 32, 10) = 0.181510E+01
+ PKER_SDRYG( 32, 11) = 0.170367E+01
+ PKER_SDRYG( 32, 12) = 0.159904E+01
+ PKER_SDRYG( 32, 13) = 0.150080E+01
+ PKER_SDRYG( 32, 14) = 0.140855E+01
+ PKER_SDRYG( 32, 15) = 0.132192E+01
+ PKER_SDRYG( 32, 16) = 0.124058E+01
+ PKER_SDRYG( 32, 17) = 0.116421E+01
+ PKER_SDRYG( 32, 18) = 0.109249E+01
+ PKER_SDRYG( 32, 19) = 0.102514E+01
+ PKER_SDRYG( 32, 20) = 0.961907E+00
+ PKER_SDRYG( 32, 21) = 0.902526E+00
+ PKER_SDRYG( 32, 22) = 0.846765E+00
+ PKER_SDRYG( 32, 23) = 0.794404E+00
+ PKER_SDRYG( 32, 24) = 0.745233E+00
+ PKER_SDRYG( 32, 25) = 0.699057E+00
+ PKER_SDRYG( 32, 26) = 0.655693E+00
+ PKER_SDRYG( 32, 27) = 0.614968E+00
+ PKER_SDRYG( 32, 28) = 0.576720E+00
+ PKER_SDRYG( 32, 29) = 0.540795E+00
+ PKER_SDRYG( 32, 30) = 0.507051E+00
+ PKER_SDRYG( 32, 31) = 0.475350E+00
+ PKER_SDRYG( 32, 32) = 0.445567E+00
+ PKER_SDRYG( 32, 33) = 0.417580E+00
+ PKER_SDRYG( 32, 34) = 0.391276E+00
+ PKER_SDRYG( 32, 35) = 0.366546E+00
+ PKER_SDRYG( 32, 36) = 0.343288E+00
+ PKER_SDRYG( 32, 37) = 0.321405E+00
+ PKER_SDRYG( 32, 38) = 0.300804E+00
+ PKER_SDRYG( 32, 39) = 0.281394E+00
+ PKER_SDRYG( 32, 40) = 0.263091E+00
+ PKER_SDRYG( 32, 41) = 0.245809E+00
+ PKER_SDRYG( 32, 42) = 0.229469E+00
+ PKER_SDRYG( 32, 43) = 0.213990E+00
+ PKER_SDRYG( 32, 44) = 0.199297E+00
+ PKER_SDRYG( 32, 45) = 0.185318E+00
+ PKER_SDRYG( 32, 46) = 0.171989E+00
+ PKER_SDRYG( 32, 47) = 0.159255E+00
+ PKER_SDRYG( 32, 48) = 0.147081E+00
+ PKER_SDRYG( 32, 49) = 0.135452E+00
+ PKER_SDRYG( 32, 50) = 0.124376E+00
+ PKER_SDRYG( 32, 51) = 0.113884E+00
+ PKER_SDRYG( 32, 52) = 0.104021E+00
+ PKER_SDRYG( 32, 53) = 0.948256E-01
+ PKER_SDRYG( 32, 54) = 0.863244E-01
+ PKER_SDRYG( 32, 55) = 0.785179E-01
+ PKER_SDRYG( 32, 56) = 0.713821E-01
+ PKER_SDRYG( 32, 57) = 0.648731E-01
+ PKER_SDRYG( 32, 58) = 0.589359E-01
+ PKER_SDRYG( 32, 59) = 0.535119E-01
+ PKER_SDRYG( 32, 60) = 0.485445E-01
+ PKER_SDRYG( 32, 61) = 0.439825E-01
+ PKER_SDRYG( 32, 62) = 0.397817E-01
+ PKER_SDRYG( 32, 63) = 0.359045E-01
+ PKER_SDRYG( 32, 64) = 0.323209E-01
+ PKER_SDRYG( 32, 65) = 0.290070E-01
+ PKER_SDRYG( 32, 66) = 0.259441E-01
+ PKER_SDRYG( 32, 67) = 0.231196E-01
+ PKER_SDRYG( 32, 68) = 0.205267E-01
+ PKER_SDRYG( 32, 69) = 0.181592E-01
+ PKER_SDRYG( 32, 70) = 0.160162E-01
+ PKER_SDRYG( 32, 71) = 0.141022E-01
+ PKER_SDRYG( 32, 72) = 0.124158E-01
+ PKER_SDRYG( 32, 73) = 0.109584E-01
+ PKER_SDRYG( 32, 74) = 0.973316E-02
+ PKER_SDRYG( 32, 75) = 0.873966E-02
+ PKER_SDRYG( 32, 76) = 0.796029E-02
+ PKER_SDRYG( 32, 77) = 0.738911E-02
+ PKER_SDRYG( 32, 78) = 0.702077E-02
+ PKER_SDRYG( 32, 79) = 0.682454E-02
+ PKER_SDRYG( 32, 80) = 0.678880E-02
+ PKER_SDRYG( 33, 1) = 0.320876E+01
+ PKER_SDRYG( 33, 2) = 0.301240E+01
+ PKER_SDRYG( 33, 3) = 0.282802E+01
+ PKER_SDRYG( 33, 4) = 0.265489E+01
+ PKER_SDRYG( 33, 5) = 0.249232E+01
+ PKER_SDRYG( 33, 6) = 0.233967E+01
+ PKER_SDRYG( 33, 7) = 0.219633E+01
+ PKER_SDRYG( 33, 8) = 0.206174E+01
+ PKER_SDRYG( 33, 9) = 0.193536E+01
+ PKER_SDRYG( 33, 10) = 0.181670E+01
+ PKER_SDRYG( 33, 11) = 0.170527E+01
+ PKER_SDRYG( 33, 12) = 0.160064E+01
+ PKER_SDRYG( 33, 13) = 0.150240E+01
+ PKER_SDRYG( 33, 14) = 0.141015E+01
+ PKER_SDRYG( 33, 15) = 0.132352E+01
+ PKER_SDRYG( 33, 16) = 0.124219E+01
+ PKER_SDRYG( 33, 17) = 0.116581E+01
+ PKER_SDRYG( 33, 18) = 0.109409E+01
+ PKER_SDRYG( 33, 19) = 0.102675E+01
+ PKER_SDRYG( 33, 20) = 0.963516E+00
+ PKER_SDRYG( 33, 21) = 0.904137E+00
+ PKER_SDRYG( 33, 22) = 0.848379E+00
+ PKER_SDRYG( 33, 23) = 0.796021E+00
+ PKER_SDRYG( 33, 24) = 0.746854E+00
+ PKER_SDRYG( 33, 25) = 0.700684E+00
+ PKER_SDRYG( 33, 26) = 0.657326E+00
+ PKER_SDRYG( 33, 27) = 0.616608E+00
+ PKER_SDRYG( 33, 28) = 0.578369E+00
+ PKER_SDRYG( 33, 29) = 0.542455E+00
+ PKER_SDRYG( 33, 30) = 0.508723E+00
+ PKER_SDRYG( 33, 31) = 0.477038E+00
+ PKER_SDRYG( 33, 32) = 0.447273E+00
+ PKER_SDRYG( 33, 33) = 0.419308E+00
+ PKER_SDRYG( 33, 34) = 0.393031E+00
+ PKER_SDRYG( 33, 35) = 0.368334E+00
+ PKER_SDRYG( 33, 36) = 0.345115E+00
+ PKER_SDRYG( 33, 37) = 0.323280E+00
+ PKER_SDRYG( 33, 38) = 0.302737E+00
+ PKER_SDRYG( 33, 39) = 0.283398E+00
+ PKER_SDRYG( 33, 40) = 0.265179E+00
+ PKER_SDRYG( 33, 41) = 0.248001E+00
+ PKER_SDRYG( 33, 42) = 0.231784E+00
+ PKER_SDRYG( 33, 43) = 0.216454E+00
+ PKER_SDRYG( 33, 44) = 0.201936E+00
+ PKER_SDRYG( 33, 45) = 0.188160E+00
+ PKER_SDRYG( 33, 46) = 0.175059E+00
+ PKER_SDRYG( 33, 47) = 0.162573E+00
+ PKER_SDRYG( 33, 48) = 0.150653E+00
+ PKER_SDRYG( 33, 49) = 0.139264E+00
+ PKER_SDRYG( 33, 50) = 0.128391E+00
+ PKER_SDRYG( 33, 51) = 0.118043E+00
+ PKER_SDRYG( 33, 52) = 0.108246E+00
+ PKER_SDRYG( 33, 53) = 0.990391E-01
+ PKER_SDRYG( 33, 54) = 0.904578E-01
+ PKER_SDRYG( 33, 55) = 0.825243E-01
+ PKER_SDRYG( 33, 56) = 0.752379E-01
+ PKER_SDRYG( 33, 57) = 0.685753E-01
+ PKER_SDRYG( 33, 58) = 0.624955E-01
+ PKER_SDRYG( 33, 59) = 0.569470E-01
+ PKER_SDRYG( 33, 60) = 0.518753E-01
+ PKER_SDRYG( 33, 61) = 0.472275E-01
+ PKER_SDRYG( 33, 62) = 0.429558E-01
+ PKER_SDRYG( 33, 63) = 0.390186E-01
+ PKER_SDRYG( 33, 64) = 0.353804E-01
+ PKER_SDRYG( 33, 65) = 0.320117E-01
+ PKER_SDRYG( 33, 66) = 0.288882E-01
+ PKER_SDRYG( 33, 67) = 0.259908E-01
+ PKER_SDRYG( 33, 68) = 0.233051E-01
+ PKER_SDRYG( 33, 69) = 0.208197E-01
+ PKER_SDRYG( 33, 70) = 0.185279E-01
+ PKER_SDRYG( 33, 71) = 0.164268E-01
+ PKER_SDRYG( 33, 72) = 0.145150E-01
+ PKER_SDRYG( 33, 73) = 0.127936E-01
+ PKER_SDRYG( 33, 74) = 0.112662E-01
+ PKER_SDRYG( 33, 75) = 0.993136E-02
+ PKER_SDRYG( 33, 76) = 0.879659E-02
+ PKER_SDRYG( 33, 77) = 0.785167E-02
+ PKER_SDRYG( 33, 78) = 0.709416E-02
+ PKER_SDRYG( 33, 79) = 0.653114E-02
+ PKER_SDRYG( 33, 80) = 0.613422E-02
+ PKER_SDRYG( 34, 1) = 0.321013E+01
+ PKER_SDRYG( 34, 2) = 0.301377E+01
+ PKER_SDRYG( 34, 3) = 0.282938E+01
+ PKER_SDRYG( 34, 4) = 0.265625E+01
+ PKER_SDRYG( 34, 5) = 0.249368E+01
+ PKER_SDRYG( 34, 6) = 0.234103E+01
+ PKER_SDRYG( 34, 7) = 0.219770E+01
+ PKER_SDRYG( 34, 8) = 0.206311E+01
+ PKER_SDRYG( 34, 9) = 0.193673E+01
+ PKER_SDRYG( 34, 10) = 0.181807E+01
+ PKER_SDRYG( 34, 11) = 0.170664E+01
+ PKER_SDRYG( 34, 12) = 0.160201E+01
+ PKER_SDRYG( 34, 13) = 0.150377E+01
+ PKER_SDRYG( 34, 14) = 0.141152E+01
+ PKER_SDRYG( 34, 15) = 0.132489E+01
+ PKER_SDRYG( 34, 16) = 0.124356E+01
+ PKER_SDRYG( 34, 17) = 0.116718E+01
+ PKER_SDRYG( 34, 18) = 0.109547E+01
+ PKER_SDRYG( 34, 19) = 0.102812E+01
+ PKER_SDRYG( 34, 20) = 0.964891E+00
+ PKER_SDRYG( 34, 21) = 0.905514E+00
+ PKER_SDRYG( 34, 22) = 0.849759E+00
+ PKER_SDRYG( 34, 23) = 0.797403E+00
+ PKER_SDRYG( 34, 24) = 0.748240E+00
+ PKER_SDRYG( 34, 25) = 0.702073E+00
+ PKER_SDRYG( 34, 26) = 0.658720E+00
+ PKER_SDRYG( 34, 27) = 0.618008E+00
+ PKER_SDRYG( 34, 28) = 0.579775E+00
+ PKER_SDRYG( 34, 29) = 0.543869E+00
+ PKER_SDRYG( 34, 30) = 0.510147E+00
+ PKER_SDRYG( 34, 31) = 0.478474E+00
+ PKER_SDRYG( 34, 32) = 0.448723E+00
+ PKER_SDRYG( 34, 33) = 0.420775E+00
+ PKER_SDRYG( 34, 34) = 0.394518E+00
+ PKER_SDRYG( 34, 35) = 0.369845E+00
+ PKER_SDRYG( 34, 36) = 0.346657E+00
+ PKER_SDRYG( 34, 37) = 0.324858E+00
+ PKER_SDRYG( 34, 38) = 0.304358E+00
+ PKER_SDRYG( 34, 39) = 0.285071E+00
+ PKER_SDRYG( 34, 40) = 0.266917E+00
+ PKER_SDRYG( 34, 41) = 0.249816E+00
+ PKER_SDRYG( 34, 42) = 0.233693E+00
+ PKER_SDRYG( 34, 43) = 0.218475E+00
+ PKER_SDRYG( 34, 44) = 0.204091E+00
+ PKER_SDRYG( 34, 45) = 0.190473E+00
+ PKER_SDRYG( 34, 46) = 0.177555E+00
+ PKER_SDRYG( 34, 47) = 0.165275E+00
+ PKER_SDRYG( 34, 48) = 0.153578E+00
+ PKER_SDRYG( 34, 49) = 0.142416E+00
+ PKER_SDRYG( 34, 50) = 0.131757E+00
+ PKER_SDRYG( 34, 51) = 0.121589E+00
+ PKER_SDRYG( 34, 52) = 0.111916E+00
+ PKER_SDRYG( 34, 53) = 0.102764E+00
+ PKER_SDRYG( 34, 54) = 0.941652E-01
+ PKER_SDRYG( 34, 55) = 0.861526E-01
+ PKER_SDRYG( 34, 56) = 0.787448E-01
+ PKER_SDRYG( 34, 57) = 0.719403E-01
+ PKER_SDRYG( 34, 58) = 0.657167E-01
+ PKER_SDRYG( 34, 59) = 0.600352E-01
+ PKER_SDRYG( 34, 60) = 0.548480E-01
+ PKER_SDRYG( 34, 61) = 0.501041E-01
+ PKER_SDRYG( 34, 62) = 0.457547E-01
+ PKER_SDRYG( 34, 63) = 0.417550E-01
+ PKER_SDRYG( 34, 64) = 0.380663E-01
+ PKER_SDRYG( 34, 65) = 0.346552E-01
+ PKER_SDRYG( 34, 66) = 0.314935E-01
+ PKER_SDRYG( 34, 67) = 0.285580E-01
+ PKER_SDRYG( 34, 68) = 0.258292E-01
+ PKER_SDRYG( 34, 69) = 0.232916E-01
+ PKER_SDRYG( 34, 70) = 0.209331E-01
+ PKER_SDRYG( 34, 71) = 0.187445E-01
+ PKER_SDRYG( 34, 72) = 0.167197E-01
+ PKER_SDRYG( 34, 73) = 0.148560E-01
+ PKER_SDRYG( 34, 74) = 0.131512E-01
+ PKER_SDRYG( 34, 75) = 0.116067E-01
+ PKER_SDRYG( 34, 76) = 0.102254E-01
+ PKER_SDRYG( 34, 77) = 0.900807E-02
+ PKER_SDRYG( 34, 78) = 0.795670E-02
+ PKER_SDRYG( 34, 79) = 0.707317E-02
+ PKER_SDRYG( 34, 80) = 0.635774E-02
+ PKER_SDRYG( 35, 1) = 0.321130E+01
+ PKER_SDRYG( 35, 2) = 0.301493E+01
+ PKER_SDRYG( 35, 3) = 0.283055E+01
+ PKER_SDRYG( 35, 4) = 0.265742E+01
+ PKER_SDRYG( 35, 5) = 0.249485E+01
+ PKER_SDRYG( 35, 6) = 0.234220E+01
+ PKER_SDRYG( 35, 7) = 0.219887E+01
+ PKER_SDRYG( 35, 8) = 0.206428E+01
+ PKER_SDRYG( 35, 9) = 0.193790E+01
+ PKER_SDRYG( 35, 10) = 0.181923E+01
+ PKER_SDRYG( 35, 11) = 0.170781E+01
+ PKER_SDRYG( 35, 12) = 0.160318E+01
+ PKER_SDRYG( 35, 13) = 0.150494E+01
+ PKER_SDRYG( 35, 14) = 0.141269E+01
+ PKER_SDRYG( 35, 15) = 0.132607E+01
+ PKER_SDRYG( 35, 16) = 0.124473E+01
+ PKER_SDRYG( 35, 17) = 0.116835E+01
+ PKER_SDRYG( 35, 18) = 0.109664E+01
+ PKER_SDRYG( 35, 19) = 0.102930E+01
+ PKER_SDRYG( 35, 20) = 0.966067E+00
+ PKER_SDRYG( 35, 21) = 0.906692E+00
+ PKER_SDRYG( 35, 22) = 0.850938E+00
+ PKER_SDRYG( 35, 23) = 0.798585E+00
+ PKER_SDRYG( 35, 24) = 0.749424E+00
+ PKER_SDRYG( 35, 25) = 0.703260E+00
+ PKER_SDRYG( 35, 26) = 0.659911E+00
+ PKER_SDRYG( 35, 27) = 0.619203E+00
+ PKER_SDRYG( 35, 28) = 0.580975E+00
+ PKER_SDRYG( 35, 29) = 0.545076E+00
+ PKER_SDRYG( 35, 30) = 0.511361E+00
+ PKER_SDRYG( 35, 31) = 0.479697E+00
+ PKER_SDRYG( 35, 32) = 0.449956E+00
+ PKER_SDRYG( 35, 33) = 0.422022E+00
+ PKER_SDRYG( 35, 34) = 0.395780E+00
+ PKER_SDRYG( 35, 35) = 0.371126E+00
+ PKER_SDRYG( 35, 36) = 0.347960E+00
+ PKER_SDRYG( 35, 37) = 0.326188E+00
+ PKER_SDRYG( 35, 38) = 0.305721E+00
+ PKER_SDRYG( 35, 39) = 0.286474E+00
+ PKER_SDRYG( 35, 40) = 0.268367E+00
+ PKER_SDRYG( 35, 41) = 0.251325E+00
+ PKER_SDRYG( 35, 42) = 0.235272E+00
+ PKER_SDRYG( 35, 43) = 0.220139E+00
+ PKER_SDRYG( 35, 44) = 0.205857E+00
+ PKER_SDRYG( 35, 45) = 0.192361E+00
+ PKER_SDRYG( 35, 46) = 0.179586E+00
+ PKER_SDRYG( 35, 47) = 0.167472E+00
+ PKER_SDRYG( 35, 48) = 0.155960E+00
+ PKER_SDRYG( 35, 49) = 0.144998E+00
+ PKER_SDRYG( 35, 50) = 0.134544E+00
+ PKER_SDRYG( 35, 51) = 0.124567E+00
+ PKER_SDRYG( 35, 52) = 0.115053E+00
+ PKER_SDRYG( 35, 53) = 0.106009E+00
+ PKER_SDRYG( 35, 54) = 0.974547E-01
+ PKER_SDRYG( 35, 55) = 0.894206E-01
+ PKER_SDRYG( 35, 56) = 0.819354E-01
+ PKER_SDRYG( 35, 57) = 0.750153E-01
+ PKER_SDRYG( 35, 58) = 0.686578E-01
+ PKER_SDRYG( 35, 59) = 0.628415E-01
+ PKER_SDRYG( 35, 60) = 0.575301E-01
+ PKER_SDRYG( 35, 61) = 0.526787E-01
+ PKER_SDRYG( 35, 62) = 0.482402E-01
+ PKER_SDRYG( 35, 63) = 0.441689E-01
+ PKER_SDRYG( 35, 64) = 0.404234E-01
+ PKER_SDRYG( 35, 65) = 0.369676E-01
+ PKER_SDRYG( 35, 66) = 0.337703E-01
+ PKER_SDRYG( 35, 67) = 0.308051E-01
+ PKER_SDRYG( 35, 68) = 0.280497E-01
+ PKER_SDRYG( 35, 69) = 0.254855E-01
+ PKER_SDRYG( 35, 70) = 0.230970E-01
+ PKER_SDRYG( 35, 71) = 0.208713E-01
+ PKER_SDRYG( 35, 72) = 0.187982E-01
+ PKER_SDRYG( 35, 73) = 0.168703E-01
+ PKER_SDRYG( 35, 74) = 0.150815E-01
+ PKER_SDRYG( 35, 75) = 0.134288E-01
+ PKER_SDRYG( 35, 76) = 0.119116E-01
+ PKER_SDRYG( 35, 77) = 0.105294E-01
+ PKER_SDRYG( 35, 78) = 0.928417E-02
+ PKER_SDRYG( 35, 79) = 0.817987E-02
+ PKER_SDRYG( 35, 80) = 0.721421E-02
+ PKER_SDRYG( 36, 1) = 0.321230E+01
+ PKER_SDRYG( 36, 2) = 0.301593E+01
+ PKER_SDRYG( 36, 3) = 0.283155E+01
+ PKER_SDRYG( 36, 4) = 0.265842E+01
+ PKER_SDRYG( 36, 5) = 0.249585E+01
+ PKER_SDRYG( 36, 6) = 0.234320E+01
+ PKER_SDRYG( 36, 7) = 0.219987E+01
+ PKER_SDRYG( 36, 8) = 0.206528E+01
+ PKER_SDRYG( 36, 9) = 0.193890E+01
+ PKER_SDRYG( 36, 10) = 0.182024E+01
+ PKER_SDRYG( 36, 11) = 0.170881E+01
+ PKER_SDRYG( 36, 12) = 0.160418E+01
+ PKER_SDRYG( 36, 13) = 0.150594E+01
+ PKER_SDRYG( 36, 14) = 0.141369E+01
+ PKER_SDRYG( 36, 15) = 0.132707E+01
+ PKER_SDRYG( 36, 16) = 0.124573E+01
+ PKER_SDRYG( 36, 17) = 0.116936E+01
+ PKER_SDRYG( 36, 18) = 0.109764E+01
+ PKER_SDRYG( 36, 19) = 0.103030E+01
+ PKER_SDRYG( 36, 20) = 0.967073E+00
+ PKER_SDRYG( 36, 21) = 0.907699E+00
+ PKER_SDRYG( 36, 22) = 0.851947E+00
+ PKER_SDRYG( 36, 23) = 0.799595E+00
+ PKER_SDRYG( 36, 24) = 0.750436E+00
+ PKER_SDRYG( 36, 25) = 0.704275E+00
+ PKER_SDRYG( 36, 26) = 0.660928E+00
+ PKER_SDRYG( 36, 27) = 0.620224E+00
+ PKER_SDRYG( 36, 28) = 0.582000E+00
+ PKER_SDRYG( 36, 29) = 0.546105E+00
+ PKER_SDRYG( 36, 30) = 0.512396E+00
+ PKER_SDRYG( 36, 31) = 0.480738E+00
+ PKER_SDRYG( 36, 32) = 0.451006E+00
+ PKER_SDRYG( 36, 33) = 0.423081E+00
+ PKER_SDRYG( 36, 34) = 0.396851E+00
+ PKER_SDRYG( 36, 35) = 0.372212E+00
+ PKER_SDRYG( 36, 36) = 0.349063E+00
+ PKER_SDRYG( 36, 37) = 0.327311E+00
+ PKER_SDRYG( 36, 38) = 0.306869E+00
+ PKER_SDRYG( 36, 39) = 0.287653E+00
+ PKER_SDRYG( 36, 40) = 0.269582E+00
+ PKER_SDRYG( 36, 41) = 0.252583E+00
+ PKER_SDRYG( 36, 42) = 0.236584E+00
+ PKER_SDRYG( 36, 43) = 0.221515E+00
+ PKER_SDRYG( 36, 44) = 0.207311E+00
+ PKER_SDRYG( 36, 45) = 0.193907E+00
+ PKER_SDRYG( 36, 46) = 0.181243E+00
+ PKER_SDRYG( 36, 47) = 0.169258E+00
+ PKER_SDRYG( 36, 48) = 0.157896E+00
+ PKER_SDRYG( 36, 49) = 0.147102E+00
+ PKER_SDRYG( 36, 50) = 0.136828E+00
+ PKER_SDRYG( 36, 51) = 0.127035E+00
+ PKER_SDRYG( 36, 52) = 0.117693E+00
+ PKER_SDRYG( 36, 53) = 0.108790E+00
+ PKER_SDRYG( 36, 54) = 0.100330E+00
+ PKER_SDRYG( 36, 55) = 0.923315E-01
+ PKER_SDRYG( 36, 56) = 0.848218E-01
+ PKER_SDRYG( 36, 57) = 0.778261E-01
+ PKER_SDRYG( 36, 58) = 0.713586E-01
+ PKER_SDRYG( 36, 59) = 0.654162E-01
+ PKER_SDRYG( 36, 60) = 0.599783E-01
+ PKER_SDRYG( 36, 61) = 0.550109E-01
+ PKER_SDRYG( 36, 62) = 0.504721E-01
+ PKER_SDRYG( 36, 63) = 0.463179E-01
+ PKER_SDRYG( 36, 64) = 0.425060E-01
+ PKER_SDRYG( 36, 65) = 0.389979E-01
+ PKER_SDRYG( 36, 66) = 0.357599E-01
+ PKER_SDRYG( 36, 67) = 0.327630E-01
+ PKER_SDRYG( 36, 68) = 0.299825E-01
+ PKER_SDRYG( 36, 69) = 0.273977E-01
+ PKER_SDRYG( 36, 70) = 0.249908E-01
+ PKER_SDRYG( 36, 71) = 0.227467E-01
+ PKER_SDRYG( 36, 72) = 0.206528E-01
+ PKER_SDRYG( 36, 73) = 0.186985E-01
+ PKER_SDRYG( 36, 74) = 0.168752E-01
+ PKER_SDRYG( 36, 75) = 0.151760E-01
+ PKER_SDRYG( 36, 76) = 0.135960E-01
+ PKER_SDRYG( 36, 77) = 0.121320E-01
+ PKER_SDRYG( 36, 78) = 0.107828E-01
+ PKER_SDRYG( 36, 79) = 0.954776E-02
+ PKER_SDRYG( 36, 80) = 0.842894E-02
+ PKER_SDRYG( 37, 1) = 0.321315E+01
+ PKER_SDRYG( 37, 2) = 0.301679E+01
+ PKER_SDRYG( 37, 3) = 0.283241E+01
+ PKER_SDRYG( 37, 4) = 0.265928E+01
+ PKER_SDRYG( 37, 5) = 0.249671E+01
+ PKER_SDRYG( 37, 6) = 0.234406E+01
+ PKER_SDRYG( 37, 7) = 0.220072E+01
+ PKER_SDRYG( 37, 8) = 0.206614E+01
+ PKER_SDRYG( 37, 9) = 0.193976E+01
+ PKER_SDRYG( 37, 10) = 0.182109E+01
+ PKER_SDRYG( 37, 11) = 0.170967E+01
+ PKER_SDRYG( 37, 12) = 0.160504E+01
+ PKER_SDRYG( 37, 13) = 0.150680E+01
+ PKER_SDRYG( 37, 14) = 0.141455E+01
+ PKER_SDRYG( 37, 15) = 0.132793E+01
+ PKER_SDRYG( 37, 16) = 0.124659E+01
+ PKER_SDRYG( 37, 17) = 0.117022E+01
+ PKER_SDRYG( 37, 18) = 0.109850E+01
+ PKER_SDRYG( 37, 19) = 0.103116E+01
+ PKER_SDRYG( 37, 20) = 0.967933E+00
+ PKER_SDRYG( 37, 21) = 0.908560E+00
+ PKER_SDRYG( 37, 22) = 0.852809E+00
+ PKER_SDRYG( 37, 23) = 0.800458E+00
+ PKER_SDRYG( 37, 24) = 0.751301E+00
+ PKER_SDRYG( 37, 25) = 0.705142E+00
+ PKER_SDRYG( 37, 26) = 0.661797E+00
+ PKER_SDRYG( 37, 27) = 0.621095E+00
+ PKER_SDRYG( 37, 28) = 0.582874E+00
+ PKER_SDRYG( 37, 29) = 0.546983E+00
+ PKER_SDRYG( 37, 30) = 0.513278E+00
+ PKER_SDRYG( 37, 31) = 0.481626E+00
+ PKER_SDRYG( 37, 32) = 0.451901E+00
+ PKER_SDRYG( 37, 33) = 0.423983E+00
+ PKER_SDRYG( 37, 34) = 0.397762E+00
+ PKER_SDRYG( 37, 35) = 0.373134E+00
+ PKER_SDRYG( 37, 36) = 0.349998E+00
+ PKER_SDRYG( 37, 37) = 0.328262E+00
+ PKER_SDRYG( 37, 38) = 0.307839E+00
+ PKER_SDRYG( 37, 39) = 0.288645E+00
+ PKER_SDRYG( 37, 40) = 0.270603E+00
+ PKER_SDRYG( 37, 41) = 0.253637E+00
+ PKER_SDRYG( 37, 42) = 0.237677E+00
+ PKER_SDRYG( 37, 43) = 0.222657E+00
+ PKER_SDRYG( 37, 44) = 0.208511E+00
+ PKER_SDRYG( 37, 45) = 0.195178E+00
+ PKER_SDRYG( 37, 46) = 0.182599E+00
+ PKER_SDRYG( 37, 47) = 0.170714E+00
+ PKER_SDRYG( 37, 48) = 0.159470E+00
+ PKER_SDRYG( 37, 49) = 0.148812E+00
+ PKER_SDRYG( 37, 50) = 0.138690E+00
+ PKER_SDRYG( 37, 51) = 0.129060E+00
+ PKER_SDRYG( 37, 52) = 0.119883E+00
+ PKER_SDRYG( 37, 53) = 0.111134E+00
+ PKER_SDRYG( 37, 54) = 0.102800E+00
+ PKER_SDRYG( 37, 55) = 0.948842E-01
+ PKER_SDRYG( 37, 56) = 0.874029E-01
+ PKER_SDRYG( 37, 57) = 0.803806E-01
+ PKER_SDRYG( 37, 58) = 0.738398E-01
+ PKER_SDRYG( 37, 59) = 0.677928E-01
+ PKER_SDRYG( 37, 60) = 0.622361E-01
+ PKER_SDRYG( 37, 61) = 0.571501E-01
+ PKER_SDRYG( 37, 62) = 0.525027E-01
+ PKER_SDRYG( 37, 63) = 0.482549E-01
+ PKER_SDRYG( 37, 64) = 0.443658E-01
+ PKER_SDRYG( 37, 65) = 0.407958E-01
+ PKER_SDRYG( 37, 66) = 0.375092E-01
+ PKER_SDRYG( 37, 67) = 0.344748E-01
+ PKER_SDRYG( 37, 68) = 0.316655E-01
+ PKER_SDRYG( 37, 69) = 0.290583E-01
+ PKER_SDRYG( 37, 70) = 0.266339E-01
+ PKER_SDRYG( 37, 71) = 0.243755E-01
+ PKER_SDRYG( 37, 72) = 0.222689E-01
+ PKER_SDRYG( 37, 73) = 0.203019E-01
+ PKER_SDRYG( 37, 74) = 0.184641E-01
+ PKER_SDRYG( 37, 75) = 0.167467E-01
+ PKER_SDRYG( 37, 76) = 0.151420E-01
+ PKER_SDRYG( 37, 77) = 0.136442E-01
+ PKER_SDRYG( 37, 78) = 0.122492E-01
+ PKER_SDRYG( 37, 79) = 0.109531E-01
+ PKER_SDRYG( 37, 80) = 0.975456E-02
+ PKER_SDRYG( 38, 1) = 0.321388E+01
+ PKER_SDRYG( 38, 2) = 0.301752E+01
+ PKER_SDRYG( 38, 3) = 0.283314E+01
+ PKER_SDRYG( 38, 4) = 0.266001E+01
+ PKER_SDRYG( 38, 5) = 0.249744E+01
+ PKER_SDRYG( 38, 6) = 0.234479E+01
+ PKER_SDRYG( 38, 7) = 0.220146E+01
+ PKER_SDRYG( 38, 8) = 0.206687E+01
+ PKER_SDRYG( 38, 9) = 0.194049E+01
+ PKER_SDRYG( 38, 10) = 0.182182E+01
+ PKER_SDRYG( 38, 11) = 0.171040E+01
+ PKER_SDRYG( 38, 12) = 0.160577E+01
+ PKER_SDRYG( 38, 13) = 0.150753E+01
+ PKER_SDRYG( 38, 14) = 0.141528E+01
+ PKER_SDRYG( 38, 15) = 0.132866E+01
+ PKER_SDRYG( 38, 16) = 0.124732E+01
+ PKER_SDRYG( 38, 17) = 0.117095E+01
+ PKER_SDRYG( 38, 18) = 0.109924E+01
+ PKER_SDRYG( 38, 19) = 0.103190E+01
+ PKER_SDRYG( 38, 20) = 0.968669E+00
+ PKER_SDRYG( 38, 21) = 0.909296E+00
+ PKER_SDRYG( 38, 22) = 0.853546E+00
+ PKER_SDRYG( 38, 23) = 0.801197E+00
+ PKER_SDRYG( 38, 24) = 0.752040E+00
+ PKER_SDRYG( 38, 25) = 0.705882E+00
+ PKER_SDRYG( 38, 26) = 0.662539E+00
+ PKER_SDRYG( 38, 27) = 0.621840E+00
+ PKER_SDRYG( 38, 28) = 0.583621E+00
+ PKER_SDRYG( 38, 29) = 0.547733E+00
+ PKER_SDRYG( 38, 30) = 0.514032E+00
+ PKER_SDRYG( 38, 31) = 0.482384E+00
+ PKER_SDRYG( 38, 32) = 0.452663E+00
+ PKER_SDRYG( 38, 33) = 0.424751E+00
+ PKER_SDRYG( 38, 34) = 0.398537E+00
+ PKER_SDRYG( 38, 35) = 0.373917E+00
+ PKER_SDRYG( 38, 36) = 0.350791E+00
+ PKER_SDRYG( 38, 37) = 0.329068E+00
+ PKER_SDRYG( 38, 38) = 0.308659E+00
+ PKER_SDRYG( 38, 39) = 0.289483E+00
+ PKER_SDRYG( 38, 40) = 0.271461E+00
+ PKER_SDRYG( 38, 41) = 0.254521E+00
+ PKER_SDRYG( 38, 42) = 0.238592E+00
+ PKER_SDRYG( 38, 43) = 0.223608E+00
+ PKER_SDRYG( 38, 44) = 0.209507E+00
+ PKER_SDRYG( 38, 45) = 0.196227E+00
+ PKER_SDRYG( 38, 46) = 0.183712E+00
+ PKER_SDRYG( 38, 47) = 0.171905E+00
+ PKER_SDRYG( 38, 48) = 0.160752E+00
+ PKER_SDRYG( 38, 49) = 0.150201E+00
+ PKER_SDRYG( 38, 50) = 0.140203E+00
+ PKER_SDRYG( 38, 51) = 0.130711E+00
+ PKER_SDRYG( 38, 52) = 0.121682E+00
+ PKER_SDRYG( 38, 53) = 0.113083E+00
+ PKER_SDRYG( 38, 54) = 0.104887E+00
+ PKER_SDRYG( 38, 55) = 0.970832E-01
+ PKER_SDRYG( 38, 56) = 0.896740E-01
+ PKER_SDRYG( 38, 57) = 0.826740E-01
+ PKER_SDRYG( 38, 58) = 0.761051E-01
+ PKER_SDRYG( 38, 59) = 0.699873E-01
+ PKER_SDRYG( 38, 60) = 0.643313E-01
+ PKER_SDRYG( 38, 61) = 0.591334E-01
+ PKER_SDRYG( 38, 62) = 0.543747E-01
+ PKER_SDRYG( 38, 63) = 0.500254E-01
+ PKER_SDRYG( 38, 64) = 0.460488E-01
+ PKER_SDRYG( 38, 65) = 0.424067E-01
+ PKER_SDRYG( 38, 66) = 0.390625E-01
+ PKER_SDRYG( 38, 67) = 0.359829E-01
+ PKER_SDRYG( 38, 68) = 0.331387E-01
+ PKER_SDRYG( 38, 69) = 0.305049E-01
+ PKER_SDRYG( 38, 70) = 0.280601E-01
+ PKER_SDRYG( 38, 71) = 0.257861E-01
+ PKER_SDRYG( 38, 72) = 0.236673E-01
+ PKER_SDRYG( 38, 73) = 0.216904E-01
+ PKER_SDRYG( 38, 74) = 0.198439E-01
+ PKER_SDRYG( 38, 75) = 0.181177E-01
+ PKER_SDRYG( 38, 76) = 0.165031E-01
+ PKER_SDRYG( 38, 77) = 0.149927E-01
+ PKER_SDRYG( 38, 78) = 0.135800E-01
+ PKER_SDRYG( 38, 79) = 0.122598E-01
+ PKER_SDRYG( 38, 80) = 0.110278E-01
+ PKER_SDRYG( 39, 1) = 0.321451E+01
+ PKER_SDRYG( 39, 2) = 0.301815E+01
+ PKER_SDRYG( 39, 3) = 0.283377E+01
+ PKER_SDRYG( 39, 4) = 0.266063E+01
+ PKER_SDRYG( 39, 5) = 0.249807E+01
+ PKER_SDRYG( 39, 6) = 0.234542E+01
+ PKER_SDRYG( 39, 7) = 0.220208E+01
+ PKER_SDRYG( 39, 8) = 0.206749E+01
+ PKER_SDRYG( 39, 9) = 0.194112E+01
+ PKER_SDRYG( 39, 10) = 0.182245E+01
+ PKER_SDRYG( 39, 11) = 0.171103E+01
+ PKER_SDRYG( 39, 12) = 0.160640E+01
+ PKER_SDRYG( 39, 13) = 0.150816E+01
+ PKER_SDRYG( 39, 14) = 0.141591E+01
+ PKER_SDRYG( 39, 15) = 0.132929E+01
+ PKER_SDRYG( 39, 16) = 0.124795E+01
+ PKER_SDRYG( 39, 17) = 0.117158E+01
+ PKER_SDRYG( 39, 18) = 0.109987E+01
+ PKER_SDRYG( 39, 19) = 0.103253E+01
+ PKER_SDRYG( 39, 20) = 0.969298E+00
+ PKER_SDRYG( 39, 21) = 0.909926E+00
+ PKER_SDRYG( 39, 22) = 0.854176E+00
+ PKER_SDRYG( 39, 23) = 0.801828E+00
+ PKER_SDRYG( 39, 24) = 0.752672E+00
+ PKER_SDRYG( 39, 25) = 0.706516E+00
+ PKER_SDRYG( 39, 26) = 0.663174E+00
+ PKER_SDRYG( 39, 27) = 0.622476E+00
+ PKER_SDRYG( 39, 28) = 0.584259E+00
+ PKER_SDRYG( 39, 29) = 0.548373E+00
+ PKER_SDRYG( 39, 30) = 0.514674E+00
+ PKER_SDRYG( 39, 31) = 0.483030E+00
+ PKER_SDRYG( 39, 32) = 0.453313E+00
+ PKER_SDRYG( 39, 33) = 0.425406E+00
+ PKER_SDRYG( 39, 34) = 0.399197E+00
+ PKER_SDRYG( 39, 35) = 0.374583E+00
+ PKER_SDRYG( 39, 36) = 0.351465E+00
+ PKER_SDRYG( 39, 37) = 0.329751E+00
+ PKER_SDRYG( 39, 38) = 0.309353E+00
+ PKER_SDRYG( 39, 39) = 0.290190E+00
+ PKER_SDRYG( 39, 40) = 0.272185E+00
+ PKER_SDRYG( 39, 41) = 0.255264E+00
+ PKER_SDRYG( 39, 42) = 0.239358E+00
+ PKER_SDRYG( 39, 43) = 0.224402E+00
+ PKER_SDRYG( 39, 44) = 0.210335E+00
+ PKER_SDRYG( 39, 45) = 0.197096E+00
+ PKER_SDRYG( 39, 46) = 0.184630E+00
+ PKER_SDRYG( 39, 47) = 0.172881E+00
+ PKER_SDRYG( 39, 48) = 0.161799E+00
+ PKER_SDRYG( 39, 49) = 0.151332E+00
+ PKER_SDRYG( 39, 50) = 0.141432E+00
+ PKER_SDRYG( 39, 51) = 0.132052E+00
+ PKER_SDRYG( 39, 52) = 0.123149E+00
+ PKER_SDRYG( 39, 53) = 0.114684E+00
+ PKER_SDRYG( 39, 54) = 0.106623E+00
+ PKER_SDRYG( 39, 55) = 0.989442E-01
+ PKER_SDRYG( 39, 56) = 0.916356E-01
+ PKER_SDRYG( 39, 57) = 0.846988E-01
+ PKER_SDRYG( 39, 58) = 0.781472E-01
+ PKER_SDRYG( 39, 59) = 0.720003E-01
+ PKER_SDRYG( 39, 60) = 0.662762E-01
+ PKER_SDRYG( 39, 61) = 0.609842E-01
+ PKER_SDRYG( 39, 62) = 0.561201E-01
+ PKER_SDRYG( 39, 63) = 0.516663E-01
+ PKER_SDRYG( 39, 64) = 0.475946E-01
+ PKER_SDRYG( 39, 65) = 0.438709E-01
+ PKER_SDRYG( 39, 66) = 0.404594E-01
+ PKER_SDRYG( 39, 67) = 0.373260E-01
+ PKER_SDRYG( 39, 68) = 0.344398E-01
+ PKER_SDRYG( 39, 69) = 0.317735E-01
+ PKER_SDRYG( 39, 70) = 0.293039E-01
+ PKER_SDRYG( 39, 71) = 0.270111E-01
+ PKER_SDRYG( 39, 72) = 0.248780E-01
+ PKER_SDRYG( 39, 73) = 0.228902E-01
+ PKER_SDRYG( 39, 74) = 0.210352E-01
+ PKER_SDRYG( 39, 75) = 0.193021E-01
+ PKER_SDRYG( 39, 76) = 0.176816E-01
+ PKER_SDRYG( 39, 77) = 0.161652E-01
+ PKER_SDRYG( 39, 78) = 0.147457E-01
+ PKER_SDRYG( 39, 79) = 0.134166E-01
+ PKER_SDRYG( 39, 80) = 0.121725E-01
+ PKER_SDRYG( 40, 1) = 0.321505E+01
+ PKER_SDRYG( 40, 2) = 0.301868E+01
+ PKER_SDRYG( 40, 3) = 0.283430E+01
+ PKER_SDRYG( 40, 4) = 0.266117E+01
+ PKER_SDRYG( 40, 5) = 0.249860E+01
+ PKER_SDRYG( 40, 6) = 0.234595E+01
+ PKER_SDRYG( 40, 7) = 0.220262E+01
+ PKER_SDRYG( 40, 8) = 0.206803E+01
+ PKER_SDRYG( 40, 9) = 0.194165E+01
+ PKER_SDRYG( 40, 10) = 0.182299E+01
+ PKER_SDRYG( 40, 11) = 0.171156E+01
+ PKER_SDRYG( 40, 12) = 0.160694E+01
+ PKER_SDRYG( 40, 13) = 0.150869E+01
+ PKER_SDRYG( 40, 14) = 0.141644E+01
+ PKER_SDRYG( 40, 15) = 0.132982E+01
+ PKER_SDRYG( 40, 16) = 0.124849E+01
+ PKER_SDRYG( 40, 17) = 0.117212E+01
+ PKER_SDRYG( 40, 18) = 0.110040E+01
+ PKER_SDRYG( 40, 19) = 0.103307E+01
+ PKER_SDRYG( 40, 20) = 0.969836E+00
+ PKER_SDRYG( 40, 21) = 0.910465E+00
+ PKER_SDRYG( 40, 22) = 0.854716E+00
+ PKER_SDRYG( 40, 23) = 0.802368E+00
+ PKER_SDRYG( 40, 24) = 0.753213E+00
+ PKER_SDRYG( 40, 25) = 0.707057E+00
+ PKER_SDRYG( 40, 26) = 0.663716E+00
+ PKER_SDRYG( 40, 27) = 0.623019E+00
+ PKER_SDRYG( 40, 28) = 0.584804E+00
+ PKER_SDRYG( 40, 29) = 0.548920E+00
+ PKER_SDRYG( 40, 30) = 0.515223E+00
+ PKER_SDRYG( 40, 31) = 0.483581E+00
+ PKER_SDRYG( 40, 32) = 0.453867E+00
+ PKER_SDRYG( 40, 33) = 0.425963E+00
+ PKER_SDRYG( 40, 34) = 0.399759E+00
+ PKER_SDRYG( 40, 35) = 0.375150E+00
+ PKER_SDRYG( 40, 36) = 0.352038E+00
+ PKER_SDRYG( 40, 37) = 0.330331E+00
+ PKER_SDRYG( 40, 38) = 0.309942E+00
+ PKER_SDRYG( 40, 39) = 0.290789E+00
+ PKER_SDRYG( 40, 40) = 0.272796E+00
+ PKER_SDRYG( 40, 41) = 0.255890E+00
+ PKER_SDRYG( 40, 42) = 0.240002E+00
+ PKER_SDRYG( 40, 43) = 0.225068E+00
+ PKER_SDRYG( 40, 44) = 0.211026E+00
+ PKER_SDRYG( 40, 45) = 0.197818E+00
+ PKER_SDRYG( 40, 46) = 0.185389E+00
+ PKER_SDRYG( 40, 47) = 0.173686E+00
+ PKER_SDRYG( 40, 48) = 0.162657E+00
+ PKER_SDRYG( 40, 49) = 0.152255E+00
+ PKER_SDRYG( 40, 50) = 0.142431E+00
+ PKER_SDRYG( 40, 51) = 0.133141E+00
+ PKER_SDRYG( 40, 52) = 0.124340E+00
+ PKER_SDRYG( 40, 53) = 0.115989E+00
+ PKER_SDRYG( 40, 54) = 0.108051E+00
+ PKER_SDRYG( 40, 55) = 0.100495E+00
+ PKER_SDRYG( 40, 56) = 0.932989E-01
+ PKER_SDRYG( 40, 57) = 0.864523E-01
+ PKER_SDRYG( 40, 58) = 0.799563E-01
+ PKER_SDRYG( 40, 59) = 0.738226E-01
+ PKER_SDRYG( 40, 60) = 0.680689E-01
+ PKER_SDRYG( 40, 61) = 0.627114E-01
+ PKER_SDRYG( 40, 62) = 0.577583E-01
+ PKER_SDRYG( 40, 63) = 0.532053E-01
+ PKER_SDRYG( 40, 64) = 0.490356E-01
+ PKER_SDRYG( 40, 65) = 0.452228E-01
+ PKER_SDRYG( 40, 66) = 0.417349E-01
+ PKER_SDRYG( 40, 67) = 0.385386E-01
+ PKER_SDRYG( 40, 68) = 0.356022E-01
+ PKER_SDRYG( 40, 69) = 0.328967E-01
+ PKER_SDRYG( 40, 70) = 0.303969E-01
+ PKER_SDRYG( 40, 71) = 0.280809E-01
+ PKER_SDRYG( 40, 72) = 0.259303E-01
+ PKER_SDRYG( 40, 73) = 0.239293E-01
+ PKER_SDRYG( 40, 74) = 0.220643E-01
+ PKER_SDRYG( 40, 75) = 0.203236E-01
+ PKER_SDRYG( 40, 76) = 0.186972E-01
+ PKER_SDRYG( 40, 77) = 0.171761E-01
+ PKER_SDRYG( 40, 78) = 0.157525E-01
+ PKER_SDRYG( 40, 79) = 0.144193E-01
+ PKER_SDRYG( 40, 80) = 0.131706E-01
+END IF
+!
+END SUBROUTINE READ_XKER_SDRYG
diff --git a/src/mesonh/micro/read_xker_sweth.f90 b/src/mesonh/micro/read_xker_sweth.f90
new file mode 100644
index 000000000..52d9df6a7
--- /dev/null
+++ b/src/mesonh/micro/read_xker_sweth.f90
@@ -0,0 +1,3337 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 microph 2006/05/18 13:07:25
+!-----------------------------------------------------------------
+! ###########################
+ MODULE MODI_READ_XKER_SWETH
+! ###########################
+!
+INTERFACE
+ SUBROUTINE READ_XKER_SWETH (KWETLBDAH,KWETLBDAS,KND, &
+ PALPHAH,PNUH,PALPHAS,PNUS,PEHS,PBS,PCH,PDH,PCS,PDS, &
+ PWETLBDAH_MAX,PWETLBDAS_MAX,PWETLBDAH_MIN,PWETLBDAS_MIN, &
+ PFDINFTY,PKER_SWETH )
+!
+INTEGER, INTENT(OUT) :: KND,KWETLBDAH,KWETLBDAS
+REAL, INTENT(OUT) :: PALPHAH
+REAL, INTENT(OUT) :: PNUH
+REAL, INTENT(OUT) :: PALPHAS
+REAL, INTENT(OUT) :: PNUS
+REAL, INTENT(OUT) :: PEHS
+REAL, INTENT(OUT) :: PBS
+REAL, INTENT(OUT) :: PCH
+REAL, INTENT(OUT) :: PDH
+REAL, INTENT(OUT) :: PCS
+REAL, INTENT(OUT) :: PDS
+REAL, INTENT(OUT) :: PWETLBDAH_MAX
+REAL, INTENT(OUT) :: PWETLBDAS_MAX
+REAL, INTENT(OUT) :: PWETLBDAH_MIN
+REAL, INTENT(OUT) :: PWETLBDAS_MIN
+REAL, INTENT(OUT) :: PFDINFTY
+REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_SWETH
+!
+END SUBROUTINE
+!
+END INTERFACE
+!
+END MODULE MODI_READ_XKER_SWETH
+! ########################################################################
+ SUBROUTINE READ_XKER_SWETH (KWETLBDAH,KWETLBDAS,KND, &
+ PALPHAH,PNUH,PALPHAS,PNUS,PEHS,PBS,PCH,PDH,PCS,PDS, &
+ PWETLBDAH_MAX,PWETLBDAS_MAX,PWETLBDAH_MIN,PWETLBDAS_MIN, &
+ PFDINFTY,PKER_SWETH )
+! ########################################################################
+!
+!!**** * * - initialize the kernels for the snow-hail wet growth process
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to initialize the kernels PKER_SWETH
+!! prepared from a previous run of the routine INI_RAIN_ICE. The reading
+!! of the kernels is optional after checking for the dimensions of the
+!! arrays.
+!!
+!!** METHOD
+!! ------
+!!
+!!
+!! EXTERNAL
+!! --------
+!! None
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation ( routine READ_XKER_SWETH )
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 19/04/97
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!* 0.2 Declarations of local variables :
+!
+!
+INTEGER, INTENT(OUT) :: KND,KWETLBDAH,KWETLBDAS
+REAL, INTENT(OUT) :: PALPHAH
+REAL, INTENT(OUT) :: PNUH
+REAL, INTENT(OUT) :: PALPHAS
+REAL, INTENT(OUT) :: PNUS
+REAL, INTENT(OUT) :: PEHS
+REAL, INTENT(OUT) :: PBS
+REAL, INTENT(OUT) :: PCH
+REAL, INTENT(OUT) :: PDH
+REAL, INTENT(OUT) :: PCS
+REAL, INTENT(OUT) :: PDS
+REAL, INTENT(OUT) :: PWETLBDAH_MAX
+REAL, INTENT(OUT) :: PWETLBDAS_MAX
+REAL, INTENT(OUT) :: PWETLBDAH_MIN
+REAL, INTENT(OUT) :: PWETLBDAS_MIN
+REAL, INTENT(OUT) :: PFDINFTY
+REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_SWETH
+!
+! ########################################################################
+! #INSERT HERE THE OUTPUT OF INI_RAIN_ICE_HAIL IF THE KERNELS ARE UPDATED#
+! ########################################################################
+!
+KND= 50
+KWETLBDAH= 40
+KWETLBDAS= 80
+PALPHAH= 0.100000E+01
+PNUH= 0.800000E+01
+PALPHAS= 0.100000E+01
+PNUS= 0.100000E+01
+PEHS= 0.100000E+01
+PBS= 0.190000E+01
+PCH= 0.207000E+03
+PDH= 0.640000E+00
+PCS= 0.510000E+01
+PDS= 0.270000E+00
+PWETLBDAH_MAX= 0.100000E+08
+PWETLBDAS_MAX= 0.250000E+10
+PWETLBDAH_MIN= 0.100000E+04
+PWETLBDAS_MIN= 0.250000E+02
+PFDINFTY= 0.200000E+02
+!
+IF( PRESENT(PKER_SWETH) ) THEN
+ PKER_SWETH( 1, 1) = 0.615237E+01
+ PKER_SWETH( 1, 2) = 0.637080E+01
+ PKER_SWETH( 1, 3) = 0.658231E+01
+ PKER_SWETH( 1, 4) = 0.678858E+01
+ PKER_SWETH( 1, 5) = 0.699129E+01
+ PKER_SWETH( 1, 6) = 0.719213E+01
+ PKER_SWETH( 1, 7) = 0.739259E+01
+ PKER_SWETH( 1, 8) = 0.759386E+01
+ PKER_SWETH( 1, 9) = 0.779656E+01
+ PKER_SWETH( 1, 10) = 0.800053E+01
+ PKER_SWETH( 1, 11) = 0.820465E+01
+ PKER_SWETH( 1, 12) = 0.840686E+01
+ PKER_SWETH( 1, 13) = 0.860429E+01
+ PKER_SWETH( 1, 14) = 0.879377E+01
+ PKER_SWETH( 1, 15) = 0.897226E+01
+ PKER_SWETH( 1, 16) = 0.913741E+01
+ PKER_SWETH( 1, 17) = 0.928778E+01
+ PKER_SWETH( 1, 18) = 0.942293E+01
+ PKER_SWETH( 1, 19) = 0.954325E+01
+ PKER_SWETH( 1, 20) = 0.964973E+01
+ PKER_SWETH( 1, 21) = 0.974368E+01
+ PKER_SWETH( 1, 22) = 0.982656E+01
+ PKER_SWETH( 1, 23) = 0.989979E+01
+ PKER_SWETH( 1, 24) = 0.996470E+01
+ PKER_SWETH( 1, 25) = 0.100225E+02
+ PKER_SWETH( 1, 26) = 0.100741E+02
+ PKER_SWETH( 1, 27) = 0.101205E+02
+ PKER_SWETH( 1, 28) = 0.101624E+02
+ PKER_SWETH( 1, 29) = 0.102004E+02
+ PKER_SWETH( 1, 30) = 0.102350E+02
+ PKER_SWETH( 1, 31) = 0.102667E+02
+ PKER_SWETH( 1, 32) = 0.102957E+02
+ PKER_SWETH( 1, 33) = 0.103224E+02
+ PKER_SWETH( 1, 34) = 0.103471E+02
+ PKER_SWETH( 1, 35) = 0.103699E+02
+ PKER_SWETH( 1, 36) = 0.103911E+02
+ PKER_SWETH( 1, 37) = 0.104108E+02
+ PKER_SWETH( 1, 38) = 0.104291E+02
+ PKER_SWETH( 1, 39) = 0.104461E+02
+ PKER_SWETH( 1, 40) = 0.104620E+02
+ PKER_SWETH( 1, 41) = 0.104769E+02
+ PKER_SWETH( 1, 42) = 0.104908E+02
+ PKER_SWETH( 1, 43) = 0.105038E+02
+ PKER_SWETH( 1, 44) = 0.105159E+02
+ PKER_SWETH( 1, 45) = 0.105273E+02
+ PKER_SWETH( 1, 46) = 0.105380E+02
+ PKER_SWETH( 1, 47) = 0.105480E+02
+ PKER_SWETH( 1, 48) = 0.105573E+02
+ PKER_SWETH( 1, 49) = 0.105661E+02
+ PKER_SWETH( 1, 50) = 0.105744E+02
+ PKER_SWETH( 1, 51) = 0.105821E+02
+ PKER_SWETH( 1, 52) = 0.105893E+02
+ PKER_SWETH( 1, 53) = 0.105961E+02
+ PKER_SWETH( 1, 54) = 0.106025E+02
+ PKER_SWETH( 1, 55) = 0.106085E+02
+ PKER_SWETH( 1, 56) = 0.106141E+02
+ PKER_SWETH( 1, 57) = 0.106194E+02
+ PKER_SWETH( 1, 58) = 0.106244E+02
+ PKER_SWETH( 1, 59) = 0.106290E+02
+ PKER_SWETH( 1, 60) = 0.106334E+02
+ PKER_SWETH( 1, 61) = 0.106375E+02
+ PKER_SWETH( 1, 62) = 0.106413E+02
+ PKER_SWETH( 1, 63) = 0.106450E+02
+ PKER_SWETH( 1, 64) = 0.106483E+02
+ PKER_SWETH( 1, 65) = 0.106515E+02
+ PKER_SWETH( 1, 66) = 0.106545E+02
+ PKER_SWETH( 1, 67) = 0.106573E+02
+ PKER_SWETH( 1, 68) = 0.106600E+02
+ PKER_SWETH( 1, 69) = 0.106624E+02
+ PKER_SWETH( 1, 70) = 0.106648E+02
+ PKER_SWETH( 1, 71) = 0.106669E+02
+ PKER_SWETH( 1, 72) = 0.106690E+02
+ PKER_SWETH( 1, 73) = 0.106709E+02
+ PKER_SWETH( 1, 74) = 0.106727E+02
+ PKER_SWETH( 1, 75) = 0.106744E+02
+ PKER_SWETH( 1, 76) = 0.106760E+02
+ PKER_SWETH( 1, 77) = 0.106775E+02
+ PKER_SWETH( 1, 78) = 0.106789E+02
+ PKER_SWETH( 1, 79) = 0.106802E+02
+ PKER_SWETH( 1, 80) = 0.106815E+02
+ PKER_SWETH( 2, 1) = 0.482432E+01
+ PKER_SWETH( 2, 2) = 0.503595E+01
+ PKER_SWETH( 2, 3) = 0.523941E+01
+ PKER_SWETH( 2, 4) = 0.543608E+01
+ PKER_SWETH( 2, 5) = 0.562743E+01
+ PKER_SWETH( 2, 6) = 0.581495E+01
+ PKER_SWETH( 2, 7) = 0.600013E+01
+ PKER_SWETH( 2, 8) = 0.618431E+01
+ PKER_SWETH( 2, 9) = 0.636855E+01
+ PKER_SWETH( 2, 10) = 0.655341E+01
+ PKER_SWETH( 2, 11) = 0.673880E+01
+ PKER_SWETH( 2, 12) = 0.692377E+01
+ PKER_SWETH( 2, 13) = 0.710655E+01
+ PKER_SWETH( 2, 14) = 0.728471E+01
+ PKER_SWETH( 2, 15) = 0.745548E+01
+ PKER_SWETH( 2, 16) = 0.761628E+01
+ PKER_SWETH( 2, 17) = 0.776507E+01
+ PKER_SWETH( 2, 18) = 0.790065E+01
+ PKER_SWETH( 2, 19) = 0.802264E+01
+ PKER_SWETH( 2, 20) = 0.813143E+01
+ PKER_SWETH( 2, 21) = 0.822788E+01
+ PKER_SWETH( 2, 22) = 0.831318E+01
+ PKER_SWETH( 2, 23) = 0.838861E+01
+ PKER_SWETH( 2, 24) = 0.845542E+01
+ PKER_SWETH( 2, 25) = 0.851480E+01
+ PKER_SWETH( 2, 26) = 0.856779E+01
+ PKER_SWETH( 2, 27) = 0.861528E+01
+ PKER_SWETH( 2, 28) = 0.865805E+01
+ PKER_SWETH( 2, 29) = 0.869674E+01
+ PKER_SWETH( 2, 30) = 0.873190E+01
+ PKER_SWETH( 2, 31) = 0.876398E+01
+ PKER_SWETH( 2, 32) = 0.879336E+01
+ PKER_SWETH( 2, 33) = 0.882036E+01
+ PKER_SWETH( 2, 34) = 0.884525E+01
+ PKER_SWETH( 2, 35) = 0.886825E+01
+ PKER_SWETH( 2, 36) = 0.888956E+01
+ PKER_SWETH( 2, 37) = 0.890934E+01
+ PKER_SWETH( 2, 38) = 0.892772E+01
+ PKER_SWETH( 2, 39) = 0.894485E+01
+ PKER_SWETH( 2, 40) = 0.896081E+01
+ PKER_SWETH( 2, 41) = 0.897571E+01
+ PKER_SWETH( 2, 42) = 0.898963E+01
+ PKER_SWETH( 2, 43) = 0.900265E+01
+ PKER_SWETH( 2, 44) = 0.901483E+01
+ PKER_SWETH( 2, 45) = 0.902623E+01
+ PKER_SWETH( 2, 46) = 0.903690E+01
+ PKER_SWETH( 2, 47) = 0.904690E+01
+ PKER_SWETH( 2, 48) = 0.905628E+01
+ PKER_SWETH( 2, 49) = 0.906507E+01
+ PKER_SWETH( 2, 50) = 0.907331E+01
+ PKER_SWETH( 2, 51) = 0.908104E+01
+ PKER_SWETH( 2, 52) = 0.908830E+01
+ PKER_SWETH( 2, 53) = 0.909510E+01
+ PKER_SWETH( 2, 54) = 0.910149E+01
+ PKER_SWETH( 2, 55) = 0.910748E+01
+ PKER_SWETH( 2, 56) = 0.911311E+01
+ PKER_SWETH( 2, 57) = 0.911839E+01
+ PKER_SWETH( 2, 58) = 0.912334E+01
+ PKER_SWETH( 2, 59) = 0.912799E+01
+ PKER_SWETH( 2, 60) = 0.913236E+01
+ PKER_SWETH( 2, 61) = 0.913646E+01
+ PKER_SWETH( 2, 62) = 0.914031E+01
+ PKER_SWETH( 2, 63) = 0.914392E+01
+ PKER_SWETH( 2, 64) = 0.914731E+01
+ PKER_SWETH( 2, 65) = 0.915050E+01
+ PKER_SWETH( 2, 66) = 0.915349E+01
+ PKER_SWETH( 2, 67) = 0.915630E+01
+ PKER_SWETH( 2, 68) = 0.915894E+01
+ PKER_SWETH( 2, 69) = 0.916141E+01
+ PKER_SWETH( 2, 70) = 0.916374E+01
+ PKER_SWETH( 2, 71) = 0.916592E+01
+ PKER_SWETH( 2, 72) = 0.916797E+01
+ PKER_SWETH( 2, 73) = 0.916989E+01
+ PKER_SWETH( 2, 74) = 0.917170E+01
+ PKER_SWETH( 2, 75) = 0.917339E+01
+ PKER_SWETH( 2, 76) = 0.917499E+01
+ PKER_SWETH( 2, 77) = 0.917648E+01
+ PKER_SWETH( 2, 78) = 0.917789E+01
+ PKER_SWETH( 2, 79) = 0.917921E+01
+ PKER_SWETH( 2, 80) = 0.918044E+01
+ PKER_SWETH( 3, 1) = 0.368905E+01
+ PKER_SWETH( 3, 2) = 0.389478E+01
+ PKER_SWETH( 3, 3) = 0.409193E+01
+ PKER_SWETH( 3, 4) = 0.428141E+01
+ PKER_SWETH( 3, 5) = 0.446434E+01
+ PKER_SWETH( 3, 6) = 0.464196E+01
+ PKER_SWETH( 3, 7) = 0.481560E+01
+ PKER_SWETH( 3, 8) = 0.498655E+01
+ PKER_SWETH( 3, 9) = 0.515601E+01
+ PKER_SWETH( 3, 10) = 0.532493E+01
+ PKER_SWETH( 3, 11) = 0.549382E+01
+ PKER_SWETH( 3, 12) = 0.566262E+01
+ PKER_SWETH( 3, 13) = 0.583056E+01
+ PKER_SWETH( 3, 14) = 0.599610E+01
+ PKER_SWETH( 3, 15) = 0.615716E+01
+ PKER_SWETH( 3, 16) = 0.631137E+01
+ PKER_SWETH( 3, 17) = 0.645651E+01
+ PKER_SWETH( 3, 18) = 0.659082E+01
+ PKER_SWETH( 3, 19) = 0.671329E+01
+ PKER_SWETH( 3, 20) = 0.682361E+01
+ PKER_SWETH( 3, 21) = 0.692215E+01
+ PKER_SWETH( 3, 22) = 0.700968E+01
+ PKER_SWETH( 3, 23) = 0.708726E+01
+ PKER_SWETH( 3, 24) = 0.715602E+01
+ PKER_SWETH( 3, 25) = 0.721708E+01
+ PKER_SWETH( 3, 26) = 0.727148E+01
+ PKER_SWETH( 3, 27) = 0.732015E+01
+ PKER_SWETH( 3, 28) = 0.736386E+01
+ PKER_SWETH( 3, 29) = 0.740332E+01
+ PKER_SWETH( 3, 30) = 0.743910E+01
+ PKER_SWETH( 3, 31) = 0.747167E+01
+ PKER_SWETH( 3, 32) = 0.750144E+01
+ PKER_SWETH( 3, 33) = 0.752875E+01
+ PKER_SWETH( 3, 34) = 0.755388E+01
+ PKER_SWETH( 3, 35) = 0.757707E+01
+ PKER_SWETH( 3, 36) = 0.759853E+01
+ PKER_SWETH( 3, 37) = 0.761842E+01
+ PKER_SWETH( 3, 38) = 0.763691E+01
+ PKER_SWETH( 3, 39) = 0.765410E+01
+ PKER_SWETH( 3, 40) = 0.767013E+01
+ PKER_SWETH( 3, 41) = 0.768507E+01
+ PKER_SWETH( 3, 42) = 0.769903E+01
+ PKER_SWETH( 3, 43) = 0.771207E+01
+ PKER_SWETH( 3, 44) = 0.772427E+01
+ PKER_SWETH( 3, 45) = 0.773569E+01
+ PKER_SWETH( 3, 46) = 0.774638E+01
+ PKER_SWETH( 3, 47) = 0.775639E+01
+ PKER_SWETH( 3, 48) = 0.776578E+01
+ PKER_SWETH( 3, 49) = 0.777457E+01
+ PKER_SWETH( 3, 50) = 0.778282E+01
+ PKER_SWETH( 3, 51) = 0.779056E+01
+ PKER_SWETH( 3, 52) = 0.779781E+01
+ PKER_SWETH( 3, 53) = 0.780462E+01
+ PKER_SWETH( 3, 54) = 0.781101E+01
+ PKER_SWETH( 3, 55) = 0.781700E+01
+ PKER_SWETH( 3, 56) = 0.782263E+01
+ PKER_SWETH( 3, 57) = 0.782791E+01
+ PKER_SWETH( 3, 58) = 0.783287E+01
+ PKER_SWETH( 3, 59) = 0.783752E+01
+ PKER_SWETH( 3, 60) = 0.784189E+01
+ PKER_SWETH( 3, 61) = 0.784599E+01
+ PKER_SWETH( 3, 62) = 0.784984E+01
+ PKER_SWETH( 3, 63) = 0.785345E+01
+ PKER_SWETH( 3, 64) = 0.785684E+01
+ PKER_SWETH( 3, 65) = 0.786003E+01
+ PKER_SWETH( 3, 66) = 0.786302E+01
+ PKER_SWETH( 3, 67) = 0.786583E+01
+ PKER_SWETH( 3, 68) = 0.786846E+01
+ PKER_SWETH( 3, 69) = 0.787094E+01
+ PKER_SWETH( 3, 70) = 0.787326E+01
+ PKER_SWETH( 3, 71) = 0.787545E+01
+ PKER_SWETH( 3, 72) = 0.787750E+01
+ PKER_SWETH( 3, 73) = 0.787942E+01
+ PKER_SWETH( 3, 74) = 0.788123E+01
+ PKER_SWETH( 3, 75) = 0.788292E+01
+ PKER_SWETH( 3, 76) = 0.788452E+01
+ PKER_SWETH( 3, 77) = 0.788601E+01
+ PKER_SWETH( 3, 78) = 0.788742E+01
+ PKER_SWETH( 3, 79) = 0.788874E+01
+ PKER_SWETH( 3, 80) = 0.788997E+01
+ PKER_SWETH( 4, 1) = 0.272364E+01
+ PKER_SWETH( 4, 2) = 0.292170E+01
+ PKER_SWETH( 4, 3) = 0.311233E+01
+ PKER_SWETH( 4, 4) = 0.329553E+01
+ PKER_SWETH( 4, 5) = 0.347178E+01
+ PKER_SWETH( 4, 6) = 0.364187E+01
+ PKER_SWETH( 4, 7) = 0.380681E+01
+ PKER_SWETH( 4, 8) = 0.396771E+01
+ PKER_SWETH( 4, 9) = 0.412569E+01
+ PKER_SWETH( 4, 10) = 0.428181E+01
+ PKER_SWETH( 4, 11) = 0.443691E+01
+ PKER_SWETH( 4, 12) = 0.459147E+01
+ PKER_SWETH( 4, 13) = 0.474544E+01
+ PKER_SWETH( 4, 14) = 0.489819E+01
+ PKER_SWETH( 4, 15) = 0.504840E+01
+ PKER_SWETH( 4, 16) = 0.519429E+01
+ PKER_SWETH( 4, 17) = 0.533381E+01
+ PKER_SWETH( 4, 18) = 0.546505E+01
+ PKER_SWETH( 4, 19) = 0.558652E+01
+ PKER_SWETH( 4, 20) = 0.569735E+01
+ PKER_SWETH( 4, 21) = 0.579731E+01
+ PKER_SWETH( 4, 22) = 0.588672E+01
+ PKER_SWETH( 4, 23) = 0.596630E+01
+ PKER_SWETH( 4, 24) = 0.603698E+01
+ PKER_SWETH( 4, 25) = 0.609976E+01
+ PKER_SWETH( 4, 26) = 0.615566E+01
+ PKER_SWETH( 4, 27) = 0.620557E+01
+ PKER_SWETH( 4, 28) = 0.625032E+01
+ PKER_SWETH( 4, 29) = 0.629062E+01
+ PKER_SWETH( 4, 30) = 0.632707E+01
+ PKER_SWETH( 4, 31) = 0.636018E+01
+ PKER_SWETH( 4, 32) = 0.639038E+01
+ PKER_SWETH( 4, 33) = 0.641803E+01
+ PKER_SWETH( 4, 34) = 0.644343E+01
+ PKER_SWETH( 4, 35) = 0.646684E+01
+ PKER_SWETH( 4, 36) = 0.648846E+01
+ PKER_SWETH( 4, 37) = 0.650849E+01
+ PKER_SWETH( 4, 38) = 0.652707E+01
+ PKER_SWETH( 4, 39) = 0.654435E+01
+ PKER_SWETH( 4, 40) = 0.656044E+01
+ PKER_SWETH( 4, 41) = 0.657544E+01
+ PKER_SWETH( 4, 42) = 0.658943E+01
+ PKER_SWETH( 4, 43) = 0.660251E+01
+ PKER_SWETH( 4, 44) = 0.661473E+01
+ PKER_SWETH( 4, 45) = 0.662617E+01
+ PKER_SWETH( 4, 46) = 0.663687E+01
+ PKER_SWETH( 4, 47) = 0.664690E+01
+ PKER_SWETH( 4, 48) = 0.665629E+01
+ PKER_SWETH( 4, 49) = 0.666510E+01
+ PKER_SWETH( 4, 50) = 0.667335E+01
+ PKER_SWETH( 4, 51) = 0.668109E+01
+ PKER_SWETH( 4, 52) = 0.668835E+01
+ PKER_SWETH( 4, 53) = 0.669516E+01
+ PKER_SWETH( 4, 54) = 0.670155E+01
+ PKER_SWETH( 4, 55) = 0.670755E+01
+ PKER_SWETH( 4, 56) = 0.671318E+01
+ PKER_SWETH( 4, 57) = 0.671846E+01
+ PKER_SWETH( 4, 58) = 0.672342E+01
+ PKER_SWETH( 4, 59) = 0.672807E+01
+ PKER_SWETH( 4, 60) = 0.673244E+01
+ PKER_SWETH( 4, 61) = 0.673654E+01
+ PKER_SWETH( 4, 62) = 0.674039E+01
+ PKER_SWETH( 4, 63) = 0.674400E+01
+ PKER_SWETH( 4, 64) = 0.674739E+01
+ PKER_SWETH( 4, 65) = 0.675058E+01
+ PKER_SWETH( 4, 66) = 0.675357E+01
+ PKER_SWETH( 4, 67) = 0.675638E+01
+ PKER_SWETH( 4, 68) = 0.675902E+01
+ PKER_SWETH( 4, 69) = 0.676149E+01
+ PKER_SWETH( 4, 70) = 0.676382E+01
+ PKER_SWETH( 4, 71) = 0.676600E+01
+ PKER_SWETH( 4, 72) = 0.676805E+01
+ PKER_SWETH( 4, 73) = 0.676997E+01
+ PKER_SWETH( 4, 74) = 0.677178E+01
+ PKER_SWETH( 4, 75) = 0.677348E+01
+ PKER_SWETH( 4, 76) = 0.677507E+01
+ PKER_SWETH( 4, 77) = 0.677656E+01
+ PKER_SWETH( 4, 78) = 0.677797E+01
+ PKER_SWETH( 4, 79) = 0.677929E+01
+ PKER_SWETH( 4, 80) = 0.678053E+01
+ PKER_SWETH( 5, 1) = 0.191873E+01
+ PKER_SWETH( 5, 2) = 0.210156E+01
+ PKER_SWETH( 5, 3) = 0.228144E+01
+ PKER_SWETH( 5, 4) = 0.245647E+01
+ PKER_SWETH( 5, 5) = 0.262578E+01
+ PKER_SWETH( 5, 6) = 0.278922E+01
+ PKER_SWETH( 5, 7) = 0.294715E+01
+ PKER_SWETH( 5, 8) = 0.310025E+01
+ PKER_SWETH( 5, 9) = 0.324939E+01
+ PKER_SWETH( 5, 10) = 0.339551E+01
+ PKER_SWETH( 5, 11) = 0.353950E+01
+ PKER_SWETH( 5, 12) = 0.368211E+01
+ PKER_SWETH( 5, 13) = 0.382377E+01
+ PKER_SWETH( 5, 14) = 0.396446E+01
+ PKER_SWETH( 5, 15) = 0.410364E+01
+ PKER_SWETH( 5, 16) = 0.424020E+01
+ PKER_SWETH( 5, 17) = 0.437258E+01
+ PKER_SWETH( 5, 18) = 0.449905E+01
+ PKER_SWETH( 5, 19) = 0.461795E+01
+ PKER_SWETH( 5, 20) = 0.472801E+01
+ PKER_SWETH( 5, 21) = 0.482849E+01
+ PKER_SWETH( 5, 22) = 0.491922E+01
+ PKER_SWETH( 5, 23) = 0.500049E+01
+ PKER_SWETH( 5, 24) = 0.507296E+01
+ PKER_SWETH( 5, 25) = 0.513746E+01
+ PKER_SWETH( 5, 26) = 0.519489E+01
+ PKER_SWETH( 5, 27) = 0.524613E+01
+ PKER_SWETH( 5, 28) = 0.529199E+01
+ PKER_SWETH( 5, 29) = 0.533320E+01
+ PKER_SWETH( 5, 30) = 0.537039E+01
+ PKER_SWETH( 5, 31) = 0.540410E+01
+ PKER_SWETH( 5, 32) = 0.543477E+01
+ PKER_SWETH( 5, 33) = 0.546280E+01
+ PKER_SWETH( 5, 34) = 0.548850E+01
+ PKER_SWETH( 5, 35) = 0.551214E+01
+ PKER_SWETH( 5, 36) = 0.553395E+01
+ PKER_SWETH( 5, 37) = 0.555413E+01
+ PKER_SWETH( 5, 38) = 0.557283E+01
+ PKER_SWETH( 5, 39) = 0.559020E+01
+ PKER_SWETH( 5, 40) = 0.560636E+01
+ PKER_SWETH( 5, 41) = 0.562141E+01
+ PKER_SWETH( 5, 42) = 0.563545E+01
+ PKER_SWETH( 5, 43) = 0.564856E+01
+ PKER_SWETH( 5, 44) = 0.566081E+01
+ PKER_SWETH( 5, 45) = 0.567227E+01
+ PKER_SWETH( 5, 46) = 0.568299E+01
+ PKER_SWETH( 5, 47) = 0.569303E+01
+ PKER_SWETH( 5, 48) = 0.570244E+01
+ PKER_SWETH( 5, 49) = 0.571125E+01
+ PKER_SWETH( 5, 50) = 0.571951E+01
+ PKER_SWETH( 5, 51) = 0.572725E+01
+ PKER_SWETH( 5, 52) = 0.573452E+01
+ PKER_SWETH( 5, 53) = 0.574133E+01
+ PKER_SWETH( 5, 54) = 0.574773E+01
+ PKER_SWETH( 5, 55) = 0.575372E+01
+ PKER_SWETH( 5, 56) = 0.575935E+01
+ PKER_SWETH( 5, 57) = 0.576463E+01
+ PKER_SWETH( 5, 58) = 0.576959E+01
+ PKER_SWETH( 5, 59) = 0.577425E+01
+ PKER_SWETH( 5, 60) = 0.577862E+01
+ PKER_SWETH( 5, 61) = 0.578272E+01
+ PKER_SWETH( 5, 62) = 0.578657E+01
+ PKER_SWETH( 5, 63) = 0.579018E+01
+ PKER_SWETH( 5, 64) = 0.579357E+01
+ PKER_SWETH( 5, 65) = 0.579676E+01
+ PKER_SWETH( 5, 66) = 0.579975E+01
+ PKER_SWETH( 5, 67) = 0.580256E+01
+ PKER_SWETH( 5, 68) = 0.580520E+01
+ PKER_SWETH( 5, 69) = 0.580767E+01
+ PKER_SWETH( 5, 70) = 0.581000E+01
+ PKER_SWETH( 5, 71) = 0.581218E+01
+ PKER_SWETH( 5, 72) = 0.581423E+01
+ PKER_SWETH( 5, 73) = 0.581615E+01
+ PKER_SWETH( 5, 74) = 0.581796E+01
+ PKER_SWETH( 5, 75) = 0.581966E+01
+ PKER_SWETH( 5, 76) = 0.582125E+01
+ PKER_SWETH( 5, 77) = 0.582275E+01
+ PKER_SWETH( 5, 78) = 0.582415E+01
+ PKER_SWETH( 5, 79) = 0.582547E+01
+ PKER_SWETH( 5, 80) = 0.582671E+01
+ PKER_SWETH( 6, 1) = 0.128538E+01
+ PKER_SWETH( 6, 2) = 0.143580E+01
+ PKER_SWETH( 6, 3) = 0.159310E+01
+ PKER_SWETH( 6, 4) = 0.175236E+01
+ PKER_SWETH( 6, 5) = 0.191039E+01
+ PKER_SWETH( 6, 6) = 0.206519E+01
+ PKER_SWETH( 6, 7) = 0.221578E+01
+ PKER_SWETH( 6, 8) = 0.236189E+01
+ PKER_SWETH( 6, 9) = 0.250376E+01
+ PKER_SWETH( 6, 10) = 0.264193E+01
+ PKER_SWETH( 6, 11) = 0.277711E+01
+ PKER_SWETH( 6, 12) = 0.291003E+01
+ PKER_SWETH( 6, 13) = 0.304132E+01
+ PKER_SWETH( 6, 14) = 0.317134E+01
+ PKER_SWETH( 6, 15) = 0.330011E+01
+ PKER_SWETH( 6, 16) = 0.342714E+01
+ PKER_SWETH( 6, 17) = 0.355150E+01
+ PKER_SWETH( 6, 18) = 0.367186E+01
+ PKER_SWETH( 6, 19) = 0.378671E+01
+ PKER_SWETH( 6, 20) = 0.389463E+01
+ PKER_SWETH( 6, 21) = 0.399453E+01
+ PKER_SWETH( 6, 22) = 0.408580E+01
+ PKER_SWETH( 6, 23) = 0.416829E+01
+ PKER_SWETH( 6, 24) = 0.424230E+01
+ PKER_SWETH( 6, 25) = 0.430841E+01
+ PKER_SWETH( 6, 26) = 0.436736E+01
+ PKER_SWETH( 6, 27) = 0.441996E+01
+ PKER_SWETH( 6, 28) = 0.446700E+01
+ PKER_SWETH( 6, 29) = 0.450920E+01
+ PKER_SWETH( 6, 30) = 0.454719E+01
+ PKER_SWETH( 6, 31) = 0.458156E+01
+ PKER_SWETH( 6, 32) = 0.461276E+01
+ PKER_SWETH( 6, 33) = 0.464121E+01
+ PKER_SWETH( 6, 34) = 0.466724E+01
+ PKER_SWETH( 6, 35) = 0.469115E+01
+ PKER_SWETH( 6, 36) = 0.471317E+01
+ PKER_SWETH( 6, 37) = 0.473351E+01
+ PKER_SWETH( 6, 38) = 0.475234E+01
+ PKER_SWETH( 6, 39) = 0.476981E+01
+ PKER_SWETH( 6, 40) = 0.478604E+01
+ PKER_SWETH( 6, 41) = 0.480116E+01
+ PKER_SWETH( 6, 42) = 0.481525E+01
+ PKER_SWETH( 6, 43) = 0.482840E+01
+ PKER_SWETH( 6, 44) = 0.484068E+01
+ PKER_SWETH( 6, 45) = 0.485216E+01
+ PKER_SWETH( 6, 46) = 0.486290E+01
+ PKER_SWETH( 6, 47) = 0.487296E+01
+ PKER_SWETH( 6, 48) = 0.488237E+01
+ PKER_SWETH( 6, 49) = 0.489119E+01
+ PKER_SWETH( 6, 50) = 0.489946E+01
+ PKER_SWETH( 6, 51) = 0.490721E+01
+ PKER_SWETH( 6, 52) = 0.491448E+01
+ PKER_SWETH( 6, 53) = 0.492130E+01
+ PKER_SWETH( 6, 54) = 0.492769E+01
+ PKER_SWETH( 6, 55) = 0.493369E+01
+ PKER_SWETH( 6, 56) = 0.493932E+01
+ PKER_SWETH( 6, 57) = 0.494461E+01
+ PKER_SWETH( 6, 58) = 0.494957E+01
+ PKER_SWETH( 6, 59) = 0.495422E+01
+ PKER_SWETH( 6, 60) = 0.495859E+01
+ PKER_SWETH( 6, 61) = 0.496269E+01
+ PKER_SWETH( 6, 62) = 0.496654E+01
+ PKER_SWETH( 6, 63) = 0.497016E+01
+ PKER_SWETH( 6, 64) = 0.497355E+01
+ PKER_SWETH( 6, 65) = 0.497674E+01
+ PKER_SWETH( 6, 66) = 0.497973E+01
+ PKER_SWETH( 6, 67) = 0.498254E+01
+ PKER_SWETH( 6, 68) = 0.498518E+01
+ PKER_SWETH( 6, 69) = 0.498765E+01
+ PKER_SWETH( 6, 70) = 0.498998E+01
+ PKER_SWETH( 6, 71) = 0.499216E+01
+ PKER_SWETH( 6, 72) = 0.499421E+01
+ PKER_SWETH( 6, 73) = 0.499613E+01
+ PKER_SWETH( 6, 74) = 0.499794E+01
+ PKER_SWETH( 6, 75) = 0.499964E+01
+ PKER_SWETH( 6, 76) = 0.500123E+01
+ PKER_SWETH( 6, 77) = 0.500272E+01
+ PKER_SWETH( 6, 78) = 0.500413E+01
+ PKER_SWETH( 6, 79) = 0.500545E+01
+ PKER_SWETH( 6, 80) = 0.500669E+01
+ PKER_SWETH( 7, 1) = 0.856768E+00
+ PKER_SWETH( 7, 2) = 0.947769E+00
+ PKER_SWETH( 7, 3) = 0.106025E+01
+ PKER_SWETH( 7, 4) = 0.118718E+01
+ PKER_SWETH( 7, 5) = 0.132214E+01
+ PKER_SWETH( 7, 6) = 0.146072E+01
+ PKER_SWETH( 7, 7) = 0.159954E+01
+ PKER_SWETH( 7, 8) = 0.173657E+01
+ PKER_SWETH( 7, 9) = 0.187073E+01
+ PKER_SWETH( 7, 10) = 0.200163E+01
+ PKER_SWETH( 7, 11) = 0.212938E+01
+ PKER_SWETH( 7, 12) = 0.225437E+01
+ PKER_SWETH( 7, 13) = 0.237711E+01
+ PKER_SWETH( 7, 14) = 0.249807E+01
+ PKER_SWETH( 7, 15) = 0.261757E+01
+ PKER_SWETH( 7, 16) = 0.273559E+01
+ PKER_SWETH( 7, 17) = 0.285173E+01
+ PKER_SWETH( 7, 18) = 0.296518E+01
+ PKER_SWETH( 7, 19) = 0.307480E+01
+ PKER_SWETH( 7, 20) = 0.317928E+01
+ PKER_SWETH( 7, 21) = 0.327741E+01
+ PKER_SWETH( 7, 22) = 0.336826E+01
+ PKER_SWETH( 7, 23) = 0.345129E+01
+ PKER_SWETH( 7, 24) = 0.352643E+01
+ PKER_SWETH( 7, 25) = 0.359394E+01
+ PKER_SWETH( 7, 26) = 0.365434E+01
+ PKER_SWETH( 7, 27) = 0.370832E+01
+ PKER_SWETH( 7, 28) = 0.375657E+01
+ PKER_SWETH( 7, 29) = 0.379981E+01
+ PKER_SWETH( 7, 30) = 0.383869E+01
+ PKER_SWETH( 7, 31) = 0.387377E+01
+ PKER_SWETH( 7, 32) = 0.390555E+01
+ PKER_SWETH( 7, 33) = 0.393446E+01
+ PKER_SWETH( 7, 34) = 0.396087E+01
+ PKER_SWETH( 7, 35) = 0.398507E+01
+ PKER_SWETH( 7, 36) = 0.400732E+01
+ PKER_SWETH( 7, 37) = 0.402784E+01
+ PKER_SWETH( 7, 38) = 0.404682E+01
+ PKER_SWETH( 7, 39) = 0.406440E+01
+ PKER_SWETH( 7, 40) = 0.408073E+01
+ PKER_SWETH( 7, 41) = 0.409591E+01
+ PKER_SWETH( 7, 42) = 0.411006E+01
+ PKER_SWETH( 7, 43) = 0.412325E+01
+ PKER_SWETH( 7, 44) = 0.413556E+01
+ PKER_SWETH( 7, 45) = 0.414707E+01
+ PKER_SWETH( 7, 46) = 0.415783E+01
+ PKER_SWETH( 7, 47) = 0.416790E+01
+ PKER_SWETH( 7, 48) = 0.417733E+01
+ PKER_SWETH( 7, 49) = 0.418616E+01
+ PKER_SWETH( 7, 50) = 0.419444E+01
+ PKER_SWETH( 7, 51) = 0.420220E+01
+ PKER_SWETH( 7, 52) = 0.420947E+01
+ PKER_SWETH( 7, 53) = 0.421629E+01
+ PKER_SWETH( 7, 54) = 0.422269E+01
+ PKER_SWETH( 7, 55) = 0.422869E+01
+ PKER_SWETH( 7, 56) = 0.423433E+01
+ PKER_SWETH( 7, 57) = 0.423961E+01
+ PKER_SWETH( 7, 58) = 0.424457E+01
+ PKER_SWETH( 7, 59) = 0.424923E+01
+ PKER_SWETH( 7, 60) = 0.425360E+01
+ PKER_SWETH( 7, 61) = 0.425770E+01
+ PKER_SWETH( 7, 62) = 0.426155E+01
+ PKER_SWETH( 7, 63) = 0.426517E+01
+ PKER_SWETH( 7, 64) = 0.426856E+01
+ PKER_SWETH( 7, 65) = 0.427175E+01
+ PKER_SWETH( 7, 66) = 0.427474E+01
+ PKER_SWETH( 7, 67) = 0.427755E+01
+ PKER_SWETH( 7, 68) = 0.428018E+01
+ PKER_SWETH( 7, 69) = 0.428266E+01
+ PKER_SWETH( 7, 70) = 0.428498E+01
+ PKER_SWETH( 7, 71) = 0.428717E+01
+ PKER_SWETH( 7, 72) = 0.428922E+01
+ PKER_SWETH( 7, 73) = 0.429114E+01
+ PKER_SWETH( 7, 74) = 0.429295E+01
+ PKER_SWETH( 7, 75) = 0.429464E+01
+ PKER_SWETH( 7, 76) = 0.429624E+01
+ PKER_SWETH( 7, 77) = 0.429773E+01
+ PKER_SWETH( 7, 78) = 0.429914E+01
+ PKER_SWETH( 7, 79) = 0.430046E+01
+ PKER_SWETH( 7, 80) = 0.430169E+01
+ PKER_SWETH( 8, 1) = 0.666288E+00
+ PKER_SWETH( 8, 2) = 0.672636E+00
+ PKER_SWETH( 8, 3) = 0.713972E+00
+ PKER_SWETH( 8, 4) = 0.783974E+00
+ PKER_SWETH( 8, 5) = 0.875298E+00
+ PKER_SWETH( 8, 6) = 0.981698E+00
+ PKER_SWETH( 8, 7) = 0.109726E+01
+ PKER_SWETH( 8, 8) = 0.121759E+01
+ PKER_SWETH( 8, 9) = 0.133955E+01
+ PKER_SWETH( 8, 10) = 0.146099E+01
+ PKER_SWETH( 8, 11) = 0.158073E+01
+ PKER_SWETH( 8, 12) = 0.169826E+01
+ PKER_SWETH( 8, 13) = 0.181355E+01
+ PKER_SWETH( 8, 14) = 0.192680E+01
+ PKER_SWETH( 8, 15) = 0.203828E+01
+ PKER_SWETH( 8, 16) = 0.214820E+01
+ PKER_SWETH( 8, 17) = 0.225651E+01
+ PKER_SWETH( 8, 18) = 0.236285E+01
+ PKER_SWETH( 8, 19) = 0.246652E+01
+ PKER_SWETH( 8, 20) = 0.256652E+01
+ PKER_SWETH( 8, 21) = 0.266174E+01
+ PKER_SWETH( 8, 22) = 0.275113E+01
+ PKER_SWETH( 8, 23) = 0.283388E+01
+ PKER_SWETH( 8, 24) = 0.290956E+01
+ PKER_SWETH( 8, 25) = 0.297812E+01
+ PKER_SWETH( 8, 26) = 0.303979E+01
+ PKER_SWETH( 8, 27) = 0.309508E+01
+ PKER_SWETH( 8, 28) = 0.314456E+01
+ PKER_SWETH( 8, 29) = 0.318889E+01
+ PKER_SWETH( 8, 30) = 0.322870E+01
+ PKER_SWETH( 8, 31) = 0.326456E+01
+ PKER_SWETH( 8, 32) = 0.329698E+01
+ PKER_SWETH( 8, 33) = 0.332641E+01
+ PKER_SWETH( 8, 34) = 0.335322E+01
+ PKER_SWETH( 8, 35) = 0.337775E+01
+ PKER_SWETH( 8, 36) = 0.340027E+01
+ PKER_SWETH( 8, 37) = 0.342099E+01
+ PKER_SWETH( 8, 38) = 0.344013E+01
+ PKER_SWETH( 8, 39) = 0.345784E+01
+ PKER_SWETH( 8, 40) = 0.347427E+01
+ PKER_SWETH( 8, 41) = 0.348953E+01
+ PKER_SWETH( 8, 42) = 0.350374E+01
+ PKER_SWETH( 8, 43) = 0.351697E+01
+ PKER_SWETH( 8, 44) = 0.352933E+01
+ PKER_SWETH( 8, 45) = 0.354087E+01
+ PKER_SWETH( 8, 46) = 0.355165E+01
+ PKER_SWETH( 8, 47) = 0.356174E+01
+ PKER_SWETH( 8, 48) = 0.357118E+01
+ PKER_SWETH( 8, 49) = 0.358003E+01
+ PKER_SWETH( 8, 50) = 0.358831E+01
+ PKER_SWETH( 8, 51) = 0.359607E+01
+ PKER_SWETH( 8, 52) = 0.360335E+01
+ PKER_SWETH( 8, 53) = 0.361018E+01
+ PKER_SWETH( 8, 54) = 0.361658E+01
+ PKER_SWETH( 8, 55) = 0.362259E+01
+ PKER_SWETH( 8, 56) = 0.362822E+01
+ PKER_SWETH( 8, 57) = 0.363351E+01
+ PKER_SWETH( 8, 58) = 0.363847E+01
+ PKER_SWETH( 8, 59) = 0.364313E+01
+ PKER_SWETH( 8, 60) = 0.364750E+01
+ PKER_SWETH( 8, 61) = 0.365160E+01
+ PKER_SWETH( 8, 62) = 0.365545E+01
+ PKER_SWETH( 8, 63) = 0.365907E+01
+ PKER_SWETH( 8, 64) = 0.366246E+01
+ PKER_SWETH( 8, 65) = 0.366565E+01
+ PKER_SWETH( 8, 66) = 0.366864E+01
+ PKER_SWETH( 8, 67) = 0.367145E+01
+ PKER_SWETH( 8, 68) = 0.367408E+01
+ PKER_SWETH( 8, 69) = 0.367656E+01
+ PKER_SWETH( 8, 70) = 0.367889E+01
+ PKER_SWETH( 8, 71) = 0.368107E+01
+ PKER_SWETH( 8, 72) = 0.368312E+01
+ PKER_SWETH( 8, 73) = 0.368504E+01
+ PKER_SWETH( 8, 74) = 0.368685E+01
+ PKER_SWETH( 8, 75) = 0.368855E+01
+ PKER_SWETH( 8, 76) = 0.369014E+01
+ PKER_SWETH( 8, 77) = 0.369163E+01
+ PKER_SWETH( 8, 78) = 0.369304E+01
+ PKER_SWETH( 8, 79) = 0.369436E+01
+ PKER_SWETH( 8, 80) = 0.369560E+01
+ PKER_SWETH( 9, 1) = 0.707414E+00
+ PKER_SWETH( 9, 2) = 0.624644E+00
+ PKER_SWETH( 9, 3) = 0.580795E+00
+ PKER_SWETH( 9, 4) = 0.573199E+00
+ PKER_SWETH( 9, 5) = 0.598399E+00
+ PKER_SWETH( 9, 6) = 0.650444E+00
+ PKER_SWETH( 9, 7) = 0.723705E+00
+ PKER_SWETH( 9, 8) = 0.812303E+00
+ PKER_SWETH( 9, 9) = 0.910888E+00
+ PKER_SWETH( 9, 10) = 0.101536E+01
+ PKER_SWETH( 9, 11) = 0.112252E+01
+ PKER_SWETH( 9, 12) = 0.123028E+01
+ PKER_SWETH( 9, 13) = 0.133733E+01
+ PKER_SWETH( 9, 14) = 0.144307E+01
+ PKER_SWETH( 9, 15) = 0.154726E+01
+ PKER_SWETH( 9, 16) = 0.164991E+01
+ PKER_SWETH( 9, 17) = 0.175103E+01
+ PKER_SWETH( 9, 18) = 0.185052E+01
+ PKER_SWETH( 9, 19) = 0.194801E+01
+ PKER_SWETH( 9, 20) = 0.204288E+01
+ PKER_SWETH( 9, 21) = 0.213426E+01
+ PKER_SWETH( 9, 22) = 0.222119E+01
+ PKER_SWETH( 9, 23) = 0.230275E+01
+ PKER_SWETH( 9, 24) = 0.237826E+01
+ PKER_SWETH( 9, 25) = 0.244736E+01
+ PKER_SWETH( 9, 26) = 0.251001E+01
+ PKER_SWETH( 9, 27) = 0.256645E+01
+ PKER_SWETH( 9, 28) = 0.261712E+01
+ PKER_SWETH( 9, 29) = 0.266256E+01
+ PKER_SWETH( 9, 30) = 0.270334E+01
+ PKER_SWETH( 9, 31) = 0.274003E+01
+ PKER_SWETH( 9, 32) = 0.277315E+01
+ PKER_SWETH( 9, 33) = 0.280314E+01
+ PKER_SWETH( 9, 34) = 0.283042E+01
+ PKER_SWETH( 9, 35) = 0.285531E+01
+ PKER_SWETH( 9, 36) = 0.287812E+01
+ PKER_SWETH( 9, 37) = 0.289907E+01
+ PKER_SWETH( 9, 38) = 0.291839E+01
+ PKER_SWETH( 9, 39) = 0.293624E+01
+ PKER_SWETH( 9, 40) = 0.295278E+01
+ PKER_SWETH( 9, 41) = 0.296813E+01
+ PKER_SWETH( 9, 42) = 0.298241E+01
+ PKER_SWETH( 9, 43) = 0.299570E+01
+ PKER_SWETH( 9, 44) = 0.300810E+01
+ PKER_SWETH( 9, 45) = 0.301967E+01
+ PKER_SWETH( 9, 46) = 0.303048E+01
+ PKER_SWETH( 9, 47) = 0.304059E+01
+ PKER_SWETH( 9, 48) = 0.305005E+01
+ PKER_SWETH( 9, 49) = 0.305890E+01
+ PKER_SWETH( 9, 50) = 0.306720E+01
+ PKER_SWETH( 9, 51) = 0.307497E+01
+ PKER_SWETH( 9, 52) = 0.308225E+01
+ PKER_SWETH( 9, 53) = 0.308908E+01
+ PKER_SWETH( 9, 54) = 0.309549E+01
+ PKER_SWETH( 9, 55) = 0.310150E+01
+ PKER_SWETH( 9, 56) = 0.310713E+01
+ PKER_SWETH( 9, 57) = 0.311242E+01
+ PKER_SWETH( 9, 58) = 0.311739E+01
+ PKER_SWETH( 9, 59) = 0.312204E+01
+ PKER_SWETH( 9, 60) = 0.312642E+01
+ PKER_SWETH( 9, 61) = 0.313052E+01
+ PKER_SWETH( 9, 62) = 0.313437E+01
+ PKER_SWETH( 9, 63) = 0.313799E+01
+ PKER_SWETH( 9, 64) = 0.314138E+01
+ PKER_SWETH( 9, 65) = 0.314457E+01
+ PKER_SWETH( 9, 66) = 0.314756E+01
+ PKER_SWETH( 9, 67) = 0.315037E+01
+ PKER_SWETH( 9, 68) = 0.315301E+01
+ PKER_SWETH( 9, 69) = 0.315548E+01
+ PKER_SWETH( 9, 70) = 0.315781E+01
+ PKER_SWETH( 9, 71) = 0.315999E+01
+ PKER_SWETH( 9, 72) = 0.316204E+01
+ PKER_SWETH( 9, 73) = 0.316396E+01
+ PKER_SWETH( 9, 74) = 0.316577E+01
+ PKER_SWETH( 9, 75) = 0.316747E+01
+ PKER_SWETH( 9, 76) = 0.316906E+01
+ PKER_SWETH( 9, 77) = 0.317056E+01
+ PKER_SWETH( 9, 78) = 0.317196E+01
+ PKER_SWETH( 9, 79) = 0.317328E+01
+ PKER_SWETH( 9, 80) = 0.317452E+01
+ PKER_SWETH( 10, 1) = 0.911913E+00
+ PKER_SWETH( 10, 2) = 0.763036E+00
+ PKER_SWETH( 10, 3) = 0.645536E+00
+ PKER_SWETH( 10, 4) = 0.561056E+00
+ PKER_SWETH( 10, 5) = 0.510613E+00
+ PKER_SWETH( 10, 6) = 0.492913E+00
+ PKER_SWETH( 10, 7) = 0.504602E+00
+ PKER_SWETH( 10, 8) = 0.541947E+00
+ PKER_SWETH( 10, 9) = 0.599761E+00
+ PKER_SWETH( 10, 10) = 0.673026E+00
+ PKER_SWETH( 10, 11) = 0.756871E+00
+ PKER_SWETH( 10, 12) = 0.847450E+00
+ PKER_SWETH( 10, 13) = 0.941685E+00
+ PKER_SWETH( 10, 14) = 0.103741E+01
+ PKER_SWETH( 10, 15) = 0.113330E+01
+ PKER_SWETH( 10, 16) = 0.122855E+01
+ PKER_SWETH( 10, 17) = 0.132276E+01
+ PKER_SWETH( 10, 18) = 0.141568E+01
+ PKER_SWETH( 10, 19) = 0.150707E+01
+ PKER_SWETH( 10, 20) = 0.159652E+01
+ PKER_SWETH( 10, 21) = 0.168345E+01
+ PKER_SWETH( 10, 22) = 0.176708E+01
+ PKER_SWETH( 10, 23) = 0.184656E+01
+ PKER_SWETH( 10, 24) = 0.192110E+01
+ PKER_SWETH( 10, 25) = 0.199011E+01
+ PKER_SWETH( 10, 26) = 0.205330E+01
+ PKER_SWETH( 10, 27) = 0.211065E+01
+ PKER_SWETH( 10, 28) = 0.216238E+01
+ PKER_SWETH( 10, 29) = 0.220889E+01
+ PKER_SWETH( 10, 30) = 0.225067E+01
+ PKER_SWETH( 10, 31) = 0.228824E+01
+ PKER_SWETH( 10, 32) = 0.232210E+01
+ PKER_SWETH( 10, 33) = 0.235272E+01
+ PKER_SWETH( 10, 34) = 0.238050E+01
+ PKER_SWETH( 10, 35) = 0.240580E+01
+ PKER_SWETH( 10, 36) = 0.242893E+01
+ PKER_SWETH( 10, 37) = 0.245014E+01
+ PKER_SWETH( 10, 38) = 0.246966E+01
+ PKER_SWETH( 10, 39) = 0.248768E+01
+ PKER_SWETH( 10, 40) = 0.250434E+01
+ PKER_SWETH( 10, 41) = 0.251979E+01
+ PKER_SWETH( 10, 42) = 0.253415E+01
+ PKER_SWETH( 10, 43) = 0.254750E+01
+ PKER_SWETH( 10, 44) = 0.255994E+01
+ PKER_SWETH( 10, 45) = 0.257155E+01
+ PKER_SWETH( 10, 46) = 0.258239E+01
+ PKER_SWETH( 10, 47) = 0.259252E+01
+ PKER_SWETH( 10, 48) = 0.260200E+01
+ PKER_SWETH( 10, 49) = 0.261087E+01
+ PKER_SWETH( 10, 50) = 0.261917E+01
+ PKER_SWETH( 10, 51) = 0.262696E+01
+ PKER_SWETH( 10, 52) = 0.263425E+01
+ PKER_SWETH( 10, 53) = 0.264108E+01
+ PKER_SWETH( 10, 54) = 0.264749E+01
+ PKER_SWETH( 10, 55) = 0.265350E+01
+ PKER_SWETH( 10, 56) = 0.265914E+01
+ PKER_SWETH( 10, 57) = 0.266443E+01
+ PKER_SWETH( 10, 58) = 0.266940E+01
+ PKER_SWETH( 10, 59) = 0.267406E+01
+ PKER_SWETH( 10, 60) = 0.267843E+01
+ PKER_SWETH( 10, 61) = 0.268253E+01
+ PKER_SWETH( 10, 62) = 0.268639E+01
+ PKER_SWETH( 10, 63) = 0.269000E+01
+ PKER_SWETH( 10, 64) = 0.269340E+01
+ PKER_SWETH( 10, 65) = 0.269659E+01
+ PKER_SWETH( 10, 66) = 0.269958E+01
+ PKER_SWETH( 10, 67) = 0.270239E+01
+ PKER_SWETH( 10, 68) = 0.270502E+01
+ PKER_SWETH( 10, 69) = 0.270750E+01
+ PKER_SWETH( 10, 70) = 0.270983E+01
+ PKER_SWETH( 10, 71) = 0.271201E+01
+ PKER_SWETH( 10, 72) = 0.271406E+01
+ PKER_SWETH( 10, 73) = 0.271598E+01
+ PKER_SWETH( 10, 74) = 0.271779E+01
+ PKER_SWETH( 10, 75) = 0.271949E+01
+ PKER_SWETH( 10, 76) = 0.272108E+01
+ PKER_SWETH( 10, 77) = 0.272257E+01
+ PKER_SWETH( 10, 78) = 0.272398E+01
+ PKER_SWETH( 10, 79) = 0.272530E+01
+ PKER_SWETH( 10, 80) = 0.272654E+01
+ PKER_SWETH( 11, 1) = 0.118545E+01
+ PKER_SWETH( 11, 2) = 0.100295E+01
+ PKER_SWETH( 11, 3) = 0.841340E+00
+ PKER_SWETH( 11, 4) = 0.703241E+00
+ PKER_SWETH( 11, 5) = 0.591315E+00
+ PKER_SWETH( 11, 6) = 0.507481E+00
+ PKER_SWETH( 11, 7) = 0.452983E+00
+ PKER_SWETH( 11, 8) = 0.427344E+00
+ PKER_SWETH( 11, 9) = 0.428797E+00
+ PKER_SWETH( 11, 10) = 0.453908E+00
+ PKER_SWETH( 11, 11) = 0.498674E+00
+ PKER_SWETH( 11, 12) = 0.558774E+00
+ PKER_SWETH( 11, 13) = 0.629851E+00
+ PKER_SWETH( 11, 14) = 0.708336E+00
+ PKER_SWETH( 11, 15) = 0.791265E+00
+ PKER_SWETH( 11, 16) = 0.876433E+00
+ PKER_SWETH( 11, 17) = 0.962409E+00
+ PKER_SWETH( 11, 18) = 0.104825E+01
+ PKER_SWETH( 11, 19) = 0.113333E+01
+ PKER_SWETH( 11, 20) = 0.121716E+01
+ PKER_SWETH( 11, 21) = 0.129924E+01
+ PKER_SWETH( 11, 22) = 0.137896E+01
+ PKER_SWETH( 11, 23) = 0.145558E+01
+ PKER_SWETH( 11, 24) = 0.152835E+01
+ PKER_SWETH( 11, 25) = 0.159658E+01
+ PKER_SWETH( 11, 26) = 0.165976E+01
+ PKER_SWETH( 11, 27) = 0.171764E+01
+ PKER_SWETH( 11, 28) = 0.177021E+01
+ PKER_SWETH( 11, 29) = 0.181769E+01
+ PKER_SWETH( 11, 30) = 0.186044E+01
+ PKER_SWETH( 11, 31) = 0.189891E+01
+ PKER_SWETH( 11, 32) = 0.193356E+01
+ PKER_SWETH( 11, 33) = 0.196485E+01
+ PKER_SWETH( 11, 34) = 0.199318E+01
+ PKER_SWETH( 11, 35) = 0.201894E+01
+ PKER_SWETH( 11, 36) = 0.204243E+01
+ PKER_SWETH( 11, 37) = 0.206393E+01
+ PKER_SWETH( 11, 38) = 0.208369E+01
+ PKER_SWETH( 11, 39) = 0.210188E+01
+ PKER_SWETH( 11, 40) = 0.211869E+01
+ PKER_SWETH( 11, 41) = 0.213425E+01
+ PKER_SWETH( 11, 42) = 0.214869E+01
+ PKER_SWETH( 11, 43) = 0.216211E+01
+ PKER_SWETH( 11, 44) = 0.217461E+01
+ PKER_SWETH( 11, 45) = 0.218626E+01
+ PKER_SWETH( 11, 46) = 0.219713E+01
+ PKER_SWETH( 11, 47) = 0.220729E+01
+ PKER_SWETH( 11, 48) = 0.221679E+01
+ PKER_SWETH( 11, 49) = 0.222567E+01
+ PKER_SWETH( 11, 50) = 0.223399E+01
+ PKER_SWETH( 11, 51) = 0.224178E+01
+ PKER_SWETH( 11, 52) = 0.224908E+01
+ PKER_SWETH( 11, 53) = 0.225592E+01
+ PKER_SWETH( 11, 54) = 0.226233E+01
+ PKER_SWETH( 11, 55) = 0.226835E+01
+ PKER_SWETH( 11, 56) = 0.227399E+01
+ PKER_SWETH( 11, 57) = 0.227928E+01
+ PKER_SWETH( 11, 58) = 0.228425E+01
+ PKER_SWETH( 11, 59) = 0.228891E+01
+ PKER_SWETH( 11, 60) = 0.229329E+01
+ PKER_SWETH( 11, 61) = 0.229739E+01
+ PKER_SWETH( 11, 62) = 0.230124E+01
+ PKER_SWETH( 11, 63) = 0.230486E+01
+ PKER_SWETH( 11, 64) = 0.230826E+01
+ PKER_SWETH( 11, 65) = 0.231144E+01
+ PKER_SWETH( 11, 66) = 0.231444E+01
+ PKER_SWETH( 11, 67) = 0.231724E+01
+ PKER_SWETH( 11, 68) = 0.231988E+01
+ PKER_SWETH( 11, 69) = 0.232236E+01
+ PKER_SWETH( 11, 70) = 0.232468E+01
+ PKER_SWETH( 11, 71) = 0.232687E+01
+ PKER_SWETH( 11, 72) = 0.232892E+01
+ PKER_SWETH( 11, 73) = 0.233084E+01
+ PKER_SWETH( 11, 74) = 0.233265E+01
+ PKER_SWETH( 11, 75) = 0.233434E+01
+ PKER_SWETH( 11, 76) = 0.233594E+01
+ PKER_SWETH( 11, 77) = 0.233743E+01
+ PKER_SWETH( 11, 78) = 0.233884E+01
+ PKER_SWETH( 11, 79) = 0.234016E+01
+ PKER_SWETH( 11, 80) = 0.234140E+01
+ PKER_SWETH( 12, 1) = 0.145894E+01
+ PKER_SWETH( 12, 2) = 0.126502E+01
+ PKER_SWETH( 12, 3) = 0.108573E+01
+ PKER_SWETH( 12, 4) = 0.922022E+00
+ PKER_SWETH( 12, 5) = 0.775551E+00
+ PKER_SWETH( 12, 6) = 0.648490E+00
+ PKER_SWETH( 12, 7) = 0.543095E+00
+ PKER_SWETH( 12, 8) = 0.461483E+00
+ PKER_SWETH( 12, 9) = 0.405081E+00
+ PKER_SWETH( 12, 10) = 0.373938E+00
+ PKER_SWETH( 12, 11) = 0.367149E+00
+ PKER_SWETH( 12, 12) = 0.382311E+00
+ PKER_SWETH( 12, 13) = 0.416306E+00
+ PKER_SWETH( 12, 14) = 0.465232E+00
+ PKER_SWETH( 12, 15) = 0.525344E+00
+ PKER_SWETH( 12, 16) = 0.593373E+00
+ PKER_SWETH( 12, 17) = 0.666351E+00
+ PKER_SWETH( 12, 18) = 0.742209E+00
+ PKER_SWETH( 12, 19) = 0.819328E+00
+ PKER_SWETH( 12, 20) = 0.896597E+00
+ PKER_SWETH( 12, 21) = 0.973187E+00
+ PKER_SWETH( 12, 22) = 0.104838E+01
+ PKER_SWETH( 12, 23) = 0.112146E+01
+ PKER_SWETH( 12, 24) = 0.119172E+01
+ PKER_SWETH( 12, 25) = 0.125842E+01
+ PKER_SWETH( 12, 26) = 0.132096E+01
+ PKER_SWETH( 12, 27) = 0.137888E+01
+ PKER_SWETH( 12, 28) = 0.143197E+01
+ PKER_SWETH( 12, 29) = 0.148024E+01
+ PKER_SWETH( 12, 30) = 0.152388E+01
+ PKER_SWETH( 12, 31) = 0.156323E+01
+ PKER_SWETH( 12, 32) = 0.159870E+01
+ PKER_SWETH( 12, 33) = 0.163070E+01
+ PKER_SWETH( 12, 34) = 0.165963E+01
+ PKER_SWETH( 12, 35) = 0.168589E+01
+ PKER_SWETH( 12, 36) = 0.170978E+01
+ PKER_SWETH( 12, 37) = 0.173161E+01
+ PKER_SWETH( 12, 38) = 0.175162E+01
+ PKER_SWETH( 12, 39) = 0.177002E+01
+ PKER_SWETH( 12, 40) = 0.178699E+01
+ PKER_SWETH( 12, 41) = 0.180268E+01
+ PKER_SWETH( 12, 42) = 0.181722E+01
+ PKER_SWETH( 12, 43) = 0.183072E+01
+ PKER_SWETH( 12, 44) = 0.184328E+01
+ PKER_SWETH( 12, 45) = 0.185498E+01
+ PKER_SWETH( 12, 46) = 0.186588E+01
+ PKER_SWETH( 12, 47) = 0.187607E+01
+ PKER_SWETH( 12, 48) = 0.188559E+01
+ PKER_SWETH( 12, 49) = 0.189449E+01
+ PKER_SWETH( 12, 50) = 0.190282E+01
+ PKER_SWETH( 12, 51) = 0.191063E+01
+ PKER_SWETH( 12, 52) = 0.191793E+01
+ PKER_SWETH( 12, 53) = 0.192478E+01
+ PKER_SWETH( 12, 54) = 0.193120E+01
+ PKER_SWETH( 12, 55) = 0.193722E+01
+ PKER_SWETH( 12, 56) = 0.194286E+01
+ PKER_SWETH( 12, 57) = 0.194816E+01
+ PKER_SWETH( 12, 58) = 0.195313E+01
+ PKER_SWETH( 12, 59) = 0.195779E+01
+ PKER_SWETH( 12, 60) = 0.196217E+01
+ PKER_SWETH( 12, 61) = 0.196627E+01
+ PKER_SWETH( 12, 62) = 0.197013E+01
+ PKER_SWETH( 12, 63) = 0.197374E+01
+ PKER_SWETH( 12, 64) = 0.197714E+01
+ PKER_SWETH( 12, 65) = 0.198033E+01
+ PKER_SWETH( 12, 66) = 0.198332E+01
+ PKER_SWETH( 12, 67) = 0.198613E+01
+ PKER_SWETH( 12, 68) = 0.198877E+01
+ PKER_SWETH( 12, 69) = 0.199124E+01
+ PKER_SWETH( 12, 70) = 0.199357E+01
+ PKER_SWETH( 12, 71) = 0.199575E+01
+ PKER_SWETH( 12, 72) = 0.199780E+01
+ PKER_SWETH( 12, 73) = 0.199973E+01
+ PKER_SWETH( 12, 74) = 0.200153E+01
+ PKER_SWETH( 12, 75) = 0.200323E+01
+ PKER_SWETH( 12, 76) = 0.200482E+01
+ PKER_SWETH( 12, 77) = 0.200632E+01
+ PKER_SWETH( 12, 78) = 0.200772E+01
+ PKER_SWETH( 12, 79) = 0.200904E+01
+ PKER_SWETH( 12, 80) = 0.201028E+01
+ PKER_SWETH( 13, 1) = 0.170405E+01
+ PKER_SWETH( 13, 2) = 0.150769E+01
+ PKER_SWETH( 13, 3) = 0.132375E+01
+ PKER_SWETH( 13, 4) = 0.115199E+01
+ PKER_SWETH( 13, 5) = 0.992573E+00
+ PKER_SWETH( 13, 6) = 0.846175E+00
+ PKER_SWETH( 13, 7) = 0.713998E+00
+ PKER_SWETH( 13, 8) = 0.597806E+00
+ PKER_SWETH( 13, 9) = 0.499584E+00
+ PKER_SWETH( 13, 10) = 0.421275E+00
+ PKER_SWETH( 13, 11) = 0.364551E+00
+ PKER_SWETH( 13, 12) = 0.329932E+00
+ PKER_SWETH( 13, 13) = 0.316966E+00
+ PKER_SWETH( 13, 14) = 0.324306E+00
+ PKER_SWETH( 13, 15) = 0.349233E+00
+ PKER_SWETH( 13, 16) = 0.388790E+00
+ PKER_SWETH( 13, 17) = 0.439524E+00
+ PKER_SWETH( 13, 18) = 0.498464E+00
+ PKER_SWETH( 13, 19) = 0.562783E+00
+ PKER_SWETH( 13, 20) = 0.630325E+00
+ PKER_SWETH( 13, 21) = 0.699430E+00
+ PKER_SWETH( 13, 22) = 0.768779E+00
+ PKER_SWETH( 13, 23) = 0.837340E+00
+ PKER_SWETH( 13, 24) = 0.904222E+00
+ PKER_SWETH( 13, 25) = 0.968619E+00
+ PKER_SWETH( 13, 26) = 0.102980E+01
+ PKER_SWETH( 13, 27) = 0.108719E+01
+ PKER_SWETH( 13, 28) = 0.114036E+01
+ PKER_SWETH( 13, 29) = 0.118912E+01
+ PKER_SWETH( 13, 30) = 0.123349E+01
+ PKER_SWETH( 13, 31) = 0.127366E+01
+ PKER_SWETH( 13, 32) = 0.130993E+01
+ PKER_SWETH( 13, 33) = 0.134267E+01
+ PKER_SWETH( 13, 34) = 0.137225E+01
+ PKER_SWETH( 13, 35) = 0.139905E+01
+ PKER_SWETH( 13, 36) = 0.142339E+01
+ PKER_SWETH( 13, 37) = 0.144558E+01
+ PKER_SWETH( 13, 38) = 0.146588E+01
+ PKER_SWETH( 13, 39) = 0.148451E+01
+ PKER_SWETH( 13, 40) = 0.150167E+01
+ PKER_SWETH( 13, 41) = 0.151750E+01
+ PKER_SWETH( 13, 42) = 0.153215E+01
+ PKER_SWETH( 13, 43) = 0.154574E+01
+ PKER_SWETH( 13, 44) = 0.155836E+01
+ PKER_SWETH( 13, 45) = 0.157012E+01
+ PKER_SWETH( 13, 46) = 0.158107E+01
+ PKER_SWETH( 13, 47) = 0.159129E+01
+ PKER_SWETH( 13, 48) = 0.160083E+01
+ PKER_SWETH( 13, 49) = 0.160975E+01
+ PKER_SWETH( 13, 50) = 0.161810E+01
+ PKER_SWETH( 13, 51) = 0.162591E+01
+ PKER_SWETH( 13, 52) = 0.163323E+01
+ PKER_SWETH( 13, 53) = 0.164009E+01
+ PKER_SWETH( 13, 54) = 0.164651E+01
+ PKER_SWETH( 13, 55) = 0.165254E+01
+ PKER_SWETH( 13, 56) = 0.165818E+01
+ PKER_SWETH( 13, 57) = 0.166348E+01
+ PKER_SWETH( 13, 58) = 0.166845E+01
+ PKER_SWETH( 13, 59) = 0.167312E+01
+ PKER_SWETH( 13, 60) = 0.167749E+01
+ PKER_SWETH( 13, 61) = 0.168160E+01
+ PKER_SWETH( 13, 62) = 0.168546E+01
+ PKER_SWETH( 13, 63) = 0.168907E+01
+ PKER_SWETH( 13, 64) = 0.169247E+01
+ PKER_SWETH( 13, 65) = 0.169566E+01
+ PKER_SWETH( 13, 66) = 0.169865E+01
+ PKER_SWETH( 13, 67) = 0.170146E+01
+ PKER_SWETH( 13, 68) = 0.170410E+01
+ PKER_SWETH( 13, 69) = 0.170658E+01
+ PKER_SWETH( 13, 70) = 0.170890E+01
+ PKER_SWETH( 13, 71) = 0.171108E+01
+ PKER_SWETH( 13, 72) = 0.171313E+01
+ PKER_SWETH( 13, 73) = 0.171506E+01
+ PKER_SWETH( 13, 74) = 0.171687E+01
+ PKER_SWETH( 13, 75) = 0.171856E+01
+ PKER_SWETH( 13, 76) = 0.172016E+01
+ PKER_SWETH( 13, 77) = 0.172165E+01
+ PKER_SWETH( 13, 78) = 0.172306E+01
+ PKER_SWETH( 13, 79) = 0.172437E+01
+ PKER_SWETH( 13, 80) = 0.172561E+01
+ PKER_SWETH( 14, 1) = 0.191644E+01
+ PKER_SWETH( 14, 2) = 0.171981E+01
+ PKER_SWETH( 14, 3) = 0.153516E+01
+ PKER_SWETH( 14, 4) = 0.136183E+01
+ PKER_SWETH( 14, 5) = 0.119931E+01
+ PKER_SWETH( 14, 6) = 0.104729E+01
+ PKER_SWETH( 14, 7) = 0.905766E+00
+ PKER_SWETH( 14, 8) = 0.775129E+00
+ PKER_SWETH( 14, 9) = 0.656292E+00
+ PKER_SWETH( 14, 10) = 0.550615E+00
+ PKER_SWETH( 14, 11) = 0.459778E+00
+ PKER_SWETH( 14, 12) = 0.385647E+00
+ PKER_SWETH( 14, 13) = 0.329785E+00
+ PKER_SWETH( 14, 14) = 0.293160E+00
+ PKER_SWETH( 14, 15) = 0.275937E+00
+ PKER_SWETH( 14, 16) = 0.276977E+00
+ PKER_SWETH( 14, 17) = 0.294714E+00
+ PKER_SWETH( 14, 18) = 0.326332E+00
+ PKER_SWETH( 14, 19) = 0.369117E+00
+ PKER_SWETH( 14, 20) = 0.420187E+00
+ PKER_SWETH( 14, 21) = 0.476869E+00
+ PKER_SWETH( 14, 22) = 0.536997E+00
+ PKER_SWETH( 14, 23) = 0.598735E+00
+ PKER_SWETH( 14, 24) = 0.660650E+00
+ PKER_SWETH( 14, 25) = 0.721544E+00
+ PKER_SWETH( 14, 26) = 0.780441E+00
+ PKER_SWETH( 14, 27) = 0.836536E+00
+ PKER_SWETH( 14, 28) = 0.889213E+00
+ PKER_SWETH( 14, 29) = 0.938066E+00
+ PKER_SWETH( 14, 30) = 0.982909E+00
+ PKER_SWETH( 14, 31) = 0.102375E+01
+ PKER_SWETH( 14, 32) = 0.106077E+01
+ PKER_SWETH( 14, 33) = 0.109424E+01
+ PKER_SWETH( 14, 34) = 0.112450E+01
+ PKER_SWETH( 14, 35) = 0.115187E+01
+ PKER_SWETH( 14, 36) = 0.117671E+01
+ PKER_SWETH( 14, 37) = 0.119930E+01
+ PKER_SWETH( 14, 38) = 0.121993E+01
+ PKER_SWETH( 14, 39) = 0.123882E+01
+ PKER_SWETH( 14, 40) = 0.125618E+01
+ PKER_SWETH( 14, 41) = 0.127218E+01
+ PKER_SWETH( 14, 42) = 0.128696E+01
+ PKER_SWETH( 14, 43) = 0.130065E+01
+ PKER_SWETH( 14, 44) = 0.131335E+01
+ PKER_SWETH( 14, 45) = 0.132516E+01
+ PKER_SWETH( 14, 46) = 0.133616E+01
+ PKER_SWETH( 14, 47) = 0.134642E+01
+ PKER_SWETH( 14, 48) = 0.135599E+01
+ PKER_SWETH( 14, 49) = 0.136494E+01
+ PKER_SWETH( 14, 50) = 0.137330E+01
+ PKER_SWETH( 14, 51) = 0.138113E+01
+ PKER_SWETH( 14, 52) = 0.138846E+01
+ PKER_SWETH( 14, 53) = 0.139532E+01
+ PKER_SWETH( 14, 54) = 0.140175E+01
+ PKER_SWETH( 14, 55) = 0.140778E+01
+ PKER_SWETH( 14, 56) = 0.141343E+01
+ PKER_SWETH( 14, 57) = 0.141874E+01
+ PKER_SWETH( 14, 58) = 0.142371E+01
+ PKER_SWETH( 14, 59) = 0.142837E+01
+ PKER_SWETH( 14, 60) = 0.143275E+01
+ PKER_SWETH( 14, 61) = 0.143686E+01
+ PKER_SWETH( 14, 62) = 0.144072E+01
+ PKER_SWETH( 14, 63) = 0.144434E+01
+ PKER_SWETH( 14, 64) = 0.144773E+01
+ PKER_SWETH( 14, 65) = 0.145092E+01
+ PKER_SWETH( 14, 66) = 0.145391E+01
+ PKER_SWETH( 14, 67) = 0.145672E+01
+ PKER_SWETH( 14, 68) = 0.145936E+01
+ PKER_SWETH( 14, 69) = 0.146184E+01
+ PKER_SWETH( 14, 70) = 0.146416E+01
+ PKER_SWETH( 14, 71) = 0.146635E+01
+ PKER_SWETH( 14, 72) = 0.146840E+01
+ PKER_SWETH( 14, 73) = 0.147032E+01
+ PKER_SWETH( 14, 74) = 0.147213E+01
+ PKER_SWETH( 14, 75) = 0.147383E+01
+ PKER_SWETH( 14, 76) = 0.147542E+01
+ PKER_SWETH( 14, 77) = 0.147692E+01
+ PKER_SWETH( 14, 78) = 0.147832E+01
+ PKER_SWETH( 14, 79) = 0.147964E+01
+ PKER_SWETH( 14, 80) = 0.148088E+01
+ PKER_SWETH( 15, 1) = 0.209919E+01
+ PKER_SWETH( 15, 2) = 0.190259E+01
+ PKER_SWETH( 15, 3) = 0.171794E+01
+ PKER_SWETH( 15, 4) = 0.154449E+01
+ PKER_SWETH( 15, 5) = 0.138158E+01
+ PKER_SWETH( 15, 6) = 0.122859E+01
+ PKER_SWETH( 15, 7) = 0.108503E+01
+ PKER_SWETH( 15, 8) = 0.950547E+00
+ PKER_SWETH( 15, 9) = 0.825033E+00
+ PKER_SWETH( 15, 10) = 0.708693E+00
+ PKER_SWETH( 15, 11) = 0.602154E+00
+ PKER_SWETH( 15, 12) = 0.506482E+00
+ PKER_SWETH( 15, 13) = 0.423037E+00
+ PKER_SWETH( 15, 14) = 0.353533E+00
+ PKER_SWETH( 15, 15) = 0.299551E+00
+ PKER_SWETH( 15, 16) = 0.262102E+00
+ PKER_SWETH( 15, 17) = 0.241884E+00
+ PKER_SWETH( 15, 18) = 0.238413E+00
+ PKER_SWETH( 15, 19) = 0.250171E+00
+ PKER_SWETH( 15, 20) = 0.275347E+00
+ PKER_SWETH( 15, 21) = 0.311363E+00
+ PKER_SWETH( 15, 22) = 0.355624E+00
+ PKER_SWETH( 15, 23) = 0.405543E+00
+ PKER_SWETH( 15, 24) = 0.458917E+00
+ PKER_SWETH( 15, 25) = 0.513821E+00
+ PKER_SWETH( 15, 26) = 0.568682E+00
+ PKER_SWETH( 15, 27) = 0.622251E+00
+ PKER_SWETH( 15, 28) = 0.673551E+00
+ PKER_SWETH( 15, 29) = 0.721876E+00
+ PKER_SWETH( 15, 30) = 0.766778E+00
+ PKER_SWETH( 15, 31) = 0.808050E+00
+ PKER_SWETH( 15, 32) = 0.845689E+00
+ PKER_SWETH( 15, 33) = 0.879844E+00
+ PKER_SWETH( 15, 34) = 0.910766E+00
+ PKER_SWETH( 15, 35) = 0.938752E+00
+ PKER_SWETH( 15, 36) = 0.964114E+00
+ PKER_SWETH( 15, 37) = 0.987153E+00
+ PKER_SWETH( 15, 38) = 0.100814E+01
+ PKER_SWETH( 15, 39) = 0.102733E+01
+ PKER_SWETH( 15, 40) = 0.104492E+01
+ PKER_SWETH( 15, 41) = 0.106110E+01
+ PKER_SWETH( 15, 42) = 0.107603E+01
+ PKER_SWETH( 15, 43) = 0.108984E+01
+ PKER_SWETH( 15, 44) = 0.110263E+01
+ PKER_SWETH( 15, 45) = 0.111451E+01
+ PKER_SWETH( 15, 46) = 0.112557E+01
+ PKER_SWETH( 15, 47) = 0.113587E+01
+ PKER_SWETH( 15, 48) = 0.114547E+01
+ PKER_SWETH( 15, 49) = 0.115444E+01
+ PKER_SWETH( 15, 50) = 0.116283E+01
+ PKER_SWETH( 15, 51) = 0.117067E+01
+ PKER_SWETH( 15, 52) = 0.117801E+01
+ PKER_SWETH( 15, 53) = 0.118488E+01
+ PKER_SWETH( 15, 54) = 0.119132E+01
+ PKER_SWETH( 15, 55) = 0.119736E+01
+ PKER_SWETH( 15, 56) = 0.120301E+01
+ PKER_SWETH( 15, 57) = 0.120832E+01
+ PKER_SWETH( 15, 58) = 0.121329E+01
+ PKER_SWETH( 15, 59) = 0.121796E+01
+ PKER_SWETH( 15, 60) = 0.122234E+01
+ PKER_SWETH( 15, 61) = 0.122645E+01
+ PKER_SWETH( 15, 62) = 0.123031E+01
+ PKER_SWETH( 15, 63) = 0.123393E+01
+ PKER_SWETH( 15, 64) = 0.123732E+01
+ PKER_SWETH( 15, 65) = 0.124051E+01
+ PKER_SWETH( 15, 66) = 0.124351E+01
+ PKER_SWETH( 15, 67) = 0.124632E+01
+ PKER_SWETH( 15, 68) = 0.124896E+01
+ PKER_SWETH( 15, 69) = 0.125143E+01
+ PKER_SWETH( 15, 70) = 0.125376E+01
+ PKER_SWETH( 15, 71) = 0.125594E+01
+ PKER_SWETH( 15, 72) = 0.125799E+01
+ PKER_SWETH( 15, 73) = 0.125992E+01
+ PKER_SWETH( 15, 74) = 0.126172E+01
+ PKER_SWETH( 15, 75) = 0.126342E+01
+ PKER_SWETH( 15, 76) = 0.126501E+01
+ PKER_SWETH( 15, 77) = 0.126651E+01
+ PKER_SWETH( 15, 78) = 0.126792E+01
+ PKER_SWETH( 15, 79) = 0.126923E+01
+ PKER_SWETH( 15, 80) = 0.127047E+01
+ PKER_SWETH( 16, 1) = 0.225627E+01
+ PKER_SWETH( 16, 2) = 0.205974E+01
+ PKER_SWETH( 16, 3) = 0.187515E+01
+ PKER_SWETH( 16, 4) = 0.170176E+01
+ PKER_SWETH( 16, 5) = 0.153889E+01
+ PKER_SWETH( 16, 6) = 0.138588E+01
+ PKER_SWETH( 16, 7) = 0.124213E+01
+ PKER_SWETH( 16, 8) = 0.110710E+01
+ PKER_SWETH( 16, 9) = 0.980292E+00
+ PKER_SWETH( 16, 10) = 0.861366E+00
+ PKER_SWETH( 16, 11) = 0.750132E+00
+ PKER_SWETH( 16, 12) = 0.646663E+00
+ PKER_SWETH( 16, 13) = 0.551374E+00
+ PKER_SWETH( 16, 14) = 0.465058E+00
+ PKER_SWETH( 16, 15) = 0.388869E+00
+ PKER_SWETH( 16, 16) = 0.324265E+00
+ PKER_SWETH( 16, 17) = 0.272776E+00
+ PKER_SWETH( 16, 18) = 0.235577E+00
+ PKER_SWETH( 16, 19) = 0.213511E+00
+ PKER_SWETH( 16, 20) = 0.206520E+00
+ PKER_SWETH( 16, 21) = 0.213797E+00
+ PKER_SWETH( 16, 22) = 0.233640E+00
+ PKER_SWETH( 16, 23) = 0.263928E+00
+ PKER_SWETH( 16, 24) = 0.302257E+00
+ PKER_SWETH( 16, 25) = 0.346122E+00
+ PKER_SWETH( 16, 26) = 0.393290E+00
+ PKER_SWETH( 16, 27) = 0.441774E+00
+ PKER_SWETH( 16, 28) = 0.489947E+00
+ PKER_SWETH( 16, 29) = 0.536578E+00
+ PKER_SWETH( 16, 30) = 0.580787E+00
+ PKER_SWETH( 16, 31) = 0.622021E+00
+ PKER_SWETH( 16, 32) = 0.660014E+00
+ PKER_SWETH( 16, 33) = 0.694722E+00
+ PKER_SWETH( 16, 34) = 0.726265E+00
+ PKER_SWETH( 16, 35) = 0.754860E+00
+ PKER_SWETH( 16, 36) = 0.780775E+00
+ PKER_SWETH( 16, 37) = 0.804293E+00
+ PKER_SWETH( 16, 38) = 0.825685E+00
+ PKER_SWETH( 16, 39) = 0.845200E+00
+ PKER_SWETH( 16, 40) = 0.863058E+00
+ PKER_SWETH( 16, 41) = 0.879451E+00
+ PKER_SWETH( 16, 42) = 0.894545E+00
+ PKER_SWETH( 16, 43) = 0.908480E+00
+ PKER_SWETH( 16, 44) = 0.921377E+00
+ PKER_SWETH( 16, 45) = 0.933340E+00
+ PKER_SWETH( 16, 46) = 0.944457E+00
+ PKER_SWETH( 16, 47) = 0.954804E+00
+ PKER_SWETH( 16, 48) = 0.964449E+00
+ PKER_SWETH( 16, 49) = 0.973449E+00
+ PKER_SWETH( 16, 50) = 0.981857E+00
+ PKER_SWETH( 16, 51) = 0.989717E+00
+ PKER_SWETH( 16, 52) = 0.997071E+00
+ PKER_SWETH( 16, 53) = 0.100395E+01
+ PKER_SWETH( 16, 54) = 0.101040E+01
+ PKER_SWETH( 16, 55) = 0.101644E+01
+ PKER_SWETH( 16, 56) = 0.102211E+01
+ PKER_SWETH( 16, 57) = 0.102741E+01
+ PKER_SWETH( 16, 58) = 0.103239E+01
+ PKER_SWETH( 16, 59) = 0.103706E+01
+ PKER_SWETH( 16, 60) = 0.104144E+01
+ PKER_SWETH( 16, 61) = 0.104556E+01
+ PKER_SWETH( 16, 62) = 0.104941E+01
+ PKER_SWETH( 16, 63) = 0.105303E+01
+ PKER_SWETH( 16, 64) = 0.105643E+01
+ PKER_SWETH( 16, 65) = 0.105962E+01
+ PKER_SWETH( 16, 66) = 0.106262E+01
+ PKER_SWETH( 16, 67) = 0.106543E+01
+ PKER_SWETH( 16, 68) = 0.106807E+01
+ PKER_SWETH( 16, 69) = 0.107054E+01
+ PKER_SWETH( 16, 70) = 0.107287E+01
+ PKER_SWETH( 16, 71) = 0.107505E+01
+ PKER_SWETH( 16, 72) = 0.107710E+01
+ PKER_SWETH( 16, 73) = 0.107903E+01
+ PKER_SWETH( 16, 74) = 0.108083E+01
+ PKER_SWETH( 16, 75) = 0.108253E+01
+ PKER_SWETH( 16, 76) = 0.108412E+01
+ PKER_SWETH( 16, 77) = 0.108562E+01
+ PKER_SWETH( 16, 78) = 0.108703E+01
+ PKER_SWETH( 16, 79) = 0.108834E+01
+ PKER_SWETH( 16, 80) = 0.108958E+01
+ PKER_SWETH( 17, 1) = 0.239130E+01
+ PKER_SWETH( 17, 2) = 0.219480E+01
+ PKER_SWETH( 17, 3) = 0.201026E+01
+ PKER_SWETH( 17, 4) = 0.183694E+01
+ PKER_SWETH( 17, 5) = 0.167414E+01
+ PKER_SWETH( 17, 6) = 0.152122E+01
+ PKER_SWETH( 17, 7) = 0.137754E+01
+ PKER_SWETH( 17, 8) = 0.124255E+01
+ PKER_SWETH( 17, 9) = 0.111570E+01
+ PKER_SWETH( 17, 10) = 0.996495E+00
+ PKER_SWETH( 17, 11) = 0.884490E+00
+ PKER_SWETH( 17, 12) = 0.779332E+00
+ PKER_SWETH( 17, 13) = 0.680798E+00
+ PKER_SWETH( 17, 14) = 0.588860E+00
+ PKER_SWETH( 17, 15) = 0.503782E+00
+ PKER_SWETH( 17, 16) = 0.426137E+00
+ PKER_SWETH( 17, 17) = 0.356873E+00
+ PKER_SWETH( 17, 18) = 0.297270E+00
+ PKER_SWETH( 17, 19) = 0.248688E+00
+ PKER_SWETH( 17, 20) = 0.212450E+00
+ PKER_SWETH( 17, 21) = 0.189516E+00
+ PKER_SWETH( 17, 22) = 0.180089E+00
+ PKER_SWETH( 17, 23) = 0.183781E+00
+ PKER_SWETH( 17, 24) = 0.199287E+00
+ PKER_SWETH( 17, 25) = 0.224789E+00
+ PKER_SWETH( 17, 26) = 0.257938E+00
+ PKER_SWETH( 17, 27) = 0.296342E+00
+ PKER_SWETH( 17, 28) = 0.337770E+00
+ PKER_SWETH( 17, 29) = 0.380196E+00
+ PKER_SWETH( 17, 30) = 0.422074E+00
+ PKER_SWETH( 17, 31) = 0.462252E+00
+ PKER_SWETH( 17, 32) = 0.499999E+00
+ PKER_SWETH( 17, 33) = 0.534934E+00
+ PKER_SWETH( 17, 34) = 0.566940E+00
+ PKER_SWETH( 17, 35) = 0.596084E+00
+ PKER_SWETH( 17, 36) = 0.622549E+00
+ PKER_SWETH( 17, 37) = 0.646567E+00
+ PKER_SWETH( 17, 38) = 0.668394E+00
+ PKER_SWETH( 17, 39) = 0.688272E+00
+ PKER_SWETH( 17, 40) = 0.706427E+00
+ PKER_SWETH( 17, 41) = 0.723060E+00
+ PKER_SWETH( 17, 42) = 0.738344E+00
+ PKER_SWETH( 17, 43) = 0.752430E+00
+ PKER_SWETH( 17, 44) = 0.765446E+00
+ PKER_SWETH( 17, 45) = 0.777501E+00
+ PKER_SWETH( 17, 46) = 0.788690E+00
+ PKER_SWETH( 17, 47) = 0.799094E+00
+ PKER_SWETH( 17, 48) = 0.808782E+00
+ PKER_SWETH( 17, 49) = 0.817816E+00
+ PKER_SWETH( 17, 50) = 0.826250E+00
+ PKER_SWETH( 17, 51) = 0.834130E+00
+ PKER_SWETH( 17, 52) = 0.841500E+00
+ PKER_SWETH( 17, 53) = 0.848396E+00
+ PKER_SWETH( 17, 54) = 0.854853E+00
+ PKER_SWETH( 17, 55) = 0.860901E+00
+ PKER_SWETH( 17, 56) = 0.866570E+00
+ PKER_SWETH( 17, 57) = 0.871883E+00
+ PKER_SWETH( 17, 58) = 0.876865E+00
+ PKER_SWETH( 17, 59) = 0.881538E+00
+ PKER_SWETH( 17, 60) = 0.885922E+00
+ PKER_SWETH( 17, 61) = 0.890034E+00
+ PKER_SWETH( 17, 62) = 0.893893E+00
+ PKER_SWETH( 17, 63) = 0.897515E+00
+ PKER_SWETH( 17, 64) = 0.900914E+00
+ PKER_SWETH( 17, 65) = 0.904104E+00
+ PKER_SWETH( 17, 66) = 0.907099E+00
+ PKER_SWETH( 17, 67) = 0.909910E+00
+ PKER_SWETH( 17, 68) = 0.912549E+00
+ PKER_SWETH( 17, 69) = 0.915026E+00
+ PKER_SWETH( 17, 70) = 0.917352E+00
+ PKER_SWETH( 17, 71) = 0.919536E+00
+ PKER_SWETH( 17, 72) = 0.921586E+00
+ PKER_SWETH( 17, 73) = 0.923511E+00
+ PKER_SWETH( 17, 74) = 0.925319E+00
+ PKER_SWETH( 17, 75) = 0.927015E+00
+ PKER_SWETH( 17, 76) = 0.928609E+00
+ PKER_SWETH( 17, 77) = 0.930105E+00
+ PKER_SWETH( 17, 78) = 0.931509E+00
+ PKER_SWETH( 17, 79) = 0.932828E+00
+ PKER_SWETH( 17, 80) = 0.934067E+00
+ PKER_SWETH( 18, 1) = 0.250736E+01
+ PKER_SWETH( 18, 2) = 0.231089E+01
+ PKER_SWETH( 18, 3) = 0.212639E+01
+ PKER_SWETH( 18, 4) = 0.195312E+01
+ PKER_SWETH( 18, 5) = 0.179038E+01
+ PKER_SWETH( 18, 6) = 0.163752E+01
+ PKER_SWETH( 18, 7) = 0.149393E+01
+ PKER_SWETH( 18, 8) = 0.135903E+01
+ PKER_SWETH( 18, 9) = 0.123229E+01
+ PKER_SWETH( 18, 10) = 0.111318E+01
+ PKER_SWETH( 18, 11) = 0.100122E+01
+ PKER_SWETH( 18, 12) = 0.895967E+00
+ PKER_SWETH( 18, 13) = 0.797018E+00
+ PKER_SWETH( 18, 14) = 0.704029E+00
+ PKER_SWETH( 18, 15) = 0.616756E+00
+ PKER_SWETH( 18, 16) = 0.535113E+00
+ PKER_SWETH( 18, 17) = 0.459233E+00
+ PKER_SWETH( 18, 18) = 0.389543E+00
+ PKER_SWETH( 18, 19) = 0.326796E+00
+ PKER_SWETH( 18, 20) = 0.272095E+00
+ PKER_SWETH( 18, 21) = 0.226702E+00
+ PKER_SWETH( 18, 22) = 0.191896E+00
+ PKER_SWETH( 18, 23) = 0.168801E+00
+ PKER_SWETH( 18, 24) = 0.157853E+00
+ PKER_SWETH( 18, 25) = 0.158846E+00
+ PKER_SWETH( 18, 26) = 0.170918E+00
+ PKER_SWETH( 18, 27) = 0.192288E+00
+ PKER_SWETH( 18, 28) = 0.220881E+00
+ PKER_SWETH( 18, 29) = 0.254306E+00
+ PKER_SWETH( 18, 30) = 0.290385E+00
+ PKER_SWETH( 18, 31) = 0.327168E+00
+ PKER_SWETH( 18, 32) = 0.363206E+00
+ PKER_SWETH( 18, 33) = 0.397516E+00
+ PKER_SWETH( 18, 34) = 0.429526E+00
+ PKER_SWETH( 18, 35) = 0.458999E+00
+ PKER_SWETH( 18, 36) = 0.485922E+00
+ PKER_SWETH( 18, 37) = 0.510423E+00
+ PKER_SWETH( 18, 38) = 0.532699E+00
+ PKER_SWETH( 18, 39) = 0.552969E+00
+ PKER_SWETH( 18, 40) = 0.571453E+00
+ PKER_SWETH( 18, 41) = 0.588356E+00
+ PKER_SWETH( 18, 42) = 0.603857E+00
+ PKER_SWETH( 18, 43) = 0.618115E+00
+ PKER_SWETH( 18, 44) = 0.631267E+00
+ PKER_SWETH( 18, 45) = 0.643428E+00
+ PKER_SWETH( 18, 46) = 0.654700E+00
+ PKER_SWETH( 18, 47) = 0.665169E+00
+ PKER_SWETH( 18, 48) = 0.674907E+00
+ PKER_SWETH( 18, 49) = 0.683980E+00
+ PKER_SWETH( 18, 50) = 0.692444E+00
+ PKER_SWETH( 18, 51) = 0.700348E+00
+ PKER_SWETH( 18, 52) = 0.707736E+00
+ PKER_SWETH( 18, 53) = 0.714646E+00
+ PKER_SWETH( 18, 54) = 0.721114E+00
+ PKER_SWETH( 18, 55) = 0.727171E+00
+ PKER_SWETH( 18, 56) = 0.732846E+00
+ PKER_SWETH( 18, 57) = 0.738165E+00
+ PKER_SWETH( 18, 58) = 0.743151E+00
+ PKER_SWETH( 18, 59) = 0.747827E+00
+ PKER_SWETH( 18, 60) = 0.752213E+00
+ PKER_SWETH( 18, 61) = 0.756327E+00
+ PKER_SWETH( 18, 62) = 0.760188E+00
+ PKER_SWETH( 18, 63) = 0.763810E+00
+ PKER_SWETH( 18, 64) = 0.767210E+00
+ PKER_SWETH( 18, 65) = 0.770401E+00
+ PKER_SWETH( 18, 66) = 0.773396E+00
+ PKER_SWETH( 18, 67) = 0.776208E+00
+ PKER_SWETH( 18, 68) = 0.778847E+00
+ PKER_SWETH( 18, 69) = 0.781325E+00
+ PKER_SWETH( 18, 70) = 0.783651E+00
+ PKER_SWETH( 18, 71) = 0.785835E+00
+ PKER_SWETH( 18, 72) = 0.787885E+00
+ PKER_SWETH( 18, 73) = 0.789810E+00
+ PKER_SWETH( 18, 74) = 0.791618E+00
+ PKER_SWETH( 18, 75) = 0.793315E+00
+ PKER_SWETH( 18, 76) = 0.794908E+00
+ PKER_SWETH( 18, 77) = 0.796404E+00
+ PKER_SWETH( 18, 78) = 0.797809E+00
+ PKER_SWETH( 18, 79) = 0.799128E+00
+ PKER_SWETH( 18, 80) = 0.800366E+00
+ PKER_SWETH( 19, 1) = 0.260712E+01
+ PKER_SWETH( 19, 2) = 0.241068E+01
+ PKER_SWETH( 19, 3) = 0.222621E+01
+ PKER_SWETH( 19, 4) = 0.205297E+01
+ PKER_SWETH( 19, 5) = 0.189027E+01
+ PKER_SWETH( 19, 6) = 0.173746E+01
+ PKER_SWETH( 19, 7) = 0.159394E+01
+ PKER_SWETH( 19, 8) = 0.145912E+01
+ PKER_SWETH( 19, 9) = 0.133246E+01
+ PKER_SWETH( 19, 10) = 0.121346E+01
+ PKER_SWETH( 19, 11) = 0.110163E+01
+ PKER_SWETH( 19, 12) = 0.996507E+00
+ PKER_SWETH( 19, 13) = 0.897673E+00
+ PKER_SWETH( 19, 14) = 0.804722E+00
+ PKER_SWETH( 19, 15) = 0.717285E+00
+ PKER_SWETH( 19, 16) = 0.635038E+00
+ PKER_SWETH( 19, 17) = 0.557733E+00
+ PKER_SWETH( 19, 18) = 0.485242E+00
+ PKER_SWETH( 19, 19) = 0.417618E+00
+ PKER_SWETH( 19, 20) = 0.355152E+00
+ PKER_SWETH( 19, 21) = 0.298466E+00
+ PKER_SWETH( 19, 22) = 0.248486E+00
+ PKER_SWETH( 19, 23) = 0.206362E+00
+ PKER_SWETH( 19, 24) = 0.173382E+00
+ PKER_SWETH( 19, 25) = 0.150641E+00
+ PKER_SWETH( 19, 26) = 0.138811E+00
+ PKER_SWETH( 19, 27) = 0.137940E+00
+ PKER_SWETH( 19, 28) = 0.147153E+00
+ PKER_SWETH( 19, 29) = 0.165086E+00
+ PKER_SWETH( 19, 30) = 0.189581E+00
+ PKER_SWETH( 19, 31) = 0.218462E+00
+ PKER_SWETH( 19, 32) = 0.249591E+00
+ PKER_SWETH( 19, 33) = 0.281174E+00
+ PKER_SWETH( 19, 34) = 0.311929E+00
+ PKER_SWETH( 19, 35) = 0.341031E+00
+ PKER_SWETH( 19, 36) = 0.368064E+00
+ PKER_SWETH( 19, 37) = 0.392893E+00
+ PKER_SWETH( 19, 38) = 0.415567E+00
+ PKER_SWETH( 19, 39) = 0.436229E+00
+ PKER_SWETH( 19, 40) = 0.455063E+00
+ PKER_SWETH( 19, 41) = 0.472262E+00
+ PKER_SWETH( 19, 42) = 0.488006E+00
+ PKER_SWETH( 19, 43) = 0.502461E+00
+ PKER_SWETH( 19, 44) = 0.515768E+00
+ PKER_SWETH( 19, 45) = 0.528053E+00
+ PKER_SWETH( 19, 46) = 0.539421E+00
+ PKER_SWETH( 19, 47) = 0.549964E+00
+ PKER_SWETH( 19, 48) = 0.559761E+00
+ PKER_SWETH( 19, 49) = 0.568879E+00
+ PKER_SWETH( 19, 50) = 0.577378E+00
+ PKER_SWETH( 19, 51) = 0.585309E+00
+ PKER_SWETH( 19, 52) = 0.592718E+00
+ PKER_SWETH( 19, 53) = 0.599645E+00
+ PKER_SWETH( 19, 54) = 0.606125E+00
+ PKER_SWETH( 19, 55) = 0.612192E+00
+ PKER_SWETH( 19, 56) = 0.617874E+00
+ PKER_SWETH( 19, 57) = 0.623199E+00
+ PKER_SWETH( 19, 58) = 0.628190E+00
+ PKER_SWETH( 19, 59) = 0.632869E+00
+ PKER_SWETH( 19, 60) = 0.637258E+00
+ PKER_SWETH( 19, 61) = 0.641374E+00
+ PKER_SWETH( 19, 62) = 0.645237E+00
+ PKER_SWETH( 19, 63) = 0.648860E+00
+ PKER_SWETH( 19, 64) = 0.652261E+00
+ PKER_SWETH( 19, 65) = 0.655453E+00
+ PKER_SWETH( 19, 66) = 0.658449E+00
+ PKER_SWETH( 19, 67) = 0.661261E+00
+ PKER_SWETH( 19, 68) = 0.663901E+00
+ PKER_SWETH( 19, 69) = 0.666379E+00
+ PKER_SWETH( 19, 70) = 0.668705E+00
+ PKER_SWETH( 19, 71) = 0.670889E+00
+ PKER_SWETH( 19, 72) = 0.672939E+00
+ PKER_SWETH( 19, 73) = 0.674865E+00
+ PKER_SWETH( 19, 74) = 0.676672E+00
+ PKER_SWETH( 19, 75) = 0.678369E+00
+ PKER_SWETH( 19, 76) = 0.679963E+00
+ PKER_SWETH( 19, 77) = 0.681459E+00
+ PKER_SWETH( 19, 78) = 0.682863E+00
+ PKER_SWETH( 19, 79) = 0.684182E+00
+ PKER_SWETH( 19, 80) = 0.685421E+00
+ PKER_SWETH( 20, 1) = 0.269288E+01
+ PKER_SWETH( 20, 2) = 0.249646E+01
+ PKER_SWETH( 20, 3) = 0.231201E+01
+ PKER_SWETH( 20, 4) = 0.213879E+01
+ PKER_SWETH( 20, 5) = 0.197613E+01
+ PKER_SWETH( 20, 6) = 0.182336E+01
+ PKER_SWETH( 20, 7) = 0.167988E+01
+ PKER_SWETH( 20, 8) = 0.154512E+01
+ PKER_SWETH( 20, 9) = 0.141853E+01
+ PKER_SWETH( 20, 10) = 0.129961E+01
+ PKER_SWETH( 20, 11) = 0.118788E+01
+ PKER_SWETH( 20, 12) = 0.108288E+01
+ PKER_SWETH( 20, 13) = 0.984187E+00
+ PKER_SWETH( 20, 14) = 0.891397E+00
+ PKER_SWETH( 20, 15) = 0.804124E+00
+ PKER_SWETH( 20, 16) = 0.722009E+00
+ PKER_SWETH( 20, 17) = 0.644714E+00
+ PKER_SWETH( 20, 18) = 0.571940E+00
+ PKER_SWETH( 20, 19) = 0.503441E+00
+ PKER_SWETH( 20, 20) = 0.439066E+00
+ PKER_SWETH( 20, 21) = 0.378811E+00
+ PKER_SWETH( 20, 22) = 0.322879E+00
+ PKER_SWETH( 20, 23) = 0.271763E+00
+ PKER_SWETH( 20, 24) = 0.226263E+00
+ PKER_SWETH( 20, 25) = 0.187406E+00
+ PKER_SWETH( 20, 26) = 0.156446E+00
+ PKER_SWETH( 20, 27) = 0.134517E+00
+ PKER_SWETH( 20, 28) = 0.122305E+00
+ PKER_SWETH( 20, 29) = 0.120067E+00
+ PKER_SWETH( 20, 30) = 0.127125E+00
+ PKER_SWETH( 20, 31) = 0.142001E+00
+ PKER_SWETH( 20, 32) = 0.162875E+00
+ PKER_SWETH( 20, 33) = 0.187599E+00
+ PKER_SWETH( 20, 34) = 0.214210E+00
+ PKER_SWETH( 20, 35) = 0.241099E+00
+ PKER_SWETH( 20, 36) = 0.267168E+00
+ PKER_SWETH( 20, 37) = 0.291755E+00
+ PKER_SWETH( 20, 38) = 0.314552E+00
+ PKER_SWETH( 20, 39) = 0.335492E+00
+ PKER_SWETH( 20, 40) = 0.354644E+00
+ PKER_SWETH( 20, 41) = 0.372144E+00
+ PKER_SWETH( 20, 42) = 0.388151E+00
+ PKER_SWETH( 20, 43) = 0.402823E+00
+ PKER_SWETH( 20, 44) = 0.416308E+00
+ PKER_SWETH( 20, 45) = 0.428733E+00
+ PKER_SWETH( 20, 46) = 0.440212E+00
+ PKER_SWETH( 20, 47) = 0.450843E+00
+ PKER_SWETH( 20, 48) = 0.460707E+00
+ PKER_SWETH( 20, 49) = 0.469878E+00
+ PKER_SWETH( 20, 50) = 0.478418E+00
+ PKER_SWETH( 20, 51) = 0.486380E+00
+ PKER_SWETH( 20, 52) = 0.493813E+00
+ PKER_SWETH( 20, 53) = 0.500759E+00
+ PKER_SWETH( 20, 54) = 0.507254E+00
+ PKER_SWETH( 20, 55) = 0.513332E+00
+ PKER_SWETH( 20, 56) = 0.519023E+00
+ PKER_SWETH( 20, 57) = 0.524354E+00
+ PKER_SWETH( 20, 58) = 0.529350E+00
+ PKER_SWETH( 20, 59) = 0.534034E+00
+ PKER_SWETH( 20, 60) = 0.538425E+00
+ PKER_SWETH( 20, 61) = 0.542544E+00
+ PKER_SWETH( 20, 62) = 0.546409E+00
+ PKER_SWETH( 20, 63) = 0.550034E+00
+ PKER_SWETH( 20, 64) = 0.553436E+00
+ PKER_SWETH( 20, 65) = 0.556629E+00
+ PKER_SWETH( 20, 66) = 0.559625E+00
+ PKER_SWETH( 20, 67) = 0.562438E+00
+ PKER_SWETH( 20, 68) = 0.565078E+00
+ PKER_SWETH( 20, 69) = 0.567556E+00
+ PKER_SWETH( 20, 70) = 0.569883E+00
+ PKER_SWETH( 20, 71) = 0.572067E+00
+ PKER_SWETH( 20, 72) = 0.574118E+00
+ PKER_SWETH( 20, 73) = 0.576043E+00
+ PKER_SWETH( 20, 74) = 0.577850E+00
+ PKER_SWETH( 20, 75) = 0.579548E+00
+ PKER_SWETH( 20, 76) = 0.581141E+00
+ PKER_SWETH( 20, 77) = 0.582637E+00
+ PKER_SWETH( 20, 78) = 0.584042E+00
+ PKER_SWETH( 20, 79) = 0.585361E+00
+ PKER_SWETH( 20, 80) = 0.586599E+00
+ PKER_SWETH( 21, 1) = 0.276660E+01
+ PKER_SWETH( 21, 2) = 0.257019E+01
+ PKER_SWETH( 21, 3) = 0.238576E+01
+ PKER_SWETH( 21, 4) = 0.221256E+01
+ PKER_SWETH( 21, 5) = 0.204992E+01
+ PKER_SWETH( 21, 6) = 0.189718E+01
+ PKER_SWETH( 21, 7) = 0.175373E+01
+ PKER_SWETH( 21, 8) = 0.161901E+01
+ PKER_SWETH( 21, 9) = 0.149248E+01
+ PKER_SWETH( 21, 10) = 0.137362E+01
+ PKER_SWETH( 21, 11) = 0.126196E+01
+ PKER_SWETH( 21, 12) = 0.115706E+01
+ PKER_SWETH( 21, 13) = 0.105848E+01
+ PKER_SWETH( 21, 14) = 0.965820E+00
+ PKER_SWETH( 21, 15) = 0.878708E+00
+ PKER_SWETH( 21, 16) = 0.796778E+00
+ PKER_SWETH( 21, 17) = 0.719688E+00
+ PKER_SWETH( 21, 18) = 0.647114E+00
+ PKER_SWETH( 21, 19) = 0.578752E+00
+ PKER_SWETH( 21, 20) = 0.514323E+00
+ PKER_SWETH( 21, 21) = 0.453593E+00
+ PKER_SWETH( 21, 22) = 0.396401E+00
+ PKER_SWETH( 21, 23) = 0.342701E+00
+ PKER_SWETH( 21, 24) = 0.292637E+00
+ PKER_SWETH( 21, 25) = 0.246605E+00
+ PKER_SWETH( 21, 26) = 0.205290E+00
+ PKER_SWETH( 21, 27) = 0.169646E+00
+ PKER_SWETH( 21, 28) = 0.140837E+00
+ PKER_SWETH( 21, 29) = 0.119992E+00
+ PKER_SWETH( 21, 30) = 0.107857E+00
+ PKER_SWETH( 21, 31) = 0.104691E+00
+ PKER_SWETH( 21, 32) = 0.109912E+00
+ PKER_SWETH( 21, 33) = 0.122241E+00
+ PKER_SWETH( 21, 34) = 0.139853E+00
+ PKER_SWETH( 21, 35) = 0.160815E+00
+ PKER_SWETH( 21, 36) = 0.183364E+00
+ PKER_SWETH( 21, 37) = 0.206102E+00
+ PKER_SWETH( 21, 38) = 0.228109E+00
+ PKER_SWETH( 21, 39) = 0.248850E+00
+ PKER_SWETH( 21, 40) = 0.268092E+00
+ PKER_SWETH( 21, 41) = 0.285801E+00
+ PKER_SWETH( 21, 42) = 0.302045E+00
+ PKER_SWETH( 21, 43) = 0.316939E+00
+ PKER_SWETH( 21, 44) = 0.330615E+00
+ PKER_SWETH( 21, 45) = 0.343198E+00
+ PKER_SWETH( 21, 46) = 0.354804E+00
+ PKER_SWETH( 21, 47) = 0.365535E+00
+ PKER_SWETH( 21, 48) = 0.375478E+00
+ PKER_SWETH( 21, 49) = 0.384710E+00
+ PKER_SWETH( 21, 50) = 0.393297E+00
+ PKER_SWETH( 21, 51) = 0.401296E+00
+ PKER_SWETH( 21, 52) = 0.408758E+00
+ PKER_SWETH( 21, 53) = 0.415725E+00
+ PKER_SWETH( 21, 54) = 0.422237E+00
+ PKER_SWETH( 21, 55) = 0.428328E+00
+ PKER_SWETH( 21, 56) = 0.434029E+00
+ PKER_SWETH( 21, 57) = 0.439368E+00
+ PKER_SWETH( 21, 58) = 0.444370E+00
+ PKER_SWETH( 21, 59) = 0.449059E+00
+ PKER_SWETH( 21, 60) = 0.453454E+00
+ PKER_SWETH( 21, 61) = 0.457576E+00
+ PKER_SWETH( 21, 62) = 0.461442E+00
+ PKER_SWETH( 21, 63) = 0.465069E+00
+ PKER_SWETH( 21, 64) = 0.468472E+00
+ PKER_SWETH( 21, 65) = 0.471666E+00
+ PKER_SWETH( 21, 66) = 0.474663E+00
+ PKER_SWETH( 21, 67) = 0.477476E+00
+ PKER_SWETH( 21, 68) = 0.480117E+00
+ PKER_SWETH( 21, 69) = 0.482596E+00
+ PKER_SWETH( 21, 70) = 0.484923E+00
+ PKER_SWETH( 21, 71) = 0.487107E+00
+ PKER_SWETH( 21, 72) = 0.489158E+00
+ PKER_SWETH( 21, 73) = 0.491083E+00
+ PKER_SWETH( 21, 74) = 0.492891E+00
+ PKER_SWETH( 21, 75) = 0.494588E+00
+ PKER_SWETH( 21, 76) = 0.496182E+00
+ PKER_SWETH( 21, 77) = 0.497678E+00
+ PKER_SWETH( 21, 78) = 0.499083E+00
+ PKER_SWETH( 21, 79) = 0.500402E+00
+ PKER_SWETH( 21, 80) = 0.501640E+00
+ PKER_SWETH( 22, 1) = 0.282997E+01
+ PKER_SWETH( 22, 2) = 0.263357E+01
+ PKER_SWETH( 22, 3) = 0.244915E+01
+ PKER_SWETH( 22, 4) = 0.227597E+01
+ PKER_SWETH( 22, 5) = 0.211334E+01
+ PKER_SWETH( 22, 6) = 0.196063E+01
+ PKER_SWETH( 22, 7) = 0.181721E+01
+ PKER_SWETH( 22, 8) = 0.168252E+01
+ PKER_SWETH( 22, 9) = 0.155602E+01
+ PKER_SWETH( 22, 10) = 0.143721E+01
+ PKER_SWETH( 22, 11) = 0.132561E+01
+ PKER_SWETH( 22, 12) = 0.122077E+01
+ PKER_SWETH( 22, 13) = 0.112227E+01
+ PKER_SWETH( 22, 14) = 0.102972E+01
+ PKER_SWETH( 22, 15) = 0.942728E+00
+ PKER_SWETH( 22, 16) = 0.860945E+00
+ PKER_SWETH( 22, 17) = 0.784032E+00
+ PKER_SWETH( 22, 18) = 0.711667E+00
+ PKER_SWETH( 22, 19) = 0.643543E+00
+ PKER_SWETH( 22, 20) = 0.579369E+00
+ PKER_SWETH( 22, 21) = 0.518868E+00
+ PKER_SWETH( 22, 22) = 0.461786E+00
+ PKER_SWETH( 22, 23) = 0.407901E+00
+ PKER_SWETH( 22, 24) = 0.357051E+00
+ PKER_SWETH( 22, 25) = 0.309171E+00
+ PKER_SWETH( 22, 26) = 0.264357E+00
+ PKER_SWETH( 22, 27) = 0.222939E+00
+ PKER_SWETH( 22, 28) = 0.185511E+00
+ PKER_SWETH( 22, 29) = 0.152956E+00
+ PKER_SWETH( 22, 30) = 0.126371E+00
+ PKER_SWETH( 22, 31) = 0.106799E+00
+ PKER_SWETH( 22, 32) = 0.950337E-01
+ PKER_SWETH( 22, 33) = 0.913020E-01
+ PKER_SWETH( 22, 34) = 0.950413E-01
+ PKER_SWETH( 22, 35) = 0.105099E+00
+ PKER_SWETH( 22, 36) = 0.119803E+00
+ PKER_SWETH( 22, 37) = 0.137435E+00
+ PKER_SWETH( 22, 38) = 0.156413E+00
+ PKER_SWETH( 22, 39) = 0.175558E+00
+ PKER_SWETH( 22, 40) = 0.194103E+00
+ PKER_SWETH( 22, 41) = 0.211605E+00
+ PKER_SWETH( 22, 42) = 0.227888E+00
+ PKER_SWETH( 22, 43) = 0.242923E+00
+ PKER_SWETH( 22, 44) = 0.256764E+00
+ PKER_SWETH( 22, 45) = 0.269505E+00
+ PKER_SWETH( 22, 46) = 0.281247E+00
+ PKER_SWETH( 22, 47) = 0.292089E+00
+ PKER_SWETH( 22, 48) = 0.302122E+00
+ PKER_SWETH( 22, 49) = 0.311425E+00
+ PKER_SWETH( 22, 50) = 0.320067E+00
+ PKER_SWETH( 22, 51) = 0.328110E+00
+ PKER_SWETH( 22, 52) = 0.335604E+00
+ PKER_SWETH( 22, 53) = 0.342597E+00
+ PKER_SWETH( 22, 54) = 0.349129E+00
+ PKER_SWETH( 22, 55) = 0.355235E+00
+ PKER_SWETH( 22, 56) = 0.360948E+00
+ PKER_SWETH( 22, 57) = 0.366296E+00
+ PKER_SWETH( 22, 58) = 0.371305E+00
+ PKER_SWETH( 22, 59) = 0.375999E+00
+ PKER_SWETH( 22, 60) = 0.380398E+00
+ PKER_SWETH( 22, 61) = 0.384523E+00
+ PKER_SWETH( 22, 62) = 0.388392E+00
+ PKER_SWETH( 22, 63) = 0.392021E+00
+ PKER_SWETH( 22, 64) = 0.395426E+00
+ PKER_SWETH( 22, 65) = 0.398621E+00
+ PKER_SWETH( 22, 66) = 0.401619E+00
+ PKER_SWETH( 22, 67) = 0.404433E+00
+ PKER_SWETH( 22, 68) = 0.407074E+00
+ PKER_SWETH( 22, 69) = 0.409553E+00
+ PKER_SWETH( 22, 70) = 0.411880E+00
+ PKER_SWETH( 22, 71) = 0.414065E+00
+ PKER_SWETH( 22, 72) = 0.416116E+00
+ PKER_SWETH( 22, 73) = 0.418041E+00
+ PKER_SWETH( 22, 74) = 0.419849E+00
+ PKER_SWETH( 22, 75) = 0.421547E+00
+ PKER_SWETH( 22, 76) = 0.423140E+00
+ PKER_SWETH( 22, 77) = 0.424636E+00
+ PKER_SWETH( 22, 78) = 0.426041E+00
+ PKER_SWETH( 22, 79) = 0.427360E+00
+ PKER_SWETH( 22, 80) = 0.428599E+00
+ PKER_SWETH( 23, 1) = 0.288445E+01
+ PKER_SWETH( 23, 2) = 0.268806E+01
+ PKER_SWETH( 23, 3) = 0.250364E+01
+ PKER_SWETH( 23, 4) = 0.233048E+01
+ PKER_SWETH( 23, 5) = 0.216786E+01
+ PKER_SWETH( 23, 6) = 0.201516E+01
+ PKER_SWETH( 23, 7) = 0.187176E+01
+ PKER_SWETH( 23, 8) = 0.173710E+01
+ PKER_SWETH( 23, 9) = 0.161063E+01
+ PKER_SWETH( 23, 10) = 0.149185E+01
+ PKER_SWETH( 23, 11) = 0.138029E+01
+ PKER_SWETH( 23, 12) = 0.127551E+01
+ PKER_SWETH( 23, 13) = 0.117707E+01
+ PKER_SWETH( 23, 14) = 0.108459E+01
+ PKER_SWETH( 23, 15) = 0.997690E+00
+ PKER_SWETH( 23, 16) = 0.916018E+00
+ PKER_SWETH( 23, 17) = 0.839238E+00
+ PKER_SWETH( 23, 18) = 0.767034E+00
+ PKER_SWETH( 23, 19) = 0.699104E+00
+ PKER_SWETH( 23, 20) = 0.635161E+00
+ PKER_SWETH( 23, 21) = 0.574928E+00
+ PKER_SWETH( 23, 22) = 0.518145E+00
+ PKER_SWETH( 23, 23) = 0.464561E+00
+ PKER_SWETH( 23, 24) = 0.413942E+00
+ PKER_SWETH( 23, 25) = 0.366084E+00
+ PKER_SWETH( 23, 26) = 0.320828E+00
+ PKER_SWETH( 23, 27) = 0.278103E+00
+ PKER_SWETH( 23, 28) = 0.237978E+00
+ PKER_SWETH( 23, 29) = 0.200731E+00
+ PKER_SWETH( 23, 30) = 0.166899E+00
+ PKER_SWETH( 23, 31) = 0.137289E+00
+ PKER_SWETH( 23, 32) = 0.112921E+00
+ PKER_SWETH( 23, 33) = 0.947715E-01
+ PKER_SWETH( 23, 34) = 0.835556E-01
+ PKER_SWETH( 23, 35) = 0.795022E-01
+ PKER_SWETH( 23, 36) = 0.820667E-01
+ PKER_SWETH( 23, 37) = 0.901434E-01
+ PKER_SWETH( 23, 38) = 0.102318E+00
+ PKER_SWETH( 23, 39) = 0.117002E+00
+ PKER_SWETH( 23, 40) = 0.132892E+00
+ PKER_SWETH( 23, 41) = 0.148969E+00
+ PKER_SWETH( 23, 42) = 0.164595E+00
+ PKER_SWETH( 23, 43) = 0.179397E+00
+ PKER_SWETH( 23, 44) = 0.193221E+00
+ PKER_SWETH( 23, 45) = 0.206041E+00
+ PKER_SWETH( 23, 46) = 0.217890E+00
+ PKER_SWETH( 23, 47) = 0.228840E+00
+ PKER_SWETH( 23, 48) = 0.238967E+00
+ PKER_SWETH( 23, 49) = 0.248348E+00
+ PKER_SWETH( 23, 50) = 0.257053E+00
+ PKER_SWETH( 23, 51) = 0.265145E+00
+ PKER_SWETH( 23, 52) = 0.272678E+00
+ PKER_SWETH( 23, 53) = 0.279701E+00
+ PKER_SWETH( 23, 54) = 0.286256E+00
+ PKER_SWETH( 23, 55) = 0.292380E+00
+ PKER_SWETH( 23, 56) = 0.298107E+00
+ PKER_SWETH( 23, 57) = 0.303465E+00
+ PKER_SWETH( 23, 58) = 0.308482E+00
+ PKER_SWETH( 23, 59) = 0.313182E+00
+ PKER_SWETH( 23, 60) = 0.317586E+00
+ PKER_SWETH( 23, 61) = 0.321715E+00
+ PKER_SWETH( 23, 62) = 0.325587E+00
+ PKER_SWETH( 23, 63) = 0.329218E+00
+ PKER_SWETH( 23, 64) = 0.332625E+00
+ PKER_SWETH( 23, 65) = 0.335821E+00
+ PKER_SWETH( 23, 66) = 0.338820E+00
+ PKER_SWETH( 23, 67) = 0.341635E+00
+ PKER_SWETH( 23, 68) = 0.344276E+00
+ PKER_SWETH( 23, 69) = 0.346756E+00
+ PKER_SWETH( 23, 70) = 0.349083E+00
+ PKER_SWETH( 23, 71) = 0.351269E+00
+ PKER_SWETH( 23, 72) = 0.353320E+00
+ PKER_SWETH( 23, 73) = 0.355245E+00
+ PKER_SWETH( 23, 74) = 0.357053E+00
+ PKER_SWETH( 23, 75) = 0.358751E+00
+ PKER_SWETH( 23, 76) = 0.360345E+00
+ PKER_SWETH( 23, 77) = 0.361841E+00
+ PKER_SWETH( 23, 78) = 0.363246E+00
+ PKER_SWETH( 23, 79) = 0.364565E+00
+ PKER_SWETH( 23, 80) = 0.365803E+00
+ PKER_SWETH( 24, 1) = 0.293128E+01
+ PKER_SWETH( 24, 2) = 0.273490E+01
+ PKER_SWETH( 24, 3) = 0.255049E+01
+ PKER_SWETH( 24, 4) = 0.237733E+01
+ PKER_SWETH( 24, 5) = 0.221473E+01
+ PKER_SWETH( 24, 6) = 0.206204E+01
+ PKER_SWETH( 24, 7) = 0.191865E+01
+ PKER_SWETH( 24, 8) = 0.178401E+01
+ PKER_SWETH( 24, 9) = 0.165756E+01
+ PKER_SWETH( 24, 10) = 0.153881E+01
+ PKER_SWETH( 24, 11) = 0.142728E+01
+ PKER_SWETH( 24, 12) = 0.132253E+01
+ PKER_SWETH( 24, 13) = 0.122414E+01
+ PKER_SWETH( 24, 14) = 0.113172E+01
+ PKER_SWETH( 24, 15) = 0.104489E+01
+ PKER_SWETH( 24, 16) = 0.963296E+00
+ PKER_SWETH( 24, 17) = 0.886615E+00
+ PKER_SWETH( 24, 18) = 0.814532E+00
+ PKER_SWETH( 24, 19) = 0.746748E+00
+ PKER_SWETH( 24, 20) = 0.682980E+00
+ PKER_SWETH( 24, 21) = 0.622959E+00
+ PKER_SWETH( 24, 22) = 0.566429E+00
+ PKER_SWETH( 24, 23) = 0.513140E+00
+ PKER_SWETH( 24, 24) = 0.462858E+00
+ PKER_SWETH( 24, 25) = 0.415356E+00
+ PKER_SWETH( 24, 26) = 0.370422E+00
+ PKER_SWETH( 24, 27) = 0.327867E+00
+ PKER_SWETH( 24, 28) = 0.287546E+00
+ PKER_SWETH( 24, 29) = 0.249386E+00
+ PKER_SWETH( 24, 30) = 0.213448E+00
+ PKER_SWETH( 24, 31) = 0.179979E+00
+ PKER_SWETH( 24, 32) = 0.149462E+00
+ PKER_SWETH( 24, 33) = 0.122655E+00
+ PKER_SWETH( 24, 34) = 0.100473E+00
+ PKER_SWETH( 24, 35) = 0.838046E-01
+ PKER_SWETH( 24, 36) = 0.732975E-01
+ PKER_SWETH( 24, 37) = 0.690734E-01
+ PKER_SWETH( 24, 38) = 0.706629E-01
+ PKER_SWETH( 24, 39) = 0.770847E-01
+ PKER_SWETH( 24, 40) = 0.870070E-01
+ PKER_SWETH( 24, 41) = 0.991818E-01
+ PKER_SWETH( 24, 42) = 0.112426E+00
+ PKER_SWETH( 24, 43) = 0.125916E+00
+ PKER_SWETH( 24, 44) = 0.139097E+00
+ PKER_SWETH( 24, 45) = 0.151650E+00
+ PKER_SWETH( 24, 46) = 0.163434E+00
+ PKER_SWETH( 24, 47) = 0.174410E+00
+ PKER_SWETH( 24, 48) = 0.184599E+00
+ PKER_SWETH( 24, 49) = 0.194049E+00
+ PKER_SWETH( 24, 50) = 0.202817E+00
+ PKER_SWETH( 24, 51) = 0.210962E+00
+ PKER_SWETH( 24, 52) = 0.218539E+00
+ PKER_SWETH( 24, 53) = 0.225596E+00
+ PKER_SWETH( 24, 54) = 0.232178E+00
+ PKER_SWETH( 24, 55) = 0.238323E+00
+ PKER_SWETH( 24, 56) = 0.244066E+00
+ PKER_SWETH( 24, 57) = 0.249437E+00
+ PKER_SWETH( 24, 58) = 0.254464E+00
+ PKER_SWETH( 24, 59) = 0.259171E+00
+ PKER_SWETH( 24, 60) = 0.263581E+00
+ PKER_SWETH( 24, 61) = 0.267714E+00
+ PKER_SWETH( 24, 62) = 0.271589E+00
+ PKER_SWETH( 24, 63) = 0.275223E+00
+ PKER_SWETH( 24, 64) = 0.278631E+00
+ PKER_SWETH( 24, 65) = 0.281829E+00
+ PKER_SWETH( 24, 66) = 0.284829E+00
+ PKER_SWETH( 24, 67) = 0.287645E+00
+ PKER_SWETH( 24, 68) = 0.290287E+00
+ PKER_SWETH( 24, 69) = 0.292767E+00
+ PKER_SWETH( 24, 70) = 0.295095E+00
+ PKER_SWETH( 24, 71) = 0.297281E+00
+ PKER_SWETH( 24, 72) = 0.299332E+00
+ PKER_SWETH( 24, 73) = 0.301258E+00
+ PKER_SWETH( 24, 74) = 0.303066E+00
+ PKER_SWETH( 24, 75) = 0.304764E+00
+ PKER_SWETH( 24, 76) = 0.306358E+00
+ PKER_SWETH( 24, 77) = 0.307854E+00
+ PKER_SWETH( 24, 78) = 0.309259E+00
+ PKER_SWETH( 24, 79) = 0.310578E+00
+ PKER_SWETH( 24, 80) = 0.311817E+00
+ PKER_SWETH( 25, 1) = 0.297154E+01
+ PKER_SWETH( 25, 2) = 0.277516E+01
+ PKER_SWETH( 25, 3) = 0.259076E+01
+ PKER_SWETH( 25, 4) = 0.241761E+01
+ PKER_SWETH( 25, 5) = 0.225501E+01
+ PKER_SWETH( 25, 6) = 0.210233E+01
+ PKER_SWETH( 25, 7) = 0.195896E+01
+ PKER_SWETH( 25, 8) = 0.182433E+01
+ PKER_SWETH( 25, 9) = 0.169789E+01
+ PKER_SWETH( 25, 10) = 0.157916E+01
+ PKER_SWETH( 25, 11) = 0.146766E+01
+ PKER_SWETH( 25, 12) = 0.136294E+01
+ PKER_SWETH( 25, 13) = 0.126459E+01
+ PKER_SWETH( 25, 14) = 0.117220E+01
+ PKER_SWETH( 25, 15) = 0.108542E+01
+ PKER_SWETH( 25, 16) = 0.100389E+01
+ PKER_SWETH( 25, 17) = 0.927285E+00
+ PKER_SWETH( 25, 18) = 0.855291E+00
+ PKER_SWETH( 25, 19) = 0.787616E+00
+ PKER_SWETH( 25, 20) = 0.723980E+00
+ PKER_SWETH( 25, 21) = 0.664118E+00
+ PKER_SWETH( 25, 22) = 0.607779E+00
+ PKER_SWETH( 25, 23) = 0.554721E+00
+ PKER_SWETH( 25, 24) = 0.504713E+00
+ PKER_SWETH( 25, 25) = 0.457533E+00
+ PKER_SWETH( 25, 26) = 0.412967E+00
+ PKER_SWETH( 25, 27) = 0.370812E+00
+ PKER_SWETH( 25, 28) = 0.330876E+00
+ PKER_SWETH( 25, 29) = 0.292989E+00
+ PKER_SWETH( 25, 30) = 0.257023E+00
+ PKER_SWETH( 25, 31) = 0.222915E+00
+ PKER_SWETH( 25, 32) = 0.190725E+00
+ PKER_SWETH( 25, 33) = 0.160684E+00
+ PKER_SWETH( 25, 34) = 0.133246E+00
+ PKER_SWETH( 25, 35) = 0.109094E+00
+ PKER_SWETH( 25, 36) = 0.890541E-01
+ PKER_SWETH( 25, 37) = 0.738827E-01
+ PKER_SWETH( 25, 38) = 0.641418E-01
+ PKER_SWETH( 25, 39) = 0.598974E-01
+ PKER_SWETH( 25, 40) = 0.606697E-01
+ PKER_SWETH( 25, 41) = 0.656428E-01
+ PKER_SWETH( 25, 42) = 0.736972E-01
+ PKER_SWETH( 25, 43) = 0.836895E-01
+ PKER_SWETH( 25, 44) = 0.947074E-01
+ PKER_SWETH( 25, 45) = 0.106025E+00
+ PKER_SWETH( 25, 46) = 0.117165E+00
+ PKER_SWETH( 25, 47) = 0.127842E+00
+ PKER_SWETH( 25, 48) = 0.137923E+00
+ PKER_SWETH( 25, 49) = 0.147359E+00
+ PKER_SWETH( 25, 50) = 0.156153E+00
+ PKER_SWETH( 25, 51) = 0.164338E+00
+ PKER_SWETH( 25, 52) = 0.171955E+00
+ PKER_SWETH( 25, 53) = 0.179048E+00
+ PKER_SWETH( 25, 54) = 0.185659E+00
+ PKER_SWETH( 25, 55) = 0.191828E+00
+ PKER_SWETH( 25, 56) = 0.197589E+00
+ PKER_SWETH( 25, 57) = 0.202975E+00
+ PKER_SWETH( 25, 58) = 0.208013E+00
+ PKER_SWETH( 25, 59) = 0.212728E+00
+ PKER_SWETH( 25, 60) = 0.217145E+00
+ PKER_SWETH( 25, 61) = 0.221283E+00
+ PKER_SWETH( 25, 62) = 0.225162E+00
+ PKER_SWETH( 25, 63) = 0.228799E+00
+ PKER_SWETH( 25, 64) = 0.232210E+00
+ PKER_SWETH( 25, 65) = 0.235409E+00
+ PKER_SWETH( 25, 66) = 0.238411E+00
+ PKER_SWETH( 25, 67) = 0.241227E+00
+ PKER_SWETH( 25, 68) = 0.243871E+00
+ PKER_SWETH( 25, 69) = 0.246352E+00
+ PKER_SWETH( 25, 70) = 0.248680E+00
+ PKER_SWETH( 25, 71) = 0.250866E+00
+ PKER_SWETH( 25, 72) = 0.252918E+00
+ PKER_SWETH( 25, 73) = 0.254844E+00
+ PKER_SWETH( 25, 74) = 0.256652E+00
+ PKER_SWETH( 25, 75) = 0.258350E+00
+ PKER_SWETH( 25, 76) = 0.259944E+00
+ PKER_SWETH( 25, 77) = 0.261440E+00
+ PKER_SWETH( 25, 78) = 0.262845E+00
+ PKER_SWETH( 25, 79) = 0.264164E+00
+ PKER_SWETH( 25, 80) = 0.265403E+00
+ PKER_SWETH( 26, 1) = 0.300615E+01
+ PKER_SWETH( 26, 2) = 0.280977E+01
+ PKER_SWETH( 26, 3) = 0.262538E+01
+ PKER_SWETH( 26, 4) = 0.245223E+01
+ PKER_SWETH( 26, 5) = 0.228964E+01
+ PKER_SWETH( 26, 6) = 0.213697E+01
+ PKER_SWETH( 26, 7) = 0.199360E+01
+ PKER_SWETH( 26, 8) = 0.185898E+01
+ PKER_SWETH( 26, 9) = 0.173256E+01
+ PKER_SWETH( 26, 10) = 0.161385E+01
+ PKER_SWETH( 26, 11) = 0.150236E+01
+ PKER_SWETH( 26, 12) = 0.139766E+01
+ PKER_SWETH( 26, 13) = 0.129933E+01
+ PKER_SWETH( 26, 14) = 0.120698E+01
+ PKER_SWETH( 26, 15) = 0.112024E+01
+ PKER_SWETH( 26, 16) = 0.103876E+01
+ PKER_SWETH( 26, 17) = 0.962205E+00
+ PKER_SWETH( 26, 18) = 0.890279E+00
+ PKER_SWETH( 26, 19) = 0.822684E+00
+ PKER_SWETH( 26, 20) = 0.759146E+00
+ PKER_SWETH( 26, 21) = 0.699404E+00
+ PKER_SWETH( 26, 22) = 0.643208E+00
+ PKER_SWETH( 26, 23) = 0.590322E+00
+ PKER_SWETH( 26, 24) = 0.540522E+00
+ PKER_SWETH( 26, 25) = 0.493591E+00
+ PKER_SWETH( 26, 26) = 0.449320E+00
+ PKER_SWETH( 26, 27) = 0.407511E+00
+ PKER_SWETH( 26, 28) = 0.367971E+00
+ PKER_SWETH( 26, 29) = 0.330516E+00
+ PKER_SWETH( 26, 30) = 0.294977E+00
+ PKER_SWETH( 26, 31) = 0.261206E+00
+ PKER_SWETH( 26, 32) = 0.229091E+00
+ PKER_SWETH( 26, 33) = 0.198592E+00
+ PKER_SWETH( 26, 34) = 0.169777E+00
+ PKER_SWETH( 26, 35) = 0.142869E+00
+ PKER_SWETH( 26, 36) = 0.118292E+00
+ PKER_SWETH( 26, 37) = 0.966610E-01
+ PKER_SWETH( 26, 38) = 0.786825E-01
+ PKER_SWETH( 26, 39) = 0.650023E-01
+ PKER_SWETH( 26, 40) = 0.560497E-01
+ PKER_SWETH( 26, 41) = 0.518524E-01
+ PKER_SWETH( 26, 42) = 0.519800E-01
+ PKER_SWETH( 26, 43) = 0.557183E-01
+ PKER_SWETH( 26, 44) = 0.621393E-01
+ PKER_SWETH( 26, 45) = 0.703233E-01
+ PKER_SWETH( 26, 46) = 0.794632E-01
+ PKER_SWETH( 26, 47) = 0.889548E-01
+ PKER_SWETH( 26, 48) = 0.983834E-01
+ PKER_SWETH( 26, 49) = 0.107490E+00
+ PKER_SWETH( 26, 50) = 0.116142E+00
+ PKER_SWETH( 26, 51) = 0.124280E+00
+ PKER_SWETH( 26, 52) = 0.131897E+00
+ PKER_SWETH( 26, 53) = 0.139007E+00
+ PKER_SWETH( 26, 54) = 0.145642E+00
+ PKER_SWETH( 26, 55) = 0.151833E+00
+ PKER_SWETH( 26, 56) = 0.157614E+00
+ PKER_SWETH( 26, 57) = 0.163015E+00
+ PKER_SWETH( 26, 58) = 0.168066E+00
+ PKER_SWETH( 26, 59) = 0.172792E+00
+ PKER_SWETH( 26, 60) = 0.177216E+00
+ PKER_SWETH( 26, 61) = 0.181360E+00
+ PKER_SWETH( 26, 62) = 0.185244E+00
+ PKER_SWETH( 26, 63) = 0.188884E+00
+ PKER_SWETH( 26, 64) = 0.192298E+00
+ PKER_SWETH( 26, 65) = 0.195499E+00
+ PKER_SWETH( 26, 66) = 0.198503E+00
+ PKER_SWETH( 26, 67) = 0.201320E+00
+ PKER_SWETH( 26, 68) = 0.203965E+00
+ PKER_SWETH( 26, 69) = 0.206446E+00
+ PKER_SWETH( 26, 70) = 0.208775E+00
+ PKER_SWETH( 26, 71) = 0.210961E+00
+ PKER_SWETH( 26, 72) = 0.213013E+00
+ PKER_SWETH( 26, 73) = 0.214940E+00
+ PKER_SWETH( 26, 74) = 0.216748E+00
+ PKER_SWETH( 26, 75) = 0.218446E+00
+ PKER_SWETH( 26, 76) = 0.220040E+00
+ PKER_SWETH( 26, 77) = 0.221537E+00
+ PKER_SWETH( 26, 78) = 0.222942E+00
+ PKER_SWETH( 26, 79) = 0.224261E+00
+ PKER_SWETH( 26, 80) = 0.225500E+00
+ PKER_SWETH( 27, 1) = 0.303590E+01
+ PKER_SWETH( 27, 2) = 0.283953E+01
+ PKER_SWETH( 27, 3) = 0.265514E+01
+ PKER_SWETH( 27, 4) = 0.248199E+01
+ PKER_SWETH( 27, 5) = 0.231941E+01
+ PKER_SWETH( 27, 6) = 0.216674E+01
+ PKER_SWETH( 27, 7) = 0.202338E+01
+ PKER_SWETH( 27, 8) = 0.188877E+01
+ PKER_SWETH( 27, 9) = 0.176236E+01
+ PKER_SWETH( 27, 10) = 0.164366E+01
+ PKER_SWETH( 27, 11) = 0.153218E+01
+ PKER_SWETH( 27, 12) = 0.142750E+01
+ PKER_SWETH( 27, 13) = 0.132919E+01
+ PKER_SWETH( 27, 14) = 0.123687E+01
+ PKER_SWETH( 27, 15) = 0.115015E+01
+ PKER_SWETH( 27, 16) = 0.106870E+01
+ PKER_SWETH( 27, 17) = 0.992194E+00
+ PKER_SWETH( 27, 18) = 0.920318E+00
+ PKER_SWETH( 27, 19) = 0.852785E+00
+ PKER_SWETH( 27, 20) = 0.789320E+00
+ PKER_SWETH( 27, 21) = 0.729667E+00
+ PKER_SWETH( 27, 22) = 0.673578E+00
+ PKER_SWETH( 27, 23) = 0.620822E+00
+ PKER_SWETH( 27, 24) = 0.571178E+00
+ PKER_SWETH( 27, 25) = 0.524434E+00
+ PKER_SWETH( 27, 26) = 0.480388E+00
+ PKER_SWETH( 27, 27) = 0.438846E+00
+ PKER_SWETH( 27, 28) = 0.399622E+00
+ PKER_SWETH( 27, 29) = 0.362534E+00
+ PKER_SWETH( 27, 30) = 0.327412E+00
+ PKER_SWETH( 27, 31) = 0.294092E+00
+ PKER_SWETH( 27, 32) = 0.262426E+00
+ PKER_SWETH( 27, 33) = 0.232290E+00
+ PKER_SWETH( 27, 34) = 0.203599E+00
+ PKER_SWETH( 27, 35) = 0.176334E+00
+ PKER_SWETH( 27, 36) = 0.150579E+00
+ PKER_SWETH( 27, 37) = 0.126557E+00
+ PKER_SWETH( 27, 38) = 0.104653E+00
+ PKER_SWETH( 27, 39) = 0.854039E-01
+ PKER_SWETH( 27, 40) = 0.693914E-01
+ PKER_SWETH( 27, 41) = 0.571427E-01
+ PKER_SWETH( 27, 42) = 0.489777E-01
+ PKER_SWETH( 27, 43) = 0.448639E-01
+ PKER_SWETH( 27, 44) = 0.444652E-01
+ PKER_SWETH( 27, 45) = 0.471717E-01
+ PKER_SWETH( 27, 46) = 0.522132E-01
+ PKER_SWETH( 27, 47) = 0.588533E-01
+ PKER_SWETH( 27, 48) = 0.664103E-01
+ PKER_SWETH( 27, 49) = 0.743760E-01
+ PKER_SWETH( 27, 50) = 0.823690E-01
+ PKER_SWETH( 27, 51) = 0.901537E-01
+ PKER_SWETH( 27, 52) = 0.975988E-01
+ PKER_SWETH( 27, 53) = 0.104637E+00
+ PKER_SWETH( 27, 54) = 0.111249E+00
+ PKER_SWETH( 27, 55) = 0.117442E+00
+ PKER_SWETH( 27, 56) = 0.123234E+00
+ PKER_SWETH( 27, 57) = 0.128648E+00
+ PKER_SWETH( 27, 58) = 0.133711E+00
+ PKER_SWETH( 27, 59) = 0.138448E+00
+ PKER_SWETH( 27, 60) = 0.142881E+00
+ PKER_SWETH( 27, 61) = 0.147032E+00
+ PKER_SWETH( 27, 62) = 0.150920E+00
+ PKER_SWETH( 27, 63) = 0.154565E+00
+ PKER_SWETH( 27, 64) = 0.157982E+00
+ PKER_SWETH( 27, 65) = 0.161186E+00
+ PKER_SWETH( 27, 66) = 0.164191E+00
+ PKER_SWETH( 27, 67) = 0.167010E+00
+ PKER_SWETH( 27, 68) = 0.169655E+00
+ PKER_SWETH( 27, 69) = 0.172138E+00
+ PKER_SWETH( 27, 70) = 0.174467E+00
+ PKER_SWETH( 27, 71) = 0.176654E+00
+ PKER_SWETH( 27, 72) = 0.178707E+00
+ PKER_SWETH( 27, 73) = 0.180633E+00
+ PKER_SWETH( 27, 74) = 0.182442E+00
+ PKER_SWETH( 27, 75) = 0.184140E+00
+ PKER_SWETH( 27, 76) = 0.185734E+00
+ PKER_SWETH( 27, 77) = 0.187231E+00
+ PKER_SWETH( 27, 78) = 0.188636E+00
+ PKER_SWETH( 27, 79) = 0.189955E+00
+ PKER_SWETH( 27, 80) = 0.191194E+00
+ PKER_SWETH( 28, 1) = 0.306148E+01
+ PKER_SWETH( 28, 2) = 0.286511E+01
+ PKER_SWETH( 28, 3) = 0.268072E+01
+ PKER_SWETH( 28, 4) = 0.250758E+01
+ PKER_SWETH( 28, 5) = 0.234500E+01
+ PKER_SWETH( 28, 6) = 0.219234E+01
+ PKER_SWETH( 28, 7) = 0.204898E+01
+ PKER_SWETH( 28, 8) = 0.191437E+01
+ PKER_SWETH( 28, 9) = 0.178797E+01
+ PKER_SWETH( 28, 10) = 0.166928E+01
+ PKER_SWETH( 28, 11) = 0.155782E+01
+ PKER_SWETH( 28, 12) = 0.145315E+01
+ PKER_SWETH( 28, 13) = 0.135485E+01
+ PKER_SWETH( 28, 14) = 0.126254E+01
+ PKER_SWETH( 28, 15) = 0.117585E+01
+ PKER_SWETH( 28, 16) = 0.109443E+01
+ PKER_SWETH( 28, 17) = 0.101795E+01
+ PKER_SWETH( 28, 18) = 0.946114E+00
+ PKER_SWETH( 28, 19) = 0.878627E+00
+ PKER_SWETH( 28, 20) = 0.815218E+00
+ PKER_SWETH( 28, 21) = 0.755631E+00
+ PKER_SWETH( 28, 22) = 0.699623E+00
+ PKER_SWETH( 28, 23) = 0.646965E+00
+ PKER_SWETH( 28, 24) = 0.597438E+00
+ PKER_SWETH( 28, 25) = 0.550835E+00
+ PKER_SWETH( 28, 26) = 0.506959E+00
+ PKER_SWETH( 28, 27) = 0.465619E+00
+ PKER_SWETH( 28, 28) = 0.426636E+00
+ PKER_SWETH( 28, 29) = 0.389834E+00
+ PKER_SWETH( 28, 30) = 0.355045E+00
+ PKER_SWETH( 28, 31) = 0.322108E+00
+ PKER_SWETH( 28, 32) = 0.290872E+00
+ PKER_SWETH( 28, 33) = 0.261193E+00
+ PKER_SWETH( 28, 34) = 0.232948E+00
+ PKER_SWETH( 28, 35) = 0.206039E+00
+ PKER_SWETH( 28, 36) = 0.180409E+00
+ PKER_SWETH( 28, 37) = 0.156068E+00
+ PKER_SWETH( 28, 38) = 0.133115E+00
+ PKER_SWETH( 28, 39) = 0.111765E+00
+ PKER_SWETH( 28, 40) = 0.923608E-01
+ PKER_SWETH( 28, 41) = 0.753445E-01
+ PKER_SWETH( 28, 42) = 0.611817E-01
+ PKER_SWETH( 28, 43) = 0.502690E-01
+ PKER_SWETH( 28, 44) = 0.428431E-01
+ PKER_SWETH( 28, 45) = 0.388528E-01
+ PKER_SWETH( 28, 46) = 0.380123E-01
+ PKER_SWETH( 28, 47) = 0.398568E-01
+ PKER_SWETH( 28, 48) = 0.437542E-01
+ PKER_SWETH( 28, 49) = 0.490872E-01
+ PKER_SWETH( 28, 50) = 0.553254E-01
+ PKER_SWETH( 28, 51) = 0.619931E-01
+ PKER_SWETH( 28, 52) = 0.687719E-01
+ PKER_SWETH( 28, 53) = 0.754350E-01
+ PKER_SWETH( 28, 54) = 0.818527E-01
+ PKER_SWETH( 28, 55) = 0.879516E-01
+ PKER_SWETH( 28, 56) = 0.937041E-01
+ PKER_SWETH( 28, 57) = 0.991077E-01
+ PKER_SWETH( 28, 58) = 0.104172E+00
+ PKER_SWETH( 28, 59) = 0.108914E+00
+ PKER_SWETH( 28, 60) = 0.113354E+00
+ PKER_SWETH( 28, 61) = 0.117512E+00
+ PKER_SWETH( 28, 62) = 0.121407E+00
+ PKER_SWETH( 28, 63) = 0.125056E+00
+ PKER_SWETH( 28, 64) = 0.128476E+00
+ PKER_SWETH( 28, 65) = 0.131683E+00
+ PKER_SWETH( 28, 66) = 0.134690E+00
+ PKER_SWETH( 28, 67) = 0.137511E+00
+ PKER_SWETH( 28, 68) = 0.140158E+00
+ PKER_SWETH( 28, 69) = 0.142641E+00
+ PKER_SWETH( 28, 70) = 0.144972E+00
+ PKER_SWETH( 28, 71) = 0.147159E+00
+ PKER_SWETH( 28, 72) = 0.149212E+00
+ PKER_SWETH( 28, 73) = 0.151139E+00
+ PKER_SWETH( 28, 74) = 0.152948E+00
+ PKER_SWETH( 28, 75) = 0.154646E+00
+ PKER_SWETH( 28, 76) = 0.156240E+00
+ PKER_SWETH( 28, 77) = 0.157737E+00
+ PKER_SWETH( 28, 78) = 0.159143E+00
+ PKER_SWETH( 28, 79) = 0.160462E+00
+ PKER_SWETH( 28, 80) = 0.161701E+00
+ PKER_SWETH( 29, 1) = 0.308347E+01
+ PKER_SWETH( 29, 2) = 0.288710E+01
+ PKER_SWETH( 29, 3) = 0.270272E+01
+ PKER_SWETH( 29, 4) = 0.252958E+01
+ PKER_SWETH( 29, 5) = 0.236700E+01
+ PKER_SWETH( 29, 6) = 0.221434E+01
+ PKER_SWETH( 29, 7) = 0.207099E+01
+ PKER_SWETH( 29, 8) = 0.193639E+01
+ PKER_SWETH( 29, 9) = 0.180999E+01
+ PKER_SWETH( 29, 10) = 0.169130E+01
+ PKER_SWETH( 29, 11) = 0.157985E+01
+ PKER_SWETH( 29, 12) = 0.147519E+01
+ PKER_SWETH( 29, 13) = 0.137691E+01
+ PKER_SWETH( 29, 14) = 0.128461E+01
+ PKER_SWETH( 29, 15) = 0.119793E+01
+ PKER_SWETH( 29, 16) = 0.111653E+01
+ PKER_SWETH( 29, 17) = 0.104008E+01
+ PKER_SWETH( 29, 18) = 0.968270E+00
+ PKER_SWETH( 29, 19) = 0.900817E+00
+ PKER_SWETH( 29, 20) = 0.837451E+00
+ PKER_SWETH( 29, 21) = 0.777915E+00
+ PKER_SWETH( 29, 22) = 0.721968E+00
+ PKER_SWETH( 29, 23) = 0.669383E+00
+ PKER_SWETH( 29, 24) = 0.619944E+00
+ PKER_SWETH( 29, 25) = 0.573448E+00
+ PKER_SWETH( 29, 26) = 0.529699E+00
+ PKER_SWETH( 29, 27) = 0.488512E+00
+ PKER_SWETH( 29, 28) = 0.449712E+00
+ PKER_SWETH( 29, 29) = 0.413127E+00
+ PKER_SWETH( 29, 30) = 0.378596E+00
+ PKER_SWETH( 29, 31) = 0.345961E+00
+ PKER_SWETH( 29, 32) = 0.315072E+00
+ PKER_SWETH( 29, 33) = 0.285787E+00
+ PKER_SWETH( 29, 34) = 0.257972E+00
+ PKER_SWETH( 29, 35) = 0.231509E+00
+ PKER_SWETH( 29, 36) = 0.206298E+00
+ PKER_SWETH( 29, 37) = 0.182272E+00
+ PKER_SWETH( 29, 38) = 0.159406E+00
+ PKER_SWETH( 29, 39) = 0.137733E+00
+ PKER_SWETH( 29, 40) = 0.117365E+00
+ PKER_SWETH( 29, 41) = 0.984979E-01
+ PKER_SWETH( 29, 42) = 0.814212E-01
+ PKER_SWETH( 29, 43) = 0.664782E-01
+ PKER_SWETH( 29, 44) = 0.540142E-01
+ PKER_SWETH( 29, 45) = 0.443303E-01
+ PKER_SWETH( 29, 46) = 0.375787E-01
+ PKER_SWETH( 29, 47) = 0.337194E-01
+ PKER_SWETH( 29, 48) = 0.325388E-01
+ PKER_SWETH( 29, 49) = 0.336514E-01
+ PKER_SWETH( 29, 50) = 0.365861E-01
+ PKER_SWETH( 29, 51) = 0.408448E-01
+ PKER_SWETH( 29, 52) = 0.459450E-01
+ PKER_SWETH( 29, 53) = 0.515262E-01
+ PKER_SWETH( 29, 54) = 0.572696E-01
+ PKER_SWETH( 29, 55) = 0.629759E-01
+ PKER_SWETH( 29, 56) = 0.685136E-01
+ PKER_SWETH( 29, 57) = 0.738057E-01
+ PKER_SWETH( 29, 58) = 0.788178E-01
+ PKER_SWETH( 29, 59) = 0.835388E-01
+ PKER_SWETH( 29, 60) = 0.879729E-01
+ PKER_SWETH( 29, 61) = 0.921314E-01
+ PKER_SWETH( 29, 62) = 0.960291E-01
+ PKER_SWETH( 29, 63) = 0.996821E-01
+ PKER_SWETH( 29, 64) = 0.103106E+00
+ PKER_SWETH( 29, 65) = 0.106316E+00
+ PKER_SWETH( 29, 66) = 0.109326E+00
+ PKER_SWETH( 29, 67) = 0.112149E+00
+ PKER_SWETH( 29, 68) = 0.114797E+00
+ PKER_SWETH( 29, 69) = 0.117281E+00
+ PKER_SWETH( 29, 70) = 0.119613E+00
+ PKER_SWETH( 29, 71) = 0.121801E+00
+ PKER_SWETH( 29, 72) = 0.123854E+00
+ PKER_SWETH( 29, 73) = 0.125782E+00
+ PKER_SWETH( 29, 74) = 0.127591E+00
+ PKER_SWETH( 29, 75) = 0.129289E+00
+ PKER_SWETH( 29, 76) = 0.130884E+00
+ PKER_SWETH( 29, 77) = 0.132381E+00
+ PKER_SWETH( 29, 78) = 0.133786E+00
+ PKER_SWETH( 29, 79) = 0.135106E+00
+ PKER_SWETH( 29, 80) = 0.136344E+00
+ PKER_SWETH( 30, 1) = 0.310238E+01
+ PKER_SWETH( 30, 2) = 0.290601E+01
+ PKER_SWETH( 30, 3) = 0.272162E+01
+ PKER_SWETH( 30, 4) = 0.254849E+01
+ PKER_SWETH( 30, 5) = 0.238591E+01
+ PKER_SWETH( 30, 6) = 0.223325E+01
+ PKER_SWETH( 30, 7) = 0.208991E+01
+ PKER_SWETH( 30, 8) = 0.195531E+01
+ PKER_SWETH( 30, 9) = 0.182891E+01
+ PKER_SWETH( 30, 10) = 0.171023E+01
+ PKER_SWETH( 30, 11) = 0.159878E+01
+ PKER_SWETH( 30, 12) = 0.149413E+01
+ PKER_SWETH( 30, 13) = 0.139586E+01
+ PKER_SWETH( 30, 14) = 0.130357E+01
+ PKER_SWETH( 30, 15) = 0.121691E+01
+ PKER_SWETH( 30, 16) = 0.113552E+01
+ PKER_SWETH( 30, 17) = 0.105909E+01
+ PKER_SWETH( 30, 18) = 0.987301E+00
+ PKER_SWETH( 30, 19) = 0.919876E+00
+ PKER_SWETH( 30, 20) = 0.856541E+00
+ PKER_SWETH( 30, 21) = 0.797043E+00
+ PKER_SWETH( 30, 22) = 0.741143E+00
+ PKER_SWETH( 30, 23) = 0.688613E+00
+ PKER_SWETH( 30, 24) = 0.639241E+00
+ PKER_SWETH( 30, 25) = 0.592825E+00
+ PKER_SWETH( 30, 26) = 0.549173E+00
+ PKER_SWETH( 30, 27) = 0.508102E+00
+ PKER_SWETH( 30, 28) = 0.469441E+00
+ PKER_SWETH( 30, 29) = 0.433022E+00
+ PKER_SWETH( 30, 30) = 0.398687E+00
+ PKER_SWETH( 30, 31) = 0.366284E+00
+ PKER_SWETH( 30, 32) = 0.335667E+00
+ PKER_SWETH( 30, 33) = 0.306696E+00
+ PKER_SWETH( 30, 34) = 0.279238E+00
+ PKER_SWETH( 30, 35) = 0.253167E+00
+ PKER_SWETH( 30, 36) = 0.228374E+00
+ PKER_SWETH( 30, 37) = 0.204762E+00
+ PKER_SWETH( 30, 38) = 0.182262E+00
+ PKER_SWETH( 30, 39) = 0.160835E+00
+ PKER_SWETH( 30, 40) = 0.140485E+00
+ PKER_SWETH( 30, 41) = 0.121268E+00
+ PKER_SWETH( 30, 42) = 0.103293E+00
+ PKER_SWETH( 30, 43) = 0.867296E-01
+ PKER_SWETH( 30, 44) = 0.717964E-01
+ PKER_SWETH( 30, 45) = 0.587461E-01
+ PKER_SWETH( 30, 46) = 0.478245E-01
+ PKER_SWETH( 30, 47) = 0.392417E-01
+ PKER_SWETH( 30, 48) = 0.331060E-01
+ PKER_SWETH( 30, 49) = 0.293783E-01
+ PKER_SWETH( 30, 50) = 0.279234E-01
+ PKER_SWETH( 30, 51) = 0.284480E-01
+ PKER_SWETH( 30, 52) = 0.305694E-01
+ PKER_SWETH( 30, 53) = 0.339106E-01
+ PKER_SWETH( 30, 54) = 0.380759E-01
+ PKER_SWETH( 30, 55) = 0.427144E-01
+ PKER_SWETH( 30, 56) = 0.475751E-01
+ PKER_SWETH( 30, 57) = 0.524601E-01
+ PKER_SWETH( 30, 58) = 0.572399E-01
+ PKER_SWETH( 30, 59) = 0.618346E-01
+ PKER_SWETH( 30, 60) = 0.662050E-01
+ PKER_SWETH( 30, 61) = 0.703339E-01
+ PKER_SWETH( 30, 62) = 0.742197E-01
+ PKER_SWETH( 30, 63) = 0.778693E-01
+ PKER_SWETH( 30, 64) = 0.812936E-01
+ PKER_SWETH( 30, 65) = 0.845052E-01
+ PKER_SWETH( 30, 66) = 0.875171E-01
+ PKER_SWETH( 30, 67) = 0.903420E-01
+ PKER_SWETH( 30, 68) = 0.929917E-01
+ PKER_SWETH( 30, 69) = 0.954775E-01
+ PKER_SWETH( 30, 70) = 0.978099E-01
+ PKER_SWETH( 30, 71) = 0.999987E-01
+ PKER_SWETH( 30, 72) = 0.102053E+00
+ PKER_SWETH( 30, 73) = 0.103981E+00
+ PKER_SWETH( 30, 74) = 0.105790E+00
+ PKER_SWETH( 30, 75) = 0.107489E+00
+ PKER_SWETH( 30, 76) = 0.109084E+00
+ PKER_SWETH( 30, 77) = 0.110581E+00
+ PKER_SWETH( 30, 78) = 0.111986E+00
+ PKER_SWETH( 30, 79) = 0.113306E+00
+ PKER_SWETH( 30, 80) = 0.114545E+00
+ PKER_SWETH( 31, 1) = 0.311863E+01
+ PKER_SWETH( 31, 2) = 0.292226E+01
+ PKER_SWETH( 31, 3) = 0.273788E+01
+ PKER_SWETH( 31, 4) = 0.256474E+01
+ PKER_SWETH( 31, 5) = 0.240217E+01
+ PKER_SWETH( 31, 6) = 0.224951E+01
+ PKER_SWETH( 31, 7) = 0.210617E+01
+ PKER_SWETH( 31, 8) = 0.197157E+01
+ PKER_SWETH( 31, 9) = 0.184518E+01
+ PKER_SWETH( 31, 10) = 0.172650E+01
+ PKER_SWETH( 31, 11) = 0.161506E+01
+ PKER_SWETH( 31, 12) = 0.151041E+01
+ PKER_SWETH( 31, 13) = 0.141215E+01
+ PKER_SWETH( 31, 14) = 0.131987E+01
+ PKER_SWETH( 31, 15) = 0.123322E+01
+ PKER_SWETH( 31, 16) = 0.115184E+01
+ PKER_SWETH( 31, 17) = 0.107542E+01
+ PKER_SWETH( 31, 18) = 0.100365E+01
+ PKER_SWETH( 31, 19) = 0.936246E+00
+ PKER_SWETH( 31, 20) = 0.872936E+00
+ PKER_SWETH( 31, 21) = 0.813467E+00
+ PKER_SWETH( 31, 22) = 0.757602E+00
+ PKER_SWETH( 31, 23) = 0.705114E+00
+ PKER_SWETH( 31, 24) = 0.655793E+00
+ PKER_SWETH( 31, 25) = 0.609438E+00
+ PKER_SWETH( 31, 26) = 0.565859E+00
+ PKER_SWETH( 31, 27) = 0.524877E+00
+ PKER_SWETH( 31, 28) = 0.486320E+00
+ PKER_SWETH( 31, 29) = 0.450027E+00
+ PKER_SWETH( 31, 30) = 0.415842E+00
+ PKER_SWETH( 31, 31) = 0.383618E+00
+ PKER_SWETH( 31, 32) = 0.353211E+00
+ PKER_SWETH( 31, 33) = 0.324485E+00
+ PKER_SWETH( 31, 34) = 0.297310E+00
+ PKER_SWETH( 31, 35) = 0.271562E+00
+ PKER_SWETH( 31, 36) = 0.247124E+00
+ PKER_SWETH( 31, 37) = 0.223892E+00
+ PKER_SWETH( 31, 38) = 0.201777E+00
+ PKER_SWETH( 31, 39) = 0.180710E+00
+ PKER_SWETH( 31, 40) = 0.160650E+00
+ PKER_SWETH( 31, 41) = 0.141588E+00
+ PKER_SWETH( 31, 42) = 0.123552E+00
+ PKER_SWETH( 31, 43) = 0.106604E+00
+ PKER_SWETH( 31, 44) = 0.908414E-01
+ PKER_SWETH( 31, 45) = 0.763931E-01
+ PKER_SWETH( 31, 46) = 0.634109E-01
+ PKER_SWETH( 31, 47) = 0.520606E-01
+ PKER_SWETH( 31, 48) = 0.425084E-01
+ PKER_SWETH( 31, 49) = 0.349021E-01
+ PKER_SWETH( 31, 50) = 0.293151E-01
+ PKER_SWETH( 31, 51) = 0.257350E-01
+ PKER_SWETH( 31, 52) = 0.240679E-01
+ PKER_SWETH( 31, 53) = 0.241097E-01
+ PKER_SWETH( 31, 54) = 0.255670E-01
+ PKER_SWETH( 31, 55) = 0.281346E-01
+ PKER_SWETH( 31, 56) = 0.314877E-01
+ PKER_SWETH( 31, 57) = 0.353359E-01
+ PKER_SWETH( 31, 58) = 0.394363E-01
+ PKER_SWETH( 31, 59) = 0.436099E-01
+ PKER_SWETH( 31, 60) = 0.477319E-01
+ PKER_SWETH( 31, 61) = 0.517211E-01
+ PKER_SWETH( 31, 62) = 0.555332E-01
+ PKER_SWETH( 31, 63) = 0.591462E-01
+ PKER_SWETH( 31, 64) = 0.625536E-01
+ PKER_SWETH( 31, 65) = 0.657586E-01
+ PKER_SWETH( 31, 66) = 0.687686E-01
+ PKER_SWETH( 31, 67) = 0.715936E-01
+ PKER_SWETH( 31, 68) = 0.742443E-01
+ PKER_SWETH( 31, 69) = 0.767313E-01
+ PKER_SWETH( 31, 70) = 0.790647E-01
+ PKER_SWETH( 31, 71) = 0.812543E-01
+ PKER_SWETH( 31, 72) = 0.833091E-01
+ PKER_SWETH( 31, 73) = 0.852376E-01
+ PKER_SWETH( 31, 74) = 0.870477E-01
+ PKER_SWETH( 31, 75) = 0.887468E-01
+ PKER_SWETH( 31, 76) = 0.903417E-01
+ PKER_SWETH( 31, 77) = 0.918390E-01
+ PKER_SWETH( 31, 78) = 0.932447E-01
+ PKER_SWETH( 31, 79) = 0.945644E-01
+ PKER_SWETH( 31, 80) = 0.958034E-01
+ PKER_SWETH( 32, 1) = 0.313260E+01
+ PKER_SWETH( 32, 2) = 0.293624E+01
+ PKER_SWETH( 32, 3) = 0.275185E+01
+ PKER_SWETH( 32, 4) = 0.257872E+01
+ PKER_SWETH( 32, 5) = 0.241614E+01
+ PKER_SWETH( 32, 6) = 0.226349E+01
+ PKER_SWETH( 32, 7) = 0.212015E+01
+ PKER_SWETH( 32, 8) = 0.198555E+01
+ PKER_SWETH( 32, 9) = 0.185917E+01
+ PKER_SWETH( 32, 10) = 0.174049E+01
+ PKER_SWETH( 32, 11) = 0.162905E+01
+ PKER_SWETH( 32, 12) = 0.152441E+01
+ PKER_SWETH( 32, 13) = 0.142615E+01
+ PKER_SWETH( 32, 14) = 0.133388E+01
+ PKER_SWETH( 32, 15) = 0.124723E+01
+ PKER_SWETH( 32, 16) = 0.116587E+01
+ PKER_SWETH( 32, 17) = 0.108946E+01
+ PKER_SWETH( 32, 18) = 0.101770E+01
+ PKER_SWETH( 32, 19) = 0.950309E+00
+ PKER_SWETH( 32, 20) = 0.887017E+00
+ PKER_SWETH( 32, 21) = 0.827571E+00
+ PKER_SWETH( 32, 22) = 0.771732E+00
+ PKER_SWETH( 32, 23) = 0.719277E+00
+ PKER_SWETH( 32, 24) = 0.669995E+00
+ PKER_SWETH( 32, 25) = 0.623686E+00
+ PKER_SWETH( 32, 26) = 0.580163E+00
+ PKER_SWETH( 32, 27) = 0.539247E+00
+ PKER_SWETH( 32, 28) = 0.500771E+00
+ PKER_SWETH( 32, 29) = 0.464574E+00
+ PKER_SWETH( 32, 30) = 0.430504E+00
+ PKER_SWETH( 32, 31) = 0.398415E+00
+ PKER_SWETH( 32, 32) = 0.368170E+00
+ PKER_SWETH( 32, 33) = 0.339635E+00
+ PKER_SWETH( 32, 34) = 0.312682E+00
+ PKER_SWETH( 32, 35) = 0.287189E+00
+ PKER_SWETH( 32, 36) = 0.263042E+00
+ PKER_SWETH( 32, 37) = 0.240131E+00
+ PKER_SWETH( 32, 38) = 0.218359E+00
+ PKER_SWETH( 32, 39) = 0.197643E+00
+ PKER_SWETH( 32, 40) = 0.177917E+00
+ PKER_SWETH( 32, 41) = 0.159141E+00
+ PKER_SWETH( 32, 42) = 0.141300E+00
+ PKER_SWETH( 32, 43) = 0.124409E+00
+ PKER_SWETH( 32, 44) = 0.108506E+00
+ PKER_SWETH( 32, 45) = 0.936524E-01
+ PKER_SWETH( 32, 46) = 0.799192E-01
+ PKER_SWETH( 32, 47) = 0.673874E-01
+ PKER_SWETH( 32, 48) = 0.561491E-01
+ PKER_SWETH( 32, 49) = 0.463031E-01
+ PKER_SWETH( 32, 50) = 0.379538E-01
+ PKER_SWETH( 32, 51) = 0.312049E-01
+ PKER_SWETH( 32, 52) = 0.261105E-01
+ PKER_SWETH( 32, 53) = 0.226845E-01
+ PKER_SWETH( 32, 54) = 0.208720E-01
+ PKER_SWETH( 32, 55) = 0.205205E-01
+ PKER_SWETH( 32, 56) = 0.214305E-01
+ PKER_SWETH( 32, 57) = 0.233522E-01
+ PKER_SWETH( 32, 58) = 0.260139E-01
+ PKER_SWETH( 32, 59) = 0.291765E-01
+ PKER_SWETH( 32, 60) = 0.326186E-01
+ PKER_SWETH( 32, 61) = 0.361785E-01
+ PKER_SWETH( 32, 62) = 0.397295E-01
+ PKER_SWETH( 32, 63) = 0.431912E-01
+ PKER_SWETH( 32, 64) = 0.465163E-01
+ PKER_SWETH( 32, 65) = 0.496779E-01
+ PKER_SWETH( 32, 66) = 0.526668E-01
+ PKER_SWETH( 32, 67) = 0.554823E-01
+ PKER_SWETH( 32, 68) = 0.581292E-01
+ PKER_SWETH( 32, 69) = 0.606151E-01
+ PKER_SWETH( 32, 70) = 0.629486E-01
+ PKER_SWETH( 32, 71) = 0.651387E-01
+ PKER_SWETH( 32, 72) = 0.671941E-01
+ PKER_SWETH( 32, 73) = 0.691232E-01
+ PKER_SWETH( 32, 74) = 0.709337E-01
+ PKER_SWETH( 32, 75) = 0.726332E-01
+ PKER_SWETH( 32, 76) = 0.742284E-01
+ PKER_SWETH( 32, 77) = 0.757259E-01
+ PKER_SWETH( 32, 78) = 0.771318E-01
+ PKER_SWETH( 32, 79) = 0.784516E-01
+ PKER_SWETH( 32, 80) = 0.796907E-01
+ PKER_SWETH( 33, 1) = 0.314461E+01
+ PKER_SWETH( 33, 2) = 0.294825E+01
+ PKER_SWETH( 33, 3) = 0.276386E+01
+ PKER_SWETH( 33, 4) = 0.259073E+01
+ PKER_SWETH( 33, 5) = 0.242816E+01
+ PKER_SWETH( 33, 6) = 0.227551E+01
+ PKER_SWETH( 33, 7) = 0.213217E+01
+ PKER_SWETH( 33, 8) = 0.199757E+01
+ PKER_SWETH( 33, 9) = 0.187119E+01
+ PKER_SWETH( 33, 10) = 0.175251E+01
+ PKER_SWETH( 33, 11) = 0.164108E+01
+ PKER_SWETH( 33, 12) = 0.153644E+01
+ PKER_SWETH( 33, 13) = 0.143818E+01
+ PKER_SWETH( 33, 14) = 0.134592E+01
+ PKER_SWETH( 33, 15) = 0.125928E+01
+ PKER_SWETH( 33, 16) = 0.117792E+01
+ PKER_SWETH( 33, 17) = 0.110152E+01
+ PKER_SWETH( 33, 18) = 0.102977E+01
+ PKER_SWETH( 33, 19) = 0.962391E+00
+ PKER_SWETH( 33, 20) = 0.899114E+00
+ PKER_SWETH( 33, 21) = 0.839685E+00
+ PKER_SWETH( 33, 22) = 0.783867E+00
+ PKER_SWETH( 33, 23) = 0.731436E+00
+ PKER_SWETH( 33, 24) = 0.682183E+00
+ PKER_SWETH( 33, 25) = 0.635910E+00
+ PKER_SWETH( 33, 26) = 0.592429E+00
+ PKER_SWETH( 33, 27) = 0.551564E+00
+ PKER_SWETH( 33, 28) = 0.513149E+00
+ PKER_SWETH( 33, 29) = 0.477025E+00
+ PKER_SWETH( 33, 30) = 0.443042E+00
+ PKER_SWETH( 33, 31) = 0.411059E+00
+ PKER_SWETH( 33, 32) = 0.380937E+00
+ PKER_SWETH( 33, 33) = 0.352549E+00
+ PKER_SWETH( 33, 34) = 0.325769E+00
+ PKER_SWETH( 33, 35) = 0.300478E+00
+ PKER_SWETH( 33, 36) = 0.276562E+00
+ PKER_SWETH( 33, 37) = 0.253913E+00
+ PKER_SWETH( 33, 38) = 0.232431E+00
+ PKER_SWETH( 33, 39) = 0.212025E+00
+ PKER_SWETH( 33, 40) = 0.192616E+00
+ PKER_SWETH( 33, 41) = 0.174143E+00
+ PKER_SWETH( 33, 42) = 0.156567E+00
+ PKER_SWETH( 33, 43) = 0.139871E+00
+ PKER_SWETH( 33, 44) = 0.124064E+00
+ PKER_SWETH( 33, 45) = 0.109173E+00
+ PKER_SWETH( 33, 46) = 0.952378E-01
+ PKER_SWETH( 33, 47) = 0.823015E-01
+ PKER_SWETH( 33, 48) = 0.704036E-01
+ PKER_SWETH( 33, 49) = 0.595823E-01
+ PKER_SWETH( 33, 50) = 0.498785E-01
+ PKER_SWETH( 33, 51) = 0.413438E-01
+ PKER_SWETH( 33, 52) = 0.340421E-01
+ PKER_SWETH( 33, 53) = 0.280430E-01
+ PKER_SWETH( 33, 54) = 0.233974E-01
+ PKER_SWETH( 33, 55) = 0.201291E-01
+ PKER_SWETH( 33, 56) = 0.182206E-01
+ PKER_SWETH( 33, 57) = 0.175675E-01
+ PKER_SWETH( 33, 58) = 0.180229E-01
+ PKER_SWETH( 33, 59) = 0.194061E-01
+ PKER_SWETH( 33, 60) = 0.214879E-01
+ PKER_SWETH( 33, 61) = 0.240570E-01
+ PKER_SWETH( 33, 62) = 0.269359E-01
+ PKER_SWETH( 33, 63) = 0.299571E-01
+ PKER_SWETH( 33, 64) = 0.330093E-01
+ PKER_SWETH( 33, 65) = 0.360092E-01
+ PKER_SWETH( 33, 66) = 0.389073E-01
+ PKER_SWETH( 33, 67) = 0.416736E-01
+ PKER_SWETH( 33, 68) = 0.442952E-01
+ PKER_SWETH( 33, 69) = 0.467690E-01
+ PKER_SWETH( 33, 70) = 0.490971E-01
+ PKER_SWETH( 33, 71) = 0.512851E-01
+ PKER_SWETH( 33, 72) = 0.533399E-01
+ PKER_SWETH( 33, 73) = 0.552690E-01
+ PKER_SWETH( 33, 74) = 0.570798E-01
+ PKER_SWETH( 33, 75) = 0.587796E-01
+ PKER_SWETH( 33, 76) = 0.603751E-01
+ PKER_SWETH( 33, 77) = 0.618729E-01
+ PKER_SWETH( 33, 78) = 0.632789E-01
+ PKER_SWETH( 33, 79) = 0.645989E-01
+ PKER_SWETH( 33, 80) = 0.658382E-01
+ PKER_SWETH( 34, 1) = 0.315494E+01
+ PKER_SWETH( 34, 2) = 0.295858E+01
+ PKER_SWETH( 34, 3) = 0.277419E+01
+ PKER_SWETH( 34, 4) = 0.260106E+01
+ PKER_SWETH( 34, 5) = 0.243849E+01
+ PKER_SWETH( 34, 6) = 0.228584E+01
+ PKER_SWETH( 34, 7) = 0.214250E+01
+ PKER_SWETH( 34, 8) = 0.200790E+01
+ PKER_SWETH( 34, 9) = 0.188152E+01
+ PKER_SWETH( 34, 10) = 0.176285E+01
+ PKER_SWETH( 34, 11) = 0.165142E+01
+ PKER_SWETH( 34, 12) = 0.154678E+01
+ PKER_SWETH( 34, 13) = 0.144853E+01
+ PKER_SWETH( 34, 14) = 0.135626E+01
+ PKER_SWETH( 34, 15) = 0.126963E+01
+ PKER_SWETH( 34, 16) = 0.118827E+01
+ PKER_SWETH( 34, 17) = 0.111188E+01
+ PKER_SWETH( 34, 18) = 0.104014E+01
+ PKER_SWETH( 34, 19) = 0.972772E+00
+ PKER_SWETH( 34, 20) = 0.909506E+00
+ PKER_SWETH( 34, 21) = 0.850090E+00
+ PKER_SWETH( 34, 22) = 0.794288E+00
+ PKER_SWETH( 34, 23) = 0.741876E+00
+ PKER_SWETH( 34, 24) = 0.692646E+00
+ PKER_SWETH( 34, 25) = 0.646400E+00
+ PKER_SWETH( 34, 26) = 0.602952E+00
+ PKER_SWETH( 34, 27) = 0.562126E+00
+ PKER_SWETH( 34, 28) = 0.523757E+00
+ PKER_SWETH( 34, 29) = 0.487689E+00
+ PKER_SWETH( 34, 30) = 0.453773E+00
+ PKER_SWETH( 34, 31) = 0.421869E+00
+ PKER_SWETH( 34, 32) = 0.391843E+00
+ PKER_SWETH( 34, 33) = 0.363568E+00
+ PKER_SWETH( 34, 34) = 0.336921E+00
+ PKER_SWETH( 34, 35) = 0.311787E+00
+ PKER_SWETH( 34, 36) = 0.288054E+00
+ PKER_SWETH( 34, 37) = 0.265616E+00
+ PKER_SWETH( 34, 38) = 0.244371E+00
+ PKER_SWETH( 34, 39) = 0.224227E+00
+ PKER_SWETH( 34, 40) = 0.205097E+00
+ PKER_SWETH( 34, 41) = 0.186910E+00
+ PKER_SWETH( 34, 42) = 0.169607E+00
+ PKER_SWETH( 34, 43) = 0.153151E+00
+ PKER_SWETH( 34, 44) = 0.137525E+00
+ PKER_SWETH( 34, 45) = 0.122734E+00
+ PKER_SWETH( 34, 46) = 0.108800E+00
+ PKER_SWETH( 34, 47) = 0.957515E-01
+ PKER_SWETH( 34, 48) = 0.836164E-01
+ PKER_SWETH( 34, 49) = 0.724132E-01
+ PKER_SWETH( 34, 50) = 0.621505E-01
+ PKER_SWETH( 34, 51) = 0.528311E-01
+ PKER_SWETH( 34, 52) = 0.444613E-01
+ PKER_SWETH( 34, 53) = 0.370591E-01
+ PKER_SWETH( 34, 54) = 0.306644E-01
+ PKER_SWETH( 34, 55) = 0.253251E-01
+ PKER_SWETH( 34, 56) = 0.210858E-01
+ PKER_SWETH( 34, 57) = 0.179868E-01
+ PKER_SWETH( 34, 58) = 0.160241E-01
+ PKER_SWETH( 34, 59) = 0.151403E-01
+ PKER_SWETH( 34, 60) = 0.152366E-01
+ PKER_SWETH( 34, 61) = 0.161644E-01
+ PKER_SWETH( 34, 62) = 0.177533E-01
+ PKER_SWETH( 34, 63) = 0.198251E-01
+ PKER_SWETH( 34, 64) = 0.222044E-01
+ PKER_SWETH( 34, 65) = 0.247619E-01
+ PKER_SWETH( 34, 66) = 0.273765E-01
+ PKER_SWETH( 34, 67) = 0.299716E-01
+ PKER_SWETH( 34, 68) = 0.324948E-01
+ PKER_SWETH( 34, 69) = 0.349138E-01
+ PKER_SWETH( 34, 70) = 0.372131E-01
+ PKER_SWETH( 34, 71) = 0.393864E-01
+ PKER_SWETH( 34, 72) = 0.414343E-01
+ PKER_SWETH( 34, 73) = 0.433604E-01
+ PKER_SWETH( 34, 74) = 0.451700E-01
+ PKER_SWETH( 34, 75) = 0.468695E-01
+ PKER_SWETH( 34, 76) = 0.484650E-01
+ PKER_SWETH( 34, 77) = 0.499630E-01
+ PKER_SWETH( 34, 78) = 0.513692E-01
+ PKER_SWETH( 34, 79) = 0.526893E-01
+ PKER_SWETH( 34, 80) = 0.539287E-01
+ PKER_SWETH( 35, 1) = 0.316382E+01
+ PKER_SWETH( 35, 2) = 0.296745E+01
+ PKER_SWETH( 35, 3) = 0.278307E+01
+ PKER_SWETH( 35, 4) = 0.260994E+01
+ PKER_SWETH( 35, 5) = 0.244737E+01
+ PKER_SWETH( 35, 6) = 0.229472E+01
+ PKER_SWETH( 35, 7) = 0.215138E+01
+ PKER_SWETH( 35, 8) = 0.201679E+01
+ PKER_SWETH( 35, 9) = 0.189041E+01
+ PKER_SWETH( 35, 10) = 0.177173E+01
+ PKER_SWETH( 35, 11) = 0.166030E+01
+ PKER_SWETH( 35, 12) = 0.155567E+01
+ PKER_SWETH( 35, 13) = 0.145742E+01
+ PKER_SWETH( 35, 14) = 0.136516E+01
+ PKER_SWETH( 35, 15) = 0.127853E+01
+ PKER_SWETH( 35, 16) = 0.119718E+01
+ PKER_SWETH( 35, 17) = 0.112079E+01
+ PKER_SWETH( 35, 18) = 0.104905E+01
+ PKER_SWETH( 35, 19) = 0.981692E+00
+ PKER_SWETH( 35, 20) = 0.918434E+00
+ PKER_SWETH( 35, 21) = 0.859029E+00
+ PKER_SWETH( 35, 22) = 0.803239E+00
+ PKER_SWETH( 35, 23) = 0.750842E+00
+ PKER_SWETH( 35, 24) = 0.701629E+00
+ PKER_SWETH( 35, 25) = 0.655404E+00
+ PKER_SWETH( 35, 26) = 0.611980E+00
+ PKER_SWETH( 35, 27) = 0.571185E+00
+ PKER_SWETH( 35, 28) = 0.532852E+00
+ PKER_SWETH( 35, 29) = 0.496827E+00
+ PKER_SWETH( 35, 30) = 0.462962E+00
+ PKER_SWETH( 35, 31) = 0.431119E+00
+ PKER_SWETH( 35, 32) = 0.401166E+00
+ PKER_SWETH( 35, 33) = 0.372978E+00
+ PKER_SWETH( 35, 34) = 0.346435E+00
+ PKER_SWETH( 35, 35) = 0.321423E+00
+ PKER_SWETH( 35, 36) = 0.297833E+00
+ PKER_SWETH( 35, 37) = 0.275561E+00
+ PKER_SWETH( 35, 38) = 0.254507E+00
+ PKER_SWETH( 35, 39) = 0.234578E+00
+ PKER_SWETH( 35, 40) = 0.215686E+00
+ PKER_SWETH( 35, 41) = 0.197751E+00
+ PKER_SWETH( 35, 42) = 0.180705E+00
+ PKER_SWETH( 35, 43) = 0.164495E+00
+ PKER_SWETH( 35, 44) = 0.149084E+00
+ PKER_SWETH( 35, 45) = 0.134456E+00
+ PKER_SWETH( 35, 46) = 0.120615E+00
+ PKER_SWETH( 35, 47) = 0.107577E+00
+ PKER_SWETH( 35, 48) = 0.953661E-01
+ PKER_SWETH( 35, 49) = 0.840018E-01
+ PKER_SWETH( 35, 50) = 0.734926E-01
+ PKER_SWETH( 35, 51) = 0.638322E-01
+ PKER_SWETH( 35, 52) = 0.550036E-01
+ PKER_SWETH( 35, 53) = 0.469852E-01
+ PKER_SWETH( 35, 54) = 0.397621E-01
+ PKER_SWETH( 35, 55) = 0.333353E-01
+ PKER_SWETH( 35, 56) = 0.277239E-01
+ PKER_SWETH( 35, 57) = 0.229657E-01
+ PKER_SWETH( 35, 58) = 0.191037E-01
+ PKER_SWETH( 35, 59) = 0.161795E-01
+ PKER_SWETH( 35, 60) = 0.142064E-01
+ PKER_SWETH( 35, 61) = 0.131510E-01
+ PKER_SWETH( 35, 62) = 0.129597E-01
+ PKER_SWETH( 35, 63) = 0.135198E-01
+ PKER_SWETH( 35, 64) = 0.146888E-01
+ PKER_SWETH( 35, 65) = 0.163281E-01
+ PKER_SWETH( 35, 66) = 0.182882E-01
+ PKER_SWETH( 35, 67) = 0.204331E-01
+ PKER_SWETH( 35, 68) = 0.226652E-01
+ PKER_SWETH( 35, 69) = 0.249047E-01
+ PKER_SWETH( 35, 70) = 0.270982E-01
+ PKER_SWETH( 35, 71) = 0.292114E-01
+ PKER_SWETH( 35, 72) = 0.312269E-01
+ PKER_SWETH( 35, 73) = 0.331361E-01
+ PKER_SWETH( 35, 74) = 0.349374E-01
+ PKER_SWETH( 35, 75) = 0.366329E-01
+ PKER_SWETH( 35, 76) = 0.382268E-01
+ PKER_SWETH( 35, 77) = 0.397241E-01
+ PKER_SWETH( 35, 78) = 0.411301E-01
+ PKER_SWETH( 35, 79) = 0.424503E-01
+ PKER_SWETH( 35, 80) = 0.436897E-01
+ PKER_SWETH( 36, 1) = 0.317145E+01
+ PKER_SWETH( 36, 2) = 0.297509E+01
+ PKER_SWETH( 36, 3) = 0.279070E+01
+ PKER_SWETH( 36, 4) = 0.261757E+01
+ PKER_SWETH( 36, 5) = 0.245500E+01
+ PKER_SWETH( 36, 6) = 0.230235E+01
+ PKER_SWETH( 36, 7) = 0.215901E+01
+ PKER_SWETH( 36, 8) = 0.202442E+01
+ PKER_SWETH( 36, 9) = 0.189804E+01
+ PKER_SWETH( 36, 10) = 0.177937E+01
+ PKER_SWETH( 36, 11) = 0.166794E+01
+ PKER_SWETH( 36, 12) = 0.156331E+01
+ PKER_SWETH( 36, 13) = 0.146506E+01
+ PKER_SWETH( 36, 14) = 0.137280E+01
+ PKER_SWETH( 36, 15) = 0.128617E+01
+ PKER_SWETH( 36, 16) = 0.120483E+01
+ PKER_SWETH( 36, 17) = 0.112844E+01
+ PKER_SWETH( 36, 18) = 0.105671E+01
+ PKER_SWETH( 36, 19) = 0.989358E+00
+ PKER_SWETH( 36, 20) = 0.926106E+00
+ PKER_SWETH( 36, 21) = 0.866709E+00
+ PKER_SWETH( 36, 22) = 0.810928E+00
+ PKER_SWETH( 36, 23) = 0.758542E+00
+ PKER_SWETH( 36, 24) = 0.709343E+00
+ PKER_SWETH( 36, 25) = 0.663134E+00
+ PKER_SWETH( 36, 26) = 0.619730E+00
+ PKER_SWETH( 36, 27) = 0.578957E+00
+ PKER_SWETH( 36, 28) = 0.540652E+00
+ PKER_SWETH( 36, 29) = 0.504659E+00
+ PKER_SWETH( 36, 30) = 0.470834E+00
+ PKER_SWETH( 36, 31) = 0.439039E+00
+ PKER_SWETH( 36, 32) = 0.409142E+00
+ PKER_SWETH( 36, 33) = 0.381020E+00
+ PKER_SWETH( 36, 34) = 0.354557E+00
+ PKER_SWETH( 36, 35) = 0.329639E+00
+ PKER_SWETH( 36, 36) = 0.306160E+00
+ PKER_SWETH( 36, 37) = 0.284019E+00
+ PKER_SWETH( 36, 38) = 0.263117E+00
+ PKER_SWETH( 36, 39) = 0.243361E+00
+ PKER_SWETH( 36, 40) = 0.224665E+00
+ PKER_SWETH( 36, 41) = 0.206945E+00
+ PKER_SWETH( 36, 42) = 0.190128E+00
+ PKER_SWETH( 36, 43) = 0.174150E+00
+ PKER_SWETH( 36, 44) = 0.158961E+00
+ PKER_SWETH( 36, 45) = 0.144526E+00
+ PKER_SWETH( 36, 46) = 0.130829E+00
+ PKER_SWETH( 36, 47) = 0.117873E+00
+ PKER_SWETH( 36, 48) = 0.105672E+00
+ PKER_SWETH( 36, 49) = 0.942459E-01
+ PKER_SWETH( 36, 50) = 0.836094E-01
+ PKER_SWETH( 36, 51) = 0.737662E-01
+ PKER_SWETH( 36, 52) = 0.647037E-01
+ PKER_SWETH( 36, 53) = 0.563958E-01
+ PKER_SWETH( 36, 54) = 0.488078E-01
+ PKER_SWETH( 36, 55) = 0.419058E-01
+ PKER_SWETH( 36, 56) = 0.356633E-01
+ PKER_SWETH( 36, 57) = 0.300718E-01
+ PKER_SWETH( 36, 58) = 0.251413E-01
+ PKER_SWETH( 36, 59) = 0.208989E-01
+ PKER_SWETH( 36, 60) = 0.173840E-01
+ PKER_SWETH( 36, 61) = 0.146412E-01
+ PKER_SWETH( 36, 62) = 0.126895E-01
+ PKER_SWETH( 36, 63) = 0.115219E-01
+ PKER_SWETH( 36, 64) = 0.111061E-01
+ PKER_SWETH( 36, 65) = 0.113656E-01
+ PKER_SWETH( 36, 66) = 0.121884E-01
+ PKER_SWETH( 36, 67) = 0.134579E-01
+ PKER_SWETH( 36, 68) = 0.150470E-01
+ PKER_SWETH( 36, 69) = 0.168388E-01
+ PKER_SWETH( 36, 70) = 0.187349E-01
+ PKER_SWETH( 36, 71) = 0.206605E-01
+ PKER_SWETH( 36, 72) = 0.225628E-01
+ PKER_SWETH( 36, 73) = 0.244065E-01
+ PKER_SWETH( 36, 74) = 0.261718E-01
+ PKER_SWETH( 36, 75) = 0.278484E-01
+ PKER_SWETH( 36, 76) = 0.294325E-01
+ PKER_SWETH( 36, 77) = 0.309251E-01
+ PKER_SWETH( 36, 78) = 0.323289E-01
+ PKER_SWETH( 36, 79) = 0.336481E-01
+ PKER_SWETH( 36, 80) = 0.348872E-01
+ PKER_SWETH( 37, 1) = 0.317801E+01
+ PKER_SWETH( 37, 2) = 0.298165E+01
+ PKER_SWETH( 37, 3) = 0.279727E+01
+ PKER_SWETH( 37, 4) = 0.262413E+01
+ PKER_SWETH( 37, 5) = 0.246156E+01
+ PKER_SWETH( 37, 6) = 0.230891E+01
+ PKER_SWETH( 37, 7) = 0.216558E+01
+ PKER_SWETH( 37, 8) = 0.203099E+01
+ PKER_SWETH( 37, 9) = 0.190461E+01
+ PKER_SWETH( 37, 10) = 0.178594E+01
+ PKER_SWETH( 37, 11) = 0.167451E+01
+ PKER_SWETH( 37, 12) = 0.156988E+01
+ PKER_SWETH( 37, 13) = 0.147163E+01
+ PKER_SWETH( 37, 14) = 0.137938E+01
+ PKER_SWETH( 37, 15) = 0.129275E+01
+ PKER_SWETH( 37, 16) = 0.121140E+01
+ PKER_SWETH( 37, 17) = 0.113502E+01
+ PKER_SWETH( 37, 18) = 0.106330E+01
+ PKER_SWETH( 37, 19) = 0.995945E+00
+ PKER_SWETH( 37, 20) = 0.932699E+00
+ PKER_SWETH( 37, 21) = 0.873307E+00
+ PKER_SWETH( 37, 22) = 0.817534E+00
+ PKER_SWETH( 37, 23) = 0.765157E+00
+ PKER_SWETH( 37, 24) = 0.715968E+00
+ PKER_SWETH( 37, 25) = 0.669771E+00
+ PKER_SWETH( 37, 26) = 0.626382E+00
+ PKER_SWETH( 37, 27) = 0.585627E+00
+ PKER_SWETH( 37, 28) = 0.547343E+00
+ PKER_SWETH( 37, 29) = 0.511376E+00
+ PKER_SWETH( 37, 30) = 0.477581E+00
+ PKER_SWETH( 37, 31) = 0.445822E+00
+ PKER_SWETH( 37, 32) = 0.415968E+00
+ PKER_SWETH( 37, 33) = 0.387898E+00
+ PKER_SWETH( 37, 34) = 0.361496E+00
+ PKER_SWETH( 37, 35) = 0.336651E+00
+ PKER_SWETH( 37, 36) = 0.313259E+00
+ PKER_SWETH( 37, 37) = 0.291219E+00
+ PKER_SWETH( 37, 38) = 0.270437E+00
+ PKER_SWETH( 37, 39) = 0.250820E+00
+ PKER_SWETH( 37, 40) = 0.232282E+00
+ PKER_SWETH( 37, 41) = 0.214740E+00
+ PKER_SWETH( 37, 42) = 0.198119E+00
+ PKER_SWETH( 37, 43) = 0.182349E+00
+ PKER_SWETH( 37, 44) = 0.167369E+00
+ PKER_SWETH( 37, 45) = 0.153134E+00
+ PKER_SWETH( 37, 46) = 0.139610E+00
+ PKER_SWETH( 37, 47) = 0.126783E+00
+ PKER_SWETH( 37, 48) = 0.114653E+00
+ PKER_SWETH( 37, 49) = 0.103232E+00
+ PKER_SWETH( 37, 50) = 0.925378E-01
+ PKER_SWETH( 37, 51) = 0.825827E-01
+ PKER_SWETH( 37, 52) = 0.733675E-01
+ PKER_SWETH( 37, 53) = 0.648776E-01
+ PKER_SWETH( 37, 54) = 0.570830E-01
+ PKER_SWETH( 37, 55) = 0.499450E-01
+ PKER_SWETH( 37, 56) = 0.434200E-01
+ PKER_SWETH( 37, 57) = 0.374691E-01
+ PKER_SWETH( 37, 58) = 0.320636E-01
+ PKER_SWETH( 37, 59) = 0.271887E-01
+ PKER_SWETH( 37, 60) = 0.228498E-01
+ PKER_SWETH( 37, 61) = 0.190676E-01
+ PKER_SWETH( 37, 62) = 0.158762E-01
+ PKER_SWETH( 37, 63) = 0.133176E-01
+ PKER_SWETH( 37, 64) = 0.114155E-01
+ PKER_SWETH( 37, 65) = 0.101818E-01
+ PKER_SWETH( 37, 66) = 0.960151E-02
+ PKER_SWETH( 37, 67) = 0.961729E-02
+ PKER_SWETH( 37, 68) = 0.101533E-01
+ PKER_SWETH( 37, 69) = 0.111109E-01
+ PKER_SWETH( 37, 70) = 0.123790E-01
+ PKER_SWETH( 37, 71) = 0.138599E-01
+ PKER_SWETH( 37, 72) = 0.154599E-01
+ PKER_SWETH( 37, 73) = 0.171104E-01
+ PKER_SWETH( 37, 74) = 0.187566E-01
+ PKER_SWETH( 37, 75) = 0.203627E-01
+ PKER_SWETH( 37, 76) = 0.219075E-01
+ PKER_SWETH( 37, 77) = 0.233786E-01
+ PKER_SWETH( 37, 78) = 0.247714E-01
+ PKER_SWETH( 37, 79) = 0.260851E-01
+ PKER_SWETH( 37, 80) = 0.273215E-01
+ PKER_SWETH( 38, 1) = 0.318365E+01
+ PKER_SWETH( 38, 2) = 0.298729E+01
+ PKER_SWETH( 38, 3) = 0.280291E+01
+ PKER_SWETH( 38, 4) = 0.262978E+01
+ PKER_SWETH( 38, 5) = 0.246721E+01
+ PKER_SWETH( 38, 6) = 0.231456E+01
+ PKER_SWETH( 38, 7) = 0.217122E+01
+ PKER_SWETH( 38, 8) = 0.203663E+01
+ PKER_SWETH( 38, 9) = 0.191025E+01
+ PKER_SWETH( 38, 10) = 0.179158E+01
+ PKER_SWETH( 38, 11) = 0.168015E+01
+ PKER_SWETH( 38, 12) = 0.157552E+01
+ PKER_SWETH( 38, 13) = 0.147728E+01
+ PKER_SWETH( 38, 14) = 0.138502E+01
+ PKER_SWETH( 38, 15) = 0.129840E+01
+ PKER_SWETH( 38, 16) = 0.121706E+01
+ PKER_SWETH( 38, 17) = 0.114068E+01
+ PKER_SWETH( 38, 18) = 0.106895E+01
+ PKER_SWETH( 38, 19) = 0.100161E+01
+ PKER_SWETH( 38, 20) = 0.938364E+00
+ PKER_SWETH( 38, 21) = 0.878977E+00
+ PKER_SWETH( 38, 22) = 0.823209E+00
+ PKER_SWETH( 38, 23) = 0.770839E+00
+ PKER_SWETH( 38, 24) = 0.721658E+00
+ PKER_SWETH( 38, 25) = 0.675471E+00
+ PKER_SWETH( 38, 26) = 0.632094E+00
+ PKER_SWETH( 38, 27) = 0.591352E+00
+ PKER_SWETH( 38, 28) = 0.553085E+00
+ PKER_SWETH( 38, 29) = 0.517137E+00
+ PKER_SWETH( 38, 30) = 0.483366E+00
+ PKER_SWETH( 38, 31) = 0.451634E+00
+ PKER_SWETH( 38, 32) = 0.421814E+00
+ PKER_SWETH( 38, 33) = 0.393784E+00
+ PKER_SWETH( 38, 34) = 0.367429E+00
+ PKER_SWETH( 38, 35) = 0.342641E+00
+ PKER_SWETH( 38, 36) = 0.319316E+00
+ PKER_SWETH( 38, 37) = 0.297355E+00
+ PKER_SWETH( 38, 38) = 0.276666E+00
+ PKER_SWETH( 38, 39) = 0.257158E+00
+ PKER_SWETH( 38, 40) = 0.238746E+00
+ PKER_SWETH( 38, 41) = 0.221350E+00
+ PKER_SWETH( 38, 42) = 0.204891E+00
+ PKER_SWETH( 38, 43) = 0.189299E+00
+ PKER_SWETH( 38, 44) = 0.174508E+00
+ PKER_SWETH( 38, 45) = 0.160464E+00
+ PKER_SWETH( 38, 46) = 0.147120E+00
+ PKER_SWETH( 38, 47) = 0.134448E+00
+ PKER_SWETH( 38, 48) = 0.122432E+00
+ PKER_SWETH( 38, 49) = 0.111072E+00
+ PKER_SWETH( 38, 50) = 0.100379E+00
+ PKER_SWETH( 38, 51) = 0.903681E-01
+ PKER_SWETH( 38, 52) = 0.810492E-01
+ PKER_SWETH( 38, 53) = 0.724222E-01
+ PKER_SWETH( 38, 54) = 0.644714E-01
+ PKER_SWETH( 38, 55) = 0.571675E-01
+ PKER_SWETH( 38, 56) = 0.504700E-01
+ PKER_SWETH( 38, 57) = 0.443333E-01
+ PKER_SWETH( 38, 58) = 0.387134E-01
+ PKER_SWETH( 38, 59) = 0.335716E-01
+ PKER_SWETH( 38, 60) = 0.288792E-01
+ PKER_SWETH( 38, 61) = 0.246214E-01
+ PKER_SWETH( 38, 62) = 0.207986E-01
+ PKER_SWETH( 38, 63) = 0.174274E-01
+ PKER_SWETH( 38, 64) = 0.145371E-01
+ PKER_SWETH( 38, 65) = 0.121635E-01
+ PKER_SWETH( 38, 66) = 0.103355E-01
+ PKER_SWETH( 38, 67) = 0.907165E-02
+ PKER_SWETH( 38, 68) = 0.837324E-02
+ PKER_SWETH( 38, 69) = 0.820126E-02
+ PKER_SWETH( 38, 70) = 0.849900E-02
+ PKER_SWETH( 38, 71) = 0.919422E-02
+ PKER_SWETH( 38, 72) = 0.101904E-01
+ PKER_SWETH( 38, 73) = 0.113982E-01
+ PKER_SWETH( 38, 74) = 0.127419E-01
+ PKER_SWETH( 38, 75) = 0.141481E-01
+ PKER_SWETH( 38, 76) = 0.155678E-01
+ PKER_SWETH( 38, 77) = 0.169638E-01
+ PKER_SWETH( 38, 78) = 0.183137E-01
+ PKER_SWETH( 38, 79) = 0.196037E-01
+ PKER_SWETH( 38, 80) = 0.208275E-01
+ PKER_SWETH( 39, 1) = 0.318850E+01
+ PKER_SWETH( 39, 2) = 0.299214E+01
+ PKER_SWETH( 39, 3) = 0.280776E+01
+ PKER_SWETH( 39, 4) = 0.263463E+01
+ PKER_SWETH( 39, 5) = 0.247206E+01
+ PKER_SWETH( 39, 6) = 0.231941E+01
+ PKER_SWETH( 39, 7) = 0.217607E+01
+ PKER_SWETH( 39, 8) = 0.204148E+01
+ PKER_SWETH( 39, 9) = 0.191510E+01
+ PKER_SWETH( 39, 10) = 0.179644E+01
+ PKER_SWETH( 39, 11) = 0.168501E+01
+ PKER_SWETH( 39, 12) = 0.158038E+01
+ PKER_SWETH( 39, 13) = 0.148213E+01
+ PKER_SWETH( 39, 14) = 0.138988E+01
+ PKER_SWETH( 39, 15) = 0.130326E+01
+ PKER_SWETH( 39, 16) = 0.122192E+01
+ PKER_SWETH( 39, 17) = 0.114554E+01
+ PKER_SWETH( 39, 18) = 0.107382E+01
+ PKER_SWETH( 39, 19) = 0.100647E+01
+ PKER_SWETH( 39, 20) = 0.943232E+00
+ PKER_SWETH( 39, 21) = 0.883849E+00
+ PKER_SWETH( 39, 22) = 0.828086E+00
+ PKER_SWETH( 39, 23) = 0.775721E+00
+ PKER_SWETH( 39, 24) = 0.726547E+00
+ PKER_SWETH( 39, 25) = 0.680367E+00
+ PKER_SWETH( 39, 26) = 0.636998E+00
+ PKER_SWETH( 39, 27) = 0.596268E+00
+ PKER_SWETH( 39, 28) = 0.558013E+00
+ PKER_SWETH( 39, 29) = 0.522080E+00
+ PKER_SWETH( 39, 30) = 0.488327E+00
+ PKER_SWETH( 39, 31) = 0.456617E+00
+ PKER_SWETH( 39, 32) = 0.426823E+00
+ PKER_SWETH( 39, 33) = 0.398824E+00
+ PKER_SWETH( 39, 34) = 0.372505E+00
+ PKER_SWETH( 39, 35) = 0.347761E+00
+ PKER_SWETH( 39, 36) = 0.324487E+00
+ PKER_SWETH( 39, 37) = 0.302588E+00
+ PKER_SWETH( 39, 38) = 0.281972E+00
+ PKER_SWETH( 39, 39) = 0.262550E+00
+ PKER_SWETH( 39, 40) = 0.244238E+00
+ PKER_SWETH( 39, 41) = 0.226957E+00
+ PKER_SWETH( 39, 42) = 0.210631E+00
+ PKER_SWETH( 39, 43) = 0.195187E+00
+ PKER_SWETH( 39, 44) = 0.180559E+00
+ PKER_SWETH( 39, 45) = 0.166686E+00
+ PKER_SWETH( 39, 46) = 0.153516E+00
+ PKER_SWETH( 39, 47) = 0.141008E+00
+ PKER_SWETH( 39, 48) = 0.129131E+00
+ PKER_SWETH( 39, 49) = 0.117873E+00
+ PKER_SWETH( 39, 50) = 0.107233E+00
+ PKER_SWETH( 39, 51) = 0.972184E-01
+ PKER_SWETH( 39, 52) = 0.878440E-01
+ PKER_SWETH( 39, 53) = 0.791184E-01
+ PKER_SWETH( 39, 54) = 0.710406E-01
+ PKER_SWETH( 39, 55) = 0.635951E-01
+ PKER_SWETH( 39, 56) = 0.567529E-01
+ PKER_SWETH( 39, 57) = 0.504750E-01
+ PKER_SWETH( 39, 58) = 0.447169E-01
+ PKER_SWETH( 39, 59) = 0.394327E-01
+ PKER_SWETH( 39, 60) = 0.345813E-01
+ PKER_SWETH( 39, 61) = 0.301271E-01
+ PKER_SWETH( 39, 62) = 0.260446E-01
+ PKER_SWETH( 39, 63) = 0.223191E-01
+ PKER_SWETH( 39, 64) = 0.189491E-01
+ PKER_SWETH( 39, 65) = 0.159459E-01
+ PKER_SWETH( 39, 66) = 0.133348E-01
+ PKER_SWETH( 39, 67) = 0.111460E-01
+ PKER_SWETH( 39, 68) = 0.940775E-02
+ PKER_SWETH( 39, 69) = 0.814637E-02
+ PKER_SWETH( 39, 70) = 0.736755E-02
+ PKER_SWETH( 39, 71) = 0.705182E-02
+ PKER_SWETH( 39, 72) = 0.716064E-02
+ PKER_SWETH( 39, 73) = 0.763295E-02
+ PKER_SWETH( 39, 74) = 0.839614E-02
+ PKER_SWETH( 39, 75) = 0.937315E-02
+ PKER_SWETH( 39, 76) = 0.104870E-01
+ PKER_SWETH( 39, 77) = 0.116808E-01
+ PKER_SWETH( 39, 78) = 0.129002E-01
+ PKER_SWETH( 39, 79) = 0.141107E-01
+ PKER_SWETH( 39, 80) = 0.152883E-01
+ PKER_SWETH( 40, 1) = 0.319267E+01
+ PKER_SWETH( 40, 2) = 0.299631E+01
+ PKER_SWETH( 40, 3) = 0.281193E+01
+ PKER_SWETH( 40, 4) = 0.263880E+01
+ PKER_SWETH( 40, 5) = 0.247623E+01
+ PKER_SWETH( 40, 6) = 0.232358E+01
+ PKER_SWETH( 40, 7) = 0.218024E+01
+ PKER_SWETH( 40, 8) = 0.204565E+01
+ PKER_SWETH( 40, 9) = 0.191927E+01
+ PKER_SWETH( 40, 10) = 0.180061E+01
+ PKER_SWETH( 40, 11) = 0.168918E+01
+ PKER_SWETH( 40, 12) = 0.158455E+01
+ PKER_SWETH( 40, 13) = 0.148631E+01
+ PKER_SWETH( 40, 14) = 0.139405E+01
+ PKER_SWETH( 40, 15) = 0.130743E+01
+ PKER_SWETH( 40, 16) = 0.122609E+01
+ PKER_SWETH( 40, 17) = 0.114971E+01
+ PKER_SWETH( 40, 18) = 0.107800E+01
+ PKER_SWETH( 40, 19) = 0.101065E+01
+ PKER_SWETH( 40, 20) = 0.947416E+00
+ PKER_SWETH( 40, 21) = 0.888036E+00
+ PKER_SWETH( 40, 22) = 0.832276E+00
+ PKER_SWETH( 40, 23) = 0.779916E+00
+ PKER_SWETH( 40, 24) = 0.730746E+00
+ PKER_SWETH( 40, 25) = 0.684572E+00
+ PKER_SWETH( 40, 26) = 0.641210E+00
+ PKER_SWETH( 40, 27) = 0.600488E+00
+ PKER_SWETH( 40, 28) = 0.562243E+00
+ PKER_SWETH( 40, 29) = 0.526323E+00
+ PKER_SWETH( 40, 30) = 0.492583E+00
+ PKER_SWETH( 40, 31) = 0.460890E+00
+ PKER_SWETH( 40, 32) = 0.431116E+00
+ PKER_SWETH( 40, 33) = 0.403140E+00
+ PKER_SWETH( 40, 34) = 0.376851E+00
+ PKER_SWETH( 40, 35) = 0.352140E+00
+ PKER_SWETH( 40, 36) = 0.328907E+00
+ PKER_SWETH( 40, 37) = 0.307055E+00
+ PKER_SWETH( 40, 38) = 0.286495E+00
+ PKER_SWETH( 40, 39) = 0.267140E+00
+ PKER_SWETH( 40, 40) = 0.248907E+00
+ PKER_SWETH( 40, 41) = 0.231718E+00
+ PKER_SWETH( 40, 42) = 0.215498E+00
+ PKER_SWETH( 40, 43) = 0.200175E+00
+ PKER_SWETH( 40, 44) = 0.185683E+00
+ PKER_SWETH( 40, 45) = 0.171959E+00
+ PKER_SWETH( 40, 46) = 0.158946E+00
+ PKER_SWETH( 40, 47) = 0.146595E+00
+ PKER_SWETH( 40, 48) = 0.134867E+00
+ PKER_SWETH( 40, 49) = 0.123735E+00
+ PKER_SWETH( 40, 50) = 0.113185E+00
+ PKER_SWETH( 40, 51) = 0.103216E+00
+ PKER_SWETH( 40, 52) = 0.938355E-01
+ PKER_SWETH( 40, 53) = 0.850554E-01
+ PKER_SWETH( 40, 54) = 0.768835E-01
+ PKER_SWETH( 40, 55) = 0.693180E-01
+ PKER_SWETH( 40, 56) = 0.623442E-01
+ PKER_SWETH( 40, 57) = 0.559346E-01
+ PKER_SWETH( 40, 58) = 0.500518E-01
+ PKER_SWETH( 40, 59) = 0.446530E-01
+ PKER_SWETH( 40, 60) = 0.396945E-01
+ PKER_SWETH( 40, 61) = 0.351341E-01
+ PKER_SWETH( 40, 62) = 0.309350E-01
+ PKER_SWETH( 40, 63) = 0.270668E-01
+ PKER_SWETH( 40, 64) = 0.235073E-01
+ PKER_SWETH( 40, 65) = 0.202425E-01
+ PKER_SWETH( 40, 66) = 0.172698E-01
+ PKER_SWETH( 40, 67) = 0.145977E-01
+ PKER_SWETH( 40, 68) = 0.122444E-01
+ PKER_SWETH( 40, 69) = 0.102365E-01
+ PKER_SWETH( 40, 70) = 0.860187E-02
+ PKER_SWETH( 40, 71) = 0.736637E-02
+ PKER_SWETH( 40, 72) = 0.654201E-02
+ PKER_SWETH( 40, 73) = 0.611859E-02
+ PKER_SWETH( 40, 74) = 0.607653E-02
+ PKER_SWETH( 40, 75) = 0.636809E-02
+ PKER_SWETH( 40, 76) = 0.693164E-02
+ PKER_SWETH( 40, 77) = 0.770652E-02
+ PKER_SWETH( 40, 78) = 0.862610E-02
+ PKER_SWETH( 40, 79) = 0.962951E-02
+ PKER_SWETH( 40, 80) = 0.106726E-01
+END IF
+!
+END SUBROUTINE READ_XKER_SWETH
diff --git a/src/mesonh/micro/rrcolss.f90 b/src/mesonh/micro/rrcolss.f90
new file mode 100644
index 000000000..527165111
--- /dev/null
+++ b/src/mesonh/micro/rrcolss.f90
@@ -0,0 +1,312 @@
+!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ###################
+ MODULE MODI_RRCOLSS
+! ###################
+!
+INTERFACE
+!
+ SUBROUTINE RRCOLSS( KND, PALPHAS, PNUS, PALPHAR, PNUR, &
+ PESR, PEXMASSR, PFALLS, PEXFALLS, PFALLR, PEXFALLR, &
+ PLBDASMAX, PLBDARMAX, PLBDASMIN, PLBDARMIN, &
+ PDINFTY, PRRCOLSS, PAG, PBS, PAS )
+!
+INTEGER, INTENT(IN) :: KND ! Number of discrete size intervals in DS and DR
+!
+REAL, INTENT(IN) :: PALPHAS ! First shape parameter of the aggregates
+ ! size distribution (generalized gamma law)
+REAL, INTENT(IN) :: PNUS ! Second shape parameter of the aggregates
+ ! size distribution (generalized gamma law)
+REAL, INTENT(IN) :: PALPHAR ! First shape parameter of the rain
+ ! size distribution (generalized gamma law)
+REAL, INTENT(IN) :: PNUR ! Second shape parameter of the rain
+ ! size distribution (generalized gamma law)
+REAL, INTENT(IN) :: PESR ! Efficiency of aggregates collecting rain
+REAL, INTENT(IN) :: PEXMASSR ! Mass exponent of rain
+REAL, INTENT(IN) :: PFALLS ! Fall speed constant of aggregates
+REAL, INTENT(IN) :: PEXFALLS ! Fall speed exponent of aggregates
+REAL, INTENT(IN) :: PFALLR ! Fall speed constant of rain
+REAL, INTENT(IN) :: PEXFALLR ! Fall speed exponent of rain
+REAL, INTENT(IN) :: PLBDASMAX ! Maximun slope of size distribution of aggregates
+REAL, INTENT(IN) :: PLBDARMAX ! Maximun slope of size distribution of rain
+REAL, INTENT(IN) :: PLBDASMIN ! Minimun slope of size distribution of aggregates
+REAL, INTENT(IN) :: PLBDARMIN ! Minimun slope of size distribution of rain
+REAL, INTENT(IN) :: PDINFTY ! Factor to define the largest diameter up to
+ ! which the diameter integration is performed
+REAL, INTENT(IN) :: PAG, PBS, PAS
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PRRCOLSS! Scaled fall speed difference in
+ ! the mass collection kernel as a
+ ! function of LAMBDAX and LAMBDAZ
+!
+ END SUBROUTINE RRCOLSS
+!
+END INTERFACE
+!
+ END MODULE MODI_RRCOLSS
+! ########################################################################
+ SUBROUTINE RRCOLSS( KND, PALPHAS, PNUS, PALPHAR, PNUR, &
+ PESR, PEXMASSR, PFALLS, PEXFALLS, PFALLR, PEXFALLR, &
+ PLBDASMAX, PLBDARMAX, PLBDASMIN, PLBDARMIN, &
+ PDINFTY, PRRCOLSS, PAG, PBS, PAS )
+! ########################################################################
+!
+!
+!
+!!**** * - Build up a look-up table containing the scaled fall speed
+!! difference between size distributed particles of aggregates and Z
+!!
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to integrate numerically the scaled fall
+!! speed difference between aggregates and rain for use in collection
+!! kernels. A first integral of the form
+!!
+!! infty Dz_max
+!! / /
+!! |{| }
+!! |{| E_xz (Dx+Dz)^2 |cxDx^dx-czDz^dz| Dz^bz n(Dz) dDz} n(Dx) dDx
+!! |{| }
+!! / /
+!! 0 Dz_min
+!!
+!! is evaluated and normalised by a second integral of the form
+!!
+!! infty
+!! / /
+!! |{| }
+!! |{| (Dx+Dz)^2 Dz^bz n(Dz) dDz} n(Dx) dDx
+!! |{| }
+!! / /
+!! 0
+!!
+!! The result is stored in a two-dimensional array.
+!!
+!!** METHOD
+!! ------
+!! The free parameters of the size distribution function of aggregates and Z
+!! (slope parameter LAMBDA) are discretized with a geometrical rate in a
+!! specific range
+!! LAMBDA = exp( (Log(LAMBDA_max) - Log(LAMBDA_min))/N_interval )
+!! The two above integrals are performed using the trapezoidal scheme.
+!!
+!! EXTERNAL
+!! --------
+!! MODI_GENERAL_GAMMA: Generalized gamma distribution law
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! MODD_CST : XPI,XRHOLW
+!! MODD_RAIN_ICE_DESCR: XAS,XAS,XBS
+!!
+!! REFERENCE
+!! ---------
+!! B.S. Ferrier , 1994 : A Double-Moment Multiple-Phase Four-Class
+!! Bulk Ice Scheme,JAS,51,249-280.
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * Laboratoire d'Aerologie *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 8/11/95
+!!
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!
+USE MODI_GENERAL_GAMMA
+!
+USE MODD_CST
+USE MODD_RAIN_ICE_DESCR
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 Declarations of dummy arguments
+! -------------------------------
+!
+!
+INTEGER, INTENT(IN) :: KND ! Number of discrete size intervals in DS and DR
+!
+REAL, INTENT(IN) :: PALPHAS ! First shape parameter of the aggregates
+ ! size distribution (generalized gamma law)
+REAL, INTENT(IN) :: PNUS ! Second shape parameter of the aggregates
+ ! size distribution (generalized gamma law)
+REAL, INTENT(IN) :: PALPHAR ! First shape parameter of the rain
+ ! size distribution (generalized gamma law)
+REAL, INTENT(IN) :: PNUR ! Second shape parameter of the rain
+ ! size distribution (generalized gamma law)
+REAL, INTENT(IN) :: PESR ! Efficiency of aggregates collecting rain
+REAL, INTENT(IN) :: PEXMASSR ! Mass exponent of rain
+REAL, INTENT(IN) :: PFALLS ! Fall speed constant of aggregates
+REAL, INTENT(IN) :: PEXFALLS ! Fall speed exponent of aggregates
+REAL, INTENT(IN) :: PFALLR ! Fall speed constant of rain
+REAL, INTENT(IN) :: PEXFALLR ! Fall speed exponent of rain
+REAL, INTENT(IN) :: PLBDASMAX ! Maximun slope of size distribution of aggregates
+REAL, INTENT(IN) :: PLBDARMAX ! Maximun slope of size distribution of rain
+REAL, INTENT(IN) :: PLBDASMIN ! Minimun slope of size distribution of aggregates
+REAL, INTENT(IN) :: PLBDARMIN ! Minimun slope of size distribution of rain
+REAL, INTENT(IN) :: PDINFTY ! Factor to define the largest diameter up to
+ ! which the diameter integration is performed
+REAL, INTENT(IN) :: PAG, PBS, PAS
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PRRCOLSS! Scaled fall speed difference in
+ ! the mass collection kernel as a
+ ! function of LAMBDAX and LAMBDAZ
+!
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+!
+INTEGER :: JLBDAS ! Slope index of the size distribution of aggregates
+INTEGER :: JLBDAR ! Slope index of the size distribution of rain
+INTEGER :: JDS ! Diameter index of a particle of aggregates
+INTEGER :: JDR ! Diameter index of a particle of rain
+!
+INTEGER :: INR ! Number of diameter step for the partial integration
+!
+!
+REAL :: ZLBDAS ! Current slope parameter LAMBDA of aggregates
+REAL :: ZLBDAR ! Current slope parameter LAMBDA of rain
+REAL :: ZDLBDAS ! Growth rate of the slope parameter LAMBDA of aggregates
+REAL :: ZDLBDAR ! Growth rate of the slope parameter LAMBDA of rain
+REAL :: ZDDS ! Integration step of the diameter of aggregates
+REAL :: ZDDSCALR! Integration step of the diameter of rain (scaling integral)
+REAL :: ZDDCOLLR! Integration step of the diameter of rain (fallspe integral)
+REAL :: ZDS ! Current diameter of the particle aggregates
+REAL :: ZDR ! Current diameter of the rain
+REAL :: ZDRMAX ! Maximal diameter of the raindrops where the integration ends
+REAL :: ZCOLLR ! Single integral of the mass weighted fall speed difference
+ ! over the spectrum of rain
+REAL :: ZCOLLDRMAX ! Maximum ending point for the partial integral
+REAL :: ZCOLLSR ! Double integral of the mass weighted fall speed difference
+ ! over the spectra of aggregates and rain
+REAL :: ZSCALR ! Single integral of the scaling factor over
+ ! the spectrum of rain
+REAL :: ZSCALSR ! Double integral of the scaling factor over
+ ! the spectra of aggregates and rain
+REAL :: ZFUNC ! Ancillary function
+REAL :: ZCST1
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 1 COMPUTE THE SCALED VELOCITY DIFFERENCE IN THE MASS
+!* COLLECTION KERNEL,
+! -------------------------------------------------
+!
+!
+!
+!* 1.0 Initialization
+!
+PRRCOLSS(:,:) = 0.0
+ZCST1 = (3.0/XPI)/XRHOLW
+!
+!* 1.1 Compute the growth rate of the slope factors LAMBDA
+!
+ZDLBDAS = EXP( LOG(PLBDASMAX/PLBDASMIN)/REAL(SIZE(PRRCOLSS(:,:),1)-1) )
+ZDLBDAR = EXP( LOG(PLBDARMAX/PLBDARMIN)/REAL(SIZE(PRRCOLSS(:,:),2)-1) )
+!
+!* 1.2 Scan the slope factors LAMBDAX and LAMBDAZ
+!
+DO JLBDAS = 1,SIZE(PRRCOLSS(:,:),1)
+ ZLBDAS = PLBDASMIN * ZDLBDAS ** (JLBDAS-1)
+!
+!* 1.3 Compute the diameter steps
+!
+ ZDDS = PDINFTY / (REAL(KND) * ZLBDAS)
+ DO JLBDAR = 1,SIZE(PRRCOLSS(:,:),2)
+ ZLBDAR = PLBDARMIN * ZDLBDAR ** (JLBDAR-1)
+!
+!* 1.4 Initialize the collection integrals
+!
+ ZSCALSR = 0.0
+ ZCOLLSR = 0.0
+!
+!* 1.5 Compute the diameter steps
+!
+ ZDDSCALR = PDINFTY / (REAL(KND) * ZLBDAR)
+!
+!* 1.6 Scan over the diameters DS and DR
+!
+ DO JDS = 1,KND-1
+ ZDS = ZDDS * REAL(JDS)
+ ZSCALR = 0.0
+ ZCOLLR = 0.0
+ DO JDR = 1,KND-1
+ ZDR = ZDDSCALR * REAL(JDR)
+!
+!* 1.7 Compute the normalization factor by integration over the
+! dimensional spectrum of rain
+!
+ ZSCALR = ZSCALR + (ZDS+ZDR)**2 * ZDR**PEXMASSR &
+ * GENERAL_GAMMA(PALPHAR,PNUR,ZLBDAR,ZDR)
+ END DO
+!
+!* 1.8 Compute the scaled fall speed difference by partial
+! integration over the dimensional spectrum of rain
+!
+ ZFUNC = PAG - PAS*ZDS**(PBS-3.0) ! approximate limit is Ds=240 microns
+ IF( ZFUNC>0.0 ) THEN
+ ZDRMAX = ZDS*( ZCST1*ZFUNC )**0.3333333
+ ELSE
+ ZDRMAX = PDINFTY / ZLBDAR
+ END IF
+ IF( ZDS>1.0E-4 ) THEN ! allow computation if Ds>100 microns
+ ! corresponding to a maximal density of the aggregates of XRHOLW
+ IF( ZDRMAX >= 0.5*ZDDSCALR ) THEN
+ INR = CEILING( ZDRMAX/ZDDSCALR )
+ ZDDCOLLR = ZDRMAX / REAL(INR)
+ IF (INR>=KND ) THEN
+ INR = KND
+ ZDDCOLLR = ZDDSCALR
+ END IF
+ DO JDR = 1,INR-1
+ ZDR = ZDDCOLLR * REAL(JDR)
+ ZCOLLR = ZCOLLR + (ZDS+ZDR)**2 * ZDR**PEXMASSR &
+ * PESR * ABS(PFALLS*ZDS**PEXFALLS-PFALLR*ZDR**PEXFALLR) &
+ * GENERAL_GAMMA(PALPHAR,PNUR,ZLBDAR,ZDR)
+ END DO
+ ZCOLLDRMAX = (ZDS+ZDRMAX)**2 * ZDRMAX**PEXMASSR &
+ * PESR * ABS(PFALLS*ZDS**PEXFALLS-PFALLR*ZDRMAX**PEXFALLR) &
+ * GENERAL_GAMMA(PALPHAR,PNUR,ZLBDAR,ZDRMAX)
+ ZCOLLR = (ZCOLLR + 0.5*ZCOLLDRMAX)*(ZDDCOLLR/ZDDSCALR)
+!
+!* 1.9 Compute the normalization factor by integration over the
+! dimensional spectrum of aggregates
+!
+ ZFUNC = GENERAL_GAMMA(PALPHAS,PNUS,ZLBDAS,ZDS)
+ ZSCALSR = ZSCALSR + ZSCALR * ZFUNC
+!
+!* 1.10 Compute the scaled fall speed difference by integration over
+! the dimensional spectrum of aggregates
+!
+ ZCOLLSR = ZCOLLSR + ZCOLLR * ZFUNC
+ END IF
+!
+! Otherwise ZDRMAX = 0.0 so the density of the graupel cannot be reached
+! and so PRRCOLSS(JLBDAS,JLBDAR) = 0.0 !
+!
+ END IF
+ END DO
+!
+!* 1.11 Scale the fall speed difference
+!
+ IF( ZSCALSR>0.0 ) PRRCOLSS(JLBDAS,JLBDAR) = ZCOLLSR / ZSCALSR
+ END DO
+END DO
+!
+END SUBROUTINE RRCOLSS
diff --git a/src/mesonh/micro/rscolrg.f90 b/src/mesonh/micro/rscolrg.f90
new file mode 100644
index 000000000..caa868e91
--- /dev/null
+++ b/src/mesonh/micro/rscolrg.f90
@@ -0,0 +1,312 @@
+!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ###################
+ MODULE MODI_RSCOLRG
+! ###################
+!
+INTERFACE
+!
+ SUBROUTINE RSCOLRG( KND, PALPHAS, PZNUS, PALPHAR, PNUR, &
+ PESR, PEXMASSS, PFALLS, PEXFALLS, PFALLR, PEXFALLR, &
+ PLBDASMAX, PLBDARMAX, PLBDASMIN, PLBDARMIN, &
+ PDINFTY, PRSCOLRG,PAG, PBS, PAS )
+!
+INTEGER, INTENT(IN) :: KND ! Number of discrete size intervals in DS and DR
+!
+REAL, INTENT(IN) :: PALPHAS ! First shape parameter of the aggregates
+ ! size distribution (generalized gamma law)
+REAL, INTENT(IN) :: PZNUS ! Second shape parameter of the aggregates
+ ! size distribution (generalized gamma law)
+REAL, INTENT(IN) :: PALPHAR ! First shape parameter of the rain
+ ! size distribution (generalized gamma law)
+REAL, INTENT(IN) :: PNUR ! Second shape parameter of the rain
+ ! size distribution (generalized gamma law)
+REAL, INTENT(IN) :: PESR ! Efficiency of the aggregates collecting rain
+REAL, INTENT(IN) :: PEXMASSS ! Mass exponent of the aggregates
+REAL, INTENT(IN) :: PFALLS ! Fall speed constant of the aggregates
+REAL, INTENT(IN) :: PEXFALLS ! Fall speed exponent of the aggregates
+REAL, INTENT(IN) :: PFALLR ! Fall speed constant of rain
+REAL, INTENT(IN) :: PEXFALLR ! Fall speed exponent of rain
+REAL, INTENT(IN) :: PLBDASMAX ! Maximun slope of size distribution of the aggregates
+REAL, INTENT(IN) :: PLBDARMAX ! Maximun slope of size distribution of rain
+REAL, INTENT(IN) :: PLBDASMIN ! Minimun slope of size distribution of the aggregates
+REAL, INTENT(IN) :: PLBDARMIN ! Minimun slope of size distribution of rain
+REAL, INTENT(IN) :: PDINFTY ! Factor to define the largest diameter up to
+ ! which the diameter integration is performed
+REAL, INTENT(IN) :: PAG, PBS, PAS
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PRSCOLRG! Scaled fall speed difference in
+ ! the mass collection kernel as a
+ ! function of LAMBDAX and LAMBDAZ
+!
+ END SUBROUTINE RSCOLRG
+!
+END INTERFACE
+!
+ END MODULE MODI_RSCOLRG
+! ########################################################################
+ SUBROUTINE RSCOLRG( KND, PALPHAS, PZNUS, PALPHAR, PNUR, &
+ PESR, PEXMASSS, PFALLS, PEXFALLS, PFALLR, PEXFALLR, &
+ PLBDASMAX, PLBDARMAX, PLBDASMIN, PLBDARMIN, &
+ PDINFTY, PRSCOLRG,PAG, PBS, PAS )
+! ########################################################################
+!
+!
+!
+!!**** * - Build up a look-up table containing the scaled fall speed
+!! difference between size distributed particles of the aggregates and Z
+!!
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to integrate numerically the scaled fall
+!! speed difference between aggregates and rain for use in collection
+!! kernels. A first integral of the form
+!!
+!! infty Dz_max
+!! / /
+!! |{| }
+!! |{| E_xz (Dx+Dz)^2 |cxDx^dx-czDz^dz| Dz^bz n(Dz) dDz} n(Dx) dDx
+!! |{| }
+!! / /
+!! 0 Dz_min
+!!
+!! is evaluated and normalised by a second integral of the form
+!!
+!! infty
+!! / /
+!! |{| }
+!! |{| (Dx+Dz)^2 Dz^bz n(Dz) dDz} n(Dx) dDx
+!! |{| }
+!! / /
+!! 0
+!!
+!! The result is stored in a two-dimensional array.
+!!
+!!** METHOD
+!! ------
+!! The free parameters of the size distribution function of the aggregates
+!! and Z (slope parameter LAMBDA) are discretized with a geometrical rate
+!! in a specific range
+!! LAMBDA = exp( (Log(LAMBDA_max) - Log(LAMBDA_min))/N_interval )
+!! The two above integrals are performed using the trapezoidal scheme.
+!!
+!! EXTERNAL
+!! --------
+!! MODI_GENERAL_GAMMA: Generalized gamma distribution law
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! MODD_CST : XPI,XRHOLW
+!! MODD_RAIN_ICE_DESCR: XAS,XAS,XBS
+!!
+!! REFERENCE
+!! ---------
+!! B.S. Ferrier , 1994 : A Double-Moment Multiple-Phase Four-Class
+!! Bulk Ice Scheme,JAS,51,249-280.
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * Laboratoire d'Aerologie *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 8/11/95
+!!
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODI_GENERAL_GAMMA
+!
+USE MODD_CST
+USE MODD_RAIN_ICE_DESCR
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments
+! -------------------------------
+!
+!
+INTEGER, INTENT(IN) :: KND ! Number of discrete size intervals in DS and DR
+!
+REAL, INTENT(IN) :: PALPHAS ! First shape parameter of the aggregates
+ ! size distribution (generalized gamma law)
+REAL, INTENT(IN) :: PZNUS ! Second shape parameter of the aggregates
+ ! size distribution (generalized gamma law)
+REAL, INTENT(IN) :: PALPHAR ! First shape parameter of the rain
+ ! size distribution (generalized gamma law)
+REAL, INTENT(IN) :: PNUR ! Second shape parameter of the rain
+ ! size distribution (generalized gamma law)
+REAL, INTENT(IN) :: PESR ! Efficiency of the aggregates collecting rain
+REAL, INTENT(IN) :: PEXMASSS ! Mass exponent of the aggregates
+REAL, INTENT(IN) :: PFALLS ! Fall speed constant of the aggregates
+REAL, INTENT(IN) :: PEXFALLS ! Fall speed exponent of the aggregates
+REAL, INTENT(IN) :: PFALLR ! Fall speed constant of rain
+REAL, INTENT(IN) :: PEXFALLR ! Fall speed exponent of rain
+REAL, INTENT(IN) :: PLBDASMAX ! Maximun slope of size distribution of the aggregates
+REAL, INTENT(IN) :: PLBDARMAX ! Maximun slope of size distribution of rain
+REAL, INTENT(IN) :: PLBDASMIN ! Minimun slope of size distribution of the aggregates
+REAL, INTENT(IN) :: PLBDARMIN ! Minimun slope of size distribution of rain
+REAL, INTENT(IN) :: PDINFTY ! Factor to define the largest diameter up to
+ ! which the diameter integration is performed
+REAL, INTENT(IN) :: PAG, PBS, PAS
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PRSCOLRG! Scaled fall speed difference in
+ ! the mass collection kernel as a
+ ! function of LAMBDAX and LAMBDAZ
+!
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+!
+INTEGER :: JLBDAS ! Slope index of the size distribution of the aggregates
+INTEGER :: JLBDAR ! Slope index of the size distribution of rain
+INTEGER :: JDS ! Diameter index of a particle of the aggregates
+INTEGER :: JDR ! Diameter index of a particle of rain
+!
+INTEGER :: INR ! Number of diameter step for the partial integration
+!
+REAL :: ZLBDAS ! Current slope parameter LAMBDA of the aggregates
+REAL :: ZLBDAR ! Current slope parameter LAMBDA of rain
+REAL :: ZDLBDAS ! Growth rate of the slope parameter LAMBDA of the aggregates
+REAL :: ZDLBDAR ! Growth rate of the slope parameter LAMBDA of rain
+REAL :: ZDDS ! Integration step of the diameter of the aggregates
+REAL :: ZDDSCALR! Integration step of the diameter of rain (scaling integral)
+REAL :: ZDDCOLLR! Integration step of the diameter of rain (fallspe integral)
+REAL :: ZDS ! Current diameter of the particle aggregates
+REAL :: ZDR ! Current diameter of the raindrops
+REAL :: ZDRMIN ! Minimal diameter of the raindrops where the integration starts
+REAL :: ZDRMAX ! Maximal diameter of the raindrops where the integration ends
+REAL :: ZCOLLR ! Single integral of the mass weighted fall speed difference
+ ! over the spectrum of rain
+REAL :: ZCOLLDRMIN ! Minimum ending point for the partial integral
+REAL :: ZCOLLSR ! Double integral of the mass weighted fall speed difference
+ ! over the spectra of the aggregates and rain
+REAL :: ZSCALR ! Single integral of the scaling factor over
+ ! the spectrum of rain
+REAL :: ZSCALSR ! Double integral of the scaling factor over
+ ! the spectra of the aggregates and rain
+REAL :: ZFUNC ! Ancillary function
+REAL :: ZCST1
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 1 COMPUTE THE SCALED VELOCITY DIFFERENCE IN THE MASS
+!* COLLECTION KERNEL,
+! -------------------------------------------------
+!
+!
+!* 1.0 Initialization
+!
+PRSCOLRG(:,:) = 0.0
+ZCST1 = (3.0/XPI)/XRHOLW
+!
+!* 1.1 Compute the growth rate of the slope factors LAMBDA
+!
+ZDLBDAR = EXP( LOG(PLBDARMAX/PLBDARMIN)/REAL(SIZE(PRSCOLRG(:,:),1)-1) )
+ZDLBDAS = EXP( LOG(PLBDASMAX/PLBDASMIN)/REAL(SIZE(PRSCOLRG(:,:),2)-1) )
+!
+!* 1.2 Scan the slope factors LAMBDAX and LAMBDAZ
+!
+DO JLBDAR = 1,SIZE(PRSCOLRG(:,:),1)
+ ZLBDAR = PLBDARMIN * ZDLBDAR ** (JLBDAR-1)
+ ZDRMAX = PDINFTY / ZLBDAR
+!
+!* 1.3 Compute the diameter steps
+!
+ ZDDSCALR = PDINFTY / (REAL(KND) * ZLBDAR)
+ DO JLBDAS = 1,SIZE(PRSCOLRG(:,:),2)
+ ZLBDAS = PLBDASMIN * ZDLBDAS ** (JLBDAS-1)
+!
+!* 1.4 Initialize the collection integrals
+!
+ ZSCALSR = 0.0
+ ZCOLLSR = 0.0
+!
+!* 1.5 Compute the diameter steps
+!
+ ZDDS = PDINFTY / (REAL(KND) * ZLBDAS)
+!
+!* 1.6 Scan over the diameters DS and DR
+!
+ DO JDS = 1,KND-1
+ ZDS = ZDDS * REAL(JDS)
+ ZSCALR = 0.0
+ ZCOLLR = 0.0
+ DO JDR = 1,KND-1
+ ZDR = ZDDSCALR * REAL(JDR)
+!
+!* 1.7 Compute the normalization factor by integration over the
+! dimensional spectrum of rain
+!
+ ZSCALR = ZSCALR + (ZDS+ZDR)**2 * GENERAL_GAMMA(PALPHAR,PNUR,ZLBDAR,ZDR)
+ END DO
+!
+!* 1.8 Compute the scaled fall speed difference by partial
+! integration over the dimensional spectrum of rain
+!
+ ZFUNC = PAG - PAS*ZDS**(PBS-3.0) ! approximate limit is Ds=240 microns
+ IF( ZFUNC>0.0 ) THEN
+ ZDRMIN = ZDS*( ZCST1*ZFUNC )**0.3333333
+ ELSE
+ ZDRMIN = 0.0
+ END IF
+ IF( ZDS>1.0E-4 ) THEN ! allow computation if Ds>100 microns
+ ! corresponding to a maximal density of the aggregates of XRHOLW
+ IF( (ZDRMAX-ZDRMIN) >= 0.5*ZDDSCALR ) THEN
+ INR = CEILING( (ZDRMAX-ZDRMIN)/ZDDSCALR )
+ ZDDCOLLR = (ZDRMAX-ZDRMIN) / REAL(INR)
+ DO JDR = 1,INR-1
+ ZDR = ZDDCOLLR * REAL(JDR) + ZDRMIN
+ ZCOLLR = ZCOLLR + (ZDS+ZDR)**2 &
+ * GENERAL_GAMMA(PALPHAR,PNUR,ZLBDAR,ZDR) &
+ * PESR * ABS(PFALLS*ZDS**PEXFALLS-PFALLR*ZDR**PEXFALLR)
+ END DO
+ IF( ZDRMIN>0.0 ) THEN
+ ZCOLLDRMIN = (ZDS+ZDRMIN)**2 &
+ * GENERAL_GAMMA(PALPHAR,PNUR,ZLBDAR,ZDRMIN) &
+ * PESR * ABS(PFALLS*ZDS**PEXFALLS-PFALLR*ZDRMIN**PEXFALLR)
+ ELSE
+ ZCOLLDRMIN = 0.0
+ END IF
+ ZCOLLR = (ZCOLLR + 0.5*ZCOLLDRMIN)*(ZDDCOLLR/ZDDSCALR)
+!
+!* 1.9 Compute the normalization factor by integration over the
+! dimensional spectrum of the aggregates
+!
+ ZFUNC = (ZDS**PEXMASSS) * GENERAL_GAMMA(PALPHAS,PZNUS,ZLBDAS,ZDS)
+ ZSCALSR = ZSCALSR + ZSCALR * ZFUNC
+!
+!* 1.10 Compute the scaled fall speed difference by integration over
+! the dimensional spectrum of the aggregates
+!
+ ZCOLLSR = ZCOLLSR + ZCOLLR * ZFUNC
+!
+! Otherwise ZDRMIN>ZDRMAX so PRRCOLSS(JLBDAS,JLBDAR) = 0.0 !
+!
+ END IF
+!
+! Otherwise ZDRMAX = 0.0 so the density of the graupel cannot be reached
+! and so PRRCOLSS(JLBDAS,JLBDAR) = 0.0 !
+!
+ END IF
+ END DO
+!
+!* 1.10 Scale the fall speed difference
+!
+ IF( ZSCALSR>0.0 ) PRSCOLRG(JLBDAR,JLBDAS) = ZCOLLSR / ZSCALSR
+ END DO
+END DO
+!
+END SUBROUTINE RSCOLRG
diff --git a/src/mesonh/micro/rzcolx.f90 b/src/mesonh/micro/rzcolx.f90
new file mode 100644
index 000000000..28658241c
--- /dev/null
+++ b/src/mesonh/micro/rzcolx.f90
@@ -0,0 +1,271 @@
+!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ##################
+ MODULE MODI_RZCOLX
+! ##################
+!
+INTERFACE
+!
+ SUBROUTINE RZCOLX( KND, PALPHAX, PNUX, PALPHAZ, PNUZ, &
+ PEXZ, PEXMASSZ, PFALLX, PEXFALLX, PFALLZ, PEXFALLZ, &
+ PLBDAXMAX, PLBDAZMAX, PLBDAXMIN, PLBDAZMIN, &
+ PDINFTY, PRZCOLX )
+!
+INTEGER, INTENT(IN) :: KND ! Number of discrete size intervals in DX and DZ
+!
+!
+REAL, INTENT(IN) :: PALPHAX ! First shape parameter of the specy X
+ ! size distribution (generalized gamma law)
+REAL, INTENT(IN) :: PNUX ! Second shape parameter of the specy X
+ ! size distribution (generalized gamma law)
+REAL, INTENT(IN) :: PALPHAZ ! First shape parameter of the specy Z
+ ! size distribution (generalized gamma law)
+REAL, INTENT(IN) :: PNUZ ! Second shape parameter of the specy Z
+ ! size distribution (generalized gamma law)
+REAL, INTENT(IN) :: PEXZ ! Efficiency of specy X collecting specy Z
+REAL, INTENT(IN) :: PEXMASSZ ! Mass exponent of specy Z
+REAL, INTENT(IN) :: PFALLX ! Fall speed constant of specy X
+REAL, INTENT(IN) :: PEXFALLX ! Fall speed exponent of specy X
+REAL, INTENT(IN) :: PFALLZ ! Fall speed constant of specy Z
+REAL, INTENT(IN) :: PEXFALLZ ! Fall speed exponent of specy Z
+REAL, INTENT(IN) :: PLBDAXMAX ! Maximun slope of size distribution of specy X
+REAL, INTENT(IN) :: PLBDAZMAX ! Maximun slope of size distribution of specy Z
+REAL, INTENT(IN) :: PLBDAXMIN ! Minimun slope of size distribution of specy X
+REAL, INTENT(IN) :: PLBDAZMIN ! Minimun slope of size distribution of specy Z
+REAL, INTENT(IN) :: PDINFTY ! Factor to define the largest diameter up to
+ ! which the diameter integration is performed
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PRZCOLX ! Scaled fall speed difference in
+ ! the mass collection kernel as a
+ ! function of LAMBDAX and LAMBDAZ
+!
+ END SUBROUTINE RZCOLX
+!
+END INTERFACE
+!
+ END MODULE MODI_RZCOLX
+! ########################################################################
+ SUBROUTINE RZCOLX( KND, PALPHAX, PNUX, PALPHAZ, PNUZ, &
+ PEXZ, PEXMASSZ, PFALLX, PEXFALLX, PFALLZ, PEXFALLZ, &
+ PLBDAXMAX, PLBDAZMAX, PLBDAXMIN, PLBDAZMIN, &
+ PDINFTY, PRZCOLX )
+! ########################################################################
+!
+!
+!
+!!**** * - Build up a look-up table containing the scaled fall speed
+!! difference between size distributed particles of specy X and Z
+!!
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to integrate numerically the scaled fall
+!! speed difference between specy X and specy Z for use in collection
+!! kernels. A first integral of the form
+!!
+!! infty
+!! / /
+!! |{| }
+!! |{| E_xz (Dx+Dz)^2 |cxDx^dx-czDz^dz| Dz^bz g(Dz) dDz} g(Dx) dDx
+!! |{| }
+!! / /
+!! 0
+!!
+!! is evaluated and normalised by a second integral of the form
+!!
+!! infty
+!! / /
+!! |{| }
+!! |{| (Dx+Dz)^2 Dz^bz g(Dz) dDz} g(Dx) dDx
+!! |{| }
+!! / /
+!! 0
+!!
+!! where E_xz is a collection efficiency, g(D) is the generalized Gamma
+!! distribution law. The 'infty' diameter is defined according to the
+!! current value of the Lbda that is D_x=PDINFTY/Lbda_x or
+!! D_z=PINFTY/Lbda_z.
+!! The result is stored in a two-dimensional array.
+!!
+!!** METHOD
+!! ------
+!! The free parameters of the size distribution function of specy X and Z
+!! (slope parameter LAMBDA) are discretized with a geometrical rate in a
+!! specific range
+!! LAMBDA = exp( (Log(LAMBDA_max) - Log(LAMBDA_min))/N_interval )
+!! The two above integrals are performed using the trapezoidal scheme and
+!! the [0,infty] interval is discretized over KND values of D_x or D_z.
+!!
+!! EXTERNAL
+!! --------
+!! MODI_GENERAL_GAMMA: Generalized gamma distribution law
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!! B.S. Ferrier , 1994 : A Double-Moment Multiple-Phase Four-Class
+!! Bulk Ice Scheme,JAS,51,249-280.
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * Laboratoire d'Aerologie *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 8/11/95
+!!
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODI_GENERAL_GAMMA
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 Declarations of dummy arguments
+! -------------------------------
+!
+!
+INTEGER, INTENT(IN) :: KND ! Number of discrete size intervals in DX and DZ
+!
+!
+REAL, INTENT(IN) :: PALPHAX ! First shape parameter of the specy X
+ ! size distribution (generalized gamma law)
+REAL, INTENT(IN) :: PNUX ! Second shape parameter of the specy X
+ ! size distribution (generalized gamma law)
+REAL, INTENT(IN) :: PALPHAZ ! First shape parameter of the specy Z
+ ! size distribution (generalized gamma law)
+REAL, INTENT(IN) :: PNUZ ! Second shape parameter of the specy Z
+ ! size distribution (generalized gamma law)
+REAL, INTENT(IN) :: PEXZ ! Efficiency of specy X collecting specy Z
+REAL, INTENT(IN) :: PEXMASSZ ! Mass exponent of specy Z
+REAL, INTENT(IN) :: PFALLX ! Fall speed constant of specy X
+REAL, INTENT(IN) :: PEXFALLX ! Fall speed exponent of specy X
+REAL, INTENT(IN) :: PFALLZ ! Fall speed constant of specy Z
+REAL, INTENT(IN) :: PEXFALLZ ! Fall speed exponent of specy Z
+REAL, INTENT(IN) :: PLBDAXMAX ! Maximun slope of size distribution of specy X
+REAL, INTENT(IN) :: PLBDAZMAX ! Maximun slope of size distribution of specy Z
+REAL, INTENT(IN) :: PLBDAXMIN ! Minimun slope of size distribution of specy X
+REAL, INTENT(IN) :: PLBDAZMIN ! Minimun slope of size distribution of specy Z
+REAL, INTENT(IN) :: PDINFTY ! Factor to define the largest diameter up to
+ ! which the diameter integration is performed
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PRZCOLX ! Scaled fall speed difference in
+ ! the mass collection kernel as a
+ ! function of LAMBDAX and LAMBDAZ
+!
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+!
+INTEGER :: JLBDAX ! Slope index of the size distribution of specy X
+INTEGER :: JLBDAZ ! Slope index of the size distribution of specy Z
+INTEGER :: JDX ! Diameter index of a particle of specy X
+INTEGER :: JDZ ! Diameter index of a particle of specy Z
+!
+!
+REAL :: ZLBDAX ! Current slope parameter LAMBDA of specy X
+REAL :: ZLBDAZ ! Current slope parameter LAMBDA of specy Z
+REAL :: ZDLBDAX ! Growth rate of the slope parameter LAMBDA of specy X
+REAL :: ZDLBDAZ ! Growth rate of the slope parameter LAMBDA of specy Z
+REAL :: ZDDX ! Integration step of the diameter of specy X
+REAL :: ZDDZ ! Integration step of the diameter of specy Z
+REAL :: ZDX ! Current diameter of the particle specy X
+REAL :: ZDZ ! Current diameter of the particle specy Z
+REAL :: ZCOLLZ ! Single integral of the mass weighted fall speed difference
+ ! over the spectrum of specy Z
+REAL :: ZCOLLXZ ! Double integral of the mass weighted fall speed difference
+ ! over the spectra of specy X and specy Z
+REAL :: ZSCALZ ! Single integral of the scaling factor over
+ ! the spectrum of specy Z
+REAL :: ZSCALXZ ! Double integral of the scaling factor over
+ ! the spectra of specy X and specy Z
+REAL :: ZFUNC ! Ancillary function
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 1 COMPUTE THE SCALED VELOCITZ DIFFERENCE IN THE MASS
+!* COLLECTION KERNEL,
+! -------------------------------------------------
+!
+!
+!
+!* 1.1 Compute the growth rate of the slope factors LAMBDA
+!
+ZDLBDAX = EXP( LOG(PLBDAXMAX/PLBDAXMIN)/REAL(SIZE(PRZCOLX(:,:),1)-1) )
+ZDLBDAZ = EXP( LOG(PLBDAZMAX/PLBDAZMIN)/REAL(SIZE(PRZCOLX(:,:),2)-1) )
+!
+!* 1.2 Scan the slope factors LAMBDAX and LAMBDAZ
+!
+DO JLBDAX = 1,SIZE(PRZCOLX(:,:),1)
+ ZLBDAX = PLBDAXMIN * ZDLBDAX ** (JLBDAX-1)
+ DO JLBDAZ = 1,SIZE(PRZCOLX(:,:),2)
+ ZLBDAZ = PLBDAZMIN * ZDLBDAZ ** (JLBDAZ-1)
+!
+!* 1.3 Initialize the collection integrals
+!
+ ZSCALXZ = 0.0
+ ZCOLLXZ = 0.0
+!
+!* 1.4 Compute the diameter steps
+!
+ ZDDX = PDINFTY / (REAL(KND) * ZLBDAX)
+ ZDDZ = PDINFTY / (REAL(KND) * ZLBDAZ)
+!
+!* 1.5 Scan over the diameters DX and DZ
+!
+ DO JDX = 1,KND-1
+ ZDX = ZDDX * REAL(JDX)
+!
+ ZSCALZ = 0.0
+ ZCOLLZ = 0.0
+ DO JDZ = 1,KND-1
+ ZDZ = ZDDZ * REAL(JDZ)
+!
+!* 1.6 Compute the normalization factor by integration over the
+! dimensional spectrum of specy Z
+!
+ ZFUNC = (ZDX+ZDZ)**2 * ZDZ**PEXMASSZ &
+ * GENERAL_GAMMA(PALPHAZ,PNUZ,ZLBDAZ,ZDZ)
+ ZSCALZ = ZSCALZ + ZFUNC
+!
+!* 1.7 Compute the scaled fall speed difference by integration over
+! the dimensional spectrum of specy Z
+!
+ ZCOLLZ = ZCOLLZ + ZFUNC &
+ * PEXZ * ABS(PFALLX*ZDX**PEXFALLX-PFALLZ*ZDZ**PEXFALLZ)
+ END DO
+!
+!* 1.8 Compute the normalization factor by integration over the
+! dimensional spectrum of specy X
+!
+ ZFUNC = GENERAL_GAMMA(PALPHAX,PNUX,ZLBDAX,ZDX)
+ ZSCALXZ = ZSCALXZ + ZSCALZ * ZFUNC
+!
+!* 1.9 Compute the scaled fall speed difference by integration over
+! the dimensional spectrum of specy X
+!
+ ZCOLLXZ = ZCOLLXZ + ZCOLLZ * ZFUNC
+ END DO
+!
+!* 1.10 Scale the fall speed difference
+!
+ PRZCOLX(JLBDAX,JLBDAZ) = ZCOLLXZ / ZSCALXZ
+ END DO
+END DO
+!
+END SUBROUTINE RZCOLX
diff --git a/src/mesonh/micro/set_conc_lima.f90 b/src/mesonh/micro/set_conc_lima.f90
new file mode 100644
index 000000000..3eeda7f5a
--- /dev/null
+++ b/src/mesonh/micro/set_conc_lima.f90
@@ -0,0 +1,200 @@
+!MNH_LIC Copyright 2000-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!#######################################
+module mode_set_conc_lima
+!#######################################
+
+implicit none
+
+contains
+
+! ###########################################################################
+ SUBROUTINE SET_CONC_LIMA( kmi, HGETCLOUD, PRHODREF, PRT, PSVT )
+! ###########################################################################
+!
+!!**** *SET_CONC_LIMA * - initialize droplet, raindrop and ice
+!! concentration for a RESTArt simulation of the LIMA scheme
+!!
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to initialize cloud droplet and rain drop
+!! concentrations when the cloud droplet and rain drop mixing ratios are
+!! only available (generally from a previous run using the Kessler scheme).
+!! This routine is used to initialize the droplet/drop concentrations
+!! using the r_c and r_r of a previous REVE or KESS run but also to compute
+!! the LB tendencies in ONE_WAY$n in case of grid-nesting when the optional
+!! argument PTIME is set (a LIMA run embedded in a KESS or REVE run).
+!!
+!!** METHOD
+!! ------
+!! The method assumes a Csk law for the activation of aerososl with "s"
+!! the supersaturation (here 0.05 % is chosen). A Marshall-Palmer law with
+!! N_o=10**(-7) m**(-4) is assumed for the rain drop concentration.
+!! The initialization of the PSVT is straightforward for the cloud droplets
+!! while N_r=N_0/Lambda_r with Rho*r_r=Pi*Rho_w*N_0/(Lambda_r**4) is used for
+!! the rain drops. The HGETCLOUD test is used to discriminate between the
+!! 'REVE' and 'KESS' options for CCLOUD in the previous run (from which
+!! PRT was calculated).
+!!
+!! EXTERNAL
+!! --------
+!! None
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_RAIN_C2R2_DESCR, ONLY : XRTMIN, XCTMIN
+!! Module MODD_RAIN_C2R2_KHKO_PARAM, ONLY : XCONCC_INI, XCONCR_PARAM_INI
+!! Module MODD_CONF, ONLY : NVERB
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation ( routine SET_CONC_RAIN_C2R2 )
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! P. Jabouille * CNRM/GMME *
+!! B. Vié * CNRM/GMME *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 15/11/00
+!! 2014 G.Delautier : remplace MODD_RAIN_C2R2_PARAM par MODD_RAIN_C2R2_KHKO_PARAM *
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! B. Vié 03/03/2020: secure physical tests
+! P. Wautelet 04/06/2020: correct array start for microphys. concentrations + add kmi dummy argument
+! (this subroutine is also called for other models)
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, LCOLD, LWARM, LRAIN, NMOD_CCN, NMOD_IFN
+USE MODD_PARAM_LIMA_COLD, ONLY : XAI, XBI
+USE MODD_NSV, ONLY : NSV_LIMA_BEG_A, NSV_LIMA_NC_A, NSV_LIMA_NR_A, NSV_LIMA_CCN_ACTI_A, &
+ NSV_LIMA_NI_A, NSV_LIMA_IFN_NUCL_A
+USE MODD_CST, ONLY : XPI, XRHOLW, XRHOLI
+USE MODD_CONF, ONLY : NVERB
+USE MODD_CONF_n, ONLY : NRR
+USE MODD_LUNIT_n, ONLY : TLUOUT
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+integer, intent(in) :: kmi ! Model number
+CHARACTER (LEN=4), INTENT(IN) :: HGETCLOUD ! Get indicator
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
+!
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRT ! microphysical mixing ratios
+!
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG_A(kmi):), INTENT(INOUT):: PSVT ! microphys. concentrations
+!
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IRESP ! Return code of FM routines
+INTEGER :: ILUOUT ! Logical unit number of output-listing
+REAL :: ZCONCC, ZCONCR, ZCONCI
+!
+!-------------------------------------------------------------------------------
+!* 1. RETRIEVE LOGICAL UNIT NUMBER
+! ----------------------------
+!
+ILUOUT = TLUOUT%NLU
+!
+!* 2. INITIALIZATION
+! --------------
+!
+IF (LWARM .AND. NRR.GE.2) THEN
+!
+! droplets
+!
+ ZCONCC = 300.E6 ! droplet concentration set at 300 cm-3
+ WHERE ( PRT(:,:,:,2) > 1.E-11 )
+ PSVT(:,:,:,NSV_LIMA_NC_A(kmi)) = ZCONCC
+ END WHERE
+ WHERE ( PRT(:,:,:,2) <= 1.E-11 )
+ PRT(:,:,:,2) = 0.0
+ PSVT(:,:,:,NSV_LIMA_NC_A(kmi)) = 0.0
+ END WHERE
+
+ IF (NMOD_CCN .GE. 1) THEN
+ WHERE ( PRT(:,:,:,2) > 1.E-11 )
+ PSVT(:,:,:,NSV_LIMA_CCN_ACTI_A(kmi)) = ZCONCC
+ END WHERE
+ WHERE ( PRT(:,:,:,2) <= 1.E-11 )
+ PSVT(:,:,:,NSV_LIMA_CCN_ACTI_A(kmi)) = 0.0
+ END WHERE
+ END IF
+
+ IF( NVERB >= 5 ) THEN
+ WRITE (UNIT=ILUOUT,FMT=*) "!INI_MODEL$n: The droplet concentration has "
+ WRITE (UNIT=ILUOUT,FMT=*) "been roughly initialised"
+ END IF
+END IF
+!
+IF (LWARM .AND. LRAIN .AND. NRR.GE.3) THEN
+!
+! drops
+!
+ ZCONCR = (1.E7)**3/(XPI*XRHOLW) ! cf XCONCR_PARAM_INI in ini_rain_c2r2.f90
+ IF (HGETCLOUD == 'INI1') THEN ! init from REVE scheme
+ PSVT(:,:,:,NSV_LIMA_NR_A(kmi)) = 0.0
+ ELSE ! init from KESS, ICE3...
+ WHERE ( PRT(:,:,:,3) > 1.E-11 )
+ PSVT(:,:,:,NSV_LIMA_NR_A(kmi)) = MAX( SQRT(SQRT(PRHODREF(:,:,:)*PRT(:,:,:,3) &
+ *ZCONCR)),1. )
+ END WHERE
+ WHERE ( PRT(:,:,:,3) <= 1.E-11 )
+ PRT(:,:,:,3) = 0.0
+ PSVT(:,:,:,NSV_LIMA_NR_A(kmi)) = 0.0
+ END WHERE
+ IF( NVERB >= 5 ) THEN
+ WRITE (UNIT=ILUOUT,FMT=*) "!INI_MODEL$n: The raindrop concentration has "
+ WRITE (UNIT=ILUOUT,FMT=*) "been roughly initialised"
+ END IF
+ END IF
+END IF
+!
+IF (LCOLD .AND. NRR.GE.4) THEN
+!
+! ice crystals
+!
+ ZCONCI = 100.E3 ! maximum ice concentration set at 100/L
+ WHERE ( PRT(:,:,:,4) > 1.E-11 )
+!
+! PSVT(:,:,:,NSV_LIMA_NI_A(kmi)) = MIN( PRHODREF(:,:,:) / &
+! ( XRHOLI * XAI*(10.E-06)**XBI * PRT(:,:,:,4) ), &
+! ZCONCI )
+! Correction
+ PSVT(:,:,:,NSV_LIMA_NI_A(kmi)) = MIN(PRT(:,:,:,4)/(0.82*(10.E-06)**2.5),ZCONCI )
+ END WHERE
+ WHERE ( PRT(:,:,:,4) <= 1.E-11 )
+ PRT(:,:,:,4) = 0.0
+ PSVT(:,:,:,NSV_LIMA_NI_A(kmi)) = 0.0
+ END WHERE
+
+ IF (NMOD_IFN .GE. 1) THEN
+ WHERE ( PRT(:,:,:,4) > 1.E-11 )
+ PSVT(:,:,:,NSV_LIMA_IFN_NUCL_A(kmi)) = PSVT(:,:,:,NSV_LIMA_NI_A(kmi))
+ END WHERE
+ WHERE ( PRT(:,:,:,4) <= 1.E-11 )
+ PSVT(:,:,:,NSV_LIMA_IFN_NUCL_A(kmi)) = 0.0
+ END WHERE
+ END IF
+
+ IF( NVERB >= 5 ) THEN
+ WRITE (UNIT=ILUOUT,FMT=*) "!INI_MODEL$n: The cloud ice concentration has "
+ WRITE (UNIT=ILUOUT,FMT=*) "been roughly initialised"
+ END IF
+!
+END IF
+!
+END SUBROUTINE SET_CONC_LIMA
+
+end module mode_set_conc_lima
diff --git a/src/mesonh/turb/bl89.f90 b/src/mesonh/turb/bl89.f90
new file mode 100644
index 000000000..8d9fe3e36
--- /dev/null
+++ b/src/mesonh/turb/bl89.f90
@@ -0,0 +1,396 @@
+!MNH_LIC Copyright 1997-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ################
+ MODULE MODI_BL89
+! ################
+INTERFACE
+ SUBROUTINE BL89(KKA,KKU,KKL,PZZ,PDZZ,PTHVREF,PTHLM,KRR,PRM,PTKEM,PSHEAR,PLM)
+!
+INTEGER, INTENT(IN) :: KKA
+INTEGER, INTENT(IN) :: KKU
+INTEGER, INTENT(IN) :: KKL
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM
+INTEGER, INTENT(IN) :: KRR
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSHEAR
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLM
+
+END SUBROUTINE BL89
+END INTERFACE
+END MODULE MODI_BL89
+!
+! #########################################################
+ SUBROUTINE BL89(KKA,KKU,KKL,PZZ,PDZZ,PTHVREF,PTHLM,KRR,PRM,PTKEM,PSHEAR,PLM)
+! #########################################################
+!
+!!**** *BL89* -
+!!
+!! PURPOSE
+!! -------
+!! This routine computes the mixing length from Bougeault-Lacarrere 89
+!! formula.
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Book 2
+!!
+!! AUTHOR
+!! ------
+!!
+!! J. Cuxart INM and Meteo-France
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 27/04/97 (V. Masson) separation from turb.f90
+!! and optimization
+!! 06/01/98 (V. Masson and P. Jabouille) optimization
+!! 15/03/99 (V. Masson) new lup ldown averaging
+!! 21/02/01 (P. Jabouille) improve vectorization
+!! 2012-02 (Y. Seity) add possibility to run with
+!! reversed vertical levels
+!! Philippe 13/02/2018: use ifdef MNH_REAL to prevent problems with intrinsics on Blue Gene/Q
+!! 01/2019 (Q. Rodier) support for RM17 mixing length
+!! 03/2021 (JL Redelsperger) Ocean model case
+!! 06/2021 (P. Marquet) correction of exponent on final length according to Lemarié et al. 2021
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CONF, ONLY: CPROGRAM
+USE MODD_CST
+USE MODD_CTURB
+USE MODD_DYN_n, ONLY: LOCEAN
+USE MODD_PARAMETERS
+use modd_precision, only: MNHREAL
+!
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of arguments
+! ------------------------
+!
+INTEGER, INTENT(IN) :: KKA !near ground array index
+INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM ! conservative pot. temp.
+INTEGER, INTENT(IN) :: KRR
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! water var.
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSHEAR
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLM ! Mixing length
+! thermodynamical variables PTHLM=Theta at the begining
+!
+!* 0.2 Declaration of local variables
+! ------------------------------
+!
+INTEGER :: IKB,IKE
+INTEGER :: IKT ! array size in k direction
+INTEGER :: IKTB,IKTE ! start, end of k loops in physical domain
+
+REAL, DIMENSION(SIZE(PTKEM,1)*SIZE(PTKEM,2),SIZE(PTKEM,3)) :: ZVPT ! Virtual Potential Temp at half levels
+REAL, DIMENSION(SIZE(PTKEM,1)*SIZE(PTKEM,2),SIZE(PTKEM,3)) :: ZDELTVPT
+ ! Increment of Virtual Potential Temp between two following levels
+REAL, DIMENSION(SIZE(PTKEM,1)*SIZE(PTKEM,2),SIZE(PTKEM,3)) :: ZHLVPT
+ ! Virtual Potential Temp at half levels
+REAL, DIMENSION(SIZE(PTKEM,1)*SIZE(PTKEM,2)) :: ZLWORK,ZINTE
+! ! downwards then upwards vertical displacement,
+! ! residual internal energy,
+! ! residual potential energy
+REAL, DIMENSION(SIZE(PTKEM,1)*SIZE(PTKEM,2),SIZE(PTKEM,3)) :: ZZZ,ZDZZ, &
+ ZG_O_THVREF, &
+ ZTHM,ZTKEM,ZLM, &
+ ZLMDN,ZSHEAR, &
+ ZSQRT_TKE
+! ! input and output arrays packed according one horizontal coord.
+REAL, DIMENSION(SIZE(PRM,1)*SIZE(PRM,2),SIZE(PRM,3),SIZE(PRM,4)) :: ZRM
+! ! input array packed according one horizontal coord.
+REAL, DIMENSION(SIZE(PRM,1)*SIZE(PRM,2),SIZE(PRM,3)) :: ZSUM ! to replace SUM function
+!
+INTEGER :: IIU,IJU
+INTEGER :: J1D ! horizontal loop counter
+INTEGER :: JK,JKK,J3RD ! loop counters
+INTEGER :: JRR ! moist loop counter
+REAL :: ZRVORD ! Rv/Rd
+REAL :: ZPOTE,ZLWORK1,ZLWORK2
+REAL :: ZTEST,ZTEST0,ZTESTM ! test for vectorization
+REAL :: Z2SQRT2,ZUSRBL89,ZBL89EXP
+!-------------------------------------------------------------------------------
+!
+Z2SQRT2=2.*SQRT(2.)
+IIU=SIZE(PTKEM,1)
+IJU=SIZE(PTKEM,2)
+!
+IKB=KKA+JPVEXT_TURB*KKL
+IKE=KKU-JPVEXT_TURB*KKL
+
+IKTB = JPVEXT_TURB + 1
+IKT = SIZE(PTKEM,3)
+IKTE = IKT-JPVEXT_TURB
+ZRVORD = XRV / XRD
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. pack the horizontal dimensions into one
+! ---------------------------------------
+!
+IF (CPROGRAM=='AROME ') THEN
+ DO JK=1,IKT
+ ZZZ (:,JK) = PZZ (:,1,JK)
+ ZDZZ (:,JK) = PDZZ (:,1,JK)
+ ZTHM (:,JK) = PTHLM (:,1,JK)
+ ZTKEM (:,JK) = PTKEM (:,1,JK)
+ ZG_O_THVREF(:,JK) = XG/PTHVREF(:,1,JK)
+ END DO
+ DO JK=1,IKT
+ DO JRR=1,KRR
+ ZRM (:,JK,JRR) = PRM (:,1,JK,JRR)
+ END DO
+ END DO
+ELSE
+ DO JK=1,IKT
+ ZZZ (:,JK) = RESHAPE(PZZ (:,:,JK),(/ IIU*IJU /) )
+ ZDZZ (:,JK) = RESHAPE(PDZZ (:,:,JK),(/ IIU*IJU /) )
+ ZTHM (:,JK) = RESHAPE(PTHLM (:,:,JK),(/ IIU*IJU /) )
+ ZSHEAR (:,JK) = RESHAPE(PSHEAR (:,:,JK),(/ IIU*IJU /) )
+ ZTKEM (:,JK) = RESHAPE(PTKEM (:,:,JK),(/ IIU*IJU /) )
+ ZG_O_THVREF(:,JK) = RESHAPE(XG/PTHVREF(:,:,JK),(/ IIU*IJU /) )
+ IF (LOCEAN) ZG_O_THVREF(:,JK) = XG * XALPHAOC
+ DO JRR=1,KRR
+ ZRM (:,JK,JRR) = RESHAPE(PRM (:,:,JK,JRR),(/ IIU*IJU /) )
+ END DO
+ END DO
+END IF
+!
+ZSQRT_TKE = SQRT(ZTKEM)
+!
+!ZBL89EXP is defined here because (and not in ini_cturb) because XCED is defined in read_exseg (depending on BL89/RM17)
+ZBL89EXP = LOG(16.)/(4.*LOG(XKARMAN)+LOG(XCED)-3.*LOG(XCMFS))
+ZUSRBL89 = 1./ZBL89EXP
+!-------------------------------------------------------------------------------
+!
+!* 2. Virtual potential temperature on the model grid
+! -----------------------------------------------
+!
+IF(KRR /= 0) THEN
+ ZSUM(:,:) = 0.
+ DO JRR=1,KRR
+ ZSUM(:,:) = ZSUM(:,:)+ZRM(:,:,JRR)
+ ENDDO
+ ZVPT(:,1:)=ZTHM(:,:) * ( 1. + ZRVORD*ZRM(:,:,1) ) &
+ / ( 1. + ZSUM(:,:) )
+ELSE
+ ZVPT(:,1:)=ZTHM(:,:)
+END IF
+!
+!!!!!!!!!!!!
+!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!! WARNING !!
+!!!!!!!!!!!!
+!!!!!!!!!!!!
+!Any modification done to the following lines and to the sections 4 and
+!6 must be copied in compute_bl89_ml routine.
+!We do not call directly this routine for numerical performance reasons
+!but algorithm must remain the same.
+!!!!!!!!!!!!
+
+ZDELTVPT(:,IKTB:IKTE)=ZVPT(:,IKTB:IKTE)-ZVPT(:,IKTB-KKL:IKTE-KKL)
+ZDELTVPT(:,KKU)=ZVPT(:,KKU)-ZVPT(:,KKU-KKL)
+ZDELTVPT(:,KKA)=0.
+WHERE (ABS(ZDELTVPT(:,:))<XLINF)
+ ZDELTVPT(:,:)=XLINF
+END WHERE
+!
+ZHLVPT(:,IKTB:IKTE)= 0.5 * ( ZVPT(:,IKTB:IKTE)+ZVPT(:,IKTB-KKL:IKTE-KKL) )
+ZHLVPT(:,KKU)= 0.5 * ( ZVPT(:,KKU)+ZVPT(:,KKU-KKL) )
+ZHLVPT(:,KKA) = ZVPT(:,KKA)
+!-------------------------------------------------------------------------------
+!
+!* 3. loop on model levels
+! --------------------
+DO JK=IKTB,IKTE
+!
+!-------------------------------------------------------------------------------
+!
+!
+
+!* 4. mixing length for a downwards displacement
+! ------------------------------------------
+ ZINTE(:)=ZTKEM(:,JK)
+ ZLWORK=0.
+ ZTESTM=1.
+ DO JKK=JK,IKB,-KKL
+ IF(ZTESTM > 0.) THEN
+ ZTESTM=0.
+ DO J1D=1,IIU*IJU
+
+ ZTEST0=0.5+SIGN(0.5,ZINTE(J1D))
+
+ !--------- SHEAR + STABILITY -----------
+ ZPOTE = ZTEST0* &
+ (-ZG_O_THVREF(J1D,JK)*(ZHLVPT(J1D,JKK)-ZVPT(J1D,JK)) &
+ + XRM17*ZSHEAR(J1D,JKK)*ZSQRT_TKE(J1D,JK) &
+ )*ZDZZ(J1D,JKK)
+
+ ZTEST =0.5+SIGN(0.5,ZINTE(J1D)-ZPOTE)
+ ZTESTM=ZTESTM+ZTEST0
+ ZLWORK1=ZDZZ(J1D,JKK)
+
+ !-------- ORIGINAL -------------
+! ZLWORK2= ( + ZG_O_THVREF(J1D,JK) * &
+! ( ZVPT(J1D,JKK) - ZVPT(J1D,JK) ) &
+! + SQRT (ABS( &
+! ( ZG_O_THVREF(J1D,JK) * (ZVPT(J1D,JKK) - ZVPT(J1D,JK)) )**2 &
+! + 2. * ZINTE(J1D) * ZG_O_THVREF(J1D,JK) &
+! * ZDELTVPT(J1D,JKK) / ZDZZ(J1D,JKK) ))) / &
+! ( ZG_O_THVREF(J1D,JK) * ZDELTVPT(J1D,JKK) / ZDZZ(J1D,JKK))
+
+
+ !--------- SHEAR + STABILITY -----------
+ ZLWORK2 = (ZG_O_THVREF(J1D,JK) *(ZVPT(J1D,JKK) - ZVPT(J1D,JK)) &
+ -XRM17*ZSHEAR(J1D,JKK)*ZSQRT_TKE(J1D,JK) &
+ + sqrt(abs( (XRM17*ZSHEAR(J1D,JKK)*ZSQRT_TKE(J1D,JK) &
+ + ( -ZG_O_THVREF(J1D,JK) * (ZVPT(J1D,JKK) - ZVPT(J1D,JK)) ))**2.0 + &
+ 2. * ZINTE(J1D) * &
+ (ZG_O_THVREF(J1D,JK) * ZDELTVPT(J1D,JKK)/ ZDZZ(J1D,JKK))))) / &
+ (ZG_O_THVREF(J1D,JK) * ZDELTVPT(J1D,JKK) / ZDZZ(J1D,JKK))
+
+
+ ZLWORK(J1D)=ZLWORK(J1D)+ZTEST0*(ZTEST*ZLWORK1+(1-ZTEST)*ZLWORK2)
+ ZINTE(J1D) = ZINTE(J1D) - ZPOTE
+
+ END DO
+ ENDIF
+ END DO
+!-------------------------------------------------------------------------------
+!
+!* 5. intermediate storage of the final mixing length
+! -----------------------------------------------
+!
+ ZLMDN(:,JK)=MIN(ZLWORK(:),0.5*(ZZZ(:,JK)+ZZZ(:,JK+KKL))-ZZZ(:,IKB))
+!
+!-------------------------------------------------------------------------------
+!
+!* 6. mixing length for an upwards displacement
+! -----------------------------------------
+!
+ ZINTE(:)=ZTKEM(:,JK)
+ ZLWORK=0.
+ ZTESTM=1.
+!
+ DO JKK=JK+KKL,IKE,KKL
+ IF(ZTESTM > 0.) THEN
+ ZTESTM=0.
+ DO J1D=1,IIU*IJU
+ ZTEST0=0.5+SIGN(0.5,ZINTE(J1D))
+
+ !-------- ORIGINAL -------------
+ !ZPOTE = ZTEST0*ZG_O_THVREF(J1D,JK) * &
+ ! (ZHLVPT(J1D,JKK) - ZVPT(J1D,JK) ) *ZDZZ(J1D,JKK)
+
+ !--------- SHEAR + STABILITY -----------
+ ZPOTE = ZTEST0* &
+ (ZG_O_THVREF(J1D,JK)*(ZHLVPT(J1D,JKK)-ZVPT(J1D,JK)) &
+ +XRM17*ZSHEAR(J1D,JKK)*ZSQRT_TKE(J1D,JK) &
+ )*ZDZZ(J1D,JKK)
+
+ ZTEST =0.5+SIGN(0.5,ZINTE(J1D)-ZPOTE)
+ ZTESTM=ZTESTM+ZTEST0
+ ZLWORK1=ZDZZ(J1D,JKK)
+
+ !-------- ORIGINAL -------------
+ ! ZLWORK2= ( - ZG_O_THVREF(J1D,JK) * &
+ ! ( ZVPT(J1D,JKK-KKL) - ZVPT(J1D,JK) ) &
+ ! + SQRT (ABS( &
+ ! ( ZG_O_THVREF(J1D,JK) * (ZVPT(J1D,JKK-KKL) - ZVPT(J1D,JK)) )**2 &
+ ! + 2. * ZINTE(J1D) * ZG_O_THVREF(J1D,JK) &
+ ! * ZDELTVPT(J1D,JKK) / ZDZZ(J1D,JKK) )) ) / &
+ ! ( ZG_O_THVREF(J1D,JK) * ZDELTVPT(J1D,JKK) / ZDZZ(J1D,JKK) )
+
+ !--------- SHEAR + STABILITY -----------
+ ZLWORK2= ( - ZG_O_THVREF(J1D,JK) *(ZVPT(J1D,JKK-KKL) - ZVPT(J1D,JK) ) &
+ - XRM17*ZSHEAR(J1D,JKK)*ZSQRT_TKE(J1D,JK) &
+ + SQRT (ABS( &
+ (XRM17*ZSHEAR(J1D,JKK)*ZSQRT_TKE(J1D,JK) &
+ + ( ZG_O_THVREF(J1D,JK) * (ZVPT(J1D,JKK-KKL) - ZVPT(J1D,JK))) )**2 &
+ + 2. * ZINTE(J1D) * &
+ ( ZG_O_THVREF(J1D,JK)* ZDELTVPT(J1D,JKK)/ZDZZ(J1D,JKK))))) / &
+ (ZG_O_THVREF(J1D,JK) * ZDELTVPT(J1D,JKK) / ZDZZ(J1D,JKK))
+
+
+
+
+ ZLWORK(J1D)=ZLWORK(J1D)+ZTEST0*(ZTEST*ZLWORK1+(1-ZTEST)*ZLWORK2)
+ ZINTE(J1D) = ZINTE(J1D) - ZPOTE
+ END DO
+ ENDIF
+ END DO
+!
+!-------------------------------------------------------------------------------
+!
+!* 7. final mixing length
+!
+ DO J1D=1,IIU*IJU
+ ZLWORK1=MAX(ZLMDN(J1D,JK),1.E-10_MNHREAL)
+ ZLWORK2=MAX(ZLWORK(J1D),1.E-10_MNHREAL)
+ ZPOTE = ZLWORK1 / ZLWORK2
+ ZLWORK2=1.d0 + ZPOTE**ZBL89EXP
+ ZLM(J1D,JK) = ZLWORK1*(2./ZLWORK2)**ZUSRBL89
+ END DO
+
+ZLM(:,JK)=MAX(ZLM(:,JK),XLINI)
+
+!
+!
+!* 8. end of the loop on the vertical levels
+! --------------------------------------
+!
+END DO
+!
+!-------------------------------------------------------------------------------
+!
+!* 9. boundaries
+! ----------
+!
+ZLM(:,KKA)=ZLM(:,IKB)
+ZLM(:,IKE)=ZLM(:,IKE-KKL)
+ZLM(:,KKU)=ZLM(:,IKE-KKL)
+!
+!-------------------------------------------------------------------------------
+!
+!* 10. retrieve output array in model coordinates
+! ------------------------------------------
+!
+IF (CPROGRAM=='AROME ') THEN
+ DO JK=1,IKT
+ PLM (:,1,JK) = ZLM (:,JK)
+ END DO
+ELSE
+ DO JK=1,IKT
+ PLM (:,:,JK) = RESHAPE(ZLM (:,JK), (/ IIU,IJU /) )
+ END DO
+END IF
+
+!
+END SUBROUTINE BL89
diff --git a/src/mesonh/turb/bl_depth_diag.f90 b/src/mesonh/turb/bl_depth_diag.f90
new file mode 100644
index 000000000..2e7fb121c
--- /dev/null
+++ b/src/mesonh/turb/bl_depth_diag.f90
@@ -0,0 +1,200 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 turb 2006/05/18 13:07:25
+!-----------------------------------------------------------------
+! ################
+ MODULE MODI_BL_DEPTH_DIAG
+! ################
+!
+INTERFACE BL_DEPTH_DIAG
+!
+!
+ FUNCTION BL_DEPTH_DIAG_3D(KKB,KKE,PSURF,PZS,PFLUX,PZZ,PFTOP_O_FSURF)
+
+INTEGER, INTENT(IN) :: KKB ! bottom point
+INTEGER, INTENT(IN) :: KKE ! top point
+REAL, DIMENSION(:,:), INTENT(IN) :: PSURF ! surface flux
+REAL, DIMENSION(:,:), INTENT(IN) :: PZS ! orography
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFLUX ! flux
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitude of flux points
+REAL, INTENT(IN) :: PFTOP_O_FSURF! Flux at BL top / Surface flux
+REAL, DIMENSION(SIZE(PSURF,1),SIZE(PSURF,2)) :: BL_DEPTH_DIAG_3D
+!
+END FUNCTION BL_DEPTH_DIAG_3D
+!
+!
+ FUNCTION BL_DEPTH_DIAG_1D(KKB,KKE,PSURF,PZS,PFLUX,PZZ,PFTOP_O_FSURF)
+INTEGER, INTENT(IN) :: KKB ! bottom point
+INTEGER, INTENT(IN) :: KKE ! top point
+REAL, INTENT(IN) :: PSURF ! surface flux
+REAL, INTENT(IN) :: PZS ! orography
+REAL, DIMENSION(:), INTENT(IN) :: PFLUX ! flux
+REAL, DIMENSION(:), INTENT(IN) :: PZZ ! altitude of flux points
+REAL, INTENT(IN) :: PFTOP_O_FSURF! Flux at BL top / Surface flux
+REAL :: BL_DEPTH_DIAG_1D
+!
+END FUNCTION BL_DEPTH_DIAG_1D
+!
+END INTERFACE
+!
+END MODULE MODI_BL_DEPTH_DIAG
+!
+!-------------------------------------------------------------------------------
+!
+! ################
+ MODULE MODI_BL_DEPTH_DIAG_3D
+! ################
+!
+!
+INTERFACE
+!
+!
+ FUNCTION BL_DEPTH_DIAG_3D(KKB,KKE,PSURF,PZS,PFLUX,PZZ,PFTOP_O_FSURF)
+INTEGER, INTENT(IN) :: KKB ! bottom point
+INTEGER, INTENT(IN) :: KKE ! top point
+REAL, DIMENSION(:,:), INTENT(IN) :: PSURF ! surface flux
+REAL, DIMENSION(:,:), INTENT(IN) :: PZS ! orography
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFLUX ! flux
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitude of flux points
+REAL, INTENT(IN) :: PFTOP_O_FSURF! Flux at BL top / Surface flux
+REAL, DIMENSION(SIZE(PSURF,1),SIZE(PSURF,2)) :: BL_DEPTH_DIAG_3D
+!
+END FUNCTION BL_DEPTH_DIAG_3D
+!
+!
+END INTERFACE
+!
+END MODULE MODI_BL_DEPTH_DIAG_3D
+!
+!-------------------------------------------------------------------------------
+!
+FUNCTION BL_DEPTH_DIAG_3D(KKB,KKE,PSURF,PZS,PFLUX,PZZ,PFTOP_O_FSURF)
+!
+!
+!!**** *SBL_DEPTH* - computes SBL depth
+!!
+!! PURPOSE
+!! -------
+!
+!!** METHOD
+!! ------
+!!
+!! SBL is defined as the layer where momentum flux is equal to XSBL_FRAC of its surface value
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! V. Masson * Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original nov. 2005
+!!
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!* 0.1 declarations of arguments
+!
+IMPLICIT NONE
+!
+INTEGER, INTENT(IN) :: KKB ! bottom point
+INTEGER, INTENT(IN) :: KKE ! top point
+REAL, DIMENSION(:,:), INTENT(IN) :: PSURF ! surface flux
+REAL, DIMENSION(:,:), INTENT(IN) :: PZS ! orography
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFLUX ! flux
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitude of flux points
+REAL, INTENT(IN) :: PFTOP_O_FSURF! Flux at BL top / Surface flux
+REAL, DIMENSION(SIZE(PSURF,1),SIZE(PSURF,2)) :: BL_DEPTH_DIAG_3D
+!
+!
+! 0.2 declaration of local variables
+!
+INTEGER :: JI,JJ,JK ! loop counters
+INTEGER :: IKL ! +1 : MesoNH levels -1: Arome
+REAL :: ZFLX ! flux at top of BL
+!
+!----------------------------------------------------------------------------
+!
+IF (KKB < KKE) THEN
+ IKL=1
+ELSE
+ IKL=-1
+ENDIF
+
+BL_DEPTH_DIAG_3D(:,:) = 0.
+!
+
+DO JJ=1,SIZE(PSURF,2)
+ DO JI=1,SIZE(PSURF,1)
+ IF (PSURF(JI,JJ)==0.) CYCLE
+ DO JK=KKB,KKE,IKL
+ IF (PZZ(JI,JJ,JK-IKL)<=PZS(JI,JJ)) CYCLE
+ ZFLX = PSURF(JI,JJ) * PFTOP_O_FSURF
+ IF ( (PFLUX(JI,JJ,JK)-ZFLX)*(PFLUX(JI,JJ,JK-IKL)-ZFLX) <= 0. ) THEN
+ BL_DEPTH_DIAG_3D(JI,JJ) = (PZZ (JI,JJ,JK-IKL) - PZS(JI,JJ)) &
+ + (PZZ (JI,JJ,JK) - PZZ (JI,JJ,JK-IKL)) &
+ * (ZFLX - PFLUX(JI,JJ,JK-IKL) ) &
+ / (PFLUX(JI,JJ,JK) - PFLUX(JI,JJ,JK-IKL) )
+ EXIT
+ END IF
+ END DO
+ END DO
+END DO
+!
+BL_DEPTH_DIAG_3D(:,:) = BL_DEPTH_DIAG_3D(:,:) / (1. - PFTOP_O_FSURF)
+!
+END FUNCTION BL_DEPTH_DIAG_3D
+!
+!
+!-------------------------------------------------------------------------------
+!-------------------------------------------------------------------------------
+!
+FUNCTION BL_DEPTH_DIAG_1D(KKB,KKE,PSURF,PZS,PFLUX,PZZ,PFTOP_O_FSURF)
+!
+USE MODI_BL_DEPTH_DIAG_3D
+IMPLICIT NONE
+!
+INTEGER, INTENT(IN) :: KKB ! bottom point
+INTEGER, INTENT(IN) :: KKE ! top point
+REAL, INTENT(IN) :: PSURF ! surface flux
+REAL, INTENT(IN) :: PZS ! orography
+REAL, DIMENSION(:), INTENT(IN) :: PFLUX ! flux
+REAL, DIMENSION(:), INTENT(IN) :: PZZ ! altitude of flux points
+REAL, INTENT(IN) :: PFTOP_O_FSURF! Flux at BL top / Surface flux
+REAL :: BL_DEPTH_DIAG_1D
+!
+REAL, DIMENSION(1,1) :: ZSURF
+REAL, DIMENSION(1,1) :: ZZS
+REAL, DIMENSION(1,1,SIZE(PFLUX)) :: ZFLUX
+REAL, DIMENSION(1,1,SIZE(PZZ)) :: ZZZ
+REAL, DIMENSION(1,1) :: ZBL_DEPTH_DIAG
+!
+ZSURF = PSURF
+ZZS = PZS
+ZFLUX(1,1,:) = PFLUX(:)
+ZZZ (1,1,:) = PZZ (:)
+!
+ZBL_DEPTH_DIAG = BL_DEPTH_DIAG_3D(KKB,KKE,ZSURF,ZZS,ZFLUX,ZZZ,PFTOP_O_FSURF)
+!
+BL_DEPTH_DIAG_1D = ZBL_DEPTH_DIAG(1,1)
+!
+!-------------------------------------------------------------------------------
+!
+END FUNCTION BL_DEPTH_DIAG_1D
diff --git a/src/mesonh/turb/compute_bl89_ml.f90 b/src/mesonh/turb/compute_bl89_ml.f90
new file mode 100644
index 000000000..20c9a078d
--- /dev/null
+++ b/src/mesonh/turb/compute_bl89_ml.f90
@@ -0,0 +1,250 @@
+!MNH_LIC Copyright 2006-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ###########################
+ MODULE MODI_COMPUTE_BL89_ML
+! ###########################
+
+INTERFACE
+
+! ###################################################################
+ SUBROUTINE COMPUTE_BL89_ML(KKA,KKB,KKE,KKU,KKL,PDZZ2D, &
+ PTKEM_DEP,PG_O_THVREF,PVPT,KK,OUPORDN,OFLUX,PSHEAR,PLWORK)
+! ###################################################################
+
+!* 1.1 Declaration of Arguments
+
+INTEGER, INTENT(IN) :: KKA ! near ground array index
+INTEGER, INTENT(IN) :: KKB ! near ground physical index
+INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
+INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ2D ! height difference between two mass levels
+REAL, DIMENSION(:), INTENT(IN) :: PTKEM_DEP ! TKE to consume
+REAL, DIMENSION(:), INTENT(IN) :: PG_O_THVREF ! g/ThetaVRef at the departure point
+REAL, DIMENSION(:,:), INTENT(IN) :: PVPT ! ThetaV on mass levels
+INTEGER, INTENT(IN) :: KK ! index of departure level
+LOGICAL, INTENT(IN) :: OUPORDN ! switch to compute upward (true) or
+ ! downward (false) mixing length
+LOGICAL, INTENT(IN) :: OFLUX ! Computation must be done from flux level
+REAL, DIMENSION(:), INTENT(OUT) :: PLWORK ! Resulting mixing length
+REAL, DIMENSION(:,:), INTENT(IN) :: PSHEAR ! vertical wind shear for RM17 mixing length
+
+END SUBROUTINE COMPUTE_BL89_ML
+
+END INTERFACE
+!
+END MODULE MODI_COMPUTE_BL89_ML
+! ######spl
+ SUBROUTINE COMPUTE_BL89_ML(KKA,KKB,KKE,KKU,KKL,PDZZ2D, &
+ PTKEM_DEP,PG_O_THVREF,PVPT,KK,OUPORDN,OFLUX,PSHEAR,PLWORK)
+
+! ###################################################################
+!!
+!! COMPUTE_BL89_ML routine to:
+!! 1/ compute upward or downward mixing length with BL89 formulation
+!!
+!! AUTHOR
+!! ------
+!! J. PERGAUD
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 19/01/06
+!! S. Riette Jan 2012: support for both order of vertical levels and cleaning
+!! R.Honnert Oct 2016 : Update with AROME
+!! Q.Rodier 01/2019 : support RM17 mixing length as in bl89.f90
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+! ------------
+!
+!!!!!!!!!!!!
+!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!! WARNING !!
+!!!!!!!!!!!!
+!!!!!!!!!!!!
+!Any modification done to this routine must be copied in bl89.f90.
+!This routine was inlined in bl89 for numerical performance reasons
+!but algorithm must remain the same.
+!!!!!!!!!!!!
+!
+USE MODD_CTURB
+USE MODD_PARAMETERS, ONLY: JPVEXT
+!
+use mode_msg
+!
+USE MODI_SHUMAN_MF
+!
+IMPLICIT NONE
+!
+! 0.1 arguments
+!
+INTEGER, INTENT(IN) :: KKA ! near ground array index
+INTEGER, INTENT(IN) :: KKB ! near ground physical index
+INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
+INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ2D ! height difference between two mass levels
+REAL, DIMENSION(:), INTENT(IN) :: PTKEM_DEP ! TKE to consume
+REAL, DIMENSION(:), INTENT(IN) :: PG_O_THVREF ! g/ThetaVRef at the departure point
+REAL, DIMENSION(:,:), INTENT(IN) :: PVPT ! ThetaV on mass levels
+INTEGER, INTENT(IN) :: KK ! index of departure level
+LOGICAL, INTENT(IN) :: OUPORDN ! switch to compute upward (true) or
+ ! downward (false) mixing length
+LOGICAL, INTENT(IN) :: OFLUX ! Computation must be done from flux level
+REAL, DIMENSION(:), INTENT(OUT) :: PLWORK ! Resulting mixing length
+REAL, DIMENSION(:,:), INTENT(IN) :: PSHEAR ! vertical wind shear for RM17 mixing length
+
+! 0.2 Local variable
+!
+REAL, DIMENSION(SIZE(PVPT,1)) :: ZLWORK1,ZLWORK2 ! Temporary mixing length
+REAL, DIMENSION(SIZE(PVPT,1)) :: ZINTE,ZPOTE ! TKE and potential energy
+ ! between 2 levels
+REAL, DIMENSION(SIZE(PVPT,1)) :: ZVPT_DEP ! Thetav on departure point
+!
+REAL, DIMENSION(SIZE(PVPT,1),SIZE(PVPT,2)) :: ZDELTVPT,ZHLVPT
+ !Virtual Potential Temp at Half level and DeltaThv between
+ !2 mass levels
+
+INTEGER :: IIJU !Internal Domain
+INTEGER :: J1D !horizontal loop counter
+INTEGER :: JKK !loop counters
+REAL :: ZTEST,ZTEST0,ZTESTM !test for vectorization
+!-------------------------------------------------------------------------------------
+!
+!* 1. INITIALISATION
+! --------------
+IIJU=SIZE(PVPT,1)
+!
+ZDELTVPT(:,:)=DZM_MF(KKA,KKU,KKL,PVPT(:,:))
+ZDELTVPT(:,KKA)=0.
+WHERE (ABS(ZDELTVPT(:,:))<XLINF)
+ ZDELTVPT(:,:)=XLINF
+END WHERE
+!
+ZHLVPT(:,:)=MZM_MF(KKA,KKU,KKL,PVPT(:,:))
+!
+!We consider that gradient between mass levels KKB and KKB+KKL is the same as
+!the gradient between flux level KKB and mass level KKB
+ZDELTVPT(:,KKB)=PDZZ2D(:,KKB)*ZDELTVPT(:,KKB+KKL)/PDZZ2D(:,KKB+KKL)
+ZHLVPT(:,KKB)=PVPT(:,KKB)-ZDELTVPT(:,KKB)*0.5
+!
+!
+!
+!* 2. CALCULATION OF THE UPWARD MIXING LENGTH
+! ---------------------------------------
+!
+
+IF (OUPORDN.EQV..TRUE.) THEN
+ ZINTE(:)=PTKEM_DEP(:)
+ PLWORK=0.
+ ZTESTM=1.
+ IF(OFLUX)THEN
+ ZVPT_DEP(:)=ZHLVPT(:,KK) ! departure point is on flux level
+ !We must compute what happens between flux level KK and mass level KK
+ DO J1D=1,IIJU
+ ZTEST0=0.5+SIGN(0.5,ZINTE(J1D)) ! test if there's energy to consume
+ ! Energy consumed if parcel cross the entire layer
+ ZPOTE(J1D) = ZTEST0*(PG_O_THVREF(J1D) * &
+ (0.5*(ZHLVPT(J1D,KK)+ PVPT(J1D,KK)) - ZVPT_DEP(J1D)) + &
+ XRM17*PSHEAR(J1D,KK)*SQRT(ABS(PTKEM_DEP(J1D)))) * &
+ PDZZ2D(J1D,KK)*0.5
+ ! Test if it rests some energy to consume
+ ZTEST =0.5+SIGN(0.5,ZINTE(J1D)-ZPOTE(J1D))
+ ! Length travelled by parcel if it rests energy to consume
+ ZLWORK1(J1D)=PDZZ2D(J1D,KK)*0.5
+ ! Lenght travelled by parcel to nullify energy
+ ZLWORK2(J1D)= ( - PG_O_THVREF(J1D) * &
+ ( ZHLVPT(J1D,KK) - ZVPT_DEP(J1D) ) &
+ - XRM17*PSHEAR(J1D,JKK)*sqrt(abs(PTKEM_DEP(J1D))) &
+ + SQRT (ABS( &
+ (XRM17*PSHEAR(J1D,JKK)*sqrt(abs(PTKEM_DEP(J1D))) + &
+ PG_O_THVREF(J1D) * (ZHLVPT(J1D,KK) - ZVPT_DEP(J1D)) )**2 &
+ + 2. * ZINTE(J1D) * PG_O_THVREF(J1D) &
+ * ZDELTVPT(J1D,KK) / PDZZ2D(J1D,KK) )) ) / &
+ ( PG_O_THVREF(J1D) * ZDELTVPT(J1D,KK) / PDZZ2D(J1D,KK) )
+ ! Effective length travelled by parcel
+ PLWORK(J1D)=PLWORK(J1D)+ZTEST0*(ZTEST*ZLWORK1(J1D)+ &
+ (1-ZTEST)*ZLWORK2(J1D))
+ ! Rest of energy to consume
+ ZINTE(J1D) = ZINTE(J1D) - ZPOTE(J1D)
+ ENDDO
+ ELSE
+ ZVPT_DEP(:)=PVPT(:,KK) ! departure point is on mass level
+ ENDIF
+
+ DO JKK=KK+KKL,KKE,KKL
+ IF(ZTESTM > 0.) THEN
+ ZTESTM=0
+ DO J1D=1,IIJU
+ ZTEST0=0.5+SIGN(0.5,ZINTE(J1D))
+ ZPOTE(J1D) = ZTEST0*(PG_O_THVREF(J1D) * &
+ (ZHLVPT(J1D,JKK) - ZVPT_DEP(J1D)) &
+ + XRM17*PSHEAR(J1D,JKK)*SQRT(ABS(PTKEM_DEP(J1D))))* PDZZ2D(J1D,JKK)
+ ZTEST =0.5+SIGN(0.5,ZINTE(J1D)-ZPOTE(J1D))
+ ZTESTM=ZTESTM+ZTEST0
+ ZLWORK1(J1D)=PDZZ2D(J1D,JKK)
+ !ZLWORK2 jump of the last reached level
+ ZLWORK2(J1D)= ( - PG_O_THVREF(J1D) * &
+ ( PVPT(J1D,JKK-KKL) - ZVPT_DEP(J1D) ) &
+ - XRM17*PSHEAR(J1D,JKK)*sqrt(abs(PTKEM_DEP(J1D))) &
+ + SQRT (ABS( &
+ (XRM17*PSHEAR(J1D,JKK)*sqrt(abs(PTKEM_DEP(J1D))) + &
+ PG_O_THVREF(J1D) * (PVPT(J1D,JKK-KKL) - ZVPT_DEP(J1D)) )**2 &
+ + 2. * ZINTE(J1D) * PG_O_THVREF(J1D) &
+ * ZDELTVPT(J1D,JKK) / PDZZ2D(J1D,JKK) )) ) / &
+ ( PG_O_THVREF(J1D) * ZDELTVPT(J1D,JKK) / PDZZ2D(J1D,JKK) )
+!
+ PLWORK(J1D)=PLWORK(J1D)+ZTEST0*(ZTEST*ZLWORK1(J1D)+ &
+ (1-ZTEST)*ZLWORK2(J1D))
+ ZINTE(J1D) = ZINTE(J1D) - ZPOTE(J1D)
+ END DO
+ ENDIF
+ END DO
+ENDIF
+!!
+!* 2. CALCULATION OF THE DOWNWARD MIXING LENGTH
+! ---------------------------------------
+!
+
+IF (OUPORDN.EQV..FALSE.) THEN
+ IF(OFLUX) call Print_msg(NVERB_FATAL,'GEN','COMPUTE_BL89_ML','OFLUX option not coded for downward mixing length')
+ ZINTE(:)=PTKEM_DEP(:)
+ PLWORK=0.
+ ZTESTM=1.
+ DO JKK=KK,KKB,-KKL
+ IF(ZTESTM > 0.) THEN
+ ZTESTM=0
+ DO J1D=1,IIJU
+ ZTEST0=0.5+SIGN(0.5,ZINTE(J1D))
+ ZPOTE(J1D) = ZTEST0*(-PG_O_THVREF(J1D) * &
+ (ZHLVPT(J1D,JKK) - PVPT(J1D,KK)) &
+ + XRM17*PSHEAR(J1D,JKK)*SQRT(ABS(PTKEM_DEP(J1D))))* PDZZ2D(J1D,JKK)
+ ZTEST =0.5+SIGN(0.5,ZINTE(J1D)-ZPOTE(J1D))
+ ZTESTM=ZTESTM+ZTEST0
+ ZLWORK1(J1D)=PDZZ2D(J1D,JKK)
+ ZLWORK2(J1D)= ( + PG_O_THVREF(J1D) * &
+ ( PVPT(J1D,JKK) - PVPT(J1D,KK) ) &
+ -XRM17*PSHEAR(J1D,JKK)*sqrt(abs(PTKEM_DEP(J1D))) &
+ + SQRT (ABS( &
+ (XRM17*PSHEAR(J1D,JKK)*sqrt(abs(PTKEM_DEP(J1D))) - &
+ PG_O_THVREF(J1D) * (PVPT(J1D,JKK) - PVPT(J1D,KK)) )**2 &
+ + 2. * ZINTE(J1D) * PG_O_THVREF(J1D) &
+ * ZDELTVPT(J1D,JKK) / PDZZ2D(J1D,JKK) )) ) / &
+ ( PG_O_THVREF(J1D) * ZDELTVPT(J1D,JKK) / PDZZ2D(J1D,JKK) )
+!
+ PLWORK(J1D)=PLWORK(J1D)+ZTEST0*(ZTEST*ZLWORK1(J1D)+ &
+ (1-ZTEST)*ZLWORK2(J1D))
+ ZINTE(J1D) = ZINTE(J1D) - ZPOTE(J1D)
+ END DO
+ ENDIF
+ END DO
+ENDIF
+
+END SUBROUTINE COMPUTE_BL89_ML
diff --git a/src/mesonh/turb/compute_entr_detr.f90 b/src/mesonh/turb/compute_entr_detr.f90
new file mode 100644
index 000000000..80a9d68db
--- /dev/null
+++ b/src/mesonh/turb/compute_entr_detr.f90
@@ -0,0 +1,488 @@
+!MNH_LIC Copyright 2009-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+! ######spl
+ MODULE MODI_COMPUTE_ENTR_DETR
+! ##############################
+!
+INTERFACE
+!
+ SUBROUTINE COMPUTE_ENTR_DETR(KK,KKB,KKE,KKL,OTEST,OTESTLCL,&
+ HFRAC_ICE,PFRAC_ICE,PRHODREF,&
+ PPRE_MINUS_HALF,&
+ PPRE_PLUS_HALF,PZZ,PDZZ,&
+ PTHVM,PTHLM,PRTM,PW_UP2,PTH_UP,&
+ PTHL_UP,PRT_UP,PLUP,&
+ PRC_UP,PRI_UP,PTHV_UP,&
+ PRSAT_UP,PRC_MIX,PRI_MIX, &
+ PENTR,PDETR,PENTR_CLD,PDETR_CLD,&
+ PBUO_INTEG_DRY,PBUO_INTEG_CLD,&
+ PPART_DRY)
+
+!INTEGER, INTENT(IN) :: KK
+INTEGER, INTENT(IN) :: KKB ! near ground physical index
+INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
+INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+LOGICAL,DIMENSION(:), INTENT(IN) :: OTEST ! test to see if updraft is running
+LOGICAL,DIMENSION(:), INTENT(IN) :: OTESTLCL !test of condensation
+CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE ! frac_ice can be compute using
+ ! Temperature (T) or prescribed
+ ! (Y)
+REAL, DIMENSION(:), INTENT(IN) :: PFRAC_ICE ! fraction of ice
+!
+! prognostic variables at t- deltat
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRHODREF !rhodref
+REAL, DIMENSION(:), INTENT(IN) :: PPRE_MINUS_HALF ! Pressure at flux level KK
+REAL, DIMENSION(:), INTENT(IN) :: PPRE_PLUS_HALF ! Pressure at flux level KK+KKL
+REAL, DIMENSION(:,:), INTENT(IN) :: PZZ ! Height at the flux point
+REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! metrics coefficient
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHVM ! ThetaV environment
+
+!
+! thermodynamical variables which are transformed in conservative var.
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM ! Thetal
+REAL, DIMENSION(:,:), INTENT(IN) :: PRTM ! total mixing ratio
+REAL, DIMENSION(:,:), INTENT(IN) :: PW_UP2 ! Vertical velocity^2
+REAL, DIMENSION(:), INTENT(IN) :: PTH_UP,PTHL_UP,PRT_UP ! updraft properties
+REAL, DIMENSION(:), INTENT(IN) :: PLUP ! LUP compute from the ground
+REAL, DIMENSION(:), INTENT(IN) :: PRC_UP,PRI_UP ! Updraft cloud content
+REAL, DIMENSION(:), INTENT(IN) :: PTHV_UP ! Thetav of updraft
+REAL, DIMENSION(:), INTENT(IN) :: PRSAT_UP ! Mixing ratio at saturation in updraft
+REAL, DIMENSION(:), INTENT(INOUT) :: PRC_MIX, PRI_MIX ! Mixture cloud content
+REAL, DIMENSION(:), INTENT(OUT) :: PENTR ! Mass flux entrainment of the updraft
+REAL, DIMENSION(:), INTENT(OUT) :: PDETR ! Mass flux detrainment of the updraft
+REAL, DIMENSION(:), INTENT(OUT) :: PENTR_CLD ! Mass flux entrainment of the updraft in cloudy part
+REAL, DIMENSION(:), INTENT(OUT) :: PDETR_CLD ! Mass flux detrainment of the updraft in cloudy part
+REAL, DIMENSION(:), INTENT(OUT) :: PBUO_INTEG_DRY, PBUO_INTEG_CLD! Integral Buoyancy
+REAL, DIMENSION(:), INTENT(OUT) :: PPART_DRY ! ratio of dry part at the transition level
+!
+!
+END SUBROUTINE COMPUTE_ENTR_DETR
+
+END INTERFACE
+!
+END MODULE MODI_COMPUTE_ENTR_DETR
+! ######spl
+ SUBROUTINE COMPUTE_ENTR_DETR(KK,KKB,KKE,KKL,OTEST,OTESTLCL,&
+ HFRAC_ICE,PFRAC_ICE,PRHODREF,&
+ PPRE_MINUS_HALF,&
+ PPRE_PLUS_HALF,PZZ,PDZZ,&
+ PTHVM,PTHLM,PRTM,PW_UP2,PTH_UP,&
+ PTHL_UP,PRT_UP,PLUP,&
+ PRC_UP,PRI_UP,PTHV_UP,&
+ PRSAT_UP,PRC_MIX,PRI_MIX, &
+ PENTR,PDETR,PENTR_CLD,PDETR_CLD,&
+ PBUO_INTEG_DRY,PBUO_INTEG_CLD,&
+ PPART_DRY)
+! #############################################################
+
+!!
+!!***COMPUTE_ENTR_DETR* - calculates caracteristics of the updraft or downdraft
+!! using model of the EDMF scheme
+!!
+!! PURPOSE
+!! -------
+!!**** The purpose of this routine is to compute entrainement and
+!! detrainement at one level of the updraft
+!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!! Book 1 of Meso-NH documentation (chapter Convection)
+!!
+!!
+!! AUTHOR
+!! ------
+!! J.Pergaud : 2009
+!!
+!! MODIFICATIONS
+!! -------------
+!! Y.Seity (06/2010) Bug correction
+!! V.Masson (09/2010) Optimization
+!! S. Riette april 2011 : ice added, protection against zero divide by Yves Bouteloup
+!! protection against too big ZPART_DRY, interface modified
+!! S. Riette Jan 2012: support for both order of vertical levels
+!! S. Riette & J. Escobar (11/2013) : remove div by 0 on real*4 case
+!! P.Marguinaud Jun 2012: fix uninitialized variable
+!! P.Marguinaud Nov 2012: fix gfortran bug
+!! S. Riette Apr 2013: bugs correction, rewriting (for optimisation) and
+!! improvement of continuity at the condensation level
+!! S. Riette Nov 2013: protection against zero divide for min value of dry PDETR
+!! R.Honnert Oct 2016 : Update with AROME
+! P. Wautelet 08/02/2019: bugfix: compute ZEPSI_CLOUD only once and only when it is needed
+! P. Wautelet 10/02/2021: bugfix: initialized PPART_DRY everywhere
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_PARAM_MFSHALL_n
+USE MODD_PARAMETERS, ONLY: XUNDEF
+
+USE MODE_THERMO
+
+USE MODI_TH_R_FROM_THL_RT_1D
+
+IMPLICIT NONE
+!
+!
+!* 1.1 Declaration of Arguments
+!
+!
+INTEGER, INTENT(IN) :: KK
+INTEGER, INTENT(IN) :: KKB ! near ground physical index
+INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
+INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+LOGICAL,DIMENSION(:), INTENT(IN) :: OTEST ! test to see if updraft is running
+LOGICAL,DIMENSION(:), INTENT(IN) :: OTESTLCL !test of condensation
+CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE ! frac_ice can be compute using
+ ! Temperature (T) or prescribed
+ ! (Y)
+REAL, DIMENSION(:), INTENT(IN) :: PFRAC_ICE ! fraction of ice
+!
+! prognostic variables at t- deltat
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRHODREF !rhodref
+REAL, DIMENSION(:), INTENT(IN) :: PPRE_MINUS_HALF ! Pressure at flux level KK
+REAL, DIMENSION(:), INTENT(IN) :: PPRE_PLUS_HALF ! Pressure at flux level KK+KKL
+REAL, DIMENSION(:,:), INTENT(IN) :: PZZ ! Height at the flux point
+REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! metrics coefficient
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHVM ! ThetaV environment
+
+!
+! thermodynamical variables which are transformed in conservative var.
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM ! Thetal
+REAL, DIMENSION(:,:), INTENT(IN) :: PRTM ! total mixing ratio
+REAL, DIMENSION(:,:), INTENT(IN) :: PW_UP2 ! Vertical velocity^2
+REAL, DIMENSION(:), INTENT(IN) :: PTH_UP,PTHL_UP,PRT_UP ! updraft properties
+REAL, DIMENSION(:), INTENT(IN) :: PLUP ! LUP compute from the ground
+REAL, DIMENSION(:), INTENT(IN) :: PRC_UP,PRI_UP ! Updraft cloud content
+REAL, DIMENSION(:), INTENT(IN) :: PTHV_UP ! Thetav of updraft
+REAL, DIMENSION(:), INTENT(IN) :: PRSAT_UP ! Mixing ratio at saturation in updraft
+REAL, DIMENSION(:), INTENT(INOUT) :: PRC_MIX, PRI_MIX ! Mixture cloud content
+REAL, DIMENSION(:), INTENT(OUT) :: PENTR ! Mass flux entrainment of the updraft
+REAL, DIMENSION(:), INTENT(OUT) :: PDETR ! Mass flux detrainment of the updraft
+REAL, DIMENSION(:), INTENT(OUT) :: PENTR_CLD ! Mass flux entrainment of the updraft in cloudy part
+REAL, DIMENSION(:), INTENT(OUT) :: PDETR_CLD ! Mass flux detrainment of the updraft in cloudy part
+REAL, DIMENSION(:), INTENT(OUT) :: PBUO_INTEG_DRY, PBUO_INTEG_CLD! Integral Buoyancy
+REAL, DIMENSION(:), INTENT(OUT) :: PPART_DRY ! ratio of dry part at the transition level
+!
+!
+! 1.2 Declaration of local variables
+!
+!
+
+! Variables for cloudy part
+REAL, DIMENSION(SIZE(PTHLM,1)) :: ZKIC, ZKIC_F2 ! fraction of env. mass in the muxtures
+REAL, DIMENSION(SIZE(PTHLM,1)) :: ZEPSI,ZDELTA ! factor entrainment detrainment
+REAL, DIMENSION(SIZE(PTHLM,1)) :: ZEPSI_CLOUD ! factor entrainment detrainment
+REAL :: ZCOEFFMF_CLOUD ! factor for compputing entr. detr.
+REAL, DIMENSION(SIZE(PTHLM,1)) :: ZMIXTHL,ZMIXRT ! Thetal and rt in the mixtures
+REAL, DIMENSION(SIZE(PTHLM,1)) :: ZTHMIX ! Theta and Thetav of mixtures
+REAL, DIMENSION(SIZE(PTHLM,1)) :: ZRVMIX,ZRCMIX,ZRIMIX ! mixing ratios in mixtures
+REAL, DIMENSION(SIZE(PTHLM,1)) :: ZTHVMIX, ZTHVMIX_F2 ! Theta and Thetav of mixtures
+REAL, DIMENSION(SIZE(PTHLM,1)) :: ZTHV_UP_F2 ! thv_up at flux point kk+kkl
+REAL, DIMENSION(SIZE(PTHLM,1)) :: ZRSATW, ZRSATI ! working arrays (mixing ratio at saturation)
+REAL, DIMENSION(SIZE(PTHLM,1)) :: ZTHV ! theta V of environment at the bottom of cloudy part
+REAL :: ZKIC_INIT !Initial value of ZKIC
+REAL, DIMENSION(SIZE(PTHLM,1)) :: ZCOTHVU ! Variation of Thvup between bottom and top of cloudy part
+
+! Variables for dry part
+REAL, DIMENSION(SIZE(PTHLM,1)) :: ZFOESW, ZFOESI ! saturating vapor pressure
+REAL, DIMENSION(SIZE(PTHLM,1)) :: ZDRSATODP ! d.Rsat/dP
+REAL, DIMENSION(SIZE(PTHLM,1)) :: ZT ! Temperature
+REAL, DIMENSION(SIZE(PTHLM,1)) :: ZWK ! Work array
+
+! Variables for dry and cloudy parts
+REAL, DIMENSION(SIZE(PTHLM,1)) :: ZCOEFF_MINUS_HALF,& ! Variation of Thv between mass points kk-kkl and kk
+ ZCOEFF_PLUS_HALF ! Variation of Thv between mass points kk and kk+kkl
+REAL, DIMENSION(SIZE(PTHLM,1)) :: ZPRE ! pressure at the bottom of the cloudy part
+REAL, DIMENSION(SIZE(PTHVM,1)) :: ZG_O_THVREF
+REAL, DIMENSION(SIZE(PTHLM,1)) :: ZFRAC_ICE ! fraction of ice
+REAL :: ZRVORD ! RV/RD
+REAL, DIMENSION(SIZE(PTHLM,1)) :: ZDZ_STOP,& ! Exact Height of the LCL above flux level KK
+ ZTHV_MINUS_HALF,& ! Thv at flux point(kk)
+ ZTHV_PLUS_HALF,& ! Thv at flux point(kk+kkl)
+ ZDZ ! Delta Z used in computations
+INTEGER :: JI,JLOOP
+
+!----------------------------------------------------------------------------------
+
+! 1.3 Initialisation
+! ------------------
+
+
+ ZRVORD = XRV / XRD !=1.607
+ ZG_O_THVREF(:)=XG/PTHVM(:,KK)
+ ZCOEFFMF_CLOUD=XENTR_MF * XG / XCRAD_MF
+
+ ZFRAC_ICE(:)=PFRAC_ICE(:) ! to not modify fraction of ice
+
+ ZPRE(:)=PPRE_MINUS_HALF(:)
+ ZMIXTHL(:)=0.1
+ ZMIXRT(:)=0.1
+
+ !Initialize PPART_DRY everywhere to prevent access to non-initialized values
+ ! (intent(out) arrays have undefined values at subroutine entry)
+ PPART_DRY(:) = XUNDEF
+
+! 1.4 Estimation of PPART_DRY
+ DO JLOOP=1,SIZE(OTEST)
+ IF(OTEST(JLOOP) .AND. OTESTLCL(JLOOP)) THEN
+ !No dry part when condensation level is reached
+ PPART_DRY(JLOOP)=0.
+ ZDZ_STOP(JLOOP)=0.
+ ZPRE(JLOOP)=PPRE_MINUS_HALF(JLOOP)
+ ELSE IF (OTEST(JLOOP) .AND. .NOT. OTESTLCL(JLOOP)) THEN
+ !Temperature at flux level KK
+ ZT(JLOOP)=PTH_UP(JLOOP)*(PPRE_MINUS_HALF(JLOOP)/XP00) ** (XRD/XCPD)
+ !Saturating vapor pressure at flux level KK
+ ZFOESW(JLOOP) = MIN(EXP( XALPW - XBETAW/ZT(JLOOP) - XGAMW*LOG(ZT(JLOOP)) ), 0.99*PPRE_MINUS_HALF(JLOOP))
+ ZFOESI(JLOOP) = MIN(EXP( XALPI - XBETAI/ZT(JLOOP) - XGAMI*LOG(ZT(JLOOP)) ), 0.99*PPRE_MINUS_HALF(JLOOP))
+ !Computation of d.Rsat / dP (partial derivations with respect to P and T
+ !and use of T=Theta*(P/P0)**(R/Cp) to transform dT into dP with theta_up
+ !constant at the vertical)
+ ZDRSATODP(JLOOP)=(XBETAW/ZT(JLOOP)-XGAMW)*(1-ZFRAC_ICE(JLOOP))+(XBETAI/ZT(JLOOP)-XGAMI)*ZFRAC_ICE(JLOOP)
+ ZDRSATODP(JLOOP)=((XRD/XCPD)*ZDRSATODP(JLOOP)-1.)*PRSAT_UP(JLOOP)/ &
+ &(PPRE_MINUS_HALF(JLOOP)-(ZFOESW(JLOOP)*(1-ZFRAC_ICE(JLOOP)) + ZFOESI(JLOOP)*ZFRAC_ICE(JLOOP)))
+ !Use of d.Rsat / dP and pressure at flux level KK to find pressure (ZPRE)
+ !where Rsat is equal to PRT_UP
+ ZPRE(JLOOP)=PPRE_MINUS_HALF(JLOOP)+(PRT_UP(JLOOP)-PRSAT_UP(JLOOP))/ZDRSATODP(JLOOP)
+ !Fraction of dry part (computed with pressure and used with heights, no
+ !impact found when using log function here and for pressure on flux levels
+ !computation)
+ PPART_DRY(JLOOP)=MAX(0., MIN(1., (PPRE_MINUS_HALF(JLOOP)-ZPRE(JLOOP))/(PPRE_MINUS_HALF(JLOOP)-PPRE_PLUS_HALF(JLOOP))))
+ !Height above flux level KK of the cloudy part
+ ZDZ_STOP(JLOOP) = (PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK))*PPART_DRY(JLOOP)
+ END IF
+ END DO
+
+! 1.5 Gradient and flux values of thetav
+ IF(KK/=KKB)THEN
+ ZCOEFF_MINUS_HALF(:)=((PTHVM(:,KK)-PTHVM(:,KK-KKL))/PDZZ(:,KK))
+ ZTHV_MINUS_HALF(:) = PTHVM(:,KK) - ZCOEFF_MINUS_HALF(:)*0.5*(PZZ(:,KK+KKL)-PZZ(:,KK))
+ ELSE
+ ZCOEFF_MINUS_HALF(:)=0.
+ ZTHV_MINUS_HALF(:) = PTHVM(:,KK)
+ ENDIF
+ ZCOEFF_PLUS_HALF(:) = ((PTHVM(:,KK+KKL)-PTHVM(:,KK))/PDZZ(:,KK+KKL))
+ ZTHV_PLUS_HALF(:) = PTHVM(:,KK) + ZCOEFF_PLUS_HALF(:)*0.5*(PZZ(:,KK+KKL)-PZZ(:,KK))
+
+! 2 Dry part computation:
+! Integral buoyancy and computation of PENTR and PDETR for dry part
+! --------------------------------------------------------------------
+
+DO JLOOP=1,SIZE(OTEST)
+ IF (OTEST(JLOOP) .AND. PPART_DRY(JLOOP)>0.) THEN
+ ZDZ(JLOOP)=MIN(ZDZ_STOP(JLOOP),(PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK))*0.5)
+ PBUO_INTEG_DRY(JLOOP) = ZG_O_THVREF(JLOOP)*ZDZ(JLOOP)*&
+ (0.5 * ( - ZCOEFF_MINUS_HALF(JLOOP))*ZDZ(JLOOP) &
+ - ZTHV_MINUS_HALF(JLOOP) + PTHV_UP(JLOOP) )
+
+ !Between mass flux KK and bottom of cloudy part (if above mass flux)
+ ZDZ(JLOOP)=MAX(0., ZDZ_STOP(JLOOP)-(PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK))*0.5)
+ PBUO_INTEG_DRY(JLOOP) = PBUO_INTEG_DRY(JLOOP) + ZG_O_THVREF(JLOOP)*ZDZ(JLOOP)*&
+ (0.5 * ( - ZCOEFF_PLUS_HALF(JLOOP))*ZDZ(JLOOP) &
+ - PTHVM(JLOOP,KK) + PTHV_UP(JLOOP) )
+ IF (PBUO_INTEG_DRY(JLOOP)>=0.) THEN
+ PENTR(JLOOP) = 0.5/(XABUO-XBENTR*XENTR_DRY)*&
+ LOG(1.+ (2.*(XABUO-XBENTR*XENTR_DRY)/PW_UP2(JLOOP,KK))* &
+ PBUO_INTEG_DRY(JLOOP))
+ PDETR(JLOOP) = 0.
+ ELSE
+ PENTR(JLOOP) = 0.
+ PDETR(JLOOP) = 0.5/(XABUO)*&
+ LOG(1.+ (2.*(XABUO)/PW_UP2(JLOOP,KK))* &
+ (-PBUO_INTEG_DRY(JLOOP)))
+ ENDIF
+ PENTR(JLOOP) = XENTR_DRY*PENTR(JLOOP)/(PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK))
+ PDETR(JLOOP) = XDETR_DRY*PDETR(JLOOP)/(PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK))
+ !Minimum value of detrainment
+ ZWK(JLOOP)=PLUP(JLOOP)-0.5*(PZZ(JLOOP,KK)+PZZ(JLOOP,KK+KKL))
+ ZWK(JLOOP)=SIGN(MAX(1., ABS(ZWK(JLOOP))), ZWK(JLOOP)) ! ZWK must not be zero
+ PDETR(JLOOP) = MAX(PPART_DRY(JLOOP)*XDETR_LUP/ZWK(JLOOP), PDETR(JLOOP))
+ ELSE
+ !No dry part, consation reached (OTESTLCL)
+ PBUO_INTEG_DRY(JLOOP) = 0.
+ PENTR(JLOOP)=0.
+ PDETR(JLOOP)=0.
+ END IF
+ENDDO
+
+
+! 3 Wet part computation
+! -----------------------
+
+! 3.1 Integral buoyancy for cloudy part
+
+ ! Compute theta_v of updraft at flux level KK+KKL
+ !MIX variables are used to avoid declaring new variables
+ !but we are dealing with updraft and not mixture
+ ZRCMIX(:)=PRC_UP(:)
+ ZRIMIX(:)=PRI_UP(:)
+ CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,ZFRAC_ICE,&
+ PPRE_PLUS_HALF,PTHL_UP,PRT_UP,&
+ ZTHMIX,ZRVMIX,ZRCMIX,ZRIMIX,&
+ ZRSATW, ZRSATI)
+ ZTHV_UP_F2(:) = ZTHMIX(:)*(1.+ZRVORD*ZRVMIX(:))/(1.+PRT_UP(:))
+
+ ! Integral buoyancy for cloudy part
+ DO JLOOP=1,SIZE(OTEST)
+ IF(OTEST(JLOOP) .AND. PPART_DRY(JLOOP)<1.) THEN
+ !Gradient of Theta V updraft over the cloudy part, assuming that thetaV updraft don't change
+ !between flux level KK and bottom of cloudy part
+ ZCOTHVU(JLOOP)=(ZTHV_UP_F2(JLOOP)-PTHV_UP(JLOOP))/((PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK))*(1-PPART_DRY(JLOOP)))
+
+ !Computation in two parts to use change of gradient of theta v of environment
+ !Between bottom of cloudy part (if under mass level) and mass level KK
+ ZDZ(JLOOP)=MAX(0., 0.5*(PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK))-ZDZ_STOP(JLOOP))
+ PBUO_INTEG_CLD(JLOOP) = ZG_O_THVREF(JLOOP)*ZDZ(JLOOP)*&
+ (0.5*( ZCOTHVU(JLOOP) - ZCOEFF_MINUS_HALF(JLOOP))*ZDZ(JLOOP) &
+ - (PTHVM(JLOOP,KK)-ZDZ(JLOOP)*ZCOEFF_MINUS_HALF(JLOOP)) + PTHV_UP(JLOOP) )
+
+ !Between max(mass level, bottom of cloudy part) and flux level KK+KKL
+ ZDZ(JLOOP)=(PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK))-MAX(ZDZ_STOP(JLOOP),0.5*(PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK)))
+ PBUO_INTEG_CLD(JLOOP) = PBUO_INTEG_CLD(JLOOP)+ZG_O_THVREF(JLOOP)*ZDZ(JLOOP)*&
+ (0.5*( ZCOTHVU(JLOOP) - ZCOEFF_PLUS_HALF(JLOOP))*ZDZ(JLOOP)&
+ - (PTHVM(JLOOP,KK)+(0.5*((PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK)))-ZDZ(JLOOP))*ZCOEFF_PLUS_HALF(JLOOP)) +&
+ PTHV_UP(JLOOP) )
+
+ ELSE
+ !No cloudy part
+ PBUO_INTEG_CLD(JLOOP)=0.
+ END IF
+ END DO
+
+! 3.2 Critical mixed fraction for KK+KKL flux level (ZKIC_F2) and
+! for bottom of cloudy part (ZKIC), then a mean for the cloudy part
+! (put also in ZKIC)
+!
+! computation by estimating unknown
+! T^mix r_c^mix and r_i^mix from enthalpy^mix and r_w^mix
+! We determine the zero crossing of the linear curve
+! evaluating the derivative using ZMIXF=0.1
+
+ ZKIC_INIT=0.1 ! starting value for critical mixed fraction for CLoudy Part
+
+ ! Compute thetaV of environment at the bottom of cloudy part
+ ! and cons then non cons. var. of mixture at the bottom of cloudy part
+
+ ! JI computed to avoid KKL(KK-KKL) being < KKL*KKB
+ JI=KKL*MAX(KKL*(KK-KKL),KKL*KKB)
+ DO JLOOP=1,SIZE(OTEST)
+ IF(OTEST(JLOOP) .AND. PPART_DRY(JLOOP)>0.5) THEN
+ ZDZ(JLOOP)=ZDZ_STOP(JLOOP)-0.5*(PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK))
+ ZTHV(JLOOP)= PTHVM(JLOOP,KK)+ZCOEFF_PLUS_HALF(JLOOP)*ZDZ(JLOOP)
+ ZMIXTHL(JLOOP) = ZKIC_INIT * &
+ (PTHLM(JLOOP,KK)+ZDZ(JLOOP)*(PTHLM(JLOOP,KK+KKL)-PTHLM(JLOOP,KK))/PDZZ(JLOOP,KK+KKL)) + &
+ (1. - ZKIC_INIT)*PTHL_UP(JLOOP)
+ ZMIXRT(JLOOP) = ZKIC_INIT * &
+ (PRTM(JLOOP,KK)+ZDZ(JLOOP)*(PRTM(JLOOP,KK+KKL)-PRTM(JLOOP,KK))/PDZZ(JLOOP,KK+KKL)) + &
+ (1. - ZKIC_INIT)*PRT_UP(JLOOP)
+ ELSEIF(OTEST(JLOOP)) THEN
+ ZDZ(JLOOP)=0.5*(PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK))-ZDZ_STOP(JLOOP)
+ ZTHV(JLOOP)= PTHVM(JLOOP,KK)-ZCOEFF_MINUS_HALF(JLOOP)*ZDZ(JLOOP)
+ ZMIXTHL(JLOOP) = ZKIC_INIT * &
+ (PTHLM(JLOOP,KK)-ZDZ(JLOOP)*(PTHLM(JLOOP,KK)-PTHLM(JLOOP,JI))/PDZZ(JLOOP,KK)) + &
+ (1. - ZKIC_INIT)*PTHL_UP(JLOOP)
+ ZMIXRT(JLOOP) = ZKIC_INIT * &
+ (PRTM(JLOOP,KK)-ZDZ(JLOOP)*(PRTM(JLOOP,KK)-PRTM(JLOOP,JI))/PDZZ(JLOOP,KK)) + &
+ (1. - ZKIC_INIT)*PRT_UP(JLOOP)
+ ENDIF
+ ENDDO
+ CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,ZFRAC_ICE,&
+ ZPRE,ZMIXTHL,ZMIXRT,&
+ ZTHMIX,ZRVMIX,PRC_MIX,PRI_MIX,&
+ ZRSATW, ZRSATI)
+ ZTHVMIX(:) = ZTHMIX(:)*(1.+ZRVORD*ZRVMIX(:))/(1.+ZMIXRT(:))
+
+ ! Compute cons then non cons. var. of mixture at the flux level KK+KKL with initial ZKIC
+ ZMIXTHL(:) = ZKIC_INIT * 0.5*(PTHLM(:,KK)+PTHLM(:,KK+KKL))+(1. - ZKIC_INIT)*PTHL_UP(:)
+ ZMIXRT(:) = ZKIC_INIT * 0.5*(PRTM(:,KK)+PRTM(:,KK+KKL))+(1. - ZKIC_INIT)*PRT_UP(:)
+ CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,ZFRAC_ICE,&
+ PPRE_PLUS_HALF,ZMIXTHL,ZMIXRT,&
+ ZTHMIX,ZRVMIX,PRC_MIX,PRI_MIX,&
+ ZRSATW, ZRSATI)
+ ZTHVMIX_F2(:) = ZTHMIX(:)*(1.+ZRVORD*ZRVMIX(:))/(1.+ZMIXRT(:))
+
+ !Computation of mean ZKIC over the cloudy part
+ DO JLOOP=1,SIZE(OTEST)
+ IF (OTEST(JLOOP)) THEN
+ ! Compute ZKIC at the bottom of cloudy part
+ ! Thetav_up at bottom is equal to Thetav_up at flux level KK
+ IF (ABS(PTHV_UP(JLOOP)-ZTHVMIX(JLOOP))<1.E-10) THEN
+ ZKIC(JLOOP)=1.
+ ELSE
+ ZKIC(JLOOP) = MAX(0.,PTHV_UP(JLOOP)-ZTHV(JLOOP))*ZKIC_INIT / &
+ (PTHV_UP(JLOOP)-ZTHVMIX(JLOOP))
+ END IF
+ ! Compute ZKIC_F2 at flux level KK+KKL
+ IF (ABS(ZTHV_UP_F2(JLOOP)-ZTHVMIX_F2(JLOOP))<1.E-10) THEN
+ ZKIC_F2(JLOOP)=1.
+ ELSE
+ ZKIC_F2(JLOOP) = MAX(0.,ZTHV_UP_F2(JLOOP)-ZTHV_PLUS_HALF(JLOOP))*ZKIC_INIT / &
+ (ZTHV_UP_F2(JLOOP)-ZTHVMIX_F2(JLOOP))
+ END IF
+ !Mean ZKIC over the cloudy part
+ ZKIC(JLOOP)=MAX(MIN(0.5*(ZKIC(JLOOP)+ZKIC_F2(JLOOP)),1.),0.)
+ END IF
+ END DO
+
+
+! 3.3 Integration of PDF
+! According to Kain and Fritsch (1990), we replace delta Mt
+! in eq. (7) and (8) using eq. (5). Here we compute the ratio
+! of integrals without computing delta Me
+
+ !Constant PDF
+ !For this PDF, eq. (5) is delta Me=0.5*delta Mt
+ DO JLOOP=1,SIZE(OTEST)
+ IF(OTEST(JLOOP)) THEN
+ ZEPSI(JLOOP) = ZKIC(JLOOP)**2. !integration multiplied by 2
+ ZDELTA(JLOOP) = (1.-ZKIC(JLOOP))**2. !idem
+ ENDIF
+ ENDDO
+
+ !Triangular PDF
+ !Calculus must be verified before activating this part, but in this state,
+ !results on ARM case are almost identical
+ !For this PDF, eq. (5) is also delta Me=0.5*delta Mt
+ !WHERE(OTEST)
+ ! !Integration multiplied by 2
+ ! WHERE(ZKIC<0.5)
+ ! ZEPSI(:)=8.*ZKIC(:)**3/3.
+ ! ZDELTA(:)=1.-4.*ZKIC(:)**2+8.*ZKIC(:)**3/3.
+ ! ELSEWHERE
+ ! ZEPSI(:)=5./3.-4*ZKIC(:)**2+8.*ZKIC(:)**3/3.
+ ! ZDELTA(:)=8.*(1.-ZKIC(:))**3/3.
+ ! ENDWHERE
+ !ENDWHERE
+
+! 3.4 Computation of PENTR and PDETR
+ DO JLOOP=1,SIZE(OTEST)
+ IF(OTEST(JLOOP)) THEN
+ ZEPSI_CLOUD(JLOOP)=MIN(ZDELTA(JLOOP),ZEPSI(JLOOP))
+ PENTR_CLD(JLOOP) = (1.-PPART_DRY(JLOOP))*ZCOEFFMF_CLOUD*PRHODREF(JLOOP)*ZEPSI_CLOUD(JLOOP)
+ PDETR_CLD(JLOOP) = (1.-PPART_DRY(JLOOP))*ZCOEFFMF_CLOUD*PRHODREF(JLOOP)*ZDELTA(JLOOP)
+ PENTR(JLOOP) = PENTR(JLOOP)+PENTR_CLD(JLOOP)
+ PDETR(JLOOP) = PDETR(JLOOP)+PDETR_CLD(JLOOP)
+ ELSE
+ PENTR_CLD(JLOOP) = 0.
+ PDETR_CLD(JLOOP) = 0.
+ ENDIF
+ ENDDO
+
+END SUBROUTINE COMPUTE_ENTR_DETR
diff --git a/src/mesonh/turb/compute_frac_ice.f90 b/src/mesonh/turb/compute_frac_ice.f90
new file mode 100644
index 000000000..b0e8e7b2d
--- /dev/null
+++ b/src/mesonh/turb/compute_frac_ice.f90
@@ -0,0 +1,286 @@
+!MNH_LIC Copyright 2006-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ######spl
+ MODULE MODI_COMPUTE_FRAC_ICE
+! ############################
+!
+INTERFACE COMPUTE_FRAC_ICE
+!
+ SUBROUTINE COMPUTE_FRAC_ICE3D(HFRAC_ICE,PFRAC_ICE,PT)
+!
+CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PT
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFRAC_ICE
+!
+ END SUBROUTINE COMPUTE_FRAC_ICE3D
+!
+ SUBROUTINE COMPUTE_FRAC_ICE2D(HFRAC_ICE,PFRAC_ICE,PT)
+!
+CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE
+REAL, DIMENSION(:,:), INTENT(IN) :: PT
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PFRAC_ICE
+!
+ END SUBROUTINE COMPUTE_FRAC_ICE2D
+
+ SUBROUTINE COMPUTE_FRAC_ICE1D(HFRAC_ICE,PFRAC_ICE,PT)
+!
+CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE
+REAL, DIMENSION(:), INTENT(IN) :: PT
+REAL, DIMENSION(:), INTENT(INOUT) :: PFRAC_ICE
+
+ END SUBROUTINE COMPUTE_FRAC_ICE1D
+
+END INTERFACE
+!
+END MODULE MODI_COMPUTE_FRAC_ICE
+!
+! ##############################
+ MODULE MODI_COMPUTE_FRAC_ICE3D
+! ##############################
+
+INTERFACE
+!
+ SUBROUTINE COMPUTE_FRAC_ICE3D(HFRAC_ICE,PFRAC_ICE,PT)
+!
+CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PT
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFRAC_ICE
+!
+ END SUBROUTINE COMPUTE_FRAC_ICE3D
+END INTERFACE
+END MODULE MODI_COMPUTE_FRAC_ICE3D
+!
+! ##############################
+ MODULE MODI_COMPUTE_FRAC_ICE1D
+! ##############################
+
+INTERFACE
+!
+ SUBROUTINE COMPUTE_FRAC_ICE1D(HFRAC_ICE,PFRAC_ICE,PT)
+!
+CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE
+REAL, DIMENSION(:), INTENT(IN) :: PT
+REAL, DIMENSION(:), INTENT(INOUT) :: PFRAC_ICE
+!
+ END SUBROUTINE COMPUTE_FRAC_ICE1D
+END INTERFACE
+END MODULE MODI_COMPUTE_FRAC_ICE1D
+! ##########################################################
+ SUBROUTINE COMPUTE_FRAC_ICE3D(HFRAC_ICE,PFRAC_ICE,PT)
+! #################################################################
+!
+!
+!!**** *COMPUTE_FRAC_ICE* - computes ice fraction
+!!
+!! PURPOSE
+!! -------
+!!
+!!** METHOD
+!! ------
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! Julien PERGAUD * Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 13/03/06
+!! S. Riette April 2011 optimisation
+!!
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODI_COMPUTE_FRAC_ICE1D
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE ! scheme to use
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PT ! Temperature
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFRAC_ICE ! Ice fraction (1 for ice only, 0 for liquid only)
+!-------------------------------------------------------------------------
+!
+! 0.2 declaration of local variables
+!
+INTEGER :: JJ, JK
+!-------------------------------------------------------------------------
+!
+! 0.3 Initialisation
+!
+!
+!----------------------------------------------------------------------------
+!
+! 1 Compute FRAC_ICE
+! ----------------
+!
+DO JK=1, SIZE(PT,3)
+ DO JJ=1, SIZE(PT,2)
+ CALL COMPUTE_FRAC_ICE1D(HFRAC_ICE,PFRAC_ICE(:,JJ,JK),PT(:,JJ,JK))
+ ENDDO
+ENDDO
+
+
+END SUBROUTINE COMPUTE_FRAC_ICE3D
+! ##########################################################
+ SUBROUTINE COMPUTE_FRAC_ICE2D(HFRAC_ICE,PFRAC_ICE,PT)
+! ##########################################################
+!
+!
+!!**** *COMPUTE_FRAC_ICE* - computes ice fraction
+!!
+!! PURPOSE
+!! -------
+!!
+!!** METHOD
+!! ------
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! Julien PERGAUD * Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 13/03/06
+!! S. Riette April 2011 optimisation
+!!
+!! --------------------------------------------------------------------------
+! 0. DECLARATIONS
+! ------------
+!
+USE MODI_COMPUTE_FRAC_ICE1D
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE ! scheme to use
+REAL, DIMENSION(:,:), INTENT(IN) :: PT ! Temperature
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PFRAC_ICE ! Ice fraction (1 for ice only, 0 for liquid only)
+!-------------------------------------------------------------------------
+!
+! 0.2 declaration of local variables
+!
+INTEGER :: JK
+!-------------------------------------------------------------------------
+!
+! 0.3 Initialisation
+!
+!
+!----------------------------------------------------------------------------
+!
+! 1 Compute FRAC_ICE
+! ----------------
+!
+DO JK=1, SIZE(PT,2)
+ CALL COMPUTE_FRAC_ICE1D(HFRAC_ICE,PFRAC_ICE(:,JK),PT(:,JK))
+ENDDO
+
+
+END SUBROUTINE COMPUTE_FRAC_ICE2D
+! ##########################################################
+ SUBROUTINE COMPUTE_FRAC_ICE1D(HFRAC_ICE,PFRAC_ICE,PT)
+! ##########################################################
+!
+!
+!!**** *COMPUTE_FRAC_ICE* - computes ice fraction
+!!
+!! PURPOSE
+!! -------
+!!
+!!** METHOD
+!! ------
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! Julien PERGAUD * Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 13/03/06
+!! S. Riette April 2011 optimisation
+!! S. Riette 08/2016 add option O
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+!!
+!! --------------------------------------------------------------------------
+! 0. DECLARATIONS
+! ------------
+!
+USE MODD_NEB, ONLY : XTMINMIX, XTMAXMIX
+USE MODD_CST, ONLY : XTT
+USE MODE_MSG
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE ! scheme to use
+REAL, DIMENSION(:), INTENT(IN) :: PT ! temperature
+REAL, DIMENSION(:), INTENT(INOUT) :: PFRAC_ICE ! Ice fraction (1 for ice only, 0 for liquid only)
+!
+! 0.2 declaration of local variables
+!
+!
+! 0.2 initialisation
+!
+!
+!------------------------------------------------------------------------
+! 1. Compute FRAC_ICE
+!
+IF (HFRAC_ICE=='T') THEN !using Temperature
+ PFRAC_ICE(:) = ( XTMAXMIX - PT(:) ) / ( XTMAXMIX - XTMINMIX ) ! freezing interval
+ELSEIF (HFRAC_ICE=='O') THEN !using Temperature with old formulae
+ PFRAC_ICE(:) = ( XTT - PT(:) ) / 40. ! freezing interval
+ELSEIF (HFRAC_ICE=='N') THEN !No ice
+ PFRAC_ICE(:) = 0.
+ELSEIF (HFRAC_ICE=='S') THEN !Same as previous
+ !nothing to do
+ELSE
+ call Print_msg(NVERB_FATAL,'GEN','COMPUTE_FRAC_ICE','invalid option for HFRAC_ICE='//HFRAC_ICE)
+ENDIF
+
+PFRAC_ICE(:) = MAX( 0., MIN(1., PFRAC_ICE(:) ) )
+
+
+END SUBROUTINE COMPUTE_FRAC_ICE1D
diff --git a/src/mesonh/turb/compute_function_thermo_mf.f90 b/src/mesonh/turb/compute_function_thermo_mf.f90
new file mode 100644
index 000000000..ae9499c70
--- /dev/null
+++ b/src/mesonh/turb/compute_function_thermo_mf.f90
@@ -0,0 +1,238 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+! ######spl
+ MODULE MODI_COMPUTE_FUNCTION_THERMO_MF
+! ######################################
+!
+INTERFACE
+
+! #################################################################
+ SUBROUTINE COMPUTE_FUNCTION_THERMO_MF( KRR,KRRL,KRRI, &
+ PTH, PR, PEXN, PFRAC_ICE, PPABS, &
+ PT, PAMOIST,PATHETA )
+! #################################################################
+
+!* 1.1 Declaration of Arguments
+!
+
+INTEGER, INTENT(IN) :: KRR ! number of moist var.
+INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
+INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
+
+REAL, DIMENSION(:,:), INTENT(IN) :: PTH ! theta
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PR ! water species
+REAL, DIMENSION(:,:) , INTENT(IN) :: PPABS,PEXN ! pressure, Exner funct.
+REAL, DIMENSION(:,:) , INTENT(IN) :: PFRAC_ICE ! ice fraction
+
+REAL, DIMENSION(:,:), INTENT(OUT) :: PT ! temperature
+
+REAL, DIMENSION(:,:), INTENT(OUT) :: PAMOIST,PATHETA
+!
+END SUBROUTINE COMPUTE_FUNCTION_THERMO_MF
+
+END INTERFACE
+!
+END MODULE MODI_COMPUTE_FUNCTION_THERMO_MF
+! ######spl
+ SUBROUTINE COMPUTE_FUNCTION_THERMO_MF( KRR,KRRL,KRRI, &
+ PTH, PR, PEXN, PFRAC_ICE, PPABS, &
+ PT,PAMOIST,PATHETA )
+! #################################################################
+!
+!!
+!!**** *COMPUTE_FUNCTION_THERMO_MF* -
+!!
+!! PURPOSE
+!! -------
+!!
+!!** METHOD
+!! ------
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!!
+!! JP Pinty *LA*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 24/02/03
+!! Externalisation of computations done in TURB and MF_TURB (Malardel and Pergaud, fev. 2007)
+!! Optimization : V.Masson, 09/2010
+!! S. Riette Sept 2011 : remove of unused PL?OCPEXN, use of received ice fraction
+!!
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+INTEGER, INTENT(IN) :: KRR ! number of moist var.
+INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
+INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
+
+REAL, DIMENSION(:,:), INTENT(IN) :: PTH ! theta
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PR ! water species
+REAL, DIMENSION(:,:) , INTENT(IN) :: PPABS,PEXN ! pressure, Exner funct.
+REAL, DIMENSION(:,:) , INTENT(IN) :: PFRAC_ICE ! ice fraction
+
+REAL, DIMENSION(:,:), INTENT(OUT) :: PT ! temperature
+
+REAL, DIMENSION(:,:), INTENT(OUT) :: PAMOIST,PATHETA
+!
+!-------------------------------------------------------------------------------
+!
+!* 0.2 Declarations of local variables
+!
+REAL :: ZEPS ! XMV / XMD
+REAL, DIMENSION(SIZE(PTH,1),SIZE(PTH,2)) :: &
+ ZCP, & ! Cp
+ ZE, & ! Saturation mixing ratio
+ ZDEDT, & ! Saturation mixing ratio derivative
+ ZAMOIST_W, & ! Coefficients for s = f (Thetal,Rnp)
+ ZATHETA_W, & !
+ ZAMOIST_I, & !
+ ZATHETA_I, & !
+ ZLVOCP,ZLSOCP
+
+INTEGER :: JRR
+!
+!-------------------------------------------------------------------------------
+!
+!
+ ZEPS = XMV / XMD
+
+!
+!* Cph
+!
+ZCP=XCPD
+
+IF (KRR > 0) ZCP(:,:) = ZCP(:,:) + XCPV * PR(:,:,1)
+
+DO JRR = 2,1+KRRL ! loop on the liquid components
+ ZCP(:,:) = ZCP(:,:) + XCL * PR(:,:,JRR)
+END DO
+
+DO JRR = 2+KRRL,1+KRRL+KRRI ! loop on the solid components
+ ZCP(:,:) = ZCP(:,:) + XCI * PR(:,:,JRR)
+END DO
+
+!* Temperature
+!
+PT(:,:) = PTH(:,:) * PEXN(:,:)
+!
+!
+!! Liquid water
+!
+IF ( KRRL >= 1 ) THEN
+!
+!* Lv/Cph
+!
+ ZLVOCP(:,:) = (XLVTT + (XCPV-XCL) * (PT(:,:)-XTT) ) / ZCP(:,:)
+!
+!* Saturation vapor pressure with respect to water
+!
+ ZE(:,:) = EXP( XALPW - XBETAW/PT(:,:) - XGAMW*ALOG( PT(:,:) ) )
+!
+!* Saturation mixing ratio with respect to water
+!
+ ZE(:,:) = ZE(:,:) * ZEPS / ( PPABS(:,:) - ZE(:,:) )
+!
+!* Compute the saturation mixing ratio derivative (rvs')
+!
+ ZDEDT(:,:) = ( XBETAW / PT(:,:) - XGAMW ) / PT(:,:) &
+ * ZE(:,:) * ( 1. + ZE(:,:) / ZEPS )
+!
+!* Compute Amoist
+!
+ ZAMOIST_W(:,:)= 0.5 / ( 1.0 + ZDEDT(:,:) * ZLVOCP(:,:) )
+!
+!* Compute Atheta
+!
+ ZATHETA_W(:,:)= ZAMOIST_W(:,:) * PEXN(:,:) * &
+ ( ( ZE(:,:) - PR(:,:,1) ) * ZLVOCP(:,:) / &
+ ( 1. + ZDEDT(:,:) * ZLVOCP(:,:) ) * &
+ ( &
+ ZE(:,:) * (1. + ZE(:,:)/ZEPS) &
+ * ( -2.*XBETAW/PT(:,:) + XGAMW ) / PT(:,:)**2 &
+ +ZDEDT(:,:) * (1. + 2. * ZE(:,:)/ZEPS) &
+ * ( XBETAW/PT(:,:) - XGAMW ) / PT(:,:) &
+ ) &
+ - ZDEDT(:,:) &
+ )
+
+!
+!! Solid water
+!
+ IF ( KRRI >= 1 ) THEN
+
+!
+!* Ls/Cph
+!
+ ZLSOCP(:,:) = (XLSTT + (XCPV-XCI) * (PT(:,:)-XTT) ) / ZCP(:,:)
+!
+!* Saturation vapor pressure with respect to ice
+!
+ ZE(:,:) = EXP( XALPI - XBETAI/PT(:,:) - XGAMI*ALOG( PT(:,:) ) )
+!
+!* Saturation mixing ratio with respect to ice
+!
+ ZE(:,:) = ZE(:,:) * ZEPS / ( PPABS(:,:) - ZE(:,:) )
+!
+!* Compute the saturation mixing ratio derivative (rvs')
+!
+ ZDEDT(:,:) = ( XBETAI / PT(:,:) - XGAMI ) / PT(:,:) &
+ * ZE(:,:) * ( 1. + ZE(:,:) / ZEPS )
+!
+!* Compute Amoist
+!
+ ZAMOIST_I(:,:)= 0.5 / ( 1.0 + ZDEDT(:,:) * ZLSOCP(:,:) )
+!
+!* Compute Atheta
+!
+ ZATHETA_I(:,:)= ZAMOIST_I(:,:) * PEXN(:,:) * &
+ ( ( ZE(:,:) - PR(:,:,1) ) * ZLSOCP(:,:) / &
+ ( 1. + ZDEDT(:,:) * ZLSOCP(:,:) ) * &
+ ( &
+ ZE(:,:) * (1. + ZE(:,:)/ZEPS) &
+ * ( -2.*XBETAI/PT(:,:) + XGAMI ) / PT(:,:)**2 &
+ +ZDEDT(:,:) * (1. + 2. * ZE(:,:)/ZEPS) &
+ * ( XBETAI/PT(:,:) - XGAMI ) / PT(:,:) &
+ ) &
+ - ZDEDT(:,:) &
+ )
+
+ ELSE
+ ZAMOIST_I(:,:)=0.
+ ZATHETA_I(:,:)=0.
+ ENDIF
+
+ PAMOIST(:,:) = (1.0-PFRAC_ICE(:,:))*ZAMOIST_W(:,:) &
+ +PFRAC_ICE(:,:) *ZAMOIST_I(:,:)
+ PATHETA(:,:) = (1.0-PFRAC_ICE(:,:))*ZATHETA_W(:,:) &
+ +PFRAC_ICE(:,:) *ZATHETA_I(:,:)
+
+!
+ELSE
+ PAMOIST(:,:) = 0.
+ PATHETA(:,:) = 0.
+ENDIF
+END SUBROUTINE COMPUTE_FUNCTION_THERMO_MF
diff --git a/src/mesonh/turb/compute_mf_cloud.f90 b/src/mesonh/turb/compute_mf_cloud.f90
new file mode 100644
index 000000000..23f94bce5
--- /dev/null
+++ b/src/mesonh/turb/compute_mf_cloud.f90
@@ -0,0 +1,196 @@
+!MNH_LIC Copyright 2009-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ######spl
+ MODULE MODI_COMPUTE_MF_CLOUD
+! ############################
+!
+INTERFACE
+! #################################################################
+ SUBROUTINE COMPUTE_MF_CLOUD(KKA,KKB,KKE,KKU,KKL,KRR,KRRL,KRRI,HMF_CLOUD,&
+ PFRAC_ICE, &
+ PRC_UP,PRI_UP,PEMF, &
+ PTHL_UP, PRT_UP, PFRAC_UP, &
+ PTHV_UP, PFRAC_ICE_UP, PRSAT_UP, &
+ PEXNM, PTHLM, PRTM, PTHM, PTHVM, PRM, &
+ PDZZ, PZZ, KKLCL, &
+ PPABSM, PRHODREF, &
+ PRC_MF, PRI_MF, PCF_MF, PSIGMF, PDEPTH )
+! #################################################################
+!!
+!
+!* 1.1 Declaration of Arguments
+!
+INTEGER, INTENT(IN) :: KKA ! near ground array index
+INTEGER, INTENT(IN) :: KKB ! near ground physical index
+INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
+INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+INTEGER, INTENT(IN) :: KRR ! number of moist var.
+INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
+INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
+CHARACTER (LEN=4), INTENT(IN) :: HMF_CLOUD ! Type of statistical cloud scheme
+REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_ICE ! liquid/ice fraction
+REAL, DIMENSION(:,:), INTENT(IN) :: PRC_UP,PRI_UP,PEMF ! updraft characteritics
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHL_UP, PRT_UP
+REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_UP
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHV_UP ! updraft thetaV
+REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_ICE_UP ! liquid/solid fraction in updraft
+REAL, DIMENSION(:,:), INTENT(IN) :: PRSAT_UP ! Rsat in updraft
+REAL, DIMENSION(:,:), INTENT(IN) :: PEXNM ! exner function
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM, PRTM ! cons. var. at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHM, PTHVM ! theta and thetaV
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRM ! water var. at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ, PZZ
+INTEGER, DIMENSION(:), INTENT(IN) :: KKLCL ! index of updraft condensation level
+REAL, DIMENSION(:,:), INTENT(IN) :: PPABSM, PRHODREF ! environement
+REAL, DIMENSION(:,:), INTENT(OUT) :: PRC_MF, PRI_MF ! cloud content and
+REAL, DIMENSION(:,:), INTENT(OUT) :: PCF_MF ! cloud fraction for MF scheme
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSIGMF ! SQRT(variance) for statistical cloud scheme
+REAL, DIMENSION(:), INTENT(IN) :: PDEPTH ! Deepness of cloud
+
+END SUBROUTINE COMPUTE_MF_CLOUD
+
+END INTERFACE
+!
+END MODULE MODI_COMPUTE_MF_CLOUD
+! ######spl
+ SUBROUTINE COMPUTE_MF_CLOUD(KKA,KKB,KKE,KKU,KKL,KRR,KRRL,KRRI,HMF_CLOUD, &
+ PFRAC_ICE, &
+ PRC_UP,PRI_UP,PEMF, &
+ PTHL_UP, PRT_UP, PFRAC_UP, &
+ PTHV_UP, PFRAC_ICE_UP, PRSAT_UP, &
+ PEXNM, PTHLM, PRTM, PTHM, PTHVM, PRM, &
+ PDZZ, PZZ, KKLCL, &
+ PPABSM, PRHODREF, &
+ PRC_MF, PRI_MF, PCF_MF, PSIGMF, PDEPTH )
+! #################################################################
+!!
+!!**** *COMPUTE_MF_CLOUD* -
+!! compute diagnostic subgrid cumulus cloud caracteristics
+!!
+!! PURPOSE
+!! -------
+!!**** The purpose of this routine is to compute the cloud fraction and
+!! the mean cloud content associated with clouds described by the
+!! mass flux scheme
+!!
+!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original
+!! S. Riette Dec 2010 BIGA case
+!! S. Riette Aug 2011 code is split into subroutines
+!! S. Riette Jan 2012: support for both order of vertical levels
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+use mode_msg
+!
+USE MODI_COMPUTE_MF_CLOUD_BIGAUS
+USE MODI_COMPUTE_MF_CLOUD_DIRECT
+USE MODI_COMPUTE_MF_CLOUD_STAT
+!
+
+IMPLICIT NONE
+
+!* 1.1 Declaration of Arguments
+!
+!
+!
+INTEGER, INTENT(IN) :: KKA ! near ground array index
+INTEGER, INTENT(IN) :: KKB ! near ground physical index
+INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
+INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+INTEGER, INTENT(IN) :: KRR ! number of moist var.
+INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
+INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
+CHARACTER (LEN=4), INTENT(IN) :: HMF_CLOUD ! Type of statistical cloud scheme
+REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_ICE ! liquid/ice fraction
+REAL, DIMENSION(:,:), INTENT(IN) :: PRC_UP,PRI_UP,PEMF! updraft characteritics
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHL_UP, PRT_UP ! rc,w,Mass Flux,Thetal,rt
+REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_UP ! Updraft Fraction
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHV_UP ! updraft thetaV
+REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_ICE_UP ! liquid/solid fraction in updraft
+REAL, DIMENSION(:,:), INTENT(IN) :: PRSAT_UP ! Rsat in updraft
+REAL, DIMENSION(:,:), INTENT(IN) :: PEXNM ! exner function
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM, PRTM ! cons. var. at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHM, PTHVM ! theta and thetaV
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRM ! water var. at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ, PZZ
+INTEGER, DIMENSION(:), INTENT(IN) :: KKLCL ! index of updraft condensation level
+REAL, DIMENSION(:,:), INTENT(IN) :: PPABSM, PRHODREF ! environement
+REAL, DIMENSION(:,:), INTENT(OUT) :: PRC_MF, PRI_MF ! cloud content (INPUT=environment, OUTPUT=conv. cloud)
+REAL, DIMENSION(:,:), INTENT(OUT) :: PCF_MF ! and cloud fraction for MF scheme
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSIGMF ! SQRT(variance) for statistical cloud scheme
+REAL, DIMENSION(:), INTENT(IN) :: PDEPTH ! Deepness of cloud
+
+!
+! 1.2 Declaration of local variables
+!
+!------------------------------------------------------------------------
+
+! 1. INITIALISATION
+!
+!
+! 2.1 Internal domain
+
+PRC_MF = 0.
+PRI_MF = 0.
+PCF_MF = 0.
+PSIGMF = 0.
+
+IF (HMF_CLOUD == 'DIRE') THEN
+ !Direct cloud scheme
+ CALL COMPUTE_MF_CLOUD_DIRECT(KKE, KKL, &
+ &KKLCL(:), PFRAC_UP(:,:), PRC_UP(:,:), PRI_UP(:,:),&
+ &PRC_MF(:,:), PRI_MF(:,:), PCF_MF(:,:))
+ !
+ELSEIF (HMF_CLOUD == 'STAT') THEN
+ !Statistical scheme using the PDF proposed by Bougeault (81, 82) and
+ !Bechtold et al (95).
+ CALL COMPUTE_MF_CLOUD_STAT(KKA, KKB, KKE, KKU, KKL, KRR, KRRL, KRRI,&
+ &PFRAC_ICE,&
+ &PTHLM, PRTM, PPABSM, PRM,&
+ &PDZZ, PTHM, PEXNM,&
+ &PEMF, PTHL_UP, PRT_UP,&
+ &PSIGMF)
+ELSEIF (HMF_CLOUD == 'BIGA') THEN
+ !Statistical scheme using the bi-gaussian PDF proposed by E. Perraud.
+ CALL COMPUTE_MF_CLOUD_BIGAUS(KKA, KKB, KKE, KKU, KKL,&
+ &PEMF, PDEPTH,&
+ &PRT_UP, PTHV_UP, PFRAC_ICE_UP, PRSAT_UP,&
+ &PRTM, PTHM, PTHVM,&
+ &PDZZ, PZZ, PRHODREF,&
+ &PRC_MF, PRI_MF, PCF_MF)
+ !
+ELSEIF (HMF_CLOUD == 'NONE') THEN
+ ! No CONVECTIVE CLOUD SCHEME
+ ! Nothing to do: PRC_MF, PRI_MF, PCF_MF, PSIGMF are already filled with zero
+ELSE
+ call Print_msg(NVERB_FATAL,'GEN','COMPUTE_MF_CLOUD','Shallow convection cloud scheme not valid: HMF_CLOUD='//TRIM(HMF_CLOUD))
+ENDIF
+
+END SUBROUTINE COMPUTE_MF_CLOUD
diff --git a/src/mesonh/turb/compute_mf_cloud_bigaus.f90 b/src/mesonh/turb/compute_mf_cloud_bigaus.f90
new file mode 100644
index 000000000..b080f9923
--- /dev/null
+++ b/src/mesonh/turb/compute_mf_cloud_bigaus.f90
@@ -0,0 +1,209 @@
+!MNH_LIC Copyright 2011-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ######spl
+ MODULE MODI_COMPUTE_MF_CLOUD_BIGAUS
+! ###################################
+!
+INTERFACE
+! #################################################################
+ SUBROUTINE COMPUTE_MF_CLOUD_BIGAUS(KKA, KKB, KKE, KKU, KKL,&
+ PEMF, PDEPTH,&
+ PRT_UP, PTHV_UP, PFRAC_ICE_UP, PRSAT_UP,&
+ PRTM, PTHM, PTHVM,&
+ PDZZ, PZZ, PRHODREF,&
+ PRC_MF, PRI_MF, PCF_MF)
+! #################################################################
+!!
+!
+!* 1.1 Declaration of Arguments
+!
+INTEGER, INTENT(IN) :: KKA ! near ground array index
+INTEGER, INTENT(IN) :: KKB ! near ground physical index
+INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
+INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:), INTENT(IN) :: PEMF ! updraft characteritics
+REAL, DIMENSION(:), INTENT(IN) :: PDEPTH ! Deepness of cloud
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHV_UP, PRSAT_UP, PRT_UP ! updraft characteritics
+REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_ICE_UP ! liquid/ice fraction in updraft
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHM, PRTM, PTHVM ! env. var. at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ, PZZ
+REAL, DIMENSION(:,:), INTENT(IN) :: PRHODREF
+REAL, DIMENSION(:,:), INTENT(OUT) :: PRC_MF, PRI_MF ! cloud content
+REAL, DIMENSION(:,:), INTENT(OUT) :: PCF_MF ! and cloud fraction for MF scheme
+
+END SUBROUTINE COMPUTE_MF_CLOUD_BIGAUS
+
+END INTERFACE
+!
+END MODULE MODI_COMPUTE_MF_CLOUD_BIGAUS
+! ######spl
+ SUBROUTINE COMPUTE_MF_CLOUD_BIGAUS(KKA, KKB, KKE, KKU, KKL,&
+ PEMF, PDEPTH,&
+ PRT_UP, PTHV_UP, PFRAC_ICE_UP, PRSAT_UP,&
+ PRTM, PTHM, PTHVM,&
+ PDZZ, PZZ, PRHODREF,&
+ PRC_MF, PRI_MF, PCF_MF)
+! #################################################################
+!!
+!!**** *COMPUTE_MF_CLOUD_BIGAUS* -
+!! compute diagnostic subgrid cumulus cloud caracteristics with a statistical scheme
+!! based on a bi-gaussian PDF. In this routine, we only compute the shallow convection
+!! part of this bi-gaussian
+!!
+!! PURPOSE
+!! -------
+!!**** With this option, a formulation for the computation of the variance of the departure
+!! to saturation is proposed. This variance is used to compute the cloud fraction and
+!! the mean convective cloud content from the bi-gaussian PDF proposed by E. Perraud
+!!
+!
+!!** METHOD
+!! ------
+!! Updraft variables are used to diagnose the variance
+!! Perraud et al (2011)
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! S. Riette moving of code previously in compute_mf_cloud code
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 25 Aug 2011
+!! S. Riette Jan 2012: support for both order of vertical levels
+!! S. Riette Jun 2019: remove unused PRC_UP and PRI_UP, use SIGN in ERFC computation
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+USE MODD_PARAM_MFSHALL_n, ONLY : XALPHA_MF, XSIGMA_MF
+USE MODD_CST, ONLY : XPI, XG
+!
+USE MODI_SHUMAN_MF
+USE MODI_GAMMA_INC
+!
+USE MODE_THERMO
+!
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of Arguments
+!
+INTEGER, INTENT(IN) :: KKA ! near ground array index
+INTEGER, INTENT(IN) :: KKB ! near ground physical index
+INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
+INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:), INTENT(IN) :: PEMF ! updraft characteritics
+REAL, DIMENSION(:), INTENT(IN) :: PDEPTH ! Deepness of cloud
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHV_UP, PRSAT_UP, PRT_UP ! updraft characteritics
+REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_ICE_UP ! liquid/ice fraction in updraft
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHM, PRTM, PTHVM ! env. var. at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ, PZZ
+REAL, DIMENSION(:,:), INTENT(IN) :: PRHODREF
+REAL, DIMENSION(:,:), INTENT(OUT) :: PRC_MF, PRI_MF ! cloud content
+REAL, DIMENSION(:,:), INTENT(OUT) :: PCF_MF ! and cloud fraction for MF scheme
+!
+!* 0.1 Declaration of local variables
+!
+!
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZGRAD_Z_RT, & !
+ & ZALPHA_UP_M, & ! Variables used to compute variance
+ & ZSIGMF ! and sqrt(variance)
+REAL, DIMENSION(SIZE(PTHM,1)) :: ZOMEGA_UP_M !
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZW1 ! working array
+INTEGER :: JK ! vertical loop control
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZEMF_M, ZTHV_UP_M, & !
+ & ZRSAT_UP_M, ZRT_UP_M,& ! Interpolation on mass points
+ & ZFRAC_ICE_UP_M !
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZCOND ! condensate
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZA, ZGAM ! used for integration
+
+
+!Computation is done on mass points
+!----------------------------------------------------------------------------
+!
+!* 1. Computation of the variance
+! ------------------------------------------------
+!
+!
+!Vertical gradient of RT, result on mass points
+ZW1(:,:)=GZ_M_W_MF(KKA,KKU,KKL, PRTM(:,:), PDZZ(:,:))
+ZGRAD_Z_RT(:,:)=MZF_MF(KKA,KKU,KKL, ZW1(:,:))
+
+!Interpolation on mass points
+ZTHV_UP_M(:,:) = MZF_MF(KKA,KKU,KKL, PTHV_UP(:,:))
+ZRSAT_UP_M(:,:)= MZF_MF(KKA,KKU,KKL, PRSAT_UP(:,:))
+ZRT_UP_M(:,:) = MZF_MF(KKA,KKU,KKL, PRT_UP(:,:))
+ZEMF_M(:,:) = MZF_MF(KKA,KKU,KKL, PEMF(:,:))
+ZFRAC_ICE_UP_M(:,:) = MZF_MF(KKA,KKU,KKL, PFRAC_ICE_UP(:,:))
+
+!computation of omega star up
+ZOMEGA_UP_M(:)=0.
+DO JK=KKB,KKE,KKL
+ !Vertical integration over the entire column but only buoyant points are used
+ !ZOMEGA_UP_M(:)=ZOMEGA_UP_M(:) + &
+ ! ZEMF_M(:,JK) * &
+ ! MAX(0.,(ZTHV_UP_M(:,JK)-PTHVM(:,JK))) * &
+ ! (PZZ(:,JK+KKL)-PZZ(:,JK)) / &
+ ! (PTHM(:,JK) * PRHODREF(:,JK))
+
+ !Vertical integration over the entire column
+ ZOMEGA_UP_M(:)=ZOMEGA_UP_M(:) + &
+ ZEMF_M(:,JK) * &
+ (ZTHV_UP_M(:,JK)-PTHVM(:,JK)) * &
+ (PZZ(:,JK+KKL)-PZZ(:,JK)) / &
+ (PTHM(:,JK) * PRHODREF(:,JK))
+ENDDO
+ZOMEGA_UP_M(:)=MAX(ZOMEGA_UP_M(:), 1.E-20)
+ZOMEGA_UP_M(:)=(XG*ZOMEGA_UP_M(:))**(1./3.)
+
+!computation of alpha up
+DO JK=KKA,KKU,KKL
+ ZALPHA_UP_M(:,JK)=ZEMF_M(:,JK)/(XALPHA_MF*PRHODREF(:,JK)*ZOMEGA_UP_M(:))
+ENDDO
+ZALPHA_UP_M(:,:)=MAX(0., MIN(ZALPHA_UP_M(:,:), 1.))
+
+!computation of sigma of the distribution
+DO JK=KKA,KKU,KKL
+ ZSIGMF(:,JK)=ZEMF_M(:,JK) * &
+ (ZRT_UP_M(:,JK) - PRTM(:,JK)) * &
+ PDEPTH(:) * ZGRAD_Z_RT(:,JK) / &
+ (XSIGMA_MF * ZOMEGA_UP_M(:) * PRHODREF(:,JK))
+ENDDO
+ZSIGMF(:,:)=SQRT(MAX(ABS(ZSIGMF(:,:)), 1.E-40))
+!
+!* 2. PDF integration
+! ------------------------------------------------
+!
+!The mean of the distribution is ZRT_UP
+!Computation of ZA and ZGAM (=efrc(ZA)) coefficient
+ZA(:,:)=(ZRSAT_UP_M(:,:)-ZRT_UP_M(:,:))/(sqrt(2.)*ZSIGMF(:,:))
+
+!Approximation of erf function
+ZGAM(:,:)=1-SIGN(1., ZA(:,:))*SQRT(1-EXP(-4*ZA(:,:)**2/XPI))
+
+!computation of cloud fraction
+PCF_MF(:,:)=MAX( 0., MIN(1.,0.5*ZGAM(:,:) * ZALPHA_UP_M(:,:)))
+
+!computation of condensate, then PRC and PRI
+ZCOND(:,:)=(EXP(-ZA(:,:)**2)-ZA(:,:)*SQRT(XPI)*ZGAM(:,:))*ZSIGMF(:,:)/SQRT(2.*XPI) * ZALPHA_UP_M(:,:)
+ZCOND(:,:)=MAX(ZCOND(:,:), 0.) !due to approximation of ZGAM value, ZCOND could be slightly negative
+PRC_MF(:,:)=(1.-ZFRAC_ICE_UP_M(:,:)) * ZCOND(:,:)
+PRI_MF(:,:)=( ZFRAC_ICE_UP_M(:,:)) * ZCOND(:,:)
+
+
+END SUBROUTINE COMPUTE_MF_CLOUD_BIGAUS
diff --git a/src/mesonh/turb/compute_mf_cloud_direct.f90 b/src/mesonh/turb/compute_mf_cloud_direct.f90
new file mode 100644
index 000000000..c1c1b6220
--- /dev/null
+++ b/src/mesonh/turb/compute_mf_cloud_direct.f90
@@ -0,0 +1,119 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+! ######spl
+ MODULE MODI_COMPUTE_MF_CLOUD_DIRECT
+! ###################################
+!
+INTERFACE
+! #################################################################
+ SUBROUTINE COMPUTE_MF_CLOUD_DIRECT(KKE, KKL, &
+ &KKLCL, PFRAC_UP, PRC_UP, PRI_UP,&
+ &PRC_MF, PRI_MF, PCF_MF)
+! #################################################################
+!!
+!
+!* 1.1 Declaration of Arguments
+!
+INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
+INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+INTEGER, DIMENSION(:), INTENT(IN) :: KKLCL ! index of updraft condensation level
+REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_UP ! Updraft Fraction
+REAL, DIMENSION(:,:), INTENT(IN) :: PRC_UP,PRI_UP ! updraft characteritics
+REAL, DIMENSION(:,:), INTENT(OUT) :: PRC_MF, PRI_MF ! cloud content (INPUT=environment, OUTPUT=conv. cloud)
+REAL, DIMENSION(:,:), INTENT(OUT) :: PCF_MF ! and cloud fraction for MF scheme
+
+END SUBROUTINE COMPUTE_MF_CLOUD_DIRECT
+
+END INTERFACE
+!
+END MODULE MODI_COMPUTE_MF_CLOUD_DIRECT
+! ######spl
+ SUBROUTINE COMPUTE_MF_CLOUD_DIRECT(KKE, KKL, &
+ &KKLCL, PFRAC_UP, PRC_UP, PRI_UP,&
+ &PRC_MF, PRI_MF, PCF_MF)
+! #################################################################
+!!
+!!**** *COMPUTE_MF_CLOUD_DIRECT* -
+!! compute diagnostic subgrid cumulus cloud caracteristics with a direct scheme
+!!
+!! PURPOSE
+!! -------
+!!**** The purpose of this routine is to compute the cloud fraction and
+!! the mean cloud content associated with clouds described by the
+!! mass flux scheme
+!!
+!
+!!** METHOD
+!! ------
+!! Updraft variables are used directly to diagnose subgrid clouds
+!! This scheme may be activated only if the selected updraft model
+!! gives the updraft fraction as an output
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! S. Riette moving of code previously in compute_mf_cloud code
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 25 Aug 2011
+!! S. Riette Jan 2012: support for both order of vertical levels
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+USE MODD_PARAM_MFSHALL_n, ONLY : XKCF_MF
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of Arguments
+!
+INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
+INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+INTEGER, DIMENSION(:), INTENT(IN) :: KKLCL ! index of updraft condensation level
+REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_UP ! Updraft Fraction
+REAL, DIMENSION(:,:), INTENT(IN) :: PRC_UP,PRI_UP ! updraft characteritics
+REAL, DIMENSION(:,:), INTENT(OUT) :: PRC_MF, PRI_MF ! cloud content
+REAL, DIMENSION(:,:), INTENT(OUT) :: PCF_MF ! and cloud fraction for MF scheme
+!
+!* 0.1 Declaration of local variables
+!
+INTEGER :: JI,JK
+!
+!* 0.2 Initialisation
+!
+!
+!* 1. COMPUTATION OF SUBGRID CLOUD
+! ----------------------------
+
+!
+! Warning: updraft variables are on flux levels
+! and PRC_MF, PRI_MF and PCF_MF are on mass levels
+PRC_MF(:,:)=0.
+PRI_MF(:,:)=0.
+PCF_MF(:,:)=0.
+
+DO JI=1,SIZE(PCF_MF,1)
+ DO JK=KKLCL(JI),KKE-KKL,KKL
+ PCF_MF(JI,JK ) = MAX( 0., MIN(1.,XKCF_MF *0.5* ( &
+ & PFRAC_UP(JI,JK) + PFRAC_UP(JI,JK+KKL) ) ))
+ PRC_MF(JI,JK) = 0.5* XKCF_MF * ( PFRAC_UP(JI,JK)*PRC_UP(JI,JK) &
+ + PFRAC_UP(JI,JK+KKL)*PRC_UP(JI,JK+KKL) )
+ PRI_MF(JI,JK) = 0.5* XKCF_MF * ( PFRAC_UP(JI,JK)*PRI_UP(JI,JK) &
+ + PFRAC_UP(JI,JK+KKL)*PRI_UP(JI,JK+KKL) )
+ END DO
+END DO
+
+
+END SUBROUTINE COMPUTE_MF_CLOUD_DIRECT
diff --git a/src/mesonh/turb/compute_mf_cloud_stat.f90 b/src/mesonh/turb/compute_mf_cloud_stat.f90
new file mode 100644
index 000000000..c3c78d467
--- /dev/null
+++ b/src/mesonh/turb/compute_mf_cloud_stat.f90
@@ -0,0 +1,181 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+! ######spl
+ MODULE MODI_COMPUTE_MF_CLOUD_STAT
+! ############################
+!
+INTERFACE
+! #################################################################
+ SUBROUTINE COMPUTE_MF_CLOUD_STAT(KKA, KKB, KKE, KKU, KKL, KRR, KRRL, KRRI,&
+ &PFRAC_ICE,&
+ &PTHLM, PRTM, PPABSM, PRM,&
+ &PDZZ, PTHM, PEXNM,&
+ &PEMF, PTHL_UP, PRT_UP,&
+ &PSIGMF)
+! #################################################################
+!!
+!
+!* 1.1 Declaration of Arguments
+!
+INTEGER, INTENT(IN) :: KKA ! near ground array index
+INTEGER, INTENT(IN) :: KKB ! near ground physical index
+INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
+INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+INTEGER, INTENT(IN) :: KRR ! number of moist var.
+INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
+INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
+REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_ICE ! liquid/ice fraction
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM, PRTM ! cons. var. at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PPABSM ! Pressure at time t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRM ! water var. at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHM ! environement
+REAL, DIMENSION(:,:), INTENT(IN) :: PEXNM
+REAL, DIMENSION(:,:), INTENT(IN) :: PEMF ! updraft characteritics
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHL_UP, PRT_UP ! rc,w,Mass Flux,Thetal,rt
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSIGMF ! SQRT(variance) for statistical cloud scheme
+
+
+END SUBROUTINE COMPUTE_MF_CLOUD_STAT
+
+END INTERFACE
+!
+END MODULE MODI_COMPUTE_MF_CLOUD_STAT
+! ######spl
+ SUBROUTINE COMPUTE_MF_CLOUD_STAT(KKA, KKB, KKE, KKU, KKL, KRR, KRRL, KRRI,&
+ &PFRAC_ICE,&
+ &PTHLM, PRTM, PPABSM, PRM,&
+ &PDZZ, PTHM, PEXNM, &
+ &PEMF, PTHL_UP, PRT_UP,&
+ &PSIGMF)
+! #################################################################
+!!
+!!**** *COMPUTE_MF_CLOUD_STAT* -
+!! compute diagnostic subgrid cumulus cloud caracteristics with a statistical scheme
+!!
+!! PURPOSE
+!! -------
+!!**** With this option, a formulation for the computation of the variance of the departure
+!! to saturation is proposed.
+!!
+!
+!!** METHOD
+!! ------
+!! Updraft variables are used to diagnose the variance
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! S. Riette moving of code previously in compute_mf_cloud code
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 25 Aug 2011
+!! S. Riette Jan 2012: support for both order of vertical levels
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+USE MODD_PARAM_MFSHALL_n, ONLY : XTAUSIGMF
+USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
+!
+USE MODI_SHUMAN_MF
+USE MODI_COMPUTE_FUNCTION_THERMO_MF
+!
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of Arguments
+!
+INTEGER, INTENT(IN) :: KKA ! near ground array index
+INTEGER, INTENT(IN) :: KKB ! near ground physical index
+INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
+INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+INTEGER, INTENT(IN) :: KRR ! number of moist var.
+INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
+INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
+REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_ICE ! liquid/ice fraction
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM, PRTM ! cons. var. at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PPABSM ! Pressure at time t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRM ! water var. at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHM ! environement
+REAL, DIMENSION(:,:), INTENT(IN) :: PEXNM
+REAL, DIMENSION(:,:), INTENT(IN) :: PEMF ! updraft characteritics
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHL_UP, PRT_UP ! rc,w,Mass Flux,Thetal,rt
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSIGMF ! SQRT(variance) for statistical cloud scheme
+!
+!* 0.1 Declaration of local variables
+!
+!
+REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2)) :: ZFLXZ
+REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2)) :: ZT
+REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2)) :: ZAMOIST, ZATHETA
+!
+!* 0.2 initialisation
+!
+!
+!----------------------------------------------------------------------------
+!
+!* 1. COMPUTE SIGMA_MF (saturation deviation variance)
+! Soares et al (2004) formulation
+! ------------------------------------------------
+!
+! Thermodynamics functions
+CALL COMPUTE_FUNCTION_THERMO_MF( KRR,KRRL,KRRI, &
+ PTHM,PRM,PEXNM,PFRAC_ICE,PPABSM, &
+ ZT,ZAMOIST,ZATHETA )
+!
+IF (KRRL > 0) THEN
+!
+!* 1.1 contribution from <THl THl>
+!
+
+!
+ ZFLXZ(:,:) = -2 * XTAUSIGMF * PEMF(:,:)*(PTHL_UP(:,:)-MZM_MF(KKA,KKU,KKL,PTHLM(:,:))) * &
+ GZ_M_W_MF(KKA,KKU,KKL,PTHLM(:,:),PDZZ(:,:))
+!
+! Avoid negative values
+ ZFLXZ(:,:) = MAX(0.,ZFLXZ(:,:))
+
+
+ PSIGMF(:,:) = MZF_MF(KKA,KKU,KKL,ZFLXZ(:,:)) * ZATHETA(:,:)**2
+
+!
+!
+!* 1.2 contribution from <Rnp Rnp>
+!
+!
+!
+!
+ ZFLXZ(:,:) = -2 * XTAUSIGMF * PEMF(:,:)*(PRT_UP(:,:)-MZM_MF(KKA,KKU,KKL,PRTM(:,:))) * &
+ GZ_M_W_MF(KKA,KKU,KKL,PRTM(:,:),PDZZ(:,:))
+!
+! Avoid negative values
+ ZFLXZ(:,:) = MAX(0.,ZFLXZ(:,:))
+!
+
+ PSIGMF(:,:) = PSIGMF(:,:) + ZAMOIST(:,:) **2 * MZF_MF(KKA,KKU,KKL,ZFLXZ(:,:))
+!
+! 1.3 Vertical part of Sigma_s
+!
+ PSIGMF(:,:) = SQRT( MAX (PSIGMF(:,:) , 0.) )
+ELSE
+ PSIGMF(:,:) = 0.
+END IF
+!
+!
+END SUBROUTINE COMPUTE_MF_CLOUD_STAT
diff --git a/src/mesonh/turb/compute_updraft.f90 b/src/mesonh/turb/compute_updraft.f90
new file mode 100644
index 000000000..69985ecdb
--- /dev/null
+++ b/src/mesonh/turb/compute_updraft.f90
@@ -0,0 +1,647 @@
+!MNH_LIC Copyright 2004-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ######spl
+ MODULE MODI_COMPUTE_UPDRAFT
+! ###########################
+!
+INTERFACE
+!
+! #################################################################
+ SUBROUTINE COMPUTE_UPDRAFT(KKA,KKB,KKE,KKU,KKL, HFRAC_ICE, &
+ OENTR_DETR,OMIXUV, &
+ ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
+ PZZ,PDZZ, &
+ PSFTH,PSFRV, &
+ PPABSM,PRHODREF,PUM,PVM,PTKEM, &
+ PTHM,PRVM,PTHLM,PRTM, &
+ PSVM,PTHL_UP,PRT_UP, &
+ PRV_UP,PRC_UP,PRI_UP,PTHV_UP, &
+ PW_UP,PU_UP, PV_UP, PSV_UP, &
+ PFRAC_UP,PFRAC_ICE_UP,PRSAT_UP, &
+ PEMF,PDETR,PENTR, &
+ PBUO_INTEG,KKLCL,KKETL,KKCTL, &
+ PDEPTH)
+! #################################################################
+!
+!* 1.1 Declaration of Arguments
+!
+!
+!
+INTEGER, INTENT(IN) :: KKA ! near ground array index
+INTEGER, INTENT(IN) :: KKB ! near ground physical index
+INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
+INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme
+LOGICAL, INTENT(IN) :: OENTR_DETR! flag to recompute entrainment, detrainment and mass flux
+LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum
+LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer
+INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer
+INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer
+REAL, DIMENSION(:,:), INTENT(IN) :: PZZ ! Height at the flux point
+REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! Metrics coefficient
+
+REAL, DIMENSION(:), INTENT(IN) :: PSFTH,PSFRV
+! normal surface fluxes of theta,rv,(u,v) parallel to the orography
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PPABSM ! Pressure at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PRHODREF ! dry density of the
+ ! reference state
+REAL, DIMENSION(:,:), INTENT(IN) :: PUM ! u mean wind
+REAL, DIMENSION(:,:), INTENT(IN) :: PVM ! v mean wind
+REAL, DIMENSION(:,:), INTENT(IN) :: PTKEM ! TKE at t-dt
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHM ! liquid pot. temp. at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PRVM ! vapor mixing ratio at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM,PRTM ! cons. var. at t-dt
+
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-dt
+
+REAL, DIMENSION(:,:), INTENT(OUT) :: PTHL_UP,PRT_UP ! updraft properties
+REAL, DIMENSION(:,:), INTENT(OUT) :: PU_UP, PV_UP ! updraft wind components
+REAL, DIMENSION(:,:), INTENT(INOUT):: PRV_UP,PRC_UP, & ! updraft rv, rc
+ PRI_UP,PTHV_UP,& ! updraft ri, THv
+ PW_UP,PFRAC_UP,& ! updraft w, fraction
+ PFRAC_ICE_UP,& ! liquid/solid fraction in updraft
+ PRSAT_UP ! Rsat
+
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSV_UP ! updraft scalar var.
+
+REAL, DIMENSION(:,:), INTENT(INOUT):: PEMF,PDETR,PENTR ! Mass_flux,
+ ! entrainment, detrainment
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PBUO_INTEG ! Integrated Buoyancy
+INTEGER, DIMENSION(:), INTENT(INOUT):: KKLCL,KKETL,KKCTL! LCL, ETL, CTL
+REAL, DIMENSION(:), INTENT(OUT) :: PDEPTH ! Deepness of cloud
+
+
+END SUBROUTINE COMPUTE_UPDRAFT
+
+END INTERFACE
+!
+END MODULE MODI_COMPUTE_UPDRAFT
+! ######spl
+ SUBROUTINE COMPUTE_UPDRAFT(KKA,KKB,KKE,KKU,KKL,HFRAC_ICE, &
+ OENTR_DETR,OMIXUV, &
+ ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
+ PZZ,PDZZ, &
+ PSFTH,PSFRV, &
+ PPABSM,PRHODREF,PUM,PVM, PTKEM, &
+ PTHM,PRVM,PTHLM,PRTM, &
+ PSVM,PTHL_UP,PRT_UP, &
+ PRV_UP,PRC_UP,PRI_UP,PTHV_UP, &
+ PW_UP,PU_UP, PV_UP, PSV_UP, &
+ PFRAC_UP,PFRAC_ICE_UP,PRSAT_UP, &
+ PEMF,PDETR,PENTR, &
+ PBUO_INTEG,KKLCL,KKETL,KKCTL, &
+ PDEPTH )
+
+! #################################################################
+!!
+!!**** *COMPUTE_UPDRAFT* - calculates caracteristics of the updraft
+!!
+!!
+!! PURPOSE
+!! -------
+!!**** The purpose of this routine is to build the updraft model
+!!
+!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! !! REFERENCE
+!! ---------
+!! Book 1 of Meso-NH documentation (chapter Turbulence)
+!! Soares et al. 2004 QJ
+!!
+!! AUTHOR
+!! ------
+!! J.Pergaud
+!! V.Masson : Optimization 07/2010
+!! S. Riette : 07/2010 : modification for reproducibility
+!! S. Riette may 2011: ice added, interface modified
+!! S. Riette Jan 2012: support for both order of vertical levels
+!! V.Masson, C.Lac : 02/2011 : SV_UP initialized by a non-zero value
+!! S. Riette Apr 2013: improvement of continuity at the condensation level
+!! R.Honnert Oct 2016 : Add ZSURF and Update with AROME
+!! Q.Rodier 01/2019 : support RM17 mixing length
+!! R.Honnert 01/2019 : add LGZ (reduction of the mass-flux surface closure with the resolution)
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_PARAM_MFSHALL_n
+USE MODD_TURB_n, ONLY : CTURBLEN
+
+USE MODI_COMPUTE_ENTR_DETR
+USE MODI_TH_R_FROM_THL_RT_1D
+USE MODI_SHUMAN_MF
+
+USE MODI_COMPUTE_BL89_ML
+USE MODD_GRID_n, ONLY : XDXHAT, XDYHAT
+
+
+IMPLICIT NONE
+
+!* 1.1 Declaration of Arguments
+!
+!
+!
+INTEGER, INTENT(IN) :: KKA ! near ground array index
+INTEGER, INTENT(IN) :: KKB ! near ground physical index
+INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
+INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme
+LOGICAL, INTENT(IN) :: OENTR_DETR! flag to recompute entrainment, detrainment and mass flux
+LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum
+LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer
+INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer
+INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer
+REAL, DIMENSION(:,:), INTENT(IN) :: PZZ ! Height at the flux point
+REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! Metrics coefficient
+
+REAL, DIMENSION(:), INTENT(IN) :: PSFTH,PSFRV
+! normal surface fluxes of theta,rv,(u,v) parallel to the orography
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PPABSM ! Pressure at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PRHODREF ! dry density of the
+ ! reference state
+REAL, DIMENSION(:,:), INTENT(IN) :: PUM ! u mean wind
+REAL, DIMENSION(:,:), INTENT(IN) :: PVM ! v mean wind
+REAL, DIMENSION(:,:), INTENT(IN) :: PTKEM ! TKE at t-dt
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHM ! liquid pot. temp. at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PRVM ! vapor mixing ratio at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM,PRTM ! cons. var. at t-dt
+
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-dt
+
+REAL, DIMENSION(:,:), INTENT(OUT) :: PTHL_UP,PRT_UP ! updraft properties
+REAL, DIMENSION(:,:), INTENT(OUT) :: PU_UP, PV_UP ! updraft wind components
+REAL, DIMENSION(:,:), INTENT(INOUT):: PRV_UP,PRC_UP, & ! updraft rv, rc
+ PRI_UP,PTHV_UP,& ! updraft ri, THv
+ PW_UP,PFRAC_UP,& ! updraft w, fraction
+ PFRAC_ICE_UP,& ! liquid/solid fraction in updraft
+ PRSAT_UP ! Rsat
+
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSV_UP ! updraft scalar var.
+
+REAL, DIMENSION(:,:), INTENT(INOUT):: PEMF,PDETR,PENTR ! Mass_flux,
+ ! detrainment,entrainment
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PBUO_INTEG ! Integrated Buoyancy
+INTEGER, DIMENSION(:), INTENT(INOUT) :: KKLCL,KKETL,KKCTL! LCL, ETL, CTL
+REAL, DIMENSION(:), INTENT(OUT) :: PDEPTH ! Deepness of cloud
+! 1.2 Declaration of local variables
+!
+!
+! Mean environment variables at t-dt at flux point
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: &
+ ZTHM_F,ZRVM_F ! Theta,rv of
+ ! updraft environnement
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: &
+ ZRTM_F, ZTHLM_F, ZTKEM_F,& ! rt, thetal,TKE,pressure,
+ ZUM_F,ZVM_F,ZRHO_F, & ! density,momentum
+ ZPRES_F,ZTHVM_F,ZTHVM, & ! interpolated at the flux point
+ ZG_O_THVREF, & ! g*ThetaV ref
+ ZW_UP2, & ! w**2 of the updraft
+ ZBUO_INTEG_DRY, ZBUO_INTEG_CLD,&! Integrated Buoyancy
+ ZENTR_CLD,ZDETR_CLD ! wet entrainment and detrainment
+
+REAL, DIMENSION(SIZE(PSVM,1),SIZE(PTHM,2),SIZE(PSVM,3)) :: &
+ ZSVM_F ! scalar variables
+
+
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: &
+ ZTH_UP, & ! updraft THETA
+ ZRC_MIX, ZRI_MIX ! guess of Rc and Ri for KF mixture
+
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZCOEF ! diminution coefficient for too high clouds
+
+REAL, DIMENSION(SIZE(PSFTH,1) ) :: ZWTHVSURF ! Surface w'thetav'
+
+REAL :: ZRDORV ! RD/RV
+REAL :: ZRVORD ! RV/RD
+
+
+REAL, DIMENSION(SIZE(PTHM,1)) :: ZMIX1,ZMIX2,ZMIX3_CLD,ZMIX2_CLD
+
+REAL, DIMENSION(SIZE(PTHM,1)) :: ZLUP ! Upward Mixing length from the ground
+
+INTEGER :: ISV ! Number of scalar variables
+INTEGER :: JK,JI,JSV ! loop counters
+
+LOGICAL, DIMENSION(SIZE(PTHM,1)) :: GTEST,GTESTLCL,GTESTETL
+ ! Test if the ascent continue, if LCL or ETL is reached
+LOGICAL :: GLMIX
+ ! To choose upward or downward mixing length
+LOGICAL, DIMENSION(SIZE(PTHM,1)) :: GWORK1
+LOGICAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: GWORK2
+
+INTEGER :: ITEST,JLOOP
+
+REAL, DIMENSION(SIZE(PTHM,1)) :: ZRC_UP, ZRI_UP, ZRV_UP, ZRSATW, ZRSATI,&
+ ZPART_DRY
+
+REAL :: ZDEPTH_MAX1, ZDEPTH_MAX2 ! control auto-extinction process
+
+REAL :: ZTMAX,ZRMAX ! control value
+
+REAL, DIMENSION(SIZE(PTHM,1)) :: ZSURF
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZSHEAR,ZDUDZ,ZDVDZ ! vertical wind shear
+! Thresholds for the perturbation of
+! theta_l and r_t at the first level of the updraft
+ZTMAX=2.0
+ZRMAX=1.E-3
+!------------------------------------------------------------------------
+
+! INITIALISATION
+
+! Initialisation of the constants
+ZRDORV = XRD / XRV !=0.622
+ZRVORD = (XRV / XRD)
+
+ZDEPTH_MAX1=3000. ! clouds with depth inferior to this value are keeped untouched
+ZDEPTH_MAX2=4000. ! clouds with depth superior to this value are suppressed
+
+! Local variables, internal domain
+!number of scalar variables
+ISV=SIZE(PSVM,3)
+
+IF (OENTR_DETR) THEN
+ ! Initialisation of intersesting Level :LCL,ETL,CTL
+ KKLCL(:)=KKE
+ KKETL(:)=KKE
+ KKCTL(:)=KKE
+
+ !
+ ! Initialisation
+ !* udraft governing variables
+ PEMF(:,:)=0.
+ PDETR(:,:)=0.
+ PENTR(:,:)=0.
+
+ ! Initialisation
+ !* updraft core variables
+ PRV_UP(:,:)=0.
+ PRC_UP(:,:)=0.
+ PRI_UP(:,:)=0.
+ PW_UP(:,:)=0.
+ ZTH_UP(:,:)=0.
+ PFRAC_UP(:,:)=0.
+ PTHV_UP(:,:)=0.
+
+ PBUO_INTEG=0.
+
+ PFRAC_ICE_UP(:,:)=0.
+ PRSAT_UP(:,:)=PRVM(:,:) ! should be initialised correctly but is (normaly) not used
+
+ !cloud/dry air mixture cloud content
+ ZRC_MIX = 0.
+ ZRI_MIX = 0.
+
+END IF
+
+! Initialisation of environment variables at t-dt
+! variables at flux level
+ZTHLM_F(:,:) = MZM_MF(KKA,KKU,KKL,PTHLM(:,:))
+ZRTM_F (:,:) = MZM_MF(KKA,KKU,KKL,PRTM(:,:))
+ZUM_F (:,:) = MZM_MF(KKA,KKU,KKL,PUM(:,:))
+ZVM_F (:,:) = MZM_MF(KKA,KKU,KKL,PVM(:,:))
+ZTKEM_F(:,:) = MZM_MF(KKA,KKU,KKL,PTKEM(:,:))
+
+DO JSV=1,ISV
+ IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE
+ ZSVM_F(:,:,JSV) = MZM_MF(KKA,KKU,KKL,PSVM(:,:,JSV))
+END DO
+!
+! Initialisation of updraft characteristics
+PTHL_UP(:,:)=ZTHLM_F(:,:)
+PRT_UP(:,:)=ZRTM_F(:,:)
+PU_UP(:,:)=ZUM_F(:,:)
+PV_UP(:,:)=ZVM_F(:,:)
+PSV_UP(:,:,:)=ZSVM_F(:,:,:)
+
+
+! Computation or initialisation of updraft characteristics at the KKB level
+! thetal_up,rt_up,thetaV_up, w2,Buoyancy term and mass flux (PEMF)
+
+PTHL_UP(:,KKB)= ZTHLM_F(:,KKB)+MAX(0.,MIN(ZTMAX,(PSFTH(:)/SQRT(ZTKEM_F(:,KKB)))*XALP_PERT))
+PRT_UP(:,KKB) = ZRTM_F(:,KKB)+MAX(0.,MIN(ZRMAX,(PSFRV(:)/SQRT(ZTKEM_F(:,KKB)))*XALP_PERT))
+
+
+IF (OENTR_DETR) THEN
+ ZTHM_F (:,:) = MZM_MF(KKA,KKU,KKL,PTHM (:,:))
+ ZPRES_F(:,:) = MZM_MF(KKA,KKU,KKL,PPABSM(:,:))
+ ZRHO_F (:,:) = MZM_MF(KKA,KKU,KKL,PRHODREF(:,:))
+ ZRVM_F (:,:) = MZM_MF(KKA,KKU,KKL,PRVM(:,:))
+
+ ! thetav at mass and flux levels
+ ZTHVM_F(:,:)=ZTHM_F(:,:)*((1.+ZRVORD*ZRVM_F(:,:))/(1.+ZRTM_F(:,:)))
+ ZTHVM(:,:)=PTHM(:,:)*((1.+ZRVORD*PRVM(:,:))/(1.+PRTM(:,:)))
+
+ PTHV_UP(:,:)=ZTHVM_F(:,:)
+
+ ZW_UP2(:,:)=0.
+ ZW_UP2(:,KKB) = MAX(0.0001,(2./3.)*ZTKEM_F(:,KKB))
+
+
+ ! Computation of non conservative variable for the KKB level of the updraft
+ ! (all or nothing ajustement)
+ PRC_UP(:,KKB)=0.
+ PRI_UP(:,KKB)=0.
+ CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE_UP(:,KKB),ZPRES_F(:,KKB), &
+ PTHL_UP(:,KKB),PRT_UP(:,KKB),ZTH_UP(:,KKB), &
+ PRV_UP(:,KKB),PRC_UP(:,KKB),PRI_UP(:,KKB),ZRSATW(:),ZRSATI(:))
+
+ ! compute updraft thevav and buoyancy term at KKB level
+ PTHV_UP(:,KKB) = ZTH_UP(:,KKB)*((1+ZRVORD*PRV_UP(:,KKB))/(1+PRT_UP(:,KKB)))
+ ! compute mean rsat in updraft
+ PRSAT_UP(:,KKB) = ZRSATW(:)*(1-PFRAC_ICE_UP(:,KKB)) + ZRSATI(:)*PFRAC_ICE_UP(:,KKB)
+
+ ! Closure assumption for mass flux at KKB level
+ !
+
+ ZG_O_THVREF=XG/ZTHVM_F
+
+ ! compute L_up
+ GLMIX=.TRUE.
+ ZTKEM_F(:,KKB)=0.
+ !
+ IF(CTURBLEN=='RM17') THEN
+ ZDUDZ = MZF_MF(KKA,KKU,KKL,GZ_M_W_MF(KKA,KKU,KKL,PUM,PDZZ))
+ ZDVDZ = MZF_MF(KKA,KKU,KKL,GZ_M_W_MF(KKA,KKU,KKL,PVM,PDZZ))
+ ZSHEAR = SQRT(ZDUDZ*ZDUDZ + ZDVDZ*ZDVDZ)
+ ELSE
+ ZSHEAR = 0. !no shear in bl89 mixing length
+ END IF
+ !
+ CALL COMPUTE_BL89_ML(KKA,KKB,KKE,KKU,KKL,PDZZ,ZTKEM_F(:,KKB),ZG_O_THVREF(:,KKB),ZTHVM,KKB,GLMIX,.FALSE.,ZSHEAR,ZLUP)
+ ZLUP(:)=MAX(ZLUP(:),1.E-10)
+
+ ! Compute Buoyancy flux at the ground
+ ZWTHVSURF(:) = (ZTHVM_F(:,KKB)/ZTHM_F(:,KKB))*PSFTH(:)+ &
+ (0.61*ZTHM_F(:,KKB))*PSFRV(:)
+
+ ! Mass flux at KKB level (updraft triggered if PSFTH>0.)
+ IF (LGZ) THEN
+ ZSURF(:)=TANH(XGZ*SQRT(XDXHAT(1)*XDYHAT(1))/ZLUP)
+ ELSE
+ ZSURF(:)=1.
+ END IF
+ WHERE (ZWTHVSURF(:)>0.)
+ PEMF(:,KKB) = XCMF * ZSURF(:) * ZRHO_F(:,KKB) * &
+ ((ZG_O_THVREF(:,KKB))*ZWTHVSURF*ZLUP)**(1./3.)
+ PFRAC_UP(:,KKB)=MIN(PEMF(:,KKB)/(SQRT(ZW_UP2(:,KKB))*ZRHO_F(:,KKB)),XFRAC_UP_MAX)
+ ZW_UP2(:,KKB)=(PEMF(:,KKB)/(PFRAC_UP(:,KKB)*ZRHO_F(:,KKB)))**2
+ GTEST(:)=.TRUE.
+ ELSEWHERE
+ PEMF(:,KKB) =0.
+ GTEST(:)=.FALSE.
+ ENDWHERE
+ELSE
+ GTEST(:)=PEMF(:,KKB+KKL)>0.
+END IF
+
+!--------------------------------------------------------------------------
+
+! 3. Vertical ascending loop
+! -----------------------
+!
+! If GTEST = T the updraft starts from the KKB level and stops when GTEST becomes F
+!
+!
+GTESTLCL(:)=.FALSE.
+GTESTETL(:)=.FALSE.
+
+! Loop on vertical level
+DO JK=KKB,KKE-KKL,KKL
+
+! IF the updraft top is reached for all column, stop the loop on levels
+ ITEST=COUNT(GTEST)
+ IF (ITEST==0) CYCLE
+
+! Computation of entrainment and detrainment with KF90
+! parameterization in clouds and LR01 in subcloud layer
+
+
+! to find the LCL (check if JK is LCL or not)
+
+ WHERE ((PRC_UP(:,JK)+PRI_UP(:,JK)>0.).AND.(.NOT.(GTESTLCL)))
+ KKLCL(:) = JK
+ GTESTLCL(:)=.TRUE.
+ ENDWHERE
+
+! COMPUTE PENTR and PDETR at mass level JK
+ IF (OENTR_DETR) THEN
+ IF(JK/=KKB) THEN
+ ZRC_MIX(:,JK) = ZRC_MIX(:,JK-KKL) ! guess of Rc of mixture
+ ZRI_MIX(:,JK) = ZRI_MIX(:,JK-KKL) ! guess of Ri of mixture
+ ENDIF
+ CALL COMPUTE_ENTR_DETR(JK,KKB,KKE,KKL,GTEST,GTESTLCL,HFRAC_ICE,PFRAC_ICE_UP(:,JK),&
+ PRHODREF(:,JK),ZPRES_F(:,JK),ZPRES_F(:,JK+KKL),&
+ PZZ(:,:),PDZZ(:,:),ZTHVM(:,:), &
+ PTHLM(:,:),PRTM(:,:),ZW_UP2(:,:),ZTH_UP(:,JK), &
+ PTHL_UP(:,JK),PRT_UP(:,JK),ZLUP(:), &
+ PRC_UP(:,JK),PRI_UP(:,JK),PTHV_UP(:,JK),&
+ PRSAT_UP(:,JK),ZRC_MIX(:,JK),ZRI_MIX(:,JK), &
+ PENTR(:,JK),PDETR(:,JK),ZENTR_CLD(:,JK),ZDETR_CLD(:,JK),&
+ ZBUO_INTEG_DRY(:,JK), ZBUO_INTEG_CLD(:,JK), &
+ ZPART_DRY(:) )
+ PBUO_INTEG(:,JK)=ZBUO_INTEG_DRY(:,JK)+ZBUO_INTEG_CLD(:,JK)
+
+ IF (JK==KKB) THEN
+ PDETR(:,JK)=0.
+ ZDETR_CLD(:,JK)=0.
+ ENDIF
+
+! Computation of updraft characteristics at level JK+KKL
+ WHERE(GTEST)
+ ZMIX1(:)=0.5*(PZZ(:,JK+KKL)-PZZ(:,JK))*(PENTR(:,JK)-PDETR(:,JK))
+ PEMF(:,JK+KKL)=PEMF(:,JK)*EXP(2*ZMIX1(:))
+ ENDWHERE
+ ELSE
+ GTEST(:) = (PEMF(:,JK+KKL)>0.)
+ END IF
+
+
+! stop the updraft if MF becomes negative
+ WHERE (GTEST.AND.(PEMF(:,JK+KKL)<=0.))
+ PEMF(:,JK+KKL)=0.
+ KKCTL(:) = JK+KKL
+ GTEST(:)=.FALSE.
+ PFRAC_ICE_UP(:,JK+KKL)=PFRAC_ICE_UP(:,JK)
+ PRSAT_UP(:,JK+KKL)=PRSAT_UP(:,JK)
+ ENDWHERE
+
+
+! If the updraft did not stop, compute cons updraft characteritics at jk+KKL
+! WHERE(GTEST)
+ DO JLOOP=1,SIZE(GTEST)
+ IF (GTEST(JLOOP) ) THEN
+ ZMIX2(JLOOP) = (PZZ(JLOOP,JK+KKL)-PZZ(JLOOP,JK))*PENTR(JLOOP,JK) !&
+ ZMIX3_CLD(JLOOP) = (PZZ(JLOOP,JK+KKL)-PZZ(JLOOP,JK))*(1.-ZPART_DRY(JLOOP))*ZDETR_CLD(JLOOP,JK) !&
+ ZMIX2_CLD(JLOOP) = (PZZ(JLOOP,JK+KKL)-PZZ(JLOOP,JK))*(1.-ZPART_DRY(JLOOP))*ZENTR_CLD(JLOOP,JK)
+
+ !PTHL_UP(JLOOP,JK+KKL)=(PTHL_UP(JLOOP,JK)*(1.-0.5*ZMIX2(JLOOP)) + PTHLM(JLOOP,JK)*ZMIX2(JLOOP)) &
+ ! /(1.+0.5*ZMIX2(JLOOP))
+ !PRT_UP(JLOOP,JK+KKL) =(PRT_UP (JLOOP,JK)*(1.-0.5*ZMIX2(JLOOP)) + PRTM(JLOOP,JK)*ZMIX2(JLOOP)) &
+ ! /(1.+0.5*ZMIX2(JLOOP))
+
+ PTHL_UP(JLOOP,JK+KKL)=PTHL_UP(JLOOP,JK)*EXP(-ZMIX2(JLOOP)) + PTHLM(JLOOP,JK)*(1-EXP(-ZMIX2(JLOOP)))
+ PRT_UP(JLOOP,JK+KKL) =PRT_UP (JLOOP,JK)*EXP(-ZMIX2(JLOOP)) + PRTM(JLOOP,JK)*(1-EXP(-ZMIX2(JLOOP)))
+
+ END IF
+ END DO
+! ENDWHERE
+
+
+ IF(OMIXUV) THEN
+ IF(JK/=KKB) THEN
+ WHERE(GTEST)
+ PU_UP(:,JK+KKL) = (PU_UP (:,JK)*(1-0.5*ZMIX2(:)) + PUM(:,JK)*ZMIX2(:)+ &
+ 0.5*XPRES_UV*(PZZ(:,JK+KKL)-PZZ(:,JK))*&
+ ((PUM(:,JK+KKL)-PUM(:,JK))/PDZZ(:,JK+KKL)+&
+ (PUM(:,JK)-PUM(:,JK-KKL))/PDZZ(:,JK)) ) &
+ /(1+0.5*ZMIX2(:))
+ PV_UP(:,JK+KKL) = (PV_UP (:,JK)*(1-0.5*ZMIX2(:)) + PVM(:,JK)*ZMIX2(:)+ &
+ 0.5*XPRES_UV*(PZZ(:,JK+KKL)-PZZ(:,JK))*&
+ ((PVM(:,JK+KKL)-PVM(:,JK))/PDZZ(:,JK+KKL)+&
+ (PVM(:,JK)-PVM(:,JK-KKL))/PDZZ(:,JK)) ) &
+ /(1+0.5*ZMIX2(:))
+ ENDWHERE
+ ELSE
+ WHERE(GTEST)
+ PU_UP(:,JK+KKL) = (PU_UP (:,JK)*(1-0.5*ZMIX2(:)) + PUM(:,JK)*ZMIX2(:)+ &
+ 0.5*XPRES_UV*(PZZ(:,JK+KKL)-PZZ(:,JK))*&
+ ((PUM(:,JK+KKL)-PUM(:,JK))/PDZZ(:,JK+KKL)) ) &
+ /(1+0.5*ZMIX2(:))
+ PV_UP(:,JK+KKL) = (PV_UP (:,JK)*(1-0.5*ZMIX2(:)) + PVM(:,JK)*ZMIX2(:)+ &
+ 0.5*XPRES_UV*(PZZ(:,JK+KKL)-PZZ(:,JK))*&
+ ((PVM(:,JK+KKL)-PVM(:,JK))/PDZZ(:,JK+KKL)) ) &
+ /(1+0.5*ZMIX2(:))
+ ENDWHERE
+
+ ENDIF
+ ENDIF
+ DO JSV=1,ISV
+ IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE
+ WHERE(GTEST)
+ PSV_UP(:,JK+KKL,JSV) = (PSV_UP (:,JK,JSV)*(1-0.5*ZMIX2(:)) + &
+ PSVM(:,JK,JSV)*ZMIX2(:)) /(1+0.5*ZMIX2(:))
+ ENDWHERE
+ END DO
+
+ IF (OENTR_DETR) THEN
+
+! Compute non cons. var. at level JK+KKL
+ ZRC_UP(:)=PRC_UP(:,JK) ! guess = level just below
+ ZRI_UP(:)=PRI_UP(:,JK) ! guess = level just below
+ CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE_UP(:,JK+KKL),ZPRES_F(:,JK+KKL), &
+ PTHL_UP(:,JK+KKL),PRT_UP(:,JK+KKL),ZTH_UP(:,JK+KKL), &
+ ZRV_UP(:),ZRC_UP(:),ZRI_UP(:),ZRSATW(:),ZRSATI(:))
+ WHERE(GTEST)
+ PRC_UP(:,JK+KKL)=ZRC_UP(:)
+ PRV_UP(:,JK+KKL)=ZRV_UP(:)
+ PRI_UP(:,JK+KKL)=ZRI_UP(:)
+ PRSAT_UP(:,JK+KKL) = ZRSATW(:)*(1-PFRAC_ICE_UP(:,JK+KKL)) + ZRSATI(:)*PFRAC_ICE_UP(:,JK+KKL)
+ ENDWHERE
+
+
+! Compute the updraft theta_v, buoyancy and w**2 for level JK+KKL
+ WHERE(GTEST)
+ PTHV_UP(:,JK+KKL) = ZTH_UP(:,JK+KKL)*((1+ZRVORD*PRV_UP(:,JK+KKL))/(1+PRT_UP(:,JK+KKL)))
+ WHERE (ZBUO_INTEG_DRY(:,JK)>0.)
+ ZW_UP2(:,JK+KKL) = ZW_UP2(:,JK) + 2.*(XABUO-XBENTR*XENTR_DRY)* ZBUO_INTEG_DRY(:,JK)
+ ELSEWHERE
+ ZW_UP2(:,JK+KKL) = ZW_UP2(:,JK) + 2.*XABUO* ZBUO_INTEG_DRY(:,JK)
+ ENDWHERE
+ ZW_UP2(:,JK+KKL) = ZW_UP2(:,JK+KKL)*(1.-(XBDETR*ZMIX3_CLD(:)+XBENTR*ZMIX2_CLD(:)))&
+ /(1.+(XBDETR*ZMIX3_CLD(:)+XBENTR*ZMIX2_CLD(:))) &
+ +2.*(XABUO)*ZBUO_INTEG_CLD(:,JK)/(1.+(XBDETR*ZMIX3_CLD(:)+XBENTR*ZMIX2_CLD(:)))
+ ENDWHERE
+
+
+! Test if the updraft has reach the ETL
+ GTESTETL(:)=.FALSE.
+ WHERE (GTEST.AND.(PBUO_INTEG(:,JK)<=0.))
+ KKETL(:) = JK+KKL
+ GTESTETL(:)=.TRUE.
+ ENDWHERE
+
+! Test is we have reached the top of the updraft
+ WHERE (GTEST.AND.((ZW_UP2(:,JK+KKL)<=0.).OR.(PEMF(:,JK+KKL)<=0.)))
+ ZW_UP2(:,JK+KKL)=0.
+ PEMF(:,JK+KKL)=0.
+ GTEST(:)=.FALSE.
+ PTHL_UP(:,JK+KKL)=ZTHLM_F(:,JK+KKL)
+ PRT_UP(:,JK+KKL)=ZRTM_F(:,JK+KKL)
+ PRC_UP(:,JK+KKL)=0.
+ PRI_UP(:,JK+KKL)=0.
+ PRV_UP(:,JK+KKL)=0.
+ PTHV_UP(:,JK+KKL)=ZTHVM_F(:,JK+KKL)
+ PFRAC_UP(:,JK+KKL)=0.
+ KKCTL(:)=JK+KKL
+ ENDWHERE
+
+! compute frac_up at JK+KKL
+ WHERE (GTEST)
+ PFRAC_UP(:,JK+KKL)=PEMF(:,JK+KKL)/(SQRT(ZW_UP2(:,JK+KKL))*ZRHO_F(:,JK+KKL))
+ ENDWHERE
+
+! Updraft fraction must be smaller than XFRAC_UP_MAX
+ WHERE (GTEST)
+ PFRAC_UP(:,JK+KKL)=MIN(XFRAC_UP_MAX,PFRAC_UP(:,JK+KKL))
+ ENDWHERE
+
+
+! When cloudy and non-buoyant, updraft fraction must decrease
+
+ WHERE ((GTEST.AND.GTESTETL).AND.GTESTLCL)
+ PFRAC_UP(:,JK+KKL)=MIN(PFRAC_UP(:,JK+KKL),PFRAC_UP(:,JK))
+ ENDWHERE
+
+! Mass flux is updated with the new updraft fraction
+
+ IF (OENTR_DETR) PEMF(:,JK+KKL)=PFRAC_UP(:,JK+KKL)*SQRT(ZW_UP2(:,JK+KKL))*ZRHO_F(:,JK+KKL)
+
+ END IF
+
+ENDDO
+
+IF(OENTR_DETR) THEN
+
+ PW_UP(:,:)=SQRT(ZW_UP2(:,:))
+
+ PEMF(:,KKB) =0.
+
+! Limits the shallow convection scheme when cloud heigth is higher than 3000m.
+! To do this, mass flux is multiplied by a coefficient decreasing linearly
+! from 1 (for clouds of ZDEPTH_MAX1 m of depth) to 0 (for clouds of ZDEPTH_MAX2 m of depth).
+! This way, all MF fluxes are diminished by this amount.
+! Diagnosed cloud fraction is also multiplied by the same coefficient.
+!
+ DO JI=1,SIZE(PTHM,1)
+ PDEPTH(JI) = MAX(0., PZZ(JI,KKCTL(JI)) - PZZ(JI,KKLCL(JI)) )
+ END DO
+
+ GWORK1(:)= (GTESTLCL(:) .AND. (PDEPTH(:) > ZDEPTH_MAX1) )
+ GWORK2(:,:) = SPREAD( GWORK1(:), DIM=2, NCOPIES=MAX(KKU,KKA) )
+ ZCOEF(:,:) = SPREAD( (1.-(PDEPTH(:)-ZDEPTH_MAX1)/(ZDEPTH_MAX2-ZDEPTH_MAX1)), DIM=2, NCOPIES=SIZE(ZCOEF,2))
+ ZCOEF=MIN(MAX(ZCOEF,0.),1.)
+ WHERE (GWORK2)
+ PEMF(:,:) = PEMF(:,:) * ZCOEF(:,:)
+ PFRAC_UP(:,:) = PFRAC_UP(:,:) * ZCOEF(:,:)
+ ENDWHERE
+ENDIF
+END SUBROUTINE COMPUTE_UPDRAFT
diff --git a/src/mesonh/turb/compute_updraft_raha.f90 b/src/mesonh/turb/compute_updraft_raha.f90
new file mode 100644
index 000000000..1cf8c32b2
--- /dev/null
+++ b/src/mesonh/turb/compute_updraft_raha.f90
@@ -0,0 +1,666 @@
+!MNH_LIC Copyright 2012-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ######spl
+ MODULE MODI_COMPUTE_UPDRAFT_RAHA
+! ###########################
+!
+INTERFACE
+!
+! #################################################################
+ SUBROUTINE COMPUTE_UPDRAFT_RAHA(KKA,KKB,KKE,KKU,KKL,HFRAC_ICE, &
+ OENTR_DETR,OMIXUV, &
+ ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
+ PZZ,PDZZ, &
+ PSFTH,PSFRV, &
+ PPABSM,PRHODREF,PUM,PVM, PTKEM, &
+ PEXNM,PTHM,PRVM,PTHLM,PRTM, &
+ PSVM,PTHL_UP,PRT_UP, &
+ PRV_UP,PRC_UP,PRI_UP,PTHV_UP, &
+ PW_UP,PU_UP, PV_UP, PSV_UP, &
+ PFRAC_UP,PFRAC_ICE_UP,PRSAT_UP, &
+ PEMF,PDETR,PENTR, &
+ PBUO_INTEG,KKLCL,KKETL,KKCTL, &
+ PDEPTH )
+! #################################################################
+!
+!* 1.1 Declaration of Arguments
+!
+!
+INTEGER, INTENT(IN) :: KKA ! near ground array index
+INTEGER, INTENT(IN) :: KKB ! near ground physical index
+INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
+INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme
+LOGICAL, INTENT(IN) :: OENTR_DETR! flag to recompute entrainment, detrainment and mass flux
+LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum
+LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer
+INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer
+INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer
+REAL, DIMENSION(:,:), INTENT(IN) :: PZZ ! Height at the flux point
+REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! Metrics coefficient
+
+REAL, DIMENSION(:), INTENT(IN) :: PSFTH,PSFRV
+! normal surface fluxes of theta,rv,(u,v) parallel to the orography
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PPABSM ! Pressure at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PRHODREF ! dry density of the
+ ! reference state
+REAL, DIMENSION(:,:), INTENT(IN) :: PUM ! u mean wind
+REAL, DIMENSION(:,:), INTENT(IN) :: PVM ! v mean wind
+REAL, DIMENSION(:,:), INTENT(IN) :: PTKEM ! TKE at t-dt
+
+REAL, DIMENSION(:,:), INTENT(IN) :: PEXNM ! Exner function at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHM ! liquid pot. temp. at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PRVM ! vapor mixing ratio at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM,PRTM ! cons. var. at t-dt
+
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-dt
+
+REAL, DIMENSION(:,:), INTENT(OUT) :: PTHL_UP,PRT_UP ! updraft properties
+REAL, DIMENSION(:,:), INTENT(OUT) :: PU_UP, PV_UP ! updraft wind components
+REAL, DIMENSION(:,:), INTENT(INOUT):: PRV_UP,PRC_UP ! updraft rv, rc
+REAL, DIMENSION(:,:), INTENT(INOUT):: PRI_UP,PTHV_UP ! updraft ri, THv
+REAL, DIMENSION(:,:), INTENT(INOUT):: PW_UP,PFRAC_UP ! updraft w, fraction
+REAL, DIMENSION(:,:), INTENT(INOUT):: PFRAC_ICE_UP ! liquid/solid fraction in updraft
+REAL, DIMENSION(:,:), INTENT(INOUT):: PRSAT_UP ! Rsat
+
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSV_UP ! updraft scalar var.
+
+REAL, DIMENSION(:,:), INTENT(INOUT):: PEMF,PDETR,PENTR ! Mass_flux,
+ ! detrainment,entrainment
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PBUO_INTEG ! Integrated Buoyancy
+INTEGER, DIMENSION(:), INTENT(INOUT):: KKLCL,KKETL,KKCTL! LCL, ETL, CTL
+REAL, DIMENSION(:), INTENT(OUT) :: PDEPTH ! Deepness of cloud
+
+
+END SUBROUTINE COMPUTE_UPDRAFT_RAHA
+
+END INTERFACE
+!
+END MODULE MODI_COMPUTE_UPDRAFT_RAHA
+!
+! ######spl
+ SUBROUTINE COMPUTE_UPDRAFT_RAHA(KKA,KKB,KKE,KKU,KKL,HFRAC_ICE, &
+ OENTR_DETR,OMIXUV, &
+ ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
+ PZZ,PDZZ, &
+ PSFTH,PSFRV, &
+ PPABSM,PRHODREF,PUM,PVM, PTKEM, &
+ PEXNM,PTHM,PRVM,PTHLM,PRTM, &
+ PSVM,PTHL_UP,PRT_UP, &
+ PRV_UP,PRC_UP,PRI_UP,PTHV_UP, &
+ PW_UP,PU_UP, PV_UP, PSV_UP, &
+ PFRAC_UP,PFRAC_ICE_UP,PRSAT_UP, &
+ PEMF,PDETR,PENTR, &
+ PBUO_INTEG,KKLCL,KKETL,KKCTL, &
+ PDEPTH )
+
+! #################################################################
+!!
+!!**** *COMPUTE_UPDRAF_RAHA* - calculates caracteristics of the updraft
+!!
+!!
+!! PURPOSE
+!! -------
+!!**** The purpose of this routine is to build the updraft following Rio et al (2010)
+!! Same as compute_updraft_rhcj10 exept the use of Hourdin et al closure
+!!
+!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! !! REFERENCE
+!! ---------
+!! Rio et al (2010) (Boundary Layer Meteorol 135:469-483)
+!! Hourdin et al (xxxx)
+!!
+!! AUTHOR
+!! ------
+!! Y. Bouteloup (2012)
+!! R. Honnert Janv 2013 ==> corection of some coding bugs
+!! Y. Bouteloup Janv 2014 ==> Allow the use of loops in the both direction
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+
+USE MODD_CST
+USE MODD_PARAM_MFSHALL_n
+
+USE MODI_TH_R_FROM_THL_RT_1D
+USE MODI_SHUMAN_MF
+
+IMPLICIT NONE
+
+!* 1.1 Declaration of Arguments
+!
+!
+!
+INTEGER, INTENT(IN) :: KKA ! near ground array index
+INTEGER, INTENT(IN) :: KKB ! near ground physical index
+INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
+INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme
+LOGICAL, INTENT(IN) :: OENTR_DETR! flag to recompute entrainment, detrainment and mass flux
+LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum
+LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer
+INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer
+INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer
+REAL, DIMENSION(:,:), INTENT(IN) :: PZZ ! Height at the flux point
+REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! Metrics coefficient
+
+REAL, DIMENSION(:), INTENT(IN) :: PSFTH,PSFRV
+! normal surface fluxes of theta,rv,(u,v) parallel to the orography
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PPABSM ! Pressure at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PRHODREF ! dry density of the
+ ! reference state
+REAL, DIMENSION(:,:), INTENT(IN) :: PUM ! u mean wind
+REAL, DIMENSION(:,:), INTENT(IN) :: PVM ! v mean wind
+REAL, DIMENSION(:,:), INTENT(IN) :: PTKEM ! TKE at t-dt
+
+REAL, DIMENSION(:,:), INTENT(IN) :: PEXNM ! Exner function at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHM ! liquid pot. temp. at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PRVM ! vapor mixing ratio at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM,PRTM ! cons. var. at t-dt
+
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-dt
+
+REAL, DIMENSION(:,:), INTENT(OUT) :: PTHL_UP,PRT_UP ! updraft properties
+REAL, DIMENSION(:,:), INTENT(OUT) :: PU_UP, PV_UP ! updraft wind components
+REAL, DIMENSION(:,:), INTENT(INOUT):: PRV_UP,PRC_UP ! updraft rv, rc
+REAL, DIMENSION(:,:), INTENT(INOUT):: PRI_UP,PTHV_UP ! updraft ri, THv
+REAL, DIMENSION(:,:), INTENT(INOUT):: PW_UP,PFRAC_UP ! updraft w, fraction
+REAL, DIMENSION(:,:), INTENT(INOUT):: PFRAC_ICE_UP ! liquid/solid fraction in updraft
+REAL, DIMENSION(:,:), INTENT(INOUT):: PRSAT_UP ! Rsat
+
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSV_UP ! updraft scalar var.
+
+REAL, DIMENSION(:,:), INTENT(INOUT):: PEMF,PDETR,PENTR ! Mass_flux,
+ ! detrainment,entrainment
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PBUO_INTEG ! Integrated Buoyancy
+INTEGER, DIMENSION(:), INTENT(INOUT):: KKLCL,KKETL,KKCTL! LCL, ETL, CTL
+REAL, DIMENSION(:), INTENT(OUT) :: PDEPTH ! Deepness of cloud
+! 1.2 Declaration of local variables
+!
+!
+! Mean environment variables at t-dt at flux point
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZTHM_F,ZRVM_F,ZRCM_F ! Theta,rv of
+ ! updraft environnement
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZRTM_F, ZTHLM_F, ZTKEM_F ! rt, thetal,TKE,pressure,
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZUM_F,ZVM_F,ZRHO_F ! density,momentum
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZPRES_F,ZTHVM_F,ZTHVM ! interpolated at the flux point
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZG_O_THVREF ! g*ThetaV ref
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZW_UP2 ! w**2 of the updraft
+
+REAL, DIMENSION(SIZE(PSVM,1),SIZE(PTHM,2),SIZE(PSVM,3)) :: ZSVM_F ! scalar variables
+
+
+
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZTH_UP ! updraft THETA
+REAL, DIMENSION(SIZE(PTHM,1)) :: ZT_UP ! updraft T
+REAL, DIMENSION(SIZE(PTHM,1)) :: ZLVOCPEXN ! updraft L
+REAL, DIMENSION(SIZE(PTHM,1)) :: ZCP ! updraft cp
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZBUO ! Buoyancy
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZTHS_UP,ZTHSM
+
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZCOEF ! diminution coefficient for too high clouds
+
+REAL, DIMENSION(SIZE(PSFTH,1) ) :: ZWTHVSURF ! Surface w'thetav'
+
+REAL :: ZRDORV ! RD/RV
+REAL :: ZRVORD ! RV/RD
+
+
+REAL, DIMENSION(SIZE(PTHM,1)) :: ZMIX1,ZMIX2,ZMIX3
+
+REAL, DIMENSION(SIZE(PTHM,1)) :: ZLUP ! Upward Mixing length from the ground
+
+REAL, DIMENSION(SIZE(PTHM,1)) :: ZDEPTH ! Deepness limit for cloud
+
+INTEGER :: ISV ! Number of scalar variables
+INTEGER :: IKU,IIJU ! array size in k
+INTEGER :: JK,JI,JJ,JSV ! loop counters
+
+LOGICAL, DIMENSION(SIZE(PTHM,1)) :: GTEST,GTESTLCL,GTESTETL
+ ! Test if the ascent continue, if LCL or ETL is reached
+LOGICAL :: GLMIX
+ ! To choose upward or downward mixing length
+LOGICAL, DIMENSION(SIZE(PTHM,1)) :: GWORK1
+LOGICAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: GWORK2
+
+
+INTEGER :: ITEST
+
+REAL, DIMENSION(SIZE(PTHM,1)) :: ZRC_UP, ZRI_UP, ZRV_UP, ZWP2, ZRSATW, ZRSATI
+
+LOGICAL, DIMENSION(SIZE(PTHM,1)) :: GTEST_FER
+REAL, DIMENSION(SIZE(PTHM,1)) :: ZPHI,ZALIM_STAR_TOT
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZDTHETASDZ,ZALIM_STAR,ZZDZ,ZZZ
+INTEGER, DIMENSION(SIZE(PTHM,1)) :: IALIM
+
+REAL, DIMENSION(SIZE(PTHM,1)) :: ZTEST,ZDZ,ZWUP_MEAN !
+REAL, DIMENSION(SIZE(PTHM,1)) :: ZCOE,ZWCOE,ZBUCOE
+REAL, DIMENSION(SIZE(PTHM,1)) :: ZDETR_BUO, ZDETR_RT
+REAL, DIMENSION(SIZE(PTHM,1)) :: ZW_MAX ! w**2 max of the updraft
+REAL, DIMENSION(SIZE(PTHM,1)) :: ZZTOP ! Top of the updraft
+REAL, DIMENSION(SIZE(PTHM,1)) :: ZA,ZB,ZQTM,ZQT_UP
+
+REAL :: ZDEPTH_MAX1, ZDEPTH_MAX2 ! control auto-extinction process
+
+REAL :: ZTMAX,ZRMAX, ZEPS ! control value
+
+
+! Thresholds for the perturbation of
+! theta_l and r_t at the first level of the updraft
+
+ZTMAX=2.0
+ZRMAX=1.E-3
+ZEPS=1.E-15
+!------------------------------------------------------------------------
+! INITIALISATION
+
+! Initialisation of the constants
+ZRDORV = XRD / XRV !=0.622
+ZRVORD = (XRV / XRD)
+
+ZDEPTH_MAX1=4500. ! clouds with depth infeRIOr to this value are keeped untouched
+ZDEPTH_MAX2=5000. ! clouds with depth superior to this value are suppressed
+
+! Local variables, internal domain
+! Internal Domain
+
+IKU=SIZE(PTHM,2)
+IIJU =SIZE(PTHM,1)
+!number of scalar variables
+ISV=SIZE(PSVM,3)
+
+! Initialisation of intersesting Level :LCL,ETL,CTL
+KKLCL(:)=KKE
+KKETL(:)=KKE
+KKCTL(:)=KKE
+
+!
+! Initialisation
+!* udraft governing variables
+PEMF(:,:)=0.
+PDETR(:,:)=0.
+PENTR(:,:)=0.
+
+! Initialisation
+!* updraft core variables
+PRV_UP(:,:)=0.
+PRC_UP(:,:)=0.
+
+PW_UP(:,:)=0.
+ZTH_UP(:,:)=0.
+PFRAC_UP(:,:)=0.
+PTHV_UP(:,:)=0.
+
+PBUO_INTEG=0.
+ZBUO =0.
+
+!no ice cloud coded yet
+PRI_UP(:,:)=0.
+PFRAC_ICE_UP(:,:)=0.
+PRSAT_UP(:,:)=PRVM(:,:) ! should be initialised correctly but is (normaly) not used
+
+! Initialisation of environment variables at t-dt
+
+! variables at flux level
+ZTHLM_F(:,:) = MZM_MF(KKA,KKU,KKL,PTHLM(:,:))
+ZRTM_F (:,:) = MZM_MF(KKA,KKU,KKL,PRTM(:,:))
+ZUM_F (:,:) = MZM_MF(KKA,KKU,KKL,PUM(:,:))
+ZVM_F (:,:) = MZM_MF(KKA,KKU,KKL,PVM(:,:))
+ZTKEM_F(:,:) = MZM_MF(KKA,KKU,KKL,PTKEM(:,:))
+
+!DO JSV=1,ISV
+! IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE
+! ZSVM_F(:,KKB:IKU,JSV) = 0.5*(PSVM(:,KKB:IKU,JSV)+PSVM(:,1:IKU-1,JSV))
+! ZSVM_F(:,1,JSV) = ZSVM_F(:,KKB,JSV)
+!END DO
+
+! Initialisation of updraft characteristics
+PTHL_UP(:,:)=ZTHLM_F(:,:)
+PRT_UP(:,:)=ZRTM_F(:,:)
+PU_UP(:,:)=ZUM_F(:,:)
+PV_UP(:,:)=ZVM_F(:,:)
+PSV_UP(:,:,:)=0.
+!IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) then
+! PSV_UP(:,:,:)=ZSVM_F(:,:,:)
+!ENDIF
+
+! Computation or initialisation of updraft characteristics at the KKB level
+! thetal_up,rt_up,thetaV_up, w�,Buoyancy term and mass flux (PEMF)
+
+PTHL_UP(:,KKB)= ZTHLM_F(:,KKB)+MAX(0.,MIN(ZTMAX,(PSFTH(:)/SQRT(ZTKEM_F(:,KKB)))*XALP_PERT))
+PRT_UP(:,KKB) = ZRTM_F(:,KKB)+MAX(0.,MIN(ZRMAX,(PSFRV(:)/SQRT(ZTKEM_F(:,KKB)))*XALP_PERT))
+
+ZQT_UP(:) = PRT_UP(:,KKB)/(1.+PRT_UP(:,KKB))
+ZTHS_UP(:,KKB)=PTHL_UP(:,KKB)*(1.+XLAMBDA_MF*ZQT_UP(:))
+
+ZTHM_F (:,:) = MZM_MF(KKA,KKU,KKL,PTHM (:,:))
+ZPRES_F(:,:) = MZM_MF(KKA,KKU,KKL,PPABSM(:,:))
+ZRHO_F (:,:) = MZM_MF(KKA,KKU,KKL,PRHODREF(:,:))
+ZRVM_F (:,:) = MZM_MF(KKA,KKU,KKL,PRVM(:,:))
+
+! thetav at mass and flux levels
+ZTHVM_F(:,:)=ZTHM_F(:,:)*((1.+ZRVORD*ZRVM_F(:,:))/(1.+ZRTM_F(:,:)))
+ZTHVM(:,:)=PTHM(:,:)*((1.+ZRVORD*PRVM(:,:))/(1.+PRTM(:,:)))
+
+PTHV_UP(:,:)= ZTHVM_F(:,:)
+PRV_UP (:,:)= ZRVM_F (:,:)
+
+ZW_UP2(:,:)=ZEPS
+ZW_UP2(:,KKB) = MAX(0.0001,(1./6.)*ZTKEM_F(:,KKB))
+GTEST = (ZW_UP2(:,KKB) > ZEPS)
+
+! Computation of non conservative variable for the KKB level of the updraft
+! (all or nothing ajustement)
+PRC_UP(:,KKB)=0.
+PRI_UP(:,KKB)=0.
+
+CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE_UP(:,KKB),ZPRES_F(:,KKB), &
+ PTHL_UP(:,KKB),PRT_UP(:,KKB),ZTH_UP(:,KKB), &
+ PRV_UP(:,KKB),PRC_UP(:,KKB),PRI_UP(:,KKB),ZRSATW(:),ZRSATI(:))
+
+! compute updraft thevav and buoyancy term at KKB level
+PTHV_UP(:,KKB) = ZTH_UP(:,KKB)*((1+ZRVORD*PRV_UP(:,KKB))/(1+PRT_UP(:,KKB)))
+! compute mean rsat in updraft
+PRSAT_UP(:,KKB) = ZRSATW(:)*(1-PFRAC_ICE_UP(:,KKB)) + ZRSATI(:)*PFRAC_ICE_UP(:,KKB)
+
+!Tout est commente pour tester dans un premier temps la s�paration en deux de la
+! boucle verticale, une pour w et une pour PEMF
+
+ZG_O_THVREF=XG/ZTHVM_F
+
+
+! Definition de l'alimentation au sens de la fermeture de Hourdin et al
+
+ZALIM_STAR(:,:) = 0.
+ZALIM_STAR_TOT(:) = 0. ! <== Normalization of ZALIM_STAR
+IALIM(:) = KKB ! <== Top level of the alimentation layer
+
+DO JK=KKB,KKE-KKL,KKL ! Vertical loop
+ ZZDZ(:,JK) = MAX(ZEPS,PZZ(:,JK+KKL)-PZZ(:,JK)) ! <== Delta Z between two flux level
+ ZZZ(:,JK) = MAX(0.,0.5*(PZZ(:,JK+KKL)+PZZ(:,JK)) ) ! <== Hight of mass levels
+ ZDTHETASDZ(:,JK) = (ZTHVM_F(:,JK)-ZTHVM_F(:,JK+KKL)) ! <== Delta theta_v
+
+ WHERE ((ZTHVM_F(:,JK+KKL)<ZTHVM_F(:,JK)) .AND. (ZTHVM_F(:,KKB)>=ZTHVM_F(:,JK)))
+ ZALIM_STAR(:,JK) = SQRT(ZZZ(:,JK))*ZDTHETASDZ(:,JK)/ZZDZ(:,JK)
+ ZALIM_STAR_TOT(:) = ZALIM_STAR_TOT(:)+ZALIM_STAR(:,JK)*ZZDZ(:,JK)
+ IALIM(:) = JK
+ ENDWHERE
+ENDDO
+
+! Normalization of ZALIM_STAR
+DO JK=KKB,KKE-KKL,KKL ! Vertical loop
+ WHERE (ZALIM_STAR_TOT > ZEPS)
+ ZALIM_STAR(:,JK) = ZALIM_STAR(:,JK)/ZALIM_STAR_TOT(:)
+ ENDWHERE
+ENDDO
+ZALIM_STAR_TOT(:) = 0.
+
+
+! --------- END of alimentation calculation ---------------------------------------
+
+
+!--------------------------------------------------------------------------
+
+! 3. Vertical ascending loop
+! -----------------------
+!
+! If GTEST = T the updraft starts from the KKB level and stops when GTEST becomes F
+!
+!
+GTESTLCL(:)=.FALSE.
+GTESTETL(:)=.FALSE.
+
+! Loop on vertical level to compute W
+
+ZW_MAX(:) = 0.
+ZZTOP(:) = 0.
+ZPHI(:) = 0.
+
+
+DO JK=KKB,KKE-KKL,KKL
+
+! IF the updraft top is reached for all column, stop the loop on levels
+
+! ITEST=COUNT(GTEST)
+! IF (ITEST==0) CYCLE
+
+! Computation of entrainment and detrainment with KF90
+! parameterization in clouds and LR01 in subcloud layer
+
+
+! to find the LCL (check if JK is LCL or not)
+
+ WHERE ((PRC_UP(:,JK)+PRI_UP(:,JK)>0.).AND.(.NOT.(GTESTLCL)))
+ KKLCL(:) = JK
+ GTESTLCL(:)=.TRUE.
+ ENDWHERE
+
+
+! COMPUTE PENTR and PDETR at mass level JK
+
+
+! Buoyancy is computed on "flux" levels where updraft variables are known
+
+ ! Compute theta_v of updraft at flux level JK
+
+ ZRC_UP(:) = PRC_UP(:,JK)
+ ZRI_UP(:) = PRI_UP(:,JK) ! guess
+ ZRV_UP(:) = PRV_UP(:,JK)
+ ZBUO (:,JK) = ZG_O_THVREF(:,JK)*(PTHV_UP(:,JK) - ZTHVM_F(:,JK))
+ PBUO_INTEG(:,JK) = ZBUO(:,JK)*(PZZ(:,JK+KKL)-PZZ(:,JK))
+
+ ZDZ(:) = MAX(ZEPS,PZZ(:,JK+KKL)-PZZ(:,JK))
+ ZTEST(:) = XA1*ZBUO(:,JK) - XB*ZW_UP2(:,JK)
+
+ ZCOE(:) = ZDZ(:)
+ WHERE (ZTEST(:)>0.)
+ ZCOE(:) = ZDZ(:)/(1.+ XBETA1)
+ ENDWHERE
+
+! Calcul de la vitesse
+
+ ZWCOE(:) = (1.-XB*ZCOE(:))/(1.+XB*ZCOE(:))
+ ZBUCOE(:) = 2.*ZCOE(:)/(1.+XB*ZCOE(:))
+
+ ZW_UP2(:,JK+KKL) = MAX(ZEPS,ZW_UP2(:,JK)*ZWCOE(:) + XA1*ZBUO(:,JK)*ZBUCOE(:) )
+ ZW_MAX(:) = MAX(ZW_MAX(:), SQRT(ZW_UP2(:,JK+KKL)))
+ ZWUP_MEAN(:) = MAX(ZEPS,0.5*(ZW_UP2(:,JK+KKL)+ZW_UP2(:,JK)))
+
+! Entrainement et detrainement
+
+ PENTR(:,JK) = MAX(0.,(XBETA1/(1.+XBETA1))*(XA1*ZBUO(:,JK)/ZWUP_MEAN(:)-XB))
+
+ ZDETR_BUO(:) = MAX(0., -(XBETA1/(1.+XBETA1))*XA1*ZBUO(:,JK)/ZWUP_MEAN(:))
+ ZDETR_RT(:) = XC*SQRT(MAX(0.,(PRT_UP(:,JK) - ZRTM_F(:,JK))) / MAX(ZEPS,ZRTM_F(:,JK)) / ZWUP_MEAN(:))
+ PDETR(:,JK) = ZDETR_RT(:)+ZDETR_BUO(:)
+
+
+! If the updraft did not stop, compute cons updraft characteritics at jk+1
+ WHERE(GTEST)
+ ZZTOP(:) = MAX(ZZTOP(:),PZZ(:,JK+KKL))
+ ZMIX2(:) = (PZZ(:,JK+KKL)-PZZ(:,JK))*PENTR(:,JK) !&
+ ZMIX3(:) = (PZZ(:,JK+KKL)-PZZ(:,JK))*PDETR(:,JK) !&
+
+ ZQTM(:) = PRTM(:,JK)/(1.+PRTM(:,JK))
+ ZTHSM(:,JK) = PTHLM(:,JK)*(1.+XLAMBDA_MF*ZQTM(:))
+ ZTHS_UP(:,JK+KKL)=(ZTHS_UP(:,JK)*(1.-0.5*ZMIX2(:)) + ZTHSM(:,JK)*ZMIX2(:)) &
+ /(1.+0.5*ZMIX2(:))
+ PRT_UP(:,JK+KKL)=(PRT_UP (:,JK)*(1.-0.5*ZMIX2(:)) + PRTM(:,JK)*ZMIX2(:)) &
+ /(1.+0.5*ZMIX2(:))
+ ZQT_UP(:) = PRT_UP(:,JK+KKL)/(1.+PRT_UP(:,JK+KKL))
+ PTHL_UP(:,JK+KKL)=ZTHS_UP(:,JK+KKL)/(1.+XLAMBDA_MF*ZQT_UP(:))
+ ENDWHERE
+
+
+ IF(OMIXUV) THEN
+ IF(JK/=KKB) THEN
+ WHERE(GTEST)
+ PU_UP(:,JK+KKL) = (PU_UP (:,JK)*(1-0.5*ZMIX2(:)) + PUM(:,JK)*ZMIX2(:)+ &
+ 0.5*XPRES_UV*(PZZ(:,JK+KKL)-PZZ(:,JK))*&
+ ((PUM(:,JK+KKL)-PUM(:,JK))/PDZZ(:,JK+KKL)+&
+ (PUM(:,JK)-PUM(:,JK-KKL))/PDZZ(:,JK)) ) &
+ /(1+0.5*ZMIX2(:))
+ PV_UP(:,JK+KKL) = (PV_UP (:,JK)*(1-0.5*ZMIX2(:)) + PVM(:,JK)*ZMIX2(:)+ &
+ 0.5*XPRES_UV*(PZZ(:,JK+KKL)-PZZ(:,JK))*&
+ ((PVM(:,JK+KKL)-PVM(:,JK))/PDZZ(:,JK+KKL)+&
+ (PVM(:,JK)-PVM(:,JK-KKL))/PDZZ(:,JK)) ) &
+ /(1+0.5*ZMIX2(:))
+ ENDWHERE
+ ELSE
+ WHERE(GTEST)
+ PU_UP(:,JK+KKL) = (PU_UP (:,JK)*(1-0.5*ZMIX2(:)) + PUM(:,JK)*ZMIX2(:)+ &
+ 0.5*XPRES_UV*(PZZ(:,JK+KKL)-PZZ(:,JK))*&
+ ((PUM(:,JK+KKL)-PUM(:,JK))/PDZZ(:,JK+KKL)) ) &
+ /(1+0.5*ZMIX2(:))
+ PV_UP(:,JK+KKL) = (PV_UP (:,JK)*(1-0.5*ZMIX2(:)) + PVM(:,JK)*ZMIX2(:)+ &
+ 0.5*XPRES_UV*(PZZ(:,JK+KKL)-PZZ(:,JK))*&
+ ((PVM(:,JK+KKL)-PVM(:,JK))/PDZZ(:,JK+KKL)) ) &
+ /(1+0.5*ZMIX2(:))
+ ENDWHERE
+
+ ENDIF
+ ENDIF
+! DO JSV=1,ISV
+! IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE
+! WHERE(GTEST)
+! PSV_UP(:,JK+KKL,JSV) = (PSV_UP (:,JK,JSV)*(1-0.5*ZMIX2(:)) + &
+! PSVM(:,JK,JSV)*ZMIX2(:)) /(1+0.5*ZMIX2(:))
+! ENDWHERE
+! ENDDO
+
+
+! Compute non cons. var. at level JK+KKL
+ ZRC_UP(:)=PRC_UP(:,JK) ! guess = level just below
+ ZRI_UP(:)=PRI_UP(:,JK) ! guess = level just below
+ ZRV_UP(:)=PRV_UP(:,JK)
+ CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE_UP(:,JK+KKL),ZPRES_F(:,JK+KKL), &
+ PTHL_UP(:,JK+KKL),PRT_UP(:,JK+KKL),ZTH_UP(:,JK+KKL), &
+ ZRV_UP(:),ZRC_UP(:),ZRI_UP(:),ZRSATW(:),ZRSATI(:))
+ WHERE(GTEST)
+ ZT_UP(:) = ZTH_UP(:,JK+KKL)*PEXNM(:,JK+KKL)
+ ZCP(:) = XCPD + XCL * ZRC_UP(:)
+ ZLVOCPEXN(:)=(XLVTT + (XCPV-XCL) * (ZT_UP(:)-XTT) ) / ZCP(:) / PEXNM(:,JK+KKL)
+ PRC_UP(:,JK+KKL)=MIN(0.5E-3,ZRC_UP(:)) ! On ne peut depasser 0.5 g/kg (autoconversion donc elimination !)
+ PTHL_UP(:,JK+KKL) = PTHL_UP(:,JK+KKL)+ZLVOCPEXN(:)*(ZRC_UP(:)-PRC_UP(:,JK+KKL))
+ PRV_UP(:,JK+KKL)=ZRV_UP(:)
+ PRI_UP(:,JK+KKL)=ZRI_UP(:)
+ PRT_UP(:,JK+KKL) = PRC_UP(:,JK+KKL) + PRV_UP(:,JK+KKL)
+ PRSAT_UP(:,JK+KKL) = ZRSATW(:)*(1-PFRAC_ICE_UP(:,JK+KKL)) + ZRSATI(:)*PFRAC_ICE_UP(:,JK+KKL)
+ ENDWHERE
+
+
+! Compute the updraft theta_v, buoyancy and w**2 for level JK+1
+ WHERE(GTEST)
+! PTHV_UP(:,JK+KKL) = ZTH_UP(:,JK+KKL)*((1+ZRVORD*PRV_UP(:,JK+KKL))/(1+PRT_UP(:,JK+KKL)))
+ PTHV_UP(:,JK+KKL) = ZTH_UP(:,JK+KKL)*(1.+0.608*PRV_UP(:,JK+KKL) - PRC_UP(:,JK+KKL))
+ ENDWHERE
+
+
+! Test if the updraft has reach the ETL
+ GTESTETL(:)=.FALSE.
+ WHERE (GTEST.AND.(PBUO_INTEG(:,JK)<=0.))
+ KKETL(:) = JK+KKL
+ GTESTETL(:)=.TRUE.
+ ENDWHERE
+
+! Test is we have reached the top of the updraft
+
+ WHERE (GTEST.AND.((ZW_UP2(:,JK+KKL)<=ZEPS)))
+ ZW_UP2(:,JK+KKL)=ZEPS
+ GTEST(:)=.FALSE.
+ PTHL_UP(:,JK+KKL)=ZTHLM_F(:,JK+KKL)
+ PRT_UP(:,JK+KKL)=ZRTM_F(:,JK+KKL)
+ PRC_UP(:,JK+KKL)=0.
+ PRI_UP(:,JK+KKL)=0.
+ PRV_UP(:,JK+KKL)=0.
+ PTHV_UP(:,JK+KKL)=ZTHVM_F(:,JK+KKL)
+ PFRAC_UP(:,JK+KKL)=0.
+ KKCTL(:)=JK+KKL
+ ENDWHERE
+
+ENDDO
+
+! Closure assumption for mass flux at KKB+1 level (Mass flux is supposed to be 0 at KKB level !)
+! Hourdin et al 2002 formulation
+
+
+ZZTOP(:) = MAX(ZZTOP(:),ZEPS)
+
+DO JK=KKB+KKL,KKE-KKL,KKL ! Vertical loop
+ WHERE(JK<=IALIM)
+ ZALIM_STAR_TOT(:) = ZALIM_STAR_TOT(:) + ZALIM_STAR(:,JK)*ZALIM_STAR(:,JK)*ZZDZ(:,JK)/PRHODREF(:,JK)
+ ENDWHERE
+ENDDO
+
+WHERE (ZALIM_STAR_TOT*ZZTOP > ZEPS)
+ ZPHI(:) = ZW_MAX(:)/(XR*ZZTOP(:)*ZALIM_STAR_TOT(:))
+ENDWHERE
+
+GTEST(:) = .TRUE.
+PEMF(:,KKB+KKL) = ZPHI(:)*ZZDZ(:,KKB)*ZALIM_STAR(:,KKB)
+! Updraft fraction must be smaller than XFRAC_UP_MAX
+PFRAC_UP(:,KKB+KKL)=PEMF(:,KKB+KKL)/(SQRT(ZW_UP2(:,KKB+KKL))*ZRHO_F(:,KKB+KKL))
+PFRAC_UP(:,KKB+KKL)=MIN(XFRAC_UP_MAX,PFRAC_UP(:,KKB+KKL))
+PEMF(:,KKB+KKL) = ZRHO_F(:,KKB+KKL)*PFRAC_UP(:,KKB+KKL)*SQRT(ZW_UP2(:,KKB+KKL))
+
+DO JK=KKB+KKL,KKE-KKL,KKL ! Vertical loop
+
+ GTEST = (ZW_UP2(:,JK) > ZEPS)
+
+ WHERE (GTEST)
+ WHERE(JK<IALIM)
+ PEMF(:,JK+KKL) = MAX(0.,PEMF(:,JK) + ZPHI(:)*ZZDZ(:,JK)*(PENTR(:,JK) - PDETR(:,JK)))
+ ELSEWHERE
+ ZMIX1(:)=ZZDZ(:,JK)*(PENTR(:,JK)-PDETR(:,JK))
+ PEMF(:,JK+KKL)=PEMF(:,JK)*EXP(ZMIX1(:))
+ ENDWHERE
+
+! Updraft fraction must be smaller than XFRAC_UP_MAX
+ PFRAC_UP(:,JK+KKL)=PEMF(:,JK+KKL)/(SQRT(ZW_UP2(:,JK+KKL))*ZRHO_F(:,JK+KKL))
+ PFRAC_UP(:,JK+KKL)=MIN(XFRAC_UP_MAX,PFRAC_UP(:,JK+KKL))
+ PEMF(:,JK+KKL) = ZRHO_F(:,JK+KKL)*PFRAC_UP(:,JK+KKL)*SQRT(ZW_UP2(:,JK+KKL))
+ ENDWHERE
+
+ENDDO
+
+PW_UP(:,:)=SQRT(ZW_UP2(:,:))
+PEMF(:,KKB) =0.
+
+! Limits the shallow convection scheme when cloud heigth is higher than 3000m.
+! To do this, mass flux is multiplied by a coefficient decreasing linearly
+! from 1 (for clouds of 3000m of depth) to 0 (for clouds of 4000m of depth).
+! This way, all MF fluxes are diminished by this amount.
+! Diagnosed cloud fraction is also multiplied by the same coefficient.
+!
+DO JI=1,SIZE(PTHM,1)
+ PDEPTH(JI) = MAX(0., PZZ(JI,KKCTL(JI)) - PZZ(JI,KKLCL(JI)) )
+END DO
+
+GWORK1(:)= (GTESTLCL(:) .AND. (PDEPTH(:) > ZDEPTH_MAX1) )
+GWORK2(:,:) = SPREAD( GWORK1(:), DIM=2, NCOPIES=IKU )
+ZCOEF(:,:) = SPREAD( (1.-(PDEPTH(:)-ZDEPTH_MAX1)/(ZDEPTH_MAX2-ZDEPTH_MAX1)), DIM=2, NCOPIES=IKU)
+ZCOEF=MIN(MAX(ZCOEF,0.),1.)
+WHERE (GWORK2)
+ PEMF(:,:) = PEMF(:,:) * ZCOEF(:,:)
+ PFRAC_UP(:,:) = PFRAC_UP(:,:) * ZCOEF(:,:)
+ENDWHERE
+
+
+END SUBROUTINE COMPUTE_UPDRAFT_RAHA
diff --git a/src/mesonh/turb/compute_updraft_rhcj10.f90 b/src/mesonh/turb/compute_updraft_rhcj10.f90
new file mode 100644
index 000000000..a918d05b0
--- /dev/null
+++ b/src/mesonh/turb/compute_updraft_rhcj10.f90
@@ -0,0 +1,625 @@
+!MNH_LIC Copyright 2012-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ######spl
+ MODULE MODI_COMPUTE_UPDRAFT_RHCJ10
+! ###########################
+!
+INTERFACE
+!
+! #################################################################
+ SUBROUTINE COMPUTE_UPDRAFT_RHCJ10(KKA,KKB,KKE,KKU,KKL, HFRAC_ICE, &
+ OENTR_DETR,OMIXUV, &
+ ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
+ PZZ,PDZZ, &
+ PSFTH,PSFRV, &
+ PPABSM,PRHODREF,PUM,PVM,PTKEM, &
+ PTHM,PRVM,PTHLM,PRTM, &
+ PSVM,PTHL_UP,PRT_UP, &
+ PRV_UP,PRC_UP,PRI_UP,PTHV_UP, &
+ PW_UP,PU_UP, PV_UP, PSV_UP, &
+ PFRAC_UP,PFRAC_ICE_UP,PRSAT_UP, &
+ PEMF,PDETR,PENTR, &
+ PBUO_INTEG,KKLCL,KKETL,KKCTL, &
+ PDEPTH)
+! #################################################################
+!
+!* 1.1 Declaration of Arguments
+!
+!
+!
+INTEGER, INTENT(IN) :: KKA ! near ground array index
+INTEGER, INTENT(IN) :: KKB ! near ground physical index
+INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
+INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme
+LOGICAL, INTENT(IN) :: OENTR_DETR! flag to recompute entrainment, detrainment and mass flux
+LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum
+LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer
+INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer
+INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer
+REAL, DIMENSION(:,:), INTENT(IN) :: PZZ ! Height at the flux point
+REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! Metrics coefficient
+
+REAL, DIMENSION(:), INTENT(IN) :: PSFTH,PSFRV
+! normal surface fluxes of theta,rv,(u,v) parallel to the orography
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PPABSM ! Pressure at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PRHODREF ! dry density of the
+ ! reference state
+REAL, DIMENSION(:,:), INTENT(IN) :: PUM ! u mean wind
+REAL, DIMENSION(:,:), INTENT(IN) :: PVM ! v mean wind
+REAL, DIMENSION(:,:), INTENT(IN) :: PTKEM ! TKE at t-dt
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHM ! liquid pot. temp. at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PRVM ! vapor mixing ratio at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM,PRTM ! cons. var. at t-dt
+
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-dt
+
+REAL, DIMENSION(:,:), INTENT(OUT) :: PTHL_UP,PRT_UP ! updraft properties
+REAL, DIMENSION(:,:), INTENT(OUT) :: PU_UP, PV_UP ! updraft wind components
+REAL, DIMENSION(:,:), INTENT(INOUT):: PRV_UP,PRC_UP, & ! updraft rv, rc
+ PRI_UP,PTHV_UP,& ! updraft ri, THv
+ PW_UP,PFRAC_UP,& ! updraft w, fraction
+ PFRAC_ICE_UP,& ! liquid/solid fraction in updraft
+ PRSAT_UP ! Rsat
+
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSV_UP ! updraft scalar var.
+
+REAL, DIMENSION(:,:), INTENT(INOUT):: PEMF,PDETR,PENTR ! Mass_flux,
+ ! entrainment, detrainment
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PBUO_INTEG ! Integrated Buoyancy
+INTEGER, DIMENSION(:), INTENT(INOUT):: KKLCL,KKETL,KKCTL! LCL, ETL, CTL
+REAL, DIMENSION(:), INTENT(OUT) :: PDEPTH ! Deepness of cloud
+
+
+END SUBROUTINE COMPUTE_UPDRAFT_RHCJ10
+
+END INTERFACE
+!
+END MODULE MODI_COMPUTE_UPDRAFT_RHCJ10
+!
+SUBROUTINE COMPUTE_UPDRAFT_RHCJ10(KKA,KKB,KKE,KKU,KKL,HFRAC_ICE, &
+ OENTR_DETR,OMIXUV, &
+ ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
+ PZZ,PDZZ, &
+ PSFTH,PSFRV, &
+ PPABSM,PRHODREF,PUM,PVM, PTKEM, &
+ PTHM,PRVM,PTHLM,PRTM, &
+ PSVM,PTHL_UP,PRT_UP, &
+ PRV_UP,PRC_UP,PRI_UP,PTHV_UP, &
+ PW_UP,PU_UP, PV_UP, PSV_UP, &
+ PFRAC_UP,PFRAC_ICE_UP,PRSAT_UP, &
+ PEMF,PDETR,PENTR, &
+ PBUO_INTEG,KKLCL,KKETL,KKCTL, &
+ PDEPTH )
+! #################################################################
+!!
+!!**** *COMPUTE_UPDRAF_RHCJ10* - calculates caracteristics of the updraft
+!!
+!!
+!! PURPOSE
+!! -------
+!!**** The purpose of this routine is to build the updraft following Rio et al (2010)
+!!
+!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! !! REFERENCE
+!! ---------
+!! Rio et al (2010) (Boundary Layer Meteorol 135:469-483)
+!!
+!! AUTHOR
+!! ------
+!! Y. Bouteloup (2012)
+!! R. Honert Janv 2013 ==> corection of some bugs
+!! Q.Rodier 01/2019 : support RM17 mixing length
+!! --------------------------------------------------------------------------
+
+! WARNING ==> This updraft is not yet ready to use scalar variables
+
+!* 0. DECLARATIONS
+! ------------
+
+USE MODD_CST
+USE MODD_PARAM_MFSHALL_n
+USE MODD_TURB_n, ONLY : CTURBLEN
+USE MODI_COMPUTE_ENTR_DETR
+USE MODI_TH_R_FROM_THL_RT_1D
+USE MODI_SHUMAN_MF
+
+USE MODI_COMPUTE_BL89_ML
+
+
+IMPLICIT NONE
+
+!* 1.1 Declaration of Arguments
+
+
+INTEGER, INTENT(IN) :: KKA ! near ground array index
+INTEGER, INTENT(IN) :: KKB ! near ground physical index
+INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
+INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme
+LOGICAL, INTENT(IN) :: OENTR_DETR! flag to recompute entrainment, detrainment and mass flux
+LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum
+LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer
+INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer
+INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer
+REAL, DIMENSION(:,:), INTENT(IN) :: PZZ ! Height at the flux point
+REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! Metrics coefficient
+
+REAL, DIMENSION(:), INTENT(IN) :: PSFTH,PSFRV
+! normal surface fluxes of theta,rv,(u,v) parallel to the orography
+
+REAL, DIMENSION(:,:), INTENT(IN) :: PPABSM ! Pressure at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PRHODREF ! dry density of the
+ ! reference state
+REAL, DIMENSION(:,:), INTENT(IN) :: PUM ! u mean wind
+REAL, DIMENSION(:,:), INTENT(IN) :: PVM ! v mean wind
+REAL, DIMENSION(:,:), INTENT(IN) :: PTKEM ! TKE at t-dt
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHM ! pot. temp. at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PRVM ! vapor mixing ratio at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM,PRTM ! cons. var. at t-dt
+
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-dt
+
+REAL, DIMENSION(:,:), INTENT(OUT) :: PTHL_UP,PRT_UP ! updraft properties
+REAL, DIMENSION(:,:), INTENT(OUT) :: PU_UP, PV_UP ! updraft wind components
+REAL, DIMENSION(:,:), INTENT(INOUT):: PRV_UP,PRC_UP ! updraft rv, rc
+REAL, DIMENSION(:,:), INTENT(INOUT):: PRI_UP ! updraft ri
+REAL, DIMENSION(:,:), INTENT(INOUT):: PTHV_UP ! updraft THv
+REAL, DIMENSION(:,:), INTENT(INOUT):: PW_UP,PFRAC_UP ! updraft w, fraction
+REAL, DIMENSION(:,:), INTENT(INOUT):: PFRAC_ICE_UP ! liquid/solid fraction in updraft
+REAL, DIMENSION(:,:), INTENT(INOUT):: PRSAT_UP ! Rsat
+
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSV_UP ! updraft scalar var.
+
+REAL, DIMENSION(:,:), INTENT(INOUT):: PEMF,PDETR,PENTR ! Mass_flux,
+ ! detrainment,entrainment
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PBUO_INTEG ! Integrated Buoyancy
+INTEGER, DIMENSION(:), INTENT(INOUT):: KKLCL,KKETL,KKCTL! LCL, ETL, CTL
+REAL, DIMENSION(:), INTENT(OUT) :: PDEPTH ! Deepness of cloud
+! 1.2 Declaration of local variables
+
+! Mean environment variables at t-dt at flux point
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZTHM_F,ZRVM_F ! Theta,rv of
+ ! updraft environnement
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZRTM_F, ZTHLM_F, ZTKEM_F ! rt, thetal,TKE,pressure,
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZUM_F,ZVM_F,ZRHO_F ! density,momentum
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZPRES_F,ZTHVM_F,ZTHVM ! interpolated at the flux point
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZG_O_THVREF ! g*ThetaV ref
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZW_UP2 ! w**2 of the updraft
+
+REAL, DIMENSION(SIZE(PSVM,1),SIZE(PTHM,2),SIZE(PSVM,3)) :: ZSVM_F ! scalar variables
+
+
+
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZTH_UP ! updraft THETA
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZBUO ! Buoyancy
+
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZCOEF ! diminution coefficient for too high clouds
+
+REAL, DIMENSION(SIZE(PSFTH,1) ) :: ZWTHVSURF ! Surface w'thetav'
+
+REAL :: ZRDORV ! RD/RV
+REAL :: ZRVORD ! RV/RD
+
+
+REAL, DIMENSION(SIZE(PTHM,1)) :: ZMIX1,ZMIX2,ZMIX3
+
+REAL, DIMENSION(SIZE(PTHM,1)) :: ZLUP ! Upward Mixing length from the ground
+
+
+INTEGER :: ISV ! Number of scalar variables
+INTEGER :: IKU,IIJU ! array size in k
+INTEGER :: JK,JI,JJ,JSV ! loop counters
+
+LOGICAL, DIMENSION(SIZE(PTHM,1)) :: GTEST,GTESTLCL,GTESTETL
+ ! Test if the ascent continue, if LCL or ETL is reached
+LOGICAL :: GLMIX
+ ! To choose upward or downward mixing length
+LOGICAL, DIMENSION(SIZE(PTHM,1)) :: GWORK1
+LOGICAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: GWORK2
+
+INTEGER :: ITEST
+
+REAL, DIMENSION(SIZE(PTHM,1)) :: ZRC_UP, ZRI_UP, ZRV_UP, ZRSATW, ZRSATI
+
+REAL, DIMENSION(SIZE(PTHM,1)) :: ZPHI
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZZDZ,ZZZ
+
+REAL, DIMENSION(SIZE(PTHM,1)) :: ZTEST,ZDZ,ZWUP_MEAN !
+REAL, DIMENSION(SIZE(PTHM,1)) :: ZCOE,ZWCOE,ZBUCOE
+REAL, DIMENSION(SIZE(PTHM,1)) :: ZDETR_BUO, ZDETR_RT
+REAL, DIMENSION(SIZE(PTHM,1)) :: ZW_MAX ! w**2 max of the updraft
+REAL, DIMENSION(SIZE(PTHM,1)) :: ZZTOP ! Top of the updraft
+REAL, DIMENSION(SIZE(PTHM,1)) :: ZBETA1
+
+REAL :: ZDEPTH_MAX1, ZDEPTH_MAX2 ! control auto-extinction process
+
+REAL :: ZTMAX,ZRMAX, ZEPS ! control value
+
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZSHEAR,ZDUDZ,ZDVDZ ! vertical wind shear
+
+! Thresholds for the perturbation of
+! theta_l and r_t at the first level of the updraft
+
+ZTMAX=2.0
+ZRMAX=1.E-3
+ZEPS=1.E-15
+!------------------------------------------------------------------------
+! INITIALISATION
+
+! Initialisation of the constants
+ZRDORV = XRD / XRV !=0.622
+ZRVORD = (XRV / XRD)
+
+! depth are different in compute_updraft (3000. and 4000.) ==> impact is small
+ZDEPTH_MAX1=4500. ! clouds with depth infeRIOr to this value are keeped untouched
+ZDEPTH_MAX2=5000. ! clouds with depth superior to this value are suppressed
+
+
+! Initialisation of ZBETA1 ==> I do not remember why I introduced a KLON array for beta1 !
+
+ZBETA1(:) = XBETA1
+
+! Local variables, internal domain
+! Internal Domain
+
+IKU=SIZE(PTHM,2)
+IIJU =SIZE(PTHM,1)
+!number of scalar variables
+ISV=SIZE(PSVM,3)
+
+! Initialisation of intersesting Level :LCL,ETL,CTL
+KKLCL(:)=KKE
+KKETL(:)=KKE
+KKCTL(:)=KKE
+
+!
+! Initialisation
+!* udraft governing variables
+PEMF(:,:)=0.
+PDETR(:,:)=0.
+PENTR(:,:)=0.
+
+! Initialisation
+!* updraft core variables
+PRC_UP(:,:)=0.
+
+PW_UP(:,:)=0.
+ZTH_UP(:,:)=0.
+PFRAC_UP(:,:)=0.
+PTHV_UP(:,:)=0.
+
+PBUO_INTEG=0.
+ZBUO =0.
+
+PRI_UP(:,:)=0.
+PFRAC_ICE_UP(:,:)=0.
+PRSAT_UP(:,:)=PRVM(:,:) ! should be initialised correctly but is (normaly) not used
+
+! Initialisation of environment variables at t-dt
+! variables at flux level
+ZTHLM_F(:,:) = MZM_MF(KKA,KKU,KKL,PTHLM(:,:))
+ZRTM_F (:,:) = MZM_MF(KKA,KKU,KKL,PRTM(:,:))
+ZUM_F (:,:) = MZM_MF(KKA,KKU,KKL,PUM(:,:))
+ZVM_F (:,:) = MZM_MF(KKA,KKU,KKL,PVM(:,:))
+ZTKEM_F(:,:) = MZM_MF(KKA,KKU,KKL,PTKEM(:,:))
+
+
+! This updraft is not yet ready to use scalar variables
+!DO JSV=1,ISV
+! IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE
+! ZSVM_F(:,:,JSV) = MZM_MF(KKA,KKU,KKL,PSVM(:,:,JSV))
+!END DO
+
+! Initialisation of updraft characteristics
+PTHL_UP(:,:)=ZTHLM_F(:,:)
+PRT_UP(:,:)=ZRTM_F(:,:)
+PU_UP(:,:)=ZUM_F(:,:)
+PV_UP(:,:)=ZVM_F(:,:)
+PSV_UP(:,:,:)=0.
+! This updraft is not yet ready to use scalar variables
+!IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) then
+! PSV_UP(:,:,:)=ZSVM_F(:,:,:)
+!ENDIF
+
+! Computation or initialisation of updraft characteristics at the KKB level
+! thetal_up,rt_up,thetaV_up, w�,Buoyancy term and mass flux (PEMF)
+
+!PTHL_UP(:,KKB)= ZTHLM_F(:,KKB)+MAX(0.,MIN(ZTMAX,(PSFTH(:)/SQRT(ZTKEM_F(:,KKB)))*XALP_PERT))
+!PRT_UP(:,KKB) = ZRTM_F(:,KKB)+MAX(0.,MIN(ZRMAX,(PSFRV(:)/SQRT(ZTKEM_F(:,KKB)))*XALP_PERT))
+PTHL_UP(:,KKB)= ZTHLM_F(:,KKB)
+PRT_UP(:,KKB) = ZRTM_F(:,KKB)
+
+ZTHM_F (:,:) = MZM_MF(KKA,KKU,KKL,PTHM (:,:))
+ZPRES_F(:,:) = MZM_MF(KKA,KKU,KKL,PPABSM(:,:))
+ZRHO_F (:,:) = MZM_MF(KKA,KKU,KKL,PRHODREF(:,:))
+ZRVM_F (:,:) = MZM_MF(KKA,KKU,KKL,PRVM(:,:))
+
+! thetav at mass and flux levels
+ZTHVM_F(:,:)=ZTHM_F(:,:)*((1.+ZRVORD*ZRVM_F(:,:))/(1.+ZRTM_F(:,:)))
+ZTHVM(:,:)=PTHM(:,:)*((1.+ZRVORD*PRVM(:,:))/(1.+PRTM(:,:)))
+
+PTHV_UP(:,:)= ZTHVM_F(:,:)
+PRV_UP (:,:)= ZRVM_F (:,:)
+
+ZW_UP2(:,:)=ZEPS
+ZW_UP2(:,KKB) = MAX(0.0001,(2./3.)*ZTKEM_F(:,KKB))
+
+! Computation of non conservative variable for the KKB level of the updraft
+! (all or nothing ajustement)
+
+PRC_UP(:,KKB)=0.
+PRI_UP(:,KKB)=0.
+CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE_UP(:,KKB),ZPRES_F(:,KKB), &
+ PTHL_UP(:,KKB),PRT_UP(:,KKB),ZTH_UP(:,KKB), &
+ PRV_UP(:,KKB),PRC_UP(:,KKB),PRI_UP(:,KKB),ZRSATW(:),ZRSATI(:))
+
+! compute updraft thevav and buoyancy term at KKB level
+PTHV_UP(:,KKB) = ZTH_UP(:,KKB)*((1+ZRVORD*PRV_UP(:,KKB))/(1+PRT_UP(:,KKB)))
+! compute mean rsat in updraft
+PRSAT_UP(:,KKB) = ZRSATW(:)*(1-PFRAC_ICE_UP(:,KKB)) + ZRSATI(:)*PFRAC_ICE_UP(:,KKB)
+
+!Tout est commente pour tester dans un premier temps la séparation en deux de la
+! boucle verticale, une pour w et une pour PEMF
+
+ZG_O_THVREF=XG/ZTHVM_F
+
+! Calcul de la fermeture de Julien Pergaut comme limite max de PHY
+
+DO JK=KKB,KKE-KKL,KKL ! Vertical loop
+ ZZDZ(:,JK) = MAX(ZEPS,PZZ(:,JK+KKL)-PZZ(:,JK)) ! <== Delta Z between two flux level
+ ZZZ(:,JK) = 0.5*(PZZ(:,JK+KKL)+PZZ(:,JK)) ! <== Hight of mass levels
+ENDDO
+
+! compute L_up
+GLMIX=.TRUE.
+ZTKEM_F(:,KKB)=0.
+!
+IF(CTURBLEN=='RM17') THEN
+ ZDUDZ = MZF_MF(KKA,KKU,KKL,GZ_M_W_MF(KKA,KKU,KKL,PUM,PDZZ))
+ ZDVDZ = MZF_MF(KKA,KKU,KKL,GZ_M_W_MF(KKA,KKU,KKL,PVM,PDZZ))
+ ZSHEAR = SQRT(ZDUDZ*ZDUDZ + ZDVDZ*ZDVDZ)
+ELSE
+ ZSHEAR = 0. !no shear in bl89 mixing length
+END IF
+!
+CALL COMPUTE_BL89_ML(KKA,KKB,KKE,KKU,KKL,PDZZ,ZTKEM_F(:,KKB),ZG_O_THVREF(:,KKB), &
+ ZTHVM_F,KKB,GLMIX,.TRUE.,ZSHEAR,ZLUP)
+ZLUP(:)=MAX(ZLUP(:),1.E-10)
+
+! Compute Buoyancy flux at the ground
+ZWTHVSURF(:) = (ZTHVM_F(:,KKB)/ZTHM_F(:,KKB))*PSFTH(:)+ &
+ (0.61*ZTHM_F(:,KKB))*PSFRV(:)
+
+! Mass flux at KKB level (updraft triggered if PSFTH>0.)
+WHERE (ZWTHVSURF(:)>0.010) ! <== Not 0 Important to have stratocumulus !!!!!
+ PEMF(:,KKB) = XCMF * ZRHO_F(:,KKB) * ((ZG_O_THVREF(:,KKB))*ZWTHVSURF*ZLUP)**(1./3.)
+ PFRAC_UP(:,KKB)=MIN(PEMF(:,KKB)/(SQRT(ZW_UP2(:,KKB))*ZRHO_F(:,KKB)),XFRAC_UP_MAX)
+ ZW_UP2(:,KKB)=(PEMF(:,KKB)/(PFRAC_UP(:,KKB)*ZRHO_F(:,KKB)))**2
+ GTEST(:)=.TRUE.
+ELSEWHERE
+ PEMF(:,KKB) =0.
+ GTEST(:)=.FALSE.
+ENDWHERE
+
+
+!--------------------------------------------------------------------------
+
+! 3. Vertical ascending loop
+! -----------------------
+!
+! If GTEST = T the updraft starts from the KKB level and stops when GTEST becomes F
+!
+!
+GTESTLCL(:)=.FALSE.
+GTESTETL(:)=.FALSE.
+
+
+! Loop on vertical level to compute W
+
+ZW_MAX(:) = 0.
+ZZTOP(:) = 0.
+ZPHI(:) = 0.
+
+DO JK=KKB,KKE-KKL,KKL
+
+! IF the updraft top is reached for all column, stop the loop on levels
+
+ ITEST=COUNT(GTEST)
+! IF (ITEST==0) CYCLE ! <== I do not remember why I removed this ...
+
+! Computation of entrainment and detrainment with KF90
+! parameterization in clouds and LR01 in subcloud layer
+
+
+! to find the LCL (check if JK is LCL or not)
+
+ WHERE ((PRC_UP(:,JK)+PRI_UP(:,JK)>0.).AND.(.NOT.(GTESTLCL)))
+ KKLCL(:) = JK
+ GTESTLCL(:)=.TRUE.
+ ENDWHERE
+
+
+! COMPUTE PENTR and PDETR at mass level JK
+
+
+! Buoyancy is computed on "flux" levels where updraft variables are known
+
+ ! Compute theta_v of updraft at flux level JK
+
+ ZRC_UP(:) =PRC_UP(:,JK) ! guess
+ ZRI_UP(:) =PRI_UP(:,JK) ! guess
+ ZRV_UP(:) =PRV_UP(:,JK)
+ CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE_UP(:,JK),&
+ PPABSM(:,JK),PTHL_UP(:,JK),PRT_UP(:,JK),&
+ ZTH_UP(:,JK),ZRV_UP,ZRC_UP,ZRI_UP,ZRSATW(:),ZRSATI(:))
+
+ WHERE (GTEST)
+ PTHV_UP (:,JK) = ZTH_UP(:,JK)*(1.+ZRVORD*ZRV_UP(:))/(1.+PRT_UP(:,JK))
+ ZBUO (:,JK) = ZG_O_THVREF(:,JK)*(PTHV_UP(:,JK) - ZTHVM_F(:,JK))
+ PBUO_INTEG(:,JK) = ZBUO(:,JK)*(PZZ(:,JK+KKL)-PZZ(:,JK))
+
+ ZDZ(:) = MAX(ZEPS,PZZ(:,JK+KKL)-PZZ(:,JK))
+ ZTEST(:) = XA1*ZBUO(:,JK) - XB*ZW_UP2(:,JK)
+
+ ZCOE(:) = ZDZ(:)
+ WHERE (ZTEST(:)>0.)
+ ZCOE(:) = ZDZ(:)/(1.+ ZBETA1(:))
+ ENDWHERE
+
+! Convective Vertical speed computation
+
+ ZWCOE(:) = (1.-XB*ZCOE(:))/(1.+XB*ZCOE(:))
+ ZBUCOE(:) = 2.*ZCOE(:)/(1.+XB*ZCOE(:))
+
+! Second Rachel bug correction (XA1 has been forgotten ... not yet tested ...)
+! ZW_UP2(:,JK+KKL) = MAX(ZEPS,ZW_UP2(:,JK)*ZWCOE(:) + ZBUO(:,JK)*ZBUCOE(:) )
+ ZW_UP2(:,JK+KKL) = MAX(ZEPS,ZW_UP2(:,JK)*ZWCOE(:) + XA1*ZBUO(:,JK)*ZBUCOE(:) )
+ ZW_MAX(:) = MAX(ZW_MAX(:), SQRT(ZW_UP2(:,JK+KKL)))
+ ZWUP_MEAN(:) = MAX(ZEPS,0.5*(ZW_UP2(:,JK+KKL)+ZW_UP2(:,JK)))
+
+! Entrainement and detrainement
+
+! First Rachel bug correction (Parenthesis around 1+beta1 ==> impact is small)
+ PENTR(:,JK) = MAX(0.,(ZBETA1(:)/(1.+ZBETA1(:)))*(XA1*ZBUO(:,JK)/ZWUP_MEAN(:)-XB))
+ ZDETR_BUO(:) = MAX(0., -(ZBETA1(:)/(1.+ZBETA1(:)))*XA1*ZBUO(:,JK)/ZWUP_MEAN(:))
+ ZDETR_RT(:) = XC*SQRT(MAX(0.,(PRT_UP(:,JK) - ZRTM_F(:,JK))) / MAX(ZEPS,ZRTM_F(:,JK)) / ZWUP_MEAN(:))
+ PDETR(:,JK) = ZDETR_RT(:)+ZDETR_BUO(:)
+
+! If the updraft did not stop, compute cons updraft characteritics at jk+1
+
+ ZZTOP(:) = MAX(ZZTOP(:),PZZ(:,JK+KKL))
+ ZMIX2(:) = (PZZ(:,JK+KKL)-PZZ(:,JK))*PENTR(:,JK) !&
+ ZMIX3(:) = (PZZ(:,JK+KKL)-PZZ(:,JK))*PDETR(:,JK) !&
+
+ PTHL_UP(:,JK+KKL)=(PTHL_UP(:,JK)*(1.-0.5*ZMIX2(:)) + PTHLM(:,JK)*ZMIX2(:)) &
+ /(1.+0.5*ZMIX2(:))
+ PRT_UP(:,JK+KKL) =(PRT_UP (:,JK)*(1.-0.5*ZMIX2(:)) + PRTM(:,JK)*ZMIX2(:)) &
+ /(1.+0.5*ZMIX2(:))
+ ENDWHERE ! GTEST
+
+
+ IF(OMIXUV) THEN
+ WHERE(GTEST)
+ PU_UP(:,JK+KKL) = (PU_UP (:,JK)*(1-0.5*ZMIX2(:)) + PUM(:,JK)*ZMIX2(:)+ &
+ 0.5*XPRES_UV*(PZZ(:,JK+KKL)-PZZ(:,JK))*&
+ ((PUM(:,JK+KKL)-PUM(:,JK))/PDZZ(:,JK+KKL)+&
+ (PUM(:,JK)-PUM(:,JK-KKL))/PDZZ(:,JK)) ) &
+ /(1+0.5*ZMIX2(:))
+ PV_UP(:,JK+KKL) = (PV_UP (:,JK)*(1-0.5*ZMIX2(:)) + PVM(:,JK)*ZMIX2(:)+ &
+ 0.5*XPRES_UV*(PZZ(:,JK+KKL)-PZZ(:,JK))*&
+ ((PVM(:,JK+KKL)-PVM(:,JK))/PDZZ(:,JK+KKL)+&
+ (PVM(:,JK)-PVM(:,JK-KKL))/PDZZ(:,JK)) ) &
+ /(1+0.5*ZMIX2(:))
+ ENDWHERE
+ ENDIF
+
+! This updraft is not yet ready to use scalar variables
+! DO JSV=1,ISV
+! IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE
+! WHERE(GTEST)
+! PSV_UP(:,JK+KKL,JSV) = (PSV_UP (:,JK,JSV)*(1-0.5*ZMIX2(:)) + &
+! PSVM(:,JK,JSV)*ZMIX2(:)) /(1+0.5*ZMIX2(:))
+! ENDWHERE
+! ENDDO
+
+
+! Compute non cons. var. at level JK+KKL
+ ZRC_UP(:)=PRC_UP(:,JK) ! guess = level just below
+ ZRI_UP(:)=PRI_UP(:,JK) ! guess = level just below
+ ZRV_UP(:)=PRV_UP(:,JK)
+ CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE_UP(:,JK+KKL),ZPRES_F(:,JK+KKL), &
+ PTHL_UP(:,JK+KKL),PRT_UP(:,JK+KKL),ZTH_UP(:,JK+KKL), &
+ ZRV_UP(:),ZRC_UP(:),ZRI_UP(:),ZRSATW(:),ZRSATI(:))
+ WHERE(GTEST)
+ PRC_UP(:,JK+KKL)=ZRC_UP(:)
+ PRV_UP(:,JK+KKL)=ZRV_UP(:)
+ PRI_UP(:,JK+KKL)=ZRI_UP(:)
+ PRSAT_UP(:,JK+KKL) = ZRSATW(:)*(1-PFRAC_ICE_UP(:,JK+KKL)) + ZRSATI(:)*PFRAC_ICE_UP(:,JK+KKL)
+ ENDWHERE
+
+
+! Compute the updraft theta_v, buoyancy and w**2 for level JK+1
+ WHERE(GTEST)
+ PTHV_UP(:,JK+KKL) = ZTH_UP(:,JK+KKL)*((1+ZRVORD*PRV_UP(:,JK+KKL))/(1+PRT_UP(:,JK+KKL)))
+ ENDWHERE
+
+ WHERE(GTEST)
+ ZMIX1(:)=ZZDZ(:,JK)*(PENTR(:,JK)-PDETR(:,JK))
+ PEMF(:,JK+KKL)=PEMF(:,JK)*EXP(ZMIX1(:))
+
+! Updraft fraction must be smaller than XFRAC_UP_MAX
+ PFRAC_UP(:,JK+KKL)=PEMF(:,JK+KKL)/(SQRT(ZW_UP2(:,JK+KKL))*ZRHO_F(:,JK+KKL))
+ PFRAC_UP(:,JK+KKL)=MIN(XFRAC_UP_MAX,PFRAC_UP(:,JK+KKL))
+ ENDWHERE
+
+! Test if the updraft has reach the ETL
+ GTESTETL(:)=.FALSE.
+ WHERE (GTEST.AND.(PBUO_INTEG(:,JK)<=0.))
+ KKETL(:) = JK+KKL
+ GTESTETL(:)=.TRUE.
+ ENDWHERE
+
+
+! Test is we have reached the top of the updraft
+
+ WHERE (GTEST.AND.((ZW_UP2(:,JK+KKL)<=ZEPS).OR.(PEMF(:,JK+KKL)<=ZEPS)))
+ ZW_UP2 (:,JK+KKL)=ZEPS
+ PEMF (:,JK+KKL)=0.
+ GTEST (:) =.FALSE.
+ PTHL_UP (:,JK+KKL)=ZTHLM_F(:,JK+KKL)
+ PRT_UP (:,JK+KKL)=ZRTM_F(:,JK+KKL)
+ PRC_UP (:,JK+KKL)=0.
+ PRI_UP (:,JK+KKL)=0.
+ PRV_UP (:,JK+KKL)=ZRVM_F (:,JK+KKL)
+ PTHV_UP (:,JK+KKL)=ZTHVM_F(:,JK+KKL)
+ PFRAC_UP (:,JK+KKL)=0.
+ KKCTL (:) =JK+KKL
+
+ ENDWHERE
+
+
+ENDDO ! Fin de la boucle verticale
+
+PW_UP(:,:)=SQRT(ZW_UP2(:,:))
+PEMF(:,KKB) =0.
+
+! Limits the shallow convection scheme when cloud heigth is higher than 3000m.
+! To do this, mass flux is multiplied by a coefficient decreasing linearly
+! from 1 (for clouds of 3000m of depth) to 0 (for clouds of 4000m of depth).
+! This way, all MF fluxes are diminished by this amount.
+! Diagnosed cloud fraction is also multiplied by the same coefficient.
+!
+DO JI=1,SIZE(PTHM,1)
+ PDEPTH(JI) = MAX(0., PZZ(JI,KKCTL(JI)) - PZZ(JI,KKLCL(JI)) )
+END DO
+
+GWORK1(:)= (GTESTLCL(:) .AND. (PDEPTH(:) > ZDEPTH_MAX1) )
+GWORK2(:,:) = SPREAD( GWORK1(:), DIM=2, NCOPIES=IKU )
+ZCOEF(:,:) = SPREAD( (1.-(PDEPTH(:)-ZDEPTH_MAX1)/(ZDEPTH_MAX2-ZDEPTH_MAX1)), DIM=2, NCOPIES=IKU)
+ZCOEF=MIN(MAX(ZCOEF,0.),1.)
+WHERE (GWORK2)
+ PEMF(:,:) = PEMF(:,:) * ZCOEF(:,:)
+ PFRAC_UP(:,:) = PFRAC_UP(:,:) * ZCOEF(:,:)
+ENDWHERE
+
+END SUBROUTINE COMPUTE_UPDRAFT_RHCJ10
+
+
diff --git a/src/mesonh/turb/emoist.f90 b/src/mesonh/turb/emoist.f90
new file mode 100644
index 000000000..7703fb388
--- /dev/null
+++ b/src/mesonh/turb/emoist.f90
@@ -0,0 +1,185 @@
+!MNH_LIC Copyright 1995-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!#################
+MODULE MODI_EMOIST
+!#################
+!
+INTERFACE
+!
+FUNCTION EMOIST(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM) RESULT(PEMOIST)
+!
+INTEGER :: KRR ! number of moist var.
+INTEGER :: KRRI ! number of ice var.
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM ! Conservative pot. temperature
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios, where
+! PRM(:,:,:,1) = conservative mixing ratio
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exner at time t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! Amoist
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM ! Normalized 2dn_order
+ ! moment s'r'c/2Sigma_s2
+!
+REAL,DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)):: PEMOIST ! result
+!
+END FUNCTION EMOIST
+!
+END INTERFACE
+!
+END MODULE MODI_EMOIST
+!
+! ############################################################################
+FUNCTION EMOIST(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM) RESULT(PEMOIST)
+! ############################################################################
+!
+! PURPOSE
+!! -------
+! EMOIST computes the coefficient Emoist in the flottability turbulent
+! flux. This coefficient relates the vertical flux of the virtual potential
+! temperature ( <Thv' W'> ) to the vertical flux of the conservative mixing
+! ratio ( <Rnp' W'> ).
+!
+!!** METHOD
+!! ------
+!! The virtual potential temperature perturbation is linearized in function
+!! of Thl' and Rnp'. The result is
+!! Thv'= ( ZA + ZC * Atheta * 2 * SRC ) Thl'
+!! +( ZB + ZC * Amoist * 2 * SRC ) Rnp'
+!! From this relation, we can compute the verical turbulent fluxes.
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST : contains physical constants.
+!! XRV, XRD : R for water vapor and dry air
+!!
+!! REFERENCE
+!! ---------
+!!
+!! NONE
+!!
+!!
+!! AUTHOR
+!! ------
+!! Jean-Marie Carriere * Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 20/03/95
+!!
+!! J. Stein Feb 28, 1996 optimization + Doctorization
+!! J. Stein Spet 15, 1996 Amoist previously computed
+!! J.-P. Pinty May 20, 2003 Improve EMOIST expression
+!! 03/2021 (JL Redelsperger) Ocean model case
+!!
+!! ----------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+USE MODD_CST
+USE MODD_DYN_n, ONLY : LOCEAN
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments and result
+!
+!
+INTEGER :: KRR ! number of moist var.
+INTEGER :: KRRI ! number of ice var.
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM ! Conservative pot. temperature
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios, where
+! PRM(:,:,:,1) = conservative mixing ratio
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exner at time t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! Amoist
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM ! Normalized 2dn_order
+ ! moment s'r'c/2Sigma_s2
+!
+REAL,DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)):: PEMOIST ! result
+!
+!* 0.2 declarations of local variables
+!
+REAL,DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: &
+ ZA, ZRW
+! ZA = coeft A, ZRW = total mixing ratio rw
+REAL :: ZDELTA ! = Rv/Rd - 1
+INTEGER :: JRR ! moist loop counter
+!
+!---------------------------------------------------------------------------
+!
+!
+!* 1. COMPUTE EMOIST
+! --------------
+IF (LOCEAN) THEN
+ IF ( KRR == 0 ) THEN ! Unsalted
+ PEMOIST(:,:,:) = 0.
+ ELSE
+ PEMOIST(:,:,:) = 1. ! Salted case
+ END IF
+!
+ELSE
+!
+ IF ( KRR == 0 ) THEN ! dry case
+ PEMOIST(:,:,:) = 0.
+ ELSE IF ( KRR == 1 ) THEN ! only vapor
+ ZDELTA = (XRV/XRD) - 1.
+ PEMOIST(:,:,:) = ZDELTA*PTHLM(:,:,:)
+ ELSE ! liquid water & ice present
+ ZDELTA = (XRV/XRD) - 1.
+ ZRW(:,:,:) = PRM(:,:,:,1)
+!
+ IF ( KRRI>0) THEN ! rc and ri case
+ ZRW(:,:,:) = ZRW(:,:,:) + PRM(:,:,:,3)
+ DO JRR=5,KRR
+ ZRW(:,:,:) = ZRW(:,:,:) + PRM(:,:,:,JRR)
+ ENDDO
+ ZA(:,:,:) = 1. + ( & ! Compute A
+ (1.+ZDELTA) * (PRM(:,:,:,1) - PRM(:,:,:,2) - PRM(:,:,:,4)) &
+ -ZRW(:,:,:) &
+ ) / (1. + ZRW(:,:,:))
+ !
+ ! Emoist = ZB + ZC * Amoist
+ ! ZB is computed from line 1 to line 2
+ ! ZC is computed from line 3 to line 5
+ ! Amoist* 2 * SRC is computed at line 6
+ !
+ PEMOIST(:,:,:) = ZDELTA * (PTHLM(:,:,:) + PLOCPEXNM(:,:,:)*( &
+ PRM(:,:,:,2)+PRM(:,:,:,4)))&
+ / (1. + ZRW(:,:,:)) &
+ +( PLOCPEXNM(:,:,:) * ZA(:,:,:) &
+ -(1.+ZDELTA) * (PTHLM(:,:,:) + PLOCPEXNM(:,:,:)*( &
+ PRM(:,:,:,2)+PRM(:,:,:,4)))&
+ / (1. + ZRW(:,:,:)) &
+ ) * PAMOIST(:,:,:) * 2. * PSRCM(:,:,:)
+ ELSE
+ DO JRR=3,KRR
+ ZRW(:,:,:) = ZRW(:,:,:) + PRM(:,:,:,JRR)
+ ENDDO
+ ZA(:,:,:) = 1. + ( & ! Compute ZA
+ (1.+ZDELTA) * (PRM(:,:,:,1) - PRM(:,:,:,2)) &
+ -ZRW(:,:,:) &
+ ) / (1. + ZRW(:,:,:))
+ !
+ ! Emoist = ZB + ZC * Amoist
+ ! ZB is computed from line 1 to line 2
+ ! ZC is computed from line 3 to line 5
+ ! Amoist* 2 * SRC is computed at line 6
+ !
+ PEMOIST(:,:,:) = ZDELTA * (PTHLM(:,:,:) + PLOCPEXNM(:,:,:)*PRM(:,:,:,2)) &
+ / (1. + ZRW(:,:,:)) &
+ +( PLOCPEXNM(:,:,:) * ZA(:,:,:) &
+ -(1.+ZDELTA) * (PTHLM(:,:,:) + PLOCPEXNM(:,:,:)*PRM(:,:,:,2)) &
+ / (1. + ZRW(:,:,:)) &
+ ) * PAMOIST(:,:,:) * 2. * PSRCM(:,:,:)
+ END IF
+ END IF
+!
+END IF
+!---------------------------------------------------------------------------
+!
+END FUNCTION EMOIST
diff --git a/src/mesonh/turb/etheta.f90 b/src/mesonh/turb/etheta.f90
new file mode 100644
index 000000000..3ef29178b
--- /dev/null
+++ b/src/mesonh/turb/etheta.f90
@@ -0,0 +1,180 @@
+!MNH_LIC Copyright 1995-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!#################
+MODULE MODI_ETHETA
+!#################
+!
+INTERFACE
+!
+FUNCTION ETHETA(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM) RESULT(PETHETA)
+!
+INTEGER :: KRR ! number of moist var.
+INTEGER :: KRRI ! number of ice var.
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM ! Conservative pot. temperature
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios, where
+! PRM(:,:,:,1) = conservative mixing ratio
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exner at time t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! Atheta
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM ! Normalized 2dn_order
+ ! moment s'r'c/2Sigma_s2
+!
+REAL,DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)):: PETHETA ! result
+!
+!
+END FUNCTION ETHETA
+!
+END INTERFACE
+!
+END MODULE MODI_ETHETA
+!
+! ############################################################################
+FUNCTION ETHETA(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM) RESULT(PETHETA)
+! ############################################################################
+!
+! PURPOSE
+!! -------
+! ETHETA computes the coefficient Etheta in the flottability turbulent
+! flux. This coefficient relates the vertical flux of the virtual potential
+! temperature ( <Thv' W'> ) to the vertical flux of the conservative potential
+! temperature ( <Thl' W'> ).
+!
+!!** METHOD
+!! ------
+!!
+!! The virtual potential temperature perturbation is linearized in function
+!! of Thl' and Rnp'. The result is
+!! Thv'= ( ZA + ZC * Atheta * 2 * SRC ) Thl'
+!! +( ZB + ZC * Amoist * 2 * SRC ) Rnp'
+!! From this relation, we can compute the vertical turbulent fluxes.
+!!
+!! EXTERNAL
+!! --------
+!!
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST : contains physical constants.
+!! XRV, XRD : R for water vapor and dry air
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! Jean-Marie Carriere * Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 20/03/95
+!!
+!! J. Stein Feb 28, 1996 optimization + Doctorization
+!! J. Stein Sept 15, 1996 Atheta previously computed
+!! J.-P. Pinty May 20, 2003 Improve ETHETA expression
+!! J.L Redelsperger 03, 2021 Ocean Model Case
+!! ----------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+USE MODD_CST
+USE MODD_DYN_n, ONLY : LOCEAN
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments and result
+!
+!
+INTEGER :: KRR ! number of moist var.
+INTEGER :: KRRI ! number of ice var.
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM ! Conservative pot. temperature
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios, where
+! PRM(:,:,:,1) = conservative mixing ratio
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exner at time t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! Atheta
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM ! Normalized 2dn_order
+ ! moment s'r'c/2Sigma_s2
+!
+REAL,DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)):: PETHETA ! result
+!
+!
+!
+!* 0.2 declarations of local variables
+!
+REAL,DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: &
+ ZA, ZRW
+! ZA = coeft A, ZRW = total mixing ratio rw
+REAL :: ZDELTA ! = Rv/Rd - 1
+INTEGER :: JRR ! moist loop counter
+!
+!---------------------------------------------------------------------------
+!
+!
+!* 1. COMPUTE ETHETA
+! --------------
+!
+!
+IF (LOCEAN) THEN ! ocean case
+ PETHETA(:,:,:) = 1.
+ELSE
+ IF ( KRR == 0.) THEN ! dry case
+ PETHETA(:,:,:) = 1.
+ ELSE IF ( KRR == 1 ) THEN ! only vapor
+ ZDELTA = (XRV/XRD) - 1.
+ PETHETA(:,:,:) = 1. + ZDELTA*PRM(:,:,:,1)
+ ELSE ! liquid water & ice present
+ ZDELTA = (XRV/XRD) - 1.
+ ZRW(:,:,:) = PRM(:,:,:,1)
+!
+ IF ( KRRI>0 ) THEN ! rc and ri case
+ ZRW(:,:,:) = ZRW(:,:,:) + PRM(:,:,:,3)
+ DO JRR=5,KRR
+ ZRW(:,:,:) = ZRW(:,:,:) + PRM(:,:,:,JRR)
+ ENDDO
+ ZA(:,:,:) = 1. + ( & ! Compute A
+ (1.+ZDELTA) * (PRM(:,:,:,1) - PRM(:,:,:,2) - PRM(:,:,:,4)) &
+ -ZRW(:,:,:) &
+ ) / (1. + ZRW(:,:,:))
+ !
+ ! Etheta = ZA + ZC * Atheta
+ ! ZC is computed from line 2 to line 5
+ ! - Atheta * 2. * SRC is computed at line 6
+ !
+ PETHETA(:,:,:) = ZA(:,:,:) &
+ +( PLOCPEXNM(:,:,:) * ZA(:,:,:) &
+ -(1.+ZDELTA) * (PTHLM(:,:,:) + PLOCPEXNM(:,:,:)*( &
+ PRM(:,:,:,2)+PRM(:,:,:,4)))&
+ / (1. + ZRW(:,:,:)) &
+ ) * PATHETA(:,:,:) * 2. * PSRCM(:,:,:)
+ ELSE
+ DO JRR=3,KRR
+ ZRW(:,:,:) = ZRW(:,:,:) + PRM(:,:,:,JRR)
+ ENDDO
+ ZA(:,:,:) = 1. + ( & ! Compute A
+ (1.+ZDELTA) * (PRM(:,:,:,1) - PRM(:,:,:,2)) &
+ -ZRW(:,:,:) &
+ ) / (1. + ZRW(:,:,:))
+ !
+ ! Etheta = ZA + ZC * Atheta
+ ! ZC is computed from line 2 to line 5
+ ! - Atheta * 2. * SRC is computed at line 6
+ !
+ PETHETA(:,:,:) = ZA(:,:,:) &
+ +( PLOCPEXNM(:,:,:) * ZA(:,:,:) &
+ -(1.+ZDELTA) * (PTHLM(:,:,:) + PLOCPEXNM(:,:,:)*PRM(:,:,:,2)) &
+ / (1. + ZRW(:,:,:)) &
+ ) * PATHETA(:,:,:) * 2. * PSRCM(:,:,:)
+ END IF
+ END IF
+!
+END IF
+!---------------------------------------------------------------------------
+!
+END FUNCTION ETHETA
diff --git a/src/mesonh/turb/ini_cturb.f90 b/src/mesonh/turb/ini_cturb.f90
new file mode 100644
index 000000000..245dfa063
--- /dev/null
+++ b/src/mesonh/turb/ini_cturb.f90
@@ -0,0 +1,254 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$ $Date$
+!-----------------------------------------------------------------
+!-----------------------------------------------------------------
+! #####################
+ MODULE MODI_INI_CTURB
+! #####################
+!
+INTERFACE
+!
+SUBROUTINE INI_CTURB
+END SUBROUTINE INI_CTURB
+!
+END INTERFACE
+!
+END MODULE MODI_INI_CTURB
+!
+!
+!
+! ####################
+ SUBROUTINE INI_CTURB
+! ####################
+!
+!!**** *INI_CTURB* - routine to initialize the turbulence scheme
+!! constants.
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to initialize the turbulence
+! scheme constants that are stored in module MODD_CTURB
+!
+!! METHOD
+!! ------
+!! The constants are set to their numerical values
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CTURB
+!!
+!! REFERENCE
+!! ---------
+!! Book 2 of Meso-NH documentation (module INI_CTURB)
+!! Book 1 of Meso-NH documentation (Chapter Turbulence)
+!!
+!! AUTHOR
+!! ------
+!! Joan Cuxart * INM and Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 08/08/94
+!! J.Cuxart 15/06/95 document more precisely the Shuman cts
+!! P.Jabouille 20/10/99 XCET=0.4
+!! V.Masson 13/11/02 XALPSBL and XASBL
+!! 05/06 Remove KEPS
+!! Q.Rodier 01/19 XCED replaced by XCEDIS in read_exsegn.f90 and ini_modeln.f90
+!! Remove XASBL (not used)
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_CTURB
+!
+IMPLICIT NONE
+!
+! ---------------------------------------------------------------------------
+!
+! 1. SETTING THE NUMERICAL VALUES
+! ----------------------------
+!
+! 1.1 Constant for dissipation of Tke
+!
+!XCED is now replaced by XCEDIS
+!XCED = 0.70
+!XCED = 0.84
+!
+! Redelsperger-Sommeria (1981) = 0.70
+! Schmidt-Schumann (1989) = 0.845
+! Cheng-Canuto-Howard (2002) = 0.845
+! Rodier, Masson, Couvreux, Paci (2017) = 0.34
+!
+!
+! 1.2 Constant for wind pressure-correlations
+!
+!XCEP = 4.
+XCEP = 2.11
+! Redelsperger-Sommeria (1981) = 4.
+! Schmidt-Schumann (1989) = 3.5
+! Cheng-Canuto-Howard (2002) = 2.11
+!
+!
+! 1.3 Constant a0 for wind pressure-correlations
+!
+XA0 = 0.6
+! Redelsperger-Sommeria (1981) = 0.6
+! Schmidt-Schumann (1989) = 0.55
+! Cheng-Canuto-Howard (2002) = 0.6
+!
+!
+! 1.4 Constant a2 for wind pressure-correlations
+!
+XA2 = 1.
+! Redelsperger-Sommeria (1981) = 1.
+! Schmidt-Schumann (1989) = 1.
+! Cheng-Canuto-Howard (2002) = 0.57
+!
+!
+! 1.5 Constant a3 for wind pressure-correlations
+!
+XA3 = 0.
+! Redelsperger-Sommeria (1981) = 0.
+! Schmidt-Schumann (1989) = 0.45
+! Cheng-Canuto-Howard (2002) = 0.5
+!
+!
+! 1.6 Constant for dissipation of th'2, r'2, th'r'
+!
+XCTD = 1.2
+! Redelsperger-Sommeria (1981) = 1.2
+! Schmidt-Schumann (1989) = 1.01
+! Cheng-Canuto-Howard (2002) = 0.98
+!
+!
+! 1.7 Constant for temperature and vapor pressure-correlations
+!
+XCTP = 4.65
+! Redelsperger-Sommeria (1981) = 4.
+! Schmidt-Schumann (1989) = 3.25
+! Cheng-Canuto-Howard (2002) = 4.65
+!
+!
+! 1.8 Constant a5 for temperature pressure-correlations
+!
+XA5 = 1./3.
+! Redelsperger-Sommeria (1981) = 1./3.
+! Schmidt-Schumann (1989) = 0.
+! Cheng-Canuto-Howard (2002) = 1./3.
+!
+!
+! 1.9 Values in the evolution equation of the TKE
+!
+XCET = 0.40
+!
+! Redelsperger-Sommeria (1981) = 0.20
+! Schmidt-Schumann (1989) = 0.33
+! Krettenauer-Schumann (1992) = 0.33
+! Bougeault and Lacarrere(1989)= 0.40
+!
+!
+! 1.10 Value related to the TKE universal function within SBL
+!
+XALPSBL = 4.63
+! Redelsperger et al 2001 = 4.63
+! Wyngaard et al. 1974 = 3.75
+! Stull 1988 = 4.75
+!
+!
+! 1.11 Value related to the shear term in mixing length computation
+!
+XRM17 = 0.5 ! Rodier et al 2017
+!
+!
+! 2. Derivated constants
+! -------------------
+!
+! 2.1 Constant in fluxes equations
+!
+XCMFS= 2./3./XCEP*(1.-XA0) !Constant for the momentum flux due to shear (RS)
+!
+! Redelsperger-Sommeria (1981) ......... 0.066
+! Schmidt-Schumann (1989) ......... 0.086
+!
+!
+XCSHF= 2./3./XCTP !Constant for the sensible heat flux(RS)
+!
+! Redelsperger-Sommeria (1981) ......... 0.167
+! Schmidt-Schumann (1989) ......... 0.204
+!
+!
+XCHF= XCSHF !Constant for the humidity flux(RS)
+!
+! 2.2 Constant in variances and covariances equations
+!
+XCTV= 2./3./XCTP/XCTD !Constant for the temperature variance(RS)
+!
+! Redelsperger-Sommeria (1981) ......... 0.139
+! Schmidt-Schumann (1989) ......... 0.202
+!
+XCHV= XCTV !Constant for the humidity variance(RS)
+!
+! Redelsperger-Sommeria (1981) ......... 0.139
+!
+!
+XCHT1= XCTV/2. !Constants for the temperature-humidity correlation(RS)
+XCHT2= XCTV/2.
+!
+! 2.3 Constant in Prandtl numbers
+!
+XCPR1= XCTV !Constants for the turbulent Prandtl and Schmidt numbers
+XCPR2= XCHT1
+XCPR3= XCPR2 ! used only for the Schmidt number for scalar variables
+XCPR4= XCPR2
+XCPR5= XCPR2
+!
+! 3. MINIMUM VALUES
+! --------------
+!
+XTKEMIN=0.01
+!
+!XLINI=10. ! BL mixing length
+XLINI=0.1 ! BL mixing length
+XLINF=1.E-10! to prevent division by zero
+!
+!
+! 4. MAXIMUM VALUES
+! --------------
+!
+XPHI_LIM = 3.
+!
+!
+! 5. Constants in K-eps scheme
+! -------------------------
+!
+! 1.3 Values in the evolution equation of the dissipation of TKE
+XCDP = 1.46
+! Duynkerke (1988) = 1.46
+!
+XCDD = 1.83
+! Duynkerke (1988) = 1.83
+!
+XCDT = 0.42
+! Duynkerke (1988) = 1./(2.38)
+!
+!
+! 6. Constants in RMC01
+! ------------------
+!
+XSBL_O_BL = 0.05 ! SBL height / BL height ratio
+XFTOP_O_FSURF = 0.05 ! Fraction of surface (heat or momentum) flux used to define top of BL
+!
+!
+END SUBROUTINE INI_CTURB
diff --git a/src/mesonh/turb/mf_turb.f90 b/src/mesonh/turb/mf_turb.f90
new file mode 100644
index 000000000..2a96b713a
--- /dev/null
+++ b/src/mesonh/turb/mf_turb.f90
@@ -0,0 +1,332 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+! ######################
+ MODULE MODI_MF_TURB
+! ######################
+!
+INTERFACE
+! #################################################################
+ SUBROUTINE MF_TURB(KKA,KKB,KKE,KKU,KKL,OMIXUV, &
+ ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
+ PIMPL, PTSTEP, &
+ PDZZ, &
+ PRHODJ, &
+ PTHLM,PTHVM,PRTM,PUM,PVM,PSVM, &
+ PTHLDT,PRTDT,PUDT,PVDT,PSVDT, &
+ PEMF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP,PSV_UP, &
+ PFLXZTHMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF, &
+ PFLXZSVMF )
+
+! #################################################################
+!
+!
+!* 1.1 Declaration of Arguments
+!
+!
+INTEGER, INTENT(IN) :: KKA ! near ground array index
+INTEGER, INTENT(IN) :: KKB ! near ground physical index
+INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
+INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+
+LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum
+LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer
+INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer
+INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer
+REAL, INTENT(IN) :: PIMPL ! degree of implicitness
+REAL, INTENT(IN) :: PTSTEP ! Dynamical timestep
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! metric coefficients
+
+REAL, DIMENSION(:,:), INTENT(IN) :: PRHODJ ! dry density * Grid size
+
+! Conservative var. at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM ! conservative pot. temp.
+REAL, DIMENSION(:,:), INTENT(IN) :: PRTM ! water var. where
+! Virtual potential temperature at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHVM
+! Momentum at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PUM
+REAL, DIMENSION(:,:), INTENT(IN) :: PVM
+! scalar variables at t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVM
+!
+! Tendencies of conservative variables
+REAL, DIMENSION(:,:), INTENT(OUT) :: PTHLDT
+
+REAL, DIMENSION(:,:), INTENT(OUT) :: PRTDT
+! Tendencies of momentum
+REAL, DIMENSION(:,:), INTENT(OUT) :: PUDT
+REAL, DIMENSION(:,:), INTENT(OUT) :: PVDT
+! Tendencies of scalar variables
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSVDT
+
+
+! Updraft characteritics
+REAL, DIMENSION(:,:), INTENT(IN) :: PEMF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSV_UP
+! Fluxes
+REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZTHMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF
+
+REAL, DIMENSION(:,:,:), INTENT(OUT):: PFLXZSVMF
+
+END SUBROUTINE MF_TURB
+
+END INTERFACE
+!
+END MODULE MODI_MF_TURB
+
+
+! #################################################################
+ SUBROUTINE MF_TURB(KKA,KKB,KKE,KKU,KKL,OMIXUV, &
+ ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
+ PIMPL, PTSTEP, &
+ PDZZ, &
+ PRHODJ, &
+ PTHLM,PTHVM,PRTM,PUM,PVM,PSVM, &
+ PTHLDT,PRTDT,PUDT,PVDT,PSVDT, &
+ PEMF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP,PSV_UP, &
+ PFLXZTHMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF, &
+ PFLXZSVMF )
+
+! #################################################################
+!
+!
+!!**** *MF_TURB* - computes the MF_turbulent source terms for the prognostic
+!! variables.
+!!
+!! PURPOSE
+!! -------
+!!**** The purpose of this routine is to compute the source terms in
+!! the evolution equations due to the MF turbulent mixing.
+!! The source term is computed as the divergence of the turbulent fluxes.
+!
+!!** METHOD
+!! ------
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!!
+!!
+!! MODIFICATIONS
+!! -------------
+!! 10/2009 (C.Lac) Introduction of different PTSTEP according to the
+!! advection schemes
+!! 09/2010 (V.Masson) Optimization
+!! S. Riette Jan 2012: support for both order of vertical levels
+!! suppression of useless initialisations
+!!
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAM_MFSHALL_n
+!
+USE MODI_SHUMAN_MF
+USE MODI_TRIDIAG_MASSFLUX
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+!
+INTEGER, INTENT(IN) :: KKA ! near ground array index
+INTEGER, INTENT(IN) :: KKB ! near ground physical index
+INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
+INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum
+LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer
+INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer
+INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer
+REAL, INTENT(IN) :: PIMPL ! degree of implicitness
+REAL, INTENT(IN) :: PTSTEP ! Dynamical timestep
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! metric coefficients
+
+REAL, DIMENSION(:,:), INTENT(IN) :: PRHODJ ! dry density * Grid size
+
+! Conservative var. at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM ! conservative pot. temp.
+REAL, DIMENSION(:,:), INTENT(IN) :: PRTM ! water var. where
+! Virtual potential temperature at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHVM
+! Momentum at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PUM
+REAL, DIMENSION(:,:), INTENT(IN) :: PVM
+! scalar variables at t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVM
+!
+! Tendencies of conservative variables
+REAL, DIMENSION(:,:), INTENT(OUT) :: PTHLDT
+
+REAL, DIMENSION(:,:), INTENT(OUT) :: PRTDT
+! Tendencies of momentum
+REAL, DIMENSION(:,:), INTENT(OUT) :: PUDT
+REAL, DIMENSION(:,:), INTENT(OUT) :: PVDT
+! Tendencies of scalar variables
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSVDT
+
+
+! Updraft characteritics
+REAL, DIMENSION(:,:), INTENT(IN) :: PEMF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSV_UP
+! Fluxes
+REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZTHMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF
+
+REAL, DIMENSION(:,:,:), INTENT(OUT):: PFLXZSVMF
+!
+!
+!
+!-------------------------------------------------------------------------------
+!
+! 0.2 declaration of local variables
+!
+
+REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2)) :: ZVARS
+
+!
+INTEGER :: ISV,JSV !number of scalar variables and Loop counter
+!
+!----------------------------------------------------------------------------
+!
+!* 1.PRELIMINARIES
+! -------------
+!
+!
+! number of scalar var
+ISV=SIZE(PSVM,3)
+
+!
+PFLXZSVMF = 0.
+PSVDT = 0.
+
+!
+!----------------------------------------------------------------------------
+!
+!* 2. COMPUTE THE MEAN FLUX OF CONSERVATIVE VARIABLES at time t-dt
+! (equation (3) of Soares et al)
+! + THE MEAN FLUX OF THETA_V (buoyancy flux)
+! -----------------------------------------------
+! ( Resulting fluxes are in flux level (w-point) as PEMF and PTHL_UP )
+!
+
+PFLXZTHMF(:,:) = PEMF(:,:)*(PTHL_UP(:,:)-MZM_MF(KKA,KKU,KKL,PTHLM(:,:)))
+
+PFLXZRMF(:,:) = PEMF(:,:)*(PRT_UP(:,:)-MZM_MF(KKA,KKU,KKL,PRTM(:,:)))
+
+PFLXZTHVMF(:,:) = PEMF(:,:)*(PTHV_UP(:,:)-MZM_MF(KKA,KKU,KKL,PTHVM(:,:)))
+
+IF (OMIXUV) THEN
+ PFLXZUMF(:,:) = PEMF(:,:)*(PU_UP(:,:)-MZM_MF(KKA,KKU,KKL,PUM(:,:)))
+ PFLXZVMF(:,:) = PEMF(:,:)*(PV_UP(:,:)-MZM_MF(KKA,KKU,KKL,PVM(:,:)))
+ELSE
+ PFLXZUMF(:,:) = 0.
+ PFLXZVMF(:,:) = 0.
+ENDIF
+!
+!
+!----------------------------------------------------------------------------
+!
+!* 3. COMPUTE TENDENCIES OF CONSERVATIVE VARIABLES (or treated as such...)
+! (implicit formulation)
+! --------------------------------------------
+!
+
+!
+!
+! 3.1 Compute the tendency for the conservative potential temperature
+! (PDZZ and flux in w-point and PRHODJ is mass point, result in mass point)
+!
+CALL TRIDIAG_MASSFLUX(KKA,KKB,KKE,KKU,KKL,PTHLM,PFLXZTHMF,-PEMF,PTSTEP,PIMPL, &
+ PDZZ,PRHODJ,ZVARS )
+! compute new flux
+PFLXZTHMF(:,:) = PEMF(:,:)*(PTHL_UP(:,:)-MZM_MF(KKA,KKU,KKL,ZVARS(:,:)))
+
+!!! compute THL tendency
+!
+PTHLDT(:,:)= (ZVARS(:,:)-PTHLM(:,:))/PTSTEP
+
+!
+! 3.2 Compute the tendency for the conservative mixing ratio
+!
+CALL TRIDIAG_MASSFLUX(KKA,KKB,KKE,KKU,KKL,PRTM(:,:),PFLXZRMF,-PEMF,PTSTEP,PIMPL, &
+ PDZZ,PRHODJ,ZVARS )
+! compute new flux
+PFLXZRMF(:,:) = PEMF(:,:)*(PRT_UP(:,:)-MZM_MF(KKA,KKU,KKL,ZVARS(:,:)))
+
+!!! compute RT tendency
+PRTDT(:,:) = (ZVARS(:,:)-PRTM(:,:))/PTSTEP
+!
+
+IF (OMIXUV) THEN
+ !
+ ! 3.3 Compute the tendency for the (non conservative but treated as it) zonal momentum
+ ! (PDZZ and flux in w-point and PRHODJ is mass point, result in mass point)
+ !
+
+ CALL TRIDIAG_MASSFLUX(KKA,KKB,KKE,KKU,KKL,PUM,PFLXZUMF,-PEMF,PTSTEP,PIMPL, &
+ PDZZ,PRHODJ,ZVARS )
+ ! compute new flux
+ PFLXZUMF(:,:) = PEMF(:,:)*(PU_UP(:,:)-MZM_MF(KKA,KKU,KKL,ZVARS(:,:)))
+
+ ! compute U tendency
+ PUDT(:,:)= (ZVARS(:,:)-PUM(:,:))/PTSTEP
+
+ !
+ !
+ ! 3.4 Compute the tendency for the (non conservative but treated as it for the time beiing)
+ ! meridian momentum
+ ! (PDZZ and flux in w-point and PRHODJ is mass point, result in mass point)
+ !
+ CALL TRIDIAG_MASSFLUX(KKA,KKB,KKE,KKU,KKL,PVM,PFLXZVMF,-PEMF,PTSTEP,PIMPL, &
+ PDZZ,PRHODJ,ZVARS )
+ ! compute new flux
+ PFLXZVMF(:,:) = PEMF(:,:)*(PV_UP(:,:)-MZM_MF(KKA,KKU,KKL,ZVARS(:,:)))
+
+ ! compute V tendency
+ PVDT(:,:)= (ZVARS(:,:)-PVM(:,:))/PTSTEP
+ELSE
+ PUDT(:,:)=0.
+ PVDT(:,:)=0.
+ENDIF
+
+DO JSV=1,ISV
+
+ IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE
+
+ !* compute mean flux of scalar variables at time t-dt
+ ! ( Resulting fluxes are in flux level (w-point) as PEMF and PTHL_UP )
+
+ PFLXZSVMF(:,:,JSV) = PEMF(:,:)*(PSV_UP(:,:,JSV)-MZM_MF(KKA,KKU,KKL,PSVM(:,:,JSV)))
+
+ !
+ ! 3.5 Compute the tendency for scalar variables
+ ! (PDZZ and flux in w-point and PRHODJ is mass point, result in mass point)
+ !
+ CALL TRIDIAG_MASSFLUX(KKA,KKB,KKE,KKU,KKL,PSVM(:,:,JSV),PFLXZSVMF(:,:,JSV),&
+ -PEMF,PTSTEP,PIMPL,PDZZ,PRHODJ,ZVARS )
+ ! compute new flux
+ PFLXZSVMF(:,:,JSV) = PEMF(:,:)*(PSV_UP(:,:,JSV)-MZM_MF(KKA,KKU,KKL,ZVARS))
+
+ ! compute Sv tendency
+ PSVDT(:,:,JSV)= (ZVARS(:,:)-PSVM(:,:,JSV))/PTSTEP
+
+ENDDO
+!
+END SUBROUTINE MF_TURB
diff --git a/src/mesonh/turb/mf_turb_expl.f90 b/src/mesonh/turb/mf_turb_expl.f90
new file mode 100644
index 000000000..a22f092c2
--- /dev/null
+++ b/src/mesonh/turb/mf_turb_expl.f90
@@ -0,0 +1,227 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+! ######################
+ MODULE MODI_MF_TURB_EXPL
+! ######################
+!
+INTERFACE
+!
+! #################################################################
+ SUBROUTINE MF_TURB_EXPL(KKA,KKB,KKE,KKU,KKL,OMIXUV, &
+ PRHODJ, &
+ PTHLM,PTHVM,PRTM,PUM,PVM, &
+ PTHLDT,PRTDT,PUDT,PVDT, &
+ PEMF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP, &
+ PFLXZTHLMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF)
+! #################################################################
+!
+!* 1.1 Declaration of Arguments
+!
+!
+INTEGER, INTENT(IN) :: KKA ! near ground array index
+INTEGER, INTENT(IN) :: KKB ! near ground physical index
+INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
+INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum
+
+REAL, DIMENSION(:,:), INTENT(IN) :: PRHODJ ! dry density * Grid size
+
+! Conservative var. at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM ! conservative pot. temp.
+REAL, DIMENSION(:,:), INTENT(IN) :: PRTM ! water var. where
+
+! Virtual potential temperature at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHVM
+! Momentum at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PUM
+REAL, DIMENSION(:,:), INTENT(IN) :: PVM
+!
+! Tendencies of conservative variables
+REAL, DIMENSION(:,:), INTENT(OUT) :: PTHLDT
+
+REAL, DIMENSION(:,:), INTENT(OUT) :: PRTDT
+
+! Tendencies of momentum
+REAL, DIMENSION(:,:), INTENT(OUT) :: PUDT
+REAL, DIMENSION(:,:), INTENT(OUT) :: PVDT
+
+! Updraft characteritics
+REAL, DIMENSION(:,:), INTENT(IN) :: PEMF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP
+
+! Fluxes
+REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZTHLMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF
+
+END SUBROUTINE MF_TURB_EXPL
+
+END INTERFACE
+!
+END MODULE MODI_MF_TURB_EXPL
+!
+
+! ######spl
+ SUBROUTINE MF_TURB_EXPL(KKA,KKB,KKE,KKU,KKL,OMIXUV, &
+ PRHODJ, &
+ PTHLM,PTHVM,PRTM,PUM,PVM, &
+ PTHLDT,PRTDT,PUDT,PVDT, &
+ PEMF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP, &
+ PFLXZTHLMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF)
+
+! #################################################################
+!
+!
+!!**** *MF_TURB_EXPL* - computes the MF_turbulent source terms for the prognostic
+!! variables (when PIMPL=0)
+!!
+!! PURPOSE
+!! -------
+!!**** The purpose of this routine is to compute the source terms in
+!! the evolution equations due to the MF turbulent mixing.
+!! The source term is computed as the divergence of the turbulent fluxes.
+!
+!!** METHOD
+!! ------
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!!
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+
+USE MODD_PARAM_MFSHALL_n
+USE MODI_SHUMAN_MF
+
+IMPLICIT NONE
+
+
+!* 0.1 declarations of arguments
+
+
+INTEGER, INTENT(IN) :: KKA ! near ground array index
+INTEGER, INTENT(IN) :: KKB ! near ground physical index
+INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
+INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum
+
+REAL, DIMENSION(:,:), INTENT(IN) :: PRHODJ ! dry density * Grid size
+
+! Conservative var. at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM ! conservative pot. temp.
+REAL, DIMENSION(:,:), INTENT(IN) :: PRTM ! water var. where
+
+! Virtual potential temperature at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHVM
+! Momentum at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PUM
+REAL, DIMENSION(:,:), INTENT(IN) :: PVM
+!
+! Tendencies of conservative variables
+REAL, DIMENSION(:,:), INTENT(OUT) :: PTHLDT
+
+REAL, DIMENSION(:,:), INTENT(OUT) :: PRTDT
+
+! Tendencies of momentum
+REAL, DIMENSION(:,:), INTENT(OUT) :: PUDT
+REAL, DIMENSION(:,:), INTENT(OUT) :: PVDT
+
+! Updraft characteritics
+REAL, DIMENSION(:,:), INTENT(IN) :: PEMF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP
+
+! Fluxes
+REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZTHLMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF
+
+REAL, DIMENSION(SIZE(PFLXZTHLMF,1),SIZE(PFLXZTHLMF,2)) :: ZFLXZTHSMF,ZTHS_UP,ZTHSM ! Theta S flux
+REAL, DIMENSION(SIZE(PFLXZTHLMF,1),SIZE(PFLXZTHLMF,2)) :: ZQT_UP,ZQTM,ZTHSDT,ZQTDT
+REAL, DIMENSION(SIZE(PFLXZTHLMF,1),SIZE(PFLXZTHLMF,2)) :: ZTHLM_F,ZRTM_F
+
+INTEGER :: JK ! loop counter
+
+!----------------------------------------------------------------------------
+!
+!* 1.PRELIMINARIES
+! -------------
+
+PFLXZRMF = 0.
+PFLXZTHVMF = 0.
+PFLXZTHLMF = 0.
+PFLXZUMF = 0.
+PFLXZVMF = 0.
+PTHLDT = 0.
+PRTDT = 0.
+PUDT = 0.
+PVDT = 0.
+
+!
+!----------------------------------------------------------------------------
+!
+!* 2. COMPUTE THE MEAN FLUX OF CONSERVATIVE VARIABLES at time t-dt
+! (equation (3) of Soares et al)
+! + THE MEAN FLUX OF THETA_V (buoyancy flux)
+! -----------------------------------------------
+! ( Resulting fluxes are in flux level (w-point) as PEMF and PTHL_UP )
+
+ZRTM_F (:,:) = MZM_MF(KKA,KKU,KKL,PRTM (:,:))
+ZTHLM_F(:,:) = MZM_MF(KKA,KKU,KKL,PTHLM(:,:))
+ZQTM (:,:) = ZRTM_F (:,:)/(1.+ZRTM_F (:,:))
+ZQT_UP (:,:) = PRT_UP (:,:)/(1.+PRT_UP (:,:))
+ZTHS_UP(:,:) = PTHL_UP(:,:)*(1.+XLAMBDA_MF*ZQT_UP(:,:))
+ZTHSM (:,:) = ZTHLM_F(:,:)*(1.+XLAMBDA_MF*ZQTM(:,:))
+
+PFLXZTHLMF(:,:) = PEMF(:,:)*(PTHL_UP(:,:)-MZM_MF(KKA,KKU,KKL,PTHLM(:,:))) ! ThetaL
+PFLXZRMF(:,:) = PEMF(:,:)*(PRT_UP (:,:)-MZM_MF(KKA,KKU,KKL,PRTM (:,:))) ! Rt
+PFLXZTHVMF(:,:) = PEMF(:,:)*(PTHV_UP(:,:)-MZM_MF(KKA,KKU,KKL,PTHVM(:,:))) ! ThetaV
+
+ZFLXZTHSMF(:,:) = PEMF(:,:)*(ZTHS_UP(:,:)-ZTHSM(:,:)) ! Theta S flux
+
+IF (OMIXUV) THEN
+ PFLXZUMF(:,:) = PEMF(:,:)*(PU_UP(:,:)-MZM_MF(KKA,KKU,KKL,PUM(:,:))) ! U
+ PFLXZVMF(:,:) = PEMF(:,:)*(PV_UP(:,:)-MZM_MF(KKA,KKU,KKL,PVM(:,:))) ! V
+ELSE
+ PFLXZUMF(:,:) = 0.
+ PFLXZVMF(:,:) = 0.
+ENDIF
+
+
+!----------------------------------------------------------------------------
+!
+!* 3. COMPUTE TENDENCIES OF CONSERVATIVE VARIABLES (or treated as such...)
+! (explicit formulation)
+! --------------------------------------------
+
+DO JK=KKB,KKE-KKL,KKL
+! PTHLDT(:,JK) = (PFLXZTHLMF(:,JK ) - PFLXZTHLMF(:,JK+KKL)) / PRHODJ(:,JK)
+ PRTDT (:,JK) = (PFLXZRMF (:,JK ) - PFLXZRMF (:,JK+KKL)) / PRHODJ(:,JK)
+ ZQTDT (:,JK) = PRTDT (:,JK)/(1.+ ZRTM_F (:,JK)*ZRTM_F (:,JK))
+ ZTHSDT(:,JK) = (ZFLXZTHSMF(:,JK ) - ZFLXZTHSMF(:,JK+KKL)) / PRHODJ(:,JK)
+ PTHLDT(:,JK) = ZTHSDT(:,JK)/(1.+XLAMBDA_MF*ZQTM(:,JK)) - ZTHLM_F(:,JK)*XLAMBDA_MF*ZQTDT(:,JK)
+END DO
+
+IF (OMIXUV) THEN
+ DO JK=KKB,KKE-KKL,KKL
+ PUDT(:,JK) = (PFLXZUMF(:,JK ) - PFLXZUMF(:,JK+KKL)) / PRHODJ(:,JK)
+ PVDT(:,JK) = (PFLXZVMF(:,JK ) - PFLXZVMF(:,JK+KKL)) / PRHODJ(:,JK)
+ END DO
+ENDIF
+
+
+END SUBROUTINE MF_TURB_EXPL
diff --git a/src/mesonh/turb/mf_turb_greyzone.f90 b/src/mesonh/turb/mf_turb_greyzone.f90
new file mode 100644
index 000000000..ab28b6c61
--- /dev/null
+++ b/src/mesonh/turb/mf_turb_greyzone.f90
@@ -0,0 +1,340 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+! ######spl
+ MODULE MODI_MF_TURB_GREYZONE
+! ######################
+!
+INTERFACE
+! #################################################################
+ SUBROUTINE MF_TURB_GREYZONE(KKA,KKB,KKE,KKU,KKL,OMIXUV, &
+ ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
+ PIMPL, PTSTEP, &
+ PDZZ, &
+ PRHODJ, &
+ PTHLM,PTHVM,PRTM,PUM,PVM,PSVM, &
+ PTHLDT,PRTDT,PUDT,PVDT,PSVDT, &
+ PEMF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP,PSV_UP, &
+ PTHL_DO,PTHV_DO,PRT_DO,PU_DO,PV_DO,PSV_DO, &
+ PFLXZTHMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF, &
+ PFLXZSVMF )
+
+! #################################################################
+!
+!
+!* 1.1 Declaration of Arguments
+!
+!
+INTEGER, INTENT(IN) :: KKA ! near ground array index
+INTEGER, INTENT(IN) :: KKB ! near ground physical index
+INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
+INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+
+LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum
+LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer
+INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer
+INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer
+REAL, INTENT(IN) :: PIMPL ! degree of implicitness
+REAL, INTENT(IN) :: PTSTEP ! Dynamical timestep
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! metric coefficients
+
+REAL, DIMENSION(:,:), INTENT(IN) :: PRHODJ ! dry density * Grid size
+
+! Conservative var. at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM ! conservative pot. temp.
+REAL, DIMENSION(:,:), INTENT(IN) :: PRTM ! water var. where
+! Virtual potential temperature at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHVM
+! Momentum at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PUM
+REAL, DIMENSION(:,:), INTENT(IN) :: PVM
+! scalar variables at t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVM
+!
+! Tendencies of conservative variables
+REAL, DIMENSION(:,:), INTENT(OUT) :: PTHLDT
+
+REAL, DIMENSION(:,:), INTENT(OUT) :: PRTDT
+! Tendencies of momentum
+REAL, DIMENSION(:,:), INTENT(OUT) :: PUDT
+REAL, DIMENSION(:,:), INTENT(OUT) :: PVDT
+! Tendencies of scalar variables
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSVDT
+
+
+! Updraft characteritics
+REAL, DIMENSION(:,:), INTENT(IN) :: PEMF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHL_DO,PTHV_DO,PRT_DO,PU_DO,PV_DO
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSV_UP, PSV_DO
+! Fluxes
+REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZTHMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF
+
+REAL, DIMENSION(:,:,:), INTENT(OUT):: PFLXZSVMF
+
+END SUBROUTINE MF_TURB_GREYZONE
+
+END INTERFACE
+!
+END MODULE MODI_MF_TURB_GREYZONE
+! #################################################################
+ SUBROUTINE MF_TURB_GREYZONE(KKA, KKB, KKE, KKU, KKL,OMIXUV, &
+ ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
+ PIMPL, PTSTEP, &
+ PDZZ, &
+ PRHODJ, &
+ PTHLM,PTHVM,PRTM,PUM,PVM,PSVM, &
+ PTHLDT,PRTDT,PUDT,PVDT,PSVDT, &
+ PEMF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP,PSV_UP, &
+ PTHL_DO,PTHV_DO,PRT_DO,PU_DO,PV_DO,PSV_DO, &
+ PFLXZTHMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF, &
+ PFLXZSVMF )
+
+! #################################################################
+!
+!
+!!**** *MF_TURB_GREYZONE* - computes the MF_turbulent source terms for the prognostic
+!! variables.
+!!
+!! PURPOSE
+!! -------
+!!**** The purpose of this routine is to compute the source terms in
+!! the evolution equations due to the MF turbulent mixing.
+!! The source term is computed as the divergence of the turbulent fluxes.
+!
+!!** METHOD
+!! ------
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!!
+!!
+!! MODIFICATIONS
+!! -------------
+!! 10/2009 (C.Lac) Introduction of different PTSTEP according to the
+!! advection schemes
+!! 09/2010 (V.Masson) Optimization
+!! S. Riette Jan 2012: support for both order of vertical levels
+!! suppression of useless initialisations
+!!
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAM_MFSHALL_n
+!
+USE MODI_SHUMAN_MF
+USE MODI_TRIDIAG_MASSFLUX
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+!
+INTEGER, INTENT(IN) :: KKA ! near ground array index
+INTEGER, INTENT(IN) :: KKB ! near ground physical index
+INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
+INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum
+LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer
+INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer
+INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer
+REAL, INTENT(IN) :: PIMPL ! degree of implicitness
+REAL, INTENT(IN) :: PTSTEP ! Dynamical timestep
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! metric coefficients
+
+REAL, DIMENSION(:,:), INTENT(IN) :: PRHODJ ! dry density * Grid size
+
+! Conservative var. at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM ! conservative pot. temp.
+REAL, DIMENSION(:,:), INTENT(IN) :: PRTM ! water var. where
+! Virtual potential temperature at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHVM
+! Momentum at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PUM
+REAL, DIMENSION(:,:), INTENT(IN) :: PVM
+! scalar variables at t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVM
+!
+! Tendencies of conservative variables
+REAL, DIMENSION(:,:), INTENT(OUT) :: PTHLDT
+
+REAL, DIMENSION(:,:), INTENT(OUT) :: PRTDT
+! Tendencies of momentum
+REAL, DIMENSION(:,:), INTENT(OUT) :: PUDT
+REAL, DIMENSION(:,:), INTENT(OUT) :: PVDT
+! Tendencies of scalar variables
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSVDT
+
+
+! Updraft/environment characteritics
+REAL, DIMENSION(:,:), INTENT(IN) :: PEMF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHL_DO,PTHV_DO,PRT_DO,PU_DO,PV_DO
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSV_UP,PSV_DO
+! Fluxes
+REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZTHMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF
+
+REAL, DIMENSION(:,:,:), INTENT(OUT):: PFLXZSVMF
+!
+!
+!
+!-------------------------------------------------------------------------------
+!
+! 0.2 declaration of local variables
+!
+
+REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2)) :: ZVARS
+
+!
+INTEGER :: ISV,JSV !number of scalar variables and Loop counter
+!
+!----------------------------------------------------------------------------
+!
+!* 1.PRELIMINARIES
+! -------------
+!
+!
+! number of scalar var
+ISV=SIZE(PSVM,3)
+
+!
+PFLXZSVMF = 0.
+PSVDT = 0.
+
+!
+!----------------------------------------------------------------------------
+!
+!* 2. COMPUTE THE MEAN FLUX OF CONSERVATIVE VARIABLES at time t-dt
+! (equation (3) of Soares et al)
+! + THE MEAN FLUX OF THETA_V (buoyancy flux)
+! -----------------------------------------------
+! ( Resulting fluxes are in flux level (w-point) as PEMF and PTHL_UP )
+!
+! downdraft data are on the flux points
+PFLXZTHMF(:,:) = PEMF(:,:)*(PTHL_UP(:,:)-PTHL_DO(:,:))
+
+PFLXZRMF(:,:) = PEMF(:,:)*(PRT_UP(:,:)-PRT_DO(:,:))
+
+PFLXZTHVMF(:,:) = PEMF(:,:)*(PTHV_UP(:,:)-PTHV_DO(:,:))
+
+IF (OMIXUV) THEN
+ PFLXZUMF(:,:) = PEMF(:,:)*(PU_UP(:,:)-PU_DO(:,:))
+ PFLXZVMF(:,:) = PEMF(:,:)*(PV_UP(:,:)-PV_DO(:,:))
+ELSE
+ PFLXZUMF(:,:) = 0.
+ PFLXZVMF(:,:) = 0.
+ENDIF
+!
+!
+!----------------------------------------------------------------------------
+!
+!* 3. COMPUTE TENDENCIES OF CONSERVATIVE VARIABLES (or treated as such...)
+! (implicit formulation)
+! --------------------------------------------
+!
+
+!
+!
+! 3.1 Compute the tendency for the conservative potential temperature
+! (PDZZ and flux in w-point and PRHODJ is mass point, result in mass point)
+!
+CALL TRIDIAG_MASSFLUX(KKA,KKB,KKE,KKU,KKL,PTHLM,PFLXZTHMF,-PEMF,PTSTEP,PIMPL, &
+ PDZZ,PRHODJ,ZVARS )
+! compute new flux
+!!!!!!!!!!!!!!!!!!!!!!!!!!
+! Pourquoi on le recalcule ici alors qu'il n'est pas utilisé ailleurs
+! sauf pour l'écriture ?
+! Est ce que ZVARS est au point de masse pour qu'il doivent être remis au point
+! de flux ?
+!!!!!!!!!!!!!!!!!!!!!!!!!!
+PFLXZTHMF(:,:) = PEMF(:,:)*(PTHL_UP(:,:)-MZM_MF(KKA,KKU,KKL,ZVARS(:,:)))
+
+!!! compute THL tendency
+!
+PTHLDT(:,:)= (ZVARS(:,:)-PTHLM(:,:))/PTSTEP
+
+!
+! 3.2 Compute the tendency for the conservative mixing ratio
+!
+CALL TRIDIAG_MASSFLUX(KKA,KKB,KKE,KKU,KKL,PRTM(:,:),PFLXZRMF,-PEMF,PTSTEP,PIMPL, &
+ PDZZ,PRHODJ,ZVARS )
+! compute new flux
+PFLXZRMF(:,:) = PEMF(:,:)*(PRT_UP(:,:)-MZM_MF(KKA,KKU,KKL,ZVARS(:,:)))
+
+!!! compute RT tendency
+PRTDT(:,:) = (ZVARS(:,:)-PRTM(:,:))/PTSTEP
+!
+
+IF (OMIXUV) THEN
+ !
+ ! 3.3 Compute the tendency for the (non conservative but treated as it) zonal momentum
+ ! (PDZZ and flux in w-point and PRHODJ is mass point, result in mass point)
+ !
+
+ CALL TRIDIAG_MASSFLUX(KKA,KKB,KKE,KKU,KKL,PUM,PFLXZUMF,-PEMF,PTSTEP,PIMPL, &
+ PDZZ,PRHODJ,ZVARS )
+ ! compute new flux
+ PFLXZUMF(:,:) = PEMF(:,:)*(PU_UP(:,:)-MZM_MF(KKA,KKU,KKL,ZVARS(:,:)))
+
+ ! compute U tendency
+ PUDT(:,:)= (ZVARS(:,:)-PUM(:,:))/PTSTEP
+
+ !
+ !
+ ! 3.4 Compute the tendency for the (non conservative but treated as it for the time beiing)
+ ! meridian momentum
+ ! (PDZZ and flux in w-point and PRHODJ is mass point, result in mass point)
+ !
+ CALL TRIDIAG_MASSFLUX(KKA,KKB,KKE,KKU,KKL,PVM,PFLXZVMF,-PEMF,PTSTEP,PIMPL, &
+ PDZZ,PRHODJ,ZVARS )
+ ! compute new flux
+ PFLXZVMF(:,:) = PEMF(:,:)*(PV_UP(:,:)-MZM_MF(KKA,KKU,KKL,ZVARS(:,:)))
+
+ ! compute V tendency
+ PVDT(:,:)= (ZVARS(:,:)-PVM(:,:))/PTSTEP
+ELSE
+ PUDT(:,:)=0.
+ PVDT(:,:)=0.
+ENDIF
+
+DO JSV=1,ISV
+
+ IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE
+
+ !* compute mean flux of scalar variables at time t-dt
+ ! ( Resulting fluxes are in flux level (w-point) as PEMF and PTHL_UP )
+
+ PFLXZSVMF(:,:,JSV) = PEMF(:,:)*(PSV_UP(:,:,JSV)-MZM_MF(KKA,KKU,KKL,PSVM(:,:,JSV)))
+
+ !
+ ! 3.5 Compute the tendency for scalar variables
+ ! (PDZZ and flux in w-point and PRHODJ is mass point, result in mass point)
+ !
+ CALL TRIDIAG_MASSFLUX(KKA,KKB,KKE,KKU,KKL,PSVM(:,:,JSV),PFLXZSVMF(:,:,JSV),&
+ -PEMF,PTSTEP,PIMPL,PDZZ,PRHODJ,ZVARS )
+ ! compute new flux
+ PFLXZSVMF(:,:,JSV) = PEMF(:,:)*(PSV_UP(:,:,JSV)-MZM_MF(KKA,KKU,KKL,ZVARS))
+
+ ! compute Sv tendency
+ PSVDT(:,:,JSV)= (ZVARS(:,:)-PSVM(:,:,JSV))/PTSTEP
+
+ENDDO
+!
+END SUBROUTINE MF_TURB_GREYZONE
diff --git a/src/mesonh/turb/modd_cturb.f90 b/src/mesonh/turb/modd_cturb.f90
new file mode 100644
index 000000000..db23e955b
--- /dev/null
+++ b/src/mesonh/turb/modd_cturb.f90
@@ -0,0 +1,91 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 modd 2006/05/23 10:10:13
+!-----------------------------------------------------------------
+! #######################
+ MODULE MODD_CTURB
+! #######################
+!
+!!**** *MODD_CTURB* - declaration of the turbulent scheme constants
+!!
+!! PURPOSE
+!! -------
+! The purpose of this declarative module is to declare the
+! turbulence scheme constants.
+!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! NONE
+!!
+!! REFERENCE
+!! ---------
+!! Book 2 of Meso-NH documentation (MODD_CTURB)
+!! Book 1 of Meso-NH documentation (Chapter Turbulence)
+!!
+!! AUTHOR
+!! ------
+!1 Joan Cuxart * INM and Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 08/08/94
+!! Nov 06, 2002 (V. Masson) add XALPSBL and XASBL
+!! May 06 Remove EPS
+!! Jan 2019 (Q. Rodier) Remove XASBL
+!----------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+REAL,SAVE :: XCMFS ! constant for the momentum flux due to shear
+REAL,SAVE :: XCMFB ! constant for the momentum flux due to buoyancy
+REAL,SAVE :: XCSHF ! constant for the sensible heat flux
+REAL,SAVE :: XCHF ! constant for the humidity flux
+REAL,SAVE :: XCTV ! constant for the temperature variance
+REAL,SAVE :: XCHV ! constant for the humidity variance
+REAL,SAVE :: XCHT1 ! first ct. for the humidity-temperature correlation
+REAL,SAVE :: XCHT2 ! second ct. for the humidity-temperature correlation
+!
+REAL,SAVE :: XCPR1 ! first ct. for the turbulent Prandtl numbers
+REAL,SAVE :: XCPR2 ! second ct. for the turbulent Prandtl numbers
+REAL,SAVE :: XCPR3 ! third ct. for the turbulent Prandtl numbers
+REAL,SAVE :: XCPR4 ! fourth ct. for the turbulent Prandtl numbers
+REAL,SAVE :: XCPR5 ! fifth ct. for the turbulent Prandtl numbers
+!
+REAL,SAVE :: XCET ! constant into the transport term of the TKE eq.
+REAL,SAVE :: XCED ! constant into the dissipation term of the TKE eq.
+!
+REAL,SAVE :: XCDP ! ct. for the production term in the dissipation eq.
+REAL,SAVE :: XCDD ! ct. for the destruction term in the dissipation eq.
+REAL,SAVE :: XCDT ! ct. for the transport term in the dissipation eq.
+!
+REAL,SAVE :: XTKEMIN ! mimimum value for the TKE
+REAL,SAVE :: XRM17 ! Rodier et al 2017 constant in shear term for mixing length
+!
+REAL,SAVE :: XLINI ! initial value for BL mixing length
+REAL,SAVE :: XLINF ! to prevent division by zero in the BL algorithm
+!
+REAL,SAVE :: XALPSBL ! constant linking TKE and friction velocity in the SBL
+!
+REAL,SAVE :: XCEP ! Constant for wind pressure-correlations
+REAL,SAVE :: XA0 ! Constant a0 for wind pressure-correlations
+REAL,SAVE :: XA2 ! Constant a2 for wind pressure-correlations
+REAL,SAVE :: XA3 ! Constant a3 for wind pressure-correlations
+REAL,SAVE :: XA5 ! Constant a5 for temperature pressure-correlations
+REAL,SAVE :: XCTD ! Constant for temperature and vapor dissipation
+REAL,SAVE :: XCTP ! Constant for temperature and vapor pressure-correlations
+!
+REAL,SAVE :: XPHI_LIM ! Threshold value for Phi3 and Psi3
+REAL,SAVE :: XSBL_O_BL ! SBL height / BL height ratio
+REAL,SAVE :: XFTOP_O_FSURF! Fraction of surface (heat or momentum) flux used to define top of BL
+!
+END MODULE MODD_CTURB
diff --git a/src/mesonh/turb/modd_diag_in_run.f90 b/src/mesonh/turb/modd_diag_in_run.f90
new file mode 100644
index 000000000..b7bba80d0
--- /dev/null
+++ b/src/mesonh/turb/modd_diag_in_run.f90
@@ -0,0 +1,43 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 modd 2006/10/24 10:07:40
+!-----------------------------------------------------------------
+MODULE MODD_DIAG_IN_RUN
+! Modifications
+!! 02/2018 Q.Libois ECRAD
+!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
+!
+!* stores instantaneous diagnostic arrays for the current time-step
+!
+IMPLICIT NONE
+
+LOGICAL :: LDIAG_IN_RUN ! flag for diagnostics
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: XCURRENT_RN ! net radiation
+REAL, DIMENSION(:,:), ALLOCATABLE :: XCURRENT_H ! sensible heat flux
+REAL, DIMENSION(:,:), ALLOCATABLE :: XCURRENT_LE ! Total latent heat flux
+REAL, DIMENSION(:,:), ALLOCATABLE :: XCURRENT_LEI ! Solid latent heat flux
+REAL, DIMENSION(:,:), ALLOCATABLE :: XCURRENT_GFLUX ! ground flux
+REAL, DIMENSION(:,:), ALLOCATABLE :: XCURRENT_LWD ! incoming longwave at the surface
+REAL, DIMENSION(:,:), ALLOCATABLE :: XCURRENT_LWU ! outcoming longwave at the surface
+REAL, DIMENSION(:,:), ALLOCATABLE :: XCURRENT_SWD ! incoming Shortwave at the surface
+REAL, DIMENSION(:,:), ALLOCATABLE :: XCURRENT_SWU ! outcoming Shortwave at the surface
+REAL, DIMENSION(:,:), ALLOCATABLE :: XCURRENT_SWDIR ! incoming Shortwave direct at the surface
+REAL, DIMENSION(:,:), ALLOCATABLE :: XCURRENT_SWDIFF! incoming Shortwave diffuse at the surface
+REAL, DIMENSION(:,:), ALLOCATABLE :: XCURRENT_T2M ! temperature at 2m
+REAL, DIMENSION(:,:), ALLOCATABLE :: XCURRENT_Q2M ! humidity at 2m
+REAL, DIMENSION(:,:), ALLOCATABLE :: XCURRENT_HU2M ! relative humidity at 2m
+REAL, DIMENSION(:,:), ALLOCATABLE :: XCURRENT_ZON10M! zonal wind at 10m
+REAL, DIMENSION(:,:), ALLOCATABLE :: XCURRENT_MER10M! meridian wind at 10m
+REAL, DIMENSION(:,:), ALLOCATABLE :: XCURRENT_DSTAOD! dust aerosol optical depth
+REAL, DIMENSION(:,:), ALLOCATABLE :: XCURRENT_SFCO2 ! CO2 Surface flux
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XCURRENT_TKE_DISS ! Tke dissipation rate
+REAL, DIMENSION(:,:), ALLOCATABLE :: XCURRENT_SLTAOD ! Salt aerosol optical depth
+REAL, DIMENSION(:,:), ALLOCATABLE :: XCURRENT_ZWS ! Significant height of waves
+END MODULE MODD_DIAG_IN_RUN
diff --git a/src/mesonh/turb/modd_turb_cloud.f90 b/src/mesonh/turb/modd_turb_cloud.f90
new file mode 100644
index 000000000..28b1f106f
--- /dev/null
+++ b/src/mesonh/turb/modd_turb_cloud.f90
@@ -0,0 +1,58 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 modd 2006/05/18 13:07:25
+!-----------------------------------------------------------------
+! ##################
+ MODULE MODD_TURB_CLOUD
+! ##################
+!
+!!**** *MODD_TURB_CLOUD* - declaration of parameters for cloud mixing length
+!!
+!! PURPOSE
+!! -------
+! The purpose of this declarative module is to declare the
+! variables that may be set by namelist for the cloud mixing length
+!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! M. Tomasini *Meteo France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original September, 2004
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+INTEGER,SAVE :: NMODEL_CLOUD ! model number where the modification ! of the mixing length in the clouds is computed
+CHARACTER (LEN=4),SAVE :: CTURBLEN_CLOUD ! type of length in the clouds
+ ! 'DEAR' Deardorff mixing length
+ ! 'BL89' Bougeault and Lacarrere scheme
+ ! 'DELT' length = ( volum) ** 1/3
+REAL,SAVE :: XCOEF_AMPL_SAT ! saturation of the amplification coefficient
+REAL,SAVE :: XCEI_MIN ! minimum threshold for the instability index CEI
+ !(beginning of the amplification)
+REAL,SAVE :: XCEI_MAX ! maximum threshold for the instability index CEI
+ !(beginning of the saturation of the amplification)
+REAL,SAVE,DIMENSION(:,:,:), ALLOCATABLE :: XCEI ! Cloud Entrainment instability
+ ! index to emphasize localy
+ ! turbulent fluxes
+!
+END MODULE MODD_TURB_CLOUD
diff --git a/src/mesonh/turb/modd_turb_flux_aircraft_balloon.f90 b/src/mesonh/turb/modd_turb_flux_aircraft_balloon.f90
new file mode 100644
index 000000000..cd3e40b62
--- /dev/null
+++ b/src/mesonh/turb/modd_turb_flux_aircraft_balloon.f90
@@ -0,0 +1,54 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$ $Date$
+!-----------------------------------------------------------------
+!-----------------------------------------------------------------
+!-----------------------------------------------------------------
+! ######################################
+ MODULE MODD_TURB_FLUX_AIRCRAFT_BALLOON
+! ######################################
+!
+!!**** *MODD_CVERT* - Declares work arrays for vertical cross-sections
+!!
+!! PURPOSE
+!! -------
+! For vertical cross-sections only, this declarative module declares
+! the arrays containing the sea-level altitudes and the model topography
+! of the oblique cross-section points.
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Book2 of the TRACE volume of the Meso-NH user manual
+!! (MODD_CVERT)
+!!
+!! AUTHOR
+!! ------
+!! P.Lacarrere
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 18/09/06
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!
+IMPLICIT NONE
+!
+REAL,DIMENSION(:,:,:) ,ALLOCATABLE,SAVE :: XTHW_FLUX !sensible flux
+REAL,DIMENSION(:,:,:) ,ALLOCATABLE,SAVE :: XRCW_FLUX !Latent flux
+REAL,DIMENSION(:,:,:,:),ALLOCATABLE,SAVE :: XSVW_FLUX !turb scalar flux
+!
+END MODULE MODD_TURB_FLUX_AIRCRAFT_BALLOON
diff --git a/src/mesonh/turb/modd_turbn.f90 b/src/mesonh/turb/modd_turbn.f90
new file mode 100644
index 000000000..8c35fd9d4
--- /dev/null
+++ b/src/mesonh/turb/modd_turbn.f90
@@ -0,0 +1,211 @@
+!MNH_LIC Copyright 1995-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ##################
+ MODULE MODD_TURB_n
+! ##################
+!
+!!**** *MODD_TURB$n* - declaration of turbulence scheme free parameters
+!!
+!! PURPOSE
+!! -------
+! The purpose of this declarative module is to declare the
+! variables that may be set by namelist for the turbulence scheme
+!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (module MODD_PARAMn)
+!!
+!! AUTHOR
+!! ------
+!! J. Cuxart and J. Stein * I.N.M. and Meteo France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original January 9, 1995
+!! J.Cuxart February 15, 1995 add the switches for diagnostic storages
+!! J.M. Carriere May 15, 1995 add the subgrid condensation
+!! M. Tomasini Jul 05, 2001 add the subgrid autoconversion
+!! P. Bechtold Feb 11, 2002 add switch for Sigma_s computation
+!! P. Jabouille Apr 4, 2002 add switch for Sigma_s convection
+!! V. Masson Nov 13 2002 add switch for SBL lengths
+!! May 2006 Remove KEPS
+!! C.Lac Nov 2014 add terms of TKE production for LES diag
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! D. Ricard May 2021 add the switches for Leonard terms
+!! JL Redelsperger 03/2021 Add O-A flux for auto-coupled LES case
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS, ONLY: JPMODELMAX
+IMPLICIT NONE
+
+TYPE TURB_t
+!
+!
+ REAL :: XIMPL ! implicitness degree for the vertical terms of
+ ! the turbulence scheme
+ REAL :: XKEMIN ! mimimum value for the TKE
+ REAL :: XCEDIS ! Constant for dissipation of Tke
+ REAL :: XCADAP ! Coefficient for ADAPtative mixing length
+ CHARACTER (LEN=4) :: CTURBLEN ! type of length used for the closure
+ ! 'BL89' Bougeault and Lacarrere scheme
+ ! 'DELT' length = ( volum) ** 1/3
+ CHARACTER (LEN=4) :: CTURBDIM ! dimensionality of the turbulence scheme
+ ! '1DIM' for purely vertical computations
+ ! '3DIM' for computations in the 3
+ ! directions
+ LOGICAL :: LTURB_FLX ! logical switch for the storage of all
+ ! the turbulent fluxes
+ LOGICAL :: LTURB_DIAG! logical switch for the storage of some
+ ! turbulence related diagnostics
+ LOGICAL :: LSUBG_COND! Switch for subgrid condensation
+ LOGICAL :: LSIGMAS ! Switch for using Sigma_s from turbulence scheme
+ LOGICAL :: LSIG_CONV ! Switch for computing Sigma_s due to convection
+!
+ LOGICAL :: LRMC01 ! Switch for computing separate mixing
+! ! and dissipative length in the SBL
+! ! according to Redelsperger, Mahe &
+! ! Carlotti 2001
+ CHARACTER(LEN=4) :: CTOM ! type of Third Order Moments
+ ! 'NONE' none
+ ! 'TM06' Tomas Masson 2006
+ CHARACTER(LEN=4) :: CSUBG_AUCV ! type of subgrid rc->rr autoconv. method
+ CHARACTER(LEN=80) :: CSUBG_AUCV_RI ! type of subgrid ri->rs autoconv. method
+ CHARACTER(LEN=80) :: CCONDENS ! subrgrid condensation PDF
+ CHARACTER(LEN=4) :: CLAMBDA3 ! lambda3 choice for subgrid cloud scheme
+ CHARACTER(LEN=80) :: CSUBG_MF_PDF ! PDF to use for MF cloud autoconversions
+
+! REAL, DIMENSION(:,:), POINTER :: XBL_DEPTH=>NULL() ! BL depth for TOMS computations
+! REAL, DIMENSION(:,:), POINTER :: XSBL_DEPTH=>NULL()! SurfaceBL depth for RMC01 computations
+! REAL, DIMENSION(:,:,:), POINTER :: XWTHVMF=>NULL()! Mass Flux vert. transport of buoyancy
+ REAL :: VSIGQSAT ! coeff applied to qsat variance contribution
+ REAL, DIMENSION(:,:,:), POINTER :: XDYP=>NULL() ! Dynamical production of Kinetic energy
+ REAL, DIMENSION(:,:,:), POINTER :: XTHP=>NULL() ! Thermal production of Kinetic energy
+ REAL, DIMENSION(:,:,:), POINTER :: XTR=>NULL() ! Transport production of Kinetic energy
+ REAL, DIMENSION(:,:,:), POINTER :: XDISS=>NULL() ! Dissipation of Kinetic energy
+ REAL, DIMENSION(:,:,:), POINTER :: XLEM=>NULL() ! Mixing length
+ REAL, DIMENSION(:,:,:), POINTER :: XSSUFL_C=>NULL() ! O-A interface flux for u
+ REAL, DIMENSION(:,:,:), POINTER :: XSSVFL_C=>NULL() ! O-A interface flux for v
+ REAL, DIMENSION(:,:,:), POINTER :: XSSTFL_C=>NULL() ! O-A interface flux for theta
+ REAL, DIMENSION(:,:,:), POINTER :: XSSRFL_C=>NULL() ! O-A interface flux for vapor
+ LOGICAL :: LHGRAD ! logical switch for the computation of the Leornard Terms
+ REAL :: XCOEFHGRADTHL ! coeff applied to thl contribution
+ REAL :: XCOEFHGRADRM ! coeff applied to mixing ratio contribution
+ REAL :: XALTHGRAD ! altitude from which to apply the Leonard terms
+ REAL :: XCLDTHOLD ! cloud threshold to apply the Leonard terms
+ ! negative value : applied everywhere
+ ! 0.000001 applied only inside the clouds ri+rc > 10**-6 kg/kg
+!
+END TYPE TURB_t
+
+TYPE(TURB_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: TURB_MODEL
+
+REAL, POINTER :: XIMPL=>NULL()
+REAL, POINTER :: XKEMIN=>NULL()
+REAL, POINTER :: XCEDIS=>NULL()
+REAL, POINTER :: XCADAP=>NULL()
+CHARACTER (LEN=4), POINTER :: CTURBLEN=>NULL()
+CHARACTER (LEN=4), POINTER :: CTURBDIM=>NULL()
+LOGICAL, POINTER :: LTURB_FLX=>NULL()
+LOGICAL, POINTER :: LTURB_DIAG=>NULL()
+LOGICAL, POINTER :: LSUBG_COND=>NULL()
+LOGICAL, POINTER :: LSIGMAS=>NULL()
+LOGICAL, POINTER :: LSIG_CONV=>NULL()
+LOGICAL, POINTER :: LRMC01=>NULL()
+CHARACTER(LEN=4),POINTER :: CTOM=>NULL()
+CHARACTER(LEN=4),POINTER :: CSUBG_AUCV=>NULL()
+CHARACTER(LEN=80),POINTER :: CSUBG_AUCV_RI=>NULL()
+CHARACTER(LEN=80),POINTER :: CCONDENS=>NULL()
+CHARACTER(LEN=4),POINTER :: CLAMBDA3=>NULL()
+CHARACTER(LEN=80),POINTER :: CSUBG_MF_PDF=>NULL()
+REAL, DIMENSION(:,:), POINTER :: XBL_DEPTH=>NULL()
+REAL, DIMENSION(:,:), POINTER :: XSBL_DEPTH=>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XWTHVMF=>NULL()
+REAL, POINTER :: VSIGQSAT=>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XDYP=>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XTHP=>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XTR=>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XDISS=>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XLEM=>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XSSUFL_C=>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XSSVFL_C=>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XSSTFL_C=>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XSSRFL_C=>NULL()
+LOGICAL, POINTER :: LHGRAD=>NULL()
+REAL, POINTER :: XCOEFHGRADTHL=>NULL()
+REAL, POINTER :: XCOEFHGRADRM=>NULL()
+REAL, POINTER :: XALTHGRAD=>NULL()
+REAL, POINTER :: XCLDTHOLD=>NULL()
+
+CONTAINS
+
+SUBROUTINE TURB_GOTO_MODEL(KFROM, KTO)
+INTEGER, INTENT(IN) :: KFROM, KTO
+!
+! Save current state for allocated arrays
+!
+!TURB_MODEL(KFROM)%XBL_DEPTH=>XBL_DEPTH !Done in FIELDLIST_GOTO_MODEL
+!TURB_MODEL(KFROM)%XSBL_DEPTH=>XSBL_DEPTH !Done in FIELDLIST_GOTO_MODEL
+!TURB_MODEL(KFROM)%XWTHVMF=>XWTHVMF !Done in FIELDLIST_GOTO_MODEL
+TURB_MODEL(KFROM)%XDYP=>XDYP
+TURB_MODEL(KFROM)%XTHP=>XTHP
+TURB_MODEL(KFROM)%XTR=>XTR
+TURB_MODEL(KFROM)%XDISS=>XDISS
+TURB_MODEL(KFROM)%XLEM=>XLEM
+TURB_MODEL(KFROM)%XSSUFL_C=>XSSUFL_C
+TURB_MODEL(KFROM)%XSSVFL_C=>XSSVFL_C
+TURB_MODEL(KFROM)%XSSTFL_C=>XSSTFL_C
+TURB_MODEL(KFROM)%XSSRFL_C=>XSSRFL_C
+!
+! Current model is set to model KTO
+XIMPL=>TURB_MODEL(KTO)%XIMPL
+XKEMIN=>TURB_MODEL(KTO)%XKEMIN
+XCEDIS=>TURB_MODEL(KTO)%XCEDIS
+XCADAP=>TURB_MODEL(KTO)%XCADAP
+CTURBLEN=>TURB_MODEL(KTO)%CTURBLEN
+CTURBDIM=>TURB_MODEL(KTO)%CTURBDIM
+LTURB_FLX=>TURB_MODEL(KTO)%LTURB_FLX
+LTURB_DIAG=>TURB_MODEL(KTO)%LTURB_DIAG
+LSUBG_COND=>TURB_MODEL(KTO)%LSUBG_COND
+LSIGMAS=>TURB_MODEL(KTO)%LSIGMAS
+LSIG_CONV=>TURB_MODEL(KTO)%LSIG_CONV
+LRMC01=>TURB_MODEL(KTO)%LRMC01
+CTOM=>TURB_MODEL(KTO)%CTOM
+CSUBG_AUCV=>TURB_MODEL(KTO)%CSUBG_AUCV
+CSUBG_AUCV_RI=>TURB_MODEL(KTO)%CSUBG_AUCV_RI
+CCONDENS=>TURB_MODEL(KTO)%CCONDENS
+CLAMBDA3=>TURB_MODEL(KTO)%CLAMBDA3
+CSUBG_MF_PDF=>TURB_MODEL(KTO)%CSUBG_MF_PDF
+!XBL_DEPTH=>TURB_MODEL(KTO)%XBL_DEPTH !Done in FIELDLIST_GOTO_MODEL
+!XSBL_DEPTH=>TURB_MODEL(KTO)%XSBL_DEPTH !Done in FIELDLIST_GOTO_MODEL
+!XWTHVMF=>TURB_MODEL(KTO)%XWTHVMF !Done in FIELDLIST_GOTO_MODEL
+VSIGQSAT=>TURB_MODEL(KTO)%VSIGQSAT
+XDYP=>TURB_MODEL(KTO)%XDYP
+XTHP=>TURB_MODEL(KTO)%XTHP
+XTR=>TURB_MODEL(KTO)%XTR
+XDISS=>TURB_MODEL(KTO)%XDISS
+XLEM=>TURB_MODEL(KTO)%XLEM
+XSSUFL_C=>TURB_MODEL(KTO)%XSSUFL_C
+XSSVFL_C=>TURB_MODEL(KTO)%XSSVFL_C
+XSSTFL_C=>TURB_MODEL(KTO)%XSSTFL_C
+XSSRFL_C=>TURB_MODEL(KTO)%XSSRFL_C
+LHGRAD=>TURB_MODEL(KTO)%LHGRAD
+XCOEFHGRADTHL=>TURB_MODEL(KTO)%XCOEFHGRADTHL
+XCOEFHGRADRM=>TURB_MODEL(KTO)%XCOEFHGRADRM
+XALTHGRAD=>TURB_MODEL(KTO)%XALTHGRAD
+XCLDTHOLD=>TURB_MODEL(KTO)%XCLDTHOLD
+
+END SUBROUTINE TURB_GOTO_MODEL
+
+END MODULE MODD_TURB_n
diff --git a/src/mesonh/turb/mode_prandtl.f90 b/src/mesonh/turb/mode_prandtl.f90
new file mode 100644
index 000000000..04dfe6155
--- /dev/null
+++ b/src/mesonh/turb/mode_prandtl.f90
@@ -0,0 +1,1399 @@
+!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ####################
+ MODULE MODE_PRANDTL
+! ####################
+!
+!* modification 08/2010 V. Masson smoothing of the discontinuity in functions
+! used for implicitation of exchange coefficients
+! 05/2020 V. Masson and C. Lac : bug in D_PHI3DTDZ2_O_DDTDZ
+!
+USE MODD_CTURB, ONLY : XCTV, XCSHF, XCTD, XPHI_LIM, XCPR3, XCPR4, XCPR5
+USE MODD_PARAMETERS, ONLY : JPVEXT_TURB
+!
+USE MODI_SHUMAN
+IMPLICIT NONE
+!----------------------------------------------------------------------------
+CONTAINS
+!----------------------------------------------------------------------------
+SUBROUTINE SMOOTH_TURB_FUNCT(PPHI3,PF_LIM,PF)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPHI3 ! Phi3
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PF_LIM ! Value of F when Phi3 is
+! ! larger than Phi_lim
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PF ! function F to smooth
+!
+REAL, DIMENSION(SIZE(PF,1),SIZE(PF,2),SIZE(PF,3)) :: ZCOEF
+!
+!* adds a artificial correction to smooth the function near the discontinuity
+! point at Phi3 = Phi_lim
+! This smoothing is applied between 0.9*phi_lim (=2.7) and Phi_lim (=3)
+! Note that in the Boundary layer, phi is usually between 0.8 and 1
+!
+!
+ZCOEF = MAX(MIN(( 10.*(1.-PPHI3/XPHI_LIM)) ,1.), 0.)
+!
+PF(:,:,:) = ZCOEF(:,:,:) * PF &
+ + (1.-ZCOEF(:,:,:)) * PF_LIM
+!
+END SUBROUTINE SMOOTH_TURB_FUNCT
+!----------------------------------------------------------------------------
+FUNCTION PHI3(PREDTH1,PREDR1,PRED2TH3,PRED2R3,PRED2THR3,HTURBDIM,OUSERV)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2TH3
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2R3
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2THR3
+ CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! 1DIM or 3DIM turb. scheme
+ LOGICAL, INTENT(IN) :: OUSERV ! flag to use vapor
+ REAL, DIMENSION(SIZE(PREDTH1,1),SIZE(PREDTH1,2),SIZE(PREDTH1,3)) :: PHI3
+!
+ REAL, DIMENSION(SIZE(PREDTH1,1),SIZE(PREDTH1,2),SIZE(PREDTH1,3)) :: ZW1, ZW2
+ INTEGER :: IKB, IKE
+!
+IKB = 1+JPVEXT_TURB
+IKE = SIZE(PREDTH1,3)-JPVEXT_TURB
+!
+IF (HTURBDIM=='3DIM') THEN
+ !* 3DIM case
+ IF (OUSERV) THEN
+ ZW1(:,:,:) = 1. + 1.5* (PREDTH1(:,:,:)+PREDR1(:,:,:)) + &
+ ( 0.5 * (PREDTH1(:,:,:)**2+PREDR1(:,:,:)**2) &
+ + PREDTH1(:,:,:) * PREDR1(:,:,:) &
+ )
+
+ ZW2(:,:,:) = 0.5 * (PRED2TH3(:,:,:)-PRED2R3(:,:,:))
+
+ PHI3(:,:,:)= 1. - &
+ ( ( (1.+PREDR1(:,:,:)) * &
+ (PRED2THR3(:,:,:) + PRED2TH3(:,:,:)) / PREDTH1(:,:,:) &
+ ) + ZW2(:,:,:) &
+ ) / ZW1(:,:,:)
+ ELSE
+ ZW1(:,:,:) = 1. + 1.5* PREDTH1(:,:,:) + &
+ 0.5* PREDTH1(:,:,:)**2
+
+ ZW2(:,:,:) = 0.5* PRED2TH3(:,:,:)
+
+ PHI3(:,:,:)= 1. - &
+ (PRED2TH3(:,:,:) / PREDTH1(:,:,:) + ZW2(:,:,:)) / ZW1(:,:,:)
+ END IF
+ WHERE( PHI3 <= 0. .OR. PHI3 > XPHI_LIM )
+ PHI3 = XPHI_LIM
+ END WHERE
+
+ELSE
+ !* 1DIM case
+ IF (OUSERV) THEN
+ PHI3(:,:,:)= 1./(1.+PREDTH1(:,:,:)+PREDR1(:,:,:))
+ ELSE
+ PHI3(:,:,:)= 1./(1.+PREDTH1(:,:,:))
+ END IF
+END IF
+!
+PHI3(:,:,IKB-1)=PHI3(:,:,IKB)
+PHI3(:,:,IKE+1)=PHI3(:,:,IKE)
+!
+END FUNCTION PHI3
+!----------------------------------------------------------------------------
+FUNCTION PSI_SV(PREDTH1,PREDR1,PREDS1,PRED2THS,PRED2RS,PPHI3,PPSI3)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PREDS1
+ REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRED2THS
+ REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRED2RS
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PPHI3
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PPSI3
+ REAL, DIMENSION(SIZE(PRED2THS,1),SIZE(PRED2THS,2),SIZE(PRED2THS,3),SIZE(PRED2THS,4)) :: PSI_SV
+!
+ INTEGER :: IKB, IKE
+ INTEGER :: JSV
+!
+IKB = 1+JPVEXT_TURB
+IKE = SIZE(PREDTH1,3)-JPVEXT_TURB
+!
+DO JSV=1,SIZE(PSI_SV,4)
+ PSI_SV(:,:,:,JSV) = ( 1. &
+ - (XCPR3+XCPR5) * (PRED2THS(:,:,:,JSV)/PREDS1(:,:,:,JSV)-PREDTH1) &
+ - (XCPR4+XCPR5) * (PRED2RS (:,:,:,JSV)/PREDS1(:,:,:,JSV)-PREDR1 ) &
+ - XCPR3 * PREDTH1 * PPHI3 - XCPR4 * PREDR1 * PPSI3 &
+ ) / ( 1. + XCPR5 * ( PREDTH1 + PREDR1 ) )
+
+! control of the PSI_SV positivity
+ WHERE ( (PSI_SV(:,:,:,JSV) <=0.).AND. (PREDTH1+PREDR1) <= 0. )
+ PSI_SV(:,:,:,JSV)=XPHI_LIM
+ END WHERE
+ PSI_SV(:,:,:,JSV) = MAX( 1.E-4, MIN(XPHI_LIM,PSI_SV(:,:,:,JSV)) )
+!
+ PSI_SV(:,:,IKB-1,JSV)=PSI_SV(:,:,IKB,JSV)
+ PSI_SV(:,:,IKE+1,JSV)=PSI_SV(:,:,IKE,JSV)
+END DO
+!
+END FUNCTION PSI_SV
+!----------------------------------------------------------------------------
+FUNCTION D_PHI3DTDZ_O_DDTDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,HTURBDIM,OUSERV)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PPHI3
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2TH3
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2THR3
+ CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! 1DIM or 3DIM turb. scheme
+ LOGICAL, INTENT(IN) :: OUSERV ! flag to use vapor
+ REAL, DIMENSION(SIZE(PREDTH1,1),SIZE(PREDTH1,2),SIZE(PREDTH1,3)) :: D_PHI3DTDZ_O_DDTDZ
+ INTEGER :: IKB, IKE,JL,JK,JJ
+!
+IKB = 1+JPVEXT_TURB
+IKE = SIZE(PREDTH1,3)-JPVEXT_TURB
+!
+IF (HTURBDIM=='3DIM') THEN
+ !* 3DIM case
+ IF (OUSERV) THEN
+ WHERE (PPHI3(:,:,:)<=XPHI_LIM)
+ D_PHI3DTDZ_O_DDTDZ(:,:,:) = PPHI3(:,:,:) &
+ * (1. - PREDTH1(:,:,:) * (3./2.+PREDTH1+PREDR1) &
+ /((1.+PREDTH1+PREDR1)*(1.+1./2.*(PREDTH1+PREDR1)))) &
+ + (1.+PREDR1)*(PRED2THR3+PRED2TH3) &
+ / (PREDTH1*(1.+PREDTH1+PREDR1)*(1.+1./2.*(PREDTH1+PREDR1))) &
+ - (1./2.*PREDTH1+PREDR1 * (1.+PREDTH1+PREDR1)) &
+ / ((1.+PREDTH1+PREDR1)*(1.+1./2.*(PREDTH1+PREDR1)))
+ ELSEWHERE
+ D_PHI3DTDZ_O_DDTDZ(:,:,:) = PPHI3(:,:,:)
+ ENDWHERE
+
+!
+ ELSE
+ WHERE (PPHI3(:,:,:)<=XPHI_LIM)
+ D_PHI3DTDZ_O_DDTDZ(:,:,:) = PPHI3(:,:,:) &
+ * (1. - PREDTH1(:,:,:) * (3./2.+PREDTH1) &
+ /((1.+PREDTH1)*(1.+1./2.*PREDTH1))) &
+ + PRED2TH3 / (PREDTH1*(1.+PREDTH1)*(1.+1./2.*PREDTH1)) &
+ - 1./2.*PREDTH1 / ((1.+PREDTH1)*(1.+1./2.*PREDTH1))
+ ELSEWHERE
+ D_PHI3DTDZ_O_DDTDZ(:,:,:) = PPHI3(:,:,:)
+ ENDWHERE
+!
+ END IF
+ELSE
+ !* 1DIM case
+! WHERE (PPHI3(:,:,:)<=XPHI_LIM)
+! D_PHI3DTDZ_O_DDTDZ(:,:,:) = PPHI3(:,:,:) &
+! * (1. - PREDTH1(:,:,:)*PPHI3(:,:,:))
+! ELSEWHERE
+! D_PHI3DTDZ_O_DDTDZ(:,:,:) = PPHI3(:,:,:)
+! ENDWHERE
+DO JJ=1,SIZE(PPHI3,2)
+ DO JL=1,SIZE(PPHI3,1)
+ DO JK=1,SIZE(PPHI3,3)
+ IF ( ABS(PPHI3(JL,JJ,JK)-XPHI_LIM) < 1.E-12 ) THEN
+ D_PHI3DTDZ_O_DDTDZ(JL,JJ,JK)=PPHI3(JL,JJ,JK)*&
+& (1. - PREDTH1(JL,JJ,JK)*PPHI3(JL,JJ,JK))
+ ELSE
+ D_PHI3DTDZ_O_DDTDZ(JL,JJ,JK)=PPHI3(JL,JJ,JK)
+ ENDIF
+ ENDDO
+ ENDDO
+ENDDO
+END IF
+!
+!* smoothing
+CALL SMOOTH_TURB_FUNCT(PPHI3,PPHI3,D_PHI3DTDZ_O_DDTDZ)
+!
+D_PHI3DTDZ_O_DDTDZ(:,:,IKB-1)=D_PHI3DTDZ_O_DDTDZ(:,:,IKB)
+D_PHI3DTDZ_O_DDTDZ(:,:,IKE+1)=D_PHI3DTDZ_O_DDTDZ(:,:,IKE)
+!
+END FUNCTION D_PHI3DTDZ_O_DDTDZ
+!----------------------------------------------------------------------------
+FUNCTION D_PHI3DRDZ_O_DDRDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,HTURBDIM,OUSERV)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PPHI3
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2TH3
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2THR3
+ CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! 1DIM or 3DIM turb. scheme
+ LOGICAL, INTENT(IN) :: OUSERV ! flag to use vapor
+ REAL, DIMENSION(SIZE(PREDTH1,1),SIZE(PREDTH1,2),SIZE(PREDTH1,3)) :: D_PHI3DRDZ_O_DDRDZ
+ INTEGER :: IKB, IKE
+!
+IKB = 1+JPVEXT_TURB
+IKE = SIZE(PREDTH1,3)-JPVEXT_TURB
+!
+!
+IF (HTURBDIM=='3DIM') THEN
+ !* 3DIM case
+ IF (OUSERV) THEN
+ WHERE (PPHI3(:,:,:)<=XPHI_LIM)
+ D_PHI3DRDZ_O_DDRDZ(:,:,:) = &
+ PPHI3(:,:,:) * (1.-PREDR1(:,:,:)*(3./2.+PREDTH1+PREDR1) &
+ / ((1.+PREDTH1+PREDR1)*(1.+1./2.*(PREDTH1+PREDR1)))) &
+ - PREDR1(:,:,:) * (PRED2THR3+PRED2TH3) / (PREDTH1 &
+ * (1.+PREDTH1+PREDR1)*(1.+1./2.*(PREDTH1+PREDR1))) &
+ + PREDR1(:,:,:) * (1./2.+PREDTH1+PREDR1) &
+ / ((1.+PREDTH1+PREDR1)*(1.+1./2.*(PREDTH1+PREDR1)))
+ ELSEWHERE
+ D_PHI3DRDZ_O_DDRDZ(:,:,:) = PPHI3(:,:,:)
+ END WHERE
+ ELSE
+ D_PHI3DRDZ_O_DDRDZ(:,:,:) = PPHI3(:,:,:)
+ END IF
+ELSE
+ !* 1DIM case
+ WHERE (PPHI3(:,:,:)<=XPHI_LIM)
+ D_PHI3DRDZ_O_DDRDZ(:,:,:) = PPHI3(:,:,:) &
+ * (1. - PREDR1(:,:,:)*PPHI3(:,:,:))
+ ELSEWHERE
+ D_PHI3DRDZ_O_DDRDZ(:,:,:) = PPHI3(:,:,:)
+ END WHERE
+END IF
+!
+!* smoothing
+CALL SMOOTH_TURB_FUNCT(PPHI3,PPHI3,D_PHI3DRDZ_O_DDRDZ)
+!
+D_PHI3DRDZ_O_DDRDZ(:,:,IKB-1)=D_PHI3DRDZ_O_DDRDZ(:,:,IKB)
+D_PHI3DRDZ_O_DDRDZ(:,:,IKE+1)=D_PHI3DRDZ_O_DDRDZ(:,:,IKE)
+!
+END FUNCTION D_PHI3DRDZ_O_DDRDZ
+!----------------------------------------------------------------------------
+FUNCTION D_PHI3DTDZ2_O_DDTDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,PDTDZ,HTURBDIM,OUSERV)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PPHI3
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2TH3
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2THR3
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTDZ
+ CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! 1DIM or 3DIM turb. scheme
+ LOGICAL, INTENT(IN) :: OUSERV ! flag to use vapor
+ REAL, DIMENSION(SIZE(PREDTH1,1),SIZE(PREDTH1,2),SIZE(PREDTH1,3)) :: D_PHI3DTDZ2_O_DDTDZ
+ INTEGER :: IKB, IKE
+!
+IKB = 1+JPVEXT_TURB
+IKE = SIZE(PREDTH1,3)-JPVEXT_TURB
+!
+!
+IF (HTURBDIM=='3DIM') THEN
+ ! by derivation of (phi3 dtdz) * dtdz according to dtdz we obtain:
+ D_PHI3DTDZ2_O_DDTDZ(:,:,:) = PDTDZ * (PPHI3 + &
+ D_PHI3DTDZ_O_DDTDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,HTURBDIM,OUSERV) )
+
+! !* 3DIM case
+! IF (OUSERV) THEN
+! WHERE (PPHI3(:,:,:)<=XPHI_LIM)
+! D_PHI3DTDZ2_O_DDTDZ(:,:,:) = PPHI3(:,:,:) &
+! * PDTDZ(:,:,:)*(2.-PREDTH1(:,:,:)*(3./2.+PREDTH1+PREDR1) &
+! /((1.+PREDTH1+PREDR1)*(1.+1./2.*(PREDTH1+PREDR1)))) &
+! + (1.+PREDR1)*(PRED2THR3+PRED2TH3) &
+! / (PREDTH1*(1.+PREDTH1+PREDR1)*(1.+1./2.*(PREDTH1+PREDR1))) &
+! - (1./2.*PREDTH1+PREDR1 * (1.+PREDTH1+PREDR1)) &
+! / ((1.+PREDTH1+PREDR1)*(1.+1./2.*(PREDTH1+PREDR1)))
+! ELSEWHERE
+! D_PHI3DTDZ2_O_DDTDZ(:,:,:) = PPHI3(:,:,:) * 2. * PDTDZ(:,:,:)
+! ENDWHERE
+!
+!!
+! ELSE
+! WHERE (PPHI3(:,:,:)<=XPHI_LIM)
+! D_PHI3DTDZ2_O_DDTDZ(:,:,:) = PPHI3(:,:,:) &
+! * PDTDZ(:,:,:)*(2.-PREDTH1(:,:,:)*(3./2.+PREDTH1) &
+! /((1.+PREDTH1)*(1.+1./2.*PREDTH1))) &
+! + PRED2TH3 / (PREDTH1*(1.+PREDTH1)*(1.+1./2.*PREDTH1)) &
+! - 1./2.*PREDTH1 / ((1.+PREDTH1)*(1.+1./2.*PREDTH1))
+! ELSEWHERE
+! D_PHI3DTDZ2_O_DDTDZ(:,:,:) = PPHI3(:,:,:) * 2. * PDTDZ(:,:,:)
+! ENDWHERE
+! END IF
+ELSE
+ !* 1DIM case
+ WHERE (PPHI3(:,:,:)<=XPHI_LIM)
+ D_PHI3DTDZ2_O_DDTDZ(:,:,:) = PPHI3(:,:,:)*PDTDZ(:,:,:) &
+ * (2. - PREDTH1(:,:,:)*PPHI3(:,:,:))
+ ELSEWHERE
+ D_PHI3DTDZ2_O_DDTDZ(:,:,:) = PPHI3(:,:,:) * 2. * PDTDZ(:,:,:)
+ END WHERE
+END IF
+!
+!* smoothing
+CALL SMOOTH_TURB_FUNCT(PPHI3,PPHI3*2.*PDTDZ,D_PHI3DTDZ2_O_DDTDZ)
+!
+!
+D_PHI3DTDZ2_O_DDTDZ(:,:,IKB-1)=D_PHI3DTDZ2_O_DDTDZ(:,:,IKB)
+D_PHI3DTDZ2_O_DDTDZ(:,:,IKE+1)=D_PHI3DTDZ2_O_DDTDZ(:,:,IKE)
+!
+END FUNCTION D_PHI3DTDZ2_O_DDTDZ
+!----------------------------------------------------------------------------
+FUNCTION M3_WTH_WTH2(PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_WTH_WTH2
+ INTEGER :: IKB, IKE
+!
+IKB = 1+JPVEXT_TURB
+IKE = SIZE(PD,3)-JPVEXT_TURB
+
+M3_WTH_WTH2(:,:,:) = XCSHF*PBLL_O_E*PETHETA*0.5/XCTD &
+ * (1.+0.5*PREDTH1+PREDR1) / PD
+M3_WTH_WTH2(:,:,IKB-1)=M3_WTH_WTH2(:,:,IKB)
+M3_WTH_WTH2(:,:,IKE+1)=M3_WTH_WTH2(:,:,IKE)
+!
+END FUNCTION M3_WTH_WTH2
+!----------------------------------------------------------------------------
+FUNCTION D_M3_WTH_WTH2_O_DDTDZ(PM3_WTH_WTH2,PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PM3_WTH_WTH2
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_WTH_WTH2_O_DDTDZ
+ INTEGER :: IKB, IKE
+!
+IKB = 1+JPVEXT_TURB
+IKE = SIZE(PD,3)-JPVEXT_TURB
+
+D_M3_WTH_WTH2_O_DDTDZ(:,:,:) = ( 0.5*XCSHF*PBLL_O_E*PETHETA*0.5/XCTD/PD &
+ - PM3_WTH_WTH2/PD*(1.5+PREDTH1+PREDR1) )&
+ * PBLL_O_E * PETHETA * XCTV
+!
+D_M3_WTH_WTH2_O_DDTDZ(:,:,IKB-1)=D_M3_WTH_WTH2_O_DDTDZ(:,:,IKB)
+D_M3_WTH_WTH2_O_DDTDZ(:,:,IKE+1)=D_M3_WTH_WTH2_O_DDTDZ(:,:,IKE)
+!
+END FUNCTION D_M3_WTH_WTH2_O_DDTDZ
+!----------------------------------------------------------------------------
+FUNCTION M3_WTH_W2TH(PREDTH1,PREDR1,PD,PKEFF,PTKE)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PKEFF
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_WTH_W2TH
+ INTEGER :: IKB, IKE
+!
+IKB = 1+JPVEXT_TURB
+IKE = SIZE(PD,3)-JPVEXT_TURB
+
+M3_WTH_W2TH(:,:,:) = XCSHF*PKEFF*1.5/MZM(PTKE) &
+ * (1. - 0.5*PREDR1*(1.+PREDR1)/PD ) / (1.+PREDTH1)
+!
+M3_WTH_W2TH(:,:,IKB-1)=M3_WTH_W2TH(:,:,IKB)
+M3_WTH_W2TH(:,:,IKE+1)=M3_WTH_W2TH(:,:,IKE)
+!
+END FUNCTION M3_WTH_W2TH
+!----------------------------------------------------------------------------
+FUNCTION D_M3_WTH_W2TH_O_DDTDZ(PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA,PKEFF,PTKE)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PKEFF
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_WTH_W2TH_O_DDTDZ
+ INTEGER :: IKB, IKE
+!
+IKB = 1+JPVEXT_TURB
+IKE = SIZE(PD,3)-JPVEXT_TURB
+
+D_M3_WTH_W2TH_O_DDTDZ(:,:,:) = &
+ - XCSHF*PKEFF*1.5/MZM(PTKE)/(1.+PREDTH1)**2*XCTV*PBLL_O_E*PETHETA &
+ * (1. - 0.5*PREDR1*(1.+PREDR1)/PD*( 1.+(1.+PREDTH1)*(1.5+PREDR1+PREDTH1)/PD) )
+!
+D_M3_WTH_W2TH_O_DDTDZ(:,:,IKB-1)=D_M3_WTH_W2TH_O_DDTDZ(:,:,IKB)
+D_M3_WTH_W2TH_O_DDTDZ(:,:,IKE+1)=D_M3_WTH_W2TH_O_DDTDZ(:,:,IKE)
+!
+END FUNCTION D_M3_WTH_W2TH_O_DDTDZ
+!----------------------------------------------------------------------------
+FUNCTION M3_WTH_W2R(PD,PKEFF,PTKE,PBLL_O_E,PEMOIST,PDTDZ)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PKEFF
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTDZ
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_WTH_W2R
+ INTEGER :: IKB, IKE
+!
+IKB = 1+JPVEXT_TURB
+IKE = SIZE(PD,3)-JPVEXT_TURB
+
+M3_WTH_W2R(:,:,:) = - XCSHF*PKEFF*0.75*XCTV*PBLL_O_E/MZM(PTKE)*PEMOIST*PDTDZ/PD
+!
+M3_WTH_W2R(:,:,IKB-1)=M3_WTH_W2R(:,:,IKB)
+M3_WTH_W2R(:,:,IKE+1)=M3_WTH_W2R(:,:,IKE)
+!
+END FUNCTION M3_WTH_W2R
+!----------------------------------------------------------------------------
+FUNCTION D_M3_WTH_W2R_O_DDTDZ(PREDTH1,PREDR1,PD,PKEFF,PTKE,PBLL_O_E,PEMOIST)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PKEFF
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_WTH_W2R_O_DDTDZ
+ INTEGER :: IKB, IKE
+!
+IKB = 1+JPVEXT_TURB
+IKE = SIZE(PD,3)-JPVEXT_TURB
+
+D_M3_WTH_W2R_O_DDTDZ(:,:,:) = - XCSHF*PKEFF*0.75*XCTV*PBLL_O_E/MZM(PTKE)*PEMOIST/PD &
+ * (1. - PREDTH1*(1.5+PREDTH1+PREDR1)/PD)
+!
+D_M3_WTH_W2R_O_DDTDZ(:,:,IKB-1)=D_M3_WTH_W2R_O_DDTDZ(:,:,IKB)
+D_M3_WTH_W2R_O_DDTDZ(:,:,IKE+1)=D_M3_WTH_W2R_O_DDTDZ(:,:,IKE)
+!
+END FUNCTION D_M3_WTH_W2R_O_DDTDZ
+!----------------------------------------------------------------------------
+FUNCTION M3_WTH_WR2(PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST,PDTDZ)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PKEFF
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PBETA
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTDZ
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_WTH_WR2
+ INTEGER :: IKB, IKE
+!
+IKB = 1+JPVEXT_TURB
+IKE = SIZE(PD,3)-JPVEXT_TURB
+
+M3_WTH_WR2(:,:,:) = - XCSHF*PKEFF*0.25*PBLL_O_E*XCTV*PEMOIST**2 &
+ *MZM(PBETA*PLEPS/(PSQRT_TKE*PTKE))/XCTD*PDTDZ/PD
+!
+M3_WTH_WR2(:,:,IKB-1)=M3_WTH_WR2(:,:,IKB)
+M3_WTH_WR2(:,:,IKE+1)=M3_WTH_WR2(:,:,IKE)
+!
+END FUNCTION M3_WTH_WR2
+!----------------------------------------------------------------------------
+FUNCTION D_M3_WTH_WR2_O_DDTDZ(PREDTH1,PREDR1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PKEFF
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PBETA
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_WTH_WR2_O_DDTDZ
+ INTEGER :: IKB, IKE
+!
+IKB = 1+JPVEXT_TURB
+IKE = SIZE(PD,3)-JPVEXT_TURB
+
+D_M3_WTH_WR2_O_DDTDZ(:,:,:) = - XCSHF*PKEFF*0.25*PBLL_O_E*XCTV*PEMOIST**2 &
+ *MZM(PBETA*PLEPS/(PSQRT_TKE*PTKE))/XCTD/PD &
+ * (1. - PREDTH1*(1.5+PREDTH1+PREDR1)/PD)
+!
+D_M3_WTH_WR2_O_DDTDZ(:,:,IKB-1)=D_M3_WTH_WR2_O_DDTDZ(:,:,IKB)
+D_M3_WTH_WR2_O_DDTDZ(:,:,IKE+1)=D_M3_WTH_WR2_O_DDTDZ(:,:,IKE)
+!
+END FUNCTION D_M3_WTH_WR2_O_DDTDZ
+!----------------------------------------------------------------------------
+FUNCTION M3_WTH_WTHR(PREDR1,PD,PKEFF,PTKE,PSQRT_TKE,PBETA,PLEPS,PEMOIST)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PKEFF
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PBETA
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
+ REAL, DIMENSION(SIZE(PREDR1,1),SIZE(PREDR1,2),SIZE(PREDR1,3)) :: M3_WTH_WTHR
+ INTEGER :: IKB, IKE
+!
+IKB = 1+JPVEXT_TURB
+IKE = SIZE(PD,3)-JPVEXT_TURB
+
+!M3_WTH_WTHR(:,:,:) = XCSHF*PKEFF*PEMOIST/MZM(PBETA*PTKE*PSQRT_TKE) &
+! *0.5*PLEPS/XCTD*(1+PREDR1)/PD
+M3_WTH_WTHR(:,:,:) = XCSHF*PKEFF*PEMOIST*MZM(PBETA/PTKE*PSQRT_TKE) &
+ *0.5*PLEPS/XCTD*(1+PREDR1)/PD
+!
+M3_WTH_WTHR(:,:,IKB-1)=M3_WTH_WTHR(:,:,IKB)
+M3_WTH_WTHR(:,:,IKE+1)=M3_WTH_WTHR(:,:,IKE)
+!
+END FUNCTION M3_WTH_WTHR
+!----------------------------------------------------------------------------
+FUNCTION D_M3_WTH_WTHR_O_DDTDZ(PM3_WTH_WTHR,PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PM3_WTH_WTHR
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_WTH_WTHR_O_DDTDZ
+ INTEGER :: IKB, IKE
+!
+IKB = 1+JPVEXT_TURB
+IKE = SIZE(PD,3)-JPVEXT_TURB
+
+D_M3_WTH_WTHR_O_DDTDZ(:,:,:) = - PM3_WTH_WTHR * (1.5+PREDTH1+PREDR1)/PD*XCTV*PBLL_O_E*PETHETA
+!
+D_M3_WTH_WTHR_O_DDTDZ(:,:,IKB-1)=D_M3_WTH_WTHR_O_DDTDZ(:,:,IKB)
+D_M3_WTH_WTHR_O_DDTDZ(:,:,IKE+1)=D_M3_WTH_WTHR_O_DDTDZ(:,:,IKE)
+!
+END FUNCTION D_M3_WTH_WTHR_O_DDTDZ
+!----------------------------------------------------------------------------
+FUNCTION M3_TH2_W2TH(PREDTH1,PREDR1,PD,PDTDZ,PLM,PLEPS,PTKE)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTDZ
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_TH2_W2TH
+ INTEGER :: IKB, IKE
+!
+IKB = 1+JPVEXT_TURB
+IKE = SIZE(PD,3)-JPVEXT_TURB
+
+M3_TH2_W2TH(:,:,:) = - MZF((1.-0.5*PREDR1*(1.+PREDR1)/PD)/(1.+PREDTH1)*PDTDZ) &
+ * 1.5*PLM*PLEPS/PTKE*XCTV
+!
+M3_TH2_W2TH(:,:,IKB-1)=M3_TH2_W2TH(:,:,IKB)
+M3_TH2_W2TH(:,:,IKE+1)=M3_TH2_W2TH(:,:,IKE)
+!
+END FUNCTION M3_TH2_W2TH
+!----------------------------------------------------------------------------
+FUNCTION D_M3_TH2_W2TH_O_DDTDZ(PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,OUSERV)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
+ LOGICAL, INTENT(IN) :: OUSERV
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_TH2_W2TH_O_DDTDZ
+ INTEGER :: IKB, IKE
+!
+IKB = 1+JPVEXT_TURB
+IKE = SIZE(PD,3)-JPVEXT_TURB
+
+IF (OUSERV) THEN
+! D_M3_TH2_W2TH_O_DDTDZ(:,:,:) = - 1.5*PLM*PLEPS/PTKE*XCTV * MZF( &
+! (1.-0.5*PREDR1*(1.+PREDR1)/PD)*(1.-(1.5+PREDTH1+PREDR1)*(1.+PREDTH1)/PD ) &
+! / (1.+PREDTH1)**2 )
+ D_M3_TH2_W2TH_O_DDTDZ(:,:,:) = - 1.5*PLM*PLEPS/PTKE*XCTV * MZF( &
+ (1.-0.5*PREDR1*(1.+PREDR1)/PD)*(1.-(1.5+PREDTH1+PREDR1)* &
+ PREDTH1*(1.+PREDTH1)/PD ) / (1.+PREDTH1)**2 )
+
+ELSE
+ D_M3_TH2_W2TH_O_DDTDZ(:,:,:) = - 1.5*PLM*PLEPS/PTKE*XCTV * MZF(1./(1.+PREDTH1)**2)
+END IF
+!
+D_M3_TH2_W2TH_O_DDTDZ(:,:,IKB-1)=D_M3_TH2_W2TH_O_DDTDZ(:,:,IKB)
+D_M3_TH2_W2TH_O_DDTDZ(:,:,IKE+1)=D_M3_TH2_W2TH_O_DDTDZ(:,:,IKE)
+!
+END FUNCTION D_M3_TH2_W2TH_O_DDTDZ
+!----------------------------------------------------------------------------
+FUNCTION M3_TH2_WTH2(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_TH2_WTH2
+ INTEGER :: IKB, IKE
+!
+IKB = 1+JPVEXT_TURB
+IKE = SIZE(PD,3)-JPVEXT_TURB
+
+M3_TH2_WTH2(:,:,:) = PLEPS*0.5/XCTD/PSQRT_TKE &
+ * MZF( (1.+0.5*PREDTH1+1.5*PREDR1+0.5*PREDR1**2)/PD )
+!
+M3_TH2_WTH2(:,:,IKB-1)=M3_TH2_WTH2(:,:,IKB)
+M3_TH2_WTH2(:,:,IKE+1)=M3_TH2_WTH2(:,:,IKE)
+!
+END FUNCTION M3_TH2_WTH2
+!----------------------------------------------------------------------------
+FUNCTION D_M3_TH2_WTH2_O_DDTDZ(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_TH2_WTH2_O_DDTDZ
+ INTEGER :: IKB, IKE
+!
+IKB = 1+JPVEXT_TURB
+IKE = SIZE(PD,3)-JPVEXT_TURB
+
+D_M3_TH2_WTH2_O_DDTDZ(:,:,:) = PLEPS*0.5/XCTD/PSQRT_TKE*XCTV &
+ * MZF( PBLL_O_E*PETHETA* (0.5/PD &
+ - (1.5+PREDTH1+PREDR1)*(1.+0.5*PREDTH1+1.5*PREDR1+0.5*PREDR1**2)/PD**2 &
+ ) )
+!
+D_M3_TH2_WTH2_O_DDTDZ(:,:,IKB-1)=D_M3_TH2_WTH2_O_DDTDZ(:,:,IKB)
+D_M3_TH2_WTH2_O_DDTDZ(:,:,IKE+1)=D_M3_TH2_WTH2_O_DDTDZ(:,:,IKE)
+!
+END FUNCTION D_M3_TH2_WTH2_O_DDTDZ
+!----------------------------------------------------------------------------
+FUNCTION M3_TH2_W2R(PD,PLM,PLEPS,PTKE,PBLL_O_E,PEMOIST,PDTDZ)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTDZ
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_TH2_W2R
+ INTEGER :: IKB, IKE
+!
+IKB = 1+JPVEXT_TURB
+IKE = SIZE(PD,3)-JPVEXT_TURB
+
+M3_TH2_W2R(:,:,:) = 0.75*XCTV**2*MZF(PBLL_O_E*PEMOIST/PD*PDTDZ**2)*PLM*PLEPS/PTKE
+!
+M3_TH2_W2R(:,:,IKB-1)=M3_TH2_W2R(:,:,IKB)
+M3_TH2_W2R(:,:,IKE+1)=M3_TH2_W2R(:,:,IKE)
+!
+END FUNCTION M3_TH2_W2R
+!----------------------------------------------------------------------------
+FUNCTION D_M3_TH2_W2R_O_DDTDZ(PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PEMOIST,PDTDZ)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTDZ
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_TH2_W2R_O_DDTDZ
+ INTEGER :: IKB, IKE
+!
+IKB = 1+JPVEXT_TURB
+IKE = SIZE(PD,3)-JPVEXT_TURB
+
+D_M3_TH2_W2R_O_DDTDZ(:,:,:) = 0.75*XCTV**2*PLM*PLEPS/PTKE &
+ * MZF( PBLL_O_E*PEMOIST/PD*PDTDZ*(2.-PREDTH1*(1.5+PREDTH1+PREDR1)/PD) )
+!
+D_M3_TH2_W2R_O_DDTDZ(:,:,IKB-1)=D_M3_TH2_W2R_O_DDTDZ(:,:,IKB)
+D_M3_TH2_W2R_O_DDTDZ(:,:,IKE+1)=D_M3_TH2_W2R_O_DDTDZ(:,:,IKE)
+!
+END FUNCTION D_M3_TH2_W2R_O_DDTDZ
+!----------------------------------------------------------------------------
+FUNCTION M3_TH2_WR2(PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTDZ
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_TH2_WR2
+ INTEGER :: IKB, IKE
+!
+IKB = 1+JPVEXT_TURB
+IKE = SIZE(PD,3)-JPVEXT_TURB
+
+M3_TH2_WR2(:,:,:) = 0.25*XCTV**2*MZF((PBLL_O_E*PEMOIST*PDTDZ)**2/PD)*PLEPS/PSQRT_TKE/XCTD
+!
+M3_TH2_WR2(:,:,IKB-1)=M3_TH2_WR2(:,:,IKB)
+M3_TH2_WR2(:,:,IKE+1)=M3_TH2_WR2(:,:,IKE)
+!
+END FUNCTION M3_TH2_WR2
+!----------------------------------------------------------------------------
+FUNCTION D_M3_TH2_WR2_O_DDTDZ(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTDZ
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_TH2_WR2_O_DDTDZ
+ INTEGER :: IKB, IKE
+!
+IKB = 1+JPVEXT_TURB
+IKE = SIZE(PD,3)-JPVEXT_TURB
+
+D_M3_TH2_WR2_O_DDTDZ(:,:,:) = 0.25*XCTV**2*PLEPS/PSQRT_TKE/XCTD &
+ * MZF( (PBLL_O_E*PEMOIST)**2*PDTDZ/PD*(2.-PREDTH1*(1.5+PREDTH1+PREDR1)/PD) )
+!
+D_M3_TH2_WR2_O_DDTDZ(:,:,IKB-1)=D_M3_TH2_WR2_O_DDTDZ(:,:,IKB)
+D_M3_TH2_WR2_O_DDTDZ(:,:,IKE+1)=D_M3_TH2_WR2_O_DDTDZ(:,:,IKE)
+!
+END FUNCTION D_M3_TH2_WR2_O_DDTDZ
+!----------------------------------------------------------------------------
+FUNCTION M3_TH2_WTHR(PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTDZ
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_TH2_WTHR
+ INTEGER :: IKB, IKE
+!
+IKB = 1+JPVEXT_TURB
+IKE = SIZE(PD,3)-JPVEXT_TURB
+
+M3_TH2_WTHR(:,:,:) = - 0.5*XCTV*PLEPS/PSQRT_TKE/XCTD &
+ * MZF( PBLL_O_E*PEMOIST*PDTDZ*(1.+PREDR1)/PD )
+!
+M3_TH2_WTHR(:,:,IKB-1)=M3_TH2_WTHR(:,:,IKB)
+M3_TH2_WTHR(:,:,IKE+1)=M3_TH2_WTHR(:,:,IKE)
+!
+END FUNCTION M3_TH2_WTHR
+!----------------------------------------------------------------------------
+FUNCTION D_M3_TH2_WTHR_O_DDTDZ(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTDZ
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_TH2_WTHR_O_DDTDZ
+ INTEGER :: IKB, IKE
+!
+IKB = 1+JPVEXT_TURB
+IKE = SIZE(PD,3)-JPVEXT_TURB
+
+D_M3_TH2_WTHR_O_DDTDZ(:,:,:) = - 0.5*XCTV*PLEPS/PSQRT_TKE/XCTD &
+ * MZF( PBLL_O_E*PEMOIST*(1.+PREDR1)/PD * (1. -PREDTH1*(1.5+PREDTH1+PREDR1)/PD) )
+!
+D_M3_TH2_WTHR_O_DDTDZ(:,:,IKB-1)=D_M3_TH2_WTHR_O_DDTDZ(:,:,IKB)
+D_M3_TH2_WTHR_O_DDTDZ(:,:,IKE+1)=D_M3_TH2_WTHR_O_DDTDZ(:,:,IKE)
+!
+END FUNCTION D_M3_TH2_WTHR_O_DDTDZ
+!----------------------------------------------------------------------------
+FUNCTION M3_THR_WTHR(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_THR_WTHR
+ INTEGER :: IKB, IKE
+!
+IKB = 1+JPVEXT_TURB
+IKE = SIZE(PD,3)-JPVEXT_TURB
+
+M3_THR_WTHR(:,:,:) = 0.5*PLEPS/PSQRT_TKE/XCTD &
+ * MZF( (1.+PREDTH1)*(1.+PREDR1)/PD )
+!
+M3_THR_WTHR(:,:,IKB-1)=M3_THR_WTHR(:,:,IKB)
+M3_THR_WTHR(:,:,IKE+1)=M3_THR_WTHR(:,:,IKE)
+!
+END FUNCTION M3_THR_WTHR
+!----------------------------------------------------------------------------
+FUNCTION D_M3_THR_WTHR_O_DDTDZ(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_THR_WTHR_O_DDTDZ
+ INTEGER :: IKB, IKE
+!
+IKB = 1+JPVEXT_TURB
+IKE = SIZE(PD,3)-JPVEXT_TURB
+
+D_M3_THR_WTHR_O_DDTDZ(:,:,:) = 0.5*PLEPS/PSQRT_TKE/XCTD * XCTV &
+ * MZF( PETHETA*PBLL_O_E/PD*(1.+PREDR1)*(1.-(1.+PREDTH1)*(1.5+PREDTH1+PREDR1)/PD) )
+!
+D_M3_THR_WTHR_O_DDTDZ(:,:,IKB-1)=D_M3_THR_WTHR_O_DDTDZ(:,:,IKB)
+D_M3_THR_WTHR_O_DDTDZ(:,:,IKE+1)=D_M3_THR_WTHR_O_DDTDZ(:,:,IKE)
+!
+END FUNCTION D_M3_THR_WTHR_O_DDTDZ
+!----------------------------------------------------------------------------
+FUNCTION M3_THR_WTH2(PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PDRDZ
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_THR_WTH2
+ INTEGER :: IKB, IKE
+!
+IKB = 1+JPVEXT_TURB
+IKE = SIZE(PD,3)-JPVEXT_TURB
+
+M3_THR_WTH2(:,:,:) = - 0.25*PLEPS/PSQRT_TKE/XCTD*XCTV &
+ * MZF( (1.+PREDR1)*PBLL_O_E*PETHETA*PDRDZ/PD )
+!
+M3_THR_WTH2(:,:,IKB-1)=M3_THR_WTH2(:,:,IKB)
+M3_THR_WTH2(:,:,IKE+1)=M3_THR_WTH2(:,:,IKE)
+!
+END FUNCTION M3_THR_WTH2
+!----------------------------------------------------------------------------
+FUNCTION D_M3_THR_WTH2_O_DDTDZ(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PDRDZ
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_THR_WTH2_O_DDTDZ
+ INTEGER :: IKB, IKE
+!
+IKB = 1+JPVEXT_TURB
+IKE = SIZE(PD,3)-JPVEXT_TURB
+
+D_M3_THR_WTH2_O_DDTDZ(:,:,:) = - 0.25*PLEPS/PSQRT_TKE/XCTD*XCTV**2 &
+ * MZF( -(1.+PREDR1)*(PBLL_O_E*PETHETA/PD)**2*PDRDZ*(1.5+PREDTH1+PREDR1) )
+!
+D_M3_THR_WTH2_O_DDTDZ(:,:,IKB-1)=D_M3_THR_WTH2_O_DDTDZ(:,:,IKB)
+D_M3_THR_WTH2_O_DDTDZ(:,:,IKE+1)=D_M3_THR_WTH2_O_DDTDZ(:,:,IKE)
+!
+END FUNCTION D_M3_THR_WTH2_O_DDTDZ
+!----------------------------------------------------------------------------
+FUNCTION D_M3_THR_WTH2_O_DDRDZ(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_THR_WTH2_O_DDRDZ
+ INTEGER :: IKB, IKE
+!
+IKB = 1+JPVEXT_TURB
+IKE = SIZE(PD,3)-JPVEXT_TURB
+
+D_M3_THR_WTH2_O_DDRDZ(:,:,:) = - 0.25*PLEPS/PSQRT_TKE/XCTD*XCTV &
+ * MZF( PBLL_O_E*PETHETA/PD &
+ *(-(1.+PREDR1)*PREDR1/PD*(1.5+PREDTH1+PREDR1)+(1.+2.*PREDR1)) &
+ )
+!
+D_M3_THR_WTH2_O_DDRDZ(:,:,IKB-1)=D_M3_THR_WTH2_O_DDRDZ(:,:,IKB)
+D_M3_THR_WTH2_O_DDRDZ(:,:,IKE+1)=D_M3_THR_WTH2_O_DDRDZ(:,:,IKE)
+!
+END FUNCTION D_M3_THR_WTH2_O_DDRDZ
+!----------------------------------------------------------------------------
+FUNCTION M3_THR_W2TH(PREDR1,PD,PLM,PLEPS,PTKE,PDRDZ)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PDRDZ
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_THR_W2TH
+ INTEGER :: IKB, IKE
+!
+IKB = 1+JPVEXT_TURB
+IKE = SIZE(PD,3)-JPVEXT_TURB
+
+M3_THR_W2TH(:,:,:) = - 0.75*PLM*PLEPS/PTKE * XCTV &
+ * MZF( (1.+PREDR1)*PDRDZ/PD )
+!
+M3_THR_W2TH(:,:,IKB-1)=M3_THR_W2TH(:,:,IKB)
+M3_THR_W2TH(:,:,IKE+1)=M3_THR_W2TH(:,:,IKE)
+!
+END FUNCTION M3_THR_W2TH
+!----------------------------------------------------------------------------
+FUNCTION D_M3_THR_W2TH_O_DDTDZ(PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PDRDZ,PETHETA)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PDRDZ
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_THR_W2TH_O_DDTDZ
+ INTEGER :: IKB, IKE
+!
+IKB = 1+JPVEXT_TURB
+IKE = SIZE(PD,3)-JPVEXT_TURB
+
+D_M3_THR_W2TH_O_DDTDZ(:,:,:) = - 0.75*PLM*PLEPS/PTKE * XCTV**2 &
+ * MZF( -PETHETA*PBLL_O_E*(1.+PREDR1)*PDRDZ*(1.5+PREDTH1+PREDR1)/PD**2 )
+
+!
+D_M3_THR_W2TH_O_DDTDZ(:,:,IKB-1)=D_M3_THR_W2TH_O_DDTDZ(:,:,IKB)
+D_M3_THR_W2TH_O_DDTDZ(:,:,IKE+1)=D_M3_THR_W2TH_O_DDTDZ(:,:,IKE)
+!
+END FUNCTION D_M3_THR_W2TH_O_DDTDZ
+!----------------------------------------------------------------------------
+FUNCTION D_M3_THR_W2TH_O_DDRDZ(PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_THR_W2TH_O_DDRDZ
+ INTEGER :: IKB, IKE
+!
+IKB = 1+JPVEXT_TURB
+IKE = SIZE(PD,3)-JPVEXT_TURB
+
+D_M3_THR_W2TH_O_DDRDZ(:,:,:) = - 0.75*PLM*PLEPS/PTKE * XCTV &
+ * MZF( -(1.+PREDR1)*PREDR1*(1.5+PREDTH1+PREDR1)/PD**2 &
+ +(1.+2.*PREDR1)/PD &
+ )
+
+!
+D_M3_THR_W2TH_O_DDRDZ(:,:,IKB-1)=D_M3_THR_W2TH_O_DDRDZ(:,:,IKB)
+D_M3_THR_W2TH_O_DDRDZ(:,:,IKE+1)=D_M3_THR_W2TH_O_DDRDZ(:,:,IKE)
+!
+END FUNCTION D_M3_THR_W2TH_O_DDRDZ
+!----------------------------------------------------------------------------
+!----------------------------------------------------------------------------
+!----------------------------------------------------------------------------
+!
+FUNCTION PSI3(PREDR1,PREDTH1,PRED2R3,PRED2TH3,PRED2THR3,HTURBDIM,OUSERV)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2TH3
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2R3
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2THR3
+ CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! 1DIM or 3DIM turb. scheme
+ LOGICAL, INTENT(IN) :: OUSERV ! flag to use vapor
+ REAL, DIMENSION(SIZE(PREDTH1,1),SIZE(PREDTH1,2),SIZE(PREDTH1,3)) :: PSI3
+!
+PSI3 = PHI3(PREDR1,PREDTH1,PRED2R3,PRED2TH3,PRED2THR3,HTURBDIM,OUSERV)
+!
+END FUNCTION PSI3
+!----------------------------------------------------------------------------
+FUNCTION D_PSI3DRDZ_O_DDRDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,OUSERV)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PPSI3
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2R3
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2THR3
+ CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! 1DIM or 3DIM turb. scheme
+ LOGICAL, INTENT(IN) :: OUSERV ! flag to use vapor
+ REAL, DIMENSION(SIZE(PREDTH1,1),SIZE(PREDTH1,2),SIZE(PREDTH1,3)) :: D_PSI3DRDZ_O_DDRDZ
+
+D_PSI3DRDZ_O_DDRDZ = D_PHI3DTDZ_O_DDTDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,OUSERV)
+!
+!C'est ok?!
+!
+END FUNCTION D_PSI3DRDZ_O_DDRDZ
+!----------------------------------------------------------------------------
+FUNCTION D_PSI3DTDZ_O_DDTDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,OUSERV)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PPSI3
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2R3
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2THR3
+ CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! 1DIM or 3DIM turb. scheme
+ LOGICAL, INTENT(IN) :: OUSERV ! flag to use vapor
+ REAL, DIMENSION(SIZE(PREDTH1,1),SIZE(PREDTH1,2),SIZE(PREDTH1,3)) :: D_PSI3DTDZ_O_DDTDZ
+!
+D_PSI3DTDZ_O_DDTDZ = D_PHI3DRDZ_O_DDRDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,OUSERV)
+!
+END FUNCTION D_PSI3DTDZ_O_DDTDZ
+!----------------------------------------------------------------------------
+FUNCTION D_PSI3DRDZ2_O_DDRDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,PDRDZ,HTURBDIM,OUSERV)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PPSI3
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2R3
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2THR3
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PDRDZ
+ CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! 1DIM or 3DIM turb. scheme
+ LOGICAL, INTENT(IN) :: OUSERV ! flag to use vapor
+ REAL, DIMENSION(SIZE(PREDTH1,1),SIZE(PREDTH1,2),SIZE(PREDTH1,3)) :: D_PSI3DRDZ2_O_DDRDZ
+!
+D_PSI3DRDZ2_O_DDRDZ = D_PHI3DTDZ2_O_DDTDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,PDRDZ,HTURBDIM,OUSERV)
+!
+END FUNCTION D_PSI3DRDZ2_O_DDRDZ
+!----------------------------------------------------------------------------
+FUNCTION M3_WR_WR2(PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_WR_WR2
+!
+M3_WR_WR2 = M3_WTH_WTH2(PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST)
+!
+END FUNCTION M3_WR_WR2
+!----------------------------------------------------------------------------
+FUNCTION D_M3_WR_WR2_O_DDRDZ(PM3_WR_WR2,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PM3_WR_WR2
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_WR_WR2_O_DDRDZ
+!
+D_M3_WR_WR2_O_DDRDZ = D_M3_WTH_WTH2_O_DDTDZ(PM3_WR_WR2,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST)
+!
+END FUNCTION D_M3_WR_WR2_O_DDRDZ
+!----------------------------------------------------------------------------
+FUNCTION M3_WR_W2R(PREDR1,PREDTH1,PD,PKEFF,PTKE)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PKEFF
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_WR_W2R
+!
+M3_WR_W2R = M3_WTH_W2TH(PREDR1,PREDTH1,PD,PKEFF,PTKE)
+!
+END FUNCTION M3_WR_W2R
+!----------------------------------------------------------------------------
+FUNCTION D_M3_WR_W2R_O_DDRDZ(PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST,PKEFF,PTKE)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PKEFF
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_WR_W2R_O_DDRDZ
+!
+D_M3_WR_W2R_O_DDRDZ = D_M3_WTH_W2TH_O_DDTDZ(PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST,PKEFF,PTKE)
+!
+END FUNCTION D_M3_WR_W2R_O_DDRDZ
+!----------------------------------------------------------------------------
+FUNCTION M3_WR_W2TH(PD,PKEFF,PTKE,PBLL_O_E,PETHETA,PDRDZ)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PKEFF
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PDRDZ
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_WR_W2TH
+!
+M3_WR_W2TH = M3_WTH_W2R(PD,PKEFF,PTKE,PBLL_O_E,PETHETA,PDRDZ)
+!
+END FUNCTION M3_WR_W2TH
+!----------------------------------------------------------------------------
+FUNCTION D_M3_WR_W2TH_O_DDRDZ(PREDR1,PREDTH1,PD,PKEFF,PTKE,PBLL_O_E,PETHETA)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PKEFF
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_WR_W2TH_O_DDRDZ
+!
+D_M3_WR_W2TH_O_DDRDZ = D_M3_WTH_W2R_O_DDTDZ(PREDR1,PREDTH1,PD,PKEFF,PTKE,PBLL_O_E,PETHETA)
+!
+END FUNCTION D_M3_WR_W2TH_O_DDRDZ
+!----------------------------------------------------------------------------
+FUNCTION M3_WR_WTH2(PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA,PDRDZ)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PKEFF
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PBETA
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PDRDZ
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_WR_WTH2
+!
+M3_WR_WTH2 = M3_WTH_WR2(PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA,PDRDZ)
+!
+END FUNCTION M3_WR_WTH2
+!----------------------------------------------------------------------------
+FUNCTION D_M3_WR_WTH2_O_DDRDZ(PREDR1,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PKEFF
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PBETA
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_WR_WTH2_O_DDRDZ
+!
+D_M3_WR_WTH2_O_DDRDZ = D_M3_WTH_WR2_O_DDTDZ(PREDR1,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA)
+!
+END FUNCTION D_M3_WR_WTH2_O_DDRDZ
+!----------------------------------------------------------------------------
+FUNCTION M3_WR_WTHR(PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBETA,PLEPS,PETHETA)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PKEFF
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PBETA
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_WR_WTHR
+!
+M3_WR_WTHR = M3_WTH_WTHR(PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBETA,PLEPS,PETHETA)
+!
+END FUNCTION M3_WR_WTHR
+!----------------------------------------------------------------------------
+FUNCTION D_M3_WR_WTHR_O_DDRDZ(PM3_WR_WTHR,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PM3_WR_WTHR
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_WR_WTHR_O_DDRDZ
+!
+D_M3_WR_WTHR_O_DDRDZ = D_M3_WTH_WTHR_O_DDTDZ(PM3_WR_WTHR,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST)
+!
+END FUNCTION D_M3_WR_WTHR_O_DDRDZ
+!----------------------------------------------------------------------------
+FUNCTION M3_R2_W2R(PREDR1,PREDTH1,PD,PDRDZ,PLM,PLEPS,PTKE)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PDRDZ
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_R2_W2R
+!
+M3_R2_W2R = M3_TH2_W2TH(PREDR1,PREDTH1,PD,PDRDZ,PLM,PLEPS,PTKE)
+!
+END FUNCTION M3_R2_W2R
+!----------------------------------------------------------------------------
+FUNCTION D_M3_R2_W2R_O_DDRDZ(PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,OUSERV)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
+ LOGICAL, INTENT(IN) :: OUSERV
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_R2_W2R_O_DDRDZ
+!
+D_M3_R2_W2R_O_DDRDZ = D_M3_TH2_W2TH_O_DDTDZ(PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,OUSERV)
+!
+END FUNCTION D_M3_R2_W2R_O_DDRDZ
+!----------------------------------------------------------------------------
+FUNCTION M3_R2_WR2(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_R2_WR2
+!
+M3_R2_WR2 = M3_TH2_WTH2(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE)
+!
+END FUNCTION M3_R2_WR2
+!----------------------------------------------------------------------------
+FUNCTION D_M3_R2_WR2_O_DDRDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_R2_WR2_O_DDRDZ
+!
+D_M3_R2_WR2_O_DDRDZ = D_M3_TH2_WTH2_O_DDTDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST)
+!
+END FUNCTION D_M3_R2_WR2_O_DDRDZ
+!----------------------------------------------------------------------------
+FUNCTION M3_R2_W2TH(PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,PDRDZ)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PDRDZ
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_R2_W2TH
+!
+M3_R2_W2TH = M3_TH2_W2R(PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,PDRDZ)
+!
+END FUNCTION M3_R2_W2TH
+!----------------------------------------------------------------------------
+FUNCTION D_M3_R2_W2TH_O_DDRDZ(PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,PDRDZ)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PDRDZ
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_R2_W2TH_O_DDRDZ
+!
+D_M3_R2_W2TH_O_DDRDZ = D_M3_TH2_W2R_O_DDTDZ(PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,PDRDZ)
+!
+END FUNCTION D_M3_R2_W2TH_O_DDRDZ
+!----------------------------------------------------------------------------
+FUNCTION M3_R2_WTH2(PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PDRDZ
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_R2_WTH2
+!
+M3_R2_WTH2 = M3_TH2_WR2(PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+!
+END FUNCTION M3_R2_WTH2
+!----------------------------------------------------------------------------
+FUNCTION D_M3_R2_WTH2_O_DDRDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PDRDZ
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_R2_WTH2_O_DDRDZ
+!
+D_M3_R2_WTH2_O_DDRDZ = D_M3_TH2_WR2_O_DDTDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+!
+END FUNCTION D_M3_R2_WTH2_O_DDRDZ
+!----------------------------------------------------------------------------
+FUNCTION M3_R2_WTHR(PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PDRDZ
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_R2_WTHR
+!
+M3_R2_WTHR = M3_TH2_WTHR(PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+!
+END FUNCTION M3_R2_WTHR
+!----------------------------------------------------------------------------
+FUNCTION D_M3_R2_WTHR_O_DDRDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PDRDZ
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_R2_WTHR_O_DDRDZ
+!
+D_M3_R2_WTHR_O_DDRDZ = D_M3_TH2_WTHR_O_DDTDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+!
+END FUNCTION D_M3_R2_WTHR_O_DDRDZ
+!----------------------------------------------------------------------------
+FUNCTION D_M3_THR_WTHR_O_DDRDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_THR_WTHR_O_DDRDZ
+!
+D_M3_THR_WTHR_O_DDRDZ = D_M3_THR_WTHR_O_DDTDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST)
+!
+END FUNCTION D_M3_THR_WTHR_O_DDRDZ
+!----------------------------------------------------------------------------
+FUNCTION M3_THR_WR2(PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTDZ
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_THR_WR2
+!
+M3_THR_WR2 = M3_THR_WTH2(PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
+!
+END FUNCTION M3_THR_WR2
+!----------------------------------------------------------------------------
+FUNCTION D_M3_THR_WR2_O_DDRDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTDZ
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_THR_WR2_O_DDRDZ
+!
+D_M3_THR_WR2_O_DDRDZ = D_M3_THR_WTH2_O_DDTDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
+!
+END FUNCTION D_M3_THR_WR2_O_DDRDZ
+!----------------------------------------------------------------------------
+FUNCTION D_M3_THR_WR2_O_DDTDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_THR_WR2_O_DDTDZ
+!
+D_M3_THR_WR2_O_DDTDZ = D_M3_THR_WTH2_O_DDRDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST)
+!
+END FUNCTION D_M3_THR_WR2_O_DDTDZ
+!----------------------------------------------------------------------------
+FUNCTION M3_THR_W2R(PREDTH1,PD,PLM,PLEPS,PTKE,PDTDZ)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTDZ
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_THR_W2R
+!
+M3_THR_W2R = M3_THR_W2TH(PREDTH1,PD,PLM,PLEPS,PTKE,PDTDZ)
+!
+END FUNCTION M3_THR_W2R
+!----------------------------------------------------------------------------
+FUNCTION D_M3_THR_W2R_O_DDRDZ(PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PDTDZ,PEMOIST)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTDZ
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_THR_W2R_O_DDRDZ
+!
+D_M3_THR_W2R_O_DDRDZ = D_M3_THR_W2TH_O_DDTDZ(PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PDTDZ,PEMOIST)
+!
+END FUNCTION D_M3_THR_W2R_O_DDRDZ
+!----------------------------------------------------------------------------
+FUNCTION D_M3_THR_W2R_O_DDTDZ(PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_THR_W2R_O_DDTDZ
+!
+D_M3_THR_W2R_O_DDTDZ = D_M3_THR_W2TH_O_DDRDZ(PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE)
+!
+END FUNCTION D_M3_THR_W2R_O_DDTDZ
+!----------------------------------------------------------------------------
+!
+END MODULE MODE_PRANDTL
diff --git a/src/mesonh/turb/mode_sbl.f90 b/src/mesonh/turb/mode_sbl.f90
new file mode 100644
index 000000000..1c5e1da7f
--- /dev/null
+++ b/src/mesonh/turb/mode_sbl.f90
@@ -0,0 +1,457 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 mode 2006/05/18 13:07:25
+!-----------------------------------------------------------------
+! ###############
+ MODULE MODE_SBL
+! ###############
+!
+!!**** *MODE_SBL * - contains Surface Boundary Layer characteristics functions
+!!
+!! PURPOSE
+!! -------
+!
+!!** METHOD
+!! ------
+!!
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Businger et al 1971, Wyngaard and Cote 1974
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Masson * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 13/10/99
+!! V. Masson 06/11/02 optimization and add Businger fonction for TKE
+!! V. Masson 01/01/03 use PAULSON_PSIM function
+!-----------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+!
+INTERFACE BUSINGER_PHIM
+ MODULE PROCEDURE BUSINGER_PHIM_0D
+ MODULE PROCEDURE BUSINGER_PHIM_1D
+ MODULE PROCEDURE BUSINGER_PHIM_2D
+ MODULE PROCEDURE BUSINGER_PHIM_3D
+END INTERFACE
+INTERFACE BUSINGER_PHIH
+ MODULE PROCEDURE BUSINGER_PHIH_0D
+ MODULE PROCEDURE BUSINGER_PHIH_1D
+ MODULE PROCEDURE BUSINGER_PHIH_2D
+ MODULE PROCEDURE BUSINGER_PHIH_3D
+END INTERFACE
+INTERFACE BUSINGER_PHIE
+ MODULE PROCEDURE BUSINGER_PHIE_3D
+END INTERFACE
+INTERFACE PAULSON_PSIM
+ MODULE PROCEDURE PAULSON_PSIM_0D
+ MODULE PROCEDURE PAULSON_PSIM_1D
+ MODULE PROCEDURE PAULSON_PSIM_2D
+END INTERFACE
+INTERFACE LMO
+ MODULE PROCEDURE LMO_0D
+ MODULE PROCEDURE LMO_1D
+ MODULE PROCEDURE LMO_2D
+END INTERFACE
+INTERFACE USTAR
+ MODULE PROCEDURE USTAR_0D
+ MODULE PROCEDURE USTAR_1D
+ MODULE PROCEDURE USTAR_2D
+END INTERFACE
+!
+!-------------------------------------------------------------------------------
+CONTAINS
+!-------------------------------------------------------------------------------
+!
+FUNCTION BUSINGER_PHIM_3D(PZ_O_LMO)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PZ_O_LMO
+ REAL, DIMENSION(SIZE(PZ_O_LMO,1), &
+ SIZE(PZ_O_LMO,2),SIZE(PZ_O_LMO,3)) :: BUSINGER_PHIM_3D
+!
+ WHERE ( PZ_O_LMO(:,:,:) < 0. )
+ BUSINGER_PHIM_3D(:,:,:) = (1.-15.*PZ_O_LMO)**(-0.25)
+ ELSEWHERE
+ BUSINGER_PHIM_3D(:,:,:) = 1. + 4.7 * PZ_O_LMO
+ END WHERE
+END FUNCTION BUSINGER_PHIM_3D
+!
+!-------------------------------------------------------------------------------
+!
+FUNCTION BUSINGER_PHIM_2D(PZ_O_LMO)
+ REAL, DIMENSION(:,:), INTENT(IN) :: PZ_O_LMO
+ REAL, DIMENSION(SIZE(PZ_O_LMO,1),SIZE(PZ_O_LMO,2)) :: BUSINGER_PHIM_2D
+!
+ WHERE ( PZ_O_LMO(:,:) < 0. )
+ BUSINGER_PHIM_2D(:,:) = (1.-15.*PZ_O_LMO)**(-0.25)
+ ELSEWHERE
+ BUSINGER_PHIM_2D(:,:) = 1. + 4.7 * PZ_O_LMO
+ END WHERE
+END FUNCTION BUSINGER_PHIM_2D
+!
+!-------------------------------------------------------------------------------
+!
+FUNCTION BUSINGER_PHIM_1D(PZ_O_LMO)
+ REAL, DIMENSION(:), INTENT(IN) :: PZ_O_LMO
+ REAL, DIMENSION(SIZE(PZ_O_LMO)) :: BUSINGER_PHIM_1D
+!
+ WHERE ( PZ_O_LMO(:) < 0. )
+ BUSINGER_PHIM_1D(:) = (1.-15.*PZ_O_LMO)**(-0.25)
+ ELSEWHERE
+ BUSINGER_PHIM_1D(:) = 1. + 4.7 * PZ_O_LMO
+ END WHERE
+END FUNCTION BUSINGER_PHIM_1D
+!
+!-------------------------------------------------------------------------------
+!
+FUNCTION BUSINGER_PHIM_0D(PZ_O_LMO)
+ REAL, INTENT(IN) :: PZ_O_LMO
+ REAL :: BUSINGER_PHIM_0D
+!
+ IF ( PZ_O_LMO < 0. ) THEN
+ BUSINGER_PHIM_0D = (1.-15.*PZ_O_LMO)**(-0.25)
+ ELSE
+ BUSINGER_PHIM_0D = 1. + 4.7 * PZ_O_LMO
+ END IF
+END FUNCTION BUSINGER_PHIM_0D
+!
+!-------------------------------------------------------------------------------
+!-------------------------------------------------------------------------------
+!
+FUNCTION BUSINGER_PHIH_3D(PZ_O_LMO)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PZ_O_LMO
+ REAL, DIMENSION(SIZE(PZ_O_LMO,1), &
+ SIZE(PZ_O_LMO,2),SIZE(PZ_O_LMO,3)) :: BUSINGER_PHIH_3D
+!
+ WHERE ( PZ_O_LMO(:,:,:) < 0. )
+ BUSINGER_PHIH_3D(:,:,:) = 0.74 * (1.-9.*PZ_O_LMO)**(-0.5)
+ ELSEWHERE
+ BUSINGER_PHIH_3D(:,:,:) = 0.74 + 4.7 * PZ_O_LMO
+ END WHERE
+END FUNCTION BUSINGER_PHIH_3D
+!
+!-------------------------------------------------------------------------------
+!
+FUNCTION BUSINGER_PHIH_2D(PZ_O_LMO)
+ REAL, DIMENSION(:,:), INTENT(IN) :: PZ_O_LMO
+ REAL, DIMENSION(SIZE(PZ_O_LMO,1),SIZE(PZ_O_LMO,2)) :: BUSINGER_PHIH_2D
+!
+ WHERE ( PZ_O_LMO(:,:) < 0. )
+ BUSINGER_PHIH_2D(:,:) = 0.74 * (1.-9.*PZ_O_LMO)**(-0.5)
+ ELSEWHERE
+ BUSINGER_PHIH_2D(:,:) = 0.74 + 4.7 * PZ_O_LMO
+ END WHERE
+END FUNCTION BUSINGER_PHIH_2D
+!
+!-------------------------------------------------------------------------------
+!
+FUNCTION BUSINGER_PHIH_1D(PZ_O_LMO)
+ REAL, DIMENSION(:), INTENT(IN) :: PZ_O_LMO
+ REAL, DIMENSION(SIZE(PZ_O_LMO)) :: BUSINGER_PHIH_1D
+!
+ WHERE ( PZ_O_LMO(:) < 0. )
+ BUSINGER_PHIH_1D(:) = 0.74 * (1.-9.*PZ_O_LMO)**(-0.5)
+ ELSEWHERE
+ BUSINGER_PHIH_1D(:) = 0.74 + 4.7 * PZ_O_LMO
+ END WHERE
+END FUNCTION BUSINGER_PHIH_1D
+!
+!-------------------------------------------------------------------------------
+!
+FUNCTION BUSINGER_PHIH_0D(PZ_O_LMO)
+ REAL, INTENT(IN) :: PZ_O_LMO
+ REAL :: BUSINGER_PHIH_0D
+!
+ IF ( PZ_O_LMO < 0. ) THEN
+ BUSINGER_PHIH_0D = 0.74 * (1.-9.*PZ_O_LMO)**(-0.5)
+ ELSE
+ BUSINGER_PHIH_0D = 0.74 + 4.7 * PZ_O_LMO
+ END IF
+END FUNCTION BUSINGER_PHIH_0D
+!
+!-------------------------------------------------------------------------------
+!-------------------------------------------------------------------------------
+!
+FUNCTION BUSINGER_PHIE_3D(PZ_O_LMO)
+ USE MODD_CTURB
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PZ_O_LMO
+ REAL, DIMENSION(SIZE(PZ_O_LMO,1), &
+ SIZE(PZ_O_LMO,2),SIZE(PZ_O_LMO,3)) :: BUSINGER_PHIE_3D
+!
+ WHERE ( PZ_O_LMO(:,:,:) < 0. )
+ BUSINGER_PHIE_3D(:,:,:) = (1.+(-PZ_O_LMO)**(2./3.)/XALPSBL) &
+ * (1.-15.*PZ_O_LMO)**(0.5)
+ ELSEWHERE
+ BUSINGER_PHIE_3D(:,:,:) = 1./(1. + 4.7 * PZ_O_LMO)**2
+ END WHERE
+END FUNCTION BUSINGER_PHIE_3D
+!
+!-------------------------------------------------------------------------------
+!-------------------------------------------------------------------------------
+!
+FUNCTION PAULSON_PSIM_2D(PZ_O_LMO)
+ USE MODD_CST
+ REAL, DIMENSION(:,:), INTENT(IN) :: PZ_O_LMO
+ REAL, DIMENSION(SIZE(PZ_O_LMO,1),SIZE(PZ_O_LMO,2)) :: PAULSON_PSIM_2D
+!
+ REAL, DIMENSION(SIZE(PZ_O_LMO,1),SIZE(PZ_O_LMO,2)) :: ZX
+
+ ZX=1.
+ WHERE ( PZ_O_LMO(:,:) < 0. )
+ ZX=(1.-15.*PZ_O_LMO)**(0.25)
+ PAULSON_PSIM_2D(:,:) = LOG( (1.+ZX**2)*(1+ZX)**2/8. ) - 2.*ATAN(ZX) + XPI/2.
+ ELSEWHERE
+ PAULSON_PSIM_2D(:,:) = - 4.7 * PZ_O_LMO
+ END WHERE
+END FUNCTION PAULSON_PSIM_2D
+!
+!-------------------------------------------------------------------------------
+!
+FUNCTION PAULSON_PSIM_1D(PZ_O_LMO)
+ USE MODD_CST
+ REAL, DIMENSION(:), INTENT(IN) :: PZ_O_LMO
+ REAL, DIMENSION(SIZE(PZ_O_LMO,1)) :: PAULSON_PSIM_1D
+!
+ REAL, DIMENSION(SIZE(PZ_O_LMO,1)) :: ZX
+
+ ZX=1.
+ WHERE ( PZ_O_LMO(:) < 0. )
+ ZX=(1.-15.*PZ_O_LMO)**(0.25)
+ PAULSON_PSIM_1D(:) = LOG( (1.+ZX**2)*(1+ZX)**2/8. ) - 2.*ATAN(ZX) + XPI/2.
+ ELSEWHERE
+ PAULSON_PSIM_1D(:) = - 4.7 * PZ_O_LMO
+ END WHERE
+END FUNCTION PAULSON_PSIM_1D
+!
+!-------------------------------------------------------------------------------
+!
+FUNCTION PAULSON_PSIM_0D(PZ_O_LMO)
+ USE MODD_CST
+ REAL, INTENT(IN) :: PZ_O_LMO
+ REAL :: PAULSON_PSIM_0D
+!
+ REAL :: ZX
+
+ ZX=1.
+ IF ( PZ_O_LMO < 0. ) THEN
+ ZX=(1.-15.*PZ_O_LMO)**(0.25)
+ PAULSON_PSIM_0D = LOG( (1.+ZX**2)*(1+ZX)**2/8. ) - 2.*ATAN(ZX) + XPI/2.
+ ELSE
+ PAULSON_PSIM_0D = - 4.7 * PZ_O_LMO
+ END IF
+END FUNCTION PAULSON_PSIM_0D
+!
+!-------------------------------------------------------------------------------
+!-------------------------------------------------------------------------------
+!
+FUNCTION LMO_2D(PUSTAR,PTHETA,PRV,PSFTH,PSFRV)
+ USE MODD_CST
+ USE MODD_PARAMETERS
+ REAL, DIMENSION(:,:), INTENT(IN) :: PUSTAR
+ REAL, DIMENSION(:,:), INTENT(IN) :: PTHETA
+ REAL, DIMENSION(:,:), INTENT(IN) :: PRV
+ REAL, DIMENSION(:,:), INTENT(IN) :: PSFTH
+ REAL, DIMENSION(:,:), INTENT(IN) :: PSFRV
+ REAL, DIMENSION(SIZE(PUSTAR,1),SIZE(PUSTAR,2)) :: LMO_2D
+!
+ REAL, DIMENSION(SIZE(PUSTAR,1),SIZE(PUSTAR,2)) :: ZTHETAV
+ REAL, DIMENSION(SIZE(PUSTAR,1),SIZE(PUSTAR,2)) :: ZQ0
+ REAL :: ZEPS
+!
+!
+ ZEPS=(XRV-XRD)/XRD
+ ZTHETAV(:,:) = PTHETA(:,:) * ( 1. +ZEPS * PRV(:,:))
+ ZQ0 (:,:) = PSFTH(:,:) + ZTHETAV(:,:) * ZEPS * PSFRV(:,:)
+!
+ LMO_2D(:,:) = XUNDEF
+ WHERE ( ZQ0(:,:) /=0. ) &
+ LMO_2D(:,:) = - MAX(PUSTAR(:,:),1.E-6)**3 &
+ / ( XKARMAN * XG / ZTHETAV(:,:) *ZQ0(:,:) )
+
+END FUNCTION LMO_2D
+!
+!-------------------------------------------------------------------------------
+!
+FUNCTION LMO_1D(PUSTAR,PTHETA,PRV,PSFTH,PSFRV)
+ USE MODD_CST
+ USE MODD_PARAMETERS
+ REAL, DIMENSION(:), INTENT(IN) :: PUSTAR
+ REAL, DIMENSION(:), INTENT(IN) :: PTHETA
+ REAL, DIMENSION(:), INTENT(IN) :: PRV
+ REAL, DIMENSION(:), INTENT(IN) :: PSFTH
+ REAL, DIMENSION(:), INTENT(IN) :: PSFRV
+ REAL, DIMENSION(SIZE(PUSTAR)) :: LMO_1D
+!
+ REAL, DIMENSION(SIZE(PUSTAR)) :: ZTHETAV
+ REAL :: ZEPS
+!
+!
+ ZEPS=(XRV-XRD)/XRD
+!
+ ZTHETAV(:) = PTHETA(:) * ( 1. +ZEPS * PRV(:))
+!
+ LMO_1D(:) = XUNDEF
+ WHERE ( PSFTH(:)/ZTHETAV(:)+ZEPS*PSFRV(:)/=0. ) &
+ LMO_1D(:) = - MAX(PUSTAR(:),1.E-6)**3 &
+ / ( XKARMAN * ( XG / ZTHETAV(:) * PSFTH(:) &
+ + XG * ZEPS * PSFRV(:) ) )
+END FUNCTION LMO_1D
+!
+!-------------------------------------------------------------------------------
+!
+FUNCTION LMO_0D(PUSTAR,PTHETA,PRV,PSFTH,PSFRV)
+ USE MODD_CST
+ USE MODD_PARAMETERS
+ REAL, INTENT(IN) :: PUSTAR
+ REAL, INTENT(IN) :: PTHETA
+ REAL, INTENT(IN) :: PRV
+ REAL, INTENT(IN) :: PSFTH
+ REAL, INTENT(IN) :: PSFRV
+ REAL :: LMO_0D
+!
+ REAL :: ZTHETAV
+ REAL :: ZEPS
+!
+!
+ ZEPS=(XRV-XRD)/XRD
+!
+!
+ ZTHETAV = PTHETA * ( 1. +ZEPS * PRV)
+!
+ LMO_0D = XUNDEF
+ IF ( PSFTH/ZTHETAV+ZEPS*PSFRV/=0. ) &
+ LMO_0D = - MAX(PUSTAR,1.E-6)**3 &
+ / ( XKARMAN * ( XG / ZTHETAV * PSFTH &
+ + XG * ZEPS * PSFRV ) )
+END FUNCTION LMO_0D
+!
+!-------------------------------------------------------------------------------
+!-------------------------------------------------------------------------------
+!
+FUNCTION USTAR_2D(PU,PV,PZ,PZ0,PLMO)
+ USE MODD_CST
+ USE MODD_PARAMETERS
+ REAL, DIMENSION(:,:), INTENT(IN) :: PU
+ REAL, DIMENSION(:,:), INTENT(IN) :: PV
+ REAL, DIMENSION(:,:), INTENT(IN) :: PZ
+ REAL, DIMENSION(:,:), INTENT(IN) :: PZ0
+ REAL, DIMENSION(:,:), INTENT(IN) :: PLMO
+ REAL, DIMENSION(SIZE(PU,1),SIZE(PU,2)) :: USTAR_2D
+
+ REAL, DIMENSION(SIZE(PU,1),SIZE(PU,2)) :: ZZ_O_LMO
+ REAL, DIMENSION(SIZE(PU,1),SIZE(PU,2)) :: ZZ0_O_LMO
+!
+!* purely unstable case
+ USTAR_2D(:,:) = 0.
+ ZZ_O_LMO(:,:) = XUNDEF
+ ZZ0_O_LMO(:,:) = XUNDEF
+!
+!* general case
+ WHERE(ABS(PLMO) > 1.E-20 .AND. PLMO/=XUNDEF)
+ ZZ_O_LMO = PZ(:,:) / PLMO(:,:)
+ ZZ0_O_LMO = PZ0(:,:) / PLMO(:,:)
+ USTAR_2D(:,:) = SQRT( PU(:,:)**2+PV(:,:)**2 ) &
+ * XKARMAN / ( LOG(PZ(:,:)/PZ0(:,:)) &
+ - PAULSON_PSIM(ZZ_O_LMO(:,:)) &
+ + PAULSON_PSIM(ZZ0_O_LMO(:,:)) )
+ END WHERE
+!
+!* purely neutral case
+ WHERE(PLMO==XUNDEF)
+ ZZ_O_LMO = 0.
+ USTAR_2D(:,:) = SQRT( PU(:,:)**2+PV(:,:)**2 ) &
+ * XKARMAN / LOG(PZ(:,:)/PZ0(:,:))
+ END WHERE
+!
+END FUNCTION USTAR_2D
+!
+!-------------------------------------------------------------------------------
+!
+FUNCTION USTAR_1D(PU,PV,PZ,PZ0,PLMO)
+ USE MODD_CST
+ USE MODD_PARAMETERS
+ REAL, DIMENSION(:), INTENT(IN) :: PU
+ REAL, DIMENSION(:), INTENT(IN) :: PV
+ REAL, DIMENSION(:), INTENT(IN) :: PZ
+ REAL, DIMENSION(:), INTENT(IN) :: PZ0
+ REAL, DIMENSION(:), INTENT(IN) :: PLMO
+ REAL, DIMENSION(SIZE(PU)) :: USTAR_1D
+
+ REAL, DIMENSION(SIZE(PU)) :: ZZ_O_LMO
+ REAL, DIMENSION(SIZE(PU)) :: ZZ0_O_LMO
+!
+!* purely unstable case
+ USTAR_1D(:) = 0.
+ ZZ_O_LMO(:) = XUNDEF
+ ZZ0_O_LMO(:) = XUNDEF
+!
+!* general case
+ WHERE(ABS(PLMO) > 1.E-20 .AND. PLMO/=XUNDEF)
+ ZZ_O_LMO = PZ(:) / PLMO(:)
+ ZZ0_O_LMO = PZ0(:) / PLMO(:)
+ USTAR_1D(:) = SQRT( PU(:)**2+PV(:)**2 ) &
+ * XKARMAN / ( LOG(PZ(:)/PZ0(:)) &
+ - PAULSON_PSIM(ZZ_O_LMO(:)) &
+ + PAULSON_PSIM(ZZ0_O_LMO(:)) )
+ END WHERE
+!
+!* purely neutral case
+ WHERE(PLMO==XUNDEF)
+ ZZ_O_LMO = 0.
+ USTAR_1D(:) = SQRT( PU(:)**2+PV(:)**2 ) &
+ * XKARMAN / LOG(PZ(:)/PZ0(:))
+ END WHERE
+!
+END FUNCTION USTAR_1D
+!
+!-------------------------------------------------------------------------------
+!
+FUNCTION USTAR_0D(PU,PV,PZ,PZ0,PLMO)
+ USE MODD_CST
+ USE MODD_PARAMETERS
+ REAL, INTENT(IN) :: PU
+ REAL, INTENT(IN) :: PV
+ REAL, INTENT(IN) :: PZ
+ REAL, INTENT(IN) :: PZ0
+ REAL, INTENT(IN) :: PLMO
+ REAL :: USTAR_0D
+!
+!* purely unstable case
+ USTAR_0D = 0.
+!
+!* general case
+ IF ( ABS(PLMO) >= 1.E-20 .AND. PLMO/=XUNDEF) &
+ USTAR_0D = SQRT( PU**2+PV**2 ) &
+ * XKARMAN / ( LOG(PZ/PZ0) &
+ - PAULSON_PSIM(PZ/PLMO) &
+ + PAULSON_PSIM(PZ0/PLMO))
+!
+!* purely neutral case
+ IF (PLMO==XUNDEF) &
+ USTAR_0D = SQRT( PU**2+PV**2 ) &
+ * XKARMAN / LOG(PZ/PZ0)
+
+END FUNCTION USTAR_0D
+!
+!-------------------------------------------------------------------------------
+!
+END MODULE MODE_SBL
diff --git a/src/mesonh/turb/modn_turb.f90 b/src/mesonh/turb/modn_turb.f90
new file mode 100644
index 000000000..a7c794abd
--- /dev/null
+++ b/src/mesonh/turb/modn_turb.f90
@@ -0,0 +1,47 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 modn 2006/05/18 13:07:25
+!-----------------------------------------------------------------
+! ###################
+ MODULE MODN_TURB
+! ###################
+!
+!!**** *MODN_TURB* - declaration of namelist NAM_TURB
+!!
+!! PURPOSE
+!! -------
+! The purpose of this module is to specify the namelist NAM_TURB
+! which concern the parameters of the turbulence scheme for all models
+!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! V. Masson * Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original November 2005
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CTURB
+!
+IMPLICIT NONE
+!
+NAMELIST/NAM_TURB/XPHI_LIM, XSBL_O_BL, XFTOP_O_FSURF
+!
+END MODULE MODN_TURB
diff --git a/src/mesonh/turb/modn_turb_cloud.f90 b/src/mesonh/turb/modn_turb_cloud.f90
new file mode 100644
index 000000000..f4929a58c
--- /dev/null
+++ b/src/mesonh/turb/modn_turb_cloud.f90
@@ -0,0 +1,49 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 modn 2006/05/18 13:07:25
+!-----------------------------------------------------------------
+! ##################
+ MODULE MODN_TURB_CLOUD
+! ##################
+!
+!!**** *MODN_TURB_CLOUD* - declaration of namelist NAM_TURB_CLOUD
+!!
+!! PURPOSE
+!! -------
+! The purpose of this module is to specify the namelist NAM_TURB_CLOUD
+! which concern the parameters of the cloud mixing length for a given model.
+!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_TURB_CLOUD
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! M. Tomasini *Meteo France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original September, 2004
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_TURB_CLOUD
+!
+IMPLICIT NONE
+!
+NAMELIST/NAM_TURB_CLOUD/NMODEL_CLOUD, CTURBLEN_CLOUD, &
+ XCOEF_AMPL_SAT, XCEI_MIN, XCEI_MAX
+!
+END MODULE MODN_TURB_CLOUD
diff --git a/src/mesonh/turb/modn_turbn.f90 b/src/mesonh/turb/modn_turbn.f90
new file mode 100644
index 000000000..3e777d2da
--- /dev/null
+++ b/src/mesonh/turb/modn_turbn.f90
@@ -0,0 +1,167 @@
+!MNH_LIC Copyright 1995-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ###################
+ MODULE MODN_TURB_n
+! ###################
+!
+!!**** *MODN_TURB$n* - declaration of namelist NAM_TURBn
+!!
+!! PURPOSE
+!! -------
+! The purpose of this module is to specify the namelist NAM_TURBn
+! which concern the parameters of the turbulence scheme for one nested
+! model.
+!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_TURB$n : contains declaration of turbulence scheme
+!! variables entering by a namelist
+!!
+!! XIMPL,CTURBLEN,CTURBDIM,LTURB_FLX
+!! LTURB_DIAG,LSUBG_COND,LTGT_FLX
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (module MODD_TURBn)
+!!
+!! AUTHOR
+!! ------
+!! J. Cuxart and J. Stein * I.N.M. and Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original January 9, 1995
+!! J.Cuxart February 15, 1995 add the switches for diagnostic storages
+!! J. Stein June 14, 1995 add the subgrid condensation switch
+!! J. Stein October, 1999 add the tangential fluxes switch
+!! M. Tomasini Jul 05, 2001 add the subgrid autoconversion
+!! P. Bechtold Feb 11, 2002 add switch for Sigma_s computation
+!! P. Jabouille Apr 4, 2002 add switch for Sigma_s convection
+!! V. Masson Nov 13 2002 add switch for SBL lengths
+!! D. Ricard May, 2021 add switch for Leonard Terms
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_TURB_n, ONLY: &
+ XIMPL_n => XIMPL, &
+ XKEMIN_n => XKEMIN, &
+ XCEDIS_n => XCEDIS, &
+ XCADAP_n => XCADAP, &
+ CTURBLEN_n => CTURBLEN, &
+ CTURBDIM_n => CTURBDIM, &
+ LTURB_FLX_n => LTURB_FLX, &
+ LTURB_DIAG_n => LTURB_DIAG, &
+ LSUBG_COND_n => LSUBG_COND, &
+ LSIGMAS_n => LSIGMAS, &
+ LSIG_CONV_n => LSIG_CONV, &
+ LRMC01_n => LRMC01, &
+ CTOM_n => CTOM, &
+ CSUBG_AUCV_n => CSUBG_AUCV, &
+ VSIGQSAT_n => VSIGQSAT, &
+ CSUBG_AUCV_RI_n => CSUBG_AUCV_RI, &
+ CCONDENS_n => CCONDENS, &
+ CLAMBDA3_n => CLAMBDA3, &
+ CSUBG_MF_PDF_n => CSUBG_MF_PDF, &
+ LHGRAD_n => LHGRAD, &
+ XCOEFHGRADTHL_n => XCOEFHGRADTHL, &
+ XCOEFHGRADRM_n => XCOEFHGRADRM, &
+ XALTHGRAD_n => XALTHGRAD, &
+ XCLDTHOLD_n => XCLDTHOLD
+!
+IMPLICIT NONE
+!
+REAL,SAVE :: XIMPL
+REAL,SAVE :: XKEMIN
+REAL,SAVE :: XCEDIS
+REAL,SAVE :: XCADAP
+CHARACTER (LEN=4),SAVE :: CTURBLEN
+CHARACTER (LEN=4),SAVE :: CTURBDIM
+LOGICAL,SAVE :: LTURB_FLX
+LOGICAL,SAVE :: LTURB_DIAG
+LOGICAL,SAVE :: LSUBG_COND
+LOGICAL,SAVE :: LSIGMAS
+LOGICAL,SAVE :: LSIG_CONV
+LOGICAL,SAVE :: LRMC01
+CHARACTER (LEN=4),SAVE :: CTOM
+CHARACTER (LEN=4),SAVE :: CSUBG_AUCV
+CHARACTER (LEN=80),SAVE :: CSUBG_AUCV_RI
+CHARACTER (LEN=80),SAVE :: CCONDENS
+CHARACTER (LEN=4),SAVE :: CLAMBDA3
+CHARACTER (LEN=80),SAVE :: CSUBG_MF_PDF
+REAL,SAVE :: VSIGQSAT
+LOGICAL,SAVE :: LHGRAD
+REAL,SAVE :: XCOEFHGRADTHL
+REAL,SAVE :: XCOEFHGRADRM
+REAL,SAVE :: XALTHGRAD
+REAL,SAVE :: XCLDTHOLD
+!
+NAMELIST/NAM_TURBn/XIMPL,CTURBLEN,CTURBDIM,LTURB_FLX,LTURB_DIAG, &
+ LSUBG_COND,LSIGMAS,LSIG_CONV,LRMC01,CTOM,CSUBG_AUCV,&
+ XKEMIN,VSIGQSAT,XCEDIS,XCADAP,CSUBG_AUCV_RI,CCONDENS,&
+ CLAMBDA3,CSUBG_MF_PDF,LHGRAD,XCOEFHGRADTHL, XCOEFHGRADRM, &
+ XALTHGRAD, XCLDTHOLD
+
+!
+CONTAINS
+!
+SUBROUTINE INIT_NAM_TURBn
+ XIMPL = XIMPL_n
+ XKEMIN = XKEMIN_n
+ XCEDIS = XCEDIS_n
+ XCADAP = XCADAP_n
+ CTURBLEN = CTURBLEN_n
+ CTURBDIM = CTURBDIM_n
+ LTURB_FLX = LTURB_FLX_n
+ LTURB_DIAG = LTURB_DIAG_n
+ LSUBG_COND = LSUBG_COND_n
+ LSIGMAS = LSIGMAS_n
+ LSIG_CONV = LSIG_CONV_n
+ LRMC01 = LRMC01_n
+ CTOM = CTOM_n
+ CSUBG_AUCV = CSUBG_AUCV_n
+ VSIGQSAT = VSIGQSAT_n
+ CSUBG_AUCV_RI = CSUBG_AUCV_RI_n
+ CCONDENS = CCONDENS_n
+ CLAMBDA3 = CLAMBDA3_n
+ CSUBG_MF_PDF = CSUBG_MF_PDF_n
+ LHGRAD = LHGRAD_n
+ XCOEFHGRADTHL = XCOEFHGRADTHL_n
+ XCOEFHGRADRM = XCOEFHGRADRM_n
+ XALTHGRAD = XALTHGRAD_n
+ XCLDTHOLD = XCLDTHOLD_n
+END SUBROUTINE INIT_NAM_TURBn
+
+SUBROUTINE UPDATE_NAM_TURBn
+ XIMPL_n = XIMPL
+ XKEMIN_n = XKEMIN
+ XCEDIS_n = XCEDIS
+ XCADAP_n = XCADAP
+ CTURBLEN_n = CTURBLEN
+ CTURBDIM_n = CTURBDIM
+ LTURB_FLX_n = LTURB_FLX
+ LTURB_DIAG_n = LTURB_DIAG
+ LSUBG_COND_n = LSUBG_COND
+ LSIGMAS_n = LSIGMAS
+ LSIG_CONV_n = LSIG_CONV
+ LRMC01_n = LRMC01
+ CTOM_n = CTOM
+ CSUBG_AUCV_n = CSUBG_AUCV
+ VSIGQSAT_n = VSIGQSAT
+ CSUBG_AUCV_RI_n = CSUBG_AUCV_RI
+ CCONDENS_n = CCONDENS
+ CLAMBDA3_n = CLAMBDA3
+ CSUBG_MF_PDF_n = CSUBG_MF_PDF
+ LHGRAD_n = LHGRAD
+ XCOEFHGRADTHL_n = XCOEFHGRADTHL
+ XCOEFHGRADRM_n = XCOEFHGRADRM
+ XALTHGRAD_n = XALTHGRAD
+ XCLDTHOLD_n = XCLDTHOLD
+END SUBROUTINE UPDATE_NAM_TURBn
+
+END MODULE MODN_TURB_n
diff --git a/src/mesonh/turb/prandtl.f90 b/src/mesonh/turb/prandtl.f90
new file mode 100644
index 000000000..fbfe0a762
--- /dev/null
+++ b/src/mesonh/turb/prandtl.f90
@@ -0,0 +1,609 @@
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ###################
+ MODULE MODI_PRANDTL
+! ###################
+!
+INTERFACE
+!
+ SUBROUTINE PRANDTL(KKA,KKU,KKL,KRR,KRRI,OTURB_DIAG, &
+ HTURBDIM, &
+ TPFILE, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY, &
+ PTHVREF,PLOCPEXNM,PATHETA,PAMOIST, &
+ PLM,PLEPS,PTKEM,PTHLM,PRM,PSVM,PSRCM, &
+ PREDTH1,PREDR1, &
+ PRED2TH3, PRED2R3, PRED2THR3, &
+ PREDS1,PRED2THS3, PRED2RS3, &
+ PBLL_O_E, &
+ PETHETA, PEMOIST )
+!
+!
+USE MODD_IO, ONLY: TFILEDATA
+!
+INTEGER, INTENT(IN) :: KKA !near ground array index
+INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
+INTEGER, INTENT(IN) :: KRR ! number of moist var.
+INTEGER, INTENT(IN) :: KRRI ! number of ice var.
+!
+LOGICAL, INTENT(IN) :: OTURB_DIAG ! switch to write some
+ ! diagnostic fields in the syncronous FM-file
+CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! Kind of turbulence param.
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
+ ! metric coefficients
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! Virtual Potential Temp.
+ ! of the reference state
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exner at t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! coefficients between
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turbulent Mixing length
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! Dissipative length
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM,PTKEM! Conservative Potential
+ ! Temperature and TKE at t-1
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios at t-1
+ ! with PRM(:,:,:,1) = cons.
+ ! mixing ratio
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! Scalars at t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM
+ ! s'r'c/2Sigma_s2 at t-1 multiplied by Lambda_3
+!
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PREDTH1 ! Redelsperger number R_theta
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PREDR1 ! Redelsperger number R_q
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRED2TH3 ! Redelsperger number R*2_theta
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRED2R3 ! Redelsperger number R*2_q
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRED2THR3! Redelsperger number R*2_thq
+REAL, DIMENSION(:,:,:,:), INTENT(OUT):: PREDS1 ! Redelsperger number R_sv
+REAL, DIMENSION(:,:,:,:), INTENT(OUT):: PRED2THS3! Redelsperger number R*2_thsv
+REAL, DIMENSION(:,:,:,:), INTENT(OUT):: PRED2RS3 ! Redelsperger number R*2_qsv
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PBLL_O_E! beta*Lk*Leps/tke
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PETHETA ! coefficient E_theta
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PEMOIST ! coefficient E_moist
+!
+END SUBROUTINE PRANDTL
+!
+END INTERFACE
+!
+END MODULE MODI_PRANDTL
+!
+!
+!
+! ###########################################################
+ SUBROUTINE PRANDTL(KKA,KKU,KKL,KRR,KRRI,OTURB_DIAG, &
+ HTURBDIM, &
+ TPFILE, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY, &
+ PTHVREF,PLOCPEXNM,PATHETA,PAMOIST, &
+ PLM,PLEPS,PTKEM,PTHLM,PRM,PSVM,PSRCM, &
+ PREDTH1,PREDR1, &
+ PRED2TH3, PRED2R3, PRED2THR3, &
+ PREDS1,PRED2THS3, PRED2RS3, &
+ PBLL_O_E, &
+ PETHETA, PEMOIST )
+! ###########################################################
+!
+!
+!!**** *PRANDTL* - routine to compute the Prandtl turbulent numbers
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to compute the Redelsperger
+! numbers and then get the turbulent Prandtl and Schmidt numbers:
+! * for the heat fluxes - PHI3 = 1/ Prandtl
+! * for the moisture fluxes - PSI3 = 1/ Schmidt
+!
+!!** METHOD
+!! ------
+!! The following steps are performed:
+!!
+!! 1 - default values of 1 are taken for phi3 and psi3 and different masks
+!! are defined depending on the presence of turbulence, stratification and
+!! humidity. The 1D Redelsperger numbers are computed
+!! * ZREDTH1 : (g / THVREF ) (LT**2 / TKE ) ETHETA (D Theta / Dz)
+!! * ZREDR1 : (g / THVREF ) (LT**2 / TKE ) EMOIST (D TW / Dz)
+!! 2 - 3D Redelsperger numbers are computed only for turbulent
+!! grid points where ZREDTH1 or ZREDR1 are > 0.
+!! 3 - PHI3 is computed only for turbulent grid points where ZREDTH1 > 0
+!! (turbulent thermally stratified points)
+!! 4 - PSI3 is computed only for turbulent grid points where ZREDR1 > 0
+!! (turbulent moist points)
+!!
+!!
+!! EXTERNAL
+!! --------
+!! FUNCTIONs ETHETA and EMOIST :
+!! allows to compute the coefficients
+!! for the turbulent correlation between any variable
+!! and the virtual potential temperature, of its correlations
+!! with the conservative potential temperature and the humidity
+!! conservative variable:
+!! ------- ------- -------
+!! A' Thv' = ETHETA A' Thl' + EMOIST A' Rnp'
+!!
+!! GX_M_M, GY_M_M, GZ_M_M : Cartesian gradient operators
+!! MZM : Shuman function (mean operator in the z direction)
+!! Module MODI_ETHETA : interface module for ETHETA
+!! Module MODI_EMOIST : interface module for EMOIST
+!! Module MODI_SHUMAN : interface module for Shuman operators
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST : contains physical constants
+!! XG : gravity constant
+!!
+!! Module MODD_CTURB: contains the set of constants for
+!! the turbulence scheme
+!! XCTV,XCPR2 : constants for the turbulent prandtl numbers
+!! XTKEMIN : minimum value allowed for the TKE
+!!
+!! Module MODD_PARAMETERS
+!! JPVEXT_TURB : number of vertical marginal points
+!!
+!! REFERENCE
+!! ---------
+!! Book 2 of documentation (routine PRANDTL)
+!! Book 1 of documentation (Chapter: Turbulence)
+!!
+!! AUTHOR
+!! ------
+!! Joan Cuxart * INM and Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 18/10/94
+!! Modifications: Feb 14, 1995 (J.Cuxart and J.Stein)
+!! Doctorization and Optimization
+!! Modifications: March 21, 1995 (J.M. Carriere)
+!! Introduction of cloud water
+!! Modifications: March 21, 1995 (J. Cuxart and J.Stein)
+!! Phi3 and Psi3 at w point + cleaning
+!! Modifications: July 2, 1995 (J.Cuxart and Ph.Bougeault)
+!! change the value of Phi3 and Psi3 if negative
+!! Modifications: Sept 20, 1995 (J. Stein, J. Cuxart, J.L. Redelsperger)
+!! remove the Where + use REDTH1+REDR1 for the tests
+!! Modifications: October 10, 1995 (J. Cuxart and J.Stein)
+!! Psi3 for tPREDS1he scalar variables
+!! Modifications: February 27, 1996 (J.Stein) optimization
+!! Modifications: June 15, 1996 (P.Jabouille) return to the previous
+!! computation of Phi3 and Psi3
+!! Modifications: October 10, 1996 (J. Stein) change the temporal
+!! discretization
+!! Modifications: May 23, 1997 (J. Stein) bug in 3D Redels number at ground
+!! with orography
+!! Modifications: Feb 20, 1998 (J. Stein) bug in all the 3D cases due to
+!! the use of ZW1 instead of ZW2
+!! Feb 20, 2003 (JP Pinty) Add PFRAC_ICE
+!! July 2005 (Tomas, Masson) implicitation of PHI3 and PSI3
+!! October 2009 (G. Tanguy) add ILENCH=LEN(YCOMMENT) after
+!! change of YCOMMENT
+!! 2012-02 Y. Seity, add possibility to run with reversed
+!! vertical levels
+!! 2017-09 J.Escobar, use epsilon XMNH_TINY_12 for R*4
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! JL Redelsperger 03/2021 : adding Ocean case for temperature only
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_CONF
+USE MODD_CTURB
+USE MODD_DYN_n, ONLY: LOCEAN
+use modd_field, only: tfielddata, TYPEREAL
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_PARAMETERS
+!
+USE MODI_GRADIENT_M
+USE MODI_EMOIST
+USE MODI_ETHETA
+USE MODI_SHUMAN
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+INTEGER, INTENT(IN) :: KKA !near ground array index
+INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
+
+INTEGER, INTENT(IN) :: KRR ! number of moist var.
+INTEGER, INTENT(IN) :: KRRI ! number of ice var.
+!
+LOGICAL, INTENT(IN) :: OTURB_DIAG ! switch to write some
+ ! diagnostic fields in the syncronous FM-file
+CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! Kind of turbulence param.
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
+ ! metric coefficients
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! Virtual Potential Temp.
+ ! of the reference state
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exner at t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! coefficients between
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turbulent Mixing length
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! Dissipative length
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM,PTKEM! Conservative Potential
+ ! Temperature and TKE at t-1
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios at t-1
+ ! with PRM(:,:,:,1) = cons.
+ ! mixing ratio
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! Scalars at t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM
+ ! s'r'c/2Sigma_s2 at t-1 multiplied by Lambda_3
+!
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PREDTH1 ! Redelsperger number R_theta
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PREDR1 ! Redelsperger number R_q
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRED2TH3 ! Redelsperger number R*2_theta
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRED2R3 ! Redelsperger number R*2_q
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRED2THR3! Redelsperger number R*2_thq
+REAL, DIMENSION(:,:,:,:), INTENT(OUT):: PREDS1 ! Redelsperger number R_s
+REAL, DIMENSION(:,:,:,:), INTENT(OUT):: PRED2THS3! Redelsperger number R*2_thsv
+REAL, DIMENSION(:,:,:,:), INTENT(OUT):: PRED2RS3 ! Redelsperger number R*2_qsv
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PBLL_O_E! beta*Lk*Leps/tke
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PETHETA ! coefficient E_theta
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PEMOIST ! coefficient E_moist
+!
+!
+! 0.2 declaration of local variables
+!
+REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: &
+ ZW1, ZW2
+! working variables
+!
+INTEGER :: IKB ! vertical index value for the first inner mass point
+INTEGER :: IKE ! vertical index value for the last inner mass point
+INTEGER:: ISV ! number of scalar variables
+INTEGER:: JSV ! loop index for the scalar variables
+
+INTEGER :: JLOOP
+REAL :: ZMINVAL
+TYPE(TFIELDDATA) :: TZFIELD
+! ---------------------------------------------------------------------------
+!
+!* 1. DEFAULT VALUES, 1D REDELSPERGER NUMBERS
+! ----------------------------------------
+!
+IKB = KKA+JPVEXT_TURB*KKL
+IKE = KKU-JPVEXT_TURB*KKL
+ISV =SIZE(PSVM,4)
+!
+PETHETA(:,:,:) = MZM( ETHETA(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM) )
+PEMOIST(:,:,:) = MZM( EMOIST(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM) )
+PETHETA(:,:,KKA) = 2.*PETHETA(:,:,IKB) - PETHETA(:,:,IKB+KKL)
+PEMOIST(:,:,KKA) = 2.*PEMOIST(:,:,IKB) - PEMOIST(:,:,IKB+KKL)
+!
+!---------------------------------------------------------------------------
+!
+! 1.3 1D Redelsperger numbers
+!
+IF (LOCEAN) THEN
+ PBLL_O_E(:,:,:) = MZM(XG *XALPHAOC* PLM(:,:,:) * PLEPS(:,:,:) / PTKEM(:,:,:) )
+ PREDTH1(:,:,:)= XCTV*PBLL_O_E(:,:,:) * GZ_M_W(KKA,KKU,KKL,PTHLM,PDZZ)
+ PREDR1(:,:,:) = 0.
+ELSE
+ PBLL_O_E(:,:,:) = MZM(XG / PTHVREF(:,:,:) * PLM(:,:,:) * PLEPS(:,:,:) / PTKEM(:,:,:) )
+ IF (KRR /= 0) THEN ! moist case
+ PREDTH1(:,:,:)= XCTV*PBLL_O_E(:,:,:) * PETHETA(:,:,:) * &
+ & GZ_M_W(KKA,KKU,KKL,PTHLM,PDZZ)
+ PREDR1(:,:,:) = XCTV*PBLL_O_E(:,:,:) * PEMOIST(:,:,:) * &
+ & GZ_M_W(KKA,KKU,KKL,PRM(:,:,:,1),PDZZ)
+ ELSE ! dry case
+ PREDTH1(:,:,:)= XCTV*PBLL_O_E(:,:,:) * GZ_M_W(KKA,KKU,KKL,PTHLM,PDZZ)
+ PREDR1(:,:,:) = 0.
+ END IF
+!
+END IF
+!
+! 3. Limits on 1D Redelperger numbers
+! --------------------------------
+!
+ZMINVAL = (1.-1./XPHI_LIM)
+!
+ZW1 = 1.
+ZW2 = 1.
+!
+WHERE (PREDTH1+PREDR1<-ZMINVAL)
+ ZW1 = (-ZMINVAL) / (PREDTH1+PREDR1)
+END WHERE
+!
+WHERE (PREDTH1<-ZMINVAL)
+ ZW2 = (-ZMINVAL) / (PREDTH1)
+END WHERE
+ZW2 = MIN(ZW1,ZW2)
+!
+ZW1 = 1.
+WHERE (PREDR1<-ZMINVAL)
+ ZW1 = (-ZMINVAL) / (PREDR1)
+END WHERE
+ZW1 = MIN(ZW2,ZW1)
+!
+!
+! 3. Modification of Mixing length and dissipative length
+! ----------------------------------------------------
+!
+PBLL_O_E(:,:,:) = PBLL_O_E(:,:,:) * ZW1(:,:,:)
+PREDTH1 (:,:,:) = PREDTH1 (:,:,:) * ZW1(:,:,:)
+PREDR1 (:,:,:) = PREDR1 (:,:,:) * ZW1(:,:,:)
+!
+! 4. Threshold for very small (in absolute value) Redelperger numbers
+! ----------------------------------------------------------------
+!
+ZW2=SIGN(1.,PREDTH1(:,:,:))
+PREDTH1(:,:,:)= ZW2(:,:,:) * MAX(XMNH_TINY_12, ZW2(:,:,:)*PREDTH1(:,:,:))
+!
+IF (.NOT.LOCEAN) THEN
+ IF (KRR /= 0) THEN ! dry case
+ ZW2=SIGN(1.,PREDR1(:,:,:))
+ PREDR1(:,:,:)= ZW2(:,:,:) * MAX(XMNH_TINY_12, ZW2(:,:,:)*PREDR1(:,:,:))
+ END IF
+END IF
+!
+!
+!---------------------------------------------------------------------------
+!
+! For the scalar variables
+DO JSV=1,ISV
+ PREDS1(:,:,:,JSV)=XCTV*PBLL_O_E(:,:,:)*GZ_M_W(KKA,KKU,KKL,PSVM(:,:,:,JSV),PDZZ)
+END DO
+!
+DO JSV=1,ISV
+ ZW2=SIGN(1.,PREDS1(:,:,:,JSV))
+ PREDS1(:,:,:,JSV)= ZW2(:,:,:) * MAX(XMNH_TINY_12, ZW2(:,:,:)*PREDS1(:,:,:,JSV))
+END DO
+!
+!---------------------------------------------------------------------------
+!
+!* 2. 3D REDELSPERGER NUMBERS
+! ------------------------
+!
+IF(HTURBDIM=='1DIM') THEN ! 1D case
+!
+!
+ PRED2TH3(:,:,:) = PREDTH1(:,:,:)**2
+!
+ PRED2R3(:,:,:) = PREDR1(:,:,:) **2
+!
+ PRED2THR3(:,:,:) = PREDTH1(:,:,:) * PREDR1(:,:,:)
+!
+ELSE IF (L2D) THEN ! 3D case in a 2D model
+!
+ IF (KRR /= 0) THEN ! moist 3D case
+ PRED2TH3(:,:,:)= PREDTH1(:,:,:)**2+(XCTV*PBLL_O_E(:,:,:)*PETHETA(:,:,:) )**2 * &
+ MZM( GX_M_M(PTHLM,PDXX,PDZZ,PDZX)**2 )
+ PRED2TH3(:,:,IKB)=PRED2TH3(:,:,IKB+KKL)
+!
+ PRED2R3(:,:,:)= PREDR1(:,:,:)**2 + (XCTV*PBLL_O_E(:,:,:)*PEMOIST(:,:,:))**2 * &
+ MZM( GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX)**2 )
+ PRED2R3(:,:,IKB)=PRED2R3(:,:,IKB+KKL)
+!
+ PRED2THR3(:,:,:)= PREDR1(:,:,:) * PREDTH1(:,:,:) + XCTV**2*PBLL_O_E(:,:,:)**2 * &
+ PEMOIST(:,:,:) * PETHETA(:,:,:) * &
+ MZM( GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX)* &
+ GX_M_M(PTHLM,PDXX,PDZZ,PDZX))
+ PRED2THR3(:,:,IKB)=PRED2THR3(:,:,IKB+KKL)
+!
+ ELSE ! dry 3D case in a 2D model
+ PRED2TH3(:,:,:) = PREDTH1(:,:,:)**2 + XCTV**2*PBLL_O_E(:,:,:)**2 * &
+ MZM( GX_M_M(PTHLM,PDXX,PDZZ,PDZX)**2 )
+ PRED2TH3(:,:,IKB)=PRED2TH3(:,:,IKB+KKL)
+!
+ PRED2R3(:,:,:) = 0.
+!
+ PRED2THR3(:,:,:) = 0.
+!
+ END IF
+!
+ELSE ! 3D case in a 3D model
+!
+ IF (KRR /= 0) THEN ! moist 3D case
+ PRED2TH3(:,:,:)= PREDTH1(:,:,:)**2 + ( XCTV*PBLL_O_E(:,:,:)*PETHETA(:,:,:) )**2 * &
+ MZM( GX_M_M(PTHLM,PDXX,PDZZ,PDZX)**2 &
+ + GY_M_M(PTHLM,PDYY,PDZZ,PDZY)**2 )
+ PRED2TH3(:,:,IKB)=PRED2TH3(:,:,IKB+KKL)
+!
+ PRED2R3(:,:,:)= PREDR1(:,:,:)**2 + (XCTV*PBLL_O_E(:,:,:)*PEMOIST(:,:,:))**2 * &
+ MZM( GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX)**2 + &
+ GY_M_M(PRM(:,:,:,1),PDYY,PDZZ,PDZY)**2 )
+ PRED2R3(:,:,IKB)=PRED2R3(:,:,IKB+KKL)
+!
+ PRED2THR3(:,:,:)= PREDR1(:,:,:) * PREDTH1(:,:,:) + XCTV**2*PBLL_O_E(:,:,:)**2 * &
+ PEMOIST(:,:,:) * PETHETA(:,:,:) * &
+ MZM( GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX)* &
+ GX_M_M(PTHLM,PDXX,PDZZ,PDZX)+ &
+ GY_M_M(PRM(:,:,:,1),PDYY,PDZZ,PDZY)* &
+ GY_M_M(PTHLM,PDYY,PDZZ,PDZY) )
+ PRED2THR3(:,:,IKB)=PRED2THR3(:,:,IKB+KKL)
+!
+ ELSE ! dry 3D case in a 3D model
+ PRED2TH3(:,:,:) = PREDTH1(:,:,:)**2 + XCTV**2*PBLL_O_E(:,:,:)**2 * &
+ MZM( GX_M_M(PTHLM,PDXX,PDZZ,PDZX)**2 &
+ + GY_M_M(PTHLM,PDYY,PDZZ,PDZY)**2 )
+ PRED2TH3(:,:,IKB)=PRED2TH3(:,:,IKB+KKL)
+!
+ PRED2R3(:,:,:) = 0.
+!
+ PRED2THR3(:,:,:) = 0.
+!
+ END IF
+!
+END IF ! end of the if structure on the turbulence dimensionnality
+!
+!
+!---------------------------------------------------------------------------
+!
+! 5. Prandtl numbers for scalars
+! ---------------------------
+IF(HTURBDIM=='1DIM') THEN
+! 1D case
+ DO JSV=1,ISV
+ PRED2THS3(:,:,:,JSV) = PREDS1(:,:,:,JSV) * PREDTH1(:,:,:)
+ IF (KRR /= 0) THEN
+ PRED2RS3(:,:,:,JSV) = PREDR1(:,:,:) *PREDS1(:,:,:,JSV)
+ ELSE
+ PRED2RS3(:,:,:,JSV) = 0.
+ END IF
+ ENDDO
+!
+ELSE IF (L2D) THEN ! 3D case in a 2D model
+!
+ IF (LOCEAN) THEN
+ IF (KRR /= 0) THEN
+ ZW1 = MZM((XG *XALPHAOC * PLM * PLEPS / PTKEM)**2 ) *PETHETA
+ ELSE
+ ZW1 = MZM((XG *XALPHAOC * PLM * PLEPS / PTKEM)**2)
+ END IF
+ ELSE
+ DO JSV=1,ISV
+ IF (KRR /= 0) THEN
+ ZW1 = MZM( (XG / PTHVREF * PLM * PLEPS / PTKEM)**2 ) *PETHETA
+ ELSE
+ ZW1 = MZM( (XG / PTHVREF * PLM * PLEPS / PTKEM)**2)
+ END IF
+ PRED2THS3(:,:,:,JSV) = PREDTH1(:,:,:) * PREDS1(:,:,:,JSV) + &
+ ZW1* &
+ MZM(GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)* &
+ GX_M_M(PTHLM,PDXX,PDZZ,PDZX) &
+ )
+!
+ IF (KRR /= 0) THEN
+ PRED2RS3(:,:,:,JSV) = PREDR1(:,:,:) * PREDS1(:,:,:,JSV) + &
+ ZW1 * PEMOIST * &
+ MZM(GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)* &
+ GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX) &
+ )
+ ELSE
+ PRED2RS3(:,:,:,JSV) = 0.
+ END IF
+ ENDDO
+ END IF
+!
+ELSE ! 3D case in a 3D model
+!
+ IF (LOCEAN) THEN
+ IF (KRR /= 0) THEN
+ ZW1 = MZM((XG *XALPHAOC * PLM * PLEPS / PTKEM)**2 ) *PETHETA
+ ELSE
+ ZW1 = MZM((XG *XALPHAOC * PLM * PLEPS / PTKEM)**2)
+ END IF
+ ELSE
+ DO JSV=1,ISV
+ IF (KRR /= 0) THEN
+ ZW1 = MZM( (XG / PTHVREF * PLM * PLEPS / PTKEM)**2 ) *PETHETA
+ ELSE
+ ZW1 = MZM( (XG / PTHVREF * PLM * PLEPS / PTKEM)**2)
+ END IF
+ PRED2THS3(:,:,:,JSV) = PREDTH1(:,:,:) * PREDS1(:,:,:,JSV) + &
+ ZW1* &
+ MZM(GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)* &
+ GX_M_M(PTHLM,PDXX,PDZZ,PDZX) &
+ +GY_M_M(PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY)* &
+ GY_M_M(PTHLM,PDYY,PDZZ,PDZY) &
+ )
+!
+ IF (KRR /= 0) THEN
+ PRED2RS3(:,:,:,JSV) = PREDR1(:,:,:) * PREDS1(:,:,:,JSV) + &
+ ZW1 * PEMOIST * &
+ MZM(GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)* &
+ GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX) &
+ +GY_M_M(PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY)* &
+ GY_M_M(PRM(:,:,:,1),PDYY,PDZZ,PDZY) &
+ )
+ ELSE
+ PRED2RS3(:,:,:,JSV) = 0.
+ END IF
+ ENDDO
+ END IF
+!
+END IF ! end of HTURBDIM if-block
+!
+!
+!---------------------------------------------------------------------------
+!
+!* 6. SAVES THE REDELSPERGER NUMBERS
+! ------------------------------
+!
+IF ( OTURB_DIAG .AND. tpfile%lopened ) THEN
+ !
+ ! stores the RED_TH1
+ TZFIELD%CMNHNAME = 'RED_TH1'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'RED_TH1'
+ TZFIELD%CUNITS = '1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_RED_TH1'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,PREDTH1)
+ !
+ ! stores the RED_R1
+ TZFIELD%CMNHNAME = 'RED_R1'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'RED_R1'
+ TZFIELD%CUNITS = '1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_RED_R1'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,PREDR1)
+ !
+ ! stores the RED2_TH3
+ TZFIELD%CMNHNAME = 'RED2_TH3'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'RED2_TH3'
+ TZFIELD%CUNITS = '1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_RED2_TH3'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,PRED2TH3)
+ !
+ ! stores the RED2_R3
+ TZFIELD%CMNHNAME = 'RED2_R3'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'RED2_R3'
+ TZFIELD%CUNITS = '1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_RED2_R3'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,PRED2R3)
+ !
+ ! stores the RED2_THR3
+ TZFIELD%CMNHNAME = 'RED2_THR3'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'RED2_THR3'
+ TZFIELD%CUNITS = '1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_RED2_THR3'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,PRED2THR3)
+ !
+END IF
+!
+!---------------------------------------------------------------------------
+!
+END SUBROUTINE PRANDTL
diff --git a/src/mesonh/turb/rmc01.f90 b/src/mesonh/turb/rmc01.f90
new file mode 100644
index 000000000..cf77c5033
--- /dev/null
+++ b/src/mesonh/turb/rmc01.f90
@@ -0,0 +1,260 @@
+!MNH_LIC Copyright 2002-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ################
+ MODULE MODI_RMC01
+! ################
+INTERFACE
+ SUBROUTINE RMC01(HTURBLEN,KKA,KKU,KKL,PZZ,PDXX,PDYY,PDZZ,PDIRCOSZW, &
+ PSBL_DEPTH, PLMO, PLK, PLEPS )
+!
+CHARACTER(LEN=4), INTENT(IN) :: HTURBLEN ! type of mixing length
+INTEGER, INTENT(IN) :: KKA !near ground array index
+INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitude of flux points
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! width of grid mesh (X dir)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! width of grid mesh (Y dir)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! width of vert. layers
+REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW ! Director Cosinus
+REAL, DIMENSION(:,:), INTENT(IN) :: PSBL_DEPTH! SBL depth
+REAL, DIMENSION(:,:), INTENT(IN) :: PLMO ! Monin Obuhkov length
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLK ! Mixing length
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLEPS ! Dissipative length
+
+END SUBROUTINE RMC01
+END INTERFACE
+END MODULE MODI_RMC01
+!
+! ##############################################################
+ SUBROUTINE RMC01(HTURBLEN,KKA, KKU, KKL, PZZ, PDXX, PDYY, PDZZ, PDIRCOSZW, &
+ PSBL_DEPTH, PLMO, PLK, PLEPS )
+! ##############################################################
+!
+!!**** *RMC01* -
+!!
+!! PURPOSE
+!! -------
+!! This routine modifies the mixing and dissipative length near the SBL.
+!! (Redelsperger, Mahe and Carlotti, 2001)
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Book 2
+!!
+!! AUTHOR
+!! ------
+!!
+!! V. Masson - Meteo-France -
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 14/02/02
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS
+USE MODD_CST
+USE MODD_CTURB
+!
+USE MODE_SBL
+!
+USE MODI_SHUMAN
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of arguments
+! ------------------------
+!
+CHARACTER(LEN=4), INTENT(IN) :: HTURBLEN ! type of mixing length
+INTEGER, INTENT(IN) :: KKA !near ground array index
+INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitude of flux points
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! width of grid mesh (X dir)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! width of grid mesh (Y dir)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! width of vert. layers
+REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW ! Director Cosinus
+REAL, DIMENSION(:,:), INTENT(IN) :: PSBL_DEPTH! SBL depth
+REAL, DIMENSION(:,:), INTENT(IN) :: PLMO ! Monin Obuhkov length
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLK ! Mixing length
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLEPS ! Dissipative length
+!
+!* 0.2 Declaration of local variables
+! ------------------------------
+!
+INTEGER :: IKB,IKE ! first,last physical level
+INTEGER :: IKT ! array size in k direction
+INTEGER :: IKTB,IKTE ! start, end of k loops in physical domain
+INTEGER :: IIU ! horizontal x boundary
+INTEGER :: IJU ! horizontal y boundary
+INTEGER :: JK ! loop counter
+!
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) :: ZZZ ! height of mass
+ ! points above ground
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) :: ZZ_O_LMO ! height / LMO
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) :: ZGAM ! factor controling
+ ! transition betw.
+ ! SBL and free BL
+
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) :: ZPHIM! MO function
+ ! for stress
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) :: ZPHIE! MO function
+ ! for TKE
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) :: ZDH ! hor. grid mesh
+ ! size
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) :: ZL ! SBL length
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) :: ZZC ! alt. where
+ ! turb. is isotr.
+!-------------------------------------------------------------------------------
+!
+!* 1. Initializations
+! ---------------
+!
+! horizontal boundaries
+IIU=SIZE(PZZ,1)
+IJU=SIZE(PZZ,2)
+!
+! vertical boundaries
+IKB=KKA+JPVEXT_TURB*KKL
+IKE=KKU-JPVEXT_TURB*KKL
+
+IKTB=1+JPVEXT_TURB
+IKT=SIZE(PZZ,3)
+IKTE=IKT-JPVEXT_TURB
+!
+! altitude of mass points
+ZZZ=MZF(PZZ)
+! replace by height of mass points
+DO JK=1,IKT
+ ZZZ(:,:,JK) = ZZZ(:,:,JK) - PZZ(:,:,IKB)
+END DO
+! fill upper level with physical value
+ZZZ(:,:,KKU) = 2.*ZZZ(:,:,KKU-KKL) - ZZZ(:,:,KKU-2*KKL)
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. MO quantities
+! -------------
+!
+! z/LMO
+DO JK=1,IKT
+ WHERE (PLMO(:,:)==XUNDEF)
+ ZZ_O_LMO(:,:,JK)=0.
+ ELSEWHERE
+ ZZ_O_LMO(:,:,JK)=ZZZ(:,:,JK)*PDIRCOSZW(:,:)/PLMO(:,:)
+ END WHERE
+END DO
+ZZ_O_LMO(:,:,:) = MAX(ZZ_O_LMO(:,:,:),-10.)
+ZZ_O_LMO(:,:,:) = MIN(ZZ_O_LMO(:,:,:), 10.)
+!
+!
+! MO function for stress
+ZPHIM(:,:,:) = BUSINGER_PHIM(ZZ_O_LMO)
+!
+! MO function for TKE
+ZPHIE(:,:,:) = BUSINGER_PHIE(ZZ_O_LMO)
+!
+!-------------------------------------------------------------------------------
+SELECT CASE (HTURBLEN)
+!-------------------------------------------------------------------------------
+!
+!* 3. altitude where turbulence is isotropic inside a layer of given width (3D case)
+! --------------------------------------------------------------------
+!
+!
+!* LES subgrid mixing (unresolved eddies all below mesh size)
+! For stable cases, the vertical size of eddies is supposed to be given by the
+! same law as in the neutral case (i.e. with Phim = 1).
+!
+ CASE ('DELT','DEAR')
+ ZDH = SQRT(MXF(PDXX)*MYF(PDYY))
+ ZDH(IIU,:,:) = ZDH(IIU-1,:,:)
+ ZDH(:,IJU,:) = ZDH(:,IJU-1,:)
+ DO JK=1,IKT
+ ZZC(:,:,JK) = 2.*MIN(ZPHIM(:,:,JK),1.)/XKARMAN &
+ * MAX( PDZZ(:,:,JK)*PDIRCOSZW(:,:) , ZDH(:,:,JK)/PDIRCOSZW(:,:)/3. )
+ END DO
+!
+!* 4. factor controling the transition between SBL and free isotropic turb. (3D case)
+! --------------------------------------------------------------------
+!
+ ZGAM(:,:,KKA) = 0.
+ DO JK=IKTB,IKTE
+ ZGAM(:,:,JK) = 1. - EXP( -3.*(ZZZ(:,:,JK)-ZZZ(:,:,IKB))/(ZZC(:,:,JK)) )
+ WHERE (ZGAM(:,:,JK-KKL)>ZGAM(:,:,JK) .OR. ZGAM(:,:,JK-KKL)>0.99 ) ZGAM(:,:,JK) = 1.
+ END DO
+ ZGAM(:,:,KKU) = 1. - EXP( -3.*(ZZZ(:,:,KKU)-ZZZ(:,:,IKB))/(ZZC(:,:,KKU)) )
+ WHERE (ZGAM(:,:,KKU-KKL)>ZGAM(:,:,KKU) .OR. ZGAM(:,:,KKU-KKL)>0.99 ) ZGAM(:,:,KKU) = 1.
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 5. factor controling the transition between SBL and free isotropic turb.(1D case)
+! --------------------------------------------------------------------
+!
+ CASE DEFAULT
+!* SBL depth is used
+ ZGAM(:,:,:) = 1.
+ ZGAM(:,:,KKA) = 0.
+ DO JK=IKTB,IKTE
+ WHERE(PSBL_DEPTH>0.) &
+ ZGAM(:,:,JK) = TANH( (ZZZ(:,:,JK)-ZZZ(:,:,IKB))/PSBL_DEPTH(:,:) )
+ WHERE (ZGAM(:,:,JK-KKL)>0.99 ) ZGAM(:,:,JK) = 1.
+ END DO
+ WHERE(PSBL_DEPTH>0.) &
+ ZGAM(:,:,KKU) = TANH( (ZZZ(:,:,KKU)-ZZZ(:,:,IKB))/PSBL_DEPTH(:,:) )
+ WHERE (ZGAM(:,:,KKU-KKL)>0.99 ) ZGAM(:,:,JK) = 1.
+!
+!-------------------------------------------------------------------------------
+END SELECT
+!-------------------------------------------------------------------------------
+!
+!* 6. Modification of the mixing length
+! ---------------------------------
+!
+DO JK=1,IKT
+ ZL(:,:,JK) = XKARMAN/SQRT(XALPSBL)/XCMFS &
+ * ZZZ(:,:,JK)*PDIRCOSZW(:,:)/(ZPHIM(:,:,JK)**2*SQRT(ZPHIE(:,:,JK)))
+END DO
+!
+PLK(:,:,:)=(1.-ZGAM)*ZL+ZGAM*PLK
+!
+PLK(:,:,KKA) = PLK(:,:,IKB)
+PLK(:,:,KKU) = PLK(:,:,IKE)
+!-------------------------------------------------------------------------------
+!
+!* 7. Modification of the dissipative length
+! --------------------------------------
+!
+ZL = ZL * (XALPSBL**(3./2.)*XKARMAN*XCED) &
+ / (XKARMAN/SQRT(XALPSBL)/XCMFS)
+!
+WHERE (ZZ_O_LMO<0.)
+ ZL = ZL/(1.-1.9*ZZ_O_LMO)
+ELSEWHERE
+ ZL = ZL/(1.-0.3*SQRT(ZZ_O_LMO))
+ENDWHERE
+!
+PLEPS(:,:,:)=(1.-ZGAM)*ZL+ZGAM*PLEPS
+!
+PLEPS(:,:,KKA) = PLEPS(:,:,IKB)
+PLEPS(:,:,KKU ) = PLEPS(:,:,IKE)
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE RMC01
diff --git a/src/mesonh/turb/sbl_depth.f90 b/src/mesonh/turb/sbl_depth.f90
new file mode 100644
index 000000000..e83d8f784
--- /dev/null
+++ b/src/mesonh/turb/sbl_depth.f90
@@ -0,0 +1,145 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+! ################
+ MODULE MODI_SBL_DEPTH
+! ################
+!
+INTERFACE
+!
+ SUBROUTINE SBL_DEPTH(KKB,KKE,PZZ,PFLXU,PFLXV,PWTHV,PLMO,PSBL_DEPTH)
+!
+INTEGER, INTENT(IN) :: KKB ! first physical level
+INTEGER, INTENT(IN) :: KKE ! upper physical level
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitude of flux levels
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFLXU ! u'w'
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFLXV ! v'w'
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PWTHV ! buoyancy flux
+REAL, DIMENSION(:,:), INTENT(IN) :: PLMO ! Monin-Obukhov length
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PSBL_DEPTH! boundary layer height
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE SBL_DEPTH
+!
+END INTERFACE
+!
+END MODULE MODI_SBL_DEPTH
+!
+! #################################################################
+ SUBROUTINE SBL_DEPTH(KKB,KKE,PZZ,PFLXU,PFLXV,PWTHV,PLMO,PSBL_DEPTH)
+! #################################################################
+!
+!
+!!**** *SBL_DEPTH* - computes SBL depth
+!!
+!! PURPOSE
+!! -------
+!
+!!** METHOD
+!! ------
+!!
+!! SBL is defined as the layer where momentum flux is equal to XSBL_FRAC of its surface value
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! V. Masson * Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original nov. 2005
+!! 26/02/2020 T.Nagel Correction of SBL depth computation in neutral stratification
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS, ONLY : XUNDEF
+USE MODD_CTURB, ONLY : XFTOP_O_FSURF, XSBL_O_BL
+!
+USE MODI_BL_DEPTH_DIAG
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+INTEGER, INTENT(IN) :: KKB ! first physical level
+INTEGER, INTENT(IN) :: KKE ! upper physical level
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitude of flux levels
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFLXU ! u'w'
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFLXV ! v'w'
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PWTHV ! buoyancy flux
+REAL, DIMENSION(:,:), INTENT(IN) :: PLMO ! Monin-Obukhov length
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PSBL_DEPTH! boundary layer height
+!
+!-------------------------------------------------------------------------------
+!
+! 0.2 declaration of local variables
+!
+!
+INTEGER :: JLOOP ! loop counter
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2)) :: ZQ0 ! surface buoyancy flux
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2)) :: ZWU ! surface friction u'w'
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2)) :: ZWV ! surface friction v'w'
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2)) :: ZUSTAR2 ! surface friction
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2)) :: ZSBL_DYN ! SBL wih dynamical criteria
+REAL, DIMENSION(SIZE(PFLXU,1),SIZE(PFLXU,2),SIZE(PFLXU,3)) :: ZWIND
+ ! intermediate wind for SBL calculation
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2)) :: ZSBL_THER! SBL wih thermal criteria
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2)) :: ZA ! ponderation coefficient
+!----------------------------------------------------------------------------
+!
+!* initialisations
+!
+!
+ZWU (:,:) = PFLXU(:,:,KKB)
+ZWV (:,:) = PFLXV(:,:,KKB)
+ZQ0 (:,:) = PWTHV(:,:,KKB)
+!
+ZUSTAR2(:,:) = SQRT(ZWU**2+ZWV**2)
+!
+!----------------------------------------------------------------------------
+!
+!* BL and SBL diagnosed with friction criteria
+!
+ZWIND=SQRT(PFLXU**2+PFLXV**2)
+ZSBL_DYN = XSBL_O_BL * BL_DEPTH_DIAG(KKB,KKE,ZUSTAR2,PZZ(:,:,KKB),ZWIND,PZZ,XFTOP_O_FSURF)
+!
+!----------------------------------------------------------------------------
+!
+!* BL and SBL diagnosed with buoyancy flux criteria
+!
+ZSBL_THER= XSBL_O_BL * BL_DEPTH_DIAG(KKB,KKE,ZQ0,PZZ(:,:,KKB),PWTHV,PZZ,XFTOP_O_FSURF)
+!
+!----------------------------------------------------------------------------
+!
+!* SBL depth
+!
+PSBL_DEPTH = 0.
+WHERE (ZSBL_THER> 0. .AND. ZSBL_DYN> 0.) PSBL_DEPTH = MIN(ZSBL_THER(:,:),ZSBL_DYN(:,:))
+WHERE (ZSBL_THER> 0. .AND. ZSBL_DYN==0.) PSBL_DEPTH = ZSBL_THER(:,:)
+WHERE (ZSBL_THER==0. .AND. ZSBL_DYN> 0.) PSBL_DEPTH = ZSBL_DYN(:,:)
+!
+DO JLOOP=1,5
+ WHERE (PLMO(:,:)/=XUNDEF .AND. ABS(PLMO(:,:))>=0.01 )
+ ZA = TANH(2.*PSBL_DEPTH/PLMO)**2
+ PSBL_DEPTH = 0.2 * PSBL_DEPTH + 0.8 * ((1.-ZA) * ZSBL_DYN + ZA * ZSBL_THER )
+ END WHERE
+END DO
+WHERE (ABS(PLMO(:,:))<=0.01 ) PSBL_DEPTH = ZSBL_THER
+WHERE (PLMO(:,:)==XUNDEF) PSBL_DEPTH = ZSBL_DYN
+!
+!----------------------------------------------------------------------------
+END SUBROUTINE SBL_DEPTH
diff --git a/src/mesonh/turb/shallow_mf.f90 b/src/mesonh/turb/shallow_mf.f90
new file mode 100644
index 000000000..2ae315ad5
--- /dev/null
+++ b/src/mesonh/turb/shallow_mf.f90
@@ -0,0 +1,437 @@
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ######spl
+ MODULE MODI_SHALLOW_MF
+! ######################
+!
+INTERFACE
+! #################################################################
+ SUBROUTINE SHALLOW_MF(KKA,KKU,KKL,KRR,KRRL,KRRI, &
+ HMF_UPDRAFT, HMF_CLOUD, HFRAC_ICE, OMIXUV, &
+ ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
+ PIMPL_MF, PTSTEP, &
+ PDZZ, PZZ, &
+ PRHODJ, PRHODREF, &
+ PPABSM, PEXNM, &
+ PSFTH,PSFRV, &
+ PTHM,PRM,PUM,PVM,PWM,PTKEM,PSVM, &
+ PDUDT_MF,PDVDT_MF, &
+ PDTHLDT_MF,PDRTDT_MF,PDSVDT_MF, &
+ PSIGMF,PRC_MF,PRI_MF,PCF_MF,PFLXZTHVMF, &
+ PFLXZTHMF,PFLXZRMF,PFLXZUMF,PFLXZVMF, &
+ PTHL_UP,PRT_UP,PRV_UP,PRC_UP,PRI_UP, &
+ PU_UP, PV_UP, PTHV_UP, PW_UP, &
+ PTHL_DO,PTHV_DO,PRT_DO,PU_DO, PV_DO, &
+ PFRAC_UP,PEMF,PDETR,PENTR, &
+ KKLCL,KKETL,KKCTL )
+! #################################################################
+!!
+!
+!* 1.1 Declaration of Arguments
+!
+!
+INTEGER, INTENT(IN) :: KKA ! near ground array index
+INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+INTEGER, INTENT(IN) :: KRR ! number of moist var.
+INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
+INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
+CHARACTER (LEN=4), INTENT(IN) :: HMF_UPDRAFT ! Type of Mass Flux Scheme
+ ! 'NONE' if no parameterization
+CHARACTER (LEN=4), INTENT(IN) :: HMF_CLOUD ! Type of statistical cloud
+ ! scheme
+CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme
+LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum
+LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer
+INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer
+INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer
+REAL, INTENT(IN) :: PIMPL_MF ! degre of implicitness
+REAL, INTENT(IN) :: PTSTEP ! Dynamical timestep
+
+REAL, DIMENSION(:,:), INTENT(IN) :: PZZ ! Height of flux point
+REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! Metric coefficients
+REAL, DIMENSION(:,:), INTENT(IN) :: PRHODJ ! dry density * Grid size
+REAL, DIMENSION(:,:), INTENT(IN) :: PRHODREF ! dry density of the
+ ! reference state
+REAL, DIMENSION(:,:), INTENT(IN) :: PPABSM ! Pressure at time t-1
+REAL, DIMENSION(:,:), INTENT(IN) :: PEXNM ! Exner function at t-dt
+
+REAL, DIMENSION(:), INTENT(IN) :: PSFTH,PSFRV ! normal surface fluxes of theta and Rv
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHM ! Theta at t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRM ! water var. at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PUM,PVM,PWM ! wind components at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PTKEM ! tke at t-dt
+
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVM ! scalar variable a t-dt
+
+REAL, DIMENSION(:,:), INTENT(OUT):: PDUDT_MF ! tendency of U by massflux scheme
+REAL, DIMENSION(:,:), INTENT(OUT):: PDVDT_MF ! tendency of V by massflux scheme
+REAL, DIMENSION(:,:), INTENT(OUT):: PDTHLDT_MF ! tendency of thl by massflux scheme
+REAL, DIMENSION(:,:), INTENT(OUT):: PDRTDT_MF ! tendency of rt by massflux scheme
+REAL, DIMENSION(:,:,:), INTENT(OUT):: PDSVDT_MF ! tendency of Sv by massflux scheme
+
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSIGMF,PRC_MF,PRI_MF,PCF_MF ! cloud info for the cloud scheme
+REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZTHVMF ! Thermal production for TKE scheme
+REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZTHMF
+REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZRMF
+REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZUMF
+REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZVMF
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PTHL_UP ! Thl updraft characteristics
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PRT_UP ! Rt updraft characteristics
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PRV_UP ! Vapor updraft characteristics
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PU_UP ! U wind updraft characteristics
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PV_UP ! V wind updraft characteristics
+
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PTHL_DO ! Thl environment characteristics
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PTHV_DO ! Thv environment characteristics
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PRT_DO ! Rt environment characteristics
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PU_DO ! U wind environment characteristics
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PV_DO ! V wind environment characteristics
+
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PRC_UP ! cloud content updraft characteristics
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PRI_UP ! ice content updraft characteristics
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PTHV_UP ! Thv updraft characteristics
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PW_UP ! vertical speed updraft characteristics
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PFRAC_UP ! updraft fraction
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PEMF ! updraft mass flux
+REAL, DIMENSION(:,:), INTENT(OUT) :: PDETR ! updraft detrainment
+REAL, DIMENSION(:,:), INTENT(OUT) :: PENTR ! updraft entrainment
+INTEGER,DIMENSION(:), INTENT(OUT) :: KKLCL,KKETL,KKCTL ! level of LCL,ETL and CTL
+
+
+END SUBROUTINE SHALLOW_MF
+
+END INTERFACE
+!
+END MODULE MODI_SHALLOW_MF
+! ################################################################
+ SUBROUTINE SHALLOW_MF(KKA,KKU,KKL,KRR,KRRL,KRRI, &
+ HMF_UPDRAFT, HMF_CLOUD, HFRAC_ICE, OMIXUV, &
+ ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
+ PIMPL_MF, PTSTEP, &
+ PDZZ, PZZ, &
+ PRHODJ, PRHODREF, &
+ PPABSM, PEXNM, &
+ PSFTH,PSFRV, &
+ PTHM,PRM,PUM,PVM,PWM,PTKEM,PSVM, &
+ PDUDT_MF,PDVDT_MF, &
+ PDTHLDT_MF,PDRTDT_MF,PDSVDT_MF, &
+ PSIGMF,PRC_MF,PRI_MF,PCF_MF,PFLXZTHVMF, &
+ PFLXZTHMF,PFLXZRMF,PFLXZUMF,PFLXZVMF, &
+ PTHL_UP,PRT_UP,PRV_UP,PRC_UP,PRI_UP, &
+ PU_UP, PV_UP, PTHV_UP, PW_UP, &
+ PTHL_DO,PTHV_DO,PRT_DO,PU_DO, PV_DO, &
+ PFRAC_UP,PEMF,PDETR,PENTR, &
+ KKLCL,KKETL,KKCTL )
+
+! #################################################################
+!!
+!!**** *SHALLOW_MF* -
+!!
+!!
+!! PURPOSE
+!! -------
+!!**** The purpose of this routine is
+!!
+!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! J.Pergaud
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original
+!! V.Masson 09/2010 : optimization
+!! S. Riette 18 May 2010 interface changed due to ice correction
+!! S.Riette DUAL case
+!! S. Riette Jan 2012: support for both order of vertical levels
+!! R.Honnert 07/2012 : elemnts of Rio according to Bouteloup
+!! R.Honnert 07/2012 : MF gray zone
+!! R.Honnert 10/2016 : SURF=gray zone initilisation + EDKF
+!! R.Honnert 10/2016 : Update with Arome
+!! Philippe Wautelet 28/05/2018: corrected truncated integer division (2/3 -> 2./3.)
+!! Q.Rodier 01/2019 : support RM17 mixing length
+!! R.Honnert 1/2019 : remove SURF
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+! R. Honnert 04/2021: remove HRIO and BOUT schemes
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_PARAMETERS, ONLY: JPVEXT
+USE MODD_PARAM_MFSHALL_n
+USE MODD_TURB_n, ONLY: CTURBLEN
+
+USE MODI_THL_RT_FROM_TH_R_MF
+USE MODI_COMPUTE_UPDRAFT
+USE MODI_COMPUTE_UPDRAFT_RHCJ10
+USE MODI_COMPUTE_UPDRAFT_RAHA
+USE MODI_MF_TURB
+USE MODI_MF_TURB_EXPL
+USE MODI_MF_TURB_GREYZONE
+USE MODI_COMPUTE_MF_CLOUD
+USE MODI_COMPUTE_FRAC_ICE
+USE MODI_SHUMAN_MF
+!
+USE MODI_COMPUTE_BL89_ML
+USE MODD_GRID_n, ONLY : XDXHAT, XDYHAT
+USE MODD_REF_n, ONLY : XTHVREF
+USE MODE_MSG
+!
+IMPLICIT NONE
+
+!* 0.1 Declaration of Arguments
+!
+!
+!
+INTEGER, INTENT(IN) :: KKA ! near ground array index
+INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+INTEGER, INTENT(IN) :: KRR ! number of moist var.
+INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
+INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
+CHARACTER (LEN=4), INTENT(IN) :: HMF_UPDRAFT ! Type of Mass Flux Scheme
+ ! 'NONE' if no parameterization
+CHARACTER (LEN=4), INTENT(IN) :: HMF_CLOUD ! Type of statistical cloud
+ ! scheme
+CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme
+LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum
+LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer
+INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer
+INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer
+REAL, INTENT(IN) :: PIMPL_MF ! degre of implicitness
+REAL, INTENT(IN) :: PTSTEP ! Dynamical timestep
+
+REAL, DIMENSION(:,:), INTENT(IN) :: PZZ ! Height of flux point
+REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! Metric coefficients
+REAL, DIMENSION(:,:), INTENT(IN) :: PRHODJ ! dry density * Grid size
+REAL, DIMENSION(:,:), INTENT(IN) :: PRHODREF ! dry density of the
+ ! reference state
+REAL, DIMENSION(:,:), INTENT(IN) :: PPABSM ! Pressure at time t-1
+REAL, DIMENSION(:,:), INTENT(IN) :: PEXNM ! Exner function at t-dt
+
+REAL, DIMENSION(:), INTENT(IN) :: PSFTH,PSFRV ! normal surface fluxes of theta and Rv
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHM ! Theta at t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRM ! water var. at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PUM,PVM,PWM ! wind components at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PTKEM ! tke at t-dt
+
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVM ! scalar variable a t-dt
+
+REAL, DIMENSION(:,:), INTENT(OUT):: PDUDT_MF ! tendency of U by massflux scheme
+REAL, DIMENSION(:,:), INTENT(OUT):: PDVDT_MF ! tendency of V by massflux scheme
+REAL, DIMENSION(:,:), INTENT(OUT):: PDTHLDT_MF ! tendency of thl by massflux scheme
+REAL, DIMENSION(:,:), INTENT(OUT):: PDRTDT_MF ! tendency of rt by massflux scheme
+REAL, DIMENSION(:,:,:), INTENT(OUT):: PDSVDT_MF ! tendency of Sv by massflux scheme
+
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSIGMF,PRC_MF,PRI_MF,PCF_MF ! cloud info for the cloud scheme
+REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZTHVMF ! Thermal production for TKE scheme
+REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZTHMF
+REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZRMF
+REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZUMF
+REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZVMF
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PTHL_UP ! Thl updraft characteristics
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PRT_UP ! Rt updraft characteristics
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PRV_UP ! Vapor updraft characteristics
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PU_UP ! U wind updraft characteristics
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PV_UP ! V wind updraft characteristics
+
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PTHL_DO ! Thl environment characteristics
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PTHV_DO ! Thv environment characteristics
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PRT_DO ! Rt environment characteristics
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PU_DO ! U wind environment characteristics
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PV_DO ! V wind environment characteristics
+
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PRC_UP ! cloud content updraft characteristics
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PRI_UP ! ice content updraft characteristics
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PTHV_UP ! Thv updraft characteristics
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PW_UP ! vertical speed updraft characteristics
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PFRAC_UP ! updraft fraction
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PEMF ! updraft mass flux
+REAL, DIMENSION(:,:), INTENT(OUT) :: PDETR ! updraft detrainment
+REAL, DIMENSION(:,:), INTENT(OUT) :: PENTR ! updraft entrainment
+INTEGER,DIMENSION(:), INTENT(OUT) :: KKLCL,KKETL,KKCTL ! level of LCL,ETL and CTL
+!
+! 0.2 Declaration of local variables
+!
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: &
+ ZTHLM, & !
+ ZRTM, & !
+ ZTHVM, & !
+ ZEMF_O_RHODREF, & ! entrainment/detrainment
+ ZBUO_INTEG ! integrated buoyancy
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZFRAC_ICE
+
+REAL, DIMENSION(SIZE(PSVM,1),SIZE(PSVM,2),SIZE(PSVM,3)) :: &
+ ZSV_UP,& ! updraft scalar var.
+ ZSV_DO,& ! updraft scalar var.
+ ZFLXZSVMF ! Flux
+REAL, DIMENSION(SIZE(PTHM,1)) :: ZDEPTH ! Deepness of cloud
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZFRAC_ICE_UP ! liquid/solid fraction in updraft
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZRSAT_UP ! Rsat in updraft
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZSHEAR,ZDUDZ,ZDVDZ !vertical wind shear
+
+LOGICAL :: GENTR_DETR ! flag to recompute entrainment, detrainment and mass flux
+INTEGER :: IKB ! near ground physical index
+INTEGER :: IKE ! uppest atmosphere physical index
+! pour bouttle et al.
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZG_O_THVREF,PTHVREF
+REAL, DIMENSION(SIZE(PTHM,1)) :: ZRESOL_NORM, ZRESOL_GRID,& ! normalized grid
+ ZLUP, ZPLAW
+! Test if the ascent continue, if LCL or ETL is reached
+LOGICAL :: GLMIX
+ INTEGER :: JI,JJ,JK ! loop counter
+!------------------------------------------------------------------------
+
+!!! 1. Initialisation
+
+! vertical boundaries
+IKB=KKA+KKL*JPVEXT
+IKE=KKU-KKL*JPVEXT
+
+! updraft governing variables
+IF (HMF_UPDRAFT == 'EDKF' .OR. HMF_UPDRAFT == 'RHCJ') THEN
+ PENTR = 1.E20
+ PDETR = 1.E20
+ PEMF = 1.E20
+ ZBUO_INTEG = 1.E20
+ENDIF
+
+! Thermodynamics functions
+ZFRAC_ICE(:,:) = 0.
+IF (SIZE(PRM,3).GE.4) THEN
+ WHERE(PRM(:,:,2)+PRM(:,:,4) > 1.E-20)
+ ZFRAC_ICE(:,:) = PRM(:,:,4) / (PRM(:,:,2)+PRM(:,:,4))
+ ENDWHERE
+ENDIF
+CALL COMPUTE_FRAC_ICE(HFRAC_ICE,ZFRAC_ICE(:,:),PTHM(:,:)*PEXNM(:,:))
+
+! Conservative variables at t-dt
+CALL THL_RT_FROM_TH_R_MF(KRR,KRRL,KRRI, &
+ PTHM, PRM, PEXNM, &
+ ZTHLM, ZRTM )
+
+! Virtual potential temperature at t-dt
+ZTHVM(:,:) = PTHM(:,:)*((1.+XRV / XRD *PRM(:,:,1))/(1.+ZRTM(:,:)))
+
+!
+!!! 2. Compute updraft
+!!! ---------------
+!
+IF (HMF_UPDRAFT == 'EDKF') THEN
+ GENTR_DETR = .TRUE.
+ CALL COMPUTE_UPDRAFT(KKA,IKB,IKE,KKU,KKL,HFRAC_ICE,GENTR_DETR,OMIXUV,&
+ ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
+ PZZ,PDZZ, &
+ PSFTH,PSFRV,PPABSM,PRHODREF, &
+ PUM,PVM,PTKEM, &
+ PTHM,PRM(:,:,1),ZTHLM,ZRTM,PSVM, &
+ PTHL_UP,PRT_UP,PRV_UP,PRC_UP,PRI_UP, &
+ PTHV_UP, PW_UP, PU_UP, PV_UP, ZSV_UP, &
+ PFRAC_UP,ZFRAC_ICE_UP,ZRSAT_UP,PEMF,PDETR,&
+ PENTR,ZBUO_INTEG,KKLCL,KKETL,KKCTL,ZDEPTH )
+ELSEIF (HMF_UPDRAFT == 'RHCJ') THEN
+ GENTR_DETR = .TRUE.
+ CALL COMPUTE_UPDRAFT_RHCJ10(KKA,IKB,IKE,KKU,KKL,HFRAC_ICE,GENTR_DETR,OMIXUV,&
+ ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
+ PZZ,PDZZ, &
+ PSFTH,PSFRV,PPABSM,PRHODREF, &
+ PUM,PVM,PTKEM, &
+ PTHM,PRM(:,:,1),ZTHLM,ZRTM,PSVM, &
+ PTHL_UP,PRT_UP,PRV_UP,PRC_UP,PRI_UP, &
+ PTHV_UP, PW_UP, PU_UP, PV_UP, ZSV_UP, &
+ PFRAC_UP,ZFRAC_ICE_UP,ZRSAT_UP,PEMF,PDETR,&
+ PENTR,ZBUO_INTEG,KKLCL,KKETL,KKCTL,ZDEPTH )
+ELSEIF (HMF_UPDRAFT == 'RAHA') THEN
+ CALL COMPUTE_UPDRAFT_RAHA(KKA,IKB,IKE,KKU,KKL,HFRAC_ICE, &
+ GENTR_DETR,OMIXUV, &
+ ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
+ PZZ,PDZZ, &
+ PSFTH,PSFRV, &
+ PPABSM,PRHODREF,PUM,PVM,PTKEM, &
+ PEXNM,PTHM,PRM(:,:,1),ZTHLM,ZRTM, &
+ PSVM,PTHL_UP,PRT_UP, &
+ PRV_UP,PRC_UP,PRI_UP, PTHV_UP, &
+ PW_UP, PU_UP, PV_UP, ZSV_UP, &
+ PFRAC_UP,ZFRAC_ICE_UP,ZRSAT_UP, &
+ PEMF,PDETR,PENTR, &
+ ZBUO_INTEG,KKLCL,KKETL,KKCTL, &
+ ZDEPTH )
+ELSEIF (HMF_UPDRAFT == 'DUAL') THEN
+ !Updraft characteristics are already computed and received by interface
+ELSE
+ call Print_msg( NVERB_FATAL, 'GEN', 'SHALLOW_MF', 'no updraft model for EDKF: CMF_UPDRAFT='//trim(HMF_UPDRAFT) )
+ENDIF
+
+!!! 5. Compute diagnostic convective cloud fraction and content
+!!! --------------------------------------------------------
+!
+CALL COMPUTE_MF_CLOUD(KKA,IKB,IKE,KKU,KKL,KRR,KRRL,KRRI,&
+ HMF_CLOUD,ZFRAC_ICE, &
+ PRC_UP,PRI_UP,PEMF, &
+ PTHL_UP,PRT_UP,PFRAC_UP, &
+ PTHV_UP,ZFRAC_ICE_UP, &
+ ZRSAT_UP,PEXNM,ZTHLM,ZRTM, &
+ PTHM, ZTHVM, PRM, &
+ PDZZ,PZZ,KKLCL, &
+ PPABSM,PRHODREF, &
+ PRC_MF,PRI_MF,PCF_MF,PSIGMF,ZDEPTH)
+
+
+!!! 3. Compute fluxes of conservative variables and their divergence = tendency
+!!! ------------------------------------------------------------------------
+!
+ZEMF_O_RHODREF=PEMF/PRHODREF
+IF(HMF_UPDRAFT == 'EDKF' .OR. HMF_UPDRAFT == 'RHCJ') THEN
+ IF ( PIMPL_MF > 1.E-10 ) THEN
+ CALL MF_TURB(KKA, IKB, IKE, KKU, KKL, OMIXUV, &
+ ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
+ PIMPL_MF, PTSTEP, &
+ PDZZ, &
+ PRHODJ, &
+ ZTHLM,ZTHVM,ZRTM,PUM,PVM,PSVM, &
+ PDTHLDT_MF,PDRTDT_MF,PDUDT_MF,PDVDT_MF,PDSVDT_MF, &
+ ZEMF_O_RHODREF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP,ZSV_UP,&
+ PFLXZTHMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF, &
+ ZFLXZSVMF )
+ ELSE
+ CALL MF_TURB_EXPL(KKA, IKB, IKE, KKU, KKL, OMIXUV, &
+ PRHODJ, &
+ ZTHLM,ZTHVM,ZRTM,PUM,PVM, &
+ PDTHLDT_MF,PDRTDT_MF,PDUDT_MF,PDVDT_MF, &
+ ZEMF_O_RHODREF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP, &
+ PFLXZTHMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF)
+ ENDIF
+ELSE
+ call Print_msg( NVERB_FATAL, 'GEN', 'SHALLOW_MF', 'no updraft model for EDKF: CMF_UPDRAFT='//trim(HMF_UPDRAFT) )
+END IF
+
+! security in the case HMF_UPDRAFT = 'DUAL'
+! to be modified if 'DUAL' is evolving (momentum mixing for example)
+IF( HMF_UPDRAFT == 'DUAL') THEN
+ ! Now thetav_up from vdfhghtnn is used!
+ PFLXZTHVMF=0.
+ ! Yes/No UV mixing!
+! PDUDT_MF=0.
+! PDVDT_MF=0.
+ENDIF
+!
+END SUBROUTINE SHALLOW_MF
diff --git a/src/mesonh/turb/shuman_mf.f90 b/src/mesonh/turb/shuman_mf.f90
new file mode 100644
index 000000000..ce9cde051
--- /dev/null
+++ b/src/mesonh/turb/shuman_mf.f90
@@ -0,0 +1,445 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+! ##################
+ MODULE MODI_SHUMAN_MF
+! ##################
+!
+INTERFACE
+!
+FUNCTION DZF_MF(KKA,KKU,KKL,PA) RESULT(PDZF)
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:), INTENT(IN) :: PA ! variable at flux
+ ! side
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2)) :: PDZF ! result at mass
+ ! localization
+END FUNCTION DZF_MF
+!
+FUNCTION DZM_MF(KKA,KKU,KKL,PA) RESULT(PDZM)
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:), INTENT(IN) :: PA ! variable at mass
+ ! localization
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2)) :: PDZM ! result at flux
+ ! side
+END FUNCTION DZM_MF
+!
+FUNCTION MZF_MF(KKA,KKU,KKL,PA) RESULT(PMZF)
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:), INTENT(IN) :: PA ! variable at flux
+ ! side
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2)) :: PMZF ! result at mass
+ ! localization
+END FUNCTION MZF_MF
+!
+FUNCTION MZM_MF(KKA,KKU,KKL,PA) RESULT(PMZM)
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:), INTENT(IN) :: PA ! variable at mass localization
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2)) :: PMZM ! result at flux localization
+END FUNCTION MZM_MF
+!
+FUNCTION GZ_M_W_MF(KKA,KKU,KKL,PY,PDZZ) RESULT(PGZ_M_W)
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! Metric coefficient d*zz
+REAL, DIMENSION(:,:), INTENT(IN) :: PY ! variable at mass localization
+REAL, DIMENSION(SIZE(PY,1),SIZE(PY,2)) :: PGZ_M_W ! result at flux side
+END FUNCTION GZ_M_W_MF
+!
+END INTERFACE
+!
+END MODULE MODI_SHUMAN_MF
+!
+! ###############################
+ FUNCTION MZF_MF(KKA,KKU,KKL,PA) RESULT(PMZF)
+! ###############################
+!
+!!**** *MZF* - SHUMAN_MF operator : mean operator in z direction for a
+!! variable at a flux side
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute a mean
+! along the z direction (K index) for a field PA localized at a z-flux
+! point (w point). The result is localized at a mass point.
+!
+!!** METHOD
+!! ------
+!! The result PMZF(:,:,k) is defined by 0.5*(PA(:,:,k)+PA(:,:,k+1))
+!! At k=size(PA,3), PMZF(:,:,k) is defined by PA(:,:,k).
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! NONE
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (SHUMAN_MF operators)
+!! Technical specifications Report of The Meso-NH (chapters 3)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 04/07/94
+!! optimisation 20/08/00 J. Escobar
+!! S. Riette, Jan 2012: Simplification and suppression of array overflow
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:), INTENT(IN) :: PA ! variable at flux
+ ! side
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2)) :: PMZF ! result at mass
+ ! localization
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: JK ! Loop index in z direction
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. DEFINITION OF MZF
+! ------------------
+!
+DO JK=2,SIZE(PA,2)-1
+ PMZF(:,JK) = 0.5*( PA(:,JK)+PA(:,JK+KKL) )
+END DO
+PMZF(:,KKA) = 0.5*( PA(:,KKA)+PA(:,KKA+KKL) )
+PMZF(:,KKU) = PA(:,KKU)
+!
+!-------------------------------------------------------------------------------
+!
+END FUNCTION MZF_MF
+! ###############################
+ FUNCTION MZM_MF(KKA,KKU,KKL,PA) RESULT(PMZM)
+! ###############################
+!
+!!**** *MZM* - SHUMAN_MF operator : mean operator in z direction for a
+!! mass variable
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute a mean
+! along the z direction (K index) for a field PA localized at a mass
+! point. The result is localized at a z-flux point (w point).
+!
+!!** METHOD
+!! ------
+!! The result PMZM(:,:,k) is defined by 0.5*(PA(:,:,k)+PA(:,:,k-1))
+!! At k=1, PMZM(:,:,1) is defined by PA(:,:,1).
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! NONE
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (SHUMAN_MF operators)
+!! Technical specifications Report of The Meso-NH (chapters 3)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 04/07/94
+!! optimisation 20/08/00 J. Escobar
+!! S. Riette, Jan 2012: Simplification and suppression of array overflow
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:), INTENT(IN) :: PA ! variable at mass localization
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2)) :: PMZM ! result at flux localization
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: JK ! Loop index in z direction
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. DEFINITION OF MZM
+! ------------------
+!
+DO JK=2,SIZE(PA,2)-1
+ PMZM(:,JK) = 0.5*( PA(:,JK)+PA(:,JK-KKL) )
+END DO
+PMZM(:,KKA) = PA(:,KKA)
+PMZM(:,KKU) = 0.5*( PA(:,KKU)+PA(:,KKU-KKL) )
+!
+!-------------------------------------------------------------------------------
+!
+END FUNCTION MZM_MF
+! ###############################
+ FUNCTION DZF_MF(KKA,KKU,KKL,PA) RESULT(PDZF)
+! ###############################
+!
+!!**** *DZF* - SHUMAN_MF operator : finite difference operator in z direction
+!! for a variable at a flux side
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute a finite difference
+! along the z direction (K index) for a field PA localized at a z-flux
+! point (w point). The result is localized at a mass point.
+!
+!!** METHOD
+!! ------
+!! The result PDZF(:,:,k) is defined by (PA(:,:,k+1)-PA(:,:,k))
+!! At k=size(PA,3), PDZF(:,:,k) is defined by 0.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! NONE
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (SHUMAN_MF operators)
+!! Technical specifications Report of The Meso-NH (chapters 3)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 05/07/94
+!! optimisation 20/08/00 J. Escobar
+!! S. Riette, Jan 2012: Simplification and suppression of array overflow
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:), INTENT(IN) :: PA ! variable at flux
+ ! side
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2)) :: PDZF ! result at mass
+ ! localization
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: JK ! Loop index in z direction
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. DEFINITION OF DZF
+! ------------------
+!
+DO JK=2,SIZE(PA,2)-1
+ PDZF(:,JK) = PA(:,JK+KKL) - PA(:,JK)
+END DO
+PDZF(:,KKA) = PA(:,KKA+KKL) - PA(:,KKA)
+PDZF(:,KKU) = 0.
+!
+!-------------------------------------------------------------------------------
+!
+END FUNCTION DZF_MF
+! ###############################
+ FUNCTION DZM_MF(KKA,KKU,KKL,PA) RESULT(PDZM)
+! ###############################
+!
+!!**** *DZM* - SHUMAN_MF operator : finite difference operator in z direction
+!! for a variable at a mass localization
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute a finite difference
+! along the z direction (K index) for a field PA localized at a mass
+! point. The result is localized at a z-flux point (w point).
+!
+!!** METHOD
+!! ------
+!! The result PDZM(:,j,:) is defined by (PA(:,:,k)-PA(:,:,k-1))
+!! At k=1, PDZM(:,:,k) is defined by 0.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! NONE
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (SHUMAN_MF operators)
+!! Technical specifications Report of The Meso-NH (chapters 3)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 05/07/94
+!! optimisation 20/08/00 J. Escobar
+!! S. Riette, Jan 2012: Simplification and suppression of array overflow
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:), INTENT(IN) :: PA ! variable at mass
+ ! localization
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2)) :: PDZM ! result at flux
+ ! side
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: JK ! Loop index in z direction
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. DEFINITION OF DZM
+! ------------------
+!
+DO JK=2,SIZE(PA,2)-1
+ PDZM(:,JK) = PA(:,JK) - PA(:,JK-KKL)
+END DO
+PDZM(:,KKA) = 0.
+PDZM(:,KKU) = PA(:,KKU) - PA(:,KKU-KKL)
+!
+!-------------------------------------------------------------------------------
+!
+END FUNCTION DZM_MF
+
+! ###############################
+ FUNCTION GZ_M_W_MF(KKA,KKU,KKL,PY,PDZZ) RESULT(PGZ_M_W)
+! ###############################
+!
+!!**** *GZ_M_W * - Compute the gradient along z direction for a
+!! variable localized at a mass point
+!!
+!! PURPOSE
+!! -------
+!
+!!** METHOD
+!! ------
+! dzm(PY)
+! PGZ_M_W = -------
+! d*zz
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! NONE
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! S.Riette moving of code previously in compute_mf_cloud code
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 25 Aug 2011
+!! S. Riette, Jan 2012: Simplification and suppression of array overflow
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!!
+!
+!-------------------------------------------------------------------------------
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! Metric coefficient d*zz
+REAL, DIMENSION(:,:), INTENT(IN) :: PY ! variable at mass localization
+REAL, DIMENSION(SIZE(PY,1),SIZE(PY,2)) :: PGZ_M_W ! result at flux side
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER JK
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTE THE GRADIENT ALONG Z
+! -----------------------------
+!
+DO JK=2,SIZE(PY,2)-1
+ PGZ_M_W(:,JK) = (PY(:,JK) - PY(:,JK-KKL)) / PDZZ(:,JK)
+END DO
+PGZ_M_W(:,KKA) = 0.
+PGZ_M_W(:,KKU) = (PY(:,KKU) - PY(:,KKU-KKL)) / PDZZ(:,KKU)
+!
+!-------------------------------------------------------------------------------
+!
+END FUNCTION GZ_M_W_MF
diff --git a/src/mesonh/turb/thl_rt_from_th_r_mf.f90 b/src/mesonh/turb/thl_rt_from_th_r_mf.f90
new file mode 100644
index 000000000..1fb982a1a
--- /dev/null
+++ b/src/mesonh/turb/thl_rt_from_th_r_mf.f90
@@ -0,0 +1,146 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+! ######spl
+ MODULE MODI_THL_RT_FROM_TH_R_MF
+! ###############################
+!
+INTERFACE
+! #################################################################
+ SUBROUTINE THL_RT_FROM_TH_R_MF( KRR,KRRL,KRRI, &
+ PTH, PR, PEXN, &
+ PTHL, PRT )
+! #################################################################
+!
+!
+!* 1.1 Declaration of Arguments
+!
+!
+INTEGER, INTENT(IN) :: KRR ! number of moist var.
+INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
+INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
+
+REAL, DIMENSION(:,:), INTENT(IN) :: PTH ! theta
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PR ! water species
+REAL, DIMENSION(:,:), INTENT(IN) :: PEXN ! exner function
+
+REAL, DIMENSION(:,:), INTENT(OUT) :: PTHL ! th_l
+REAL, DIMENSION(:,:), INTENT(OUT) :: PRT ! total non precip. water
+!
+END SUBROUTINE THL_RT_FROM_TH_R_MF
+
+END INTERFACE
+!
+END MODULE MODI_THL_RT_FROM_TH_R_MF
+! #################################################################
+ SUBROUTINE THL_RT_FROM_TH_R_MF( KRR,KRRL,KRRI, &
+ PTH, PR, PEXN, &
+ PTHL, PRT )
+! #################################################################
+!
+!!
+!!**** *THL_RT_FROM_TH_R* - computes the conservative variables THL and RT
+!! from TH and the non precipitating water species
+!!
+!! PURPOSE
+!! -------
+!!
+!!** METHOD
+!! ------
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! V. Masson * Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 20/09/02
+!! Externalisation of computations done in TURB and MF_TURB (Malardel and Pergaud, fev. 2007)
+!! V.Masson : Optimization
+!! S. Riette 2011 suppression of PLVOCPEXN and PLSOCPEXN
+!!
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+INTEGER, INTENT(IN) :: KRR ! number of moist var.
+INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
+INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
+
+REAL, DIMENSION(:,:), INTENT(IN) :: PTH ! theta
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PR ! water species
+REAL, DIMENSION(:,:), INTENT(IN) :: PEXN ! exner function
+
+REAL, DIMENSION(:,:), INTENT(OUT) :: PTHL ! th_l
+REAL, DIMENSION(:,:), INTENT(OUT) :: PRT ! total non precip. water
+!
+!-------------------------------------------------------------------------------
+!
+! 0.2 declaration of local variables
+!
+
+!----------------------------------------------------------------------------
+REAL, DIMENSION(SIZE(PTH,1),SIZE(PTH,2)) :: ZCP, ZT
+REAL, DIMENSION(SIZE(PTH,1),SIZE(PTH,2)) :: ZLVOCPEXN, ZLSOCPEXN
+INTEGER :: JRR
+!----------------------------------------------------------------------------
+!
+!
+!temperature
+ZT(:,:) = PTH(:,:) * PEXN(:,:)
+
+!Cp
+ZCP=XCPD
+IF (KRR > 0) ZCP(:,:) = ZCP(:,:) + XCPV * PR(:,:,1)
+DO JRR = 2,1+KRRL ! loop on the liquid components
+ ZCP(:,:) = ZCP(:,:) + XCL * PR(:,:,JRR)
+END DO
+DO JRR = 2+KRRL,1+KRRL+KRRI ! loop on the solid components
+ ZCP(:,:) = ZCP(:,:) + XCI * PR(:,:,JRR)
+END DO
+
+IF ( KRRL >= 1 ) THEN
+ IF ( KRRI >= 1 ) THEN
+ !ZLVOCPEXN and ZLSOCPEXN
+ ZLVOCPEXN(:,:)=(XLVTT + (XCPV-XCL) * (ZT(:,:)-XTT) ) / ZCP(:,:) / PEXN(:,:)
+ ZLSOCPEXN(:,:)=(XLSTT + (XCPV-XCI) * (ZT(:,:)-XTT) ) / ZCP(:,:) / PEXN(:,:)
+ ! Rnp
+ PRT(:,:) = PR(:,:,1) + PR(:,:,2) + PR(:,:,4)
+ ! Theta_l
+ PTHL(:,:) = PTH(:,:) - ZLVOCPEXN(:,:) * PR(:,:,2) &
+ - ZLSOCPEXN(:,:) * PR(:,:,4)
+ ELSE
+ !ZLVOCPEXN
+ ZLVOCPEXN(:,:)=(XLVTT + (XCPV-XCL) * (ZT(:,:)-XTT) ) / ZCP(:,:) / PEXN(:,:)
+ ! Rnp
+ PRT(:,:) = PR(:,:,1) + PR(:,:,2)
+ ! Theta_l
+ PTHL(:,:) = PTH(:,:) - ZLVOCPEXN(:,:) * PR(:,:,2)
+ END IF
+ELSE
+ ! Rnp = rv
+ PRT(:,:) = PR(:,:,1)
+ ! Theta_l = Theta
+ PTHL(:,:) = PTH(:,:)
+END IF
+END SUBROUTINE THL_RT_FROM_TH_R_MF
diff --git a/src/mesonh/turb/tke_eps_sources.f90 b/src/mesonh/turb/tke_eps_sources.f90
new file mode 100644
index 000000000..4efe246be
--- /dev/null
+++ b/src/mesonh/turb/tke_eps_sources.f90
@@ -0,0 +1,485 @@
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ###########################
+ MODULE MODI_TKE_EPS_SOURCES
+! ###########################
+INTERFACE
+!
+ SUBROUTINE TKE_EPS_SOURCES(KKA,KKU,KKL,KMI,PTKEM,PLM,PLEPS,PDP,PTRH, &
+ PRHODJ,PDZZ,PDXX,PDYY,PDZX,PDZY,PZZ, &
+ PTSTEP,PIMPL,PEXPL, &
+ HTURBLEN,HTURBDIM, &
+ TPFILE,OTURB_DIAG, &
+ PTP,PRTKES,PRTKESM, PRTHLS,PCOEF_DISS,PTR,PDISS )
+!
+USE MODD_IO, ONLY: TFILEDATA
+!
+INTEGER, INTENT(IN) :: KKA !near ground array index
+INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
+INTEGER, INTENT(IN) :: KMI ! model index number
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at t-deltat
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! mixing length
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! dissipative length
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density * grid volume
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
+ ! metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! physical height w-pt
+REAL, INTENT(IN) :: PTSTEP ! Time step
+REAL, INTENT(IN) :: PEXPL, PIMPL ! Coef. temporal. disc.
+CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
+ ! turbulence scheme
+CHARACTER(len=4), INTENT(IN) :: HTURBLEN ! kind of mixing length
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+LOGICAL, INTENT(IN) :: OTURB_DIAG ! switch to write some
+ ! diagnostic fields in the syncronous FM-file
+REAL, DIMENSION(:,:,:), INTENT(INOUT):: PDP ! Dyn. prod. of TKE
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTRH
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTP ! Ther. prod. of TKE
+REAL, DIMENSION(:,:,:), INTENT(INOUT):: PRTKES ! RHOD * Jacobian *
+ ! TKE at t+deltat
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRTKESM ! Advection source
+REAL, DIMENSION(:,:,:), INTENT(INOUT):: PRTHLS ! Source of Theta_l
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCOEF_DISS ! 1/(Cph*Exner)
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTR ! Transport prod. of TKE
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDISS ! Dissipati prod. of TKE
+!
+!
+!
+END SUBROUTINE TKE_EPS_SOURCES
+!
+END INTERFACE
+!
+END MODULE MODI_TKE_EPS_SOURCES
+!
+! ##################################################################
+ SUBROUTINE TKE_EPS_SOURCES(KKA,KKU,KKL,KMI,PTKEM,PLM,PLEPS,PDP, &
+ PTRH,PRHODJ,PDZZ,PDXX,PDYY,PDZX,PDZY,PZZ, &
+ PTSTEP,PIMPL,PEXPL, &
+ HTURBLEN,HTURBDIM, &
+ TPFILE,OTURB_DIAG, &
+ PTP,PRTKES,PRTKESM, PRTHLS,PCOEF_DISS,PTR,PDISS )
+! ##################################################################
+!
+!
+!!**** *TKE_EPS_SOURCES* - routine to compute the sources of the turbulent
+!! evolutive variables: TKE and its dissipation when it is taken into
+!! account. The contribution to the heating of tke dissipation is computed.
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to compute the sources necessary for
+! the evolution of the turbulent kinetic energy and its dissipation
+! if necessary.
+!
+!!** METHOD
+!! ------
+!! The vertical turbulent flux is computed in an off-centered
+!! implicit scheme (a Crank-Nicholson type with coefficients different
+!! than 0.5), which allows to vary the degree of implicitness of the
+!! formulation.
+!! In high resolution, the horizontal transport terms are also
+!! calculated, but explicitly.
+!! The evolution of the dissipation as a variable is made if
+!! the parameter HTURBLEN is set equal to KEPS. The same reasoning
+!! made for TKE applies.
+!!
+!! EXTERNAL
+!! --------
+!! GX_U_M,GY_V_M,GZ_W_M
+!! GX_M_U,GY_M_V : Cartesian vertical gradient operators
+!!
+!! MXF,MXM.MYF,MYM,MZF,MZM: Shuman functions (mean operators)
+!! DZF : Shuman functions (difference operators)
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST : contains physical constants
+!!
+!! XG : gravity constant
+!!
+!! Module MODD_CTURB: contains the set of constants for
+!! the turbulence scheme
+!!
+!! XCET,XCED : transport and dissipation cts. for the TKE
+!! XCDP,XCDD,XCDT: constants from the parameterization of
+!! the K-epsilon equation
+!! XTKEMIN,XEPSMIN : minimum values for the TKE and its
+!! dissipation
+!!
+!! Module MODD_PARAMETERS:
+!!
+!! JPVEXT
+!! Module MODD_BUDGET:
+!! NBUMOD : model in which budget is calculated
+!! CBUTYPE : type of desired budget
+!! 'CART' for cartesian box configuration
+!! 'MASK' for budget zone defined by a mask
+!! 'NONE' ' for no budget
+!! LBU_RTKE : logical for budget of RTKE (turbulent kinetic energy)
+!! .TRUE. = budget of RTKE
+!! .FALSE. = no budget of RTKE
+!!
+!!
+!! REFERENCE
+!! ---------
+!! Book 2 of documentation (routine TKE_EPS_SOURCES)
+!! Book 1 of documentation (Chapter: Turbulence)
+!!
+!! AUTHOR
+!! ------
+!! Joan Cuxart * INM and Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original August 23, 1994
+!! Modifications: Feb 14, 1995 (J.Cuxart and J.Stein)
+!! Doctorization and Optimization
+!! June 29, 1995 (J.Stein) TKE budget
+!! June 28, 1995 (J.Cuxart) Add LES tools
+!! Modifications: February 29, 1996 (J. Stein) optimization
+!! Modifications: May 6, 1996 (N. Wood) Extend some loops over
+!! the outer points
+!! Modifications: August 30, 1996 (P. Jabouille) calcul ZFLX at the
+!! IKU level
+!! October 10, 1996 (J.Stein) set Keff at t-deltat
+!! Oct 8, 1996 (Cuxart,Sanchez) Var.LES: XETR_TF,XDISS_TF
+!! December 20, 1996 (J.-P. Pinty) update the CALL BUDGET
+!! November 24, 1997 (V. Masson) bug in <v'e>
+!! removes the DO loops
+!! Augu. 9, 1999 (J.Stein) TKE budget correction
+!! Mar 07 2001 (V. Masson and J. Stein) remove the horizontal
+!! turbulent transports of Tke computation
+!! Nov 06, 2002 (V. Masson) LES budgets
+!! July 20, 2003 (J.-P. Pinty P Jabouille) add the dissipative heating
+!! May 2006 Remove KEPS
+!! October 2009 (G. Tanguy) add ILENCH=LEN(YCOMMENT) after
+!! change of YCOMMENT
+!! 2012-02 Y. Seity, add possibility to run with reversed
+!! vertical levels
+!! 2015-01 (J. Escobar) missing get_halo(ZRES) for JPHEXT<> 1
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
+! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_ARGSLIST_ll, ONLY: LIST_ll
+use modd_budget, only: lbudget_tke, lbudget_th, NBUDGET_TKE, NBUDGET_TH, tbudgets
+USE MODD_CONF
+USE MODD_CST
+USE MODD_CTURB
+USE MODD_DIAG_IN_RUN, ONLY: LDIAG_IN_RUN, XCURRENT_TKE_DISS
+use modd_field, only: tfielddata, TYPEREAL
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LES
+USE MODD_PARAMETERS
+!
+use mode_budget, only: Budget_store_add, Budget_store_end, Budget_store_init
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+USE MODE_ll
+!
+USE MODI_GET_HALO
+USE MODI_GRADIENT_M
+USE MODI_GRADIENT_U
+USE MODI_GRADIENT_V
+USE MODI_GRADIENT_W
+USE MODI_LES_MEAN_SUBGRID
+USE MODI_SHUMAN
+USE MODI_TRIDIAG_TKE
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+!
+INTEGER, INTENT(IN) :: KKA !near ground array index
+INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
+
+INTEGER, INTENT(IN) :: KMI ! model index number
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at t-deltat
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! mixing length
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! dissipative length
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density * grid volume
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
+ ! metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! physical height w-pt
+REAL, INTENT(IN) :: PTSTEP ! Time step
+REAL, INTENT(IN) :: PEXPL, PIMPL ! Coef. temporal. disc.
+CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
+ ! turbulence scheme
+CHARACTER(len=4), INTENT(IN) :: HTURBLEN ! kind of mixing length
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+LOGICAL, INTENT(IN) :: OTURB_DIAG ! switch to write some
+ ! diagnostic fields in the syncronous FM-file
+REAL, DIMENSION(:,:,:), INTENT(INOUT):: PDP ! Dyn. prod. of TKE
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTRH
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTP ! Ther. prod. of TKE
+REAL, DIMENSION(:,:,:), INTENT(INOUT):: PRTKES ! RHOD * Jacobian *
+ ! TKE at t+deltat
+REAL, DIMENSION(:,:,:), INTENT(INOUT):: PRTHLS ! Source of Theta_l
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCOEF_DISS ! 1/(Cph*Exner)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRTKESM ! Advection source
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTR ! Transport prod. of TKE
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDISS ! Dissipati prod. of TKE
+!
+!
+!
+!* 0.2 declaration of local variables
+!
+REAL, DIMENSION(SIZE(PTKEM,1),SIZE(PTKEM,2),SIZE(PTKEM,3)):: &
+ ZA, & ! under diagonal elements of the tri-diagonal matrix involved
+ ! in the temporal implicit scheme
+ ZRES, & ! treated variable at t+ deltat when the turbu-
+ ! lence is the only source of evolution added to the ones
+ ! considered in ZSOURCE. This variable is also used to
+ ! temporarily store some diagnostics stored in FM file
+ ZFLX, & ! horizontal or vertical flux of the treated variable
+ ZSOURCE, & ! source of evolution for the treated variable
+ ZKEFF ! effectif diffusion coeff = LT * SQRT( TKE )
+!LOGICAL,DIMENSION(SIZE(PTKEM,1),SIZE(PTKEM,2),SIZE(PTKEM,3)) :: GTKENEG
+! ! 3D mask .T. if TKE < XTKEMIN
+INTEGER :: IIB,IIE,IJB,IJE,IKB,IKE
+ ! Index values for the Beginning and End
+ ! mass points of the domain
+INTEGER :: IIU,IJU,IKU ! array size in the 3 dimensions
+!
+TYPE(LIST_ll), POINTER :: TZFIELDDISS_ll ! list of fields to exchange
+INTEGER :: IINFO_ll ! return code of parallel routine
+TYPE(TFIELDDATA) :: TZFIELD
+!
+!----------------------------------------------------------------------------
+NULLIFY(TZFIELDDISS_ll)
+!
+!* 1. PRELIMINARY COMPUTATIONS
+! ------------------------
+!
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+IIU=SIZE(PTKEM,1)
+IJU=SIZE(PTKEM,2)
+IKB=KKA+JPVEXT_TURB*KKL
+IKE=KKU-JPVEXT_TURB*KKL
+!
+! compute the effective diffusion coefficient at the mass point
+ZKEFF(:,:,:) = PLM(:,:,:) * SQRT(PTKEM(:,:,:))
+
+if (lbudget_th) call Budget_store_init( tbudgets(NBUDGET_TH), 'DISSH', prthls(:, :, :) )
+
+!----------------------------------------------------------------------------
+!
+!* 2. TKE EQUATION
+! ------------
+!
+!* 2.1 Horizontal turbulent explicit transport
+!
+!
+! Complete the sources of TKE with the horizontal turbulent explicit transport
+!
+IF (HTURBDIM=='3DIM') THEN
+ PTR=PTRH
+ELSE
+ PTR=0.
+END IF
+!
+!
+!
+!* 2.2 Explicit TKE sources except horizontal turbulent transport
+!
+!
+! extrapolate the dynamic production with a 1/Z law from its value at the
+! W(IKB+1) value stored in PDP(IKB) to the mass localization tke(IKB)
+PDP(:,:,IKB) = PDP(:,:,IKB) * (1. + PDZZ(:,:,IKB+KKL)/PDZZ(:,:,IKB))
+!
+! Compute the source terms for TKE: ( ADVECtion + NUMerical DIFFusion + ..)
+! + (Dynamical Production) + (Thermal Production) - (dissipation)
+ZFLX(:,:,:) = XCED * SQRT(PTKEM(:,:,:)) / PLEPS(:,:,:)
+ZSOURCE(:,:,:) = ( PRTKES(:,:,:) + PRTKESM(:,:,:) ) / PRHODJ(:,:,:) &
+ - PTKEM(:,:,:) / PTSTEP &
+ + PDP(:,:,:) + PTP(:,:,:) + PTR(:,:,:) - PEXPL * ZFLX(:,:,:) * PTKEM(:,:,:)
+!
+!* 2.2 implicit vertical TKE transport
+!
+!
+! Compute the vector giving the elements just under the diagonal for the
+! matrix inverted in TRIDIAG
+!
+ZA(:,:,:) = - PTSTEP * XCET * &
+ MZM(ZKEFF) * MZM(PRHODJ) / PDZZ**2
+!
+! Compute TKE at time t+deltat: ( stored in ZRES )
+!
+CALL TRIDIAG_TKE(KKA,KKU,KKL,PTKEM,ZA,PTSTEP,PEXPL,PIMPL,PRHODJ,&
+ & ZSOURCE,PTSTEP*ZFLX,ZRES)
+CALL GET_HALO(ZRES)
+!
+!* diagnose the dissipation
+!
+IF (LDIAG_IN_RUN) THEN
+ XCURRENT_TKE_DISS = ZFLX(:,:,:) * PTKEM(:,:,:) &
+ *(PEXPL*PTKEM(:,:,:) + PIMPL*ZRES(:,:,:))
+ CALL ADD3DFIELD_ll( TZFIELDDISS_ll, XCURRENT_TKE_DISS, 'TKE_EPS_SOURCES::XCURRENT_TKE_DISS' )
+ CALL UPDATE_HALO_ll(TZFIELDDISS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDDISS_ll)
+ENDIF
+!
+! TKE must be greater than its minimum value
+!
+! CL : Now done at the end of the time step in ADVECTION_METSV
+!GTKENEG = ZRES <= XTKEMIN
+!WHERE ( GTKENEG )
+! ZRES = XTKEMIN
+!END WHERE
+!
+IF ( LLES_CALL .OR. &
+ (OTURB_DIAG .AND. tpfile%lopened) ) THEN
+!
+! Compute the cartesian vertical flux of TKE in ZFLX
+!
+
+ ZFLX(:,:,:) = - XCET * MZM(ZKEFF) * &
+ DZM(PIMPL * ZRES + PEXPL * PTKEM ) / PDZZ
+!
+ ZFLX(:,:,IKB) = 0.
+ ZFLX(:,:,KKA) = 0.
+!
+! Compute the whole turbulent TRansport of TKE:
+!
+ PTR(:,:,:)= PTR - DZF( MZM(PRHODJ) * ZFLX / PDZZ ) /PRHODJ
+!
+! Storage in the LES configuration
+!
+ IF (LLES_CALL) THEN
+ CALL LES_MEAN_SUBGRID( MZF(ZFLX), X_LES_SUBGRID_WTke )
+ CALL LES_MEAN_SUBGRID( -PTR, X_LES_SUBGRID_ddz_WTke )
+ END IF
+!
+END IF
+!
+!* 2.4 stores the explicit sources for budget purposes
+!
+if (lbudget_tke) then
+ ! Dynamical production
+ call Budget_store_add( tbudgets(NBUDGET_TKE), 'DP', pdp(:, :, :) * prhodj(:, :, :) )
+ ! Thermal production
+ call Budget_store_add( tbudgets(NBUDGET_TKE), 'TP', ptp(:, :, :) * prhodj(:, :, :) )
+ ! Dissipation
+ call Budget_store_add( tbudgets(NBUDGET_TKE), 'DISS', -xced * sqrt( ptkem(:, :, :) ) / pleps(:, :, :) &
+ * ( pexpl * ptkem(:, :, :) + pimpl * zres(:, :, :) ) * prhodj(:, :, :) )
+end if
+!
+!* 2.5 computes the final RTKE and stores the whole turbulent transport
+! with the removal of the advection part
+
+if (lbudget_tke) then
+ !Store the previous source terms in prtkes before initializing the next one
+ PRTKES(:,:,:) = PRTKES(:,:,:) + PRHODJ(:,:,:) * &
+ ( PDP(:,:,:) + PTP(:,:,:) &
+ - XCED * SQRT(PTKEM(:,:,:)) / PLEPS(:,:,:) * ( PEXPL*PTKEM(:,:,:) + PIMPL*ZRES(:,:,:) ) )
+
+ call Budget_store_init( tbudgets(NBUDGET_TKE), 'TR', prtkes(:, :, :) )
+end if
+
+PRTKES(:,:,:) = ZRES(:,:,:) * PRHODJ(:,:,:) / PTSTEP - PRTKESM(:,:,:)
+!
+! stores the whole turbulent transport
+!
+if (lbudget_tke) call Budget_store_end( tbudgets(NBUDGET_TKE), 'TR', prtkes(:, :, :) )
+
+!----------------------------------------------------------------------------
+!
+!* 3. COMPUTE THE DISSIPATIVE HEATING
+! -------------------------------
+!
+PRTHLS(:,:,:) = PRTHLS(:,:,:) + XCED * SQRT(PTKEM(:,:,:)) / PLEPS(:,:,:) * &
+ (PEXPL*PTKEM(:,:,:) + PIMPL*ZRES(:,:,:)) * PRHODJ(:,:,:) * PCOEF_DISS(:,:,:)
+
+if (lbudget_th) call Budget_store_end( tbudgets(NBUDGET_TH), 'DISSH', prthls(:, :, :) )
+
+!----------------------------------------------------------------------------
+!
+!* 4. STORES SOME DIAGNOSTICS
+! -----------------------
+!
+PDISS(:,:,:) = -XCED * (PTKEM(:,:,:)**1.5) / PLEPS(:,:,:)
+!
+IF ( OTURB_DIAG .AND. tpfile%lopened ) THEN
+!
+! stores the dynamic production
+!
+ TZFIELD%CMNHNAME = 'DP'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'DP'
+ TZFIELD%CUNITS = 'm2 s-3'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_DP'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,PDP)
+!
+! stores the thermal production
+!
+ TZFIELD%CMNHNAME = 'TP'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'TP'
+ TZFIELD%CUNITS = 'm2 s-3'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_TP'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,PTP)
+!
+! stores the whole turbulent transport
+!
+ TZFIELD%CMNHNAME = 'TR'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'TR'
+ TZFIELD%CUNITS = 'm2 s-3'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_TR'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,PTR)
+!
+! stores the dissipation of TKE
+!
+ TZFIELD%CMNHNAME = 'DISS'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'DISS'
+ TZFIELD%CUNITS = 'm2 s-3'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_DISS'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,PDISS)
+END IF
+!
+! Storage in the LES configuration of the Dynamic Production of TKE and
+! the dissipation of TKE
+!
+IF (LLES_CALL ) THEN
+ CALL LES_MEAN_SUBGRID( PDISS, X_LES_SUBGRID_DISS_Tke )
+END IF
+!
+!----------------------------------------------------------------------------
+!
+!
+!----------------------------------------------------------------------------
+!
+END SUBROUTINE TKE_EPS_SOURCES
diff --git a/src/mesonh/turb/tm06.f90 b/src/mesonh/turb/tm06.f90
new file mode 100644
index 000000000..eb82548d9
--- /dev/null
+++ b/src/mesonh/turb/tm06.f90
@@ -0,0 +1,165 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 newsrc 2006/05/18 13:07:25
+!-----------------------------------------------------------------
+! ################
+ MODULE MODI_TM06
+! ################
+!
+INTERFACE
+!
+ SUBROUTINE TM06(KKA,KKU,KKL,PTHVREF,PBL_DEPTH,PZZ,PSFTH,PMWTH,PMTH2)
+!
+INTEGER, INTENT(IN) :: KKA !near ground array index
+INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! reference potential temperature
+REAL, DIMENSION(:,:), INTENT(IN) :: PBL_DEPTH ! boundary layer height
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitude of flux levels
+REAL, DIMENSION(:,:), INTENT(IN) :: PSFTH ! surface heat flux
+REAL, DIMENSION(:,:,:), INTENT(OUT):: PMWTH ! w'2th'
+REAL, DIMENSION(:,:,:), INTENT(OUT):: PMTH2 ! w'th'2
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE TM06
+!
+END INTERFACE
+!
+END MODULE MODI_TM06
+!
+! #################################################################
+ SUBROUTINE TM06(KKA,KKU,KKL,PTHVREF,PBL_DEPTH,PZZ,PSFTH,PMWTH,PMTH2)
+! #################################################################
+!
+!
+!!**** *TM06* - computes the Third Order Moments
+!!
+!! PURPOSE
+!! -------
+!
+!!** METHOD
+!! ------
+!!
+!! TOMs are deduced from convective normalized TOMs according to Tomas and
+!! Masson 2006
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! V. MAsson and S. Tomas * Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original sept. 2005
+!!
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS, ONLY : XUNDEF
+USE MODD_CST, ONLY : XG
+USE MODD_PARAMETERS, ONLY : JPVEXT_TURB
+
+!
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+INTEGER, INTENT(IN) :: KKA !near ground array index
+INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! reference potential temperature
+REAL, DIMENSION(:,:), INTENT(IN) :: PBL_DEPTH ! boundary layer height
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitude of flux levels
+REAL, DIMENSION(:,:), INTENT(IN) :: PSFTH ! surface heat flux
+REAL, DIMENSION(:,:,:), INTENT(OUT):: PMWTH ! w'2th'
+REAL, DIMENSION(:,:,:), INTENT(OUT):: PMTH2 ! w'th'2
+!
+!-------------------------------------------------------------------------------
+!
+! 0.2 declaration of local variables
+!
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZZ_O_H ! normalized height z/h (where h=BL height)
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2)) :: ZWSTAR ! normalized convective velocity w*
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2)) :: ZTSTAR ! normalized temperature velocity w*
+!
+INTEGER :: JK ! loop counter
+INTEGER :: IKT ! vertical size
+INTEGER :: IKTB,IKTE,IKB,IKE ! vertical levels
+!----------------------------------------------------------------------------
+!
+IKT=SIZE(PZZ,3)
+IKTB=1+JPVEXT_TURB
+IKTE=IKT-JPVEXT_TURB
+IKB=KKA+JPVEXT_TURB*KKL
+IKE=KKU-JPVEXT_TURB*KKL
+
+!
+!
+!* w* and T*
+!
+WHERE(PSFTH>0.)
+ ZWSTAR = ((XG/PTHVREF(:,:,IKB))*PSFTH*PBL_DEPTH)**(1./3.)
+ ZTSTAR = PSFTH / ZWSTAR
+ELSEWHERE
+ ZWSTAR = 0.
+ ZTSTAR = 0.
+END WHERE
+!
+!
+!* normalized height
+!
+ZZ_O_H = XUNDEF
+DO JK=1,IKT
+ WHERE (PBL_DEPTH/=XUNDEF)
+ ZZ_O_H(:,:,JK) = (PZZ(:,:,JK)-PZZ(:,:,IKB)) / PBL_DEPTH(:,:)
+ END WHERE
+END DO
+!
+!* w'th'2
+!
+PMTH2 = 0.
+WHERE(ZZ_O_H < 0.95 .AND. ZZ_O_H/=XUNDEF)
+ PMTH2(:,:,:) = 4.*(MAX(ZZ_O_H,0.))**0.4*(ZZ_O_H-0.95)**2
+END WHERE
+DO JK=IKTB+1,IKTE-1
+ PMTH2(:,:,JK) = PMTH2(:,:,JK) * ZTSTAR(:,:)**2*ZWSTAR(:,:)
+END DO
+PMTH2(:,:,IKE)=PMTH2(:,:,IKE) * ZTSTAR(:,:)**2*ZWSTAR(:,:)
+PMTH2(:,:,KKU)=PMTH2(:,:,KKU) * ZTSTAR(:,:)**2*ZWSTAR(:,:)
+
+!
+!
+!* w'2th'
+!
+PMWTH = 0.
+WHERE(ZZ_O_H <0.9 .AND. ZZ_O_H/=XUNDEF)
+ PMWTH(:,:,:) = MAX(-7.9*(ABS(ZZ_O_H-0.35))**2.9 * (ABS(ZZ_O_H-1.))**0.58 + 0.37, 0.)
+END WHERE
+DO JK=IKTB+1,IKTE-1
+ PMWTH(:,:,JK) = PMWTH(:,:,JK) * ZWSTAR(:,:)**2*ZTSTAR(:,:)
+END DO
+PMWTH(:,:,IKE) = PMWTH(:,:,IKE) * ZWSTAR(:,:)**2*ZTSTAR(:,:)
+PMWTH(:,:,KKU) = PMWTH(:,:,KKU) * ZWSTAR(:,:)**2*ZTSTAR(:,:)
+!
+!----------------------------------------------------------------------------
+END SUBROUTINE TM06
diff --git a/src/mesonh/turb/tm06_h.f90 b/src/mesonh/turb/tm06_h.f90
new file mode 100644
index 000000000..58f018554
--- /dev/null
+++ b/src/mesonh/turb/tm06_h.f90
@@ -0,0 +1,124 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 newsrc 2006/06/02 17:34:59
+!-----------------------------------------------------------------
+! ################
+ MODULE MODI_TM06_H
+! ################
+!
+INTERFACE
+!
+ SUBROUTINE TM06_H(KKB,KKTB,KKTE,PTSTEP,PZZ,PFLXZ,PBL_DEPTH)
+!
+INTEGER, INTENT(IN) :: KKB ! index of 1st physical level
+ ! close to ground
+INTEGER, INTENT(IN) :: KKTB ! first physical level in k
+INTEGER, INTENT(IN) :: KKTE ! last physical level in k
+REAL, INTENT(IN) :: PTSTEP ! Double time step
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitude of flux levels
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFLXZ ! heat flux
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PBL_DEPTH ! boundary layer height
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE TM06_H
+!
+END INTERFACE
+!
+END MODULE MODI_TM06_H
+!
+! #################################################################
+ SUBROUTINE TM06_H(KKB,KKTB,KKTE,PTSTEP,PZZ,PFLXZ,PBL_DEPTH)
+! #################################################################
+!
+!
+!!**** *TM06_H* - computes the Third Order Moments
+!!
+!! PURPOSE
+!! -------
+!
+!!** METHOD
+!! ------
+!!
+!! TOMs are deduced from convective normalized TOMs according to Tomas and
+!! Masson 2006
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! V. MAsson and S. Tomas * Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original sept. 2005
+!!
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS, ONLY : XUNDEF
+!
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+INTEGER, INTENT(IN) :: KKB ! index of 1st physical level
+ ! close to ground
+INTEGER, INTENT(IN) :: KKTB ! first physical level in k
+INTEGER, INTENT(IN) :: KKTE ! last physical level in k
+REAL, INTENT(IN) :: PTSTEP ! Double time step
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitude of flux levels
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFLXZ ! heat flux
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PBL_DEPTH ! boundary layer height
+!
+!-------------------------------------------------------------------------------
+!
+! 0.2 declaration of local variables
+!
+!
+INTEGER :: JK ! loop counter
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2)) :: ZFLXZMIN ! minimum of temperature flux
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2)) :: ZBL_DEPTH! BL depth at previous time-step
+REAL :: ZGROWTH ! maximum BL growth rate
+!----------------------------------------------------------------------------
+!
+!* mixed boundary layer cannot grow more rapidly than 1800m/h
+ZGROWTH = 2.0 ! (m/s)
+!
+!----------------------------------------------------------------------------
+!
+ZBL_DEPTH(:,:) = PBL_DEPTH(:,:)
+WHERE(ZBL_DEPTH(:,:)==XUNDEF) ZBL_DEPTH(:,:)=0.
+!
+PBL_DEPTH(:,:) = XUNDEF
+ZFLXZMIN (:,:) = PFLXZ(:,:,KKB)
+!
+DO JK=KKTB,KKTE
+ WHERE (PFLXZ(:,:,KKB)>0. .AND. PFLXZ(:,:,JK)<ZFLXZMIN(:,:))
+ PBL_DEPTH(:,:) = PZZ (:,:,JK) - PZZ(:,:,KKB)
+ ZFLXZMIN (:,:) = PFLXZ(:,:,JK)
+ END WHERE
+END DO
+!
+WHERE(PBL_DEPTH(:,:)/=XUNDEF) PBL_DEPTH(:,:)=MIN(PBL_DEPTH(:,:),ZBL_DEPTH(:,:)+ZGROWTH*PTSTEP)
+!
+!----------------------------------------------------------------------------
+END SUBROUTINE TM06_H
diff --git a/src/mesonh/turb/tridiag.f90 b/src/mesonh/turb/tridiag.f90
new file mode 100644
index 000000000..20a4213da
--- /dev/null
+++ b/src/mesonh/turb/tridiag.f90
@@ -0,0 +1,261 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 turb 2006/06/06 09:55:03
+!-----------------------------------------------------------------
+! ###################
+ MODULE MODI_TRIDIAG
+! ###################
+INTERFACE
+!
+ SUBROUTINE TRIDIAG(KKA,KKU,KKL,PVARM,PA,PTSTEP,PEXPL,PIMPL, &
+ PRHODJ,PSOURCE,PVARP )
+!
+INTEGER, INTENT(IN) :: KKA !near ground array index
+INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=AR
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PVARM ! variable at t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! upper diag. elements
+REAL, INTENT(IN) :: PTSTEP ! Double time step
+REAL, INTENT(IN) :: PEXPL,PIMPL ! weights of the temporal scheme
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! (dry rho)*J
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSOURCE ! source term of PVAR
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PVARP ! variable at t+1
+!
+END SUBROUTINE TRIDIAG
+!
+END INTERFACE
+!
+END MODULE MODI_TRIDIAG
+!
+!
+!
+! #################################################
+ SUBROUTINE TRIDIAG(KKA,KKU,KKL,PVARM,PA,PTSTEP,PEXPL,PIMPL, &
+ PRHODJ,PSOURCE,PVARP )
+! #################################################
+!
+!
+!!**** *TRIDIAG* - routine to solve a time implicit scheme
+!!
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to give a field PVARP at t+1, by
+! solving an implicit tridiagonal system obtained by the
+! discretization of the vertical turbulent diffusion. It should be noted
+! that the degree of implicitness can be varied (PIMPL parameter) and the
+! sources of evolution other than the turbulent diffusion can be taken
+! into account through the PSOURCE field. PVARP is localized at a mass
+! point.
+!
+!!** METHOD
+!! ------
+!! First, the Right Hand Side of the implicit equation is computed.
+!! It is build as follows:
+!! ZY = PVARM + PTSTEP*PSOURCE + DIFF_EXPLI
+!! where PVARM is the variable at t-dt, PSOURCE the supplementary sources of
+!! PVAR ( and not PVAR * PRHODJ !!) and DIFF_EXPLI is the explicit part
+!! of the vertical turbulent diffusion. This operator is spatially
+!! discretized as the implicit one, thus:
+!! DIFF_EXPLI(k) = - PEXPL / PRHODJ(k) *
+!! ( PA(k+1) * (PVARM(k+1) - PVARM(k) )
+!! -PA(k) * (PVARM(k) - PVARM(k-1)) )
+!! For the first level, only the upper part is considered, the lower one
+!! is replaced by the turbulent surface flux (taken into account in the
+!! PSOURCE(ikb) term).
+!! DIFF_EXPLI(ikb) = - PEXPL / PRHODJ(ikb) *
+!! ( PA(ikb+1) * (PVARM(ikb+1) - PVARM(ikb)) )
+!! For the last level, only the lower part is considered, the upper one
+!! is replaced by the turbulent flux which is taken equal to 0
+!! (taken into account in the PSOURCE(ike) term).
+!!
+!! DIFF_EXPLI(ike) = + PEXPL / PRHODJ(ike) *
+!! ( PA(ike) * (PVARM(ike) - PVARM(ike-1)) )
+!!
+!! Then, the classical tridiagonal algorithm is used to invert the
+!! implicit operator. Its matrix is given by:
+!!
+!! ( b(ikb) c(ikb) 0 0 0 0 0 0 )
+!! ( 0 a(ikb+1) b(ikb+1) c(ikb+1) 0 ... 0 0 0 )
+!! ( 0 0 a(ikb+2) b(ikb+2) c(ikb+2). 0 0 0 )
+!! .......................................................................
+!! ( 0 ... 0 a(k) b(k) c(k) 0 ... 0 0 )
+!! .......................................................................
+!! ( 0 0 0 0 0 ...a(ike-1) b(ike-1) c(ike-1))
+!! ( 0 0 0 0 0 ... 0 a(ike) b(ike) )
+!!
+!! ikb and ike represent the first and the last inner mass levels of the
+!! model. The coefficients are:
+!!
+!! a(k) = PIMPL * PA(k)/PRHODJ(k)
+!! b(k) = 1 - PIMPL * PA(k)/PRHODJ(k) - PIMPL * PA(k+1)/PRHODJ(k)
+!! c(k) = PIMPL * PA(k+1)/PRHODJ(k)
+!!
+!! for all k /= ikb or ike
+!!
+!! b(ikb) = 1 - PIMPL * PA(ikb+1)/PRHODJ(ikb)
+!! c(ikb) = PIMPL * PA(ikb+1)/PRHODJ(ikb)
+!! (discretization of the upper part of the implicit operator)
+!! b(ike) = 1 - PIMPL * PA(ike)/PRHODJ(ike)
+!! a(ike) = PIMPL * PA(ike)/PRHODJ(ike)
+!! (discretization of the lower part of the implicit operator)
+!! Finally, the marginal points are prescribed.
+!!
+!! All these computations are purely vertical and vectorizations are
+!! easely achieved by processing all the verticals in parallel.
+!!
+!! EXTERNAL
+!! --------
+!!
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! MODD_PARAMETERS
+!! JPVEXT_TURB: number of vertical external points
+!!
+!! REFERENCE
+!! ---------
+!! Book 1 of Meso-NH documentation (chapter Turbulence)
+!! Press et al: Numerical recipes (1986) Cambridge Univ. Press
+!!
+!! AUTHOR
+!! ------
+!! Joan Cuxart * INM and Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original August 29, 1994
+!! Modification : January 29, 1995 Algorithm written with two
+!! local variables less
+!! (Cuxart, Stein) August 21, 1995 Bug correction for PRHODJ
+!! (Stein) November 16, 1995 new version
+!! (Stein) February 28, 1995 no inversion in the explicit case
+!! (Seity) February 2012 add possibility to run with reversed
+!! vertical levels
+!! ---------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+USE MODD_PARAMETERS
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+INTEGER, INTENT(IN) :: KKA !near ground array index
+INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PVARM ! variable at t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! upper diag. elements
+REAL, INTENT(IN) :: PTSTEP ! Double time step
+REAL, INTENT(IN) :: PEXPL,PIMPL ! weights of the temporal scheme
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! (dry rho)*J
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSOURCE ! source term of PVAR
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PVARP ! variable at t+1
+!
+!* 0.2 declarations of local variables
+!
+REAL, DIMENSION(SIZE(PVARM,1),SIZE(PVARM,2),SIZE(PVARM,3)) :: ZY ,ZGAM
+ ! RHS of the equation, 3D work array
+REAL, DIMENSION(SIZE(PVARM,1),SIZE(PVARM,2)) :: ZBET
+ ! 2D work array
+INTEGER :: JK ! loop counter
+INTEGER :: IKB,IKE ! inner vertical limits
+INTEGER :: IKT ! array size in k direction
+INTEGER :: IKTB,IKTE ! start, end of k loops in physical domain
+
+!
+! ---------------------------------------------------------------------------
+!
+!* 1. COMPUTE THE RIGHT HAND SIDE
+! ---------------------------
+!
+IKTB=1+JPVEXT_TURB
+IKT=SIZE(PVARM,3)
+IKTE=IKT-JPVEXT_TURB
+IKB=KKA+JPVEXT_TURB*KKL
+IKE=KKU-JPVEXT_TURB*KKL
+!
+!
+ZY(:,:,IKB) = PVARM(:,:,IKB) + PTSTEP*PSOURCE(:,:,IKB) - &
+ PEXPL / PRHODJ(:,:,IKB) * PA(:,:,IKB+KKL) * (PVARM(:,:,IKB+KKL) - PVARM(:,:,IKB))
+!
+DO JK=IKTB+1,IKTE-1
+ ZY(:,:,JK)= PVARM(:,:,JK) + PTSTEP*PSOURCE(:,:,JK) - &
+ PEXPL / PRHODJ(:,:,JK) * &
+ ( PVARM(:,:,JK-KKL)*PA(:,:,JK) &
+ -PVARM(:,:,JK)*(PA(:,:,JK)+PA(:,:,JK+KKL)) &
+ +PVARM(:,:,JK+KKL)*PA(:,:,JK+KKL) &
+ )
+END DO
+!
+ZY(:,:,IKE)= PVARM(:,:,IKE) + PTSTEP*PSOURCE(:,:,IKE) + &
+ PEXPL / PRHODJ(:,:,IKE) * PA(:,:,IKE) * (PVARM(:,:,IKE)-PVARM(:,:,IKE-KKL))
+!
+!
+!* 2. INVERSION OF THE TRIDIAGONAL SYSTEM
+! -----------------------------------
+!
+IF ( PIMPL > 1.E-10 ) THEN
+!
+ !
+ ! going up
+ !
+ ZBET(:,:) = 1. - PIMPL * PA(:,:,IKB+KKL) / PRHODJ(:,:,IKB) ! bet = b(ikb)
+ PVARP(:,:,IKB) = ZY(:,:,IKB) / ZBET(:,:)
+ !
+ DO JK = IKB+KKL,IKE-KKL,KKL
+ ZGAM(:,:,JK) = PIMPL * PA(:,:,JK) / PRHODJ(:,:,JK-KKL) / ZBET(:,:)
+ ! gam(k) = c(k-1) / bet
+ ZBET(:,:) = 1. - PIMPL * ( PA(:,:,JK) * (1. + ZGAM(:,:,JK)) &
+ + PA(:,:,JK+KKL) &
+ ) / PRHODJ(:,:,JK)
+ ! bet = b(k) - a(k)* gam(k)
+ PVARP(:,:,JK)= ( ZY(:,:,JK) - PIMPL * PA(:,:,JK) / PRHODJ(:,:,JK) &
+ * PVARP(:,:,JK-KKL) &
+ ) / ZBET(:,:)
+ ! res(k) = (y(k) -a(k)*res(k-1))/ bet
+ END DO
+ ! special treatment for the last level
+ ZGAM(:,:,IKE) = PIMPL * PA(:,:,IKE) / PRHODJ(:,:,IKE-KKL) / ZBET(:,:)
+ ! gam(k) = c(k-1) / bet
+ ZBET(:,:) = 1. - PIMPL * ( PA(:,:,IKE) * (1. + ZGAM(:,:,IKE)) &
+ ) / PRHODJ(:,:,IKE)
+ ! bet = b(k) - a(k)* gam(k)
+ PVARP(:,:,IKE)= ( ZY(:,:,IKE) - PIMPL * PA(:,:,IKE) / PRHODJ(:,:,IKE) &
+ * PVARP(:,:,IKE-KKL) &
+ ) / ZBET(:,:)
+ ! res(k) = (y(k) -a(k)*res(k-1))/ bet
+ !
+ ! going down
+ !
+ DO JK = IKE-KKL,IKB,-1*KKL
+ PVARP(:,:,JK) = PVARP(:,:,JK) - ZGAM(:,:,JK+KKL) * PVARP(:,:,JK+KKL)
+ END DO
+!
+ELSE
+!
+ PVARP(:,:,IKTB:IKTE) = ZY(:,:,IKTB:IKTE)
+!
+END IF
+!
+!
+!* 3. FILL THE UPPER AND LOWER EXTERNAL VALUES
+! ----------------------------------------
+!
+PVARP(:,:,KKA)=PVARP(:,:,IKB)
+PVARP(:,:,KKU)=PVARP(:,:,IKE)
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE TRIDIAG
diff --git a/src/mesonh/turb/tridiag_massflux.f90 b/src/mesonh/turb/tridiag_massflux.f90
new file mode 100644
index 000000000..122fcf318
--- /dev/null
+++ b/src/mesonh/turb/tridiag_massflux.f90
@@ -0,0 +1,301 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+! ###################
+ MODULE MODI_TRIDIAG_MASSFLUX
+! ###################
+INTERFACE
+!
+ SUBROUTINE TRIDIAG_MASSFLUX(KKA,KKB,KKE,KKU,KKL,PVARM,PF,PDFDT,PTSTEP,PIMPL, &
+ PDZZ,PRHODJ,PVARP )
+!
+INTEGER, INTENT(IN) :: KKA ! near ground array index
+INTEGER, INTENT(IN) :: KKB ! near ground physical index
+INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
+INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:), INTENT(IN) :: PVARM ! variable at t-1 at mass point
+REAL, DIMENSION(:,:), INTENT(IN) :: PF ! flux in dT/dt=-dF/dz at flux point
+REAL, DIMENSION(:,:), INTENT(IN) :: PDFDT ! dF/dT at flux point
+REAL, INTENT(IN) :: PTSTEP ! Double time step
+REAL, INTENT(IN) :: PIMPL ! implicit weight
+REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! Dz at flux point
+REAL, DIMENSION(:,:), INTENT(IN) :: PRHODJ ! (dry rho)*J at mass point
+!
+REAL, DIMENSION(:,:), INTENT(OUT):: PVARP ! variable at t+1 at mass point
+!
+END SUBROUTINE TRIDIAG_MASSFLUX
+!
+END INTERFACE
+!
+END MODULE MODI_TRIDIAG_MASSFLUX
+
+
+! #################################################
+ SUBROUTINE TRIDIAG_MASSFLUX(KKA,KKB,KKE,KKU,KKL,PVARM,PF,PDFDT,PTSTEP,PIMPL, &
+ PDZZ,PRHODJ,PVARP )
+! #################################################
+!
+!
+!!**** *TRIDIAG_MASSFLUX* - routine to solve a time implicit scheme
+!!
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to give a field PVARP at t+1, by
+! solving an implicit TRIDIAGonal system obtained by the
+! discretization of the vertical turbulent diffusion. It should be noted
+! that the degree of implicitness can be varied (PIMPL parameter) and that
+! the function of F(T) must have been linearized.
+! PVARP is localized at a mass point.
+!
+!!** METHOD
+!! ------
+!!
+!! [T(+) - T(-)]/2Dt = -d{ F + dF/dT *impl*[T(+) + T(-)] }/dz
+!!
+!! It is discretized as follows:
+!!
+!! PRHODJ(k)*PVARP(k)/PTSTEP
+!! =
+!! PRHODJ(k)*PVARM(k)/PTSTEP
+!! - (PRHODJ(k+1)+PRHODJ(k) )/2. * PF(k+1)/PDZZ(k+1)
+!! + (PRHODJ(k) +PRHODJ(k-1))/2. * PF(k) /PDZZ(k)
+!! + (PRHODJ(k+1)+PRHODJ(k) )/2. * 0.5*PIMPL* PDFDT(k+1) * PVARM(k+1)/PDZZ(k+1)
+!! - (PRHODJ(k+1)+PRHODJ(k) )/2. * 0.5*PIMPL* PDFDT(k+1) * PVARP(k+1)/PDZZ(k+1)
+!! + (PRHODJ(k+1)+PRHODJ(k) )/2. * 0.5*PIMPL* PDFDT(k+1) * PVARM(k) /PDZZ(k+1)
+!! - (PRHODJ(k+1)+PRHODJ(k) )/2. * 0.5*PIMPL* PDFDT(k+1) * PVARP(k) /PDZZ(k+1)
+!! - (PRHODJ(k) +PRHODJ(k-1))/2. * 0.5*PIMPL* PDFDT(k) * PVARM(k) /PDZZ(k)
+!! + (PRHODJ(k) +PRHODJ(k-1))/2. * 0.5*PIMPL* PDFDT(k) * PVARP(k) /PDZZ(k)
+!! - (PRHODJ(k) +PRHODJ(k-1))/2. * 0.5*PIMPL* PDFDT(k) * PVARM(k-1)/PDZZ(k)
+!! + (PRHODJ(k) +PRHODJ(k-1))/2. * 0.5*PIMPL* PDFDT(k) * PVARP(k-1)/PDZZ(k)
+!!
+!!
+!! The system to solve is:
+!!
+!! A*PVARP(k-1) + B*PVARP(k) + C*PVARP(k+1) = Y(k)
+!!
+!!
+!! The RHS of the linear system in PVARP writes:
+!!
+!! y(k) = PRHODJ(k)*PVARM(k)/PTSTEP
+!! - (PRHODJ(k+1)+PRHODJ(k) )/2. * PF(k+1)/PDZZ(k+1)
+!! + (PRHODJ(k) +PRHODJ(k-1))/2. * PF(k) /PDZZ(k)
+!! + (PRHODJ(k+1)+PRHODJ(k) )/2. * 0.5*PIMPL* PDFDT(k+1) * PVARM(k+1)/PDZZ(k+1)
+!! + (PRHODJ(k+1)+PRHODJ(k) )/2. * 0.5*PIMPL* PDFDT(k+1) * PVARM(k) /PDZZ(k+1)
+!! - (PRHODJ(k) +PRHODJ(k-1))/2. * 0.5*PIMPL* PDFDT(k) * PVARM(k) /PDZZ(k)
+!! - (PRHODJ(k) +PRHODJ(k-1))/2. * 0.5*PIMPL* PDFDT(k) * PVARM(k-1)/PDZZ(k)
+!!
+!!
+!! Then, the classical TRIDIAGonal algorithm is used to invert the
+!! implicit operator. Its matrix is given by:
+!!
+!! ( b(KKB) c(KKB) 0 0 0 0 0 0 )
+!! ( a(KKB+1) b(KKB+1) c(KKB+1) 0 ... 0 0 0 0 )
+!! ( 0 a(KKB+2) b(KKB+2) c(KKB+2). 0 0 0 0 )
+!! .......................................................................
+!! ( 0 ... 0 a(k) b(k) c(k) 0 ... 0 0 )
+!! .......................................................................
+!! ( 0 0 0 0 0 ...a(KKE-1) b(KKE-1) c(KKE-1))
+!! ( 0 0 0 0 0 ... 0 a(KKE) b(KKE) )
+!!
+!! KKB and KKE represent the first and the last inner mass levels of the
+!! model. The coefficients are:
+!!
+!! a(k) = - (PRHODJ(k) +PRHODJ(k-1))/2. * 0.5*PIMPL* PDFDT(k) /PDZZ(k)
+!! b(k) = PRHODJ(k) / PTSTEP
+!! + (PRHODJ(k+1)+PRHODJ(k) )/2. * 0.5*PIMPL* PDFDT(k+1)/PDZZ(k+1)
+!! - (PRHODJ(k) +PRHODJ(k-1))/2. * 0.5*PIMPL* PDFDT(k) /PDZZ(k)
+!! c(k) = + (PRHODJ(k+1)+PRHODJ(k) )/2. * 0.5*PIMPL* PDFDT(k+1)/PDZZ(k+1)
+!!
+!! for all k /= KKB or KKE
+!!
+!!
+!! b(KKB) = PRHODJ(KKB) / PTSTEP
+!! +(PRHODJ(KKB+1)+PRHODJ(KKB))/2.*0.5*PIMPL*PDFDT(KKB+1)/PDZZ(KKB+1)
+!! c(KKB) = +(PRHODJ(KKB+1)+PRHODJ(KKB))/2.*0.5*PIMPL*PDFDT(KKB+1)/PDZZ(KKB+1)
+!!
+!! b(KKE) = PRHODJ(KKE) / PTSTEP
+!! -(PRHODJ(KKE)+PRHODJ(KKE-1))/2.*0.5*PIMPL*PDFDT(KKE)/PDZZ(KKE)
+!! a(KKE) = -(PRHODJ(KKE)+PRHODJ(KKE-1))/2.*0.5*PIMPL*PDFDT(KKE)/PDZZ(KKE)
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!! Press et al: Numerical recipes (1986) Cambridge Univ. Press
+!!
+!! AUTHOR
+!! ------
+!! V. Masson and S. Malardel * Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 07/2006
+!! V.Masson : Optimization
+!! S. Riette Jan 2012: support for both order of vertical levels
+!! ---------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+USE MODD_PARAMETERS, ONLY: JPVEXT
+USE MODI_SHUMAN_MF
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+INTEGER, INTENT(IN) :: KKA ! near ground array index
+INTEGER, INTENT(IN) :: KKB ! near ground physical index
+INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
+INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:), INTENT(IN) :: PVARM ! variable at t-1 at mass point
+REAL, DIMENSION(:,:), INTENT(IN) :: PF ! flux in dT/dt=-dF/dz at flux point
+REAL, DIMENSION(:,:), INTENT(IN) :: PDFDT ! dF/dT at flux point
+REAL, INTENT(IN) :: PTSTEP ! Double time step
+REAL, INTENT(IN) :: PIMPL ! implicit weight
+REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! Dz at flux point
+REAL, DIMENSION(:,:), INTENT(IN) :: PRHODJ ! (dry rho)*J at mass point
+!
+REAL, DIMENSION(:,:), INTENT(OUT):: PVARP ! variable at t+1 at mass point
+!
+!
+!* 0.2 declarations of local variables
+!
+REAL, DIMENSION(SIZE(PVARM,1),SIZE(PVARM,2)) :: ZRHODJ_DFDT_O_DZ
+REAL, DIMENSION(SIZE(PVARM,1),SIZE(PVARM,2)) :: ZMZM_RHODJ
+REAL, DIMENSION(SIZE(PVARM,1),SIZE(PVARM,2)) :: ZA, ZB, ZC
+REAL, DIMENSION(SIZE(PVARM,1),SIZE(PVARM,2)) :: ZY ,ZGAM
+ ! RHS of the equation, 3D work array
+REAL, DIMENSION(SIZE(PVARM,1)) :: ZBET
+ ! 2D work array
+INTEGER :: JK ! loop counter
+!
+! ---------------------------------------------------------------------------
+!
+!* 1. Preliminaries
+! -------------
+!
+ZMZM_RHODJ = MZM_MF(KKA,KKU,KKL,PRHODJ)
+ZRHODJ_DFDT_O_DZ = ZMZM_RHODJ*PDFDT/PDZZ
+!
+ZA=0.
+ZB=0.
+ZC=0.
+ZY=0.
+!
+!
+!* 2. COMPUTE THE RIGHT HAND SIDE
+! ---------------------------
+!
+ZY(:,KKB) = PRHODJ(:,KKB)*PVARM(:,KKB)/PTSTEP &
+ - ZMZM_RHODJ(:,KKB+KKL) * PF(:,KKB+KKL)/PDZZ(:,KKB+KKL) &
+ + ZMZM_RHODJ(:,KKB ) * PF(:,KKB )/PDZZ(:,KKB ) &
+ + ZRHODJ_DFDT_O_DZ(:,KKB+KKL) * 0.5*PIMPL * PVARM(:,KKB+KKL) &
+ + ZRHODJ_DFDT_O_DZ(:,KKB+KKL) * 0.5*PIMPL * PVARM(:,KKB )
+!
+DO JK=2+JPVEXT,SIZE(ZY,2)-JPVEXT-1
+ ZY(:,JK) = PRHODJ(:,JK)*PVARM(:,JK)/PTSTEP &
+ - ZMZM_RHODJ(:,JK+KKL) * PF(:,JK+KKL)/PDZZ(:,JK+KKL) &
+ + ZMZM_RHODJ(:,JK ) * PF(:,JK )/PDZZ(:,JK ) &
+ + ZRHODJ_DFDT_O_DZ(:,JK+KKL) * 0.5*PIMPL * PVARM(:,JK+KKL) &
+ + ZRHODJ_DFDT_O_DZ(:,JK+KKL) * 0.5*PIMPL * PVARM(:,JK ) &
+ - ZRHODJ_DFDT_O_DZ(:,JK ) * 0.5*PIMPL * PVARM(:,JK ) &
+ - ZRHODJ_DFDT_O_DZ(:,JK ) * 0.5*PIMPL * PVARM(:,JK-KKL)
+END DO
+!
+IF (JPVEXT==0) THEN
+ ZY(:,KKE) = PRHODJ(:,KKE)*PVARM(:,KKE)/PTSTEP
+ELSE
+ ZY(:,KKE) = PRHODJ(:,KKE)*PVARM(:,KKE)/PTSTEP &
+ - ZMZM_RHODJ(:,KKE+KKL) * PF(:,KKE+KKL)/PDZZ(:,KKE+KKL) &
+ + ZMZM_RHODJ(:,KKE ) * PF(:,KKE )/PDZZ(:,KKE ) &
+ - ZRHODJ_DFDT_O_DZ(:,KKE ) * 0.5*PIMPL * PVARM(:,KKE ) &
+ - ZRHODJ_DFDT_O_DZ(:,KKE ) * 0.5*PIMPL * PVARM(:,KKE-KKL)
+ENDIF
+!
+!
+!* 3. INVERSION OF THE TRIDIAGONAL SYSTEM
+! -----------------------------------
+!
+IF ( PIMPL > 1.E-10 ) THEN
+!
+!* 3.1 arrays A, B, C
+! --------------
+!
+ ZB(:,KKB) = PRHODJ(:,KKB)/PTSTEP &
+ + ZRHODJ_DFDT_O_DZ(:,KKB+KKL) * 0.5*PIMPL
+ ZC(:,KKB) = ZRHODJ_DFDT_O_DZ(:,KKB+KKL) * 0.5*PIMPL
+
+ DO JK=2+JPVEXT,SIZE(ZY,2)-JPVEXT-1
+ ZA(:,JK) = - ZRHODJ_DFDT_O_DZ(:,JK ) * 0.5*PIMPL
+ ZB(:,JK) = PRHODJ(:,JK)/PTSTEP &
+ + ZRHODJ_DFDT_O_DZ(:,JK+KKL) * 0.5*PIMPL &
+ - ZRHODJ_DFDT_O_DZ(:,JK ) * 0.5*PIMPL
+ ZC(:,JK) = ZRHODJ_DFDT_O_DZ(:,JK+KKL) * 0.5*PIMPL
+ END DO
+
+ ZA(:,KKE) = - ZRHODJ_DFDT_O_DZ(:,KKE ) * 0.5*PIMPL
+ ZB(:,KKE) = PRHODJ(:,KKE)/PTSTEP &
+ - ZRHODJ_DFDT_O_DZ(:,KKE ) * 0.5*PIMPL
+!
+!* 3.2 going up
+! --------
+!
+ ZBET(:) = ZB(:,KKB) ! bet = b(KKB)
+ PVARP(:,KKB) = ZY(:,KKB) / ZBET(:)
+
+ !
+ DO JK = KKB+KKL,KKE-KKL,KKL
+ ZGAM(:,JK) = ZC(:,JK-KKL) / ZBET(:)
+ ! gam(k) = c(k-1) / bet
+ ZBET(:) = ZB(:,JK) - ZA(:,JK) * ZGAM(:,JK)
+ ! bet = b(k) - a(k)* gam(k)
+ PVARP(:,JK)= ( ZY(:,JK) - ZA(:,JK) * PVARP(:,JK-KKL) ) / ZBET(:)
+ ! res(k) = (y(k) -a(k)*res(k-1))/ bet
+ END DO
+ ! special treatment for the last level
+ ZGAM(:,KKE) = ZC(:,KKE-KKL) / ZBET(:)
+ ! gam(k) = c(k-1) / bet
+ ZBET(:) = ZB(:,KKE) - ZA(:,KKE) * ZGAM(:,KKE)
+ ! bet = b(k) - a(k)* gam(k)
+ PVARP(:,KKE)= ( ZY(:,KKE) - ZA(:,KKE) * PVARP(:,KKE-KKL) ) / ZBET(:)
+ ! res(k) = (y(k) -a(k)*res(k-1))/ bet
+!
+!* 3.3 going down
+! ----------
+!
+ DO JK = KKE-KKL,KKB,-KKL
+ PVARP(:,JK) = PVARP(:,JK) - ZGAM(:,JK+KKL) * PVARP(:,JK+KKL)
+ END DO
+!
+!
+ELSE
+ !!! EXPLICIT FORMULATION
+ !
+ DO JK=1+JPVEXT,SIZE(PVARP,2)-JPVEXT
+ PVARP(:,JK) = ZY(:,JK) * PTSTEP / PRHODJ(:,JK)
+ ENDDO
+ !
+END IF
+!
+!
+!* 4. FILL THE UPPER AND LOWER EXTERNAL VALUES
+! ----------------------------------------
+!
+PVARP(:,KKA)=PVARP(:,KKB)
+PVARP(:,KKU)=PVARP(:,KKE)
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE TRIDIAG_MASSFLUX
diff --git a/src/mesonh/turb/tridiag_thermo.f90 b/src/mesonh/turb/tridiag_thermo.f90
new file mode 100644
index 000000000..2a02b6346
--- /dev/null
+++ b/src/mesonh/turb/tridiag_thermo.f90
@@ -0,0 +1,297 @@
+!MNH_LIC Copyright 2003-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ###################
+ MODULE MODI_TRIDIAG_THERMO
+! ###################
+INTERFACE
+!
+ SUBROUTINE TRIDIAG_THERMO(KKA,KKU,KKL,PVARM,PF,PDFDDTDZ,PTSTEP,PIMPL, &
+ PDZZ,PRHODJ,PVARP )
+!
+INTEGER, INTENT(IN) :: KKA !near ground array index
+INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=AR
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PVARM ! variable at t-1 at mass point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PF ! flux in dT/dt=-dF/dz at flux point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDFDDTDZ! dF/d(dT/dz) at flux point
+REAL, INTENT(IN) :: PTSTEP ! Double time step
+REAL, INTENT(IN) :: PIMPL ! implicit weight
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Dz at flux point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! (dry rho)*J at mass point
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT):: PVARP ! variable at t+1 at mass point
+!
+END SUBROUTINE TRIDIAG_THERMO
+!
+END INTERFACE
+!
+END MODULE MODI_TRIDIAG_THERMO
+!
+!
+!
+
+! #################################################
+ SUBROUTINE TRIDIAG_THERMO(KKA,KKU,KKL,PVARM,PF,PDFDDTDZ,PTSTEP,PIMPL, &
+ PDZZ,PRHODJ,PVARP )
+! #################################################
+!
+!
+!!**** *TRIDIAG_THERMO* - routine to solve a time implicit scheme
+!!
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to give a field PVARP at t+1, by
+! solving an implicit TRIDIAGonal system obtained by the
+! discretization of the vertical turbulent diffusion. It should be noted
+! that the degree of implicitness can be varied (PIMPL parameter) and that
+! the function of F(dT/dz) must have been linearized.
+! PVARP is localized at a mass point.
+!
+!!** METHOD
+!! ------
+!!
+!! [T(+) - T(-)]/2Dt = -d{ F + dF/d(dT/dz) * [impl*dT/dz(+) + expl* dT/dz(-)] }/dz
+!!
+!! It is discretized as follows:
+!!
+!! PRHODJ(k)*PVARP(k)/PTSTEP
+!! =
+!! PRHODJ(k)*PVARM(k)/PTSTEP
+!! - (PRHODJ(k+1)+PRHODJ(k) )/2. * PF(k+1)/PDZZ(k+1)
+!! + (PRHODJ(k) +PRHODJ(k-1))/2. * PF(k) /PDZZ(k)
+!! + (PRHODJ(k+1)+PRHODJ(k) )/2. * ZEXPL* PDFDDTDZ(k+1) * PVARM(k+1)/PDZZ(k+1)**2
+!! - (PRHODJ(k+1)+PRHODJ(k) )/2. * PIMPL* PDFDDTDZ(k+1) * PVARP(k+1)/PDZZ(k+1)**2
+!! - (PRHODJ(k+1)+PRHODJ(k) )/2. * ZEXPL* PDFDDTDZ(k+1) * PVARM(k) /PDZZ(k+1)**2
+!! + (PRHODJ(k+1)+PRHODJ(k) )/2. * PIMPL* PDFDDTDZ(k+1) * PVARP(k) /PDZZ(k+1)**2
+!! - (PRHODJ(k) +PRHODJ(k-1))/2. * ZEXPL* PDFDDTDZ(k) * PVARM(k) /PDZZ(k)**2
+!! + (PRHODJ(k) +PRHODJ(k-1))/2. * PIMPL* PDFDDTDZ(k) * PVARP(k) /PDZZ(k)**2
+!! + (PRHODJ(k) +PRHODJ(k-1))/2. * ZEXPL* PDFDDTDZ(k) * PVARM(k-1)/PDZZ(k)**2
+!! - (PRHODJ(k) +PRHODJ(k-1))/2. * PIMPL* PDFDDTDZ(k) * PVARP(k-1)/PDZZ(k)**2
+!!
+!!
+!! The system to solve is:
+!!
+!! A*PVARP(k-1) + B*PVARP(k) + C*PVARP(k+1) = Y(k)
+!!
+!!
+!! The RHS of the linear system in PVARP writes:
+!!
+!! y(k) = PRHODJ(k)*PVARM(k)/PTSTEP
+!! - (PRHODJ(k+1)+PRHODJ(k) )/2. * PF(k+1)/PDZZ(k+1)
+!! + (PRHODJ(k) +PRHODJ(k-1))/2. * PF(k) /PDZZ(k)
+!! + (PRHODJ(k+1)+PRHODJ(k) )/2. * ZEXPL* PDFDDTDZ(k+1) * PVARM(k+1)/PDZZ(k+1)**2
+!! - (PRHODJ(k+1)+PRHODJ(k) )/2. * ZEXPL* PDFDDTDZ(k+1) * PVARM(k) /PDZZ(k+1)**2
+!! - (PRHODJ(k) +PRHODJ(k-1))/2. * ZEXPL* PDFDDTDZ(k) * PVARM(k) /PDZZ(k)**2
+!! + (PRHODJ(k) +PRHODJ(k-1))/2. * ZEXPL* PDFDDTDZ(k) * PVARM(k-1)/PDZZ(k)**2
+!!
+!!
+!! Then, the classical TRIDIAGonal algorithm is used to invert the
+!! implicit operator. Its matrix is given by:
+!!
+!! ( b(ikb) c(ikb) 0 0 0 0 0 0 )
+!! ( 0 a(ikb+1) b(ikb+1) c(ikb+1) 0 ... 0 0 0 )
+!! ( 0 0 a(ikb+2) b(ikb+2) c(ikb+2). 0 0 0 )
+!! .......................................................................
+!! ( 0 ... 0 a(k) b(k) c(k) 0 ... 0 0 )
+!! .......................................................................
+!! ( 0 0 0 0 0 ...a(ike-1) b(ike-1) c(ike-1))
+!! ( 0 0 0 0 0 ... 0 a(ike) b(ike) )
+!!
+!! ikb and ike represent the first and the last inner mass levels of the
+!! model. The coefficients are:
+!!
+!! a(k) = + (PRHODJ(k) +PRHODJ(k-1))/2. * PIMPL* PDFDDTDZ(k) /PDZZ(k)**2
+!! b(k) = PRHODJ(k) / PTSTEP
+!! - (PRHODJ(k+1)+PRHODJ(k) )/2. * PIMPL* PDFDDTDZ(k+1)/PDZZ(k+1)**2
+!! - (PRHODJ(k) +PRHODJ(k-1))/2. * PIMPL* PDFDDTDZ(k) /PDZZ(k)**2
+!! c(k) = + (PRHODJ(k+1)+PRHODJ(k) )/2. * PIMPL* PDFDDTDZ(k+1)/PDZZ(k+1)**2
+!!
+!! for all k /= ikb or ike
+!!
+!!
+!! b(ikb) = PRHODJ(ikb) / PTSTEP
+!! -(PRHODJ(ikb+1)+PRHODJ(ikb))/2.*PIMPL*PDFDDTDZ(ikb+1)/PDZZ(ikb+1)**2
+!! c(ikb) = +(PRHODJ(ikb+1)+PRHODJ(ikb))/2.*PIMPL*PDFDDTDZ(ikb+1)/PDZZ(ikb+1)**2
+!!
+!! b(ike) = PRHODJ(ike) / PTSTEP
+!! -(PRHODJ(ike)+PRHODJ(ike-1))/2.*PIMPL*PDFDDTDZ(ike)/PDZZ(ike)**2
+!! a(ike) = +(PRHODJ(ike)+PRHODJ(ike-1))/2.*PIMPL*PDFDDTDZ(ike)/PDZZ(ike)**2
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!! Press et al: Numerical recipes (1986) Cambridge Univ. Press
+!!
+!! AUTHOR
+!! ------
+!! V. Masson * Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 04/2003 (from tridiag.f90)
+!! ---------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+USE MODD_PARAMETERS, ONLY : JPVEXT_TURB
+!
+USE MODI_SHUMAN
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+INTEGER, INTENT(IN) :: KKA !near ground array index
+INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PVARM ! variable at t-1 at mass point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PF ! flux in dT/dt=-dF/dz at flux point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDFDDTDZ! dF/d(dT/dz) at flux point
+REAL, INTENT(IN) :: PTSTEP ! Double time step
+REAL, INTENT(IN) :: PIMPL ! implicit weight
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Dz at flux point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! (dry rho)*J at mass point
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT):: PVARP ! variable at t+1 at mass point
+!
+!
+!* 0.2 declarations of local variables
+!
+REAL, DIMENSION(SIZE(PVARM,1),SIZE(PVARM,2),SIZE(PVARM,3)) :: ZRHODJ_DFDDTDZ_O_DZ2
+REAL, DIMENSION(SIZE(PVARM,1),SIZE(PVARM,2),SIZE(PVARM,3)) :: ZMZM_RHODJ
+REAL, DIMENSION(SIZE(PVARM,1),SIZE(PVARM,2),SIZE(PVARM,3)) :: ZA, ZB, ZC
+REAL, DIMENSION(SIZE(PVARM,1),SIZE(PVARM,2),SIZE(PVARM,3)) :: ZY ,ZGAM
+ ! RHS of the equation, 3D work array
+REAL, DIMENSION(SIZE(PVARM,1),SIZE(PVARM,2)) :: ZBET
+ ! 2D work array
+INTEGER :: JK ! loop counter
+INTEGER :: IKB,IKE ! inner vertical limits
+INTEGER :: IKT ! array size in k direction
+INTEGER :: IKTB,IKTE ! start, end of k loops in physical domain
+!
+! ---------------------------------------------------------------------------
+!
+!* 1. Preliminaries
+! -------------
+!
+IKT=SIZE(PVARM,3)
+IKTB=1+JPVEXT_TURB
+IKTE=IKT-JPVEXT_TURB
+IKB=KKA+JPVEXT_TURB*KKL
+IKE=KKU-JPVEXT_TURB*KKL
+
+!
+ZMZM_RHODJ = MZM(PRHODJ)
+ZRHODJ_DFDDTDZ_O_DZ2 = ZMZM_RHODJ*PDFDDTDZ/PDZZ**2
+!
+ZA=0.
+ZB=0.
+ZC=0.
+ZY=0.
+!
+!
+!* 2. COMPUTE THE RIGHT HAND SIDE
+! ---------------------------
+!
+ZY(:,:,IKB) = PRHODJ(:,:,IKB)*PVARM(:,:,IKB)/PTSTEP &
+ - ZMZM_RHODJ(:,:,IKB+KKL) * PF(:,:,IKB+KKL)/PDZZ(:,:,IKB+KKL) &
+ + ZMZM_RHODJ(:,:,IKB ) * PF(:,:,IKB )/PDZZ(:,:,IKB ) &
+ + ZRHODJ_DFDDTDZ_O_DZ2(:,:,IKB+KKL) * PIMPL * PVARM(:,:,IKB+KKL) &
+ - ZRHODJ_DFDDTDZ_O_DZ2(:,:,IKB+KKL) * PIMPL * PVARM(:,:,IKB )
+!
+ ZY(:,:,IKTB+1:IKTE-1) = PRHODJ(:,:,IKTB+1:IKTE-1)*PVARM(:,:,IKTB+1:IKTE-1)/PTSTEP &
+ - ZMZM_RHODJ(:,:,IKTB+1+KKL:IKTE-1+KKL) * PF(:,:,IKTB+1+KKL:IKTE-1+KKL)/PDZZ(:,:,IKTB+1+KKL:IKTE-1+KKL) &
+ + ZMZM_RHODJ(:,:,IKTB+1:IKTE-1 ) * PF(:,:,IKTB+1:IKTE-1 )/PDZZ(:,:,IKTB+1:IKTE-1 ) &
+ + ZRHODJ_DFDDTDZ_O_DZ2(:,:,IKTB+1+KKL:IKTE-1+KKL) * PIMPL * PVARM(:,:,IKTB+1+KKL:IKTE-1+KKL) &
+ - ZRHODJ_DFDDTDZ_O_DZ2(:,:,IKTB+1+KKL:IKTE-1+KKL) * PIMPL * PVARM(:,:,IKTB+1:IKTE-1 ) &
+ - ZRHODJ_DFDDTDZ_O_DZ2(:,:,IKTB+1:IKTE-1 ) * PIMPL * PVARM(:,:,IKTB+1:IKTE-1 ) &
+ + ZRHODJ_DFDDTDZ_O_DZ2(:,:,IKTB+1:IKTE-1 ) * PIMPL * PVARM(:,:,IKTB+1-KKL:IKTE-1-KKL)
+!
+ZY(:,:,IKE) = PRHODJ(:,:,IKE)*PVARM(:,:,IKE)/PTSTEP &
+ - ZMZM_RHODJ(:,:,IKE+KKL) * PF(:,:,IKE+KKL)/PDZZ(:,:,IKE+KKL) &
+ + ZMZM_RHODJ(:,:,IKE ) * PF(:,:,IKE )/PDZZ(:,:,IKE ) &
+ - ZRHODJ_DFDDTDZ_O_DZ2(:,:,IKE ) * PIMPL * PVARM(:,:,IKE ) &
+ + ZRHODJ_DFDDTDZ_O_DZ2(:,:,IKE ) * PIMPL * PVARM(:,:,IKE-KKL)
+!
+!
+!* 3. INVERSION OF THE TRIDIAGONAL SYSTEM
+! -----------------------------------
+!
+IF ( PIMPL > 1.E-10 ) THEN
+!
+!* 3.1 arrays A, B, C
+! --------------
+!
+ ZB(:,:,IKB) = PRHODJ(:,:,IKB)/PTSTEP &
+ - ZRHODJ_DFDDTDZ_O_DZ2(:,:,IKB+KKL) * PIMPL
+ ZC(:,:,IKB) = ZRHODJ_DFDDTDZ_O_DZ2(:,:,IKB+KKL) * PIMPL
+!
+ ZA(:,:,IKTB+1:IKTE-1) = ZRHODJ_DFDDTDZ_O_DZ2(:,:,IKTB+1:IKTE-1) * PIMPL
+ ZB(:,:,IKTB+1:IKTE-1) = PRHODJ(:,:,IKTB+1:IKTE-1)/PTSTEP &
+ - ZRHODJ_DFDDTDZ_O_DZ2(:,:,IKTB+1+KKL:IKTE-1+KKL) * PIMPL &
+ - ZRHODJ_DFDDTDZ_O_DZ2(:,:,IKTB+1:IKTE-1) * PIMPL
+ ZC(:,:,IKTB+1:IKTE-1) = ZRHODJ_DFDDTDZ_O_DZ2(:,:,IKTB+1+KKL:IKTE-1+KKL) * PIMPL
+!
+ ZA(:,:,IKE) = ZRHODJ_DFDDTDZ_O_DZ2(:,:,IKE ) * PIMPL
+ ZB(:,:,IKE) = PRHODJ(:,:,IKE)/PTSTEP &
+ - ZRHODJ_DFDDTDZ_O_DZ2(:,:,IKE ) * PIMPL
+!
+!* 3.2 going up
+! --------
+!
+ ZBET(:,:) = ZB(:,:,IKB) ! bet = b(ikb)
+ PVARP(:,:,IKB) = ZY(:,:,IKB) / ZBET(:,:)
+
+ !
+ DO JK = IKB+KKL,IKE-KKL,KKL
+ ZGAM(:,:,JK) = ZC(:,:,JK-KKL) / ZBET(:,:)
+ ! gam(k) = c(k-1) / bet
+ ZBET(:,:) = ZB(:,:,JK) - ZA(:,:,JK) * ZGAM(:,:,JK)
+ ! bet = b(k) - a(k)* gam(k)
+ PVARP(:,:,JK)= ( ZY(:,:,JK) - ZA(:,:,JK) * PVARP(:,:,JK-KKL) ) / ZBET(:,:)
+ ! res(k) = (y(k) -a(k)*res(k-1))/ bet
+ END DO
+ ! special treatment for the last level
+ ZGAM(:,:,IKE) = ZC(:,:,IKE-KKL) / ZBET(:,:)
+ ! gam(k) = c(k-1) / bet
+ ZBET(:,:) = ZB(:,:,IKE) - ZA(:,:,IKE) * ZGAM(:,:,IKE)
+ ! bet = b(k) - a(k)* gam(k)
+ PVARP(:,:,IKE)= ( ZY(:,:,IKE) - ZA(:,:,IKE) * PVARP(:,:,IKE-KKL) ) / ZBET(:,:)
+ ! res(k) = (y(k) -a(k)*res(k-1))/ bet
+!
+!* 3.3 going down
+! ----------
+!
+ DO JK = IKE-KKL,IKB,-1*KKL
+ PVARP(:,:,JK) = PVARP(:,:,JK) - ZGAM(:,:,JK+KKL) * PVARP(:,:,JK+KKL)
+ END DO
+!
+ELSE
+!
+ PVARP(:,:,IKTB:IKTE) = ZY(:,:,IKTB:IKTE) * PTSTEP / PRHODJ(:,:,IKTB:IKTE)
+!
+END IF
+!
+!
+!* 4. FILL THE UPPER AND LOWER EXTERNAL VALUES
+! ----------------------------------------
+!
+PVARP(:,:,KKA)=PVARP(:,:,IKB)
+PVARP(:,:,KKU)=PVARP(:,:,IKE)
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE TRIDIAG_THERMO
diff --git a/src/mesonh/turb/tridiag_tke.f90 b/src/mesonh/turb/tridiag_tke.f90
new file mode 100644
index 000000000..170f83f6c
--- /dev/null
+++ b/src/mesonh/turb/tridiag_tke.f90
@@ -0,0 +1,266 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 turb 2006/06/06 10:00:49
+!-----------------------------------------------------------------
+! ##########################
+ MODULE MODI_TRIDIAG_TKE
+! ##########################
+INTERFACE
+!
+ SUBROUTINE TRIDIAG_TKE(KKA,KKU,KKL,PVARM,PA,PTSTEP,PEXPL,PIMPL, &
+ PRHODJ,PSOURCE,PDIAG,PVARP )
+!
+INTEGER, INTENT(IN) :: KKA !near ground array index
+INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PVARM ! variable at t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! upper diag. elements
+REAL, INTENT(IN) :: PTSTEP ! Double time step
+REAL, INTENT(IN) :: PEXPL,PIMPL ! weights of the temporal scheme
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! (dry rho)*J
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSOURCE ! source term of PVAR
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDIAG ! diagonal term linked to
+ ! the implicit dissipation
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PVARP ! variable at t+1
+!
+END SUBROUTINE TRIDIAG_TKE
+!
+END INTERFACE
+!
+END MODULE MODI_TRIDIAG_TKE
+!
+!
+!
+! ########################################################
+ SUBROUTINE TRIDIAG_TKE(KKA,KKU,KKL,PVARM,PA,PTSTEP,PEXPL,PIMPL, &
+ PRHODJ,PSOURCE,PDIAG,PVARP )
+! ########################################################
+!
+!
+!!**** *TRIDIAG_TKE* - routine to solve a time implicit scheme
+!!
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to give a field PVARP at t+1, by
+! solving an implicit tridiagonal system obtained by the
+! discretization of the vertical turbulent diffusion. It should be noted
+! that the degree of implicitness can be varied (PIMPL parameter) and the
+! sources of evolution other than the turbulent diffusion can be taken
+! into account through the PSOURCE field. PVARP is localized at a mass
+! point.
+!
+!!** METHOD
+!! ------
+!! First, the Right Hand Side of the implicit equation is computed.
+!! It is build as follows:
+!! ZY = PVARM + PTSTEP*PSOURCE + DIFF_EXPLI
+!! where PVARM is the variable at t-dt, PSOURCE the supplementary sources of
+!! PVAR ( and not PVAR * PRHODJ !!) and DIFF_EXPLI is the explicit part
+!! of the vertical turbulent diffusion. This operator is spatially
+!! discretized as the implicit one, thus:
+!! DIFF_EXPLI(k) = - PEXPL / PRHODJ(k) *
+!! ( PA(k+1) * (PVARM(k+1) - PVARM(k) )
+!! -PA(k) * (PVARM(k) - PVARM(k-1)) )
+!! For the first level, only the upper part is considered, the lower one
+!! is replaced by the turbulent surface flux (taken into account in the
+!! PSOURCE(ikb) term).
+!! DIFF_EXPLI(ikb) = - PEXPL / PRHODJ(ikb) *
+!! ( PA(ikb+1) * (PVARM(ikb+1) - PVARM(ikb)) )
+!! For the last level, only the lower part is considered, the upper one
+!! is replaced by the turbulent flux which is taken equal to 0
+!! (taken into account in the PSOURCE(ike) term).
+!!
+!! DIFF_EXPLI(ike) = + PEXPL / PRHODJ(ike) *
+!! ( PA(ike) * (PVARM(ike) - PVARM(ike-1)) )
+!!
+!! Then, the classical tridiagonal algorithm is used to invert the
+!! implicit operator. Its matrix is given by:
+!!
+!! ( b(ikb) c(ikb) 0 0 0 0 0 0 )
+!! ( 0 a(ikb+1) b(ikb+1) c(ikb+1) 0 ... 0 0 0 )
+!! ( 0 0 a(ikb+2) b(ikb+2) c(ikb+2). 0 0 0 )
+!! .......................................................................
+!! ( 0 ... 0 a(k) b(k) c(k) 0 ... 0 0 )
+!! .......................................................................
+!! ( 0 0 0 0 0 ...a(ike-1) b(ike-1) c(ike-1))
+!! ( 0 0 0 0 0 ... 0 a(ike) b(ike) )
+!!
+!! ikb and ike represent the first and the last inner mass levels of the
+!! model. The coefficients are:
+!!
+!! a(k) = PIMPL * PA(k)/PRHODJ(k)
+!! b(k) = 1 - PIMPL * PA(k)/PRHODJ(k) - PIMPL * PA(k+1)/PRHODJ(k)
+!! c(k) = PIMPL * PA(k+1)/PRHODJ(k)
+!!
+!! for all k /= ikb or ike
+!!
+!! b(ikb) = 1 - PIMPL * PA(ikb+1)/PRHODJ(ikb)
+!! c(ikb) = PIMPL * PA(ikb+1)/PRHODJ(ikb)
+!! (discretization of the upper part of the implicit operator)
+!! b(ike) = 1 - PIMPL * PA(ike)/PRHODJ(ike)
+!! a(ike) = PIMPL * PA(ike)/PRHODJ(ike)
+!! (discretization of the lower part of the implicit operator)
+!! Finally, the marginal points are prescribed.
+!!
+!! All these computations are purely vertical and vectorizations are
+!! easely achieved by processing all the verticals in parallel.
+!!
+!! EXTERNAL
+!! --------
+!!
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! MODD_PARAMETERS
+!! JPVEXT_TURB: number of vertical external points
+!!
+!! REFERENCE
+!! ---------
+!! Book 1 of Meso-NH documentation (chapter Turbulence)
+!! Press et al: Numerical recipes (1986) Cambridge Univ. Press
+!!
+!! AUTHOR
+!! ------
+!! Joan Cuxart * INM and Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original August 29, 1994
+!! Modification : January 29, 1995 Algorithm written with two
+!! local variables less
+!! (Cuxart, Stein) August 21, 1995 Bug correction for PRHODJ
+!! (Stein) November 16, 1995 new version
+!! (Stein) February 28, 1995 no inversion in the explicit case
+!! ---------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+USE MODD_PARAMETERS
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+INTEGER, INTENT(IN) :: KKA !near ground array index
+INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PVARM ! variable at t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! upper diag. elements
+REAL, INTENT(IN) :: PTSTEP ! Double time step
+REAL, INTENT(IN) :: PEXPL,PIMPL ! weights of the temporal scheme
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! (dry rho)*J
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSOURCE ! source term of PVAR
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDIAG ! diagonal term linked to
+ ! the implicit dissipation
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PVARP ! variable at t+1
+!
+!* 0.2 declarations of local variables
+!
+REAL, DIMENSION(SIZE(PVARM,1),SIZE(PVARM,2),SIZE(PVARM,3)) :: ZY ,ZGAM
+ ! RHS of the equation, 3D work array
+REAL, DIMENSION(SIZE(PVARM,1),SIZE(PVARM,2)) :: ZBET
+ ! 2D work array
+INTEGER :: JK ! loop counter
+INTEGER :: IKB,IKE ! inner vertical limits
+INTEGER :: IKT ! array size in k direction
+INTEGER :: IKTB,IKTE ! start, end of k loops in physical domain
+!
+! ---------------------------------------------------------------------------
+!
+!* 1. COMPUTE THE RIGHT HAND SIDE
+! ---------------------------
+!
+IKT=SIZE(PVARM,3)
+IKTB=1+JPVEXT_TURB
+IKTE=IKT-JPVEXT_TURB
+IKB=KKA+JPVEXT_TURB*KKL
+IKE=KKU-JPVEXT_TURB*KKL
+
+!
+!
+ZY(:,:,IKB) = PVARM(:,:,IKB) + PTSTEP*PSOURCE(:,:,IKB) - &
+ PEXPL / PRHODJ(:,:,IKB) * PA(:,:,IKB+KKL) * (PVARM(:,:,IKB+KKL) - PVARM(:,:,IKB))
+!
+DO JK=IKTB+1,IKTE-1
+ ZY(:,:,JK)= PVARM(:,:,JK) + PTSTEP*PSOURCE(:,:,JK) - &
+ PEXPL / PRHODJ(:,:,JK) * &
+ ( PVARM(:,:,JK-KKL)*PA(:,:,JK) &
+ -PVARM(:,:,JK)*(PA(:,:,JK)+PA(:,:,JK+KKL)) &
+ +PVARM(:,:,JK+KKL)*PA(:,:,JK+KKL) &
+ )
+END DO
+!
+ZY(:,:,IKE)= PVARM(:,:,IKE) + PTSTEP*PSOURCE(:,:,IKE) + &
+ PEXPL / PRHODJ(:,:,IKE) * PA(:,:,IKE) * (PVARM(:,:,IKE)-PVARM(:,:,IKE-KKL))
+!
+!
+!* 2. INVERSION OF THE TRIDIAGONAL SYSTEM
+! -----------------------------------
+!
+IF ( PIMPL > 1.E-10 ) THEN
+!
+ !
+ ! going up
+ !
+ ZBET(:,:) = 1. + PIMPL * (PDIAG(:,:,IKB)-PA(:,:,IKB+KKL) / PRHODJ(:,:,IKB))
+ ! bet = b(ikb)
+ PVARP(:,:,IKB) = ZY(:,:,IKB) / ZBET(:,:)
+ !
+ DO JK = IKB+KKL,IKE-KKL,KKL
+ ZGAM(:,:,JK) = PIMPL * PA(:,:,JK) / PRHODJ(:,:,JK-KKL) / ZBET(:,:)
+ ! gam(k) = c(k-1) / bet
+ ZBET(:,:) = 1. + PIMPL * ( PDIAG(:,:,JK) - &
+ ( PA(:,:,JK) * (1. + ZGAM(:,:,JK)) &
+ + PA(:,:,JK+KKL) &
+ ) / PRHODJ(:,:,JK) &
+ ) ! bet = b(k) - a(k)* gam(k)
+ PVARP(:,:,JK)= ( ZY(:,:,JK) - PIMPL * PA(:,:,JK) / PRHODJ(:,:,JK) &
+ * PVARP(:,:,JK-KKL) &
+ ) / ZBET(:,:)
+ ! res(k) = (y(k) -a(k)*res(k-1))/ bet
+ END DO
+ ! special treatment for the last level
+ ZGAM(:,:,IKE) = PIMPL * PA(:,:,IKE) / PRHODJ(:,:,IKE-KKL) / ZBET(:,:)
+ ! gam(k) = c(k-1) / bet
+ ZBET(:,:) = 1. + PIMPL * ( PDIAG(:,:,IKE) - &
+ ( PA(:,:,IKE) * (1. + ZGAM(:,:,IKE)) ) / PRHODJ(:,:,IKE) &
+ )
+ ! bet = b(k) - a(k)* gam(k)
+ PVARP(:,:,IKE)= ( ZY(:,:,IKE) - PIMPL * PA(:,:,IKE) / PRHODJ(:,:,IKE) &
+ * PVARP(:,:,IKE-KKL) &
+ ) / ZBET(:,:)
+ ! res(k) = (y(k) -a(k)*res(k-1))/ bet
+ !
+ ! going down
+ !
+ DO JK = IKE-KKL,IKB,-1*KKL
+ PVARP(:,:,JK) = PVARP(:,:,JK) - ZGAM(:,:,JK+KKL) * PVARP(:,:,JK+KKL)
+ END DO
+!
+ELSE
+!
+ PVARP(:,:,IKTB:IKTE) = ZY(:,:,IKTB:IKTE)
+!
+END IF
+!
+!
+!* 3. FILL THE UPPER AND LOWER EXTERNAL VALUES
+! ----------------------------------------
+!
+PVARP(:,:,KKA)=PVARP(:,:,IKB)
+PVARP(:,:,KKU)=PVARP(:,:,IKE)
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE TRIDIAG_TKE
diff --git a/src/mesonh/turb/tridiag_wind.f90 b/src/mesonh/turb/tridiag_wind.f90
new file mode 100644
index 000000000..5dc35f1b1
--- /dev/null
+++ b/src/mesonh/turb/tridiag_wind.f90
@@ -0,0 +1,267 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 turb 2006/06/06 09:36:38
+!-----------------------------------------------------------------
+! ########################
+ MODULE MODI_TRIDIAG_WIND
+! ########################
+INTERFACE
+!
+ SUBROUTINE TRIDIAG_WIND(KKA,KKU,KKL,PVARM,PA,PCOEFS,PTSTEP,PEXPL,PIMPL, &
+ PRHODJA,PSOURCE,PVARP )
+!
+INTEGER, INTENT(IN) :: KKA !near ground array index
+INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=AR
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PVARM ! variable at t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! upper diag. elements
+REAL, DIMENSION(:,:), INTENT(IN) :: PCOEFS ! implicit coeff for the
+ ! surface flux
+REAL, INTENT(IN) :: PTSTEP ! Double time step
+REAL, INTENT(IN) :: PEXPL,PIMPL ! weights of the temporal scheme
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJA ! (dry rho)*J averaged
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSOURCE ! source term of PVAR
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PVARP ! variable at t+1
+!
+END SUBROUTINE TRIDIAG_WIND
+!
+END INTERFACE
+!
+END MODULE MODI_TRIDIAG_WIND
+!
+!
+!
+! #############################################################
+ SUBROUTINE TRIDIAG_WIND(KKA,KKU,KKL,PVARM,PA,PCOEFS,PTSTEP,PEXPL,PIMPL, &
+ PRHODJA,PSOURCE,PVARP )
+! #############################################################
+!
+!
+!!**** *TRIDIAG_WIND* - routine to solve a time implicit scheme
+!!
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to give a field PVARP at t+1, by
+! solving an implicit tridiagonal system obtained by the
+! discretization of the vertical turbulent diffusion. It should be noted
+! that the degree of implicitness can be varied (PIMPL parameter) and the
+! sources of evolution other than the turbulent diffusion can be taken
+! into account through the PSOURCE field. PVARP is localized at a wind
+! point either U or V, PRHODJA is averaged to be localized at the same
+! point. The surface flux is also implicitly computed.
+!
+!!** METHOD
+!! ------
+!! First, the Right Hand Side of the implicit equation is computed.
+!! It is build as follows:
+!! ZY = PVARM + PTSTEP*PSOURCE + DIFF_EXPLI
+!! where PVARM is the variable at t-dt, PSOURCE the supplementary sources of
+!! PVAR ( and not PVAR * PRHODJA !!) and DIFF_EXPLI is the explicit part
+!! of the vertical turbulent diffusion. This operator is spatially
+!! discretized as the implicit one, thus:
+!! DIFF_EXPLI(k) = - PEXPL / PRHODJA(k) *
+!! ( PA(k+1) * (PVARM(k+1) - PVARM(k) )
+!! -PA(k) * (PVARM(k) - PVARM(k-1)) )
+!! For the first level, only the upper part is considered, the lower one
+!! is replaced by the turbulent surface flux (taken into account in the
+!! PSOURCE(ikb) term).
+!! DIFF_EXPLI(ikb) = - PEXPL / PRHODJA(ikb) *
+!! ( PA(ikb+1) * (PVARM(ikb+1) - PVARM(ikb)) )
+!! For the last level, only the lower part is considered, the upper one
+!! is replaced by the turbulent flux which is taken equal to 0
+!! (taken into account in the PSOURCE(ike) term).
+!!
+!! DIFF_EXPLI(ike) = + PEXPL / PRHODJA(ike) *
+!! ( PA(ike) * (PVARM(ike) - PVARM(ike-1)) )
+!!
+!! Then, the classical tridiagonal algorithm is used to invert the
+!! implicit operator. Its matrix is given by:
+!!
+!! ( b(ikb) c(ikb) 0 0 0 0 0 0 )
+!! ( 0 a(ikb+1) b(ikb+1) c(ikb+1) 0 ... 0 0 0 )
+!! ( 0 0 a(ikb+2) b(ikb+2) c(ikb+2). 0 0 0 )
+!! .......................................................................
+!! ( 0 ... 0 a(k) b(k) c(k) 0 ... 0 0 )
+!! .......................................................................
+!! ( 0 0 0 0 0 ...a(ike-1) b(ike-1) c(ike-1))
+!! ( 0 0 0 0 0 ... 0 a(ike) b(ike) )
+!!
+!! ikb and ike represent the first and the last inner mass levels of the
+!! model. The coefficients are:
+!!
+!! a(k) = PIMPL * PA(k)/PRHODJA(k)
+!! b(k) = 1 - PIMPL * PA(k)/PRHODJA(k) - PIMPL * PA(k+1)/PRHODJA(k)
+!! c(k) = PIMPL * PA(k+1)/PRHODJA(k)
+!!
+!! for all k /= ikb or ike
+!!
+!! b(ikb) = 1 - PIMPL * PA(ikb+1)/PRHODJA(ikb) - PIMPL * PCOEFS
+!! c(ikb) = PIMPL * PA(ikb+1)/PRHODJA(ikb)
+!! (discretization of the upper part of the implicit operator)
+!! b(ike) = 1 - PIMPL * PA(ike)/PRHODJA(ike)
+!! a(ike) = PIMPL * PA(ike)/PRHODJA(ike)
+!! (discretization of the lower part of the implicit operator)
+!!
+!! The surface flux is given by:
+!! <w'u'> = <w'u'>EXPL + PIMPL * PCOEFS * PVARP
+!! The explicit part is taken into account in PSOURCE(ikb) and the
+!! implicit one is present in the LHS of the equation in b(ikb)
+!!
+!! Finally, the marginal points are prescribed.
+!!
+!! All these computations are purely vertical and vectorizations are
+!! easely achieved by processing all the verticals in parallel.
+!!
+!! EXTERNAL
+!! --------
+!!
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! MODD_PARAMETERS
+!! JPVEXT_TURB: number of vertical external points
+!!
+!! REFERENCE
+!! ---------
+!! Book 1 of Meso-NH documentation (chapter Turbulence)
+!! Press et al: Numerical recipes (1986) Cambridge Univ. Press
+!!
+!! AUTHOR
+!! ------
+!! Joel Stein * Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original November 16, 1995
+!! (Stein) February 28, 1995 no inversion in the explicit case
+!! (Seity) February 2012 add possibility to run with reversed
+!! vertical levels
+!! ---------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+USE MODD_PARAMETERS
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+INTEGER, INTENT(IN) :: KKA !near ground array index
+INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PVARM ! variable at t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! upper diag. elements
+REAL, DIMENSION(:,:), INTENT(IN) :: PCOEFS ! implicit coeff for the
+ ! surface flux
+REAL, INTENT(IN) :: PTSTEP ! Double time step
+REAL, INTENT(IN) :: PEXPL,PIMPL ! weights of the temporal scheme
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJA ! (dry rho)*J averaged
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSOURCE ! source term of PVAR
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PVARP ! variable at t+1
+!
+!* 0.2 declarations of local variables
+!
+REAL, DIMENSION(SIZE(PVARM,1),SIZE(PVARM,2),SIZE(PVARM,3)) :: ZY ,ZGAM
+ ! RHS of the equation, 3D work array
+REAL, DIMENSION(SIZE(PVARM,1),SIZE(PVARM,2)) :: ZBET
+ ! 2D work array
+INTEGER :: JK ! loop counter
+INTEGER :: IKB,IKE ! inner vertical limits
+INTEGER :: IKT ! array size in k direction
+INTEGER :: IKTB,IKTE ! start, end of k loops in physical domain
+!
+! ---------------------------------------------------------------------------
+!
+!* 1. COMPUTE THE RIGHT HAND SIDE
+! ---------------------------
+!
+IKT=SIZE(PVARM,3)
+IKTB=1+JPVEXT_TURB
+IKTE=IKT-JPVEXT_TURB
+IKB=KKA+JPVEXT_TURB*KKL
+IKE=KKU-JPVEXT_TURB*KKL
+
+!
+!
+ZY(:,:,IKB) = PVARM(:,:,IKB) + PTSTEP*PSOURCE(:,:,IKB) - &
+ PEXPL / PRHODJA(:,:,IKB) * PA(:,:,IKB+KKL) * (PVARM(:,:,IKB+KKL) - PVARM(:,:,IKB))
+!
+ ZY(:,:,IKTB+1:IKTE-1)= PVARM(:,:,IKTB+1:IKTE-1) + PTSTEP*PSOURCE(:,:,IKTB+1:IKTE-1) - &
+ PEXPL / PRHODJA(:,:,IKTB+1:IKTE-1) * &
+ ( PVARM(:,:,IKTB+1-KKL:IKTE-1-KKL)*PA(:,:,IKTB+1:IKTE-1) &
+ -PVARM(:,:,IKTB+1:IKTE-1)*(PA(:,:,IKTB+1:IKTE-1)+PA(:,:,IKTB+1+KKL:IKTE-1+KKL)) &
+ +PVARM(:,:,IKTB+1+KKL:IKTE-1+KKL)*PA(:,:,IKTB+1+KKL:IKTE-1+KKL) &
+ )
+!
+ZY(:,:,IKE)= PVARM(:,:,IKE) + PTSTEP*PSOURCE(:,:,IKE) + &
+ PEXPL / PRHODJA(:,:,IKE) * PA(:,:,IKE) * (PVARM(:,:,IKE)-PVARM(:,:,IKE-KKL))
+!
+!
+!* 2. INVERSION OF THE TRIDIAGONAL SYSTEM
+! -----------------------------------
+!
+IF ( PIMPL > 1.E-10 ) THEN
+!
+ !
+ ! going up
+ !
+ ZBET(:,:) = 1. - PIMPL * ( PA(:,:,IKB+KKL) / PRHODJA(:,:,IKB) &
+ + PCOEFS(:,:) * PTSTEP ) ! bet = b(ikb)
+ PVARP(:,:,IKB) = ZY(:,:,IKB) / ZBET(:,:)
+ !
+ DO JK = IKB+KKL,IKE-KKL,KKL
+ ZGAM(:,:,JK) = PIMPL * PA(:,:,JK) / PRHODJA(:,:,JK-KKL) / ZBET(:,:)
+ ! gam(k) = c(k-1) / bet
+ ZBET(:,:) = 1. - PIMPL * ( PA(:,:,JK) * (1. + ZGAM(:,:,JK)) &
+ + PA(:,:,JK+KKL) &
+ ) / PRHODJA(:,:,JK)
+ ! bet = b(k) - a(k)* gam(k)
+ PVARP(:,:,JK)= ( ZY(:,:,JK) - PIMPL * PA(:,:,JK) / PRHODJA(:,:,JK) &
+ * PVARP(:,:,JK-KKL) &
+ ) / ZBET(:,:)
+ ! res(k) = (y(k) -a(k)*res(k-1))/ bet
+ END DO
+ ! special treatment for the last level
+ ZGAM(:,:,IKE) = PIMPL * PA(:,:,IKE) / PRHODJA(:,:,IKE-KKL) / ZBET(:,:)
+ ! gam(k) = c(k-1) / bet
+ ZBET(:,:) = 1. - PIMPL * ( PA(:,:,IKE) * (1. + ZGAM(:,:,IKE)) &
+ ) / PRHODJA(:,:,IKE)
+ ! bet = b(k) - a(k)* gam(k)
+ PVARP(:,:,IKE)= ( ZY(:,:,IKE) - PIMPL * PA(:,:,IKE) / PRHODJA(:,:,IKE) &
+ * PVARP(:,:,IKE-KKL) &
+ ) / ZBET(:,:)
+ ! res(k) = (y(k) -a(k)*res(k-1))/ bet
+ !
+ ! going down
+ !
+ DO JK = IKE-KKL,IKB,-1*KKL
+ PVARP(:,:,JK) = PVARP(:,:,JK) - ZGAM(:,:,JK+KKL) * PVARP(:,:,JK+KKL)
+ END DO
+!
+ELSE
+!
+ PVARP(:,:,IKTB:IKTE) = ZY(:,:,IKTB:IKTE)
+!
+END IF
+!
+!
+!* 3. FILL THE UPPER AND LOWER EXTERNAL VALUES
+! ----------------------------------------
+!
+PVARP(:,:,KKA)=PVARP(:,:,IKB)
+PVARP(:,:,KKU)=PVARP(:,:,IKE)
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE TRIDIAG_WIND
diff --git a/src/mesonh/turb/turb.f90 b/src/mesonh/turb/turb.f90
new file mode 100644
index 000000000..228241e2c
--- /dev/null
+++ b/src/mesonh/turb/turb.f90
@@ -0,0 +1,1876 @@
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ################
+ MODULE MODI_TURB
+! ################
+!
+INTERFACE
+!
+ SUBROUTINE TURB(KKA, KKU, KKL, KMI,KRR,KRRL,KRRI,HLBCX,HLBCY, &
+ KSPLIT,KMODEL_CL, &
+ OTURB_FLX,OTURB_DIAG,OSUBG_COND,ORMC01, &
+ HTURBDIM,HTURBLEN,HTOM,HTURBLEN_CL,HCLOUD,PIMPL, &
+ PTSTEP,TPFILE,PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
+ PDIRCOSXW,PDIRCOSYW,PDIRCOSZW,PCOSSLOPE,PSINSLOPE, &
+ PRHODJ,PTHVREF, &
+ PSFTH,PSFRV,PSFSV,PSFU,PSFV, &
+ PPABST,PUT,PVT,PWT,PTKET,PSVT,PSRCT, &
+ PBL_DEPTH, PSBL_DEPTH, &
+ PCEI,PCEI_MIN,PCEI_MAX,PCOEF_AMPL_SAT, &
+ PTHLT,PRT, &
+ PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS,PRTKES,PRTKEMS,PSIGS,&
+ PFLXZTHVMF,PWTH,PWRC,PWSV,PDYP,PTHP,PTR,PDISS,PLEM )
+
+!
+USE MODD_IO, ONLY: TFILEDATA
+!
+INTEGER, INTENT(IN) :: KKA !near ground array index
+INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=AR
+INTEGER, INTENT(IN) :: KMI ! model index number
+INTEGER, INTENT(IN) :: KRR ! number of moist var.
+INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
+INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
+CHARACTER(LEN=*),DIMENSION(:),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
+INTEGER, INTENT(IN) :: KSPLIT ! number of time-splitting
+INTEGER, INTENT(IN) :: KMODEL_CL ! model number for cloud mixing length
+LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
+ ! turbulent fluxes in the syncronous FM-file
+LOGICAL, INTENT(IN) :: OTURB_DIAG ! switch to write some
+ ! diagnostic fields in the syncronous FM-file
+LOGICAL, INTENT(IN) :: OSUBG_COND ! switch for SUBGrid
+ ! CONDensation
+LOGICAL, INTENT(IN) :: ORMC01 ! switch for RMC01 lengths in SBL
+CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
+ ! turbulence scheme
+CHARACTER(len=4), INTENT(IN) :: HTURBLEN ! kind of mixing length
+CHARACTER(len=4), INTENT(IN) :: HTOM ! kind of Third Order Moment
+CHARACTER(len=4), INTENT(IN) :: HTURBLEN_CL ! kind of cloud mixing length
+ ! surface friction flux
+REAL, INTENT(IN) :: PIMPL ! degree of implicitness
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
+REAL, INTENT(IN) :: PTSTEP ! timestep
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
+ ! metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! physical distance
+! between 2 succesive grid points along the K direction
+REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSXW, PDIRCOSYW, PDIRCOSZW
+! Director Cosinus along x, y and z directions at surface w-point
+REAL, DIMENSION(:,:), INTENT(IN) :: PCOSSLOPE ! cosinus of the angle
+ ! between i and the slope vector
+REAL, DIMENSION(:,:), INTENT(IN) :: PSINSLOPE ! sinus of the angle
+ ! between i and the slope vector
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry density * Grid size
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! Virtual Potential
+ ! Temperature of the reference state
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PSFTH,PSFRV, &
+! normal surface fluxes of theta and Rv
+ PSFU,PSFV
+! normal surface fluxes of (u,v) parallel to the orography
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSFSV
+! normal surface fluxes of Scalar var.
+!
+! prognostic variables at t- deltat
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Pressure at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT,PVT,PWT ! wind components
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKET ! TKE
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! passive scal. var.
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCT ! Second-order flux
+ ! s'rc'/2Sigma_s2 at time t-1 multiplied by Lambda_3
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PBL_DEPTH ! BL depth for TOMS
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PSBL_DEPTH ! SBL depth for RMC01
+!
+!
+! variables for cloud mixing length
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCEI ! Cloud Entrainment instability
+ ! index to emphasize localy
+ ! turbulent fluxes
+REAL, INTENT(IN) :: PCEI_MIN ! minimum threshold for the instability index CEI
+REAL, INTENT(IN) :: PCEI_MAX ! maximum threshold for the instability index CEI
+REAL, INTENT(IN) :: PCOEF_AMPL_SAT ! saturation of the amplification coefficient
+! thermodynamical variables which are transformed in conservative var.
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHLT ! conservative pot. temp.
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRT ! water var. where
+ ! PRT(:,:,:,1) is the conservative mixing ratio
+!
+! sources of momentum, conservative potential temperature, Turb. Kin. Energy,
+! TKE dissipation
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS,PRVS,PRWS,PRTHLS,PRTKES
+! Source terms for all water kinds, PRRS(:,:,:,1) is used for the conservative
+! mixing ratio
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRTKEMS
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS
+! Source terms for all passive scalar variables
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS
+! Sigma_s at time t+1 : square root of the variance of the deviation to the
+! saturation
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSIGS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFLXZTHVMF
+! MF contribution for vert. turb. transport
+! used in the buoy. prod. of TKE
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWTH ! heat flux
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWRC ! cloud water flux
+REAL, DIMENSION(:,:,:,:),INTENT(OUT) :: PWSV ! scalar flux
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDYP ! Dynamical production of TKE
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTHP ! Thermal production of TKE
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTR ! Transport production of TKE
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDISS ! Dissipation of TKE
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLEM ! Mixing length
+
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE TURB
+!
+END INTERFACE
+!
+END MODULE MODI_TURB
+!
+! #################################################################
+ SUBROUTINE TURB(KKA, KKU, KKL, KMI,KRR,KRRL,KRRI,HLBCX,HLBCY, &
+ KSPLIT,KMODEL_CL, &
+ OTURB_FLX,OTURB_DIAG,OSUBG_COND,ORMC01, &
+ HTURBDIM,HTURBLEN,HTOM,HTURBLEN_CL,HCLOUD,PIMPL, &
+ PTSTEP,TPFILE,PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
+ PDIRCOSXW,PDIRCOSYW,PDIRCOSZW,PCOSSLOPE,PSINSLOPE, &
+ PRHODJ,PTHVREF, &
+ PSFTH,PSFRV,PSFSV,PSFU,PSFV, &
+ PPABST,PUT,PVT,PWT,PTKET,PSVT,PSRCT, &
+ PBL_DEPTH, PSBL_DEPTH, &
+ PCEI,PCEI_MIN,PCEI_MAX,PCOEF_AMPL_SAT, &
+ PTHLT,PRT, &
+ PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS,PRTKES,PRTKEMS,PSIGS,&
+ PFLXZTHVMF,PWTH,PWRC,PWSV,PDYP,PTHP,PTR,PDISS,PLEM )
+! #################################################################
+!
+!
+!!**** *TURB* - computes the turbulent source terms for the prognostic
+!! variables.
+!!
+!! PURPOSE
+!! -------
+!!**** The purpose of this routine is to compute the source terms in
+!! the evolution equations due to the turbulent mixing.
+!! The source term is computed as the divergence of the turbulent fluxes.
+!! The cartesian fluxes are obtained by a one and a half order closure, based
+!! on a prognostic equation for the Turbulence Kinetic Energy( TKE ). The
+!! system is closed by prescribing a turbulent mixing length. Different
+!! choices are available for this length.
+!
+!!** METHOD
+!! ------
+!!
+!! The dimensionality of the turbulence parameterization can be chosen by
+!! means of the parameter HTURBDIM:
+!! * HTURBDIM='1DIM' the parameterization is 1D but can be used in
+!! 3D , 2D or 1D simulations. Only the sources associated to the vertical
+!! turbulent fluxes are taken into account.
+!! * HTURBDIM='3DIM' the parameterization is fully 2D or 3D depending
+!! on the model dimensionality. Of course, it does not make any sense to
+!! activate this option with a 1D model.
+!!
+!! The following steps are made:
+!! 1- Preliminary computations.
+!! 2- The metric coefficients are recovered from the grid knowledge.
+!! 3- The mixing length is computed according to its choice:
+!! * HTURBLEN='BL89' the Bougeault and Lacarrere algorithm is used.
+!! The mixing length is given by the vertical displacement from its
+!! original level of an air particule having an initial internal
+!! energy equal to its TKE and stopped by the buoyancy forces.
+!! The discrete formulation is second order accurate.
+!! * HTURBLEN='DELT' the mixing length is given by the mesh size
+!! depending on the model dimensionality, this length is limited
+!! with the ground distance.
+!! * HTURBLEN='DEAR' the mixing length is given by the mesh size
+!! depending on the model dimensionality, this length is limited
+!! with the ground distance and also by the Deardorff mixing length
+!! pertinent in the stable cases.
+!! * HTURBLEN='KEPS' the mixing length is deduced from the TKE
+!! dissipation, which becomes a prognostic variable of the model (
+!! Duynkerke formulation).
+!! 3'- The cloud mixing length is computed according to HTURBLEN_CLOUD
+!! and emphasized following the CEI index
+!! 4- The conservative variables are computed along with Lv/Cp.
+!! 5- The turbulent Prandtl numbers are computed from the resolved fields
+!! and TKE
+!! 6- The sources associated to the vertical turbulent fluxes are computed
+!! with a temporal scheme allowing a degree of implicitness given by
+!! PIMPL, varying from PIMPL=0. ( purely explicit scheme) to PIMPL=1.
+!! ( purely implicit scheme)
+!! The sources associated to the horizontal fluxes are computed with a
+!! purely explicit temporal scheme. These sources are only computed when
+!! the turbulence parameterization is 2D or 3D( HTURBDIM='3DIM' ).
+!! 7- The sources for TKE are computed, along with the dissipation of TKE
+!! if HTURBLEN='KEPS'.
+!! 8- Some turbulence-related quantities are stored in the synchronous
+!! FM-file.
+!! 9- The non-conservative variables are retrieved.
+!!
+!!
+!! The saving of the fields in the synchronous FM-file is controlled by:
+!! * OTURB_FLX => saves all the turbulent fluxes and correlations
+!! * OTURB_DIAG=> saves the turbulent Prandtl and Schmidt numbers, the
+!! source terms of TKE and dissipation of TKE
+!!
+!! EXTERNAL
+!! --------
+!! SUBROUTINE PRANDTL : computes the turbulent Prandtl number
+!! SUBROUTINE TURB_VER : computes the sources from the vertical fluxes
+!! SUBROUTINE TURB_HOR : computes the sources from the horizontal fluxes
+!! SUBROUTINE TKE_EPS_SOURCES : computes the sources for TKE and its
+!! dissipation
+!! SUBROUTINE BUDGET : computes and stores the budgets
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! MODD_PARAMETERS : JPVEXT number of marginal vertical points
+!!
+!! MODD_CONF : CCONF model configuration (start/restart)
+!! L1D switch for 1D model version
+!! L2D switch for 2D model version
+!!
+!! MODD_CST : contains physical constants
+!! XG gravity constant
+!! XRD Gas constant for dry air
+!! XRV Gas constant for vapor
+!!
+!! MODD_CTURB : contains turbulence scheme constants
+!! XCMFS,XCED to compute the dissipation mixing length
+!! XTKEMIN minimum values for the TKE
+!! XLINI,XLINF to compute Bougeault-Lacarrere mixing
+!! length
+!! Module MODD_BUDGET:
+!! NBUMOD
+!! CBUTYPE
+!! LBU_RU
+!! LBU_RV
+!! LBU_RW
+!! LBU_RTH
+!! LBU_RSV1
+!! LBU_RRV
+!! LBU_RRC
+!! LBU_RRR
+!! LBU_RRI
+!! LBU_RRS
+!! LBU_RRG
+!! LBU_RRH
+!!
+!! REFERENCE
+!! ---------
+!! Book 2 of documentation (routine TURB)
+!! Book 1 of documentation (Chapter: Turbulence)
+!!
+!! AUTHOR
+!! ------
+!! Joan Cuxart * INM and Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 05/10/94
+!! Modifications: Feb 14, 1995 (J.Cuxart and J.Stein)
+!! Doctorization and Optimization
+!! Modifications: March 21, 1995 (J.M. Carriere)
+!! Introduction of cloud water
+!! Modifications: June 1, 1995 (J.Cuxart )
+!! take min(Kz,delta)
+!! Modifications: June 1, 1995 (J.Stein J.Cuxart)
+!! remove unnecessary arrays and change Prandtl
+!! and Schmidt numbers localizations
+!! Modifications: July 20, 1995 (J.Stein) remove MODI_ground_ocean +
+!! TZDTCUR + MODD_TIME because they are not used
+!! change RW in RNP for the outputs
+!! Modifications: August 21, 1995 (Ph. Bougeault)
+!! take min(K(z-zsol),delta)
+!! Modifications: Sept 14, 1995 (Ph Bougeault, J. Cuxart)
+!! second order BL89 mixing length computations + add Deardorff length
+!! in the Delta case for stable cases
+!! Modifications: Sept 19, 1995 (J. Stein, J. Cuxart)
+!! define a DEAR case for the mixing length, add MODI_BUDGET and change
+!! some BUDGET calls, add LES tools
+!! Modifications: Oct 16, 1995 (J. Stein) change the budget calls
+!! Modifications: Feb 28, 1996 (J. Stein) optimization +
+!! remove min(K(z-zsol),delta)+
+!! bug in the tangential fluxes
+!! Modifications: Oct 16, 1996 (J. Stein) change the subgrid condensation
+!! scheme + temporal discretization
+!! Modifications: Dec 19, 1996 (J.-P. Pinty) update the budget calls
+!! Jun 22, 1997 (J. Stein) use the absolute pressure and
+!! change the Deardorf length at the surface
+!! Modifications: Apr 27, 1997 (V. Masson) BL89 mix. length computed in
+!! a separate routine
+!! Oct 13, 1999 (J. Stein) switch for the tgt fluxes
+!! Jun 24, 1999 (P Jabouille) Add routine UPDATE_ROTATE_WIND
+!! Feb 15, 2001 (J. Stein) remove tgt fluxes
+!! Mar 8, 2001 (V. Masson) forces the same behaviour near the surface
+!! for all mixing lengths
+!! Nov 06, 2002 (V. Masson) LES budgets
+!! Nov, 2002 (V. Masson) implement modifications of
+!! mixing and dissipative lengths
+!! near the surface (according
+!! Redelsperger et al 2001)
+!! Apr, 2003 (V. Masson) bug in Blackadar length
+!! bug in LES in 1DIM case
+!! Feb 20, 2003 (J.-P. Pinty) Add reversible ice processes
+!! May,26 2004 (P Jabouille) coef for computing dissipative heating
+!! Sept 2004 (M.Tomasini) Cloud Mixing length modification
+!! following the instability
+!! criterium CEI calculated in modeln
+!! May 2006 Remove KEPS
+!! Sept.2006 (I.Sandu): Modification of the stability criterion for
+!! DEAR (theta_v -> theta_l)
+!! Oct 2007 (J.Pergaud) Add MF contribution for vert. turb. transport
+!! Oct.2009 (C.Lac) Introduction of different PTSTEP according to the
+!! advection schemes
+!! October 2009 (G. Tanguy) add ILENCH=LEN(YCOMMENT) after
+!! change of YCOMMENT
+!! 06/2011 (J.escobar ) Bypass Bug with ifort11/12 on HLBCX,HLBC
+!! 2012-02 Y. Seity, add possibility to run with reversed
+!! vertical levels
+!! 10/2012 (J. Colin) Correct bug in DearDoff for dry simulations
+!! 10/2012 J.Escobar Bypass PGI bug , redefine some allocatable array inplace of automatic
+!! 04/2016 (C.Lac) correction of negativity for KHKO
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! Q. Rodier 01/2018: introduction of RM17
+! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
+! B. Vie 03/2020: LIMA negativity checks after turbulence, advection and microphysics budgets
+! P. Wautelet 11/06/2020: bugfix: correct PRSVS array indices
+! P. Wautelet + Benoit Vié 06/2020: improve removal of negative scalar variables + adapt the corresponding budgets
+! P. Wautelet 30/06/2020: move removal of negative scalar variables to Sources_neg_correct
+! R. Honnert/V. Masson 02/2021: new mixing length in the grey zone
+! J.L. Redelsperger 03/2021: add Ocean LES case
+! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+use modd_budget, only: lbudget_u, lbudget_v, lbudget_w, lbudget_th, lbudget_rv, lbudget_rc, &
+ lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, &
+ NBUDGET_U, NBUDGET_V, NBUDGET_W, NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, &
+ NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1, &
+ tbudgets
+USE MODD_CONF
+USE MODD_CST
+USE MODD_CTURB
+USE MODD_DYN_n, ONLY : LOCEAN
+use modd_field, only: tfielddata, TYPEREAL
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LES
+USE MODD_NSV
+USE MODD_PARAMETERS, ONLY: JPVEXT_TURB
+USE MODD_PARAM_LIMA
+USE MODD_TURB_n, ONLY: XCADAP
+!
+USE MODI_GRADIENT_M
+USE MODI_GRADIENT_U
+USE MODI_GRADIENT_V
+USE MODI_BL89
+USE MODI_TURB_VER
+USE MODI_ROTATE_WIND
+USE MODI_TURB_HOR_SPLT
+USE MODI_TKE_EPS_SOURCES
+USE MODI_SHUMAN
+USE MODI_GRADIENT_M
+USE MODI_LES_MEAN_SUBGRID
+USE MODI_RMC01
+USE MODI_GRADIENT_W
+USE MODI_TM06
+USE MODI_UPDATE_LM
+USE MODI_GET_HALO
+!
+use mode_budget, only: Budget_store_init, Budget_store_end
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+USE MODE_SBL
+use mode_sources_neg_correct, only: Sources_neg_correct
+!
+USE MODI_EMOIST
+USE MODI_ETHETA
+!
+USE MODI_SECOND_MNH
+!
+USE MODD_IBM_PARAM_n, ONLY: LIBM, XIBM_LS, XIBM_XMUT
+USE MODI_IBM_MIXINGLENGTH
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+!
+!
+INTEGER, INTENT(IN) :: KKA !near ground array index
+INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
+INTEGER, INTENT(IN) :: KMI ! model index number
+INTEGER, INTENT(IN) :: KRR ! number of moist var.
+INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
+INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
+CHARACTER(LEN=*),DIMENSION(:),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
+INTEGER, INTENT(IN) :: KSPLIT ! number of time-splitting
+INTEGER, INTENT(IN) :: KMODEL_CL ! model number for cloud mixing length
+LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
+ ! turbulent fluxes in the syncronous FM-file
+LOGICAL, INTENT(IN) :: OTURB_DIAG ! switch to write some
+ ! diagnostic fields in the syncronous FM-file
+LOGICAL, INTENT(IN) :: OSUBG_COND ! switch for SUBGrid
+ ! CONDensation
+LOGICAL, INTENT(IN) :: ORMC01 ! switch for RMC01 lengths in SBL
+CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
+ ! turbulence scheme
+CHARACTER(len=4), INTENT(IN) :: HTURBLEN ! kind of mixing length
+CHARACTER(len=4), INTENT(IN) :: HTOM ! kind of Third Order Moment
+CHARACTER(len=4), INTENT(IN) :: HTURBLEN_CL ! kind of cloud mixing length
+REAL, INTENT(IN) :: PIMPL ! degree of implicitness
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
+REAL, INTENT(IN) :: PTSTEP ! timestep
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
+ ! metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! physical distance
+! between 2 succesive grid points along the K direction
+REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSXW, PDIRCOSYW, PDIRCOSZW
+! Director Cosinus along x, y and z directions at surface w-point
+REAL, DIMENSION(:,:), INTENT(IN) :: PCOSSLOPE ! cosinus of the angle
+ ! between i and the slope vector
+REAL, DIMENSION(:,:), INTENT(IN) :: PSINSLOPE ! sinus of the angle
+ ! between i and the slope vector
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry density * Grid size
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! Virtual Potential
+ ! Temperature of the reference state
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PSFTH,PSFRV, &
+! normal surface fluxes of theta and Rv
+ PSFU,PSFV
+! normal surface fluxes of (u,v) parallel to the orography
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSFSV
+! normal surface fluxes of Scalar var.
+!
+! prognostic variables at t- deltat
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Pressure at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT,PVT,PWT ! wind components
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKET ! TKE
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! passive scal. var.
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCT ! Second-order flux
+ ! s'rc'/2Sigma_s2 at time t-1 multiplied by Lambda_3
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PBL_DEPTH ! BL height for TOMS
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PSBL_DEPTH ! SBL depth for RMC01
+!
+! variables for cloud mixing length
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCEI ! Cloud Entrainment instability
+ ! index to emphasize localy
+ ! turbulent fluxes
+REAL, INTENT(IN) :: PCEI_MIN ! minimum threshold for the instability index CEI
+REAL, INTENT(IN) :: PCEI_MAX ! maximum threshold for the instability index CEI
+REAL, INTENT(IN) :: PCOEF_AMPL_SAT ! saturation of the amplification coefficient
+!
+! thermodynamical variables which are transformed in conservative var.
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHLT ! conservative pot. temp.
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRT ! water var. where
+ ! PRT(:,:,:,1) is the conservative mixing ratio
+!
+! sources of momentum, conservative potential temperature, Turb. Kin. Energy,
+! TKE dissipation
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS,PRVS,PRWS,PRTHLS,PRTKES
+! Source terms for all water kinds, PRRS(:,:,:,1) is used for the conservative
+! mixing ratio
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRTKEMS
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS
+! Source terms for all passive scalar variables
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS
+! Sigma_s at time t+1 : square root of the variance of the deviation to the
+! saturation
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSIGS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFLXZTHVMF
+! MF contribution for vert. turb. transport
+! used in the buoy. prod. of TKE
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWTH ! heat flux
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWRC ! cloud water flux
+REAL, DIMENSION(:,:,:,:),INTENT(OUT) :: PWSV ! scalar flux
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDYP ! Dynamical production of TKE
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTHP ! Thermal production of TKE
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTR ! Transport production of TKE
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDISS ! Dissipation of TKE
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLEM ! Mixing length
+!
+!
+!-------------------------------------------------------------------------------
+!
+! 0.2 declaration of local variables
+!
+REAL, ALLOCATABLE, DIMENSION(:,:,:) ::&
+ ZCP, & ! Cp at t-1
+ ZEXN, & ! EXN at t-1
+ ZT, & ! T at t-1
+ ZLOCPEXNM, & ! Lv/Cp/EXNREF at t-1
+ ZLMW, & ! Turbulent mixing length (work array)
+ ZLEPS, & ! Dissipative length
+ ZTRH, & ! Dynamic and Thermal Production of TKE
+ ZATHETA,ZAMOIST, & ! coefficients for s = f (Thetal,Rnp)
+ ZCOEF_DISS, & ! 1/(Cph*Exner) for dissipative heating
+ ZFRAC_ICE, & ! ri fraction of rc+ri
+ ZMWTH,ZMWR,ZMTH2,ZMR2,ZMTHR,& ! 3rd order moments
+ ZFWTH,ZFWR,ZFTH2,ZFR2,ZFTHR,& ! opposite of verticale derivate of 3rd order moments
+ ZTHLM, ZTR, ZDISS ! initial potential temp.
+REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: &
+ ZRM ! initial mixing ratio
+REAL, ALLOCATABLE, DIMENSION(:,:) :: ZTAU11M,ZTAU12M, &
+ ZTAU22M,ZTAU33M, &
+ ! tangential surface fluxes in the axes following the orography
+ ZUSLOPE,ZVSLOPE, &
+ ! wind components at the first mass level parallel
+ ! to the orography
+ ZCDUEFF, &
+ ! - Cd*||u|| where ||u|| is the module of the wind tangential to
+ ! orography (ZUSLOPE,ZVSLOPE) at the surface.
+ ZUSTAR, ZLMO, &
+ ZRVM, ZSFRV
+ ! friction velocity, Monin Obuhkov length, work arrays for vapor
+!
+ ! Virtual Potential Temp. used
+ ! in the Deardorff mixing length computation
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: &
+ ZLVOCPEXNM,ZLSOCPEXNM, & ! Lv/Cp/EXNREF and Ls/Cp/EXNREF at t-1
+ ZATHETA_ICE,ZAMOIST_ICE ! coefficients for s = f (Thetal,Rnp)
+!
+REAL :: ZEXPL ! 1-PIMPL deg of expl.
+REAL :: ZRVORD ! RV/RD
+!
+INTEGER :: IKB,IKE ! index value for the
+! Beginning and the End of the physical domain for the mass points
+INTEGER :: IKT ! array size in k direction
+INTEGER :: IKTB,IKTE ! start, end of k loops in physical domain
+INTEGER :: JRR,JK,JSV ! loop counters
+INTEGER :: JI,JJ ! loop counters
+REAL :: ZL0 ! Max. Mixing Length in Blakadar formula
+REAL :: ZALPHA ! work coefficient :
+ ! - proportionnality constant between Dz/2 and
+! ! BL89 mixing length near the surface
+!
+REAL :: ZTIME1, ZTIME2
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)):: ZTT,ZEXNE,ZLV,ZLS,ZCPH,ZCOR
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)):: ZSHEAR, ZDUDZ, ZDVDZ
+TYPE(TFIELDDATA) :: TZFIELD
+!
+!------------------------------------------------------------------------------------------
+ALLOCATE ( &
+ ZCP(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+ ZEXN(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+ ZT(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+ ZLOCPEXNM(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+ ZLMW(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+ ZLEPS(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+ ZTRH(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+ ZATHETA(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+ ZAMOIST(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+ ZCOEF_DISS(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+ ZFRAC_ICE(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+ ZMWTH(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+ ZMWR(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+ ZMTH2(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+ ZMR2(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+ ZMTHR(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+ ZFWTH(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+ ZFWR(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+ ZFTH2(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+ ZFR2(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+ ZFTHR(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+ ZTHLM(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)) )
+
+ALLOCATE ( ZRM(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),SIZE(PRT,4)) )
+
+ALLOCATE ( &
+ ZTAU11M(SIZE(PTHLT,1),SIZE(PTHLT,2)), &
+ ZTAU12M(SIZE(PTHLT,1),SIZE(PTHLT,2)), &
+ ZTAU22M(SIZE(PTHLT,1),SIZE(PTHLT,2)), &
+ ZTAU33M(SIZE(PTHLT,1),SIZE(PTHLT,2)), &
+ ZUSLOPE(SIZE(PTHLT,1),SIZE(PTHLT,2)), &
+ ZVSLOPE(SIZE(PTHLT,1),SIZE(PTHLT,2)), &
+ ZCDUEFF(SIZE(PTHLT,1),SIZE(PTHLT,2)), &
+ ZUSTAR(SIZE(PTHLT,1),SIZE(PTHLT,2)), &
+ ZLMO(SIZE(PTHLT,1),SIZE(PTHLT,2)), &
+ ZRVM(SIZE(PTHLT,1),SIZE(PTHLT,2)), &
+ ZSFRV(SIZE(PTHLT,1),SIZE(PTHLT,2)) )
+
+!------------------------------------------------------------------------------------------
+!
+!* 1.PRELIMINARIES
+! -------------
+!
+!* 1.1 Set the internal domains, ZEXPL
+!
+!
+IKT=SIZE(PTHLT,3)
+IKTB=1+JPVEXT_TURB
+IKTE=IKT-JPVEXT_TURB
+IKB=KKA+JPVEXT_TURB*KKL
+IKE=KKU-JPVEXT_TURB*KKL
+!
+ZEXPL = 1.- PIMPL
+ZRVORD= XRV / XRD
+!
+!
+!Copy data into ZTHLM and ZRM only if needed
+IF (HTURBLEN=='BL89' .OR. HTURBLEN=='RM17' .OR. ORMC01) THEN
+ ZTHLM(:,:,:) = PTHLT(:,:,:)
+ ZRM(:,:,:,:) = PRT(:,:,:,:)
+END IF
+!
+!
+!
+!----------------------------------------------------------------------------
+!
+!* 2. COMPUTE CONSERVATIVE VARIABLES AND RELATED QUANTITIES
+! -----------------------------------------------------
+!
+!* 2.1 Cph at t
+!
+ZCP(:,:,:)=XCPD
+!
+IF (KRR > 0) ZCP(:,:,:) = ZCP(:,:,:) + XCPV * PRT(:,:,:,1)
+DO JRR = 2,1+KRRL ! loop on the liquid components
+ ZCP(:,:,:) = ZCP(:,:,:) + XCL * PRT(:,:,:,JRR)
+END DO
+!
+DO JRR = 2+KRRL,1+KRRL+KRRI ! loop on the solid components
+ ZCP(:,:,:) = ZCP(:,:,:) + XCI * PRT(:,:,:,JRR)
+END DO
+!
+!* 2.2 Exner function at t
+!
+IF (LOCEAN) THEN
+ ZEXN(:,:,:) = 1.
+ELSE
+ ZEXN(:,:,:) = (PPABST(:,:,:)/XP00) ** (XRD/XCPD)
+END IF
+!
+!* 2.3 dissipative heating coeff a t
+!
+ZCOEF_DISS(:,:,:) = 1/(ZCP(:,:,:) * ZEXN(:,:,:))
+!
+!
+ZFRAC_ICE(:,:,:) = 0.0
+ZATHETA(:,:,:) = 0.0
+ZAMOIST(:,:,:) = 0.0
+!
+IF (KRRL >=1) THEN
+!
+!* 2.4 Temperature at t
+!
+ ZT(:,:,:) = PTHLT(:,:,:) * ZEXN(:,:,:)
+!
+!* 2.5 Lv/Cph/Exn
+!
+ IF ( KRRI >= 1 ) THEN
+ ALLOCATE(ZLVOCPEXNM(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)))
+ ALLOCATE(ZLSOCPEXNM(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)))
+ ALLOCATE(ZAMOIST_ICE(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)))
+ ALLOCATE(ZATHETA_ICE(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)))
+!
+ CALL COMPUTE_FUNCTION_THERMO(XALPW,XBETAW,XGAMW,XLVTT,XCL,ZT,ZEXN,ZCP, &
+ ZLVOCPEXNM,ZAMOIST,ZATHETA)
+ CALL COMPUTE_FUNCTION_THERMO(XALPI,XBETAI,XGAMI,XLSTT,XCI,ZT,ZEXN,ZCP, &
+ ZLSOCPEXNM,ZAMOIST_ICE,ZATHETA_ICE)
+!
+ WHERE(PRT(:,:,:,2)+PRT(:,:,:,4)>0.0)
+ ZFRAC_ICE(:,:,:) = PRT(:,:,:,4) / ( PRT(:,:,:,2)+PRT(:,:,:,4) )
+ END WHERE
+!
+ ZLOCPEXNM(:,:,:) = (1.0-ZFRAC_ICE(:,:,:))*ZLVOCPEXNM(:,:,:) &
+ +ZFRAC_ICE(:,:,:) *ZLSOCPEXNM(:,:,:)
+ ZAMOIST(:,:,:) = (1.0-ZFRAC_ICE(:,:,:))*ZAMOIST(:,:,:) &
+ +ZFRAC_ICE(:,:,:) *ZAMOIST_ICE(:,:,:)
+ ZATHETA(:,:,:) = (1.0-ZFRAC_ICE(:,:,:))*ZATHETA(:,:,:) &
+ +ZFRAC_ICE(:,:,:) *ZATHETA_ICE(:,:,:)
+
+ DEALLOCATE(ZAMOIST_ICE)
+ DEALLOCATE(ZATHETA_ICE)
+ ELSE
+ CALL COMPUTE_FUNCTION_THERMO(XALPW,XBETAW,XGAMW,XLVTT,XCL,ZT,ZEXN,ZCP, &
+ ZLOCPEXNM,ZAMOIST,ZATHETA)
+ END IF
+!
+!
+ IF ( tpfile%lopened .AND. OTURB_DIAG ) THEN
+ TZFIELD%CMNHNAME = 'ATHETA'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'ATHETA'
+ TZFIELD%CUNITS = 'm'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_ATHETA'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZATHETA)
+!
+ TZFIELD%CMNHNAME = 'AMOIST'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'AMOIST'
+ TZFIELD%CUNITS = 'm'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_AMOIST'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZAMOIST)
+ END IF
+!
+ELSE
+ ZLOCPEXNM=0.
+END IF ! loop end on KRRL >= 1
+!
+! computes conservative variables
+!
+IF ( KRRL >= 1 ) THEN
+ IF ( KRRI >= 1 ) THEN
+ ! Rnp at t
+ PRT(:,:,:,1) = PRT(:,:,:,1) + PRT(:,:,:,2) + PRT(:,:,:,4)
+ PRRS(:,:,:,1) = PRRS(:,:,:,1) + PRRS(:,:,:,2) + PRRS(:,:,:,4)
+ ! Theta_l at t
+ PTHLT(:,:,:) = PTHLT(:,:,:) - ZLVOCPEXNM(:,:,:) * PRT(:,:,:,2) &
+ - ZLSOCPEXNM(:,:,:) * PRT(:,:,:,4)
+ PRTHLS(:,:,:) = PRTHLS(:,:,:) - ZLVOCPEXNM(:,:,:) * PRRS(:,:,:,2) &
+ - ZLSOCPEXNM(:,:,:) * PRRS(:,:,:,4)
+ ELSE
+ ! Rnp at t
+ PRT(:,:,:,1) = PRT(:,:,:,1) + PRT(:,:,:,2)
+ PRRS(:,:,:,1) = PRRS(:,:,:,1) + PRRS(:,:,:,2)
+ ! Theta_l at t
+ PTHLT(:,:,:) = PTHLT(:,:,:) - ZLOCPEXNM(:,:,:) * PRT(:,:,:,2)
+ PRTHLS(:,:,:) = PRTHLS(:,:,:) - ZLOCPEXNM(:,:,:) * PRRS(:,:,:,2)
+ END IF
+END IF
+!
+!----------------------------------------------------------------------------
+!
+!* 3. MIXING LENGTH : SELECTION AND COMPUTATION
+! -----------------------------------------
+!
+!
+SELECT CASE (HTURBLEN)
+!
+!* 3.1 BL89 mixing length
+! ------------------
+
+ CASE ('BL89')
+ ZSHEAR=0.
+ CALL BL89(KKA,KKU,KKL,PZZ,PDZZ,PTHVREF,ZTHLM,KRR,ZRM,PTKET,ZSHEAR,PLEM)
+!
+!* 3.2 RM17 mixing length
+! ------------------
+
+ CASE ('RM17')
+ ZDUDZ = MXF(MZF(GZ_U_UW(PUT,PDZZ)))
+ ZDVDZ = MYF(MZF(GZ_V_VW(PVT,PDZZ)))
+ ZSHEAR = SQRT(ZDUDZ*ZDUDZ + ZDVDZ*ZDVDZ)
+ CALL BL89(KKA,KKU,KKL,PZZ,PDZZ,PTHVREF,ZTHLM,KRR,ZRM,PTKET,ZSHEAR,PLEM)
+!
+!* 3.3 Grey-zone combined RM17 & Deardorff mixing lengths
+! --------------------------------------------------
+
+ CASE ('ADAP')
+ ZDUDZ = MXF(MZF(GZ_U_UW(PUT,PDZZ)))
+ ZDVDZ = MYF(MZF(GZ_V_VW(PVT,PDZZ)))
+ ZSHEAR = SQRT(ZDUDZ*ZDUDZ + ZDVDZ*ZDVDZ)
+ CALL BL89(KKA,KKU,KKL,PZZ,PDZZ,PTHVREF,ZTHLM,KRR,ZRM,PTKET,ZSHEAR,PLEM)
+
+ CALL DELT(ZLMW,ODZ=.FALSE.)
+ ! The minimum mixing length is chosen between Horizontal grid mesh (not taking into account the vertical grid mesh) and RM17.
+ ! For large horizontal grid meshes, this is equal to RM17
+ ! For LES grid meshes, this is equivalent to Deardorff : the base mixing lentgh is the horizontal grid mesh,
+ ! and it is limited by a stability-based length (RM17), as was done in Deardorff length (but taking into account shear as well)
+ ! For grid meshes in the grey zone, then this is the smaller of the two.
+ PLEM = MIN(PLEM,XCADAP*ZLMW)
+!
+!* 3.4 Delta mixing length
+! -------------------
+!
+ CASE ('DELT')
+ CALL DELT(PLEM,ODZ=.TRUE.)
+!
+!* 3.5 Deardorff mixing length
+! -----------------------
+!
+ CASE ('DEAR')
+ CALL DEAR(PLEM)
+!
+!* 3.6 Blackadar mixing length
+! -----------------------
+!
+ CASE ('BLKR')
+ ZL0 = 100.
+ PLEM(:,:,:) = ZL0
+
+ ZALPHA=0.5**(-1.5)
+ !
+ DO JK=IKTB,IKTE
+ PLEM(:,:,JK) = ( 0.5*(PZZ(:,:,JK)+PZZ(:,:,JK+KKL)) - &
+ & PZZ(:,:,KKA+JPVEXT_TURB*KKL) ) * PDIRCOSZW(:,:)
+ PLEM(:,:,JK) = ZALPHA * PLEM(:,:,JK) * ZL0 / ( ZL0 + ZALPHA*PLEM(:,:,JK) )
+ END DO
+!
+ PLEM(:,:,IKTB-1) = PLEM(:,:,IKTB)
+ PLEM(:,:,IKTE+1) = PLEM(:,:,IKTE)
+!
+!
+!
+END SELECT
+!
+!
+!
+!* 3.5 Mixing length modification for cloud
+! -----------------------
+IF (KMODEL_CL==KMI .AND. HTURBLEN_CL/='NONE') CALL CLOUD_MODIF_LM
+
+!
+!* 3.6 Dissipative length
+! ------------------
+!
+ZLEPS(:,:,:)=PLEM(:,:,:)
+!
+!* 3.7 Correction in the Surface Boundary Layer (Redelsperger 2001)
+! ----------------------------------------
+!
+ZLMO=XUNDEF
+IF (ORMC01) THEN
+ ZUSTAR=(PSFU**2+PSFV**2)**(0.25)
+ IF (KRR>0) THEN
+ ZLMO=LMO(ZUSTAR,ZTHLM(:,:,IKB),ZRM(:,:,IKB,1),PSFTH,PSFRV)
+ ELSE
+ ZRVM=0.
+ ZSFRV=0.
+ ZLMO=LMO(ZUSTAR,ZTHLM(:,:,IKB),ZRVM,PSFTH,ZSFRV)
+ END IF
+ CALL RMC01(HTURBLEN,KKA,KKU,KKL,PZZ,PDXX,PDYY,PDZZ,PDIRCOSZW,PSBL_DEPTH,ZLMO,PLEM,ZLEPS)
+END IF
+!
+!RMC01 is only applied on RM17 in ADAP
+IF (HTURBLEN=='ADAP') ZLEPS = MIN(ZLEPS,ZLMW*XCADAP)
+!
+!* 3.8 Mixing length in external points (used if HTURBDIM="3DIM")
+! ----------------------------------------------------------
+!
+IF (HTURBDIM=="3DIM") THEN
+ CALL UPDATE_LM(HLBCX,HLBCY,PLEM,ZLEPS)
+END IF
+!
+!* 3.9 Mixing length correction if immersed walls
+! ------------------------------------------
+!
+IF (LIBM) THEN
+ CALL IBM_MIXINGLENGTH(PLEM,ZLEPS,XIBM_XMUT,XIBM_LS(:,:,:,1),PTKET)
+ENDIF
+!----------------------------------------------------------------------------
+!
+!* 4. GO INTO THE AXES FOLLOWING THE SURFACE
+! --------------------------------------
+!
+!
+!* 4.1 rotate the wind at time t
+!
+!
+!
+ IF (CPROGRAM/='AROME ') THEN
+ CALL ROTATE_WIND(PUT,PVT,PWT, &
+ PDIRCOSXW, PDIRCOSYW, PDIRCOSZW, &
+ PCOSSLOPE,PSINSLOPE, &
+ PDXX,PDYY,PDZZ, &
+ ZUSLOPE,ZVSLOPE )
+!
+ CALL UPDATE_ROTATE_WIND(ZUSLOPE,ZVSLOPE)
+ ELSE
+ ZUSLOPE=PUT(:,:,KKA)
+ ZVSLOPE=PVT(:,:,KKA)
+ END IF
+!
+!
+!* 4.2 compute the proportionality coefficient between wind and stress
+!
+ ZCDUEFF(:,:) =-SQRT ( (PSFU(:,:)**2 + PSFV(:,:)**2) / &
+ (XMNH_TINY + ZUSLOPE(:,:)**2 + ZVSLOPE(:,:)**2 ) )
+!
+!* 4.6 compute the surface tangential fluxes
+!
+ZTAU11M(:,:) =2./3.*( (1.+ (PZZ (:,:,IKB+KKL)-PZZ (:,:,IKB)) &
+ /(PDZZ(:,:,IKB+KKL)+PDZZ(:,:,IKB)) &
+ ) *PTKET(:,:,IKB) &
+ -0.5 *PTKET(:,:,IKB+KKL) &
+ )
+ZTAU12M(:,:) =0.0
+ZTAU22M(:,:) =ZTAU11M(:,:)
+ZTAU33M(:,:) =ZTAU11M(:,:)
+!
+!* 4.7 third order terms in temperature and water fluxes and correlations
+! ------------------------------------------------------------------
+!
+!
+ZMWTH = 0. ! w'2th'
+ZMWR = 0. ! w'2r'
+ZMTH2 = 0. ! w'th'2
+ZMR2 = 0. ! w'r'2
+ZMTHR = 0. ! w'th'r'
+
+IF (HTOM=='TM06') THEN
+ CALL TM06(KKA,KKU,KKL,PTHVREF,PBL_DEPTH,PZZ,PSFTH,ZMWTH,ZMTH2)
+!
+ ZFWTH = -GZ_M_W(KKA,KKU,KKL,ZMWTH,PDZZ) ! -d(w'2th' )/dz
+ !ZFWR = -GZ_M_W(KKA,KKU,KKL,ZMWR, PDZZ) ! -d(w'2r' )/dz
+ ZFTH2 = -GZ_W_M(ZMTH2,PDZZ) ! -d(w'th'2 )/dz
+ !ZFR2 = -GZ_W_M(ZMR2, PDZZ) ! -d(w'r'2 )/dz
+ !ZFTHR = -GZ_W_M(ZMTHR,PDZZ) ! -d(w'th'r')/dz
+!
+ ZFWTH(:,:,IKTE:) = 0.
+ ZFWTH(:,:,:IKTB) = 0.
+ !ZFWR (:,:,IKTE:) = 0.
+ !ZFWR (:,:,:IKTB) = 0.
+ ZFWR = 0.
+ ZFTH2(:,:,IKTE:) = 0.
+ ZFTH2(:,:,:IKTB) = 0.
+ !ZFR2 (:,:,IKTE:) = 0.
+ !ZFR2 (:,:,:IKTB) = 0.
+ ZFR2 = 0.
+ !ZFTHR(:,:,IKTE:) = 0.
+ !ZFTHR(:,:,:IKTB) = 0.
+ ZFTHR = 0.
+ELSE
+ ZFWTH = 0.
+ ZFWR = 0.
+ ZFTH2 = 0.
+ ZFR2 = 0.
+ ZFTHR = 0.
+ENDIF
+!
+!----------------------------------------------------------------------------
+!
+!* 5. TURBULENT SOURCES
+! -----------------
+!
+if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U ), 'VTURB', prus (:, :, :) )
+if ( lbudget_v ) call Budget_store_init( tbudgets(NBUDGET_V ), 'VTURB', prvs (:, :, :) )
+if ( lbudget_w ) call Budget_store_init( tbudgets(NBUDGET_W ), 'VTURB', prws (:, :, :) )
+
+if ( lbudget_th ) then
+ if ( krri >= 1 .and. krrl >= 1 ) then
+ call Budget_store_init( tbudgets(NBUDGET_TH), 'VTURB', prthls(:, :, :) + zlvocpexnm(:, :, :) * prrs(:, :, :, 2) &
+ + zlsocpexnm(:, :, :) * prrs(:, :, :, 4) )
+ else if ( krrl >= 1 ) then
+ call Budget_store_init( tbudgets(NBUDGET_TH), 'VTURB', prthls(:, :, :) + zlocpexnm(:, :, :) * prrs(:, :, :, 2) )
+ else
+ call Budget_store_init( tbudgets(NBUDGET_TH), 'VTURB', prthls(:, :, :) )
+ end if
+end if
+
+if ( lbudget_rv ) then
+ if ( krri >= 1 .and. krrl >= 1 ) then
+ call Budget_store_init( tbudgets(NBUDGET_RV), 'VTURB', prrs(:, :, :, 1) - prrs(:, :, :, 2) - prrs(:, :, :, 4) )
+ else if ( krrl >= 1 ) then
+ call Budget_store_init( tbudgets(NBUDGET_RV), 'VTURB', prrs(:, :, :, 1) - prrs(:, :, :, 2) )
+ else
+ call Budget_store_init( tbudgets(NBUDGET_RV), 'VTURB', prrs(:, :, :, 1) )
+ end if
+end if
+
+if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'VTURB', prrs (:, :, :, 2) )
+if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'VTURB', prrs (:, :, :, 4) )
+
+if ( lbudget_sv ) then
+ do jsv = 1, nsv
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + jsv), 'VTURB', prsvs(:, :, :, jsv) )
+ end do
+end if
+
+CALL TURB_VER(KKA,KKU,KKL,KRR, KRRL, KRRI, &
+ OTURB_FLX, &
+ HTURBDIM,HTOM,PIMPL,ZEXPL, &
+ PTSTEP,TPFILE, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
+ PCOSSLOPE,PSINSLOPE, &
+ PRHODJ,PTHVREF, &
+ PSFTH,PSFRV,PSFSV,PSFTH,PSFRV,PSFSV, &
+ ZCDUEFF,ZTAU11M,ZTAU12M,ZTAU33M, &
+ PUT,PVT,PWT,ZUSLOPE,ZVSLOPE,PTHLT,PRT,PSVT, &
+ PTKET,PLEM,ZLEPS, &
+ ZLOCPEXNM,ZATHETA,ZAMOIST,PSRCT,ZFRAC_ICE, &
+ ZFWTH,ZFWR,ZFTH2,ZFR2,ZFTHR,PBL_DEPTH, &
+ PSBL_DEPTH,ZLMO, &
+ PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS, &
+ PDYP,PTHP,PSIGS,PWTH,PWRC,PWSV )
+
+if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'VTURB', prus(:, :, :) )
+if ( lbudget_v ) call Budget_store_end( tbudgets(NBUDGET_V), 'VTURB', prvs(:, :, :) )
+if ( lbudget_w ) call Budget_store_end( tbudgets(NBUDGET_W), 'VTURB', prws(:, :, :) )
+
+if ( lbudget_th ) then
+ if ( krri >= 1 .and. krrl >= 1 ) then
+ call Budget_store_end( tbudgets(NBUDGET_TH), 'VTURB', prthls(:, :, :) + zlvocpexnm(:, :, :) * prrs(:, :, :, 2) &
+ + zlsocpexnm(:, :, :) * prrs(:, :, :, 4) )
+ else if ( krrl >= 1 ) then
+ call Budget_store_end( tbudgets(NBUDGET_TH), 'VTURB', prthls(:, :, :) + zlocpexnm(:, :, :) * prrs(:, :, :, 2) )
+ else
+ call Budget_store_end( tbudgets(NBUDGET_TH), 'VTURB', prthls(:, :, :) )
+ end if
+end if
+
+if ( lbudget_rv ) then
+ if ( krri >= 1 .and. krrl >= 1 ) then
+ call Budget_store_end( tbudgets(NBUDGET_RV), 'VTURB', prrs(:, :, :, 1) - prrs(:, :, :, 2) - prrs(:, :, :, 4) )
+ else if ( krrl >= 1 ) then
+ call Budget_store_end( tbudgets(NBUDGET_RV), 'VTURB', prrs(:, :, :, 1) - prrs(:, :, :, 2) )
+ else
+ call Budget_store_end( tbudgets(NBUDGET_RV), 'VTURB', prrs(:, :, :, 1) )
+ end if
+end if
+
+if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'VTURB', prrs(:, :, :, 2) )
+if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'VTURB', prrs(:, :, :, 4) )
+
+if ( lbudget_sv ) then
+ do jsv = 1, nsv
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + jsv), 'VTURB', prsvs(:, :, :, jsv) )
+ end do
+end if
+!
+if ( hturbdim == '3DIM' ) then
+ if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U ), 'HTURB', prus (:, :, :) )
+ if ( lbudget_v ) call Budget_store_init( tbudgets(NBUDGET_V ), 'HTURB', prvs (:, :, :) )
+ if ( lbudget_w ) call Budget_store_init( tbudgets(NBUDGET_W ), 'HTURB', prws (:, :, :) )
+
+ if (lbudget_th) then
+ if ( krri >= 1 .and. krrl >= 1 ) then
+ call Budget_store_init( tbudgets(NBUDGET_TH), 'HTURB', prthls(:, :, :) + zlvocpexnm(:, :, :) * prrs(:, :, :, 2) &
+ + zlsocpexnm(:, :, :) * prrs(:, :, :, 4) )
+ else if ( krrl >= 1 ) then
+ call Budget_store_init( tbudgets(NBUDGET_TH), 'HTURB', prthls(:, :, :) + zlocpexnm(:, :, :) * prrs(:, :, :, 2) )
+ else
+ call Budget_store_init( tbudgets(NBUDGET_TH), 'HTURB', prthls(:, :, :) )
+ end if
+ end if
+
+ if ( lbudget_rv ) then
+ if ( krri >= 1 .and. krrl >= 1 ) then
+ call Budget_store_init( tbudgets(NBUDGET_RV), 'HTURB', prrs(:, :, :, 1) - prrs(:, :, :, 2) - prrs(:, :, :, 4) )
+ else if ( krrl >= 1 ) then
+ call Budget_store_init( tbudgets(NBUDGET_RV), 'HTURB', prrs(:, :, :, 1) - prrs(:, :, :, 2) )
+ else
+ call Budget_store_init( tbudgets(NBUDGET_RV), 'HTURB', prrs(:, :, :, 1) )
+ end if
+ end if
+
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'HTURB', prrs(:, :, :, 2) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'HTURB', prrs(:, :, :, 4) )
+
+ if ( lbudget_sv ) then
+ do jsv = 1, nsv
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + jsv), 'HTURB', prsvs(:, :, :, jsv) )
+ end do
+ end if
+
+ CALL TURB_HOR_SPLT(KSPLIT, KRR, KRRL, KRRI, PTSTEP, &
+ HLBCX,HLBCY,OTURB_FLX,OSUBG_COND, &
+ TPFILE, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
+ PDIRCOSXW,PDIRCOSYW,PDIRCOSZW, &
+ PCOSSLOPE,PSINSLOPE, &
+ PRHODJ,PTHVREF, &
+ PSFTH,PSFRV,PSFSV, &
+ ZCDUEFF,ZTAU11M,ZTAU12M,ZTAU22M,ZTAU33M, &
+ PUT,PVT,PWT,ZUSLOPE,ZVSLOPE,PTHLT,PRT,PSVT, &
+ PTKET,PLEM,ZLEPS, &
+ ZLOCPEXNM,ZATHETA,ZAMOIST,PSRCT,ZFRAC_ICE, &
+ PDYP,PTHP,PSIGS, &
+ ZTRH, &
+ PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS )
+
+ if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'HTURB', prus(:, :, :) )
+ if ( lbudget_v ) call Budget_store_end( tbudgets(NBUDGET_V), 'HTURB', prvs(:, :, :) )
+ if ( lbudget_w ) call Budget_store_end( tbudgets(NBUDGET_W), 'HTURB', prws(:, :, :) )
+
+ if ( lbudget_th ) then
+ if ( krri >= 1 .and. krrl >= 1 ) then
+ call Budget_store_end( tbudgets(NBUDGET_TH), 'HTURB', prthls(:, :, :) + zlvocpexnm(:, :, :) * prrs(:, :, :, 2) &
+ + zlsocpexnm(:, :, :) * prrs(:, :, :, 4) )
+ else if ( krrl >= 1 ) then
+ call Budget_store_end( tbudgets(NBUDGET_TH), 'HTURB', prthls(:, :, :) + zlocpexnm(:, :, :) * prrs(:, :, :, 2) )
+ else
+ call Budget_store_end( tbudgets(NBUDGET_TH), 'HTURB', prthls(:, :, :) )
+ end if
+ end if
+
+ if ( lbudget_rv ) then
+ if ( krri >= 1 .and. krrl >= 1 ) then
+ call Budget_store_end( tbudgets(NBUDGET_RV), 'HTURB', prrs(:, :, :, 1) - prrs(:, :, :, 2) - prrs(:, :, :, 4) )
+ else if ( krrl >= 1 ) then
+ call Budget_store_end( tbudgets(NBUDGET_RV), 'HTURB', prrs(:, :, :, 1) - prrs(:, :, :, 2) )
+ else
+ call Budget_store_end( tbudgets(NBUDGET_RV), 'HTURB', prrs(:, :, :, 1) )
+ end if
+ end if
+
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'HTURB', prrs(:, :, :, 2) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'HTURB', prrs(:, :, :, 4) )
+
+ if ( lbudget_sv ) then
+ do jsv = 1, nsv
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + jsv), 'HTURB', prsvs(:, :, :, jsv) )
+ end do
+ end if
+end if
+!----------------------------------------------------------------------------
+!
+!* 6. EVOLUTION OF THE TKE AND ITS DISSIPATION
+! ----------------------------------------
+!
+! 6.1 Contribution of mass-flux in the TKE buoyancy production if
+! cloud computation is not statistical
+
+ PTHP = PTHP + XG / PTHVREF * MZF( PFLXZTHVMF )
+
+! 6.2 TKE evolution equation
+
+CALL TKE_EPS_SOURCES(KKA,KKU,KKL,KMI,PTKET,PLEM,ZLEPS,PDYP,ZTRH, &
+ PRHODJ,PDZZ,PDXX,PDYY,PDZX,PDZY,PZZ, &
+ PTSTEP,PIMPL,ZEXPL, &
+ HTURBLEN,HTURBDIM, &
+ TPFILE,OTURB_DIAG, &
+ PTHP,PRTKES,PRTKEMS,PRTHLS,ZCOEF_DISS,PTR,PDISS )
+
+!----------------------------------------------------------------------------
+!
+!* 7. STORES SOME INFORMATIONS RELATED TO THE TURBULENCE SCHEME
+! ---------------------------------------------------------
+!
+IF ( OTURB_DIAG .AND. tpfile%lopened ) THEN
+!
+! stores the mixing length
+!
+ TZFIELD%CMNHNAME = 'LM'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'LM'
+ TZFIELD%CUNITS = 'm'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'Mixing length'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,PLEM)
+!
+ IF (KRR /= 0) THEN
+!
+! stores the conservative potential temperature
+!
+ TZFIELD%CMNHNAME = 'THLM'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'THLM'
+ TZFIELD%CUNITS = 'K'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'Conservative potential temperature'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,PTHLT)
+!
+! stores the conservative mixing ratio
+!
+ TZFIELD%CMNHNAME = 'RNPM'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'RNPM'
+ TZFIELD%CUNITS = 'kg kg-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'Conservative mixing ratio'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,PRT(:,:,:,1))
+ END IF
+END IF
+!
+!----------------------------------------------------------------------------
+!
+!* 8. RETRIEVE NON-CONSERVATIVE VARIABLES
+! -----------------------------------
+!
+IF ( KRRL >= 1 ) THEN
+ IF ( KRRI >= 1 ) THEN
+ PRT(:,:,:,1) = PRT(:,:,:,1) - PRT(:,:,:,2) - PRT(:,:,:,4)
+ PRRS(:,:,:,1) = PRRS(:,:,:,1) - PRRS(:,:,:,2) - PRRS(:,:,:,4)
+ PTHLT(:,:,:) = PTHLT(:,:,:) + ZLVOCPEXNM(:,:,:) * PRT(:,:,:,2) &
+ + ZLSOCPEXNM(:,:,:) * PRT(:,:,:,4)
+ PRTHLS(:,:,:) = PRTHLS(:,:,:) + ZLVOCPEXNM(:,:,:) * PRRS(:,:,:,2) &
+ + ZLSOCPEXNM(:,:,:) * PRRS(:,:,:,4)
+!
+ DEALLOCATE(ZLVOCPEXNM)
+ DEALLOCATE(ZLSOCPEXNM)
+ ELSE
+ PRT(:,:,:,1) = PRT(:,:,:,1) - PRT(:,:,:,2)
+ PRRS(:,:,:,1) = PRRS(:,:,:,1) - PRRS(:,:,:,2)
+ PTHLT(:,:,:) = PTHLT(:,:,:) + ZLOCPEXNM(:,:,:) * PRT(:,:,:,2)
+ PRTHLS(:,:,:) = PRTHLS(:,:,:) + ZLOCPEXNM(:,:,:) * PRRS(:,:,:,2)
+ END IF
+END IF
+
+! Remove non-physical negative values (unnecessary in a perfect world) + corresponding budgets
+call Sources_neg_correct( hcloud, 'NETUR', krr, ptstep, ppabst, pthlt, prt, prthls, prrs, prsvs )
+
+!----------------------------------------------------------------------------
+!
+!* 9. LES averaged surface fluxes
+! ---------------------------
+!
+IF (LLES_CALL) THEN
+ CALL SECOND_MNH(ZTIME1)
+ CALL LES_MEAN_SUBGRID(PSFTH,X_LES_Q0)
+ CALL LES_MEAN_SUBGRID(PSFRV,X_LES_E0)
+ DO JSV=1,NSV
+ CALL LES_MEAN_SUBGRID(PSFSV(:,:,JSV),X_LES_SV0(:,JSV))
+ END DO
+ CALL LES_MEAN_SUBGRID(PSFU,X_LES_UW0)
+ CALL LES_MEAN_SUBGRID(PSFV,X_LES_VW0)
+ CALL LES_MEAN_SUBGRID((PSFU*PSFU+PSFV*PSFV)**0.25,X_LES_USTAR)
+!----------------------------------------------------------------------------
+!
+!* 10. LES for 3rd order moments
+! -------------------------
+!
+ CALL LES_MEAN_SUBGRID(ZMWTH,X_LES_SUBGRID_W2Thl)
+ CALL LES_MEAN_SUBGRID(ZMTH2,X_LES_SUBGRID_WThl2)
+ IF (KRR>0) THEN
+ CALL LES_MEAN_SUBGRID(ZMWR,X_LES_SUBGRID_W2Rt)
+ CALL LES_MEAN_SUBGRID(ZMTHR,X_LES_SUBGRID_WThlRt)
+ CALL LES_MEAN_SUBGRID(ZMR2,X_LES_SUBGRID_WRt2)
+ END IF
+!
+!----------------------------------------------------------------------------
+!
+!* 11. LES quantities depending on <w'2> in "1DIM" mode
+! ------------------------------------------------
+!
+ IF (HTURBDIM=="1DIM") THEN
+ CALL LES_MEAN_SUBGRID(2./3.*PTKET,X_LES_SUBGRID_U2)
+ X_LES_SUBGRID_V2 = X_LES_SUBGRID_U2
+ X_LES_SUBGRID_W2 = X_LES_SUBGRID_U2
+ CALL LES_MEAN_SUBGRID(2./3.*PTKET*MZF(&
+ & GZ_M_W(KKA,KKU,KKL,PTHLT,PDZZ)),X_LES_RES_ddz_Thl_SBG_W2)
+ IF (KRR>=1) &
+ CALL LES_MEAN_SUBGRID(2./3.*PTKET*MZF(&
+ & GZ_M_W(KKA,KKU,KKL,PRT(:,:,:,1),PDZZ)),X_LES_RES_ddz_Rt_SBG_W2)
+ DO JSV=1,NSV
+ CALL LES_MEAN_SUBGRID(2./3.*PTKET*MZF(&
+ & GZ_M_W(KKA,KKU,KKL,PSVT(:,:,:,JSV),PDZZ)),X_LES_RES_ddz_Sv_SBG_W2(:,:,:,JSV))
+ END DO
+ END IF
+
+!----------------------------------------------------------------------------
+!
+!* 12. LES mixing end dissipative lengths, presso-correlations
+! -------------------------------------------------------
+!
+ CALL LES_MEAN_SUBGRID(PLEM,X_LES_SUBGRID_LMix)
+ CALL LES_MEAN_SUBGRID(ZLEPS,X_LES_SUBGRID_LDiss)
+!
+!* presso-correlations for subgrid Tke are equal to zero.
+!
+ ZLEPS = 0. !ZLEPS is used as a work array (not used anymore)
+ CALL LES_MEAN_SUBGRID(ZLEPS,X_LES_SUBGRID_WP)
+!
+ CALL SECOND_MNH(ZTIME2)
+ XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+END IF
+
+!
+
+!
+!----------------------------------------------------------------------------
+!
+CONTAINS
+!
+!
+! ##############################################
+ SUBROUTINE UPDATE_ROTATE_WIND(PUSLOPE,PVSLOPE)
+! ##############################################
+!!
+!!**** *UPDATE_ROTATE_WIND* routine to set rotate wind values at the border
+!
+!! AUTHOR
+!! ------
+!!
+!! P Jabouille *CNRM METEO-FRANCE
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 24/06/99
+!! J.Escobar 21/03/2013: for HALOK comment all NHALO=1 test
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+USE MODE_ll
+USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+USE MODD_CONF
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PUSLOPE,PVSLOPE
+! tangential surface fluxes in the axes following the orography
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IIB,IIE,IJB,IJE ! index values for the physical subdomain
+TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
+INTEGER :: IINFO_ll ! return code of parallel routine
+!
+!* 1 PROLOGUE
+!
+NULLIFY(TZFIELDS_ll)
+!
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+!
+! 2 Update halo if necessary
+!
+!!$IF (NHALO == 1) THEN
+ CALL ADD2DFIELD_ll( TZFIELDS_ll, PUSLOPE, 'UPDATE_ROTATE_WIND::PUSLOPE' )
+ CALL ADD2DFIELD_ll( TZFIELDS_ll, PVSLOPE, 'UPDATE_ROTATE_WIND::PVSLOPE' )
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+!!$ENDIF
+!
+! 3 Boundary conditions for non cyclic case
+!
+IF ( HLBCX(1) /= "CYCL" .AND. LWEST_ll()) THEN
+ PUSLOPE(IIB-1,:)=PUSLOPE(IIB,:)
+ PVSLOPE(IIB-1,:)=PVSLOPE(IIB,:)
+END IF
+IF ( HLBCX(2) /= "CYCL" .AND. LEAST_ll()) THEN
+ PUSLOPE(IIE+1,:)=PUSLOPE(IIE,:)
+ PVSLOPE(IIE+1,:)=PVSLOPE(IIE,:)
+END IF
+IF ( HLBCY(1) /= "CYCL" .AND. LSOUTH_ll()) THEN
+ PUSLOPE(:,IJB-1)=PUSLOPE(:,IJB)
+ PVSLOPE(:,IJB-1)=PVSLOPE(:,IJB)
+END IF
+IF( HLBCY(2) /= "CYCL" .AND. LNORTH_ll()) THEN
+ PUSLOPE(:,IJE+1)=PUSLOPE(:,IJE)
+ PVSLOPE(:,IJE+1)=PVSLOPE(:,IJE)
+END IF
+!
+END SUBROUTINE UPDATE_ROTATE_WIND
+!
+! ########################################################################
+ SUBROUTINE COMPUTE_FUNCTION_THERMO(PALP,PBETA,PGAM,PLTT,PC,PT,PEXN,PCP,&
+ PLOCPEXN,PAMOIST,PATHETA )
+! ########################################################################
+!!
+!!**** *COMPUTE_FUNCTION_THERMO* routine to compute several thermo functions
+!
+!! AUTHOR
+!! ------
+!!
+!! JP Pinty *LA*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 24/02/03
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+USE MODD_CST
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments
+!
+REAL, INTENT(IN) :: PALP,PBETA,PGAM,PLTT,PC
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PT,PEXN,PCP
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLOCPEXN
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PAMOIST,PATHETA
+!
+!* 0.2 Declarations of local variables
+!
+REAL :: ZEPS ! XMV / XMD
+REAL, DIMENSION(SIZE(PEXN,1),SIZE(PEXN,2),SIZE(PEXN,3)) :: ZRVSAT
+REAL, DIMENSION(SIZE(PEXN,1),SIZE(PEXN,2),SIZE(PEXN,3)) :: ZDRVSATDT
+!
+!-------------------------------------------------------------------------------
+!
+ ZEPS = XMV / XMD
+!
+!* 1.1 Lv/Cph at t
+!
+ PLOCPEXN(:,:,:) = ( PLTT + (XCPV-PC) * (PT(:,:,:)-XTT) ) / PCP(:,:,:)
+!
+!* 1.2 Saturation vapor pressure at t
+!
+ ZRVSAT(:,:,:) = EXP( PALP - PBETA/PT(:,:,:) - PGAM*ALOG( PT(:,:,:) ) )
+!
+!* 1.3 saturation mixing ratio at t
+!
+ ZRVSAT(:,:,:) = ZRVSAT(:,:,:) * ZEPS / ( PPABST(:,:,:) - ZRVSAT(:,:,:) )
+!
+!* 1.4 compute the saturation mixing ratio derivative (rvs')
+!
+ ZDRVSATDT(:,:,:) = ( PBETA / PT(:,:,:) - PGAM ) / PT(:,:,:) &
+ * ZRVSAT(:,:,:) * ( 1. + ZRVSAT(:,:,:) / ZEPS )
+!
+!* 1.5 compute Amoist
+!
+ PAMOIST(:,:,:)= 0.5 / ( 1.0 + ZDRVSATDT(:,:,:) * PLOCPEXN(:,:,:) )
+!
+!* 1.6 compute Atheta
+!
+ PATHETA(:,:,:)= PAMOIST(:,:,:) * PEXN(:,:,:) * &
+ ( ( ZRVSAT(:,:,:) - PRT(:,:,:,1) ) * PLOCPEXN(:,:,:) / &
+ ( 1. + ZDRVSATDT(:,:,:) * PLOCPEXN(:,:,:) ) * &
+ ( &
+ ZRVSAT(:,:,:) * (1. + ZRVSAT(:,:,:)/ZEPS) &
+ * ( -2.*PBETA/PT(:,:,:) + PGAM ) / PT(:,:,:)**2 &
+ +ZDRVSATDT(:,:,:) * (1. + 2. * ZRVSAT(:,:,:)/ZEPS) &
+ * ( PBETA/PT(:,:,:) - PGAM ) / PT(:,:,:) &
+ ) &
+ - ZDRVSATDT(:,:,:) &
+ )
+!
+!* 1.7 Lv/Cph/Exner at t-1
+!
+ PLOCPEXN(:,:,:) = PLOCPEXN(:,:,:) / PEXN(:,:,:)
+!
+END SUBROUTINE COMPUTE_FUNCTION_THERMO
+!
+! ####################
+ SUBROUTINE DELT(PLM,ODZ)
+! ####################
+!!
+!!**** *DELT* routine to compute mixing length for DELT case
+!
+!! AUTHOR
+!! ------
+!!
+!! M Tomasini *Meteo-France
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/05
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!* 0.1 Declarations of dummy arguments
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLM
+LOGICAL, INTENT(IN) :: ODZ
+!
+!* 0.2 Declarations of local variables
+!
+REAL :: ZD ! distance to the surface
+!
+!-------------------------------------------------------------------------------
+!
+IF (ODZ) THEN
+ ! Dz is take into account in the computation
+ DO JK = IKTB,IKTE ! 1D turbulence scheme
+ PLM(:,:,JK) = PZZ(:,:,JK+KKL) - PZZ(:,:,JK)
+ END DO
+ PLM(:,:,KKU) = PLM(:,:,IKE)
+ PLM(:,:,KKA) = PZZ(:,:,IKB) - PZZ(:,:,KKA)
+ IF ( HTURBDIM /= '1DIM' ) THEN ! 3D turbulence scheme
+ IF ( L2D) THEN
+ PLM(:,:,:) = SQRT( PLM(:,:,:)*MXF(PDXX(:,:,:)) )
+ ELSE
+ PLM(:,:,:) = (PLM(:,:,:)*MXF(PDXX(:,:,:))*MYF(PDYY(:,:,:)) ) ** (1./3.)
+ END IF
+ END IF
+ELSE
+ ! Dz not taken into account in computation to assure invariability with vertical grid mesh
+ PLM=1.E10
+ IF ( HTURBDIM /= '1DIM' ) THEN ! 3D turbulence scheme
+ IF ( L2D) THEN
+ PLM(:,:,:) = MXF(PDXX(:,:,:))
+ ELSE
+ PLM(:,:,:) = (MXF(PDXX(:,:,:))*MYF(PDYY(:,:,:)) ) ** (1./2.)
+ END IF
+ END IF
+END IF
+
+!
+! mixing length limited by the distance normal to the surface
+! (with the same factor as for BL89)
+!
+IF (.NOT. ORMC01) THEN
+ ZALPHA=0.5**(-1.5)
+ !
+ DO JJ=1,SIZE(PUT,2)
+ DO JI=1,SIZE(PUT,1)
+ IF (LOCEAN) THEN
+ DO JK=IKTE,IKTB,-1
+ ZD=ZALPHA*(PZZ(JI,JJ,IKTE+1)-PZZ(JI,JJ,JK))
+ IF ( PLM(JI,JJ,JK)>ZD) THEN
+ PLM(JI,JJ,JK)=ZD
+ ELSE
+ EXIT
+ ENDIF
+ END DO
+ ELSE
+ DO JK=IKTB,IKTE
+ ZD=ZALPHA*(0.5*(PZZ(JI,JJ,JK)+PZZ(JI,JJ,JK+KKL))&
+ -PZZ(JI,JJ,IKB)) *PDIRCOSZW(JI,JJ)
+ IF ( PLM(JI,JJ,JK)>ZD) THEN
+ PLM(JI,JJ,JK)=ZD
+ ELSE
+ EXIT
+ ENDIF
+ END DO
+ ENDIF
+ END DO
+ END DO
+END IF
+!
+PLM(:,:,KKA) = PLM(:,:,IKB )
+PLM(:,:,KKU ) = PLM(:,:,IKE)
+!
+END SUBROUTINE DELT
+!
+! ####################
+ SUBROUTINE DEAR(PLM)
+! ####################
+!!
+!!**** *DEAR* routine to compute mixing length for DEARdorff case
+!
+!! AUTHOR
+!! ------
+!!
+!! M Tomasini *Meteo-France
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/05
+!! I.Sandu (Sept.2006) : Modification of the stability criterion
+!! (theta_v -> theta_l)
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!* 0.1 Declarations of dummy arguments
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLM
+!
+!* 0.2 Declarations of local variables
+!
+REAL :: ZD ! distance to the surface
+REAL :: ZVAR ! Intermediary variable
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2)) :: ZWORK2D
+!
+REAL, DIMENSION(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)) :: &
+ ZDTHLDZ,ZDRTDZ, &!dtheta_l/dz, drt_dz used for computing the stablity
+! ! criterion
+ ZETHETA,ZEMOIST !coef ETHETA and EMOIST
+!----------------------------------------------------------------------------
+!
+!-------------------------------------------------------------------------------
+!
+! initialize the mixing length with the mesh grid
+! 1D turbulence scheme
+PLM(:,:,IKTB:IKTE) = PZZ(:,:,IKTB+KKL:IKTE+KKL) - PZZ(:,:,IKTB:IKTE)
+PLM(:,:,KKU) = PLM(:,:,IKE)
+PLM(:,:,KKA) = PZZ(:,:,IKB) - PZZ(:,:,KKA)
+IF ( HTURBDIM /= '1DIM' ) THEN ! 3D turbulence scheme
+ IF ( L2D) THEN
+ PLM(:,:,:) = SQRT( PLM(:,:,:)*MXF(PDXX(:,:,:)) )
+ ELSE
+ PLM(:,:,:) = (PLM(:,:,:)*MXF(PDXX(:,:,:))*MYF(PDYY(:,:,:)) ) ** (1./3.)
+ END IF
+END IF
+! compute a mixing length limited by the stability
+!
+ZETHETA(:,:,:) = ETHETA(KRR,KRRI,PTHLT,PRT,ZLOCPEXNM,ZATHETA,PSRCT)
+ZEMOIST(:,:,:) = EMOIST(KRR,KRRI,PTHLT,PRT,ZLOCPEXNM,ZAMOIST,PSRCT)
+!
+IF (KRR>0) THEN
+ DO JK = IKTB+1,IKTE-1
+ DO JJ=1,SIZE(PUT,2)
+ DO JI=1,SIZE(PUT,1)
+ ZDTHLDZ(JI,JJ,JK)= 0.5*((PTHLT(JI,JJ,JK+KKL)-PTHLT(JI,JJ,JK ))/PDZZ(JI,JJ,JK+KKL)+ &
+ (PTHLT(JI,JJ,JK )-PTHLT(JI,JJ,JK-KKL))/PDZZ(JI,JJ,JK ))
+ ZDRTDZ(JI,JJ,JK) = 0.5*((PRT(JI,JJ,JK+KKL,1)-PRT(JI,JJ,JK ,1))/PDZZ(JI,JJ,JK+KKL)+ &
+ (PRT(JI,JJ,JK ,1)-PRT(JI,JJ,JK-KKL,1))/PDZZ(JI,JJ,JK ))
+ IF (LOCEAN) THEN
+ ZVAR=XG*(XALPHAOC*ZDTHLDZ(JI,JJ,JK)-XBETAOC*ZDRTDZ(JI,JJ,JK))
+ ELSE
+ ZVAR=XG/PTHVREF(JI,JJ,JK)* &
+ (ZETHETA(JI,JJ,JK)*ZDTHLDZ(JI,JJ,JK)+ZEMOIST(JI,JJ,JK)*ZDRTDZ(JI,JJ,JK))
+ END IF
+ !
+ IF (ZVAR>0.) THEN
+ PLM(JI,JJ,JK)=MAX(XMNH_EPSILON,MIN(PLM(JI,JJ,JK), &
+ 0.76* SQRT(PTKET(JI,JJ,JK)/ZVAR)))
+ END IF
+ END DO
+ END DO
+ END DO
+ELSE! For dry atmos or unsalted ocean runs
+ DO JK = IKTB+1,IKTE-1
+ DO JJ=1,SIZE(PUT,2)
+ DO JI=1,SIZE(PUT,1)
+ ZDTHLDZ(JI,JJ,JK)= 0.5*((PTHLT(JI,JJ,JK+KKL)-PTHLT(JI,JJ,JK ))/PDZZ(JI,JJ,JK+KKL)+ &
+ (PTHLT(JI,JJ,JK )-PTHLT(JI,JJ,JK-KKL))/PDZZ(JI,JJ,JK ))
+ IF (LOCEAN) THEN
+ ZVAR= XG*XALPHAOC*ZDTHLDZ(JI,JJ,JK)
+ ELSE
+ ZVAR= XG/PTHVREF(JI,JJ,JK)*ZETHETA(JI,JJ,JK)*ZDTHLDZ(JI,JJ,JK)
+ END IF
+!
+ IF (ZVAR>0.) THEN
+ PLM(JI,JJ,JK)=MAX(XMNH_EPSILON,MIN(PLM(JI,JJ,JK), &
+ 0.76* SQRT(PTKET(JI,JJ,JK)/ZVAR)))
+ END IF
+ END DO
+ END DO
+ END DO
+END IF
+! special case near the surface
+ZDTHLDZ(:,:,IKB)=(PTHLT(:,:,IKB+KKL)-PTHLT(:,:,IKB))/PDZZ(:,:,IKB+KKL)
+! For dry simulations
+IF (KRR>0) THEN
+ ZDRTDZ(:,:,IKB)=(PRT(:,:,IKB+KKL,1)-PRT(:,:,IKB,1))/PDZZ(:,:,IKB+KKL)
+ELSE
+ ZDRTDZ(:,:,IKB)=0
+ENDIF
+!
+IF (LOCEAN) THEN
+ ZWORK2D(:,:)=XG*(XALPHAOC*ZDTHLDZ(:,:,IKB)-XBETAOC*ZDRTDZ(:,:,IKB))
+ELSE
+ ZWORK2D(:,:)=XG/PTHVREF(:,:,IKB)* &
+ (ZETHETA(:,:,IKB)*ZDTHLDZ(:,:,IKB)+ZEMOIST(:,:,IKB)*ZDRTDZ(:,:,IKB))
+END IF
+WHERE(ZWORK2D(:,:)>0.)
+ PLM(:,:,IKB)=MAX(XMNH_EPSILON,MIN( PLM(:,:,IKB), &
+ 0.76* SQRT(PTKET(:,:,IKB)/ZWORK2D(:,:))))
+END WHERE
+!
+! mixing length limited by the distance normal to the surface (with the same factor as for BL89)
+!
+IF (.NOT. ORMC01) THEN
+ ZALPHA=0.5**(-1.5)
+ !
+ DO JJ=1,SIZE(PUT,2)
+ DO JI=1,SIZE(PUT,1)
+ IF (LOCEAN) THEN
+ DO JK=IKTE,IKTB,-1
+ ZD=ZALPHA*(PZZ(JI,JJ,IKTE+1)-PZZ(JI,JJ,JK))
+ IF ( PLM(JI,JJ,JK)>ZD) THEN
+ PLM(JI,JJ,JK)=ZD
+ ELSE
+ EXIT
+ ENDIF
+ END DO
+ ELSE
+ DO JK=IKTB,IKTE
+ ZD=ZALPHA*(0.5*(PZZ(JI,JJ,JK)+PZZ(JI,JJ,JK+KKL))-PZZ(JI,JJ,IKB)) &
+ *PDIRCOSZW(JI,JJ)
+ IF ( PLM(JI,JJ,JK)>ZD) THEN
+ PLM(JI,JJ,JK)=ZD
+ ELSE
+ EXIT
+ ENDIF
+ END DO
+ ENDIF
+ END DO
+ END DO
+END IF
+!
+PLM(:,:,KKA) = PLM(:,:,IKB )
+PLM(:,:,IKE ) = PLM(:,:,IKE-KKL)
+PLM(:,:,KKU ) = PLM(:,:,KKU-KKL)
+!
+END SUBROUTINE DEAR
+!
+! #########################
+ SUBROUTINE CLOUD_MODIF_LM
+! #########################
+!!
+!!*****CLOUD_MODIF_LM routine to:
+!! 1/ change the mixing length in the clouds
+!! 2/ emphasize the mixing length in the cloud
+!! by the coefficient ZCOEF_AMPL calculated here
+!! when the CEI index is above ZCEI_MIN.
+!!
+!!
+!! ZCOEF_AMPL ^
+!! |
+!! |
+!! ZCOEF_AMPL_SAT - ---------- Saturation
+!! (XDUMMY1) | -
+!! | -
+!! | -
+!! | -
+!! | - Amplification
+!! | - straight
+!! | - line
+!! | -
+!! | -
+!! | -
+!! | -
+!! | -
+!! 1 ------------
+!! |
+!! |
+!! 0 -----------|------------|----------> PCEI
+!! 0 ZCEI_MIN ZCEI_MAX
+!! (XDUMMY2) (XDUMMY3)
+!!
+!!
+!!
+!! AUTHOR
+!! ------
+!! M. Tomasini *CNRM METEO-FRANCE
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 09/07/04
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+REAL :: ZPENTE ! Slope of the amplification straight line
+REAL :: ZCOEF_AMPL_CEI_NUL! Ordonnate at the origin of the
+ ! amplification straight line
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZCOEF_AMPL
+ ! Amplification coefficient of the mixing length
+ ! when the instability criterium is verified
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZLM_CLOUD
+ ! Turbulent mixing length in the clouds
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. INITIALISATION
+! --------------
+!
+ZPENTE = ( PCOEF_AMPL_SAT - 1. ) / ( PCEI_MAX - PCEI_MIN )
+ZCOEF_AMPL_CEI_NUL = 1. - ZPENTE * PCEI_MIN
+!
+ZCOEF_AMPL(:,:,:) = 1.
+!
+!* 2. CALCULATION OF THE AMPLIFICATION COEFFICIENT
+! --------------------------------------------
+!
+! Saturation
+!
+WHERE ( PCEI(:,:,:)>=PCEI_MAX ) ZCOEF_AMPL(:,:,:)=PCOEF_AMPL_SAT
+!
+! Between the min and max limits of CEI index, linear variation of the
+! amplification coefficient ZCOEF_AMPL as a function of CEI
+!
+WHERE ( PCEI(:,:,:) < PCEI_MAX .AND. &
+ PCEI(:,:,:) > PCEI_MIN ) &
+ ZCOEF_AMPL(:,:,:) = ZPENTE * PCEI(:,:,:) + ZCOEF_AMPL_CEI_NUL
+!
+!
+!* 3. CALCULATION OF THE MIXING LENGTH IN CLOUDS
+! ------------------------------------------
+!
+IF (HTURBLEN_CL == HTURBLEN) THEN
+ ZLM_CLOUD(:,:,:) = PLEM(:,:,:)
+ELSE
+ SELECT CASE (HTURBLEN_CL)
+!
+!* 3.1 BL89 mixing length
+! ------------------
+ CASE ('BL89','RM17','ADAP')
+ ZSHEAR=0.
+ CALL BL89(KKA,KKU,KKL,PZZ,PDZZ,PTHVREF,ZTHLM,KRR,ZRM,PTKET,ZSHEAR,ZLM_CLOUD)
+!
+!* 3.2 Delta mixing length
+! -------------------
+ CASE ('DELT')
+ CALL DELT(ZLM_CLOUD,ODZ=.TRUE.)
+!
+!* 3.3 Deardorff mixing length
+! -----------------------
+ CASE ('DEAR')
+ CALL DEAR(ZLM_CLOUD)
+!
+ END SELECT
+ENDIF
+!
+!* 4. MODIFICATION OF THE MIXING LENGTH IN THE CLOUDS
+! -----------------------------------------------
+!
+! Impression before modification of the mixing length
+IF ( OTURB_DIAG .AND. tpfile%lopened ) THEN
+ TZFIELD%CMNHNAME = 'LM_CLEAR_SKY'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'LM_CLEAR_SKY'
+ TZFIELD%CUNITS = 'm'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_LM CLEAR SKY'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,PLEM)
+ENDIF
+!
+! Amplification of the mixing length when the criteria are verified
+!
+WHERE (ZCOEF_AMPL(:,:,:) /= 1.) PLEM(:,:,:) = ZCOEF_AMPL(:,:,:)*ZLM_CLOUD(:,:,:)
+!
+! Cloud mixing length in the clouds at the points which do not verified the CEI
+!
+WHERE (PCEI(:,:,:) == -1.) PLEM(:,:,:) = ZLM_CLOUD(:,:,:)
+!
+!
+!* 5. IMPRESSION
+! ----------
+!
+IF ( OTURB_DIAG .AND. tpfile%lopened ) THEN
+ TZFIELD%CMNHNAME = 'COEF_AMPL'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'COEF_AMPL'
+ TZFIELD%CUNITS = '1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_COEF AMPL'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZCOEF_AMPL)
+ !
+ TZFIELD%CMNHNAME = 'LM_CLOUD'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'LM_CLOUD'
+ TZFIELD%CUNITS = 'm'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_LM CLOUD'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ CALL IO_Field_write(TPFILE,TZFIELD,ZLM_CLOUD)
+ !
+ENDIF
+!
+END SUBROUTINE CLOUD_MODIF_LM
+!
+END SUBROUTINE TURB
diff --git a/src/mesonh/turb/turb_cloud_index.f90 b/src/mesonh/turb/turb_cloud_index.f90
new file mode 100644
index 000000000..c194db611
--- /dev/null
+++ b/src/mesonh/turb/turb_cloud_index.f90
@@ -0,0 +1,344 @@
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ################
+ MODULE MODI_TURB_CLOUD_INDEX
+! ################
+!
+INTERFACE
+!
+ SUBROUTINE TURB_CLOUD_INDEX(PTSTEP,TPFILE, &
+ OTURB_DIAG,KRRI, &
+ PRRS,PRM,PRHODJ,PDXX,PDYY,PDZZ,PDZX,PDZY, &
+ PCEI )
+!
+USE MODD_IO, ONLY: TFILEDATA
+!
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+LOGICAL, INTENT(IN) :: OTURB_DIAG ! switch to write some
+ ! diagnostic fields in the syncronous FM-file
+INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRRS ! Sources term of RR
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Variable at t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Jacobian * dry density of
+ ! the reference state
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
+ ! metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(OUT):: PCEI ! Cloud Entrainment instability
+ ! index to emphasize locally
+ ! turbulent fluxes
+!
+END SUBROUTINE TURB_CLOUD_INDEX
+!
+END INTERFACE
+!
+END MODULE MODI_TURB_CLOUD_INDEX
+!
+! #######################
+ SUBROUTINE TURB_CLOUD_INDEX(PTSTEP,TPFILE, &
+ OTURB_DIAG,KRRI, &
+ PRRS,PRM,PRHODJ,PDXX,PDYY,PDZZ,PDZX,PDZY, &
+ PCEI )
+! #######################
+ !
+!! PURPOSE
+!! -------
+!! CEI (cloud Entrainment Instability) index calculation
+!! It permits to localize cloudy points where a different mixing length
+!! from the one in clear sky can be applicated
+!! It permits to quantify also, at those cloudy points, an instability
+!! that can emphasize sub-grid turbulence.
+!! If such an instability exists, mixing length is increased proportionnaly
+!! to that CEI criterium
+!!
+!!** METHOD
+!! ------
+!!
+!! Criteria: For a cloudy point or a point adjacent to a cloudy point,
+!! G = NORM( dVAR/dx_j ) > threshold
+!! Q_j = DG_j/Dt of the same sign as G_j
+!! where VAR=rv+rc+ri and j=x or y
+!! then CEI= NORM(Q)
+!!
+!! EXTERNAL
+!! --------
+!! GX_M_M, GY_M_M : Cartesian gradient operators
+!! FMWRIT : FM-routine to write a record
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODI_GRADIENT_M : GX_M_M, GY_M_M
+!!
+!! AUTHOR
+!! ------
+!! M. Tomasini * Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 15/09/94
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!
+!-------------------------------------------------------------------------------
+!
+use modd_field, only: tfielddata, TYPEREAL
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_PARAMETERS, ONLY: JPVEXT
+!
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+use mode_tools_ll, only: GET_INDICE_ll
+!
+USE MODI_GRADIENT_M
+!
+IMPLICIT NONE
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!* 0.1 declarations of arguments
+!
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+LOGICAL, INTENT(IN) :: OTURB_DIAG ! switch to write some
+ ! diagnostic fields in the syncronous FM-file
+INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRRS ! Sources term of RR
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Variable at t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Jacobian * dry density of
+ ! the reference state
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
+ ! metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(OUT):: PCEI ! Cloud Entrainment instability
+ ! index to emphasize locally
+ ! turbulent fluxes
+!
+!* 0.2 declarations of local variables
+!
+REAL, DIMENSION(SIZE(PRM,1),SIZE(PRM,2),SIZE(PRM,3)) :: ZWORK,ZRVCI0 ! Work arrays
+REAL, DIMENSION(SIZE(PRM,1),SIZE(PRM,2),SIZE(PRM,3)) :: ZCLOUD
+ ! rc+ri at time after ADVECTION routine
+ ! for the CEI criterium
+REAL, DIMENSION(SIZE(PRM,1),SIZE(PRM,2),SIZE(PRM,3)) :: ZRVCI,ZGNORM_RVCI,ZQNORM_RVCI
+ ! rv+rc+ri at time after ADVECTION routine
+ ! horizontal norm of the vector PG_RVCI
+ ! horizontal norm of the vector PQ_RVCI
+REAL, DIMENSION(SIZE(PRM,1),SIZE(PRM,2),SIZE(PRM,3),2) :: ZG_RVCI,ZQ_RVCI
+ ! x and y gradient of rv+rc+ri
+ ! x and y gradient of the advection of rv+rc+ri
+!
+INTEGER :: JI,JJ,JK ! loop counters
+INTEGER :: IIB,IJB,IKB ! Begin of physical dimensions
+INTEGER :: IIE,IJE,IKE ! End of physical dimensions
+INTEGER, DIMENSION(SIZE(PRM,1),SIZE(PRM,2),SIZE(PRM,3)) :: IMASK_CLOUD
+ ! 0 except cloudy points or adjacent points (1)
+TYPE(TFIELDDATA) :: TZFIELD
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. INITIALISATION
+! --------------
+!
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+IKB = 1 + JPVEXT
+IKE = SIZE(PRM,3) - JPVEXT
+!
+IMASK_CLOUD(:,:,:) = 0
+PCEI(:,:,:) = 0.
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. CALCULATION
+! -----------
+!* 2.1 Gradients calculation of the variable :
+! VAR at time (t+1)=VAR at time (t-1) + 2*dt*ADV at time t
+! VAR is a source term (i.e. x by RHODJ)
+!
+! To avoid negative mixing ratios at external points
+! but also in the physical domain !
+ZRVCI0(:,:,:) = MAX ( PRRS(:,:,:,1) , 0. ) + MAX ( PRRS(:,:,:,2) , 0. )
+IF (KRRI>=1) ZRVCI0(:,:,:) = ZRVCI0(:,:,:) + MAX ( PRRS(:,:,:,4) , 0. )
+!
+ZRVCI(:,:,:)= PTSTEP *ZRVCI0(:,:,:) /PRHODJ(:,:,:)
+ZG_RVCI(:,:,:,1) = GX_M_M(ZRVCI,PDXX,PDZZ,PDZX)
+ZG_RVCI(:,:,:,2) = GY_M_M(ZRVCI,PDYY,PDZZ,PDZY)
+!
+ZGNORM_RVCI(:,:,:) = SQRT( ZG_RVCI(:,:,:,1)*ZG_RVCI(:,:,:,1) + &
+ ZG_RVCI(:,:,:,2)*ZG_RVCI(:,:,:,2) )
+!
+!
+!* 2.2 Frontogenetic terms calculation
+! (gradient of the advection)
+! Q_j=DG_j/Dt=d(DVAR/Dt)dx_j - d(u_k*dVAR/dx_k)/dx_j
+! As DVAR/Dt=0 if the VAR is conserved during the movement,
+! Q_j = dADV/dx_j
+! VAR=rv+rc+ri
+!
+ZWORK(:,:,:) = ZRVCI0 / PRHODJ(:,:,:) - &
+ ( PRM(:,:,:,1)+ PRM(:,:,:,2) ) / PTSTEP
+IF (KRRI>=1) ZWORK(:,:,:) = ZWORK(:,:,:) - PRM(:,:,:,4) / PTSTEP
+!
+ZQ_RVCI(:,:,:,1) = GX_M_M(ZWORK,PDXX,PDZZ,PDZX)
+ZQ_RVCI(:,:,:,2) = GY_M_M(ZWORK,PDYY,PDZZ,PDZY)
+!
+ZQNORM_RVCI(:,:,:) = SQRT( ZQ_RVCI(:,:,:,1)*ZQ_RVCI(:,:,:,1) + &
+ ZQ_RVCI(:,:,:,2)*ZQ_RVCI(:,:,:,2) )
+!
+!
+!* 2.3 Cloud mask
+!
+ZCLOUD(:,:,:)= MAX ( PRRS(:,:,:,2) , 0. )
+IF (KRRI>=1) ZCLOUD(:,:,:) = ZCLOUD(:,:,:) + MAX ( PRRS(:,:,:,4) , 0. )
+ZCLOUD(:,:,:) = PTSTEP * ZCLOUD / PRHODJ(:,:,:)
+!
+DO JK=IKB,IKE
+DO JJ=IJB,IJE
+DO JI=IIB,IIE
+ ! rc+ri threshold to avoid white noise and calculations
+ IF ( ZCLOUD(JI,JJ,JK) > 1.E-6 ) THEN
+ IMASK_CLOUD(JI-1,JJ ,JK ) = 1
+ IMASK_CLOUD(JI ,JJ ,JK ) = 1
+ IMASK_CLOUD(JI+1,JJ ,JK ) = 1
+ IMASK_CLOUD(JI ,JJ-1,JK ) = 1
+ IMASK_CLOUD(JI ,JJ+1,JK ) = 1
+ IMASK_CLOUD(JI ,JJ ,JK-1) = 1
+ IMASK_CLOUD(JI ,JJ ,JK+1) = 1
+ ! The cloudy points where the criteria will not be satisfied
+ ! will have the cloudy mixing length not amplified
+ ! We put in the CEI index a negative number to mark those points
+ ! in turb.f90
+ PCEI(JI,JJ,JK) = -1.
+ ENDIF
+ENDDO
+ENDDO
+ENDDO
+!
+!* 2.4 Cloud Entrainment Instability index
+!
+! CEI(:,:,:)=NORM_Q
+!
+! if the considered point is cloudy or surrounded by at least one cloudy point
+!
+! and if the characteristic time >0 in at least one direction that is to say
+! |grad(rv+rc+ri)| increasing with time that is to say
+! grad(rv+rc+ri) has the same sign as Q_RVCI
+!
+! and if NORM_G_RVCI >= 0.1 g/kg/km
+!
+DO JK=IKB,IKE
+DO JJ=IJB,IJE
+DO JI=IIB,IIE
+ IF ( IMASK_CLOUD(JI,JJ,JK) == 1 ) THEN
+ IF ( ZGNORM_RVCI(JI,JJ,JK) >= 1.E-07 ) THEN
+ IF ( SIGN(1.0,ZG_RVCI(JI,JJ,JK,1))==SIGN(1.0,ZQ_RVCI(JI,JJ,JK,1)) .OR. &
+ SIGN(1.0,ZG_RVCI(JI,JJ,JK,2))==SIGN(1.0,ZQ_RVCI(JI,JJ,JK,2)) ) THEN
+ PCEI(JI,JJ,JK) = ZQNORM_RVCI(JI,JJ,JK)
+ ENDIF
+ ENDIF
+ ENDIF
+ENDDO
+ENDDO
+ENDDO
+!
+!* 2.5 Writing
+!
+IF ( OTURB_DIAG .AND. tpfile%lopened ) THEN
+ TZFIELD%CMNHNAME = 'RVCI'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'RVCI'
+ TZFIELD%CUNITS = 'kg kg-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_RVCI'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZRVCI)
+ !
+ TZFIELD%CMNHNAME = 'GX_RVCI'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'GX_RVCI'
+ TZFIELD%CUNITS = 'kg kg-1 m-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_GX_RVCI'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZG_RVCI(:,:,:,1))
+ !
+ TZFIELD%CMNHNAME = 'GY_RVCI'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'GY_RVCI'
+ TZFIELD%CUNITS = 'kg kg-1 m-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_GY_RVCI'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZG_RVCI(:,:,:,2))
+ !
+ TZFIELD%CMNHNAME = 'GNORM_RVCI'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'GNORM_RVCI'
+ TZFIELD%CUNITS = 'kg kg-1 m-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_NORM G'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZGNORM_RVCI)
+ !
+ TZFIELD%CMNHNAME = 'QX_RVCI'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'QX_RVCI'
+ TZFIELD%CUNITS = 'kg kg-1 m-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_QX_RVCI'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZQ_RVCI(:,:,:,1))
+ !
+ TZFIELD%CMNHNAME = 'QY_RVCI'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'QY_RVCI'
+ TZFIELD%CUNITS = 'kg kg-1 m-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_QY_RVCI'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZQ_RVCI(:,:,:,2))
+ !
+ TZFIELD%CMNHNAME = 'QNORM_RVCI'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'QNORM_RVCI'
+ TZFIELD%CUNITS = 'kg kg-1 m-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_QNORM_RVCI'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZQNORM_RVCI)
+ !
+ TZFIELD%CMNHNAME = 'CEI'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'CEI'
+ TZFIELD%CUNITS = 'kg kg-1 m-1 s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_CEI'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,PCEI)
+END IF
+!
+END SUBROUTINE TURB_CLOUD_INDEX
diff --git a/src/mesonh/turb/turb_hor.f90 b/src/mesonh/turb/turb_hor.f90
new file mode 100644
index 000000000..8c872dcee
--- /dev/null
+++ b/src/mesonh/turb/turb_hor.f90
@@ -0,0 +1,469 @@
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ####################
+ MODULE MODI_TURB_HOR
+! ####################
+!
+INTERFACE
+!
+ SUBROUTINE TURB_HOR(KSPLT, KRR, KRRL, KRRI, PTSTEP, &
+ OTURB_FLX,OSUBG_COND, &
+ TPFILE, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
+ PDIRCOSXW,PDIRCOSYW,PDIRCOSZW, &
+ PCOSSLOPE,PSINSLOPE, &
+ PINV_PDXX, PINV_PDYY, PINV_PDZZ, PMZM_PRHODJ, &
+ PK, &
+ PRHODJ,PTHVREF, &
+ PSFTHM,PSFRM,PSFSVM, &
+ PCDUEFF,PTAU11M,PTAU12M,PTAU22M,PTAU33M, &
+ PUM,PVM,PWM,PUSLOPEM,PVSLOPEM,PTHLM,PRM,PSVM, &
+ PTKEM,PLM,PLEPS, &
+ PLOCPEXNM,PATHETA,PAMOIST,PSRCM,PFRAC_ICE, &
+ PDP,PTP,PSIGS, &
+ PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS )
+
+!
+USE MODD_IO, ONLY: TFILEDATA
+!
+INTEGER, INTENT(IN) :: KSPLT ! current split index
+INTEGER, INTENT(IN) :: KRR ! number of moist var.
+INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
+INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
+REAL, INTENT(IN) :: PTSTEP !
+LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
+ ! turbulent fluxes in the syncronous FM-file
+LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for sub-grid
+! condensation
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
+ ! Metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! vertical grid
+REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSXW, PDIRCOSYW, PDIRCOSZW
+! Director Cosinus along x, y and z directions at surface w-point
+REAL, DIMENSION(:,:), INTENT(IN) :: PCOSSLOPE ! cosinus of the angle
+ ! between i and the slope vector
+REAL, DIMENSION(:,:), INTENT(IN) :: PSINSLOPE ! sinus of the angle
+ ! between i and the slope vector
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density * grid volume
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! ref. state VPT
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHM,PSFRM
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSFSVM ! surface fluxes
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PCDUEFF ! Cd * || u || at time t
+REAL, DIMENSION(:,:), INTENT(IN) :: PTAU11M ! <uu> in the axes linked
+ ! to the maximum slope direction and the surface normal and the binormal
+ ! at time t - dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PTAU12M ! <uv> in the same axes
+REAL, DIMENSION(:,:), INTENT(IN) :: PTAU22M ! <vv> in the same axes
+REAL, DIMENSION(:,:), INTENT(IN) :: PTAU33M ! <ww> in the same axes
+!
+! Variables at t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM,PWM,PTHLM
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! mixing ratios at t-1,
+ ! where PRM(:,:,:,1) = conservative mixing ratio
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-1
+REAL, DIMENSION(:,:), INTENT(IN) :: PUSLOPEM ! wind component along the
+ ! maximum slope direction
+REAL, DIMENSION(:,:), INTENT(IN) :: PVSLOPEM ! wind component along the
+ ! direction normal to the maximum slope one
+
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PK ! Turbulent diffusion doef.
+ ! PK = PLM * SQRT(PTKEM)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDXX ! 1./PDXX
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDYY ! 1./PDYY
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDZZ ! 1./PDZZ
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PMZM_PRHODJ ! MZM(PRHODJ)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t- dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! dissipative length
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exner at time t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! coefficients between
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
+
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM
+ ! normalized 2nd-order flux
+ ! s'r'c/2Sigma_s2 at t-1 multiplied by Lambda_3
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFRAC_ICE ! ri fraction of rc+ri
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS, PRTHLS
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS,PRRS ! var. at t+1 -split-
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDP,PTP ! TKE production terms
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSIGS
+ ! IN: Vertical part of Sigma_s at t
+ ! OUT: Total Sigma_s at t
+!
+!
+!
+END SUBROUTINE TURB_HOR
+!
+END INTERFACE
+!
+END MODULE MODI_TURB_HOR
+! ################################################################
+ SUBROUTINE TURB_HOR(KSPLT, KRR, KRRL, KRRI, PTSTEP, &
+ OTURB_FLX,OSUBG_COND, &
+ TPFILE, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
+ PDIRCOSXW,PDIRCOSYW,PDIRCOSZW, &
+ PCOSSLOPE,PSINSLOPE, &
+ PINV_PDXX, PINV_PDYY, PINV_PDZZ, PMZM_PRHODJ, &
+ PK, &
+ PRHODJ,PTHVREF, &
+ PSFTHM,PSFRM,PSFSVM, &
+ PCDUEFF,PTAU11M,PTAU12M,PTAU22M,PTAU33M, &
+ PUM,PVM,PWM,PUSLOPEM,PVSLOPEM,PTHLM,PRM,PSVM, &
+ PTKEM,PLM,PLEPS, &
+ PLOCPEXNM,PATHETA,PAMOIST,PSRCM,PFRAC_ICE, &
+ PDP,PTP,PSIGS, &
+ PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS )
+! ################################################################
+!
+!
+!!**** *TURB_HOR* -routine to compute the source terms in the meso-NH
+!! model equations due to the non-vertical turbulent fluxes.
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to compute the non-vertical
+! turbulent fluxes of the evolutive variables and give back the
+! source terms to the main program.
+!
+!!** METHOD
+!! ------
+!! Complementary 3D calculations when running at high resolution;
+!! The non-vertical turbulent fluxes are computed explicitly. The
+!! contributions are cumulated in PRvarS and in DP and TP of TKE
+!
+! d(rho*T) = -d(rho*u'T'/dxx) -d(-rho*u'T'*dzx/dxx/dzz)
+! / dt / dx /dz
+!!
+!!
+!! Near the bottom of the model, uncentred evaluation of vertical
+!! gradients are required because no field values are available under
+!! the level where the gradient must be evaluated. In this case, the
+!! gradient is computed with a second order accurate uncentred scheme
+!! according to:
+!!
+!! D FF dzz3 (dzz3+dzz4)
+!! ---- = - ----------------- FF(4) + ----------------- FF(3)
+!! D z (dzz3+dzz4) dzz4 dzz3 dzz4
+!!
+!! dzz4 + 2 dzz3
+!! - ----------------- FF(2)
+!! (dzz3+dzz4) dzz3
+!!
+!! where the values are taken from:
+!!
+!! ----- FF(5)
+!! |
+!! | dzz5
+!! |
+!! ----- FF(4)
+!! |
+!! | dzz4
+!! |
+!! ----- FF(3)
+!! |
+!! | dzz3
+!! |
+!! ----- FF(2) , (D FF / DZ)
+!! | dzz2 * 0.5
+!! ----- ground
+!!
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST : contains physical constants
+!!
+!! XG : gravity constant
+!!
+!! Module MODD_CTURB: contains the set of constants for
+!! the turbulence scheme
+!!
+!! XCMFS,XCMFB : cts for the momentum flux
+!! XCSHF : ct for the sensible heat flux
+!! XCHF : ct for the moisture flux
+!! XCTV,XCHV : cts for the T and moisture variances
+!!
+!! Module MODD_PARAMETERS
+!!
+!! JPVEXT : number of vertical external points
+!!
+!!
+!!
+!!
+!! REFERENCE
+!! ---------
+!! Book 2 of documentation (routine TURB_HOR)
+!! Book 1 of documentation (Chapter: Turbulence)
+!!
+!! AUTHOR
+!! ------
+!! Joan Cuxart * INM and Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original Aug 29, 1994
+!! Modifications: Feb 14, 1995 (J.Cuxart and J.Stein)
+!! Doctorization and Optimization
+!! March 21, 1995 (J.M. Carriere)
+!! Introduction of cloud water
+!! June 14, 1995 (J. Stein)
+!! rm the ZVTPV computation + bug in the all
+!! or nothing condens. case
+!! June 28, 1995 (J.Cuxart) Add the LES tools
+!! Sept 19, 1995 (J. Stein) change the surface flux
+!! computations
+!! Nov 13, 1995 (J. Stein) include the tangential fluxes
+!! bug in <u'w'> at the surface
+!! Nov 27, 1997 (V. Saravane) spliting of the routine
+!! Nov 27, 1997 (V. Masson) clearing of the routine
+!! Nov 06, 2002 (V. Masson) LES budgets
+!! Feb 20, 2003 (JP Pinty) Add PFRAC_ICE
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_CTURB
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_PARAMETERS
+USE MODD_LES
+!
+USE MODI_TURB_HOR_THERMO_FLUX
+USE MODI_TURB_HOR_THERMO_CORR
+USE MODI_TURB_HOR_DYN_CORR
+USE MODI_TURB_HOR_UV
+USE MODI_TURB_HOR_UW
+USE MODI_TURB_HOR_VW
+USE MODI_TURB_HOR_SV_FLUX
+USE MODI_TURB_HOR_SV_CORR
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declaration of arguments
+!
+!
+INTEGER, INTENT(IN) :: KSPLT ! current split index
+INTEGER, INTENT(IN) :: KRR ! number of moist var.
+INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
+INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
+REAL, INTENT(IN) :: PTSTEP !
+LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
+ ! turbulent fluxes in the syncronous FM-file
+LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for sub-grid
+! condensation
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
+ ! Metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! vertical grid
+REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSXW, PDIRCOSYW, PDIRCOSZW
+! Director Cosinus along x, y and z directions at surface w-point
+REAL, DIMENSION(:,:), INTENT(IN) :: PCOSSLOPE ! cosinus of the angle
+ ! between i and the slope vector
+REAL, DIMENSION(:,:), INTENT(IN) :: PSINSLOPE ! sinus of the angle
+ ! between i and the slope vector
+
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PK ! Turbulent diffusion doef.
+ ! PK = PLM * SQRT(PTKEM)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDXX ! 1./PDXX
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDYY ! 1./PDYY
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDZZ ! 1./PDZZ
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PMZM_PRHODJ ! MZM(PRHODJ)
+
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density * grid volume
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! ref. state VPT
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHM,PSFRM
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSFSVM ! surface fluxes
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PCDUEFF ! Cd * || u || at time t
+REAL, DIMENSION(:,:), INTENT(IN) :: PTAU11M ! <uu> in the axes linked
+ ! to the maximum slope direction and the surface normal and the binormal
+ ! at time t - dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PTAU12M ! <uv> in the same axes
+REAL, DIMENSION(:,:), INTENT(IN) :: PTAU22M ! <vv> in the same axes
+REAL, DIMENSION(:,:), INTENT(IN) :: PTAU33M ! <ww> in the same axes
+!
+! Variables at t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM,PWM,PTHLM
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! mixing ratios at t-1,
+ ! where PRM(:,:,:,1) = conservative mixing ratio
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-1
+REAL, DIMENSION(:,:), INTENT(IN) :: PUSLOPEM ! wind component along the
+ ! maximum slope direction
+REAL, DIMENSION(:,:), INTENT(IN) :: PVSLOPEM ! wind component along the
+ ! direction normal to the maximum slope one
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t- dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! dissipative length
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exner at time t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! coefficients between
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
+
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM
+ ! normalized 2nd-order flux
+ ! s'r'c/2Sigma_s2 at t-1 multiplied by Lambda_3
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFRAC_ICE ! ri fraction of rc+ri
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS, PRTHLS
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS,PRRS ! var. at t+1 -split-
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDP,PTP ! TKE production terms
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSIGS
+ ! IN: Vertical part of Sigma_s at t
+ ! OUT: Total Sigma_s at t
+!
+!
+!
+!* 0.2 declaration of local variables
+!
+! ---------------------------------------------------------------------------
+!
+!* 1. PRELIMINARY COMPUTATIONS
+! ------------------------
+!
+!* Exchange coefficient is limited in order to insure numerical stability
+!
+!!
+!* 2. < U' THETA'l >
+!* 3. < U' R'np >
+!* 4. < U' TPV' >
+!* 5. < V' THETA'l >
+!* 6. < V' R'np >
+!* 7. < V' TPV' >
+!
+ CALL TURB_HOR_THERMO_FLUX(KSPLT, KRR, KRRL, KRRI, &
+ OTURB_FLX,OSUBG_COND, &
+ TPFILE, &
+ PK,PINV_PDXX,PINV_PDYY,PINV_PDZZ,PMZM_PRHODJ, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY, &
+ PDIRCOSXW,PDIRCOSYW, &
+ PRHODJ, &
+ PSFTHM,PSFRM, &
+ PWM,PTHLM,PRM, &
+ PATHETA,PAMOIST,PSRCM,PFRAC_ICE, &
+ PRTHLS,PRRS )
+!
+!
+!* 8. TURBULENT CORRELATIONS : <THl THl>, <THl Rnp>, <Rnp Rnp>, Sigma_s
+!
+ IF (KSPLT==1) &
+ CALL TURB_HOR_THERMO_CORR(KRR, KRRL, KRRI, &
+ OTURB_FLX,OSUBG_COND, &
+ TPFILE, &
+ PINV_PDXX,PINV_PDYY, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY, &
+ PTHVREF, &
+ PWM,PTHLM,PRM, &
+ PTKEM,PLM,PLEPS, &
+ PLOCPEXNM,PATHETA,PAMOIST,PSRCM, &
+ PSIGS )
+!
+!
+!* 9. < U'U'>
+!* 10. < V'V'>
+!* 11. < W'W'>
+!
+ CALL TURB_HOR_DYN_CORR(KSPLT, PTSTEP, &
+ OTURB_FLX,KRR, &
+ TPFILE, &
+ PK,PINV_PDZZ, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
+ PDIRCOSZW, &
+ PCOSSLOPE,PSINSLOPE, &
+ PRHODJ, &
+ PCDUEFF,PTAU11M,PTAU12M,PTAU22M,PTAU33M, &
+ PUM,PVM,PWM, PUSLOPEM,PVSLOPEM, &
+ PTHLM,PRM,PSVM, &
+ PTKEM,PLM, &
+ PDP,PTP, &
+ PRUS,PRVS,PRWS )
+!
+!
+!* 12. < U'V'>
+!
+ CALL TURB_HOR_UV(KSPLT, &
+ OTURB_FLX, &
+ TPFILE, &
+ PK,PINV_PDXX,PINV_PDYY,PINV_PDZZ,PMZM_PRHODJ, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY, &
+ PDIRCOSZW, &
+ PCOSSLOPE,PSINSLOPE, &
+ PRHODJ, &
+ PCDUEFF,PTAU11M,PTAU12M,PTAU22M,PTAU33M, &
+ PUM,PVM,PUSLOPEM,PVSLOPEM, &
+ PDP, &
+ PRUS,PRVS )
+!
+!
+!* 13. < U'W'>
+!
+ CALL TURB_HOR_UW(KSPLT, &
+ OTURB_FLX,KRR, &
+ TPFILE, &
+ PK,PINV_PDXX,PINV_PDZZ,PMZM_PRHODJ, &
+ PDXX,PDZZ,PDZX, &
+ PRHODJ,PTHVREF, &
+ PUM,PWM,PTHLM,PRM,PSVM, &
+ PTKEM,PLM, &
+ PDP, &
+ PRUS,PRWS )
+!
+!
+!* 14. < V'W'>
+!
+ CALL TURB_HOR_VW(KSPLT, &
+ OTURB_FLX,KRR, &
+ TPFILE, &
+ PK,PINV_PDYY,PINV_PDZZ,PMZM_PRHODJ, &
+ PDYY,PDZZ,PDZY, &
+ PRHODJ,PTHVREF, &
+ PVM,PWM,PTHLM,PRM,PSVM, &
+ PTKEM,PLM, &
+ PDP, &
+ PRVS,PRWS )
+
+!
+!
+!* 15. HORIZONTAL FLUXES OF PASSIVE SCALARS
+!
+ CALL TURB_HOR_SV_FLUX(KSPLT, &
+ OTURB_FLX, &
+ TPFILE, &
+ PK,PINV_PDXX,PINV_PDYY,PINV_PDZZ,PMZM_PRHODJ, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY, &
+ PDIRCOSXW,PDIRCOSYW, &
+ PRHODJ,PWM, &
+ PSFSVM, &
+ PSVM, &
+ PRSVS )
+!
+ IF (KSPLT==1 .AND. LLES_CALL) &
+ CALL TURB_HOR_SV_CORR(KRR,KRRL,KRRI, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY, &
+ PLM,PLEPS,PTKEM,PTHVREF, &
+ PTHLM,PRM, &
+ PLOCPEXNM,PATHETA,PAMOIST,PSRCM, &
+ PWM,PSVM )
+!
+!
+END SUBROUTINE TURB_HOR
diff --git a/src/mesonh/turb/turb_hor_dyn_corr.f90 b/src/mesonh/turb/turb_hor_dyn_corr.f90
new file mode 100644
index 000000000..2a4a3e98d
--- /dev/null
+++ b/src/mesonh/turb/turb_hor_dyn_corr.f90
@@ -0,0 +1,625 @@
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+MODULE MODI_TURB_HOR_DYN_CORR
+!
+INTERFACE
+!
+ SUBROUTINE TURB_HOR_DYN_CORR(KSPLT, PTSTEP, &
+ OTURB_FLX,KRR, &
+ TPFILE, &
+ PK,PINV_PDZZ, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
+ PDIRCOSZW, &
+ PCOSSLOPE,PSINSLOPE, &
+ PRHODJ, &
+ PCDUEFF,PTAU11M,PTAU12M,PTAU22M,PTAU33M, &
+ PUM,PVM,PWM,PUSLOPEM,PVSLOPEM, &
+ PTHLM,PRM,PSVM, &
+ PTKEM,PLM, &
+ PDP,PTP, &
+ PRUS,PRVS,PRWS )
+!
+USE MODD_IO, ONLY: TFILEDATA
+!
+INTEGER, INTENT(IN) :: KSPLT ! split process index
+REAL, INTENT(IN) :: PTSTEP ! timestep
+LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
+ ! turbulent fluxes in the syncronous FM-file
+INTEGER, INTENT(IN) :: KRR ! number of moist var.
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PK ! Turbulent diffusion doef.
+ ! PK = PLM * SQRT(PTKEM)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDZZ ! 1./PDZZ
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
+ ! Metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! vertical grid
+REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW
+! Director Cosinus along z directions at surface w-point
+REAL, DIMENSION(:,:), INTENT(IN) :: PCOSSLOPE ! cosinus of the angle
+ ! between i and the slope vector
+REAL, DIMENSION(:,:), INTENT(IN) :: PSINSLOPE ! sinus of the angle
+ ! between i and the slope vector
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density * grid volume
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PCDUEFF ! Cd * || u || at time t
+REAL, DIMENSION(:,:), INTENT(IN) :: PTAU11M ! <uu> in the axes linked
+ ! to the maximum slope direction and the surface normal and the binormal
+ ! at time t - dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PTAU12M ! <uv> in the same axes
+REAL, DIMENSION(:,:), INTENT(IN) :: PTAU22M ! <vv> in the same axes
+REAL, DIMENSION(:,:), INTENT(IN) :: PTAU33M ! <ww> in the same axes
+!
+! Variables at t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM,PWM,PTHLM
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM
+REAL, DIMENSION(:,:), INTENT(IN) :: PUSLOPEM ! wind component along the
+ ! maximum slope direction
+REAL, DIMENSION(:,:), INTENT(IN) :: PVSLOPEM ! wind component along the
+ ! direction normal to the maximum slope one
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t- dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDP,PTP ! TKE production terms
+!
+!
+!
+END SUBROUTINE TURB_HOR_DYN_CORR
+!
+END INTERFACE
+!
+END MODULE MODI_TURB_HOR_DYN_CORR
+! ################################################################
+ SUBROUTINE TURB_HOR_DYN_CORR(KSPLT, PTSTEP, &
+ OTURB_FLX,KRR, &
+ TPFILE, &
+ PK,PINV_PDZZ, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
+ PDIRCOSZW, &
+ PCOSSLOPE,PSINSLOPE, &
+ PRHODJ, &
+ PCDUEFF,PTAU11M,PTAU12M,PTAU22M,PTAU33M, &
+ PUM,PVM,PWM,PUSLOPEM,PVSLOPEM, &
+ PTHLM,PRM,PSVM, &
+ PTKEM,PLM, &
+ PDP,PTP, &
+ PRUS,PRVS,PRWS )
+! ################################################################
+!
+!!**** *TURB_HOR* -routine to compute the source terms in the meso-NH
+!! model equations due to the non-vertical turbulent fluxes.
+!!
+!! PURPOSE
+!! -------
+!!
+!! see TURB_HOR
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!!
+!! Joan Cuxart * INM and Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Aug , 1997 (V. Saravane) spliting of TURB_HOR
+!! Nov 27, 1997 (V. Masson) clearing of the routine
+!! Oct 18, 2000 (V. Masson) LES computations + LFLAT switch
+!! Feb 15, 2001 (J. Stein) remove the use of w=0 at the
+!! ground
+!! Mar 12, 2001 (V. Masson and J. Stein) major bugs
+!! + change of discretization at the surface
+!! Nov 06, 2002 (V. Masson) LES budgets
+!! October 2009 (G. Tanguy) add ILENCH=LEN(YCOMMENT) after
+!! change of YCOMMENT
+!! July 2012 (V.Masson) Implicitness of W
+!! March 2014 (V.Masson) tridiag_w : bug between
+!! mass and flux position
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_ARGSLIST_ll, ONLY: LIST_ll
+USE MODD_CST
+USE MODD_CONF
+USE MODD_CTURB
+use modd_field, only: tfielddata, TYPEREAL
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_PARAMETERS
+USE MODD_LES
+USE MODD_NSV
+!
+USE MODE_ll
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+!
+USE MODI_GRADIENT_M
+USE MODI_GRADIENT_U
+USE MODI_GRADIENT_V
+USE MODI_GRADIENT_W
+USE MODI_SHUMAN
+USE MODI_COEFJ
+USE MODI_LES_MEAN_SUBGRID
+USE MODI_TRIDIAG_W
+!
+USE MODI_SECOND_MNH
+USE MODE_MPPDB
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declaration of arguments
+!
+!
+!
+INTEGER, INTENT(IN) :: KSPLT ! split process index
+REAL, INTENT(IN) :: PTSTEP ! timestep
+LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
+ ! turbulent fluxes in the syncronous FM-file
+INTEGER, INTENT(IN) :: KRR ! number of moist var.
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PK ! Turbulent diffusion doef.
+ ! PK = PLM * SQRT(PTKEM)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDZZ ! 1./PDZZ
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
+ ! Metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! vertical grid
+REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW
+! Director Cosinus along z directions at surface w-point
+REAL, DIMENSION(:,:), INTENT(IN) :: PCOSSLOPE ! cosinus of the angle
+ ! between i and the slope vector
+REAL, DIMENSION(:,:), INTENT(IN) :: PSINSLOPE ! sinus of the angle
+ ! between i and the slope vector
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density * grid volume
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PCDUEFF ! Cd * || u || at time t
+REAL, DIMENSION(:,:), INTENT(IN) :: PTAU11M ! <uu> in the axes linked
+ ! to the maximum slope direction and the surface normal and the binormal
+ ! at time t - dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PTAU12M ! <uv> in the same axes
+REAL, DIMENSION(:,:), INTENT(IN) :: PTAU22M ! <vv> in the same axes
+REAL, DIMENSION(:,:), INTENT(IN) :: PTAU33M ! <ww> in the same axes
+!
+! Variables at t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM,PWM,PTHLM
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM
+REAL, DIMENSION(:,:), INTENT(IN) :: PUSLOPEM ! wind component along the
+ ! maximum slope direction
+REAL, DIMENSION(:,:), INTENT(IN) :: PVSLOPEM ! wind component along the
+ ! direction normal to the maximum slope one
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t- dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDP,PTP ! TKE production terms
+!
+!
+!
+!* 0.2 declaration of local variables
+!
+REAL, DIMENSION(SIZE(PUM,1),SIZE(PUM,2),SIZE(PUM,3)) &
+ :: ZFLX,ZWORK
+ ! work arrays, PK is the turb. mixing coef.
+!
+REAL, DIMENSION(SIZE(PUM,1),SIZE(PUM,2)) ::ZDIRSINZW
+ ! sinus of the angle between the vertical and the normal to the orography
+INTEGER :: IKB,IKE
+ ! Index values for the Beginning and End
+ ! mass points of the domain
+INTEGER :: IKU
+INTEGER :: JSV ! scalar loop counter
+!
+REAL, DIMENSION(SIZE(PUM,1),SIZE(PUM,2),SIZE(PUM,3)) :: GX_U_M_PUM
+REAL, DIMENSION(SIZE(PVM,1),SIZE(PVM,2),SIZE(PVM,3)) :: GY_V_M_PVM
+REAL, DIMENSION(SIZE(PWM,1),SIZE(PWM,2),SIZE(PWM,3)) :: GZ_W_M_PWM
+REAL, DIMENSION(SIZE(PWM,1),SIZE(PWM,2),SIZE(PWM,3)) :: GZ_W_M_ZWP
+REAL, DIMENSION(SIZE(PWM,1),SIZE(PWM,2),SIZE(PWM,3)) :: ZMZF_DZZ ! MZF(PDZZ)
+REAL, DIMENSION(SIZE(PWM,1),SIZE(PWM,2),SIZE(PWM,3)) :: ZDFDDWDZ ! formal derivative of the
+! ! flux (variable: dW/dz)
+REAL, DIMENSION(SIZE(PWM,1),SIZE(PWM,2),SIZE(PWM,3)) :: ZWP ! W at future time-step
+!
+REAL, DIMENSION(SIZE(PWM,1),SIZE(PWM,2),1) :: ZDU_DZ_DZS_DX ! du/dz*dzs/dx surf
+REAL, DIMENSION(SIZE(PWM,1),SIZE(PWM,2),1) :: ZDV_DZ_DZS_DY ! dv/dz*dzs/dy surf
+REAL, DIMENSION(SIZE(PWM,1),SIZE(PWM,2),1) :: ZDU_DX ! du/dx surf
+REAL, DIMENSION(SIZE(PWM,1),SIZE(PWM,2),1) :: ZDV_DY ! dv/dy surf
+REAL, DIMENSION(SIZE(PWM,1),SIZE(PWM,2),1) :: ZDW_DZ ! dw/dz surf
+!
+INTEGER :: IINFO_ll ! return code of parallel routine
+TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
+
+REAL :: ZTIME1, ZTIME2
+
+
+REAL, DIMENSION(SIZE(PDZZ,1),SIZE(PDZZ,2),1+JPVEXT:3+JPVEXT) :: ZCOEFF , ZDZZ
+ ! coefficients for the uncentred gradient
+ ! computation near the ground
+TYPE(TFIELDDATA) :: TZFIELD
+! --------------------------------------------------------------------------
+!
+!* 1. PRELIMINARY COMPUTATIONS
+! ------------------------
+NULLIFY(TZFIELDS_ll)
+!
+IKB = 1+JPVEXT
+IKE = SIZE(PUM,3)-JPVEXT
+IKU = SIZE(PUM,3)
+!
+!
+ZDIRSINZW(:,:) = SQRT( 1. - PDIRCOSZW(:,:)**2 )
+!
+GX_U_M_PUM = GX_U_M(PUM,PDXX,PDZZ,PDZX)
+IF (.NOT. L2D) GY_V_M_PVM = GY_V_M(PVM,PDYY,PDZZ,PDZY)
+GZ_W_M_PWM = GZ_W_M(PWM,PDZZ)
+!
+ZMZF_DZZ = MZF(PDZZ)
+!
+CALL ADD3DFIELD_ll( TZFIELDS_ll, ZFLX, 'TURB_HOR_DYN_CORR::ZFLX' )
+
+
+! compute the coefficients for the uncentred gradient computation near the
+! ground
+!
+!* 9. < U'U'>
+! -------
+!
+! Computes the U variance
+IF (.NOT. L2D) THEN
+ ZFLX(:,:,:)= (2./3.) * PTKEM &
+ - XCMFS * PK *( (4./3.) * GX_U_M_PUM &
+ -(2./3.) * ( GY_V_M_PVM &
+ +GZ_W_M_PWM ) )
+ !! & to be tested later
+ !! + XCMFB * PLM / SQRT(PTKEM) * (-2./3.) * PTP
+ELSE
+ ZFLX(:,:,:)= (2./3.) * PTKEM &
+ - XCMFS * PK *( (4./3.) * GX_U_M_PUM &
+ -(2./3.) * ( GZ_W_M_PWM ) )
+ !! & to be tested later
+ !! + XCMFB * PLM / SQRT(PTKEM) * (-2./3.) * PTP
+END IF
+!
+ZFLX(:,:,IKE+1) = ZFLX(:,:,IKE)
+!
+!* prescription of du/dz and dv/dz with uncentered gradient at the surface
+! prescription of dw/dz at Dz/2 above ground using the continuity equation
+! using a Boussinesq hypothesis to remove the z dependance of rhod_ref
+! (div u = 0)
+!
+ZDZZ(:,:,:) = MXM(PDZZ(:,:,IKB:IKB+2))
+ZCOEFF(:,:,IKB+2)= - ZDZZ(:,:,2) / &
+ ( (ZDZZ(:,:,3)+ZDZZ(:,:,2)) * ZDZZ(:,:,3) )
+ZCOEFF(:,:,IKB+1)= (ZDZZ(:,:,3)+ZDZZ(:,:,2)) / &
+ ( ZDZZ(:,:,2) * ZDZZ(:,:,3) )
+ZCOEFF(:,:,IKB)= - (ZDZZ(:,:,3)+2.*ZDZZ(:,:,2)) / &
+ ( (ZDZZ(:,:,3)+ZDZZ(:,:,2)) * ZDZZ(:,:,2) )
+!
+ZDU_DZ_DZS_DX(:,:,:)=MXF ((ZCOEFF(:,:,IKB+2:IKB+2)*PUM(:,:,IKB+2:IKB+2) &
+ +ZCOEFF(:,:,IKB+1:IKB+1)*PUM(:,:,IKB+1:IKB+1) &
+ +ZCOEFF(:,:,IKB :IKB )*PUM(:,:,IKB :IKB ) &
+ )* 0.5 * ( PDZX(:,:,IKB+1:IKB+1)+PDZX(:,:,IKB:IKB)) &
+ )/ MXF(PDXX(:,:,IKB:IKB))
+!
+ZDZZ(:,:,:) = MYM(PDZZ(:,:,IKB:IKB+2))
+ZCOEFF(:,:,IKB+2)= - ZDZZ(:,:,2) / &
+ ( (ZDZZ(:,:,3)+ZDZZ(:,:,2)) * ZDZZ(:,:,3) )
+ZCOEFF(:,:,IKB+1)= (ZDZZ(:,:,3)+ZDZZ(:,:,2)) / &
+ ( ZDZZ(:,:,2) * ZDZZ(:,:,3) )
+ZCOEFF(:,:,IKB)= - (ZDZZ(:,:,3)+2.*ZDZZ(:,:,2)) / &
+ ( (ZDZZ(:,:,3)+ZDZZ(:,:,2)) * ZDZZ(:,:,2) )
+!
+
+ZDV_DZ_DZS_DY(:,:,:)=MYF ((ZCOEFF(:,:,IKB+2:IKB+2)*PVM(:,:,IKB+2:IKB+2) &
+ +ZCOEFF(:,:,IKB+1:IKB+1)*PVM(:,:,IKB+1:IKB+1) &
+ +ZCOEFF(:,:,IKB :IKB )*PVM(:,:,IKB :IKB ) &
+ )* 0.5 * ( PDZY(:,:,IKB+1:IKB+1)+PDZY(:,:,IKB:IKB)) &
+ )/ MYF(PDYY(:,:,IKB:IKB))
+!
+!
+ZDU_DX(:,:,:)= DXF(PUM(:,:,IKB:IKB)) / MXF(PDXX(:,:,IKB:IKB)) &
+ - ZDU_DZ_DZS_DX(:,:,:)
+
+ZDV_DY(:,:,:)= DYF(PVM(:,:,IKB:IKB)) / MYF(PDYY(:,:,IKB:IKB)) &
+ - ZDV_DZ_DZS_DY(:,:,:)
+!
+ZDW_DZ(:,:,:)=-ZDU_DX(:,:,:)-ZDV_DY(:,:,:)
+!
+!* computation
+!
+ZFLX(:,:,IKB) = (2./3.) * PTKEM(:,:,IKB) &
+ - XCMFS * PK(:,:,IKB) * 2. * ZDU_DX(:,:,1)
+
+
+!! & to be tested later
+!! + XCMFB * PLM(:,:,IKB:IKB) /SQRT(PTKEM(:,:,IKB:IKB)) * &
+!! (-2./3.) * PTP(:,:,IKB:IKB)
+!
+! extrapolates this flux under the ground with the surface flux
+ZFLX(:,:,IKB-1) = &
+ PTAU11M(:,:) * PCOSSLOPE(:,:)**2 * PDIRCOSZW(:,:)**2 &
+ -2. * PTAU12M(:,:) * PCOSSLOPE(:,:)* PSINSLOPE(:,:) * PDIRCOSZW(:,:) &
+ + PTAU22M(:,:) * PSINSLOPE(:,:)**2 &
+ + PTAU33M(:,:) * PCOSSLOPE(:,:)**2 * ZDIRSINZW(:,:)**2 &
+ +2. * PCDUEFF(:,:) * ( &
+ PVSLOPEM(:,:) * PCOSSLOPE(:,:) * PSINSLOPE(:,:) * ZDIRSINZW(:,:) &
+ - PUSLOPEM(:,:) * PCOSSLOPE(:,:)**2 * ZDIRSINZW(:,:) * PDIRCOSZW(:,:) )
+!
+ZFLX(:,:,IKB-1) = 2. * ZFLX(:,:,IKB-1) - ZFLX(:,:,IKB)
+!
+CALL UPDATE_HALO_ll(TZFIELDS_ll, IINFO_ll)
+IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
+ ! stores <U U>
+ TZFIELD%CMNHNAME = 'U_VAR'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'U_VAR'
+ TZFIELD%CUNITS = 'm2 s-2'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_U_VAR'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLX)
+END IF
+!
+! Complete the U tendency
+IF (.NOT. LFLAT) THEN
+CALL MPPDB_CHECK3DM("before turb_corr:PRUS,PRHODJ,ZFLX,PDXX,PDZX,PINV_PDZZ",PRECISION,&
+ & PRUS,PRHODJ,ZFLX,PDXX,PDZX,PINV_PDZZ )
+
+ PRUS(:,:,:)=PRUS &
+ -DXM(PRHODJ * ZFLX / MXF(PDXX) ) &
+ +DZF( PDZX / MZM(PDXX) * MXM( MZM(PRHODJ*ZFLX) * PINV_PDZZ ) )
+CALL MPPDB_CHECK3DM("after turb_corr:PRUS,PRHODJ,ZFLX,PDXX,PDZX,PINV_PDZZ",PRECISION,&
+ & PRUS,PRHODJ,ZFLX,PDXX,PDZX,PINV_PDZZ )
+ELSE
+ PRUS(:,:,:)=PRUS -DXM(PRHODJ * ZFLX / MXF(PDXX) )
+END IF
+!
+IF (KSPLT==1) THEN
+ ! Contribution to the dynamic production of TKE:
+ ZWORK(:,:,:) = - ZFLX(:,:,:) * GX_U_M_PUM
+ !
+ ! evaluate the dynamic production at w(IKB+1) in PDP(IKB)
+ !
+ ZWORK(:,:,IKB) = 0.5* ( -ZFLX(:,:,IKB)*ZDU_DX(:,:,1) + ZWORK(:,:,IKB+1) )
+ !
+ PDP(:,:,:) = PDP(:,:,:) + ZWORK(:,:,:)
+END IF
+!
+! Storage in the LES configuration
+!
+IF (LLES_CALL .AND. KSPLT==1) THEN
+ CALL SECOND_MNH(ZTIME1)
+ CALL LES_MEAN_SUBGRID( ZFLX, X_LES_SUBGRID_U2 )
+ CALL LES_MEAN_SUBGRID( -ZWORK, X_LES_RES_ddxa_U_SBG_UaU , .TRUE.)
+ CALL SECOND_MNH(ZTIME2)
+ XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+END IF
+
+!
+!* 10. < V'V'>
+! -------
+!
+! Computes the V variance
+IF (.NOT. L2D) THEN
+ ZFLX(:,:,:)= (2./3.) * PTKEM &
+ - XCMFS * PK *( (4./3.) * GY_V_M_PVM &
+ -(2./3.) * ( GX_U_M_PUM &
+ +GZ_W_M_PWM ) )
+ !! & to be tested
+ !! + XCMFB * PLM / SQRT(PTKEM) * (-2./3.) * PTP
+ !
+ELSE
+ ZFLX(:,:,:)= (2./3.) * PTKEM &
+ - XCMFS * PK *(-(2./3.) * ( GX_U_M_PUM &
+ +GZ_W_M_PWM ) )
+ !! & to be tested
+ !! + XCMFB * PLM / SQRT(PTKEM) * (-2./3.) * PTP
+ !
+END IF
+!
+ZFLX(:,:,IKE+1) = ZFLX(:,:,IKE)
+!
+ZFLX(:,:,IKB) = (2./3.) * PTKEM(:,:,IKB) &
+ - XCMFS * PK(:,:,IKB) * 2. * ZDV_DY(:,:,1)
+
+!! & to be tested
+!! + XCMFB * PLM(:,:,IKB:IKB) /SQRT(PTKEM(:,:,IKB:IKB)) * &
+!! (-2./3.) * PTP(:,:,IKB:IKB)
+!
+! extrapolates this flux under the ground with the surface flux
+ZFLX(:,:,IKB-1) = &
+ PTAU11M(:,:) * PSINSLOPE(:,:)**2 * PDIRCOSZW(:,:)**2 &
+ +2. * PTAU12M(:,:) * PCOSSLOPE(:,:)* PSINSLOPE(:,:) * PDIRCOSZW(:,:) &
+ + PTAU22M(:,:) * PCOSSLOPE(:,:)**2 &
+ + PTAU33M(:,:) * PSINSLOPE(:,:)**2 * ZDIRSINZW(:,:)**2 &
+ -2. * PCDUEFF(:,:)* ( &
+ PUSLOPEM(:,:) * PSINSLOPE(:,:)**2 * ZDIRSINZW(:,:) * PDIRCOSZW(:,:) &
+ + PVSLOPEM(:,:) * PCOSSLOPE(:,:) * PSINSLOPE(:,:) * ZDIRSINZW(:,:) )
+!
+ZFLX(:,:,IKB-1) = 2. * ZFLX(:,:,IKB-1) - ZFLX(:,:,IKB)
+!
+CALL UPDATE_HALO_ll(TZFIELDS_ll, IINFO_ll)
+!
+IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
+ ! stores <V V>
+ TZFIELD%CMNHNAME = 'V_VAR'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'V_VAR'
+ TZFIELD%CUNITS = 'm2 s-2'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_V_VAR'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLX)
+END IF
+!
+! Complete the V tendency
+IF (.NOT. L2D) THEN
+ IF (.NOT. LFLAT) THEN
+ PRVS(:,:,:)=PRVS &
+ -DYM(PRHODJ * ZFLX / MYF(PDYY) ) &
+ +DZF( PDZY / MZM(PDYY) * &
+ MYM( MZM(PRHODJ*ZFLX) * PINV_PDZZ ) )
+ ELSE
+ PRVS(:,:,:)=PRVS -DYM(PRHODJ * ZFLX / MYF(PDYY) )
+ END IF
+!
+! Contribution to the dynamic production of TKE:
+ IF (KSPLT==1) ZWORK(:,:,:) = - ZFLX(:,:,:) * GY_V_M_PVM
+ELSE
+ ZWORK(:,:,:) = 0.
+END IF
+!
+IF (KSPLT==1) THEN
+ !
+ ! evaluate the dynamic production at w(IKB+1) in PDP(IKB)
+ !
+ ZWORK(:,:,IKB) = 0.5* ( -ZFLX(:,:,IKB)*ZDV_DY(:,:,1) + ZWORK(:,:,IKB+1) )
+ !
+ PDP(:,:,:) = PDP(:,:,:) + ZWORK(:,:,:)
+END IF
+!
+! Storage in the LES configuration
+!
+IF (LLES_CALL .AND. KSPLT==1) THEN
+ CALL SECOND_MNH(ZTIME1)
+ CALL LES_MEAN_SUBGRID( ZFLX, X_LES_SUBGRID_V2 )
+ CALL LES_MEAN_SUBGRID( -ZWORK, X_LES_RES_ddxa_V_SBG_UaV , .TRUE.)
+ CALL SECOND_MNH(ZTIME2)
+ XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+END IF
+!
+!* 11. < W'W'>
+! -------
+!
+! Computes the W variance
+IF (.NOT. L2D) THEN
+ ZFLX(:,:,:)= (2./3.) * PTKEM &
+ - XCMFS * PK *( (4./3.) * GZ_W_M_PWM &
+ -(2./3.) * ( GX_U_M_PUM &
+ +GY_V_M_PVM ) )
+ !! & to be tested
+ !! -2.* XCMFB * PLM / SQRT(PTKEM) * (-2./3.) * PTP
+ELSE
+ ZFLX(:,:,:)= (2./3.) * PTKEM &
+ - XCMFS * PK *( (4./3.) * GZ_W_M_PWM &
+ -(2./3.) * ( GX_U_M_PUM ) )
+ !! & to be tested
+ !! -2.* XCMFB * PLM / SQRT(PTKEM) * (-2./3.) * PTP
+END IF
+!
+ZFLX(:,:,IKE+1)= ZFLX(:,:,IKE)
+!
+ZFLX(:,:,IKB) = (2./3.) * PTKEM(:,:,IKB) &
+ - XCMFS * PK(:,:,IKB) * 2. * ZDW_DZ(:,:,1)
+
+! & to be tested
+! - 2.* XCMFB * PLM(:,:,IKB:IKB) /SQRT(PTKEM(:,:,IKB:IKB)) * &
+! (-2./3.) * PTP(:,:,IKB:IKB)
+!
+! extrapolates this flux under the ground with the surface flux
+ZFLX(:,:,IKB-1) = &
+ PTAU11M(:,:) * ZDIRSINZW(:,:)**2 &
+ + PTAU33M(:,:) * PDIRCOSZW(:,:)**2 &
+ +2. * PCDUEFF(:,:)* PUSLOPEM(:,:) * ZDIRSINZW(:,:) * PDIRCOSZW(:,:)
+ !
+ZFLX(:,:,IKB-1) = 2. * ZFLX(:,:,IKB-1) - ZFLX(:,:,IKB)
+!
+IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
+ ! stores <W W>
+ TZFIELD%CMNHNAME = 'W_VAR'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'W_VAR'
+ TZFIELD%CUNITS = 'm2 s-2'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_W_VAR'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLX)
+END IF
+!
+! Complete the W tendency
+!
+!PRWS(:,:,:)=PRWS(:,:,:) - DZM( PRHODJ*ZFLX/MZF(PDZZ) )
+ZDFDDWDZ(:,:,:) = - XCMFS * PK(:,:,:) * (4./3.)
+ZDFDDWDZ(:,:,:IKB) = 0.
+!
+CALL TRIDIAG_W(PWM,ZFLX,ZDFDDWDZ,PTSTEP,ZMZF_DZZ,PRHODJ,ZWP)
+!
+PRWS = PRWS(:,:,:) + MZM(PRHODJ(:,:,:))*(ZWP(:,:,:)-PWM(:,:,:))/PTSTEP
+!
+!* recomputes flux using guess of W
+!
+GZ_W_M_ZWP = GZ_W_M(ZWP,PDZZ)
+ZFLX(:,:,IKB+1:)=ZFLX(:,:,IKB+1:) &
+ - XCMFS * PK(:,:,IKB+1:) * (4./3.) * (GZ_W_M_ZWP(:,:,IKB+1:) - GZ_W_M_PWM(:,:,IKB+1:))
+!
+IF (KSPLT==1) THEN
+ !Contribution to the dynamic production of TKE:
+! ZWORK(:,:,:) = - ZFLX(:,:,:) * GZ_W_M_PWM
+ ZWORK(:,:,:) = - ZFLX(:,:,:) * GZ_W_M_ZWP
+ !
+ ! evaluate the dynamic production at w(IKB+1) in PDP(IKB)
+ !
+ ZWORK(:,:,IKB) = 0.5* ( -ZFLX(:,:,IKB)*ZDW_DZ(:,:,1) + ZWORK(:,:,IKB+1) )
+ !
+ PDP(:,:,:) = PDP(:,:,:) + ZWORK(:,:,:)
+END IF
+!
+! Storage in the LES configuration
+!
+!
+IF (LLES_CALL .AND. KSPLT==1) THEN
+ CALL SECOND_MNH(ZTIME1)
+ CALL LES_MEAN_SUBGRID( ZFLX, X_LES_SUBGRID_W2 )
+ CALL LES_MEAN_SUBGRID( -ZWORK, X_LES_RES_ddxa_W_SBG_UaW , .TRUE.)
+ CALL LES_MEAN_SUBGRID( GZ_M_M(PTHLM,PDZZ)*ZFLX, X_LES_RES_ddxa_Thl_SBG_UaW , .TRUE.)
+ CALL LES_MEAN_SUBGRID(ZFLX*MZF(GZ_M_W(1,IKU,1,PTHLM,PDZZ)),X_LES_RES_ddz_Thl_SBG_W2)
+ IF (KRR>=1) THEN
+ CALL LES_MEAN_SUBGRID( GZ_M_M(PRM(:,:,:,1),PDZZ)*ZFLX, &
+ X_LES_RES_ddxa_Rt_SBG_UaW , .TRUE.)
+ CALL LES_MEAN_SUBGRID(ZFLX*MZF(GZ_M_W(1,IKU,1,PRM(:,:,:,1),PDZZ)), &
+ X_LES_RES_ddz_Rt_SBG_W2)
+ END IF
+ DO JSV=1,NSV
+ CALL LES_MEAN_SUBGRID( GZ_M_M(PSVM(:,:,:,JSV),PDZZ)*ZFLX, &
+ X_LES_RES_ddxa_Sv_SBG_UaW(:,:,:,JSV) , .TRUE.)
+ CALL LES_MEAN_SUBGRID(ZFLX*MZF(GZ_M_W(1,IKU,1,PSVM(:,:,:,JSV),PDZZ)), &
+ X_LES_RES_ddz_Sv_SBG_W2(:,:,:,JSV))
+ END DO
+ CALL SECOND_MNH(ZTIME2)
+ XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+END IF
+!
+CALL CLEANLIST_ll(TZFIELDS_ll)
+!
+!
+END SUBROUTINE TURB_HOR_DYN_CORR
diff --git a/src/mesonh/turb/turb_hor_splt.f90 b/src/mesonh/turb/turb_hor_splt.f90
new file mode 100644
index 000000000..2de0ca9a8
--- /dev/null
+++ b/src/mesonh/turb/turb_hor_splt.f90
@@ -0,0 +1,632 @@
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! #########################
+ MODULE MODI_TURB_HOR_SPLT
+! #########################
+!
+INTERFACE
+!
+ SUBROUTINE TURB_HOR_SPLT(KSPLIT, KRR, KRRL, KRRI, PTSTEP, &
+ HLBCX,HLBCY,OTURB_FLX,OSUBG_COND, &
+ TPFILE, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
+ PDIRCOSXW,PDIRCOSYW,PDIRCOSZW, &
+ PCOSSLOPE,PSINSLOPE, &
+ PRHODJ,PTHVREF, &
+ PSFTHM,PSFRM,PSFSVM, &
+ PCDUEFF,PTAU11M,PTAU12M,PTAU22M,PTAU33M, &
+ PUM,PVM,PWM,PUSLOPEM,PVSLOPEM,PTHLM,PRM,PSVM, &
+ PTKEM,PLM,PLEPS, &
+ PLOCPEXNM,PATHETA,PAMOIST,PSRCM,PFRAC_ICE, &
+ PDP,PTP,PSIGS, &
+ PTRH, &
+ PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS )
+
+!
+USE MODD_IO, ONLY: TFILEDATA
+!
+INTEGER, INTENT(IN) :: KSPLIT ! number of time splitting
+INTEGER, INTENT(IN) :: KRR ! number of moist var.
+INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
+INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
+REAL, INTENT(IN) :: PTSTEP ! timestep
+CHARACTER (LEN=*), DIMENSION(:), INTENT(IN) :: HLBCX,HLBCY
+LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
+ ! turbulent fluxes in the syncronous FM-file
+LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for sub-grid
+! condensation
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
+ ! Metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! vertical grid
+REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSXW, PDIRCOSYW, PDIRCOSZW
+! Director Cosinus along x, y and z directions at surface w-point
+REAL, DIMENSION(:,:), INTENT(IN) :: PCOSSLOPE ! cosinus of the angle
+ ! between i and the slope vector
+REAL, DIMENSION(:,:), INTENT(IN) :: PSINSLOPE ! sinus of the angle
+ ! between i and the slope vector
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density * grid volume
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! ref. state VPT
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHM,PSFRM
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSFSVM ! surface fluxes
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PCDUEFF ! Cd * || u || at time t
+REAL, DIMENSION(:,:), INTENT(IN) :: PTAU11M ! <uu> in the axes linked
+ ! to the maximum slope direction and the surface normal and the binormal
+ ! at time t - dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PTAU12M ! <uv> in the same axes
+REAL, DIMENSION(:,:), INTENT(IN) :: PTAU22M ! <vv> in the same axes
+REAL, DIMENSION(:,:), INTENT(IN) :: PTAU33M ! <ww> in the same axes
+!
+! Variables at t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM,PWM,PTHLM
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! mixing ratios at t-1,
+ ! where PRM(:,:,:,1) = conservative mixing ratio
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-1
+REAL, DIMENSION(:,:), INTENT(IN) :: PUSLOPEM ! wind component along the
+ ! maximum slope direction
+REAL, DIMENSION(:,:), INTENT(IN) :: PVSLOPEM ! wind component along the
+ ! direction normal to the maximum slope one
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t- dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! dissipative length
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exner at time t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! coefficients between
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
+
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM
+ ! normalized 2nd-order flux
+ ! s'r'c/2Sigma_s2 at t-1 multiplied by Lambda_3
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFRAC_ICE ! ri fraction of rc+ri
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS, PRTHLS
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS,PRRS ! var. at t+1 -split-
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDP,PTP ! TKE production terms
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTRH
+
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSIGS
+ ! IN: Vertical part of Sigma_s at t
+ ! OUT: Total Sigma_s at t
+!
+!
+!
+END SUBROUTINE TURB_HOR_SPLT
+!
+END INTERFACE
+!
+END MODULE MODI_TURB_HOR_SPLT
+! ################################################################
+ SUBROUTINE TURB_HOR_SPLT(KSPLIT, KRR, KRRL, KRRI, PTSTEP, &
+ HLBCX,HLBCY,OTURB_FLX,OSUBG_COND, &
+ TPFILE, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
+ PDIRCOSXW,PDIRCOSYW,PDIRCOSZW, &
+ PCOSSLOPE,PSINSLOPE, &
+ PRHODJ,PTHVREF, &
+ PSFTHM,PSFRM,PSFSVM, &
+ PCDUEFF,PTAU11M,PTAU12M,PTAU22M,PTAU33M, &
+ PUM,PVM,PWM,PUSLOPEM,PVSLOPEM,PTHLM,PRM,PSVM, &
+ PTKEM,PLM,PLEPS, &
+ PLOCPEXNM,PATHETA,PAMOIST,PSRCM,PFRAC_ICE, &
+ PDP,PTP,PSIGS, &
+ PTRH, &
+ PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS )
+! ################################################################
+!
+!
+!!**** *TURB_HOR* -routine to compute the source terms in the meso-NH
+!! model equations due to the non-vertical turbulent fluxes.
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to compute the non-vertical
+! turbulent fluxes of the evolutive variables and give back the
+! source terms to the main program.
+!
+!!** METHOD
+!! ------
+!! Complementary 3D calculations when running at high resolution;
+!! The non-vertical turbulent fluxes are computed explicitly. The
+!! contributions are cumulated in PRvarS and in DP and TP of TKE
+!
+! d(rho*T) = -d(rho*u'T'/dxx) -d(-rho*u'T'*dzx/dxx/dzz)
+! / dt / dx /dz
+!!
+!!
+!! Near the bottom of the model, uncentred evaluation of vertical
+!! gradients are required because no field values are available under
+!! the level where the gradient must be evaluated. In this case, the
+!! gradient is computed with a second order accurate uncentred scheme
+!! according to:
+!!
+!! D FF dzz3 (dzz3+dzz4)
+!! ---- = - ----------------- FF(4) + ----------------- FF(3)
+!! D z (dzz3+dzz4) dzz4 dzz3 dzz4
+!!
+!! dzz4 + 2 dzz3
+!! - ----------------- FF(2)
+!! (dzz3+dzz4) dzz3
+!!
+!! where the values are taken from:
+!!
+!! ----- FF(5)
+!! |
+!! | dzz5
+!! |
+!! ----- FF(4)
+!! |
+!! | dzz4
+!! |
+!! ----- FF(3)
+!! |
+!! | dzz3
+!! |
+!! ----- FF(2) , (D FF / DZ)
+!! | dzz2 * 0.5
+!! ----- ground
+!!
+!!
+!!
+!! EXTERNAL
+!! --------
+!! GX_M_U, GY_M_V
+!! GX_M_M, GY_M_M, GZ_M_M
+!! GY_U_UV,GX_V_UV
+!! GX_U_M, GY_V_M, GZ_W_M
+!! GX_W_UW,GY_W_UW
+!! : Cartesian vertical gradient operators
+!!
+!!
+!! MXM,MXF,MYM,MYF,MZM,MZF
+!! : Shuman functions (mean operators)
+!! DXM,DXF.DYM,DYF,DZM,DZF
+!! : Shuman functions (difference operators)
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST : contains physical constants
+!!
+!! XG : gravity constant
+!!
+!! Module MODD_CTURB: contains the set of constants for
+!! the turbulence scheme
+!!
+!! XCMFS,XCMFB : cts for the momentum flux
+!! XCSHF : ct for the sensible heat flux
+!! XCHF : ct for the moisture flux
+!! XCTV,XCHV : cts for the T and moisture variances
+!!
+!! Module MODD_PARAMETERS
+!!
+!! JPVEXT : number of vertical external points
+!!
+!! Module MODD_CONF
+!!
+!! CPROGRAM
+!!
+!!
+!! REFERENCE
+!! ---------
+!! Book 2 of documentation (routine TURB_HOR)
+!! Book 1 of documentation (Chapter: Turbulence)
+!!
+!! AUTHOR
+!! ------
+!! Joan Cuxart * INM and Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original Aug 29, 1994
+!! Modifications: Feb 14, 1995 (J.Cuxart and J.Stein)
+!! Doctorization and Optimization
+!! March 21, 1995 (J.M. Carriere)
+!! Introduction of cloud water
+!! June 14, 1995 (J. Stein)
+!! rm the ZVTPV computation + bug in the all
+!! or nothing condens. case
+!! June 28, 1995 (J.Cuxart) Add the LES tools
+!! Sept 19, 1995 (J. Stein) change the surface flux
+!! computations
+!! Nov 13, 1995 (J. Stein) include the tangential fluxes
+!! bug in <u'w'> at the surface
+!! Nov 27, 1997 (V. Saravane) spliting of the routine
+!! Nov 27, 1997 (V. Masson) clearing of the routine
+!! Mar 07, 2001 (V. Masson and J. Stein) time splitting
+!! + major bugs correction for slopes
+!! Nov 06, 2002 (V. Masson) LES budgets
+!! Feb 20, 2003 (JP Pinty) Add PFRAC_ICE
+!! Oct.2009 (C.Lac) Introduction of different PTSTEP according to the
+!! advection schemes
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CONF
+USE MODD_CST
+USE MODD_CTURB
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_PARAMETERS
+!
+!
+USE MODI_SHUMAN
+USE MODI_TURB_HOR
+USE MODI_TURB_HOR_TKE
+!
+USE MODE_ll
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declaration of arguments
+!
+!
+INTEGER, INTENT(IN) :: KSPLIT ! number of time splitting
+INTEGER, INTENT(IN) :: KRR ! number of moist var.
+INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
+INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
+REAL, INTENT(IN) :: PTSTEP ! timestep
+CHARACTER (LEN=*), DIMENSION(:), INTENT(IN) :: HLBCX,HLBCY
+LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
+ ! turbulent fluxes in the syncronous FM-file
+LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for sub-grid
+! condensation
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
+ ! Metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! vertical grid
+REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSXW, PDIRCOSYW, PDIRCOSZW
+! Director Cosinus along x, y and z directions at surface w-point
+REAL, DIMENSION(:,:), INTENT(IN) :: PCOSSLOPE ! cosinus of the angle
+ ! between i and the slope vector
+REAL, DIMENSION(:,:), INTENT(IN) :: PSINSLOPE ! sinus of the angle
+ ! between i and the slope vector
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density * grid volume
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! ref. state VPT
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHM,PSFRM
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSFSVM ! surface fluxes
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PCDUEFF ! Cd * || u || at time t
+REAL, DIMENSION(:,:), INTENT(IN) :: PTAU11M ! <uu> in the axes linked
+ ! to the maximum slope direction and the surface normal and the binormal
+ ! at time t - dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PTAU12M ! <uv> in the same axes
+REAL, DIMENSION(:,:), INTENT(IN) :: PTAU22M ! <vv> in the same axes
+REAL, DIMENSION(:,:), INTENT(IN) :: PTAU33M ! <ww> in the same axes
+!
+! Variables at t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM,PWM,PTHLM
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! mixing ratios at t-1,
+ ! where PRM(:,:,:,1) = conservative mixing ratio
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-1
+REAL, DIMENSION(:,:), INTENT(IN) :: PUSLOPEM ! wind component along the
+ ! maximum slope direction
+REAL, DIMENSION(:,:), INTENT(IN) :: PVSLOPEM ! wind component along the
+ ! direction normal to the maximum slope one
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t- dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! dissipative length
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exner at time t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! coefficients between
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
+
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM
+ ! normalized 2nd-order flux
+ ! s'r'c/2Sigma_s2 at t-1 multiplied by Lambda_3
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFRAC_ICE ! ri fraction of rc+ri
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS, PRTHLS
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS,PRRS ! var. at t+1 -split-
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDP,PTP ! TKE production terms
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTRH
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSIGS
+ ! IN: Vertical part of Sigma_s at t
+ ! OUT: Total Sigma_s at t
+!
+!
+!
+!* 0.2 declaration of local variables
+!
+REAL,ALLOCATABLE,DIMENSION(:,:,:) :: ZK ! Turbulent diffusion doef.
+ ! ZK = PLM * SQRT(PTKEM)
+REAL,ALLOCATABLE,DIMENSION(:,:,:) :: ZINV_PDXX ! 1./PDXX
+REAL,ALLOCATABLE,DIMENSION(:,:,:) :: ZINV_PDYY ! 1./PDYY
+REAL,ALLOCATABLE,DIMENSION(:,:,:) :: ZINV_PDZZ ! 1./PDZZ
+REAL,ALLOCATABLE,DIMENSION(:,:,:) :: ZMZM_PRHODJ ! MZM(PRHODJ)
+!
+INTEGER :: JSPLT ! current split
+!
+INTEGER :: IKB, IKE, IIB, IIE, IJB, IJE
+INTEGER :: JRR, JSV
+!
+INTEGER :: ISV
+INTEGER :: IINFO_ll
+!
+REAL,ALLOCATABLE,DIMENSION(:,:,:) :: ZUM, ZVM, ZWM, ZTHLM, ZTKEM
+REAL,ALLOCATABLE,DIMENSION(:,:,:,:) :: ZRM, ZSVM
+REAL,ALLOCATABLE,DIMENSION(:,:,:) :: ZRUS, ZRVS, ZRWS, ZRTHLS
+REAL,ALLOCATABLE,DIMENSION(:,:,:,:) :: ZRRS, ZRSVS
+!
+!
+TYPE(LIST_ll), POINTER, SAVE :: TZFIELDS_ll
+!
+! ---------------------------------------------------------------------------
+!
+!* 1. PRELIMINARY COMPUTATIONS
+! ------------------------
+!
+IKB = 1.+JPVEXT
+IKE = SIZE(PUM,3) - JPVEXT
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+ISV=SIZE(PSVM,4)
+!
+ALLOCATE(ZK(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)))
+ALLOCATE(ZINV_PDXX(SIZE(PDXX,1),SIZE(PDXX,2),SIZE(PDXX,3)))
+ALLOCATE(ZINV_PDYY(SIZE(PDYY,1),SIZE(PDYY,2),SIZE(PDYY,3)))
+ALLOCATE(ZINV_PDZZ(SIZE(PDZZ,1),SIZE(PDZZ,2),SIZE(PDZZ,3)))
+ALLOCATE(ZMZM_PRHODJ(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3)))
+!
+ZINV_PDXX = 1./PDXX
+ZINV_PDYY = 1./PDYY
+ZINV_PDZZ = 1./PDZZ
+ZMZM_PRHODJ = MZM(PRHODJ)
+!
+ZK(:,:,:) = PLM(:,:,:) * SQRT(PTKEM(:,:,:))
+!
+NULLIFY(TZFIELDS_ll)
+!
+!--------------------------------------------------------------------
+!
+!* 2. SPLIT PROCESS LOOP
+! ------------------
+!
+IF (KSPLIT>1 .AND. CPROGRAM=='MESONH') THEN
+!
+!* 2.1 allocations
+! -----------
+!
+ ALLOCATE(ZUM(SIZE(PUM,1),SIZE(PUM,2),SIZE(PUM,3)))
+ ALLOCATE(ZVM(SIZE(PVM,1),SIZE(PVM,2),SIZE(PVM,3)))
+ ALLOCATE(ZWM(SIZE(PWM,1),SIZE(PWM,2),SIZE(PWM,3)))
+ ALLOCATE(ZSVM(SIZE(PSVM,1),SIZE(PSVM,2),SIZE(PSVM,3),SIZE(PSVM,4)))
+ ALLOCATE(ZTHLM(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)))
+ ALLOCATE(ZTKEM(SIZE(PTKEM,1),SIZE(PTKEM,2),SIZE(PTKEM,3)))
+ ALLOCATE(ZRM(SIZE(PRM,1),SIZE(PRM,2),SIZE(PRM,3),SIZE(PRM,4)))
+ ALLOCATE(ZRUS(SIZE(PRUS,1),SIZE(PRUS,2),SIZE(PRUS,3)))
+ ALLOCATE(ZRVS(SIZE(PRVS,1),SIZE(PRVS,2),SIZE(PRVS,3)))
+ ALLOCATE(ZRWS(SIZE(PRWS,1),SIZE(PRWS,2),SIZE(PRWS,3)))
+ ALLOCATE(ZRSVS(SIZE(PRSVS,1),SIZE(PRSVS,2),SIZE(PRSVS,3),SIZE(PRSVS,4)))
+ ALLOCATE(ZRTHLS(SIZE(PRTHLS,1),SIZE(PRTHLS,2),SIZE(PRTHLS,3)))
+ ALLOCATE(ZRRS(SIZE(PRRS,1),SIZE(PRRS,2),SIZE(PRRS,3),SIZE(PRRS,4)))
+!
+!
+!* 2.2 list for parallel exchanges
+! ---------------------------
+!
+ CALL ADD3DFIELD_ll( TZFIELDS_ll, ZUM, 'TURB_HOR_SPLT::ZUM' )
+ CALL ADD3DFIELD_ll( TZFIELDS_ll, ZVM, 'TURB_HOR_SPLT::ZVM' )
+ CALL ADD3DFIELD_ll( TZFIELDS_ll, ZWM, 'TURB_HOR_SPLT::ZWM' )
+ CALL ADD3DFIELD_ll( TZFIELDS_ll, ZTHLM, 'TURB_HOR_SPLT::ZTHLM' )
+ CALL ADD3DFIELD_ll( TZFIELDS_ll, ZTKEM, 'TURB_HOR_SPLT::ZTKEM' )
+ CALL ADD4DFIELD_ll( TZFIELDS_ll, ZSVM(:,:,:,1:ISV), 'TURB_HOR_SPLT::ZSVM(:,:,:,1:ISV)' )
+ CALL ADD4DFIELD_ll( TZFIELDS_ll, ZRM(:,:,:,1:KRR), 'TURB_HOR_SPLT::ZRM(:,:,:,1:KRR)' )
+!
+!
+!* 2.3 initializations
+! ---------------
+!
+!
+ ZUM=PUM
+ ZVM=PVM
+ ZWM=PWM
+ IF (ISV>0) ZSVM=PSVM
+ ZTHLM=PTHLM
+ ZTKEM=PTKEM
+ IF (KRR>0) ZRM=PRM
+ !
+ ZRUS=PRUS*KSPLIT
+ ZRVS=PRVS*KSPLIT
+ ZRWS=PRWS*KSPLIT
+ IF (ISV>0) ZRSVS=PRSVS*KSPLIT
+ ZRTHLS=PRTHLS*KSPLIT
+ IF (KRR>0) ZRRS=PRRS*KSPLIT
+
+!
+!* 2.4 split process
+! -------------
+!
+ DO JSPLT=1,KSPLIT
+!
+! compute the turbulent tendencies for the small time step
+ CALL TURB_HOR(JSPLT, KRR, KRRL, KRRI, PTSTEP, &
+ OTURB_FLX,OSUBG_COND, &
+ TPFILE, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
+ PDIRCOSXW,PDIRCOSYW,PDIRCOSZW, &
+ PCOSSLOPE,PSINSLOPE, &
+ ZINV_PDXX, ZINV_PDYY, ZINV_PDZZ, ZMZM_PRHODJ, &
+ ZK, &
+ PRHODJ,PTHVREF, &
+ PSFTHM,PSFRM,PSFSVM, &
+ PCDUEFF,PTAU11M,PTAU12M,PTAU22M,PTAU33M, &
+ ZUM,ZVM,ZWM,PUSLOPEM,PVSLOPEM,ZTHLM,ZRM,ZSVM, &
+ PTKEM,PLM,PLEPS, &
+ PLOCPEXNM,PATHETA,PAMOIST,PSRCM,PFRAC_ICE, &
+ PDP,PTP,PSIGS, &
+ ZRUS,ZRVS,ZRWS,ZRTHLS,ZRRS,ZRSVS )
+!
+! horizontal transport of Tke
+!
+ CALL TURB_HOR_TKE(JSPLT, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY, &
+ ZINV_PDXX, ZINV_PDYY, ZINV_PDZZ, ZMZM_PRHODJ, &
+ ZK, PRHODJ, ZTKEM, &
+ PTRH )
+!
+!
+! split temporal advance
+
+ ZUM=PUM+(ZRUS/KSPLIT-PRUS)/MXM(PRHODJ)*PTSTEP
+ ZVM=PVM+(ZRVS/KSPLIT-PRVS)/MYM(PRHODJ)*PTSTEP
+ ZWM=PWM+(ZRWS/KSPLIT-PRWS)/ZMZM_PRHODJ*PTSTEP
+ DO JSV=1,ISV
+ ZSVM(:,:,:,JSV)=PSVM(:,:,:,JSV)+ &
+ (ZRSVS(:,:,:,JSV)/KSPLIT-PRSVS(:,:,:,JSV))/PRHODJ*PTSTEP
+ END DO
+ ZTHLM=PTHLM+(ZRTHLS/KSPLIT-PRTHLS)/PRHODJ*PTSTEP
+ ZTKEM=ZTKEM+PTRH*PTSTEP/KSPLIT
+ DO JRR=1,KRR
+ ZRM(:,:,:,JRR)=PRM(:,:,:,JRR)+ &
+ (ZRRS(:,:,:,JRR)/KSPLIT-PRRS(:,:,:,JRR))/PRHODJ*PTSTEP
+ END DO
+!
+! reinforce boundary conditions
+!
+ IF (JSPLT<KSPLIT-NHALO+1) CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ !
+ IF ( HLBCX(1) /= "CYCL" .AND. LWEST_ll()) THEN
+ ZUM(IIB ,:,:)=PUM(IIB ,:,:)
+ ZVM(IIB-1,:,:)=PVM(IIB-1,:,:)
+ ZWM(IIB-1,:,:)=PWM(IIB-1,:,:)
+ ZTHLM(IIB-1,:,:)=PTHLM(IIB-1,:,:)
+ ZTKEM(IIB-1,:,:)=PTKEM(IIB-1,:,:)
+ IF (ISV>0) ZSVM(IIB-1,:,:,:)=PSVM(IIB-1,:,:,:)
+ IF (KRR>0) ZRM (IIB-1,:,:,:)=PRM (IIB-1,:,:,:)
+ ENDIF
+ !
+ IF ( HLBCX(2) /= "CYCL" .AND. LEAST_ll()) THEN
+ ZUM(IIE+1,:,:)=PUM(IIE+1,:,:)
+ ZVM(IIE+1,:,:)=PVM(IIE+1,:,:)
+ ZWM(IIE+1,:,:)=PWM(IIE+1,:,:)
+ ZTHLM(IIE+1,:,:)=PTHLM(IIE+1,:,:)
+ ZTKEM(IIE+1,:,:)=PTKEM(IIE+1,:,:)
+ IF (ISV>0) ZSVM(IIE+1,:,:,:)=PSVM(IIE+1,:,:,:)
+ IF (KRR>0) ZRM (IIE+1,:,:,:)=PRM(IIE+1,:,:,:)
+ ENDIF
+ !
+ IF ( HLBCY(1) /= "CYCL" .AND. LSOUTH_ll()) THEN
+ ZUM(:,IJB-1,:)=PUM(:,IJB-1,:)
+ ZVM(:,IJB ,:)=PVM(:,IJB ,:)
+ ZWM(:,IJB-1,:)=PWM(:,IJB-1,:)
+ ZTHLM(:,IJB-1,:)=PTHLM(:,IJB-1,:)
+ ZTKEM(:,IJB-1,:)=PTKEM(:,IJB-1,:)
+ IF (ISV>0) ZSVM(:,IJB-1,:,:)=PSVM(:,IJB-1,:,:)
+ IF (KRR>0) ZRM (:,IJB-1,:,:)=PRM (:,IJB-1,:,:)
+ ENDIF
+ !
+ IF ( HLBCY(2) /= "CYCL" .AND. LNORTH_ll()) THEN
+ ZUM(:,IJE+1,:)=PUM(:,IJE+1,:)
+ ZVM(:,IJE+1,:)=PVM(:,IJE+1,:)
+ ZWM(:,IJE+1,:)=PWM(:,IJE+1,:)
+ ZTHLM(:,IJE+1,:)=PTHLM(:,IJE+1,:)
+ ZTKEM(:,IJE+1,:)=PTKEM(:,IJE+1,:)
+ IF (ISV>0) ZSVM(:,IJE+1,:,:)=PSVM(:,IJE+1,:,:)
+ IF (KRR>0) ZRM (:,IJE+1,:,:)=PRM(:,IJE+1,:,:)
+ ENDIF
+ !
+ ZUM(:,:,IKB-1)=ZUM(:,:,IKB)
+ ZVM(:,:,IKB-1)=ZVM(:,:,IKB)
+ ZWM(:,:,IKB-1)=ZWM(:,:,IKB)
+ ZTHLM(:,:,IKB-1)=ZTHLM(:,:,IKB)
+ ZTKEM(:,:,IKB-1)=ZTKEM(:,:,IKB)
+ IF (ISV>0) ZSVM(:,:,IKB-1,:)=ZSVM(:,:,IKB,:)
+ IF (KRR>0) ZRM (:,:,IKB-1,:)=ZRM (:,:,IKB,:)
+ !
+ ZUM(:,:,IKE+1)=ZUM(:,:,IKE)
+ ZVM(:,:,IKE+1)=ZVM(:,:,IKE)
+ ZWM(:,:,IKE+1)=ZWM(:,:,IKE)
+ ZTHLM(:,:,IKE+1)=ZTHLM(:,:,IKE)
+ ZTKEM(:,:,IKE+1)=ZTKEM(:,:,IKE)
+ IF (ISV>0) ZSVM(:,:,IKE+1,:)=ZSVM(:,:,IKE,:)
+ IF (KRR>0) ZRM (:,:,IKE+1,:)=ZRM (:,:,IKE,:)
+ !
+ END DO
+!
+!* 2.5 update the complete tendencies
+! ------------------------------
+!
+ PRUS=ZRUS/KSPLIT
+ PRVS=ZRVS/KSPLIT
+ PRWS=ZRWS/KSPLIT
+ IF (ISV>0) PRSVS=ZRSVS/KSPLIT
+ PRTHLS=ZRTHLS/KSPLIT
+ IF (KRR>0) PRRS=ZRRS/KSPLIT
+ PTRH=(ZTKEM-PTKEM)/PTSTEP
+!
+!* 2.6 deallocations
+! -------------
+!
+ DEALLOCATE(ZUM)
+ DEALLOCATE(ZVM)
+ DEALLOCATE(ZWM)
+ DEALLOCATE(ZSVM)
+ DEALLOCATE(ZTHLM)
+ DEALLOCATE(ZTKEM)
+ DEALLOCATE(ZRM)
+ DEALLOCATE(ZRUS)
+ DEALLOCATE(ZRVS)
+ DEALLOCATE(ZRWS)
+ DEALLOCATE(ZRSVS)
+ DEALLOCATE(ZRTHLS)
+ DEALLOCATE(ZRRS)
+ !
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+!
+!-------------------------------------------------------------------
+!
+!* 4. NO SPLIT PROCESS CASE
+! ---------------------
+!
+ELSE
+!
+ CALL TURB_HOR(1, KRR, KRRL, KRRI, PTSTEP, &
+ OTURB_FLX,OSUBG_COND, &
+ TPFILE, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
+ PDIRCOSXW,PDIRCOSYW,PDIRCOSZW, &
+ PCOSSLOPE,PSINSLOPE, &
+ ZINV_PDXX, ZINV_PDYY, ZINV_PDZZ, ZMZM_PRHODJ, &
+ ZK, &
+ PRHODJ,PTHVREF, &
+ PSFTHM,PSFRM,PSFSVM, &
+ PCDUEFF,PTAU11M,PTAU12M,PTAU22M,PTAU33M, &
+ PUM,PVM,PWM,PUSLOPEM,PVSLOPEM,PTHLM,PRM,PSVM, &
+ PTKEM,PLM,PLEPS, &
+ PLOCPEXNM,PATHETA,PAMOIST,PSRCM,PFRAC_ICE, &
+ PDP,PTP,PSIGS, &
+ PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS )
+
+! horizontal transport of Tke
+!
+
+ CALL TURB_HOR_TKE(1, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY, &
+ ZINV_PDXX, ZINV_PDYY, ZINV_PDZZ, ZMZM_PRHODJ, &
+ ZK, PRHODJ, PTKEM, &
+ PTRH )
+!
+END IF
+!--------------------------------------------------------------------
+!
+DEALLOCATE(ZK)
+DEALLOCATE(ZINV_PDXX)
+DEALLOCATE(ZINV_PDYY)
+DEALLOCATE(ZINV_PDZZ)
+DEALLOCATE(ZMZM_PRHODJ)
+!
+END SUBROUTINE TURB_HOR_SPLT
diff --git a/src/mesonh/turb/turb_hor_sv_corr.f90 b/src/mesonh/turb/turb_hor_sv_corr.f90
new file mode 100644
index 000000000..f9e2c7b55
--- /dev/null
+++ b/src/mesonh/turb/turb_hor_sv_corr.f90
@@ -0,0 +1,218 @@
+!MNH_LIC Copyright 2002-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ############################
+ MODULE MODI_TURB_HOR_SV_CORR
+! ############################
+!
+INTERFACE
+!
+ SUBROUTINE TURB_HOR_SV_CORR(KRR,KRRL,KRRI, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY, &
+ PLM,PLEPS,PTKEM,PTHVREF, &
+ PTHLM,PRM, &
+ PLOCPEXNM,PATHETA,PAMOIST,PSRCM, &
+ PWM,PSVM )
+!
+INTEGER, INTENT(IN) :: KRR ! number of moist var.
+INTEGER, INTENT(IN) :: KRRL ! number of liquid var.
+INTEGER, INTENT(IN) :: KRRI ! number of ice var.
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
+ ! Metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! mixing length
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! dissipative length
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! tke
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! reference Thv
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM ! potential temperature at t-Delta t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios at t-Delta t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exnref at time t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! coefficients between
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM ! normalized
+ ! 2nd-order flux s'r'c/2Sigma_s2 at t-1 multiplied by Lambda_3
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PWM ! w at t-1
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-1
+!
+!
+END SUBROUTINE TURB_HOR_SV_CORR
+!
+END INTERFACE
+!
+END MODULE MODI_TURB_HOR_SV_CORR
+! ################################################################
+ SUBROUTINE TURB_HOR_SV_CORR(KRR,KRRL,KRRI, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY, &
+ PLM,PLEPS,PTKEM,PTHVREF, &
+ PTHLM,PRM, &
+ PLOCPEXNM,PATHETA,PAMOIST,PSRCM, &
+ PWM,PSVM )
+! ################################################################
+!
+!
+!!**** *TURB_HOT_SV_CORR* computes subgrid Sv2 and SvThv terms
+!!
+!! PURPOSE
+!! -------
+!!
+!! see TURB_HOR
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!!
+!! V. Masson * Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 06/11/02
+!! JP Pinty Feb 20, 2003 Add PFRAC_ICE
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_CONF
+USE MODD_CTURB
+USE MODD_PARAMETERS
+USE MODD_NSV, ONLY : NSV,NSV_LGBEG,NSV_LGEND
+USE MODD_LES
+USE MODD_BLOWSNOW
+!
+USE MODI_GRADIENT_M
+USE MODI_GRADIENT_U
+USE MODI_GRADIENT_V
+USE MODI_GRADIENT_W
+USE MODI_SHUMAN
+USE MODI_LES_MEAN_SUBGRID
+USE MODI_EMOIST
+USE MODI_ETHETA
+!
+USE MODI_SECOND_MNH
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declaration of arguments
+!
+!
+!
+INTEGER, INTENT(IN) :: KRR ! number of moist var.
+INTEGER, INTENT(IN) :: KRRL ! number of liquid var.
+INTEGER, INTENT(IN) :: KRRI ! number of ice var.
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
+ ! Metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! mixing length
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! dissipative length
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! tke
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! reference Thv
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM ! potential temperature at t-Delta t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios at t-Delta t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exnref at time t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! coefficients between
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM ! normalized
+ ! 2nd-order flux s'r'c/2Sigma_s2 at t-1 multiplied by Lambda_3
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PWM ! w at t-1
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-1
+!
+!
+!
+!* 0.2 declaration of local variables
+!
+REAL, DIMENSION(SIZE(PSVM,1),SIZE(PSVM,2),SIZE(PSVM,3)) &
+ :: ZFLX, ZA
+!
+INTEGER :: JSV ! loop counter
+!
+REAL :: ZTIME1, ZTIME2
+!
+REAL :: ZCSVD = 1.2 ! constant for scalar variance dissipation
+REAL :: ZCTSVD = 2.4 ! constant for temperature - scalar covariance dissipation
+REAL :: ZCQSVD = 2.4 ! constant for humidity - scalar covariance dissipation
+!
+REAL :: ZCSV !constant for the scalar flux
+! ---------------------------------------------------------------------------
+!
+CALL SECOND_MNH(ZTIME1)
+!
+IF(LBLOWSNOW) THEN
+! See Vionnet (PhD, 2012) for a complete discussion around the value of the Schmidt number for blowing snow variables
+ ZCSV= XCHF/XRSNOW
+ELSE
+ ZCSV= XCHF
+ENDIF
+!
+DO JSV=1,NSV
+!
+ IF (LNOMIXLG .AND. JSV >= NSV_LGBEG .AND. JSV<= NSV_LGEND) CYCLE
+ !
+ ! variance Sv2
+ !
+ IF (LLES_CALL) THEN
+ IF (.NOT. L2D) THEN
+ ZFLX(:,:,:) = ZCSV / ZCSVD * PLM(:,:,:) * PLEPS(:,:,:) * &
+ ( GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)**2 &
+ + GY_M_M(PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY)**2 )
+ ELSE
+ ZFLX(:,:,:) = ZCSV / ZCSVD * PLM(:,:,:) * PLEPS(:,:,:) * &
+ GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)**2
+ END IF
+ CALL LES_MEAN_SUBGRID( -2.*ZCSVD*SQRT(PTKEM)*ZFLX/PLEPS, &
+ X_LES_SUBGRID_DISS_Sv2(:,:,:,JSV), .TRUE. )
+ CALL LES_MEAN_SUBGRID( MZF(PWM)*ZFLX, X_LES_RES_W_SBG_Sv2(:,:,:,JSV), .TRUE. )
+ END IF
+ !
+ ! covariance SvThv
+ !
+ IF (LLES_CALL) THEN
+ ZA(:,:,:) = ETHETA(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM)
+ IF (.NOT. L2D) THEN
+ ZFLX(:,:,:)= PLM(:,:,:) * PLEPS(:,:,:) &
+ * ( GX_M_M(PTHLM,PDXX,PDZZ,PDZX) * GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX) &
+ + GY_M_M(PTHLM,PDYY,PDZZ,PDZY) * GY_M_M(PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY) &
+ ) * (XCSHF+ZCSV) / (2.*ZCTSVD)
+ ELSE
+ ZFLX(:,:,:)= PLM(:,:,:) * PLEPS(:,:,:) &
+ * GX_M_M(PTHLM,PDXX,PDZZ,PDZX) * GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX) &
+ * (XCSHF+ZCSV) / (2.*ZCTSVD)
+ END IF
+ CALL LES_MEAN_SUBGRID( ZA*ZFLX, X_LES_SUBGRID_SvThv(:,:,:,JSV) , .TRUE.)
+ CALL LES_MEAN_SUBGRID( -XG/PTHVREF/3.*ZA*ZFLX, X_LES_SUBGRID_SvPz(:,:,:,JSV), .TRUE. )
+ !
+ IF (KRR>=1) THEN
+ ZA(:,:,:) = EMOIST(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM)
+ IF (.NOT. L2D) THEN
+ ZFLX(:,:,:)= PLM(:,:,:) * PLEPS(:,:,:) &
+ * ( GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX) * GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX) &
+ + GY_M_M(PRM(:,:,:,1),PDYY,PDZZ,PDZY) * GY_M_M(PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY) &
+ ) * (XCHF+ZCSV) / (2.*ZCQSVD)
+ ELSE
+ ZFLX(:,:,:)= PLM(:,:,:) * PLEPS(:,:,:) &
+ * GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX) * GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX) &
+ * (XCHF+ZCSV) / (2.*ZCQSVD)
+ END IF
+ CALL LES_MEAN_SUBGRID( ZA*ZFLX, X_LES_SUBGRID_SvThv(:,:,:,JSV) , .TRUE.)
+ CALL LES_MEAN_SUBGRID( -XG/PTHVREF/3.*ZA*ZFLX, X_LES_SUBGRID_SvPz(:,:,:,JSV), .TRUE. )
+ END IF
+ END IF
+!
+END DO ! end loop JSV
+!
+CALL SECOND_MNH(ZTIME2)
+XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+!
+END SUBROUTINE TURB_HOR_SV_CORR
diff --git a/src/mesonh/turb/turb_hor_sv_flux.f90 b/src/mesonh/turb/turb_hor_sv_flux.f90
new file mode 100644
index 000000000..163ee3d02
--- /dev/null
+++ b/src/mesonh/turb/turb_hor_sv_flux.f90
@@ -0,0 +1,364 @@
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ############################
+ MODULE MODI_TURB_HOR_SV_FLUX
+! ############################
+!
+INTERFACE
+!
+ SUBROUTINE TURB_HOR_SV_FLUX(KSPLT, &
+ OTURB_FLX, &
+ TPFILE, &
+ PK,PINV_PDXX,PINV_PDYY,PINV_PDZZ,PMZM_PRHODJ, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY, &
+ PDIRCOSXW,PDIRCOSYW, &
+ PRHODJ,PWM, &
+ PSFSVM, &
+ PSVM, &
+ PRSVS )
+!
+USE MODD_IO, ONLY: TFILEDATA
+!
+INTEGER, INTENT(IN) :: KSPLT ! split process index
+LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
+ ! turbulent fluxes in the syncronous FM-file
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PK ! Turbulent diffusion doef.
+ ! PK = PLM * SQRT(PTKEM)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDXX ! 1./PDXX
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDYY ! 1./PDYY
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDZZ ! 1./PDZZ
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PMZM_PRHODJ ! MZM(PRHODJ)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
+ ! Metric coefficients
+REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSXW, PDIRCOSYW
+! Director Cosinus along x and y directions at surface w-point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density * grid volume
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PWM ! vertical wind
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSFSVM ! surface fluxes
+!
+!
+! Variables at t-1
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-1
+!
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS ! var. at t+1 -split-
+!
+!
+!
+END SUBROUTINE TURB_HOR_SV_FLUX
+!
+END INTERFACE
+!
+END MODULE MODI_TURB_HOR_SV_FLUX
+! ################################################################
+ SUBROUTINE TURB_HOR_SV_FLUX(KSPLT, &
+ OTURB_FLX, &
+ TPFILE, &
+ PK,PINV_PDXX,PINV_PDYY,PINV_PDZZ,PMZM_PRHODJ, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY, &
+ PDIRCOSXW,PDIRCOSYW, &
+ PRHODJ,PWM, &
+ PSFSVM, &
+ PSVM, &
+ PRSVS )
+! ################################################################
+!
+!
+!!**** *TURB_HOR* -routine to compute the source terms in the meso-NH
+!! model equations due to the non-vertical turbulent fluxes.
+!!
+!! PURPOSE
+!! -------
+!!
+!! see TURB_HOR
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!!
+!! Joan Cuxart * INM and Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Aug , 1997 (V. Saravane) spliting of TURB_HOR
+!! Nov 27, 1997 (V. Masson) clearing of the routine
+!! Oct 18, 2000 (V. Masson) LES computations + LFLAT swith
+!! + bug on Y scalar flux
+!! Jun 20, 2001 (J Stein) case of lagragian variables
+!! Nov 06, 2002 (V. Masson) LES budgets
+!! October 2009 (G. Tanguy) add ILENCH=LEN(YCOMMENT) after
+!! change of YCOMMENT
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_CONF
+USE MODD_CTURB
+use modd_field, only: tfielddata, TYPEREAL
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_PARAMETERS
+USE MODD_NSV, ONLY: NSV_LGBEG, NSV_LGEND
+USE MODD_LES
+USE MODD_BLOWSNOW
+!
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+!
+USE MODI_GRADIENT_M
+USE MODI_GRADIENT_U
+USE MODI_GRADIENT_V
+USE MODI_GRADIENT_W
+USE MODI_SHUMAN
+USE MODI_COEFJ
+USE MODI_LES_MEAN_SUBGRID
+!
+USE MODI_SECOND_MNH
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declaration of arguments
+!
+!
+!
+INTEGER, INTENT(IN) :: KSPLT ! split process index
+LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
+ ! turbulent fluxes in the syncronous FM-file
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PK ! Turbulent diffusion doef.
+ ! PK = PLM * SQRT(PTKEM)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDXX ! 1./PDXX
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDYY ! 1./PDYY
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDZZ ! 1./PDZZ
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PMZM_PRHODJ ! MZM(PRHODJ)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
+ ! Metric coefficients
+REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSXW, PDIRCOSYW
+! Director Cosinus along x and y directions at surface w-point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density * grid volume
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PWM ! vertical wind
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSFSVM ! surface fluxes
+!
+!
+! Variables at t-1
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-1
+!
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS ! var. at t+1 -split-
+!
+!
+!
+!* 0.2 declaration of local variables
+!
+REAL, DIMENSION(SIZE(PSVM,1),SIZE(PSVM,2),SIZE(PSVM,3)) &
+ :: ZFLXX,ZFLXY
+ ! work arrays
+REAL, DIMENSION(SIZE(PSVM,1),SIZE(PSVM,2),1) :: ZWORK2D
+!
+REAL :: ZCSV !constant for the scalar flux
+
+INTEGER :: IKB,IKE
+ ! Index values for the Beginning and End
+ ! mass points of the domain
+INTEGER :: JSV ! loop counter
+INTEGER :: ISV ! number of scalar var.
+REAL, DIMENSION(SIZE(PDZZ,1),SIZE(PDZZ,2),1+JPVEXT:3+JPVEXT) :: ZCOEFF
+ ! coefficients for the uncentred gradient
+ ! computation near the ground
+!
+INTEGER :: IKU
+TYPE(TFIELDDATA) :: TZFIELD
+REAL :: ZTIME1, ZTIME2
+! ---------------------------------------------------------------------------
+!
+!* 1. PRELIMINARY COMPUTATIONS
+! ------------------------
+!
+IKB = 1+JPVEXT
+IKE = SIZE(PSVM,3)-JPVEXT
+IKU = SIZE(PSVM,3)
+!
+ISV = SIZE(PSVM,4)
+!
+IF(LBLOWSNOW) THEN
+! See Vionnet (PhD, 2012) for a complete discussion around the value of the Schmidt number for blowing snow variables
+ ZCSV= XCHF/XRSNOW
+ELSE
+ ZCSV= XCHF
+ENDIF
+!
+! compute the coefficients for the uncentred gradient computation near the
+! ground
+ZCOEFF(:,:,IKB+2)= - PDZZ(:,:,IKB+1) / &
+ ( (PDZZ(:,:,IKB+2)+PDZZ(:,:,IKB+1)) * PDZZ(:,:,IKB+2) )
+ZCOEFF(:,:,IKB+1)= (PDZZ(:,:,IKB+2)+PDZZ(:,:,IKB+1)) / &
+ ( PDZZ(:,:,IKB+1) * PDZZ(:,:,IKB+2) )
+ZCOEFF(:,:,IKB)= - (PDZZ(:,:,IKB+2)+2.*PDZZ(:,:,IKB+1)) / &
+ ( (PDZZ(:,:,IKB+2)+PDZZ(:,:,IKB+1)) * PDZZ(:,:,IKB+1) )
+!
+!
+!* 15. HORIZONTAL FLUXES OF PASSIVE SCALARS
+! ------------------------------------
+!
+!
+DO JSV=1,ISV
+!
+ IF (LNOMIXLG .AND. JSV >= NSV_LGBEG .AND. JSV<= NSV_LGEND) CYCLE
+!
+! 15.1 <U' SVth'>
+! ----------
+!
+ ! Computes the flux in the X direction
+ ZFLXX(:,:,:) = -ZCSV * MXM(PK) * GX_M_U(1,IKU,1,PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)
+ ZFLXX(:,:,IKE+1) = ZFLXX(:,:,IKE)
+!
+! Compute the flux at the first inner U-point with an uncentred vertical
+! gradient
+ ZFLXX(:,:,IKB:IKB) = -ZCSV * MXM( PK(:,:,IKB:IKB) ) * &
+ ( DXM(PSVM(:,:,IKB:IKB,JSV)) * PINV_PDXX(:,:,IKB:IKB) &
+ -MXM ( ZCOEFF(:,:,IKB+2:IKB+2)*PSVM(:,:,IKB+2:IKB+2,JSV) &
+ +ZCOEFF(:,:,IKB+1:IKB+1)*PSVM(:,:,IKB+1:IKB+1,JSV) &
+ +ZCOEFF(:,:,IKB :IKB )*PSVM(:,:,IKB :IKB ,JSV) &
+ ) * 0.5 * ( PDZX(:,:,IKB+1:IKB+1)+PDZX(:,:,IKB:IKB) ) &
+ * PINV_PDXX(:,:,IKB:IKB) &
+ )
+! extrapolates the flux under the ground so that the vertical average with
+! the IKB flux gives the ground value
+ ZWORK2D(:,:,1)=PSFSVM(:,:,JSV) * PDIRCOSXW(:,:)
+ ZFLXX(:,:,IKB-1:IKB-1) = 2. * MXM( ZWORK2D(:,:,1:1) ) - ZFLXX(:,:,IKB:IKB)
+ !
+ ! stores <U SVth>
+ IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
+ WRITE(TZFIELD%CMNHNAME,'("USV_FLX_",I3.3)') JSV
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'SVUNIT m s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%NGRID = 2
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLXX)
+ END IF
+!
+ IF (LLES_CALL .AND. KSPLT==1) THEN
+ CALL SECOND_MNH(ZTIME1)
+ CALL LES_MEAN_SUBGRID( MXF(ZFLXX), X_LES_SUBGRID_USv(:,:,:,JSV) )
+ CALL LES_MEAN_SUBGRID( MZF(MXF(GX_W_UW(PWM,PDXX,PDZZ,PDZX)*MZM(ZFLXX))), &
+ X_LES_RES_ddxa_W_SBG_UaSv(:,:,:,JSV) , .TRUE. )
+ CALL LES_MEAN_SUBGRID( GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)*MXF(ZFLXX), &
+ X_LES_RES_ddxa_Sv_SBG_UaSv(:,:,:,JSV), .TRUE. )
+ CALL SECOND_MNH(ZTIME2)
+ XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ END IF
+!
+! 15.2 <V' SVth'>
+! ----------
+!
+ IF (.NOT. L2D) THEN
+!
+! Computes the flux in the Y direction
+ ZFLXY(:,:,:)=-ZCSV * MYM(PK) * GY_M_V(1,IKU,1,PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY)
+ ZFLXY(:,:,IKE+1) = ZFLXY(:,:,IKE)
+!
+! Compute the flux at the first inner V-point with an uncentred vertical
+! gradient
+!
+ ZFLXY(:,:,IKB:IKB) = -ZCSV * MYM( PK(:,:,IKB:IKB) ) * &
+ ( DYM(PSVM(:,:,IKB:IKB,JSV)) * PINV_PDYY(:,:,IKB:IKB) &
+ -MYM ( ZCOEFF(:,:,IKB+2:IKB+2)*PSVM(:,:,IKB+2:IKB+2,JSV) &
+ +ZCOEFF(:,:,IKB+1:IKB+1)*PSVM(:,:,IKB+1:IKB+1,JSV) &
+ +ZCOEFF(:,:,IKB :IKB )*PSVM(:,:,IKB :IKB ,JSV) &
+ ) * 0.5 * ( PDZY(:,:,IKB+1:IKB+1)+PDZY(:,:,IKB:IKB) ) &
+ * PINV_PDYY(:,:,IKB:IKB) &
+ )
+! extrapolates the flux under the ground so that the vertical average with
+! the IKB flux gives the ground value
+ ZWORK2D(:,:,1)=PSFSVM(:,:,JSV) * PDIRCOSYW(:,:)
+ ZFLXY(:,:,IKB-1:IKB-1) = 2. * MYM( ZWORK2D(:,:,1:1) ) - ZFLXY(:,:,IKB:IKB)
+ !
+ ! stores <V SVth>
+ IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
+ WRITE(TZFIELD%CMNHNAME,'("VSV_FLX_",I3.3)') JSV
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'SVUNIT m s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%NGRID = 3
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLXY)
+ END IF
+!
+ ELSE
+ ZFLXY=0.
+ END IF
+!
+ IF (LLES_CALL .AND. KSPLT==1) THEN
+ CALL SECOND_MNH(ZTIME1)
+ CALL LES_MEAN_SUBGRID( MYF(ZFLXY), X_LES_SUBGRID_VSv(:,:,:,JSV) )
+ CALL LES_MEAN_SUBGRID( MZF(MYF(GY_W_VW(PWM,PDYY,PDZZ,PDZY)*MZM(ZFLXY))), &
+ X_LES_RES_ddxa_W_SBG_UaSv(:,:,:,JSV) , .TRUE. )
+ CALL LES_MEAN_SUBGRID( GY_M_M(PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY)*MYF(ZFLXY), &
+ X_LES_RES_ddxa_Sv_SBG_UaSv(:,:,:,JSV) , .TRUE. )
+ CALL SECOND_MNH(ZTIME2)
+ XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ END IF
+!
+!
+! 15.3 Horizontal source terms
+! -----------------------
+!
+ IF (.NOT. L2D) THEN
+ IF (.NOT. LFLAT) THEN
+ PRSVS(:,:,:,JSV)= PRSVS(:,:,:,JSV) &
+ -DXF( MXM(PRHODJ) * ZFLXX * PINV_PDXX ) &
+ -DYF( MYM(PRHODJ) * ZFLXY * PINV_PDYY ) &
+ +DZF( PMZM_PRHODJ * PINV_PDZZ * &
+ ( MXF( MZM(ZFLXX * PINV_PDXX) * PDZX ) + MYF( MZM(ZFLXY * PINV_PDYY) * PDZY ) ) &
+ )
+ ELSE
+ PRSVS(:,:,:,JSV)= PRSVS(:,:,:,JSV) &
+ -DXF( MXM(PRHODJ) * ZFLXX * PINV_PDXX ) &
+ -DYF( MYM(PRHODJ) * ZFLXY * PINV_PDYY )
+ END IF
+ ELSE
+ IF (.NOT. LFLAT) THEN
+ PRSVS(:,:,:,JSV)= PRSVS(:,:,:,JSV) &
+ -DXF( MXM(PRHODJ) * ZFLXX * PINV_PDXX ) &
+ +DZF( PMZM_PRHODJ * PINV_PDZZ * &
+ ( MXF( MZM(ZFLXX * PINV_PDXX) * PDZX ) ) &
+ )
+ ELSE
+ PRSVS(:,:,:,JSV)= PRSVS(:,:,:,JSV) &
+ -DXF( MXM(PRHODJ) *ZFLXX * PINV_PDXX )
+ END IF
+ END IF
+!
+!
+END DO ! end loop JSV
+!
+!
+END SUBROUTINE TURB_HOR_SV_FLUX
diff --git a/src/mesonh/turb/turb_hor_thermo_corr.f90 b/src/mesonh/turb/turb_hor_thermo_corr.f90
new file mode 100644
index 000000000..b61948676
--- /dev/null
+++ b/src/mesonh/turb/turb_hor_thermo_corr.f90
@@ -0,0 +1,468 @@
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ################################
+ MODULE MODI_TURB_HOR_THERMO_CORR
+! ################################
+!
+INTERFACE
+!
+ SUBROUTINE TURB_HOR_THERMO_CORR(KRR, KRRL, KRRI, &
+ OTURB_FLX,OSUBG_COND, &
+ TPFILE, &
+ PINV_PDXX,PINV_PDYY, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY, &
+ PTHVREF, &
+ PWM,PTHLM,PRM, &
+ PTKEM,PLM,PLEPS, &
+ PLOCPEXNM,PATHETA,PAMOIST,PSRCM, &
+ PSIGS )
+!
+USE MODD_IO, ONLY: TFILEDATA
+!
+INTEGER, INTENT(IN) :: KRR ! number of moist var.
+INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
+INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
+LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
+ ! turbulent fluxes in the syncronous FM-file
+LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for sub-grid
+! condensation
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDXX ! 1./PDXX
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDYY ! 1./PDYY
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
+ ! Metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! ref. state Virtual
+ ! Potential Temperature
+!
+! Variables at t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PWM
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! mixing ratios at t-1,
+ ! where PRM(:,:,:,1) = conservative mixing ratio
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! Turb. Kin. Energy
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! dissipative length
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exnref at time t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! coefficients between
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM ! normalized
+ ! 2nd-order flux s'r'c/2Sigma_s2 at t-1 multiplied by Lambda_3
+!
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSIGS
+ ! IN: Vertical part of Sigma_s at t
+ ! OUT: Total Sigma_s at t
+!
+!
+!
+END SUBROUTINE TURB_HOR_THERMO_CORR
+!
+END INTERFACE
+!
+END MODULE MODI_TURB_HOR_THERMO_CORR
+! ################################################################
+ SUBROUTINE TURB_HOR_THERMO_CORR(KRR, KRRL, KRRI, &
+ OTURB_FLX,OSUBG_COND, &
+ TPFILE, &
+ PINV_PDXX,PINV_PDYY, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY, &
+ PTHVREF, &
+ PWM,PTHLM,PRM, &
+ PTKEM,PLM,PLEPS, &
+ PLOCPEXNM,PATHETA,PAMOIST,PSRCM, &
+ PSIGS )
+! ################################################################
+!
+!
+!!**** *TURB_HOR* -routine to compute the source terms in the meso-NH
+!! model equations due to the non-vertical turbulent fluxes.
+!!
+!! PURPOSE
+!! -------
+!!
+!! see TURB_HOR
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!!
+!! Joan Cuxart * INM and Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Aug , 1997 (V. Saravane) spliting of TURB_HOR
+!! Nov 27, 1997 (V. Masson) clearing of the routine
+!! Nov 06, 2002 (V. Masson) LES budgets
+!! Feb 20, 2003 (JP Pinty) Add PFRAC_ICE
+!! October 2009 (G. Tanguy) add ILENCH=LEN(YCOMMENT) after
+!! change of YCOMMENT
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_CONF
+USE MODD_CTURB
+use modd_field, only: tfielddata, TYPEREAL
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_PARAMETERS
+USE MODD_LES
+!
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+!
+USE MODI_GRADIENT_M
+USE MODI_GRADIENT_U
+USE MODI_GRADIENT_V
+USE MODI_GRADIENT_W
+USE MODI_SHUMAN
+USE MODI_LES_MEAN_SUBGRID
+!
+USE MODI_EMOIST
+USE MODI_ETHETA
+!
+USE MODI_SECOND_MNH
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declaration of arguments
+!
+!
+!
+INTEGER, INTENT(IN) :: KRR ! number of moist var.
+INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
+INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
+LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
+ ! turbulent fluxes in the syncronous FM-file
+LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for sub-grid
+! condensation
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDXX ! 1./PDXX
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDYY ! 1./PDYY
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
+ ! Metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! ref. state Virtual
+ ! Potential Temperature
+!
+! Variables at t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PWM
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! mixing ratios at t-1,
+ ! where PRM(:,:,:,1) = conservative mixing ratio
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! Turb. Kin. Energy
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! dissipative length
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exnref at time t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! coefficients between
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM ! normalized
+!
+!
+!
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSIGS
+ ! IN: Vertical part of Sigma_s at t
+ ! OUT: Total Sigma_s at t
+!
+!* 0.2 declaration of local variables
+!
+REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) &
+ :: ZFLX,ZWORK,ZA
+ ! work arrays
+!
+INTEGER :: IKB,IKE
+ ! Index values for the Beginning and End
+ ! mass points of the domain
+REAL, DIMENSION(SIZE(PDZZ,1),SIZE(PDZZ,2),1+JPVEXT:3+JPVEXT) :: ZCOEFF
+ ! coefficients for the uncentred gradient
+ ! computation near the ground
+REAL :: ZTIME1, ZTIME2
+TYPE(TFIELDDATA) :: TZFIELD
+!
+! ---------------------------------------------------------------------------
+!
+!* 1. PRELIMINARY COMPUTATIONS
+! ------------------------
+!
+IKB = 1+JPVEXT
+IKE = SIZE(PTHLM,3)-JPVEXT
+!
+!
+!
+! compute the coefficients for the uncentred gradient computation near the
+! ground
+ZCOEFF(:,:,IKB+2)= - PDZZ(:,:,IKB+1) / &
+ ( (PDZZ(:,:,IKB+2)+PDZZ(:,:,IKB+1)) * PDZZ(:,:,IKB+2) )
+ZCOEFF(:,:,IKB+1)= (PDZZ(:,:,IKB+2)+PDZZ(:,:,IKB+1)) / &
+ ( PDZZ(:,:,IKB+1) * PDZZ(:,:,IKB+2) )
+ZCOEFF(:,:,IKB)= - (PDZZ(:,:,IKB+2)+2.*PDZZ(:,:,IKB+1)) / &
+ ( (PDZZ(:,:,IKB+2)+PDZZ(:,:,IKB+1)) * PDZZ(:,:,IKB+1) )
+!
+!
+!* 8. TURBULENT CORRELATIONS : <THl THl>, <THl Rnp>, <Rnp Rnp>, Sigma_s
+! -----------------------------------------------------------------
+!
+!
+!
+IF ( ( KRRL > 0 .AND. OSUBG_COND) .OR. ( OTURB_FLX .AND. tpfile%lopened ) &
+ .OR. ( LLES_CALL ) ) THEN
+!
+!* 8.1 <THl THl>
+!
+ ! Computes the horizontal variance <THl THl>
+ IF (.NOT. L2D) THEN
+ ZFLX(:,:,:) = XCTV * PLM(:,:,:) * PLEPS(:,:,:) * &
+ ( GX_M_M(PTHLM,PDXX,PDZZ,PDZX)**2 + GY_M_M(PTHLM,PDYY,PDZZ,PDZY)**2 )
+ ELSE
+ ZFLX(:,:,:) = XCTV * PLM(:,:,:) * PLEPS(:,:,:) * &
+ GX_M_M(PTHLM,PDXX,PDZZ,PDZX)**2
+ END IF
+!
+! Compute the flux at the first inner U-point with an uncentred vertical
+! gradient
+!
+ ZFLX(:,:,IKB:IKB) = XCTV * PLM(:,:,IKB:IKB) &
+ * PLEPS(:,:,IKB:IKB) * ( &
+ ( MXF(DXM(PTHLM(:,:,IKB:IKB)) * PINV_PDXX(:,:,IKB:IKB)) &
+ - ( ZCOEFF(:,:,IKB+2:IKB+2)*PTHLM(:,:,IKB+2:IKB+2) &
+ +ZCOEFF(:,:,IKB+1:IKB+1)*PTHLM(:,:,IKB+1:IKB+1) &
+ +ZCOEFF(:,:,IKB :IKB )*PTHLM(:,:,IKB :IKB ) &
+ ) * 0.5 * ( PDZX(:,:,IKB+1:IKB+1)+PDZX(:,:,IKB:IKB) ) &
+ / MXF(PDXX(:,:,IKB:IKB)) &
+ ) ** 2 + &
+ ( MYF(DYM(PTHLM(:,:,IKB:IKB)) * PINV_PDYY(:,:,IKB:IKB)) &
+ - ( ZCOEFF(:,:,IKB+2:IKB+2)*PTHLM(:,:,IKB+2:IKB+2) &
+ +ZCOEFF(:,:,IKB+1:IKB+1)*PTHLM(:,:,IKB+1:IKB+1) &
+ +ZCOEFF(:,:,IKB :IKB )*PTHLM(:,:,IKB :IKB ) &
+ ) * 0.5 * ( PDZY(:,:,IKB+1:IKB+1)+PDZY(:,:,IKB:IKB) ) &
+ / MYF(PDYY(:,:,IKB:IKB)) &
+ ) ** 2 )
+ !
+ ZFLX(:,:,IKB-1) = ZFLX(:,:,IKB)
+ !
+ IF ( KRRL > 0 ) THEN
+ ZWORK(:,:,:) = ZFLX(:,:,:) * PATHETA(:,:,:) * PATHETA(:,:,:)
+ END IF
+ !
+ ! stores <THl THl>
+ IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
+ TZFIELD%CMNHNAME = 'THL_HVAR'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'THL_HVAR'
+ TZFIELD%CUNITS = 'K2'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_THL_HVAR'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLX)
+ END IF
+!
+! Storage in the LES configuration (addition to TURB_VER computation)
+!
+ IF (LLES_CALL) THEN
+ CALL SECOND_MNH(ZTIME1)
+ CALL LES_MEAN_SUBGRID( ZFLX, X_LES_SUBGRID_Thl2, .TRUE. )
+ CALL LES_MEAN_SUBGRID( MZF(PWM)*ZFLX, X_LES_RES_W_SBG_Thl2, .TRUE. )
+ CALL LES_MEAN_SUBGRID( -2.*XCTD*SQRT(PTKEM)*ZFLX/PLEPS ,X_LES_SUBGRID_DISS_Thl2, .TRUE. )
+ ZA(:,:,:) = ETHETA(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM)
+ CALL LES_MEAN_SUBGRID( ZA*ZFLX, X_LES_SUBGRID_ThlThv, .TRUE. )
+ CALL LES_MEAN_SUBGRID( -XG/PTHVREF/3.*ZA*ZFLX, X_LES_SUBGRID_ThlPz, .TRUE. )
+ CALL SECOND_MNH(ZTIME2)
+ XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ END IF
+!
+ IF ( KRR /= 0 ) THEN
+!
+!* 8.3 <THl Rnp>
+!
+ ! Computes the horizontal correlation <THl Rnp>
+ IF (.NOT. L2D) THEN
+ ZFLX(:,:,:)= &
+ PLM(:,:,:) * PLEPS(:,:,:) * &
+ (GX_M_M(PTHLM,PDXX,PDZZ,PDZX) * GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX) &
+ + GY_M_M(PTHLM,PDYY,PDZZ,PDZY) * GY_M_M(PRM(:,:,:,1),PDYY,PDZZ,PDZY) &
+ ) * (XCHT1+XCHT2)
+ ELSE
+ ZFLX(:,:,:)= &
+ PLM(:,:,:) * PLEPS(:,:,:) * &
+ (GX_M_M(PTHLM,PDXX,PDZZ,PDZX) * GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX) &
+ ) * (XCHT1+XCHT2)
+
+ END IF
+!
+! Compute the flux at the first inner U-point with an uncentred vertical
+! gradient
+ ZFLX(:,:,IKB:IKB) = (XCHT1+XCHT2) * PLM(:,:,IKB:IKB) &
+ * PLEPS(:,:,IKB:IKB) * ( &
+ ( MXF(DXM(PTHLM(:,:,IKB:IKB)) * PINV_PDXX(:,:,IKB:IKB)) &
+ - ( ZCOEFF(:,:,IKB+2:IKB+2)*PTHLM(:,:,IKB+2:IKB+2) &
+ +ZCOEFF(:,:,IKB+1:IKB+1)*PTHLM(:,:,IKB+1:IKB+1) &
+ +ZCOEFF(:,:,IKB :IKB )*PTHLM(:,:,IKB :IKB ) &
+ ) * 0.5 * ( PDZX(:,:,IKB+1:IKB+1)+PDZX(:,:,IKB:IKB) ) &
+ / MXF(PDXX(:,:,IKB:IKB)) &
+ ) * &
+ ( MXF(DXM(PRM(:,:,IKB:IKB,1)) * PINV_PDXX(:,:,IKB:IKB)) &
+ - ( ZCOEFF(:,:,IKB+2:IKB+2)*PRM(:,:,IKB+2:IKB+2,1) &
+ +ZCOEFF(:,:,IKB+1:IKB+1)*PRM(:,:,IKB+1:IKB+1,1) &
+ +ZCOEFF(:,:,IKB :IKB )*PRM(:,:,IKB :IKB ,1) &
+ ) * 0.5 * ( PDZX(:,:,IKB+1:IKB+1)+PDZX(:,:,IKB:IKB) ) &
+ / MXF(PDXX(:,:,IKB:IKB)) &
+ ) + &
+ ( MYF(DYM(PTHLM(:,:,IKB:IKB)) * PINV_PDYY(:,:,IKB:IKB)) &
+ - ( ZCOEFF(:,:,IKB+2:IKB+2)*PTHLM(:,:,IKB+2:IKB+2) &
+ +ZCOEFF(:,:,IKB+1:IKB+1)*PTHLM(:,:,IKB+1:IKB+1) &
+ +ZCOEFF(:,:,IKB :IKB )*PTHLM(:,:,IKB :IKB ) &
+ ) * 0.5 * ( PDZY(:,:,IKB+1:IKB+1)+PDZY(:,:,IKB:IKB) ) &
+ / MYF(PDYY(:,:,IKB:IKB)) &
+ ) * &
+ ( MYF(DYM(PRM(:,:,IKB:IKB,1)) * PINV_PDYY(:,:,IKB:IKB)) &
+ - ( ZCOEFF(:,:,IKB+2:IKB+2)*PRM(:,:,IKB+2:IKB+2,1) &
+ +ZCOEFF(:,:,IKB+1:IKB+1)*PRM(:,:,IKB+1:IKB+1,1) &
+ +ZCOEFF(:,:,IKB :IKB )*PRM(:,:,IKB :IKB ,1) &
+ ) * 0.5 * ( PDZY(:,:,IKB+1:IKB+1)+PDZY(:,:,IKB:IKB) ) &
+ / MYF(PDYY(:,:,IKB:IKB)) &
+ ) )
+ !
+ ZFLX(:,:,IKB-1) = ZFLX(:,:,IKB)
+ !
+ IF ( KRRL > 0 ) THEN
+ ZWORK(:,:,:) = ZWORK(:,:,:) + &
+ 2. * PATHETA(:,:,:) * PAMOIST(:,:,:) * ZFLX(:,:,:)
+ END IF
+ !
+ ! stores <THl Rnp>
+ IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
+ TZFIELD%CMNHNAME = 'THLR_HCOR'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'THLR_HCOR'
+ TZFIELD%CUNITS = 'K kg kg-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_THLR_HCOR'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLX)
+ END IF
+!
+! Storage in the LES configuration (addition to TURB_VER computation)
+!
+ IF (LLES_CALL) THEN
+ CALL SECOND_MNH(ZTIME1)
+ CALL LES_MEAN_SUBGRID( ZFLX, X_LES_SUBGRID_ThlRt, .TRUE. )
+ CALL LES_MEAN_SUBGRID( MZF(PWM)*ZFLX, X_LES_RES_W_SBG_ThlRt, .TRUE. )
+ CALL LES_MEAN_SUBGRID( -XCTD*SQRT(PTKEM)*ZFLX/PLEPS ,X_LES_SUBGRID_DISS_ThlRt, .TRUE. )
+ CALL LES_MEAN_SUBGRID( ZA*ZFLX, X_LES_SUBGRID_RtThv, .TRUE. )
+ CALL LES_MEAN_SUBGRID( -XG/PTHVREF/3.*ZA*ZFLX, X_LES_SUBGRID_RtPz,.TRUE.)
+ ZA(:,:,:) = EMOIST(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM)
+ CALL LES_MEAN_SUBGRID( ZA*ZFLX, X_LES_SUBGRID_ThlThv, .TRUE. )
+ CALL LES_MEAN_SUBGRID( -XG/PTHVREF/3.*ZA*ZFLX, X_LES_SUBGRID_ThlPz,.TRUE.)
+ CALL SECOND_MNH(ZTIME2)
+ XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ END IF
+!
+!* 8.4 <Rnp Rnp>
+!
+ ! Computes the horizontal variance <Rnp Rnp>
+ IF (.NOT. L2D) THEN
+ ZFLX(:,:,:) = XCHV * PLM(:,:,:) * PLEPS(:,:,:) * &
+ ( GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX)**2 + &
+ GY_M_M(PRM(:,:,:,1),PDYY,PDZZ,PDZY)**2 )
+ ELSE
+ ZFLX(:,:,:) = XCHV * PLM(:,:,:) * PLEPS(:,:,:) * &
+ ( GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX)**2 )
+ END IF
+!
+! Compute the flux at the first inner U-point with an uncentred vertical
+! gradient
+ ZFLX(:,:,IKB:IKB) = XCHV * PLM(:,:,IKB:IKB) &
+ * PLEPS(:,:,IKB:IKB) * ( &
+ ( MXF(DXM(PRM(:,:,IKB:IKB,1)) * PINV_PDXX(:,:,IKB:IKB)) &
+ - ( ZCOEFF(:,:,IKB+2:IKB+2)*PRM(:,:,IKB+2:IKB+2,1) &
+ +ZCOEFF(:,:,IKB+1:IKB+1)*PRM(:,:,IKB+1:IKB+1,1) &
+ +ZCOEFF(:,:,IKB :IKB )*PRM(:,:,IKB :IKB ,1) &
+ ) * 0.5 * ( PDZX(:,:,IKB+1:IKB+1)+PDZX(:,:,IKB:IKB) ) &
+ / MXF(PDXX(:,:,IKB:IKB)) &
+ ) ** 2 + &
+ ( MYF(DYM(PRM(:,:,IKB:IKB,1)) * PINV_PDYY(:,:,IKB:IKB)) &
+ - ( ZCOEFF(:,:,IKB+2:IKB+2)*PRM(:,:,IKB+2:IKB+2,1) &
+ +ZCOEFF(:,:,IKB+1:IKB+1)*PRM(:,:,IKB+1:IKB+1,1) &
+ +ZCOEFF(:,:,IKB :IKB )*PRM(:,:,IKB :IKB ,1) &
+ ) * 0.5 * ( PDZY(:,:,IKB+1:IKB+1)+PDZY(:,:,IKB:IKB) ) &
+ / MYF(PDYY(:,:,IKB:IKB)) &
+ ) ** 2 )
+!
+ ZFLX(:,:,IKB-1) = ZFLX(:,:,IKB)
+ !
+ IF ( KRRL > 0 ) THEN
+ ZWORK(:,:,:) = ZWORK(:,:,:)+ PAMOIST(:,:,:) * PAMOIST(:,:,:) * ZFLX(:,:,:)
+ END IF
+ !
+ ! stores <Rnp Rnp>
+ IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
+ TZFIELD%CMNHNAME = 'R_HVAR'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'R_HVAR'
+ TZFIELD%CUNITS = 'kg2 kg-2'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_R_HVAR'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLX)
+ END IF
+ !
+ ! Storage in the LES configuration (addition to TURB_VER computation)
+ !
+ IF (LLES_CALL) THEN
+ CALL SECOND_MNH(ZTIME1)
+ CALL LES_MEAN_SUBGRID( ZFLX, X_LES_SUBGRID_Rt2, .TRUE. )
+ CALL LES_MEAN_SUBGRID( MZF(PWM)*ZFLX, X_LES_RES_W_SBG_Rt2, .TRUE. )
+ CALL LES_MEAN_SUBGRID( ZA*ZFLX, X_LES_SUBGRID_RtThv, .TRUE. )
+ CALL LES_MEAN_SUBGRID( -XG/PTHVREF/3.*ZA*ZFLX, X_LES_SUBGRID_RtPz,.TRUE.)
+ CALL LES_MEAN_SUBGRID( -2.*XCTD*SQRT(PTKEM)*ZFLX/PLEPS, X_LES_SUBGRID_DISS_Rt2, .TRUE. )
+ CALL SECOND_MNH(ZTIME2)
+ XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ END IF
+ !
+ END IF
+!
+! 8.5 Complete the Sigma_s computation:
+!
+ IF ( KRRL > 0 ) THEN
+ !
+ PSIGS(:,:,:)=PSIGS(:,:,:)*PSIGS(:,:,:) + ZWORK(:,:,:)
+ ! Extrapolate PSIGS at the ground and at the top
+ PSIGS(:,:,IKB-1) = PSIGS(:,:,IKB)
+ PSIGS(:,:,IKE+1) = PSIGS(:,:,IKE)
+ PSIGS(:,:,:) = SQRT(MAX ( PSIGS(:,:,:),1.E-12) )
+ END IF
+!
+END IF
+!
+!
+!
+END SUBROUTINE TURB_HOR_THERMO_CORR
diff --git a/src/mesonh/turb/turb_hor_thermo_flux.f90 b/src/mesonh/turb/turb_hor_thermo_flux.f90
new file mode 100644
index 000000000..90d189a2b
--- /dev/null
+++ b/src/mesonh/turb/turb_hor_thermo_flux.f90
@@ -0,0 +1,752 @@
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ################################
+ MODULE MODI_TURB_HOR_THERMO_FLUX
+! ################################
+!
+INTERFACE
+!
+ SUBROUTINE TURB_HOR_THERMO_FLUX(KSPLT, KRR, KRRL, KRRI, &
+ OTURB_FLX,OSUBG_COND, &
+ TPFILE, &
+ PK,PINV_PDXX,PINV_PDYY,PINV_PDZZ,PMZM_PRHODJ, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY, &
+ PDIRCOSXW,PDIRCOSYW, &
+ PRHODJ, &
+ PSFTHM,PSFRM, &
+ PWM,PTHLM,PRM, &
+ PATHETA,PAMOIST,PSRCM,PFRAC_ICE, &
+ PRTHLS,PRRS )
+!
+USE MODD_IO, ONLY: TFILEDATA
+!
+INTEGER, INTENT(IN) :: KSPLT ! split process index
+INTEGER, INTENT(IN) :: KRR ! number of moist var.
+INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
+INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
+LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
+ ! turbulent fluxes in the syncronous FM-file
+LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for sub-grid
+! condensation
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PK ! Turbulent diffusion doef.
+ ! PK = PLM * SQRT(PTKEM)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDXX ! 1./PDXX
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDYY ! 1./PDYY
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDZZ ! 1./PDZZ
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PMZM_PRHODJ ! MZM(PRHODJ)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
+ ! Metric coefficients
+REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSXW, PDIRCOSYW
+! Director Cosinus along x, y and z directions at surface w-point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density * grid volume
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHM,PSFRM
+!
+! Variables at t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PWM
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! mixing ratios at t-1,
+ ! where PRM(:,:,:,1) = conservative mixing ratio
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! coefficients between
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
+
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM
+ ! normalized 2nd-order flux
+ ! s'r'c/2Sigma_s2 at t-1 multiplied by Lambda_3
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFRAC_ICE ! ri fraction of rc+ri
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHLS
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS ! var. at t+1 -split-
+!
+!
+END SUBROUTINE TURB_HOR_THERMO_FLUX
+!
+END INTERFACE
+!
+END MODULE MODI_TURB_HOR_THERMO_FLUX
+! ################################################################
+ SUBROUTINE TURB_HOR_THERMO_FLUX(KSPLT, KRR, KRRL, KRRI, &
+ OTURB_FLX,OSUBG_COND, &
+ TPFILE, &
+ PK,PINV_PDXX,PINV_PDYY,PINV_PDZZ,PMZM_PRHODJ, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY, &
+ PDIRCOSXW,PDIRCOSYW, &
+ PRHODJ, &
+ PSFTHM,PSFRM, &
+ PWM,PTHLM,PRM, &
+ PATHETA,PAMOIST,PSRCM,PFRAC_ICE, &
+ PRTHLS,PRRS )
+! ################################################################
+!
+!
+!!**** *TURB_HOR* -routine to compute the source terms in the meso-NH
+!! model equations due to the non-vertical turbulent fluxes.
+!!
+!! PURPOSE
+!! -------
+!!
+!! see TURB_HOR
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!!
+!! Joan Cuxart * INM and Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Aug , 1997 (V. Saravane) spliting of TURB_HOR
+!! Nov 27, 1997 (V. Masson) clearing of the routine
+!! Feb. 18, 1998 (J. Stein) bug for v'RC'
+!! Oct 18, 2000 (V. Masson) LES computations + LFLAT switch
+!! Nov 06, 2002 (V. Masson) LES budgets
+!! Feb 20, 2003 (JP Pinty) Add PFRAC_ICE
+!! October 2009 (G. Tanguy) add ILENCH=LEN(YCOMMENT) after
+!! change of YCOMMENT
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_CONF
+USE MODD_CTURB
+use modd_field, only: tfielddata, TYPEREAL
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_PARAMETERS
+USE MODD_LES
+!
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+!
+USE MODI_GRADIENT_M
+USE MODI_GRADIENT_U
+USE MODI_GRADIENT_V
+USE MODI_GRADIENT_W
+USE MODI_SHUMAN
+USE MODI_LES_MEAN_SUBGRID
+!!USE MODI_EMOIST
+!!USE MODI_ETHETA
+!
+USE MODI_SECOND_MNH
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declaration of arguments
+!
+!
+!
+INTEGER, INTENT(IN) :: KSPLT ! split process index
+INTEGER, INTENT(IN) :: KRR ! number of moist var.
+INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
+INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
+LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
+ ! turbulent fluxes in the syncronous FM-file
+LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for sub-grid
+! condensation
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PK ! Turbulent diffusion doef.
+ ! PK = PLM * SQRT(PTKEM)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDXX ! 1./PDXX
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDYY ! 1./PDYY
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDZZ ! 1./PDZZ
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PMZM_PRHODJ ! MZM(PRHODJ)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
+ ! Metric coefficients
+REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSXW, PDIRCOSYW
+! Director Cosinus along x, y and z directions at surface w-point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density * grid volume
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHM,PSFRM
+!
+! Variables at t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PWM
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! mixing ratios at t-1,
+ ! where PRM(:,:,:,1) = conservative mixing ratio
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! coefficients between
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
+
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM
+ ! normalized 2nd-order flux
+ ! s'r'c/2Sigma_s2 at t-1 multiplied by Lambda_3
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFRAC_ICE ! ri fraction of rc+ri
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHLS
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS ! var. at t+1 -split-
+!
+!
+!
+!* 0.2 declaration of local variables
+!
+REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) &
+ :: ZFLX,ZFLXC
+ ! work arrays
+!
+!! REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: ZVPTV
+INTEGER :: IKB,IKE,IKU
+ ! Index values for the Beginning and End
+ ! mass points of the domain
+REAL, DIMENSION(SIZE(PDZZ,1),SIZE(PDZZ,2),1+JPVEXT:3+JPVEXT) :: ZCOEFF
+ ! coefficients for the uncentred gradient
+ ! computation near the ground
+!
+REAL :: ZTIME1, ZTIME2
+TYPE(TFIELDDATA) :: TZFIELD
+! ---------------------------------------------------------------------------
+!
+!* 1. PRELIMINARY COMPUTATIONS
+! ------------------------
+!
+IKB = 1+JPVEXT
+IKE = SIZE(PTHLM,3)-JPVEXT
+IKU = SIZE(PTHLM,3)
+!
+!
+! compute the coefficients for the uncentred gradient computation near the
+! ground
+ZCOEFF(:,:,IKB+2)= - PDZZ(:,:,IKB+1) / &
+ ( (PDZZ(:,:,IKB+2)+PDZZ(:,:,IKB+1)) * PDZZ(:,:,IKB+2) )
+ZCOEFF(:,:,IKB+1)= (PDZZ(:,:,IKB+2)+PDZZ(:,:,IKB+1)) / &
+ ( PDZZ(:,:,IKB+1) * PDZZ(:,:,IKB+2) )
+ZCOEFF(:,:,IKB)= - (PDZZ(:,:,IKB+2)+2.*PDZZ(:,:,IKB+1)) / &
+ ( (PDZZ(:,:,IKB+2)+PDZZ(:,:,IKB+1)) * PDZZ(:,:,IKB+1) )
+!
+!* 2. < U' THETA'l >
+! --------------
+!
+!
+ZFLX(:,:,:) = -XCSHF * MXM( PK ) * GX_M_U(1,IKU,1,PTHLM,PDXX,PDZZ,PDZX)
+ZFLX(:,:,IKE+1) = ZFLX(:,:,IKE)
+!
+! Compute the flux at the first inner U-point with an uncentred vertical
+! gradient
+ZFLX(:,:,IKB:IKB) = -XCSHF * MXM( PK(:,:,IKB:IKB) ) * &
+ ( DXM(PTHLM(:,:,IKB:IKB)) * PINV_PDXX(:,:,IKB:IKB) &
+ -MXM( ZCOEFF(:,:,IKB+2:IKB+2)*PTHLM(:,:,IKB+2:IKB+2) &
+ +ZCOEFF(:,:,IKB+1:IKB+1)*PTHLM(:,:,IKB+1:IKB+1) &
+ +ZCOEFF(:,:,IKB :IKB )*PTHLM(:,:,IKB :IKB )) &
+ *0.5* ( PDZX(:,:,IKB+1:IKB+1)+PDZX(:,:,IKB:IKB)) &
+ * PINV_PDXX(:,:,IKB:IKB) )
+! extrapolates the flux under the ground so that the vertical average with
+! the IKB flux gives the ground value ( warning the tangential surface
+! flux has been set to 0 for the moment !! to be improved )
+ZFLX(:,:,IKB-1:IKB-1) = 2. * MXM( SPREAD( PSFTHM(:,:)* PDIRCOSXW(:,:), 3,1) ) &
+ - ZFLX(:,:,IKB:IKB)
+!
+! Add this source to the Theta_l sources
+!
+IF (.NOT. LFLAT) THEN
+ PRTHLS(:,:,:) = PRTHLS &
+ - DXF( MXM(PRHODJ) * ZFLX * PINV_PDXX ) &
+ + DZF( PMZM_PRHODJ *MXF(PDZX*(MZM(ZFLX * PINV_PDXX))) * PINV_PDZZ )
+ELSE
+ PRTHLS(:,:,:) = PRTHLS - DXF( MXM(PRHODJ) * ZFLX * PINV_PDXX )
+END IF
+!
+! Compute the equivalent tendancy for Rc and Ri
+!
+IF ( KRRL >= 1 ) THEN
+ IF (.NOT. LFLAT) THEN
+ ZFLXC = 2.*( MXF( MXM( PRHODJ*PATHETA*PSRCM )*ZFLX ) &
+ +MZF( MZM( PRHODJ*PATHETA*PSRCM )*MXF( &
+ PDZX*(MZM( ZFLX*PINV_PDXX )) ) )&
+ )
+ IF ( KRRI >= 1 ) THEN
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) + 2. * &
+ (- DXF( MXM( PRHODJ*PATHETA*PSRCM )*ZFLX*PINV_PDXX ) &
+ + DZF( MZM( PRHODJ*PATHETA*PSRCM )*MXF( PDZX*(MZM( ZFLX*PINV_PDXX )) )&
+ *PINV_PDZZ ) &
+ )*(1.0-PFRAC_ICE(:,:,:))
+ PRRS(:,:,:,4) = PRRS(:,:,:,4) + 2. * &
+ (- DXF( MXM( PRHODJ*PATHETA*PSRCM )*ZFLX*PINV_PDXX ) &
+ + DZF( MZM( PRHODJ*PATHETA*PSRCM )*MXF( PDZX*(MZM( ZFLX*PINV_PDXX )) )&
+ *PINV_PDZZ ) &
+ )*PFRAC_ICE(:,:,:)
+ ELSE
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) + 2. * &
+ (- DXF( MXM( PRHODJ*PATHETA*PSRCM )*ZFLX*PINV_PDXX ) &
+ + DZF( MZM( PRHODJ*PATHETA*PSRCM )*MXF( PDZX*(MZM( ZFLX*PINV_PDXX )) )&
+ *PINV_PDZZ ) &
+ )
+ END IF
+ ELSE
+ ZFLXC = 2.*MXF( MXM( PRHODJ*PATHETA*PSRCM )*ZFLX )
+ IF ( KRRI >= 1 ) THEN
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) - 2. * &
+ DXF( MXM( PRHODJ*PATHETA*PSRCM )*ZFLX*PINV_PDXX )*(1.0-PFRAC_ICE(:,:,:))
+ PRRS(:,:,:,4) = PRRS(:,:,:,4) - 2. * &
+ DXF( MXM( PRHODJ*PATHETA*PSRCM )*ZFLX*PINV_PDXX )*PFRAC_ICE(:,:,:)
+ ELSE
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) - 2. * &
+ DXF( MXM( PRHODJ*PATHETA*PSRCM )*ZFLX*PINV_PDXX )
+ END IF
+ END IF
+END IF
+!
+!! stores this flux in ZWORK to compute later <U' VPT'>
+!!ZWORK(:,:,:) = ZFLX(:,:,:)
+!
+! stores the horizontal <U THl>
+IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
+ TZFIELD%CMNHNAME = 'UTHL_FLX'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'UTHL_FLX'
+ TZFIELD%CUNITS = 'K m s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_UTHL_FLX'
+ TZFIELD%NGRID = 2
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLX)
+END IF
+!
+IF (KSPLT==1 .AND. LLES_CALL) THEN
+ CALL SECOND_MNH(ZTIME1)
+ CALL LES_MEAN_SUBGRID( MXF(ZFLX), X_LES_SUBGRID_UThl )
+ CALL LES_MEAN_SUBGRID( MZF(MXF(GX_W_UW(PWM,PDXX,PDZZ,PDZX)*MZM(ZFLX))),&
+ X_LES_RES_ddxa_W_SBG_UaThl , .TRUE. )
+ CALL LES_MEAN_SUBGRID( GX_M_M(PTHLM,PDXX,PDZZ,PDZX)*MXF(ZFLX),&
+ X_LES_RES_ddxa_Thl_SBG_UaThl , .TRUE. )
+ IF (KRR>=1) THEN
+ CALL LES_MEAN_SUBGRID( GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX)*MXF(ZFLX), &
+ X_LES_RES_ddxa_Rt_SBG_UaThl , .TRUE. )
+ END IF
+ CALL SECOND_MNH(ZTIME2)
+ XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+END IF
+!
+!* 3. < U' R'np >
+! -----------
+IF (KRR/=0) THEN
+ !
+ ZFLX(:,:,:) = -XCHF * MXM( PK ) * GX_M_U(1,IKU,1,PRM(:,:,:,1),PDXX,PDZZ,PDZX)
+ ZFLX(:,:,IKE+1) = ZFLX(:,:,IKE)
+!
+! Compute the flux at the first inner U-point with an uncentred vertical
+! gradient
+ ZFLX(:,:,IKB:IKB) = -XCHF * MXM( PK(:,:,IKB:IKB) ) * &
+ ( DXM(PRM(:,:,IKB:IKB,1)) * PINV_PDXX(:,:,IKB:IKB) &
+ -MXM( ZCOEFF(:,:,IKB+2:IKB+2)*PRM(:,:,IKB+2:IKB+2,1) &
+ +ZCOEFF(:,:,IKB+1:IKB+1)*PRM(:,:,IKB+1:IKB+1,1) &
+ +ZCOEFF(:,:,IKB :IKB )*PRM(:,:,IKB :IKB ,1)) &
+ *0.5* ( PDZX(:,:,IKB+1:IKB+1)+PDZX(:,:,IKB:IKB)) &
+ * PINV_PDXX(:,:,IKB:IKB) )
+! extrapolates the flux under the ground so that the vertical average with
+! the IKB flux gives the ground value ( warning the tangential surface
+! flux has been set to 0 for the moment !! to be improved )
+ ZFLX(:,:,IKB-1:IKB-1) = 2. * MXM( SPREAD( PSFRM(:,:)* PDIRCOSXW(:,:), 3,1) ) &
+ - ZFLX(:,:,IKB:IKB)
+ !
+ ! Add this source to the conservative mixing ratio sources
+ !
+ IF (.NOT. LFLAT) THEN
+ PRRS(:,:,:,1) = PRRS(:,:,:,1) &
+ - DXF( MXM(PRHODJ) * ZFLX * PINV_PDXX ) &
+ + DZF( PMZM_PRHODJ *MXF(PDZX*(MZM(ZFLX * PINV_PDXX))) * PINV_PDZZ )
+ ELSE
+ PRRS(:,:,:,1) = PRRS(:,:,:,1) - DXF( MXM(PRHODJ) * ZFLX * PINV_PDXX )
+ END IF
+ !
+ ! Compute the equivalent tendancy for Rc and Ri
+ !
+ IF ( KRRL >= 1 ) THEN
+ IF (.NOT. LFLAT) THEN
+ ZFLXC = ZFLXC &
+ + 2.*( MXF( MXM( PRHODJ*PAMOIST*PSRCM )*ZFLX ) &
+ +MZF( MZM( PRHODJ*PAMOIST*PSRCM )*MXF( &
+ PDZX*(MZM( ZFLX*PINV_PDXX )) ) )&
+ )
+ IF ( KRRI >= 1 ) THEN
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) + 2. * &
+ (- DXF( MXM( PRHODJ*PAMOIST*PSRCM )*ZFLX*PINV_PDXX ) &
+ + DZF( MZM( PRHODJ*PAMOIST*PSRCM )*MXF( PDZX*(MZM( ZFLX*PINV_PDXX )) )&
+ *PINV_PDZZ ) &
+ )*(1.0-PFRAC_ICE(:,:,:))
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) + 2. * &
+ (- DXF( MXM( PRHODJ*PAMOIST*PSRCM )*ZFLX*PINV_PDXX ) &
+ + DZF( MZM( PRHODJ*PAMOIST*PSRCM )*MXF( PDZX*(MZM( ZFLX*PINV_PDXX )) )&
+ *PINV_PDZZ ) &
+ )*PFRAC_ICE(:,:,:)
+ ELSE
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) + 2. * &
+ (- DXF( MXM( PRHODJ*PAMOIST*PSRCM )*ZFLX*PINV_PDXX ) &
+ + DZF( MZM( PRHODJ*PAMOIST*PSRCM )*MXF( PDZX*(MZM( ZFLX*PINV_PDXX )) )&
+ *PINV_PDZZ ) &
+ )
+ END IF
+ ELSE
+ ZFLXC = ZFLXC + 2.*MXF( MXM( PRHODJ*PAMOIST*PSRCM )*ZFLX )
+ IF ( KRRI >= 1 ) THEN
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) - 2. * &
+ DXF( MXM( PRHODJ*PAMOIST*PSRCM )*ZFLX*PINV_PDXX )*(1.0-PFRAC_ICE(:,:,:))
+ PRRS(:,:,:,4) = PRRS(:,:,:,4) - 2. * &
+ DXF( MXM( PRHODJ*PAMOIST*PSRCM )*ZFLX*PINV_PDXX )*PFRAC_ICE(:,:,:)
+ ELSE
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) - 2. * &
+ DXF( MXM( PRHODJ*PAMOIST*PSRCM )*ZFLX*PINV_PDXX )
+ END IF
+ END IF
+ END IF
+ !
+ ! stores the horizontal <U Rnp>
+ IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
+ TZFIELD%CMNHNAME = 'UR_FLX'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'UR_FLX'
+ TZFIELD%CUNITS = 'kg kg-1 m s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_UR_FLX'
+ TZFIELD%NGRID = 2
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLX)
+ END IF
+ !
+ IF (KSPLT==1 .AND. LLES_CALL) THEN
+ CALL SECOND_MNH(ZTIME1)
+ CALL LES_MEAN_SUBGRID( MXF(ZFLX), X_LES_SUBGRID_URt )
+ CALL LES_MEAN_SUBGRID( MZF(MXF(GX_W_UW(PWM,PDXX,PDZZ,PDZX)*MZM(ZFLX))),&
+ X_LES_RES_ddxa_W_SBG_UaRt , .TRUE. )
+ CALL LES_MEAN_SUBGRID( GX_M_M(PTHLM,PDXX,PDZZ,PDZX)*MXF(ZFLX),&
+ X_LES_RES_ddxa_Thl_SBG_UaRt , .TRUE. )
+ CALL LES_MEAN_SUBGRID( GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX)*MXF(ZFLX),&
+ X_LES_RES_ddxa_Rt_SBG_UaRt , .TRUE. )
+ CALL SECOND_MNH(ZTIME2)
+ XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ END IF
+!
+ !
+ IF (KRRL>0 .AND. KSPLT==1 .AND. LLES_CALL) THEN
+ CALL SECOND_MNH(ZTIME1)
+ CALL LES_MEAN_SUBGRID(MXF(ZFLXC), X_LES_SUBGRID_URc )
+ CALL SECOND_MNH(ZTIME2)
+ XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ END IF
+!
+END IF
+!
+!* 4. < U' TPV' >
+! -----------
+!
+!! to be tested later
+!!IF (KRR/=0) THEN
+!! ! here ZFLX= <U'Rnp'> and ZWORK= <U'Thetal'>
+!! !
+!! ZVPTU(:,:,:) = &
+!! ZWORK(:,:,:)*MXM(ETHETA(KRR,KRRI,PTHLT,PEXNREF,PRT,PLOCPT,PSRCM)) + &
+!! ZFLX(:,:,:)*MXM(EMOIST(KRR,KRRI,PTHLT,PEXNREF,PRT,PLOCPT,PSRCM))
+!! !
+!! ! stores the horizontal <U VPT>
+!! IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
+!! TZFIELD%CMNHNAME = 'UVPT_FLX'
+!! TZFIELD%CSTDNAME = ''
+!! TZFIELD%CLONGNAME = 'UVPT_FLX'
+!! TZFIELD%CUNITS = 'K m s-1'
+!! TZFIELD%CDIR = 'XY'
+!! TZFIELD%CCOMMENT = 'X_Y_Z_UVPT_FLX'
+!! TZFIELD%NGRID = 2
+!! TZFIELD%NTYPE = TYPEREAL
+!! TZFIELD%NDIMS = 3
+!! TZFIELD%LTIMEDEP = .TRUE.
+!! CALL IO_Field_write(TPFILE,TZFIELD,ZVPTU)
+!! END IF
+!!!
+!!ELSE
+!! ZVPTU(:,:,:)=ZWORK(:,:,:)
+!!END IF
+!
+!
+!* 5. < V' THETA'l >
+! --------------
+!
+!
+IF (.NOT. L2D) THEN
+ ZFLX(:,:,:) = -XCSHF * MYM( PK ) * GY_M_V(1,IKU,1,PTHLM,PDYY,PDZZ,PDZY)
+ ZFLX(:,:,IKE+1) = ZFLX(:,:,IKE)
+ELSE
+ ZFLX(:,:,:) = 0.
+END IF
+!
+!
+! Compute the flux at the first inner U-point with an uncentred vertical
+! gradient
+ZFLX(:,:,IKB:IKB) = -XCSHF * MYM( PK(:,:,IKB:IKB) ) * &
+ ( DYM(PTHLM(:,:,IKB:IKB)) * PINV_PDYY(:,:,IKB:IKB) &
+ -MYM( ZCOEFF(:,:,IKB+2:IKB+2)*PTHLM(:,:,IKB+2:IKB+2) &
+ +ZCOEFF(:,:,IKB+1:IKB+1)*PTHLM(:,:,IKB+1:IKB+1) &
+ +ZCOEFF(:,:,IKB :IKB )*PTHLM(:,:,IKB :IKB ) ) &
+ *0.5* ( PDZY(:,:,IKB+1:IKB+1)+PDZY(:,:,IKB:IKB)) &
+ * PINV_PDYY(:,:,IKB:IKB) )
+! extrapolates the flux under the ground so that the vertical average with
+! the IKB flux gives the ground value ( warning the tangential surface
+! flux has been set to 0 for the moment !! to be improved )
+ZFLX(:,:,IKB-1:IKB-1) = 2. * MYM( SPREAD( PSFTHM(:,:)* PDIRCOSYW(:,:), 3,1) ) &
+ - ZFLX(:,:,IKB:IKB)
+!
+! Add this source to the Theta_l sources
+!
+IF (.NOT. L2D) THEN
+ IF (.NOT. LFLAT) THEN
+ PRTHLS(:,:,:) = PRTHLS &
+ - DYF( MYM(PRHODJ) * ZFLX * PINV_PDYY ) &
+ + DZF( PMZM_PRHODJ *MYF(PDZY*(MZM(ZFLX * PINV_PDYY))) * PINV_PDZZ )
+ ELSE
+ PRTHLS(:,:,:) = PRTHLS - DYF( MYM(PRHODJ) * ZFLX * PINV_PDYY )
+ END IF
+END IF
+!
+! Compute the equivalent tendancy for Rc and Ri
+!
+!IF ( OSUBG_COND .AND. KRRL > 0 .AND. .NOT. L2D) THEN
+IF ( KRRL >= 1 .AND. .NOT. L2D) THEN
+ IF (.NOT. LFLAT) THEN
+ ZFLXC = 2.*( MYF( MYM( PRHODJ*PATHETA*PSRCM )*ZFLX ) &
+ +MZF( MZM( PRHODJ*PATHETA*PSRCM )*MYF( &
+ PDZY*(MZM( ZFLX*PINV_PDYY )) ) )&
+ )
+ IF ( KRRI >= 1 ) THEN
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) + 2. * &
+ (- DYF( MYM( PRHODJ*PATHETA*PSRCM )*ZFLX*PINV_PDYY ) &
+ + DZF( MZM( PRHODJ*PATHETA*PSRCM )*MYF( PDZY*(MZM( ZFLX*PINV_PDYY )) )&
+ *PINV_PDZZ ) &
+ )*(1.0-PFRAC_ICE(:,:,:))
+ PRRS(:,:,:,4) = PRRS(:,:,:,4) + 2. * &
+ (- DYF( MYM( PRHODJ*PATHETA*PSRCM )*ZFLX*PINV_PDYY ) &
+ + DZF( MZM( PRHODJ*PATHETA*PSRCM )*MYF( PDZY*(MZM( ZFLX*PINV_PDYY )) )&
+ *PINV_PDZZ ) &
+ )*PFRAC_ICE(:,:,:)
+ ELSE
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) + 2. * &
+ (- DYF( MYM( PRHODJ*PATHETA*PSRCM )*ZFLX*PINV_PDYY ) &
+ + DZF( MZM( PRHODJ*PATHETA*PSRCM )*MYF( PDZY*(MZM( ZFLX*PINV_PDYY )) )&
+ *PINV_PDZZ ) &
+ )
+ END IF
+ ELSE
+ ZFLXC = 2.*MYF( MYM( PRHODJ*PATHETA*PSRCM )*ZFLX )
+ IF ( KRRI >= 1 ) THEN
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) - 2. * &
+ DYF( MYM( PRHODJ*PATHETA*PSRCM )*ZFLX*PINV_PDYY )*(1.0-PFRAC_ICE(:,:,:))
+ PRRS(:,:,:,4) = PRRS(:,:,:,4) - 2. * &
+ DYF( MYM( PRHODJ*PATHETA*PSRCM )*ZFLX*PINV_PDYY )*PFRAC_ICE(:,:,:)
+ ELSE
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) - 2. * &
+ DYF( MYM( PRHODJ*PATHETA*PSRCM )*ZFLX*PINV_PDYY )
+ END IF
+ END IF
+END IF
+!
+!! stores this flux in ZWORK to compute later <V' VPT'>
+!!ZWORK(:,:,:) = ZFLX(:,:,:)
+!
+! stores the horizontal <V THl>
+IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
+ TZFIELD%CMNHNAME = 'VTHL_FLX'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'VTHL_FLX'
+ TZFIELD%CUNITS = 'K m s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_VTHL_FLX'
+ TZFIELD%NGRID = 3
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLX)
+END IF
+!
+IF (KSPLT==1 .AND. LLES_CALL) THEN
+ CALL SECOND_MNH(ZTIME1)
+ CALL LES_MEAN_SUBGRID( MYF(ZFLX), X_LES_SUBGRID_VThl )
+ CALL LES_MEAN_SUBGRID( MZF(MYF(GY_W_VW(PWM,PDYY,PDZZ,PDZY)*MZM(ZFLX))),&
+ X_LES_RES_ddxa_W_SBG_UaThl , .TRUE. )
+ CALL LES_MEAN_SUBGRID( GY_M_M(PTHLM,PDYY,PDZZ,PDZY)*MYF(ZFLX),&
+ X_LES_RES_ddxa_Thl_SBG_UaThl , .TRUE. )
+ IF (KRR>=1) THEN
+ CALL LES_MEAN_SUBGRID( GY_M_M(PRM(:,:,:,1),PDYY,PDZZ,PDZY)*MYF(ZFLX),&
+ X_LES_RES_ddxa_Rt_SBG_UaThl , .TRUE. )
+ END IF
+ CALL SECOND_MNH(ZTIME2)
+ XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+END IF
+!
+!
+!* 6. < V' R'np >
+! -----------
+!
+IF (KRR/=0) THEN
+ !
+ IF (.NOT. L2D) THEN
+ ZFLX(:,:,:) = -XCHF * MYM( PK ) * GY_M_V(1,IKU,1,PRM(:,:,:,1),PDYY,PDZZ,PDZY)
+ ZFLX(:,:,IKE+1) = ZFLX(:,:,IKE)
+ ELSE
+ ZFLX(:,:,:) = 0.
+ END IF
+!
+! Compute the flux at the first inner U-point with an uncentred vertical
+! gradient
+ ZFLX(:,:,IKB:IKB) = -XCHF * MYM( PK(:,:,IKB:IKB) ) * &
+ ( DYM(PRM(:,:,IKB:IKB,1)) * PINV_PDYY(:,:,IKB:IKB) &
+ -MYM( ZCOEFF(:,:,IKB+2:IKB+2)*PRM(:,:,IKB+2:IKB+2,1) &
+ +ZCOEFF(:,:,IKB+1:IKB+1)*PRM(:,:,IKB+1:IKB+1,1) &
+ +ZCOEFF(:,:,IKB :IKB )*PRM(:,:,IKB :IKB ,1) ) &
+ *0.5* ( PDZY(:,:,IKB+1:IKB+1)+PDZY(:,:,IKB:IKB)) &
+ * PINV_PDYY(:,:,IKB:IKB) )
+! extrapolates the flux under the ground so that the vertical average with
+! the IKB flux gives the ground value ( warning the tangential surface
+! flux has been set to 0 for the moment !! to be improved )
+ ZFLX(:,:,IKB-1:IKB-1) = 2. * MYM( SPREAD( PSFRM(:,:)* PDIRCOSYW(:,:), 3,1) ) &
+ - ZFLX(:,:,IKB:IKB)
+ !
+ ! Add this source to the conservative mixing ratio sources
+ !
+ IF (.NOT. L2D) THEN
+ IF (.NOT. LFLAT) THEN
+ PRRS(:,:,:,1) = PRRS(:,:,:,1) &
+ - DYF( MYM(PRHODJ) * ZFLX * PINV_PDYY ) &
+
+ + DZF( PMZM_PRHODJ *MYF(PDZY*(MZM(ZFLX * PINV_PDYY))) * PINV_PDZZ )
+ ELSE
+ PRRS(:,:,:,1) = PRRS(:,:,:,1) - DYF( MYM(PRHODJ) * ZFLX * PINV_PDYY )
+ END IF
+ END IF
+ !
+ ! Compute the equivalent tendancy for Rc and Ri
+ !
+ IF ( KRRL >= 1 .AND. .NOT. L2D) THEN ! Sub-grid condensation
+ IF (.NOT. LFLAT) THEN
+ ZFLXC = ZFLXC &
+ + 2.*( MXF( MYM( PRHODJ*PAMOIST*PSRCM )*ZFLX ) &
+ + MZF( MZM( PRHODJ*PAMOIST*PSRCM )*MYF( &
+ PDZY*(MZM( ZFLX*PINV_PDYY )) ) )&
+ )
+ IF ( KRRI >= 1 ) THEN
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) + 2. * &
+ (- DYF( MYM( PRHODJ*PAMOIST*PSRCM )*ZFLX/PDYY ) &
+ + DZF( MZM( PRHODJ*PAMOIST*PSRCM )*MYF( PDZY*(MZM( ZFLX*PINV_PDYY )) )&
+ * PINV_PDZZ ) &
+ )*(1.0-PFRAC_ICE(:,:,:))
+ PRRS(:,:,:,4) = PRRS(:,:,:,4) + 2. * &
+ (- DYF( MYM( PRHODJ*PAMOIST*PSRCM )*ZFLX/PDYY ) &
+ + DZF( MZM( PRHODJ*PAMOIST*PSRCM )*MYF( PDZY*(MZM( ZFLX*PINV_PDYY )) )&
+ * PINV_PDZZ ) &
+ )*PFRAC_ICE(:,:,:)
+ ELSE
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) + 2. * &
+ (- DYF( MYM( PRHODJ*PAMOIST*PSRCM )*ZFLX/PDYY ) &
+ + DZF( MZM( PRHODJ*PAMOIST*PSRCM )*MYF( PDZY*(MZM( ZFLX*PINV_PDYY )) )&
+ * PINV_PDZZ ) &
+ )
+ END IF
+ ELSE
+ ZFLXC = ZFLXC + 2.*MXF( MYM( PRHODJ*PAMOIST*PSRCM )*ZFLX )
+ IF ( KRRI >= 1 ) THEN
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) - 2. * &
+ DYF( MYM( PRHODJ*PAMOIST*PSRCM )*ZFLX/PDYY )*(1.0-PFRAC_ICE(:,:,:))
+ PRRS(:,:,:,4) = PRRS(:,:,:,4) - 2. * &
+ DYF( MYM( PRHODJ*PAMOIST*PSRCM )*ZFLX/PDYY )*PFRAC_ICE(:,:,:)
+ ELSE
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) - 2. * &
+ DYF( MYM( PRHODJ*PAMOIST*PSRCM )*ZFLX/PDYY )
+ END IF
+ END IF
+ END IF
+ !
+ ! stores the horizontal <V Rnp>
+ IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
+ TZFIELD%CMNHNAME = 'VR_FLX'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'VR_FLX'
+ TZFIELD%CUNITS = 'kg kg-1 m s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_VR_FLX'
+ TZFIELD%NGRID = 3
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLX)
+ END IF
+ !
+ IF (KSPLT==1 .AND. LLES_CALL) THEN
+ CALL SECOND_MNH(ZTIME1)
+ CALL LES_MEAN_SUBGRID( MYF(ZFLX), X_LES_SUBGRID_VRt )
+ CALL LES_MEAN_SUBGRID( MZF(MYF(GY_W_VW(PWM,PDYY,PDZZ,PDZY)*MZM(ZFLX))),&
+ X_LES_RES_ddxa_W_SBG_UaRt , .TRUE. )
+ CALL LES_MEAN_SUBGRID( GY_M_M(PTHLM,PDYY,PDZZ,PDZY)*MYF(ZFLX), &
+ X_LES_RES_ddxa_Thl_SBG_UaRt , .TRUE. )
+ CALL LES_MEAN_SUBGRID( GY_M_M(PRM(:,:,:,1),PDYY,PDZZ,PDZY)*MYF(ZFLX), &
+ X_LES_RES_ddxa_Rt_SBG_UaRt , .TRUE. )
+ CALL SECOND_MNH(ZTIME2)
+ XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ END IF
+!
+ !
+ IF (KRRL>0 .AND. KSPLT==1 .AND. LLES_CALL) THEN
+ CALL SECOND_MNH(ZTIME1)
+ CALL LES_MEAN_SUBGRID(MYF(ZFLXC), X_LES_SUBGRID_VRc )
+ CALL SECOND_MNH(ZTIME2)
+ XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ END IF
+ !
+END IF
+!
+!* 7. < V' TPV' >
+! -----------
+!
+!! to be tested later
+!!IF (KRR/=0) THEN
+!! ! here ZFLX= <V'R'np> and ZWORK= <V'Theta'l>
+!! !
+!! IF (.NOT. L2D) THEN &
+!! ZVPTV(:,:,:) = &
+!! ZWORK(:,:,:)*MYM(ETHETA(KRR,KRRI,PTHLT,PEXNREF,PRT,PLOCPT,PSRCM)) + &
+!! ZFLX(:,:,:)*MYM(EMOIST(KRR,KRRI,PTHLT,PEXNREF,PRT,PLOCPT,PSRCM))
+!! ELSE
+!! ZVPTV(:,:,:) = 0.
+!! END IF
+!! !
+!! ! stores the horizontal <V VPT>
+!! IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
+!! TZFIELD%CMNHNAME = 'VVPT_FLX'
+!! TZFIELD%CSTDNAME = ''
+!! TZFIELD%CLONGNAME = 'VVPT_FLX'
+!! TZFIELD%CUNITS = 'K m s-1'
+!! TZFIELD%CDIR = 'XY'
+!! TZFIELD%CCOMMENT = 'X_Y_Z_VVPT_FLX'
+!! TZFIELD%NGRID = 3
+!! TZFIELD%NTYPE = TYPEREAL
+!! TZFIELD%NDIMS = 3
+!! TZFIELD%LTIMEDEP = .TRUE.
+!! CALL IO_Field_write(TPFILE,TZFIELD,ZVPTV)
+!! END IF
+!!!
+!!ELSE
+!! ZVPTV(:,:,:)=ZWORK(:,:,:)
+!!END IF
+!
+!
+END SUBROUTINE TURB_HOR_THERMO_FLUX
diff --git a/src/mesonh/turb/turb_hor_tke.f90 b/src/mesonh/turb/turb_hor_tke.f90
new file mode 100644
index 000000000..ec8e9e2b6
--- /dev/null
+++ b/src/mesonh/turb/turb_hor_tke.f90
@@ -0,0 +1,246 @@
+!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ####################
+ MODULE MODI_TURB_HOR_TKE
+! ####################
+!
+INTERFACE
+!
+ SUBROUTINE TURB_HOR_TKE(KSPLT, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY, &
+ PINV_PDXX, PINV_PDYY, PINV_PDZZ, PMZM_PRHODJ, &
+ PK, PRHODJ, PTKEM, &
+ PTRH )
+
+!
+INTEGER, INTENT(IN) :: KSPLT ! current split index
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
+ ! Metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PK ! Turbulent diffusion doef.
+ ! PK = PLM * SQRT(PTKEM)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDXX ! 1./PDXX
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDYY ! 1./PDYY
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDZZ ! 1./PDZZ
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PMZM_PRHODJ ! MZM(PRHODJ)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density * grid volume
+!
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t- dt
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTRH ! horizontal transport of Tke
+!
+!
+!
+END SUBROUTINE TURB_HOR_TKE
+!
+END INTERFACE
+!
+END MODULE MODI_TURB_HOR_TKE
+! ################################################################
+ SUBROUTINE TURB_HOR_TKE(KSPLT, &
+ PDXX, PDYY, PDZZ,PDZX,PDZY, &
+ PINV_PDXX, PINV_PDYY, PINV_PDZZ, PMZM_PRHODJ, &
+ PK, PRHODJ, PTKEM, &
+ PTRH )
+! ################################################################
+!
+!
+!!**** *TURB_HOR_TKE* computes the horizontal turbulant transports of Tke
+!!
+!! PURPOSE
+!! -------
+
+!!** METHOD
+!! ------
+!!
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! Joan Cuxart * INM and Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original Aug 29, 1994
+!! Mar 07 2001 (V. Masson and J. Stein) new routine
+!! Nov 06, 2002 (V. Masson) LES budgets
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CONF
+USE MODD_CST
+USE MODD_CTURB
+USE MODD_PARAMETERS
+USE MODD_LES
+!
+!
+USE MODI_SHUMAN
+USE MODI_GRADIENT_M
+USE MODI_LES_MEAN_SUBGRID
+!
+USE MODI_SECOND_MNH
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declaration of arguments
+!
+!
+INTEGER, INTENT(IN) :: KSPLT ! current split index
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
+ ! Metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PK ! Turbulent diffusion doef.
+ ! PK = PLM * SQRT(PTKEM)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDXX ! 1./PDXX
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDYY ! 1./PDYY
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDZZ ! 1./PDZZ
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PMZM_PRHODJ ! MZM(PRHODJ)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density * grid volume
+!
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t- dt
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTRH ! horizontal transport of Tke
+!
+!
+!
+!* 0.2 declaration of local variables
+!
+INTEGER :: IKB, IKU
+!
+REAL, DIMENSION(SIZE(PDZZ,1),SIZE(PDZZ,2),1+JPVEXT:3+JPVEXT) :: ZCOEFF
+ ! coefficients for the uncentred gradient
+ ! computation near the ground
+!
+REAL, DIMENSION(SIZE(PTKEM,1),SIZE(PTKEM,2),SIZE(PTKEM,3)):: ZFLX
+!
+REAL :: ZTIME1, ZTIME2
+! ---------------------------------------------------------------------------
+!
+!* 1. PRELIMINARY COMPUTATIONS
+! ------------------------
+!
+IKB = 1.+JPVEXT
+IKU = SIZE(PTKEM,3)
+!
+! compute the coefficients for the uncentred gradient computation near the
+! ground
+!
+ZCOEFF(:,:,IKB+2)= - PDZZ(:,:,IKB+1) / &
+ ( (PDZZ(:,:,IKB+2)+PDZZ(:,:,IKB+1)) * PDZZ(:,:,IKB+2) )
+ZCOEFF(:,:,IKB+1)= (PDZZ(:,:,IKB+2)+PDZZ(:,:,IKB+1)) / &
+ ( PDZZ(:,:,IKB+1) * PDZZ(:,:,IKB+2) )
+ZCOEFF(:,:,IKB)= - (PDZZ(:,:,IKB+2)+2.*PDZZ(:,:,IKB+1)) / &
+ ( (PDZZ(:,:,IKB+2)+PDZZ(:,:,IKB+1)) * PDZZ(:,:,IKB+1) )
+!
+!--------------------------------------------------------------------
+!
+!* 2. horizontal transport of Tke u'e
+! -------------------------------
+!
+!
+ZFLX = -XCET * MXM(PK) * GX_M_U(1,IKU,1,PTKEM,PDXX,PDZZ,PDZX) ! < u'e >
+!
+! special case near the ground ( uncentred gradient )
+!
+ZFLX(:,:,IKB) = ZCOEFF(:,:,IKB+2)*PTKEM(:,:,IKB+2) &
+ + ZCOEFF(:,:,IKB+1)*PTKEM(:,:,IKB+1) &
+ + ZCOEFF(:,:,IKB )*PTKEM(:,:,IKB )
+!
+ZFLX(:,:,IKB:IKB) = &
+ - XCET * MXM( PK(:,:,IKB:IKB) ) * ( &
+ DXM ( PTKEM(:,:,IKB:IKB) ) * PINV_PDXX(:,:,IKB:IKB) &
+ -MXM ( ZFLX (:,:,IKB:IKB) ) * PINV_PDXX(:,:,IKB:IKB) &
+ * 0.5 * ( PDZX(:,:,IKB+1:IKB+1) + PDZX(:,:,IKB:IKB) ) )
+!
+! extrapolate the fluxes to obtain < u'e > = 0 at the ground
+!
+ZFLX(:,:,IKB-1) = - ZFLX(:,:,IKB)
+!
+! let the same flux at IKU-1 and IKU level
+!
+ZFLX(:,:,IKU) = ZFLX(:,:,IKU-1)
+!
+IF (.NOT. LFLAT) THEN
+ PTRH =-( DXF( MXM(PRHODJ) * ZFLX * PINV_PDXX)&
+ - DZF( PMZM_PRHODJ * MXF( PDZX * MZM(ZFLX*PINV_PDXX)) * PINV_PDZZ)&
+ ) /PRHODJ
+ELSE
+ PTRH =-( DXF( MXM(PRHODJ) * ZFLX * PINV_PDXX)&
+ ) /PRHODJ
+END IF
+!
+IF (LLES_CALL .AND. KSPLT==1) THEN
+ CALL SECOND_MNH(ZTIME1)
+ CALL LES_MEAN_SUBGRID( MXF(ZFLX), X_LES_SUBGRID_UTke )
+ CALL SECOND_MNH(ZTIME2)
+ XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+END IF
+!
+!
+!--------------------------------------------------------------------
+!
+!* 3. horizontal transport of Tke v'e
+! -------------------------------
+!
+IF (.NOT. L2D) THEN
+ ZFLX =-XCET * MYM(PK) * GY_M_V(1,IKU,1,PTKEM,PDYY,PDZZ,PDZY) ! < v'e >
+!
+! special case near the ground ( uncentred gradient )
+!
+ ZFLX(:,:,IKB) = ZCOEFF(:,:,IKB+2)*PTKEM(:,:,IKB+2) &
+ + ZCOEFF(:,:,IKB+1)*PTKEM(:,:,IKB+1) &
+ + ZCOEFF(:,:,IKB )*PTKEM(:,:,IKB )
+!
+ ZFLX(:,:,IKB:IKB) = &
+ - XCET * MYM( PK(:,:,IKB:IKB) ) * ( &
+ DYM ( PTKEM(:,:,IKB:IKB) ) * PINV_PDYY(:,:,IKB:IKB) &
+ - MYM ( ZFLX (:,:,IKB:IKB) ) * PINV_PDYY(:,:,IKB:IKB) &
+ * 0.5 * ( PDZY(:,:,IKB+1:IKB+1) + PDZY(:,:,IKB:IKB) ) )
+!
+! extrapolate the fluxes to obtain < v'e > = 0 at the ground
+!
+ ZFLX(:,:,IKB-1) = - ZFLX(:,:,IKB)
+!
+! let the same flux at IKU-1 and IKU level
+!
+ ZFLX(:,:,IKU) = ZFLX(:,:,IKU-1)
+!
+! complete the explicit turbulent transport
+!
+ IF (.NOT. LFLAT) THEN
+ PTRH = PTRH - ( DYF( MYM(PRHODJ) * ZFLX * PINV_PDYY ) &
+ - DZF( PMZM_PRHODJ * MYF( PDZY * MZM(ZFLX*PINV_PDYY) ) * PINV_PDZZ ) &
+ ) /PRHODJ
+ ELSE
+ PTRH = PTRH - ( DYF( MYM(PRHODJ) * ZFLX * PINV_PDYY ) &
+ ) /PRHODJ
+ END IF
+!
+ IF (LLES_CALL .AND. KSPLT==1) THEN
+ CALL SECOND_MNH(ZTIME1)
+ CALL LES_MEAN_SUBGRID( MYF(ZFLX), X_LES_SUBGRID_VTke )
+ CALL SECOND_MNH(ZTIME2)
+ XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ END IF
+!
+END IF
+!
+!----------------------------------------------------------------------------
+!
+END SUBROUTINE TURB_HOR_TKE
diff --git a/src/mesonh/turb/turb_hor_uv.f90 b/src/mesonh/turb/turb_hor_uv.f90
new file mode 100644
index 000000000..3fcecc20e
--- /dev/null
+++ b/src/mesonh/turb/turb_hor_uv.f90
@@ -0,0 +1,355 @@
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! #######################
+ MODULE MODI_TURB_HOR_UV
+! #######################
+!
+INTERFACE
+!
+ SUBROUTINE TURB_HOR_UV(KSPLT, &
+ OTURB_FLX, &
+ TPFILE, &
+ PK,PINV_PDXX,PINV_PDYY,PINV_PDZZ,PMZM_PRHODJ, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY, &
+ PDIRCOSZW, &
+ PCOSSLOPE,PSINSLOPE, &
+ PRHODJ, &
+ PCDUEFF,PTAU11M,PTAU12M,PTAU22M,PTAU33M, &
+ PUM,PVM,PUSLOPEM,PVSLOPEM, &
+ PDP, &
+ PRUS,PRVS )
+!
+USE MODD_IO, ONLY: TFILEDATA
+!
+INTEGER, INTENT(IN) :: KSPLT ! split process index
+LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
+ ! turbulent fluxes in the syncronous FM-file
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PK ! Turbulent diffusion doef.
+ ! PK = PLM * SQRT(PTKEM)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDXX ! 1./PDXX
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDYY ! 1./PDYY
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDZZ ! 1./PDZZ
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PMZM_PRHODJ ! MZM(PRHODJ)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
+ ! Metric coefficients
+REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW
+! Director Cosinus along z directions at surface w-point
+REAL, DIMENSION(:,:), INTENT(IN) :: PCOSSLOPE ! cosinus of the angle
+ ! between i and the slope vector
+REAL, DIMENSION(:,:), INTENT(IN) :: PSINSLOPE ! sinus of the angle
+ ! between i and the slope vector
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density * grid volume
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PCDUEFF ! Cd * || u || at time t
+REAL, DIMENSION(:,:), INTENT(IN) :: PTAU11M ! <uu> in the axes linked
+ ! to the maximum slope direction and the surface normal and the binormal
+ ! at time t - dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PTAU12M ! <uv> in the same axes
+REAL, DIMENSION(:,:), INTENT(IN) :: PTAU22M ! <vv> in the same axes
+REAL, DIMENSION(:,:), INTENT(IN) :: PTAU33M ! <ww> in the same axes
+!
+! Variables at t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM
+REAL, DIMENSION(:,:), INTENT(IN) :: PUSLOPEM ! wind component along the
+ ! maximum slope direction
+REAL, DIMENSION(:,:), INTENT(IN) :: PVSLOPEM ! wind component along the
+ ! direction normal to the maximum slope one
+!
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS ! var. at t+1 -split-
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDP ! TKE production terms
+!
+!
+END SUBROUTINE TURB_HOR_UV
+!
+END INTERFACE
+!
+END MODULE MODI_TURB_HOR_UV
+! ################################################################
+ SUBROUTINE TURB_HOR_UV(KSPLT, &
+ OTURB_FLX, &
+ TPFILE, &
+ PK,PINV_PDXX,PINV_PDYY,PINV_PDZZ,PMZM_PRHODJ, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY, &
+ PDIRCOSZW, &
+ PCOSSLOPE,PSINSLOPE, &
+ PRHODJ, &
+ PCDUEFF,PTAU11M,PTAU12M,PTAU22M,PTAU33M, &
+ PUM,PVM,PUSLOPEM,PVSLOPEM, &
+ PDP, &
+ PRUS,PRVS )
+! ################################################################
+!
+!
+!!**** *TURB_HOR* -routine to compute the source terms in the meso-NH
+!! model equations due to the non-vertical turbulent fluxes.
+!!
+!! PURPOSE
+!! -------
+!!
+!! see TURB_HOR
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!!
+!! Joan Cuxart * INM and Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Aug , 1997 (V. Saravane) spliting of TURB_HOR
+!! Nov 27, 1997 (V. Masson) clearing of the routine
+!! Oct 18, 2000 (V. Masson) LES computations + LFLAT switch
+!! Nov 06, 2002 (V. Masson) LES budgets
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_CONF
+USE MODD_CTURB
+use modd_field, only: tfielddata, TYPEREAL
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_PARAMETERS
+USE MODD_LES
+!
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+!
+USE MODI_GRADIENT_M
+USE MODI_GRADIENT_U
+USE MODI_GRADIENT_V
+USE MODI_GRADIENT_W
+USE MODI_SHUMAN
+USE MODI_COEFJ
+USE MODI_LES_MEAN_SUBGRID
+!
+USE MODI_SECOND_MNH
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declaration of arguments
+!
+!
+!
+INTEGER, INTENT(IN) :: KSPLT ! split process index
+LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
+ ! turbulent fluxes in the syncronous FM-file
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PK ! Turbulent diffusion doef.
+ ! PK = PLM * SQRT(PTKEM)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDXX ! 1./PDXX
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDYY ! 1./PDYY
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDZZ ! 1./PDZZ
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PMZM_PRHODJ ! MZM(PRHODJ)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
+ ! Metric coefficients
+REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW
+! Director Cosinus along z directions at surface w-point
+REAL, DIMENSION(:,:), INTENT(IN) :: PCOSSLOPE ! cosinus of the angle
+ ! between i and the slope vector
+REAL, DIMENSION(:,:), INTENT(IN) :: PSINSLOPE ! sinus of the angle
+ ! between i and the slope vector
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density * grid volume
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PCDUEFF ! Cd * || u || at time t
+REAL, DIMENSION(:,:), INTENT(IN) :: PTAU11M ! <uu> in the axes linked
+ ! to the maximum slope direction and the surface normal and the binormal
+ ! at time t - dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PTAU12M ! <uv> in the same axes
+REAL, DIMENSION(:,:), INTENT(IN) :: PTAU22M ! <vv> in the same axes
+REAL, DIMENSION(:,:), INTENT(IN) :: PTAU33M ! <ww> in the same axes
+!
+! Variables at t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM
+REAL, DIMENSION(:,:), INTENT(IN) :: PUSLOPEM ! wind component along the
+ ! maximum slope direction
+REAL, DIMENSION(:,:), INTENT(IN) :: PVSLOPEM ! wind component along the
+ ! direction normal to the maximum slope one
+!
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS ! var. at t+1 -split-
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDP ! TKE production terms
+!
+!
+!
+!* 0.2 declaration of local variables
+!
+REAL, DIMENSION(SIZE(PUM,1),SIZE(PUM,2),SIZE(PUM,3)) &
+ :: ZFLX,ZWORK
+ ! work arrays
+!
+REAL, DIMENSION(SIZE(PUM,1),SIZE(PUM,2)) ::ZDIRSINZW
+ ! sinus of the angle between the vertical and the normal to the orography
+INTEGER :: IKB,IKE
+ ! Index values for the Beginning and End
+ ! mass points of the domain
+!
+REAL, DIMENSION(SIZE(PUM,1),SIZE(PUM,2),SIZE(PUM,3)) :: GY_U_UV_PUM
+REAL, DIMENSION(SIZE(PVM,1),SIZE(PVM,2),SIZE(PVM,3)) :: GX_V_UV_PVM
+!
+REAL :: ZTIME1, ZTIME2
+TYPE(TFIELDDATA) :: TZFIELD
+! ---------------------------------------------------------------------------
+!
+!* 1. PRELIMINARY COMPUTATIONS
+! ------------------------
+!
+IKB = 1+JPVEXT
+IKE = SIZE(PUM,3)-JPVEXT
+!
+ZDIRSINZW(:,:) = SQRT( 1. - PDIRCOSZW(:,:)**2 )
+!
+GX_V_UV_PVM = GX_V_UV(PVM,PDXX,PDZZ,PDZX)
+IF (.NOT. L2D) GY_U_UV_PUM = GY_U_UV(PUM,PDYY,PDZZ,PDZY)
+!
+!
+!* 12. < U'V'>
+! -------
+!
+!
+IF (.NOT. L2D) THEN
+ ZFLX(:,:,:)= - XCMFS * MYM(MXM(PK)) * &
+ (GY_U_UV_PUM + GX_V_UV_PVM)
+ELSE
+ ZFLX(:,:,:)= - XCMFS * MYM(MXM(PK)) * &
+ (GX_V_UV_PVM)
+END IF
+!
+ZFLX(:,:,IKE+1)= ZFLX(:,:,IKE)
+!
+!
+! Compute the correlation at the first physical level with the following
+! hypothesis du/dz vary in 1/z and w=0 at the ground
+ZFLX(:,:,IKB:IKB) = - XCMFS * MYM(MXM(PK(:,:,IKB:IKB))) * ( &
+ ( DYM( PUM(:,:,IKB:IKB) ) &
+ -MYM( (PUM(:,:,IKB+1:IKB+1)-PUM(:,:,IKB:IKB)) &
+ *(1./MXM(PDZZ(:,:,IKB+1:IKB+1))+1./MXM(PDZZ(:,:,IKB:IKB))))&
+ *0.5*MXM((PDZY(:,:,IKB+1:IKB+1)+PDZY(:,:,IKB:IKB))) &
+ ) / MXM(PDYY(:,:,IKB:IKB)) &
+ +( DXM( PVM(:,:,IKB:IKB) ) &
+ -MXM( (PVM(:,:,IKB+1:IKB+1)-PVM(:,:,IKB:IKB)) &
+ *(1./MYM(PDZZ(:,:,IKB+1:IKB+1))+1./MYM(PDZZ(:,:,IKB:IKB))))&
+ *0.5*MYM((PDZX(:,:,IKB+1:IKB+1)+PDZX(:,:,IKB:IKB))) &
+ ) / MYM(PDXX(:,:,IKB:IKB)) )
+!
+! extrapolates this flux under the ground with the surface flux
+ZFLX(:,:,IKB-1) = &
+ PTAU11M(:,:) * PCOSSLOPE(:,:) * PSINSLOPE(:,:) * PDIRCOSZW(:,:)**2 &
+ +PTAU12M(:,:) * (PCOSSLOPE(:,:)**2 - PSINSLOPE(:,:)**2) * &
+ PDIRCOSZW(:,:)**2 &
+ -PTAU22M(:,:) * PCOSSLOPE(:,:) * PSINSLOPE(:,:) &
+ +PTAU33M(:,:) * PCOSSLOPE(:,:) * PSINSLOPE(:,:) * ZDIRSINZW(:,:)**2 &
+ -PCDUEFF(:,:) * ( &
+ 2. * PUSLOPEM(:,:) * PCOSSLOPE(:,:) * PSINSLOPE(:,:) * &
+ PDIRCOSZW(:,:) * ZDIRSINZW(:,:) &
+ +PVSLOPEM(:,:) * (PCOSSLOPE(:,:)**2 - PSINSLOPE(:,:)**2) * ZDIRSINZW(:,:) &
+ )
+!
+ZFLX(:,:,IKB-1:IKB-1) = 2. * MXM( MYM( ZFLX(:,:,IKB-1:IKB-1) ) ) &
+ - ZFLX(:,:,IKB:IKB)
+!
+! stores <U V>
+IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
+ TZFIELD%CMNHNAME = 'UV_FLX'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'UV_FLX'
+ TZFIELD%CUNITS = 'm2 s-2'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_UV_FLX'
+ TZFIELD%NGRID = 5
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLX)
+END IF
+!
+!
+!
+!computation of the source for rho*V due to this flux
+IF (.NOT. LFLAT) THEN
+ PRUS(:,:,:) = PRUS(:,:,:) &
+ - DYF(ZFLX * MXM(MYM(PRHODJ) * PINV_PDYY) ) &
+ + DZF( MYF( MZM(ZFLX)*MXM(PDZY/MZM(PDYY))) &
+ * MXM(PMZM_PRHODJ * PINV_PDZZ) )
+ELSE
+ PRUS(:,:,:) = PRUS(:,:,:) - DYF(ZFLX * MXM(MYM(PRHODJ) * PINV_PDYY) )
+END IF
+!
+!computation of the source for rho*V due to this flux
+IF (.NOT. LFLAT) THEN
+ PRVS(:,:,:) = PRVS(:,:,:) &
+ - DXF(ZFLX * MYM(MXM(PRHODJ) * PINV_PDXX) ) &
+ + DZF( MXF( MZM(ZFLX)*MYM(PDZX/MZM(PDXX))) &
+ * MYM(PMZM_PRHODJ * PINV_PDZZ) )
+ELSE
+ PRVS(:,:,:) = PRVS(:,:,:) - DXF(ZFLX * MYM(MXM(PRHODJ) * PINV_PDXX) )
+END IF
+!
+IF (KSPLT==1) THEN
+ !
+ !Contribution to the dynamic production of TKE:
+ !
+ IF (.NOT. L2D) THEN
+ ZWORK(:,:,:) = - MXF( MYF( ZFLX * &
+ (GY_U_UV_PUM + GX_V_UV_PVM) ) )
+ ELSE
+ ZWORK(:,:,:) = - MXF( MYF( ZFLX * &
+ (GX_V_UV_PVM) ) )
+ ENDIF
+ !
+ ! evaluate the dynamic production at w(IKB+1) in PDP(IKB)
+ !
+ ZWORK(:,:,IKB:IKB) = - &
+ MXF ( MYF( 0.5 * (ZFLX(:,:,IKB+1:IKB+1)+ZFLX(:,:,IKB:IKB)) ) ) &
+ *(MXF ( MYF( &
+ DYM( 0.5 * (PUM(:,:,IKB+1:IKB+1)+PUM(:,:,IKB:IKB)) ) &
+ / MXM( 0.5*(PDYY(:,:,IKB:IKB)+PDYY(:,:,IKB+1:IKB+1)) ) &
+ +DXM( 0.5 * (PVM(:,:,IKB+1:IKB+1)+PVM(:,:,IKB:IKB)) ) &
+ / MYM( 0.5*(PDXX(:,:,IKB:IKB)+PDXX(:,:,IKB+1:IKB+1)) ) &
+ ) ) &
+ -MXF( (PUM(:,:,IKB+1:IKB+1)-PUM(:,:,IKB:IKB)) / &
+ MXM(PDZZ(:,:,IKB+1:IKB+1)) * PDZY(:,:,IKB+1:IKB+1) &
+ ) / MYF(MXM( 0.5*(PDYY(:,:,IKB:IKB)+PDYY(:,:,IKB+1:IKB+1)) ) )&
+ -MYF( (PVM(:,:,IKB+1:IKB+1)-PVM(:,:,IKB:IKB)) / &
+ MYM(PDZZ(:,:,IKB+1:IKB+1)) * PDZX(:,:,IKB+1:IKB+1) &
+ ) / MXF(MYM( 0.5*(PDXX(:,:,IKB:IKB)+PDXX(:,:,IKB+1:IKB+1)) ) )&
+ )
+ !
+ ! dynamic production
+ PDP(:,:,:) = PDP(:,:,:) + ZWORK(:,:,:)
+ !
+END IF
+!
+! Storage in the LES configuration
+!
+IF (LLES_CALL .AND. KSPLT==1) THEN
+ CALL SECOND_MNH(ZTIME1)
+ CALL LES_MEAN_SUBGRID( MXF(MYF(ZFLX)), X_LES_SUBGRID_UV )
+ CALL LES_MEAN_SUBGRID( MXF(MYF(GY_U_UV(PUM,PDYY,PDZZ,PDZY)*ZFLX)), X_LES_RES_ddxa_U_SBG_UaU , .TRUE.)
+ CALL LES_MEAN_SUBGRID( MXF(MYF(GX_V_UV(PVM,PDXX,PDZZ,PDZX)*ZFLX)), X_LES_RES_ddxa_V_SBG_UaV , .TRUE.)
+ CALL SECOND_MNH(ZTIME2)
+ XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+END IF
+!
+!
+END SUBROUTINE TURB_HOR_UV
diff --git a/src/mesonh/turb/turb_hor_uw.f90 b/src/mesonh/turb/turb_hor_uw.f90
new file mode 100644
index 000000000..d19c68bae
--- /dev/null
+++ b/src/mesonh/turb/turb_hor_uw.f90
@@ -0,0 +1,299 @@
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! #######################
+ MODULE MODI_TURB_HOR_UW
+! #######################
+!
+INTERFACE
+!
+ SUBROUTINE TURB_HOR_UW(KSPLT, &
+ OTURB_FLX,KRR, &
+ TPFILE, &
+ PK,PINV_PDXX,PINV_PDZZ,PMZM_PRHODJ, &
+ PDXX,PDZZ,PDZX, &
+ PRHODJ,PTHVREF, &
+ PUM,PWM,PTHLM,PRM,PSVM, &
+ PTKEM,PLM, &
+ PDP, &
+ PRUS,PRWS )
+!
+USE MODD_IO, ONLY: TFILEDATA
+!
+INTEGER, INTENT(IN) :: KSPLT ! split process index
+LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
+ ! turbulent fluxes in the syncronous FM-file
+INTEGER, INTENT(IN) :: KRR ! number of moist var.
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+!
+
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PK ! Turbulent diffusion doef.
+ ! PK = PLM * SQRT(PTKEM)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDXX ! 1./PDXX
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDZZ ! 1./PDZZ
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PMZM_PRHODJ ! MZM(PRHODJ)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDZZ, PDZX
+ ! Metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density * grid volume
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! ref. state VPT
+!
+! Variables at t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PWM,PTHLM
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t- dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRWS
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDP ! TKE production terms
+!
+!
+!
+!
+END SUBROUTINE TURB_HOR_UW
+!
+END INTERFACE
+!
+END MODULE MODI_TURB_HOR_UW
+! ################################################################
+ SUBROUTINE TURB_HOR_UW(KSPLT, &
+ OTURB_FLX,KRR, &
+ TPFILE, &
+ PK,PINV_PDXX,PINV_PDZZ,PMZM_PRHODJ, &
+ PDXX,PDZZ,PDZX, &
+ PRHODJ,PTHVREF, &
+ PUM,PWM,PTHLM,PRM,PSVM, &
+ PTKEM,PLM, &
+ PDP, &
+ PRUS,PRWS )
+! ################################################################
+!
+!
+!!**** *TURB_HOR* -routine to compute the source terms in the meso-NH
+!! model equations due to the non-vertical turbulent fluxes.
+!!
+!! PURPOSE
+!! -------
+!!
+!! see TURB_HOR
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!!
+!! Joan Cuxart * INM and Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Aug , 1997 (V. Saravane) spliting of TURB_HOR
+!! Nov 27, 1997 (V. Masson) clearing of the routine
+!! Oct 18, 2000 (V. Masson) LES computations + LFLAT switch
+!! Feb 14, 2001 (V. Masson and J. Stein) DZF bug on PRWS
+!! + remove the use of W=0 at the ground
+!! + extrapolation under the ground
+!! Nov 06, 2002 (V. Masson) LES budgets
+!! October 2009 (G. Tanguy) add ILENCH=LEN(YCOMMENT) after
+!! change of YCOMMENT
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_CONF
+USE MODD_CTURB
+use modd_field, only: tfielddata, TYPEREAL
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_PARAMETERS
+USE MODD_LES
+USE MODD_NSV
+!
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+!
+USE MODI_GRADIENT_M
+USE MODI_GRADIENT_U
+USE MODI_GRADIENT_V
+USE MODI_GRADIENT_W
+USE MODI_SHUMAN
+USE MODI_COEFJ
+USE MODI_LES_MEAN_SUBGRID
+!
+USE MODI_SECOND_MNH
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declaration of arguments
+!
+!
+!
+INTEGER, INTENT(IN) :: KSPLT ! split process index
+LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
+ ! turbulent fluxes in the syncronous FM-file
+INTEGER, INTENT(IN) :: KRR ! number of moist var.
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+!
+
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PK ! Turbulent diffusion doef.
+ ! PK = PLM * SQRT(PTKEM)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDXX ! 1./PDXX
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDZZ ! 1./PDZZ
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PMZM_PRHODJ ! MZM(PRHODJ)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDZZ, PDZX
+ ! Metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density * grid volume
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! ref. state VPT
+!
+! Variables at t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PWM,PTHLM
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t- dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRWS
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDP ! TKE production terms
+!
+!
+!
+!
+!* 0.2 declaration of local variables
+!
+REAL, DIMENSION(SIZE(PWM,1),SIZE(PWM,2),SIZE(PWM,3)) &
+ :: ZFLX,ZWORK
+ ! work arrays
+!
+INTEGER :: IKB,IKE,IKU
+ ! Index values for the Beginning and End
+ ! mass points of the domain
+INTEGER :: JSV ! scalar loop counter
+!
+REAL, DIMENSION(SIZE(PWM,1),SIZE(PWM,2),SIZE(PWM,3)) :: GX_W_UW_PWM
+!
+REAL :: ZTIME1, ZTIME2
+TYPE(TFIELDDATA) :: TZFIELD
+! ---------------------------------------------------------------------------
+!
+!* 1. PRELIMINARY COMPUTATIONS
+! ------------------------
+!
+IKB = 1+JPVEXT
+IKE = SIZE(PWM,3)-JPVEXT
+IKU = SIZE(PWM,3)
+!
+!
+GX_W_UW_PWM = GX_W_UW(PWM,PDXX,PDZZ,PDZX)
+!
+!
+!* 13. < U'W'>
+! -------
+!
+! residual part of < U'W'> depending on dw/dx
+!
+ZFLX(:,:,:) = &
+ - XCMFS * MXM(MZM(PK)) * GX_W_UW_PWM
+!! & to be tested
+!! - (2./3.) * XCMFB * MZM( ZVPTU * MXM( PLM / SQRT(PTKEM) * XG / PTHVREF ) )
+!
+ZFLX(:,:,IKE+1) = 0. ! rigid wall condition => no turbulent flux
+!
+! Nullify the flux at the ground level because it has been fully taken into
+! account in turb_ver and extrapolate the flux under the ground
+ZFLX(:,:,IKB) = 0.
+ZFLX(:,:,IKB-1)=2.*ZFLX(:,:,IKB)- ZFLX(:,:,IKB+1)
+!
+! stores <U W>
+IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
+ TZFIELD%CMNHNAME = 'UW_HFLX'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'UW_HFLX'
+ TZFIELD%CUNITS = 'm2 s-2'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_UW_HFLX'
+ TZFIELD%NGRID = 6
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLX)
+END IF
+!
+!
+! compute the source for rho*U due to this residual flux ( the other part is
+! taken into account in TURB_VER)
+PRUS(:,:,:) = PRUS(:,:,:) - DZF( ZFLX* MXM( PMZM_PRHODJ ) / MXM( PDZZ ) )
+!
+!computation of the source for rho*W due to this flux
+IF (.NOT. LFLAT) THEN
+ PRWS(:,:,:) = PRWS(:,:,:) &
+ -DXF( MZM( MXM(PRHODJ) * PINV_PDXX) * ZFLX) &
+ +DZM( PRHODJ * MXF( MZF( ZFLX*PDZX ) * PINV_PDXX ) / MZF(PDZZ) )
+ELSE
+ PRWS(:,:,:) = PRWS(:,:,:) -DXF( MZM( MXM(PRHODJ) * PINV_PDXX) * ZFLX)
+END IF
+!
+IF (KSPLT==1) THEN
+ !
+ !Contribution to the dynamic production of TKE:
+ !
+ ZWORK(:,:,:) =-MZF( MXF( &
+ ZFLX *( GZ_U_UW(PUM,PDZZ) + GX_W_UW_PWM ) ) )
+ !
+ !
+ ! evaluate the dynamic production at w(IKB+1) in PDP(IKB)
+ ZWORK(:,:,IKB:IKB) = - MXF ( &
+ ZFLX(:,:,IKB+1:IKB+1) * &
+ ( (PUM(:,:,IKB+1:IKB+1)-PUM(:,:,IKB:IKB)) / MXM(PDZZ(:,:,IKB+1:IKB+1))&
+ + ( DXM( PWM(:,:,IKB+1:IKB+1) ) &
+ -MXM( (PWM(:,:,IKB+2:IKB+2)-PWM(:,:,IKB+1:IKB+1)) &
+ /(PDZZ(:,:,IKB+2:IKB+2)+PDZZ(:,:,IKB+1:IKB+1)) &
+ +(PWM(:,:,IKB+1:IKB+1)-PWM(:,:,IKB :IKB )) &
+ /(PDZZ(:,:,IKB+1:IKB+1)+PDZZ(:,:,IKB :IKB )) &
+ ) &
+ * PDZX(:,:,IKB+1:IKB+1) &
+ ) / (0.5*(PDXX(:,:,IKB+1:IKB+1)+PDXX(:,:,IKB:IKB))) &
+ ) )
+ !
+ ! dynamic production computation
+ PDP(:,:,:) = PDP(:,:,:) + ZWORK(:,:,:)
+ !
+END IF
+!
+! Storage in the LES configuration (addition to TURB_VER computation)
+!
+IF (LLES_CALL .AND. KSPLT==1) THEN
+ CALL SECOND_MNH(ZTIME1)
+ CALL LES_MEAN_SUBGRID( MZF(MXF(ZFLX)), X_LES_SUBGRID_WU , .TRUE. )
+ CALL LES_MEAN_SUBGRID( MZF(MXF(GZ_U_UW(PUM,PDZZ)*ZFLX)), X_LES_RES_ddxa_U_SBG_UaU , .TRUE.)
+ CALL LES_MEAN_SUBGRID( MZF(MXF(GX_W_UW_PWM*ZFLX)), X_LES_RES_ddxa_W_SBG_UaW , .TRUE.)
+ CALL LES_MEAN_SUBGRID( MXF(GX_M_U(1,IKU,1,PTHLM,PDXX,PDZZ,PDZX)*MZF(ZFLX)),&
+ X_LES_RES_ddxa_Thl_SBG_UaW , .TRUE.)
+ IF (KRR>=1) THEN
+ CALL LES_MEAN_SUBGRID( MXF(GX_M_U(1,IKU,1,PRM(:,:,:,1),PDXX,PDZZ,PDZX)*MZF(ZFLX)), &
+ X_LES_RES_ddxa_Rt_SBG_UaW , .TRUE.)
+ END IF
+ DO JSV=1,NSV
+ CALL LES_MEAN_SUBGRID( MXF(GX_M_U(1,IKU,1,PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)*MZF(ZFLX)), &
+ X_LES_RES_ddxa_Sv_SBG_UaW(:,:,:,JSV) , .TRUE.)
+ END DO
+ CALL SECOND_MNH(ZTIME2)
+ XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+END IF
+
+!
+END SUBROUTINE TURB_HOR_UW
diff --git a/src/mesonh/turb/turb_hor_vw.f90 b/src/mesonh/turb/turb_hor_vw.f90
new file mode 100644
index 000000000..df888c2c7
--- /dev/null
+++ b/src/mesonh/turb/turb_hor_vw.f90
@@ -0,0 +1,307 @@
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! #######################
+ MODULE MODI_TURB_HOR_VW
+! #######################
+!
+INTERFACE
+!
+ SUBROUTINE TURB_HOR_VW(KSPLT, &
+ OTURB_FLX,KRR, &
+ TPFILE, &
+ PK,PINV_PDYY,PINV_PDZZ,PMZM_PRHODJ, &
+ PDYY,PDZZ,PDZY, &
+ PRHODJ,PTHVREF, &
+ PVM,PWM,PTHLM,PRM,PSVM, &
+ PTKEM,PLM, &
+ PDP, &
+ PRVS,PRWS )
+!
+USE MODD_IO, ONLY: TFILEDATA
+!
+INTEGER, INTENT(IN) :: KSPLT ! split process index
+LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
+ ! turbulent fluxes in the syncronous FM-file
+INTEGER, INTENT(IN) :: KRR ! number of moist var.
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PK ! Turbulent diffusion doef.
+ ! PK = PLM * SQRT(PTKEM)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDYY ! 1./PDYY
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDZZ ! 1./PDZZ
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PMZM_PRHODJ ! MZM(PRHODJ)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY, PDZZ, PDZY
+ ! Metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density * grid volume
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! ref. state VPT
+!
+! Variables at t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PVM,PWM,PTHLM
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t- dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS, PRWS ! var. at t+1 -split-
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDP ! TKE production terms
+!
+END SUBROUTINE TURB_HOR_VW
+!
+END INTERFACE
+!
+END MODULE MODI_TURB_HOR_VW
+! ################################################################
+ SUBROUTINE TURB_HOR_VW(KSPLT, &
+ OTURB_FLX,KRR, &
+ TPFILE, &
+ PK,PINV_PDYY,PINV_PDZZ,PMZM_PRHODJ, &
+ PDYY,PDZZ,PDZY, &
+ PRHODJ,PTHVREF, &
+ PVM,PWM,PTHLM,PRM,PSVM, &
+ PTKEM,PLM, &
+ PDP, &
+ PRVS,PRWS )
+! ################################################################
+!
+!
+!!**** *TURB_HOR* -routine to compute the source terms in the meso-NH
+!! model equations due to the non-vertical turbulent fluxes.
+!!
+!! PURPOSE
+!! -------
+!!
+!! see TURB_HOR
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!!
+!! Joan Cuxart * INM and Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Aug , 1997 (V. Saravane) spliting of TURB_HOR
+!! Nov 27, 1997 (V. Masson) clearing of the routine
+!! Oct 18, 2000 (V. Masson) LES computations + LFLAT switch
+!! Feb 14, 2001 (V. Masson and J. Stein) DZF bug on PRWS
+!! + remove the use of W=0 at the ground
+!! + extrapolataion under the ground
+!! Nov 06, 2002 (V. Masson) LES budgets
+!! October 2009 (G. Tanguy) add ILENCH=LEN(YCOMMENT) after
+!! change of YCOMMENT
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_CONF
+USE MODD_CTURB
+use modd_field, only: tfielddata, TYPEREAL
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_PARAMETERS
+USE MODD_LES
+USE MODD_NSV
+!
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+!
+USE MODI_GRADIENT_M
+USE MODI_GRADIENT_U
+USE MODI_GRADIENT_V
+USE MODI_GRADIENT_W
+USE MODI_SHUMAN
+USE MODI_COEFJ
+USE MODI_LES_MEAN_SUBGRID
+!
+USE MODI_SECOND_MNH
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declaration of arguments
+!
+!
+!
+INTEGER, INTENT(IN) :: KSPLT ! split process index
+LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
+ ! turbulent fluxes in the syncronous FM-file
+INTEGER, INTENT(IN) :: KRR ! number of moist var.
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PK ! Turbulent diffusion doef.
+ ! PK = PLM * SQRT(PTKEM)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDYY ! 1./PDYY
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDZZ ! 1./PDZZ
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PMZM_PRHODJ ! MZM(PRHODJ)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY, PDZZ, PDZY
+ ! Metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density * grid volume
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! ref. state VPT
+!
+! Variables at t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PVM,PWM,PTHLM
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t- dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS, PRWS ! var. at t+1 -split-
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDP ! TKE production terms
+!
+!
+!
+!* 0.2 declaration of local variables
+!
+REAL, DIMENSION(SIZE(PWM,1),SIZE(PWM,2),SIZE(PWM,3)) &
+ :: ZFLX,ZWORK
+ ! work arrays
+!
+!! REAL, DIMENSION(SIZE(PWM,1),SIZE(PWM,2),SIZE(PWM,3)) :: ZVPTV
+INTEGER :: IKB,IKE,IKU
+ ! Index values for the Beginning and End
+ ! mass points of the domain
+INTEGER :: JSV ! scalar loop counter
+!
+REAL, DIMENSION(SIZE(PWM,1),SIZE(PWM,2),SIZE(PWM,3)) :: GY_W_VW_PWM
+!
+REAL :: ZTIME1, ZTIME2
+TYPE(TFIELDDATA) :: TZFIELD
+! ---------------------------------------------------------------------------
+!
+!* 1. PRELIMINARY COMPUTATIONS
+! ------------------------
+!
+IKB = 1+JPVEXT
+IKE = SIZE(PWM,3)-JPVEXT
+IKU = SIZE(PWM,3)
+!
+!
+IF (.NOT. L2D) GY_W_VW_PWM = GY_W_VW(PWM,PDYY,PDZZ,PDZY)
+!
+!
+!* 14. < V'W'>
+! -------
+!
+! residual part of < V'W'> depending on dw/dy
+!
+IF (.NOT. L2D) THEN
+ ZFLX(:,:,:) = &
+ - XCMFS * MYM(MZM(PK)) * GY_W_VW_PWM
+ !! & to be tested
+ !! - (2./3.) * XCMFB * MZM( ZVPTV * MYM( PLM / SQRT(PTKEM) * XG / PTHVREF ) )
+ELSE
+ ZFLX(:,:,:) = 0.
+ !! & to be tested
+ !! - (2./3.) * XCMFB * MZM( ZVPTV * MYM( PLM / SQRT(PTKEM) * XG / PTHVREF ) )
+END IF
+!
+ZFLX(:,:,IKE+1) = 0. ! rigid wall condition => no turbulent flux
+!
+!
+! Nullify the flux at the ground level because it has been fully taken into
+! account in turb_ver and extrapolate the flux under the ground
+ZFLX(:,:,IKB) = 0.
+ZFLX(:,:,IKB-1)= 2.*ZFLX(:,:,IKB) - ZFLX(:,:,IKB+1)
+!
+! stores <V W>
+IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
+ TZFIELD%CMNHNAME = 'VW_HFLX'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'VW_HFLX'
+ TZFIELD%CUNITS = 'm2 s-2'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_VW_HFLX'
+ TZFIELD%NGRID = 7
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLX)
+END IF
+!
+! compute the source for rho*V due to this residual flux ( the other part is
+! taken into account in TURB_VER)
+IF (.NOT. L2D) &
+PRVS(:,:,:) = PRVS(:,:,:) - DZF( ZFLX* MYM( PMZM_PRHODJ ) / MYM ( PDZZ ) )
+!
+!computation of the source for rho*W due to this flux
+IF (.NOT. L2D) THEN
+ IF (.NOT. LFLAT) THEN
+ PRWS(:,:,:) = PRWS(:,:,:) &
+ -DYF( MZM( MYM(PRHODJ) * PINV_PDYY) * ZFLX) &
+ +DZM( PRHODJ * MYF( MZF( ZFLX*PDZY ) * PINV_PDYY ) / MZF(PDZZ) )
+ ELSE
+ PRWS(:,:,:) = PRWS(:,:,:) - DYF( MZM( MYM(PRHODJ) * PINV_PDYY) * ZFLX)
+ END IF
+END IF
+!
+IF (KSPLT==1) THEN
+ !
+ !Contribution to the dynamic production of TKE:
+ !
+ IF (.NOT. L2D) THEN
+ ZWORK(:,:,:) =-MZF( MYF( ZFLX *( GZ_V_VW(PVM,PDZZ) + GY_W_VW_PWM ) ) )
+ !
+ !
+ ! evaluate the dynamic production at w(IKB+1) in PDP(IKB)
+ ZWORK(:,:,IKB:IKB) = - MYF ( &
+ ZFLX(:,:,IKB+1:IKB+1) * &
+ ( (PVM(:,:,IKB+1:IKB+1)-PVM(:,:,IKB:IKB)) / MYM(PDZZ(:,:,IKB+1:IKB+1)) &
+ + ( DYM( PWM(:,:,IKB+1:IKB+1) ) &
+ -MYM( (PWM(:,:,IKB+2:IKB+2)-PWM(:,:,IKB+1:IKB+1)) &
+ /(PDZZ(:,:,IKB+2:IKB+2)+PDZZ(:,:,IKB+1:IKB+1)) &
+ +(PWM(:,:,IKB+1:IKB+1)-PWM(:,:,IKB :IKB )) &
+ /(PDZZ(:,:,IKB+1:IKB+1)+PDZZ(:,:,IKB :IKB )) &
+ ) * PDZY(:,:,IKB+1:IKB+1) &
+ ) / (0.5*(PDYY(:,:,IKB+1:IKB+1)+PDYY(:,:,IKB:IKB))) &
+ ) )
+ ENDIF
+ !
+ ! dynamic production computation
+ IF (.NOT. L2D) &
+ PDP(:,:,:) = PDP(:,:,:) + ZWORK(:,:,:)
+ !
+END IF
+!
+! Storage in the LES configuration (addition to TURB_VER computation)
+!
+IF (LLES_CALL .AND. KSPLT==1) THEN
+ CALL SECOND_MNH(ZTIME1)
+ CALL LES_MEAN_SUBGRID( MZF(MYF(ZFLX)), X_LES_SUBGRID_WV , .TRUE. )
+ CALL LES_MEAN_SUBGRID( MZF(MYF(GZ_V_VW(PVM,PDZZ)*ZFLX)),&
+ X_LES_RES_ddxa_V_SBG_UaV , .TRUE.)
+ CALL LES_MEAN_SUBGRID( MZF(MYF(GY_W_VW(PWM,PDYY,PDZZ,PDZY)*ZFLX)),&
+ X_LES_RES_ddxa_W_SBG_UaW , .TRUE.)
+ CALL LES_MEAN_SUBGRID( MXF(GY_M_V(1,IKU,1,PTHLM,PDYY,PDZZ,PDZY)*MZF(ZFLX)),&
+ X_LES_RES_ddxa_Thl_SBG_UaW , .TRUE.)
+ IF (KRR>=1) THEN
+ CALL LES_MEAN_SUBGRID( MXF(GY_M_V(1,IKU,1,PRM(:,:,:,1),PDYY,PDZZ,PDZY)*MZF(ZFLX)), &
+ X_LES_RES_ddxa_Rt_SBG_UaW , .TRUE.)
+ END IF
+ DO JSV=1,NSV
+ CALL LES_MEAN_SUBGRID( MXF(GY_M_V(1,IKU,1,PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY)*MZF(ZFLX)), &
+ X_LES_RES_ddxa_Sv_SBG_UaW(:,:,:,JSV), .TRUE.)
+ END DO
+ CALL SECOND_MNH(ZTIME2)
+ XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+END IF
+!
+!
+!
+END SUBROUTINE TURB_HOR_VW
diff --git a/src/mesonh/turb/turb_ver.f90 b/src/mesonh/turb/turb_ver.f90
new file mode 100644
index 000000000..4117d8191
--- /dev/null
+++ b/src/mesonh/turb/turb_ver.f90
@@ -0,0 +1,746 @@
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ####################
+ MODULE MODI_TURB_VER
+! ####################
+!
+INTERFACE
+!
+ SUBROUTINE TURB_VER(KKA,KKU,KKL,KRR,KRRL,KRRI, &
+ OTURB_FLX, &
+ HTURBDIM,HTOM,PIMPL,PEXPL, &
+ PTSTEP, TPFILE, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
+ PCOSSLOPE,PSINSLOPE, &
+ PRHODJ,PTHVREF, &
+ PSFTHM,PSFRM,PSFSVM,PSFTHP,PSFRP,PSFSVP, &
+ PCDUEFF,PTAU11M,PTAU12M,PTAU33M, &
+ PUM,PVM,PWM,PUSLOPEM,PVSLOPEM,PTHLM,PRM,PSVM, &
+ PTKEM,PLM,PLEPS, &
+ PLOCPEXNM,PATHETA,PAMOIST,PSRCM,PFRAC_ICE, &
+ PFWTH,PFWR,PFTH2,PFR2,PFTHR,PBL_DEPTH, &
+ PSBL_DEPTH,PLMO, &
+ PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS, &
+ PDP,PTP,PSIGS,PWTH,PWRC,PWSV )
+
+!
+USE MODD_IO, ONLY: TFILEDATA
+!
+INTEGER, INTENT(IN) :: KRR ! number of moist var.
+INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
+INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
+LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
+ ! turbulent fluxes in the syncronous FM-file
+CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
+ ! turbulence scheme
+CHARACTER(len=4), INTENT(IN) :: HTOM ! type of Third Order Moment
+REAL, INTENT(IN) :: PIMPL, PEXPL ! Coef. for temporal disc.
+REAL, INTENT(IN) :: PTSTEP ! timestep
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
+ ! Metric coefficients
+REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW ! Director Cosinus of the
+ ! normal to the ground surface
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitudes at flux points
+REAL, DIMENSION(:,:), INTENT(IN) :: PCOSSLOPE ! cosinus of the angle
+ ! between i and the slope vector
+REAL, DIMENSION(:,:), INTENT(IN) :: PSINSLOPE ! sinus of the angle
+ ! between i and the slope vector
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry density * grid volum
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! ref. state Virtual
+ ! Potential Temperature
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHM,PSFRM ! surface fluxes at time
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSFSVM ! t - deltat
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHP,PSFRP ! surface fluxes at time
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSFSVP ! t + deltat
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PCDUEFF ! Cd * || u || at time t
+REAL, DIMENSION(:,:), INTENT(IN) :: PTAU11M ! <uu> in the axes linked
+ ! to the maximum slope direction and the surface normal and the binormal
+ ! at time t - dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PTAU12M ! <uv> in the same axes
+REAL, DIMENSION(:,:), INTENT(IN) :: PTAU33M ! <ww> in the same axes
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM,PWM,PTHLM
+ ! Wind and potential temperature at t-Delta t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios
+ ! at t-Delta t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-Delta t
+REAL, DIMENSION(:,:), INTENT(IN) :: PUSLOPEM ! wind component along the
+ ! maximum slope direction
+REAL, DIMENSION(:,:), INTENT(IN) :: PVSLOPEM ! wind component along the
+ ! direction normal to the maximum slope one
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! dissipative length
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exner at time t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! coefficients between
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM ! normalized
+ ! 2nd-order flux s'r'c/2Sigma_s2 at t-1 multiplied by Lambda_3
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFRAC_ICE ! ri fraction of rc+ri
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFWTH ! d(w'2th' )/dz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFWR ! d(w'2r' )/dz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFTH2 ! d(w'th'2 )/dz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFR2 ! d(w'r'2 )/dz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFTHR ! d(w'th'r')/dz
+REAL, DIMENSION(:,:), INTENT(INOUT):: PBL_DEPTH ! BL depth
+REAL, DIMENSION(:,:), INTENT(INOUT):: PSBL_DEPTH ! SBL depth
+REAL, DIMENSION(:,:), INTENT(IN) :: PLMO ! Monin-Obukhov length
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS, PRTHLS
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS,PRRS
+ ! cumulated sources for the prognostic variables
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDP,PTP ! Dynamic and thermal
+ ! TKE production terms
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSIGS ! Vert. part of Sigma_s at t
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWTH ! heat flux
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWRC ! cloud water flux
+REAL, DIMENSION(:,:,:,:),INTENT(OUT) :: PWSV ! scalar flux
+
+!
+!
+END SUBROUTINE TURB_VER
+!
+END INTERFACE
+!
+END MODULE MODI_TURB_VER
+!
+!
+! ###############################################################
+ SUBROUTINE TURB_VER(KKA,KKU,KKL,KRR, KRRL, KRRI, &
+ OTURB_FLX, &
+ HTURBDIM,HTOM,PIMPL,PEXPL, &
+ PTSTEP, TPFILE, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
+ PCOSSLOPE,PSINSLOPE, &
+ PRHODJ,PTHVREF, &
+ PSFTHM,PSFRM,PSFSVM,PSFTHP,PSFRP,PSFSVP, &
+ PCDUEFF,PTAU11M,PTAU12M,PTAU33M, &
+ PUM,PVM,PWM,PUSLOPEM,PVSLOPEM,PTHLM,PRM,PSVM, &
+ PTKEM,PLM,PLEPS, &
+ PLOCPEXNM,PATHETA,PAMOIST,PSRCM,PFRAC_ICE, &
+ PFWTH,PFWR,PFTH2,PFR2,PFTHR,PBL_DEPTH, &
+ PSBL_DEPTH,PLMO, &
+ PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS, &
+ PDP,PTP,PSIGS,PWTH,PWRC,PWSV )
+! ###############################################################
+!
+!
+!!**** *TURB_VER* -compute the source terms due to the vertical turbulent
+!! fluxes.
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to compute the vertical turbulent
+! fluxes of the evolutive variables and give back the source
+! terms to the main program. In the case of large horizontal meshes,
+! the divergence of these vertical turbulent fluxes represent the whole
+! effect of the turbulence but when the three-dimensionnal version of
+! the turbulence scheme is activated (CTURBDIM="3DIM"), these divergences
+! are completed in the next routine TURB_HOR.
+! An arbitrary degree of implicitness has been implemented for the
+! temporal treatment of these diffusion terms.
+! The vertical boundary conditions are as follows:
+! * at the bottom, the surface fluxes are prescribed at the same
+! as the other turbulent fluxes
+! * at the top, the turbulent fluxes are set to 0.
+! It should be noted that the condensation has been implicitely included
+! in this turbulence scheme by using conservative variables and computing
+! the subgrid variance of a statistical variable s indicating the presence
+! or not of condensation in a given mesh.
+!
+!!** METHOD
+!! ------
+!! 1D type calculations are made;
+!! The vertical turbulent fluxes are computed in an off-centered
+!! implicit scheme (a Crank-Nicholson type with coefficients different
+!! than 0.5), which allows to vary the degree of implicitness of the
+!! formulation.
+!! The different prognostic variables are treated one by one.
+!! The contributions of each turbulent fluxes are cumulated into the
+!! tendency PRvarS, and into the dynamic and thermal production of
+!! TKE if necessary.
+!!
+!! In section 2 and 3, the thermodynamical fields are considered.
+!! Only the turbulent fluxes of the conservative variables
+!! (Thetal and Rnp stored in PRx(:,:,:,1)) are computed.
+!! Note that the turbulent fluxes at the vertical
+!! boundaries are given either by the soil scheme for the surface one
+!! ( at the same instant as the others fluxes) and equal to 0 at the
+!! top of the model. The thermal production is computed by vertically
+!! averaging the turbulent flux and multiply this flux at the mass point by
+!! a function ETHETA or EMOIST, which preform the transformation from the
+!! conservative variables to the virtual potential temperature.
+!!
+!! In section 4, the variance of the statistical variable
+!! s indicating presence or not of condensation, is determined in function
+!! of the turbulent moments of the conservative variables and its
+!! squarred root is stored in PSIGS. This information will be completed in
+!! the horizontal turbulence if the turbulence dimensionality is not
+!! equal to "1DIM".
+!!
+!! In section 5, the x component of the stress tensor is computed.
+!! The surface flux <u'w'> is computed from the value of the surface
+!! fluxes computed in axes linked to the orography ( i", j" , k"):
+!! i" is parallel to the surface and in the direction of the maximum
+!! slope
+!! j" is also parallel to the surface and in the normal direction of
+!! the maximum slope
+!! k" is the normal to the surface
+!! In order to prevent numerical instability, the implicit scheme has
+!! been extended to the surface flux regarding to its dependence in
+!! function of U. The dependence in function of the other components
+!! introduced by the different rotations is only explicit.
+!! The turbulent fluxes are used to compute the dynamic production of
+!! TKE. For the last TKE level ( located at PDZZ(:,:,IKB)/2 from the
+!! ground), an harmonic extrapolation from the dynamic production at
+!! PDZZ(:,:,IKB) is used to avoid an evaluation of the gradient of U
+!! in the surface layer.
+!!
+!! In section 6, the same steps are repeated but for the y direction
+!! and in section 7, a diagnostic computation of the W variance is
+!! performed.
+!!
+!! In section 8, the turbulent fluxes for the scalar variables are
+!! computed by the same way as the conservative thermodynamical variables
+!!
+!!
+!! EXTERNAL
+!! --------
+!! GX_U_M, GY_V_M, GZ_W_M : cartesian gradient operators
+!! GX_U_UW,GY_V_VW (X,Y,Z) represent the direction of the gradient
+!! _(M,U,...)_ represent the localization of the
+!! field to be derivated
+!! _(M,UW,...) represent the localization of the
+!! field derivated
+!!
+!! SUBROUTINE TRIDIAG : to compute the split implicit evolution
+!! of a variable located at a mass point
+!!
+!! SUBROUTINE TRIDIAG_WIND: to compute the split implicit evolution
+!! of a variable located at a wind point
+!!
+!! FUNCTIONs ETHETA and EMOIST :
+!! allows to compute:
+!! - the coefficients for the turbulent correlation between
+!! any variable and the virtual potential temperature, of its
+!! correlations with the conservative potential temperature and
+!! the humidity conservative variable:
+!! ------- ------- -------
+!! A' Thv' = ETHETA A' Thl' + EMOIST A' Rnp'
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST : contains physical constants
+!!
+!! XG : gravity constant
+!!
+!! Module MODD_CTURB: contains the set of constants for
+!! the turbulence scheme
+!!
+!! XCMFS,XCMFB : cts for the momentum flux
+!! XCSHF : ct for the sensible heat flux
+!! XCHF : ct for the moisture flux
+!! XCTV,XCHV : cts for the T and moisture variances
+!!
+!! Module MODD_PARAMETERS
+!!
+!! JPVEXT_TURB : number of vertical external points
+!! JPHEXT : number of horizontal external points
+!!
+!!
+!! REFERENCE
+!! ---------
+!! Book 1 of documentation (Chapter: Turbulence)
+!!
+!! AUTHOR
+!! ------
+!! Joan Cuxart * INM and Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original August 19, 1994
+!! Modifications: February 14, 1995 (J.Cuxart and J.Stein)
+!! Doctorization and Optimization
+!! Modifications: March 21, 1995 (J.M. Carriere)
+!! Introduction of cloud water
+!! Modifications: June 14, 1995 (J.Cuxart and J. Stein)
+!! Phi3 and Psi3 at w-point + bug in the all
+!! or nothing condens.
+!! Modifications: Sept 15, 1995 (J.Cuxart and J. Stein)
+!! Change the DP computation at the ground
+!! Modifications: October 10, 1995 (J.Cuxart and J. Stein)
+!! Psi for scal var and LES tools
+!! Modifications: November 10, 1995 (J. Stein)
+!! change the surface relations
+!! Modifications: February 20, 1995 (J. Stein) optimization
+!! Modifications: May 21, 1996 (J. Stein)
+!! bug in the vertical flux of the V wind
+!! component for explicit computation
+!! Modifications: May 21, 1996 (N. wood)
+!! modify the computation of the vertical
+!! part or the surface tangential flux
+!! Modifications: May 21, 1996 (P. Jabouille)
+!! same modification in the Y direction
+!!
+!! Modifications: Sept 17, 1996 (J. Stein) change the moist case by using
+!! Pi instead of Piref + use Atheta and Amoist
+!!
+!! Modifications: Nov 24, 1997 (V. Masson) removes the DO loops
+!! Modifications: Mar 31, 1998 (V. Masson) splits the routine TURB_VER
+!! Nov 06, 2002 (V. Masson) LES budgets
+!! Feb 20, 2003 (JP Pinty) Add PFRAC_ICE
+!! July 2005 (S. Tomas, V. Masson)
+!! Add 3rd order moments and
+!! implicitation of PHI3, PSI3
+!! Oct.2009 (C.Lac) Introduction of different PTSTEP according to the
+!! advection schemes
+!! Feb. 2012 (Y. Seity) add possibility to run with
+!! reversed vertical levels
+!! 10/2012 (J.Escobar) Bypass PGI bug , redefine some allocatable array inplace of automatic
+!! 08/2014 (J.Escobar) Bypass PGI memory leak bug , replace IF statement with IF THEN ENDIF
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! JL Redelsperger 03/2021 : add Ocean LES case
+!!--------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_CTURB
+USE MODD_DYN_n, ONLY: LOCEAN
+use modd_field, only: tfielddata, TYPEREAL
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_PARAMETERS
+USE MODD_LES
+USE MODD_NSV, ONLY: NSV
+!
+USE MODI_PRANDTL
+USE MODI_EMOIST
+USE MODI_ETHETA
+USE MODI_GRADIENT_M
+USE MODI_GRADIENT_W
+USE MODI_TURB
+USE MODI_TURB_VER_THERMO_FLUX
+USE MODI_TURB_VER_THERMO_CORR
+USE MODI_TURB_VER_DYN_FLUX
+USE MODI_TURB_VER_SV_FLUX
+USE MODI_TURB_VER_SV_CORR
+USE MODI_LES_MEAN_SUBGRID
+USE MODI_SBL_DEPTH
+!
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+USE MODE_PRANDTL
+!
+USE MODI_SECOND_MNH
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+!
+!
+INTEGER, INTENT(IN) :: KKA !near ground array index
+INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
+INTEGER, INTENT(IN) :: KRR ! number of moist var.
+INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
+INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
+LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
+ ! turbulent fluxes in the syncronous FM-file
+CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
+ ! turbulence scheme
+CHARACTER(len=4), INTENT(IN) :: HTOM ! type of Third Order Moment
+REAL, INTENT(IN) :: PIMPL, PEXPL ! Coef. for temporal disc.
+REAL, INTENT(IN) :: PTSTEP ! timestep
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
+ ! Metric coefficients
+REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW ! Director Cosinus of the
+ ! normal to the ground surface
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitudes at flux points
+REAL, DIMENSION(:,:), INTENT(IN) :: PCOSSLOPE ! cosinus of the angle
+ ! between i and the slope vector
+REAL, DIMENSION(:,:), INTENT(IN) :: PSINSLOPE ! sinus of the angle
+ ! between i and the slope vector
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry density * grid volum
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! ref. state Virtual
+ ! Potential Temperature
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHM,PSFRM ! surface fluxes at time
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSFSVM ! t - deltat
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHP,PSFRP ! surface fluxes at time
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSFSVP ! t + deltat
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PCDUEFF ! Cd * || u || at time t
+REAL, DIMENSION(:,:), INTENT(IN) :: PTAU11M ! <uu> in the axes linked
+ ! to the maximum slope direction and the surface normal and the binormal
+ ! at time t - dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PTAU12M ! <uv> in the same axes
+REAL, DIMENSION(:,:), INTENT(IN) :: PTAU33M ! <ww> in the same axes
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM,PWM,PTHLM
+ ! Wind and potential temperature at t-Delta t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios
+ ! at t-Delta t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-Delta t
+REAL, DIMENSION(:,:), INTENT(IN) :: PUSLOPEM ! wind component along the
+ ! maximum slope direction
+REAL, DIMENSION(:,:), INTENT(IN) :: PVSLOPEM ! wind component along the
+ ! direction normal to the maximum slope one
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! dissipative length
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exnref at time t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! coefficients between
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM ! normalized
+ ! 2nd-order flux s'r'c/2Sigma_s2 at t-1 multiplied by Lambda_3
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFRAC_ICE ! ri fraction of rc+ri
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFWTH ! d(w'2th' )/dz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFWR ! d(w'2r' )/dz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFTH2 ! d(w'th'2 )/dz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFR2 ! d(w'r'2 )/dz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFTHR ! d(w'th'r')/dz
+REAL, DIMENSION(:,:), INTENT(INOUT):: PBL_DEPTH ! BL depth
+REAL, DIMENSION(:,:), INTENT(INOUT):: PSBL_DEPTH ! SBL depth
+REAL, DIMENSION(:,:), INTENT(IN) :: PLMO ! Monin-Obukhov length
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS, PRTHLS
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS,PRRS
+ ! cumulated sources for the prognostic variables
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDP,PTP ! Dynamic and thermal
+ ! TKE production terms
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSIGS ! Vert. part of Sigma_s at t
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWTH ! heat flux
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWRC ! cloud water flux
+REAL, DIMENSION(:,:,:,:),INTENT(OUT) :: PWSV ! scalar flux
+
+!
+!
+!
+!
+!* 0.2 declaration of local variables
+!
+!JUAN BUG PGI
+!!$REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: &
+REAL, ALLOCATABLE, DIMENSION(:,:,:) :: &
+ ZBETA, & ! buoyancy coefficient
+ ZSQRT_TKE,& ! sqrt(e)
+ ZDTH_DZ, & ! d(th)/dz
+ ZDR_DZ, & ! d(rt)/dz
+ ZRED2TH3, & ! 3D Redeslperger number R*2_th
+ ZRED2R3, & ! 3D Redeslperger number R*2_r
+ ZRED2THR3,& ! 3D Redeslperger number R*2_thr
+ ZBLL_O_E, & ! beta * Lk * Leps / tke
+ ZETHETA, & ! Coefficient for theta in theta_v computation
+ ZEMOIST, & ! Coefficient for r in theta_v computation
+ ZREDTH1, & ! 1D Redelsperger number for Th
+ ZREDR1, & ! 1D Redelsperger number for r
+ ZPHI3, & ! phi3 Prandtl number
+ ZPSI3, & ! psi3 Prandtl number for vapor
+ ZD, & ! denominator in phi3 terms
+ ZWTHV, & ! buoyancy flux
+ ZWU, & ! (u'w')
+ ZWV, & ! (v'w')
+ ZTHLP, & ! guess of potential temperature due to vert. turbulent flux
+ ZRP ! guess of total water due to vert. turbulent flux
+
+!!$REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3),NSV) :: &
+REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: &
+ ZPSI_SV, & ! Prandtl number for scalars
+ ZREDS1, & ! 1D Redelsperger number R_sv
+ ZRED2THS, & ! 3D Redelsperger number R*2_thsv
+ ZRED2RS ! 3D Redelsperger number R*2_rsv
+!
+LOGICAL :: GUSERV ! flag to use water vapor
+INTEGER :: IKB,IKE ! index value for the Beginning
+ ! and the End of the physical domain for the mass points
+INTEGER :: JSV ! loop counter on scalar variables
+REAL :: ZTIME1
+REAL :: ZTIME2
+TYPE(TFIELDDATA) :: TZFIELD
+!----------------------------------------------------------------------------
+ALLOCATE ( ZBETA(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
+ ZSQRT_TKE(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)),&
+ ZDTH_DZ(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
+ ZDR_DZ(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
+ ZRED2TH3(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
+ ZRED2R3(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
+ ZRED2THR3(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)),&
+ ZBLL_O_E(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
+ ZETHETA(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
+ ZEMOIST(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
+ ZREDTH1(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
+ ZREDR1(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
+ ZPHI3(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
+ ZPSI3(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
+ ZD(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
+ ZWTHV(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
+ ZWU(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
+ ZWV(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
+ ZTHLP(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
+ ZRP(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) )
+
+ALLOCATE ( &
+ ZPSI_SV(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3),NSV), &
+ ZREDS1(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3),NSV), &
+ ZRED2THS(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3),NSV), &
+ ZRED2RS(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3),NSV) )
+
+!----------------------------------------------------------------------------
+!
+!* 1. PRELIMINARIES
+! -------------
+!
+IKB=KKA+JPVEXT_TURB*KKL
+IKE=KKU-JPVEXT_TURB*KKL
+!
+!
+! 3D Redelsperger numbers
+!
+!
+CALL PRANDTL(KKA,KKU,KKL,KRR,KRRI,OTURB_FLX, &
+ HTURBDIM, &
+ TPFILE, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY, &
+ PTHVREF,PLOCPEXNM,PATHETA,PAMOIST, &
+ PLM,PLEPS,PTKEM,PTHLM,PRM,PSVM,PSRCM, &
+ ZREDTH1, ZREDR1, &
+ ZRED2TH3, ZRED2R3, ZRED2THR3, &
+ ZREDS1,ZRED2THS, ZRED2RS, &
+ ZBLL_O_E, &
+ ZETHETA, ZEMOIST )
+!
+! Buoyancy coefficient
+!
+IF (LOCEAN) THEN
+ ZBETA = XG*XALPHAOC
+ELSE
+ ZBETA = XG/PTHVREF
+END IF
+!
+! Square root of Tke
+!
+ZSQRT_TKE = SQRT(PTKEM)
+!
+! gradients of mean quantities at previous time-step
+!
+ZDTH_DZ = GZ_M_W(KKA,KKU,KKL,PTHLM(:,:,:),PDZZ)
+ZDR_DZ = 0.
+IF (KRR>0) THEN
+ZDR_DZ = GZ_M_W(KKA,KKU,KKL,PRM(:,:,:,1),PDZZ)
+ENDIF
+!
+!
+! Denominator factor in 3rd order terms
+!
+ZD(:,:,:) = (1.+ZREDTH1+ZREDR1) * (1.+0.5*(ZREDTH1+ZREDR1))
+!
+! Phi3 and Psi3 Prandtl numbers
+!
+GUSERV = KRR/=0
+!
+ZPHI3 = PHI3(ZREDTH1,ZREDR1,ZRED2TH3,ZRED2R3,ZRED2THR3,HTURBDIM,GUSERV)
+IF(KRR/=0) THEN
+ZPSI3 = PSI3(ZREDR1,ZREDTH1,ZRED2R3,ZRED2TH3,ZRED2THR3,HTURBDIM,GUSERV)
+ENDIF
+!
+! Prandtl numbers for scalars
+!
+ZPSI_SV = PSI_SV(ZREDTH1,ZREDR1,ZREDS1,ZRED2THS,ZRED2RS,ZPHI3,ZPSI3)
+!
+! LES diagnostics
+!
+IF (LLES_CALL) THEN
+ CALL SECOND_MNH(ZTIME1)
+ CALL LES_MEAN_SUBGRID(ZPHI3,X_LES_SUBGRID_PHI3)
+ IF(KRR/=0) THEN
+ CALL LES_MEAN_SUBGRID(ZPSI3,X_LES_SUBGRID_PSI3)
+ END IF
+ CALL SECOND_MNH(ZTIME2)
+ XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+END IF
+!----------------------------------------------------------------------------
+!
+!
+!* 2. SOURCES OF CONSERVATIVE POTENTIAL TEMPERATURE AND
+! PARTIAL THERMAL PRODUCTION
+! ---------------------------------------------------------------
+!
+!* 3. SOURCES OF CONSERVATIVE AND CLOUD MIXING RATIO AND
+! COMPLETE THERMAL PRODUCTION
+! ------------------------------------------------------
+!
+!* 4. TURBULENT CORRELATIONS : <w Rc>, <THl THl>, <THl Rnp>, <Rnp Rnp>
+! ----------------------------------------------------------------
+!
+!
+ CALL TURB_VER_THERMO_FLUX(KKA,KKU,KKL,KRR,KRRL,KRRI, &
+ OTURB_FLX,HTURBDIM,HTOM, &
+ PIMPL,PEXPL,PTSTEP, &
+ TPFILE, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
+ PRHODJ,PTHVREF, &
+ PSFTHM,PSFRM,PSFTHP,PSFRP, &
+ PWM,PTHLM,PRM,PSVM, &
+ PTKEM,PLM,PLEPS, &
+ PLOCPEXNM,PATHETA,PAMOIST,PSRCM,PFRAC_ICE, &
+ ZBETA, ZSQRT_TKE, ZDTH_DZ, ZDR_DZ, ZRED2TH3, &
+ ZRED2R3, ZRED2THR3, ZBLL_O_E, ZETHETA, &
+ ZEMOIST, ZREDTH1, ZREDR1, ZPHI3, ZPSI3, ZD, &
+ PFWTH,PFWR,PFTH2,PFR2,PFTHR,PBL_DEPTH,ZWTHV, &
+ PRTHLS,PRRS,ZTHLP,ZRP,PTP,PWTH,PWRC )
+!
+ CALL TURB_VER_THERMO_CORR(KKA,KKU,KKL,KRR,KRRL,KRRI, &
+ OTURB_FLX,HTURBDIM,HTOM, &
+ PIMPL,PEXPL, &
+ TPFILE, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW, &
+ PRHODJ,PTHVREF, &
+ PSFTHM,PSFRM,PSFTHP,PSFRP, &
+ PWM,PTHLM,PRM,PSVM, &
+ PTKEM,PLM,PLEPS, &
+ PLOCPEXNM,PATHETA,PAMOIST,PSRCM, &
+ ZBETA, ZSQRT_TKE, ZDTH_DZ, ZDR_DZ, ZRED2TH3, &
+ ZRED2R3, ZRED2THR3, ZBLL_O_E, ZETHETA, &
+ ZEMOIST, ZREDTH1, ZREDR1, ZPHI3, ZPSI3, ZD, &
+ PFWTH,PFWR,PFTH2,PFR2,PFTHR, &
+ ZTHLP,ZRP,PSIGS )
+!
+!----------------------------------------------------------------------------
+!
+!
+!
+!* 5. SOURCES OF U,W WIND COMPONENTS AND PARTIAL DYNAMIC PRODUCTION
+! -------------------------------------------------------------
+!
+!* 6. SOURCES OF V,W WIND COMPONENTS AND COMPLETE 1D DYNAMIC PRODUCTION
+! -----------------------------------------------------------------
+!
+!* 7. DIAGNOSTIC COMPUTATION OF THE 1D <W W> VARIANCE
+! -----------------------------------------------
+!
+CALL TURB_VER_DYN_FLUX(KKA,KKU,KKL, &
+ OTURB_FLX,KRR, &
+ HTURBDIM,PIMPL,PEXPL,PTSTEP, &
+ TPFILE, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
+ PCOSSLOPE,PSINSLOPE, &
+ PRHODJ, &
+ PCDUEFF,PTAU11M,PTAU12M,PTAU33M, &
+ PTHLM,PRM,PSVM,PUM,PVM,PWM,PUSLOPEM,PVSLOPEM, &
+ PTKEM,PLM,ZWU,ZWV, &
+ PRUS,PRVS,PRWS, &
+ PDP,PTP )
+!
+!----------------------------------------------------------------------------
+!
+!
+!* 8. SOURCES OF PASSIVE SCALAR VARIABLES
+! -----------------------------------
+!
+IF (SIZE(PSVM,4)>0) &
+CALL TURB_VER_SV_FLUX(KKA,KKU,KKL, &
+ OTURB_FLX,HTURBDIM, &
+ PIMPL,PEXPL,PTSTEP, &
+ TPFILE, &
+ PDZZ,PDIRCOSZW, &
+ PRHODJ,PWM, &
+ PSFSVM,PSFSVP, &
+ PSVM, &
+ PTKEM,PLM,ZPSI_SV, &
+ PRSVS,PWSV )
+!
+!
+IF (SIZE(PSVM,4)>0 .AND. LLES_CALL) &
+CALL TURB_VER_SV_CORR(KKA,KKU,KKL,KRR,KRRL,KRRI, &
+ PDZZ, &
+ PTHLM,PRM,PTHVREF, &
+ PLOCPEXNM,PATHETA,PAMOIST,PSRCM,ZPHI3,ZPSI3, &
+ PWM,PSVM, &
+ PTKEM,PLM,PLEPS,ZPSI_SV )
+!
+!
+!----------------------------------------------------------------------------
+!
+!* 9. DIAGNOSTIC OF Surface Boundary Layer Depth
+! ------------------------------------------
+!
+IF (SIZE(PSBL_DEPTH)>0) CALL SBL_DEPTH(IKB,IKE,PZZ,ZWU,ZWV,ZWTHV,PLMO,PSBL_DEPTH)
+!
+!----------------------------------------------------------------------------
+!
+!
+!* 10. PRINTS
+! ------
+!
+!
+IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
+!
+! stores the Turbulent Prandtl number
+!
+ TZFIELD%CMNHNAME = 'PHI3'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'PHI3'
+ TZFIELD%CUNITS = '1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'Turbulent Prandtl number'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZPHI3)
+!
+! stores the Turbulent Schmidt number
+!
+ TZFIELD%CMNHNAME = 'PSI3'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'PSI3'
+ TZFIELD%CUNITS = '1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'Turbulent Schmidt number'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZPSI3)
+!
+!
+! stores the Turbulent Schmidt number for the scalar variables
+!
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = '1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ DO JSV=1,NSV
+ WRITE(TZFIELD%CMNHNAME, '("PSI_SV_",I3.3)') JSV
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(TZFIELD%CMNHNAME)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZPSI_SV(:,:,:,JSV))
+ END DO
+!
+END IF
+!
+!
+!----------------------------------------------------------------------------
+END SUBROUTINE TURB_VER
diff --git a/src/mesonh/turb/turb_ver_dyn_flux.f90 b/src/mesonh/turb/turb_ver_dyn_flux.f90
new file mode 100644
index 000000000..51bc4e7e1
--- /dev/null
+++ b/src/mesonh/turb/turb_ver_dyn_flux.f90
@@ -0,0 +1,924 @@
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ####################
+ MODULE MODI_TURB_VER_DYN_FLUX
+! ####################
+!
+INTERFACE
+!
+ SUBROUTINE TURB_VER_DYN_FLUX(KKA,KKU,KKL, &
+ OTURB_FLX,KRR, &
+ HTURBDIM,PIMPL,PEXPL, &
+ PTSTEP, &
+ TPFILE, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
+ PCOSSLOPE,PSINSLOPE, &
+ PRHODJ, &
+ PCDUEFF,PTAU11M,PTAU12M,PTAU33M, &
+ PTHLM,PRM,PSVM,PUM,PVM,PWM,PUSLOPEM,PVSLOPEM, &
+ PTKEM,PLM,PWU,PWV, &
+ PRUS,PRVS,PRWS, &
+ PDP,PTP )
+!
+USE MODD_IO, ONLY: TFILEDATA
+!
+INTEGER, INTENT(IN) :: KKA !near ground array index
+INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=AR
+LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
+ ! turbulent fluxes in the syncronous FM-file
+INTEGER, INTENT(IN) :: KRR ! number of moist var.
+CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
+ ! turbulence scheme
+REAL, INTENT(IN) :: PIMPL, PEXPL ! Coef. for temporal disc.
+REAL, INTENT(IN) :: PTSTEP ! Double Time Step
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
+ ! Metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitude of flux points
+REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW ! Director Cosinus of the
+ ! normal to the ground surface
+REAL, DIMENSION(:,:), INTENT(IN) :: PCOSSLOPE ! cosinus of the angle
+ ! between i and the slope vector
+REAL, DIMENSION(:,:), INTENT(IN) :: PSINSLOPE ! sinus of the angle
+ ! between i and the slope vector
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry density * grid volum
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PCDUEFF ! Cd * || u || at time t
+REAL, DIMENSION(:,:), INTENT(IN) :: PTAU11M ! <uu> in the axes linked
+ ! to the maximum slope direction and the surface normal and the binormal
+ ! at time t - dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PTAU12M ! <uv> in the same axes
+REAL, DIMENSION(:,:), INTENT(IN) :: PTAU33M ! <ww> in the same axes
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM,PWM,PTHLM
+ ! Wind at t-Delta t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM
+REAL, DIMENSION(:,:), INTENT(IN) :: PUSLOPEM ! wind component along the
+ ! maximum slope direction
+REAL, DIMENSION(:,:), INTENT(IN) :: PVSLOPEM ! wind component along the
+ ! direction normal to the maximum slope one
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWU ! momentum flux u'w'
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWV ! momentum flux v'w'
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS
+ ! cumulated sources for the prognostic variables
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDP ! Dynamic TKE production term
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTP ! Thermal TKE production term
+!
+!
+!
+END SUBROUTINE TURB_VER_DYN_FLUX
+!
+END INTERFACE
+!
+END MODULE MODI_TURB_VER_DYN_FLUX
+!
+!
+! ###############################################################
+ SUBROUTINE TURB_VER_DYN_FLUX(KKA,KKU,KKL, &
+ OTURB_FLX,KRR, &
+ HTURBDIM,PIMPL,PEXPL, &
+ PTSTEP, &
+ TPFILE, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
+ PCOSSLOPE,PSINSLOPE, &
+ PRHODJ, &
+ PCDUEFF,PTAU11M,PTAU12M,PTAU33M, &
+ PTHLM,PRM,PSVM,PUM,PVM,PWM,PUSLOPEM,PVSLOPEM, &
+ PTKEM,PLM,PWU,PWV, &
+ PRUS,PRVS,PRWS, &
+ PDP,PTP )
+! ###############################################################
+!
+!
+!!**** *TURB_VER_DYN_FLUX* -compute the source terms due to the vertical turbulent
+!! fluxes.
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to compute the vertical turbulent
+! fluxes of the evolutive variables and give back the source
+! terms to the main program. In the case of large horizontal meshes,
+! the divergence of these vertical turbulent fluxes represent the whole
+! effect of the turbulence but when the three-dimensionnal version of
+! the turbulence scheme is activated (CTURBDIM="3DIM"), these divergences
+! are completed in the next routine TURB_HOR.
+! An arbitrary degree of implicitness has been implemented for the
+! temporal treatment of these diffusion terms.
+! The vertical boundary conditions are as follows:
+! * at the bottom, the surface fluxes are prescribed at the same
+! as the other turbulent fluxes
+! * at the top, the turbulent fluxes are set to 0.
+! It should be noted that the condensation has been implicitely included
+! in this turbulence scheme by using conservative variables and computing
+! the subgrid variance of a statistical variable s indicating the presence
+! or not of condensation in a given mesh.
+!
+!!** METHOD
+!! ------
+!! 1D type calculations are made;
+!! The vertical turbulent fluxes are computed in an off-centered
+!! implicit scheme (a Crank-Nicholson type with coefficients different
+!! than 0.5), which allows to vary the degree of implicitness of the
+!! formulation.
+!! The different prognostic variables are treated one by one.
+!! The contributions of each turbulent fluxes are cumulated into the
+!! tendency PRvarS, and into the dynamic and thermal production of
+!! TKE if necessary.
+!!
+!! In section 2 and 3, the thermodynamical fields are considered.
+!! Only the turbulent fluxes of the conservative variables
+!! (Thetal and Rnp stored in PRx(:,:,:,1)) are computed.
+!! Note that the turbulent fluxes at the vertical
+!! boundaries are given either by the soil scheme for the surface one
+!! ( at the same instant as the others fluxes) and equal to 0 at the
+!! top of the model. The thermal production is computed by vertically
+!! averaging the turbulent flux and multiply this flux at the mass point by
+!! a function ETHETA or EMOIST, which preform the transformation from the
+!! conservative variables to the virtual potential temperature.
+!!
+!! In section 4, the variance of the statistical variable
+!! s indicating presence or not of condensation, is determined in function
+!! of the turbulent moments of the conservative variables and its
+!! squarred root is stored in PSIGS. This information will be completed in
+!! the horizontal turbulence if the turbulence dimensionality is not
+!! equal to "1DIM".
+!!
+!! In section 5, the x component of the stress tensor is computed.
+!! The surface flux <u'w'> is computed from the value of the surface
+!! fluxes computed in axes linked to the orography ( i", j" , k"):
+!! i" is parallel to the surface and in the direction of the maximum
+!! slope
+!! j" is also parallel to the surface and in the normal direction of
+!! the maximum slope
+!! k" is the normal to the surface
+!! In order to prevent numerical instability, the implicit scheme has
+!! been extended to the surface flux regarding to its dependence in
+!! function of U. The dependence in function of the other components
+!! introduced by the different rotations is only explicit.
+!! The turbulent fluxes are used to compute the dynamic production of
+!! TKE. For the last TKE level ( located at PDZZ(:,:,IKB)/2 from the
+!! ground), an harmonic extrapolation from the dynamic production at
+!! PDZZ(:,:,IKB) is used to avoid an evaluation of the gradient of U
+!! in the surface layer.
+!!
+!! In section 6, the same steps are repeated but for the y direction
+!! and in section 7, a diagnostic computation of the W variance is
+!! performed.
+!!
+!! In section 8, the turbulent fluxes for the scalar variables are
+!! computed by the same way as the conservative thermodynamical variables
+!!
+!!
+!! EXTERNAL
+!! --------
+!! GX_U_M, GY_V_M, GZ_W_M : cartesian gradient operators
+!! GX_U_UW,GY_V_VW (X,Y,Z) represent the direction of the gradient
+!! _(M,U,...)_ represent the localization of the
+!! field to be derivated
+!! _(M,UW,...) represent the localization of the
+!! field derivated
+!!
+!!
+!! MXM,MXF,MYM,MYF,MZM,MZF
+!! : Shuman functions (mean operators)
+!! DXF,DYF,DZF,DZM
+!! : Shuman functions (difference operators)
+!!
+!! SUBROUTINE TRIDIAG : to compute the split implicit evolution
+!! of a variable located at a mass point
+!!
+!! SUBROUTINE TRIDIAG_WIND: to compute the split implicit evolution
+!! of a variable located at a wind point
+!!
+!! FUNCTIONs ETHETA and EMOIST :
+!! allows to compute:
+!! - the coefficients for the turbulent correlation between
+!! any variable and the virtual potential temperature, of its
+!! correlations with the conservative potential temperature and
+!! the humidity conservative variable:
+!! ------- ------- -------
+!! A' Thv' = ETHETA A' Thl' + EMOIST A' Rnp'
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST : contains physical constants
+!!
+!! XG : gravity constant
+!!
+!! Module MODD_CTURB: contains the set of constants for
+!! the turbulence scheme
+!!
+!! XCMFS,XCMFB : cts for the momentum flux
+!! XCSHF : ct for the sensible heat flux
+!! XCHF : ct for the moisture flux
+!! XCTV,XCHV : cts for the T and moisture variances
+!!
+!! Module MODD_PARAMETERS
+!!
+!! JPVEXT_TURB : number of vertical external points
+!! JPHEXT : number of horizontal external points
+!!
+!!
+!! REFERENCE
+!! ---------
+!! Book 1 of documentation (Chapter: Turbulence)
+!!
+!! AUTHOR
+!! ------
+!! Joan Cuxart * INM and Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original August 19, 1994
+!! Modifications: February 14, 1995 (J.Cuxart and J.Stein)
+!! Doctorization and Optimization
+!! Modifications: March 21, 1995 (J.M. Carriere)
+!! Introduction of cloud water
+!! Modifications: June 14, 1995 (J.Cuxart and J. Stein)
+!! Phi3 and Psi3 at w-point + bug in the all
+!! or nothing condens.
+!! Modifications: Sept 15, 1995 (J.Cuxart and J. Stein)
+!! Change the DP computation at the ground
+!! Modifications: October 10, 1995 (J.Cuxart and J. Stein)
+!! Psi for scal var and LES tools
+!! Modifications: November 10, 1995 (J. Stein)
+!! change the surface relations
+!! Modifications: February 20, 1995 (J. Stein) optimization
+!! Modifications: May 21, 1996 (J. Stein)
+!! bug in the vertical flux of the V wind
+!! component for explicit computation
+!! Modifications: May 21, 1996 (N. wood)
+!! modify the computation of the vertical
+!! part or the surface tangential flux
+!! Modifications: May 21, 1996 (P. Jabouille)
+!! same modification in the Y direction
+!!
+!! Modifications: Sept 17, 1996 (J. Stein) change the moist case by using
+!! Pi instead of Piref + use Atheta and Amoist
+!!
+!! Modifications: Nov 24, 1997 (V. Masson) removes the DO loops
+!! Modifications: Mar 31, 1998 (V. Masson) splits the routine TURB_VER_DYN_FLUX
+!! Modifications: Oct 18, 2000 (J. Stein) Bug in some computations for IKB level
+!! Modifications: Oct 18, 2000 (V. Masson) LES computations + LFLAT switch
+!! Nov 06, 2002 (V. Masson) LES budgets
+!! October 2009 (G. Tanguy) add ILENCH=LEN(YCOMMENT) after
+!! change of YCOMMENT
+!! 2012-02 Y. Seity, add possibility to run with reversed vertical levels
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! Q. Rodier 17/01/2019 : cleaning : remove cyclic conditions on DP and ZA
+!! JL Redelsperger 03/2021 : Add Ocean & O-A Autocoupling LES Cases
+!!--------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CONF
+USE MODD_CST
+USE MODD_CTURB
+USE MODD_DYN_n, ONLY: LOCEAN
+use modd_field, only: tfielddata, TYPEREAL
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LES
+USE MODD_NSV
+USE MODD_OCEANH
+USE MODD_PARAMETERS
+USE MODD_REF, ONLY : LCOUPLES
+USE MODD_TURB_n
+!
+!
+USE MODI_GRADIENT_U
+USE MODI_GRADIENT_V
+USE MODI_GRADIENT_W
+USE MODI_GRADIENT_M
+USE MODI_SECOND_MNH
+USE MODI_SHUMAN
+USE MODI_TRIDIAG
+USE MODI_TRIDIAG_WIND
+USE MODI_LES_MEAN_SUBGRID
+!
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+USE MODE_ll
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+!
+!
+INTEGER, INTENT(IN) :: KKA !near ground array index
+INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
+LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
+ ! turbulent fluxes in the syncronous FM-file
+INTEGER, INTENT(IN) :: KRR ! number of moist var.
+CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
+ ! turbulence scheme
+REAL, INTENT(IN) :: PIMPL, PEXPL ! Coef. for temporal disc.
+REAL, INTENT(IN) :: PTSTEP ! Double Time Step
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
+ ! Metric coefficients
+REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW ! Director Cosinus of the
+ ! normal to the ground surface
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitude of flux points
+REAL, DIMENSION(:,:), INTENT(IN) :: PCOSSLOPE ! cosinus of the angle
+ ! between i and the slope vector
+REAL, DIMENSION(:,:), INTENT(IN) :: PSINSLOPE ! sinus of the angle
+ ! between i and the slope vector
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry density * grid volum
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PCDUEFF ! Cd * || u || at time t
+REAL, DIMENSION(:,:), INTENT(IN) :: PTAU11M ! <uu> in the axes linked
+ ! to the maximum slope direction and the surface normal and the binormal
+ ! at time t - dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PTAU12M ! <uv> in the same axes
+REAL, DIMENSION(:,:), INTENT(IN) :: PTAU33M ! <ww> in the same axes
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM,PWM, PTHLM
+ ! Wind at t-Delta t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM
+REAL, DIMENSION(:,:), INTENT(IN) :: PUSLOPEM ! wind component along the
+ ! maximum slope direction
+REAL, DIMENSION(:,:), INTENT(IN) :: PVSLOPEM ! wind component along the
+ ! direction normal to the maximum slope one
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWU ! momentum flux u'w'
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWV ! momentum flux v'w'
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS
+ ! cumulated sources for the prognostic variables
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDP ! Dynamic TKE production term
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTP ! Thermal TKE production term
+!
+!
+!
+!
+!* 0.2 declaration of local variables
+!
+!
+REAL, DIMENSION(SIZE(PUM,1),SIZE(PUM,2)) :: ZDIRSINZW ! sinus of the angle
+ ! between the normal and the vertical at the surface
+REAL, DIMENSION(SIZE(PUM,1),SIZE(PUM,2),1):: ZCOEFS ! coeff. for the
+ ! implicit scheme for the wind at the surface
+REAL, DIMENSION(SIZE(PUM,1),SIZE(PUM,2),SIZE(PUM,3)) :: &
+ ZA, & ! under diagonal elements of the tri-diagonal matrix involved
+ ! in the temporal implicit scheme (also used to store coefficient
+ ! J in Section 5)
+ ZRES, & ! guess of the treated variable at t+ deltat when the turbu-
+ ! lence is the only source of evolution added to the ones
+ ! considered in ZSOURCE
+ ZFLXZ, & ! vertical flux of the treated variable
+ ZSOURCE, & ! source of evolution for the treated variable
+ ZKEFF ! effectif diffusion coeff = LT * SQRT( TKE )
+INTEGER :: IIB,IIE, & ! I index values for the Beginning and End
+ IJB,IJE, & ! mass points of the domain in the 3 direct.
+ IKB,IKE !
+INTEGER :: IKT ! array size in k direction
+INTEGER :: IKTB,IKTE ! start, end of k loops in physical domain
+INTEGER :: JSV ! scalar loop counter
+REAL, DIMENSION(SIZE(PDZZ,1),SIZE(PDZZ,2),1) :: ZCOEFFLXU, &
+ ZCOEFFLXV, ZUSLOPEM, ZVSLOPEM
+ ! coefficients for the surface flux
+ ! evaluation and copy of PUSLOPEM and
+ ! PVSLOPEM in local 3D arrays
+INTEGER :: IIU,IJU ! size of array in x,y,z directions
+!
+REAL :: ZTIME1, ZTIME2
+TYPE(TFIELDDATA) :: TZFIELD
+!----------------------------------------------------------------------------
+!
+!* 1. PRELIMINARIES
+! -------------
+ZA=XUNDEF
+PDP=XUNDEF
+!
+IIU=SIZE(PUM,1)
+IJU=SIZE(PUM,2)
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+IKB=KKA+JPVEXT_TURB*KKL
+IKE=KKU-JPVEXT_TURB*KKL
+IKT=SIZE(PUM,3)
+IKTB=1+JPVEXT_TURB
+IKTE=IKT-JPVEXT_TURB
+
+
+!
+ZSOURCE(:,:,:) = 0.
+!
+ZDIRSINZW(:,:) = SQRT(1.-PDIRCOSZW(:,:)**2)
+! compute the coefficients for the uncentred gradient computation near the
+! ground
+!
+ZKEFF(:,:,:) = MZM( PLM(:,:,:) * SQRT(PTKEM(:,:,:)) )
+!
+ZUSLOPEM(:,:,1)=PUSLOPEM(:,:)
+ZVSLOPEM(:,:,1)=PVSLOPEM(:,:)
+!
+!----------------------------------------------------------------------------
+!
+!
+!* 5. SOURCES OF U,W WIND COMPONENTS AND PARTIAL DYNAMIC PRODUCTION
+! -------------------------------------------------------------
+!
+!* 5.1 Source of U wind component
+!
+! Preparation of the arguments for TRIDIAG_WIND
+!
+ZA(:,:,:) = -PTSTEP * XCMFS * &
+ MXM( ZKEFF ) * MXM(MZM( PRHODJ )) / &
+ MXM( PDZZ )**2
+!
+!
+! Compute the source of U wind component
+!
+! compute the coefficient between the vertical flux and the 2 components of the
+! wind following the slope
+ZCOEFFLXU(:,:,1) = PCDUEFF(:,:) * (PDIRCOSZW(:,:)**2 - ZDIRSINZW(:,:)**2) &
+ * PCOSSLOPE(:,:)
+ZCOEFFLXV(:,:,1) = PCDUEFF(:,:) * PDIRCOSZW(:,:) * PSINSLOPE(:,:)
+
+! prepare the implicit scheme coefficients for the surface flux
+ZCOEFS(:,:,1)= ZCOEFFLXU(:,:,1) * PCOSSLOPE(:,:) * PDIRCOSZW(:,:) &
+ +ZCOEFFLXV(:,:,1) * PSINSLOPE(:,:)
+!
+! average this flux to be located at the U,W vorticity point
+ZCOEFS(:,:,1:1)=MXM(ZCOEFS(:,:,1:1) / PDZZ(:,:,IKB:IKB) )
+!
+!
+! ZSOURCE= FLUX /DZ
+IF (LOCEAN) THEN ! OCEAN MODEL ONLY
+ ! Sfx flux assumed to be in SI & at vorticity point
+ IF (LCOUPLES) THEN
+ ZSOURCE(:,:,IKE:IKE) = XSSUFL_C(:,:,1:1)/PDZZ(:,:,IKE:IKE) &
+ *0.5 * ( 1. + MXM(PRHODJ(:,:,KKU:KKU)) / MXM(PRHODJ(:,:,IKE:IKE)))
+ ELSE
+ ZSOURCE(:,:,IKE) = XSSUFL(:,:)
+ ZSOURCE(:,:,IKE:IKE) = ZSOURCE (:,:,IKE:IKE) /PDZZ(:,:,IKE:IKE) &
+ *0.5 * ( 1. + MXM(PRHODJ(:,:,KKU:KKU)) / MXM(PRHODJ(:,:,IKE:IKE)) )
+ ENDIF
+ !No flux at the ocean domain bottom
+ ZSOURCE(:,:,IKB) = 0.
+ ZSOURCE(:,:,IKTB+1:IKTE-1) = 0
+!
+ELSE !ATMOS MODEL ONLY
+ IF (LCOUPLES) THEN
+ ZSOURCE(:,:,IKB:IKB) = XSSUFL_C(:,:,1:1)/PDZZ(:,:,IKB:IKB) &
+ * 0.5 * ( 1. + MXM(PRHODJ(:,:,KKA:KKA)) / MXM(PRHODJ(:,:,IKB:IKB)) )
+ ELSE
+ ! compute the explicit tangential flux at the W point
+ ZSOURCE(:,:,IKB) = &
+ PTAU11M(:,:) * PCOSSLOPE(:,:) * PDIRCOSZW(:,:) * ZDIRSINZW(:,:) &
+ -PTAU12M(:,:) * PSINSLOPE(:,:) * ZDIRSINZW(:,:) &
+ -PTAU33M(:,:) * PCOSSLOPE(:,:) * ZDIRSINZW(:,:) * PDIRCOSZW(:,:)
+!
+ ! add the vertical part or the surface flux at the U,W vorticity point
+!
+ ZSOURCE(:,:,IKB:IKB) = &
+ ( MXM( ZSOURCE(:,:,IKB:IKB) / PDZZ(:,:,IKB:IKB) ) &
+ + MXM( ZCOEFFLXU(:,:,1:1) / PDZZ(:,:,IKB:IKB) &
+ *ZUSLOPEM(:,:,1:1) &
+ -ZCOEFFLXV(:,:,1:1) / PDZZ(:,:,IKB:IKB) &
+ *ZVSLOPEM(:,:,1:1) ) &
+ - ZCOEFS(:,:,1:1) * PUM(:,:,IKB:IKB) * PIMPL &
+ ) * 0.5 * ( 1. + MXM(PRHODJ(:,:,KKA:KKA)) / MXM(PRHODJ(:,:,IKB:IKB)) )
+ ENDIF
+!
+ ZSOURCE(:,:,IKTB+1:IKTE-1) = 0.
+ ZSOURCE(:,:,IKE) = 0.
+ENDIF !end ocean or atmosphere cases
+!
+! Obtention of the split U at t+ deltat
+!
+CALL TRIDIAG_WIND(KKA,KKU,KKL,PUM,ZA,ZCOEFS(:,:,1),PTSTEP,PEXPL,PIMPL, &
+ MXM(PRHODJ),ZSOURCE,ZRES)
+!
+! Compute the equivalent tendency for the U wind component
+!
+PRUS(:,:,:)=PRUS(:,:,:)+MXM(PRHODJ(:,:,:))*(ZRES(:,:,:)-PUM(:,:,:))/PTSTEP
+!
+!
+!* 5.2 Partial Dynamic Production
+!
+! vertical flux of the U wind component
+!
+ZFLXZ(:,:,:) = -XCMFS * MXM(ZKEFF) * &
+ DZM (PIMPL*ZRES + PEXPL*PUM) / MXM(PDZZ)
+!
+! surface flux
+ZFLXZ(:,:,IKB:IKB) = MXM(PDZZ(:,:,IKB:IKB)) * &
+ ( ZSOURCE(:,:,IKB:IKB) &
+ +ZCOEFS(:,:,1:1) * ZRES(:,:,IKB:IKB) * PIMPL &
+ ) / 0.5 / ( 1. + MXM(PRHODJ(:,:,KKA:KKA)) / MXM(PRHODJ(:,:,IKB:IKB)) )
+!
+ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
+
+IF (LOCEAN) THEN !ocean model at phys sfc (ocean domain top)
+ ZFLXZ(:,:,IKE:IKE) = MXM(PDZZ(:,:,IKE:IKE)) * &
+ ZSOURCE(:,:,IKE:IKE) &
+ / 0.5 / ( 1. + MXM(PRHODJ(:,:,KKU:KKU)) / MXM(PRHODJ(:,:,IKE:IKE)) )
+ ZFLXZ(:,:,KKU) = ZFLXZ(:,:,IKE)
+END IF
+!
+IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
+ ! stores the U wind component vertical flux
+ TZFIELD%CMNHNAME = 'UW_VFLX'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'UW_VFLX'
+ TZFIELD%CUNITS = 'm2 s-2'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'U wind component vertical flux'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZ)
+END IF
+!
+! first part of total momentum flux
+!
+PWU(:,:,:) = ZFLXZ(:,:,:)
+!
+! Contribution to the dynamic production of TKE
+! compute the dynamic production at the mass point
+!
+PDP(:,:,:) = - MZF( MXF ( ZFLXZ * GZ_U_UW(PUM,PDZZ) ) )
+!
+! evaluate the dynamic production at w(IKB+KKL) in PDP(IKB)
+PDP(:,:,IKB:IKB) = - MXF ( &
+ ZFLXZ(:,:,IKB+KKL:IKB+KKL) * (PUM(:,:,IKB+KKL:IKB+KKL)-PUM(:,:,IKB:IKB)) &
+ / MXM(PDZZ(:,:,IKB+KKL:IKB+KKL)) &
+ )
+!
+IF (LOCEAN) THEN
+ ! evaluate the dynamic production at w(IKE-KKL) in PDP(IKE)
+ PDP(:,:,IKE:IKE) = - MXF ( &
+ ZFLXZ(:,:,IKE-KKL:IKE-KKL) * (PUM(:,:,IKE:IKE)-PUM(:,:,IKE-KKL:IKE-KKL)) &
+ / MXM(PDZZ(:,:,IKE-KKL:IKE-KKL)) &
+ )
+END IF
+!
+! Storage in the LES configuration
+!
+IF (LLES_CALL) THEN
+ CALL SECOND_MNH(ZTIME1)
+ CALL LES_MEAN_SUBGRID( MZF(MXF(ZFLXZ)), X_LES_SUBGRID_WU )
+ CALL LES_MEAN_SUBGRID( MZF(MXF(GZ_U_UW(PUM,PDZZ) &
+ & *ZFLXZ)), X_LES_RES_ddxa_U_SBG_UaU )
+ CALL LES_MEAN_SUBGRID( XCMFS * ZKEFF, X_LES_SUBGRID_Km )
+ CALL SECOND_MNH(ZTIME2)
+ XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+END IF
+!
+!* 5.3 Source of W wind component
+!
+!
+IF(HTURBDIM=='3DIM') THEN
+ ! Compute the source for the W wind component
+ ! used to compute the W source at the ground
+ ZFLXZ(:,:,KKA) = 2 * ZFLXZ(:,:,IKB) - ZFLXZ(:,:,IKB+KKL) ! extrapolation
+ IF (LOCEAN) THEN
+ ZFLXZ(:,:,KKU) = 2 * ZFLXZ(:,:,IKE) - ZFLXZ(:,:,IKE-KKL) ! extrapolation
+ END IF
+
+ !
+ IF (.NOT. LFLAT) THEN
+ PRWS(:,:,:)= PRWS &
+ -DXF( MZM( MXM(PRHODJ) /PDXX ) * ZFLXZ ) &
+ +DZM( PRHODJ / MZF(PDZZ ) * &
+ MXF( MZF( ZFLXZ*PDZX ) / PDXX ) &
+ )
+ ELSE
+ PRWS(:,:,:)= PRWS -DXF( MZM( MXM(PRHODJ) /PDXX ) * ZFLXZ )
+ END IF
+ !
+ ! Complete the Dynamical production with the W wind component
+ !
+ ZA(:,:,:)=-MZF( MXF ( ZFLXZ * GX_W_UW( PWM,PDXX,PDZZ,PDZX) ) )
+ !
+ !
+ ! evaluate the dynamic production at w(IKB+KKL) in PDP(IKB)
+ ZA(:,:,IKB:IKB) = - MXF ( &
+ ZFLXZ(:,:,IKB+KKL:IKB+KKL) * &
+ ( DXM( PWM(:,:,IKB+KKL:IKB+KKL) ) &
+ -MXM( (PWM(:,:,IKB+2*KKL:IKB+2*KKL )-PWM(:,:,IKB+KKL:IKB+KKL)) &
+ /(PDZZ(:,:,IKB+2*KKL:IKB+2*KKL)+PDZZ(:,:,IKB+KKL:IKB+KKL)) &
+ +(PWM(:,:,IKB+KKL:IKB+KKL)-PWM(:,:,IKB:IKB )) &
+ /(PDZZ(:,:,IKB+KKL:IKB+KKL)+PDZZ(:,:,IKB:IKB )) &
+ ) &
+ * PDZX(:,:,IKB+KKL:IKB+KKL) &
+ ) / (0.5*(PDXX(:,:,IKB+KKL:IKB+KKL)+PDXX(:,:,IKB:IKB))) &
+ )
+ !
+IF (LOCEAN) THEN
+ ! evaluate the dynamic production at w(IKE-KKL) in PDP(IKE)
+ ZA(:,:,IKE:IKE) = - MXF ( &
+ ZFLXZ(:,:,IKE-KKL:IKE-KKL) * &
+ ( DXM( PWM(:,:,IKE-KKL:IKE-KKL) ) &
+ -MXM( (PWM(:,:,IKE-2*KKL:IKE-2*KKL )-PWM(:,:,IKE-KKL:IKE-KKL)) &
+ /(PDZZ(:,:,IKE-2*KKL:IKE-2*KKL)+PDZZ(:,:,IKE-KKL:IKE-KKL)) &
+ +(PWM(:,:,IKE-KKL:IKE-KKL)-PWM(:,:,IKE:IKE )) &
+ /(PDZZ(:,:,IKE-KKL:IKE-KKL)+PDZZ(:,:,IKE:IKE )) &
+ ) &
+ * PDZX(:,:,IKE-KKL:IKE-KKL) &
+ ) / (0.5*(PDXX(:,:,IKE-KKL:IKE-KKL)+PDXX(:,:,IKE:IKE))) &
+ )
+END IF
+ !
+ PDP(:,:,:)=PDP(:,:,:)+ZA(:,:,:)
+ !
+ ! Storage in the LES configuration
+ !
+ IF (LLES_CALL) THEN
+ CALL SECOND_MNH(ZTIME1)
+ CALL LES_MEAN_SUBGRID( MZF(MXF(GX_W_UW(PWM,PDXX,&
+ PDZZ,PDZX)*ZFLXZ)), X_LES_RES_ddxa_W_SBG_UaW )
+ CALL LES_MEAN_SUBGRID( MXF(GX_M_U(KKA,KKU,KKL,PTHLM,PDXX,PDZZ,PDZX)&
+ * MZF(ZFLXZ)), X_LES_RES_ddxa_Thl_SBG_UaW )
+ IF (KRR>=1) THEN
+ CALL LES_MEAN_SUBGRID(MXF(GX_U_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX)&
+ *MZF(ZFLXZ)),X_LES_RES_ddxa_Rt_SBG_UaW )
+ END IF
+ DO JSV=1,NSV
+ CALL LES_MEAN_SUBGRID( MXF(GX_U_M(PSVM(:,:,:,JSV),PDXX,PDZZ,&
+ PDZX)*MZF(ZFLXZ)),X_LES_RES_ddxa_Sv_SBG_UaW(:,:,:,JSV) )
+ END DO
+ CALL SECOND_MNH(ZTIME2)
+ XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ END IF
+END IF
+!
+!----------------------------------------------------------------------------
+!
+!
+!* 6. SOURCES OF V,W WIND COMPONENTS AND COMPLETE 1D DYNAMIC PRODUCTION
+! -----------------------------------------------------------------
+!
+!* 6.1 Source of V wind component
+!
+! Preparation of the arguments for TRIDIAG_WIND
+!!
+ZA(:,:,:) = - PTSTEP * XCMFS * &
+ MYM( ZKEFF ) * MYM(MZM( PRHODJ )) / &
+ MYM( PDZZ )**2
+!
+!
+!
+! Compute the source of V wind component
+! compute the coefficient between the vertical flux and the 2 components of the
+! wind following the slope
+ZCOEFFLXU(:,:,1) = PCDUEFF(:,:) * (PDIRCOSZW(:,:)**2 - ZDIRSINZW(:,:)**2) &
+ * PSINSLOPE(:,:)
+ZCOEFFLXV(:,:,1) = PCDUEFF(:,:) * PDIRCOSZW(:,:) * PCOSSLOPE(:,:)
+
+! prepare the implicit scheme coefficients for the surface flux
+ZCOEFS(:,:,1)= ZCOEFFLXU(:,:,1) * PSINSLOPE(:,:) * PDIRCOSZW(:,:) &
+ +ZCOEFFLXV(:,:,1) * PCOSSLOPE(:,:)
+!
+! average this flux to be located at the V,W vorticity point
+ZCOEFS(:,:,1:1)=MYM(ZCOEFS(:,:,1:1) / PDZZ(:,:,IKB:IKB) )
+!
+IF (LOCEAN) THEN ! Ocean case
+ IF (LCOUPLES) THEN
+ ZSOURCE(:,:,IKE:IKE) = XSSVFL_C(:,:,1:1)/PDZZ(:,:,IKE:IKE) &
+ *0.5 * ( 1. + MYM(PRHODJ(:,:,KKU:KKU)) / MYM(PRHODJ(:,:,IKE:IKE)) )
+ ELSE
+ ZSOURCE(:,:,IKE) = XSSVFL(:,:)
+ ZSOURCE(:,:,IKE:IKE) = ZSOURCE(:,:,IKE:IKE)/PDZZ(:,:,IKE:IKE) &
+ *0.5 * ( 1. + MYM(PRHODJ(:,:,KKU:KKU)) / MYM(PRHODJ(:,:,IKE:IKE)) )
+ END IF
+ !No flux at the ocean domain bottom
+ ZSOURCE(:,:,IKB) = 0.
+ELSE ! Atmos case
+ IF (.NOT.LCOUPLES) THEN ! only atmosp without coupling
+ ! compute the explicit tangential flux at the W point
+ ZSOURCE(:,:,IKB) = &
+ PTAU11M(:,:) * PSINSLOPE(:,:) * PDIRCOSZW(:,:) * ZDIRSINZW(:,:) &
+ +PTAU12M(:,:) * PCOSSLOPE(:,:) * ZDIRSINZW(:,:) &
+ -PTAU33M(:,:) * PSINSLOPE(:,:) * ZDIRSINZW(:,:) * PDIRCOSZW(:,:)
+!
+ ! add the vertical part or the surface flux at the V,W vorticity point
+ ZSOURCE(:,:,IKB:IKB) = &
+ ( MYM( ZSOURCE(:,:,IKB:IKB) / PDZZ(:,:,IKB:IKB) ) &
+ + MYM( ZCOEFFLXU(:,:,1:1) / PDZZ(:,:,IKB:IKB) &
+ *ZUSLOPEM(:,:,1:1) &
+ +ZCOEFFLXV(:,:,1:1) / PDZZ(:,:,IKB:IKB) &
+ *ZVSLOPEM(:,:,1:1) ) &
+ - ZCOEFS(:,:,1:1) * PVM(:,:,IKB:IKB) * PIMPL &
+ ) * 0.5 * ( 1. + MYM(PRHODJ(:,:,KKA:KKA)) / MYM(PRHODJ(:,:,IKB:IKB)) )
+!
+ ELSE !atmosphere when coupling
+ ! input flux assumed to be in SI and at vorticity point
+ ZSOURCE(:,:,IKB:IKB) = -XSSVFL_C(:,:,1:1)/(1.*PDZZ(:,:,IKB:IKB)) &
+ * 0.5 * ( 1. + MYM(PRHODJ(:,:,KKA:KKA)) / MYM(PRHODJ(:,:,IKB:IKB)) )
+ ENDIF
+ !No flux at the atmosphere top
+ ZSOURCE(:,:,IKE) = 0.
+ENDIF ! End of Ocean or Atmospher Cases
+ZSOURCE(:,:,IKTB+1:IKTE-1) = 0.
+!
+! Obtention of the split V at t+ deltat
+CALL TRIDIAG_WIND(KKA,KKU,KKL,PVM,ZA,ZCOEFS(:,:,1),PTSTEP,PEXPL,PIMPL, &
+ MYM(PRHODJ),ZSOURCE,ZRES)
+!
+! Compute the equivalent tendency for the V wind component
+!
+PRVS(:,:,:)=PRVS(:,:,:)+MYM(PRHODJ(:,:,:))*(ZRES(:,:,:)-PVM(:,:,:))/PTSTEP
+!
+!
+!* 6.2 Complete 1D dynamic Production
+!
+! vertical flux of the V wind component
+!
+ZFLXZ(:,:,:) = -XCMFS * MYM(ZKEFF) * &
+ DZM( PIMPL*ZRES + PEXPL*PVM ) / MYM(PDZZ)
+!
+ZFLXZ(:,:,IKB:IKB) = MYM(PDZZ(:,:,IKB:IKB)) * &
+ ( ZSOURCE(:,:,IKB:IKB) &
+ +ZCOEFS(:,:,1:1) * ZRES(:,:,IKB:IKB) * PIMPL &
+ ) / 0.5 / ( 1. + MYM(PRHODJ(:,:,KKA:KKA)) / MYM(PRHODJ(:,:,IKB:IKB)) )
+!
+!
+ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
+!
+IF (LOCEAN) THEN
+ ZFLXZ(:,:,IKE:IKE) = MYM(PDZZ(:,:,IKE:IKE)) * &
+ ZSOURCE(:,:,IKE:IKE) &
+ / 0.5 / ( 1. + MYM(PRHODJ(:,:,KKU:KKU)) / MYM(PRHODJ(:,:,IKE:IKE)) )
+ ZFLXZ(:,:,KKU) = ZFLXZ(:,:,IKE)
+END IF
+!
+IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
+ ! stores the V wind component vertical flux
+ TZFIELD%CMNHNAME = 'VW_VFLX'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'VW_VFLX'
+ TZFIELD%CUNITS = 'm2 s-2'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'V wind component vertical flux'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZ)
+END IF
+!
+! second part of total momentum flux
+!
+PWV(:,:,:) = ZFLXZ(:,:,:)
+!
+! Contribution to the dynamic production of TKE
+! compute the dynamic production contribution at the mass point
+!
+ZA(:,:,:) = - MZF( MYF ( ZFLXZ * GZ_V_VW(PVM,PDZZ) ) )
+!
+! evaluate the dynamic production at w(IKB+KKL) in PDP(IKB)
+ZA(:,:,IKB:IKB) = &
+ - MYF ( &
+ZFLXZ(:,:,IKB+KKL:IKB+KKL) * (PVM(:,:,IKB+KKL:IKB+KKL)-PVM(:,:,IKB:IKB)) &
+ / MYM(PDZZ(:,:,IKB+KKL:IKB+KKL)) &
+ )
+!
+IF (LOCEAN) THEN
+ ! evaluate the dynamic production at w(IKE-KKL) in PDP(IKE)
+ ZA(:,:,IKE:IKE) = - MYF ( &
+ ZFLXZ(:,:,IKE-KKL:IKE-KKL) * (PVM(:,:,IKE:IKE)-PVM(:,:,IKE-KKL:IKE-KKL)) &
+ / MYM(PDZZ(:,:,IKE-KKL:IKE-KKL)) &
+ )
+END IF
+!
+PDP(:,:,:)=PDP(:,:,:)+ZA(:,:,:)
+!
+! Storage in the LES configuration
+!
+IF (LLES_CALL) THEN
+ CALL SECOND_MNH(ZTIME1)
+ CALL LES_MEAN_SUBGRID( MZF(MYF(ZFLXZ)), X_LES_SUBGRID_WV )
+ CALL LES_MEAN_SUBGRID( MZF(MYF(GZ_V_VW(PVM,PDZZ)*&
+ & ZFLXZ)), X_LES_RES_ddxa_V_SBG_UaV )
+ CALL SECOND_MNH(ZTIME2)
+ XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+END IF
+!
+!
+!* 6.3 Source of W wind component
+!
+IF(HTURBDIM=='3DIM') THEN
+ ! Compute the source for the W wind component
+ ZFLXZ(:,:,KKA) = 2 * ZFLXZ(:,:,IKB) - ZFLXZ(:,:,IKB+KKL) ! extrapolation
+ IF (LOCEAN) THEN
+ ZFLXZ(:,:,KKU) = 2 * ZFLXZ(:,:,IKE) - ZFLXZ(:,:,IKE-KKL) ! extrapolation
+ END IF
+ !
+ IF (.NOT. L2D) THEN
+ IF (.NOT. LFLAT) THEN
+ PRWS(:,:,:)= PRWS(:,:,:) &
+ -DYF( MZM( MYM(PRHODJ) /PDYY ) * ZFLXZ ) &
+ +DZM( PRHODJ / MZF(PDZZ ) * &
+ MYF( MZF( ZFLXZ*PDZY ) / PDYY ) &
+ )
+ ELSE
+ PRWS(:,:,:)= PRWS(:,:,:) -DYF( MZM( MYM(PRHODJ) /PDYY ) * ZFLXZ )
+ END IF
+ END IF
+ !
+ ! Complete the Dynamical production with the W wind component
+ IF (.NOT. L2D) THEN
+ ZA(:,:,:) = - MZF( MYF ( ZFLXZ * GY_W_VW( PWM,PDYY,PDZZ,PDZY) ) )
+ !
+ ! evaluate the dynamic production at w(IKB+KKL) in PDP(IKB)
+ ZA(:,:,IKB:IKB) = - MYF ( &
+ ZFLXZ(:,:,IKB+KKL:IKB+KKL) * &
+ ( DYM( PWM(:,:,IKB+KKL:IKB+KKL) ) &
+ -MYM( (PWM(:,:,IKB+2*KKL:IKB+2*KKL)-PWM(:,:,IKB+KKL:IKB+KKL)) &
+ /(PDZZ(:,:,IKB+2*KKL:IKB+2*KKL)+PDZZ(:,:,IKB+KKL:IKB+KKL)) &
+ +(PWM(:,:,IKB+KKL:IKB+KKL)-PWM(:,:,IKB:IKB )) &
+ /(PDZZ(:,:,IKB+KKL:IKB+KKL)+PDZZ(:,:,IKB:IKB )) &
+ ) &
+ * PDZY(:,:,IKB+KKL:IKB+KKL) &
+ ) / (0.5*(PDYY(:,:,IKB+KKL:IKB+KKL)+PDYY(:,:,IKB:IKB))) &
+ )
+ !
+ IF (LOCEAN) THEN
+ ZA(:,:,IKE:IKE) = - MYF ( &
+ ZFLXZ(:,:,IKE-KKL:IKE-KKL) * &
+ ( DYM( PWM(:,:,IKE-KKL:IKE-KKL) ) &
+ -MYM( (PWM(:,:,IKE-2*KKL:IKE-2*KKL)-PWM(:,:,IKE-KKL:IKE-KKL)) &
+ /(PDZZ(:,:,IKE-2*KKL:IKE-2*KKL)+PDZZ(:,:,IKE-KKL:IKE-KKL)) &
+ +(PWM(:,:,IKE-KKL:IKE-KKL)-PWM(:,:,IKE:IKE )) &
+ /(PDZZ(:,:,IKE-KKL:IKE-KKL)+PDZZ(:,:,IKE:IKE )) &
+ ) &
+ * PDZY(:,:,IKE-KKL:IKE-KKL) &
+ ) / (0.5*(PDYY(:,:,IKE-KKL:IKE-KKL)+PDYY(:,:,IKE:IKE))) &
+ )
+ END IF
+!
+ PDP(:,:,:)=PDP(:,:,:)+ZA(:,:,:)
+ !
+ END IF
+ !
+ ! Storage in the LES configuration
+ !
+ IF (LLES_CALL) THEN
+ CALL SECOND_MNH(ZTIME1)
+ CALL LES_MEAN_SUBGRID( MZF(MYF(GY_W_VW(PWM,PDYY,&
+ PDZZ,PDZY)*ZFLXZ)), X_LES_RES_ddxa_W_SBG_UaW , .TRUE. )
+ CALL LES_MEAN_SUBGRID( MYF(GY_M_V(KKA,KKU,KKL,PTHLM,PDYY,PDZZ,PDZY)&
+ *MZF(ZFLXZ)), X_LES_RES_ddxa_Thl_SBG_UaW , .TRUE. )
+ IF (KRR>=1) THEN
+ CALL LES_MEAN_SUBGRID( MYF(GY_V_M(PRM(:,:,:,1),PDYY,PDZZ,&
+ PDZY)*MZF(ZFLXZ)),X_LES_RES_ddxa_Rt_SBG_UaW , .TRUE. )
+ END IF
+ CALL SECOND_MNH(ZTIME2)
+ XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ END IF
+ !
+END IF
+!
+!
+!----------------------------------------------------------------------------
+!
+!* 7. DIAGNOSTIC COMPUTATION OF THE 1D <W W> VARIANCE
+! -----------------------------------------------
+!
+IF ( OTURB_FLX .AND. tpfile%lopened .AND. HTURBDIM == '1DIM') THEN
+ ZFLXZ(:,:,:)= (2./3.) * PTKEM(:,:,:) &
+ -XCMFS*PLM(:,:,:)*SQRT(PTKEM(:,:,:))*GZ_W_M(PWM,PDZZ)
+ ! to be tested &
+ ! +XCMFB*(4./3.)*PLM(:,:,:)/SQRT(PTKEM(:,:,:))*PTP(:,:,:)
+ ! stores the W variance
+ TZFIELD%CMNHNAME = 'W_VVAR'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'W_VVAR'
+ TZFIELD%CUNITS = 'm2 s-2'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_W_VVAR'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZ)
+END IF
+!
+!----------------------------------------------------------------------------
+!
+END SUBROUTINE TURB_VER_DYN_FLUX
diff --git a/src/mesonh/turb/turb_ver_sv_corr.f90 b/src/mesonh/turb/turb_ver_sv_corr.f90
new file mode 100644
index 000000000..b62268e7e
--- /dev/null
+++ b/src/mesonh/turb/turb_ver_sv_corr.f90
@@ -0,0 +1,223 @@
+!MNH_LIC Copyright 2002-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ####################
+ MODULE MODI_TURB_VER_SV_CORR
+! ####################
+!
+INTERFACE
+!
+ SUBROUTINE TURB_VER_SV_CORR(KKA,KKU,KKL,KRR,KRRL,KRRI, &
+ PDZZ, &
+ PTHLM,PRM,PTHVREF, &
+ PLOCPEXNM,PATHETA,PAMOIST,PSRCM,PPHI3,PPSI3, &
+ PWM,PSVM, &
+ PTKEM,PLM,PLEPS,PPSI_SV )
+!
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+INTEGER, INTENT(IN) :: KRR ! number of moist var.
+INTEGER, INTENT(IN) :: KRRL ! number of liquid var.
+INTEGER, INTENT(IN) :: KRRI ! number of ice var.
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ
+ ! Metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM ! potential temperature at t-Delta t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios at t-Delta t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! reference Thv
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exnref at time t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! coefficients between
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM ! normalized
+ ! 2nd-order flux s'r'c/2Sigma_s2 at t-1 multiplied by Lambda_3
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPHI3 ! Inv.Turb.Sch.for temperature
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPSI3 ! Inv.Turb.Sch.for humidity
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PWM ! w at time t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-Delta t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! dissipative length
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PPSI_SV ! Inv.Turb.Sch.for scalars
+ ! cumulated sources for the prognostic variables
+!
+!
+END SUBROUTINE TURB_VER_SV_CORR
+!
+END INTERFACE
+!
+END MODULE MODI_TURB_VER_SV_CORR
+!
+!
+! ###############################################################
+ SUBROUTINE TURB_VER_SV_CORR(KKA,KKU,KKL,KRR,KRRL,KRRI, &
+ PDZZ, &
+ PTHLM,PRM,PTHVREF, &
+ PLOCPEXNM,PATHETA,PAMOIST,PSRCM,PPHI3,PPSI3, &
+ PWM,PSVM, &
+ PTKEM,PLM,PLEPS,PPSI_SV )
+! ###############################################################
+!
+!
+!!**** *TURB_VER_SV_CORR* -compute the subgrid Sv2 and SvThv terms
+!!
+!! PURPOSE
+!! -------
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!! FUNCTIONs ETHETA and EMOIST :
+!! allows to compute:
+!! - the coefficients for the turbulent correlation between
+!! any variable and the virtual potential temperature, of its
+!! correlations with the conservative potential temperature and
+!! the humidity conservative variable:
+!! ------- ------- -------
+!! A' Thv' = ETHETA A' Thl' + EMOIST A' Rnp'
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! V. Masson * Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original October 29, 2002
+!! JP Pinty Feb 20, 2003 Add PFRAC_ICE
+!!--------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_CTURB
+USE MODD_PARAMETERS
+USE MODD_LES
+USE MODD_CONF
+USE MODD_NSV, ONLY : NSV,NSV_LGBEG,NSV_LGEND
+USE MODD_BLOWSNOW
+!
+!
+USE MODI_GRADIENT_U
+USE MODI_GRADIENT_V
+USE MODI_GRADIENT_W
+USE MODI_GRADIENT_M
+USE MODI_SHUMAN
+USE MODI_EMOIST
+USE MODI_ETHETA
+USE MODI_LES_MEAN_SUBGRID
+!
+USE MODI_SECOND_MNH
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+!
+!
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+INTEGER, INTENT(IN) :: KRR ! number of moist var.
+INTEGER, INTENT(IN) :: KRRL ! number of liquid var.
+INTEGER, INTENT(IN) :: KRRI ! number of ice var.
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ
+ ! Metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM ! potential temperature at t-Delta t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios at t-Delta t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! reference Thv
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exnref at time t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! coefficients between
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM ! normalized
+ ! 2nd-order flux s'r'c/2Sigma_s2 at t-1 multiplied by Lambda_3
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPHI3 ! Inv.Turb.Sch.for temperature
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPSI3 ! Inv.Turb.Sch.for humidity
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PWM ! w at time t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-Delta t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! dissipative length
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PPSI_SV ! Inv.Turb.Sch.for scalars
+ ! cumulated sources for the prognostic variables
+!
+!
+!
+!
+!* 0.2 declaration of local variables
+!
+!
+REAL, DIMENSION(SIZE(PSVM,1),SIZE(PSVM,2),SIZE(PSVM,3)) :: &
+ ZA, ZFLXZ
+!
+REAL :: ZCSV !constant for the scalar flux
+!
+INTEGER :: JSV ! loop counters
+!
+REAL :: ZTIME1, ZTIME2
+!
+REAL :: ZCSVD = 1.2 ! constant for scalar variance dissipation
+REAL :: ZCTSVD = 2.4 ! constant for temperature - scalar covariance dissipation
+REAL :: ZCQSVD = 2.4 ! constant for humidity - scalar covariance dissipation
+!----------------------------------------------------------------------------
+!
+CALL SECOND_MNH(ZTIME1)
+!
+IF(LBLOWSNOW) THEN
+! See Vionnet (PhD, 2012) for a complete discussion around the value of the Schmidt number for blowing snow variables
+ ZCSV= XCHF/XRSNOW
+ELSE
+ ZCSV= XCHF
+ENDIF
+!
+DO JSV=1,NSV
+ !
+ IF (LNOMIXLG .AND. JSV >= NSV_LGBEG .AND. JSV<= NSV_LGEND) CYCLE
+ !
+ ! variance Sv2
+ !
+ IF (LLES_CALL) THEN
+ ! approximation: diagnosed explicitely (without implicit term)
+ ZFLXZ(:,:,:) = PPSI_SV(:,:,:,JSV)*GZ_M_W(KKA,KKU,KKL,PSVM(:,:,:,JSV),PDZZ)**2
+ ZFLXZ(:,:,:) = ZCSV / ZCSVD * PLM * PLEPS * MZF(ZFLXZ(:,:,:) )
+ CALL LES_MEAN_SUBGRID( -2.*ZCSVD*SQRT(PTKEM)*ZFLXZ/PLEPS, X_LES_SUBGRID_DISS_Sv2(:,:,:,JSV) )
+ CALL LES_MEAN_SUBGRID( MZF(PWM)*ZFLXZ, X_LES_RES_W_SBG_Sv2(:,:,:,JSV) )
+ END IF
+ !
+ ! covariance ThvSv
+ !
+ IF (LLES_CALL) THEN
+ ! approximation: diagnosed explicitely (without implicit term)
+ ZA(:,:,:) = ETHETA(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM)
+ ZFLXZ(:,:,:)= ( XCSHF * PPHI3 + ZCSV * PPSI_SV(:,:,:,JSV) ) &
+ * GZ_M_W(KKA,KKU,KKL,PTHLM,PDZZ) &
+ * GZ_M_W(KKA,KKU,KKL,PSVM(:,:,:,JSV),PDZZ)
+ ZFLXZ(:,:,:)= PLM * PLEPS / (2.*ZCTSVD) * MZF(ZFLXZ)
+ CALL LES_MEAN_SUBGRID( ZA*ZFLXZ, X_LES_SUBGRID_SvThv(:,:,:,JSV) )
+ CALL LES_MEAN_SUBGRID( -XG/PTHVREF/3.*ZA*ZFLXZ, X_LES_SUBGRID_SvPz(:,:,:,JSV), .TRUE.)
+ !
+ IF (KRR>=1) THEN
+ ZA(:,:,:) = EMOIST(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM)
+ ZFLXZ(:,:,:)= ( XCHF * PPSI3 + ZCSV * PPSI_SV(:,:,:,JSV) ) &
+ * GZ_M_W(KKA,KKU,KKL,PRM(:,:,:,1),PDZZ) &
+ * GZ_M_W(KKA,KKU,KKL,PSVM(:,:,:,JSV),PDZZ)
+ ZFLXZ(:,:,:)= PLM * PLEPS / (2.*ZCQSVD) * MZF(ZFLXZ)
+ CALL LES_MEAN_SUBGRID( ZA*ZFLXZ, X_LES_SUBGRID_SvThv(:,:,:,JSV) , .TRUE.)
+ CALL LES_MEAN_SUBGRID( -XG/PTHVREF/3.*ZA*ZFLXZ, X_LES_SUBGRID_SvPz(:,:,:,JSV), .TRUE.)
+ END IF
+ END IF
+ !
+END DO ! end of scalar loop
+!
+CALL SECOND_MNH(ZTIME2)
+XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+!----------------------------------------------------------------------------
+!
+END SUBROUTINE TURB_VER_SV_CORR
diff --git a/src/mesonh/turb/turb_ver_sv_flux.f90 b/src/mesonh/turb/turb_ver_sv_flux.f90
new file mode 100644
index 000000000..23d8bee03
--- /dev/null
+++ b/src/mesonh/turb/turb_ver_sv_flux.f90
@@ -0,0 +1,490 @@
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ####################
+ MODULE MODI_TURB_VER_SV_FLUX
+! ####################
+!
+INTERFACE
+!
+ SUBROUTINE TURB_VER_SV_FLUX(KKA,KKU,KKL, &
+ OTURB_FLX,HTURBDIM, &
+ PIMPL,PEXPL, &
+ PTSTEP, &
+ TPFILE, &
+ PDZZ,PDIRCOSZW, &
+ PRHODJ,PWM, &
+ PSFSVM,PSFSVP, &
+ PSVM, &
+ PTKEM,PLM,PPSI_SV, &
+ PRSVS,PWSV )
+!
+USE MODD_IO, ONLY: TFILEDATA
+!
+INTEGER, INTENT(IN) :: KKA !near ground array index
+INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=AR
+LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
+ ! turbulent fluxes in the syncronous FM-file
+CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
+ ! turbulence scheme
+REAL, INTENT(IN) :: PIMPL, PEXPL ! Coef. for temporal disc.
+REAL, INTENT(IN) :: PTSTEP ! Double Time Step
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ
+ ! Metric coefficients
+REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW ! Director Cosinus of the
+ ! normal to the ground surface
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry density * grid volum
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSFSVM ! t - deltat
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSFSVP ! t + deltat
+!
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-Delta t
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PWM ! vertical wind
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PPSI_SV ! Inv.Turb.Sch.for scalars
+!
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS
+ ! cumulated sources for the prognostic variables
+REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PWSV ! scalar flux
+
+!
+!
+END SUBROUTINE TURB_VER_SV_FLUX
+!
+END INTERFACE
+!
+END MODULE MODI_TURB_VER_SV_FLUX
+!
+!
+! ###############################################################
+ SUBROUTINE TURB_VER_SV_FLUX(KKA,KKU,KKL, &
+ OTURB_FLX,HTURBDIM, &
+ PIMPL,PEXPL, &
+ PTSTEP, &
+ TPFILE, &
+ PDZZ,PDIRCOSZW, &
+ PRHODJ,PWM, &
+ PSFSVM,PSFSVP, &
+ PSVM, &
+ PTKEM,PLM,PPSI_SV, &
+ PRSVS,PWSV )
+!
+
+!
+!
+!!**** *TURB_VER_SV_FLUX* -compute the source terms due to the vertical turbulent
+!! fluxes.
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to compute the vertical turbulent
+! fluxes of the evolutive variables and give back the source
+! terms to the main program. In the case of large horizontal meshes,
+! the divergence of these vertical turbulent fluxes represent the whole
+! effect of the turbulence but when the three-dimensionnal version of
+! the turbulence scheme is activated (CTURBDIM="3DIM"), these divergences
+! are completed in the next routine TURB_HOR.
+! An arbitrary degree of implicitness has been implemented for the
+! temporal treatment of these diffusion terms.
+! The vertical boundary conditions are as follows:
+! * at the bottom, the surface fluxes are prescribed at the same
+! as the other turbulent fluxes
+! * at the top, the turbulent fluxes are set to 0.
+! It should be noted that the condensation has been implicitely included
+! in this turbulence scheme by using conservative variables and computing
+! the subgrid variance of a statistical variable s indicating the presence
+! or not of condensation in a given mesh.
+!
+!!** METHOD
+!! ------
+!! 1D type calculations are made;
+!! The vertical turbulent fluxes are computed in an off-centered
+!! implicit scheme (a Crank-Nicholson type with coefficients different
+!! than 0.5), which allows to vary the degree of implicitness of the
+!! formulation.
+!! The different prognostic variables are treated one by one.
+!! The contributions of each turbulent fluxes are cumulated into the
+!! tendency PRvarS, and into the dynamic and thermal production of
+!! TKE if necessary.
+!!
+!! In section 2 and 3, the thermodynamical fields are considered.
+!! Only the turbulent fluxes of the conservative variables
+!! (Thetal and Rnp stored in PRx(:,:,:,1)) are computed.
+!! Note that the turbulent fluxes at the vertical
+!! boundaries are given either by the soil scheme for the surface one
+!! ( at the same instant as the others fluxes) and equal to 0 at the
+!! top of the model. The thermal production is computed by vertically
+!! averaging the turbulent flux and multiply this flux at the mass point by
+!! a function ETHETA or EMOIST, which preform the transformation from the
+!! conservative variables to the virtual potential temperature.
+!!
+!! In section 4, the variance of the statistical variable
+!! s indicating presence or not of condensation, is determined in function
+!! of the turbulent moments of the conservative variables and its
+!! squarred root is stored in PSIGS. This information will be completed in
+!! the horizontal turbulence if the turbulence dimensionality is not
+!! equal to "1DIM".
+!!
+!! In section 5, the x component of the stress tensor is computed.
+!! The surface flux <u'w'> is computed from the value of the surface
+!! fluxes computed in axes linked to the orography ( i", j" , k"):
+!! i" is parallel to the surface and in the direction of the maximum
+!! slope
+!! j" is also parallel to the surface and in the normal direction of
+!! the maximum slope
+!! k" is the normal to the surface
+!! In order to prevent numerical instability, the implicit scheme has
+!! been extended to the surface flux regarding to its dependence in
+!! function of U. The dependence in function of the other components
+!! introduced by the different rotations is only explicit.
+!! The turbulent fluxes are used to compute the dynamic production of
+!! TKE. For the last TKE level ( located at PDZZ(:,:,IKB)/2 from the
+!! ground), an harmonic extrapolation from the dynamic production at
+!! PDZZ(:,:,IKB) is used to avoid an evaluation of the gradient of U
+!! in the surface layer.
+!!
+!! In section 6, the same steps are repeated but for the y direction
+!! and in section 7, a diagnostic computation of the W variance is
+!! performed.
+!!
+!! In section 8, the turbulent fluxes for the scalar variables are
+!! computed by the same way as the conservative thermodynamical variables
+!!
+!!
+!! EXTERNAL
+!! --------
+!! GX_U_M, GY_V_M, GZ_W_M : cartesian gradient operators
+!! GX_U_UW,GY_V_VW (X,Y,Z) represent the direction of the gradient
+!! _(M,U,...)_ represent the localization of the
+!! field to be derivated
+!! _(M,UW,...) represent the localization of the
+!! field derivated
+!!
+!!
+!! MXM,MXF,MYM,MYF,MZM,MZF
+!! : Shuman functions (mean operators)
+!! DXF,DYF,DZF,DZM
+!! : Shuman functions (difference operators)
+!!
+!! SUBROUTINE TRIDIAG : to compute the split implicit evolution
+!! of a variable located at a mass point
+!!
+!! SUBROUTINE TRIDIAG_WIND: to compute the split implicit evolution
+!! of a variable located at a wind point
+!!
+!! FUNCTIONs ETHETA and EMOIST :
+!! allows to compute:
+!! - the coefficients for the turbulent correlation between
+!! any variable and the virtual potential temperature, of its
+!! correlations with the conservative potential temperature and
+!! the humidity conservative variable:
+!! ------- ------- -------
+!! A' Thv' = ETHETA A' Thl' + EMOIST A' Rnp'
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST : contains physical constants
+!!
+!! XG : gravity constant
+!!
+!! Module MODD_CTURB: contains the set of constants for
+!! the turbulence scheme
+!!
+!! XCMFS,XCMFB : cts for the momentum flux
+!! XCSHF : ct for the sensible heat flux
+!! XCHF : ct for the moisture flux
+!! XCTV,XCHV : cts for the T and moisture variances
+!!
+!! Module MODD_PARAMETERS
+!!
+!! JPVEXT_TURB : number of vertical external points
+!! JPHEXT : number of horizontal external points
+!!
+!!
+!! REFERENCE
+!! ---------
+!! Book 1 of documentation (Chapter: Turbulence)
+!!
+!! AUTHOR
+!! ------
+!! Joan Cuxart * INM and Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original August 19, 1994
+!! Modifications: February 14, 1995 (J.Cuxart and J.Stein)
+!! Doctorization and Optimization
+!! Modifications: March 21, 1995 (J.M. Carriere)
+!! Introduction of cloud water
+!! Modifications: June 14, 1995 (J.Cuxart and J. Stein)
+!! Phi3 and Psi3 at w-point + bug in the all
+!! or nothing condens.
+!! Modifications: Sept 15, 1995 (J.Cuxart and J. Stein)
+!! Change the DP computation at the ground
+!! Modifications: October 10, 1995 (J.Cuxart and J. Stein)
+!! Psi for scal var and LES tools
+!! Modifications: November 10, 1995 (J. Stein)
+!! change the surface relations
+!! Modifications: February 20, 1995 (J. Stein) optimization
+!! Modifications: May 21, 1996 (J. Stein)
+!! bug in the vertical flux of the V wind
+!! component for explicit computation
+!! Modifications: May 21, 1996 (N. wood)
+!! modify the computation of the vertical
+!! part or the surface tangential flux
+!! Modifications: May 21, 1996 (P. Jabouille)
+!! same modification in the Y direction
+!!
+!! Modifications: Sept 17, 1996 (J. Stein) change the moist case by using
+!! Pi instead of Piref + use Atheta and Amoist
+!!
+!! Modifications: Nov 24, 1997 (V. Masson) removes the DO loops
+!! Modifications: Mar 31, 1998 (V. Masson) splits the routine TURB_VER_SV_FLUX
+!! Modifications: Dec 01, 2000 (V. Masson) conservation of scalar emission
+!! from surface in 1DIM case
+!! when slopes are present
+!! Jun 20, 2001 (J Stein) case of lagragian variables
+!! Nov 06, 2002 (V. Masson) LES budgets
+!! October 2009 (G. Tanguy) add ILENCH=LEN(YCOMMENT) after
+!! change of YCOMMENT
+!! Feb 2012(Y. Seity) add possibility to run with reversed
+!! vertical levels
+!! Feb 2017(M. Leriche) add initialisation of ZSOURCE
+!! to avoid unknwon values outside physical domain
+!! and avoid negative values in sv tendencies
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!!--------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_CTURB
+use modd_field, only: tfielddata, TYPEREAL
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_PARAMETERS
+USE MODD_LES
+USE MODD_CONF
+USE MODD_NSV, ONLY: XSVMIN, NSV_LGBEG, NSV_LGEND
+USE MODD_BLOWSNOW
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+!
+USE MODI_GRADIENT_U
+USE MODI_GRADIENT_V
+USE MODI_GRADIENT_W
+USE MODI_GRADIENT_M
+USE MODI_SHUMAN
+USE MODI_TRIDIAG
+USE MODI_TRIDIAG_WIND
+USE MODI_EMOIST
+USE MODI_ETHETA
+USE MODI_LES_MEAN_SUBGRID
+!
+USE MODI_SECOND_MNH
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+!
+INTEGER, INTENT(IN) :: KKA !near ground array index
+INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
+LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
+ ! turbulent fluxes in the syncronous FM-file
+CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
+ ! turbulence scheme
+REAL, INTENT(IN) :: PIMPL, PEXPL ! Coef. for temporal disc.
+REAL, INTENT(IN) :: PTSTEP ! Double Time Step
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ
+ ! Metric coefficients
+REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW ! Director Cosinus of the
+ ! normal to the ground surface
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry density * grid volum
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSFSVM ! t - deltat
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSFSVP ! t + deltat
+!
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-Delta t
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PWM ! vertical wind
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PPSI_SV ! Inv.Turb.Sch.for scalars
+!
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS
+ ! cumulated sources for the prognostic variables
+REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PWSV ! scalar flux
+!
+!
+!
+!
+!* 0.2 declaration of local variables
+!
+!
+REAL, DIMENSION(SIZE(PSVM,1),SIZE(PSVM,2),SIZE(PSVM,3)) :: &
+ ZA, & ! under diagonal elements of the tri-diagonal matrix involved
+ ! in the temporal implicit scheme (also used to store coefficient
+ ! J in Section 5)
+ ZRES, & ! guess of the treated variable at t+ deltat when the turbu-
+ ! lence is the only source of evolution added to the ones
+ ! considered in ZSOURCE
+ ZFLXZ, & ! vertical flux of the treated variable
+ ZSOURCE, & ! source of evolution for the treated variable
+ ZKEFF ! effectif diffusion coeff = LT * SQRT( TKE )
+INTEGER :: IKB,IKE ! I index values for the Beginning and End
+ ! mass points of the domain in the 3 direct.
+INTEGER :: IKT ! array size in k direction
+INTEGER :: IKTB,IKTE ! start, end of k loops in physical domain
+INTEGER :: JSV ! loop counters
+INTEGER :: JK ! loop
+INTEGER :: ISV ! number of scalar var.
+!
+REAL :: ZTIME1, ZTIME2
+
+REAL :: ZCSVP = 4.0 ! constant for scalar flux presso-correlation (RS81)
+REAL :: ZCSV !constant for the scalar flux
+!
+TYPE(TFIELDDATA) :: TZFIELD
+!----------------------------------------------------------------------------
+!
+!* 1. PRELIMINARIES
+! -------------
+!
+IKB=KKA+JPVEXT_TURB*KKL
+IKE=KKU-JPVEXT_TURB*KKL
+IKT=SIZE(PSVM,3)
+IKTE =IKT-JPVEXT_TURB
+IKTB =1+JPVEXT_TURB
+!
+ISV=SIZE(PSVM,4)
+!
+ZKEFF(:,:,:) = MZM( PLM(:,:,:) * SQRT(PTKEM(:,:,:)) )
+!
+IF(LBLOWSNOW) THEN
+! See Vionnet (PhD, 2012) for a complete discussion around the value of the Schmidt number for blowing snow variables
+ ZCSV= XCHF/XRSNOW
+ELSE
+ ZCSV= XCHF
+ENDIF
+!----------------------------------------------------------------------------
+!
+!* 8. SOURCES OF PASSIVE SCALAR VARIABLES
+! -----------------------------------
+!
+DO JSV=1,ISV
+!
+ IF (LNOMIXLG .AND. JSV >= NSV_LGBEG .AND. JSV<= NSV_LGEND) CYCLE
+!
+! Preparation of the arguments for TRIDIAG
+ ZA(:,:,:) = -PTSTEP*ZCSV*PPSI_SV(:,:,:,JSV) * &
+ ZKEFF * MZM(PRHODJ) / &
+ PDZZ**2
+ ZSOURCE(:,:,:) = 0.
+!
+! Compute the sources for the JSVth scalar variable
+
+!* in 3DIM case, a part of the flux goes vertically, and another goes horizontally
+! (in presence of slopes)
+!* in 1DIM case, the part of energy released in horizontal flux
+! is taken into account in the vertical part
+ IF (HTURBDIM=='3DIM') THEN
+ ZSOURCE(:,:,IKB) = (PIMPL*PSFSVP(:,:,JSV) + PEXPL*PSFSVM(:,:,JSV)) / &
+ PDZZ(:,:,IKB) * PDIRCOSZW(:,:) &
+ * 0.5 * (1. + PRHODJ(:,:,KKA) / PRHODJ(:,:,IKB))
+ ELSE
+
+ ZSOURCE(:,:,IKB) = (PIMPL*PSFSVP(:,:,JSV) + PEXPL*PSFSVM(:,:,JSV)) / &
+ PDZZ(:,:,IKB) / PDIRCOSZW(:,:) &
+ * 0.5 * (1. + PRHODJ(:,:,KKA) / PRHODJ(:,:,IKB))
+ END IF
+ ZSOURCE(:,:,IKTB+1:IKTE-1) = 0.
+ ZSOURCE(:,:,IKE) = 0.
+!
+! Obtention of the split JSV scalar variable at t+ deltat
+ CALL TRIDIAG(KKA,KKU,KKL,PSVM(:,:,:,JSV),ZA,PTSTEP,PEXPL,PIMPL,PRHODJ,ZSOURCE,ZRES)
+!
+! Compute the equivalent tendency for the JSV scalar variable
+ PRSVS(:,:,:,JSV)= PRSVS(:,:,:,JSV)+ &
+ PRHODJ(:,:,:)*(ZRES(:,:,:)-PSVM(:,:,:,JSV))/PTSTEP
+! PRSVS(:,:,:,JSV)= MAX((PRSVS(:,:,:,JSV)+ &
+! PRHODJ(:,:,:)*(ZRES(:,:,:)-PSVM(:,:,:,JSV))/PTSTEP),XSVMIN(JSV))
+!
+ IF ( (OTURB_FLX .AND. tpfile%lopened) .OR. LLES_CALL ) THEN
+ ! Diagnostic of the cartesian vertical flux
+ !
+ ZFLXZ(:,:,:) = -ZCSV * PPSI_SV(:,:,:,JSV) * MZM(PLM*SQRT(PTKEM)) / PDZZ * &
+ DZM( PIMPL*ZRES(:,:,:) + PEXPL*PSVM(:,:,:,JSV) )
+ ! surface flux
+ !* in 3DIM case, a part of the flux goes vertically, and another goes horizontally
+ ! (in presence of slopes)
+ !* in 1DIM case, the part of energy released in horizontal flux
+ ! is taken into account in the vertical part
+ IF (HTURBDIM=='3DIM') THEN
+ ZFLXZ(:,:,IKB) = (PIMPL*PSFSVP(:,:,JSV) + PEXPL*PSFSVM(:,:,JSV)) &
+ * PDIRCOSZW(:,:)
+ ELSE
+ ZFLXZ(:,:,IKB) = (PIMPL*PSFSVP(:,:,JSV) + PEXPL*PSFSVM(:,:,JSV)) &
+ / PDIRCOSZW(:,:)
+ END IF
+ ! extrapolates the flux under the ground so that the vertical average with
+ ! the IKB flux gives the ground value
+ ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
+ DO JK=IKTB+1,IKTE-1
+ PWSV(:,:,JK,JSV)=0.5*(ZFLXZ(:,:,JK)+ZFLXZ(:,:,JK+KKL))
+ END DO
+ PWSV(:,:,IKB,JSV)=0.5*(ZFLXZ(:,:,IKB)+ZFLXZ(:,:,IKB+KKL))
+ PWSV(:,:,IKE,JSV)=PWSV(:,:,IKE-KKL,JSV)
+ END IF
+ !
+ IF (OTURB_FLX .AND. tpfile%lopened) THEN
+ ! stores the JSVth vertical flux
+ WRITE(TZFIELD%CMNHNAME,'("WSV_FLX_",I3.3)') JSV
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ !PW: TODO: use the correct units of the JSV variable (and multiply it by m s-1)
+ TZFIELD%CUNITS = 'SVUNIT m s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ !
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZ)
+ END IF
+ !
+ ! Storage in the LES configuration
+ !
+ IF (LLES_CALL) THEN
+ CALL SECOND_MNH(ZTIME1)
+ CALL LES_MEAN_SUBGRID( MZF(ZFLXZ), X_LES_SUBGRID_WSv(:,:,:,JSV) )
+ CALL LES_MEAN_SUBGRID( GZ_W_M(PWM,PDZZ)*MZF(ZFLXZ), &
+ X_LES_RES_ddxa_W_SBG_UaSv(:,:,:,JSV) )
+ CALL LES_MEAN_SUBGRID( MZF(GZ_M_W(KKA,KKU,KKL,PSVM(:,:,:,JSV),PDZZ)*ZFLXZ), &
+ X_LES_RES_ddxa_Sv_SBG_UaSv(:,:,:,JSV) )
+ CALL LES_MEAN_SUBGRID( -ZCSVP*SQRT(PTKEM)/PLM*MZF(ZFLXZ), X_LES_SUBGRID_SvPz(:,:,:,JSV) )
+ CALL LES_MEAN_SUBGRID( MZF(PWM*ZFLXZ), X_LES_RES_W_SBG_WSv(:,:,:,JSV) )
+ CALL SECOND_MNH(ZTIME2)
+ XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ END IF
+ !
+END DO ! end of scalar loop
+!
+!----------------------------------------------------------------------------
+!
+END SUBROUTINE TURB_VER_SV_FLUX
diff --git a/src/mesonh/turb/turb_ver_thermo_corr.f90 b/src/mesonh/turb/turb_ver_thermo_corr.f90
new file mode 100644
index 000000000..bdd074e5c
--- /dev/null
+++ b/src/mesonh/turb/turb_ver_thermo_corr.f90
@@ -0,0 +1,848 @@
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ####################
+ MODULE MODI_TURB_VER_THERMO_CORR
+! ####################
+!
+INTERFACE
+!
+ SUBROUTINE TURB_VER_THERMO_CORR(KKA,KKU,KKL,KRR,KRRL,KRRI, &
+ OTURB_FLX,HTURBDIM,HTOM, &
+ PIMPL,PEXPL, &
+ TPFILE, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW, &
+ PRHODJ,PTHVREF, &
+ PSFTHM,PSFRM,PSFTHP,PSFRP, &
+ PWM,PTHLM,PRM,PSVM, &
+ PTKEM,PLM,PLEPS, &
+ PLOCPEXNM,PATHETA,PAMOIST,PSRCM, &
+ PBETA, PSQRT_TKE, PDTH_DZ, PDR_DZ, PRED2TH3, &
+ PRED2R3, PRED2THR3, PBLL_O_E, PETHETA, &
+ PEMOIST, PREDTH1, PREDR1, PPHI3, PPSI3, PD, &
+ PFWTH,PFWR,PFTH2,PFR2,PFTHR, &
+ PTHLP,PRP,PSIGS )
+!
+USE MODD_IO, ONLY: TFILEDATA
+!
+INTEGER, INTENT(IN) :: KKA !near ground array index
+INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=AR
+INTEGER, INTENT(IN) :: KRR ! number of moist var.
+INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
+INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
+LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
+ ! turbulent fluxes in the syncronous FM-file
+CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
+ ! turbulence scheme
+CHARACTER(len=4), INTENT(IN) :: HTOM ! type of Third Order Moment
+REAL, INTENT(IN) :: PIMPL, PEXPL ! Coef. for temporal disc.
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ, PDXX, PDYY, PDZX, PDZY
+ ! Metric coefficients
+REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW ! Director Cosinus of the
+ ! normal to the ground surface
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry density * grid volum
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! ref. state Virtual
+ ! Potential Temperature
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHM,PSFRM ! surface fluxes at time
+! ! t - deltat
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHP,PSFRP ! surface fluxes at time
+! ! t + deltat
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PWM
+! Vertical wind
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM
+! potential temperature at t-Delta t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios
+ ! at t-Delta t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! Mixing ratios
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! dissipative length
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exnref at time t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! coefficients between
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM ! normalized
+ ! 2nd-order flux s'r'c/2Sigma_s2 at t-1 multiplied by Lambda_3
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PBETA ! buoyancy coefficient
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE ! sqrt(e)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTH_DZ ! d(th)/dz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDR_DZ ! d(rt)/dz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2TH3 ! 3D Redeslperger number R*2_th
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2R3 ! 3D Redeslperger number R*2_r
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2THR3 ! 3D Redeslperger number R*2_thr
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E ! beta * Lk * Leps / tke
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA ! Coefficient for theta in theta_v computation
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST ! Coefficient for r in theta_v computation
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1 ! 1D Redelsperger number for Th
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1 ! 1D Redelsperger number for r
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPHI3 ! Prandtl number for temperature
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPSI3 ! Prandtl number for vapor
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PD ! Denominator in Prandtl numbers
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFWTH ! d(w'2th' )/dz (at flux point)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFWR ! d(w'2r' )/dz (at flux point)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFTH2 ! d(w'th'2 )/dz (at mass point)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFR2 ! d(w'r'2 )/dz (at mass point)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFTHR ! d(w'th'r')/dz (at mass point)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLP ! guess of thl at t+ deltat
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRP ! guess of r at t+ deltat
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSIGS ! Vert. part of Sigma_s at t
+!
+!
+!
+END SUBROUTINE TURB_VER_THERMO_CORR
+!
+END INTERFACE
+!
+END MODULE MODI_TURB_VER_THERMO_CORR
+!
+!
+! ###############################################################
+ SUBROUTINE TURB_VER_THERMO_CORR(KKA,KKU,KKL,KRR, KRRL, KRRI, &
+ OTURB_FLX,HTURBDIM,HTOM, &
+ PIMPL,PEXPL, &
+ TPFILE, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW, &
+ PRHODJ,PTHVREF, &
+ PSFTHM,PSFRM,PSFTHP,PSFRP, &
+ PWM,PTHLM,PRM,PSVM, &
+ PTKEM,PLM,PLEPS, &
+ PLOCPEXNM,PATHETA,PAMOIST,PSRCM, &
+ PBETA, PSQRT_TKE, PDTH_DZ, PDR_DZ, PRED2TH3, &
+ PRED2R3, PRED2THR3, PBLL_O_E, PETHETA, &
+ PEMOIST, PREDTH1, PREDR1, PPHI3, PPSI3, PD, &
+ PFWTH,PFWR,PFTH2,PFR2,PFTHR, &
+ PTHLP,PRP,PSIGS )
+! ###############################################################
+!
+!
+!!**** *TURB_VER_THERMO_FLUX* -compute the source terms due to the vertical turbulent
+!! fluxes.
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to compute the vertical turbulent
+! fluxes of the evolutive variables and give back the source
+! terms to the main program. In the case of large horizontal meshes,
+! the divergence of these vertical turbulent fluxes represent the whole
+! effect of the turbulence but when the three-dimensionnal version of
+! the turbulence scheme is activated (CTURBDIM="3DIM"), these divergences
+! are completed in the next routine TURB_HOR.
+! An arbitrary degree of implicitness has been implemented for the
+! temporal treatment of these diffusion terms.
+! The vertical boundary conditions are as follows:
+! * at the bottom, the surface fluxes are prescribed at the same
+! as the other turbulent fluxes
+! * at the top, the turbulent fluxes are set to 0.
+! It should be noted that the condensation has been implicitely included
+! in this turbulence scheme by using conservative variables and computing
+! the subgrid variance of a statistical variable s indicating the presence
+! or not of condensation in a given mesh.
+!
+!!** METHOD
+!! ------
+!! 1D type calculations are made;
+!! The vertical turbulent fluxes are computed in an off-centered
+!! implicit scheme (a Crank-Nicholson type with coefficients different
+!! than 0.5), which allows to vary the degree of implicitness of the
+!! formulation.
+!! The different prognostic variables are treated one by one.
+!! The contributions of each turbulent fluxes are cumulated into the
+!! tendency PRvarS, and into the dynamic and thermal production of
+!! TKE if necessary.
+!!
+!! In section 2 and 3, the thermodynamical fields are considered.
+!! Only the turbulent fluxes of the conservative variables
+!! (Thetal and Rnp stored in PRx(:,:,:,1)) are computed.
+!! Note that the turbulent fluxes at the vertical
+!! boundaries are given either by the soil scheme for the surface one
+!! ( at the same instant as the others fluxes) and equal to 0 at the
+!! top of the model. The thermal production is computed by vertically
+!! averaging the turbulent flux and multiply this flux at the mass point by
+!! a function ETHETA or EMOIST, which preform the transformation from the
+!! conservative variables to the virtual potential temperature.
+!!
+!! In section 4, the variance of the statistical variable
+!! s indicating presence or not of condensation, is determined in function
+!! of the turbulent moments of the conservative variables and its
+!! squarred root is stored in PSIGS. This information will be completed in
+!! the horizontal turbulence if the turbulence dimensionality is not
+!! equal to "1DIM".
+!!
+!! In section 5, the x component of the stress tensor is computed.
+!! The surface flux <u'w'> is computed from the value of the surface
+!! fluxes computed in axes linked to the orography ( i", j" , k"):
+!! i" is parallel to the surface and in the direction of the maximum
+!! slope
+!! j" is also parallel to the surface and in the normal direction of
+!! the maximum slope
+!! k" is the normal to the surface
+!! In order to prevent numerical instability, the implicit scheme has
+!! been extended to the surface flux regarding to its dependence in
+!! function of U. The dependence in function of the other components
+!! introduced by the different rotations is only explicit.
+!! The turbulent fluxes are used to compute the dynamic production of
+!! TKE. For the last TKE level ( located at PDZZ(:,:,IKB)/2 from the
+!! ground), an harmonic extrapolation from the dynamic production at
+!! PDZZ(:,:,IKB) is used to avoid an evaluation of the gradient of U
+!! in the surface layer.
+!!
+!! In section 6, the same steps are repeated but for the y direction
+!! and in section 7, a diagnostic computation of the W variance is
+!! performed.
+!!
+!! In section 8, the turbulent fluxes for the scalar variables are
+!! computed by the same way as the conservative thermodynamical variables
+!!
+!!
+!! EXTERNAL
+!! --------
+!! GX_U_M, GY_V_M, GZ_W_M : cartesian gradient operators
+!! GX_U_UW,GY_V_VW (X,Y,Z) represent the direction of the gradient
+!! _(M,U,...)_ represent the localization of the
+!! field to be derivated
+!! _(M,UW,...) represent the localization of the
+!! field derivated
+!!
+!!
+!! MXM,MXF,MYM,MYF,MZM,MZF
+!! : Shuman functions (mean operators)
+!! DXF,DYF,DZF,DZM
+!! : Shuman functions (difference operators)
+!!
+!! SUBROUTINE TRIDIAG : to compute the split implicit evolution
+!! of a variable located at a mass point
+!!
+!! SUBROUTINE TRIDIAG_WIND: to compute the split implicit evolution
+!! of a variable located at a wind point
+!!
+!! FUNCTIONs ETHETA and EMOIST :
+!! allows to compute:
+!! - the coefficients for the turbulent correlation between
+!! any variable and the virtual potential temperature, of its
+!! correlations with the conservative potential temperature and
+!! the humidity conservative variable:
+!! ------- ------- -------
+!! A' Thv' = ETHETA A' Thl' + EMOIST A' Rnp'
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST : contains physical constants
+!!
+!! XG : gravity constant
+!!
+!! Module MODD_CTURB: contains the set of constants for
+!! the turbulence scheme
+!!
+!! XCMFS,XCMFB : cts for the momentum flux
+!! XCSHF : ct for the sensible heat flux
+!! XCHF : ct for the moisture flux
+!! XCTV,XCHV : cts for the T and moisture variances
+!!
+!! Module MODD_PARAMETERS
+!!
+!! JPVEXT_TURB : number of vertical external points
+!! JPHEXT : number of horizontal external points
+!!
+!!
+!! REFERENCE
+!! ---------
+!! Book 1 of documentation (Chapter: Turbulence)
+!!
+!! AUTHOR
+!! ------
+!! Joan Cuxart * INM and Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original August 19, 1994
+!! Modifications: February 14, 1995 (J.Cuxart and J.Stein)
+!! Doctorization and Optimization
+!! Modifications: March 21, 1995 (J.M. Carriere)
+!! Introduction of cloud water
+!! Modifications: June 14, 1995 (J.Cuxart and J. Stein)
+!! Phi3 and Psi3 at w-point + bug in the all
+!! or nothing condens.
+!! Modifications: Sept 15, 1995 (J.Cuxart and J. Stein)
+!! Change the DP computation at the ground
+!! Modifications: October 10, 1995 (J.Cuxart and J. Stein)
+!! Psi for scal var and LES tools
+!! Modifications: November 10, 1995 (J. Stein)
+!! change the surface relations
+!! Modifications: February 20, 1995 (J. Stein) optimization
+!! Modifications: May 21, 1996 (J. Stein)
+!! bug in the vertical flux of the V wind
+!! component for explicit computation
+!! Modifications: May 21, 1996 (N. wood)
+!! modify the computation of the vertical
+!! part or the surface tangential flux
+!! Modifications: May 21, 1996 (P. Jabouille)
+!! same modification in the Y direction
+!!
+!! Modifications: Sept 17, 1996 (J. Stein) change the moist case by using
+!! Pi instead of Piref + use Atheta and Amoist
+!!
+!! Modifications: Nov 24, 1997 (V. Masson) removes the DO loops
+!! Modifications: Mar 31, 1998 (V. Masson) splits the routine TURB_VER_THERMO_FLUX
+!! Modifications: Oct 18, 2000 (V. Masson) LES computations
+!! Modifications: Dec 01, 2000 (V. Masson) conservation of energy from
+!! surface flux in 1DIM case
+!! when slopes are present
+!! Nov 06, 2002 (V. Masson) LES budgets
+!! October 2009 (G. Tanguy) add ILENCH=LEN(YCOMMENT) after
+!! change of YCOMMENT
+!! 2012-02 (Y. Seity) add possibility to run with reversed
+!! vertical levels
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!!--------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_CTURB
+use modd_field, only: tfielddata, TYPEREAL
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_PARAMETERS
+USE MODD_CONF
+USE MODD_LES
+!
+USE MODI_GRADIENT_U
+USE MODI_GRADIENT_V
+USE MODI_GRADIENT_W
+USE MODI_GRADIENT_M
+USE MODI_SHUMAN
+USE MODI_TRIDIAG
+USE MODI_LES_MEAN_SUBGRID
+USE MODI_PRANDTL
+USE MODI_TRIDIAG_THERMO
+!
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+USE MODE_PRANDTL
+!
+USE MODI_SECOND_MNH
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+!
+!
+INTEGER, INTENT(IN) :: KKA !near ground array index
+INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
+INTEGER, INTENT(IN) :: KRR ! number of moist var.
+INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
+INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
+LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
+ ! turbulent fluxes in the syncronous FM-file
+CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
+ ! turbulence scheme
+CHARACTER(len=4), INTENT(IN) :: HTOM ! type of Third Order Moment
+REAL, INTENT(IN) :: PIMPL, PEXPL ! Coef. for temporal disc.
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ, PDXX, PDYY, PDZX, PDZY
+ ! Metric coefficients
+REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW ! Director Cosinus of the
+ ! normal to the ground surface
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry density * grid volum
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! ref. state Virtual
+ ! Potential Temperature
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHM,PSFRM ! surface fluxes at time
+! ! t - deltat
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHP,PSFRP ! surface fluxes at time
+! ! t + deltat
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PWM
+! Vertical wind
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM
+! potential temperature at t-Delta t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios
+ ! at t-Delta t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! Mixing ratios
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! dissipative length
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exnref at time t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! coefficients between
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM ! normalized
+! 2nd-order flux s'r'c/2Sigma_s2 at t-1 multiplied by Lambda_3
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PBETA ! buoyancy coefficient
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE ! sqrt(e)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTH_DZ ! d(th)/dz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDR_DZ ! d(rt)/dz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2TH3 ! 3D Redeslperger number R*2_th
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2R3 ! 3D Redeslperger number R*2_r
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2THR3 ! 3D Redeslperger number R*2_thr
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E ! beta * Lk * Leps / tke
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA ! Coefficient for theta in theta_v computation
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST ! Coefficient for r in theta_v computation
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1 ! 1D Redelsperger number for Th
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1 ! 1D Redelsperger number for r
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPHI3 ! Prandtl number for temperature
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPSI3 ! Prandtl number for vapor
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PD ! Denominator in Prandtl numbers
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFWTH ! d(w'2th' )/dz (at flux point)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFWR ! d(w'2r' )/dz (at flux point)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFTH2 ! d(w'th'2 )/dz (at mass point)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFR2 ! d(w'r'2 )/dz (at mass point)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFTHR ! d(w'th'r')/dz (at mass point)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLP ! guess of thl at t+ deltat
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRP ! guess of r at t+ deltat
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSIGS ! Vert. part of Sigma_s at t
+!
+!
+!
+!* 0.2 declaration of local variables
+!
+!
+REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: &
+ ZA, & ! work variable for wrc
+ ZFLXZ, & ! vertical flux of the treated variable
+ ZSOURCE, & ! source of evolution for the treated variable
+ ZKEFF, & ! effectif diffusion coeff = LT * SQRT( TKE )
+ ZF, & ! Flux in dTh/dt =-dF/dz (evaluated at t-1)(or rt instead of Th)
+ ZDFDDTDZ, & ! dF/d(dTh/dz)
+ ZDFDDRDZ, & ! dF/d(dr/dz)
+ Z3RDMOMENT ! 3 order term in flux or variance equation
+INTEGER :: IKB,IKE ! I index values for the Beginning and End
+ ! mass points of the domain in the 3 direct.
+INTEGER :: I1,I2 ! For ZCOEFF allocation
+REAL, DIMENSION(:,:,:),ALLOCATABLE :: ZCOEFF
+ ! coefficients for the uncentred gradient
+ ! computation near the ground
+!
+REAL :: ZTIME1, ZTIME2
+!
+LOGICAL :: GUSERV ! flag to use water
+LOGICAL :: GFTH2 ! flag to use w'th'2
+LOGICAL :: GFWTH ! flag to use w'2th'
+LOGICAL :: GFR2 ! flag to use w'r'2
+LOGICAL :: GFWR ! flag to use w'2r'
+LOGICAL :: GFTHR ! flag to use w'th'r'
+TYPE(TFIELDDATA) :: TZFIELD
+!----------------------------------------------------------------------------
+!
+!* 1. PRELIMINARIES
+! -------------
+!
+IKB=KKA+JPVEXT_TURB*KKL
+IKE=KKU-JPVEXT_TURB*KKL
+I1=MIN(KKA+JPVEXT_TURB*KKL,KKA+JPVEXT_TURB*KKL+2*KKL)
+I2=MAX(KKA+JPVEXT_TURB*KKL,KKA+JPVEXT_TURB*KKL+2*KKL)
+
+ALLOCATE(ZCOEFF(SIZE(PDZZ,1),SIZE(PDZZ,2),I1:I2))
+!
+GUSERV = (KRR/=0)
+!
+! compute the coefficients for the uncentred gradient computation near the
+! ground
+ZCOEFF(:,:,IKB+2*KKL)= - PDZZ(:,:,IKB+KKL) / &
+ ( (PDZZ(:,:,IKB+2*KKL)+PDZZ(:,:,IKB+KKL)) * PDZZ(:,:,IKB+2*KKL) )
+ZCOEFF(:,:,IKB+KKL)= (PDZZ(:,:,IKB+2*KKL)+PDZZ(:,:,IKB+KKL)) / &
+ ( PDZZ(:,:,IKB+KKL) * PDZZ(:,:,IKB+2*KKL) )
+ZCOEFF(:,:,IKB)= - (PDZZ(:,:,IKB+2*KKL)+2.*PDZZ(:,:,IKB+KKL)) / &
+ ( (PDZZ(:,:,IKB+2*KKL)+PDZZ(:,:,IKB+KKL)) * PDZZ(:,:,IKB+KKL) )
+!
+ZKEFF(:,:,:) = MZM( PLM(:,:,:) * SQRT(PTKEM(:,:,:)) )
+!
+! Flags for 3rd order quantities
+!
+GFTH2 = .FALSE.
+GFR2 = .FALSE.
+GFTHR = .FALSE.
+GFWTH = .FALSE.
+GFWR = .FALSE.
+!
+IF (HTOM/='NONE') THEN
+ GFTH2 = ANY(PFTH2/=0.)
+ GFR2 = ANY(PFR2 /=0.) .AND. GUSERV
+ GFTHR = ANY(PFTHR/=0.) .AND. GUSERV
+ GFWTH = ANY(PFWTH/=0.)
+ GFWR = ANY(PFWR /=0.) .AND. GUSERV
+END IF
+!----------------------------------------------------------------------------
+!
+!
+!* 4. TURBULENT CORRELATIONS : <THl THl>, <THl Rnp>, <Rnp Rnp>
+! --------------------------------------------------------
+!
+!
+!* 4.2 <THl THl>
+!
+! Compute the turbulent variance F and F' at time t-dt.
+ ZF (:,:,:) = XCTV*PLM*PLEPS*MZF(PPHI3*PDTH_DZ**2)
+ ZDFDDTDZ(:,:,:) = 0. ! this term, because of discretization, is treated separately
+ !
+ ! Effect of 3rd order terms in temperature flux (at mass point)
+ !
+ ! d(w'th'2)/dz
+ IF (GFTH2) THEN
+ ZF = ZF + M3_TH2_WTH2(PREDTH1,PREDR1,PD,PLEPS,&
+ & PSQRT_TKE) * PFTH2
+ ZDFDDTDZ = ZDFDDTDZ + D_M3_TH2_WTH2_O_DDTDZ(PREDTH1,PREDR1,&
+ & PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA) * PFTH2
+ END IF
+ !
+ ! d(w'2th')/dz
+ IF (GFWTH) THEN
+ ZF = ZF + M3_TH2_W2TH(PREDTH1,PREDR1,PD,PDTH_DZ,&
+ & PLM,PLEPS,PTKEM) * MZF(PFWTH)
+ ZDFDDTDZ = ZDFDDTDZ + D_M3_TH2_W2TH_O_DDTDZ(PREDTH1,PREDR1,PD,&
+ & PLM,PLEPS,PTKEM,GUSERV) * MZF(PFWTH)
+ END IF
+ !
+ IF (KRR/=0) THEN
+ ! d(w'r'2)/dz
+ IF (GFR2) THEN
+ ZF = ZF + M3_TH2_WR2(PD,PLEPS,PSQRT_TKE,PBLL_O_E,&
+ & PEMOIST,PDTH_DZ) * PFR2
+ ZDFDDTDZ = ZDFDDTDZ + D_M3_TH2_WR2_O_DDTDZ(PREDTH1,PREDR1,PD,&
+ & PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTH_DZ) * PFR2
+ END IF
+ !
+ ! d(w'2r')/dz
+ IF (GFWR) THEN
+ ZF = ZF + M3_TH2_W2R(PD,PLM,PLEPS,PTKEM,PBLL_O_E,&
+ & PEMOIST,PDTH_DZ) * MZF(PFWR)
+ ZDFDDTDZ = ZDFDDTDZ + D_M3_TH2_W2R_O_DDTDZ(PREDTH1,PREDR1,PD,&
+ & PLM,PLEPS,PTKEM,PBLL_O_E,PEMOIST,PDTH_DZ) * MZF(PFWR)
+ END IF
+ !
+ ! d(w'th'r')/dz
+ IF (GFTHR) THEN
+ ZF = ZF + M3_TH2_WTHR(PREDR1,PD,PLEPS,PSQRT_TKE,&
+ & PBLL_O_E,PEMOIST,PDTH_DZ) * PFTHR
+ ZDFDDTDZ = ZDFDDTDZ + D_M3_TH2_WTHR_O_DDTDZ(PREDTH1,PREDR1,&
+ & PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTH_DZ) * PFTHR
+ END IF
+
+ END IF
+ !
+ ZFLXZ(:,:,:) = ZF &
+ ! + PIMPL * XCTV*PLM*PLEPS &
+ ! *MZF(D_PHI3DTDZ2_O_DDTDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,PDTH_DZ,HTURBDIM,GUSERV) &
+ ! *DZM(PTHLP - PTHLM) / PDZZ ) &
+ + PIMPL * ZDFDDTDZ * MZF(DZM(PTHLP - PTHLM) / PDZZ )
+ !
+ ! special case near the ground ( uncentred gradient )
+ ZFLXZ(:,:,IKB) = XCTV * PPHI3(:,:,IKB+KKL) * PLM(:,:,IKB) &
+ * PLEPS(:,:,IKB) &
+ *( PEXPL * &
+ ( ZCOEFF(:,:,IKB+2*KKL)*PTHLM(:,:,IKB+2*KKL) &
+ +ZCOEFF(:,:,IKB+KKL )*PTHLM(:,:,IKB+KKL ) &
+ +ZCOEFF(:,:,IKB )*PTHLM(:,:,IKB ) )**2 &
+ +PIMPL * &
+ ( ZCOEFF(:,:,IKB+2*KKL)*PTHLP(:,:,IKB+2*KKL) &
+ +ZCOEFF(:,:,IKB+KKL )*PTHLP(:,:,IKB+KKL ) &
+ +ZCOEFF(:,:,IKB )*PTHLP(:,:,IKB ) )**2 &
+ )
+ !
+ ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
+ !
+ ZFLXZ = MAX(0., ZFLXZ)
+ !
+ IF (KRRL > 0) THEN
+ PSIGS(:,:,:) = ZFLXZ(:,:,:) * PATHETA(:,:,:)**2
+ END IF
+ !
+ !
+ ! stores <THl THl>
+ IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
+ TZFIELD%CMNHNAME = 'THL_VVAR'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'THL_VVAR'
+ TZFIELD%CUNITS = 'K2'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_THL_VVAR'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZ)
+ END IF
+!
+! and we store in LES configuration
+!
+ IF (LLES_CALL) THEN
+ CALL SECOND_MNH(ZTIME1)
+ CALL LES_MEAN_SUBGRID( ZFLXZ, X_LES_SUBGRID_Thl2 )
+ CALL LES_MEAN_SUBGRID( MZF(PWM)*ZFLXZ, X_LES_RES_W_SBG_Thl2 )
+ CALL LES_MEAN_SUBGRID( -2.*XCTD*PSQRT_TKE*ZFLXZ/PLEPS, X_LES_SUBGRID_DISS_Thl2 )
+ CALL LES_MEAN_SUBGRID( PETHETA*ZFLXZ, X_LES_SUBGRID_ThlThv )
+ CALL LES_MEAN_SUBGRID( -XA3*PBETA*PETHETA*ZFLXZ, X_LES_SUBGRID_ThlPz, .TRUE. )
+ CALL SECOND_MNH(ZTIME2)
+ XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ END IF
+!
+ IF ( KRR /= 0 ) THEN
+!
+!* 4.3 <THl Rnp>
+!
+!
+ ! Compute the turbulent variance F and F' at time t-dt.
+ ZF (:,:,:) = XCTV*PLM*PLEPS*MZF(0.5*(PPHI3+PPSI3)*PDTH_DZ*PDR_DZ)
+ ZDFDDTDZ(:,:,:) = 0. ! this term, because of discretization, is treated separately
+ ZDFDDRDZ(:,:,:) = 0. ! this term, because of discretization, is treated separately
+ !
+ ! Effect of 3rd order terms in temperature flux (at mass point)
+ !
+ ! d(w'th'2)/dz
+ IF (GFTH2) THEN
+ ZF = ZF + M3_THR_WTH2(PREDR1,PD,PLEPS,PSQRT_TKE,&
+ & PBLL_O_E,PETHETA,PDR_DZ) * PFTH2
+ ZDFDDTDZ = ZDFDDTDZ + D_M3_THR_WTH2_O_DDTDZ(PREDTH1,PREDR1,&
+ & PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDR_DZ) * PFTH2
+ ZDFDDRDZ = ZDFDDRDZ + D_M3_THR_WTH2_O_DDRDZ(PREDTH1,PREDR1,&
+ & PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA) * PFTH2
+ END IF
+ !
+ ! d(w'2th')/dz
+ IF (GFWTH) THEN
+ ZF = ZF + M3_THR_W2TH(PREDR1,PD,PLM,PLEPS,PTKEM,&
+ & PDR_DZ) * MZF(PFWTH)
+ ZDFDDTDZ = ZDFDDTDZ + D_M3_THR_W2TH_O_DDTDZ(PREDTH1,PREDR1,&
+ & PD,PLM,PLEPS,PTKEM,PBLL_O_E,PDR_DZ,PETHETA) * MZF(PFWTH)
+ ZDFDDRDZ = ZDFDDRDZ + D_M3_THR_W2TH_O_DDRDZ(PREDTH1,PREDR1,&
+ & PD,PLM,PLEPS,PTKEM) * MZF(PFWTH)
+ END IF
+ !
+ ! d(w'r'2)/dz
+ IF (GFR2) THEN
+ ZF = ZF + M3_THR_WR2(PREDTH1,PD,PLEPS,PSQRT_TKE,&
+ & PBLL_O_E,PEMOIST,PDTH_DZ) * PFR2
+ ZDFDDTDZ = ZDFDDTDZ + D_M3_THR_WR2_O_DDTDZ(PREDR1,PREDTH1,PD,&
+ & PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST) * PFR2
+ ZDFDDRDZ = ZDFDDRDZ + D_M3_THR_WR2_O_DDRDZ(PREDR1,PREDTH1,PD,&
+ & PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTH_DZ) * PFR2
+ END IF
+ !
+ ! d(w'2r')/dz
+ IF (GFWR) THEN
+ ZF = ZF + M3_THR_W2R(PREDTH1,PD,PLM,PLEPS,PTKEM,&
+ & PDTH_DZ) * MZF(PFWR)
+ ZDFDDTDZ = ZDFDDTDZ + D_M3_THR_W2R_O_DDTDZ(PREDR1,PREDTH1,PD,&
+ & PLM,PLEPS,PTKEM) * MZF(PFWR)
+ ZDFDDRDZ = ZDFDDRDZ + D_M3_THR_W2R_O_DDRDZ(PREDR1,PREDTH1,PD,&
+ & PLM,PLEPS,PTKEM,PBLL_O_E,PDTH_DZ,PEMOIST) * MZF(PFWR)
+ END IF
+ !
+ ! d(w'th'r')/dz
+ IF (GFTHR) THEN
+ ZF = ZF + M3_THR_WTHR(PREDTH1,PREDR1,PD,PLEPS,&
+ & PSQRT_TKE) * PFTHR
+ ZDFDDTDZ = ZDFDDTDZ + D_M3_THR_WTHR_O_DDTDZ(PREDTH1,PREDR1,&
+ & PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA) * PFTHR
+ ZDFDDRDZ = ZDFDDRDZ + D_M3_THR_WTHR_O_DDRDZ(PREDR1,PREDTH1,&
+ & PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST) * PFTHR
+ END IF
+ !
+ ZFLXZ(:,:,:) = ZF &
+ + PIMPL * XCTV*PLM*PLEPS*0.5 &
+ * MZF( ( D_PHI3DTDZ_O_DDTDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,HTURBDIM,GUSERV) & ! d(phi3*dthdz)/ddthdz term
+ +D_PSI3DTDZ_O_DDTDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,GUSERV) & ! d(psi3*dthdz)/ddthdz term
+ ) *PDR_DZ *DZM(PTHLP - PTHLM ) / PDZZ &
+ +( D_PHI3DRDZ_O_DDRDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,HTURBDIM,GUSERV) & ! d(phi3*drdz )/ddrdz term
+ +D_PSI3DRDZ_O_DDRDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,GUSERV) & ! d(psi3*drdz )/ddrdz term
+ ) *PDTH_DZ *DZM(PRP - PRM(:,:,:,1)) / PDZZ &
+ ) &
+ + PIMPL * ZDFDDTDZ * MZF(DZM(PTHLP - PTHLM(:,:,:)) / PDZZ ) &
+ + PIMPL * ZDFDDRDZ * MZF(DZM(PRP - PRM(:,:,:,1)) / PDZZ )
+ !
+ ! special case near the ground ( uncentred gradient )
+ ZFLXZ(:,:,IKB) = &
+ (XCHT1 * PPHI3(:,:,IKB+KKL) + XCHT2 * PPSI3(:,:,IKB+KKL)) &
+ *( PEXPL * &
+ ( ZCOEFF(:,:,IKB+2*KKL)*PTHLM(:,:,IKB+2*KKL) &
+ +ZCOEFF(:,:,IKB+KKL )*PTHLM(:,:,IKB+KKL ) &
+ +ZCOEFF(:,:,IKB )*PTHLM(:,:,IKB )) &
+ *( ZCOEFF(:,:,IKB+2*KKL)*PRM(:,:,IKB+2*KKL,1) &
+ +ZCOEFF(:,:,IKB+KKL )*PRM(:,:,IKB+KKL,1 ) &
+ +ZCOEFF(:,:,IKB )*PRM(:,:,IKB ,1 )) &
+ +PIMPL * &
+ ( ZCOEFF(:,:,IKB+2*KKL)*PTHLP(:,:,IKB+2*KKL) &
+ +ZCOEFF(:,:,IKB+KKL )*PTHLP(:,:,IKB+KKL ) &
+ +ZCOEFF(:,:,IKB )*PTHLP(:,:,IKB )) &
+ *( ZCOEFF(:,:,IKB+2*KKL)*PRP(:,:,IKB+2*KKL ) &
+ +ZCOEFF(:,:,IKB+KKL )*PRP(:,:,IKB+KKL ) &
+ +ZCOEFF(:,:,IKB )*PRP(:,:,IKB )) &
+ )
+ !
+ ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
+ !
+ IF ( KRRL > 0 ) THEN
+ PSIGS(:,:,:) = PSIGS(:,:,:) + &
+ 2. * PATHETA(:,:,:) * PAMOIST(:,:,:) * ZFLXZ(:,:,:)
+ END IF
+ ! stores <THl Rnp>
+ IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
+ TZFIELD%CMNHNAME = 'THLRCONS_VCOR'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'THLRCONS_VCOR'
+ TZFIELD%CUNITS = 'K kg kg-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_THLRCONS_VCOR'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZ)
+ END IF
+!
+! and we store in LES configuration
+!
+ IF (LLES_CALL) THEN
+ CALL SECOND_MNH(ZTIME1)
+ CALL LES_MEAN_SUBGRID( ZFLXZ, X_LES_SUBGRID_THlRt )
+ CALL LES_MEAN_SUBGRID( MZF(PWM)*ZFLXZ, X_LES_RES_W_SBG_ThlRt )
+ CALL LES_MEAN_SUBGRID( -2.*XCTD*PSQRT_TKE*ZFLXZ/PLEPS, X_LES_SUBGRID_DISS_ThlRt )
+ CALL LES_MEAN_SUBGRID( PETHETA*ZFLXZ, X_LES_SUBGRID_RtThv )
+ CALL LES_MEAN_SUBGRID( -XA3*PBETA*PETHETA*ZFLXZ, X_LES_SUBGRID_RtPz, .TRUE. )
+ CALL LES_MEAN_SUBGRID( PEMOIST*ZFLXZ, X_LES_SUBGRID_ThlThv , .TRUE. )
+ CALL LES_MEAN_SUBGRID( -XA3*PBETA*PEMOIST*ZFLXZ, X_LES_SUBGRID_ThlPz, .TRUE. )
+ CALL SECOND_MNH(ZTIME2)
+ XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ END IF
+!
+!
+!* 4.4 <Rnp Rnp>
+!
+!
+ ! Compute the turbulent variance F and F' at time t-dt.
+ ZF (:,:,:) = XCTV*PLM*PLEPS*MZF(PPSI3*PDR_DZ**2)
+ ZDFDDRDZ(:,:,:) = 0. ! this term, because of discretization, is treated separately
+ !
+ ! Effect of 3rd order terms in temperature flux (at mass point)
+ !
+ ! d(w'r'2)/dz
+ IF (GFR2) THEN
+ ZF = ZF + M3_R2_WR2(PREDR1,PREDTH1,PD,PLEPS,&
+ & PSQRT_TKE) * PFR2
+ ZDFDDRDZ = ZDFDDRDZ + D_M3_R2_WR2_O_DDRDZ(PREDR1,PREDTH1,&
+ & PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST) * PFR2
+ END IF
+ !
+ ! d(w'2r')/dz
+ IF (GFWR) THEN
+ ZF = ZF + M3_R2_W2R(PREDR1,PREDTH1,PD,PDR_DZ,&
+ & PLM,PLEPS,PTKEM) * MZF(PFWR)
+ ZDFDDRDZ = ZDFDDRDZ + D_M3_R2_W2R_O_DDRDZ(PREDR1,PREDTH1,&
+ & PD,PLM,PLEPS,PTKEM,GUSERV) * MZF(PFWR)
+ END IF
+ !
+ IF (KRR/=0) THEN
+ ! d(w'r'2)/dz
+ IF (GFTH2) THEN
+ ZF = ZF + M3_R2_WTH2(PD,PLEPS,PSQRT_TKE,&
+ & PBLL_O_E,PETHETA,PDR_DZ) * PFTH2
+ ZDFDDRDZ = ZDFDDRDZ + D_M3_R2_WTH2_O_DDRDZ(PREDR1,&
+ & PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDR_DZ) * PFTH2
+ END IF
+ !
+ ! d(w'2r')/dz
+ IF (GFWTH) THEN
+ ZF = ZF + M3_R2_W2TH(PD,PLM,PLEPS,PTKEM,&
+ & PBLL_O_E,PETHETA,PDR_DZ) * MZF(PFWTH)
+ ZDFDDRDZ = ZDFDDRDZ + D_M3_R2_W2TH_O_DDRDZ(PREDR1,PREDTH1,&
+ & PD,PLM,PLEPS,PTKEM,PBLL_O_E,PETHETA,PDR_DZ) * MZF(PFWTH)
+ END IF
+ !
+ ! d(w'th'r')/dz
+ IF (GFTHR) THEN
+ ZF = ZF + M3_R2_WTHR(PREDTH1,PD,PLEPS,&
+ & PSQRT_TKE,PBLL_O_E,PETHETA,PDR_DZ) * PFTHR
+ ZDFDDRDZ = ZDFDDRDZ + D_M3_R2_WTHR_O_DDRDZ(PREDR1,PREDTH1,&
+ & PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDR_DZ) * PFTHR
+ END IF
+
+ END IF
+ !
+ ZFLXZ(:,:,:) = ZF &
+ + PIMPL * XCTV*PLM*PLEPS &
+ *MZF(D_PSI3DRDZ2_O_DDRDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,PDR_DZ,HTURBDIM,GUSERV) &
+ *DZM(PRP - PRM(:,:,:,1)) / PDZZ ) &
+ + PIMPL * ZDFDDRDZ * MZF(DZM(PRP - PRM(:,:,:,1)) / PDZZ )
+ !
+ ! special case near the ground ( uncentred gradient )
+ ZFLXZ(:,:,IKB) = XCHV * PPSI3(:,:,IKB+KKL) * PLM(:,:,IKB) &
+ * PLEPS(:,:,IKB) &
+ *( PEXPL * &
+ ( ZCOEFF(:,:,IKB+2*KKL)*PRM(:,:,IKB+2*KKL,1) &
+ +ZCOEFF(:,:,IKB+KKL )*PRM(:,:,IKB+KKL,1 ) &
+ +ZCOEFF(:,:,IKB )*PRM(:,:,IKB ,1 ))**2 &
+ +PIMPL * &
+ ( ZCOEFF(:,:,IKB+2*KKL)*PRP(:,:,IKB+2*KKL) &
+ +ZCOEFF(:,:,IKB+KKL )*PRP(:,:,IKB+KKL ) &
+ +ZCOEFF(:,:,IKB )*PRP(:,:,IKB ))**2 &
+ )
+ !
+ ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
+ !
+ IF ( KRRL > 0 ) THEN
+ PSIGS(:,:,:) = PSIGS(:,:,:) + PAMOIST(:,:,:) **2 * ZFLXZ(:,:,:)
+ END IF
+ ! stores <Rnp Rnp>
+ IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
+ TZFIELD%CMNHNAME = 'RTOT_VVAR'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'RTOT_VVAR'
+ TZFIELD%CUNITS = 'kg2 kg-2'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_RTOT_VVAR'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZ)
+ END IF
+ !
+ ! and we store in LES configuration
+ !
+ IF (LLES_CALL) THEN
+ CALL SECOND_MNH(ZTIME1)
+ CALL LES_MEAN_SUBGRID( ZFLXZ, X_LES_SUBGRID_Rt2 )
+ CALL LES_MEAN_SUBGRID( MZF(PWM)*ZFLXZ, X_LES_RES_W_SBG_Rt2 )
+ CALL LES_MEAN_SUBGRID( PEMOIST*ZFLXZ, X_LES_SUBGRID_RtThv , .TRUE. )
+ CALL LES_MEAN_SUBGRID( -XA3*PBETA*PEMOIST*ZFLXZ, X_LES_SUBGRID_RtPz, .TRUE. )
+ CALL LES_MEAN_SUBGRID( -2.*XCTD*PSQRT_TKE*ZFLXZ/PLEPS, X_LES_SUBGRID_DISS_Rt2 )
+ CALL SECOND_MNH(ZTIME2)
+ XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ END IF
+ !
+ END IF ! end if KRR ne 0
+!
+!
+! 4.5 Vertical part of Sigma_s
+!
+ IF ( KRRL > 0 ) THEN
+ ! Extrapolate PSIGS at the ground and at the top
+ PSIGS(:,:,KKA) = PSIGS(:,:,IKB)
+ PSIGS(:,:,KKU) = PSIGS(:,:,IKE)
+ PSIGS(:,:,:) = SQRT( MAX (PSIGS(:,:,:) , 1.E-12) )
+ END IF
+
+!
+! 4.6 Deallocate
+!
+ DEALLOCATE(ZCOEFF)
+!----------------------------------------------------------------------------
+END SUBROUTINE TURB_VER_THERMO_CORR
diff --git a/src/mesonh/turb/turb_ver_thermo_flux.f90 b/src/mesonh/turb/turb_ver_thermo_flux.f90
new file mode 100644
index 000000000..cf539984e
--- /dev/null
+++ b/src/mesonh/turb/turb_ver_thermo_flux.f90
@@ -0,0 +1,1109 @@
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ####################
+ MODULE MODI_TURB_VER_THERMO_FLUX
+! ####################
+!
+INTERFACE
+!
+ SUBROUTINE TURB_VER_THERMO_FLUX(KKA,KKU,KKL,KRR,KRRL,KRRI, &
+ OTURB_FLX,HTURBDIM,HTOM, &
+ PIMPL,PEXPL, &
+ PTSTEP, &
+ TPFILE, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
+ PRHODJ,PTHVREF, &
+ PSFTHM,PSFRM,PSFTHP,PSFRP, &
+ PWM,PTHLM,PRM,PSVM, &
+ PTKEM,PLM,PLEPS, &
+ PLOCPEXNM,PATHETA,PAMOIST,PSRCM,PFRAC_ICE, &
+ PBETA, PSQRT_TKE, PDTH_DZ, PDR_DZ, PRED2TH3, &
+ PRED2R3, PRED2THR3, PBLL_O_E, PETHETA, &
+ PEMOIST, PREDTH1, PREDR1, PPHI3, PPSI3, PD, &
+ PFWTH,PFWR,PFTH2,PFR2,PFTHR,PBL_DEPTH, &
+ PWTHV,PRTHLS,PRRS,PTHLP,PRP,PTP,PWTH,PWRC )
+!
+USE MODD_IO, ONLY: TFILEDATA
+!
+INTEGER, INTENT(IN) :: KKA !near ground array index
+INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=AR O
+INTEGER, INTENT(IN) :: KRR ! number of moist var.
+INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
+INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
+LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
+ ! turbulent fluxes in the syncronous FM-file
+CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
+ ! turbulence scheme
+CHARACTER(len=4), INTENT(IN) :: HTOM ! type of Third Order Moment
+REAL, INTENT(IN) :: PIMPL, PEXPL ! Coef. for temporal disc.
+REAL, INTENT(IN) :: PTSTEP ! Double Time Step
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ, PDXX, PDYY, PDZX, PDZY
+ ! Metric coefficients
+REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW ! Director Cosinus of the
+ ! normal to the ground surface
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitudes
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry density * grid volum
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! ref. state Virtual
+ ! Potential Temperature
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHM,PSFRM ! surface fluxes at time
+! ! t - deltat
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHP,PSFRP ! surface fluxes at time
+! ! t + deltat
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PWM
+! Vertical wind
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM
+! potential temperature at t-Delta t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios
+ ! at t-Delta t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! Mixing ratios
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! dissipative length
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exnref at time t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! coefficients between
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM ! normalized
+ ! 2nd-order flux s'r'c/2Sigma_s2 at t-1 multiplied by Lambda_3
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFRAC_ICE ! ri fraction of rc+ri
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PBETA ! buoyancy coefficient
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE ! sqrt(e)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTH_DZ ! d(th)/dz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDR_DZ ! d(rt)/dz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2TH3 ! 3D Redeslperger number R*2_th
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2R3 ! 3D Redeslperger number R*2_r
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2THR3 ! 3D Redeslperger number R*2_thr
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E ! beta * Lk * Leps / tke
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA ! Coefficient for theta in theta_v computation
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST ! Coefficient for r in theta_v computation
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1 ! 1D Redelsperger number for Th
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1 ! 1D Redelsperger number for r
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPHI3 ! Prandtl number for temperature
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPSI3 ! Prandtl number for vapor
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PD ! Denominator in Prandtl numbers
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFWTH ! d(w'2th' )/dz (at flux point)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFWR ! d(w'2r' )/dz (at flux point)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFTH2 ! d(w'th'2 )/dz (at mass point)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFR2 ! d(w'r'2 )/dz (at mass point)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFTHR ! d(w'th'r')/dz (at mass point)
+REAL, DIMENSION(:,:), INTENT(INOUT):: PBL_DEPTH ! BL depth
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWTHV ! buoyancy flux
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHLS ! cumulated source for theta
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS ! cumulated source for rt
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTHLP ! guess of thl at t+ deltat
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRP ! guess of r at t+ deltat
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTP ! Dynamic and thermal
+ ! TKE production terms
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWTH ! heat flux
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWRC ! cloud water flux
+!
+!
+END SUBROUTINE TURB_VER_THERMO_FLUX
+!
+END INTERFACE
+!
+END MODULE MODI_TURB_VER_THERMO_FLUX
+!
+!
+! ###############################################################
+ SUBROUTINE TURB_VER_THERMO_FLUX(KKA,KKU,KKL,KRR, KRRL, KRRI, &
+ OTURB_FLX,HTURBDIM,HTOM, &
+ PIMPL,PEXPL, &
+ PTSTEP, &
+ TPFILE, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
+ PRHODJ,PTHVREF, &
+ PSFTHM,PSFRM,PSFTHP,PSFRP, &
+ PWM,PTHLM,PRM,PSVM, &
+ PTKEM,PLM,PLEPS, &
+ PLOCPEXNM,PATHETA,PAMOIST,PSRCM,PFRAC_ICE, &
+ PBETA, PSQRT_TKE, PDTH_DZ, PDR_DZ, PRED2TH3, &
+ PRED2R3, PRED2THR3, PBLL_O_E, PETHETA, &
+ PEMOIST, PREDTH1, PREDR1, PPHI3, PPSI3, PD, &
+ PFWTH,PFWR,PFTH2,PFR2,PFTHR,PBL_DEPTH, &
+ PWTHV,PRTHLS,PRRS,PTHLP,PRP,PTP,PWTH,PWRC )
+! ###############################################################
+!
+!
+!!**** *TURB_VER_THERMO_FLUX* -compute the source terms due to the vertical turbulent
+!! fluxes.
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to compute the vertical turbulent
+! fluxes of the evolutive variables and give back the source
+! terms to the main program. In the case of large horizontal meshes,
+! the divergence of these vertical turbulent fluxes represent the whole
+! effect of the turbulence but when the three-dimensionnal version of
+! the turbulence scheme is activated (CTURBDIM="3DIM"), these divergences
+! are completed in the next routine TURB_HOR.
+! An arbitrary degree of implicitness has been implemented for the
+! temporal treatment of these diffusion terms.
+! The vertical boundary conditions are as follows:
+! * at the bottom, the surface fluxes are prescribed at the same
+! as the other turbulent fluxes
+! * at the top, the turbulent fluxes are set to 0.
+! It should be noted that the condensation has been implicitely included
+! in this turbulence scheme by using conservative variables and computing
+! the subgrid variance of a statistical variable s indicating the presence
+! or not of condensation in a given mesh.
+!
+!!** METHOD
+!! ------
+!! 1D type calculations are made;
+!! The vertical turbulent fluxes are computed in an off-centered
+!! implicit scheme (a Crank-Nicholson type with coefficients different
+!! than 0.5), which allows to vary the degree of implicitness of the
+!! formulation.
+!! The different prognostic variables are treated one by one.
+!! The contributions of each turbulent fluxes are cumulated into the
+!! tendency PRvarS, and into the dynamic and thermal production of
+!! TKE if necessary.
+!!
+!! In section 2 and 3, the thermodynamical fields are considered.
+!! Only the turbulent fluxes of the conservative variables
+!! (Thetal and Rnp stored in PRx(:,:,:,1)) are computed.
+!! Note that the turbulent fluxes at the vertical
+!! boundaries are given either by the soil scheme for the surface one
+!! ( at the same instant as the others fluxes) and equal to 0 at the
+!! top of the model. The thermal production is computed by vertically
+!! averaging the turbulent flux and multiply this flux at the mass point by
+!! a function ETHETA or EMOIST, which preform the transformation from the
+!! conservative variables to the virtual potential temperature.
+!!
+!! In section 4, the variance of the statistical variable
+!! s indicating presence or not of condensation, is determined in function
+!! of the turbulent moments of the conservative variables and its
+!! squarred root is stored in PSIGS. This information will be completed in
+!! the horizontal turbulence if the turbulence dimensionality is not
+!! equal to "1DIM".
+!!
+!! In section 5, the x component of the stress tensor is computed.
+!! The surface flux <u'w'> is computed from the value of the surface
+!! fluxes computed in axes linked to the orography ( i", j" , k"):
+!! i" is parallel to the surface and in the direction of the maximum
+!! slope
+!! j" is also parallel to the surface and in the normal direction of
+!! the maximum slope
+!! k" is the normal to the surface
+!! In order to prevent numerical instability, the implicit scheme has
+!! been extended to the surface flux regarding to its dependence in
+!! function of U. The dependence in function of the other components
+!! introduced by the different rotations is only explicit.
+!! The turbulent fluxes are used to compute the dynamic production of
+!! TKE. For the last TKE level ( located at PDZZ(:,:,IKB)/2 from the
+!! ground), an harmonic extrapolation from the dynamic production at
+!! PDZZ(:,:,IKB) is used to avoid an evaluation of the gradient of U
+!! in the surface layer.
+!!
+!! In section 6, the same steps are repeated but for the y direction
+!! and in section 7, a diagnostic computation of the W variance is
+!! performed.
+!!
+!! In section 8, the turbulent fluxes for the scalar variables are
+!! computed by the same way as the conservative thermodynamical variables
+!!
+!!
+!! EXTERNAL
+!! --------
+!! GX_U_M, GY_V_M, GZ_W_M : cartesian gradient operators
+!! GX_U_UW,GY_V_VW (X,Y,Z) represent the direction of the gradient
+!! _(M,U,...)_ represent the localization of the
+!! field to be derivated
+!! _(M,UW,...) represent the localization of the
+!! field derivated
+!!
+!!
+!! MXM,MXF,MYM,MYF,MZM,MZF
+!! : Shuman functions (mean operators)
+!! DXF,DYF,DZF,DZM
+!! : Shuman functions (difference operators)
+!!
+!! SUBROUTINE TRIDIAG : to compute the split implicit evolution
+!! of a variable located at a mass point
+!!
+!! SUBROUTINE TRIDIAG_WIND: to compute the split implicit evolution
+!! of a variable located at a wind point
+!!
+!! FUNCTIONs ETHETA and EMOIST :
+!! allows to compute:
+!! - the coefficients for the turbulent correlation between
+!! any variable and the virtual potential temperature, of its
+!! correlations with the conservative potential temperature and
+!! the humidity conservative variable:
+!! ------- ------- -------
+!! A' Thv' = ETHETA A' Thl' + EMOIST A' Rnp'
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST : contains physical constants
+!!
+!! XG : gravity constant
+!!
+!! Module MODD_CTURB: contains the set of constants for
+!! the turbulence scheme
+!!
+!! XCMFS,XCMFB : cts for the momentum flux
+!! XCSHF : ct for the sensible heat flux
+!! XCHF : ct for the moisture flux
+!! XCTV,XCHV : cts for the T and moisture variances
+!!
+!! Module MODD_PARAMETERS
+!!
+!! JPVEXT_TURB : number of vertical external points
+!! JPHEXT : number of horizontal external points
+!!
+!!
+!! REFERENCE
+!! ---------
+!! Book 1 of documentation (Chapter: Turbulence)
+!!
+!! AUTHOR
+!! ------
+!! Joan Cuxart * INM and Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original August 19, 1994
+!! Modifications: February 14, 1995 (J.Cuxart and J.Stein)
+!! Doctorization and Optimization
+!! Modifications: March 21, 1995 (J.M. Carriere)
+!! Introduction of cloud water
+!! Modifications: June 14, 1995 (J.Cuxart and J. Stein)
+!! Phi3 and Psi3 at w-point + bug in the all
+!! or nothing condens.
+!! Modifications: Sept 15, 1995 (J.Cuxart and J. Stein)
+!! Change the DP computation at the ground
+!! Modifications: October 10, 1995 (J.Cuxart and J. Stein)
+!! Psi for scal var and LES tools
+!! Modifications: November 10, 1995 (J. Stein)
+!! change the surface relations
+!! Modifications: February 20, 1995 (J. Stein) optimization
+!! Modifications: May 21, 1996 (J. Stein)
+!! bug in the vertical flux of the V wind
+!! component for explicit computation
+!! Modifications: May 21, 1996 (N. wood)
+!! modify the computation of the vertical
+!! part or the surface tangential flux
+!! Modifications: May 21, 1996 (P. Jabouille)
+!! same modification in the Y direction
+!!
+!! Modifications: Sept 17, 1996 (J. Stein) change the moist case by using
+!! Pi instead of Piref + use Atheta and Amoist
+!!
+!! Modifications: Nov 24, 1997 (V. Masson) removes the DO loops
+!! Modifications: Mar 31, 1998 (V. Masson) splits the routine TURB_VER_THERMO_FLUX
+!! Modifications: Oct 18, 2000 (V. Masson) LES computations
+!! Modifications: Dec 01, 2000 (V. Masson) conservation of energy from
+!! surface flux in 1DIM case
+!! when slopes are present
+!! Nov 06, 2002 (V. Masson) LES budgets
+!! Feb 20, 2003 (JP Pinty) Add PFRAC_ICE
+!! May 20, 2003 (JP Pinty) Correction of ETHETA
+!! and EMOIST calls
+!! July 2005 (S. Tomas, V. Masson)
+!! Add 3rd order moments
+!! and implicitation of PHI3 and PSI3
+!! October 2009 (G. Tanguy) add ILENCH=LEN(YCOMMENT) after
+!! change of YCOMMENT
+!! 2012-02 (Y. Seity) add possibility to run with reversed
+!! vertical levels
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! 2021 (D. Ricard) last version of HGRAD turbulence scheme
+!! Leronard terms instead of Reynolds terms
+!! applied to vertical fluxes of r_np and Thl
+!! for implicit version of turbulence scheme
+!! corrections and cleaning
+!! June 2020 (B. Vie) Patch preventing negative rc and ri in 2.3 and 3.3
+!! JL Redelsperger : 03/2021: Ocean and Autocoupling O-A LES Cases
+!! Sfc flux shape for LDEEPOC Case
+!!--------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_CTURB
+use modd_field, only: tfielddata, TYPEREAL
+USE MODD_GRID_n, ONLY: XZS, XXHAT, XYHAT
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_METRICS_n, ONLY: XDXX, XDYY, XDZX, XDZY, XDZZ
+USE MODD_PARAMETERS
+USE MODD_TURB_n, ONLY: LHGRAD, XCOEFHGRADTHL, XCOEFHGRADRM, XALTHGRAD, XCLDTHOLD
+USE MODD_CONF
+USE MODD_LES
+USE MODD_DIM_n
+USE MODD_DYN_n, ONLY: LOCEAN
+USE MODD_OCEANH
+USE MODD_REF, ONLY: LCOUPLES
+USE MODD_TURB_n
+USE MODD_FRC
+!
+USE MODI_GRADIENT_U
+USE MODI_GRADIENT_V
+USE MODI_GRADIENT_W
+USE MODI_GRADIENT_M
+USE MODI_GRADIENT_UV
+USE MODI_GRADIENT_UW
+USE MODI_GRADIENT_VW
+USE MODI_SHUMAN
+USE MODI_TRIDIAG
+USE MODI_LES_MEAN_SUBGRID
+USE MODI_PRANDTL
+USE MODI_TRIDIAG_THERMO
+USE MODI_TM06_H
+!
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+USE MODE_PRANDTL
+!
+USE MODI_SECOND_MNH
+USE MODE_ll
+USE MODE_GATHER_ll
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+!
+!
+INTEGER, INTENT(IN) :: KKA !near ground array index
+INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
+INTEGER, INTENT(IN) :: KRR ! number of moist var.
+INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
+INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
+LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
+ ! turbulent fluxes in the syncronous FM-file
+CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
+ ! turbulence scheme
+CHARACTER(len=4), INTENT(IN) :: HTOM ! type of Third Order Moment
+REAL, INTENT(IN) :: PIMPL, PEXPL ! Coef. for temporal disc.
+REAL, INTENT(IN) :: PTSTEP ! Double Time Step
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ, PDXX, PDYY, PDZX, PDZY
+ ! Metric coefficients
+REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW ! Director Cosinus of the
+ ! normal to the ground surface
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitudes
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry density * grid volum
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! ref. state Virtual
+ ! Potential Temperature
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHM,PSFRM ! surface fluxes at time
+! ! t - deltat
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHP,PSFRP ! surface fluxes at time
+! ! t + deltat
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PWM
+! Vertical wind
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM
+! potential temperature at t-Delta t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios
+ ! at t-Delta t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! Mixing ratios
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! dissipative length
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exnref at time t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! coefficients between
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM ! normalized
+! 2nd-order flux s'r'c/2Sigma_s2 at t-1 multiplied by Lambda_3
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFRAC_ICE ! ri fraction of rc+ri
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PBETA ! buoyancy coefficient
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE ! sqrt(e)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTH_DZ ! d(th)/dz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDR_DZ ! d(rt)/dz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2TH3 ! 3D Redeslperger number R*2_th
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2R3 ! 3D Redeslperger number R*2_r
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2THR3 ! 3D Redeslperger number R*2_thr
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E ! beta * Lk * Leps / tke
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA ! Coefficient for theta in theta_v computation
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST ! Coefficient for r in theta_v computation
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1 ! 1D Redelsperger number for Th
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1 ! 1D Redelsperger number for r
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPHI3 ! Prandtl number for temperature
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPSI3 ! Prandtl number for vapor
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PD ! Denominator in Prandtl numbers
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFWTH ! d(w'2th' )/dz (at flux point)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFWR ! d(w'2r' )/dz (at flux point)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFTH2 ! d(w'th'2 )/dz (at mass point)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFR2 ! d(w'r'2 )/dz (at mass point)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFTHR ! d(w'th'r')/dz (at mass point)
+REAL, DIMENSION(:,:), INTENT(INOUT):: PBL_DEPTH ! BL depth
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWTHV ! buoyancy flux
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHLS ! cumulated source for theta
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS ! cumulated source for rt
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTHLP ! guess of thl at t+ deltat
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRP ! guess of r at t+ deltat
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTP ! Dynamic and thermal
+ ! TKE production terms
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWTH ! heat flux
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWRC ! cloud water flux
+!
+!
+!* 0.2 declaration of local variables
+!
+!
+REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: &
+ ZA, & ! work variable for wrc or LES computation
+ ZFLXZ, & ! vertical flux of the treated variable
+ ZSOURCE, & ! source of evolution for the treated variable
+ ZKEFF, & ! effectif diffusion coeff = LT * SQRT( TKE )
+ ZF, & ! Flux in dTh/dt =-dF/dz (evaluated at t-1)(or rt instead of Th)
+ ZDFDDTDZ, & ! dF/d(dTh/dz)
+ ZDFDDRDZ, & ! dF/d(dr/dz)
+ Z3RDMOMENT,& ! 3 order term in flux or variance equation
+ ZF_NEW, &
+ ZRWTHL, &
+ ZRWRNP, &
+ ZCLD_THOLD
+!
+REAL,DIMENSION(SIZE(XZS,1),SIZE(XZS,2),KKU) :: ZALT
+!
+INTEGER :: IKB,IKE ! I index values for the Beginning and End
+ ! mass points of the domain in the 3 direct.
+INTEGER :: IKT ! array size in k direction
+INTEGER :: IKTB,IKTE ! start, end of k loops in physical domain
+INTEGER :: JI, JJ ! loop indexes
+!
+!
+INTEGER :: IIB,IJB ! Lower bounds of the physical
+ ! sub-domain in x and y directions
+INTEGER :: IIE,IJE ! Upper bounds of the physical
+ ! sub-domain in x and y directions
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZXHAT_ll ! Position x in the conformal
+ ! plane (array on the complete domain)
+REAL, DIMENSION(:), ALLOCATABLE :: ZYHAT_ll ! Position y in the conformal
+ ! plane (array on the complete domain)
+!
+!
+CHARACTER (LEN=100) :: YCOMMENT ! comment string in LFIFM file
+CHARACTER (LEN=LEN_HREC) :: YRECFM ! Name of the desired field in LFIFM file
+!
+REAL :: ZTIME1, ZTIME2
+REAL :: ZDELTAX
+REAL :: ZXBEG,ZXEND,ZYBEG,ZYEND ! Forcing size for ocean deep convection
+REAL, DIMENSION(SIZE(XXHAT),SIZE(XYHAT)) :: ZDIST ! distance
+ ! from the center of the cooling
+REAL :: ZFLPROV
+INTEGER :: JKM ! vertical index loop
+INTEGER :: JSW
+REAL :: ZSWA ! index for time flux interpolation
+!
+INTEGER :: IIU, IJU
+INTEGER :: IRESP
+INTEGER :: JK
+LOGICAL :: GUSERV ! flag to use water
+LOGICAL :: GFTH2 ! flag to use w'th'2
+LOGICAL :: GFWTH ! flag to use w'2th'
+LOGICAL :: GFR2 ! flag to use w'r'2
+LOGICAL :: GFWR ! flag to use w'2r'
+LOGICAL :: GFTHR ! flag to use w'th'r'
+TYPE(TFIELDDATA) :: TZFIELD
+!----------------------------------------------------------------------------
+!
+!* 1. PRELIMINARIES
+! -------------
+! Size for a given proc & a given model
+IIU=SIZE(PTHLM,1)
+IJU=SIZE(PTHLM,2)
+!
+!! Compute Shape of sfc flux for Oceanic Deep Conv Case
+!
+IF (LOCEAN .AND. LDEEPOC) THEN
+ !* COMPUTES THE PHYSICAL SUBDOMAIN BOUNDS
+ ALLOCATE(ZXHAT_ll(NIMAX_ll+2*JPHEXT),ZYHAT_ll(NJMAX_ll+2*JPHEXT))
+ !compute ZXHAT_ll = position in the (0:Lx) domain 1 (Lx=Size of domain1 )
+ !compute XXHAT_ll = position in the (L0_subproc,Lx_subproc) domain for the current subproc
+ ! L0_subproc as referenced in the full domain 1
+ CALL GATHERALL_FIELD_ll('XX',XXHAT,ZXHAT_ll,IRESP)
+ CALL GATHERALL_FIELD_ll('YY',XYHAT,ZYHAT_ll,IRESP)
+ CALL GET_DIM_EXT_ll('B',IIU,IJU)
+ CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
+ DO JJ = IJB,IJE
+ DO JI = IIB,IIE
+ ZDIST(JI,JJ) = SQRT( &
+ (( (XXHAT(JI)+XXHAT(JI+1))*0.5 - XCENTX_OC ) / XRADX_OC)**2 + &
+ (( (XYHAT(JJ)+XYHAT(JJ+1))*0.5 - XCENTY_OC ) / XRADY_OC)**2 &
+ )
+ END DO
+ END DO
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IF ( ZDIST(JI,JJ) > 1.) XSSTFL(JI,JJ)=0.
+ END DO
+ END DO
+END IF !END DEEP OCEAN CONV CASE
+!
+IKT =SIZE(PTHLM,3)
+IKTE =IKT-JPVEXT_TURB
+IKTB =1+JPVEXT_TURB
+IKB=KKA+JPVEXT_TURB*KKL
+IKE=KKU-JPVEXT_TURB*KKL
+!
+GUSERV = (KRR/=0)
+!
+! compute the coefficients for the uncentred gradient computation near the
+! ground
+!
+ZKEFF(:,:,:) = MZM( PLM(:,:,:) * SQRT(PTKEM(:,:,:)) )
+!
+! define a cloud mask with ri and rc (used after with a threshold) for Leonard terms
+!
+IF(LHGRAD) THEN
+ IF ( KRRL >= 1 ) THEN
+ IF ( KRRI >= 1 ) THEN
+ ZCLD_THOLD(:,:,:) = PRM(:,:,:,2) + PRM(:,:,:,4)
+ ELSE
+ ZCLD_THOLD(:,:,:) = PRM(:,:,:,2)
+ END IF
+ END IF
+END IF
+!
+! Flags for 3rd order quantities
+!
+GFTH2 = .FALSE.
+GFR2 = .FALSE.
+GFTHR = .FALSE.
+GFWTH = .FALSE.
+GFWR = .FALSE.
+!
+IF (HTOM/='NONE') THEN
+ GFTH2 = ANY(PFTH2/=0.)
+ GFR2 = ANY(PFR2 /=0.) .AND. GUSERV
+ GFTHR = ANY(PFTHR/=0.) .AND. GUSERV
+ GFWTH = ANY(PFWTH/=0.)
+ GFWR = ANY(PFWR /=0.) .AND. GUSERV
+END IF
+!----------------------------------------------------------------------------
+!
+!* 2. SOURCES OF CONSERVATIVE POTENTIAL TEMPERATURE AND
+! PARTIAL THERMAL PRODUCTION
+! ---------------------------------------------------------------
+!
+!* 2.1 Splitted value for cons. potential temperature at t+deltat
+!
+! Compute the turbulent flux F and F' at time t-dt.
+!
+ZF (:,:,:) = -XCSHF*PPHI3*ZKEFF*DZM(PTHLM)/PDZZ
+ZDFDDTDZ(:,:,:) = -XCSHF*ZKEFF*D_PHI3DTDZ_O_DDTDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,HTURBDIM,GUSERV)
+!
+IF (LHGRAD) THEN
+ ! Compute the Leonard terms for thl
+ ZDELTAX= XXHAT(3) - XXHAT(2)
+ ZF_NEW (:,:,:)= XCOEFHGRADTHL*ZDELTAX*ZDELTAX/12.0*( &
+ MXF(GX_W_UW(PWM(:,:,:), XDXX, XDZZ, XDZX))&
+ *MZM(GX_M_M(PTHLM(:,:,:),XDXX,XDZZ,XDZX)) &
+ + MYF(GY_W_VW(PWM(:,:,:), XDYY,XDZZ,XDZY)) &
+ *MZM(GY_M_M(PTHLM(:,:,:),XDYY,XDZZ,XDZY)) )
+END IF
+!
+! Effect of 3rd order terms in temperature flux (at flux point)
+!
+! d(w'2th')/dz
+IF (GFWTH) THEN
+ Z3RDMOMENT= M3_WTH_W2TH(PREDTH1,PREDR1,PD,ZKEFF,PTKEM)
+!
+ ZF = ZF + Z3RDMOMENT * PFWTH
+ ZDFDDTDZ = ZDFDDTDZ + D_M3_WTH_W2TH_O_DDTDZ(PREDTH1,PREDR1,&
+ & PD,PBLL_O_E,PETHETA,ZKEFF,PTKEM) * PFWTH
+END IF
+!
+! d(w'th'2)/dz
+IF (GFTH2) THEN
+ Z3RDMOMENT= M3_WTH_WTH2(PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA)
+!
+ ZF = ZF + Z3RDMOMENT * MZM(PFTH2)
+ ZDFDDTDZ = ZDFDDTDZ + D_M3_WTH_WTH2_O_DDTDZ(Z3RDMOMENT,PREDTH1,PREDR1,&
+ & PD,PBLL_O_E,PETHETA) * MZM(PFTH2)
+END IF
+!
+! d(w'2r')/dz
+IF (GFWR) THEN
+ ZF = ZF + M3_WTH_W2R(PD,ZKEFF,&
+ & PTKEM,PBLL_O_E,PEMOIST,PDTH_DZ) * PFWR
+ ZDFDDTDZ = ZDFDDTDZ + D_M3_WTH_W2R_O_DDTDZ(PREDTH1,PREDR1,&
+ & PD,ZKEFF,PTKEM,PBLL_O_E,PEMOIST) * PFWR
+END IF
+!
+! d(w'r'2)/dz
+IF (GFR2) THEN
+ ZF = ZF + M3_WTH_WR2(PD,ZKEFF,PTKEM,&
+ & PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST,PDTH_DZ) * MZM(PFR2)
+ ZDFDDTDZ = ZDFDDTDZ + D_M3_WTH_WR2_O_DDTDZ(PREDTH1,PREDR1,PD,&
+ & ZKEFF,PTKEM,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST) * MZM(PFR2)
+END IF
+!
+! d(w'th'r')/dz
+IF (GFTHR) THEN
+ Z3RDMOMENT= M3_WTH_WTHR(PREDR1,PD,ZKEFF,PTKEM,PSQRT_TKE,PBETA,&
+ & PLEPS,PEMOIST)
+!
+ ZF = ZF + Z3RDMOMENT * MZM(PFTHR)
+ ZDFDDTDZ = ZDFDDTDZ + D_M3_WTH_WTHR_O_DDTDZ(Z3RDMOMENT,PREDTH1,&
+ & PREDR1,PD,PBLL_O_E,PETHETA) * MZM(PFTHR)
+END IF
+! compute interface flux
+IF (LCOUPLES) THEN ! Autocoupling O-A LES
+ IF (LOCEAN) THEN ! ocean model in coupled case
+ ZF(:,:,IKE) = (XSSTFL_C(:,:,1)+XSSRFL_C(:,:,1)) &
+ *0.5* ( 1. + PRHODJ(:,:,KKU)/PRHODJ(:,:,IKE) )
+ ELSE ! atmosph model in coupled case
+ ZF(:,:,IKB) = XSSTFL_C(:,:,1) &
+ *0.5* ( 1. + PRHODJ(:,:,KKA)/PRHODJ(:,:,IKB) )
+ ENDIF
+!
+ELSE ! No coupling O and A cases
+ ! atmosp bottom
+ !*In 3D, a part of the flux goes vertically,
+ ! and another goes horizontally (in presence of slopes)
+ !*In 1D, part of energy released in horizontal flux is taken into account in the vertical part
+ IF (HTURBDIM=='3DIM') THEN
+ ZF(:,:,IKB) = ( PIMPL*PSFTHP(:,:) + PEXPL*PSFTHM(:,:) ) &
+ * PDIRCOSZW(:,:) &
+ * 0.5 * (1. + PRHODJ(:,:,KKA) / PRHODJ(:,:,IKB))
+ ELSE
+ ZF(:,:,IKB) = ( PIMPL*PSFTHP(:,:) + PEXPL*PSFTHM(:,:) ) &
+ / PDIRCOSZW(:,:) &
+ * 0.5 * (1. + PRHODJ(:,:,KKA) / PRHODJ(:,:,IKB))
+ END IF
+!
+ IF (LOCEAN) THEN
+ ZF(:,:,IKE) = XSSTFL(:,:) *0.5*(1. + PRHODJ(:,:,KKU) / PRHODJ(:,:,IKE))
+ ELSE !end ocean case (in nocoupled case)
+ ! atmos top
+ ZF(:,:,IKE)=0.
+ END IF
+END IF !end no coupled cases
+!
+! Compute the split conservative potential temperature at t+deltat
+CALL TRIDIAG_THERMO(KKA,KKU,KKL,PTHLM,ZF,ZDFDDTDZ,PTSTEP,PIMPL,PDZZ,&
+ PRHODJ,PTHLP)
+!
+! Compute the equivalent tendency for the conservative potential temperature
+!
+ZRWTHL(:,:,:)= PRHODJ(:,:,:)*(PTHLP(:,:,:)-PTHLM(:,:,:))/PTSTEP
+! replace the flux by the Leonard terms above ZALT and ZCLD_THOLD
+IF (LHGRAD) THEN
+ DO JK=1,KKU
+ ZALT(:,:,JK) = PZZ(:,:,JK)-XZS(:,:)
+ END DO
+ WHERE ( (ZCLD_THOLD(:,:,:) >= XCLDTHOLD) .AND. ( ZALT(:,:,:) >= XALTHGRAD) )
+ ZRWTHL(:,:,:) = -GZ_W_M(MZM(PRHODJ(:,:,:))*ZF_NEW(:,:,:),XDZZ)
+ END WHERE
+END IF
+!
+PRTHLS(:,:,:)= PRTHLS(:,:,:) + ZRWTHL(:,:,:)
+!
+!* 2.2 Partial Thermal Production
+!
+! Conservative potential temperature flux :
+!
+ZFLXZ(:,:,:) = ZF &
+ + PIMPL * ZDFDDTDZ * DZM(PTHLP - PTHLM) / PDZZ
+! replace the flux by the Leonard terms
+IF (LHGRAD) THEN
+ WHERE ( (ZCLD_THOLD(:,:,:) >= XCLDTHOLD) .AND. ( ZALT(:,:,:) >= XALTHGRAD) )
+ ZFLXZ(:,:,:) = ZF_NEW(:,:,:)
+ END WHERE
+END IF
+!
+ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
+IF (LOCEAN) THEN
+ ZFLXZ(:,:,KKU) = ZFLXZ(:,:,IKE)
+END IF
+!
+DO JK=IKTB+1,IKTE-1
+ PWTH(:,:,JK)=0.5*(ZFLXZ(:,:,JK)+ZFLXZ(:,:,JK+KKL))
+END DO
+!
+PWTH(:,:,IKB)=0.5*(ZFLXZ(:,:,IKB)+ZFLXZ(:,:,IKB+KKL))
+!
+IF (LOCEAN) THEN
+ PWTH(:,:,IKE)=0.5*(ZFLXZ(:,:,IKE)+ZFLXZ(:,:,IKE+KKL))
+ PWTH(:,:,KKA)=0.
+ PWTH(:,:,KKU)=ZFLXZ(:,:,KKU)
+ELSE
+ PWTH(:,:,IKE)=PWTH(:,:,IKE-KKL)
+ PWTH(:,:,KKA)=0.5*(ZFLXZ(:,:,KKA)+ZFLXZ(:,:,KKA+KKL))
+END IF
+!
+IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
+ ! stores the conservative potential temperature vertical flux
+ TZFIELD%CMNHNAME = 'THW_FLX'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'THW_FLX'
+ TZFIELD%CUNITS = 'K m s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'Conservative potential temperature vertical flux'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZ)
+END IF
+!
+! Contribution of the conservative temperature flux to the buoyancy flux
+IF (LOCEAN) THEN
+ PTP(:,:,:)= XG*XALPHAOC * MZF(ZFLXZ )
+ELSE
+ IF (KRR /= 0) THEN
+ PTP(:,:,:) = PBETA * MZF( MZM(PETHETA) * ZFLXZ )
+ PTP(:,:,IKB)= PBETA(:,:,IKB) * PETHETA(:,:,IKB) * &
+ 0.5 * ( ZFLXZ (:,:,IKB) + ZFLXZ (:,:,IKB+KKL) )
+ ELSE
+ PTP(:,:,:)= PBETA * MZF( ZFLXZ )
+ END IF
+END IF
+!
+! Buoyancy flux at flux points
+!
+PWTHV = MZM(PETHETA) * ZFLXZ
+PWTHV(:,:,IKB) = PETHETA(:,:,IKB) * ZFLXZ(:,:,IKB)
+!
+IF (LOCEAN) THEN
+ ! temperature contribution to Buy flux
+ PWTHV(:,:,IKE) = PETHETA(:,:,IKE) * ZFLXZ(:,:,IKE)
+END IF
+!* 2.3 Partial vertical divergence of the < Rc w > flux
+!
+IF ( KRRL >= 1 ) THEN
+ IF ( KRRI >= 1 ) THEN
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) - &
+ PRHODJ*PATHETA*2.*PSRCM*DZF(ZFLXZ/PDZZ) &
+ *(1.0-PFRAC_ICE(:,:,:))
+ PRRS(:,:,:,4) = PRRS(:,:,:,4) - &
+ PRHODJ*PATHETA*2.*PSRCM*DZF(ZFLXZ/PDZZ) &
+ *PFRAC_ICE(:,:,:)
+ ELSE
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) - &
+ PRHODJ*PATHETA*2.*PSRCM*DZF(ZFLXZ/PDZZ)
+ END IF
+END IF
+!
+!* 2.4 Storage in LES configuration
+!
+IF (LLES_CALL) THEN
+ CALL SECOND_MNH(ZTIME1)
+ CALL LES_MEAN_SUBGRID( MZF(ZFLXZ), X_LES_SUBGRID_WThl )
+ CALL LES_MEAN_SUBGRID( MZF(PWM*ZFLXZ), X_LES_RES_W_SBG_WThl )
+ CALL LES_MEAN_SUBGRID( GZ_W_M(PWM,PDZZ)*MZF(ZFLXZ),&
+ & X_LES_RES_ddxa_W_SBG_UaThl )
+ CALL LES_MEAN_SUBGRID( MZF(PDTH_DZ*ZFLXZ), X_LES_RES_ddxa_Thl_SBG_UaThl )
+ CALL LES_MEAN_SUBGRID( -XCTP*PSQRT_TKE/PLM*MZF(ZFLXZ), X_LES_SUBGRID_ThlPz )
+ CALL LES_MEAN_SUBGRID( MZF(MZM(PETHETA)*ZFLXZ), X_LES_SUBGRID_WThv )
+ IF (KRR>=1) THEN
+ CALL LES_MEAN_SUBGRID( MZF(PDR_DZ*ZFLXZ), X_LES_RES_ddxa_Rt_SBG_UaThl )
+ END IF
+ !* diagnostic of mixing coefficient for heat
+ ZA = DZM(PTHLP)
+ WHERE (ZA==0.) ZA=1.E-6
+ ZA = - ZFLXZ / ZA * PDZZ
+ ZA(:,:,IKB) = XCSHF*PPHI3(:,:,IKB)*ZKEFF(:,:,IKB)
+ ZA = MZF( ZA )
+ ZA = MIN(MAX(ZA,-1000.),1000.)
+ CALL LES_MEAN_SUBGRID( ZA, X_LES_SUBGRID_Kh )
+ !
+ CALL SECOND_MNH(ZTIME2)
+ XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+END IF
+!
+!* 2.5 New boundary layer depth for TOMs
+!
+IF (HTOM=='TM06') CALL TM06_H(IKB,IKTB,IKTE,PTSTEP,PZZ,ZFLXZ,PBL_DEPTH)
+!
+!----------------------------------------------------------------------------
+!
+!
+!* 3. SOURCES OF CONSERVATIVE AND CLOUD MIXING RATIO AND
+! COMPLETE THERMAL PRODUCTION
+! ------------------------------------------------------
+!
+!* 3.1 Splitted value for cons. mixing ratio at t+deltat
+!
+!
+IF (KRR /= 0) THEN
+ ! Compute the turbulent flux F and F' at time t-dt.
+ !
+ ZF (:,:,:) = -XCSHF*PPSI3*ZKEFF*DZM(PRM(:,:,:,1))/PDZZ
+ ZDFDDRDZ(:,:,:) = -XCSHF*ZKEFF*D_PSI3DRDZ_O_DDRDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,GUSERV)
+ !
+ ! Compute Leonard Terms for Cloud mixing ratio
+ IF (LHGRAD) THEN
+ ZDELTAX= XXHAT(3) - XXHAT(2)
+ ZF_NEW (:,:,:)= XCOEFHGRADRM*ZDELTAX*ZDELTAX/12.0*( &
+ MXF(GX_W_UW(PWM(:,:,:), XDXX, XDZZ, XDZX)) &
+ *MZM(GX_M_M(PRM(:,:,:,1),XDXX,XDZZ,XDZX)) &
+ +MYF(GY_W_VW(PWM(:,:,:), XDYY,XDZZ,XDZY)) &
+ *MZM(GY_M_M(PRM(:,:,:,1),XDYY,XDZZ,XDZY)) )
+ END IF
+ !
+ ! Effect of 3rd order terms in temperature flux (at flux point)
+ !
+ ! d(w'2r')/dz
+ IF (GFWR) THEN
+ Z3RDMOMENT= M3_WR_W2R(PREDR1,PREDTH1,PD,ZKEFF,PTKEM)
+ !
+ ZF = ZF + Z3RDMOMENT * PFWR
+ ZDFDDRDZ = ZDFDDRDZ + D_M3_WR_W2R_O_DDRDZ(PREDR1,PREDTH1,PD,&
+ & PBLL_O_E,PEMOIST,ZKEFF,PTKEM) * PFWR
+ END IF
+ !
+ ! d(w'r'2)/dz
+ IF (GFR2) THEN
+ Z3RDMOMENT= M3_WR_WR2(PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST)
+ !
+ ZF = ZF + Z3RDMOMENT * MZM(PFR2)
+ ZDFDDRDZ = ZDFDDRDZ + D_M3_WR_WR2_O_DDRDZ(Z3RDMOMENT,PREDR1,&
+ & PREDTH1,PD,PBLL_O_E,PEMOIST) * MZM(PFR2)
+ END IF
+ !
+ ! d(w'2th')/dz
+ IF (GFWTH) THEN
+ ZF = ZF + M3_WR_W2TH(PD,ZKEFF,&
+ & PTKEM,PBLL_O_E,PETHETA,PDR_DZ) * PFWTH
+ ZDFDDRDZ = ZDFDDRDZ + D_M3_WR_W2TH_O_DDRDZ(PREDR1,PREDTH1,&
+ & PD,ZKEFF,PTKEM,PBLL_O_E,PETHETA) * PFWTH
+ END IF
+ !
+ ! d(w'th'2)/dz
+ IF (GFTH2) THEN
+ ZF = ZF + M3_WR_WTH2(PD,ZKEFF,PTKEM,&
+ & PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA,PDR_DZ) * MZM(PFTH2)
+ ZDFDDRDZ = ZDFDDRDZ + D_M3_WR_WTH2_O_DDRDZ(PREDR1,PREDTH1,PD,&
+ &ZKEFF,PTKEM,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA) * MZM(PFTH2)
+ END IF
+ !
+ ! d(w'th'r')/dz
+ IF (GFTHR) THEN
+ Z3RDMOMENT= M3_WR_WTHR(PREDTH1,PD,ZKEFF,PTKEM,PSQRT_TKE,PBETA,&
+ & PLEPS,PETHETA)
+ !
+ ZF = ZF + Z3RDMOMENT * MZM(PFTHR)
+ ZDFDDRDZ = ZDFDDRDZ + D_M3_WR_WTHR_O_DDRDZ(Z3RDMOMENT,PREDR1, &
+ & PREDTH1,PD,PBLL_O_E,PEMOIST) * MZM(PFTHR)
+ END IF
+ !
+ ! compute interface flux
+ IF (LCOUPLES) THEN ! coupling NH O-A
+ IF (LOCEAN) THEN ! ocean model in coupled case
+ ! evap effect on salinity to be added later !!!
+ ZF(:,:,IKE) = 0.
+ ELSE ! atmosph model in coupled case
+ ZF(:,:,IKB) = 0.
+ ! AJOUTER FLUX EVAP SUR MODELE ATMOS
+ ENDIF
+ !
+ ELSE ! No coupling NH OA case
+ ! atmosp bottom
+ !* in 3DIM case, a part of the flux goes vertically, and another goes horizontally
+ ! (in presence of slopes)
+ !* in 1DIM case, the part of energy released in horizontal flux
+ ! is taken into account in the vertical part
+ !
+ IF (HTURBDIM=='3DIM') THEN
+ ZF(:,:,IKB) = ( PIMPL*PSFRP(:,:) + PEXPL*PSFRM(:,:) ) &
+ * PDIRCOSZW(:,:) &
+ * 0.5 * (1. + PRHODJ(:,:,KKA) / PRHODJ(:,:,IKB))
+ ELSE
+ ZF(:,:,IKB) = ( PIMPL*PSFRP(:,:) + PEXPL*PSFRM(:,:) ) &
+ / PDIRCOSZW(:,:) &
+ * 0.5 * (1. + PRHODJ(:,:,KKA) / PRHODJ(:,:,IKB))
+ END IF
+ !
+ IF (LOCEAN) THEN
+ ! General ocean case
+ ! salinity/evap effect to be added later !!!!!
+ ZF(:,:,IKE) = 0.
+ ELSE !end ocean case (in nocoupled case)
+ ! atmos top
+ ZF(:,:,IKE)=0.
+ END IF
+ END IF!end no coupled cases
+ ! Compute the split conservative potential temperature at t+deltat
+ CALL TRIDIAG_THERMO(KKA,KKU,KKL,PRM(:,:,:,1),ZF,ZDFDDRDZ,PTSTEP,PIMPL,&
+ PDZZ,PRHODJ,PRP)
+ !
+ ! Compute the equivalent tendency for the conservative mixing ratio
+ !
+ ZRWRNP (:,:,:) = PRHODJ(:,:,:)*(PRP(:,:,:)-PRM(:,:,:,1))/PTSTEP
+ !
+ ! replace the flux by the Leonard terms above ZALT and ZCLD_THOLD
+ IF (LHGRAD) THEN
+ DO JK=1,KKU
+ ZALT(:,:,JK) = PZZ(:,:,JK)-XZS(:,:)
+ END DO
+ WHERE ( (ZCLD_THOLD(:,:,:) >= XCLDTHOLD ) .AND. ( ZALT(:,:,:) >= XALTHGRAD ) )
+ ZRWRNP (:,:,:) = -GZ_W_M(MZM(PRHODJ(:,:,:))*ZF_NEW(:,:,:),XDZZ)
+ END WHERE
+ END IF
+ !
+ PRRS(:,:,:,1) = PRRS(:,:,:,1) + ZRWRNP (:,:,:)
+ !
+ !* 3.2 Complete thermal production
+ !
+ ! cons. mixing ratio flux :
+ !
+ ZFLXZ(:,:,:) = ZF &
+ + PIMPL * ZDFDDRDZ * DZM(PRP - PRM(:,:,:,1)) / PDZZ
+ !
+ ! replace the flux by the Leonard terms above ZALT and ZCLD_THOLD
+ IF (LHGRAD) THEN
+ WHERE ( (ZCLD_THOLD(:,:,:) >= XCLDTHOLD ) .AND. ( ZALT(:,:,:) >= XALTHGRAD ) )
+ ZFLXZ(:,:,:) = ZF_NEW(:,:,:)
+ END WHERE
+ END IF
+ !
+ ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
+ !
+ DO JK=IKTB+1,IKTE-1
+ PWRC(:,:,JK)=0.5*(ZFLXZ(:,:,JK)+ZFLXZ(:,:,JK+KKL))
+ END DO
+ PWRC(:,:,IKB)=0.5*(ZFLXZ(:,:,IKB)+ZFLXZ(:,:,IKB+KKL))
+ PWRC(:,:,KKA)=0.5*(ZFLXZ(:,:,KKA)+ZFLXZ(:,:,KKA+KKL))
+ PWRC(:,:,IKE)=PWRC(:,:,IKE-KKL)
+ !
+ !
+ IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
+ ! stores the conservative mixing ratio vertical flux
+ TZFIELD%CMNHNAME = 'RCONSW_FLX'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'RCONSW_FLX'
+ TZFIELD%CUNITS = 'kg m s-1 kg-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'Conservative mixing ratio vertical flux'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZ)
+ END IF
+ !
+ ! Contribution of the conservative water flux to the Buoyancy flux
+ IF (LOCEAN) THEN
+ ZA(:,:,:)= -XG*XBETAOC * MZF(ZFLXZ )
+ ELSE
+ ZA(:,:,:) = PBETA * MZF( MZM(PEMOIST) * ZFLXZ )
+ ZA(:,:,IKB) = PBETA(:,:,IKB) * PEMOIST(:,:,IKB) * &
+ 0.5 * ( ZFLXZ (:,:,IKB) + ZFLXZ (:,:,IKB+KKL) )
+ PTP(:,:,:) = PTP(:,:,:) + ZA(:,:,:)
+ END IF
+ !
+ ! Buoyancy flux at flux points
+ !
+ PWTHV = PWTHV + MZM(PEMOIST) * ZFLXZ
+ PWTHV(:,:,IKB) = PWTHV(:,:,IKB) + PEMOIST(:,:,IKB) * ZFLXZ(:,:,IKB)
+ IF (LOCEAN) THEN
+ PWTHV(:,:,IKE) = PWTHV(:,:,IKE) + PEMOIST(:,:,IKE)* ZFLXZ(:,:,IKE)
+ END IF
+!
+!* 3.3 Complete vertical divergence of the < Rc w > flux
+!
+ IF ( KRRL >= 1 ) THEN
+ IF ( KRRI >= 1 ) THEN
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) - &
+ PRHODJ*PAMOIST*2.*PSRCM*DZF(ZFLXZ/PDZZ ) &
+ *(1.0-PFRAC_ICE(:,:,:))
+ PRRS(:,:,:,4) = PRRS(:,:,:,4) - &
+ PRHODJ*PAMOIST*2.*PSRCM*DZF(ZFLXZ/PDZZ ) &
+ *PFRAC_ICE(:,:,:)
+ ELSE
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) - &
+ PRHODJ*PAMOIST*2.*PSRCM*DZF(ZFLXZ/PDZZ )
+ END IF
+ END IF
+!
+!* 3.4 Storage in LES configuration
+!
+ IF (LLES_CALL) THEN
+ CALL SECOND_MNH(ZTIME1)
+ CALL LES_MEAN_SUBGRID( MZF(ZFLXZ), X_LES_SUBGRID_WRt )
+ CALL LES_MEAN_SUBGRID( MZF(PWM*ZFLXZ), X_LES_RES_W_SBG_WRt )
+ CALL LES_MEAN_SUBGRID( GZ_W_M(PWM,PDZZ)*MZF(ZFLXZ),&
+ & X_LES_RES_ddxa_W_SBG_UaRt )
+ CALL LES_MEAN_SUBGRID( MZF(PDTH_DZ*ZFLXZ), X_LES_RES_ddxa_Thl_SBG_UaRt )
+ CALL LES_MEAN_SUBGRID( MZF(PDR_DZ*ZFLXZ), X_LES_RES_ddxa_Rt_SBG_UaRt )
+ CALL LES_MEAN_SUBGRID( MZF(MZM(PEMOIST)*ZFLXZ), X_LES_SUBGRID_WThv , .TRUE. )
+ CALL LES_MEAN_SUBGRID( -XCTP*PSQRT_TKE/PLM*MZF(ZFLXZ), X_LES_SUBGRID_RtPz )
+ CALL SECOND_MNH(ZTIME2)
+ XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ END IF
+!
+END IF
+!
+!----------------------------------------------------------------------------
+!
+!
+!* 4. TURBULENT CORRELATIONS : <w Rc>
+! -------------------------------
+!
+!
+!* 4.1 <w Rc>
+!
+IF ( ((OTURB_FLX .AND. tpfile%lopened) .OR. LLES_CALL) .AND. (KRRL > 0) ) THEN
+ !
+ ! recover the Conservative potential temperature flux :
+ ZA(:,:,:) = DZM(PIMPL * PTHLP + PEXPL * PTHLM) / PDZZ * &
+ (-PPHI3*MZM(PLM*PSQRT_TKE)) * XCSHF
+ ZA(:,:,IKB) = ( PIMPL*PSFTHP(:,:) + PEXPL*PSFTHM(:,:) ) &
+ * PDIRCOSZW(:,:)
+ !
+ ! compute <w Rc>
+ ZFLXZ(:,:,:) = MZM( PAMOIST * 2.* PSRCM ) * ZFLXZ(:,:,:) + &
+ MZM( PATHETA * 2.* PSRCM ) * ZA(:,:,:)
+ ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
+ !
+ ! store the liquid water mixing ratio vertical flux
+ IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
+ TZFIELD%CMNHNAME = 'RCW_FLX'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'RCW_FLX'
+ TZFIELD%CUNITS = 'kg m s-1 kg-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'Liquid water mixing ratio vertical flux'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZ)
+ END IF
+ !
+! and we store in LES configuration this subgrid flux <w'rc'>
+!
+ IF (LLES_CALL) THEN
+ CALL SECOND_MNH(ZTIME1)
+ CALL LES_MEAN_SUBGRID( MZF(ZFLXZ), X_LES_SUBGRID_WRc )
+ CALL SECOND_MNH(ZTIME2)
+ XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ END IF
+!
+END IF !end of <w Rc>
+IF (LOCEAN.AND.LDEEPOC) THEN
+ DEALLOCATE(ZXHAT_ll,ZYHAT_ll)
+END IF
+!
+!----------------------------------------------------------------------------
+END SUBROUTINE TURB_VER_THERMO_FLUX
--
GitLab