From aae9fd0e1f62d7233c6a7ec587270fca2b2fb561 Mon Sep 17 00:00:00 2001 From: Francis Vitt <fvitt@ucar.edu> Date: Wed, 11 Dec 2024 16:11:33 -0700 Subject: [PATCH 01/24] merge in CARMA_TS_cam6_4_038 branch --- .gitmodules | 4 +- bld/build-namelist | 176 +- bld/config_files/definition.xml | 12 +- bld/configure | 22 +- bld/namelist_files/namelist_defaults_cam.xml | 571 ++ bld/namelist_files/namelist_definition.xml | 293 +- .../use_cases/carma_trop_strat_cam6.xml | 135 + .../use_cases/carma_trop_strat_hist_cam6.xml | 57 + .../carma_trop_strat_nudged_cam6.xml | 118 + .../use_cases/carma_trop_strat_sd_cam6.xml | 75 + .../use_cases/carma_waccm_ma_hist_cam6.xml | 48 + .../use_cases/carma_waccm_ma_nudged_cam6.xml | 102 + cime_config/config_component.xml | 13 +- cime_config/config_compsets.xml | 40 +- cime_config/config_pes.xml | 4 +- .../testmods_dirs/cam/carma_dust/user_nl_cam | 1 - .../cam/carma_elvemis_outfrq9s/shell_commands | 2 + .../cam/carma_elvemis_outfrq9s/user_nl_cam | 14 + .../cam/carma_elvemis_outfrq9s/user_nl_clm | 27 + .../cam/carma_meteor_impact/user_nl_cam | 1 - .../cam/carma_meteor_smoke/user_nl_cam | 2 - .../cam/carma_mixed_sulfate/user_nl_cam | 1 - .../testmods_dirs/cam/carma_pmc/user_nl_cam | 1 - .../cam/carma_sea_salt/user_nl_cam | 1 - .../cam/carma_sulfate/user_nl_cam | 1 - .../cam/carma_test_growth/user_nl_cam | 1 - .../cam/carma_test_passive/user_nl_cam | 1 - .../cam/carma_test_radiative/user_nl_cam | 1 - .../cam/carma_test_swelling/user_nl_cam | 1 - .../cam/carma_test_tracers/user_nl_cam | 1 - .../cam/carma_test_tracers2/user_nl_cam | 1 - src/chemistry/aerosol/aero_deposition_cam.F90 | 2 +- src/chemistry/aerosol/aero_wetdep_cam.F90 | 30 +- src/chemistry/aerosol/aerosol_state_mod.F90 | 18 +- .../aerosol/carma_aerosol_properties_mod.F90 | 867 ++ .../aerosol/carma_aerosol_state_mod.F90 | 591 ++ .../hygrocoreshell_aerosol_optics_mod.F90 | 292 + .../hygrowghtpct_aerosol_optics_mod.F90 | 188 + src/chemistry/aerosol/mo_setsox.F90 | 122 +- .../aerosol/modal_aerosol_state_mod.F90 | 22 +- src/chemistry/bulk_aero/aero_model.F90 | 19 +- src/chemistry/bulk_aero/sox_cldaero_mod.F90 | 30 +- src/chemistry/carma_aero/aero_model.F90 | 1635 ++++ .../carma_aero/carma_aero_gasaerexch.F90 | 1117 +++ src/chemistry/carma_aero/dust_model.F90 | 20 + src/chemistry/carma_aero/seasalt_model.F90 | 19 + src/chemistry/carma_aero/sox_cldaero_mod.F90 | 528 ++ src/chemistry/modal_aero/aero_model.F90 | 18 +- src/chemistry/modal_aero/sox_cldaero_mod.F90 | 27 +- src/chemistry/mozart/chemistry.F90 | 17 +- src/chemistry/mozart/mo_gas_phase_chemdr.F90 | 30 +- src/chemistry/mozart/mo_photo.F90 | 14 +- src/chemistry/mozart/mo_usrrxt.F90 | 59 +- .../pp_trop_strat_noaero/chem_mech.doc | 1725 ++++ .../pp_trop_strat_noaero/chem_mech.in | 1121 +++ .../pp_trop_strat_noaero/chem_mods.F90 | 51 + .../pp_trop_strat_noaero/m_rxt_id.F90 | 535 ++ .../pp_trop_strat_noaero/m_spc_id.F90 | 205 + .../pp_trop_strat_noaero/mo_adjrxt.F90 | 430 + .../pp_trop_strat_noaero/mo_exp_sol.F90 | 81 + .../pp_trop_strat_noaero/mo_imp_sol.F90 | 435 + .../pp_trop_strat_noaero/mo_indprd.F90 | 257 + .../pp_trop_strat_noaero/mo_lin_matrix.F90 | 598 ++ .../pp_trop_strat_noaero/mo_lu_factor.F90 | 7261 +++++++++++++++++ .../pp_trop_strat_noaero/mo_lu_solve.F90 | 2301 ++++++ .../pp_trop_strat_noaero/mo_nln_matrix.F90 | 3282 ++++++++ .../pp_trop_strat_noaero/mo_phtadj.F90 | 27 + .../pp_trop_strat_noaero/mo_prod_loss.F90 | 1159 +++ .../mo_rxt_rates_conv.F90 | 544 ++ .../pp_trop_strat_noaero/mo_setrxt.F90 | 696 ++ .../pp_trop_strat_noaero/mo_sim_dat.F90 | 770 ++ .../pp_waccm_ma_noaero/chem_mech.doc | 775 ++ src/chemistry/pp_waccm_ma_noaero/chem_mech.in | 622 ++ .../pp_waccm_ma_noaero/chem_mods.F90 | 51 + src/chemistry/pp_waccm_ma_noaero/m_rxt_id.F90 | 315 + src/chemistry/pp_waccm_ma_noaero/m_spc_id.F90 | 84 + .../pp_waccm_ma_noaero/mo_adjrxt.F90 | 233 + .../pp_waccm_ma_noaero/mo_exp_sol.F90 | 81 + .../pp_waccm_ma_noaero/mo_imp_sol.F90 | 435 + .../pp_waccm_ma_noaero/mo_indprd.F90 | 123 + .../pp_waccm_ma_noaero/mo_lin_matrix.F90 | 309 + .../pp_waccm_ma_noaero/mo_lu_factor.F90 | 3204 ++++++++ .../pp_waccm_ma_noaero/mo_lu_solve.F90 | 849 ++ .../pp_waccm_ma_noaero/mo_nln_matrix.F90 | 1251 +++ .../pp_waccm_ma_noaero/mo_phtadj.F90 | 33 + .../pp_waccm_ma_noaero/mo_prod_loss.F90 | 493 ++ .../pp_waccm_ma_noaero/mo_rxt_rates_conv.F90 | 324 + .../pp_waccm_ma_noaero/mo_setrxt.F90 | 419 + .../pp_waccm_ma_noaero/mo_sim_dat.F90 | 500 ++ .../utils/elevated_emissions_mod.F90 | 439 + src/chemistry/utils/surface_emissions_mod.F90 | 420 + src/control/cam_history.F90 | 2 +- src/control/runtime_opts.F90 | 4 + src/physics/cam/aer_rad_props.F90 | 23 +- src/physics/cam/aerosol_optics_cam.F90 | 68 +- src/physics/cam/carma_flags_mod.F90 | 238 +- src/physics/cam/carma_intr.F90 | 312 +- src/physics/cam/clubb_intr.F90 | 60 +- src/physics/cam/constituents.F90 | 14 +- src/physics/cam/micro_pumas_cam.F90 | 51 +- src/physics/cam/microp_aero.F90 | 52 +- src/physics/cam/ndrop.F90 | 2 +- src/physics/cam/ndrop_bam.F90 | 26 +- src/physics/cam/nucleate_ice.F90 | 22 +- src/physics/cam/nucleate_ice_cam.F90 | 73 +- src/physics/cam/phys_control.F90 | 9 +- src/physics/cam/phys_prop.F90 | 406 +- src/physics/cam/physics_types.F90 | 6 +- src/physics/cam/physpkg.F90 | 119 +- src/physics/cam/rad_constituents.F90 | 1417 +++- src/physics/cam/restart_physics.F90 | 7 + src/physics/cam/vertical_diffusion.F90 | 70 +- src/physics/cam7/micro_pumas_cam.F90 | 2 + src/physics/cam7/physpkg.F90 | 23 +- src/physics/carma/base | 2 +- src/physics/carma/cam/carma_constants_mod.F90 | 9 +- src/physics/carma/cam/carma_intr.F90 | 2420 ++++-- .../carma/models/dust/carma_model_mod.F90 | 225 +- .../models/meteor_impact/carma_model_mod.F90 | 265 +- .../models/meteor_smoke/carma_model_mod.F90 | 229 +- .../models/mixed_sulfate/carma_model_mod.F90 | 249 +- .../carma/models/pmc/carma_model_mod.F90 | 253 +- .../carma/models/sea_salt/carma_model_mod.F90 | 227 +- .../carma/models/sulfate/carma_model_mod.F90 | 190 +- .../models/test_growth/carma_model_mod.F90 | 233 +- .../models/test_passive/carma_model_mod.F90 | 194 +- .../models/test_radiative/carma_model_mod.F90 | 201 +- .../models/test_swelling/carma_model_mod.F90 | 200 +- .../models/test_tracers/carma_model_mod.F90 | 213 +- .../models/test_tracers2/carma_model_mod.F90 | 217 +- .../trop_strat_soa1/carma_model_flags_mod.F90 | 113 + .../trop_strat_soa1/carma_model_mod.F90 | 4501 ++++++++++ .../trop_strat_soa5/carma_model_flags_mod.F90 | 113 + .../trop_strat_soa5/carma_model_mod.F90 | 4790 +++++++++++ 134 files changed, 56036 insertions(+), 1644 deletions(-) create mode 100644 bld/namelist_files/use_cases/carma_trop_strat_cam6.xml create mode 100644 bld/namelist_files/use_cases/carma_trop_strat_hist_cam6.xml create mode 100644 bld/namelist_files/use_cases/carma_trop_strat_nudged_cam6.xml create mode 100644 bld/namelist_files/use_cases/carma_trop_strat_sd_cam6.xml create mode 100644 bld/namelist_files/use_cases/carma_waccm_ma_hist_cam6.xml create mode 100644 bld/namelist_files/use_cases/carma_waccm_ma_nudged_cam6.xml create mode 100644 cime_config/testdefs/testmods_dirs/cam/carma_elvemis_outfrq9s/shell_commands create mode 100644 cime_config/testdefs/testmods_dirs/cam/carma_elvemis_outfrq9s/user_nl_cam create mode 100644 cime_config/testdefs/testmods_dirs/cam/carma_elvemis_outfrq9s/user_nl_clm create mode 100644 src/chemistry/aerosol/carma_aerosol_properties_mod.F90 create mode 100644 src/chemistry/aerosol/carma_aerosol_state_mod.F90 create mode 100644 src/chemistry/aerosol/hygrocoreshell_aerosol_optics_mod.F90 create mode 100644 src/chemistry/aerosol/hygrowghtpct_aerosol_optics_mod.F90 create mode 100644 src/chemistry/carma_aero/aero_model.F90 create mode 100644 src/chemistry/carma_aero/carma_aero_gasaerexch.F90 create mode 100644 src/chemistry/carma_aero/dust_model.F90 create mode 100644 src/chemistry/carma_aero/seasalt_model.F90 create mode 100644 src/chemistry/carma_aero/sox_cldaero_mod.F90 create mode 100644 src/chemistry/pp_trop_strat_noaero/chem_mech.doc create mode 100644 src/chemistry/pp_trop_strat_noaero/chem_mech.in create mode 100644 src/chemistry/pp_trop_strat_noaero/chem_mods.F90 create mode 100644 src/chemistry/pp_trop_strat_noaero/m_rxt_id.F90 create mode 100644 src/chemistry/pp_trop_strat_noaero/m_spc_id.F90 create mode 100644 src/chemistry/pp_trop_strat_noaero/mo_adjrxt.F90 create mode 100644 src/chemistry/pp_trop_strat_noaero/mo_exp_sol.F90 create mode 100644 src/chemistry/pp_trop_strat_noaero/mo_imp_sol.F90 create mode 100644 src/chemistry/pp_trop_strat_noaero/mo_indprd.F90 create mode 100644 src/chemistry/pp_trop_strat_noaero/mo_lin_matrix.F90 create mode 100644 src/chemistry/pp_trop_strat_noaero/mo_lu_factor.F90 create mode 100644 src/chemistry/pp_trop_strat_noaero/mo_lu_solve.F90 create mode 100644 src/chemistry/pp_trop_strat_noaero/mo_nln_matrix.F90 create mode 100644 src/chemistry/pp_trop_strat_noaero/mo_phtadj.F90 create mode 100644 src/chemistry/pp_trop_strat_noaero/mo_prod_loss.F90 create mode 100644 src/chemistry/pp_trop_strat_noaero/mo_rxt_rates_conv.F90 create mode 100644 src/chemistry/pp_trop_strat_noaero/mo_setrxt.F90 create mode 100644 src/chemistry/pp_trop_strat_noaero/mo_sim_dat.F90 create mode 100644 src/chemistry/pp_waccm_ma_noaero/chem_mech.doc create mode 100644 src/chemistry/pp_waccm_ma_noaero/chem_mech.in create mode 100644 src/chemistry/pp_waccm_ma_noaero/chem_mods.F90 create mode 100644 src/chemistry/pp_waccm_ma_noaero/m_rxt_id.F90 create mode 100644 src/chemistry/pp_waccm_ma_noaero/m_spc_id.F90 create mode 100644 src/chemistry/pp_waccm_ma_noaero/mo_adjrxt.F90 create mode 100644 src/chemistry/pp_waccm_ma_noaero/mo_exp_sol.F90 create mode 100644 src/chemistry/pp_waccm_ma_noaero/mo_imp_sol.F90 create mode 100644 src/chemistry/pp_waccm_ma_noaero/mo_indprd.F90 create mode 100644 src/chemistry/pp_waccm_ma_noaero/mo_lin_matrix.F90 create mode 100644 src/chemistry/pp_waccm_ma_noaero/mo_lu_factor.F90 create mode 100644 src/chemistry/pp_waccm_ma_noaero/mo_lu_solve.F90 create mode 100644 src/chemistry/pp_waccm_ma_noaero/mo_nln_matrix.F90 create mode 100644 src/chemistry/pp_waccm_ma_noaero/mo_phtadj.F90 create mode 100644 src/chemistry/pp_waccm_ma_noaero/mo_prod_loss.F90 create mode 100644 src/chemistry/pp_waccm_ma_noaero/mo_rxt_rates_conv.F90 create mode 100644 src/chemistry/pp_waccm_ma_noaero/mo_setrxt.F90 create mode 100644 src/chemistry/pp_waccm_ma_noaero/mo_sim_dat.F90 create mode 100644 src/chemistry/utils/elevated_emissions_mod.F90 create mode 100644 src/chemistry/utils/surface_emissions_mod.F90 create mode 100644 src/physics/carma/models/trop_strat_soa1/carma_model_flags_mod.F90 create mode 100644 src/physics/carma/models/trop_strat_soa1/carma_model_mod.F90 create mode 100644 src/physics/carma/models/trop_strat_soa5/carma_model_flags_mod.F90 create mode 100644 src/physics/carma/models/trop_strat_soa5/carma_model_mod.F90 diff --git a/.gitmodules b/.gitmodules index 817bb1ff6b..e49b99873a 100644 --- a/.gitmodules +++ b/.gitmodules @@ -7,9 +7,9 @@ [submodule "carma"] path = src/physics/carma/base - url = https://github.com/ESCOMP/CARMA_base.git + url = https://github.com/ESCOMP/CARMA_base.git fxrequired = AlwaysRequired - fxtag = carma4_01 + fxtag = carma4_09 fxDONOTUSEurl = https://github.com/ESCOMP/CARMA_base.git [submodule "pumas"] diff --git a/bld/build-namelist b/bld/build-namelist index 66c3574a62..4760f3629d 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -1268,6 +1268,7 @@ if ($carma ne 'none') { add_default($nl, 'carma_model', 'val'=>$carma); add_default($nl, 'carma_flag', 'val'=>'.true.'); add_default($nl, 'history_carma', 'val'=>'.true.'); + add_default($nl, 'carma_sulfnuc_method','val'=>'ZhaoTurco'); } if ($carma eq 'bc_strat') { add_default($nl, 'carma_do_drydep', 'val'=>'.true.'); @@ -1541,12 +1542,74 @@ elsif ($carma eq 'tholin') { add_default($nl, 'carma_emis_total', 'val'=>'1e5'); add_default($nl, 'carma_emis_file'); } +elsif ($carma =~ /trop_strat/) { + add_default($nl, 'carma_do_fixedinit','val'=>'.false.'); + add_default($nl, 'carma_do_partialinit','val'=>'.false.'); + add_default($nl, 'carma_do_drydep', 'val'=>'.true.'); + add_default($nl, 'carma_do_optics', 'val'=>'.false.'); + add_default($nl, 'carma_do_vtran', 'val'=>'.true.'); + add_default($nl, 'carma_do_wetdep', 'val'=>'.false.'); + add_default($nl, 'carma_soilerosion_file'); + add_default($nl, 'carma_fields', 'val'=>'Sl_soilw'); + add_default($nl, 'carma_do_vdiff', 'val'=>'.true.'); + add_default($nl, 'carma_do_WeibullK', 'val'=>'.false.'); + add_default($nl, 'carma_seasalt_emis','val'=>'Gong'); + add_default($nl, 'carma_do_coag', 'val'=>'.true.'); + add_default($nl, 'carma_do_grow', 'val'=>'.true.'); + add_default($nl, 'carma_do_substep', 'val'=>'.true.'); + add_default($nl, 'carma_do_thermo', 'val'=>'.false.'); + add_default($nl, 'carma_seasalt_emis','val'=>'Gong'); + add_default($nl, 'carma_maxretries', 'val'=>'20'); + add_default($nl, 'carma_maxsubsteps', 'val'=>'2'); + add_default($nl, 'carma_dt_threshold','val'=>'2.0'); + add_default($nl, 'carma_hetchem_feedback','val'=>'.false.'); + add_default($nl, 'bin_defs'); + add_default($nl, 'rad_climate'); + add_default($nl, 'carma_do_emission', 'val'=>'.true.'); + add_default($nl, 'water_refindex_file'); + add_default($nl, 'carma_do_cloudborne', 'val'=>'.true.'); + + # emissions + add_default($nl, 'carma_BCOCemissions','val'=>'Specified'); + my $carma_BCOCemis = $nl->get_value('carma_BCOCemissions'); + $carma_BCOCemis =~ s/['"]//g; # strip quotes "' + if ($carma_BCOCemis eq 'Specified') { + my %verhash; # = ('ver'=>'cam6'); + if ( $sim_year == '2000' ) { + %verhash = ('ver'=>'2000cam6'); + add_default($nl, 'emissions_type', 'val'=>'CYCLICAL'); + add_default($nl, 'emissions_cycle_yr', 'val'=>'2000'); + } else { + %verhash = ('ver'=>'cam6'); + add_default($nl, 'emissions_type', 'val'=>'INTERP_MISSING_MONTHS'); + } + my %species = ('bc_a4_an_srf_file' => 'BC', + 'bc_a4_bb_srf_file' => 'BC', + 'pom_a4_an_srf_file' => 'OC', + 'pom_a4_bb_srf_file' => 'OC' ); + my $first = 1; my $pre = ""; my $val = ""; + foreach my $id (sort keys %species) { + my $rel_filepath = get_default_value($id, \%verhash); + my $abs_filepath = set_abs_filepath($rel_filepath, $inputdata_rootdir); + $val .= $pre . quote_string("$species{$id} -> " . $abs_filepath); + if ($first) { $pre = ","; $first = 0; } + } + add_default($nl, 'emissions_specifier', 'val'=>$val); + } else { + add_default($nl, 'BC_GAINS_filename'); + add_default($nl, 'OC_GAINS_filename'); + add_default($nl, 'BC_ship_filename'); + add_default($nl, 'OC_ship_filename'); + add_default($nl, 'BC_GFEDv3_filename'); + add_default($nl, 'OC_GFEDv3_filename'); + } +} # Stratospheric sulfur aerosols # turn on stratospheric aerosol forcings in CAM6 configurations my $chem_has_ocs = chem_has_species($cfg, 'OCS'); -if (($phys =~ /cam6/ or $phys =~ /cam7/) and $chem =~ /_mam/) { +if (($phys =~ /cam6/ or $phys =~ /cam7/) and $chem =~ /_mam/ and $carma eq 'none') { # turn on volc forcings in cam6 -- prognostic or prescribed if ( $chem_has_ocs ) { # turn on prognostic stratospheric aerosols @@ -1587,7 +1650,8 @@ if (defined $nl->get_value('prescribed_strataero_3modes')) { # determine if prescribed stratospheric aerosol data is needed if ( ($het_chem) || ($nl->get_value('prescribed_strataero_feedback') =~ /$TRUE/io ) ){ - if ( ($carma ne 'sulfate') && !($nl->get_value('modal_strat_sulfate') =~ /$TRUE/io) ) { # if no prognostic stratospheric aerosols + if ( ($carma ne 'sulfate') && !($carma =~ /trop_strat/) && + !($nl->get_value('modal_strat_sulfate') =~ /$TRUE/io) ) { # if no prognostic stratospheric aerosols unless (defined $nl->get_value('prescribed_strataero_type')) { add_default($nl, 'prescribed_strataero_type','val'=>'CYCLICAL'); @@ -2218,7 +2282,7 @@ if ($chem eq 'trop_mam3') { } # CMIP6 emissions -if (($chem =~ /_mam4/ or $chem =~ /_mam5/) and ($phys =~ /cam6/ or $phys =~ /cam7/)) { +if ($phys =~ /cam6/ or $phys =~ /cam7/) { # OASISS (ocean) DMS emissions if (!$aqua_mode and !$scam) { @@ -2239,37 +2303,40 @@ if (($chem =~ /_mam4/ or $chem =~ /_mam5/) and ($phys =~ /cam6/ or $phys =~ /cam } } - my %species; + my %species = ('dms_bb_srf_file' => 'DMS', + 'so2_ag_sh_file' => 'SO2', + 'so2_an_srf_file' => 'SO2', + 'so2_bb_srf_file' => 'SO2'); - # Surface emission datasets: - %species = ('dms_bb_srf_file' => 'DMS', - 'so2_ag_sh_file' => 'SO2', - 'so2_an_srf_file' => 'SO2', - 'so2_bb_srf_file' => 'SO2', - 'so4_a1_an_srf_file' => 'so4_a1', - 'so4_a1_bb_srf_file' => 'so4_a1', - 'so4_a2_an_srf_file' => 'so4_a2', - 'num_a1_sh_srf_file' => 'num_a1', - 'num_a1_bb_srf_file' => 'num_a1', - 'num_a2_an_srf_file' => 'num_a2', - 'bc_a4_an_srf_file' => 'bc_a4', - 'bc_a4_bb_srf_file' => 'bc_a4', - 'num_a4_bc_srf_file' => 'num_a4', - 'num_a4_oc_srf_file' => 'num_a4', - 'num_a4_bb_srf_file' => 'num_a4', - 'num_pom_bb_srf_file' => 'num_a4' ); - if ((not defined $nl->get_value('csw_specifier')) or (not $nl->get_value('csw_specifier') ~~ /DMS/)) { - %species = (%species, - 'dms_ot_srf_file' => 'DMS' ); - } - if ($chem =~ /_vbsext/) { - %species = (%species, - 'pom_a4_an_srf_file' => 'pomff1_a4', - 'pom_a4_bb_srf_file' => 'pombb1_a4' ); - } else { + if ($chem =~ /_mam4/ or $chem =~ /_mam5/) { + + # Surface emission datasets: %species = (%species, - 'pom_a4_an_srf_file' => 'pom_a4', - 'pom_a4_bb_srf_file' => 'pom_a4' ); + 'so4_a1_an_srf_file' => 'so4_a1', + 'so4_a1_bb_srf_file' => 'so4_a1', + 'so4_a2_an_srf_file' => 'so4_a2', + 'num_a1_sh_srf_file' => 'num_a1', + 'num_a1_bb_srf_file' => 'num_a1', + 'num_a2_an_srf_file' => 'num_a2', + 'bc_a4_an_srf_file' => 'bc_a4', + 'bc_a4_bb_srf_file' => 'bc_a4', + 'num_a4_bc_srf_file' => 'num_a4', + 'num_a4_oc_srf_file' => 'num_a4', + 'num_a4_bb_srf_file' => 'num_a4', + 'num_pom_bb_srf_file' => 'num_a4' ); + if ((not defined $nl->get_value('csw_specifier')) or (not $nl->get_value('csw_specifier') ~~ /DMS/)) { + %species = (%species, + 'dms_ot_srf_file' => 'DMS' ); + } + if ($chem =~ /_vbsext/) { + %species = (%species, + 'pom_a4_an_srf_file' => 'pomff1_a4', + 'pom_a4_bb_srf_file' => 'pombb1_a4' ); + } else { + %species = (%species, + 'pom_a4_an_srf_file' => 'pom_a4', + 'pom_a4_bb_srf_file' => 'pom_a4' ); + } } # for old simple SOA schemes (without SOAE) @@ -2435,20 +2502,20 @@ if (($chem =~ /_mam4/ or $chem =~ /_mam5/) and ($phys =~ /cam6/ or $phys =~ /cam } # Vertical emission datasets: - %species = ('so2_cv_ext_file' => 'SO2', - 'so4_a1_an_ext_file' => 'so4_a1', - 'so4_a1_cv_ext_file' => 'so4_a1', - 'so4_a2_cv_ext_file' => 'so4_a2', - 'num_a1_an_ext_file' => 'num_a1', - 'num_a1_cv_ext_file' => 'num_a1', - 'num_a2_cv_ext_file' => 'num_a2', + %species = ('so2_cv_ext_file' => 'SO2'); + if ($chem =~ /_mam4/ or $chem =~ /_mam5/) { + %species = (%species, + 'so4_a1_an_ext_file' => 'so4_a1', + 'so4_a1_cv_ext_file' => 'so4_a1', + 'so4_a2_cv_ext_file' => 'so4_a2', + 'num_a1_an_ext_file' => 'num_a1', + 'num_a1_cv_ext_file' => 'num_a1', + 'num_a2_cv_ext_file' => 'num_a2', ); - + } # air craft emissions if ($chem !~ /trop_mam/ and $chem !~ /ghg_mam/ and $chem !~ /waccm_sc/) { %species = (%species, - 'bc_a4_ar_ext_file' => 'bc_a4', - 'num_a4_ar_ext_file' => 'num_a4', 'no2_ar_ext_file' => 'NO2', 'so2_ar_ext_file' => 'SO2' ); } elsif ($chem =~ /ghg_mam/) { @@ -2459,8 +2526,8 @@ if (($chem =~ /_mam4/ or $chem =~ /_mam5/) and ($phys =~ /cam6/ or $phys =~ /cam } # for transient cases include volcanic emissions - if ( ($nl->get_value('modal_strat_sulfate') =~ /$TRUE/io) and - (defined $nl->get_value('ext_frc_type')) ) { + if ( (($nl->get_value('modal_strat_sulfate') =~ /$TRUE/io) or ($carma eq 'trop_strat')) + and (defined $nl->get_value('ext_frc_type')) ) { if ( $nl->get_value('ext_frc_type') !~ /CYCLICAL/ ) { my $hgrid = $cfg->get('hgrid'); if ($hgrid =~ /1.9x2.5/) { @@ -2522,7 +2589,7 @@ if (($chem =~ /_mam4/ or $chem =~ /_mam5/) and ($phys =~ /cam6/ or $phys =~ /cam add_default($nl, 'megan_factors_file'); add_default($nl, 'megan_mapped_emisfctrs', 'val'=>'.false.'); } - if ($chem =~ /trop_strat_mam4_vbsext/ or $chem =~ /waccm_tsmlt/) { + if ($chem =~ /trop_strat_mam4_vbsext/ or $chem =~ /trop_strat_noaero/ or $chem =~ /waccm_tsmlt/) { my $val = "'ISOP = isoprene'," . "'MTERP = pinene_a + carene_3 + thujene_a + 2met_styrene + cymene_p + cymene_o + terpinolene + bornene +'" . "' fenchene_a + ocimene_al + pinene_b + sabinene + camphene + limonene + phellandrene_a + terpinene_g +'" @@ -3306,7 +3373,7 @@ add_default($nl, 'microp_aero_wsubi_min'); # Ice nucleation options if (!$simple_phys) { - if ($chem =~ /_mam/) { + if ($chem =~ /_mam/ or $carma =~ /trop_strat/) { add_default($nl, 'use_hetfrz_classnuc'); } else { add_default($nl, 'use_hetfrz_classnuc', 'val'=>'.false.'); @@ -3573,6 +3640,10 @@ if ($chem =~ /_mam/) { add_default($nl, 'sol_factb_interstitial'); add_default($nl, 'sol_factic_interstitial'); } +if ($carma =~ /trop_strat/) { + add_default($nl, 'sol_facti_cloud_borne'); + add_default($nl, 'sol_factic_interstitial'); +} # Turbulent Mountain Stress my $do_tms; @@ -4933,7 +5004,7 @@ sub check_input_files { my @vars = qw(aircraft_specifier csw_specifier ext_frc_specifier rad_climate rad_diag_1 rad_diag_2 rad_diag_3 rad_diag_4 rad_diag_5 rad_diag_6 rad_diag_7 rad_diag_8 rad_diag_9 - rad_diag_10 srf_emis_specifier mode_defs); + rad_diag_10 srf_emis_specifier mode_defs bin_defs); foreach my $var (@vars) { @@ -4995,7 +5066,7 @@ sub check_input_files { } # Look for values that begin with 'X:name:name2' where X is one of [AMN] # Extract name and filename - elsif ($spec =~ m/^\s*[AMN]:(\w+) # name of species preceded by optional whitespace and X: + elsif ($spec =~ m/^\s*[ABMN]:(\w+) # name of species preceded by optional whitespace and X: : # : separator (\S+) # name2 /xo) { @@ -5028,9 +5099,14 @@ sub check_input_files { my @flds = split /:/, $name2; if (scalar(@flds) >= 4) { + my $file; if ($flds[3] =~ m:^[/\$]:) { - - my $file = $flds[3]; + $file = $flds[3]; + } + elsif ($flds[4] =~ m:^[/\$]:) { + $file = $flds[4]; + } + if (defined $file) { if ($inputdata_rootdir) { print $fh "$var for $name = $file\n"; } diff --git a/bld/config_files/definition.xml b/bld/config_files/definition.xml index 0b7b6bca45..f5c8aadb65 100644 --- a/bld/config_files/definition.xml +++ b/bld/config_files/definition.xml @@ -95,16 +95,18 @@ PBL package: uw (University of Washington), hb (Holtslag and Boville), hbr Radiative transfer calculation: camrt (CAM4 RT package), rrtmg (RRTMG package from AER), rrtmgp (updated version). </entry> -<entry id="carma" valid_values="none,bc_strat,cirrus,cirrus_dust,dust,meteor_impact,meteor_smoke,mixed_sulfate,pmc,pmc_sulfate,sea_salt,sulfate,tholin,test_detrain,test_growth,test_passive,test_radiative,test_swelling,test_tracers,test_tracers2" value="none"> +<entry id="carma" valid_values="none,bc_strat,cirrus,cirrus_dust,dust,meteor_impact,meteor_smoke,mixed_sulfate,pmc,pmc_sulfate,sea_salt,sulfate,tholin,test_detrain,test_growth,test_passive,test_radiative,test_swelling,test_tracers,test_tracers2,trop_strat_soa1,trop_strat_soa5" value="none"> CARMA sectional microphysics: none (disabled), bc_strat (Stratospheric Black Carbon), cirrus (Cirrus Clouds), cirrus_dust (Cirrus Clouds with dust), dust (Dust), meteor_impact (Meteor Impact), meteor_smoke (Meteor Smoke), mixed_sulfate (Meteor Smoke and Sulfate), pmc (Polar Mesospheric Clouds), pmc_sulfate (PMC and Sulfate), sea_salt (Sea Salt), sulfate (Sulfate Aerosols), tholin (early earth haze), test_detrain (Detrainment), test_growth (Particle Growth), test_passive (Passive Dust), -test_radiative (Radiatively Active Dust), test_swelling (Sea Salt), test_tracers (Asian Monsoon), test_tracers2 (Guam). +test_radiative (Radiatively Active Dust), test_swelling (Sea Salt), test_tracers (Asian Monsoon), test_tracers2 (Guam), +trop_strat_soa1 (Trop Strat Aerosols SOA1), +trop_strat_soa5 (Trop Strat Aerosols SOA5) </entry> -<entry id="chem" valid_values="none,ghg_mam4,terminator,trop_mam3,trop_mam4,trop_mam7,trop_mozart,trop_strat_mam4_ts2,trop_strat_mam4_vbs,trop_strat_mam4_vbsext,trop_strat_mam5_ts2,trop_strat_mam5_ts4,trop_strat_mam5_vbs,trop_strat_mam5_vbsext,waccm_ma,waccm_mad,waccm_ma_sulfur,waccm_sc,waccm_sc_mam4,waccm_mad_mam4,waccm_ma_mam4,waccm_tsmlt_mam4,waccm_tsmlt_mam4_vbsext,waccm_mad_mam5,waccm_ma_mam5,waccm_tsmlt_mam5,waccm_tsmlt_mam5_vbsext,geoschem_mam4" value=""> - Chemistry package: none,ghg_mam4,terminator,trop_mam3,trop_mam4,trop_mam7,trop_mozart,trop_strat_mam4_ts2,trop_strat_mam4_vbs,trop_strat_mam4_vbsext,trop_strat_mam5_ts2,trop_strat_mam5_ts4,trop_strat_mam5_vbs,trop_strat_mam5_vbsext,waccm_ma,waccm_mad,waccm_ma_sulfur,waccm_sc,waccm_sc_mam4,waccm_mad_mam4,waccm_ma_mam4,waccm_tsmlt_mam4,waccm_tsmlt_mam4_vbsext,waccm_mad_mam5,waccm_ma_mam5,waccm_tsmlt_mam5,waccm_tsmlt_mam5_vbsext,geoschem_mam4 +<entry id="chem" valid_values="none,ghg_mam4,terminator,trop_mam3,trop_mam4,trop_mam7,trop_mozart,trop_strat_mam4_ts2,trop_strat_mam4_vbs,trop_strat_mam4_vbsext,trop_strat_mam5_ts2,trop_strat_mam5_ts4,trop_strat_mam5_vbs,trop_strat_mam5_vbsext,trop_strat_noaero,waccm_ma,waccm_mad,waccm_ma_sulfur,waccm_sc,waccm_sc_mam4,waccm_mad_mam4,waccm_ma_mam4,waccm_tsmlt_mam4,waccm_tsmlt_mam4_vbsext,waccm_mad_mam5,waccm_ma_mam5,waccm_tsmlt_mam5,waccm_tsmlt_mam5_vbsext,waccm_ma_noaero,geoschem_mam4" value=""> + Chemistry package: none,ghg_mam4,terminator,trop_mam3,trop_mam4,trop_mam7,trop_mozart,trop_strat_mam4_ts2,trop_strat_mam4_vbs,trop_strat_mam4_vbsext,trop_strat_mam5_ts2,trop_strat_mam5_ts4,trop_strat_mam5_vbs,trop_strat_mam5_vbsext,trop_strat_noaero,waccm_ma,waccm_mad,waccm_ma_sulfur,waccm_sc,waccm_sc_mam4,waccm_mad_mam4,waccm_ma_mam4,waccm_tsmlt_mam4,waccm_tsmlt_mam4_vbsext,waccm_mad_mam5,waccm_ma_mam5,waccm_tsmlt_mam5,waccm_tsmlt_mam5_vbsext,waccm_ma_noaero,geoschem_mam4 </entry> <entry id="prog_species" valid_values="DST,SSLT,SO4,GHG,OC,BC,CARBON16" value="" list="1"> Prognostic mozart species packages: list of any subset of the following: DST,SSLT,SO4,GHG,OC,BC,CARBON16 @@ -191,7 +193,7 @@ Total number of advected test tracers. <entry id="age_of_air_trcs" valid_values="0,1" value="0"> Switch on (off) age of air tracers: 0=off, 1=on. </entry> -<entry id="max_n_rad_cnst" value="30"> +<entry id="max_n_rad_cnst" value="80"> Maximum number of constituents that are radiatively active or in any one diagnostic list. </entry> diff --git a/bld/configure b/bld/configure index 9bee5d2077..47c56d5ea0 100755 --- a/bld/configure +++ b/bld/configure @@ -60,14 +60,14 @@ OPTIONS [ none | bc_strat | cirrus | cirrus_dust | dust | meteor_impact | meteor_smoke | mixed_sulfate | pmc | pmc_sulfate | sea_salt | sulfate | tholin | test_detrain | test_growth | test_passive | test_radiative | test_swelling | - test_tracers, test_tracers2]. + test_tracers, test_tracers2 | trop_strat_soa1 | trop_strat_soa5 ]. Default: none. - -chem <name> Build CAM with specified prognostic chemistry package - [ none | ghg_mam4 | terminator | trop_mam3 | trop_mam4 | trop_mam7 | trop_mozart | trop_strat_mam4_ts2 | - trop_strat_mam4_vbs | trop_strat_mam4_vbsext | trop_strat_mam5_ts2 | trop_strat_mam5_ts4 | trop_strat_mam5_vbs | + -chem <name> Build CAM with specified prognostic chemistry package + [ none | ghg_mam4 | terminator | trop_mam3 | trop_mam4 | trop_mam7 | trop_mozart | trop_strat_mam4_ts2 | + trop_strat_mam4_vbs | trop_strat_mam4_vbsext | trop_strat_mam5_ts2 | trop_strat_mam5_ts4 | trop_strat_mam5_vbs | trop_strat_noaero | trop_strat_mam5_vbsext | waccm_ma | waccm_mad | waccm_ma_sulfur | waccm_sc | waccm_sc_mam4 | waccm_mad_mam4 | waccm_ma_mam4 | waccm_tsmlt_mam4 | waccm_tsmlt_mam4_vbsext | waccm_mad_mam5 | - waccm_ma_mam5 | waccm_tsmlt_mam5 | waccm_tsmlt_mam5_vbsext | geoschem_mam4 ]. + waccm_ma_mam5 | waccm_tsmlt_mam5 | waccm_tsmlt_mam5_vbsext | waccm_ma_noaero | geoschem_mam4 ]. Default: trop_mam4 for cam6 and trop_mam3 for cam5. -[no]clubb_sgs Switch on [off] CLUBB_SGS. Default: on for cam6 and cam7, otherwise off. -clubb_opts <list> Comma separated list of CLUBB options to turn on/off. By default they are all off. @@ -1524,6 +1524,12 @@ elsif ($carma_pkg eq 'test_tracers') { elsif ($carma_pkg eq 'test_tracers2') { $carma_nadv = 434; } +elsif ($carma_pkg eq 'trop_strat_soa1') { + $carma_nadv = 140; +} +elsif ($carma_pkg eq 'trop_strat_soa5') { + $carma_nadv = 220; +} #----------------------------------------------------------------------------------------------- @@ -2234,8 +2240,10 @@ sub write_filepath print $fh "$camsrcdir/src/chemistry/pp_none\n"; } - if ($chem =~ /_mam/) { - print $fh "$camsrcdir/src/chemistry/modal_aero\n"; + if ($carma_pkg =~ /trop_strat/) { + print $fh "$camsrcdir/src/chemistry/carma_aero\n"; + } elsif ($chem =~ /_mam/) { + print $fh "$camsrcdir/src/chemistry/modal_aero\n"; } else { print $fh "$camsrcdir/src/chemistry/bulk_aero\n"; } diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index 462570da4a..ab4a8e28f8 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -80,6 +80,16 @@ <ncdata dyn="fv" hgrid="4x5" nlev="30" ic_ymd="101" >atm/cam/inic/fv/cami_0000-01-01_4x5_L30_c090108.nc</ncdata> <ncdata dyn="fv" hgrid="10x15" nlev="30" ic_ymd="101" >atm/cam/inic/fv/cami_0000-01-01_10x15_L30_c081013.nc</ncdata> +<ncdata dyn="fv" hgrid="10x15" nlev="32" carma="trop_strat_soa5">atm/cam/inic/fv/carma_trop_strat_2000_10x15_spinup01.cam.i.0002-01-01-00000_c211027.nc</ncdata> +<ncdata dyn="fv" hgrid="10x15" nlev="32" aquaplanet="1" carma="trop_strat_soa5">atm/cam/inic/fv/aqua_carma_trop_strat_10x15_spinup01.cam.i.0002-01-01-00000_c211027.nc</ncdata> + +<ncdata dyn="fv" hgrid="1.9x2.5" nlev="32" aquaplanet="1" carma="trop_strat_soa5">atm/cam/inic/fv/QPCARMATS_f19_carmats4038_spinup01_0002-01-01_c241029.nc</ncdata> + +<ncdata dyn="fv" hgrid="10x15" nlev="70" aquaplanet="1" carma="trop_strat_soa1">atm/waccm/ic/aqua_carma_waccm_0002-01-01_10x15_L70_c220325.nc</ncdata> +<ncdata dyn="fv" hgrid="1.9x2.5" nlev="70" carma="trop_strat_soa1">atm/waccm/ic/FWmaCARMAHIST_f19_carmats038_spinupl03.cam.i.1980-01-01_c241025.nc</ncdata> +<ncdata dyn="fv" hgrid="1.9x2.5" nlev="70" aquaplanet="1" carma="trop_strat_soa1">atm/cam/inic/fv/aqua_carma_waccm_0002-01-01_1.9x2.5_L70_c220809.nc</ncdata> +<ncdata dyn="fv" hgrid="0.9x1.25" nlev="70" carma="trop_strat_soa1">atm/waccm/ic/FWmaCARMAHIST_f09_spinup01.cam.i.1980-01-01-00000_c220128.nc</ncdata> + <ncdata dyn="fv" hgrid="0.9x1.25" nlev="32" chem="trop_strat_mam4_vbs">atm/cam/inic/fv/f.e22.FC2010climo.f09_f09_mg17.cam6_2_022.001.cam.i.0016-01-01-00000_c200610.nc</ncdata> <ncdata dyn="fv" hgrid="0.9x1.25" nlev="32" chem="trop_strat_mam4_ts2">atm/cam/inic/fv/f.e22.FC2010climo.f09_f09_mg17.cam6_2_022.001.cam.i.0016-01-01-00000_c200610.nc</ncdata> <ncdata dyn="fv" hgrid="0.9x1.25" nlev="32" chem="trop_strat_mam5_vbs">atm/cam/inic/fv/f.e22.FC2010climo.f09_f09_mg17.cam6_2_022.001.cam.i.0016-01-01-00000_c200610.nc</ncdata> @@ -619,6 +629,8 @@ <carma_escale_file carma="pmc_sulfate">atm/waccm/emis/smoke_grf_frentzke.nc</carma_escale_file> <carma_mice_file carma="pmc_sulfate">atm/cam/physprops/mice_warren2008.nc</carma_mice_file> <carma_soilerosion_file carma="cirrus_dust">atm/cam/dst/soil_erosion_factor_1x1_c120907.nc</carma_soilerosion_file> +<carma_soilerosion_file carma="trop_strat_soa1">atm/cam/dst/soil_erosion_factor_1x1_c120907.nc</carma_soilerosion_file> +<carma_soilerosion_file carma="trop_strat_soa5">atm/cam/dst/soil_erosion_factor_1x1_c120907.nc</carma_soilerosion_file> <carma_soilerosion_file carma="dust">atm/cam/dst/soil_erosion_factor_1x1_c120907.nc</carma_soilerosion_file> <carma_emis_file carma="tholin">atm/waccm/emis/early_earth_haze.nc</carma_emis_file> @@ -826,6 +838,8 @@ <effgw_beres_dp chem="trop_strat_mam4_vbsext" hgrid="0.9x1.25">0.5D0</effgw_beres_dp> <effgw_beres_dp chem="trop_strat_mam5_vbs" hgrid="0.9x1.25" >0.5D0</effgw_beres_dp> <effgw_beres_dp chem="trop_strat_mam5_vbsext" hgrid="0.9x1.25">0.5D0</effgw_beres_dp> +<effgw_beres_dp carma="trop_strat_soa1" hgrid="0.9x1.25" >0.5D0</effgw_beres_dp> +<effgw_beres_dp carma="trop_strat_soa5" hgrid="0.9x1.25" >0.5D0</effgw_beres_dp> <effgw_oro nlev="60" >0.0625D0</effgw_oro> @@ -858,6 +872,8 @@ <gw_oro_south_fac chem="trop_strat_mam4_vbsext">2.d0 </gw_oro_south_fac> <gw_oro_south_fac chem="trop_strat_mam5_vbs">2.d0 </gw_oro_south_fac> <gw_oro_south_fac chem="trop_strat_mam5_vbsext">2.d0 </gw_oro_south_fac> +<gw_oro_south_fac carma="trop_strat_soa1">2.D0</gw_oro_south_fac> +<gw_oro_south_fac carma="trop_strat_soa5">2.D0</gw_oro_south_fac> <gw_lndscl_sgh >.true. </gw_lndscl_sgh> <gw_lndscl_sgh waccm_phys="1">.false.</gw_lndscl_sgh> <gw_lndscl_sgh chem="geoschem_mam4">.false.</gw_lndscl_sgh> @@ -865,6 +881,8 @@ <gw_lndscl_sgh chem="trop_strat_mam4_vbsext">.false.</gw_lndscl_sgh> <gw_lndscl_sgh chem="trop_strat_mam5_vbs">.false.</gw_lndscl_sgh> <gw_lndscl_sgh chem="trop_strat_mam5_vbsext">.false.</gw_lndscl_sgh> +<gw_lndscl_sgh carma="trop_strat_soa1">.false.</gw_lndscl_sgh> +<gw_lndscl_sgh carma="trop_strat_soa5">.false.</gw_lndscl_sgh> <gw_limit_tau_without_eff >.false.</gw_limit_tau_without_eff> <gw_limit_tau_without_eff waccm_phys="1">.true. </gw_limit_tau_without_eff> <gw_limit_tau_without_eff chem="geoschem_mam4">.true. </gw_limit_tau_without_eff> @@ -872,6 +890,8 @@ <gw_limit_tau_without_eff chem="trop_strat_mam4_vbsext">.true. </gw_limit_tau_without_eff> <gw_limit_tau_without_eff chem="trop_strat_mam5_vbs">.true. </gw_limit_tau_without_eff> <gw_limit_tau_without_eff chem="trop_strat_mam5_vbsext">.true. </gw_limit_tau_without_eff> +<gw_limit_tau_without_eff carma="trop_strat_soa1">.true. </gw_limit_tau_without_eff> +<gw_limit_tau_without_eff carma="trop_strat_soa5">.true. </gw_limit_tau_without_eff> <gw_apply_tndmax >.true. </gw_apply_tndmax> <gw_apply_tndmax chem="geoschem_mam4" >.false.</gw_apply_tndmax> <gw_apply_tndmax phys="cam7" >.false.</gw_apply_tndmax> @@ -880,6 +900,8 @@ <gw_apply_tndmax chem="trop_strat_mam4_vbsext">.false.</gw_apply_tndmax> <gw_apply_tndmax chem="trop_strat_mam5_vbs">.false.</gw_apply_tndmax> <gw_apply_tndmax chem="trop_strat_mam5_vbsext">.false.</gw_apply_tndmax> +<gw_apply_tndmax carma="trop_strat_soa1">.false.</gw_apply_tndmax> +<gw_apply_tndmax carma="trop_strat_soa5">.false.</gw_apply_tndmax> <!-- gravity wave drag options --> <gw_rdg_do_divstream >.true. </gw_rdg_do_divstream> @@ -1077,6 +1099,11 @@ <soag_bg_srf_file ver="cam6">atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_SOAGx1.5_biogenic_surface_1750-2015_0.9x1.25_c20170322.nc</soag_bg_srf_file> <soag_bb_srf_file ver="cam6">atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_SOAGx1.5_bb_surface_1750-2015_0.9x1.25_c20170322.nc</soag_bb_srf_file> +<bc_a4_an_srf_file ver="2000cam6">atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_bc_a4_anthro_surface_2000climo_0.9x1.25_c20170608.nc</bc_a4_an_srf_file> +<bc_a4_bb_srf_file ver="2000cam6">atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_bc_a4_bb_surface_2000climo_0.9x1.25_c20170322.nc</bc_a4_bb_srf_file> +<pom_a4_an_srf_file ver="2000cam6">atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_pom_a4_anthro_surface_2000climo_0.9x1.25_c20170608.nc</pom_a4_an_srf_file> +<pom_a4_bb_srf_file ver="2000cam6">atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_pom_a4_bb_surface_2000climo_0.9x1.25_c20170322.nc</pom_a4_bb_srf_file> + <BENZENE_an_srf_file ver="cam6">atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_BENZENE_anthro_surface_1750-2015_0.9x1.25_c20170608.nc</BENZENE_an_srf_file> <BENZENE_bb_srf_file ver="cam6">atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_BENZENE_bb_surface_1750-2015_0.9x1.25_c20170322.nc</BENZENE_bb_srf_file> <BIGALK_an_srf_file ver="cam6">atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_BIGALK_anthro_surface_1750-2015_0.9x1.25_c20170608.nc</BIGALK_an_srf_file> @@ -2967,6 +2994,9 @@ <fv_nsplit hgrid="0.9x1.25" waccm_phys="1">16</fv_nsplit> <fv_nsplit hgrid="0.47x0.63" waccmx="1">32</fv_nsplit> +<fv_nspltvrm hgrid="1.9x2.5" waccm_phys="1" aquaplanet="1">4</fv_nspltvrm> +<fv_nspltrac hgrid="1.9x2.5" waccm_phys="1" aquaplanet="1">4</fv_nspltrac> + <fv_del2coef >3.e+5</fv_del2coef> <fv_filtcw >0</fv_filtcw> @@ -3705,4 +3735,545 @@ <geoschem_aeropt_inputs chem="geoschem_mam4">atm/cam/geoschem/emis/ExtData/CHEM_INPUTS/FAST_JX/v2024-05/</geoschem_aeropt_inputs> <geoschem_photol_inputs chem="geoschem_mam4">atm/cam/geoschem/emis/ExtData/CHEM_INPUTS/CLOUD_J/v2023-05/</geoschem_photol_inputs> +<BC_GAINS_filename >atm/cam/chem/carma/data/ETP_base_CLE_V5_BC_2010.nc</BC_GAINS_filename> +<OC_GAINS_filename >atm/cam/chem/carma/data/ETP_base_CLE_V5_OC_2010.nc</OC_GAINS_filename> +<BC_ship_filename >atm/cam/chem/carma/data/IPCC_BC_ships_2010_0.5x0.5.nc</BC_ship_filename> +<OC_ship_filename >atm/cam/chem/carma/data/IPCC_OC_ships_2010_0.5x0.5.nc</OC_ship_filename> +<BC_GFEDv3_filename>atm/cam/chem/carma/data/GFEDv3_BC_2010.nc</BC_GFEDv3_filename> +<OC_GFEDv3_filename>atm/cam/chem/carma/data/GFEDv3_OC_2010.nc</OC_GFEDv3_filename> + +<bin_defs carma="trop_strat_soa1"> + 'MXAER01:=', 'N:NBMXAER01:N:CLDNBMXAER01:num:+', + 'A:MXSULF01:N:CLDMXSULF01:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc:+', + 'A:MXOC01:N:CLDMXOC01:p-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/ocphi_rrtmg_carma_c100508.nc:+', + 'A:MXSOA01:N:CLDMXSOA01:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXBC01:N:CLDMXBC01:black-c:core:$INPUTDATA_ROOT/atm/cam/physprops/bcpho_rrtmg_carma_c100508.nc:+', + 'A:MXDUST01:N:CLDMXDUST01:dust:core:$INPUTDATA_ROOT/atm/cam/physprops/dust_aeronet_rrtmg_carma_c141106.nc:+', + 'A:MXSALT01:N:CLDMXSALT01:seasalt:shell:$INPUTDATA_ROOT/atm/cam/physprops/ssam_rrtmg_carma_c100508.nc', + 'MXAER02:=', 'N:NBMXAER02:N:CLDNBMXAER02:num:+', + 'A:MXSULF02:N:CLDMXSULF02:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc:+', + 'A:MXOC02:N:CLDMXOC02:p-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/ocphi_rrtmg_carma_c100508.nc:+', + 'A:MXSOA02:N:CLDMXSOA02:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXBC02:N:CLDMXBC02:black-c:core:$INPUTDATA_ROOT/atm/cam/physprops/bcpho_rrtmg_carma_c100508.nc:+', + 'A:MXDUST02:N:CLDMXDUST02:dust:core:$INPUTDATA_ROOT/atm/cam/physprops/dust_aeronet_rrtmg_carma_c141106.nc:+', + 'A:MXSALT02:N:CLDMXSALT02:seasalt:shell:$INPUTDATA_ROOT/atm/cam/physprops/ssam_rrtmg_carma_c100508.nc', + 'MXAER03:=', 'N:NBMXAER03:N:CLDNBMXAER03:num:+', + 'A:MXSULF03:N:CLDMXSULF03:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc:+', + 'A:MXOC03:N:CLDMXOC03:p-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/ocphi_rrtmg_carma_c100508.nc:+', + 'A:MXSOA03:N:CLDMXSOA03:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXBC03:N:CLDMXBC03:black-c:core:$INPUTDATA_ROOT/atm/cam/physprops/bcpho_rrtmg_carma_c100508.nc:+', + 'A:MXDUST03:N:CLDMXDUST03:dust:core:$INPUTDATA_ROOT/atm/cam/physprops/dust_aeronet_rrtmg_carma_c141106.nc:+', + 'A:MXSALT03:N:CLDMXSALT03:seasalt:shell:$INPUTDATA_ROOT/atm/cam/physprops/ssam_rrtmg_carma_c100508.nc', + 'MXAER04:=', 'N:NBMXAER04:N:CLDNBMXAER04:num:+', + 'A:MXSULF04:N:CLDMXSULF04:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc:+', + 'A:MXOC04:N:CLDMXOC04:p-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/ocphi_rrtmg_carma_c100508.nc:+', + 'A:MXSOA04:N:CLDMXSOA04:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXBC04:N:CLDMXBC04:black-c:core:$INPUTDATA_ROOT/atm/cam/physprops/bcpho_rrtmg_carma_c100508.nc:+', + 'A:MXDUST04:N:CLDMXDUST04:dust:core:$INPUTDATA_ROOT/atm/cam/physprops/dust_aeronet_rrtmg_carma_c141106.nc:+', + 'A:MXSALT04:N:CLDMXSALT04:seasalt:shell:$INPUTDATA_ROOT/atm/cam/physprops/ssam_rrtmg_carma_c100508.nc', + 'MXAER05:=', 'N:NBMXAER05:N:CLDNBMXAER05:num:+', + 'A:MXSULF05:N:CLDMXSULF05:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc:+', + 'A:MXOC05:N:CLDMXOC05:p-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/ocphi_rrtmg_carma_c100508.nc:+', + 'A:MXSOA05:N:CLDMXSOA05:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXBC05:N:CLDMXBC05:black-c:core:$INPUTDATA_ROOT/atm/cam/physprops/bcpho_rrtmg_carma_c100508.nc:+', + 'A:MXDUST05:N:CLDMXDUST05:dust:core:$INPUTDATA_ROOT/atm/cam/physprops/dust_aeronet_rrtmg_carma_c141106.nc:+', + 'A:MXSALT05:N:CLDMXSALT05:seasalt:shell:$INPUTDATA_ROOT/atm/cam/physprops/ssam_rrtmg_carma_c100508.nc', + 'MXAER06:=', 'N:NBMXAER06:N:CLDNBMXAER06:num:+', + 'A:MXSULF06:N:CLDMXSULF06:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc:+', + 'A:MXOC06:N:CLDMXOC06:p-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/ocphi_rrtmg_carma_c100508.nc:+', + 'A:MXSOA06:N:CLDMXSOA06:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXBC06:N:CLDMXBC06:black-c:core:$INPUTDATA_ROOT/atm/cam/physprops/bcpho_rrtmg_carma_c100508.nc:+', + 'A:MXDUST06:N:CLDMXDUST06:dust:core:$INPUTDATA_ROOT/atm/cam/physprops/dust_aeronet_rrtmg_carma_c141106.nc:+', + 'A:MXSALT06:N:CLDMXSALT06:seasalt:shell:$INPUTDATA_ROOT/atm/cam/physprops/ssam_rrtmg_carma_c100508.nc', + 'MXAER07:=', 'N:NBMXAER07:N:CLDNBMXAER07:num:+', + 'A:MXSULF07:N:CLDMXSULF07:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc:+', + 'A:MXOC07:N:CLDMXOC07:p-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/ocphi_rrtmg_carma_c100508.nc:+', + 'A:MXSOA07:N:CLDMXSOA07:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXBC07:N:CLDMXBC07:black-c:core:$INPUTDATA_ROOT/atm/cam/physprops/bcpho_rrtmg_carma_c100508.nc:+', + 'A:MXDUST07:N:CLDMXDUST07:dust:core:$INPUTDATA_ROOT/atm/cam/physprops/dust_aeronet_rrtmg_carma_c141106.nc:+', + 'A:MXSALT07:N:CLDMXSALT07:seasalt:shell:$INPUTDATA_ROOT/atm/cam/physprops/ssam_rrtmg_carma_c100508.nc', + 'MXAER08:=', 'N:NBMXAER08:N:CLDNBMXAER08:num:+', + 'A:MXSULF08:N:CLDMXSULF08:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc:+', + 'A:MXOC08:N:CLDMXOC08:p-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/ocphi_rrtmg_carma_c100508.nc:+', + 'A:MXSOA08:N:CLDMXSOA08:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXBC08:N:CLDMXBC08:black-c:core:$INPUTDATA_ROOT/atm/cam/physprops/bcpho_rrtmg_carma_c100508.nc:+', + 'A:MXDUST08:N:CLDMXDUST08:dust:core:$INPUTDATA_ROOT/atm/cam/physprops/dust_aeronet_rrtmg_carma_c141106.nc:+', + 'A:MXSALT08:N:CLDMXSALT08:seasalt:shell:$INPUTDATA_ROOT/atm/cam/physprops/ssam_rrtmg_carma_c100508.nc', + 'MXAER09:=', 'N:NBMXAER09:N:CLDNBMXAER09:num:+', + 'A:MXSULF09:N:CLDMXSULF09:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc:+', + 'A:MXOC09:N:CLDMXOC09:p-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/ocphi_rrtmg_carma_c100508.nc:+', + 'A:MXSOA09:N:CLDMXSOA09:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXBC09:N:CLDMXBC09:black-c:core:$INPUTDATA_ROOT/atm/cam/physprops/bcpho_rrtmg_carma_c100508.nc:+', + 'A:MXDUST09:N:CLDMXDUST09:dust:core:$INPUTDATA_ROOT/atm/cam/physprops/dust_aeronet_rrtmg_carma_c141106.nc:+', + 'A:MXSALT09:N:CLDMXSALT09:seasalt:shell:$INPUTDATA_ROOT/atm/cam/physprops/ssam_rrtmg_carma_c100508.nc', + 'MXAER10:=', 'N:NBMXAER10:N:CLDNBMXAER10:num:+', + 'A:MXSULF10:N:CLDMXSULF10:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc:+', + 'A:MXOC10:N:CLDMXOC10:p-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/ocphi_rrtmg_carma_c100508.nc:+', + 'A:MXSOA10:N:CLDMXSOA10:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXBC10:N:CLDMXBC10:black-c:core:$INPUTDATA_ROOT/atm/cam/physprops/bcpho_rrtmg_carma_c100508.nc:+', + 'A:MXDUST10:N:CLDMXDUST10:dust:core:$INPUTDATA_ROOT/atm/cam/physprops/dust_aeronet_rrtmg_carma_c141106.nc:+', + 'A:MXSALT10:N:CLDMXSALT10:seasalt:shell:$INPUTDATA_ROOT/atm/cam/physprops/ssam_rrtmg_carma_c100508.nc', + 'MXAER11:=', 'N:NBMXAER11:N:CLDNBMXAER11:num:+', + 'A:MXSULF11:N:CLDMXSULF11:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc:+', + 'A:MXOC11:N:CLDMXOC11:p-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/ocphi_rrtmg_carma_c100508.nc:+', + 'A:MXSOA11:N:CLDMXSOA11:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXBC11:N:CLDMXBC11:black-c:core:$INPUTDATA_ROOT/atm/cam/physprops/bcpho_rrtmg_carma_c100508.nc:+', + 'A:MXDUST11:N:CLDMXDUST11:dust:core:$INPUTDATA_ROOT/atm/cam/physprops/dust_aeronet_rrtmg_carma_c141106.nc:+', + 'A:MXSALT11:N:CLDMXSALT11:seasalt:shell:$INPUTDATA_ROOT/atm/cam/physprops/ssam_rrtmg_carma_c100508.nc', + 'MXAER12:=', 'N:NBMXAER12:N:CLDNBMXAER12:num:+', + 'A:MXSULF12:N:CLDMXSULF12:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc:+', + 'A:MXOC12:N:CLDMXOC12:p-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/ocphi_rrtmg_carma_c100508.nc:+', + 'A:MXSOA12:N:CLDMXSOA12:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXBC12:N:CLDMXBC12:black-c:core:$INPUTDATA_ROOT/atm/cam/physprops/bcpho_rrtmg_carma_c100508.nc:+', + 'A:MXDUST12:N:CLDMXDUST12:dust:core:$INPUTDATA_ROOT/atm/cam/physprops/dust_aeronet_rrtmg_carma_c141106.nc:+', + 'A:MXSALT12:N:CLDMXSALT12:seasalt:shell:$INPUTDATA_ROOT/atm/cam/physprops/ssam_rrtmg_carma_c100508.nc', + 'MXAER13:=', 'N:NBMXAER13:N:CLDNBMXAER13:num:+', + 'A:MXSULF13:N:CLDMXSULF13:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc:+', + 'A:MXOC13:N:CLDMXOC13:p-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/ocphi_rrtmg_carma_c100508.nc:+', + 'A:MXSOA13:N:CLDMXSOA13:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXBC13:N:CLDMXBC13:black-c:core:$INPUTDATA_ROOT/atm/cam/physprops/bcpho_rrtmg_carma_c100508.nc:+', + 'A:MXDUST13:N:CLDMXDUST13:dust:core:$INPUTDATA_ROOT/atm/cam/physprops/dust_aeronet_rrtmg_carma_c141106.nc:+', + 'A:MXSALT13:N:CLDMXSALT13:seasalt:shell:$INPUTDATA_ROOT/atm/cam/physprops/ssam_rrtmg_carma_c100508.nc', + 'MXAER14:=', 'N:NBMXAER14:N:CLDNBMXAER14:num:+', + 'A:MXSULF14:N:CLDMXSULF14:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc:+', + 'A:MXOC14:N:CLDMXOC14:p-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/ocphi_rrtmg_carma_c100508.nc:+', + 'A:MXSOA14:N:CLDMXSOA14:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXBC14:N:CLDMXBC14:black-c:core:$INPUTDATA_ROOT/atm/cam/physprops/bcpho_rrtmg_carma_c100508.nc:+', + 'A:MXDUST14:N:CLDMXDUST14:dust:core:$INPUTDATA_ROOT/atm/cam/physprops/dust_aeronet_rrtmg_carma_c141106.nc:+', + 'A:MXSALT14:N:CLDMXSALT14:seasalt:shell:$INPUTDATA_ROOT/atm/cam/physprops/ssam_rrtmg_carma_c100508.nc', + 'MXAER15:=', 'N:NBMXAER15:N:CLDNBMXAER15:num:+', + 'A:MXSULF15:N:CLDMXSULF15:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc:+', + 'A:MXOC15:N:CLDMXOC15:p-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/ocphi_rrtmg_carma_c100508.nc:+', + 'A:MXSOA15:N:CLDMXSOA15:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXBC15:N:CLDMXBC15:black-c:core:$INPUTDATA_ROOT/atm/cam/physprops/bcpho_rrtmg_carma_c100508.nc:+', + 'A:MXDUST15:N:CLDMXDUST15:dust:core:$INPUTDATA_ROOT/atm/cam/physprops/dust_aeronet_rrtmg_carma_c141106.nc:+', + 'A:MXSALT15:N:CLDMXSALT15:seasalt:shell:$INPUTDATA_ROOT/atm/cam/physprops/ssam_rrtmg_carma_c100508.nc', + 'MXAER16:=', 'N:NBMXAER16:N:CLDNBMXAER16:num:+', + 'A:MXSULF16:N:CLDMXSULF16:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc:+', + 'A:MXOC16:N:CLDMXOC16:p-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/ocphi_rrtmg_carma_c100508.nc:+', + 'A:MXSOA16:N:CLDMXSOA16:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXBC16:N:CLDMXBC16:black-c:core:$INPUTDATA_ROOT/atm/cam/physprops/bcpho_rrtmg_carma_c100508.nc:+', + 'A:MXDUST16:N:CLDMXDUST16:dust:core:$INPUTDATA_ROOT/atm/cam/physprops/dust_aeronet_rrtmg_carma_c141106.nc:+', + 'A:MXSALT16:N:CLDMXSALT16:seasalt:shell:$INPUTDATA_ROOT/atm/cam/physprops/ssam_rrtmg_carma_c100508.nc', + 'MXAER17:=', 'N:NBMXAER17:N:CLDNBMXAER17:num:+', + 'A:MXSULF17:N:CLDMXSULF17:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc:+', + 'A:MXOC17:N:CLDMXOC17:p-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/ocphi_rrtmg_carma_c100508.nc:+', + 'A:MXSOA17:N:CLDMXSOA17:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXBC17:N:CLDMXBC17:black-c:core:$INPUTDATA_ROOT/atm/cam/physprops/bcpho_rrtmg_carma_c100508.nc:+', + 'A:MXDUST17:N:CLDMXDUST17:dust:core:$INPUTDATA_ROOT/atm/cam/physprops/dust_aeronet_rrtmg_carma_c141106.nc:+', + 'A:MXSALT17:N:CLDMXSALT17:seasalt:shell:$INPUTDATA_ROOT/atm/cam/physprops/ssam_rrtmg_carma_c100508.nc', + 'MXAER18:=', 'N:NBMXAER18:N:CLDNBMXAER18:num:+', + 'A:MXSULF18:N:CLDMXSULF18:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc:+', + 'A:MXOC18:N:CLDMXOC18:p-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/ocphi_rrtmg_carma_c100508.nc:+', + 'A:MXSOA18:N:CLDMXSOA18:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXBC18:N:CLDMXBC18:black-c:core:$INPUTDATA_ROOT/atm/cam/physprops/bcpho_rrtmg_carma_c100508.nc:+', + 'A:MXDUST18:N:CLDMXDUST18:dust:core:$INPUTDATA_ROOT/atm/cam/physprops/dust_aeronet_rrtmg_carma_c141106.nc:+', + 'A:MXSALT18:N:CLDMXSALT18:seasalt:shell:$INPUTDATA_ROOT/atm/cam/physprops/ssam_rrtmg_carma_c100508.nc', + 'MXAER19:=', 'N:NBMXAER19:N:CLDNBMXAER19:num:+', + 'A:MXSULF19:N:CLDMXSULF19:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc:+', + 'A:MXOC19:N:CLDMXOC19:p-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/ocphi_rrtmg_carma_c100508.nc:+', + 'A:MXSOA19:N:CLDMXSOA19:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXBC19:N:CLDMXBC19:black-c:core:$INPUTDATA_ROOT/atm/cam/physprops/bcpho_rrtmg_carma_c100508.nc:+', + 'A:MXDUST19:N:CLDMXDUST19:dust:core:$INPUTDATA_ROOT/atm/cam/physprops/dust_aeronet_rrtmg_carma_c141106.nc:+', + 'A:MXSALT19:N:CLDMXSALT19:seasalt:shell:$INPUTDATA_ROOT/atm/cam/physprops/ssam_rrtmg_carma_c100508.nc', + 'MXAER20:=', 'N:NBMXAER20:N:CLDNBMXAER20:num:+', + 'A:MXSULF20:N:CLDMXSULF20:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc:+', + 'A:MXOC20:N:CLDMXOC20:p-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/ocphi_rrtmg_carma_c100508.nc:+', + 'A:MXSOA20:N:CLDMXSOA20:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXBC20:N:CLDMXBC20:black-c:core:$INPUTDATA_ROOT/atm/cam/physprops/bcpho_rrtmg_carma_c100508.nc:+', + 'A:MXDUST20:N:CLDMXDUST20:dust:core:$INPUTDATA_ROOT/atm/cam/physprops/dust_aeronet_rrtmg_carma_c141106.nc:+', + 'A:MXSALT20:N:CLDMXSALT20:seasalt:shell:$INPUTDATA_ROOT/atm/cam/physprops/ssam_rrtmg_carma_c100508.nc', + 'PRSUL01:=', 'N:NBPRSUL01:N:CLDNBPRSUL01:num:+', + 'A:PRSULF01:N:CLDPRSULF01:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc', + 'PRSUL02:=', 'N:NBPRSUL02:N:CLDNBPRSUL02:num:+', + 'A:PRSULF02:N:CLDPRSULF02:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc', + 'PRSUL03:=', 'N:NBPRSUL03:N:CLDNBPRSUL03:num:+', + 'A:PRSULF03:N:CLDPRSULF03:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc', + 'PRSUL04:=', 'N:NBPRSUL04:N:CLDNBPRSUL04:num:+', + 'A:PRSULF04:N:CLDPRSULF04:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc', + 'PRSUL05:=', 'N:NBPRSUL05:N:CLDNBPRSUL05:num:+', + 'A:PRSULF05:N:CLDPRSULF05:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc', + 'PRSUL06:=', 'N:NBPRSUL06:N:CLDNBPRSUL06:num:+', + 'A:PRSULF06:N:CLDPRSULF06:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc', + 'PRSUL07:=', 'N:NBPRSUL07:N:CLDNBPRSUL07:num:+', + 'A:PRSULF07:N:CLDPRSULF07:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc', + 'PRSUL08:=', 'N:NBPRSUL08:N:CLDNBPRSUL08:num:+', + 'A:PRSULF08:N:CLDPRSULF08:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc', + 'PRSUL09:=', 'N:NBPRSUL09:N:CLDNBPRSUL09:num:+', + 'A:PRSULF09:N:CLDPRSULF09:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc', + 'PRSUL10:=', 'N:NBPRSUL10:N:CLDNBPRSUL10:num:+', + 'A:PRSULF10:N:CLDPRSULF10:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc', + 'PRSUL11:=', 'N:NBPRSUL11:N:CLDNBPRSUL11:num:+', + 'A:PRSULF11:N:CLDPRSULF11:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc', + 'PRSUL12:=', 'N:NBPRSUL12:N:CLDNBPRSUL12:num:+', + 'A:PRSULF12:N:CLDPRSULF12:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc', + 'PRSUL13:=', 'N:NBPRSUL13:N:CLDNBPRSUL13:num:+', + 'A:PRSULF13:N:CLDPRSULF13:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc', + 'PRSUL14:=', 'N:NBPRSUL14:N:CLDNBPRSUL14:num:+', + 'A:PRSULF14:N:CLDPRSULF14:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc', + 'PRSUL15:=', 'N:NBPRSUL15:N:CLDNBPRSUL15:num:+', + 'A:PRSULF15:N:CLDPRSULF15:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc', + 'PRSUL16:=', 'N:NBPRSUL16:N:CLDNBPRSUL16:num:+', + 'A:PRSULF16:N:CLDPRSULF16:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc', + 'PRSUL17:=', 'N:NBPRSUL17:N:CLDNBPRSUL17:num:+', + 'A:PRSULF17:N:CLDPRSULF17:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc', + 'PRSUL18:=', 'N:NBPRSUL18:N:CLDNBPRSUL18:num:+', + 'A:PRSULF18:N:CLDPRSULF18:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc', + 'PRSUL19:=', 'N:NBPRSUL19:N:CLDNBPRSUL19:num:+', + 'A:PRSULF19:N:CLDPRSULF19:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc', + 'PRSUL20:=', 'N:NBPRSUL20:N:CLDNBPRSUL20:num:+', + 'A:PRSULF20:N:CLDPRSULF20:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc' +</bin_defs> + +<bin_defs carma="trop_strat_soa5"> + 'MXAER01:=', 'N:NBMXAER01:N:CLDNBMXAER01:num:+', + 'A:MXSULF01:N:CLDMXSULF01:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc:+', + 'A:MXOC01:N:CLDMXOC01:p-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/ocphi_rrtmg_carma_c100508.nc:+', + 'A:MXSOA101:N:CLDMXSOA101:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA201:N:CLDMXSOA201:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA301:N:CLDMXSOA301:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA401:N:CLDMXSOA401:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA501:N:CLDMXSOA501:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXBC01:N:CLDMXBC01:black-c:core:$INPUTDATA_ROOT/atm/cam/physprops/bcpho_rrtmg_carma_c100508.nc:+', + 'A:MXDUST01:N:CLDMXDUST01:dust:core:$INPUTDATA_ROOT/atm/cam/physprops/dust_aeronet_rrtmg_carma_c141106.nc:+', + 'A:MXSALT01:N:CLDMXSALT01:seasalt:shell:$INPUTDATA_ROOT/atm/cam/physprops/ssam_rrtmg_carma_c100508.nc', + 'MXAER02:=', 'N:NBMXAER02:N:CLDNBMXAER02:num:+', + 'A:MXSULF02:N:CLDMXSULF02:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc:+', + 'A:MXOC02:N:CLDMXOC02:p-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/ocphi_rrtmg_carma_c100508.nc:+', + 'A:MXSOA102:N:CLDMXSOA102:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA202:N:CLDMXSOA202:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA302:N:CLDMXSOA302:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA402:N:CLDMXSOA402:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA502:N:CLDMXSOA502:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXBC02:N:CLDMXBC02:black-c:core:$INPUTDATA_ROOT/atm/cam/physprops/bcpho_rrtmg_carma_c100508.nc:+', + 'A:MXDUST02:N:CLDMXDUST02:dust:core:$INPUTDATA_ROOT/atm/cam/physprops/dust_aeronet_rrtmg_carma_c141106.nc:+', + 'A:MXSALT02:N:CLDMXSALT02:seasalt:shell:$INPUTDATA_ROOT/atm/cam/physprops/ssam_rrtmg_carma_c100508.nc', + 'MXAER03:=', 'N:NBMXAER03:N:CLDNBMXAER03:num:+', + 'A:MXSULF03:N:CLDMXSULF03:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc:+', + 'A:MXOC03:N:CLDMXOC03:p-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/ocphi_rrtmg_carma_c100508.nc:+', + 'A:MXSOA103:N:CLDMXSOA103:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA203:N:CLDMXSOA203:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA303:N:CLDMXSOA303:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA403:N:CLDMXSOA403:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA503:N:CLDMXSOA503:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXBC03:N:CLDMXBC03:black-c:core:$INPUTDATA_ROOT/atm/cam/physprops/bcpho_rrtmg_carma_c100508.nc:+', + 'A:MXDUST03:N:CLDMXDUST03:dust:core:$INPUTDATA_ROOT/atm/cam/physprops/dust_aeronet_rrtmg_carma_c141106.nc:+', + 'A:MXSALT03:N:CLDMXSALT03:seasalt:shell:$INPUTDATA_ROOT/atm/cam/physprops/ssam_rrtmg_carma_c100508.nc', + 'MXAER04:=', 'N:NBMXAER04:N:CLDNBMXAER04:num:+', + 'A:MXSULF04:N:CLDMXSULF04:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc:+', + 'A:MXOC04:N:CLDMXOC04:p-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/ocphi_rrtmg_carma_c100508.nc:+', + 'A:MXSOA104:N:CLDMXSOA104:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA204:N:CLDMXSOA204:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA304:N:CLDMXSOA304:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA404:N:CLDMXSOA404:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA504:N:CLDMXSOA504:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXBC04:N:CLDMXBC04:black-c:core:$INPUTDATA_ROOT/atm/cam/physprops/bcpho_rrtmg_carma_c100508.nc:+', + 'A:MXDUST04:N:CLDMXDUST04:dust:core:$INPUTDATA_ROOT/atm/cam/physprops/dust_aeronet_rrtmg_carma_c141106.nc:+', + 'A:MXSALT04:N:CLDMXSALT04:seasalt:shell:$INPUTDATA_ROOT/atm/cam/physprops/ssam_rrtmg_carma_c100508.nc', + 'MXAER05:=', 'N:NBMXAER05:N:CLDNBMXAER05:num:+', + 'A:MXSULF05:N:CLDMXSULF05:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc:+', + 'A:MXOC05:N:CLDMXOC05:p-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/ocphi_rrtmg_carma_c100508.nc:+', + 'A:MXSOA105:N:CLDMXSOA105:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA205:N:CLDMXSOA205:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA305:N:CLDMXSOA305:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA405:N:CLDMXSOA405:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA505:N:CLDMXSOA505:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXBC05:N:CLDMXBC05:black-c:core:$INPUTDATA_ROOT/atm/cam/physprops/bcpho_rrtmg_carma_c100508.nc:+', + 'A:MXDUST05:N:CLDMXDUST05:dust:core:$INPUTDATA_ROOT/atm/cam/physprops/dust_aeronet_rrtmg_carma_c141106.nc:+', + 'A:MXSALT05:N:CLDMXSALT05:seasalt:shell:$INPUTDATA_ROOT/atm/cam/physprops/ssam_rrtmg_carma_c100508.nc', + 'MXAER06:=', 'N:NBMXAER06:N:CLDNBMXAER06:num:+', + 'A:MXSULF06:N:CLDMXSULF06:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc:+', + 'A:MXOC06:N:CLDMXOC06:p-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/ocphi_rrtmg_carma_c100508.nc:+', + 'A:MXSOA106:N:CLDMXSOA106:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA206:N:CLDMXSOA206:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA306:N:CLDMXSOA306:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA406:N:CLDMXSOA406:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA506:N:CLDMXSOA506:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXBC06:N:CLDMXBC06:black-c:core:$INPUTDATA_ROOT/atm/cam/physprops/bcpho_rrtmg_carma_c100508.nc:+', + 'A:MXDUST06:N:CLDMXDUST06:dust:core:$INPUTDATA_ROOT/atm/cam/physprops/dust_aeronet_rrtmg_carma_c141106.nc:+', + 'A:MXSALT06:N:CLDMXSALT06:seasalt:shell:$INPUTDATA_ROOT/atm/cam/physprops/ssam_rrtmg_carma_c100508.nc', + 'MXAER07:=', 'N:NBMXAER07:N:CLDNBMXAER07:num:+', + 'A:MXSULF07:N:CLDMXSULF07:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc:+', + 'A:MXOC07:N:CLDMXOC07:p-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/ocphi_rrtmg_carma_c100508.nc:+', + 'A:MXSOA107:N:CLDMXSOA107:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA207:N:CLDMXSOA207:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA307:N:CLDMXSOA307:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA407:N:CLDMXSOA407:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA507:N:CLDMXSOA507:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXBC07:N:CLDMXBC07:black-c:core:$INPUTDATA_ROOT/atm/cam/physprops/bcpho_rrtmg_carma_c100508.nc:+', + 'A:MXDUST07:N:CLDMXDUST07:dust:core:$INPUTDATA_ROOT/atm/cam/physprops/dust_aeronet_rrtmg_carma_c141106.nc:+', + 'A:MXSALT07:N:CLDMXSALT07:seasalt:shell:$INPUTDATA_ROOT/atm/cam/physprops/ssam_rrtmg_carma_c100508.nc', + 'MXAER08:=', 'N:NBMXAER08:N:CLDNBMXAER08:num:+', + 'A:MXSULF08:N:CLDMXSULF08:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc:+', + 'A:MXOC08:N:CLDMXOC08:p-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/ocphi_rrtmg_carma_c100508.nc:+', + 'A:MXSOA108:N:CLDMXSOA108:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA208:N:CLDMXSOA208:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA308:N:CLDMXSOA308:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA408:N:CLDMXSOA408:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA508:N:CLDMXSOA508:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXBC08:N:CLDMXBC08:black-c:core:$INPUTDATA_ROOT/atm/cam/physprops/bcpho_rrtmg_carma_c100508.nc:+', + 'A:MXDUST08:N:CLDMXDUST08:dust:core:$INPUTDATA_ROOT/atm/cam/physprops/dust_aeronet_rrtmg_carma_c141106.nc:+', + 'A:MXSALT08:N:CLDMXSALT08:seasalt:shell:$INPUTDATA_ROOT/atm/cam/physprops/ssam_rrtmg_carma_c100508.nc', + 'MXAER09:=', 'N:NBMXAER09:N:CLDNBMXAER09:num:+', + 'A:MXSULF09:N:CLDMXSULF09:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc:+', + 'A:MXOC09:N:CLDMXOC09:p-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/ocphi_rrtmg_carma_c100508.nc:+', + 'A:MXSOA109:N:CLDMXSOA109:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA209:N:CLDMXSOA209:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA309:N:CLDMXSOA309:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA409:N:CLDMXSOA409:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA509:N:CLDMXSOA509:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXBC09:N:CLDMXBC09:black-c:core:$INPUTDATA_ROOT/atm/cam/physprops/bcpho_rrtmg_carma_c100508.nc:+', + 'A:MXDUST09:N:CLDMXDUST09:dust:core:$INPUTDATA_ROOT/atm/cam/physprops/dust_aeronet_rrtmg_carma_c141106.nc:+', + 'A:MXSALT09:N:CLDMXSALT09:seasalt:shell:$INPUTDATA_ROOT/atm/cam/physprops/ssam_rrtmg_carma_c100508.nc', + 'MXAER10:=', 'N:NBMXAER10:N:CLDNBMXAER10:num:+', + 'A:MXSULF10:N:CLDMXSULF10:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc:+', + 'A:MXOC10:N:CLDMXOC10:p-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/ocphi_rrtmg_carma_c100508.nc:+', + 'A:MXSOA110:N:CLDMXSOA110:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA210:N:CLDMXSOA210:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA310:N:CLDMXSOA310:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA410:N:CLDMXSOA410:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA510:N:CLDMXSOA510:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXBC10:N:CLDMXBC10:black-c:core:$INPUTDATA_ROOT/atm/cam/physprops/bcpho_rrtmg_carma_c100508.nc:+', + 'A:MXDUST10:N:CLDMXDUST10:dust:core:$INPUTDATA_ROOT/atm/cam/physprops/dust_aeronet_rrtmg_carma_c141106.nc:+', + 'A:MXSALT10:N:CLDMXSALT10:seasalt:shell:$INPUTDATA_ROOT/atm/cam/physprops/ssam_rrtmg_carma_c100508.nc', + 'MXAER11:=', 'N:NBMXAER11:N:CLDNBMXAER11:num:+', + 'A:MXSULF11:N:CLDMXSULF11:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc:+', + 'A:MXOC11:N:CLDMXOC11:p-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/ocphi_rrtmg_carma_c100508.nc:+', + 'A:MXSOA111:N:CLDMXSOA111:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA211:N:CLDMXSOA211:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA311:N:CLDMXSOA311:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA411:N:CLDMXSOA411:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA511:N:CLDMXSOA511:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXBC11:N:CLDMXBC11:black-c:core:$INPUTDATA_ROOT/atm/cam/physprops/bcpho_rrtmg_carma_c100508.nc:+', + 'A:MXDUST11:N:CLDMXDUST11:dust:core:$INPUTDATA_ROOT/atm/cam/physprops/dust_aeronet_rrtmg_carma_c141106.nc:+', + 'A:MXSALT11:N:CLDMXSALT11:seasalt:shell:$INPUTDATA_ROOT/atm/cam/physprops/ssam_rrtmg_carma_c100508.nc', + 'MXAER12:=', 'N:NBMXAER12:N:CLDNBMXAER12:num:+', + 'A:MXSULF12:N:CLDMXSULF12:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc:+', + 'A:MXOC12:N:CLDMXOC12:p-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/ocphi_rrtmg_carma_c100508.nc:+', + 'A:MXSOA112:N:CLDMXSOA112:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA212:N:CLDMXSOA212:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA312:N:CLDMXSOA312:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA412:N:CLDMXSOA412:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA512:N:CLDMXSOA512:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXBC12:N:CLDMXBC12:black-c:core:$INPUTDATA_ROOT/atm/cam/physprops/bcpho_rrtmg_carma_c100508.nc:+', + 'A:MXDUST12:N:CLDMXDUST12:dust:core:$INPUTDATA_ROOT/atm/cam/physprops/dust_aeronet_rrtmg_carma_c141106.nc:+', + 'A:MXSALT12:N:CLDMXSALT12:seasalt:shell:$INPUTDATA_ROOT/atm/cam/physprops/ssam_rrtmg_carma_c100508.nc', + 'MXAER13:=', 'N:NBMXAER13:N:CLDNBMXAER13:num:+', + 'A:MXSULF13:N:CLDMXSULF13:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc:+', + 'A:MXOC13:N:CLDMXOC13:p-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/ocphi_rrtmg_carma_c100508.nc:+', + 'A:MXSOA113:N:CLDMXSOA113:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA213:N:CLDMXSOA213:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA313:N:CLDMXSOA313:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA413:N:CLDMXSOA413:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA513:N:CLDMXSOA513:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXBC13:N:CLDMXBC13:black-c:core:$INPUTDATA_ROOT/atm/cam/physprops/bcpho_rrtmg_carma_c100508.nc:+', + 'A:MXDUST13:N:CLDMXDUST13:dust:core:$INPUTDATA_ROOT/atm/cam/physprops/dust_aeronet_rrtmg_carma_c141106.nc:+', + 'A:MXSALT13:N:CLDMXSALT13:seasalt:shell:$INPUTDATA_ROOT/atm/cam/physprops/ssam_rrtmg_carma_c100508.nc', + 'MXAER14:=', 'N:NBMXAER14:N:CLDNBMXAER14:num:+', + 'A:MXSULF14:N:CLDMXSULF14:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc:+', + 'A:MXOC14:N:CLDMXOC14:p-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/ocphi_rrtmg_carma_c100508.nc:+', + 'A:MXSOA114:N:CLDMXSOA114:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA214:N:CLDMXSOA214:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA314:N:CLDMXSOA314:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA414:N:CLDMXSOA414:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA514:N:CLDMXSOA514:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXBC14:N:CLDMXBC14:black-c:core:$INPUTDATA_ROOT/atm/cam/physprops/bcpho_rrtmg_carma_c100508.nc:+', + 'A:MXDUST14:N:CLDMXDUST14:dust:core:$INPUTDATA_ROOT/atm/cam/physprops/dust_aeronet_rrtmg_carma_c141106.nc:+', + 'A:MXSALT14:N:CLDMXSALT14:seasalt:shell:$INPUTDATA_ROOT/atm/cam/physprops/ssam_rrtmg_carma_c100508.nc', + 'MXAER15:=', 'N:NBMXAER15:N:CLDNBMXAER15:num:+', + 'A:MXSULF15:N:CLDMXSULF15:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc:+', + 'A:MXOC15:N:CLDMXOC15:p-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/ocphi_rrtmg_carma_c100508.nc:+', + 'A:MXSOA115:N:CLDMXSOA115:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA215:N:CLDMXSOA215:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA315:N:CLDMXSOA315:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA415:N:CLDMXSOA415:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA515:N:CLDMXSOA515:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXBC15:N:CLDMXBC15:black-c:core:$INPUTDATA_ROOT/atm/cam/physprops/bcpho_rrtmg_carma_c100508.nc:+', + 'A:MXDUST15:N:CLDMXDUST15:dust:core:$INPUTDATA_ROOT/atm/cam/physprops/dust_aeronet_rrtmg_carma_c141106.nc:+', + 'A:MXSALT15:N:CLDMXSALT15:seasalt:shell:$INPUTDATA_ROOT/atm/cam/physprops/ssam_rrtmg_carma_c100508.nc', + 'MXAER16:=', 'N:NBMXAER16:N:CLDNBMXAER16:num:+', + 'A:MXSULF16:N:CLDMXSULF16:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc:+', + 'A:MXOC16:N:CLDMXOC16:p-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/ocphi_rrtmg_carma_c100508.nc:+', + 'A:MXSOA116:N:CLDMXSOA116:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA216:N:CLDMXSOA216:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA316:N:CLDMXSOA316:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA416:N:CLDMXSOA416:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA516:N:CLDMXSOA516:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXBC16:N:CLDMXBC16:black-c:core:$INPUTDATA_ROOT/atm/cam/physprops/bcpho_rrtmg_carma_c100508.nc:+', + 'A:MXDUST16:N:CLDMXDUST16:dust:core:$INPUTDATA_ROOT/atm/cam/physprops/dust_aeronet_rrtmg_carma_c141106.nc:+', + 'A:MXSALT16:N:CLDMXSALT16:seasalt:shell:$INPUTDATA_ROOT/atm/cam/physprops/ssam_rrtmg_carma_c100508.nc', + 'MXAER17:=', 'N:NBMXAER17:N:CLDNBMXAER17:num:+', + 'A:MXSULF17:N:CLDMXSULF17:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc:+', + 'A:MXOC17:N:CLDMXOC17:p-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/ocphi_rrtmg_carma_c100508.nc:+', + 'A:MXSOA117:N:CLDMXSOA117:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA217:N:CLDMXSOA217:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA317:N:CLDMXSOA317:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA417:N:CLDMXSOA417:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA517:N:CLDMXSOA517:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXBC17:N:CLDMXBC17:black-c:core:$INPUTDATA_ROOT/atm/cam/physprops/bcpho_rrtmg_carma_c100508.nc:+', + 'A:MXDUST17:N:CLDMXDUST17:dust:core:$INPUTDATA_ROOT/atm/cam/physprops/dust_aeronet_rrtmg_carma_c141106.nc:+', + 'A:MXSALT17:N:CLDMXSALT17:seasalt:shell:$INPUTDATA_ROOT/atm/cam/physprops/ssam_rrtmg_carma_c100508.nc', + 'MXAER18:=', 'N:NBMXAER18:N:CLDNBMXAER18:num:+', + 'A:MXSULF18:N:CLDMXSULF18:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc:+', + 'A:MXOC18:N:CLDMXOC18:p-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/ocphi_rrtmg_carma_c100508.nc:+', + 'A:MXSOA118:N:CLDMXSOA118:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA218:N:CLDMXSOA218:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA318:N:CLDMXSOA318:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA418:N:CLDMXSOA418:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA518:N:CLDMXSOA518:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXBC18:N:CLDMXBC18:black-c:core:$INPUTDATA_ROOT/atm/cam/physprops/bcpho_rrtmg_carma_c100508.nc:+', + 'A:MXDUST18:N:CLDMXDUST18:dust:core:$INPUTDATA_ROOT/atm/cam/physprops/dust_aeronet_rrtmg_carma_c141106.nc:+', + 'A:MXSALT18:N:CLDMXSALT18:seasalt:shell:$INPUTDATA_ROOT/atm/cam/physprops/ssam_rrtmg_carma_c100508.nc', + 'MXAER19:=', 'N:NBMXAER19:N:CLDNBMXAER19:num:+', + 'A:MXSULF19:N:CLDMXSULF19:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc:+', + 'A:MXOC19:N:CLDMXOC19:p-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/ocphi_rrtmg_carma_c100508.nc:+', + 'A:MXSOA119:N:CLDMXSOA119:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA219:N:CLDMXSOA219:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA319:N:CLDMXSOA319:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA419:N:CLDMXSOA419:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA519:N:CLDMXSOA519:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXBC19:N:CLDMXBC19:black-c:core:$INPUTDATA_ROOT/atm/cam/physprops/bcpho_rrtmg_carma_c100508.nc:+', + 'A:MXDUST19:N:CLDMXDUST19:dust:core:$INPUTDATA_ROOT/atm/cam/physprops/dust_aeronet_rrtmg_carma_c141106.nc:+', + 'A:MXSALT19:N:CLDMXSALT19:seasalt:shell:$INPUTDATA_ROOT/atm/cam/physprops/ssam_rrtmg_carma_c100508.nc', + 'MXAER20:=', 'N:NBMXAER20:N:CLDNBMXAER20:num:+', + 'A:MXSULF20:N:CLDMXSULF20:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc:+', + 'A:MXOC20:N:CLDMXOC20:p-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/ocphi_rrtmg_carma_c100508.nc:+', + 'A:MXSOA120:N:CLDMXSOA120:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA220:N:CLDMXSOA220:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA320:N:CLDMXSOA320:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA420:N:CLDMXSOA420:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXSOA520:N:CLDMXSOA520:s-organic:shell:$INPUTDATA_ROOT/atm/cam/physprops/soa_rrtmg_carma_c100508.nc:+', + 'A:MXBC20:N:CLDMXBC20:black-c:core:$INPUTDATA_ROOT/atm/cam/physprops/bcpho_rrtmg_carma_c100508.nc:+', + 'A:MXDUST20:N:CLDMXDUST20:dust:core:$INPUTDATA_ROOT/atm/cam/physprops/dust_aeronet_rrtmg_carma_c141106.nc:+', + 'A:MXSALT20:N:CLDMXSALT20:seasalt:shell:$INPUTDATA_ROOT/atm/cam/physprops/ssam_rrtmg_carma_c100508.nc', + 'PRSUL01:=', 'N:NBPRSUL01:N:CLDNBPRSUL01:num:+', + 'A:PRSULF01:N:CLDPRSULF01:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc', + 'PRSUL02:=', 'N:NBPRSUL02:N:CLDNBPRSUL02:num:+', + 'A:PRSULF02:N:CLDPRSULF02:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc', + 'PRSUL03:=', 'N:NBPRSUL03:N:CLDNBPRSUL03:num:+', + 'A:PRSULF03:N:CLDPRSULF03:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc', + 'PRSUL04:=', 'N:NBPRSUL04:N:CLDNBPRSUL04:num:+', + 'A:PRSULF04:N:CLDPRSULF04:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc', + 'PRSUL05:=', 'N:NBPRSUL05:N:CLDNBPRSUL05:num:+', + 'A:PRSULF05:N:CLDPRSULF05:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc', + 'PRSUL06:=', 'N:NBPRSUL06:N:CLDNBPRSUL06:num:+', + 'A:PRSULF06:N:CLDPRSULF06:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc', + 'PRSUL07:=', 'N:NBPRSUL07:N:CLDNBPRSUL07:num:+', + 'A:PRSULF07:N:CLDPRSULF07:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc', + 'PRSUL08:=', 'N:NBPRSUL08:N:CLDNBPRSUL08:num:+', + 'A:PRSULF08:N:CLDPRSULF08:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc', + 'PRSUL09:=', 'N:NBPRSUL09:N:CLDNBPRSUL09:num:+', + 'A:PRSULF09:N:CLDPRSULF09:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc', + 'PRSUL10:=', 'N:NBPRSUL10:N:CLDNBPRSUL10:num:+', + 'A:PRSULF10:N:CLDPRSULF10:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc', + 'PRSUL11:=', 'N:NBPRSUL11:N:CLDNBPRSUL11:num:+', + 'A:PRSULF11:N:CLDPRSULF11:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc', + 'PRSUL12:=', 'N:NBPRSUL12:N:CLDNBPRSUL12:num:+', + 'A:PRSULF12:N:CLDPRSULF12:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc', + 'PRSUL13:=', 'N:NBPRSUL13:N:CLDNBPRSUL13:num:+', + 'A:PRSULF13:N:CLDPRSULF13:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc', + 'PRSUL14:=', 'N:NBPRSUL14:N:CLDNBPRSUL14:num:+', + 'A:PRSULF14:N:CLDPRSULF14:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc', + 'PRSUL15:=', 'N:NBPRSUL15:N:CLDNBPRSUL15:num:+', + 'A:PRSULF15:N:CLDPRSULF15:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc', + 'PRSUL16:=', 'N:NBPRSUL16:N:CLDNBPRSUL16:num:+', + 'A:PRSULF16:N:CLDPRSULF16:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc', + 'PRSUL17:=', 'N:NBPRSUL17:N:CLDNBPRSUL17:num:+', + 'A:PRSULF17:N:CLDPRSULF17:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc', + 'PRSUL18:=', 'N:NBPRSUL18:N:CLDNBPRSUL18:num:+', + 'A:PRSULF18:N:CLDPRSULF18:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc', + 'PRSUL19:=', 'N:NBPRSUL19:N:CLDNBPRSUL19:num:+', + 'A:PRSULF19:N:CLDPRSULF19:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc', + 'PRSUL20:=', 'N:NBPRSUL20:N:CLDNBPRSUL20:num:+', + 'A:PRSULF20:N:CLDPRSULF20:sulfate:shell:$INPUTDATA_ROOT/atm/cam/physprops/sulfate_rrtmg_carma_c080918.nc' +</bin_defs> + +<rad_climate carma="trop_strat_soa1"> + 'A:Q:H2O', 'N:O2:O2', 'A:CO2:CO2', 'A:O3:O3', 'A:N2O:N2O', 'A:CH4:CH4','N:CFC11:CFC11', 'N:CFC12:CFC12', + 'B:MXAER01:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_CRMIX01_rrtmg.nc', + 'B:MXAER02:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_CRMIX02_rrtmg.nc', + 'B:MXAER03:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_CRMIX03_rrtmg.nc', + 'B:MXAER04:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_CRMIX04_rrtmg.nc', + 'B:MXAER05:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_CRMIX05_rrtmg.nc', + 'B:MXAER06:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_CRMIX06_rrtmg.nc', + 'B:MXAER07:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_CRMIX07_rrtmg.nc', + 'B:MXAER08:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_CRMIX08_rrtmg.nc', + 'B:MXAER09:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_CRMIX09_rrtmg.nc', + 'B:MXAER10:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_CRMIX10_rrtmg.nc', + 'B:MXAER11:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_CRMIX11_rrtmg.nc', + 'B:MXAER12:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_CRMIX12_rrtmg.nc', + 'B:MXAER13:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_CRMIX13_rrtmg.nc', + 'B:MXAER14:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_CRMIX14_rrtmg.nc', + 'B:MXAER15:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_CRMIX15_rrtmg.nc', + 'B:MXAER16:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_CRMIX16_rrtmg.nc', + 'B:MXAER17:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_CRMIX17_rrtmg.nc', + 'B:MXAER18:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_CRMIX18_rrtmg.nc', + 'B:MXAER19:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_CRMIX19_rrtmg.nc', + 'B:MXAER20:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_CRMIX20_rrtmg.nc', + 'B:PRSUL01:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_SULF01_rrtmg.nc', + 'B:PRSUL02:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_SULF02_rrtmg.nc', + 'B:PRSUL03:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_SULF03_rrtmg.nc', + 'B:PRSUL04:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_SULF04_rrtmg.nc', + 'B:PRSUL05:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_SULF05_rrtmg.nc', + 'B:PRSUL06:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_SULF06_rrtmg.nc', + 'B:PRSUL07:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_SULF07_rrtmg.nc', + 'B:PRSUL08:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_SULF08_rrtmg.nc', + 'B:PRSUL09:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_SULF09_rrtmg.nc', + 'B:PRSUL10:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_SULF10_rrtmg.nc', + 'B:PRSUL11:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_SULF11_rrtmg.nc', + 'B:PRSUL12:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_SULF12_rrtmg.nc', + 'B:PRSUL13:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_SULF13_rrtmg.nc', + 'B:PRSUL14:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_SULF14_rrtmg.nc', + 'B:PRSUL15:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_SULF15_rrtmg.nc', + 'B:PRSUL16:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_SULF16_rrtmg.nc', + 'B:PRSUL17:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_SULF17_rrtmg.nc', + 'B:PRSUL18:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_SULF18_rrtmg.nc', + 'B:PRSUL19:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_SULF19_rrtmg.nc', + 'B:PRSUL20:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_SULF20_rrtmg.nc' +</rad_climate> + +<rad_climate carma="trop_strat_soa5"> + 'A:Q:H2O', 'N:O2:O2', 'A:CO2:CO2', 'A:O3:O3', 'A:N2O:N2O', 'A:CH4:CH4','N:CFC11:CFC11', 'N:CFC12:CFC12', + 'B:MXAER01:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_CRMIX01_rrtmg.nc', + 'B:MXAER02:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_CRMIX02_rrtmg.nc', + 'B:MXAER03:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_CRMIX03_rrtmg.nc', + 'B:MXAER04:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_CRMIX04_rrtmg.nc', + 'B:MXAER05:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_CRMIX05_rrtmg.nc', + 'B:MXAER06:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_CRMIX06_rrtmg.nc', + 'B:MXAER07:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_CRMIX07_rrtmg.nc', + 'B:MXAER08:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_CRMIX08_rrtmg.nc', + 'B:MXAER09:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_CRMIX09_rrtmg.nc', + 'B:MXAER10:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_CRMIX10_rrtmg.nc', + 'B:MXAER11:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_CRMIX11_rrtmg.nc', + 'B:MXAER12:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_CRMIX12_rrtmg.nc', + 'B:MXAER13:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_CRMIX13_rrtmg.nc', + 'B:MXAER14:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_CRMIX14_rrtmg.nc', + 'B:MXAER15:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_CRMIX15_rrtmg.nc', + 'B:MXAER16:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_CRMIX16_rrtmg.nc', + 'B:MXAER17:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_CRMIX17_rrtmg.nc', + 'B:MXAER18:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_CRMIX18_rrtmg.nc', + 'B:MXAER19:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_CRMIX19_rrtmg.nc', + 'B:MXAER20:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_CRMIX20_rrtmg.nc', + 'B:PRSUL01:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_SULF01_rrtmg.nc', + 'B:PRSUL02:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_SULF02_rrtmg.nc', + 'B:PRSUL03:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_SULF03_rrtmg.nc', + 'B:PRSUL04:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_SULF04_rrtmg.nc', + 'B:PRSUL05:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_SULF05_rrtmg.nc', + 'B:PRSUL06:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_SULF06_rrtmg.nc', + 'B:PRSUL07:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_SULF07_rrtmg.nc', + 'B:PRSUL08:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_SULF08_rrtmg.nc', + 'B:PRSUL09:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_SULF09_rrtmg.nc', + 'B:PRSUL10:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_SULF10_rrtmg.nc', + 'B:PRSUL11:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_SULF11_rrtmg.nc', + 'B:PRSUL12:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_SULF12_rrtmg.nc', + 'B:PRSUL13:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_SULF13_rrtmg.nc', + 'B:PRSUL14:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_SULF14_rrtmg.nc', + 'B:PRSUL15:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_SULF15_rrtmg.nc', + 'B:PRSUL16:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_SULF16_rrtmg.nc', + 'B:PRSUL17:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_SULF17_rrtmg.nc', + 'B:PRSUL18:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_SULF18_rrtmg.nc', + 'B:PRSUL19:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_SULF19_rrtmg.nc', + 'B:PRSUL20:$INPUTDATA_ROOT/atm/cam/chem/carma/rrtmg/aerosol_cld_SULF20_rrtmg.nc' +</rad_climate> + </namelist_defaults> diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index bd003c779a..1b6338b661 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -4476,6 +4476,20 @@ is not active. Default: none </entry> +<entry id="carma_sulfnuc_method" type="char*10" category="carma" + group="carma_nl" valid_values="ZhaoTurco,Vehkamaki" > + Nucleation methods: + ZhaoTurco + Zhao and Turco, JAS, V.26, No.5, 1995. + Vehkamaki + Vehkamaki, H., M. Kulmala, I. Napari, K.E.J. Lehtinen, + C. Timmreck, M. Noppel and A. Laaksonen, 2002, + An improved parameterization for sulfuric acid-water nucleation + rates for tropospheric and stratospheric conditions, + J. Geophys. Res., 107, 4622, doi:10.1029/2002jd002184 +Default: none +</entry> + <entry id="carma_conmax" type="real" category="carma" group="carma_nl" valid_values="" > A fraction that scales how tight the convergence criteria are to @@ -4492,6 +4506,13 @@ allowed per substep. Default: 0. </entry> +<entry id="carma_do_coremasscheck" type="logical" category="carma" + group="carma_nl" valid_values="" > +Flag indicating that do coremasscheck after certain subroutines +and abort the model if the check not pass. +Default: FALSE +</entry> + <entry id="carma_do_aerosol" type="logical" category="carma" group="carma_nl" valid_values="" > Flag indicating that the CARMA model is an aerosol model, and @@ -4522,6 +4543,14 @@ carma_do_incloud is true. Default: FALSE </entry> +<entry id="carma_do_cloudborne" type="logical" category="carma" + group="carma_nl" valid_values="" > +Flag indicating whether CARMA aerosol should be allowed to become +cloudborne. It is actually CAM and not CARMA that moves aerosol +between cloudborne and interstitial. +Default: FALSE +</entry> + <entry id="carma_do_coag" type="logical" category="carma" group="carma_nl" valid_values="" > Flag indicating whether the coagulation process is enabled for @@ -4585,6 +4614,41 @@ CARMA particles. Default: FALSE </entry> +<entry id="carma_do_budget_diags" type="logical" category="carma" + group="carma_nl" valid_values="" > +Flag indicating that model specific budget diagnostics should be +generated. +Default: FALSE +</entry> + +<entry id="carma_do_package_diags" type="logical" category="carma" + group="carma_nl" valid_values="" > +Flag indicating that model specific budget diagnostics should be +generated per physics package for the packages listed in +carma_diag_packages. +Default: FALSE +</entry> + +<entry id="carma_diags_packages" type="char*12(100)" category="carma" + group="carma_nl" valid_values="" > +List of physics packages for which diagnostic output is desired. +Default: NONE +</entry> + +<entry id="carma_debug_packages" type="char*32(100)" category="carma" + group="carma_nl" valid_values="" > +List of physics packages for which debug output from the local carma +state checker is desired. +Default: NONE +</entry> + +<entry id="carma_diags_file" type="integer" category="carma" + group="carma_nl" valid_values="" > +When > 0, indicates the history file to be used by default for +diagnostic output. A value of 1 indicated the h0 file. +Default: 0 +</entry> + <entry id="carma_rad_feedback" type="logical" category="carma" group="carma_nl" valid_values="" > Flag indicating that CARMA sulfate mass mixing ratio will be used @@ -4688,14 +4752,6 @@ first guess when condensational growth requires substepping. Default: 1 </entry> -<entry id="carma_reftfile" type="char*256" category="carma" - group="carma_nl" valid_values="" > -Specifies the name of the reference temperature file that will be -used (and created if necessary) for initialization of CARMA to a -fixed temperature profile. -Default: carma_reft.nc -</entry> - <entry id="carma_cstick" type="real" category="carma" group="carma_nl" valid_values="" > Accommodation coefficient for coagulation. @@ -4877,6 +4933,13 @@ the dust model. Default: set by build-namelist. </entry> +<entry id="carma_dustemisfactor" type="real" category="carma" + group="carma_model_nl" valid_values="" > +CARMA dust emissions scaling factor +Default: 0.5e-9_r8 +</entry> + + <!-- CARMA model - sea salt --> @@ -4892,6 +4955,151 @@ Specifies the name of the sea salt emission parameterization. Default: Gong </entry> +<!-- CARMA model - aerosol --> +<entry id="carma_BCOCemissions" type="char*32" category="carma_model" + group="carma_model_nl" valid_values="Yu2015,Specified" > +Specifies the input method of black and organic carbon aerosol emissions +for the trop_strat CARMA model. + +Valid options are: + + Yu2015 -- method used in Yu et. al, 2015 + Specified -- {{ hilight }}emissions_specifier{{ closehilight }} method which places emissons in physcis buffer + +Default: Yu2015 +</entry> + +<entry id="carma_SO4elevemis" type="char*32" category="carma_model" + group="carma_model_nl" valid_values="NONE,Specified" > +Specifies the input method of sulfate emissions +for the trop_strat CARMA model. + +Valid options are: + + Specified -- {{ hilight }}elev_emis_specifier{{ closehilight }} method which places emissons in physcis buffer + +Default: NONE +</entry> + +<entry id="elev_emis_specifier" type="char*256(50)" category="cam_chem" + group="elevated_emissions_opts" valid_values="" > +List of full pathnames of surface emission datasets. + +Elevated emission data added to physcis buffer read from a set of netcdf file. +Each tracer species emissions is read from its own file as directed by the +namelist variable {{ hilight }}elve_emis_specifier{{ closehilight }}. The +{{ hilight }}emissions_specifier{{ closehilight }} variable tells the model +which species have emissions and the file path for the corresponding species. +That is, the {{ hilight }}elve_emis_specifier{{ closehilight }} variable is +set something like: + + elev_emis_specifier = 'SO4 -> /path/emis.SO4.nc', + 'OC -> /path/emis.OC.nc', etc... + +Each emission file can have more than one source. When the emission are +read in the sources are summed to give a total emission field for the +corresponding species. The emission can be read in as time series of data, +cycle over a given year, or be fixed to a given date. + +Default: set by build-namelist. +</entry> + +<entry id="elev_emis_type" type="char*32" category="cam_chem" + group="elevated_emissions_opts" valid_values="CYCLICAL,SERIAL,INTERP_MISSING_MONTHS,FIXED" > +Type of time interpolation of emission datasets specified. +Can be set to 'CYCLICAL', 'SERIAL', 'INTERP_MISSING_MONTHS', or 'FIXED'. +by {{ hilight }}elev_emis_specifier{{ closehilight }}. +Default: 'CYCLICAL' +</entry> + +<entry id="elev_emis_cycle_yr" type="integer" category="cam_chem" + group="elevated_emissions_opts" valid_values="" > +The cycle year of the elevated emissions data +if {{ hilight }}elev_emis_type{{ closehilight }} is 'CYCLICAL'. +Format: YYYY +Default: 0 +</entry> + +<entry id="elev_emis_fixed_ymd" type="integer" category="cam_chem" + group="elevated_emissions_opts" valid_values="" > +The date at which the elevated emissions are fixed +if {{ hilight }}elev_emis_type{{ closehilight }} is 'FIXED'. +Format: YYYYMMDD +Default: 0 +</entry> + +<entry id="elev_emis_fixed_tod" type="integer" category="cam_chem" + group="elevated_emissions_opts" valid_values="" > +The time of day (seconds) corresponding to {{ hilight }}elev_emis_fixed_ymd{{ closehilight }} +at which the elevated emissions are fixed +if {{ hilight }}elev_emis_type{{ closehilight }} is 'FIXED'. +Default: 0 seconds +</entry> + +<entry id="BC_GAINS_filename" type="char*256" input_pathname="abs" category="carma_model" + group="carma_model_nl" valid_values="" > +BC GAINS file. +Default: set by build-namelist. +</entry> + +<entry id="OC_GAINS_filename" type="char*256" input_pathname="abs" category="carma_model" + group="carma_model_nl" valid_values="" > +OC GAINS file. +Default: set by build-namelist. +</entry> + +<entry id="BC_ship_filename" type="char*256" input_pathname="abs" category="carma_model" + group="carma_model_nl" valid_values="" > +BC ship file. +Default: set by build-namelist. +</entry> + +<entry id="OC_ship_filename" type="char*256" input_pathname="abs" category="carma_model" + group="carma_model_nl" valid_values="" > +OC ship file. +Default: set by build-namelist. +</entry> + +<entry id="BC_GFEDv3_filename" type="char*256" input_pathname="abs" category="carma_model" + group="carma_model_nl" valid_values="" > +BC GFEDv3 file. +Default: set by build-namelist. +</entry> + +<entry id="OC_GFEDv3_filename" type="char*256" input_pathname="abs" category="carma_model" + group="carma_model_nl" valid_values="" > +OC GFEDv3 file. +Default: set by build-namelist. +</entry> + +<entry id="Chlorophy11_file" type="char*256" input_pathname="abs" category="carma_model" + group="carma_model_nl" valid_values="" > +Dust erosion factor file. +Default: set by build-namelist. +</entry> + +<!-- Ozone: Data (original CAM version) --> + +<entry id="bndtvo" type="char*256" input_pathname="abs" category="o3_data_cam" + group="cam3_ozone_data_nl" valid_values="" > +Full pathname of time-variant ozone mixing ratio boundary dataset. +Default: set by build-namelist. +</entry> + +<entry id="cam3_ozone_data_on" type="logical" category="o3_data_cam" + group="cam3_ozone_data_nl" valid_values="" > +Add CAM3 prescribed ozone to the physics buffer. +Default: FALSE +</entry> + +<entry id="ozncyc" type="logical" category="o3_data_cam" + group="cam3_ozone_data_nl" valid_values="" > +Flag for yearly cycling of ozone data. If set to FALSE, a multi-year +dataset is assumed, otherwise a single-year dataset is assumed, and ozone +will be cycled over the 12 monthly averages in the file. +Default: TRUE +</entry> + <!-- Performance Tuning and Profiling --> <entry id="papi_ctr1_str" type="char*16" category="performance" @@ -5477,7 +5685,13 @@ Default: .true. <entry id="history_carma" type="logical" category="diagnostics" group="phys_ctl_nl" valid_values="" > Switch for diagnostics specific to the current CARMA model. -Default: .true. +Default: .false. +</entry> + +<entry id="history_carma_srf_flx" type="logical" category="diagnostics" + group="phys_ctl_nl" valid_values="" > +Switch for diagnostics specific to the current CARMA model. +Default: .false. </entry> <entry id="history_clubb" type="logical" category="diagnostics" @@ -5652,6 +5866,13 @@ rad_diag_* variables. Default: set by build-namelist </entry> +<entry id="bin_defs" type="char*256(640)" category="radiation" + group="rad_cnst_nl" valid_values="" > +Definitions for the aerosol bins that may be used in the rad_climate and +rad_diag_* variables. +Default: set by build-namelist +</entry> + <entry id="rad_climate" type="char*256(n_rad_cnst)" category="radiation" group="rad_cnst_nl" valid_values="" > A list of the radiatively active species, i.e., species that affect the @@ -7147,6 +7368,60 @@ cycle over a given year, or be fixed to a given date. Default: set by build-namelist. </entry> +<entry id="emissions_specifier" type="char*256(50)" category="cam_chem" + group="surface_emissions_opts" valid_values="" > +List of full pathnames of surface emission datasets. + +Surface emission data added to physcis buffer read from a set of netcdf file. +Each tracer species emissions is read from its own file as directed by the +namelist variable {{ hilight }}emissions_specifier{{ closehilight }}. The +{{ hilight }}emissions_specifier{{ closehilight }} variable tells the model +which species have emissions and the file path for the corresponding species. +That is, the {{ hilight }}emissions_specifier{{ closehilight }} variable is +set something like: + + emissions_specifier = 'BC -> /path/emis.BC.nc', + 'OC -> /path/emis.OC.nc', etc... + +Each emission file can have more than one source. When the emission are +read in the sources are summed to give a total emission field for the +corresponding species. The emission can be read in as time series of data, +cycle over a given year, or be fixed to a given date. + +Default: set by build-namelist. +</entry> + +<entry id="emissions_type" type="char*32" category="cam_chem" + group="surface_emissions_opts" valid_values="CYCLICAL,SERIAL,INTERP_MISSING_MONTHS,FIXED" > +Type of time interpolation of emission datasets specified. +Can be set to 'CYCLICAL', 'SERIAL', 'INTERP_MISSING_MONTHS', or 'FIXED'. +by {{ hilight }}emissions_specifier{{ closehilight }}. +Default: 'CYCLICAL' +</entry> + +<entry id="emissions_cycle_yr" type="integer" category="cam_chem" + group="surface_emissions_opts" valid_values="" > +The cycle year of the surface emissions data +if {{ hilight }}emissions_type{{ closehilight }} is 'CYCLICAL'. +Format: YYYY +Default: 0 +</entry> + +<entry id="emissions_fixed_ymd" type="integer" category="cam_chem" + group="surface_emissions_opts" valid_values="" > +The date at which the surface emissions are fixed +if {{ hilight }}emissions_type{{ closehilight }} is 'FIXED'. +Format: YYYYMMDD +Default: 0 +</entry> + +<entry id="emissions_fixed_tod" type="integer" category="cam_chem" + group="surface_emissions_opts" valid_values="" > +The time of day (seconds) corresponding to {{ hilight }}emissions_fixed_ymd{{ closehilight }} +at which the surface emissions are fixed +if {{ hilight }}emissions_type{{ closehilight }} is 'FIXED'. +Default: 0 seconds +</entry> <entry id="sulf_file" type="char*256" input_pathname="abs" category="cam_chem" group="sulf_nl" valid_values="" > diff --git a/bld/namelist_files/use_cases/carma_trop_strat_cam6.xml b/bld/namelist_files/use_cases/carma_trop_strat_cam6.xml new file mode 100644 index 0000000000..08fac8d224 --- /dev/null +++ b/bld/namelist_files/use_cases/carma_trop_strat_cam6.xml @@ -0,0 +1,135 @@ +<?xml version="1.0"?> +<namelist_defaults> + +<ncdata hgrid="1.9x2.5" nlev="32">atm/cam/inic/fv/FCARMAnudged_f19_carmats3128_spinup01.cam.i.1991-01-01_c241023.nc</ncdata> +<ncdata hgrid="1.9x2.5" nlev="32" aquaplanet="1">atm/cam/inic/fv/QPCARMATS_f19_carmats4038_spinup01_0002-01-01_c241029.nc</ncdata> +<ncdata hgrid="0.9x1.25" nlev="32">atm/cam/inic/fv/FCARMA2000climo_f09_carmats4038_spinup01_0002-01-01_c241029.nc</ncdata> + +<lght_no_prd_factor hgrid="1.9x2.5">4.5D0</lght_no_prd_factor> + +<!-- Solar data --> +<solar_irrad_data_file>atm/cam/solar/SolarForcing1995-2005avg_c160929.nc</solar_irrad_data_file> +<solar_data_ymd>20000101</solar_data_ymd> +<solar_data_type>FIXED</solar_data_type> + +<!-- Lower Boundary --> +<flbc_file>atm/waccm/lb/LBC_17500116-20150116_CMIP6_0p5degLat_c180905.nc</flbc_file> + +<!-- CARMA Dust Emissions Tuning Factor --> +<carma_dustemisfactor hgrid="1.9x2.5" >0.4D-9</carma_dustemisfactor> +<carma_dustemisfactor hgrid="0.9x1.25">0.5D-9</carma_dustemisfactor> + +<!-- WACCM GW Settings --> +<use_gw_front>.true.</use_gw_front> +<use_gw_convect_dp>.true.</use_gw_convect_dp> +<tau_0_ubc>.false.</tau_0_ubc> +<gw_qbo_hdepth_scaling>0.25D0</gw_qbo_hdepth_scaling> + +<!-- History specifiers --> +<history_chemistry>.false.</history_chemistry> +<history_chemspecies_srf>.false.</history_chemspecies_srf> +<history_clubb>.false.</history_clubb> +<history_scwaccm_forcing>.false.</history_scwaccm_forcing> +<history_cesm_forcing>.false.</history_cesm_forcing> +<history_carma_srf_flx>.true.</history_carma_srf_flx> + +<fincl1> + 'EXTINCT', 'EXTINCTUV', 'EXTINCTNIR','ABSORB', 'AODVIS', 'AODABS','SAD_STRAT','SAD_SULFC','SAD_LNAT','SAD_ICE', + 'O3','CO','OH','NO2','SSAVIS','AODNIR','AODVISst','AODNIRst','AODUVst',,'TMSO2','TMH2SO4','TMOCS', + 'TMPRSULF01','TMPRSULF02','TMPRSULF03','TMPRSULF04','TMPRSULF05','TMPRSULF06','TMPRSULF07','TMPRSULF08','TMPRSULF09','TMPRSULF10', + 'TMPRSULF11','TMPRSULF12','TMPRSULF13','TMPRSULF14','TMPRSULF15','TMPRSULF16','TMPRSULF17','TMPRSULF18','TMPRSULF19','TMPRSULF20', + 'TMMXOC01','TMMXOC02','TMMXOC03','TMMXOC04','TMMXOC05','TMMXOC06','TMMXOC07','TMMXOC08','TMMXOC09','TMMXOC10', + 'TMMXOC11','TMMXOC12','TMMXOC13','TMMXOC14','TMMXOC15','TMMXOC16','TMMXOC17','TMMXOC18','TMMXOC19','TMMXOC20', + 'TMMXBC01','TMMXBC02','TMMXBC03','TMMXBC04','TMMXBC05','TMMXBC06','TMMXBC07','TMMXBC08','TMMXBC09','TMMXBC10', + 'TMMXBC11','TMMXBC12','TMMXBC13','TMMXBC14','TMMXBC15','TMMXBC16','TMMXBC17','TMMXBC18','TMMXBC19','TMMXBC20', + 'TMMXDUST01','TMMXDUST02','TMMXDUST03','TMMXDUST04','TMMXDUST05','TMMXDUST06','TMMXDUST07','TMMXDUST08','TMMXDUST09','TMMXDUST10', + 'TMMXDUST11','TMMXDUST12','TMMXDUST13','TMMXDUST14','TMMXDUST15','TMMXDUST16','TMMXDUST17','TMMXDUST18','TMMXDUST19','TMMXDUST20', + 'TMMXSALT01','TMMXSALT02','TMMXSALT03','TMMXSALT04','TMMXSALT05','TMMXSALT06','TMMXSALT07','TMMXSALT08','TMMXSALT09','TMMXSALT10', + 'TMMXSALT11','TMMXSALT12','TMMXSALT13','TMMXSALT14','TMMXSALT15','TMMXSALT16','TMMXSALT17','TMMXSALT18','TMMXSALT19','TMMXSALT20' +</fincl1> + +<!-- emissions --> + +<ext_frc_type>CYCLICAL</ext_frc_type> +<ext_frc_cycle_yr>2000</ext_frc_cycle_yr> +<ext_frc_specifier> + 'NO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_NO2_aircraft_vertical_2000climo_0.9x1.25_c20170322.nc', + 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_SO2_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc', + 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SO2_aircraft_vertical_2000climo_0.9x1.25_c20170322.nc', +</ext_frc_specifier> + +<srf_emis_type>CYCLICAL</srf_emis_type> +<srf_emis_cycle_yr>2000</srf_emis_cycle_yr> +<srf_emis_specifier> + 'BENZENE -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_BENZENE_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'BENZENE -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_BENZENE_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'BIGALK -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_BIGALK_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'BIGALK -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_BIGALK_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'BIGENE -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_BIGENE_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'BIGENE -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_BIGENE_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'C2H2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H2_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'C2H2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H2_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'C2H4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H4_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'C2H4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H4_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'C2H4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H4_other_surface_2000climo_0.9x1.25_c20170322.nc', + 'C2H5OH -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H5OH_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'C2H5OH -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H5OH_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'C2H6 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H6_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'C2H6 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H6_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'C2H6 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H6_other_surface_2000climo_0.9x1.25_c20170322.nc', + 'C3H6 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C3H6_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'C3H6 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C3H6_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'C3H6 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C3H6_other_surface_2000climo_0.9x1.25_c20170322.nc', + 'C3H8 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C3H8_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'C3H8 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C3H8_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'C3H8 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C3H8_other_surface_2000climo_0.9x1.25_c20170322.nc', + 'CH2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH2O_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'CH2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH2O_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'CH3CHO -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3CHO_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'CH3CHO -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3CHO_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'CH3CN -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3CN_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'CH3CN -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3CN_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'CH3COCH3 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3COCH3_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'CH3COCH3 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3COCH3_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'CH3COCHO -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3COCHO_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'CH3COOH -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3COOH_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'CH3COOH -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3COOH_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'CH3OH -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3OH_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'CH3OH -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3OH_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'CO -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CO_anthro_surface_2000climo_0.9x1.25_c20180504.nc', + 'CO -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CO_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'CO -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CO_other_surface_2000climo_0.9x1.25_c20170322.nc', + 'E90 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions_E90global_surface_1750-2100_0.9x1.25_c20170322.nc', + 'GLYALD -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_GLYALD_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'HCN -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_HCN_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'HCN -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_HCN_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'HCOOH -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_HCOOH_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'HCOOH -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_HCOOH_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'ISOP -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_ISOP_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'IVOC -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_IVOC_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'IVOC -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_IVOC_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'MEK -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_MEK_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'MEK -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_MEK_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'MTERP -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_MTERP_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'NH3 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_NH3_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'NH3 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_NH3_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'NH3 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_NH3_other_surface_2000climo_0.9x1.25_c20170322.nc', + 'NO -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_NO_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'NO -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_NO_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'NO -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_NO_other_surface_2000climo_0.9x1.25_c20170322.nc', + 'SVOC -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SVOC_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'SVOC -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SVOC_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'TOLUENE -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_TOLUENE_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'TOLUENE -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_TOLUENE_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'XYLENES -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_XYLENES_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'XYLENES -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_XYLENES_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'DMS -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_DMS_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'DMS -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_DMS_other_surface_2000climo_0.9x1.25_c20170322.nc', + 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SO2_anthro-ag-ship-res_surface_2000climo_0.9x1.25_c20170616.nc', + 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SO2_anthro-ene_surface_2000climo_0.9x1.25_c20170616.nc', + 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SO2_bb_surface_2000climo_0.9x1.25_c20170322.nc', +</srf_emis_specifier> + +<sim_year>2000</sim_year> + +</namelist_defaults> diff --git a/bld/namelist_files/use_cases/carma_trop_strat_hist_cam6.xml b/bld/namelist_files/use_cases/carma_trop_strat_hist_cam6.xml new file mode 100644 index 0000000000..1033b64761 --- /dev/null +++ b/bld/namelist_files/use_cases/carma_trop_strat_hist_cam6.xml @@ -0,0 +1,57 @@ +<?xml version="1.0"?> +<namelist_defaults> + +<ncdata hgrid="1.9x2.5" nlev="32">atm/cam/inic/fv/FCARMAnudged_f19_carmats3128_spinup01.cam.i.1991-01-01_c241023.nc</ncdata> +<ncdata hgrid="0.9x1.25" nlev="32">atm/cam/inic/fv/FCARMA2000climo_f09_carmats4038_spinup01_0002-01-01_c241029.nc</ncdata> + +<lght_no_prd_factor hgrid="1.9x2.5">4.5D0</lght_no_prd_factor> + +<!-- Solar data --> +<solar_irrad_data_file>atm/cam/solar/SolarForcingCMIP6_18491230-23000102_c20200615.nc</solar_irrad_data_file> + +<!-- External forcing --> +<ext_frc_type>INTERP_MISSING_MONTHS</ext_frc_type> + +<!-- Surface emissions --> +<srf_emis_type>INTERP_MISSING_MONTHS</srf_emis_type> + +<!-- Lower Boundary --> +<flbc_type>SERIAL</flbc_type> +<flbc_file>atm/waccm/lb/LBC_17500116-20150116_CMIP6_0p5degLat_c180905.nc</flbc_file> + +<!-- CARMA Dust Emissions Tuning Factor --> +<carma_dustemisfactor hgrid="1.9x2.5" >0.4D-9</carma_dustemisfactor> +<carma_dustemisfactor hgrid="0.9x1.25">0.5D-9</carma_dustemisfactor> + +<!-- WACCM GW Settings --> +<use_gw_front>.true.</use_gw_front> +<use_gw_convect_dp>.true.</use_gw_convect_dp> +<tau_0_ubc>.false.</tau_0_ubc> +<gw_qbo_hdepth_scaling>0.25D0</gw_qbo_hdepth_scaling> + +<!-- History specifiers --> +<history_chemistry>.false.</history_chemistry> +<history_chemspecies_srf>.false.</history_chemspecies_srf> +<history_clubb>.false.</history_clubb> +<history_scwaccm_forcing>.false.</history_scwaccm_forcing> +<history_cesm_forcing>.false.</history_cesm_forcing> +<history_carma_srf_flx>.true.</history_carma_srf_flx> + +<fincl1> + 'EXTINCT', 'EXTINCTUV', 'EXTINCTNIR','ABSORB', 'AODVIS', 'AODABS','SAD_STRAT','SAD_SULFC','SAD_LNAT','SAD_ICE', + 'O3','CO','OH','NO2','SSAVIS','AODNIR','AODVISst','AODNIRst','AODUVst',,'TMSO2','TMH2SO4','TMOCS', + 'TMPRSULF01','TMPRSULF02','TMPRSULF03','TMPRSULF04','TMPRSULF05','TMPRSULF06','TMPRSULF07','TMPRSULF08','TMPRSULF09','TMPRSULF10', + 'TMPRSULF11','TMPRSULF12','TMPRSULF13','TMPRSULF14','TMPRSULF15','TMPRSULF16','TMPRSULF17','TMPRSULF18','TMPRSULF19','TMPRSULF20', + 'TMMXOC01','TMMXOC02','TMMXOC03','TMMXOC04','TMMXOC05','TMMXOC06','TMMXOC07','TMMXOC08','TMMXOC09','TMMXOC10', + 'TMMXOC11','TMMXOC12','TMMXOC13','TMMXOC14','TMMXOC15','TMMXOC16','TMMXOC17','TMMXOC18','TMMXOC19','TMMXOC20', + 'TMMXBC01','TMMXBC02','TMMXBC03','TMMXBC04','TMMXBC05','TMMXBC06','TMMXBC07','TMMXBC08','TMMXBC09','TMMXBC10', + 'TMMXBC11','TMMXBC12','TMMXBC13','TMMXBC14','TMMXBC15','TMMXBC16','TMMXBC17','TMMXBC18','TMMXBC19','TMMXBC20', + 'TMMXDUST01','TMMXDUST02','TMMXDUST03','TMMXDUST04','TMMXDUST05','TMMXDUST06','TMMXDUST07','TMMXDUST08','TMMXDUST09','TMMXDUST10', + 'TMMXDUST11','TMMXDUST12','TMMXDUST13','TMMXDUST14','TMMXDUST15','TMMXDUST16','TMMXDUST17','TMMXDUST18','TMMXDUST19','TMMXDUST20', + 'TMMXSALT01','TMMXSALT02','TMMXSALT03','TMMXSALT04','TMMXSALT05','TMMXSALT06','TMMXSALT07','TMMXSALT08','TMMXSALT09','TMMXSALT10', + 'TMMXSALT11','TMMXSALT12','TMMXSALT13','TMMXSALT14','TMMXSALT15','TMMXSALT16','TMMXSALT17','TMMXSALT18','TMMXSALT19','TMMXSALT20' +</fincl1> + +<sim_year>1850-2000</sim_year> + +</namelist_defaults> diff --git a/bld/namelist_files/use_cases/carma_trop_strat_nudged_cam6.xml b/bld/namelist_files/use_cases/carma_trop_strat_nudged_cam6.xml new file mode 100644 index 0000000000..4ba33bb21e --- /dev/null +++ b/bld/namelist_files/use_cases/carma_trop_strat_nudged_cam6.xml @@ -0,0 +1,118 @@ +<?xml version="1.0"?> +<namelist_defaults> + +<ncdata hgrid="1.9x2.5" nlev="32">atm/cam/inic/fv/FCARMAnudged_f19_carmats3128_spinup01.cam.i.1991-01-01_c241023.nc</ncdata> +<ncdata hgrid="0.9x1.25" nlev="32">atm/cam/inic/fv/FCARMA2000climo_f09_carmats4038_spinup01_0002-01-01_c241029.nc</ncdata> + +<lght_no_prd_factor hgrid="1.9x2.5">4.5D0</lght_no_prd_factor> + +<!-- Solar data --> +<solar_irrad_data_file>atm/cam/solar/SolarForcingCMIP6_18491230-23000102_c20200615.nc</solar_irrad_data_file> + +<!-- External forcing --> +<ext_frc_type>INTERP_MISSING_MONTHS</ext_frc_type> + +<!-- Surface emissions --> +<srf_emis_type>INTERP_MISSING_MONTHS</srf_emis_type> + +<!-- Ocean emissions --> +<bubble_mediated_transfer>.FALSE.</bubble_mediated_transfer> +<ocean_salinity_file>atm/cam/chem/ocnexch/SSS_recooked_0-360_c171120.nc</ocean_salinity_file> +<csw_specifier> 'DMS -> $INPUTDATA_ROOT/atm/cam/chem/ocnexch/Csw_DMS_Lana2011_f09f09_1750_2100_20200717a.nc' </csw_specifier> +<csw_time_type>SERIAL</csw_time_type> + +<!-- Lower Boundary --> +<flbc_type>SERIAL</flbc_type> +<flbc_file>atm/waccm/lb/LBC_17500116-20150116_CMIP6_0p5degLat_c180905.nc</flbc_file> + +<!-- CARMA Dust Emissions Tuning Factor --> +<carma_dustemisfactor hgrid="1.9x2.5" >0.4D-9</carma_dustemisfactor> +<carma_dustemisfactor hgrid="0.9x1.25">0.5D-9</carma_dustemisfactor> + +<!-- WACCM GW Settings --> +<use_gw_front>.true.</use_gw_front> +<use_gw_convect_dp>.true.</use_gw_convect_dp> +<tau_0_ubc>.false.</tau_0_ubc> +<gw_qbo_hdepth_scaling>0.25D0</gw_qbo_hdepth_scaling> + +<!-- History specifiers --> +<history_chemistry>.false.</history_chemistry> +<history_chemspecies_srf>.false.</history_chemspecies_srf> +<history_clubb>.false.</history_clubb> +<history_scwaccm_forcing>.false.</history_scwaccm_forcing> +<history_cesm_forcing>.false.</history_cesm_forcing> +<history_carma_srf_flx>.true.</history_carma_srf_flx> + +<fincl1> + 'EXTINCT', 'EXTINCTUV', 'EXTINCTNIR','ABSORB', 'AODVIS', 'AODABS','SAD_STRAT','SAD_SULFC','SAD_LNAT','SAD_ICE', + 'O3','CO','OH','NO2','SSAVIS','AODNIR','AODVISst','AODNIRst','AODUVst',,'TMSO2','TMH2SO4','TMOCS', + 'TMPRSULF01','TMPRSULF02','TMPRSULF03','TMPRSULF04','TMPRSULF05','TMPRSULF06','TMPRSULF07','TMPRSULF08','TMPRSULF09','TMPRSULF10', + 'TMPRSULF11','TMPRSULF12','TMPRSULF13','TMPRSULF14','TMPRSULF15','TMPRSULF16','TMPRSULF17','TMPRSULF18','TMPRSULF19','TMPRSULF20', + 'TMMXOC01','TMMXOC02','TMMXOC03','TMMXOC04','TMMXOC05','TMMXOC06','TMMXOC07','TMMXOC08','TMMXOC09','TMMXOC10', + 'TMMXOC11','TMMXOC12','TMMXOC13','TMMXOC14','TMMXOC15','TMMXOC16','TMMXOC17','TMMXOC18','TMMXOC19','TMMXOC20', + 'TMMXBC01','TMMXBC02','TMMXBC03','TMMXBC04','TMMXBC05','TMMXBC06','TMMXBC07','TMMXBC08','TMMXBC09','TMMXBC10', + 'TMMXBC11','TMMXBC12','TMMXBC13','TMMXBC14','TMMXBC15','TMMXBC16','TMMXBC17','TMMXBC18','TMMXBC19','TMMXBC20', + 'TMMXDUST01','TMMXDUST02','TMMXDUST03','TMMXDUST04','TMMXDUST05','TMMXDUST06','TMMXDUST07','TMMXDUST08','TMMXDUST09','TMMXDUST10', + 'TMMXDUST11','TMMXDUST12','TMMXDUST13','TMMXDUST14','TMMXDUST15','TMMXDUST16','TMMXDUST17','TMMXDUST18','TMMXDUST19','TMMXDUST20', + 'TMMXSALT01','TMMXSALT02','TMMXSALT03','TMMXSALT04','TMMXSALT05','TMMXSALT06','TMMXSALT07','TMMXSALT08','TMMXSALT09','TMMXSALT10', + 'TMMXSALT11','TMMXSALT12','TMMXSALT13','TMMXSALT14','TMMXSALT15','TMMXSALT16','TMMXSALT17','TMMXSALT18','TMMXSALT19','TMMXSALT20' +</fincl1> + +<!-- nudging --> + +<Nudge_Model>.true.</Nudge_Model> +<Nudge_Path hgrid="1.9x2.5" nlev="32">'atm/cam/met/nudging/MERRA2_fv19_32L/'</Nudge_Path> +<Nudge_Path hgrid="0.9x1.25" nlev="32">'atm/cam/met/nudging/MERRA2_fv09_32L/'</Nudge_Path> +<Nudge_Path hgrid="ne30np4" nlev="32">'atm/cam/met/nudging/MERRA2_ne30_32L/'</Nudge_Path> +<Nudge_Path hgrid="ne30np4" npg="3" nlev="32">'atm/cam/met/nudging/MERRA2_ne30pg3_32L/'</Nudge_Path> +<Nudge_Path hgrid="ne0np4CONUS.ne30x8" nlev="32">'atm/cam/met/nudging/MERRA2_ne0CONUS30x8_L32/'</Nudge_Path> +<Nudge_File_Template hgrid="1.9x2.5" nlev="32">'%y/MERRA2_fv19.cam2.i.%y-%m-%d-%s.nc'</Nudge_File_Template> +<Nudge_File_Template hgrid="0.9x1.25" nlev="32">'%y/MERRA2_fv09.cam2.i.%y-%m-%d-%s.nc'</Nudge_File_Template> +<Nudge_File_Template hgrid="ne30np4" nlev="32">'%y/MERRA2_ne30np4_L32.cam2.i.%y-%m-%d-%s.nc'</Nudge_File_Template> +<Nudge_File_Template hgrid="ne30np4" npg="3" nlev="32">'%y/MERRA2_ne30pg3_L32.cam2.i.%y-%m-%d-%s.nc'</Nudge_File_Template> +<Nudge_File_Template hgrid="ne0np4CONUS.ne30x8" nlev="32">'%y/MERRA2_ne0CONUS30x8_L32.cam2.i.%y-%m-%d-%s.nc'</Nudge_File_Template> +<Nudge_Force_Opt>0</Nudge_Force_Opt> +<Nudge_TimeScale_Opt>0</Nudge_TimeScale_Opt> +<Nudge_Times_Per_Day>8</Nudge_Times_Per_Day> +<Model_Times_Per_Day>48</Model_Times_Per_Day> +<Model_Times_Per_Day hgrid="ne0np4CONUS.ne30x8">384</Model_Times_Per_Day> +<Nudge_Uprof>1</Nudge_Uprof> +<Nudge_Ucoef>0.25</Nudge_Ucoef> +<Nudge_Vprof>1</Nudge_Vprof> +<Nudge_Vcoef>0.25</Nudge_Vcoef> +<Nudge_Tprof>1</Nudge_Tprof> +<Nudge_Tcoef>0.25</Nudge_Tcoef> +<Nudge_Qprof>0</Nudge_Qprof> +<Nudge_Qcoef>0.00</Nudge_Qcoef> +<Nudge_PSprof>0</Nudge_PSprof> +<Nudge_PScoef>0.00</Nudge_PScoef> +<Nudge_Beg_Year>1990</Nudge_Beg_Year> +<Nudge_Beg_Year hgrid="ne0np4CONUS.ne30x8">2013</Nudge_Beg_Year> +<Nudge_Beg_Month>1</Nudge_Beg_Month> +<Nudge_Beg_Day>1</Nudge_Beg_Day> +<Nudge_End_Year>2020</Nudge_End_Year> +<Nudge_End_Month>12</Nudge_End_Month> +<Nudge_End_Day>31</Nudge_End_Day> +<Nudge_Hwin_lat0>0.0</Nudge_Hwin_lat0> +<Nudge_Hwin_lat0 hgrid="ne0np4CONUS.ne30x8">37.</Nudge_Hwin_lat0> +<Nudge_Hwin_latWidth>9999.</Nudge_Hwin_latWidth> +<Nudge_Hwin_latWidth hgrid="ne0np4CONUS.ne30x8">56.</Nudge_Hwin_latWidth> +<Nudge_Hwin_latDelta>1.</Nudge_Hwin_latDelta> +<Nudge_Hwin_latDelta hgrid="ne0np4CONUS.ne30x8">5.</Nudge_Hwin_latDelta> +<Nudge_Hwin_lon0>180.</Nudge_Hwin_lon0> +<Nudge_Hwin_lon0 hgrid="ne0np4CONUS.ne30x8">264.</Nudge_Hwin_lon0> +<Nudge_Hwin_lonWidth>9999.</Nudge_Hwin_lonWidth> +<Nudge_Hwin_lonWidth hgrid="ne0np4CONUS.ne30x8">94.</Nudge_Hwin_lonWidth> +<Nudge_Hwin_lonDelta>1.</Nudge_Hwin_lonDelta> +<Nudge_Hwin_lonDelta hgrid="ne0np4CONUS.ne30x8">5.</Nudge_Hwin_lonDelta> +<Nudge_Hwin_Invert>.false.</Nudge_Hwin_Invert> +<Nudge_Hwin_Invert hgrid="ne0np4CONUS.ne30x8">.true.</Nudge_Hwin_Invert> +<Nudge_Vwin_Hindex>33.</Nudge_Vwin_Hindex> +<Nudge_Vwin_Hdelta>0.001</Nudge_Vwin_Hdelta> +<Nudge_Vwin_Lindex>0.</Nudge_Vwin_Lindex> +<Nudge_Vwin_Ldelta>0.1</Nudge_Vwin_Ldelta> +<Nudge_Vwin_Invert>.false.</Nudge_Vwin_Invert> + +<sim_year>1850-2000</sim_year> + +</namelist_defaults> diff --git a/bld/namelist_files/use_cases/carma_trop_strat_sd_cam6.xml b/bld/namelist_files/use_cases/carma_trop_strat_sd_cam6.xml new file mode 100644 index 0000000000..b8004c93b2 --- /dev/null +++ b/bld/namelist_files/use_cases/carma_trop_strat_sd_cam6.xml @@ -0,0 +1,75 @@ +<?xml version="1.0"?> +<namelist_defaults> + +<ncdata hgrid="1.9x2.5" nlev="56">atm/cam/inic/fv/CARMA_1.9x2.5_L56_c210226.nc</ncdata> +<ncdata hgrid="0.9x1.25" nlev="56">atm/cam/inic/fv/CARMA_0.9x1.25_L56_c210226.nc</ncdata> + +<lght_no_prd_factor hgrid="1.9x2.5">4.5D0</lght_no_prd_factor> + +<met_rlx_bot>50.</met_rlx_bot> +<met_rlx_top>60.</met_rlx_top> +<met_rlx_time>50.</met_rlx_time> +<met_fix_mass>.true.</met_fix_mass> + +<met_data_file dyn="fv" hgrid="0.9x1.25">1980/MERRA2_0.9x1.25_19800101.nc</met_data_file> +<met_data_path dyn="fv" hgrid="0.9x1.25">atm/cam/met/MERRA2/0.9x1.25</met_data_path> +<met_filenames_list dyn="fv" hgrid="0.9x1.25">atm/cam/met/MERRA2/0.9x1.25/filenames_1975-2017_c190125.txt</met_filenames_list> + +<met_data_file dyn="fv" hgrid="1.9x2.5">1980/MERRA2_1.9x2.5_19800101.nc</met_data_file> +<met_data_path dyn="fv" hgrid="1.9x2.5">atm/cam/met/MERRA2/1.9x2.5</met_data_path> +<met_filenames_list dyn="fv" hgrid="1.9x2.5">atm/cam/met/MERRA2/1.9x2.5/filenames_list_c180824</met_filenames_list> + +<met_qflx_factor>0.84</met_qflx_factor> + +<bnd_topo hgrid="0.9x1.25">atm/cam/met/MERRA2/0.9x1.25/fv_0.9x1.25_nc3000_Nsw042_Nrs008_Co060_Fi001_ZR_sgh30_24km_GRNL_MERRA2_c171218.nc</bnd_topo> +<bnd_topo hgrid="1.9x2.5">atm/cam/met/MERRA2/1.9x2.5/fv_1.9x2.5_nc3000_Nsw084_Nrs016_Co120_Fi001_ZR_GRNL_MERRA2_c190617.nc</bnd_topo> + +<!-- Solar data --> +<solar_irrad_data_file>atm/cam/solar/SolarForcingCMIP6_18491230-23000102_c20200615.nc</solar_irrad_data_file> + +<!-- External forcing --> +<ext_frc_type>INTERP_MISSING_MONTHS</ext_frc_type> + +<!-- Surface emissions --> +<srf_emis_type>INTERP_MISSING_MONTHS</srf_emis_type> + +<!-- Lower Boundary --> +<flbc_type>SERIAL</flbc_type> +<flbc_file>atm/waccm/lb/LBC_17500116-20150116_CMIP6_0p5degLat_c180905.nc</flbc_file> + +<!-- CARMA Dust Emissions Tuning Factor --> +<carma_dustemisfactor hgrid="1.9x2.5" >0.4D-9</carma_dustemisfactor> +<carma_dustemisfactor hgrid="0.9x1.25">0.5D-9</carma_dustemisfactor> + +<!-- WACCM GW Settings --> +<use_gw_front>.true.</use_gw_front> +<use_gw_convect_dp>.true.</use_gw_convect_dp> +<tau_0_ubc>.false.</tau_0_ubc> +<gw_qbo_hdepth_scaling>0.25D0</gw_qbo_hdepth_scaling> + +<!-- History specifiers --> +<history_chemistry>.false.</history_chemistry> +<history_chemspecies_srf>.false.</history_chemspecies_srf> +<history_clubb>.false.</history_clubb> +<history_scwaccm_forcing>.false.</history_scwaccm_forcing> +<history_cesm_forcing>.false.</history_cesm_forcing> +<history_carma_srf_flx>.true.</history_carma_srf_flx> + +<fincl1> + 'EXTINCT', 'EXTINCTUV', 'EXTINCTNIR','ABSORB', 'AODVIS', 'AODABS','SAD_STRAT','SAD_SULFC','SAD_LNAT','SAD_ICE', + 'O3','CO','OH','NO2','SSAVIS','AODNIR','AODVISst','AODNIRst','AODUVst',,'TMSO2','TMH2SO4','TMOCS', + 'TMPRSULF01','TMPRSULF02','TMPRSULF03','TMPRSULF04','TMPRSULF05','TMPRSULF06','TMPRSULF07','TMPRSULF08','TMPRSULF09','TMPRSULF10', + 'TMPRSULF11','TMPRSULF12','TMPRSULF13','TMPRSULF14','TMPRSULF15','TMPRSULF16','TMPRSULF17','TMPRSULF18','TMPRSULF19','TMPRSULF20', + 'TMMXOC01','TMMXOC02','TMMXOC03','TMMXOC04','TMMXOC05','TMMXOC06','TMMXOC07','TMMXOC08','TMMXOC09','TMMXOC10', + 'TMMXOC11','TMMXOC12','TMMXOC13','TMMXOC14','TMMXOC15','TMMXOC16','TMMXOC17','TMMXOC18','TMMXOC19','TMMXOC20', + 'TMMXBC01','TMMXBC02','TMMXBC03','TMMXBC04','TMMXBC05','TMMXBC06','TMMXBC07','TMMXBC08','TMMXBC09','TMMXBC10', + 'TMMXBC11','TMMXBC12','TMMXBC13','TMMXBC14','TMMXBC15','TMMXBC16','TMMXBC17','TMMXBC18','TMMXBC19','TMMXBC20', + 'TMMXDUST01','TMMXDUST02','TMMXDUST03','TMMXDUST04','TMMXDUST05','TMMXDUST06','TMMXDUST07','TMMXDUST08','TMMXDUST09','TMMXDUST10', + 'TMMXDUST11','TMMXDUST12','TMMXDUST13','TMMXDUST14','TMMXDUST15','TMMXDUST16','TMMXDUST17','TMMXDUST18','TMMXDUST19','TMMXDUST20', + 'TMMXSALT01','TMMXSALT02','TMMXSALT03','TMMXSALT04','TMMXSALT05','TMMXSALT06','TMMXSALT07','TMMXSALT08','TMMXSALT09','TMMXSALT10', + 'TMMXSALT11','TMMXSALT12','TMMXSALT13','TMMXSALT14','TMMXSALT15','TMMXSALT16','TMMXSALT17','TMMXSALT18','TMMXSALT19','TMMXSALT20' +</fincl1> + +<sim_year>1850-2000</sim_year> + +</namelist_defaults> diff --git a/bld/namelist_files/use_cases/carma_waccm_ma_hist_cam6.xml b/bld/namelist_files/use_cases/carma_waccm_ma_hist_cam6.xml new file mode 100644 index 0000000000..0fba6ef50e --- /dev/null +++ b/bld/namelist_files/use_cases/carma_waccm_ma_hist_cam6.xml @@ -0,0 +1,48 @@ +<?xml version="1.0"?> +<namelist_defaults> + +<ncdata hgrid="0.9x1.25" nlev="70">atm/waccm/ic/FWmaCARMAHIST_f09_spinup01.cam.i.1980-01-01-00000_c220128.nc</ncdata> + +<!-- Solar data --> +<solar_irrad_data_file>atm/cam/solar/SolarForcingCMIP6_18491230-23000102_c20200615.nc</solar_irrad_data_file> + +<!-- External forcing --> +<ext_frc_type>INTERP_MISSING_MONTHS</ext_frc_type> + +<!-- Surface emissions --> +<srf_emis_type>INTERP_MISSING_MONTHS</srf_emis_type> + +<!-- Lower Boundary --> +<flbc_type>SERIAL</flbc_type> +<flbc_file>atm/waccm/lb/LBC_17500116-20150116_CMIP6_0p5degLat_c180905.nc</flbc_file> + +<!-- CARMA Dust Emissions Tuning Factor --> +<carma_dustemisfactor hgrid="1.9x2.5" >0.4D-9</carma_dustemisfactor> +<carma_dustemisfactor hgrid="0.9x1.25">0.5D-9</carma_dustemisfactor> + +<!-- History specifiers --> +<history_chemistry>.false.</history_chemistry> +<history_chemspecies_srf>.false.</history_chemspecies_srf> +<history_clubb>.false.</history_clubb> +<history_scwaccm_forcing>.false.</history_scwaccm_forcing> +<history_cesm_forcing>.false.</history_cesm_forcing> +<history_carma_srf_flx>.true.</history_carma_srf_flx> + +<fincl1> + 'EXTINCT', 'EXTINCTUV', 'EXTINCTNIR','ABSORB', 'AODVIS', 'AODABS','SAD_STRAT','SAD_SULFC','SAD_LNAT','SAD_ICE', + 'O3','CO','OH','NO2','SSAVIS','AODNIR','AODVISst','AODNIRst','AODUVst',,'TMSO2','TMH2SO4','TMOCS', + 'TMPRSULF01','TMPRSULF02','TMPRSULF03','TMPRSULF04','TMPRSULF05','TMPRSULF06','TMPRSULF07','TMPRSULF08','TMPRSULF09','TMPRSULF10', + 'TMPRSULF11','TMPRSULF12','TMPRSULF13','TMPRSULF14','TMPRSULF15','TMPRSULF16','TMPRSULF17','TMPRSULF18','TMPRSULF19','TMPRSULF20', + 'TMMXOC01','TMMXOC02','TMMXOC03','TMMXOC04','TMMXOC05','TMMXOC06','TMMXOC07','TMMXOC08','TMMXOC09','TMMXOC10', + 'TMMXOC11','TMMXOC12','TMMXOC13','TMMXOC14','TMMXOC15','TMMXOC16','TMMXOC17','TMMXOC18','TMMXOC19','TMMXOC20', + 'TMMXBC01','TMMXBC02','TMMXBC03','TMMXBC04','TMMXBC05','TMMXBC06','TMMXBC07','TMMXBC08','TMMXBC09','TMMXBC10', + 'TMMXBC11','TMMXBC12','TMMXBC13','TMMXBC14','TMMXBC15','TMMXBC16','TMMXBC17','TMMXBC18','TMMXBC19','TMMXBC20', + 'TMMXDUST01','TMMXDUST02','TMMXDUST03','TMMXDUST04','TMMXDUST05','TMMXDUST06','TMMXDUST07','TMMXDUST08','TMMXDUST09','TMMXDUST10', + 'TMMXDUST11','TMMXDUST12','TMMXDUST13','TMMXDUST14','TMMXDUST15','TMMXDUST16','TMMXDUST17','TMMXDUST18','TMMXDUST19','TMMXDUST20', + 'TMMXSALT01','TMMXSALT02','TMMXSALT03','TMMXSALT04','TMMXSALT05','TMMXSALT06','TMMXSALT07','TMMXSALT08','TMMXSALT09','TMMXSALT10', + 'TMMXSALT11','TMMXSALT12','TMMXSALT13','TMMXSALT14','TMMXSALT15','TMMXSALT16','TMMXSALT17','TMMXSALT18','TMMXSALT19','TMMXSALT20' +</fincl1> + +<sim_year>1850-2000</sim_year> + +</namelist_defaults> diff --git a/bld/namelist_files/use_cases/carma_waccm_ma_nudged_cam6.xml b/bld/namelist_files/use_cases/carma_waccm_ma_nudged_cam6.xml new file mode 100644 index 0000000000..47a0bcaa2f --- /dev/null +++ b/bld/namelist_files/use_cases/carma_waccm_ma_nudged_cam6.xml @@ -0,0 +1,102 @@ +<?xml version="1.0"?> +<namelist_defaults> + +<ncdata hgrid="0.9x1.25" nlev="70">atm/waccm/ic/FWmaCARMAHIST_f09_spinup01.cam.i.1980-01-01-00000_c220128.nc</ncdata> + +<!-- Solar data --> +<solar_irrad_data_file>atm/cam/solar/SolarForcingCMIP6_18491230-23000102_c20200615.nc</solar_irrad_data_file> + +<!-- External forcing --> +<ext_frc_type>INTERP_MISSING_MONTHS</ext_frc_type> + +<!-- Surface emissions --> +<srf_emis_type>INTERP_MISSING_MONTHS</srf_emis_type> + +<!-- Ocean emissions --> +<bubble_mediated_transfer>.FALSE.</bubble_mediated_transfer> +<ocean_salinity_file>atm/cam/chem/ocnexch/SSS_recooked_0-360_c171120.nc</ocean_salinity_file> +<csw_specifier> 'DMS -> $INPUTDATA_ROOT/atm/cam/chem/ocnexch/Csw_DMS_Lana2011_f09f09_1750_2100_20200717a.nc' </csw_specifier> +<csw_time_type>SERIAL</csw_time_type> + +<!-- Lower Boundary --> +<flbc_type>SERIAL</flbc_type> +<flbc_file>atm/waccm/lb/LBC_17500116-20150116_CMIP6_0p5degLat_c180905.nc</flbc_file> + +<!-- CARMA Dust Emissions Tuning Factor --> +<carma_dustemisfactor hgrid="1.9x2.5" >0.4D-9</carma_dustemisfactor> +<carma_dustemisfactor hgrid="0.9x1.25">0.5D-9</carma_dustemisfactor> + +<!-- History specifiers --> +<history_chemistry>.false.</history_chemistry> +<history_chemspecies_srf>.false.</history_chemspecies_srf> +<history_clubb>.false.</history_clubb> +<history_scwaccm_forcing>.false.</history_scwaccm_forcing> +<history_cesm_forcing>.false.</history_cesm_forcing> +<history_carma_srf_flx>.true.</history_carma_srf_flx> + +<fincl1> + 'EXTINCT', 'EXTINCTUV', 'EXTINCTNIR','ABSORB', 'AODVIS', 'AODABS','SAD_STRAT','SAD_SULFC','SAD_LNAT','SAD_ICE', + 'O3','CO','OH','NO2','SSAVIS','AODNIR','AODVISst','AODNIRst','AODUVst',,'TMSO2','TMH2SO4','TMOCS', + 'TMPRSULF01','TMPRSULF02','TMPRSULF03','TMPRSULF04','TMPRSULF05','TMPRSULF06','TMPRSULF07','TMPRSULF08','TMPRSULF09','TMPRSULF10', + 'TMPRSULF11','TMPRSULF12','TMPRSULF13','TMPRSULF14','TMPRSULF15','TMPRSULF16','TMPRSULF17','TMPRSULF18','TMPRSULF19','TMPRSULF20', + 'TMMXOC01','TMMXOC02','TMMXOC03','TMMXOC04','TMMXOC05','TMMXOC06','TMMXOC07','TMMXOC08','TMMXOC09','TMMXOC10', + 'TMMXOC11','TMMXOC12','TMMXOC13','TMMXOC14','TMMXOC15','TMMXOC16','TMMXOC17','TMMXOC18','TMMXOC19','TMMXOC20', + 'TMMXBC01','TMMXBC02','TMMXBC03','TMMXBC04','TMMXBC05','TMMXBC06','TMMXBC07','TMMXBC08','TMMXBC09','TMMXBC10', + 'TMMXBC11','TMMXBC12','TMMXBC13','TMMXBC14','TMMXBC15','TMMXBC16','TMMXBC17','TMMXBC18','TMMXBC19','TMMXBC20', + 'TMMXDUST01','TMMXDUST02','TMMXDUST03','TMMXDUST04','TMMXDUST05','TMMXDUST06','TMMXDUST07','TMMXDUST08','TMMXDUST09','TMMXDUST10', + 'TMMXDUST11','TMMXDUST12','TMMXDUST13','TMMXDUST14','TMMXDUST15','TMMXDUST16','TMMXDUST17','TMMXDUST18','TMMXDUST19','TMMXDUST20', + 'TMMXSALT01','TMMXSALT02','TMMXSALT03','TMMXSALT04','TMMXSALT05','TMMXSALT06','TMMXSALT07','TMMXSALT08','TMMXSALT09','TMMXSALT10', + 'TMMXSALT11','TMMXSALT12','TMMXSALT13','TMMXSALT14','TMMXSALT15','TMMXSALT16','TMMXSALT17','TMMXSALT18','TMMXSALT19','TMMXSALT20' +</fincl1> + +<!-- nudging --> + +<Nudge_Model>.true.</Nudge_Model> +<Nudge_Path hgrid="1.9x2.5" nlev="70">'atm/cam/met/nudging/MERRA2_fv19_70L/'</Nudge_Path> +<Nudge_Path hgrid="0.9x1.25" nlev="70">'atm/cam/met/nudging/MERRA2_fv09_70L/'</Nudge_Path> +<Nudge_File_Template hgrid="1.9x2.5" nlev="32">'%y/MERRA2_fv19.cam2.i.%y-%m-%d-%s.nc'</Nudge_File_Template> +<Nudge_File_Template hgrid="0.9x1.25" nlev="32">'%y/MERRA2_fv09.cam2.i.%y-%m-%d-%s.nc'</Nudge_File_Template> +<Nudge_Force_Opt>0</Nudge_Force_Opt> +<Nudge_TimeScale_Opt>0</Nudge_TimeScale_Opt> +<Nudge_Times_Per_Day>8</Nudge_Times_Per_Day> +<Model_Times_Per_Day>48</Model_Times_Per_Day> +<Nudge_Uprof>1</Nudge_Uprof> +<Nudge_Ucoef>0.25</Nudge_Ucoef> +<Nudge_Vprof>1</Nudge_Vprof> +<Nudge_Vcoef>0.25</Nudge_Vcoef> +<Nudge_Tprof>1</Nudge_Tprof> +<Nudge_Tcoef>0.25</Nudge_Tcoef> +<Nudge_Qprof>0</Nudge_Qprof> +<Nudge_Qcoef>0.00</Nudge_Qcoef> +<Nudge_PSprof>0</Nudge_PSprof> +<Nudge_PScoef>0.00</Nudge_PScoef> +<Nudge_Beg_Year>1990</Nudge_Beg_Year> +<Nudge_Beg_Year hgrid="ne0np4CONUS.ne30x8">2013</Nudge_Beg_Year> +<Nudge_Beg_Month>1</Nudge_Beg_Month> +<Nudge_Beg_Day>1</Nudge_Beg_Day> +<Nudge_End_Year>2020</Nudge_End_Year> +<Nudge_End_Month>12</Nudge_End_Month> +<Nudge_End_Day>31</Nudge_End_Day> +<Nudge_Hwin_lat0>0.0</Nudge_Hwin_lat0> +<Nudge_Hwin_lat0 hgrid="ne0np4CONUS.ne30x8">37.</Nudge_Hwin_lat0> +<Nudge_Hwin_latWidth>9999.</Nudge_Hwin_latWidth> +<Nudge_Hwin_latWidth hgrid="ne0np4CONUS.ne30x8">56.</Nudge_Hwin_latWidth> +<Nudge_Hwin_latDelta>1.</Nudge_Hwin_latDelta> +<Nudge_Hwin_latDelta hgrid="ne0np4CONUS.ne30x8">5.</Nudge_Hwin_latDelta> +<Nudge_Hwin_lon0>180.</Nudge_Hwin_lon0> +<Nudge_Hwin_lon0 hgrid="ne0np4CONUS.ne30x8">264.</Nudge_Hwin_lon0> +<Nudge_Hwin_lonWidth>9999.</Nudge_Hwin_lonWidth> +<Nudge_Hwin_lonWidth hgrid="ne0np4CONUS.ne30x8">94.</Nudge_Hwin_lonWidth> +<Nudge_Hwin_lonDelta>1.</Nudge_Hwin_lonDelta> +<Nudge_Hwin_lonDelta hgrid="ne0np4CONUS.ne30x8">5.</Nudge_Hwin_lonDelta> +<Nudge_Hwin_Invert>.false.</Nudge_Hwin_Invert> +<Nudge_Hwin_Invert hgrid="ne0np4CONUS.ne30x8">.true.</Nudge_Hwin_Invert> +<Nudge_Vwin_Hindex>71.</Nudge_Vwin_Hindex> +<Nudge_Vwin_Hdelta>0.001</Nudge_Vwin_Hdelta> +<Nudge_Vwin_Lindex>22.</Nudge_Vwin_Lindex> +<Nudge_Vwin_Ldelta>1.0</Nudge_Vwin_Ldelta> +<Nudge_Vwin_Invert>.false.</Nudge_Vwin_Invert> + +<sim_year>1850-2000</sim_year> + +</namelist_defaults> diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 2ab0a50558..6fc2b69724 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -9,7 +9,7 @@ =============== --> <desc atm="CAM70[%LT][%MT][%CT1S][%CT4S]" >CAM cam7 physics:</desc> - <desc atm="CAM60[%1PCT][%4xCO2][%CT1S][%CT2S][%CFIRE][%CVBSX][%NUDG][%PORT][%RCO2][%SCAM][%SDYN][%WCCM][%WCMD][%WCSC][%WCTS][%WXIE][%WXIED][%HEMCO][%GEOSCHEM][%SCAMARM95][%SCAMARM97][%SCAMATEX][%SCAMBOMEX][%SCAMCGILSS11][%SCAMCGILSS12][%SCAMCGILSS6][%SCAMDYCOMSRF01][%SCAMDYCOMSRF02][%SCAMGATE3][%SCAMMPACE][%SCAMRICO][%SCAMSPARTICUS][%SCAMTOGA2][%SCAMTWP06][%SCAMCAMFRC]" >CAM cam6 physics:</desc> + <desc atm="CAM60[%1PCT][%4xCO2][%CARMATS][%CARMAWM][%CT1S][%CT2S][%CFIRE][%CVBSX][%NUDG][%PORT][%RCO2][%SCAM][%SDYN][%WCCM][%WCMD][%WCSC][%WCTS][%WXIE][%WXIED][%HEMCO][%GEOSCHEM][%SCAMARM95][%SCAMARM97][%SCAMATEX][%SCAMBOMEX][%SCAMCGILSS11][%SCAMCGILSS12][%SCAMCGILSS6][%SCAMDYCOMSRF01][%SCAMDYCOMSRF02][%SCAMGATE3][%SCAMMPACE][%SCAMRICO][%SCAMSPARTICUS][%SCAMTOGA2][%SCAMTWP06][%SCAMCAMFRC]" >CAM cam6 physics:</desc> <desc atm="CAM50[%CT1S][%CLB][%PORT][%RCO2][%MAM7][%SCAM][%SDYN][%WCSC][%WCTS][%SCAMARM95][%SCAMARM97][%SCAMATEX][%SCAMBOMEX][%SCAMCGILSS11][%SCAMCGILSS12][%SCAMCGILSS6][%SCAMDYCOMSRF01][%SCAMDYCOMSRF02][%SCAMGATE3][%SCAMMPACE][%SCAMRICO][%SCAMSPARTICUS][%SCAMTOGA2][%SCAMTWP06][%SCAMCAMFRC]" >CAM cam5 physics:</desc> <desc atm="CAM40[%PORT][%RCO2][%SCAM][%SDYN][%TMOZ][%WX][%WXIE][%WXIED][%WCCM][%WCMD][%SCAMARM95][%SCAMARM97][%SCAMATEX][%SCAMBOMEX][%SCAMCGILSS11][%SCAMCGILSS12][%SCAMCGILSS6][%SCAMDYCOMSRF01][%SCAMDYCOMSRF02][%SCAMGATE3][%SCAMMPACE][%SCAMRICO][%SCAMSPARTICUS][%SCAMTOGA2][%SCAMTWP06][%SCAMCAMFRC]" >CAM cam4 physics:</desc> <desc atm="CAM[%ADIAB][%DABIP04][%TJ16][%GRAYRAD][%HS94][%KESSLER][%RCO2][%SPCAMS][%SPCAMCLBS][%SPCAMM][%SPCAMCLBM]" >CAM simplified and non-versioned physics :</desc> @@ -139,6 +139,8 @@ <value compset="_CAM60.*%(GEOSCHEM)">-chem geoschem_mam4</value> <value compset="%MAM7">-chem trop_mam7</value> + <value compset="CAM60%CARMATS">-chem trop_strat_noaero -carma trop_strat_soa5</value> + <value compset="CAM60%CARMAWM">-chem waccm_ma_noaero -carma trop_strat_soa1</value> <value compset="CAM60%CVBSX">-chem trop_strat_mam5_vbsext</value> <value compset="CAM60%CT2S">-chem trop_strat_mam5_ts2</value> <value compset="CAM.*%CT4S">-chem trop_strat_mam5_ts4</value> @@ -153,7 +155,7 @@ <!-- Match against "%WC" to set defaults for all WACCM cases. --> <!-- Later settings of "-chem" take precedence over earlier ones. --> - <value compset="_(CAM50|CAM60)%(WC|CT|CV|CF)">-age_of_air_trcs</value> + <value compset="_(CAM50|CAM60)%(WC|CT|CV|CF|CARMA)">-age_of_air_trcs</value> <value compset="_CAM40%WCCM">-chem waccm_ma</value> <value compset="_(CAM50|CAM60)%WCCM">-chem waccm_ma_mam5</value> <value compset="_(CAM50|CAM60)%WCMD">-chem waccm_mad_mam5</value> @@ -170,6 +172,7 @@ <value compset="_CAM.*%SDYN">-offline_dyn</value> <value compset="_CAM\d0%SDYN_CLM">-nlev 56</value> <value compset="_CAM\d0%CT.*%SDYN">-nlev 56</value> + <value compset="_CAM\d0%CARMATS.*%SDYN">-nlev 56</value> <value compset="_CAM\d0%WC.*%SDYN">-nlev 88</value> <value compset="_CAM\d0%WX.*%SDYN">-nlev 145</value> <value compset="_CAM70%LT">-nlev 58 -model_top lt</value> @@ -245,6 +248,7 @@ <value compset="2000_CAM60%WCCM" >waccm_ma_2000_cam6</value> <value compset="2000_CAM60%WCSC" >waccm_sc_2000_cam6</value> <value compset="2000_CAM60%.*CT1S" >2000_trop_strat_vbs_cam6</value> + <value compset="2000_CAM60%CARMATS">carma_trop_strat_cam6</value> <value compset="2000_CAM60%GEOSCHEM">2000_geoschem</value> <value compset="2000_CAM60%WXIE" >waccmx_ma_2000_cam6</value> @@ -282,6 +286,10 @@ <value compset="HIST[CE]?_CAM7.*CT4S" >hist_trop_strat_t4s_cam7</value> <value compset="1850[CE]?_CAM7.*CT4S" >1850_trop_strat_t4s_cam7</value> <value compset="HIST_CAM60%.*CT[12]S%NUDG">hist_trop_strat_nudged_cam6</value> + <value compset="HIST_CAM60%CARMATS">carma_trop_strat_hist_cam6</value> + <value compset="HIST_CAM60%CARMATS%NUDG">carma_trop_strat_nudged_cam6</value> + <value compset="HIST_CAM60%CARMAWM">carma_waccm_ma_hist_cam6</value> + <value compset="HIST_CAM60%CARMAWM%NUDG">carma_waccm_ma_nudged_cam6</value> <value compset="HIST_CAM60%CVBSX" >hist_trop_strat_vbsext_cam6</value> <value compset="HIST_CAM60%CFIRE" >hist_trop_strat_vbsfire_cam6</value> <value compset="HIST_CAM60%GEOSCHEM">hist_geoschem</value> @@ -312,6 +320,7 @@ <value compset="_CAM40%WCMD%SDYN" >sd_waccm_ma_cam4</value> <value compset="_CAM60%.*CT1S%SDYN" >sd_trop_strat_vbs_cam6</value> <value compset="_CAM60%.*CT2S%SDYN" >sd_trop_strat2_cam6</value> + <value compset="_CAM60%CARMATS%SDYN">carma_trop_strat_sd_cam6</value> <value compset="_CAM60%SDYN_CLM50" >sd_cam6</value> <value compset="2000_CAM%DABIP04" >dabi_p2004</value> diff --git a/cime_config/config_compsets.xml b/cime_config/config_compsets.xml index c04f925dda..d41a2f9d1b 100644 --- a/cime_config/config_compsets.xml +++ b/cime_config/config_compsets.xml @@ -418,6 +418,42 @@ <lname>2000_CAM60%GEOSCHEM%HEMCO_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV</lname> </compset> + <compset> + <alias>FCARMA2000climo</alias> + <lname>2000_CAM60%CARMATS_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV</lname> + </compset> + + <compset> + <alias>QPCARMATS</alias> + <lname>2000_CAM60%CARMATS_SLND_SICE_DOCN%AQP3_SROF_SGLC_SWAV</lname> + </compset> + <compset> + <alias>QPCARMAWM</alias> + <lname>2000_CAM60%CARMAWM_SLND_SICE_DOCN%AQP3_SROF_SGLC_SWAV</lname> + </compset> + + <compset> + <alias>FCARMAHIST</alias> + <lname>HIST_CAM60%CARMATS_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV</lname> + </compset> + <compset> + <alias>FCARMAnudged</alias> + <lname>HIST_CAM60%CARMATS%NUDG_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV</lname> + </compset> + <compset> + <alias>FCARMASD</alias> + <lname>HIST_CAM60%CARMATS%SDYN_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV</lname> + </compset> + + <compset> + <alias>FWmaCARMAHIST</alias> + <lname>HIST_CAM60%CARMAWM_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV</lname> + </compset> + <compset> + <alias>FWmaCARMAnudged</alias> + <lname>HIST_CAM60%CARMAWM%NUDG_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV</lname> + </compset> + <compset> <alias>FC2010climo</alias> <lname>2010_CAM60%CT1S_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV</lname> @@ -679,9 +715,11 @@ <value compset="HIST_CAM60%CVBSX">1995-01-01</value> <value compset="HIST_CAM60%CFIRE">1995-01-01</value> <value compset="RCP[2468]_CAM\d+">2005-01-01</value> + <value compset="_CAM.*%NUDG" >2010-01-01</value> + <value compset="CAM60%CARMA.*%NUDG" >1990-01-01</value> <value compset="_CAM.*%SDYN" >2005-01-01</value> <value compset="_CAM.*%SDYN" grid="a%0.47x0.63">2010-01-01</value> - <value compset="_CAM60%(WCCM|WCTS|WXIE).*%SDYN">1980-01-01</value> + <value compset="_CAM60%(CARMA|WCCM|WCTS|WXIE).*%SDYN">1980-01-01</value> <value compset="_CAM40%WX.*%SDYN">2000-01-01</value> <value compset="2000_CAM60%GEOSCHEM">2000-01-01</value> <value compset="2010_CAM60%GEOSCHEM">2010-01-01</value> diff --git a/cime_config/config_pes.xml b/cime_config/config_pes.xml index f488c21b27..a33880d9e6 100644 --- a/cime_config/config_pes.xml +++ b/cime_config/config_pes.xml @@ -833,7 +833,7 @@ <rootpe_cpl>0</rootpe_cpl> </rootpe> </pes> - <pes pesize="any" compset="_CAM\d0%(CT|CV|CF|WC|WX)"> + <pes pesize="any" compset="_CAM\d0%(CT|CV|CF|WC|WX|CARMA)"> <comment>none</comment> <ntasks> <ntasks_atm>-4</ntasks_atm> @@ -1418,7 +1418,7 @@ </pes> </mach> <mach name="derecho"> - <pes pesize="any" compset="_(CAM50|CAM60)%(CT|CV|CF|WC)"> + <pes pesize="any" compset="_(CAM50|CAM60)%(CT|CV|CF|WC|CARMA)"> <comment>none</comment> <ntasks> <ntasks_atm>-8</ntasks_atm> diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_dust/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/carma_dust/user_nl_cam index cfac3a4818..9893ae9a9e 100644 --- a/cime_config/testdefs/testmods_dirs/cam/carma_dust/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/carma_dust/user_nl_cam @@ -6,4 +6,3 @@ pbuf_global_allocate=.false. history_carma=.true. fincl2 = 'CRSLERFC' carma_do_fixedinit=.false. -carma_reftfile="camrun.cam.r.carma_reft.nc" diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_elvemis_outfrq9s/shell_commands b/cime_config/testdefs/testmods_dirs/cam/carma_elvemis_outfrq9s/shell_commands new file mode 100644 index 0000000000..eb40ad83e0 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/carma_elvemis_outfrq9s/shell_commands @@ -0,0 +1,2 @@ +./xmlchange ROF_NCPL=\$ATM_NCPL +./xmlchange GLC_NCPL=\$ATM_NCPL diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_elvemis_outfrq9s/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/carma_elvemis_outfrq9s/user_nl_cam new file mode 100644 index 0000000000..08b352ca35 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/carma_elvemis_outfrq9s/user_nl_cam @@ -0,0 +1,14 @@ +mfilt=1,1,1,1,1,1,1,1,1 +ndens=1,1,1,1,1,1,1,1,1 +nhtfrq=9,9,9,9,9,9,9,9,9 +inithist='ENDOFRUN' +carma_SO4elevemis = 'Specified' +elev_emis_specifier = + 'SO4 -> $DIN_LOC_ROOT/atm/cam/chem/carma/elev_emis/so4_a1_geoeng_cyclical_2Tg_20.0-20.1km_30.6S_180E_1.9x2.5_c230823.nc', + 'SO4 -> $DIN_LOC_ROOT/atm/cam/chem/carma/elev_emis/so4_a1_geoeng_cyclical_2Tg_20.0-20.1km_30.6N_180E_1.9x2.5_c230823.nc' +elev_emis_type = 'CYCLICAL' +elev_emis_cycle_yr = 2040 + +fincl2 = 'SO4_elevemis','PRSULF01EM','PRSULF02EM','PRSULF03EM','PRSULF04EM','PRSULF05EM','PRSULF06EM','PRSULF07EM', + 'PRSULF08EM','PRSULF09EM','PRSULF10EM','PRSULF11EM','PRSULF12EM','PRSULF13EM','PRSULF14EM','PRSULF15EM', + 'PRSULF16EM','PRSULF17EM','PRSULF18EM','PRSULF19EM','PRSULF20EM', diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_elvemis_outfrq9s/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/carma_elvemis_outfrq9s/user_nl_clm new file mode 100644 index 0000000000..0d83b5367b --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/carma_elvemis_outfrq9s/user_nl_clm @@ -0,0 +1,27 @@ +!---------------------------------------------------------------------------------- +! Users should add all user specific namelist changes below in the form of +! namelist_var = new_namelist_value +! +! Include namelist variables for drv_flds_in ONLY if -megan and/or -drydep options +! are set in the CLM_NAMELIST_OPTS env variable. +! +! EXCEPTIONS: +! Set use_cndv by the compset you use and the CLM_BLDNML_OPTS -dynamic_vegetation setting +! Set use_vichydro by the compset you use and the CLM_BLDNML_OPTS -vichydro setting +! Set use_cn by the compset you use and CLM_BLDNML_OPTS -bgc setting +! Set use_crop by the compset you use and CLM_BLDNML_OPTS -crop setting +! Set spinup_state by the CLM_BLDNML_OPTS -bgc_spinup setting +! Set irrigate by the CLM_BLDNML_OPTS -irrig setting +! Set dtime with L_NCPL option +! Set fatmlndfrc with LND_DOMAIN_PATH/LND_DOMAIN_FILE options +! Set finidat with RUN_REFCASE/RUN_REFDATE/RUN_REFTOD options for hybrid or branch cases +! (includes $inst_string for multi-ensemble cases) +! Set glc_grid with CISM_GRID option +! Set glc_smb with GLC_SMB option +! Set maxpatch_glcmec with GLC_NEC option +! Set glc_do_dynglacier with GLC_TWO_WAY_COUPLING env variable +!---------------------------------------------------------------------------------- +hist_nhtfrq = 9 +hist_mfilt = 1 +hist_ndens = 1 + diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_meteor_impact/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/carma_meteor_impact/user_nl_cam index 36487d1f35..ca4ea707ef 100644 --- a/cime_config/testdefs/testmods_dirs/cam/carma_meteor_impact/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/carma_meteor_impact/user_nl_cam @@ -5,7 +5,6 @@ inithist='ENDOFRUN' pbuf_global_allocate=.false. history_carma=.true. carma_do_fixedinit=.false. -carma_reftfile="camrun.cam.r.carma_reft.nc" solar_data_type='FIXED' solar_data_ymd=20000101 carma_emis_maxlat = 40. diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_meteor_smoke/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/carma_meteor_smoke/user_nl_cam index f69245ce24..50c3262a40 100644 --- a/cime_config/testdefs/testmods_dirs/cam/carma_meteor_smoke/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/carma_meteor_smoke/user_nl_cam @@ -5,7 +5,5 @@ inithist='ENDOFRUN' pbuf_global_allocate=.false. history_carma=.true. carma_do_fixedinit=.false. -carma_reftfile="camrun.cam.r.carma_reft.nc" solar_data_type='FIXED' solar_data_ymd=20000101 - diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_mixed_sulfate/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/carma_mixed_sulfate/user_nl_cam index 52b192f861..d292329b4c 100644 --- a/cime_config/testdefs/testmods_dirs/cam/carma_mixed_sulfate/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/carma_mixed_sulfate/user_nl_cam @@ -5,7 +5,6 @@ inithist='ENDOFRUN' pbuf_global_allocate=.false. history_carma=.true. carma_do_fixedinit=.false. -carma_reftfile="camrun.cam.r.carma_reft.nc" flbc_list = 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC12', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH4', 'CO2', 'H2', 'HCFC22', 'N2O', 'OCS' solar_data_type='FIXED' diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_pmc/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/carma_pmc/user_nl_cam index b40ad17f97..3ec29d7308 100644 --- a/cime_config/testdefs/testmods_dirs/cam/carma_pmc/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/carma_pmc/user_nl_cam @@ -6,4 +6,3 @@ pbuf_global_allocate=.false. history_carma=.true. carma_do_fixedinit=.false. carma_do_partialinit=.false. -carma_reftfile="camrun.cam.r.carma_reft.nc" diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_sea_salt/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/carma_sea_salt/user_nl_cam index 377cbb2295..bb1512a995 100644 --- a/cime_config/testdefs/testmods_dirs/cam/carma_sea_salt/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/carma_sea_salt/user_nl_cam @@ -5,4 +5,3 @@ inithist='ENDOFRUN' pbuf_global_allocate=.false. history_carma=.true. carma_do_fixedinit=.false. -carma_reftfile="camrun.cam.r.carma_reft.nc" diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_sulfate/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/carma_sulfate/user_nl_cam index cfc4580f54..e3a93951a0 100644 --- a/cime_config/testdefs/testmods_dirs/cam/carma_sulfate/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/carma_sulfate/user_nl_cam @@ -5,7 +5,6 @@ inithist='ENDOFRUN' pbuf_global_allocate=.false. history_carma=.true. carma_do_fixedinit=.false. -carma_reftfile="camrun.cam.r.carma_reft.nc" flbc_list = 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC12', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH4', 'CO2', 'H2', 'HCFC22', 'N2O', 'OCS' solar_data_type='FIXED' diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_test_growth/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/carma_test_growth/user_nl_cam index 377cbb2295..bb1512a995 100644 --- a/cime_config/testdefs/testmods_dirs/cam/carma_test_growth/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/carma_test_growth/user_nl_cam @@ -5,4 +5,3 @@ inithist='ENDOFRUN' pbuf_global_allocate=.false. history_carma=.true. carma_do_fixedinit=.false. -carma_reftfile="camrun.cam.r.carma_reft.nc" diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_test_passive/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/carma_test_passive/user_nl_cam index 377cbb2295..bb1512a995 100644 --- a/cime_config/testdefs/testmods_dirs/cam/carma_test_passive/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/carma_test_passive/user_nl_cam @@ -5,4 +5,3 @@ inithist='ENDOFRUN' pbuf_global_allocate=.false. history_carma=.true. carma_do_fixedinit=.false. -carma_reftfile="camrun.cam.r.carma_reft.nc" diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_test_radiative/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/carma_test_radiative/user_nl_cam index 377cbb2295..bb1512a995 100644 --- a/cime_config/testdefs/testmods_dirs/cam/carma_test_radiative/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/carma_test_radiative/user_nl_cam @@ -5,4 +5,3 @@ inithist='ENDOFRUN' pbuf_global_allocate=.false. history_carma=.true. carma_do_fixedinit=.false. -carma_reftfile="camrun.cam.r.carma_reft.nc" diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_test_swelling/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/carma_test_swelling/user_nl_cam index 377cbb2295..bb1512a995 100644 --- a/cime_config/testdefs/testmods_dirs/cam/carma_test_swelling/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/carma_test_swelling/user_nl_cam @@ -5,4 +5,3 @@ inithist='ENDOFRUN' pbuf_global_allocate=.false. history_carma=.true. carma_do_fixedinit=.false. -carma_reftfile="camrun.cam.r.carma_reft.nc" diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_test_tracers/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/carma_test_tracers/user_nl_cam index 377cbb2295..bb1512a995 100644 --- a/cime_config/testdefs/testmods_dirs/cam/carma_test_tracers/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/carma_test_tracers/user_nl_cam @@ -5,4 +5,3 @@ inithist='ENDOFRUN' pbuf_global_allocate=.false. history_carma=.true. carma_do_fixedinit=.false. -carma_reftfile="camrun.cam.r.carma_reft.nc" diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_test_tracers2/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/carma_test_tracers2/user_nl_cam index 377cbb2295..bb1512a995 100644 --- a/cime_config/testdefs/testmods_dirs/cam/carma_test_tracers2/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/carma_test_tracers2/user_nl_cam @@ -5,4 +5,3 @@ inithist='ENDOFRUN' pbuf_global_allocate=.false. history_carma=.true. carma_do_fixedinit=.false. -carma_reftfile="camrun.cam.r.carma_reft.nc" diff --git a/src/chemistry/aerosol/aero_deposition_cam.F90 b/src/chemistry/aerosol/aero_deposition_cam.F90 index d22119c6b4..e8a2fd1947 100644 --- a/src/chemistry/aerosol/aero_deposition_cam.F90 +++ b/src/chemistry/aerosol/aero_deposition_cam.F90 @@ -190,7 +190,7 @@ subroutine aero_deposition_cam_setwet(aerdepwetis, aerdepwetcw, cam_out) dst_fluxes = 0._r8 do ibin = 1,aero_props%nbins() - do ispec = 0,aero_props%nmasses(ibin) + do ispec = 0,aero_props%nspecies(ibin) if (ispec==0) then call aero_props%num_names(ibin, specname, name_c) else diff --git a/src/chemistry/aerosol/aero_wetdep_cam.F90 b/src/chemistry/aerosol/aero_wetdep_cam.F90 index 4a8a4e1ac4..bcfef0f28e 100644 --- a/src/chemistry/aerosol/aero_wetdep_cam.F90 +++ b/src/chemistry/aerosol/aero_wetdep_cam.F90 @@ -21,9 +21,11 @@ module aero_wetdep_cam use aerosol_properties_mod, only: aero_name_len use aerosol_properties_mod, only: aerosol_properties use modal_aerosol_properties_mod, only: modal_aerosol_properties + use carma_aerosol_properties_mod, only: carma_aerosol_properties use aerosol_state_mod, only: aerosol_state, ptr2d_t use modal_aerosol_state_mod, only: modal_aerosol_state + use carma_aerosol_state_mod, only: carma_aerosol_state use aero_convproc, only: aero_convproc_readnl, aero_convproc_init, aero_convproc_intr use aero_convproc, only: convproc_do_evaprain_atonce @@ -64,6 +66,7 @@ module aero_wetdep_cam real(r8),allocatable :: scavimptblvol(:,:) integer :: nmodes=0 + integer :: nbins=0 integer :: nspec_max=0 integer :: nele_tot ! total number of aerosol elements class(aerosol_properties), pointer :: aero_props=>null() @@ -169,26 +172,31 @@ subroutine aero_wetdep_init( ) history_chemistry_out=history_chemistry, & convproc_do_aer_out = convproc_do_aer) - call rad_cnst_get_info(0, nmodes=nmodes) + call rad_cnst_get_info(0, nmodes=nmodes, nbins=nbins) if (nmodes>0) then aero_props => modal_aerosol_properties() if (.not.associated(aero_props)) then call endrun(subrname//' : construction of aero_props modal_aerosol_properties object failed') end if + else if (nbins>0) then + aero_props => carma_aerosol_properties() + if (.not.associated(aero_props)) then + call endrun(subrname//' : construction of aero_props carma_aerosol_properties object failed') + end if else call endrun(subrname//' : cannot determine aerosol model') endif nele_tot = aero_props%ncnst_tot() - allocate(aero_cnst_lq(aero_props%nbins(),0:maxval(aero_props%nmasses())), stat=astat) + allocate(aero_cnst_lq(aero_props%nbins(),0:maxval(aero_props%nspecies())), stat=astat) if (astat/=0) then call endrun(subrname//' : not able to allocate aero_cnst_lq array') end if aero_cnst_lq(:,:) = .false. - allocate(aero_cnst_id(aero_props%nbins(),0:maxval(aero_props%nmasses())), stat=astat) + allocate(aero_cnst_id(aero_props%nbins(),0:maxval(aero_props%nspecies())), stat=astat) if (astat/=0) then call endrun(subrname//' : not able to allocate aero_cnst_id array') end if @@ -200,7 +208,7 @@ subroutine aero_wetdep_init( ) write(binstr,'(i2.2)') m call addfld('SOLFACTB'//binstr, (/ 'lev' /), 'A', '1', 'below cld sol fact') - do l = 0, aero_props%nmasses(m) + do l = 0, aero_props%nspecies(m) if (l == 0) then ! number call aero_props%num_names( m, tmpname, tmpname_cw) @@ -411,6 +419,11 @@ subroutine aero_wetdep_tend( state, dt, dlf, cam_out, ptend, pbuf) if (.not.associated(aero_state)) then call endrun(subrname//' : construction of aero_state modal_aerosol_state object failed') end if + else if (nbins>0) then + aero_state => carma_aerosol_state(state,pbuf) + if (.not.associated(aero_state)) then + call endrun(subrname//' : construction of aero_state carma_aerosol_state object failed') + end if else call endrun(subrname//' : cannot determine aerosol model') endif @@ -467,7 +480,7 @@ subroutine aero_wetdep_tend( state, dt, dlf, cam_out, ptend, pbuf) if (convproc_do_evaprain_atonce) then do m = 1,aero_props%nbins() - do l = 0,aero_props%nmasses(m) + do l = 0,aero_props%nspecies(m) mm = aero_props%indexer(m,l) if (l == 0) then ! number @@ -544,9 +557,10 @@ subroutine aero_wetdep_tend( state, dt, dlf, cam_out, ptend, pbuf) end if - masses_loop: do l = 0,aero_props%nmasses(m) + elem_loop: do l = 0,aero_props%nspecies(m) ndx = aero_cnst_id(m,l) + if (ndx<1) cycle elem_loop if (.not. cldbrn .and. ndx>0) then insolfr_ptr => fracis(:,:,ndx) @@ -619,7 +633,7 @@ subroutine aero_wetdep_tend( state, dt, dlf, cam_out, ptend, pbuf) end if endif - if (cldbrn .or. ndx<0) then + if (cldbrn) then do k = 1,pver do i = 1,ncol if ( (qqcw(mm)%fld(i,k) + dqdt_tmp(i,k) * dt) .lt. 0.0_r8 ) then @@ -775,7 +789,7 @@ subroutine aero_wetdep_tend( state, dt, dlf, cam_out, ptend, pbuf) end if end if - end do masses_loop + end do elem_loop end do phase_loop end do bins_loop diff --git a/src/chemistry/aerosol/aerosol_state_mod.F90 b/src/chemistry/aerosol/aerosol_state_mod.F90 index 363ce7ac99..c835219df0 100644 --- a/src/chemistry/aerosol/aerosol_state_mod.F90 +++ b/src/chemistry/aerosol/aerosol_state_mod.F90 @@ -51,6 +51,7 @@ module aerosol_state_mod procedure(aero_hetfrz_size_wght), deferred :: hetfrz_size_wght procedure(aero_hygroscopicity), deferred :: hygroscopicity procedure(aero_water_uptake), deferred :: water_uptake + procedure(aero_wgtpct), deferred :: wgtpct procedure :: refractive_index_sw procedure :: refractive_index_lw procedure(aero_volume), deferred :: dry_volume @@ -222,15 +223,15 @@ end function aero_hetfrz_size_wght ! returns hygroscopicity for a given radiation diagnostic list number and ! bin number !------------------------------------------------------------------------------ - function aero_hygroscopicity(self, list_ndx, bin_ndx) result(kappa) + subroutine aero_hygroscopicity(self, list_ndx, bin_ndx, kappa) import :: aerosol_state, r8 class(aerosol_state), intent(in) :: self integer, intent(in) :: list_ndx ! rad climate/diagnostic list index integer, intent(in) :: bin_ndx ! bin number - real(r8), pointer :: kappa(:,:) ! hygroscopicity (ncol,nlev) + real(r8), intent(out) :: kappa(:,:) ! hygroscopicity (ncol,nlev) - end function aero_hygroscopicity + end subroutine aero_hygroscopicity !------------------------------------------------------------------------------ ! returns aerosol wet diameter and aerosol water concentration for a given @@ -250,6 +251,17 @@ subroutine aero_water_uptake(self, aero_props, list_idx, bin_idx, ncol, nlev, dg end subroutine aero_water_uptake + !------------------------------------------------------------------------------ + ! aerosol weight precent of H2SO4/H2O solution + !------------------------------------------------------------------------------ + function aero_wgtpct(self, ncol, nlev) result(wtp) + import :: aerosol_state, r8 + class(aerosol_state), intent(in) :: self + integer, intent(in) :: ncol,nlev + real(r8) :: wtp(ncol,nlev) ! weight precent of H2SO4/H2O solution for given icol, ilev + + end function aero_wgtpct + !------------------------------------------------------------------------------ ! aerosol volume interface !------------------------------------------------------------------------------ diff --git a/src/chemistry/aerosol/carma_aerosol_properties_mod.F90 b/src/chemistry/aerosol/carma_aerosol_properties_mod.F90 new file mode 100644 index 0000000000..ebf50759bc --- /dev/null +++ b/src/chemistry/aerosol/carma_aerosol_properties_mod.F90 @@ -0,0 +1,867 @@ +module carma_aerosol_properties_mod + use shr_kind_mod, only: r8 => shr_kind_r8 + use physconst, only: pi + use aerosol_properties_mod, only: aerosol_properties, aero_name_len + use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_bin_props_by_idx, & + rad_cnst_get_info_by_bin, rad_cnst_get_info_by_bin_spec, rad_cnst_get_bin_props + use infnan, only: nan, assignment(=) + + implicit none + + private + + public :: carma_aerosol_properties + + type, extends(aerosol_properties) :: carma_aerosol_properties + private + integer, allocatable :: ibl(:) + contains + procedure :: number_transported + procedure :: get + procedure :: amcube + procedure :: actfracs + procedure :: num_names + procedure :: mmr_names + procedure :: amb_num_name + procedure :: amb_mmr_name + procedure :: species_type + procedure :: icenuc_updates_num + procedure :: icenuc_updates_mmr + procedure :: apply_number_limits + procedure :: hetfrz_species + procedure :: optics_params + procedure :: nbins_rlist + procedure :: nspecies_per_bin_rlist + procedure :: alogsig_rlist + procedure :: soluble + procedure :: min_mass_mean_rad + procedure :: bin_name + procedure :: scav_diam + procedure :: resuspension_resize + procedure :: rebin_bulk_fluxes + procedure :: hydrophilic + + final :: destructor + end type carma_aerosol_properties + + interface carma_aerosol_properties + procedure :: constructor + end interface carma_aerosol_properties + + real(r8), parameter :: onethird = 1._r8/3._r8 + +contains + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + function constructor() result(newobj) + + type(carma_aerosol_properties), pointer :: newobj + + integer :: l, m, nbins, ncnst_tot + integer,allocatable :: nspecies(:) + integer,allocatable :: nmasses(:) + real(r8),allocatable :: alogsig(:) + real(r8),allocatable :: f1(:) + real(r8),allocatable :: f2(:) + integer :: ierr + + integer, pointer :: ibl(:) + integer :: ii, imx, imx_num, imx_mmr, ipr, ipr_num, ipr_mmr + character(len=32) :: spectype + character(len=32) :: bin_name + character(len=32) :: bin_name_l ! bin name of the larger bin + + integer, allocatable :: imx_bl(:) ! index used to map pure sulfate bin to mixed sulfate bin + integer, allocatable :: imx_mmr_bl(:) ! index used to map pure sulfate bin to mixed sulfate bin for mmr + integer, allocatable :: imx_num_bl(:) ! index used to map pure sulfate bin to mixed sulfate bin for num + + allocate(newobj,stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + + call rad_cnst_get_info( 0, nbins=nbins) + + allocate( nspecies(nbins),stat=ierr ) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + allocate( nmasses(nbins),stat=ierr ) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + allocate( alogsig(nbins),stat=ierr ) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + allocate( f1(nbins),stat=ierr ) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + allocate( f2(nbins),stat=ierr ) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + + ncnst_tot = 0 + + do m = 1, nbins + call rad_cnst_get_info_by_bin(0, m, nspec=nspecies(m)) + ncnst_tot = ncnst_tot + nspecies(m) + 1 + nmasses(m) = nspecies(m) + end do + + alogsig(:) = log(2._r8) !!!! ???? IS THIS RIGHT ???? !!! + f1 = 1._r8 + f2 = 1._r8 + + call newobj%initialize(nbins,ncnst_tot,nspecies,nmasses,alogsig,f1,f2,ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + deallocate(nspecies) + deallocate(nmasses) + deallocate(alogsig) + deallocate(f1) + deallocate(f2) + + allocate(newobj%ibl(ncnst_tot),stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + ibl => newobj%ibl + + ibl = -1 + + allocate(imx_num_bl(nbins)) + allocate(imx_mmr_bl(nbins)) + allocate(imx_bl(nbins)) + + imx = 0 + imx_mmr = 0 + imx_num = 0 + ipr = 0 + ipr_mmr = 0 + ipr_num = 0 + + do m = 1,nbins + bin_name = newobj%bin_name(0,m) + bin_name_l = ' ' + if (m<nbins) then + bin_name_l = newobj%bin_name(0,m+1) + end if + + do l = 0,newobj%nspecies(m) + ii = newobj%indexer(m,l) + ibl(ii) = ii + + ! derive index array for larger bin, for evaporation into larger bi + if (l>0 .and. l<=newobj%nspecies(m)) then + call newobj%species_type(m,l,spectype) + else + spectype = 'other' + end if + ! identification is required for pure and mixed aerosols, mixed aeroosols are moved to + ! larger bin, pure aerosols are moved to mixed sulfate + + + if (index(bin_name,'MXAER')>0 .and. index(bin_name_l,'MXAER')>0) then + ! for mixed aerosols + ! find larger bin + ibl(ii) = newobj%indexer(m+1,l) + ! define mixed aerosol sulfate index to be used for pure sulfate only + if (trim(spectype) == 'sulfate') then + imx = imx + 1 + imx_bl(imx) = ibl(ii) + end if + if (l == newobj%nspecies(m)+1) then ! only for mmr + imx_mmr = imx_mmr + 1 + ibl(ii) = newobj%indexer(m+1,l) + imx_mmr_bl(imx_mmr) = ibl(ii) + end if + if (l == 0) then ! only for num + imx_num = imx_num + 1 + ibl(ii) = newobj%indexer(m+1,l) + imx_num_bl(imx_num) = ibl(ii) + end if + end if ! MXAER + + if (index(bin_name,'PRSUL')>0 .and. index(bin_name_l,'PRSUL')>0) then + ! assuming PRSULF and MXSULF have the same number of bins + if (trim(spectype) == 'sulfate') then + ipr = ipr +1 + ibl(ii) = imx_bl(ipr) + end if + if (l == newobj%nspecies(m)+1) then ! only for mmr reset counter to only go from 1-20 bins + ipr_mmr = ipr_mmr + 1 + ibl(ii) = imx_mmr_bl(ipr_mmr) + end if + if (l == 0 ) then ! only for num reset counter to only go from 1-20 bins + ipr_num = ipr_num + 1 + ibl(ii) = imx_num_bl(ipr_num) + end if + end if + if (ibl(ii).eq.0) then + ibl(ii) = ii + end if + end do + end do + + deallocate(imx_mmr_bl, imx_num_bl, imx_bl) + + end function constructor + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + subroutine destructor(self) + type(carma_aerosol_properties), intent(inout) :: self + + call self%final() + + end subroutine destructor + + !------------------------------------------------------------------------------ + ! returns number of transported aerosol constituents + !------------------------------------------------------------------------------ + integer function number_transported(self) + class(carma_aerosol_properties), intent(in) :: self + ! to be implemented later + number_transported = -1 + end function number_transported + + !------------------------------------------------------------------------ + ! returns aerosol properties: + ! density + ! hygroscopicity + ! species type + ! species name + ! short wave species refractive indices + ! long wave species refractive indices + ! species morphology + !------------------------------------------------------------------------ + subroutine get(self, bin_ndx, species_ndx, list_ndx, density, hygro, & + spectype, specname, specmorph, refindex_sw, refindex_lw) + + class(carma_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin index + integer, intent(in) :: species_ndx ! species index + integer, optional, intent(in) :: list_ndx ! climate or a diagnostic list number + real(r8), optional, intent(out) :: density ! density (kg/m3) + real(r8), optional, intent(out) :: hygro ! hygroscopicity + character(len=*), optional, intent(out) :: spectype ! species type + character(len=*), optional, intent(out) :: specname ! species name + character(len=*), optional, intent(out) :: specmorph ! species morphology + complex(r8), pointer, optional, intent(out) :: refindex_sw(:) ! short wave species refractive indices + complex(r8), pointer, optional, intent(out) :: refindex_lw(:) ! long wave species refractive indices + + integer :: ilist + + if (present(list_ndx)) then + ilist = list_ndx + else + ilist = 0 + end if + + if (present(density)) then + call rad_cnst_get_bin_props_by_idx(ilist, bin_ndx, species_ndx, density_aer=density) + end if + if (present(hygro)) then + call rad_cnst_get_bin_props_by_idx(ilist, bin_ndx, species_ndx, hygro_aer=hygro) + end if + if (present(spectype)) then + call rad_cnst_get_bin_props_by_idx(ilist, bin_ndx, species_ndx, spectype=spectype) + end if + if (present(refindex_sw)) then + call rad_cnst_get_bin_props_by_idx(ilist, bin_ndx, species_ndx, refindex_aer_sw=refindex_sw) + end if + if (present(refindex_lw)) then + call rad_cnst_get_bin_props_by_idx(ilist, bin_ndx, species_ndx, refindex_aer_lw=refindex_lw) + end if + if (present(specmorph)) then + call rad_cnst_get_bin_props_by_idx(ilist, bin_ndx, species_ndx, specmorph=specmorph) + end if + if (present(specname)) then + if (species_ndx>self%nspecies(bin_ndx)) then + call rad_cnst_get_info_by_bin(0, bin_ndx, mmr_name=specname) + else + call rad_cnst_get_info_by_bin_spec(ilist, bin_ndx, species_ndx, spec_name=specname) + end if + end if + + end subroutine get + + !------------------------------------------------------------------------ + ! returns optics type and table parameters + !------------------------------------------------------------------------ + subroutine optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, abspsw, asmpsw, absplw, & + refrtabsw, refitabsw, refrtablw, refitablw, ncoef, prefr, prefi, sw_hygro_ext_wtp, & + sw_hygro_ssa_wtp, sw_hygro_asm_wtp, lw_hygro_ext_wtp, wgtpct, nwtp, & + sw_hygro_coreshell_ext, sw_hygro_coreshell_ssa, sw_hygro_coreshell_asm, lw_hygro_coreshell_ext, & + corefrac, bcdust, kap, relh, nfrac, nbcdust, nkap, nrelh ) + + class(carma_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin index + integer, intent(in) :: list_ndx ! rad climate/diags list + + character(len=*), optional, intent(out) :: opticstype + + ! refactive index table parameters + real(r8), optional, pointer :: extpsw(:,:,:,:) ! short wave specific extinction + real(r8), optional, pointer :: abspsw(:,:,:,:) ! short wave specific absorption + real(r8), optional, pointer :: asmpsw(:,:,:,:) ! short wave asymmetry factor + real(r8), optional, pointer :: absplw(:,:,:,:) ! long wave specific absorption + real(r8), optional, pointer :: refrtabsw(:,:) ! table of short wave real refractive indices for aerosols + real(r8), optional, pointer :: refitabsw(:,:) ! table of short wave imaginary refractive indices for aerosols + real(r8), optional, pointer :: refrtablw(:,:) ! table of long wave real refractive indices for aerosols + real(r8), optional, pointer :: refitablw(:,:) ! table of long wave imaginary refractive indices for aerosols + integer, optional, intent(out) :: ncoef ! number of chebychev polynomials + integer, optional, intent(out) :: prefr ! number of real refractive indices in table + integer, optional, intent(out) :: prefi ! number of imaginary refractive indices in table + + ! hygrowghtpct table parameters + real(r8), optional, pointer :: sw_hygro_ext_wtp(:,:) ! short wave extinction table + real(r8), optional, pointer :: sw_hygro_ssa_wtp(:,:) ! short wave single-scatter albedo table + real(r8), optional, pointer :: sw_hygro_asm_wtp(:,:) ! short wave asymmetry table + real(r8), optional, pointer :: lw_hygro_ext_wtp(:,:) ! long wave absorption table + real(r8), optional, pointer :: wgtpct(:) ! weight precent of H2SO4/H2O solution + integer, optional, intent(out) :: nwtp ! number of weight precent values + + ! hygrocoreshell table parameters + real(r8), optional, pointer :: sw_hygro_coreshell_ext(:,:,:,:,:) ! short wave extinction table + real(r8), optional, pointer :: sw_hygro_coreshell_ssa(:,:,:,:,:) ! short wave single-scatter albedo table + real(r8), optional, pointer :: sw_hygro_coreshell_asm(:,:,:,:,:) ! short wave asymmetry table + real(r8), optional, pointer :: lw_hygro_coreshell_ext(:,:,:,:,:) ! long wave absorption table + real(r8), optional, pointer :: corefrac(:) ! core fraction dimension values + real(r8), optional, pointer :: bcdust(:) ! bc/(bc + dust) fraction dimension values + real(r8), optional, pointer :: kap(:) ! hygroscopicity dimension values + real(r8), optional, pointer :: relh(:) ! relative humidity dimension values + integer, optional, intent(out) :: nfrac ! core fraction dimension size + integer, optional, intent(out) :: nbcdust ! bc/(bc + dust) fraction dimension size + integer, optional, intent(out) :: nkap ! hygroscopicity dimension size + integer, optional, intent(out) :: nrelh ! relative humidity dimension size + + if (present(extpsw)) then + nullify(extpsw) + end if + if (present(abspsw)) then + nullify(abspsw) + end if + if (present(asmpsw)) then + nullify(asmpsw) + end if + if (present(absplw)) then + nullify(absplw) + end if + if (present(refrtabsw)) then + nullify(refrtabsw) + end if + if (present(refitabsw)) then + nullify(refitabsw) + end if + if (present(refrtablw)) then + nullify(refrtablw) + end if + if (present(refitablw)) then + nullify(refitablw) + end if + if (present(ncoef)) then + ncoef = huge(1) + end if + if (present(prefr)) then + prefr = huge(1) + end if + if (present(prefi)) then + prefi = huge(1) + end if + + call rad_cnst_get_bin_props(list_ndx,bin_ndx, & + opticstype=opticstype, & + sw_hygro_ext_wtp=sw_hygro_ext_wtp, & + sw_hygro_ssa_wtp=sw_hygro_ssa_wtp, & + sw_hygro_asm_wtp=sw_hygro_asm_wtp, & + lw_hygro_ext_wtp=lw_hygro_ext_wtp, & + wgtpct=wgtpct, & + nwtp=nwtp, & + sw_hygro_coreshell_ext=sw_hygro_coreshell_ext, & + sw_hygro_coreshell_ssa=sw_hygro_coreshell_ssa, & + sw_hygro_coreshell_asm=sw_hygro_coreshell_asm, & + lw_hygro_coreshell_ext=lw_hygro_coreshell_ext, & + corefrac=corefrac, & + bcdust=bcdust, & + kap=kap, & + relh=relh, & + nbcdust=nbcdust, & + nkap=nkap, & + nrelh=nrelh, & + nfrac=nfrac ) + + end subroutine optics_params + + !------------------------------------------------------------------------------ + ! returns radius^3 (m3) of a given bin number + !------------------------------------------------------------------------------ + pure elemental real(r8) function amcube(self, bin_ndx, volconc, numconc) + + class(carma_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + real(r8), intent(in) :: volconc ! volume conc (m3/m3) + real(r8), intent(in) :: numconc ! number conc (1/m3) + + amcube = 3._r8/(4._r8*pi)*volconc/numconc + + end function amcube + + !------------------------------------------------------------------------------ + ! returns mass and number activation fractions + !------------------------------------------------------------------------------ + subroutine actfracs(self, bin_ndx, smc, smax, fn, fm ) + class(carma_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin index + real(r8),intent(in) :: smc ! critical supersaturation for particles of bin radius + real(r8),intent(in) :: smax ! maximum supersaturation for multiple competing aerosols + real(r8),intent(out) :: fn ! activation fraction for aerosol number + real(r8),intent(out) :: fm ! activation fraction for aerosol mass + + fn = 0._r8 + fm = 0._r8 + + if (smc < smax) then + fn = 1._r8 + fm = 1._r8 + end if + + end subroutine actfracs + + !------------------------------------------------------------------------ + ! returns constituents names of aerosol number mixing ratios + !------------------------------------------------------------------------ + subroutine num_names(self, bin_ndx, name_a, name_c) + class(carma_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + character(len=*), intent(out) :: name_a ! constituent name of ambient aerosol number dens + character(len=*), intent(out) :: name_c ! constituent name of cloud-borne aerosol number dens + + call rad_cnst_get_info_by_bin(0, bin_ndx, num_name=name_a, num_name_cw=name_c) + + end subroutine num_names + + !------------------------------------------------------------------------ + ! returns constituents names of aerosol mass mixing ratios + !------------------------------------------------------------------------ + subroutine mmr_names(self, bin_ndx, species_ndx, name_a, name_c) + class(carma_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: species_ndx ! species number + character(len=*), intent(out) :: name_a ! constituent name of ambient aerosol MMR + character(len=*), intent(out) :: name_c ! constituent name of cloud-borne aerosol MMR + + if (species_ndx>0) then + call rad_cnst_get_info_by_bin_spec(0, bin_ndx, species_ndx, spec_name=name_a, spec_name_cw=name_c) + else + call rad_cnst_get_info_by_bin(0, bin_ndx, mmr_name=name_a, mmr_name_cw=name_c) + end if + + end subroutine mmr_names + + !------------------------------------------------------------------------ + ! returns constituent name of ambient aerosol number mixing ratios + !------------------------------------------------------------------------ + subroutine amb_num_name(self, bin_ndx, name) + class(carma_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + character(len=*), intent(out) :: name ! constituent name of ambient aerosol number dens + + call rad_cnst_get_info_by_bin(0, bin_ndx, num_name=name) + + end subroutine amb_num_name + + !------------------------------------------------------------------------ + ! returns constituent name of ambient aerosol mass mixing ratios + !------------------------------------------------------------------------ + subroutine amb_mmr_name(self, bin_ndx, species_ndx, name) + class(carma_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: species_ndx ! species number + character(len=*), intent(out) :: name ! constituent name of ambient aerosol MMR + + if (species_ndx>0) then + call rad_cnst_get_info_by_bin_spec(0, bin_ndx, species_ndx, spec_name=name) + else + call rad_cnst_get_info_by_bin(0, bin_ndx, mmr_name=name) + end if + + end subroutine amb_mmr_name + + !------------------------------------------------------------------------ + ! returns species type + !------------------------------------------------------------------------ + subroutine species_type(self, bin_ndx, species_ndx, spectype) + class(carma_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: species_ndx ! species number + character(len=*), intent(out) :: spectype ! species type + + call rad_cnst_get_info_by_bin_spec(0, bin_ndx, species_ndx, spec_type=spectype) + + end subroutine species_type + + !------------------------------------------------------------------------------ + ! returns TRUE if Ice Nucleation tendencies are applied to given aerosol bin number + !------------------------------------------------------------------------------ + function icenuc_updates_num(self, bin_ndx) result(res) + class(carma_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + + logical :: res + + character(len=aero_name_len) :: spectype + integer :: spc_ndx + + res = .false. + + do spc_ndx = 1, self%nspecies(bin_ndx) + call self%species_type( bin_ndx, spc_ndx, spectype) + if (trim(spectype)=='dust') res = .true. + if (trim(spectype)=='sulfate') res = .true. + end do + + end function icenuc_updates_num + + !------------------------------------------------------------------------------ + ! returns TRUE if Ice Nucleation tendencies are applied to a given species within a bin + !------------------------------------------------------------------------------ + function icenuc_updates_mmr(self, bin_ndx, species_ndx) result(res) + class(carma_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: species_ndx ! species number + + logical :: res + + character(len=aero_name_len) :: spectype + + res = .false. + + if (species_ndx==0) then + res = self%icenuc_updates_num(bin_ndx) + else + call self%species_type( bin_ndx, species_ndx, spectype) + if (trim(spectype)=='dust') res = .true. + if (trim(spectype)=='sulfate') res = .true. + end if + + end function icenuc_updates_mmr + + !------------------------------------------------------------------------------ + ! apply max / min to number concentration + !------------------------------------------------------------------------------ + subroutine apply_number_limits( self, naerosol, vaerosol, istart, istop, m ) + class(carma_aerosol_properties), intent(in) :: self + real(r8), intent(inout) :: naerosol(:) ! number conc (1/m3) + real(r8), intent(in) :: vaerosol(:) ! volume conc (m3/m3) + integer, intent(in) :: istart ! start column index (1 <= istart <= istop <= pcols) + integer, intent(in) :: istop ! stop column index + integer, intent(in) :: m ! mode or bin index + + end subroutine apply_number_limits + + !------------------------------------------------------------------------------ + ! returns TRUE if species `spc_ndx` in aerosol subset `bin_ndx` contributes to + ! the particles' ability to act as heterogeneous freezing nuclei + !------------------------------------------------------------------------------ + function hetfrz_species(self, bin_ndx, spc_ndx) result(res) + class(carma_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: spc_ndx ! species number + + logical :: res + + character(len=aero_name_len) :: species_type + + res = .false. + + call self%species_type(bin_ndx, spc_ndx, species_type) + if ( trim(species_type)=='black-c' .or. trim(species_type)=='dust' ) then + res = .true. + end if + + end function hetfrz_species + + !------------------------------------------------------------------------------ + ! returns TRUE if soluble + !------------------------------------------------------------------------------ + logical function soluble(self,bin_ndx) + class(carma_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + + soluble = .true. + + end function soluble + + !------------------------------------------------------------------------------ + ! returns minimum mass mean radius (meters) + !------------------------------------------------------------------------------ + function min_mass_mean_rad(self,bin_ndx,species_ndx) result(minrad) + class(carma_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: species_ndx ! species number + + real(r8) :: minrad ! meters + + minrad = 0.0_r8 + + end function min_mass_mean_rad + + !------------------------------------------------------------------------------ + ! returns the total number of bins for a given radiation list index + !------------------------------------------------------------------------------ + function nbins_rlist(self, list_ndx) result(res) + class(carma_aerosol_properties), intent(in) :: self + integer, intent(in) :: list_ndx ! radiation list number + + integer :: res + + call rad_cnst_get_info(list_ndx, nbins=res) + + end function nbins_rlist + + !------------------------------------------------------------------------------ + ! returns number of species in a bin for a given radiation list index + !------------------------------------------------------------------------------ + function nspecies_per_bin_rlist(self, list_ndx, bin_ndx) result(res) + class(carma_aerosol_properties), intent(in) :: self + integer, intent(in) :: list_ndx ! radiation list number + integer, intent(in) :: bin_ndx ! bin number + + integer :: res + + call rad_cnst_get_info_by_bin(list_ndx, bin_ndx, nspec=res) + + end function nspecies_per_bin_rlist + + !------------------------------------------------------------------------------ + ! returns the natural log of geometric standard deviation of the number + ! distribution for radiation list number and aerosol bin + !------------------------------------------------------------------------------ + function alogsig_rlist(self, list_ndx, bin_ndx) result(res) + class(carma_aerosol_properties), intent(in) :: self + integer, intent(in) :: list_ndx ! radiation list number + integer, intent(in) :: bin_ndx ! bin number + + real(r8) :: res + + res = self%alogsig(bin_ndx) + + end function alogsig_rlist + + !------------------------------------------------------------------------------ + ! returns name for a given radiation list number and aerosol bin + !------------------------------------------------------------------------------ + function bin_name(self, list_ndx, bin_ndx) result(name) + class(carma_aerosol_properties), intent(in) :: self + integer, intent(in) :: list_ndx ! radiation list number + integer, intent(in) :: bin_ndx ! bin number + + character(len=32) name + + call rad_cnst_get_info_by_bin(list_ndx, bin_ndx, bin_name=name) + + end function bin_name + + !------------------------------------------------------------------------------ + ! returns scavenging diameter (cm) for a given aerosol bin number + !------------------------------------------------------------------------------ + function scav_diam(self, bin_ndx) result(diam) + + use carma_intr, only: carma_get_bin_rmass + use carma_intr, only: carma_get_group_by_name + + class(carma_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + + real(r8) :: diam ! cm + + real(r8) :: mass ! the bin mass (g) + real(r8) :: rho ! density (kg/m3) + integer :: ispec + character(len=32) :: spectype + + character(len=aero_name_len) :: bin_name, shortname + integer :: igroup, ibin, rc, nchr + + call rad_cnst_get_info_by_bin(0, bin_ndx, bin_name=bin_name) + + nchr = len_trim(bin_name)-2 + shortname = bin_name(:nchr) + + call carma_get_group_by_name(shortname, igroup, rc) + + read(bin_name(nchr+1:),*) ibin + + call carma_get_bin_rmass(igroup, ibin, mass, rc) + + do ispec = 1, self%nspecies(bin_ndx) + call self%species_type(bin_ndx,ispec, spectype) + if (trim(spectype) == 'sulfate') then + call self%get(bin_ndx,ispec,density=rho) + end if + end do + + ! specdens kg/m3 to g/cm3, convert from radius to diameter + diam = 2._r8*((0.75*mass / pi / (1.0e-3_r8*rho))**onethird) + + end function scav_diam + + !------------------------------------------------------------------------------ + ! adjust aerosol concentration tendencies to create larger sizes of aerosols + ! during resuspension + !------------------------------------------------------------------------------ + subroutine resuspension_resize(self, dcondt) + class(carma_aerosol_properties), intent(in) :: self + real(r8), intent(inout) :: dcondt(:) + + integer :: m + + ! move dcondt_prevap to larger bin + do m = 1, self%ncnst_tot() + if (self%ibl(m) /= m) then + dcondt(self%ibl(m)) = dcondt(self%ibl(m)) + dcondt(m) + dcondt(m) = 0._r8 + end if + end do + + end subroutine resuspension_resize + + !------------------------------------------------------------------------------ + ! returns dust deposition fluxes rebinned to specified diameter limits + !------------------------------------------------------------------------------ + subroutine rebin_bulk_fluxes(self, bulk_type, dep_fluxes, diam_edges, bulk_fluxes, & + error_code, error_string) + + class(carma_aerosol_properties), intent(in) :: self + character(len=*),intent(in) :: bulk_type ! aerosol type to rebin + real(r8), intent(in) :: dep_fluxes(:) ! kg/m2/sec + real(r8), intent(in) :: diam_edges(:) ! meters + real(r8), intent(out) :: bulk_fluxes(:) ! kg/m2/sec + integer, intent(out) :: error_code ! error code (0 if no error) + character(len=*), intent(out) :: error_string ! error string + + real(r8) :: mflx, mflx_tot + real(r8) :: rho, mass, frac, diam + integer :: i, m,l,mm + integer :: n_bulk_bins + character(len=aero_name_len) :: spectype + logical :: type_not_found + + error_code = 0 + error_string = ' ' + + n_bulk_bins = size(bulk_fluxes) + + bulk_fluxes(:) = 0._r8 + type_not_found = .true. + + bin_loop: do m = 1,self%nbins() + + mflx_tot = 0._r8 + mflx = 0._r8 + + species: do l = 1,self%nmasses(m) + mm = self%indexer(m,l) + + if (l>self%nspecies(m)) then + ! use mass flux for the entire bin (concentration element) if available + ! -- override the total summed below + mflx_tot = dep_fluxes(mm) + else + ! this sums up the total assuming all species are transported + mflx_tot = mflx_tot + dep_fluxes(mm) + + call self%get(m,l,spectype=spectype) + + if (spectype==bulk_type) then + ! get mass flux and density of the specified type + mflx = dep_fluxes(mm) + call self%get(m,l,density=rho) ! kg/m3 + type_not_found = .false. + end if + end if + end do species + + if (mflx>0._r8 .and. mflx_tot>0._r8) then + ! mass flux fraction + frac = mflx/mflx_tot + + ! mass of the specified aerosol type + mass = frac * bin_mass(m) ! kg + + ! diameter in meters + diam = 2._r8*((0.75_r8*mass/pi/rho)**onethird) + + ! add the flux to the corresponding bulk bin + blk_loop: do i = 1,n_bulk_bins-1 + if (diam>diam_edges(i) .and. diam<=diam_edges(i+1)) then + bulk_fluxes(i) = bulk_fluxes(i) + mflx + exit blk_loop + end if + end do blk_loop + endif + + end do bin_loop + + if (type_not_found) then + bulk_fluxes(:) = nan + error_code = 1 + write(error_string,*) 'aerosol_properties::rebin_bulk_fluxes ERROR : ',trim(bulk_type),' not found' + end if + + contains + + !--------------------------------------------------------------- + ! get mass of the specified bin in kg -- could be done at init time ... + !--------------------------------------------------------------- + real(r8) function bin_mass(bin_ndx) ! (kg) + use carma_intr, only: carma_get_bin_rmass, carma_get_group_by_name + + integer, intent(in) :: bin_ndx + + character(len=aero_name_len) :: bin_name, shortname + integer :: ibin, igroup, rc, nchr + real(r8) :: rmass + + call rad_cnst_get_info_by_bin(0, bin_ndx, bin_name=bin_name) + + nchr = len_trim(bin_name)-2 + shortname = bin_name(:nchr) + + call carma_get_group_by_name(shortname, igroup, rc) + + read(bin_name(nchr+1:),*) ibin + + call carma_get_bin_rmass(igroup, ibin, rmass, rc) + bin_mass = rmass * 1.e-3_r8 ! g->kg + + end function bin_mass + + end subroutine rebin_bulk_fluxes + + !------------------------------------------------------------------------------ + ! Returns TRUE if bin is hydrophilic, otherwise FALSE + !------------------------------------------------------------------------------ + logical function hydrophilic(self, bin_ndx) + class(carma_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + + hydrophilic = .true. + + end function hydrophilic + +end module carma_aerosol_properties_mod diff --git a/src/chemistry/aerosol/carma_aerosol_state_mod.F90 b/src/chemistry/aerosol/carma_aerosol_state_mod.F90 new file mode 100644 index 0000000000..d036254446 --- /dev/null +++ b/src/chemistry/aerosol/carma_aerosol_state_mod.F90 @@ -0,0 +1,591 @@ +module carma_aerosol_state_mod + use shr_kind_mod, only: r8 => shr_kind_r8 + use aerosol_state_mod, only: aerosol_state, ptr2d_t + + use rad_constituents, only: rad_cnst_get_bin_mmr_by_idx, rad_cnst_get_bin_num !, rad_cnst_get_bin_mmr + use rad_constituents, only: rad_cnst_get_info_by_bin + use physics_buffer, only: physics_buffer_desc, pbuf_get_field, pbuf_get_index + use physics_types, only: physics_state + use aerosol_properties_mod, only: aerosol_properties, aero_name_len + + use physconst, only: pi + use carma_intr, only: carma_get_total_mmr, carma_get_dry_radius, carma_get_number, carma_get_number_cld + use carma_intr, only: carma_get_group_by_name, carma_get_kappa, carma_get_dry_radius, carma_get_wet_radius + use carma_intr, only: carma_get_wght_pct + use ppgrid, only: begchunk, endchunk, pcols, pver + + implicit none + + private + + public :: carma_aerosol_state + + type, extends(aerosol_state) :: carma_aerosol_state + private + type(physics_state), pointer :: state => null() + type(physics_buffer_desc), pointer :: pbuf(:) => null() + contains + + procedure :: get_transported + procedure :: set_transported + procedure :: ambient_total_bin_mmr + procedure :: get_ambient_mmr_0list + procedure :: get_ambient_mmr_rlist + procedure :: get_cldbrne_mmr + procedure :: get_ambient_num + procedure :: get_cldbrne_num + procedure :: get_states + procedure :: icenuc_size_wght_arr + procedure :: icenuc_size_wght_val + procedure :: update_bin + procedure :: hetfrz_size_wght + procedure :: hygroscopicity + procedure :: water_uptake + procedure :: wgtpct + procedure :: dry_volume + procedure :: wet_volume + procedure :: water_volume + procedure :: wet_diameter + + final :: destructor + + end type carma_aerosol_state + + interface carma_aerosol_state + procedure :: constructor + end interface carma_aerosol_state + + real(r8), parameter :: four_thirds_pi = pi * 4._r8 / 3._r8 + +contains + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + function constructor(state,pbuf) result(newobj) + type(physics_state), target, optional :: state + type(physics_buffer_desc), pointer, optional :: pbuf(:) + + type(carma_aerosol_state), pointer :: newobj + + integer :: ierr + + allocate(newobj,stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + + newobj%state => state + newobj%pbuf => pbuf + + end function constructor + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + subroutine destructor(self) + type(carma_aerosol_state), intent(inout) :: self + + nullify(self%state) + nullify(self%pbuf) + + end subroutine destructor + + !------------------------------------------------------------------------------ + ! sets transported components + ! This aerosol model with the state of the transported aerosol constituents + ! (mass mixing ratios or number mixing ratios) + !------------------------------------------------------------------------------ + subroutine set_transported( self, transported_array ) + class(carma_aerosol_state), intent(inout) :: self + real(r8), intent(in) :: transported_array(:,:,:) + ! to be implemented later + end subroutine set_transported + + !------------------------------------------------------------------------------ + ! returns transported components + ! This returns to current state of the transported aerosol constituents + ! (mass mixing ratios or number mixing ratios) + !------------------------------------------------------------------------------ + subroutine get_transported( self, transported_array ) + class(carma_aerosol_state), intent(in) :: self + real(r8), intent(out) :: transported_array(:,:,:) + ! to be implemented later + end subroutine get_transported + + !------------------------------------------------------------------------ + ! Total aerosol mass mixing ratio for a bin in a given grid box location (column and layer) + !------------------------------------------------------------------------ + function ambient_total_bin_mmr(self, aero_props, bin_ndx, col_ndx, lyr_ndx) result(mmr_tot) + class(carma_aerosol_state), intent(in) :: self + class(aerosol_properties), intent(in) :: aero_props ! aerosol properties object + integer, intent(in) :: bin_ndx ! bin index + integer, intent(in) :: col_ndx ! column index + integer, intent(in) :: lyr_ndx ! vertical layer index + + real(r8) :: mmr_tot ! mass mixing ratios totaled for all species + + real(r8) :: totmmr(pcols,pver) + character(len=aero_name_len) :: bin_name, shortname + integer :: igroup, ibin, rc, nchr + + call rad_cnst_get_info_by_bin(0, bin_ndx, bin_name=bin_name) + + nchr = len_trim(bin_name)-2 + shortname = bin_name(:nchr) + + call carma_get_group_by_name(shortname, igroup, rc) + + read(bin_name(nchr+1:),*) ibin + + call carma_get_total_mmr(self%state, igroup, ibin, totmmr, rc) + + mmr_tot = totmmr(col_ndx,lyr_ndx) + + end function ambient_total_bin_mmr + + !------------------------------------------------------------------------------ + ! returns ambient aerosol mass mixing ratio for a given species index and bin index + !------------------------------------------------------------------------------ + subroutine get_ambient_mmr_0list(self, species_ndx, bin_ndx, mmr) + class(carma_aerosol_state), intent(in) :: self + integer, intent(in) :: species_ndx ! species index + integer, intent(in) :: bin_ndx ! bin index + real(r8), pointer :: mmr(:,:) ! mass mixing ratios (ncol,nlev) + + call rad_cnst_get_bin_mmr_by_idx(0, bin_ndx, species_ndx, 'a', self%state, self%pbuf, mmr) + + end subroutine get_ambient_mmr_0list + + !------------------------------------------------------------------------------ + ! returns ambient aerosol mass mixing ratio for a given radiation diagnostics + ! list index, species index and bin index + !------------------------------------------------------------------------------ + subroutine get_ambient_mmr_rlist(self, list_ndx, species_ndx, bin_ndx, mmr) + class(carma_aerosol_state), intent(in) :: self + integer, intent(in) :: list_ndx ! rad climate list index + integer, intent(in) :: species_ndx ! species index + integer, intent(in) :: bin_ndx ! bin index + real(r8), pointer :: mmr(:,:) ! mass mixing ratios (ncol,nlev) + + call rad_cnst_get_bin_mmr_by_idx(list_ndx, bin_ndx, species_ndx, 'a', self%state, self%pbuf, mmr) + + end subroutine get_ambient_mmr_rlist + + !------------------------------------------------------------------------------ + ! returns cloud-borne aerosol number mixing ratio for a given species index and bin index + !------------------------------------------------------------------------------ + subroutine get_cldbrne_mmr(self, species_ndx, bin_ndx, mmr) + class(carma_aerosol_state), intent(in) :: self + integer, intent(in) :: species_ndx ! species index + integer, intent(in) :: bin_ndx ! bin index + real(r8), pointer :: mmr(:,:) ! mass mixing ratios (ncol,nlev) + + call rad_cnst_get_bin_mmr_by_idx(0, bin_ndx, species_ndx, 'c', self%state, self%pbuf, mmr) + + end subroutine get_cldbrne_mmr + + !------------------------------------------------------------------------------ + ! returns ambient aerosol number mixing ratio for a given species index and bin index + !------------------------------------------------------------------------------ + subroutine get_ambient_num(self, bin_ndx, num) + class(carma_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin index + real(r8), pointer :: num(:,:) ! number mixing ratios + + character(len=aero_name_len) :: bin_name, shortname + integer :: igroup, ibin, rc, nchr, ncol + real(r8) :: nmr(pcols,pver) + + ncol = self%state%ncol + + call rad_cnst_get_info_by_bin(0, bin_ndx, bin_name=bin_name) + + nchr = len_trim(bin_name)-2 + shortname = bin_name(:nchr) + + call carma_get_group_by_name(shortname, igroup, rc) + + read(bin_name(nchr+1:),*) ibin + + call rad_cnst_get_bin_num(0, bin_ndx, 'a', self%state, self%pbuf, num) + + call carma_get_number(self%state, igroup, ibin, nmr, rc) + + num(:ncol,:) = nmr(:ncol,:) + + end subroutine get_ambient_num + + !------------------------------------------------------------------------------ + ! returns cloud-borne aerosol number mixing ratio for a given species index and bin index + !------------------------------------------------------------------------------ + subroutine get_cldbrne_num(self, bin_ndx, num) + class(carma_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin index + real(r8), pointer :: num(:,:) ! number mixing ratios + + character(len=aero_name_len) :: bin_name, shortname + integer :: igroup, ibin, rc, nchr, ncol + real(r8) :: nmr(pcols,pver) + + ncol = self%state%ncol + + call rad_cnst_get_info_by_bin(0, bin_ndx, bin_name=bin_name) + + nchr = len_trim(bin_name)-2 + shortname = bin_name(:nchr) + + call carma_get_group_by_name(shortname, igroup, rc) + + read(bin_name(nchr+1:),*) ibin + + call rad_cnst_get_bin_num(0, bin_ndx, 'c', self%state, self%pbuf, num) + + call carma_get_number_cld(self%pbuf, igroup, ibin, ncol, pver, nmr, rc) + + num(:ncol,:) = nmr(:ncol,:) + + end subroutine get_cldbrne_num + + !------------------------------------------------------------------------------ + ! returns interstitial and cloud-borne aerosol states + !------------------------------------------------------------------------------ + subroutine get_states( self, aero_props, raer, qqcw ) + class(carma_aerosol_state), intent(in) :: self + class(aerosol_properties), intent(in) :: aero_props + type(ptr2d_t), intent(out) :: raer(:) + type(ptr2d_t), intent(out) :: qqcw(:) + + integer :: ibin,ispc, indx + + do ibin = 1, aero_props%nbins() + indx = aero_props%indexer(ibin, 0) + call self%get_ambient_num(ibin, raer(indx)%fld) + call self%get_cldbrne_num(ibin, qqcw(indx)%fld) + do ispc = 1, aero_props%nspecies(ibin) + indx = aero_props%indexer(ibin, ispc) + call self%get_ambient_mmr(ispc,ibin, raer(indx)%fld) + call self%get_cldbrne_mmr(ispc,ibin, qqcw(indx)%fld) + end do + end do + + end subroutine get_states + + !------------------------------------------------------------------------------ + ! return aerosol bin size weights for a given bin + !------------------------------------------------------------------------------ + subroutine icenuc_size_wght_arr(self, bin_ndx, ncol, nlev, species_type, use_preexisting_ice, wght) + class(carma_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of vertical levels + character(len=*), intent(in) :: species_type ! species type + logical, intent(in) :: use_preexisting_ice ! pre-existing ice flag + real(r8), intent(out) :: wght(:,:) + + character(len=aero_name_len) :: bin_name, shortname + real(r8) :: rdry(ncol,nlev), rhopdry(ncol,nlev) + integer :: i,k + real(r8) :: diamdry + integer :: igroup, ibin, rc, nchr + + wght = 0._r8 + + call rad_cnst_get_info_by_bin(0, bin_ndx, bin_name=bin_name) + + nchr = len_trim(bin_name)-2 + shortname = bin_name(:nchr) + call carma_get_group_by_name(shortname, igroup, rc) + + read(bin_name(nchr+1:),*) ibin + + call carma_get_dry_radius(self%state, igroup, ibin, rdry, rhopdry, rc) ! m, kg/m3 + + do k = 1,nlev + do i = 1,ncol + diamdry = rdry(i,k) * 2.e4_r8 * 1.e6_r8 ! diameter in microns (from radius in m) + if (diamdry >= 0.1_r8) then ! size threashold + wght(i,k) = 1._r8 + end if + end do + end do + + end subroutine icenuc_size_wght_arr + + !------------------------------------------------------------------------------ + ! return aerosol bin size weights for a given bin, column and vertical layer + !------------------------------------------------------------------------------ + subroutine icenuc_size_wght_val(self, bin_ndx, col_ndx, lyr_ndx, species_type, use_preexisting_ice, wght) + class(carma_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: col_ndx ! column index + integer, intent(in) :: lyr_ndx ! vertical layer index + character(len=*), intent(in) :: species_type ! species type + logical, intent(in) :: use_preexisting_ice ! pre-existing ice flag + real(r8), intent(out) :: wght + + real(r8) :: wght_arr(pcols,pver) + + call self%icenuc_size_wght(bin_ndx, self%state%ncol, pver, species_type, use_preexisting_ice, wght_arr) + + wght = wght_arr(col_ndx,lyr_ndx) + + end subroutine icenuc_size_wght_val + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + subroutine update_bin( self, bin_ndx, col_ndx, lyr_ndx, delmmr_sum, delnum_sum, tnd_ndx, dtime, tend ) + class(carma_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: col_ndx ! column index + integer, intent(in) :: lyr_ndx ! vertical layer index + real(r8),intent(in) :: delmmr_sum ! mass mixing ratio change summed over all species in bin + real(r8),intent(in) :: delnum_sum ! number mixing ratio change summed over all species in bin + integer, intent(in) :: tnd_ndx ! tendency index + real(r8),intent(in) :: dtime ! time step size (sec) + real(r8),intent(inout) :: tend(:,:,:) ! tendency + + real(r8), pointer :: amb_num(:,:) + real(r8), pointer :: cld_num(:,:) + + ! for updating num (num tendancies) + ! -- nothing to do here for CARMA since num is calculated when needed + + end subroutine update_bin + + !------------------------------------------------------------------------------ + ! returns the volume-weighted fractions of aerosol subset `bin_ndx` that can act + ! as heterogeneous freezing nuclei + !------------------------------------------------------------------------------ + function hetfrz_size_wght(self, bin_ndx, ncol, nlev) result(wght) + class(carma_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of vertical levels + + real(r8) :: wght(ncol,nlev) + + character(len=aero_name_len) :: bin_name, shortname + real(r8) :: rdry(ncol,nlev), rhopdry(ncol,nlev) + integer :: i,k + real(r8) :: diamdry + integer :: igroup, ibin, rc, nchr + + wght = 0._r8 + + call rad_cnst_get_info_by_bin(0, bin_ndx, bin_name=bin_name) + + nchr = len_trim(bin_name)-2 + shortname = bin_name(:nchr) + call carma_get_group_by_name(shortname, igroup, rc) + + read(bin_name(nchr+1:),*) ibin + + call carma_get_dry_radius(self%state, igroup, ibin, rdry, rhopdry, rc) ! m, kg/m3 + + do k = 1,nlev + do i = 1,ncol + diamdry = rdry(i,k) * 2.e4_r8 * 1.e6_r8 ! diameter in microns (from radius in m) + if (diamdry >= 0.1_r8) then ! size threashold + wght(i,k) = 1._r8 + end if + end do + end do + + end function hetfrz_size_wght + + !------------------------------------------------------------------------------ + ! returns hygroscopicity for a given radiation diagnostic list number and + ! bin number + !------------------------------------------------------------------------------ + subroutine hygroscopicity(self, list_ndx, bin_ndx, kappa) + class(carma_aerosol_state), intent(in) :: self + integer, intent(in) :: list_ndx ! rad climate list number + integer, intent(in) :: bin_ndx ! bin number + real(r8), intent(out) :: kappa(:,:) ! hygroscopicity (ncol,nlev) + + character(len=aero_name_len) :: bin_name, shortname + integer :: igroup, ibin, rc, nchr, ncol + + call rad_cnst_get_info_by_bin(0, bin_ndx, bin_name=bin_name) + + nchr = len_trim(bin_name)-2 + shortname = bin_name(:nchr) + + call carma_get_group_by_name(shortname, igroup, rc) + + read(bin_name(nchr+1:),*) ibin + + call carma_get_kappa(self%state, igroup, ibin, kappa, rc) + + end subroutine hygroscopicity + + !------------------------------------------------------------------------------ + ! returns aerosol wet diameter and aerosol water concentration for a given + ! radiation diagnostic list number and bin number + !------------------------------------------------------------------------------ + subroutine water_uptake(self, aero_props, list_idx, bin_idx, ncol, nlev, dgnumwet, qaerwat) + + class(carma_aerosol_state), intent(in) :: self + class(aerosol_properties), intent(in) :: aero_props + integer, intent(in) :: list_idx ! rad climate/diags list number + integer, intent(in) :: bin_idx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of levels + real(r8),intent(out) :: dgnumwet(ncol,nlev) ! aerosol wet diameter (m) + real(r8),intent(out) :: qaerwat(ncol,nlev) ! aerosol water concentration (g/g) + + dgnumwet = -huge(1._r8) + qaerwat = -huge(1._r8) + + end subroutine water_uptake + + !------------------------------------------------------------------------------ + ! aerosol weight precent of H2SO4/H2O solution + !------------------------------------------------------------------------------ + function wgtpct(self, ncol, nlev) result(wtp) + class(carma_aerosol_state), intent(in) :: self + integer, intent(in) :: ncol, nlev + real(r8) :: wtp(ncol,nlev) ! weight precent of H2SO4/H2O solution for given icol, ilev + + wtp(:,:) = carma_get_wght_pct(ncol,nlev,self%state) + + end function wgtpct + + !------------------------------------------------------------------------------ + ! aerosol dry volume (m3/kg) for given radiation diagnostic list number and bin number + !------------------------------------------------------------------------------ + function dry_volume(self, aero_props, list_idx, bin_idx, ncol, nlev) result(vol) + + class(carma_aerosol_state), intent(in) :: self + class(aerosol_properties), intent(in) :: aero_props + + integer, intent(in) :: list_idx ! rad climate/diags list number + integer, intent(in) :: bin_idx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of levels + + real(r8) :: vol(ncol,nlev) ! m3/kg + + real(r8) :: raddry(pcols,pver) !! dry radius (m) + real(r8) :: rhodry(pcols,pver) !! dry density (kg/m3) + + character(len=aero_name_len) :: bin_name, shortname + integer :: igroup, ibin, rc, nchr + + call rad_cnst_get_info_by_bin(0, bin_idx, bin_name=bin_name) + + nchr = len_trim(bin_name)-2 + shortname = bin_name(:nchr) + + call carma_get_group_by_name(shortname, igroup, rc) + + read(bin_name(nchr+1:),*) ibin + + vol = 0._r8 + + call carma_get_dry_radius(self%state, igroup, ibin, raddry, rhodry, rc) + + vol(:ncol,:) = four_thirds_pi * (raddry(:ncol,:)**3) ! ???? units = m3/kg ???? + + end function dry_volume + + !------------------------------------------------------------------------------ + ! aerosol wet volume (m3/kg) for given radiation diagnostic list number and bin number + !------------------------------------------------------------------------------ + function wet_volume(self, aero_props, list_idx, bin_idx, ncol, nlev) result(vol) + + class(carma_aerosol_state), intent(in) :: self + class(aerosol_properties), intent(in) :: aero_props + + integer, intent(in) :: list_idx ! rad climate/diags list number + integer, intent(in) :: bin_idx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of levels + + real(r8) :: vol(ncol,nlev) ! m3/kg + + real(r8) :: radwet(pcols,pver) !! wet radius (m) + real(r8) :: rhowet(pcols,pver) !! wet density (kg/m3) + + character(len=aero_name_len) :: bin_name, shortname + integer :: igroup, ibin, rc, nchr + + call rad_cnst_get_info_by_bin(0, bin_idx, bin_name=bin_name) + + nchr = len_trim(bin_name)-2 + shortname = bin_name(:nchr) + + call carma_get_group_by_name(shortname, igroup, rc) + + read(bin_name(nchr+1:),*) ibin + + vol = 0._r8 + + call carma_get_wet_radius(self%state, igroup, ibin, radwet, rhowet, rc) + + vol(:ncol,:) = four_thirds_pi * (radwet(:ncol,:)**3) ! ???? units = m3/kg ???? + + end function wet_volume + + !------------------------------------------------------------------------------ + ! aerosol water volume (m3/kg) for given radiation diagnostic list number and bin number + !------------------------------------------------------------------------------ + function water_volume(self, aero_props, list_idx, bin_idx, ncol, nlev) result(vol) + + class(carma_aerosol_state), intent(in) :: self + class(aerosol_properties), intent(in) :: aero_props + + integer, intent(in) :: list_idx ! rad climate/diags list number + integer, intent(in) :: bin_idx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of levels + + real(r8) :: vol(ncol,nlev) ! m3/kg + + real(r8) :: wetvol(ncol,nlev) + real(r8) :: dryvol(ncol,nlev) + + wetvol = self%wet_volume(aero_props, list_idx, bin_idx, ncol, nlev) + dryvol = self%dry_volume(aero_props, list_idx, bin_idx, ncol, nlev) + + vol(:ncol,:) = wetvol(:ncol,:) - dryvol(:ncol,:) + + where (vol<0._r8) + vol = 0._r8 + end where + + end function water_volume + + !------------------------------------------------------------------------------ + ! aerosol wet diameter + !------------------------------------------------------------------------------ + function wet_diameter(self, bin_idx, ncol, nlev) result(diam) + class(carma_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_idx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of levels + + real(r8) :: diam(ncol,nlev) + + real(r8) :: radwet(pcols,pver) !! wet radius (m) + real(r8) :: rhowet(pcols,pver) !! wet density (kg/m3) + + character(len=aero_name_len) :: bin_name, shortname + integer :: igroup, ibin, rc, nchr + + call rad_cnst_get_info_by_bin(0, bin_idx, bin_name=bin_name) + + nchr = len_trim(bin_name)-2 + shortname = bin_name(:nchr) + + call carma_get_group_by_name(shortname, igroup, rc) + + read(bin_name(nchr+1:),*) ibin + + call carma_get_wet_radius(self%state, igroup, ibin, radwet, rhowet, rc) + + diam(:ncol,:nlev) = 2._r8*radwet(:ncol,:nlev) + + end function wet_diameter + +end module carma_aerosol_state_mod diff --git a/src/chemistry/aerosol/hygrocoreshell_aerosol_optics_mod.F90 b/src/chemistry/aerosol/hygrocoreshell_aerosol_optics_mod.F90 new file mode 100644 index 0000000000..8871312117 --- /dev/null +++ b/src/chemistry/aerosol/hygrocoreshell_aerosol_optics_mod.F90 @@ -0,0 +1,292 @@ +module hygrocoreshell_aerosol_optics_mod + use shr_kind_mod, only: r8 => shr_kind_r8 + use aerosol_optics_mod, only: aerosol_optics + use aerosol_state_mod, only: aerosol_state + use aerosol_properties_mod, only: aerosol_properties + use table_interp_mod, only: table_interp, table_interp_wghts, table_interp_calcwghts + + implicit none + + private + public :: hygrocoreshell_aerosol_optics + + !> hygrocoreshell_aerosol_optics + !! Table look up implementation of aerosol_optics to parameterize aerosol + !! radiative properties in terms of core mass fraction, black carbon/dust fraction, + !! kappa and relative humidity + type, extends(aerosol_optics) :: hygrocoreshell_aerosol_optics + + real(r8), allocatable :: totalmmr(:,:) ! total mmr of the aerosol + real(r8), allocatable :: corefrac(:,:) ! mass fraction that is core + real(r8), allocatable :: bcdust(:,:) ! mass fraction of bc vs (bc + dust) + real(r8), allocatable :: kappa(:,:) ! hygroscopicity + real(r8), allocatable :: relh(:,:) ! relative humidity + + real(r8), pointer :: sw_hygro_coreshell_ext(:,:,:,:,:) => null() ! short wave extinction table + real(r8), pointer :: sw_hygro_coreshell_ssa(:,:,:,:,:) => null() ! short wave single-scatter albedo table + real(r8), pointer :: sw_hygro_coreshell_asm(:,:,:,:,:) => null() ! short wave asymmetry table + real(r8), pointer :: lw_hygro_coreshell_abs(:,:,:,:,:) => null() ! long wave absorption table + + real(r8), pointer :: tbl_corefrac(:) => null() ! core fraction dimension values + real(r8), pointer :: tbl_bcdust(:) => null() ! bc/(bc + dust) fraction dimension values + real(r8), pointer :: tbl_kap(:) => null() ! hygroscopicity dimension values + real(r8), pointer :: tbl_relh(:) => null() ! relative humidity dimension values + + integer :: nfrac = -1 ! core fraction dimension size + integer :: nbcdust = -1 ! bc/(bc + dust) fraction dimension size + integer :: nkap = -1 ! hygroscopicity dimension size + integer :: nrelh = -1 ! relative humidity dimension size + + contains + + procedure :: sw_props + procedure :: lw_props + + final :: destructor + + end type hygrocoreshell_aerosol_optics + + interface hygrocoreshell_aerosol_optics + procedure :: constructor + end interface hygrocoreshell_aerosol_optics + +contains + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + function constructor(aero_props, aero_state, ilist, ibin, ncol, nlev, relhum) result(newobj) + + class(aerosol_properties),intent(in) :: aero_props ! aerosol_properties object + class(aerosol_state),intent(in) :: aero_state ! aerosol_state object + integer, intent(in) :: ilist ! climate or a diagnostic list number + integer, intent(in) :: ibin ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of levels + real(r8),intent(in) :: relhum(ncol,nlev) ! relative humidity + + type(hygrocoreshell_aerosol_optics), pointer :: newobj + + integer :: ierr, nspec + integer :: ilev, ispec, icol + + real(r8), pointer :: specmmr(:,:) ! species mass mixing ratio + + real(r8) :: coremmr(ncol,nlev) + real(r8) :: coredustmmr(ncol,nlev) + real(r8) :: corebcmmr(ncol,nlev) + real(r8) :: shellmmr(ncol,nlev) + real(r8) :: bcdustmmr(ncol,nlev) + + character(len=32) :: spectype ! species type + character(len=32) :: specmorph + real(r8) :: specdens ! species density (kg/m3) + + allocate(newobj, stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + + allocate(newobj%totalmmr(ncol,nlev),stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + + allocate(newobj%corefrac(ncol,nlev),stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + + allocate(newobj%bcdust(ncol,nlev),stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + + allocate(newobj%kappa(ncol,nlev),stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + + allocate(newobj%relh(ncol,nlev),stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + + nspec = aero_props%nspecies(ilist,ibin) + + coremmr(:,:) = 0._r8 + coredustmmr(:,:) = 0._r8 + corebcmmr(:,:) = 0._r8 + shellmmr(:,:) = 0._r8 + + do ispec = 1,nspec + + call aero_state%get_ambient_mmr(ilist,ispec,ibin,specmmr) + + call aero_props%get(ibin, ispec, list_ndx=ilist, density=specdens, & + spectype=spectype, specmorph=specmorph) + + if (trim(specmorph) == 'core') then + if (trim(spectype) == 'dust') then + coredustmmr(:ncol,:nlev) = coredustmmr(:ncol,:nlev) + specmmr(:ncol,:nlev) + end if + if (trim(spectype) == 'black-c') then + corebcmmr(:ncol,:nlev) = corebcmmr(:ncol,:nlev) + specmmr(:ncol,:nlev) + end if + coremmr(:ncol,:nlev) = coremmr(:ncol,:nlev) + specmmr(:ncol,:nlev) + else if (trim(specmorph) == 'shell') then + shellmmr(:ncol,:nlev) = shellmmr(:ncol,:nlev) + specmmr(:ncol,:nlev) + else + nullify(newobj) + return + end if + + end do + + newobj%totalmmr(:,:) = coremmr(:,:) + shellmmr(:,:) + bcdustmmr(:,:) = corebcmmr(:,:) + coredustmmr(:,:) + + do ilev = 1, nlev + do icol = 1, ncol + + if (newobj%totalmmr(icol,ilev) > 0._r8) then + newobj%corefrac(icol,ilev) = coremmr(icol,ilev) / newobj%totalmmr(icol,ilev) + else + newobj%corefrac(icol,ilev) = 0._r8 + end if + newobj%corefrac(icol,ilev) = max(0._r8, min(1.0_r8, newobj%corefrac(icol,ilev))) + + if (bcdustmmr(icol,ilev) > 0._r8) then + newobj%bcdust(icol,ilev) = corebcmmr(icol,ilev) / bcdustmmr(icol,ilev) + else + newobj%bcdust(icol,ilev) = 0._r8 + end if + newobj%bcdust(icol,ilev) = max(0._r8, min(1.0_r8, newobj%bcdust(icol,ilev))) + + end do + end do + + call aero_state%hygroscopicity(ilist, ibin, newobj%kappa) + + call aero_props%optics_params(ilist, ibin, & + corefrac=newobj%tbl_corefrac, kap=newobj%tbl_kap, & + bcdust=newobj%tbl_bcdust, relh=newobj%tbl_relh, & + nfrac=newobj%nfrac, nbcdust=newobj%nbcdust, & + nkap=newobj%nkap, nrelh=newobj%nrelh) + + newobj%relh(:ncol,:) = relhum(:ncol,:) + + ! long wave optical properties table + call aero_props%optics_params(ilist, ibin, & + sw_hygro_coreshell_ext=newobj%sw_hygro_coreshell_ext, & + sw_hygro_coreshell_ssa=newobj%sw_hygro_coreshell_ssa, & + sw_hygro_coreshell_asm=newobj%sw_hygro_coreshell_asm, & + lw_hygro_coreshell_ext=newobj%lw_hygro_coreshell_abs) + + end function constructor + + !------------------------------------------------------------------------------ + ! returns short wave aerosol optics properties + !------------------------------------------------------------------------------ + subroutine sw_props(self, ncol, ilev, iwav, pext, pabs, palb, pasm) + + class(hygrocoreshell_aerosol_optics), intent(in) :: self + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: ilev ! vertical level index + integer, intent(in) :: iwav ! wave length index + real(r8),intent(out) :: pext(ncol) ! parameterized specific extinction (m2/kg) + real(r8),intent(out) :: pabs(ncol) ! parameterized specific absorption (m2/kg) + real(r8),intent(out) :: palb(ncol) ! parameterized asymmetry factor + real(r8),intent(out) :: pasm(ncol) ! parameterized single scattering albedo + + integer :: icol + + type(table_interp_wghts) :: rhwghts(ncol) + type(table_interp_wghts) :: cfwghts(ncol) + type(table_interp_wghts) :: bcwghts(ncol) + type(table_interp_wghts) :: kpwghts(ncol) + + rhwghts = table_interp_calcwghts( self%nrelh, self%tbl_relh, ncol, self%relh(:ncol,ilev) ) + cfwghts = table_interp_calcwghts( self%nfrac, self%tbl_corefrac, ncol, self%corefrac(:ncol,ilev) ) + bcwghts = table_interp_calcwghts( self%nbcdust, self%tbl_bcdust, ncol, self%bcdust(:ncol,ilev) ) + kpwghts = table_interp_calcwghts( self%nkap, self%tbl_kap, ncol, self%kappa(:ncol,ilev) ) + + pext = table_interp( ncol, self%nrelh,self%nfrac,self%nbcdust,self%nkap, rhwghts,cfwghts,bcwghts,kpwghts, self%sw_hygro_coreshell_ext(:,iwav,:,:,:)) + pabs = (1._r8-table_interp( ncol, self%nrelh,self%nfrac,self%nbcdust,self%nkap, rhwghts,cfwghts,bcwghts,kpwghts, self%sw_hygro_coreshell_ssa(:,iwav,:,:,:)))*pext + pasm = table_interp( ncol, self%nrelh,self%nfrac,self%nbcdust,self%nkap, rhwghts,cfwghts,bcwghts,kpwghts, self%sw_hygro_coreshell_asm(:,iwav,:,:,:)) + + do icol = 1, ncol + + pext(icol) = pext(icol)*self%totalmmr(icol,ilev) + pabs(icol) = pabs(icol)*self%totalmmr(icol,ilev) + pabs(icol) = max(0._r8,pabs(icol)) + pabs(icol) = min(pext(icol),pabs(icol)) + + palb(icol) = 1._r8-pabs(icol)/max(pext(icol),1.e-40_r8) + palb(icol) = 1._r8-pabs(icol)/max(pext(icol),1.e-40_r8) + + end do + + end subroutine sw_props + + !------------------------------------------------------------------------------ + ! returns long wave aerosol optics properties + !------------------------------------------------------------------------------ + subroutine lw_props(self, ncol, ilev, iwav, pabs) + + class(hygrocoreshell_aerosol_optics), intent(in) :: self + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: ilev ! vertical level index + integer, intent(in) :: iwav ! wave length index + real(r8),intent(out) :: pabs(ncol) ! parameterized specific absorption (m2/kg) + + integer :: icol + + type(table_interp_wghts) :: rhwghts(ncol) + type(table_interp_wghts) :: cfwghts(ncol) + type(table_interp_wghts) :: bcwghts(ncol) + type(table_interp_wghts) :: kpwghts(ncol) + + rhwghts = table_interp_calcwghts( self%nrelh, self%tbl_relh, ncol, self%relh(:ncol,ilev) ) + cfwghts = table_interp_calcwghts( self%nfrac, self%tbl_corefrac, ncol, self%corefrac(:ncol,ilev) ) + bcwghts = table_interp_calcwghts( self%nbcdust, self%tbl_bcdust, ncol, self%bcdust(:ncol,ilev) ) + kpwghts = table_interp_calcwghts( self%nkap, self%tbl_kap, ncol, self%kappa(:ncol,ilev) ) + + pabs = table_interp( ncol, self%nrelh,self%nfrac,self%nbcdust,self%nkap, rhwghts,cfwghts,bcwghts,kpwghts, self%lw_hygro_coreshell_abs(:,iwav,:,:,:)) + + do icol = 1, ncol + pabs(icol) = pabs(icol)*self%totalmmr(icol,ilev) + pabs(icol) = max(0._r8,pabs(icol)) + end do + + end subroutine lw_props + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + subroutine destructor(self) + + type(hygrocoreshell_aerosol_optics), intent(inout) :: self + + deallocate(self%totalmmr) + deallocate(self%corefrac) + deallocate(self%bcdust) + deallocate(self%kappa) + deallocate(self%relh) + + nullify(self%tbl_corefrac) + nullify(self%tbl_bcdust) + nullify(self%tbl_kap) + nullify(self%tbl_relh) + nullify(self%sw_hygro_coreshell_ext) + nullify(self%sw_hygro_coreshell_ssa) + nullify(self%sw_hygro_coreshell_asm) + nullify(self%lw_hygro_coreshell_abs) + + end subroutine destructor + +end module hygrocoreshell_aerosol_optics_mod diff --git a/src/chemistry/aerosol/hygrowghtpct_aerosol_optics_mod.F90 b/src/chemistry/aerosol/hygrowghtpct_aerosol_optics_mod.F90 new file mode 100644 index 0000000000..ebe84c1a56 --- /dev/null +++ b/src/chemistry/aerosol/hygrowghtpct_aerosol_optics_mod.F90 @@ -0,0 +1,188 @@ +module hygrowghtpct_aerosol_optics_mod + + use shr_kind_mod, only: r8 => shr_kind_r8 + use aerosol_optics_mod, only: aerosol_optics + use aerosol_state_mod, only: aerosol_state + use aerosol_properties_mod, only: aerosol_properties + use table_interp_mod, only: table_interp, table_interp_wghts, table_interp_calcwghts + + implicit none + + private + public :: hygrowghtpct_aerosol_optics + + !> hygrowghtpct_aerosol_optics + !! Table look up implementation of aerosol_optics to parameterize aerosol + !! radiative properties in terms of weight precent of H2SO4/H2O solution + type, extends(aerosol_optics) :: hygrowghtpct_aerosol_optics + + real(r8), allocatable :: totalmmr(:,:) ! total mmr of the aerosol + real(r8), allocatable :: wgtpct(:,:) ! weight precent of H2SO4/H2O solution + + real(r8), pointer :: sw_hygro_ext_wtp(:,:) ! short wave extinction table + real(r8), pointer :: sw_hygro_ssa_wtp(:,:) ! short wave single-scatter albedo table + real(r8), pointer :: sw_hygro_asm_wtp(:,:) ! short wave asymmetry table + real(r8), pointer :: lw_hygro_abs_wtp(:,:) ! long wave absorption table + + real(r8), pointer :: tbl_wgtpct(:) ! weight precent dimenstion values + + integer :: nwtp ! weight precent dimenstion size + + contains + + procedure :: sw_props + procedure :: lw_props + + final :: destructor + + end type hygrowghtpct_aerosol_optics + + interface hygrowghtpct_aerosol_optics + procedure :: constructor + end interface hygrowghtpct_aerosol_optics + +contains + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + function constructor(aero_props, aero_state, ilist, ibin, ncol, nlev, wgtpct_in) result(newobj) + + class(aerosol_properties),intent(in) :: aero_props ! aerosol_properties object + class(aerosol_state),intent(in) :: aero_state ! aerosol_state object + integer, intent(in) :: ilist ! climate or a diagnostic list number + integer, intent(in) :: ibin ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of levels + real(r8),intent(in) :: wgtpct_in(ncol,nlev) ! sulfate weight percent + + type(hygrowghtpct_aerosol_optics), pointer :: newobj + + integer :: ierr, nspec + integer :: ispec + integer :: i,k + + real(r8), pointer :: specmmr(:,:) ! species mass mixing ratio + + allocate(newobj, stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + + allocate(newobj%totalmmr(ncol,nlev),stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + + allocate(newobj%wgtpct(ncol,nlev),stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + + ! weight precent of H2SO4/H2O solution + newobj%wgtpct(:ncol,:nlev) = wgtpct_in(:ncol,:nlev) + + call aero_props%optics_params(ilist, ibin, wgtpct=newobj%tbl_wgtpct, nwtp=newobj%nwtp) + + nspec = aero_props%nspecies(ilist, ibin) + + newobj%totalmmr(:,:) = 0._r8 + + do ispec = 1,nspec + + call aero_state%get_ambient_mmr(ilist,ispec,ibin,specmmr) + newobj%totalmmr(:ncol,:nlev) = newobj%totalmmr(:ncol,:nlev) + specmmr(:ncol,:nlev) + + end do + + call aero_props%optics_params(ilist, ibin, & + sw_hygro_ext_wtp=newobj%sw_hygro_ext_wtp, & + sw_hygro_ssa_wtp=newobj%sw_hygro_ssa_wtp, & + sw_hygro_asm_wtp=newobj%sw_hygro_asm_wtp, & + lw_hygro_ext_wtp=newobj%lw_hygro_abs_wtp) + + end function constructor + + !------------------------------------------------------------------------------ + ! returns short wave aerosol optics properties + !------------------------------------------------------------------------------ + subroutine sw_props(self, ncol, ilev, iwav, pext, pabs, palb, pasm) + + class(hygrowghtpct_aerosol_optics), intent(in) :: self + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: ilev ! vertical level index + integer, intent(in) :: iwav ! wave length index + real(r8),intent(out) :: pext(ncol) ! parameterized specific extinction (m2/kg) + real(r8),intent(out) :: pabs(ncol) ! parameterized specific absorption (m2/kg) + real(r8),intent(out) :: palb(ncol) ! parameterized asymmetry factor + real(r8),intent(out) :: pasm(ncol) ! parameterized single scattering albedo + + integer :: icol + type(table_interp_wghts) :: wghts(ncol) + + wghts = table_interp_calcwghts( self%nwtp, self%tbl_wgtpct, ncol, self%wgtpct(:ncol,ilev) ) + pext = table_interp( ncol, self%nwtp, wghts, self%sw_hygro_ext_wtp(:,iwav) ) + pabs = (1._r8 - table_interp( ncol, self%nwtp, wghts, self%sw_hygro_ssa_wtp(:,iwav)))*pext + pasm = table_interp( ncol, self%nwtp, wghts, self%sw_hygro_asm_wtp(:,iwav) ) + + do icol = 1, ncol + + pext(icol) = pext(icol)*self%totalmmr(icol,ilev) + pabs(icol) = pabs(icol)*self%totalmmr(icol,ilev) + pabs(icol) = max(0._r8,pabs(icol)) + pabs(icol) = min(pext(icol),pabs(icol)) + + palb(icol) = 1._r8-pabs(icol)/max(pext(icol),1.e-40_r8) + palb(icol) = 1._r8-pabs(icol)/max(pext(icol),1.e-40_r8) + + end do + + end subroutine sw_props + + !------------------------------------------------------------------------------ + ! returns long wave aerosol optics properties + !------------------------------------------------------------------------------ + subroutine lw_props(self, ncol, ilev, iwav, pabs) + + class(hygrowghtpct_aerosol_optics), intent(in) :: self + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: ilev ! vertical level index + integer, intent(in) :: iwav ! wave length index + real(r8),intent(out) :: pabs(ncol) ! parameterized specific absorption (m2/kg) + + integer :: icol + type(table_interp_wghts) :: wghts(ncol) + + wghts = table_interp_calcwghts( self%nwtp, self%tbl_wgtpct, ncol, self%wgtpct(:ncol,ilev) ) + + pabs = table_interp( ncol, self%nwtp, wghts, self%lw_hygro_abs_wtp(:,iwav) ) + + do icol = 1, ncol + + pabs(icol) = pabs(icol)*self%totalmmr(icol,ilev) + pabs(icol) = max(0._r8,pabs(icol)) + + end do + + end subroutine lw_props + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + subroutine destructor(self) + + type(hygrowghtpct_aerosol_optics), intent(inout) :: self + + deallocate(self%totalmmr) + deallocate(self%wgtpct) + + nullify(self%tbl_wgtpct) + nullify(self%sw_hygro_ext_wtp) + nullify(self%sw_hygro_ssa_wtp) + nullify(self%sw_hygro_asm_wtp) + nullify(self%lw_hygro_abs_wtp) + + end subroutine destructor + +end module hygrowghtpct_aerosol_optics_mod diff --git a/src/chemistry/aerosol/mo_setsox.F90 b/src/chemistry/aerosol/mo_setsox.F90 index b994e32dd2..057bbb00ba 100644 --- a/src/chemistry/aerosol/mo_setsox.F90 +++ b/src/chemistry/aerosol/mo_setsox.F90 @@ -1,14 +1,16 @@ - -module MO_SETSOX +module mo_setsox use shr_kind_mod, only : r8 => shr_kind_r8 use cam_logfile, only : iulog + use physics_buffer,only: physics_buffer_desc, pbuf_get_index, pbuf_add_field, dtype_r8 + use physics_types, only: physics_state + + implicit none private public :: sox_inti, setsox public :: has_sox - save logical :: inv_o3 integer :: id_msa @@ -19,34 +21,31 @@ module MO_SETSOX logical :: inv_so2, inv_nh3, inv_hno3, inv_h2o2, inv_ox, inv_nh4no3, inv_ho2 logical :: cloud_borne = .false. - logical :: modal_aerosols = .false. contains -!----------------------------------------------------------------------- -!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- subroutine sox_inti - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- ! ... initialize the hetero sox routine - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- use mo_chem_utls, only : get_spc_ndx, get_inv_ndx use spmd_utils, only : masterproc use phys_control, only : phys_getopts + use carma_flags_mod, only : carma_do_cloudborne use sox_cldaero_mod, only : sox_cldaero_init - implicit none - + logical :: modal_aerosols - call phys_getopts( & - prog_modal_aero_out=modal_aerosols ) - - cloud_borne = modal_aerosols + call phys_getopts( prog_modal_aero_out=modal_aerosols ) + cloud_borne = modal_aerosols .or. carma_do_cloudborne !----------------------------------------------------------------- ! ... get species indicies !----------------------------------------------------------------- - + if (cloud_borne) then id_h2so4 = get_spc_ndx( 'H2SO4' ) else @@ -116,20 +115,26 @@ subroutine sox_inti if( has_sox ) then if (masterproc) then write(iulog,*) '-----------------------------------------' - write(iulog,*) 'mozart will do sox aerosols' + write(iulog,*) ' mo_setsox will do sox aerosols' + write(iulog,*) '-----------------------------------------' + endif + else + if (masterproc) then + write(iulog,*) '-----------------------------------------' + write(iulog,*) ' mo_setsox will not do sox aerosols' write(iulog,*) '-----------------------------------------' endif - else return end if call sox_cldaero_init() end subroutine sox_inti - -!----------------------------------------------------------------------- -!----------------------------------------------------------------------- - subroutine SETSOX( & + +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- + subroutine setsox( state, & + pbuf, & ncol, & lchnk, & loffset,& @@ -155,7 +160,7 @@ subroutine SETSOX( & aqso4_o3_3d & ) - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- ! ... Compute heterogeneous reactions of SOX ! ! (0) using initial PH to calculate PH @@ -168,7 +173,7 @@ subroutine SETSOX( & ! (b) PARTIONING ! (c) REACTION rates ! (d) PREDICTION - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- ! use ppgrid, only : pcols, pver use chem_mods, only : gas_pcnst, nfs @@ -179,11 +184,9 @@ subroutine SETSOX( & use cldaero_mod, only : cldaero_conc_t ! - implicit none - ! - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- ! ... Dummy arguments - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- integer, intent(in) :: ncol ! num of columns in chunk integer, intent(in) :: lchnk ! chunk id integer, intent(in) :: loffset ! offset of chem tracers in the advected tracers array @@ -209,12 +212,15 @@ subroutine SETSOX( & real(r8), intent(out), optional :: aqso4_h2o2_3d(:, :) ! 3D SO4 aqueous phase chemistry due to H2O2 (kg/m2) real(r8), intent(out), optional :: aqso4_o3_3d(:, :) ! 3D SO4 aqueous phase chemistry due to O3 (kg/m2) + type(physics_state), intent(in) :: state ! Physics state variables - !----------------------------------------------------------------------- + type(physics_buffer_desc), pointer :: pbuf(:) + + !----------------------------------------------------------------------- ! ... Local variables ! ! xhno3 ... in mixing ratio - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- integer, parameter :: itermax = 20 real(r8), parameter :: ph0 = 5.0_r8 ! INITIAL PH VALUES real(r8), parameter :: const0 = 1.e3_r8/6.023e23_r8 @@ -249,10 +255,10 @@ subroutine SETSOX( & real(r8) :: hno3g(ncol,pver), nh3g(ncol,pver) ! - !----------------------------------------------------------------------- - ! for Ho2(g) -> H2o2(a) formation + !----------------------------------------------------------------------- + ! for Ho2(g) -> H2o2(a) formation ! schwartz JGR, 1984, 11589 - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- real(r8) :: kh4 ! kh2+kh3 real(r8) :: xam ! air density /cm3 real(r8) :: ho2s ! ho2s = ho2(a)+o2- @@ -303,7 +309,7 @@ subroutine SETSOX( & xph0 = 10._r8**(-ph0) ! initial PH value do k = 1,pver - cfact(:,k) = xhnm(:,k) & ! /cm3(a) + cfact(:,k) = xhnm(:,k) & ! /cm3(a) * 1.e6_r8 & ! /m3(a) * 1.38e-23_r8/287._r8 & ! Kg(a)/m3(a) * 1.e-3_r8 ! Kg(a)/L(a) @@ -364,13 +370,13 @@ subroutine SETSOX( & if (id_msa > 0) xmsa (:,k) = qin(:,k,id_msa) end do - + !----------------------------------------------------------------- ! ... Temperature dependent Henry constants !----------------------------------------------------------------- ver_loop0: do k = 1,pver !! pver loop for STEP 0 col_loop0: do i = 1,ncol - + if (cloud_borne .and. cldfrc(i,k)>0._r8) then xso4(i,k) = xso4c(i,k) / cldfrc(i,k) xnh4(i,k) = xnh4c(i,k) / cldfrc(i,k) @@ -586,7 +592,7 @@ subroutine SETSOX( & xph(i,k) = 10.0_r8**(-yph) converged = .true. exit - else + else ! do another iteration converged = .false. end if @@ -615,7 +621,7 @@ subroutine SETSOX( & end do ! iter if( .not. converged ) then - write(iulog,*) 'SETSOX: pH failed to converge @ (',i,',',k,'), % change=', & + write(iulog,*) 'setsox: pH failed to converge @ (',i,',',k,'), % change=', & 100._r8*delta end if else @@ -637,9 +643,9 @@ subroutine SETSOX( & patm = press(i,k)/101300._r8 ! press is in pascal xam = press(i,k)/(1.38e-23_r8*tz) ! air density /M3 - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- ! ... hno3 - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- xk = 2.1e5_r8 *EXP( 8700._r8*work1(i) ) xe = 15.4_r8 hehno3(i,k) = xk*(1._r8 + xe/xph(i,k)) @@ -675,7 +681,7 @@ subroutine SETSOX( & heo3(i,k) = xk !------------------------------------------------------------------------ - ! ... for Ho2(g) -> H2o2(a) formation + ! ... for Ho2(g) -> H2o2(a) formation ! schwartz JGR, 1984, 11589 !------------------------------------------------------------------------ kh4 = (kh2 + kh3*kh1/xph(i,k)) / ((1._r8 + kh1/xph(i,k))**2) @@ -692,12 +698,12 @@ subroutine SETSOX( & / xam ! /cm3(a)/s / air-den = mix-ratio/s endif - if ( .not. modal_aerosols ) then + if ( .not. cloud_borne) then ! this seems to be specific to aerosols that are not cloud borne xh2o2(i,k) = xh2o2(i,k) + r2h2o2*dtime ! updated h2o2 by het production endif !----------------------------------------------- - ! ... Partioning + ! ... Partioning !----------------------------------------------- !----------------------------------------------------------------- @@ -755,8 +761,8 @@ subroutine SETSOX( & !----------------------------------------------------------------- ! ... Prediction after aqueous phase ! so4 - ! When Cloud is present - ! + ! When Cloud is present + ! ! S(IV) + H2O2 = S(VI) ! S(IV) + O3 = S(VI) ! @@ -764,12 +770,12 @@ subroutine SETSOX( & ! (1) Seinfeld ! (2) Benkovitz !----------------------------------------------------------------- - + !............................ ! S(IV) + H2O2 = S(VI) !............................ - - IF (XL .ge. 1.e-8_r8) THEN !! WHEN CLOUD IS PRESENTED + + IF (XL .ge. 1.e-8_r8) THEN !! WHEN CLOUD IS PRESENTED if (cloud_borne) then patm_x = patm @@ -777,7 +783,7 @@ subroutine SETSOX( & patm_x = 1._r8 endif - if (modal_aerosols) then + if (cloud_borne) then pso4 = rah2o2 * 7.4e4_r8*EXP(6621._r8*work1(i)) * h2o2g * patm_x & * 1.23_r8 *EXP(3120._r8*work1(i)) * so2g * patm_x @@ -825,8 +831,8 @@ subroutine SETSOX( & xso2(i,k) = xso2(i,k) - ccc end if END IF - - if (modal_aerosols) then + + if (cloud_borne) then xdelso4hp(i,k) = xso4(i,k) - xso4_init(i,k) endif !........................... @@ -839,7 +845,7 @@ subroutine SETSOX( & * xl & ! [mole/L(a)/s] / const0 & ! [/L(a)/s] / xhnm(i,k) ! [mixing ratio/s] - + ccc = pso4*dtime ccc = max(ccc, 1.e-30_r8) @@ -858,11 +864,11 @@ subroutine SETSOX( & end do col_loop1 end do ver_loop1 - call sox_cldaero_update( & - ncol, lchnk, loffset, dtime, mbar, pdel, press, tfld, cldnum, cldfrc, cfact, cldconc%xlwc, & - xdelso4hp, xh2so4, xso4, xso4_init, nh3g, hno3g, xnh3, xhno3, xnh4c, xno3c, xmsa, xso2, xh2o2, qcw, qin, & - aqso4, aqh2so4, aqso4_h2o2, aqso4_o3, aqso4_h2o2_3d=aqso4_h2o2_3d, aqso4_o3_3d=aqso4_o3_3d ) - + call sox_cldaero_update( state, & + pbuf, ncol, lchnk, loffset, dtime, mbar, pdel, press, tfld, cldnum, cldfrc, cfact, cldconc%xlwc, & + xdelso4hp, xh2so4, xso4, xso4_init, nh3g, hno3g, xnh3, xhno3, xnh4c, xno3c, xmsa, xso2, xh2o2, qcw, qin, & + aqso4, aqh2so4, aqso4_h2o2, aqso4_o3, aqso4_h2o2_3d=aqso4_h2o2_3d, aqso4_o3_3d=aqso4_o3_3d ) + xphlwc(:,:) = 0._r8 do k = 1, pver do i = 1, ncol @@ -874,6 +880,6 @@ subroutine SETSOX( & call sox_cldaero_destroy_obj(cldconc) - end subroutine SETSOX + end subroutine setsox -end module MO_SETSOX +end module mo_setsox diff --git a/src/chemistry/aerosol/modal_aerosol_state_mod.F90 b/src/chemistry/aerosol/modal_aerosol_state_mod.F90 index 819f20d1f0..5e24eac8b3 100644 --- a/src/chemistry/aerosol/modal_aerosol_state_mod.F90 +++ b/src/chemistry/aerosol/modal_aerosol_state_mod.F90 @@ -42,6 +42,7 @@ module modal_aerosol_state_mod procedure :: water_volume procedure :: wet_diameter procedure :: convcld_actfrac + procedure :: wgtpct final :: destructor @@ -428,16 +429,15 @@ end function hetfrz_size_wght ! returns hygroscopicity for a given radiation diagnostic list number and ! bin number !------------------------------------------------------------------------------ - function hygroscopicity(self, list_ndx, bin_ndx) result(kappa) + subroutine hygroscopicity(self, list_ndx, bin_ndx, kappa) class(modal_aerosol_state), intent(in) :: self integer, intent(in) :: list_ndx ! rad climate list number integer, intent(in) :: bin_ndx ! bin number + real(r8), intent(out) :: kappa(:,:) ! hygroscopicity (ncol,nlev) - real(r8), pointer :: kappa(:,:) ! hygroscopicity (ncol,nlev) + kappa = -huge(1._r8) - nullify(kappa) - - end function hygroscopicity + end subroutine hygroscopicity !------------------------------------------------------------------------------ ! returns aerosol wet diameter and aerosol water concentration for a given @@ -684,4 +684,16 @@ function convcld_actfrac(self, ibin, ispc, ncol, nlev) result(frac) end function convcld_actfrac + !------------------------------------------------------------------------------ + ! aerosol weight precent of H2SO4/H2O solution + !------------------------------------------------------------------------------ + function wgtpct(self, ncol, nlev) result(wtp) + class(modal_aerosol_state), intent(in) :: self + integer, intent(in) :: ncol, nlev + real(r8) :: wtp(ncol,nlev) ! weight precent of H2SO4/H2O solution for given icol, ilev + + wtp(:,:) = -huge(1._r8) + + end function wgtpct + end module modal_aerosol_state_mod diff --git a/src/chemistry/bulk_aero/aero_model.F90 b/src/chemistry/bulk_aero/aero_model.F90 index b285bf710a..015a4746a8 100644 --- a/src/chemistry/bulk_aero/aero_model.F90 +++ b/src/chemistry/bulk_aero/aero_model.F90 @@ -67,6 +67,7 @@ subroutine aero_model_readnl(nlfile) use namelist_utils, only: find_group_name use units, only: getunit, freeunit use mpishorthand + use dust_model, only: dust_readnl character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input @@ -112,6 +113,8 @@ subroutine aero_model_readnl(nlfile) wetdep_list = aer_wetdep_list drydep_list = aer_drydep_list + call dust_readnl(nlfile) + end subroutine aero_model_readnl !============================================================================= @@ -136,6 +139,7 @@ subroutine aero_model_init( pbuf2d ) use aer_drydep_mod, only: inidrydep use wetdep, only: wetdep_init use mo_setsox, only: has_sox + use mo_setsox, only: sox_inti ! args type(physics_buffer_desc), pointer :: pbuf2d(:,:) @@ -147,6 +151,9 @@ subroutine aero_model_init( pbuf2d ) logical :: history_aerosol ! Output MAM or SECT aerosol tendencies logical :: history_dust ! Output dust + ! aqueous chem initialization + call sox_inti() + call phys_getopts( history_aerosol_out = history_aerosol,& history_dust_out = history_dust ) @@ -690,12 +697,13 @@ subroutine aero_model_wetdep( state, dt, dlf, cam_out, ptend, pbuf) ! called from mo_usrrxt !------------------------------------------------------------------------- subroutine aero_model_surfarea( & - mmr, radmean, relhum, pmid, temp, strato_sad, sulfate, m, ltrop, & + state, mmr, radmean, relhum, pmid, temp, strato_sad, sulfate, m, ltrop, & dlat, het1_ndx, pbuf, ncol, sfc, dm_aer, sad_total, reff_trop ) use mo_constants, only : pi, avo => avogadro ! dummy args + type(physics_state), intent(in) :: state ! Physics state variables real(r8), intent(in) :: pmid(:,:) real(r8), intent(in) :: temp(:,:) real(r8), intent(in) :: mmr(:,:,:) @@ -985,9 +993,10 @@ end subroutine aero_model_surfarea !------------------------------------------------------------------------- ! stub !------------------------------------------------------------------------- - subroutine aero_model_strat_surfarea( ncol, mmr, pmid, temp, ltrop, pbuf, strato_sad, reff_strat ) + subroutine aero_model_strat_surfarea( state, ncol, mmr, pmid, temp, ltrop, pbuf, strato_sad, reff_strat ) ! dummy args + type(physics_state), intent(in) :: state ! Physics state variables integer, intent(in) :: ncol real(r8), intent(in) :: mmr(:,:,:) real(r8), intent(in) :: pmid(:,:) @@ -1004,7 +1013,7 @@ end subroutine aero_model_strat_surfarea !============================================================================= !============================================================================= - subroutine aero_model_gasaerexch( loffset, ncol, lchnk, troplev, delt, reaction_rates, & + subroutine aero_model_gasaerexch( state, loffset, ncol, lchnk, troplev, delt, reaction_rates, & tfld, pmid, pdel, mbar, relhum, & zm, qh2o, cwat, cldfr, cldnum, & airdens, invariants, del_h2so4_gasprod, & @@ -1018,6 +1027,7 @@ subroutine aero_model_gasaerexch( loffset, ncol, lchnk, troplev, delt, reaction_ !----------------------------------------------------------------------- ! ... dummy arguments !----------------------------------------------------------------------- + type(physics_state), intent(in) :: state ! Physics state variables integer, intent(in) :: loffset ! offset applied to modal aero "pointers" integer, intent(in) :: ncol ! number columns in chunk integer, intent(in) :: lchnk ! chunk index @@ -1056,7 +1066,8 @@ subroutine aero_model_gasaerexch( loffset, ncol, lchnk, troplev, delt, reaction_ ! aqueous chemistry ... if( has_sox ) then - call setsox( & + call setsox( state, & + pbuf, & ncol, & lchnk, & loffset, & diff --git a/src/chemistry/bulk_aero/sox_cldaero_mod.F90 b/src/chemistry/bulk_aero/sox_cldaero_mod.F90 index de475209d7..461b645189 100644 --- a/src/chemistry/bulk_aero/sox_cldaero_mod.F90 +++ b/src/chemistry/bulk_aero/sox_cldaero_mod.F90 @@ -8,6 +8,7 @@ module sox_cldaero_mod use ppgrid, only : pcols, pver use mo_chem_utls, only : get_spc_ndx use cldaero_mod, only : cldaero_conc_t, cldaero_allocate, cldaero_deallocate + use physics_buffer, only : physics_buffer_desc implicit none private @@ -22,7 +23,7 @@ module sox_cldaero_mod real(r8), parameter :: small_value = 1.e-20_r8 contains - + !---------------------------------------------------------------------------------- !---------------------------------------------------------------------------------- @@ -32,10 +33,10 @@ subroutine sox_cldaero_init id_so4 = get_spc_ndx( 'SO4' ) id_h2o2 = get_spc_ndx( 'H2O2' ) - if ( id_so2<1 ) then + if ( id_so2<1 ) then call endrun('sox_cldaero_init: SO2 is not included in chemistry -- should not invoke sox_cldaero_mod...') endif - + end subroutine sox_cldaero_init !---------------------------------------------------------------------------------- @@ -60,13 +61,16 @@ end function sox_cldaero_create_obj !---------------------------------------------------------------------------------- ! Update the mixing ratios !---------------------------------------------------------------------------------- - subroutine sox_cldaero_update( & - ncol, lchnk, loffset, dtime, mbar, pdel, press, tfld, cldnum, cldfrc, cfact, xlwc, & + subroutine sox_cldaero_update( state, & + pbuf, ncol, lchnk, loffset, dtime, mbar, pdel, press, tfld, cldnum, cldfrc, cfact, xlwc, & delso4_hprxn, xh2so4, xso4, xso4_init, nh3g, hno3g, xnh3, xhno3, xnh4c, xno3c, xmsa, xso2, xh2o2, qcw, qin, & aqso4, aqh2so4, aqso4_h2o2, aqso4_o3, aqso4_h2o2_3d, aqso4_o3_3d ) - - ! args - + use physics_types, only: physics_state + + ! args + + type(physics_state), intent(in) :: state ! Physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) integer, intent(in) :: ncol integer, intent(in) :: lchnk ! chunk id integer, intent(in) :: loffset @@ -74,7 +78,7 @@ subroutine sox_cldaero_update( & real(r8), intent(in) :: dtime ! time step (sec) real(r8), intent(in) :: mbar(:,:) ! mean wet atmospheric mass ( amu ) - real(r8), intent(in) :: pdel(:,:) + real(r8), intent(in) :: pdel(:,:) real(r8), intent(in) :: press(:,:) real(r8), intent(in) :: tfld(:,:) @@ -106,11 +110,11 @@ subroutine sox_cldaero_update( & real(r8), intent(out) :: aqso4_o3(:) ! SO4 aqueous phase chemistry due to O3 (kg/m2) real(r8), intent(out), optional :: aqso4_h2o2_3d(:,:) ! SO4 aqueous phase chemistry due to H2O2 (kg/m2) real(r8), intent(out), optional :: aqso4_o3_3d(:,:) ! SO4 aqueous phase chemistry due to O3 (kg/m2) - + ! local vars ... - + integer :: k - + !============================================================== ! ... Update the mixing ratios !============================================================== @@ -120,7 +124,7 @@ subroutine sox_cldaero_update( & qin(:,k,id_so2) = MAX( xso2(:,k), small_value ) endif if (id_h2o2>0) then - qin(:,k,id_h2o2)= MAX( xh2o2(:,k), small_value ) + qin(:,k,id_h2o2)= MAX( xh2o2(:,k), small_value ) endif qin(:,k,id_so4) = MAX( xso4(:,k), small_value ) diff --git a/src/chemistry/carma_aero/aero_model.F90 b/src/chemistry/carma_aero/aero_model.F90 new file mode 100644 index 0000000000..fa8959c6bc --- /dev/null +++ b/src/chemistry/carma_aero/aero_model.F90 @@ -0,0 +1,1635 @@ +!=============================================================================== +! CAMRA Aerosol Model +!=============================================================================== +module aero_model + use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_add_field, dtype_r8 + use shr_kind_mod, only: r8 => shr_kind_r8 + use constituents, only: pcnst, cnst_name, cnst_get_ind + use perf_mod, only: t_startf, t_stopf + use ppgrid, only: pcols, pver, pverp + use phys_control, only: phys_getopts, cam_physpkg_is + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use physics_types, only: physics_state, physics_ptend, physics_ptend_init + use camsrfexch, only: cam_in_t, cam_out_t + use physics_buffer, only: pbuf_get_field, pbuf_set_field, dtype_r8 + use physconst, only: gravit, rair, rhoh2o + use spmd_utils, only: masterproc + use cam_history, only: outfld + use chem_mods, only: gas_pcnst, adv_mass + use mo_tracname, only: solsym + use infnan, only: nan, assignment(=) + use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_info_by_bin, & + rad_cnst_get_info_by_bin_spec, rad_cnst_get_bin_props_by_idx, & + rad_cnst_get_bin_mmr_by_idx + use mo_setsox, only: setsox, has_sox + use carma_aerosol_properties_mod, only: carma_aerosol_properties + + use carma_intr, only: carma_get_group_by_name, carma_get_dry_radius, carma_get_wet_radius, carma_get_bin_rmass + use carma_intr, only: carma_get_total_mmr, carma_get_sad + + use aerosol_properties_mod, only: aero_name_len + + implicit none + private + + public :: aero_model_readnl + public :: aero_model_register + public :: aero_model_init + public :: aero_model_gasaerexch ! create, grow, change, and shrink aerosols. + public :: aero_model_drydep ! aerosol dry deposition and sediment + public :: aero_model_wetdep ! aerosol wet removal + public :: aero_model_emissions ! aerosol emissions + public :: aero_model_surfarea ! tropospheric aerosol wet surface area for chemistry + public :: aero_model_strat_surfarea ! stub + + ! Misc private data + character(len=32), allocatable :: fieldname(:) ! names for interstitial output fields + character(len=32), allocatable :: fieldname_cw(:) ! names for cloud_borne output fields + + ! number of modes + integer :: pblh_idx = 0 + integer :: wetdens_ap_idx = 0 + + integer :: fracis_idx = 0 + integer :: prain_idx = 0 + integer :: rprddp_idx = 0 + integer :: rprdsh_idx = 0 + integer :: nevapr_shcu_idx = 0 + integer :: nevapr_dpcu_idx = 0 + + integer :: sulfeq_idx = -1 + + integer :: nh3_ndx = 0 + integer :: nh4_ndx = 0 + integer :: h2so4_ndx = 0 + + ! variables for table lookup of aerosol impaction/interception scavenging rates + integer, parameter :: nimptblgrow_mind=-7, nimptblgrow_maxd=12 + real(r8) :: dlndg_nimptblgrow + real(r8),allocatable :: scavimptblnum(:,:) + real(r8),allocatable :: scavimptblvol(:,:) + + + ! description of bin aerosols + integer, public, protected :: nspec_max = 0 + integer, public, protected :: nbins = 0 + integer, public, protected, allocatable :: nspec(:) + + ! local indexing for bins + integer, allocatable :: bin_idx(:,:) ! table for local indexing of modal aero number and mmr + integer :: ncnst_tot ! total number of mode number conc + mode species + integer :: ncnst_extd ! twiece total number of mode number conc + mode species + + ! Indices for CARMA species in the ptend%q array. Needed for prognostic aerosol case. + logical, allocatable :: bin_cnst_lq(:,:) + integer, allocatable :: bin_cnst_idx(:,:) + + + ! ptr2d_t is used to create arrays of pointers to 2D fields + type ptr2d_t + real(r8), pointer :: fld(:,:) => null() + end type ptr2d_t + + logical :: lq(pcnst) = .false. ! set flags true for constituents with non-zero tendencies + ! in the ptend object + + ! Namelist variables + real(r8) :: sol_facti_cloud_borne = 1._r8 + real(r8) :: sol_factb_interstitial = 0.1_r8 + real(r8) :: sol_factic_interstitial = 0.4_r8 + real(r8) :: seasalt_emis_scale + + logical :: convproc_do_aer + + type(carma_aerosol_properties), pointer :: aero_props =>null() + +contains + + !============================================================================= + ! reads aerosol namelist options + !============================================================================= + subroutine aero_model_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use aero_wetdep_cam, only: aero_wetdep_readnl + use mpishorthand + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'aero_model_readnl' + + ! Namelist variables + !st character(len=16) :: aer_wetdep_list(pcnst) = ' ' + !st character(len=16) :: aer_drydep_list(pcnst) = ' ' + + namelist /aerosol_nl/ sol_facti_cloud_borne, sol_factb_interstitial, sol_factic_interstitial + + !----------------------------------------------------------------------------- + + ! Read namelist + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'aerosol_nl', status=ierr) + if (ierr == 0) then + read(unitn, aerosol_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + ! Broadcast namelist variables + !st call mpibcast(aer_wetdep_list, len(aer_wetdep_list(1))*pcnst, mpichar, 0, mpicom) + !st call mpibcast(aer_drydep_list, len(aer_drydep_list(1))*pcnst, mpichar, 0, mpicom) + call mpibcast(sol_facti_cloud_borne, 1, mpir8, 0, mpicom) + call mpibcast(sol_factb_interstitial, 1, mpir8, 0, mpicom) + call mpibcast(sol_factic_interstitial, 1, mpir8, 0, mpicom) + !st call mpibcast(modal_strat_sulfate, 1, mpilog, 0, mpicom) + !st call mpibcast(seasalt_emis_scale, 1, mpir8, 0, mpicom) + !st call mpibcast(modal_accum_coarse_exch, 1, mpilog, 0, mpicom) +#endif + + call aero_wetdep_readnl(nlfile) + + end subroutine aero_model_readnl + + !============================================================================= + !============================================================================= + subroutine aero_model_register() + + use carma_flags_mod, only: carma_model + + integer :: m, l, i + integer :: nsoa_vbs + character(len=32) :: spectype + character(len=32) :: num_name + character(len=32) :: num_name_cw + character(len=32) :: spec_name_cw + character(len=32) :: soag_name + character(len=32) :: soa_name + + integer :: idx + + call rad_cnst_get_info( 0, nbins=nbins) + allocate( nspec(nbins) ) + + ! add pbuf fields for interstitial (cloud borne) aerosols in CARMA + do m = 1, nbins + call rad_cnst_get_info_by_bin(0, m, num_name=num_name, num_name_cw=num_name_cw, nspec=nspec(m)) + call pbuf_add_field(num_name,'global',dtype_r8,(/pcols,pver/), idx) + call pbuf_add_field(num_name_cw,'global',dtype_r8,(/pcols,pver/), idx) + do l = 1, nspec(m) + call rad_cnst_get_info_by_bin_spec(0, m, l, spec_name_cw=spec_name_cw) + call pbuf_add_field(spec_name_cw,'global',dtype_r8,(/pcols,pver/),idx) + enddo + enddo + + ! SOA information + ! Define number of VBS bins (nsoa) based on number of SOAG chemistry species + nsoa_vbs = 0 + do i = 1, pcnst + if (cnst_name(i)(:4) == 'SOAG') then + nsoa_vbs = nsoa_vbs + 1 + end if + end do + if (masterproc) then + write(iulog,*) 'nsoa_vbs = ', nsoa_vbs + endif + + ! Define pbuf field for soa_fraction + call pbuf_add_field('FRACVBS','global',dtype_r8,(/pcols,pver,nbins,nsoa_vbs/), idx) + + end subroutine aero_model_register + + !============================================================================= + !============================================================================= + subroutine aero_model_init( pbuf2d ) + + use mo_chem_utls, only: get_inv_ndx + use cam_history, only: addfld, add_default, horiz_only + use mo_chem_utls, only: get_rxt_ndx, get_spc_ndx + !st use modal_aero_data, only: cnst_name_cw + !st use modal_aero_data, only: modal_aero_data_init + !st use dust_model, only: dust_init, dust_names, dust_active, dust_nbin, dust_nnum + !st use seasalt_model, only: seasalt_init, seasalt_names, seasalt_active,seasalt_nbin + !st use drydep_mod, only: inidrydep + use aero_wetdep_cam, only: aero_wetdep_init + use mo_setsox, only: sox_inti + + !st use modal_aero_calcsize, only: modal_aero_calcsize_init + !st use modal_aero_coag, only: modal_aero_coag_init + !st use modal_aero_deposition, only: modal_aero_deposition_init + use carma_aero_gasaerexch, only: carma_aero_gasaerexch_init + !st use modal_aero_newnuc, only: modal_aero_newnuc_init + !st use modal_aero_rename, only: modal_aero_rename_init + + use time_manager, only: is_first_step + use constituents, only: cnst_set_convtran2 + use aero_deposition_cam, only: aero_deposition_cam_init + + ! args + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + + ! local vars + character(len=*), parameter :: subrname = 'aero_model_init' + integer :: m, n, id, ii, mm + integer :: lptr = -1 + integer :: idxtmp = -1 + character(len=20) :: dummy + + logical :: history_aerosol ! Output MAM or SECT aerosol tendencies + logical :: history_chemistry, history_cesm_forcing, history_dust + + integer :: l + character(len=6) :: test_name + character(len=64) :: errmes + + character(len=2) :: unit_basename ! Units 'kg' or '1' + integer :: errcode + !st character(len=fieldname_len) :: field_name + + character(len=32) :: spectype + character(len=32) :: num_name + character(len=32) :: num_name_cw + character(len=32) :: spec_name_cw + + integer :: idx + real(r8) :: nanval + + aero_props => carma_aerosol_properties() + call aero_deposition_cam_init(aero_props) + + if (is_first_step()) then + do m = 1, nbins + call rad_cnst_get_info_by_bin(0, m, num_name=num_name, num_name_cw=num_name_cw) + idx = pbuf_get_index(num_name) + call pbuf_set_field(pbuf2d, idx, 0.0_r8) + idx = pbuf_get_index(num_name_cw) + call pbuf_set_field(pbuf2d, idx, 0.0_r8) + do l = 1, nspec(m) + call rad_cnst_get_info_by_bin_spec(0, m, l, spec_name_cw=spec_name_cw) + idx = pbuf_get_index(spec_name_cw) + call pbuf_set_field(pbuf2d, idx, 0.0_r8) + enddo + enddo + endif + + ! define pbuf field for soa_fraction + if (is_first_step()) then + nanval = nan + idx = pbuf_get_index('FRACVBS') + call pbuf_set_field(pbuf2d, idx, nanval) + end if + + ! aqueous chem initialization + call sox_inti() + + h2so4_ndx = get_spc_ndx('H2SO4') + nh3_ndx = get_spc_ndx('NH3') + nh4_ndx = get_spc_ndx('NH4') + + + + fracis_idx = pbuf_get_index('FRACIS') + prain_idx = pbuf_get_index('PRAIN') + rprddp_idx = pbuf_get_index('RPRDDP') + rprdsh_idx = pbuf_get_index('RPRDSH') + nevapr_shcu_idx = pbuf_get_index('NEVAPR_SHCU') + nevapr_dpcu_idx = pbuf_get_index('NEVAPR_DPCU') + !st sulfeq_idx = pbuf_get_index('MAMH2SO4EQ',errcode) + + !st not sure if this is needed + call phys_getopts(history_aerosol_out = history_aerosol, & + history_chemistry_out=history_chemistry, & + history_cesm_forcing_out=history_cesm_forcing, & + convproc_do_aer_out = convproc_do_aer) + +!!$ call carma_aero_bcscavcoef_init(pbuf2d) + + !st call modal_aero_rename_init( modal_accum_coarse_exch ) + ! calcsize call must follow rename call + !st call modal_aero_calcsize_init( pbuf2d ) + call carma_aero_gasaerexch_init + ! coag call must follow gasaerexch call + !st call modal_aero_coag_init + !st call modal_aero_newnuc_init + + ! call modal_aero_deposition_init only if the user has not specified + ! prescribed aerosol deposition fluxes + !st if (.not.aerodep_flx_prescribed()) then + !st call modal_aero_deposition_init + !stendif + + + !st all CARMA species are deposited, therefore the following is not used + !st nwetdep = 0 + !st ndrydep = 0 + + !st count_species: do m = 1,pcnst + !st if ( len_trim(wetdep_list(m)) /= 0 ) then + !st nwetdep = nwetdep+1 + !st endif + !st if ( len_trim(drydep_list(m)) /= 0 ) then + !st ndrydep = ndrydep+1 + !st endif + !st enddo count_species + + ! add plus one to include number, total mmr and nspec + nspec_max = maxval(nspec) + + ncnst_tot = nspec(1) + do m = 2, nbins + ncnst_tot = ncnst_tot + nspec(m) + end do + ncnst_extd = 2*ncnst_tot + + allocate( & + bin_idx(nbins,nspec_max), & + bin_cnst_lq(nbins,nspec_max), & + bin_cnst_idx(nbins,nspec_max), & + fieldname_cw(ncnst_tot), & + fieldname(ncnst_tot) ) + + ii = 0 + do m = 1, nbins + do l = 1, nspec(m) ! loop through species + ii = ii + 1 + bin_idx(m,l) = ii + + if (l <= nspec(m) ) then ! species + call rad_cnst_get_info_by_bin_spec(0, m, l, spec_name=fieldname(ii), spec_name_cw=fieldname_cw(ii)) + else !number + call rad_cnst_get_info_by_bin(0, m, num_name=fieldname(ii), num_name_cw=fieldname_cw(ii)) + end if + + call cnst_get_ind(fieldname(ii), idxtmp, abort=.false.) + if (idxtmp.gt.0) then + bin_cnst_lq(m,l) = .true. + bin_cnst_idx(m,l) = idxtmp + lq(idxtmp) = .true. + call cnst_set_convtran2(idxtmp, .not.convproc_do_aer) + else + bin_cnst_lq(m,l) = .false. + bin_cnst_idx(m,l) = 0 + end if + + mm = ii + + unit_basename = 'kg' + if (l == nspec(m) + 2) then ! number + unit_basename = ' 1' + end if + + + call addfld( fieldname_cw(mm), (/ 'lev' /), 'A', unit_basename//'/kg ', & + trim(fieldname_cw(mm))//' in cloud water') + call addfld (trim(fieldname_cw(mm))//'DDF', horiz_only, 'A', unit_basename//'/m2/s ', & + trim(fieldname_cw(mm))//' dry deposition flux at bottom (grav + turb)') + call addfld (trim(fieldname_cw(mm))//'TBF', horiz_only, 'A', unit_basename//'/m2/s ', & + trim(fieldname_cw(mm))//' turbulent dry deposition flux') + call addfld (trim(fieldname_cw(mm))//'GVF', horiz_only, 'A', unit_basename//'/m2/s ', & + trim(fieldname_cw(mm))//' gravitational dry deposition flux') + + if ( history_aerosol.or. history_chemistry ) then + call add_default( fieldname_cw(mm), 1, ' ' ) + endif + if ( history_aerosol ) then + call add_default (trim(fieldname_cw(mm))//'GVF', 1, ' ') + call add_default (trim(fieldname_cw(mm))//'TBF', 1, ' ') + call add_default (trim(fieldname_cw(mm))//'DDF', 1, ' ') + endif + enddo + enddo + + do m = 1,gas_pcnst + + unit_basename = 'kg' ! Units 'kg' or '1' + + call addfld( 'GS_'//trim(solsym(m)),horiz_only, 'A', unit_basename//'/m2/s ', & + trim(solsym(m))//' gas chemistry/wet removal (for gas species)') + call addfld( 'AQ_'//trim(solsym(m)),horiz_only, 'A', unit_basename//'/m2/s ', & + trim(solsym(m))//' aqueous chemistry (for gas species)') + if ( history_aerosol ) then + call add_default( 'AQ_'//trim(solsym(m)), 1, ' ') + endif + + enddo + + if (has_sox) then + do n = 1, nbins + do l = 1, nspec(n) ! not for total mass or number + mm = bin_idx(n, l) + call addfld (& + trim(fieldname_cw(mm))//'AQSO4',horiz_only, 'A','kg/m2/s', & + trim(fieldname_cw(mm))//' aqueous phase chemistry') + call addfld (& + trim(fieldname_cw(mm))//'AQH2SO4',horiz_only, 'A','kg/m2/s', & + trim(fieldname_cw(mm))//' aqueous phase chemistry') + if ( history_aerosol ) then + call add_default (trim(fieldname_cw(mm))//'AQSO4', 1, ' ') + call add_default (trim(fieldname_cw(mm))//'AQH2SO4', 1, ' ') + endif + end do + end do + + call addfld( 'XPH_LWC', (/ 'lev' /), 'A','kg/kg', 'pH value multiplied by lwc') + call addfld ('AQSO4_H2O2', horiz_only, 'A','kg/m2/s', 'SO4 aqueous phase chemistry due to H2O2') + call addfld ('AQSO4_O3', horiz_only, 'A','kg/m2/s', 'SO4 aqueous phase chemistry due to O3') + + if ( history_aerosol ) then + call add_default ('XPH_LWC', 1, ' ') + call add_default ('AQSO4_H2O2', 1, ' ') + call add_default ('AQSO4_O3', 1, ' ') + endif + endif + + call aero_wetdep_init() + + end subroutine aero_model_init + + !============================================================================= + !============================================================================= + subroutine aero_model_drydep ( state, pbuf, obklen, ustar, cam_in, dt, cam_out, ptend ) + + ! args + type(physics_state), intent(in) :: state ! Physics state variables + real(r8), intent(in) :: obklen(:) + real(r8), intent(in) :: ustar(:) ! sfc fric vel + type(cam_in_t), target, intent(in) :: cam_in ! import state + real(r8), intent(in) :: dt ! time step + type(cam_out_t), intent(inout) :: cam_out ! export state + type(physics_ptend), intent(out) :: ptend ! indivdual parameterization tendencies + type(physics_buffer_desc), pointer :: pbuf(:) + + endsubroutine aero_model_drydep + + !============================================================================= + !============================================================================= + subroutine aero_model_wetdep( state, dt, dlf, cam_out, ptend, pbuf) + + use aero_wetdep_cam, only: aero_wetdep_tend + + ! args + + type(physics_state), intent(in) :: state ! Physics state variables + real(r8), intent(in) :: dt ! time step + real(r8), intent(in) :: dlf(:,:) ! shallow+deep convective detrainment [kg/kg/s] + type(cam_out_t), intent(inout) :: cam_out ! export state + type(physics_ptend), intent(out) :: ptend ! indivdual parameterization tendencies + type(physics_buffer_desc), pointer :: pbuf(:) + + call aero_wetdep_tend(state, dt, dlf, cam_out, ptend, pbuf) + + end subroutine aero_model_wetdep + + !------------------------------------------------------------------------- + ! provides wet tropospheric aerosol surface area info for sectional aerosols + ! called from mo_usrrxt + !------------------------------------------------------------------------- + subroutine aero_model_surfarea( & + state, mmr, radmean, relhum, pmid, temp, strato_sad, sulfate, m, ltrop, & + dlat, het1_ndx, pbuf, ncol, sfc, dm_aer, sad_trop, reff_trop ) + + ! dummy args + type(physics_state), intent(in) :: state ! Physics state variables + real(r8), intent(in) :: pmid(:,:) + real(r8), intent(in) :: temp(:,:) + real(r8), intent(in) :: mmr(:,:,:) + real(r8), intent(in) :: radmean ! mean radii in cm + real(r8), intent(in) :: strato_sad(:,:) + integer, intent(in) :: ncol + integer, intent(in) :: ltrop(:) + real(r8), intent(in) :: dlat(:) ! degrees latitude + integer, intent(in) :: het1_ndx + real(r8), intent(in) :: relhum(:,:) + real(r8), intent(in) :: m(:,:) ! total atm density (/cm^3) + real(r8), intent(in) :: sulfate(:,:) + type(physics_buffer_desc), pointer :: pbuf(:) + + real(r8), intent(inout) :: sfc(:,:,:) + real(r8), intent(inout) :: dm_aer(:,:,:) + real(r8), intent(inout) :: sad_trop(:,:) ! aerosol surface area density (cm2/cm3), zeroed above the tropopause + real(r8), intent(out) :: reff_trop(:,:) ! aerosol effective radius (cm), zeroed above the tropopause + + ! local vars + integer :: beglev(ncol) + integer :: endlev(ncol) + + beglev(:ncol)=ltrop(:ncol)+1 + endlev(:ncol)=pver + call surf_area_dens( state, pbuf, ncol, mmr, beglev, endlev, sad_trop, reff_trop, sfc=sfc, dm_aer=dm_aer ) + + end subroutine aero_model_surfarea + + !------------------------------------------------------------------------- + ! provides wet stratospheric aerosol surface area info for sectional aerosols + ! called from mo_gas_phase_chemdr.F90 + !------------------------------------------------------------------------- + subroutine aero_model_strat_surfarea( state, ncol, mmr, pmid, temp, ltrop, pbuf, strato_sad, reff_strat ) + + use ref_pres, only: clim_modal_aero_top_lev + + ! dummy args + type(physics_state), intent(in) :: state ! Physics state variables + integer, intent(in) :: ncol + real(r8), intent(in) :: mmr(:,:,:) + real(r8), intent(in) :: pmid(:,:) + real(r8), intent(in) :: temp(:,:) + integer, intent(in) :: ltrop(:) ! tropopause level indices + type(physics_buffer_desc), pointer :: pbuf(:) + real(r8), intent(out) :: strato_sad(:,:) ! aerosol surface area density (cm2/cm3), zeroed below the tropopause + real(r8), intent(out) :: reff_strat(:,:) ! aerosol effective radius (cm), zeroed below the tropopause + + ! local vars + integer :: beglev(ncol) + integer :: endlev(ncol) + + beglev(:ncol) = clim_modal_aero_top_lev + endlev(:ncol) = ltrop(:ncol) + + call surf_area_dens( state, pbuf, ncol, mmr, beglev, endlev, strato_sad, reff_strat ) + + end subroutine aero_model_strat_surfarea + + !============================================================================= + !============================================================================= + subroutine aero_model_gasaerexch( state, loffset, ncol, lchnk, troplev, delt, reaction_rates, & + tfld, pmid, pdel, mbar, relhum, & + zm, qh2o, cwat, cldfr, cldnum, & + airdens, invariants, del_h2so4_gasprod, & + vmr0, vmr, pbuf ) + + use carma_aero_gasaerexch, only : carma_aero_gasaerexch_sub + use time_manager, only : get_nstep + !----------------------------------------------------------------------- + ! ... dummy arguments + !----------------------------------------------------------------------- + type(physics_state), intent(in) :: state ! Physics state variables + integer, intent(in) :: loffset ! offset applied to modal aero "pointers" + integer, intent(in) :: ncol ! number columns in chunk + integer, intent(in) :: lchnk ! chunk index + integer, intent(in) :: troplev(:) + real(r8), intent(in) :: delt ! time step size (sec) + real(r8), intent(in) :: reaction_rates(:,:,:) ! reaction rates + real(r8), intent(in) :: tfld(:,:) ! temperature (K) + real(r8), intent(in) :: pmid(:,:) ! pressure at model levels (Pa) + real(r8), intent(in) :: pdel(:,:) ! pressure thickness of levels (Pa) + real(r8), intent(in) :: mbar(:,:) ! mean wet atmospheric mass ( amu ) + real(r8), intent(in) :: relhum(:,:) ! relative humidity + real(r8), intent(in) :: airdens(:,:) ! total atms density (molec/cm**3) + real(r8), intent(in) :: invariants(:,:,:) + real(r8), intent(in) :: del_h2so4_gasprod(:,:) + real(r8), intent(in) :: zm(:,:) + real(r8), intent(in) :: qh2o(:,:) + real(r8), intent(in) :: cwat(:,:) ! cloud liquid water content (kg/kg) + real(r8), intent(in) :: cldfr(:,:) + real(r8), intent(in) :: cldnum(:,:) ! droplet number concentration (#/kg) + real(r8), intent(in) :: vmr0(:,:,:) ! initial mixing ratios (before gas-phase chem changes) + real(r8), intent(inout) :: vmr(:,:,:) ! mixing ratios ( vmr ) + + type(physics_buffer_desc), pointer :: pbuf(:) + + ! local vars + + integer :: n, m, mm + integer :: i,k,l + integer :: nstep + + type(ptr2d_t), allocatable :: raer(:) ! aerosol mass, number mixing ratios + type(ptr2d_t), allocatable :: qqcw(:) + + real(r8) :: del_h2so4_aeruptk(ncol,pver) + + !st real(r8), pointer :: dgnum(:,:,:), dgnumwet(:,:,:), wetdens(:,:,:) + real(r8), pointer :: pblh(:) ! pbl height (m) + + real(r8), dimension(ncol) :: wrk + character(len=32) :: name + real(r8) :: dvmrcwdt(ncol,pver,ncnst_tot) + real(r8) :: dvmrdt(ncol,pver,gas_pcnst) + real(r8) :: delta_so4mass(ncol,pver,ncnst_tot) + real(r8) :: wetr_n(pcols,pver,nbins) ! wet radius from CARMA for different bin + !st real(r8) :: vmrcw(ncol,pver,gas_pcnst) ! cloud-borne aerosol (vmr) + !st vmrcw is going only through CARMA aerosols (ncnst_tot) + real(r8) :: vmrcw(ncol,pver,ncnst_tot) ! cloud-borne aerosol (vmr) + real(r8) :: mmrcw(ncol,pver,ncnst_tot) ! cloud-borne aerosol (mmr) + real(r8) :: raervmr(ncol,pver,ncnst_tot) ! cloud-borne aerosol (vmr) + + real(r8) :: aqso4(ncol,ncnst_tot) ! aqueous phase chemistry + real(r8) :: aqh2so4(ncol,ncnst_tot) ! aqueous phase chemistry + real(r8) :: aqso4_h2o2(ncol) ! SO4 aqueous phase chemistry due to H2O2 + real(r8) :: aqso4_o3(ncol) ! SO4 aqueous phase chemistry due to O3 + real(r8) :: xphlwc(ncol,pver) ! pH value multiplied by lwc + real(r8) :: nh3_beg(ncol,pver) + real(r8) :: mw_carma(ncnst_tot) + real(r8), pointer :: fldcw(:,:) + real(r8), pointer :: sulfeq(:,:,:) + real(r8) :: wetr(pcols,pver) ! CARMA wet radius in cm + real(r8) :: wetrho(pcols,pver) ! CARMA wet dens + real(r8), allocatable :: rmass(:) ! CARMA rmass + + real(r8) :: old_total_mass + real(r8) :: new_total_mass + real(r8) :: old_total_number + + character(len=32) :: spectype + logical :: is_spcam_m2005 + + character(len=aero_name_len) :: bin_name, shortname + integer :: igroup, ibin, rc, nchr + character(len=*), parameter :: subname = 'aero_model_gasaerexch' + +! +! ... initialize nh3 +! + if ( nh3_ndx > 0 ) then + nh3_beg = vmr(1:ncol,:,nh3_ndx) + end if +! + is_spcam_m2005 = cam_physpkg_is('spcam_m2005') + + !st call pbuf_get_field(pbuf, dgnum_idx, dgnum) + !st call pbuf_get_field(pbuf, dgnumwet_idx, dgnumwet ) + !st call pbuf_get_field(pbuf, wetdens_ap_idx, wetdens ) + !st call pbuf_get_field(pbuf, pblh_idx, pblh) + + ! do gas-aerosol exchange (h2so4, msa, nh3 condensation) + + nstep = get_nstep() + + ! calculate tendency due to gas phase chemistry and processes + dvmrdt(:ncol,:,:) = (vmr(:ncol,:,:) - vmr0(:ncol,:,:)) / delt + do m = 1, gas_pcnst + wrk(:) = 0.0_r8 + do k = 1,pver + wrk(:ncol) = wrk(:ncol) + dvmrdt(:ncol,k,m)*adv_mass(m)/mbar(:ncol,k)*pdel(:ncol,k)/gravit + end do + name = 'GS_'//trim(solsym(m)) + call outfld( name, wrk(:ncol), ncol, lchnk ) + enddo + +! +! Aerosol processes ... +! + allocate( & + rmass(nbins), & + raer(ncnst_tot), & + qqcw(ncnst_tot) ) + + mw_carma(:) = 0.0_r8 + do m = 1, nbins ! main loop over aerosol bins + !st can we move this part to init??? + ! dryr is the dry bin radius + ! wetr is the dry bin radius + ! Note: taken here from CARMA pbuf field which may be not any more consistent with changed fields after carma was applied + ! Need to add new code that recalcuates dryr and wetr + ! get bin info + call rad_cnst_get_info_by_bin(0, m, nspec=nspec(m), bin_name=bin_name) + + nchr = len_trim(bin_name)-2 + shortname = bin_name(:nchr) + + call carma_get_group_by_name(shortname, igroup, rc) + if (rc/=0) then + call endrun(subname//': ERROR in carma_get_group_by_name') + end if + + read(bin_name(nchr+1:),*) ibin + + call carma_get_wet_radius(state, igroup, ibin, wetr, wetrho, rc) ! m + if (rc/=0) then + call endrun(subname//': ERROR in carma_get_wet_radius') + end if + wetr(:ncol,:) = wetr(:ncol,:) * 1.e2_r8 ! cm + + call carma_get_bin_rmass(igroup, ibin, rmass(m), rc) ! grams + if (rc/=0) then + call endrun(subname//': ERROR in carma_get_bin_rmass') + end if + + wetr_n(:,:,m) = wetr(:,:) + + ! Init pointers to mode number and specie mass mixing ratios in + ! intersitial and cloud borne phases. + do l = 1, nspec(m) + mm = bin_idx(m, l) + if (l <= nspec(m)) then + call rad_cnst_get_bin_props_by_idx(0, m, l,spectype=spectype) + call rad_cnst_get_bin_mmr_by_idx(0, m, l, 'a', state, pbuf, raer(mm)%fld) + call rad_cnst_get_bin_mmr_by_idx(0, m, l, 'c', state, pbuf, qqcw(mm)%fld) ! cloud-borne aerosol + if (trim(spectype) == 'sulfate') then + mw_carma(mm) = 96._r8 + end if + if (trim(spectype) == 'black-c') then + mw_carma(mm) = 12._r8 + end if + if (trim(spectype) == 'p-organic') then + mw_carma(mm) = 12._r8 + end if + if (trim(spectype) == 's-organic') then + mw_carma(mm) = 250._r8 + end if + if (trim(spectype) == 'dust') then + mw_carma(mm) = 12._r8 + end if + if (trim(spectype) == 'seasalt') then + mw_carma(mm) = 57._r8 + end if + end if + mmrcw(:ncol,:,mm) = qqcw(mm)%fld(:ncol,:) + vmrcw(:ncol,:,mm) = qqcw(mm)%fld(:ncol,:) + raervmr(:ncol,:,mm) = raer(mm)%fld(:ncol,:) + !write(iulog,*) 'qqcw(mm)%fld) ', qqcw(mm)%fld(:ncol,:) + end do + end do + !write(iulog,*) 'vmrcw(:,:,1) start', maxval(vmrcw(:ncol,:,1) ) + + !write(iulog,*) 'mm start vmrcw, raervmr' + ! qqcw2vrm is different from what is done in MAM, here we pass in the fields set by the qqcw and raer pointer + ! for all the CARMA aerosols, species, mmr, and number, vmrcw (kg/kg) -> vmr + call mmr2vmr_carma ( lchnk, vmrcw, mbar, mw_carma, ncol, loffset, rmass ) + !write(iulog,*) 'vmrcw(:,:,1) mmr', maxval(vmrcw(:,:,1)) + + if (.not. is_spcam_m2005) then ! regular CAM + dvmrdt(:ncol,:,:) = vmr(:ncol,:,:) ! all adveced species no aerosols + dvmrcwdt(:ncol,:,:) = vmrcw(:ncol,:,:) ! cloud borne carma aerosol species + ! aqueous chemistry ... + ! write(iulog,*) 'start has_sox' + + if( has_sox ) then + call setsox( state, & + pbuf, & + ncol, & + lchnk, & + loffset, & + delt, & + pmid, & + pdel, & + tfld, & + mbar, & + cwat, & + cldfr, & + cldnum, & + airdens, & + invariants, & + vmrcw, & + vmr, & + xphlwc, & + aqso4, & + aqh2so4, & + aqso4_h2o2, & + aqso4_o3 & + ) + + !write(iulog,*) 'done with has_sox' + do n = 1, nbins + do l = 1, nspec(n) ! not for total mass or number + mm = bin_idx(n, l) + call outfld( trim(fieldname_cw(mm))//'AQSO4', aqso4(:ncol,mm), ncol, lchnk) + call outfld( trim(fieldname_cw(mm))//'AQH2SO4', aqh2so4(:ncol,mm), ncol, lchnk) + end do + end do + + call outfld( 'AQSO4_H2O2', aqso4_h2o2(:ncol), ncol, lchnk) + call outfld( 'AQSO4_O3', aqso4_o3(:ncol), ncol, lchnk) + call outfld( 'XPH_LWC', xphlwc(:ncol,:), ncol, lchnk ) + + endif + +! Tendency due to aqueous chemistry + dvmrdt = (vmr - dvmrdt) / delt + dvmrcwdt = (vmrcw - dvmrcwdt) / delt + + do m = 1, gas_pcnst + wrk(:) = 0.0_r8 + do k = 1,pver + wrk(:ncol) = wrk(:ncol) + dvmrdt(:ncol,k,m) * adv_mass(m)/mbar(:ncol,k)*pdel(:ncol,k)/gravit + end do + name = 'AQ_'//trim(solsym(m)) + call outfld( name, wrk(:ncol), ncol, lchnk ) + enddo + + else if (is_spcam_m2005) then ! SPCAM ECPP +! when ECPP is used, aqueous chemistry is done in ECPP, +! and not updated here. +! Minghuai Wang, 2010-02 (Minghuai.Wang@pnl.gov) + + dvmrdt = 0.0_r8 + dvmrcwdt = 0.0_r8 + endif + +! do gas-aerosol exchange (h2so4, msa, nh3 condensation) + + if (h2so4_ndx > 0) then + del_h2so4_aeruptk(1:ncol,:) = vmr(1:ncol,:,h2so4_ndx) + else + del_h2so4_aeruptk(:,:) = 0.0_r8 + endif + + + !call t_startf('modal_gas-aer_exchng') + + !if ( sulfeq_idx>0 ) then + ! call pbuf_get_field( pbuf, sulfeq_idx, sulfeq ) + !else + ! nullify( sulfeq ) + !endif + !write(iulog,*) 'start carma_aero_gasaerexch_sub' + ! need to transform raer to raervmr from CARMA, routine requires vmr, note number wil not be changed here + call mmr2vmr_carma ( lchnk, raervmr, mbar, mw_carma, ncol, loffset, rmass) + !write(iulog,*) 'mm start raervmr done' + + call carma_aero_gasaerexch_sub( state, & + pbuf, lchnk, ncol, nstep, & + loffset, delt, mbar , & + tfld, pmid, pdel, & + qh2o, troplev, & + vmr, raervmr, & + wetr_n ) + + !if (h2so4_ndx > 0) then + ! del_h2so4_aeruptk(1:ncol,:) = vmr(1:ncol,:,h2so4_ndx) - del_h2so4_aeruptk(1:ncol,:) + !endif + + !call t_stopf('modal_gas-aer_exchng') + + + ! note vmr2qqcw does not change qqcw pointer (different than in MAM) + call vmr2mmr_carma ( lchnk, vmrcw, mbar, mw_carma, ncol, loffset, rmass ) + + !vmrcw in kg/kg + ! change pointer value for total mmr and number. In order to do this correctly + ! only mass has to be added to each bin (not number). This will require redistributing + ! mass to different bins. Here, we change both mass and number until we have a better + ! solution. + delta_so4mass(:,:,:) = 0.0_r8 + do m = 1, nbins + do l = 1, nspec(m) ! for sulfate only + mm = bin_idx(m, l) + ! sulfate mass that needs to be added to the total mass + call rad_cnst_get_bin_props_by_idx(0, m, l,spectype=spectype) + if (trim(spectype) == 'sulfate') then + ! only do loop if vmrcw has changed + do k=1,pver + do i=1,ncol + if (vmrcw(i,k,mm) .gt. mmrcw(i,k,mm) .and. mmrcw(i,k,mm) /= 0.0_r8) then + delta_so4mass(i,k,mm) = ( vmrcw(i,k,mm) - mmrcw(i,k,mm) ) + else + delta_so4mass(i,k,mm) = 0.0_r8 + end if + end do + end do + end if + end do + end do + + ! Is the loop here needed? + do m = 1, nbins + do l = 1, nspec(m) ! for sulfate only + mm = bin_idx(m, l) + qqcw(mm)%fld(:ncol,:) = vmrcw(:ncol,:,mm) + call outfld( trim(fieldname_cw(mm)), qqcw(mm)%fld(:ncol,:), ncol, lchnk) + end do + end do + + + end subroutine aero_model_gasaerexch + + !============================================================================= + !============================================================================= + subroutine aero_model_emissions( state, cam_in ) + + ! Arguments: + + type(physics_state), intent(in) :: state ! Physics state variables + type(cam_in_t), intent(inout) :: cam_in ! import state + + end subroutine aero_model_emissions + + + !=============================================================================== + !=============================================================================== + ! private methods + + + !============================================================================= + !============================================================================= + subroutine surf_area_dens( state, pbuf, ncol, mmr, beglev, endlev, sad, reff, sfc, dm_aer ) + use mo_constants, only: pi + use carma_intr, only: carma_effecitive_radius + + ! dummy args + type(physics_state), intent(in) :: state ! Physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) + integer, intent(in) :: ncol + real(r8), intent(in) :: mmr(:,:,:) + integer, intent(in) :: beglev(:) + integer, intent(in) :: endlev(:) + real(r8), intent(out) :: sad(:,:) ! bulk surface area density in cm2/cm3 from beglev to endlev, zero elsewhere + real(r8), intent(out) :: reff(:,:) ! bulk effective radius in cm from beglev to endlev, zero elsewhere + real(r8), optional, intent(out) :: sfc(:,:,:) ! surface area density per bin + real(r8), optional, intent(out) :: dm_aer(:,:,:) ! diameter per bin + + ! local vars + real(r8) :: reffaer(pcols,pver) ! bulk effective radius in cm + + real(r8), pointer, dimension(:,:) :: cmass,tmass ! carma element chemical and total mass + real(r8) :: sad_bin(pcols,pver,nbins) + integer :: err, icol, ilev, ibin, ispec !!, reff_pbf_ndx + real(r8) :: chm_mass, tot_mass + character(len=32) :: spectype + real(r8) :: wetr(pcols,pver) ! CARMA bin wet radius in cm + real(r8) :: wetrho(pcols,pver) ! CARMA bin wet density + real(r8) :: sad_carma(pcols,pver) ! CARMA bin wet surface area density in cm2/cm3 + real(r8), pointer :: aer_bin_mmr(:,:) + + character(len=aero_name_len) :: bin_name, shortname + integer :: igroup, indxbin, rc, nchr + + sad = 0._r8 + reff = 0._r8 + + ! + ! Compute surface aero for each bin. + ! Total over all bins as the surface area for chemical reactions. + ! + + reffaer = carma_effecitive_radius(state) + + sad = 0._r8 + sad_bin = 0._r8 + reff = 0._r8 + + do ibin=1,nbins ! loop over aerosol bins + call rad_cnst_get_info_by_bin(0, ibin, bin_name=bin_name) + + nchr = len_trim(bin_name)-2 + shortname = bin_name(:nchr) + + call carma_get_group_by_name(shortname, igroup, rc) + + read(bin_name(nchr+1:),*) indxbin + + call carma_get_wet_radius(state, igroup, indxbin, wetr, wetrho, rc) ! m + wetr(:ncol,:) = wetr(:ncol,:) * 1.e2_r8 ! cm + call carma_get_sad(state, igroup, indxbin, sad_carma, rc) + + if (present(dm_aer)) then + dm_aer(:ncol,:,ibin) = 2._r8 * wetr(:ncol,:) ! convert wet radius (cm) to wet diameter (cm) + endif + sad_bin(:ncol,:,ibin) = sad_carma(:ncol,:) ! cm^2/cm^3 + end do + + do icol = 1,ncol + do ilev = beglev(icol),endlev(icol) + do ibin=1,nbins ! loop over aerosol bins + ! + ! compute a mass weighting of the number + ! + tot_mass = 0._r8 + chm_mass = 0._r8 + do ispec=1,nspec(ibin) + + call rad_cnst_get_bin_mmr_by_idx(0, ibin, ispec, 'a', state, pbuf, aer_bin_mmr) + + tot_mass = tot_mass + aer_bin_mmr(icol,ilev) + + call rad_cnst_get_bin_props_by_idx(0, ibin, ispec, spectype=spectype) + + if ( trim(spectype) == 'sulfate' .or. & + trim(spectype) == 's-organic' .or. & + trim(spectype) == 'p-organic' .or. & + trim(spectype) == 'black-c' .or. & + trim(spectype) == 'ammonium') then + chm_mass = chm_mass + aer_bin_mmr(icol,ilev) + end if + + end do + if ( tot_mass > 0._r8 ) then + ! surface area density + sad_bin(icol,ilev,ibin) = chm_mass / tot_mass * sad_bin(icol,ilev,ibin) ! cm^2/cm^3 + else + sad_bin(icol,ilev,ibin) = 0._r8 + end if + end do + sad(icol,ilev) = sum(sad_bin(icol,ilev,:)) + reff(icol,ilev) = reffaer(icol,ilev) + + end do + end do + + if (present(sfc)) then + sfc(:,:,:) = sad_bin(:,:,:) + endif + + end subroutine surf_area_dens + +!!$ !=============================================================================== +!!$ !=============================================================================== +!!$ subroutine carma_aero_bcscavcoef_init ( pbuf2d ) +!!$ !----------------------------------------------------------------------- +!!$ ! +!!$ ! Purpose: +!!$ ! Computes lookup table for aerosol impaction/interception scavenging rates +!!$ ! +!!$ ! Authors: R. Easter +!!$ ! Simone Tilmes Nov 2021 +!!$ ! added modifications for bin model, assuming sigma = 1. +!!$ ! +!!$ !----------------------------------------------------------------------- +!!$ +!!$ use shr_kind_mod, only: r8 => shr_kind_r8 +!!$ use cam_abortutils, only: endrun +!!$ use mo_constants, only: pi +!!$ use ppgrid, only: begchunk +!!$ +!!$ implicit none +!!$ +!!$ type(physics_buffer_desc), pointer :: pbuf2d(:,:) +!!$ +!!$ ! local variables +!!$ integer nnfit_maxd +!!$ parameter (nnfit_maxd=27) +!!$ +!!$ integer m, i, l, jgrow, jdens, jpress, jtemp, nnfit +!!$ integer lunerr +!!$ +!!$ character(len=32) :: bin_name +!!$ character(len=32) :: spectype +!!$ +!!$ real(r8) dg0, dg0_cgs, press, dg0_base, & +!!$ rhodryaero, rhowetaero, rhowetaero_cgs, rmserr, & +!!$ scavratenum, scavratevol, sigmag, & +!!$ temp, wetdiaratio, wetvolratio +!!$ real(r8) :: specdens +!!$ real(r8) aafitnum(1), xxfitnum(1,nnfit_maxd), yyfitnum(nnfit_maxd) +!!$ real(r8) aafitvol(1), xxfitvol(1,nnfit_maxd), yyfitvol(nnfit_maxd) +!!$ +!!$ +!!$ allocate(scavimptblnum(nimptblgrow_mind:nimptblgrow_maxd, nbins)) +!!$ allocate(scavimptblvol(nimptblgrow_mind:nimptblgrow_maxd, nbins)) +!!$ +!!$ lunerr = iulog +!!$ dlndg_nimptblgrow = log( 1.25_r8 ) +!!$ +!!$ ! bin model: main loop over aerosol bins +!!$ +!!$ modeloop: do m = 1, nbins +!!$ !write(*,*) 'mloop start ',m +!!$ ! r(m) is the dry bin radius +!!$ ! taken here from CARMA pbuf field +!!$ ! get bin info +!!$ call rad_cnst_get_info_by_bin(0, m, bin_name=bin_name) +!!$ +!!$ ! for setting up the lookup table, use the dry density of the first +!!$ ! get specdens from sulfate (check) +!!$ do l = 1, nspec(m) +!!$ call aero_props%species_type(m,l, spectype) +!!$ if (trim(spectype) == 'sulfate') then +!!$ call aero_props%get(m,l,density=rhodryaero) +!!$ end if +!!$ end do +!!$ +!!$ dg0_base = 2._r8 * aero_props%scav_radius(m) +!!$ +!!$ !sigmag = sigmag_amode(mode) +!!$ !dg0_base = dcen_sect(m,n)*exp( -1.5*((log(sigmag))**2) ) +!!$ ! for bin approach sigma assumed to be 1., dg0_base equal dry radius +!!$ sigmag = 1._r8 +!!$ +!!$ +!!$ !st rhodryaero = specdens_amode(1,mode) +!!$ +!!$ growloop: do jgrow = nimptblgrow_mind, nimptblgrow_maxd +!!$ +!!$ wetdiaratio = exp( jgrow*dlndg_nimptblgrow ) +!!$ !dg0 = dgnum_amode(mode)*wetdiaratio +!!$ dg0 = dg0_base*wetdiaratio +!!$ !st write(*,*) 'm,l,dg0 ',m,l,dg0 +!!$ +!!$ wetvolratio = exp( jgrow*dlndg_nimptblgrow*3._r8 ) +!!$ rhowetaero = 1.0_r8 + (rhodryaero-1.0_r8)/wetvolratio +!!$ rhowetaero = min( rhowetaero, rhodryaero ) +!!$ +!!$ ! +!!$ ! compute impaction scavenging rates at 1 temp-press pair and save +!!$ ! +!!$ nnfit = 0 +!!$ +!!$ temp = 273.16_r8 +!!$ press = 0.75e6_r8 ! dynes/cm2 +!!$ rhowetaero = rhodryaero +!!$ +!!$ ! CARMA dry radius is in cm +!!$ !dg0_cgs = dg0*1.0e2_r8 ! m to cm +!!$ dg0_cgs = dg0 ! CARMA radius / diameter is already in cm +!!$ +!!$ rhowetaero_cgs = rhowetaero*1.0e-3_r8 ! kg/m3 to g/cm3 +!!$ +!!$ +!!$ call calc_1_impact_rate( & +!!$ dg0_cgs, sigmag, rhowetaero_cgs, temp, press, & +!!$ scavratenum, scavratevol, lunerr ) +!!$ +!!$ +!!$ nnfit = nnfit + 1 +!!$ if (nnfit > nnfit_maxd) then +!!$ write(lunerr,9110) +!!$ call endrun() +!!$ end if +!!$9110 format( '*** subr. carma_aero_bcscavcoef_init -- nnfit too big' ) +!!$ +!!$ xxfitnum(1,nnfit) = 1._r8 +!!$ yyfitnum(nnfit) = log( scavratenum ) +!!$ +!!$ xxfitvol(1,nnfit) = 1._r8 +!!$ yyfitvol(nnfit) = log( scavratevol ) +!!$ +!!$ ! +!!$ ! skip mlinfit stuff because scav table no longer has dependencies on +!!$ ! air temp, air press, and particle wet density +!!$ ! just load the log( scavrate--- ) values +!!$ ! +!!$ !! +!!$ !! do linear regression +!!$ !! log(scavrate) = a1 + a2*log(wetdens) +!!$ !! +!!$ ! call mlinft( xxfitnum, yyfitnum, aafitnum, nnfit, 1, 1, rmserr ) +!!$ ! call mlinft( xxfitvol, yyfitvol, aafitvol, nnfit, 1, 1, rmserr ) +!!$ ! +!!$ ! scavimptblnum(jgrow,mode) = aafitnum(1) +!!$ ! scavimptblvol(jgrow,mode) = aafitvol(1) +!!$ +!!$ !depends on both bins and different species +!!$ scavimptblnum(jgrow,m) = yyfitnum(1) +!!$ scavimptblvol(jgrow,m) = yyfitvol(1) +!!$ +!!$ enddo growloop +!!$ enddo modeloop +!!$ +!!$ return +!!$ end subroutine carma_aero_bcscavcoef_init +!!$ +!!$ !=============================================================================== +!!$ !=============================================================================== +!!$ +!!$ +!!$ !=============================================================================== +!!$ subroutine carma_aero_bcscavcoef_get( m, ncol, isprx, wetr, dryr, scavcoefnum, scavcoefvol, pbuf ) +!!$ ! need to go through both bins and species +!!$ ! need dry radius and wet radius +!!$ +!!$ !----------------------------------------------------------------------- +!!$ +!!$ use mo_constants, only: pi +!!$ +!!$ implicit none +!!$ +!!$ integer,intent(in) :: m, ncol +!!$ logical,intent(in):: isprx(pcols,pver) +!!$ ! wet radius per bin dgn_awet -> wetr +!!$ real(r8), intent(in) :: dryr(pcols,pver) +!!$ real(r8), intent(in) :: wetr(pcols,pver) +!!$ real(r8), intent(out) :: scavcoefnum(pcols,pver), scavcoefvol(pcols,pver) +!!$ type(physics_buffer_desc), pointer :: pbuf(:) +!!$ +!!$ integer i, k, jgrow, l +!!$ real(r8) dumdgratio, xgrow, dumfhi, dumflo, scavimpvol, scavimpnum, dg0_base, specdens, rhodryaero +!!$ +!!$ character(len=32) :: spectype +!!$ character(len=aero_name_len) :: bin_name, shortname +!!$ integer :: igroup, ibin, rc, nchr +!!$ +!!$ real(r8), allocatable :: rmass(:) ! CARMA rmass +!!$ character(len=*), parameter :: subname = 'carma_aero_bcscavcoef_get' +!!$ +!!$ allocate ( rmass(nbins) ) +!!$ ! bin model: main loop over aerosol bins +!!$ +!!$ ! get bin info +!!$ call rad_cnst_get_info_by_bin(0, m, bin_name=bin_name) +!!$ +!!$ nchr = len_trim(bin_name)-2 +!!$ shortname = bin_name(:nchr) +!!$ +!!$ call carma_get_group_by_name(shortname, igroup, rc) +!!$ +!!$ read(bin_name(nchr+1:),*) ibin +!!$ +!!$ call carma_get_bin_rmass(igroup, ibin, rmass(m), rc) +!!$ if (rc/=0) then +!!$ call endrun(subname//': ERROR in carma_get_bin_rmass') +!!$ end if +!!$ +!!$ ! get rmass and specdens for sulfate +!!$ do l = 1, nspec(m) +!!$ call rad_cnst_get_bin_props_by_idx(0, m, l,spectype=spectype, density_aer=specdens) +!!$ +!!$ ! chemical component of the aerosol type (which currently will be so4) +!!$ ! For CARMA, rmass per bin stays the same, while dry radius varies when the particle density varies +!!$ ! rmass = 4/3 * Pi * density * dry radius +!!$ ! We assume a fixed specie density +!!$ if (trim(spectype) == 'sulfate') then +!!$ rhodryaero = specdens +!!$ end if +!!$ end do +!!$ dg0_base = 2._r8 * (0.75_r8*rmass(m) / pi / (1.0e-3_r8*rhodryaero)) **(0.33_r8) ! specdens kg/m3 to g/cm3, convert from radiust to diameter +!!$ !rg0_base = (0.75_r8*rmass(m) / pi / (1.0e-3_r8*specdens)) **(0.33_r8) ! specdens kg/m3 to g/cm3 +!!$ +!!$ do k = 1, pver +!!$ do i = 1, ncol +!!$ +!!$ ! do only if no precip +!!$ if ( isprx(i,k) .and. dryr(i,k).gt.0._r8) then +!!$ ! +!!$ ! interpolate table values using log of (actual-wet-size)/(base-dry-size) +!!$ +!!$ ! dumdgratio = dgn_awet(i,k,m)/dgnum_amode(m) +!!$ ! dgnum_amode(m) is the rg0_base radius. +!!$ +!!$ dumdgratio = wetr(i,k)/dg0_base +!!$ +!!$ if ((dumdgratio >= 0.99_r8) .and. (dumdgratio <= 1.01_r8)) then +!!$ scavimpvol = scavimptblvol(0,m) +!!$ scavimpnum = scavimptblnum(0,m) +!!$ else +!!$ xgrow = log( dumdgratio ) / dlndg_nimptblgrow +!!$ jgrow = int( xgrow ) +!!$ if (xgrow < 0._r8) jgrow = jgrow - 1 +!!$ if (jgrow < nimptblgrow_mind) then +!!$ jgrow = nimptblgrow_mind +!!$ xgrow = jgrow +!!$ else +!!$ jgrow = min( jgrow, nimptblgrow_maxd-1 ) +!!$ end if +!!$ +!!$ dumfhi = xgrow - jgrow +!!$ dumflo = 1._r8 - dumfhi +!!$ +!!$ scavimpvol = dumflo*scavimptblvol(jgrow,m) + & +!!$ dumfhi*scavimptblvol(jgrow+1,m) +!!$ scavimpnum = dumflo*scavimptblnum(jgrow,m) + & +!!$ dumfhi*scavimptblnum(jgrow+1,m) +!!$ +!!$ end if +!!$ +!!$ ! impaction scavenging removal amount for volume +!!$ scavcoefvol(i,k) = exp( scavimpvol ) +!!$ ! impaction scavenging removal amount to number +!!$ scavcoefnum(i,k) = exp( scavimpnum ) +!!$ +!!$ ! scavcoef = impaction scav rate (1/h) for precip = 1 mm/h +!!$ ! scavcoef = impaction scav rate (1/s) for precip = pfx_inrain +!!$ ! (scavcoef/3600) = impaction scav rate (1/s) for precip = 1 mm/h +!!$ ! (pfx_inrain*3600) = in-rain-area precip rate (mm/h) +!!$ ! impactrate = (scavcoef/3600) * (pfx_inrain*3600) +!!$ else +!!$ scavcoefvol(i,k) = 0._r8 +!!$ scavcoefnum(i,k) = 0._r8 +!!$ end if +!!$ +!!$ end do +!!$ end do +!!$ +!!$ return +!!$ end subroutine carma_aero_bcscavcoef_get + + !=============================================================================== + subroutine calc_1_impact_rate( & + dg0, sigmag, rhoaero, temp, press, & + scavratenum, scavratevol, lunerr ) + ! + ! routine computes a single impaction scavenging rate + ! for precipitation rate of 1 mm/h + ! + ! dg0 = geometric mean diameter of aerosol number size distrib. (for CARMA it is the dry radius) (cm) + ! sigmag = geometric standard deviation of size distrib. + ! rhoaero = density of aerosol particles (g/cm^3) + ! temp = temperature (K) + ! press = pressure (dyne/cm^2) + ! scavratenum = number scavenging rate (1/h) + ! scavratevol = volume or mass scavenging rate (1/h) + ! lunerr = logical unit for error message + ! + use shr_kind_mod, only: r8 => shr_kind_r8 + use mo_constants, only: boltz_cgs, pi, rhowater => rhoh2o_cgs, & + gravity => gravity_cgs, rgas => rgas_cgs + + implicit none + + ! subr. parameters + integer lunerr + real(r8) dg0, sigmag, rhoaero, temp, press, scavratenum, scavratevol + + ! local variables + integer nrainsvmax + parameter (nrainsvmax=50) + real(r8) rrainsv(nrainsvmax), xnumrainsv(nrainsvmax),& + vfallrainsv(nrainsvmax) + + integer naerosvmax + parameter (naerosvmax=51) + real(r8) aaerosv(naerosvmax), & + ynumaerosv(naerosvmax), yvolaerosv(naerosvmax) + + integer i, ja, jr, na, nr + real(r8) a, aerodiffus, aeromass, ag0, airdynvisc, airkinvisc + real(r8) anumsum, avolsum, cair, chi + real(r8) d, dr, dum, dumfuchs, dx + real(r8) ebrown, eimpact, eintercept, etotal, freepath + real(r8) precip, precipmmhr, precipsum + real(r8) r, rainsweepout, reynolds, rhi, rhoair, rlo, rnumsum + real(r8) scavsumnum, scavsumnumbb + real(r8) scavsumvol, scavsumvolbb + real(r8) schmidt, sqrtreynolds, sstar, stokes, sx + real(r8) taurelax, vfall, vfallstp + real(r8) x, xg0, xg3, xhi, xlo, xmuwaterair + + + rlo = .005_r8 + rhi = .250_r8 + dr = 0.005_r8 + nr = 1 + nint( (rhi-rlo)/dr ) + if (nr > nrainsvmax) then + write(lunerr,9110) + call endrun() + end if + +9110 format( '*** subr. calc_1_impact_rate -- nr > nrainsvmax' ) + + precipmmhr = 1.0_r8 + precip = precipmmhr/36000._r8 + +! if dg0 the diameter, than ag0 equals the radius + ag0 = dg0/2._r8 + if (sigmag.ne.1._r8) then + sx = log( sigmag ) + xg0 = log( ag0 ) + xg3 = xg0 + 3._r8*sx*sx + + xlo = xg3 - 4._r8*sx + xhi = xg3 + 4._r8*sx + dx = 0.2_r8*sx + + dx = max( 0.2_r8*sx, 0.01_r8 ) + xlo = xg3 - max( 4._r8*sx, 2._r8*dx ) + xhi = xg3 + max( 4._r8*sx, 2._r8*dx ) + + na = 1 + nint( (xhi-xlo)/dx ) + if (na > naerosvmax) then + write(lunerr,9120) + call endrun() + end if + else + na = 1 + a = ag0 + end if + +9120 format( '*** subr. calc_1_impact_rate -- na > naerosvmax' ) + + ! air molar density + cair = press/(rgas*temp) + ! air mass density + rhoair = 28.966_r8*cair + ! molecular freepath + freepath = 2.8052e-10_r8/cair + ! air dynamic viscosity + airdynvisc = 1.8325e-4_r8 * (416.16_r8/(temp+120._r8)) * & + ((temp/296.16_r8)**1.5_r8) + ! air kinemaic viscosity + airkinvisc = airdynvisc/rhoair + ! ratio of water viscosity to air viscosity (from Slinn) + xmuwaterair = 60.0_r8 + + ! + ! compute rain drop number concentrations + ! rrainsv = raindrop radius (cm) + ! xnumrainsv = raindrop number concentration (#/cm^3) + ! (number in the bin, not number density) + ! vfallrainsv = fall velocity (cm/s) + ! + precipsum = 0._r8 + do i = 1, nr + r = rlo + (i-1)*dr + rrainsv(i) = r + xnumrainsv(i) = exp( -r/2.7e-2_r8 ) + + d = 2._r8*r + if (d <= 0.007_r8) then + vfallstp = 2.88e5_r8 * d**2._r8 + else if (d <= 0.025_r8) then + vfallstp = 2.8008e4_r8 * d**1.528_r8 + else if (d <= 0.1_r8) then + vfallstp = 4104.9_r8 * d**1.008_r8 + else if (d <= 0.25_r8) then + vfallstp = 1812.1_r8 * d**0.638_r8 + else + vfallstp = 1069.8_r8 * d**0.235_r8 + end if + + vfall = vfallstp * sqrt(1.204e-3_r8/rhoair) + vfallrainsv(i) = vfall + precipsum = precipsum + vfall*(r**3)*xnumrainsv(i) + end do + precipsum = precipsum*pi*1.333333_r8 + + rnumsum = 0._r8 + do i = 1, nr + xnumrainsv(i) = xnumrainsv(i)*(precip/precipsum) + rnumsum = rnumsum + xnumrainsv(i) + end do + + ! + ! compute aerosol concentrations + ! aaerosv = particle radius (cm) + ! fnumaerosv = fraction of total number in the bin (--) + ! fvolaerosv = fraction of total volume in the bin (--) + ! + + + anumsum = 0._r8 + avolsum = 0._r8 + ynumaerosv(:) = 1._r8 + yvolaerosv(:) = 1._r8 + aaerosv(:) = a + if (na.ne.1) then + do i = 1, na + x = xlo + (i-1)*dx + a = exp( x ) + aaerosv(i) = a + dum = (x - xg0)/sx + ynumaerosv(i) = exp( -0.5_r8*dum*dum ) + yvolaerosv(i) = ynumaerosv(i)*1.3333_r8*pi*a*a*a + anumsum = anumsum + ynumaerosv(i) + avolsum = avolsum + yvolaerosv(i) + end do + + do i = 1, na + ynumaerosv(i) = ynumaerosv(i)/anumsum + yvolaerosv(i) = yvolaerosv(i)/avolsum + end do + end if + + + ! + ! compute scavenging + ! + scavsumnum = 0._r8 + scavsumvol = 0._r8 + ! + ! outer loop for rain drop radius + ! + jr_loop: do jr = 1, nr + + r = rrainsv(jr) + vfall = vfallrainsv(jr) + + reynolds = r * vfall / airkinvisc + sqrtreynolds = sqrt( reynolds ) + + ! + ! inner loop for aerosol particle radius + ! + scavsumnumbb = 0._r8 + scavsumvolbb = 0._r8 + + ja_loop: do ja = 1, na + + a = aaerosv(ja) + + chi = a/r + + dum = freepath/a + dumfuchs = 1._r8 + 1.246_r8*dum + 0.42_r8*dum*exp(-0.87_r8/dum) + taurelax = 2._r8*rhoaero*a*a*dumfuchs/(9._r8*rhoair*airkinvisc) + + + aeromass = 4._r8*pi*a*a*a*rhoaero/3._r8 + aerodiffus = boltz_cgs*temp*taurelax/aeromass + + schmidt = airkinvisc/aerodiffus + stokes = vfall*taurelax/r + + ebrown = 4._r8*(1._r8 + 0.4_r8*sqrtreynolds*(schmidt**0.3333333_r8)) / & + (reynolds*schmidt) + + dum = (1._r8 + 2._r8*xmuwaterair*chi) / & + (1._r8 + xmuwaterair/sqrtreynolds) + eintercept = 4._r8*chi*(chi + dum) + + dum = log( 1._r8 + reynolds ) + sstar = (1.2_r8 + dum/12._r8) / (1._r8 + dum) + eimpact = 0._r8 + if (stokes > sstar) then + dum = stokes - sstar + eimpact = (dum/(dum+0.6666667_r8)) ** 1.5_r8 + end if + + etotal = ebrown + eintercept + eimpact + etotal = min( etotal, 1.0_r8 ) + + rainsweepout = xnumrainsv(jr)*4._r8*pi*r*r*vfall + + scavsumnumbb = scavsumnumbb + rainsweepout*etotal*ynumaerosv(ja) + scavsumvolbb = scavsumvolbb + rainsweepout*etotal*yvolaerosv(ja) + + enddo ja_loop + + scavsumnum = scavsumnum + scavsumnumbb + scavsumvol = scavsumvol + scavsumvolbb + + enddo jr_loop + + scavratenum = scavsumnum*3600._r8 + scavratevol = scavsumvol*3600._r8 + + return + end subroutine calc_1_impact_rate + + !============================================================================= + subroutine mmr2vmr_carma(lchnk, vmr, mbar, mw_carma, ncol, im, rmass) + !----------------------------------------------------------------- + ! ... Xfrom from mass to volume mixing ratio + !----------------------------------------------------------------- + + !st use chem_mods, only : adv_mass, gas_pcnst + + implicit none + + !----------------------------------------------------------------- + ! ... Dummy args + !----------------------------------------------------------------- + integer, intent(in) :: lchnk, ncol, im + real(r8), intent(in) :: mbar(ncol,pver) + real(r8), intent(in) :: rmass(nbins) + real(r8), intent(in) :: mw_carma(ncnst_tot) + real(r8), intent(inout) :: vmr(ncol,pver,ncnst_tot) + real(r8) :: vmr_total(ncol,pver) + + !----------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------- + integer :: k, m, mm, l + + do m = 1, nbins + vmr_total(:ncol,:) = 0._r8 + do l = 1, nspec(m) ! for each species, not total mmr or number, information of mw are missing + mm = bin_idx(m, l) + do k=1,pver + vmr(:ncol,k,mm) = mbar(:ncol,k) * vmr(:ncol,k,mm) / mw_carma(mm) + end do + vmr_total(:ncol,:) = vmr_total(:ncol,:) + vmr(:ncol,:,mm) + end do + end do + + end subroutine mmr2vmr_carma + !============================================================================= + + !============================================================================= + subroutine vmr2mmr_carma ( lchnk, vmr, mbar, mw_carma, ncol, im, rmass ) + !----------------------------------------------------------------- + ! ... Xfrom from volume to mass mixing ratio + !----------------------------------------------------------------- + + implicit none + + !----------------------------------------------------------------- + ! ... Dummy args + !----------------------------------------------------------------- + integer, intent(in) :: lchnk, ncol, im + real(r8), intent(in) :: mbar(ncol,pver) + real(r8), intent(in) :: rmass(nbins) + real(r8), intent(inout) :: vmr(ncol,pver,ncnst_tot) + real(r8), intent(in) :: mw_carma(ncnst_tot) + real(r8) :: vmr_total(ncol,pver) + + !----------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------- + integer :: k, m, mm, l + !----------------------------------------------------------------- + ! ... The non-group species + !----------------------------------------------------------------- + do m = 1, nbins + vmr_total(:ncol,:) = 0._r8 + do l = 1, nspec(m) ! for each species, not total mmr or number, information of mw are missing + mm = bin_idx(m, l) + do k=1,pver + vmr(:ncol,k,mm) = mw_carma(mm) * vmr(:ncol,k,mm) / mbar(:ncol,k) + end do + vmr_total(:ncol,:) = vmr_total(:ncol,:) + vmr(:ncol,:,mm) + end do + end do + + end subroutine vmr2mmr_carma + +end module aero_model diff --git a/src/chemistry/carma_aero/carma_aero_gasaerexch.F90 b/src/chemistry/carma_aero/carma_aero_gasaerexch.F90 new file mode 100644 index 0000000000..e78b9f9406 --- /dev/null +++ b/src/chemistry/carma_aero/carma_aero_gasaerexch.F90 @@ -0,0 +1,1117 @@ +!---------------------------------------------------------------------- +!---------------------------------------------------------------------- +!BOP +! +! !MODULE: carma_aero_gasaerexch --- does carma aerosol gas-aerosol exchange for SOA +! +! !INTERFACE: +module carma_aero_gasaerexch + +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + use chem_mods, only: gas_pcnst + use ref_pres, only: top_lev => clim_modal_aero_top_lev + use ppgrid, only: pcols, pver + use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_info_by_bin, rad_cnst_get_bin_props_by_idx, & + rad_cnst_get_info_by_bin_spec + use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_get_field + + implicit none + private + public :: carma_aero_gasaerexch_sub + public :: carma_aero_gasaerexch_init + + !PUBLIC DATA MEMBERS: + + ! description of bin aerosols + integer, public, protected :: nspec_max = 0 + integer, public, protected :: nbins = 0 + integer, public, protected :: nsoa_vbs = 0 + integer, public, protected :: nsoa = 0 + integer, public, protected :: npoa = 0 + integer, public, protected, allocatable :: nspec(:) + + ! Misc private data + character(len=32), allocatable :: fldname(:) ! names for interstitial output fields + character(len=32), allocatable :: fldname_cw(:) ! names for cloud_borne output fields + + ! local indexing for bins + integer, allocatable :: bin_idx(:,:) ! table for local indexing of modal aero number and mmr + integer :: ncnst_tot ! total number of mode number conc + mode species + + real(r8) :: mw_soa = 250._r8 + integer :: fracvbs_idx = -1 + integer, allocatable :: dqdtsoa_idx(:,:) + integer, allocatable :: cnsoa(:) ! true if soa gas is a species and carma soa in bin + integer, allocatable :: cnpoa(:) ! true if soa gas is a species and carma soa in bin + integer, allocatable :: l_soag(:) ! true if soa gas is a species and carma soa in bin + + logical, allocatable :: do_soag_any(:) ! true if soa gas is a species and carma soa in bin +! !DESCRIPTION: This module implements ... +! +! !REVISION HISTORY: +! +! RCE 07.04.13: Adapted from MIRAGE2 code +! +!EOP +!---------------------------------------------------------------------- +!BOC + +! list private module data here + +!EOC +!---------------------------------------------------------------------- + + +contains + +!---------------------------------------------------------------------- + + subroutine carma_aero_gasaerexch_init + +!----------------------------------------------------------------------- +! +! Purpose: +! gas-aerosol exchange SOAG <-> soa +! +! Author: Simone Tilmes +! +!----------------------------------------------------------------------- + + use cam_history, only: addfld, add_default, fieldname_len, horiz_only + use constituents, only: pcnst, cnst_name + use phys_control, only: phys_getopts + use mo_chem_utls, only: get_spc_ndx + +!----------------------------------------------------------------------- +! arguments + +!----------------------------------------------------------------------- +! local + integer :: j + integer :: i, ii + integer :: l + integer :: m + integer :: ns + character(len=fieldname_len+3) :: fieldname + character(len=32) :: spectype + character(len=32) :: spec_name + character(128) :: long_name + character(8) :: unit + character(len=2) :: outsoa + + logical :: history_aerosol ! Output the MAM aerosol tendencies + !----------------------------------------------------------------------- + + call phys_getopts( history_aerosol_out = history_aerosol ) + + ! + ! get info about the bin aerosols + ! get nbins + + call rad_cnst_get_info( 0, nbins=nbins) + + allocate( nspec(nbins) ) + allocate( cnsoa(nbins) ) + allocate( cnpoa(nbins) ) + + do m = 1, nbins + call rad_cnst_get_info_by_bin(0, m, nspec=nspec(m)) + end do + + nspec_max = maxval(nspec) + + ncnst_tot = nspec(1) + do m = 2, nbins + ncnst_tot = ncnst_tot + nspec(m) + end do + + allocate( bin_idx(nbins,nspec_max), & + do_soag_any(nbins), & + fldname_cw(ncnst_tot), & + fldname(ncnst_tot) ) + + ! Local indexing compresses the mode and number/mass indicies into one index. + ! This indexing is used by the pointer arrays used to reference state and pbuf + ! fields. + ! for CARMA we add number = 0, total mass = 1, and mass from each constituence into mm. + ii = 0 + do m = 1, nbins + do l = 1, nspec(m) ! do through nspec + ii = ii + 1 + bin_idx(m,l) = ii + end do + end do + + ! SOAG / SOA / POM information + ! Define number of VBS bins (nsoa) based on number of SOAG chemistry species + + nsoa_vbs = 0 + do i = 1, pcnst + if (cnst_name(i)(:4) == 'SOAG') then + nsoa_vbs = nsoa_vbs + 1 + end if + end do + allocate( l_soag(nsoa_vbs) ) + nsoa_vbs = 0 + do i = 1, pcnst + if (cnst_name(i)(:4) == 'SOAG') then + nsoa_vbs = nsoa_vbs + 1 + l_soag(nsoa_vbs) = get_spc_ndx(cnst_name(i)) + end if + end do + + fracvbs_idx = pbuf_get_index('FRACVBS') + + ! identify number of SOA and POA in CARMA code (CARMA number cn) + do m = 1, nbins + cnsoa(m) = 0 + cnpoa(m) = 0 + do l = 1, nspec(m) + call rad_cnst_get_bin_props_by_idx(0, m, l,spectype=spectype) + if (trim(spectype) == 's-organic') then + cnsoa(m) = cnsoa(m) + 1 + end if + if (trim(spectype) == 'p-organic') then + cnpoa(m) = cnpoa(m) + 1 + end if + end do + end do + ! some bins don't contain soa or poa + nsoa= maxval(cnsoa) + npoa= maxval(cnpoa) + + allocate( dqdtsoa_idx(nbins,nsoa) ) + do m = 1, nbins + ns = 0 + do l = 1, nspec(m) + call rad_cnst_get_bin_props_by_idx(0, m, l,spectype=spectype) + if (trim(spectype) == 's-organic') then + call rad_cnst_get_info_by_bin_spec(0, m, l, spec_name=spec_name) + ns = ns + 1 + dqdtsoa_idx(m,ns) = pbuf_get_index('DQDT_'//trim(spec_name)) + end if + end do + end do + + do m = 1, nbins + do_soag_any(m) = cnsoa(m)>0 + end do + +!---------define history fields for new cond/evap diagnostics---------------------------------------- + + fieldname=trim('qcon_gaex') + long_name = trim('3D fields for SOA condensation') + unit = 'kg/kg/s' + call addfld(fieldname, (/'lev'/), 'A', unit, long_name ) + if ( history_aerosol ) then + call add_default( fieldname, 1, ' ' ) + endif + + do j = 1, nsoa_vbs + write (outsoa, "(I2.2)") j + fieldname = 'qcon_gaex'//outsoa + long_name = '3D fields for SOA condensation for VBS bin'//outsoa + call addfld(fieldname, (/'lev'/), 'A', unit, long_name ) + if ( history_aerosol ) then + call add_default( fieldname, 1, ' ' ) + endif + fieldname = 'qevap_gaex'//outsoa + long_name = '3D fields for SOA evaporation for VBS bin'//outsoa + call addfld(fieldname, (/'lev'/), 'A', unit, long_name ) + if ( history_aerosol ) then + call add_default( fieldname, 1, ' ' ) + endif + end do + + fieldname=trim('qevap_gaex') + long_name = trim('3D fields for SOA evaporation') + call addfld(fieldname, (/'lev'/), 'A', unit, long_name ) + if ( history_aerosol ) then + call add_default( fieldname, 1, ' ' ) + endif + +!------------------------------------------------------------------------------ + +! define history fields for basic gas-aer exchange + do m = 1, nbins + do l = 1, nspec(m) ! do through nspec + ii = bin_idx(m,l) + if (l <= nspec(m) ) then ! species + call rad_cnst_get_info_by_bin_spec(0, m, l, spec_name=fldname(ii) ) + ! only write out SOA exchange here + call rad_cnst_get_bin_props_by_idx(0, m, l,spectype=spectype) + if (trim(spectype) == 's-organic') then + fieldname= trim(fldname(ii)) // '_sfgaex1' + long_name = trim(fldname(ii)) // ' gas-aerosol-exchange primary column tendency' + unit = 'kg/m2/s' + call addfld( fieldname, horiz_only, 'A', unit, long_name ) + if ( history_aerosol ) then + call add_default( fieldname, 1, ' ' ) + endif + end if + end if + end do + + write(fieldname,'("WETRAD_bin",I2.2)') m + write(long_name,'("bin ",I2.2," wet radius in carma_aero_gasaerexch")') m + + call addfld(fieldname, (/'lev'/), 'A', 'cm', long_name ) + if ( history_aerosol ) then + call add_default( fieldname, 1, ' ' ) + endif + + write(fieldname,'("UPTKRATE_bin",I2.2)') m + write(long_name,'("bin ",I2.2," up take rate in carma_aero_gasaerexch")') m + + call addfld(fieldname, (/'lev'/), 'A', 'sec-1', long_name ) + if ( history_aerosol ) then + call add_default( fieldname, 1, ' ' ) + endif + + write(fieldname,'("NUMDENS_bin",I2.2)') m + write(long_name,'("bin ",I2.2," number density carma_aero_gasaerexch")') m + + call addfld(fieldname, (/'lev'/), 'A', 'm-3', long_name ) + if ( history_aerosol ) then + call add_default( fieldname, 1, ' ' ) + endif + + end do + + fieldname=trim('UPTKRATE') + long_name = trim('total uptake rate in carma_aero_gasaerexch') + call addfld(fieldname, (/'lev'/), 'A', 'sec-1', long_name ) + if ( history_aerosol ) then + call add_default( fieldname, 1, ' ' ) + endif + + + end subroutine carma_aero_gasaerexch_init + + +!---------------------------------------------------------------------- + +!---------------------------------------------------------------------- +!---------------------------------------------------------------------- +!BOP +! !ROUTINE: carma_aero_gasaerexch_sub --- ... +! +! !INTERFACE: +subroutine carma_aero_gasaerexch_sub( state, & + pbuf, lchnk, ncol, nstep, & + loffset, deltat, mbar, & + t, pmid, pdel, & + qh2o, troplev, & + q, raervmr, & + wetr_n ) + + ! !USES: + use cam_history, only: outfld, fieldname_len + use physconst, only: gravit, mwdry + use cam_abortutils, only: endrun + use time_manager, only: is_first_step + use carma_aerosol_state_mod, only: carma_aerosol_state + use physics_types, only: physics_state + use physconst, only: mwdry, rair + +! !PARAMETERS: + type(physics_state), target, intent(in) :: state ! Physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) + + integer, intent(in) :: lchnk ! chunk identifier + integer, intent(in) :: ncol ! number of atmospheric column + integer, intent(in) :: nstep ! model time-step number + integer, intent(in) :: loffset ! offset applied to modal aero "ptrs" + integer, intent(in) :: troplev(pcols) ! tropopause vertical index + real(r8), intent(in) :: deltat ! time step (s) + real(r8), intent(in) :: mbar(ncol,pver) ! mean wet atmospheric mass ( amu ) + + real(r8), intent(inout) :: q(ncol,pver,gas_pcnst) ! tracer mixing ratio (TMR) array + ! *** MUST BE #/kmol-air for number + ! *** MUST BE mol/mol-air for mass + ! *** NOTE ncol dimension + real(r8), intent(in) :: raervmr (ncol,pver,ncnst_tot) ! aerosol mixing rations (vmr) + real(r8), intent(in) :: t(pcols,pver) ! temperature at model levels (K) + real(r8), intent(in) :: pmid(pcols,pver) ! pressure at model levels (Pa) + real(r8), intent(in) :: pdel(pcols,pver) ! pressure thickness of levels (Pa) + real(r8), intent(in) :: qh2o(pcols,pver) ! water vapor mixing ratio (kg/kg) + real(r8), intent(in) :: wetr_n(pcols,pver,nbins) !wet geo. mean dia. (cm) of number distrib. + +! !DESCRIPTION: +! this version does only do condensation for SOA for CARMA +! method_soa=0 is no uptake +! method_soa=1 is irreversible uptake done like h2so4 uptake +! method_soa=2 is reversible uptake using subr carma_aero_soaexch +! +! !REVISION HISTORY: +! RCE 07.04.13: Adapted from MIRAGE2 code +! +!EOP +!---------------------------------------------------------------------- +!BOC + +! local variables + integer, parameter :: ldiag1=-1, ldiag2=-1, ldiag3=-1, ldiag4=-1 + integer, parameter :: method_soa = 2 + + real (r8), parameter :: mw_poa_host = 12.0_r8 ! molec wght of poa used in host code + real (r8), parameter :: mw_soa_host = 250.0_r8 ! molec wght of soa used in host code + + integer :: i + integer :: j, jsoa + integer :: k + integer :: l + integer :: mm, m, n, nn, niter, niter_max + + character(len=fieldname_len+3) :: fieldname + character(len=32) :: spectype + character(len=2) :: outsoa + + real (r8) :: avg_uprt_soa(nsoa_vbs) + real (r8) :: deltatxx + real (r8) :: dqdt_soa_vbs(nbins,nsoa_vbs) + real (r8) :: dqdt_soa_all(pcols,pver,nbins,nsoa) + real (r8) :: dqdt_soag(nsoa_vbs) + real (r8) :: fgain_soa(nbins,nsoa_vbs) + real (r8) :: pdel_fac + real (r8) :: num_bin(pcols,pver,nbins) + real (r8) :: soa_vbs(pcols,pver,nbins,nsoa_vbs) + real (r8) :: soa_c(pcols,pver,nbins,nsoa) ! SOA from CARMA + real (r8) :: poa_c(pcols,pver,nbins,npoa) ! POA from CARMA + real (r8) :: qold_poa(nbins,npoa) ! POA from CARMA old + real (r8) :: qold_soa(nbins,nsoa_vbs) ! SOA on VBS bins old + real (r8) :: qnew_soa_vbs(nbins,nsoa_vbs) ! SOA on VBS bins new + real (r8) :: qnew_soa(nbins) ! SOA new for combined VBS bin new for combined VBS binss + real (r8) :: qold_soag(nsoa_vbs) + real (r8) :: sum_dqdt_soa(nsoa_vbs) ! sum_dqdt_soa = soa tendency from soa gas uptake (mol/mol/s) + real (r8) :: sum_uprt_soa(nsoa_vbs) ! total soa uptake rate over all bin, for each soa vbs bin + real (r8) :: uptkrate(pcols,pver,nbins) + real (r8) :: uptkrate_all(pcols,pver) + real (r8) :: uptkratebb(nbins) + real (r8) :: uptkrate_soa(nbins,nsoa_vbs) + ! gas-to-aerosol mass transfer rates (1/s) + + integer, parameter :: nsrflx = 1 ! only one dimension of qsrflx, no renaming or changes in size for CARMA currently + real(r8) :: dqdt(ncol,pver,gas_pcnst) ! TMR "delta q" array - NOTE dims + real(r8) :: qsrflx(pcols,nbins,nsoa) + ! process-specific column tracer tendencies + ! (1=gas condensation) + real(r8) :: qcon_vbs(pcols,pver,nsoa_vbs) + real(r8) :: qevap_vbs(pcols,pver,nsoa_vbs) + real(r8) :: qcon(pcols,pver) + real(r8) :: qevap(pcols,pver) + real(r8) :: total_soag + real(r8) :: soag(nsoa_vbs) + + real(r8), pointer :: frac_vbs(:,:,:,:) ! fraction of vbs SOA bins to total SOA + real(r8), pointer :: dqdt_soa(:,:) + + real(r8) :: rhoair(pcols,pver) + real(r8), pointer :: nmr(:,:) + type(carma_aerosol_state), pointer :: aero_state + +!---------------------------------------------------------------------- + aero_state => carma_aerosol_state(state, pbuf) + +! map CARMA soa to working soa(nbins,nsoa) + + call pbuf_get_field(pbuf, fracvbs_idx, frac_vbs) + + num_bin(:,:,:) = 0._r8 + soa_c(:,:,:,:) = 0._r8 + poa_c(:,:,:,:) = 0._r8 + + rhoair(:ncol,:) = pmid(:ncol,:)/(rair*t(:ncol,:)) ! (kg-air/m3) + + do m = 1, nbins ! main loop over aerosol bins + if (do_soag_any(m)) then ! only bins that contain soa + n = 0 + nn = 0 + do l = 1, nspec(m) + mm = bin_idx(m, l) + call rad_cnst_get_bin_props_by_idx(0, m, l, spectype=spectype) + if (trim(spectype) == 's-organic') then + n = n + 1 + soa_c(:ncol,:,m,n) = raervmr(:ncol,:,mm) + end if + if (trim(spectype) == 'p-organic') then + nn = nn + 1 + poa_c(:ncol,:,m,nn) = raervmr(:ncol,:,mm) + end if + end do + if (npoa .gt. 1) then + call endrun( 'carma_aero_gasaerexch_sub error: CARMA currently only supports 1 POA element' ) + end if + + if (nsoa_vbs.eq.nsoa) then + soa_vbs(:ncol,:,:,:) = soa_c(:ncol,:,:,:) + else + if (nsoa.eq.1) then + if (is_first_step()) then + !first time step initialization only + do k=top_lev,pver + do i=1,ncol + total_soag = 0.0_r8 + do j = 1, nsoa_vbs + soag(j) = q(i,k,l_soag(j)) + total_soag = total_soag + soag(j) + end do + if (total_soag .gt. 0.0_r8) then + do j= 1, nsoa_vbs + frac_vbs(i,k,m,j) = soag(j)/total_soag + end do + end if + end do + end do + end if + ! end first time step, after that use fraction from previous time step + do k=top_lev,pver + do i=1,ncol + do j= 1, nsoa_vbs + soa_vbs(i,k,m,j) = frac_vbs(i,k,m,j)*soa_c(i,k,m,nsoa) + end do + end do + end do + else + ! error message this code only works if SOAG and SOA CARMA have the same number of species, + ! or if SOA CARMA has only one species. + call endrun( 'carma_aero_gasaerexch_sub error in number of SOA species' ) + end if + + end if + + ! get bin number densities for all aerosols + call aero_state%get_ambient_num(m,nmr) ! #/kg + num_bin(:ncol,:,m) = nmr(:ncol,:)*rhoair(:ncol,:) ! #/m3 + + end if + end do + + +! SOA will be updated in CARMA + +! zero out tendencies and other + dqdt(:,:,:) = 0.0_r8 + qsrflx(:,:,:) = 0.0_r8 + +!-------Initialize evap/cond diagnostics (ncols x pver)----------- + qcon_vbs(:,:,:) = 0.0_r8 + qevap_vbs(:,:,:) = 0.0_r8 + qcon(:,:) = 0.0_r8 + qevap(:,:) = 0.0_r8 +!--------------------------------------------------- +! compute gas-to-aerosol mass transfer rates +! check if only number is needed for this calculatuion! + call gas_aer_uptkrates( ncol, loffset, & + num_bin, t, pmid, & + wetr_n, uptkrate ) + + do m = 1, nbins + + write(fieldname,'("NUMDENS_bin",I2.2)') m + call outfld(fieldname, num_bin(:ncol,:,m), ncol, lchnk ) + + write(fieldname,'("WETRAD_bin",I2.2)') m + call outfld(fieldname, wetr_n(:ncol,:,m), ncol, lchnk ) + + write(fieldname,'("UPTKRATE_bin",I2.2)') m + call outfld(fieldname, uptkrate(:ncol,:,m), ncol, lchnk ) + + uptkrate_all(:ncol,:) = uptkrate_all(:ncol,:) + uptkrate(:ncol,:,m) + end do + + fieldname = trim('UPTKRATE') + call outfld(fieldname, uptkrate_all(:ncol,:), ncol, lchnk ) + +! use this for tendency calcs to avoid generating very small negative values + deltatxx = deltat * (1.0_r8 + 1.0e-15_r8) + + dqdt_soa_all(:,:,:,:) = 0.0_r8 + do k=top_lev,pver + do i=1,ncol + sum_uprt_soa(:) = 0.0_r8 + uptkrate_soa(:,:) = 0.0_r8 + do n = 1, nbins + if (do_soag_any(n)) then ! only bins that contain soa + uptkratebb(n) = uptkrate(i,k,n) + if (npoa .gt. 0) then + do j = 1, npoa + qold_poa(n,j) = poa_c(i,k,n,j) + end do + else + qold_poa(n,j) = 0.0_r8 + end if + do jsoa = 1, nsoa_vbs + ! 0.81 factor is for gas diffusivity (soa/h2so4) + ! (differences in fuch-sutugin and accom coef ignored) + fgain_soa(n,jsoa) = uptkratebb(n)*0.81_r8 + uptkrate_soa(n,jsoa) = fgain_soa(n,jsoa) + sum_uprt_soa(jsoa) = sum_uprt_soa(jsoa) + fgain_soa(n,jsoa) + qold_soa(n,jsoa) = soa_vbs(i,k,n,jsoa) + end do + else + qold_poa(n,:) = 0.0_r8 + qold_soa(n,:) = 0.0_r8 + fgain_soa(n,:) = 0.0_r8 + end if + end do ! n + + do jsoa = 1, nsoa_vbs + if (sum_uprt_soa(jsoa) > 0.0_r8) then + do n = 1, nbins + if (do_soag_any(n)) then ! only bins that contain soa + fgain_soa(n,jsoa) = fgain_soa(n,jsoa) / sum_uprt_soa(jsoa) + end if + end do + end if + end do + +! uptake amount (fraction of gas uptaken) over deltat + do jsoa = 1, nsoa_vbs + avg_uprt_soa(jsoa) = (1.0_r8 - exp(-deltatxx*sum_uprt_soa(jsoa)))/deltatxx + end do + +! sum_dqdt_soa = soa_a tendency from soa gas uptake (mol/mol/s) + + do jsoa = 1, nsoa_vbs + sum_dqdt_soa(jsoa) = q(i,k,l_soag(jsoa)) * avg_uprt_soa(jsoa) + end do + + if (method_soa > 1) then +! compute TMR tendencies for soag and soa interstial aerosol +! using soa parameterization + niter_max = 1000 + dqdt_soa_vbs(:,:) = 0.0_r8 + dqdt_soag(:) = 0.0_r8 + do jsoa = 1, nsoa_vbs + qold_soag(jsoa) = q(i,k,l_soag(jsoa)) + end do + + call carma_aero_soaexch( deltat, t(i,k), pmid(i,k), & + niter, niter_max, nbins, nsoa_vbs, npoa, & + mw_poa_host, mw_soa_host, & + qold_soag, qold_soa, qold_poa, uptkrate_soa, & + dqdt_soag, dqdt_soa_vbs ) + + sum_dqdt_soa(:) = -dqdt_soag(:) + + else if ( method_soa .eq. 1) then +! compute TMR tendencies for soa interstial aerosol +! due to simple gas uptake + + do n = 1, nbins + if (do_soag_any(n) ) then + do jsoa = 1, nsoa_vbs + dqdt_soa_vbs(n,jsoa) = fgain_soa(n,jsoa)*sum_dqdt_soa(jsoa) + end do + end if + end do + + end if + + ! update soa to calcuate fractions (state variables and pbuf is not updated for SOA, will be done in CARMA) + pdel_fac = pdel(i,k)/gravit + qnew_soa(:) =0.0_r8 + qnew_soa_vbs(:,:) =0.0_r8 + + do n = 1, nbins + if ( do_soag_any(n) ) then + if (nsoa.eq.nsoa_vbs) then + do jsoa = 1, nsoa_vbs + qsrflx(i,n,jsoa) = qsrflx(i,n,jsoa) + dqdt_soa_vbs(n,jsoa)*pdel_fac + dqdt_soa_all(i,k,n,jsoa) = dqdt_soa_vbs(n,jsoa) ! sum up for different volatility bins + end do + else if (nsoa.eq.1) then + do jsoa = 1, nsoa_vbs + ! sum up for different volatility bins + dqdt_soa_all(i,k,n,nsoa) = dqdt_soa_all(i,k,n,nsoa) + dqdt_soa_vbs(n,jsoa) + end do + do jsoa = 1, nsoa_vbs + qsrflx(i,n,nsoa) = qsrflx(i,n,nsoa) + dqdt_soa_vbs(n,jsoa)*pdel_fac + qnew_soa_vbs(n,jsoa) = qold_soa(n,jsoa) + dqdt_soa_vbs(n,jsoa)*deltat + qnew_soa(n) = qnew_soa(n) + qnew_soa_vbs(n,jsoa) ! derive new fraction of SOA bin contributions + end do + do jsoa = 1, nsoa_vbs + if (qnew_soa(n) .gt. 0.0_r8) then + frac_vbs(i,k,n,jsoa) = qnew_soa_vbs(n,jsoa) / qnew_soa(n) + end if + end do + else + call endrun( 'carma_aero_gasaerexch_sub error' ) + end if + +!------- Add code for condensation/evaporation diagnostics sum of all bin--- + do jsoa = 1, nsoa_vbs + if (dqdt_soa_vbs(n,jsoa).ge.0.0_r8) then + qcon_vbs(i,k,jsoa)=qcon_vbs(i,k,jsoa) + dqdt_soa_vbs(n,jsoa)*(mw_soa/mwdry) + qcon(i,k)=qcon(i,k)+dqdt_soa_vbs(n,jsoa)*(mw_soa/mwdry) + else if (dqdt_soa_vbs(n,jsoa).lt.0.0_r8) then + qevap_vbs(i,k,jsoa)=qevap_vbs(i,k,jsoa) + dqdt_soa_vbs(n,jsoa)*(mw_soa/mwdry) + qevap(i,k)=qevap(i,k)+dqdt_soa_vbs(n,jsoa)*(mw_soa/mwdry) + endif + end do +!--------------------------------------------------------------------------------------------------------------------- + end if + end do ! n + +! compute TMR tendencies for SAOG gas +! due to simple gas uptake + do jsoa = 1, nsoa + dqdt(i,k,l_soag(jsoa)) = -sum_dqdt_soa(jsoa) + end do + + end do ! "i = 1, ncol" + end do ! "k = top_lev, pver" + +! This applies dqdt tendencies for SOAG only , soa is done in CARMA +! apply the dqdt to update q +! + do jsoa = 1, nsoa_vbs + do k = top_lev, pver + do i = 1, ncol + q(i,k,l_soag(jsoa)) = max (q(i,k,l_soag(jsoa)) + dqdt(i,k,l_soag(jsoa))*deltat, 1.0e-40_r8) + end do + end do + end do + + + !-----Outfld for condensation/evaporation------------------------------ + call outfld(trim('qcon_gaex'), qcon(:,:), pcols, lchnk ) + call outfld(trim('qevap_gaex'), qevap(:,:), pcols, lchnk ) + do jsoa = 1, nsoa_vbs + write (outsoa, "(I2.2)") jsoa + call outfld(trim('qcon_gaex')//outsoa, qcon_vbs(:,:,jsoa), pcols, lchnk ) + call outfld(trim('qevap_gaex')//outsoa, qevap_vbs(:,:,jsoa), pcols, lchnk ) + end do + !----------------------------------------------------------------------- + ! do history file of column-tendency fields over SOA fields (as defined in CARMA) and set pointer + do m = 1, nbins + if (do_soag_any(m)) then + j = 0 + do l = 1, nspec(m) + mm = bin_idx(m,l) + call rad_cnst_get_bin_props_by_idx(0, m, l,spectype=spectype) + if (trim(spectype) == 's-organic') then + j = j + 1 + fieldname= trim(fldname(mm)) // '_sfgaex1' + do i = 1, ncol + qsrflx(i,m,j) = qsrflx(i,m,j)*(mw_soa/mwdry) + end do + call outfld( fieldname, qsrflx(:,m,j), pcols, lchnk ) + + !set pointer field + call pbuf_get_field(pbuf, dqdtsoa_idx(m,j), dqdt_soa ) + + dqdt_soa(:ncol,:) = dqdt_soa_all(:ncol,:,m,j) *(mw_soa/mbar(:ncol,:)) + end if + end do ! l = ... + end if + end do ! m = ... + +end subroutine carma_aero_gasaerexch_sub + + +!---------------------------------------------------------------------- +!---------------------------------------------------------------------- +subroutine gas_aer_uptkrates( ncol, loffset, & + num_bin, t, pmid, & + wetr, uptkrate ) + +! +! / +! computes uptkrate = | dx dN/dx gas_conden_rate(Dp(x)) +! / +! using Gauss-Hermite quadrature of order nghq=2 +! +! Dp = particle diameter (cm) +! x = ln(Dp) +! dN/dx = log-normal particle number density distribution +! gas_conden_rate(Dp) = 2 * pi * gasdiffus * Dp * F(Kn,ac) +! F(Kn,ac) = Fuchs-Sutugin correction factor +! Kn = Knudsen number +! ac = accomodation coefficient +! + + integer, intent(in) :: ncol ! number of atmospheric column + integer, intent(in) :: loffset + real(r8), intent(in) :: t(pcols,pver) ! Temperature in Kelvin + real(r8), intent(in) :: pmid(pcols,pver) ! Air pressure in Pa + real(r8), intent(in) :: wetr(pcols,pver,nbins) + real(r8), intent(in) :: num_bin(pcols,pver,nbins) + + real(r8), intent(out) :: uptkrate(pcols,pver,nbins) + ! gas-to-aerosol mass transfer rates (1/s) + + +! local + integer, parameter :: nghq = 2 + integer :: i, k, n + + ! Can use sqrt here once Lahey is gone. + real(r8), parameter :: tworootpi = 3.5449077_r8 + real(r8), parameter :: root2 = 1.4142135_r8 + real(r8), parameter :: beta = 2.0_r8 + + real(r8) :: const + real(r8) :: dp + real(r8) :: gasdiffus, gasspeed + real(r8) :: freepathx2, fuchs_sutugin + real(r8) :: knudsen + + ! initialize to zero + uptkrate(:,:,:) = 0.0_r8 + +! outermost loop over all bins + do n = 1, nbins + +! loops k and i + do k=top_lev,pver + do i=1,ncol + if (wetr(i,k,n) .gt. 0.0_r8) then + +! gasdiffus = h2so4 gas diffusivity from mosaic code (m^2/s) +! (pmid must be Pa) + gasdiffus = 0.557e-4_r8 * (t(i,k)**1.75_r8) / pmid(i,k) +! gasspeed = h2so4 gas mean molecular speed from mosaic code (m/s) + gasspeed = 1.470e1_r8 * sqrt(t(i,k)) +! freepathx2 = 2 * (h2so4 mean free path) (m) + freepathx2 = 6.0_r8*gasdiffus/gasspeed + dp = wetr(i,k,n) * 1.e-2 ! meters + const = tworootpi * num_bin(i,k,n) * 2.0_r8 * dp + ! gas_conden_rate(Dp) = const * gasdiffus * F(Kn,ac) + ! knudsen number + knudsen = freepathx2/dp + fuchs_sutugin = (0.4875_r8*(1._r8 + knudsen)) / & + (knudsen*(1.184_r8 + knudsen) + 0.4875_r8) + uptkrate(i,k,n) = const * gasdiffus * fuchs_sutugin + + else + uptkrate(i,k,n) = 0.0_r8 + end if + + end do ! "do i = 1, ncol" + end do ! "do k = 1, pver" + + end do ! "do n = 1, nbins" + +end subroutine gas_aer_uptkrates + +!---------------------------------------------------------------------- +subroutine carma_aero_soaexch( dtfull, temp, pres, & + niter, niter_max, nbins, ntot_soaspec, ntot_poaspec, & + mw_poa_host, mw_soa_host, & + g_soa_in, a_soa_in, a_poa_in, xferrate_in, & + g_soa_tend, a_soa_tend ) + +!----------------------------------------------------------------------- +! +! Purpose: +! +! calculates condensation/evaporation of "soa gas" +! to/from multiple aerosol modes in 1 grid cell +! +! key assumptions +! (1) ambient equilibrium vapor pressure of soa gas +! is given by p0_soa_298 and delh_vap_soa +! (2) equilibrium vapor pressure of soa gas at aerosol +! particle surface is given by raoults law in the form +! g_star = g0_soa*[a_soa/(a_soa + a_opoa)] +! (3) (oxidized poa)/(total poa) is equal to frac_opoa (constant) +! +! +! Author: R. Easter and R. Zaveri +! Additions to run with multiple BC, SOA and POM's: Shrivastava et al., 2015 +!----------------------------------------------------------------------- + + use mo_constants, only: rgas ! Gas constant (J/K/mol) + + real(r8), intent(in) :: dtfull ! full integration time step (s) + real(r8), intent(in) :: temp ! air temperature (K) + real(r8), intent(in) :: pres ! air pressure (Pa) + integer, intent(out) :: niter ! number of iterations performed + integer, intent(in) :: niter_max ! max allowed number of iterations + integer, intent(in) :: nbins ! number of bins + integer, intent(in) :: ntot_poaspec ! number of poa species + integer, intent(in) :: ntot_soaspec ! number of soa species + real(r8), intent(in) :: mw_poa_host ! molec wght of poa used in host code + real(r8), intent(in) :: mw_soa_host ! molec wght of soa used in host code + real(r8), intent(in) :: g_soa_in(ntot_soaspec) ! initial soa gas mixrat (mol/mol at host mw) + real(r8), intent(in) :: a_soa_in(nbins,ntot_soaspec) ! initial soa aerosol mixrat (mol/mol at host mw) + real(r8), intent(in) :: a_poa_in(nbins,ntot_poaspec) ! initial poa aerosol mixrat (mol/mol at host mw) + real(r8), intent(in) :: xferrate_in(nbins,ntot_soaspec) ! gas-aerosol mass transfer rate (1/s) + real(r8), intent(out) :: g_soa_tend(ntot_soaspec) ! soa gas mixrat tendency (mol/mol/s at host mw) + real(r8), intent(out) :: a_soa_tend(nbins,ntot_soaspec) ! soa aerosol mixrat tendency (mol/mol/s at host mw) + + integer :: ll + integer :: m + + logical :: skip_soamode(nbins) ! true if this bin does not have soa + + real(r8), parameter :: a_min1 = 1.0e-40_r8 + real(r8), parameter :: g_min1 = 1.0e-40_r8 + real(r8), parameter :: alpha = 0.05_r8 ! parameter used in calc of time step + real(r8), parameter :: dtsub_fixed = -1.0_r8 ! fixed sub-step for time integration (s) + + real(r8) :: a_ooa_sum_tmp(nbins) ! total ooa (=soa+opoa) in a bin + real(r8) :: a_opoa(nbins) ! oxidized-poa aerosol mixrat (mol/mol at actual mw) + real(r8) :: a_soa(nbins,ntot_soaspec) ! soa aerosol mixrat (mol/mol at actual mw) + real(r8) :: a_soa_tmp(nbins,ntot_soaspec) ! temporary soa aerosol mixrat (mol/mol) + real(r8) :: beta(nbins,ntot_soaspec) ! dtcur*xferrate + real(r8) :: delh_vap_soa(ntot_soaspec) ! delh_vap_soa = heat of vaporization for gas soa (J/mol) + real(r8) :: del_g_soa_tmp(ntot_soaspec) + real(r8) :: dtcur ! current time step (s) + real(r8) :: dtmax ! = (dtfull-tcur) + real(r8) :: g0_soa(ntot_soaspec) ! ambient soa gas equilib mixrat (mol/mol at actual mw) + real(r8) :: g_soa(ntot_soaspec) ! soa gas mixrat (mol/mol at actual mw) + real(r8) :: g_star(nbins,ntot_soaspec) ! soa gas mixrat that is in equilib + ! with each aerosol mode (mol/mol) + real(r8) :: mw_poa ! actual molec wght of poa + real(r8) :: mw_soa ! actual molec wght of soa + real(r8) :: opoa_frac(ntot_poaspec) ! fraction of poa that is opoa + real(r8) :: phi(nbins,ntot_soaspec) ! "relative driving force" + real(r8) :: p0_soa(ntot_soaspec) ! soa gas equilib vapor presssure (atm) + real(r8) :: p0_soa_298(ntot_soaspec) ! p0_soa_298 = soa gas equilib vapor presssure (atm) at 298 k + real(r8) :: sat(nbins,ntot_soaspec) ! sat(m,ll) = g0_soa(ll)/a_ooa_sum_tmp(m) = g_star(m,ll)/a_soa(m,ll) + ! used by the numerical integration scheme -- it is not a saturation rato! + real(r8) :: tcur ! current integration time (from 0 s) + real(r8) :: tmpa, tmpb, tmpf + real(r8) :: tot_soa(ntot_soaspec) ! g_soa + sum( a_soa(:) ) + real(r8) :: xferrate(nbins,ntot_soaspec) ! gas-aerosol mass transfer rate (1/s) + +! Changed by Manish Shrivastava + opoa_frac(:) = 0.0_r8 !POA does not form solution with SOA for all runs; set opoa_frac=0.0_r8 by Manish Shrivastava + mw_poa = 250.0_r8 + mw_soa = 250.0_r8 + + ! New SOA properties added by Manish Shrivastava on 09/27/2012 + if (ntot_soaspec ==1) then + p0_soa_298(:) = 1.0e-12_r8 + delh_vap_soa(:) = 156.0e3_r8 + opoa_frac(:) = 0.0_r8 + elseif (ntot_soaspec ==2) then + ! same for anthropogenic and biomass burning species + p0_soa_298 (1) = 1.0e-10_r8 + p0_soa_298 (2) = 1.0e-10_r8 + delh_vap_soa(:) = 156.0e3_r8 + elseif(ntot_soaspec ==5) then + ! 5 volatility bins for each of the a combined SOA classes ( including biomass burning, fossil fuel, biogenic) + p0_soa_298 (1) = 9.7831E-13_r8 !soaff0 C*=0.01ug/m3 + p0_soa_298 (2) = 9.7831E-12_r8 !soaff1 C*=0.10ug/m3 + p0_soa_298 (3) = 9.7831E-11_r8 !soaff2 C*=1.0ug/m3 + p0_soa_298 (4) = 9.7831E-10_r8 !soaff3 C*=10.0ug/m3 + p0_soa_298 (5) = 9.7831E-9_r8 !soaff4 C*=100.0ug/m3 + + delh_vap_soa(1) = 153.0e3_r8 + delh_vap_soa(2) = 142.0e3_r8 + delh_vap_soa(3) = 131.0e3_r8 + delh_vap_soa(4) = 120.0e3_r8 + delh_vap_soa(5) = 109.0e3_r8 + elseif(ntot_soaspec ==15) then + ! + ! 5 volatility bins for each of the 3 SOA classes ( biomass burning, fossil fuel, biogenic) + ! SOA species 1-5 are for anthropogenic while 6-10 are for biomass burning SOA + ! SOA species 11-15 are for biogenic SOA, based on Cappa et al., Reference needs to be updated + ! For MW=250.0 + p0_soa_298 (1) = 9.7831E-13_r8 !soaff0 C*=0.01ug/m3 + p0_soa_298 (2) = 9.7831E-12_r8 !soaff1 C*=0.10ug/m3 + p0_soa_298 (3) = 9.7831E-11_r8 !soaff2 C*=1.0ug/m3 + p0_soa_298 (4) = 9.7831E-10_r8 !soaff3 C*=10.0ug/m3 + p0_soa_298 (5) = 9.7831E-9_r8 !soaff4 C*=100.0ug/m3 + p0_soa_298 (6) = 9.7831E-13_r8 !soabb0 C*=0.01ug/m3 + p0_soa_298 (7) = 9.7831E-12_r8 !soabb1 C*=0.10ug/m3 + p0_soa_298 (8) = 9.7831E-11_r8 !soabb2 C*=1.0ug/m3 + p0_soa_298 (9) = 9.7831E-10_r8 !soabb3 C*=10.0ug/m3 + p0_soa_298 (10) = 9.7831E-9_r8 !soabb4 C*=100.0ug/m3 + p0_soa_298 (11) = 9.7831E-13_r8 !soabg0 C*=0.01ug/m3 + p0_soa_298 (12) = 9.7831E-12_r8 !soabg1 C*=0.1ug/m3 + p0_soa_298 (13) = 9.7831E-11_r8 !soabg2 C*=1.0ug/m3 + p0_soa_298 (14) = 9.7831E-10_r8 !soabg3 C*=10.0ug/m3 + p0_soa_298 (15) = 9.7831E-9_r8 !soabg4 C*=100.0ug/m3 + + ! + ! have to be adjusted to 15 species, following the numbers by Epstein et al., 2012 + ! + delh_vap_soa(1) = 153.0e3_r8 + delh_vap_soa(2) = 142.0e3_r8 + delh_vap_soa(3) = 131.0e3_r8 + delh_vap_soa(4) = 120.0e3_r8 + delh_vap_soa(5) = 109.0e3_r8 + delh_vap_soa(6) = 153.0e3_r8 + delh_vap_soa(7) = 142.0e3_r8 + delh_vap_soa(8) = 131.0e3_r8 + delh_vap_soa(9) = 120.0e3_r8 + delh_vap_soa(10) = 109.0e3_r8 + delh_vap_soa(11) = 153.0e3_r8 + delh_vap_soa(12) = 142.0e3_r8 + delh_vap_soa(13) = 131.0e3_r8 + delh_vap_soa(14) = 120.0e3_r8 + delh_vap_soa(15) = 109.0e3_r8 + endif + + !BSINGH - Initialized g_soa_tend and a_soa_tend to circumvent the undefined behavior (04/16/12) + g_soa_tend(:) = 0.0_r8 + a_soa_tend(:,:) = 0.0_r8 + xferrate(:,:) = 0.0_r8 + + ! determine which modes have non-zero transfer rates + ! and are involved in the soa gas-aerosol transfer + ! for diameter = 1 nm and number = 1 #/cm3, xferrate ~= 1e-9 s-1 + do m = 1, nbins + if (do_soag_any(m)) then + skip_soamode(m) = .false. + do ll = 1, ntot_soaspec + xferrate(m,ll) = xferrate_in(m,ll) + end do + else + skip_soamode(m) = .true. + end if + end do + + ! convert incoming mixing ratios from mol/mol at the "host-code" molec. weight (12.0 in cam5) + ! to mol/mol at the "actual" molec. weight (currently assumed to be 250.0) + ! also + ! force things to be non-negative + ! calc tot_soa(ll) + ! calc a_opoa (always slightly >0) + do ll = 1, ntot_soaspec + tmpf = mw_soa_host/mw_soa + g_soa(ll) = max( g_soa_in(ll), 0.0_r8 ) * tmpf + tot_soa(ll) = g_soa(ll) + do m = 1, nbins + if ( skip_soamode(m) ) cycle + a_soa(m,ll) = max( a_soa_in(m,ll), 0.0_r8 ) * tmpf + tot_soa(ll) = tot_soa(ll) + a_soa(m,ll) + end do + end do + + + tmpf = mw_poa_host/mw_poa + do m = 1, nbins + if ( skip_soamode(m) ) cycle + a_opoa(m) = 0.0_r8 + !check since it seems like in the modal approach there is a bug, not summing up the values for each specie + do ll = 1, ntot_poaspec + tmpf = mw_poa_host/mw_poa + a_opoa(m) = a_opoa(m) + opoa_frac(ll)*a_poa_in(m,ll) + a_opoa(m) = max( a_opoa(m), 1.0e-40_r8 ) ! force to small non-zero value + end do + end do + + ! calc ambient equilibrium soa gas + do ll = 1, ntot_soaspec + p0_soa(ll) = p0_soa_298(ll) * & + exp( -(delh_vap_soa(ll)/rgas)*((1.0_r8/temp)-(1.0_r8/298.0_r8)) ) + g0_soa(ll) = 1.01325e5_r8*p0_soa(ll)/pres + end do + + ! IF mw of soa EQ 12 (as in the MAM3 default case), this has to be in + ! should actully talk the mw from the chemistry mechanism and substitute with 12.0 + + niter = 0 + tcur = 0.0_r8 + dtcur = 0.0_r8 + phi(:,:) = 0.0_r8 + g_star(:,:) = 0.0_r8 + +! integration loop -- does multiple substeps to reach dtfull + time_loop: do while (tcur < dtfull-1.0e-3_r8 ) + + niter = niter + 1 + if (niter > niter_max) exit + + tmpa = 0.0_r8 ! time integration parameter for all soa species + do m = 1, nbins + if ( skip_soamode(m) ) cycle + a_ooa_sum_tmp(m) = sum( a_soa(m,1:ntot_soaspec) ) + end do + do ll = 1, ntot_soaspec + tmpb = 0.0_r8 ! time integration parameter for a single soa species + do m = 1, nbins + if ( skip_soamode(m) ) cycle + sat(m,ll) = g0_soa(ll)/max( a_ooa_sum_tmp(m), a_min1 ) + g_star(m,ll) = sat(m,ll)*a_soa(m,ll) + phi(m,ll) = (g_soa(ll) - g_star(m,ll))/max( g_soa(ll), g_star(m,ll), g_min1 ) + tmpb = tmpb + xferrate(m,ll)*abs(phi(m,ll)) + end do + tmpa = max( tmpa, tmpb ) + end do + + if (dtsub_fixed > 0.0_r8) then + dtcur = dtsub_fixed + tcur = tcur + dtcur + else + dtmax = dtfull-tcur + if (dtmax*tmpa <= alpha) then +! here alpha/tmpa >= dtmax, so this is final substep + dtcur = dtmax + tcur = dtfull + else + dtcur = alpha/tmpa + tcur = tcur + dtcur + end if + end if + +! step 1 - for modes where soa is condensing, estimate "new" a_soa(m,ll) +! using an explicit calculation with "old" g_soa +! and g_star(m,ll) calculated using "old" a_soa(m,ll) +! do this to get better estimate of "new" a_soa(m,ll) and sat(m,ll) + do m = 1, nbins + if ( skip_soamode(m) ) cycle + do ll = 1, ntot_soaspec + ! first ll loop calcs a_soa_tmp(m,ll) & a_ooa_sum_tmp + a_soa_tmp(m,ll) = a_soa(m,ll) + beta(m,ll) = dtcur*xferrate(m,ll) + del_g_soa_tmp(ll) = g_soa(ll) - g_star(m,ll) + if (del_g_soa_tmp(ll) > 0.0_r8) then + a_soa_tmp(m,ll) = a_soa(m,ll) + beta(m,ll)*del_g_soa_tmp(ll) + end if + end do + a_ooa_sum_tmp(m) = sum( a_soa_tmp(m,1:ntot_soaspec) ) + do ll = 1, ntot_soaspec + ! second ll loop calcs sat & g_star + if (del_g_soa_tmp(ll) > 0.0_r8) then + sat(m,ll) = g0_soa(ll)/max( a_ooa_sum_tmp(m), a_min1 ) + g_star(m,ll) = sat(m,ll)*a_soa_tmp(m,ll) ! this just needed for diagnostics + end if + end do + end do + +! step 2 - implicit in g_soa and semi-implicit in a_soa, +! with g_star(m,ll) calculated semi-implicitly + do ll = 1, ntot_soaspec + tmpa = 0.0_r8 + tmpb = 0.0_r8 + do m = 1, nbins + if ( skip_soamode(m) ) cycle + tmpa = tmpa + a_soa(m,ll)/(1.0_r8 + beta(m,ll)*sat(m,ll)) + tmpb = tmpb + beta(m,ll)/(1.0_r8 + beta(m,ll)*sat(m,ll)) + end do + + g_soa(ll) = (tot_soa(ll) - tmpa)/(1.0_r8 + tmpb) + g_soa(ll) = max( 0.0_r8, g_soa(ll) ) + do m = 1, nbins + if ( skip_soamode(m) ) cycle + a_soa(m,ll) = (a_soa(m,ll) + beta(m,ll)*g_soa(ll))/ & + (1.0_r8 + beta(m,ll)*sat(m,ll)) + end do + end do + + end do time_loop + +! calculate outgoing tendencies (at the host-code molec. weight) +! (a_soa & g_soa are at actual mw, but a_soa_in & g_soa_in are at host-code mw) + do ll = 1, ntot_soaspec + tmpf = mw_soa/mw_soa_host + g_soa_tend(ll) = (g_soa(ll)*tmpf - g_soa_in(ll))/dtfull + do m = 1, nbins + if ( skip_soamode(m) ) cycle + a_soa_tend(m,ll) = (a_soa(m,ll)*tmpf - a_soa_in(m,ll))/dtfull + end do + end do + +end subroutine carma_aero_soaexch + +!---------------------------------------------------------------------- + +end module carma_aero_gasaerexch diff --git a/src/chemistry/carma_aero/dust_model.F90 b/src/chemistry/carma_aero/dust_model.F90 new file mode 100644 index 0000000000..3939d5192e --- /dev/null +++ b/src/chemistry/carma_aero/dust_model.F90 @@ -0,0 +1,20 @@ +!=============================================================================== +! Dust for CARMA Aerosol Model +!=============================================================================== +module dust_model + use shr_kind_mod, only: r8 => shr_kind_r8, cl => shr_kind_cl + use spmd_utils, only: masterproc + use cam_abortutils, only: endrun + + implicit none + private + + public :: dust_names + public :: dust_nbin + + integer, parameter :: dust_nbin = 4 + + character(len=6), parameter :: dust_names(dust_nbin) & + = (/'NULL01', 'NULL02', 'NULL03', 'NULL04'/) + +end module dust_model diff --git a/src/chemistry/carma_aero/seasalt_model.F90 b/src/chemistry/carma_aero/seasalt_model.F90 new file mode 100644 index 0000000000..93b9e42c34 --- /dev/null +++ b/src/chemistry/carma_aero/seasalt_model.F90 @@ -0,0 +1,19 @@ +!=============================================================================== +! Seasalt for CARMA Aerosol Model +!=============================================================================== +module seasalt_model + use shr_kind_mod, only: r8 => shr_kind_r8, cl => shr_kind_cl + use ppgrid, only: pcols, pver + + implicit none + private + + public :: seasalt_names + public :: seasalt_nbin + + integer, parameter :: seasalt_nbin = 4 + + character(len=6), parameter :: seasalt_names(seasalt_nbin) & + = (/'NULL01', 'NULL02', 'NULL03', 'NULL04'/) + +end module seasalt_model diff --git a/src/chemistry/carma_aero/sox_cldaero_mod.F90 b/src/chemistry/carma_aero/sox_cldaero_mod.F90 new file mode 100644 index 0000000000..385e121424 --- /dev/null +++ b/src/chemistry/carma_aero/sox_cldaero_mod.F90 @@ -0,0 +1,528 @@ +!---------------------------------------------------------------------------------- +! CARMA implementation +!---------------------------------------------------------------------------------- +module sox_cldaero_mod + + use physics_buffer, only : physics_buffer_desc, pbuf_get_index, pbuf_get_field, dtype_r8 + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_abortutils, only : endrun + use ppgrid, only : pcols, pver + use mo_chem_utls, only : get_spc_ndx + use cldaero_mod, only : cldaero_conc_t, cldaero_allocate, cldaero_deallocate + use cam_logfile, only : iulog + !st use modal_aero_data, only : ntot_amode, modeptr_accum, lptr_so4_cw_amode, lptr_msa_cw_amode + !st use modal_aero_data, only : numptrcw_amode, lptr_nh4_cw_amode + !st use modal_aero_data, only : cnst_name_cw, specmw_so4_amode + use chem_mods, only : adv_mass + use physconst, only : gravit + use phys_control, only : phys_getopts + use cldaero_mod, only : cldaero_uptakerate + use chem_mods, only : gas_pcnst + use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_info_by_bin, rad_cnst_get_bin_props_by_idx +use spmd_utils, only: masterproc + + implicit none + private + + public :: sox_cldaero_init + public :: sox_cldaero_create_obj + public :: sox_cldaero_update + public :: sox_cldaero_destroy_obj + + integer :: id_msa, id_h2so4, id_so2, id_h2o2, id_nh3 + + real(r8), parameter :: small_value = 1.e-20_r8 + + ! description of bin aerosols + integer, public, protected :: nspec_max = 0 + integer, public, protected :: nbins = 0 + integer, public, protected, allocatable :: nspec(:) + + ! local indexing for bins + integer, allocatable :: bin_idx(:,:) ! table for local indexing of modal aero number and mmr + integer :: ncnst_tot ! total number of mode number conc + mode species + +contains + +!---------------------------------------------------------------------------------- +!---------------------------------------------------------------------------------- + + subroutine sox_cldaero_init + + integer :: l, m, mm, ii + logical :: history_aerosol ! Output the MAM aerosol tendencies + + id_msa = get_spc_ndx( 'MSA' ) + id_h2so4 = get_spc_ndx( 'H2SO4' ) + id_so2 = get_spc_ndx( 'SO2' ) + id_h2o2 = get_spc_ndx( 'H2O2' ) + id_nh3 = get_spc_ndx( 'NH3' ) + + if (id_h2so4<1 .or. id_so2<1 .or. id_h2o2<1) then + call endrun('sox_cldaero_init:MAM mech does not include necessary species' & + //' -- should not invoke sox_cldaero_mod ') + endif + + call phys_getopts( history_aerosol_out = history_aerosol ) + ! + ! add to history + ! + + ! get info about the modal aerosols + ! get nbins + + call rad_cnst_get_info( 0, nbins=nbins) + + allocate( nspec(nbins) ) + + do m = 1, nbins + call rad_cnst_get_info_by_bin(0, m, nspec=nspec(m)) + end do + ! add plus one to include number, total mmr and nspec + nspec_max = maxval(nspec) + + ncnst_tot = nspec(1) + do m = 2, nbins + ncnst_tot = ncnst_tot + nspec(m) + end do + + allocate( bin_idx(nbins,nspec_max) ) + + + ! Local indexing compresses the mode and number/mass indicies into one index. + ! This indexing is used by the pointer arrays used to reference state and pbuf + ! fields. + ! for CARMA we add number = 0, total mass = 1, and mass from each constituence into mm. + ii = 0 + do m = 1, nbins + do l = 1, nspec(m) ! loop through species + ii = ii + 1 + bin_idx(m,l) = ii + end do + end do + + + end subroutine sox_cldaero_init + +!---------------------------------------------------------------------------------- +!---------------------------------------------------------------------------------- + function sox_cldaero_create_obj(cldfrc, qcw, lwc, cfact, ncol, loffset) result( conc_obj ) + + real(r8), intent(in) :: cldfrc(:,:) + real(r8), intent(in) :: qcw(:,:,:) + real(r8), intent(in) :: lwc(:,:) + real(r8), intent(in) :: cfact(:,:) + integer, intent(in) :: ncol + integer, intent(in) :: loffset + + real(r8) :: so4mmr(pcols,pver) + real(r8) :: nitmmr(pcols,pver) + + type(cldaero_conc_t), pointer :: conc_obj + + character(len=32) :: spectype + + integer :: l,n,m + integer :: i,k,mm + + ! local indexing for bins + !integer, allocatable :: bin_idx(:,:) ! table for local indexing of modal aero number and mmr + + + conc_obj => cldaero_allocate() + + do k = 1,pver + do i = 1,ncol + if( cldfrc(i,k) >0._r8) then + conc_obj%xlwc(i,k) = lwc(i,k) *cfact(i,k) ! cloud water L(water)/L(air) + conc_obj%xlwc(i,k) = conc_obj%xlwc(i,k) / cldfrc(i,k) ! liquid water in the cloudy fraction of cell + else + conc_obj%xlwc(i,k) = 0._r8 + endif + enddo + enddo + + conc_obj%no3c(:,:) = 0._r8 + conc_obj%nh4c(:,:) = 0._r8 + conc_obj%so4c(:,:) = 0._r8 + + so4mmr(:,:) = 0._r8 + do k = 1,pver + do i = 1,ncol + do m = 1, nbins + do l = 1, nspec(m) + mm = bin_idx(m, l) + call rad_cnst_get_bin_props_by_idx(0, m, l,spectype=spectype) + if (trim(spectype) == 'sulfate') then + so4mmr(i,k) = so4mmr(i,k) + qcw(i,k,mm) + end if + end do + end do + end do + end do + conc_obj%so4c = so4mmr + + end function sox_cldaero_create_obj + + +!---------------------------------------------------------------------------------- +! Update the mixing ratios +!---------------------------------------------------------------------------------- + subroutine sox_cldaero_update( state, & + pbuf, ncol, lchnk, loffset, dtime, mbar, pdel, press, tfld, cldnum, cldfrc, cfact, xlwc, & + delso4_hprxn, xh2so4, xso4, xso4_init, nh3g, hno3g, xnh3, xhno3, xnh4c, xno3c, xmsa, xso2, xh2o2, qcw, qin, & + aqso4, aqh2so4, aqso4_h2o2, aqso4_o3, aqso4_h2o2_3d, aqso4_o3_3d) + + use aerosol_properties_mod, only: aero_name_len + use physics_types, only: physics_state + use carma_intr, only: carma_get_group_by_name, carma_get_dry_radius + + ! args + + type(physics_state), intent(in) :: state ! Physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) + integer, intent(in) :: ncol + integer, intent(in) :: lchnk ! chunk id + integer, intent(in) :: loffset + + real(r8), intent(in) :: dtime ! time step (sec) + + real(r8), intent(in) :: mbar(:,:) ! mean wet atmospheric mass ( amu ) + real(r8), intent(in) :: pdel(:,:) + real(r8), intent(in) :: press(:,:) + real(r8), intent(in) :: tfld(:,:) + + real(r8), intent(in) :: cldnum(:,:) + real(r8), intent(in) :: cldfrc(:,:) + real(r8), intent(in) :: cfact(:,:) + real(r8), intent(in) :: xlwc(:,:) + + real(r8), intent(in) :: delso4_hprxn(:,:) + real(r8), intent(in) :: xh2so4(:,:) + real(r8), intent(in) :: xso4(:,:) + real(r8), intent(in) :: xso4_init(:,:) + real(r8), intent(in) :: nh3g(:,:) + real(r8), intent(in) :: hno3g(:,:) + real(r8), intent(in) :: xnh3(:,:) + real(r8), intent(in) :: xhno3(:,:) + real(r8), intent(in) :: xnh4c(:,:) + real(r8), intent(in) :: xmsa(:,:) + real(r8), intent(in) :: xso2(:,:) + real(r8), intent(in) :: xh2o2(:,:) + real(r8), intent(in) :: xno3c(:,:) + + real(r8), intent(inout) :: qcw(:,:,:) ! cloud-borne aerosol (vmr) vmrcw(ncol,pver,ncnst_tot) + real(r8), intent(inout) :: qin(:,:,:) ! xported species ( vmr ) + + real(r8), intent(out) :: aqso4(:,:) ! aqueous phase chemistry + real(r8), intent(out) :: aqh2so4(:,:) ! aqueous phase chemistry + real(r8), intent(out) :: aqso4_h2o2(:) ! SO4 aqueous phase chemistry due to H2O2 (kg/m2) + real(r8), intent(out) :: aqso4_o3(:) ! SO4 aqueous phase chemistry due to O3 (kg/m2) + real(r8), intent(out), optional :: aqso4_h2o2_3d(:,:) ! SO4 aqueous phase chemistry due to H2O2 (kg/m2) + real(r8), intent(out), optional :: aqso4_o3_3d(:,:) ! SO4 aqueous phase chemistry due to O3 (kg/m2) + + ! local vars ... + real(r8) :: dryr(pcols,pver) ! CARMA dry radius in cm + real(r8) :: rho(pcols,pver) ! + real(r8) :: dryr_n(nbins,ncol,pver) ! CARMA dry radius in cm + real(r8) :: dqdt_aqso4(ncol,pver,ncnst_tot), & + dqdt_aqh2so4(ncol,pver,ncnst_tot), & + dqdt_aqhprxn(ncol,pver), dqdt_aqo3rxn(ncol,pver), & + sflx(1:ncol) + + real(r8) :: faqgain_msa(nbins), faqgain_so4(nbins) + real(r8) :: wt_mass(nbins) + + real(r8) :: delso4_o3rxn, & + dso4dt_aqrxn, dso4dt_hprxn, & + dso4dt_gasuptk, dmsadt_gasuptk, & + dmsadt_gasuptk_tomsa, dmsadt_gasuptk_toso4, & + dqdt_aq, dqdt_wr, dqdt + + real(r8) :: fwetrem, sumf, uptkrate + real(r8) :: delnh3, delnh4 + + integer :: l, n, m, mm + integer :: ntot_msa_c + + integer :: i,k + real(r8) :: xl + real(r8) :: wt_sum + real(r8) :: specmw_so4_amode + + character(len=32) :: spectype + + character(len=*), parameter :: subname = 'sox_cldaero_update' + character(len=aero_name_len) :: bin_name, shortname + integer :: igroup, ibin, rc, nchr + + ! make sure dqdt is zero initially, for budgets + dqdt_aqso4(:,:,:) = 0.0_r8 + dqdt_aqh2so4(:,:,:) = 0.0_r8 + dqdt_aqhprxn(:,:) = 0.0_r8 + dqdt_aqo3rxn(:,:) = 0.0_r8 + dryr_n(:,:,:) = 0.0_r8 + + ntot_msa_c = 0.0_r8 + aqso4 = 0.0_r8 + aqh2so4 = 0.0_r8 + aqso4_h2o2 = 0.0_r8 + aqso4_o3 = 0.0_r8 + + do n = 1, nbins + call rad_cnst_get_info_by_bin(0, n, nspec=nspec(n), bin_name=bin_name) + + + nchr = len_trim(bin_name)-2 + shortname = bin_name(:nchr) + + call carma_get_group_by_name(shortname, igroup, rc) + if (rc/=0) then + call endrun(subname//': ERROR in carma_get_group_by_name') + end if + + read(bin_name(nchr+1:),*) ibin + + call carma_get_dry_radius(state, igroup, ibin, dryr, rho, rc) + if (rc/=0) then + call endrun(subname//': ERROR in carma_get_dry_radius') + end if + + dryr(:ncol,:) = dryr(:ncol,:)*1.e2_r8 ! cm + + if (index(bin_name,'MXAER')>0) then + dryr_n(n,:ncol,:) = dryr(:ncol,:) + end if + end do + + lev_loop: do k = 1,pver + col_loop: do i = 1,ncol + cloud: if (cldfrc(i,k) >= 1.0e-5_r8) then + xl = xlwc(i,k) ! / cldfrc(i,k) + + IF (XL .ge. 1.e-8_r8) THEN !! WHEN CLOUD IS PRESENTED + + delso4_o3rxn = xso4(i,k) - xso4_init(i,k) + !write(iulog,*) 'delso4_o3rxn ', delso4_o3rxn + + !st if (id_nh3>0) then + !st delnh3 = nh3g(i,k) - xnh3(i,k) + !st delnh4 = - delnh3 + !st endif + + ! the factors are proportional to the activated particle MR for each + ! bin, which is the MR of cloud drops "associated with" the mode + ! thus we are assuming the cloud drop size is independent of the + ! associated aerosol mode properties (i.e., drops associated with + ! Aitken and coarse sea-salt particles are same size) + ! + ! qnum_c(n) = activated particle number MR for mode n (these are just + ! used for partitioning among modes, so don't need to divide by cldfrc) + + !faqgain_so4(n) = fraction of total so4_c gain going to mode n + wt_sum = 0._r8 + wt_mass(:) = 0._r8 + faqgain_so4(:) = 0.0_r8 + do n = 1, nbins + if (dryr_n(n,i,k) > 0._r8) then + wt_mass(n) = delso4_o3rxn / dryr_n(n,i,k) / dryr_n(n,i,k) + wt_sum = wt_sum + wt_mass(n) + end if + end do + do n = 1, nbins + if (wt_mass(n) > 0._r8) then + faqgain_so4(n) = wt_mass(n)/wt_sum + end if + end do + + ! at this point (sumf <= 0.0) only when all the faqgain_msa are zero + uptkrate = cldaero_uptakerate( xl, cldnum(i,k), cfact(i,k), cldfrc(i,k), tfld(i,k), press(i,k) ) + ! average uptake rate over dtime + uptkrate = (1.0_r8 - exp(-min(100._r8,dtime*uptkrate))) / dtime + + ! dso4dt_gasuptk = so4_c tendency from h2so4 gas uptake (mol/mol/s) + ! dmsadt_gasuptk = msa_c tendency from msa gas uptake (mol/mol/s) + dso4dt_gasuptk = xh2so4(i,k) * uptkrate + !if (id_msa > 0) then + ! dmsadt_gasuptk = xmsa(i,k) * uptkrate + !else + ! dmsadt_gasuptk = 0.0_r8 + !end if +! + ! if no modes have msa aerosol, then "rename" scavenged msa gas to so4 + dmsadt_gasuptk_toso4 = 0.0_r8 + !st dmsadt_gasuptk_tomsa = dmsadt_gasuptk + !st if (ntot_msa_c == 0) then + !st dmsadt_gasuptk_tomsa = 0.0_r8 + !st dmsadt_gasuptk_toso4 = dmsadt_gasuptk + !st end if + + !----------------------------------------------------------------------- + ! now compute TMR tendencies + ! this includes the above aqueous so2 chemistry AND + ! the uptake of highly soluble aerosol precursor gases (h2so4, msa, ...) + ! AND the wetremoval of dissolved, unreacted so2 and h2o2 + + dso4dt_aqrxn = (delso4_o3rxn + delso4_hprxn(i,k)) / dtime + dso4dt_hprxn = delso4_hprxn(i,k) / dtime + !write(iulog,*) 'dso4dt_aqrxn ',dso4dt_aqrxn + + ! fwetrem = fraction of in-cloud-water material that is wet removed + ! fwetrem = max( 0.0_r8, (1.0_r8-exp(-min(100._r8,dtime*clwlrat(i,k)))) ) + fwetrem = 0.0_r8 ! don't have so4 & msa wet removal here + + ! compute TMR tendencies for so4, not done currently for msa aerosol-in-cloud-water + do n = 1, nbins + do l = 1, nspec(n) + mm = bin_idx(n, l) + call rad_cnst_get_bin_props_by_idx(0, n, l,spectype=spectype) + if (trim(spectype) == 'sulfate') then + if (faqgain_so4(n) .gt. 0.0_r8) then + dqdt_aqso4(i,k,mm) = faqgain_so4(n)*dso4dt_aqrxn*cldfrc(i,k) + + dqdt_aqh2so4(i,k,mm) = faqgain_so4(n)* & + (dso4dt_gasuptk + dmsadt_gasuptk_toso4)*cldfrc(i,k) + dqdt_aq = dqdt_aqso4(i,k,mm) + dqdt_aqh2so4(i,k,mm) + dqdt_wr = -fwetrem*dqdt_aq + dqdt= dqdt_aq + dqdt_wr + !write(iulog,*) 'qcw(i,k,mm) before ', m, qcw(i,k,mm) + qcw(i,k,mm) = qcw(i,k,mm) + dqdt*dtime + !write(iulog,*) 'qcw(i,k,mm) after', m, qcw(i,k,mm) + end if + end if + end do + end do + + + ! For gas species, tendency includes + ! reactive uptake to cloud water that essentially transforms the gas to + ! a different species. Wet removal associated with this is applied + ! to the "new" species (e.g., so4_c) rather than to the gas. + ! wet removal of the unreacted gas that is dissolved in cloud water. + ! Need to multiply both these parts by cldfrc + + ! h2so4 (g) & msa (g) + + !H2SO4 not updated in Pengfei's model + !st TEST with H2SO4 uptake + qin(i,k,id_h2so4) = qin(i,k,id_h2so4) - dso4dt_gasuptk * dtime * cldfrc(i,k) + !qin(i,k,id_h2so4) = MAX( qin(i,k,id_h2so4), small_value ) + + !st if (id_msa > 0) qin(i,k,id_msa) = qin(i,k,id_msa) - dmsadt_gasuptk * dtime * cldfrc(i,k) + + ! so2 -- the first order loss rate for so2 is frso2_c*clwlrat(i,k) + ! fwetrem = max( 0.0_r8, (1.0_r8-exp(-min(100._r8,dtime*frso2_c*clwlrat(i,k)))) ) + fwetrem = 0.0_r8 ! don't include so2 wet removal here + + dqdt_wr = -fwetrem*xso2(i,k)/dtime*cldfrc(i,k) + dqdt_aq = -dso4dt_aqrxn*cldfrc(i,k) + dqdt = dqdt_aq + dqdt_wr + dqdt = dqdt_aq + qin(i,k,id_so2) = qin(i,k,id_so2) + dqdt * dtime + qin(i,k,id_so2) = MAX( qin(i,k,id_so2), small_value ) + + ! h2o2 -- the first order loss rate for h2o2 is frh2o2_c*clwlrat(i,k) + ! fwetrem = max( 0.0_r8, (1.0_r8-exp(-min(100._r8,dtime*frh2o2_c*clwlrat(i,k)))) ) + fwetrem = 0.0_r8 ! don't include h2o2 wet removal here + + dqdt_wr = -fwetrem*xh2o2(i,k)/dtime*cldfrc(i,k) + dqdt_aq = -dso4dt_hprxn*cldfrc(i,k) + dqdt = dqdt_aq + dqdt_wr + dqdt = dqdt_aq + qin(i,k,id_h2o2) = qin(i,k,id_h2o2) + dqdt * dtime + qin(i,k,id_h2o2) = MAX( qin(i,k,id_h2o2), small_value ) + + ! NH3 + !st if (id_nh3>0) then + !st dqdt_aq = delnh3/dtime*cldfrc(i,k) + !st dqdt = dqdt_aq + !st qin(i,k,id_nh3) = qin(i,k,id_nh3) + dqdt * dtime + !st endif + + ! for SO4 from H2O2/O3 budgets + dqdt_aqhprxn(i,k) = dso4dt_hprxn*cldfrc(i,k) + dqdt_aqo3rxn(i,k) = (dso4dt_aqrxn - dso4dt_hprxn)*cldfrc(i,k) + + + ENDIF !! WHEN CLOUD IS PRESENTED + endif cloud + enddo col_loop + enddo lev_loop + + !============================================================== + ! ... Update the mixing ratios + !============================================================== + + ! diagnostics + + specmw_so4_amode = 96.0_r8 + do n = 1, nbins + ! while looking through all species, only dqdt_aqso4 from sulfates is gt zero + do l = 1, nspec(n) + mm = bin_idx(n, l) + aqso4(:,n)=0._r8 + do k=1,pver + do i=1,ncol + aqso4(i,n)=aqso4(i,n)+dqdt_aqso4(i,k,mm)*specmw_so4_amode/mbar(i,k) & + *pdel(i,k)/gravit ! kg/m2/s + enddo + enddo + + aqh2so4(:,n)=0._r8 + do k=1,pver + do i=1,ncol + aqh2so4(i,n)=aqh2so4(i,n)+dqdt_aqh2so4(i,k,mm)*specmw_so4_amode/mbar(i,k) & + *pdel(i,k)/gravit ! kg/m2/s + enddo + enddo + end do + end do + + aqso4_h2o2(:) = 0._r8 + do k=1,pver + do i=1,ncol + aqso4_h2o2(i)=aqso4_h2o2(i)+dqdt_aqhprxn(i,k)*specmw_so4_amode/mbar(i,k) & + *pdel(i,k)/gravit ! kg SO4 /m2/s + enddo + enddo + + if (present(aqso4_h2o2_3d)) then + aqso4_h2o2_3d(:,:) = 0._r8 + do k=1,pver + do i=1,ncol + aqso4_h2o2_3d(i,k)=dqdt_aqhprxn(i,k)*specmw_so4_amode/mbar(i,k) & + *pdel(i,k)/gravit ! kg SO4 /m2/s + enddo + enddo + end if + + aqso4_o3(:)=0._r8 + do k=1,pver + do i=1,ncol + aqso4_o3(i)=aqso4_o3(i)+dqdt_aqo3rxn(i,k)*specmw_so4_amode/mbar(i,k) & + *pdel(i,k)/gravit ! kg SO4 /m2/s + enddo + enddo + + if (present(aqso4_o3_3d)) then + aqso4_o3_3d(:,:)=0._r8 + do k=1,pver + do i=1,ncol + aqso4_o3_3d(i,k)=dqdt_aqo3rxn(i,k)*specmw_so4_amode/mbar(i,k) & + *pdel(i,k)/gravit ! kg SO4 /m2/s + enddo + enddo + end if + + end subroutine sox_cldaero_update + + !---------------------------------------------------------------------------------- + !---------------------------------------------------------------------------------- + subroutine sox_cldaero_destroy_obj( conc_obj ) + type(cldaero_conc_t), pointer :: conc_obj + + call cldaero_deallocate( conc_obj ) + + end subroutine sox_cldaero_destroy_obj + +end module sox_cldaero_mod diff --git a/src/chemistry/modal_aero/aero_model.F90 b/src/chemistry/modal_aero/aero_model.F90 index 056b998a36..3d240285ad 100644 --- a/src/chemistry/modal_aero/aero_model.F90 +++ b/src/chemistry/modal_aero/aero_model.F90 @@ -111,6 +111,7 @@ subroutine aero_model_readnl(nlfile) use units, only: getunit, freeunit use mpishorthand use aero_wetdep_cam, only: aero_wetdep_readnl + use dust_model, only: dust_readnl character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input @@ -151,6 +152,7 @@ subroutine aero_model_readnl(nlfile) drydep_list = aer_drydep_list call aero_wetdep_readnl(nlfile) + call dust_readnl(nlfile) end subroutine aero_model_readnl @@ -177,6 +179,7 @@ subroutine aero_model_init( pbuf2d ) use seasalt_model, only: seasalt_init, seasalt_names, seasalt_active,seasalt_nbin use aer_drydep_mod, only: inidrydep use aero_wetdep_cam, only: aero_wetdep_init + use mo_setsox, only: sox_inti use modal_aero_calcsize, only: modal_aero_calcsize_init use modal_aero_coag, only: modal_aero_coag_init @@ -209,6 +212,9 @@ subroutine aero_model_init( pbuf2d ) character(len=32) :: mode_type integer :: nspec + ! aqueous chem initialization + call sox_inti() + dgnum_idx = pbuf_get_index('DGNUM') dgnumwet_idx = pbuf_get_index('DGNUMWET') fracis_idx = pbuf_get_index('FRACIS') @@ -862,10 +868,11 @@ end subroutine aero_model_wetdep ! called from mo_usrrxt !------------------------------------------------------------------------- subroutine aero_model_surfarea( & - mmr, radmean, relhum, pmid, temp, strato_sad, sulfate, rho, ltrop, & + state, mmr, radmean, relhum, pmid, temp, strato_sad, sulfate, rho, ltrop, & dlat, het1_ndx, pbuf, ncol, sfc, dm_aer, sad_trop, reff_trop ) ! dummy args + type(physics_state), intent(in) :: state ! Physics state variables real(r8), intent(in) :: pmid(:,:) real(r8), intent(in) :: temp(:,:) real(r8), intent(in) :: mmr(:,:,:) @@ -909,9 +916,10 @@ end subroutine aero_model_surfarea ! provides WET stratospheric aerosol surface area info for modal aerosols ! if modal_strat_sulfate = TRUE -- called from mo_gas_phase_chemdr !------------------------------------------------------------------------- - subroutine aero_model_strat_surfarea( ncol, mmr, pmid, temp, ltrop, pbuf, strato_sad, reff_strat ) + subroutine aero_model_strat_surfarea( state, ncol, mmr, pmid, temp, ltrop, pbuf, strato_sad, reff_strat ) ! dummy args + type(physics_state), intent(in) :: state ! Physics state variables integer, intent(in) :: ncol real(r8), intent(in) :: mmr(:,:,:) real(r8), intent(in) :: pmid(:,:) @@ -941,7 +949,7 @@ end subroutine aero_model_strat_surfarea !============================================================================= !============================================================================= - subroutine aero_model_gasaerexch( loffset, ncol, lchnk, troplev, delt, reaction_rates, & + subroutine aero_model_gasaerexch( state, loffset, ncol, lchnk, troplev, delt, reaction_rates, & tfld, pmid, pdel, mbar, relhum, & zm, qh2o, cwat, cldfr, cldnum, & airdens, invariants, del_h2so4_gasprod, & @@ -956,6 +964,7 @@ subroutine aero_model_gasaerexch( loffset, ncol, lchnk, troplev, delt, reaction_ !----------------------------------------------------------------------- ! ... dummy arguments !----------------------------------------------------------------------- + type(physics_state), intent(in) :: state ! Physics state variables integer, intent(in) :: loffset ! offset applied to modal aero "pointers" integer, intent(in) :: ncol ! number columns in chunk integer, intent(in) :: lchnk ! chunk index @@ -1053,7 +1062,8 @@ subroutine aero_model_gasaerexch( loffset, ncol, lchnk, troplev, delt, reaction_ ! aqueous chemistry ... if( has_sox ) then - call setsox( & + call setsox( state, & + pbuf, & ncol, & lchnk, & loffset, & diff --git a/src/chemistry/modal_aero/sox_cldaero_mod.F90 b/src/chemistry/modal_aero/sox_cldaero_mod.F90 index 2500aa37e5..351af01aa5 100644 --- a/src/chemistry/modal_aero/sox_cldaero_mod.F90 +++ b/src/chemistry/modal_aero/sox_cldaero_mod.F90 @@ -16,6 +16,7 @@ module sox_cldaero_mod use phys_control, only : phys_getopts, cam_chempkg_is use cldaero_mod, only : cldaero_uptakerate use chem_mods, only : gas_pcnst + use physics_buffer, only : physics_buffer_desc implicit none private @@ -54,13 +55,13 @@ subroutine sox_cldaero_init ! ! add to history ! - + end subroutine sox_cldaero_init !---------------------------------------------------------------------------------- !---------------------------------------------------------------------------------- function sox_cldaero_create_obj(cldfrc, qcw, lwc, cfact, ncol, loffset) result( conc_obj ) - + real(r8), intent(in) :: cldfrc(:,:) real(r8), intent(in) :: qcw(:,:,:) real(r8), intent(in) :: lwc(:,:) @@ -97,7 +98,7 @@ function sox_cldaero_create_obj(cldfrc, qcw, lwc, cfact, ncol, loffset) result( if (mode7) then #if ( defined MODAL_AERO_7MODE ) -!put ifdef here so ifort will compile +!put ifdef here so ifort will compile id_so4_1a = lptr_so4_cw_amode(1) - loffset id_so4_2a = lptr_so4_cw_amode(2) - loffset id_so4_3a = lptr_so4_cw_amode(4) - loffset @@ -118,7 +119,7 @@ function sox_cldaero_create_obj(cldfrc, qcw, lwc, cfact, ncol, loffset) result( + qcw(:ncol,:,id_so4_3a) & + qcw(:ncol,:,id_so4_4a) & + qcw(:ncol,:,id_so4_5a) & - + qcw(:ncol,:,id_so4_6a) + + qcw(:ncol,:,id_so4_6a) conc_obj%nh4c(:ncol,:) & = qcw(:ncol,:,id_nh4_1a) & @@ -126,7 +127,7 @@ function sox_cldaero_create_obj(cldfrc, qcw, lwc, cfact, ncol, loffset) result( + qcw(:ncol,:,id_nh4_3a) & + qcw(:ncol,:,id_nh4_4a) & + qcw(:ncol,:,id_nh4_5a) & - + qcw(:ncol,:,id_nh4_6a) + + qcw(:ncol,:,id_nh4_6a) else id_so4_1a = lptr_so4_cw_amode(1) - loffset id_so4_2a = lptr_so4_cw_amode(2) - loffset @@ -137,7 +138,7 @@ function sox_cldaero_create_obj(cldfrc, qcw, lwc, cfact, ncol, loffset) result( + qcw(:,:,id_so4_3a) ! for 3-mode, so4 is assumed to be nh4hso4 - ! the partial neutralization of so4 is handled by using a + ! the partial neutralization of so4 is handled by using a ! -1 charge (instead of -2) in the electro-neutrality equation conc_obj%nh4c(:ncol,:) = 0._r8 @@ -151,13 +152,17 @@ end function sox_cldaero_create_obj !---------------------------------------------------------------------------------- ! Update the mixing ratios !---------------------------------------------------------------------------------- - subroutine sox_cldaero_update( & - ncol, lchnk, loffset, dtime, mbar, pdel, press, tfld, cldnum, cldfrc, cfact, xlwc, & + subroutine sox_cldaero_update( state, & + pbuf, ncol, lchnk, loffset, dtime, mbar, pdel, press, tfld, cldnum, cldfrc, cfact, xlwc, & delso4_hprxn, xh2so4, xso4, xso4_init, nh3g, hno3g, xnh3, xhno3, xnh4c, xno3c, xmsa, xso2, xh2o2, qcw, qin, & aqso4, aqh2so4, aqso4_h2o2, aqso4_o3, aqso4_h2o2_3d, aqso4_o3_3d) - ! args + use physics_types, only: physics_state + + ! args + type(physics_state), intent(in) :: state ! Physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) integer, intent(in) :: ncol integer, intent(in) :: lchnk ! chunk id integer, intent(in) :: loffset @@ -165,7 +170,7 @@ subroutine sox_cldaero_update( & real(r8), intent(in) :: dtime ! time step (sec) real(r8), intent(in) :: mbar(:,:) ! mean wet atmospheric mass ( amu ) - real(r8), intent(in) :: pdel(:,:) + real(r8), intent(in) :: pdel(:,:) real(r8), intent(in) :: press(:,:) real(r8), intent(in) :: tfld(:,:) @@ -484,7 +489,7 @@ subroutine sox_cldaero_update( & enddo enddo - if (present(aqso4_h2o2_3d)) then + if (present(aqso4_h2o2_3d)) then aqso4_h2o2_3d(:,:) = 0._r8 do k=1,pver do i=1,ncol diff --git a/src/chemistry/mozart/chemistry.F90 b/src/chemistry/mozart/chemistry.F90 index 085bd2237b..b96e1fc613 100644 --- a/src/chemistry/mozart/chemistry.F90 +++ b/src/chemistry/mozart/chemistry.F90 @@ -187,6 +187,7 @@ subroutine chem_register logical :: cam_outfld character(len=128) :: mixtype character(len=128) :: molectype + logical :: ndropmixed integer :: islvd !----------------------------------------------------------------------- @@ -238,11 +239,16 @@ subroutine chem_register ic_from_cam2 = .true. has_fixed_ubc = ubc_fixed_conc(solsym(m)) has_fixed_ubflx = .false. + ndropmixed = .false. lng_name = trim( solsym(m) ) molectype = 'minor' qmin = 1.e-36_r8 + if ( index(lng_name,'_a')>0 ) then ! modal aerosol species undergoes ndrop activation mixing + ndropmixed = .true. + endif + if ( lng_name(1:5) .eq. 'num_a' ) then ! aerosol number density qmin = 1.e-5_r8 else if ( m == o3_ndx ) then @@ -296,7 +302,8 @@ subroutine chem_register short_lived_map(islvd) = m else call cnst_add( solsym(m), adv_mass(m), cptmp, qmin, n, readiv=ic_from_cam2, cam_outfld=cam_outfld, & - mixtype=mixtype, molectype=molectype, fixed_ubc=has_fixed_ubc, fixed_ubflx=has_fixed_ubflx, & + mixtype=mixtype, molectype=molectype, ndropmixed=ndropmixed, & + fixed_ubc=has_fixed_ubc, fixed_ubflx=has_fixed_ubflx, & longname=trim(lng_name) ) if( imozart == -1 ) then @@ -334,7 +341,6 @@ subroutine chem_readnl(nlfile) use tracer_cnst, only: tracer_cnst_defaultopts, tracer_cnst_setopts use tracer_srcs, only: tracer_srcs_defaultopts, tracer_srcs_setopts use aero_model, only: aero_model_readnl - use dust_model, only: dust_readnl use gas_wetdep_opts, only: gas_wetdep_readnl use mo_drydep, only: drydep_srf_file use mo_sulf, only: sulf_readnl @@ -543,7 +549,6 @@ subroutine chem_readnl(nlfile) tracer_srcs_fixed_tod_in = tracer_srcs_fixed_tod ) call aero_model_readnl(nlfile) - call dust_readnl(nlfile) ! call gas_wetdep_readnl(nlfile) call gcr_ionization_readnl(nlfile) @@ -639,7 +644,6 @@ subroutine chem_init(phys_state, pbuf2d) use mo_chem_utls, only : get_spc_ndx use cam_abortutils, only : endrun use aero_model, only : aero_model_init - use mo_setsox, only : sox_inti use constituents, only : sflxnam use fire_emissions, only : fire_emissions_init use short_lived_species, only : short_lived_species_initic @@ -675,9 +679,6 @@ subroutine chem_init(phys_state, pbuf2d) history_budget_histfile_num_out = history_budget_histfile_num, & history_cesm_forcing_out = history_cesm_forcing ) - ! aqueous chem initialization - call sox_inti() - ! Initialize aerosols call aero_model_init( pbuf2d ) @@ -1257,7 +1258,7 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dt, pbuf, fh2o) ncldwtr(:ncol,k) = state%q(:ncol,k,ixndrop) end do - call gas_phase_chemdr(lchnk, ncol, imozart, state%q, & + call gas_phase_chemdr(state,lchnk, ncol, imozart, state%q, & state%phis, state%zm, state%zi, calday, & state%t, state%pmid, state%pdel, state%pint, state%rpdel, state%rpdeldry, & cldw, tropLev, tropLevChem, ncldwtr, state%u, state%v, chem_dt, state%ps, & diff --git a/src/chemistry/mozart/mo_gas_phase_chemdr.F90 b/src/chemistry/mozart/mo_gas_phase_chemdr.F90 index 0575b2f8c0..cbda47aa8d 100644 --- a/src/chemistry/mozart/mo_gas_phase_chemdr.F90 +++ b/src/chemistry/mozart/mo_gas_phase_chemdr.F90 @@ -25,6 +25,7 @@ module mo_gas_phase_chemdr integer :: het1_ndx integer :: ndx_cldfr, ndx_cmfdqr, ndx_nevapr, ndx_cldtop, ndx_prain integer :: ndx_h2so4 + integer :: jno2_pbuf_ndx=-1, jno2_rxt_ndx=-1 ! ! CCMI ! @@ -181,6 +182,8 @@ subroutine gas_phase_chemdr_inti() call add_default ('SAD_AERO',8,' ') endif call addfld( 'REFF_AERO', (/ 'lev' /), 'I', 'cm', 'aerosol effective radius' ) + call addfld( 'REFF_TROP', (/ 'lev' /), 'I', 'cm', 'tropospheric aerosol effective radius' ) + call addfld( 'REFF_STRAT', (/ 'lev' /), 'I', 'cm', 'stratospheric aerosol effective radius' ) call addfld( 'SULF_TROP', (/ 'lev' /), 'I', 'mol/mol', 'tropospheric aerosol SAD' ) call addfld( 'QDSETT', (/ 'lev' /), 'I', '/s', 'water vapor settling delta' ) call addfld( 'QDCHEM', (/ 'lev' /), 'I', '/s', 'water vapor chemistry delta') @@ -211,11 +214,15 @@ subroutine gas_phase_chemdr_inti() ndx_cldtop = pbuf_get_index('CLDTOP') sad_pbf_ndx= pbuf_get_index('VOLC_SAD',errcode=err) ! prescribed strat aerosols (volcanic) - if (.not.sad_pbf_ndx>0) sad_pbf_ndx = pbuf_get_index('SADSULF',errcode=err) ! CARMA's version of strat aerosols ele_temp_ndx = pbuf_get_index('TElec',errcode=err)! electron temperature index ion_temp_ndx = pbuf_get_index('TIon',errcode=err) ! ion temperature index + jno2_pbuf_ndx = pbuf_get_index('JNO2',errcode=err) + if (jno2_pbuf_ndx>0) then + jno2_rxt_ndx = get_rxt_ndx('jno2') + end if + ! diagnostics for stratospheric heterogeneous reactions call addfld( 'GAMMA_HET1', (/ 'lev' /), 'I', '1', 'Reaction Probability' ) call addfld( 'GAMMA_HET2', (/ 'lev' /), 'I', '1', 'Reaction Probability' ) @@ -251,7 +258,7 @@ end subroutine gas_phase_chemdr_inti !----------------------------------------------------------------------- !----------------------------------------------------------------------- - subroutine gas_phase_chemdr(lchnk, ncol, imozart, q, & + subroutine gas_phase_chemdr(state, lchnk, ncol, imozart, q, & phis, zm, zi, calday, & tfld, pmid, pdel, pint, rpdel, rpdeldry, & cldw, troplev, troplevchem, & @@ -305,6 +312,7 @@ subroutine gas_phase_chemdr(lchnk, ncol, imozart, q, & use perf_mod, only : t_startf, t_stopf use gas_wetdep_opts, only : gas_wetdep_method use physics_buffer, only : physics_buffer_desc, pbuf_get_field, pbuf_old_tim_idx + use physics_types, only : physics_state use infnan, only : nan, assignment(=) use rate_diags, only : rate_diags_calc, rate_diags_o3s_loss use mo_mass_xforms, only : mmr2vmr, vmr2mmr, h2o_to_vmr, mmr2vmri @@ -362,6 +370,7 @@ subroutine gas_phase_chemdr(lchnk, ncol, imozart, q, & real(r8), intent(out) :: noy_nitrogen_flx(pcols) logical, intent(in) :: use_hemco ! use Harmonized Emissions Component (HEMCO) + type(physics_state), intent(in) :: state ! Physics state variables type(physics_buffer_desc), pointer :: pbuf(:) !----------------------------------------------------------------------- @@ -472,6 +481,7 @@ subroutine gas_phase_chemdr(lchnk, ncol, imozart, q, & real(r8) :: o3s_loss(ncol,pver) real(r8), pointer :: srf_ozone_fld(:) + real(r8), pointer :: jno2_fld_ptr(:,:) if ( ele_temp_ndx>0 .and. ion_temp_ndx>0 ) then call pbuf_get_field(pbuf, ele_temp_ndx, ele_temp_fld) @@ -497,6 +507,10 @@ subroutine gas_phase_chemdr(lchnk, ncol, imozart, q, & call pbuf_get_field(pbuf, ndx_nevapr, nevapr, start=(/1,1/), kount=(/ncol,pver/)) call pbuf_get_field(pbuf, ndx_cldtop, cldtop ) + if (jno2_pbuf_ndx>0.and.jno2_rxt_ndx>0) then + call pbuf_get_field(pbuf, jno2_pbuf_ndx, jno2_fld_ptr) + end if + reff_strat(:,:) = 0._r8 dlats(:) = rlats(:)*rad2deg ! convert to degrees @@ -630,7 +644,7 @@ subroutine gas_phase_chemdr(lchnk, ncol, imozart, q, & strato_sad(:,:) = 0._r8 ! Prognostic modal stratospheric sulfate: compute dry strato_sad - call aero_model_strat_surfarea( ncol, mmr, pmid, tfld, troplevchem, pbuf, strato_sad, reff_strat ) + call aero_model_strat_surfarea( state, ncol, mmr, pmid, tfld, troplevchem, pbuf, strato_sad, reff_strat ) endif @@ -767,7 +781,7 @@ subroutine gas_phase_chemdr(lchnk, ncol, imozart, q, & cwat(:ncol,:pver) = cldw(:ncol,:pver) - call usrrxt( reaction_rates, tfld, ion_temp_fld, ele_temp_fld, invariants, h2ovmr, & + call usrrxt( state, reaction_rates, tfld, ion_temp_fld, ele_temp_fld, invariants, h2ovmr, & pmid, invariants(:,:,indexm), sulfate, mmr, relhum, strato_sad, & troplevchem, dlats, ncol, sad_trop, reff, cwat, mbar, pbuf ) @@ -778,6 +792,8 @@ subroutine gas_phase_chemdr(lchnk, ncol, imozart, q, & call outfld( 'SAD_AERO', sad_trop(:ncol,:), ncol, lchnk ) ! Add trop/strat components of effective radius for output + call outfld( 'REFF_TROP', reff(:ncol,:), ncol, lchnk ) + call outfld( 'REFF_STRAT', reff_strat(:ncol,:), ncol, lchnk ) reff(:ncol,:)=reff(:ncol,:)+reff_strat(:ncol,:) call outfld( 'REFF_AERO', reff(:ncol,:), ncol, lchnk ) @@ -822,6 +838,10 @@ subroutine gas_phase_chemdr(lchnk, ncol, imozart, q, & call outfld( tag_names(i), reaction_rates(:ncol,:,rxt_tag_map(i)), ncol, lchnk ) enddo + if (jno2_pbuf_ndx>0.and.jno2_rxt_ndx>0) then + jno2_fld_ptr(:ncol,:) = reaction_rates(:ncol,:,jno2_rxt_ndx) + endif + !----------------------------------------------------------------------- ! ... Adjust the photodissociation rates !----------------------------------------------------------------------- @@ -954,7 +974,7 @@ subroutine gas_phase_chemdr(lchnk, ncol, imozart, q, & ! Aerosol processes ... ! - call aero_model_gasaerexch( imozart-1, ncol, lchnk, troplevchem, delt, reaction_rates, & + call aero_model_gasaerexch( state, imozart-1, ncol, lchnk, troplevchem, delt, reaction_rates, & tfld, pmid, pdel, mbar, relhum, & zm, qh2o, cwat, cldfr, ncldwtr, & invariants(:,:,indexm), invariants, del_h2so4_gasprod, & diff --git a/src/chemistry/mozart/mo_photo.F90 b/src/chemistry/mozart/mo_photo.F90 index 5ef22df875..01ca12c06b 100644 --- a/src/chemistry/mozart/mo_photo.F90 +++ b/src/chemistry/mozart/mo_photo.F90 @@ -1128,12 +1128,14 @@ subroutine set_ub_col( col_delta, vmr, invariants, ptop, pdel, ncol, lchnk ) o3_exo_col(:) = 0._r8 end if #ifdef DEBUG - write(iulog,*) '-----------------------------------' - write(iulog,*) 'o2_exo_col' - write(iulog,'(1p,5g15.7)') o2_exo_col(:) - write(iulog,*) 'o3_exo_col' - write(iulog,'(1p,5g15.7)') o3_exo_col(:) - write(iulog,*) '-----------------------------------' + if (masterproc) then + write(iulog,*) '-----------------------------------' + write(iulog,*) 'o2_exo_col' + write(iulog,'(1p,5g15.7)') o2_exo_col(:) + write(iulog,*) 'o3_exo_col' + write(iulog,'(1p,5g15.7)') o3_exo_col(:) + write(iulog,*) '-----------------------------------' + endif #endif else !--------------------------------------------------------------- diff --git a/src/chemistry/mozart/mo_usrrxt.F90 b/src/chemistry/mozart/mo_usrrxt.F90 index f37b45c92c..124c779f1f 100644 --- a/src/chemistry/mozart/mo_usrrxt.F90 +++ b/src/chemistry/mozart/mo_usrrxt.F90 @@ -3,6 +3,7 @@ module mo_usrrxt use shr_kind_mod, only : r8 => shr_kind_r8 use cam_logfile, only : iulog use ppgrid, only : pver, pcols + use cam_abortutils, only : endrun implicit none @@ -593,7 +594,7 @@ subroutine usrrxt_inti end subroutine usrrxt_inti - subroutine usrrxt( rxt, temp, tempi, tempe, invariants, h2ovmr, & + subroutine usrrxt( state, rxt, temp, tempi, tempe, invariants, h2ovmr, & pmid, m, sulfate, mmr, relhum, strato_sad, & tropchemlev, dlat, ncol, sad_trop, reff_trop, cwat, mbar, pbuf ) @@ -601,10 +602,11 @@ subroutine usrrxt( rxt, temp, tempi, tempe, invariants, h2ovmr, & ! ... set the user specified reaction rates !----------------------------------------------------------------- - use mo_constants, only : pi, avo => avogadro, boltz_cgs, rgas - use chem_mods, only : nfs, rxntot, gas_pcnst, inv_m_ndx=>indexm - use mo_setinv, only : inv_o2_ndx=>o2_ndx, inv_h2o_ndx=>h2o_ndx - use physics_buffer,only : physics_buffer_desc + use mo_constants, only : pi, avo => avogadro, boltz_cgs, rgas + use chem_mods, only : nfs, rxntot, gas_pcnst, inv_m_ndx=>indexm + use mo_setinv, only : inv_o2_ndx=>o2_ndx, inv_h2o_ndx=>h2o_ndx + use physics_buffer, only : physics_buffer_desc + use physics_types, only : physics_state use carma_flags_mod, only : carma_hetchem_feedback use aero_model, only : aero_model_surfarea use rad_constituents,only : rad_cnst_get_info @@ -633,6 +635,7 @@ subroutine usrrxt( rxt, temp, tempi, tempe, invariants, h2ovmr, & real(r8), intent(inout) :: rxt(ncol,pver,rxntot) ! gas phase rates real(r8), intent(out) :: sad_trop(pcols,pver) ! tropospheric surface area density (cm2/cm3) real(r8), intent(out) :: reff_trop(pcols,pver) ! tropospheric effective radius (cm) + type(physics_state), intent(in) :: state ! Physics state variables type(physics_buffer_desc), pointer :: pbuf(:) !----------------------------------------------------------------- @@ -758,7 +761,7 @@ subroutine usrrxt( rxt, temp, tempi, tempe, invariants, h2ovmr, & real(r8), parameter :: pH = 4.5e+00_r8 real(r8), pointer :: sfc(:), dm_aer(:) - integer :: ntot_amode + integer :: ntot_amode, nbins real(r8), pointer :: sfc_array(:,:,:), dm_array(:,:,:) !TS2 @@ -767,16 +770,24 @@ subroutine usrrxt( rxt, temp, tempi, tempe, invariants, h2ovmr, & real(r8) :: nyield real(r8) :: acorr real(r8) :: exp_natom + character(len=*), parameter :: subname = 'usrrxt' ! get info about the modal aerosols ! get ntot_amode call rad_cnst_get_info(0, nmodes=ntot_amode) + call rad_cnst_get_info(0, nbins=nbins) + + if (ntot_amode>0.and.nbins>0) then + call endrun(subname // ':: ERROR running with MAM and CARMA simultaneously not supported.') + end if if (ntot_amode>0) then - allocate(sfc_array(pcols,pver,ntot_amode), dm_array(pcols,pver,ntot_amode) ) + allocate(sfc_array(pcols,pver,ntot_amode), dm_array(pcols,pver,ntot_amode) ) + else if (nbins>0) then + allocate(sfc_array(pcols,pver,nbins), dm_array(pcols,pver,nbins) ) else - allocate(sfc_array(pcols,pver,5), dm_array(pcols,pver,5) ) - endif + allocate(sfc_array(pcols,pver,5), dm_array(pcols,pver,5) ) + end if sfc_array(:,:,:) = 0._r8 dm_array(:,:,:) = 0._r8 @@ -784,17 +795,18 @@ subroutine usrrxt( rxt, temp, tempi, tempe, invariants, h2ovmr, & reff_trop(:,:) = 0._r8 if( usr_NO2_aer_ndx > 0 .or. usr_NO3_aer_ndx > 0 .or. usr_N2O5_aer_ndx > 0 .or. usr_HO2_aer_ndx > 0 ) then - +! CGB, put back in for old CARMA sulfate model. ! sad_trop should be set outside of usrrxt ?? - if( carma_hetchem_feedback ) then + if( carma_hetchem_feedback ) then sad_trop(:ncol,:pver)=strato_sad(:ncol,:pver) - else +! call endrun(subname // ':: ERROR carma_hetchem_feedback namelist variable is obsolete') + else - call aero_model_surfarea( & - mmr, rm1, relhum, pmid, temp, strato_sad, sulfate, m, tropchemlev, dlat, & - het1_ndx, pbuf, ncol, sfc_array, dm_array, sad_trop, reff_trop ) + call aero_model_surfarea( & + state, mmr, rm1, relhum, pmid, temp, strato_sad, sulfate, m, tropchemlev, dlat, & + het1_ndx, pbuf, ncol, sfc_array, dm_array, sad_trop, reff_trop ) - endif + endif endif level_loop : do k = 1,pver @@ -1997,13 +2009,16 @@ subroutine usrrxt( rxt, temp, tempi, tempe, invariants, h2ovmr, & ! ... estimate sulfate particles surface area (cm2/cm3) in each grid !------------------------------------------------------------------------- if ( carma_hetchem_feedback ) then +! CGB - put it back for old CARMA sulfate model +! call endrun(subname // ':: ERROR carma_hetchem_feedback namelist variable is obsolete') sur(:ncol) = strato_sad(:ncol,k) - else - sur(:) = sulfate(:,k)*m(:,k)/avo*wso4 & ! xform mixing ratio to g/cm3 - / amas & ! xform g/cm3 to num particels/cm3 - * fare & ! xform num particels/cm3 to cm2/cm3 - * xr(:)*xr(:) ! humidity factor +! else +! sur(:) = sulfate(:,k)*m(:,k)/avo*wso4 & ! xform mixing ratio to g/cm3 +! / amas & ! xform g/cm3 to num particles/cm3 +! * fare & ! xform num particles/cm3 to cm2/cm3 +! * xr(:)*xr(:) ! humidity factor endif + sur(:ncol) = sad_trop(:ncol,k) !----------------------------------------------------------------- ! ... compute the "aerosol" reaction rates !----------------------------------------------------------------- @@ -2020,7 +2035,7 @@ subroutine usrrxt( rxt, temp, tempi, tempe, invariants, h2ovmr, & ! so that velo = 3.75e3*sqrt(T) (NH3) gama=0.4 !-------------------------------------------------------- !----------------------------------------------------------------- -! ... use this n2o5 -> 2*hno3 only in tropopause +! ... use this n2o5 -> 2*hno3 only in troposphere !----------------------------------------------------------------- rxt(:,k,het1_ndx) = rxt(:,k,het1_ndx) & +.25_r8 * gam1 * sur(:) * 1.40e3_r8 * sqrt( temp(:ncol,k) ) diff --git a/src/chemistry/pp_trop_strat_noaero/chem_mech.doc b/src/chemistry/pp_trop_strat_noaero/chem_mech.doc new file mode 100644 index 0000000000..437260d6c2 --- /dev/null +++ b/src/chemistry/pp_trop_strat_noaero/chem_mech.doc @@ -0,0 +1,1725 @@ + + + Solution species + ( 1) ALKNIT (C5H11ONO2) + ( 2) ALKOOH (C5H12O2) + ( 3) AOA_NH (CO) + ( 4) BCARY (C15H24) + ( 5) BENZENE (C6H6) + ( 6) BENZOOH (C6H8O5) + ( 7) BEPOMUC (C6H6O3) + ( 8) BIGALD (C5H6O2) + ( 9) BIGALD1 (C4H4O2) + ( 10) BIGALD2 (C5H6O2) + ( 11) BIGALD3 (C5H6O2) + ( 12) BIGALD4 (C6H8O2) + ( 13) BIGALK (C5H12) + ( 14) BIGENE (C4H8) + ( 15) BR (Br) + ( 16) BRCL (BrCl) + ( 17) BRO (BrO) + ( 18) BRONO2 (BrONO2) + ( 19) BRY + ( 20) BZALD (C7H6O) + ( 21) BZOOH (C7H8O2) + ( 22) C2H2 + ( 23) C2H4 + ( 24) C2H5OH + ( 25) C2H5OOH + ( 26) C2H6 + ( 27) C3H6 + ( 28) C3H7OOH + ( 29) C3H8 + ( 30) C6H5OOH (C6H5OOH) + ( 31) CCL4 (CCl4) + ( 32) CF2CLBR (CF2ClBr) + ( 33) CF3BR (CF3Br) + ( 34) CFC11 (CFCl3) + ( 35) CFC113 (CCl2FCClF2) + ( 36) CFC114 (CClF2CClF2) + ( 37) CFC115 (CClF2CF3) + ( 38) CFC12 (CF2Cl2) + ( 39) CH2BR2 (CH2Br2) + ( 40) CH2O + ( 41) CH3BR (CH3Br) + ( 42) CH3CCL3 (CH3CCl3) + ( 43) CH3CHO + ( 44) CH3CL (CH3Cl) + ( 45) CH3CN + ( 46) CH3COCH3 + ( 47) CH3COCHO + ( 48) CH3COOH + ( 49) CH3COOOH + ( 50) CH3OH + ( 51) CH3OOH + ( 52) CH4 + ( 53) CHBR3 (CHBr3) + ( 54) CL (Cl) + ( 55) CL2 (Cl2) + ( 56) CL2O2 (Cl2O2) + ( 57) CLO (ClO) + ( 58) CLONO2 (ClONO2) + ( 59) CLY + ( 60) CO + ( 61) CO2 + ( 62) COF2 + ( 63) COFCL (COFCl) + ( 64) CRESOL (C7H8O) + ( 65) DMS (CH3SCH3) + ( 66) E90 (CO) + ( 67) EOOH (HOCH2CH2OOH) + ( 68) F + ( 69) GLYALD (HOCH2CHO) + ( 70) GLYOXAL (C2H2O2) + ( 71) H + ( 72) H2 + ( 73) H2402 (CBrF2CBrF2) + ( 74) H2O2 + ( 75) H2SO4 (H2SO4) + ( 76) HBR (HBr) + ( 77) HCFC141B (CH3CCl2F) + ( 78) HCFC142B (CH3CClF2) + ( 79) HCFC22 (CHF2Cl) + ( 80) HCL (HCl) + ( 81) HCN + ( 82) HCOOH + ( 83) HF + ( 84) HNO3 + ( 85) HO2NO2 + ( 86) HOBR (HOBr) + ( 87) HOCL (HOCl) + ( 88) HONITR (C4H9NO4) + ( 89) HPALD (HOOCH2CCH3CHCHO) + ( 90) HYAC (CH3COCH2OH) + ( 91) HYDRALD (HOCH2CCH3CHCHO) + ( 92) IEPOX (C5H10O3) + ( 93) ISOP (C5H8) + ( 94) ISOPNITA (C5H9NO4) + ( 95) ISOPNITB (C5H9NO4) + ( 96) ISOPNO3 (CH2CHCCH3OOCH2ONO2) + ( 97) ISOPNOOH (C5H9NO5) + ( 98) ISOPOOH (HOCH2COOHCH3CHCH2) + ( 99) IVOC (C13H28) + (100) MACR (CH2CCH3CHO) + (101) MACROOH (CH3COCHOOHCH2OH) + (102) MEK (C4H8O) + (103) MEKOOH (C4H8O3) + (104) MPAN (CH2CCH3CO3NO2) + (105) MTERP (C10H16) + (106) MVK (CH2CHCOCH3) + (107) N + (108) N2O + (109) N2O5 + (110) NC4CH2OH (C5H9NO4) + (111) NC4CHO (C5H7NO4) + (112) NH3 + (113) NH4 + (114) NH_5 (CO) + (115) NH_50 (CO) + (116) NO + (117) NO2 + (118) NO3 + (119) NOA (CH3COCH2ONO2) + (120) NTERPOOH (C10H17NO5) + (121) O + (122) O3 + (123) O3S (O3) + (124) OCLO (OClO) + (125) OCS (OCS) + (126) ONITR (C4H7NO4) + (127) PAN (CH3CO3NO2) + (128) PBZNIT (C7H5O3NO2) + (129) PHENO (C6H5O) + (130) PHENOL (C6H5OH) + (131) PHENOOH (C6H8O6) + (132) POOH (C3H6OHOOH) + (133) ROOH (CH3COCH2OOH) + (134) S (S) + (135) SF6 + (136) SO (SO) + (137) SO2 + (138) SO3 (SO3) + (139) SOAG0 (C15H38O2) + (140) SOAG1 (C15H38O2) + (141) SOAG2 (C15H38O2) + (142) SOAG3 (C15H38O2) + (143) SOAG4 (C15H38O2) + (144) ST80_25 (CO) + (145) SVOC (C22H46) + (146) TEPOMUC (C7H8O3) + (147) TERP2OOH (C10H16O4) + (148) TERPNIT (C10H17NO4) + (149) TERPOOH (C10H18O3) + (150) TERPROD1 (C10H16O2) + (151) TERPROD2 (C9H14O2) + (152) TOLOOH (C7H10O5) + (153) TOLUENE (C7H8) + (154) XOOH (HOCH2COOHCH3CHOHCHO) + (155) XYLENES (C8H10) + (156) XYLENOOH (C8H12O5) + (157) XYLOL (C8H10O) + (158) XYLOLOOH (C8H12O6) + (159) NHDEP (N) + (160) NDEP (N) + (161) ACBZO2 (C7H5O3) + (162) ALKO2 (C5H11O2) + (163) BCARYO2VBS (C15H25O3) + (164) BENZO2 (C6H7O5) + (165) BENZO2VBS (C6H7O5) + (166) BZOO (C7H7O2) + (167) C2H5O2 + (168) C3H7O2 + (169) C6H5O2 + (170) CH3CO3 + (171) CH3O2 + (172) DICARBO2 (C5H5O4) + (173) ENEO2 (C4H9O3) + (174) EO (HOCH2CH2O) + (175) EO2 (HOCH2CH2O2) + (176) HO2 + (177) HOCH2OO + (178) ISOPAO2 (HOC5H8O2) + (179) ISOPBO2 (HOC5H8O2) + (180) ISOPO2VBS (C5H9O3) + (181) IVOCO2VBS (C13H29O3) + (182) MACRO2 (CH3COCHO2CH2OH) + (183) MALO2 (C4H3O4) + (184) MCO3 (CH2CCH3CO3) + (185) MDIALO2 (C4H5O4) + (186) MEKO2 (C4H7O3) + (187) MTERPO2VBS (C10H17O3) + (188) NTERPO2 (C10H16NO5) + (189) O1D (O) + (190) OH + (191) PHENO2 (C6H7O6) + (192) PO2 (C3H6OHO2) + (193) RO2 (CH3COCH2O2) + (194) TERP2O2 (C10H15O4) + (195) TERPO2 (C10H17O3) + (196) TOLO2 (C7H9O5) + (197) TOLUO2VBS (C7H9O5) + (198) XO2 (HOCH2COOCH3CHOHCHO) + (199) XYLENO2 (C8H11O5) + (200) XYLEO2VBS (C8H11O5) + (201) XYLOLO2 (C8H11O6) + (202) H2O + + + Invariant species + ( 1) M + ( 2) O2 + ( 3) N2 + + + Column integrals + ( 1) O3 - 0.000E+00 + ( 2) O2 - 0.000E+00 + +Class List +========== + Explicit + -------- + ( 1) AOA_NH + ( 2) BRY + ( 3) CCL4 + ( 4) CF2CLBR + ( 5) CF3BR + ( 6) CFC11 + ( 7) CFC113 + ( 8) CFC114 + ( 9) CFC115 + ( 10) CFC12 + ( 11) CH2BR2 + ( 12) CH3BR + ( 13) CH3CCL3 + ( 14) CH3CL + ( 15) CH4 + ( 16) CHBR3 + ( 17) CLY + ( 18) CO2 + ( 19) E90 + ( 20) H2402 + ( 21) HCFC141B + ( 22) HCFC142B + ( 23) HCFC22 + ( 24) N2O + ( 25) NH_5 + ( 26) NH_50 + ( 27) O3S + ( 28) SF6 + ( 29) ST80_25 + ( 30) NHDEP + ( 31) NDEP + + Implicit + -------- + ( 1) ALKNIT + ( 2) ALKOOH + ( 3) BCARY + ( 4) BENZENE + ( 5) BENZOOH + ( 6) BEPOMUC + ( 7) BIGALD + ( 8) BIGALD1 + ( 9) BIGALD2 + ( 10) BIGALD3 + ( 11) BIGALD4 + ( 12) BIGALK + ( 13) BIGENE + ( 14) BR + ( 15) BRCL + ( 16) BRO + ( 17) BRONO2 + ( 18) BZALD + ( 19) BZOOH + ( 20) C2H2 + ( 21) C2H4 + ( 22) C2H5OH + ( 23) C2H5OOH + ( 24) C2H6 + ( 25) C3H6 + ( 26) C3H7OOH + ( 27) C3H8 + ( 28) C6H5OOH + ( 29) CH2O + ( 30) CH3CHO + ( 31) CH3CN + ( 32) CH3COCH3 + ( 33) CH3COCHO + ( 34) CH3COOH + ( 35) CH3COOOH + ( 36) CH3OH + ( 37) CH3OOH + ( 38) CL + ( 39) CL2 + ( 40) CL2O2 + ( 41) CLO + ( 42) CLONO2 + ( 43) CO + ( 44) COF2 + ( 45) COFCL + ( 46) CRESOL + ( 47) DMS + ( 48) EOOH + ( 49) F + ( 50) GLYALD + ( 51) GLYOXAL + ( 52) H + ( 53) H2 + ( 54) H2O2 + ( 55) H2SO4 + ( 56) HBR + ( 57) HCL + ( 58) HCN + ( 59) HCOOH + ( 60) HF + ( 61) HNO3 + ( 62) HO2NO2 + ( 63) HOBR + ( 64) HOCL + ( 65) HONITR + ( 66) HPALD + ( 67) HYAC + ( 68) HYDRALD + ( 69) IEPOX + ( 70) ISOP + ( 71) ISOPNITA + ( 72) ISOPNITB + ( 73) ISOPNO3 + ( 74) ISOPNOOH + ( 75) ISOPOOH + ( 76) IVOC + ( 77) MACR + ( 78) MACROOH + ( 79) MEK + ( 80) MEKOOH + ( 81) MPAN + ( 82) MTERP + ( 83) MVK + ( 84) N + ( 85) N2O5 + ( 86) NC4CH2OH + ( 87) NC4CHO + ( 88) NH3 + ( 89) NH4 + ( 90) NO + ( 91) NO2 + ( 92) NO3 + ( 93) NOA + ( 94) NTERPOOH + ( 95) O + ( 96) O3 + ( 97) OCLO + ( 98) OCS + ( 99) ONITR + (100) PAN + (101) PBZNIT + (102) PHENO + (103) PHENOL + (104) PHENOOH + (105) POOH + (106) ROOH + (107) S + (108) SO + (109) SO2 + (110) SO3 + (111) SOAG0 + (112) SOAG1 + (113) SOAG2 + (114) SOAG3 + (115) SOAG4 + (116) SVOC + (117) TEPOMUC + (118) TERP2OOH + (119) TERPNIT + (120) TERPOOH + (121) TERPROD1 + (122) TERPROD2 + (123) TOLOOH + (124) TOLUENE + (125) XOOH + (126) XYLENES + (127) XYLENOOH + (128) XYLOL + (129) XYLOLOOH + (130) ACBZO2 + (131) ALKO2 + (132) BCARYO2VBS + (133) BENZO2 + (134) BENZO2VBS + (135) BZOO + (136) C2H5O2 + (137) C3H7O2 + (138) C6H5O2 + (139) CH3CO3 + (140) CH3O2 + (141) DICARBO2 + (142) ENEO2 + (143) EO + (144) EO2 + (145) HO2 + (146) HOCH2OO + (147) ISOPAO2 + (148) ISOPBO2 + (149) ISOPO2VBS + (150) IVOCO2VBS + (151) MACRO2 + (152) MALO2 + (153) MCO3 + (154) MDIALO2 + (155) MEKO2 + (156) MTERPO2VBS + (157) NTERPO2 + (158) O1D + (159) OH + (160) PHENO2 + (161) PO2 + (162) RO2 + (163) TERP2O2 + (164) TERPO2 + (165) TOLO2 + (166) TOLUO2VBS + (167) XO2 + (168) XYLENO2 + (169) XYLEO2VBS + (170) XYLOLO2 + (171) H2O + + Photolysis + jh2o_b ( 1) H2O + hv -> H2 + O1D rate = ** User defined ** ( 1) + jh2o_a ( 2) H2O + hv -> OH + H rate = ** User defined ** ( 2) + jh2o_c ( 3) H2O + hv -> 2*H + O rate = ** User defined ** ( 3) + jh2o2 ( 4) H2O2 + hv -> 2*OH rate = ** User defined ** ( 4) + jo2_a ( 5) O2 + hv -> O + O1D rate = ** User defined ** ( 5) + jo2_b ( 6) O2 + hv -> 2*O rate = ** User defined ** ( 6) + jo3_a ( 7) O3 + hv -> O1D + O2 rate = ** User defined ** ( 7) + jo3_b ( 8) O3 + hv -> O + O2 rate = ** User defined ** ( 8) + jhno3 ( 9) HNO3 + hv -> NO2 + OH rate = ** User defined ** ( 9) + jho2no2_a ( 10) HO2NO2 + hv -> OH + NO3 rate = ** User defined ** ( 10) + jho2no2_b ( 11) HO2NO2 + hv -> NO2 + HO2 rate = ** User defined ** ( 11) + jn2o ( 12) N2O + hv -> O1D + N2 rate = ** User defined ** ( 12) + jn2o5_a ( 13) N2O5 + hv -> NO2 + NO3 rate = ** User defined ** ( 13) + jn2o5_b ( 14) N2O5 + hv -> NO + O + NO3 rate = ** User defined ** ( 14) + jno ( 15) NO + hv -> N + O rate = ** User defined ** ( 15) + jno2 ( 16) NO2 + hv -> NO + O rate = ** User defined ** ( 16) + jno3_b ( 17) NO3 + hv -> NO + O2 rate = ** User defined ** ( 17) + jno3_a ( 18) NO3 + hv -> NO2 + O rate = ** User defined ** ( 18) + jalknit ( 19) ALKNIT + hv -> NO2 + 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + HO2 rate = ** User defined ** ( 19) + + 0.8*MEK + jalkooh ( 20) ALKOOH + hv -> 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + 0.9*HO2 rate = ** User defined ** ( 20) + + 0.8*MEK + OH + jbenzooh ( 21) BENZOOH + hv -> OH + GLYOXAL + 0.5*BIGALD1 + HO2 rate = ** User defined ** ( 21) + jbepomuc ( 22) BEPOMUC + hv -> BIGALD1 + 1.5*HO2 + 1.5*CO rate = ** User defined ** ( 22) + jbigald ( 23) BIGALD + hv -> 0.45*CO + 0.13*GLYOXAL + 0.56*HO2 + 0.13*CH3CO3 rate = ** User defined ** ( 23) + + 0.18*CH3COCHO + jbigald1 ( 24) BIGALD1 + hv -> 0.6*MALO2 + HO2 rate = ** User defined ** ( 24) + jbigald2 ( 25) BIGALD2 + hv -> 0.6*HO2 + 0.6*DICARBO2 rate = ** User defined ** ( 25) + jbigald3 ( 26) BIGALD3 + hv -> 0.6*HO2 + 0.6*CO + 0.6*MDIALO2 rate = ** User defined ** ( 26) + jbigald4 ( 27) BIGALD4 + hv -> HO2 + CO + CH3COCHO + CH3CO3 rate = ** User defined ** ( 27) + jbzooh ( 28) BZOOH + hv -> BZALD + OH + HO2 rate = ** User defined ** ( 28) + jc2h5ooh ( 29) C2H5OOH + hv -> CH3CHO + HO2 + OH rate = ** User defined ** ( 29) + jc3h7ooh ( 30) C3H7OOH + hv -> 0.82*CH3COCH3 + OH + HO2 rate = ** User defined ** ( 30) + jc6h5ooh ( 31) C6H5OOH + hv -> PHENO + OH rate = ** User defined ** ( 31) + jch2o_a ( 32) CH2O + hv -> CO + 2*H rate = ** User defined ** ( 32) + jch2o_b ( 33) CH2O + hv -> CO + H2 rate = ** User defined ** ( 33) + jch3cho ( 34) CH3CHO + hv -> CH3O2 + CO + HO2 rate = ** User defined ** ( 34) + jacet ( 35) CH3COCH3 + hv -> CH3CO3 + CH3O2 rate = ** User defined ** ( 35) + jmgly ( 36) CH3COCHO + hv -> CH3CO3 + CO + HO2 rate = ** User defined ** ( 36) + jch3co3h ( 37) CH3COOOH + hv -> CH3O2 + OH + CO2 rate = ** User defined ** ( 37) + jch3ooh ( 38) CH3OOH + hv -> CH2O + H + OH rate = ** User defined ** ( 38) + jch4_a ( 39) CH4 + hv -> H + CH3O2 rate = ** User defined ** ( 39) + jch4_b ( 40) CH4 + hv -> 1.44*H2 + 0.18*CH2O + 0.18*O + 0.33*OH + 0.33*H rate = ** User defined ** ( 40) + + 0.44*CO2 + 0.38*CO + 0.05*H2O + jco2 ( 41) CO2 + hv -> CO + O rate = ** User defined ** ( 41) + jeooh ( 42) EOOH + hv -> EO + OH rate = ** User defined ** ( 42) + jglyald ( 43) GLYALD + hv -> 2*HO2 + CO + CH2O rate = ** User defined ** ( 43) + jglyoxal ( 44) GLYOXAL + hv -> 2*CO + 2*HO2 rate = ** User defined ** ( 44) + jhonitr ( 45) HONITR + hv -> NO2 + 0.67*HO2 + 0.33*CH3CHO + 0.33*CH2O + 0.33*CO rate = ** User defined ** ( 45) + + 0.33*GLYALD + 0.33*CH3CO3 + 0.17*HYAC + + 0.17*CH3COCH3 + jhpald ( 46) HPALD + hv -> BIGALD3 + OH + HO2 rate = ** User defined ** ( 46) + jhyac ( 47) HYAC + hv -> CH3CO3 + HO2 + CH2O rate = ** User defined ** ( 47) + jisopnooh ( 48) ISOPNOOH + hv -> NO2 + HO2 + ISOPOOH rate = ** User defined ** ( 48) + jisopooh ( 49) ISOPOOH + hv -> 0.402*MVK + 0.288*MACR + 0.69*CH2O + HO2 rate = ** User defined ** ( 49) + jmacr_a ( 50) MACR + hv -> 1.34*HO2 + 0.66*MCO3 + 1.34*CH2O + 1.34*CH3CO3 rate = ** User defined ** ( 50) + jmacr_b ( 51) MACR + hv -> 0.66*HO2 + 1.34*CO rate = ** User defined ** ( 51) + jmek ( 52) MEK + hv -> CH3CO3 + C2H5O2 rate = ** User defined ** ( 52) + jmekooh ( 53) MEKOOH + hv -> OH + CH3CO3 + CH3CHO rate = ** User defined ** ( 53) + jmpan ( 54) MPAN + hv -> MCO3 + NO2 rate = ** User defined ** ( 54) + jmvk ( 55) MVK + hv -> 0.7*C3H6 + 0.7*CO + 0.3*CH3O2 + 0.3*CH3CO3 rate = ** User defined ** ( 55) + jnc4cho ( 56) NC4CHO + hv -> BIGALD3 + NO2 + HO2 rate = ** User defined ** ( 56) + jnoa ( 57) NOA + hv -> NO2 + CH2O + CH3CO3 rate = ** User defined ** ( 57) + jnterpooh ( 58) NTERPOOH + hv -> TERPROD1 + NO2 + OH rate = ** User defined ** ( 58) + jonitr ( 59) ONITR + hv -> NO2 rate = ** User defined ** ( 59) + jpan ( 60) PAN + hv -> 0.6*CH3CO3 + 0.6*NO2 + 0.4*CH3O2 + 0.4*NO3 + 0.4*CO2 rate = ** User defined ** ( 60) + jphenooh ( 61) PHENOOH + hv -> OH + HO2 + 0.7*GLYOXAL rate = ** User defined ** ( 61) + jpooh ( 62) POOH + hv -> CH3CHO + CH2O + HO2 + OH rate = ** User defined ** ( 62) + jrooh ( 63) ROOH + hv -> CH3CO3 + CH2O + OH rate = ** User defined ** ( 63) + jtepomuc ( 64) TEPOMUC + hv -> 0.5*CH3CO3 + HO2 + 1.5*CO rate = ** User defined ** ( 64) + jterp2ooh ( 65) TERP2OOH + hv -> OH + 0.375*CH2O + 0.3*CH3COCH3 + 0.25*CO + CO2 rate = ** User defined ** ( 65) + + TERPROD2 + HO2 + 0.25*GLYALD + jterpnit ( 66) TERPNIT + hv -> TERPROD1 + NO2 + HO2 rate = ** User defined ** ( 66) + jterpooh ( 67) TERPOOH + hv -> 0.4*CH2O + 0.05*CH3COCH3 + TERPROD1 + HO2 + OH rate = ** User defined ** ( 67) + jterprd1 ( 68) TERPROD1 + hv -> HO2 + CO + TERPROD2 rate = ** User defined ** ( 68) + jterprd2 ( 69) TERPROD2 + hv -> 0.15*RO2 + 0.68*CH2O + 0.8*CO2 + 0.5*CH3COCH3 rate = ** User defined ** ( 69) + + 0.65*CH3CO3 + 1.2*HO2 + 1.7*CO + jtolooh ( 70) TOLOOH + hv -> OH + 0.6*GLYOXAL + 0.4*CH3COCHO + HO2 + 0.2*BIGALD1 rate = ** User defined ** ( 70) + + 0.2*BIGALD2 + 0.2*BIGALD3 + jxooh ( 71) XOOH + hv -> OH rate = ** User defined ** ( 71) + jxylenooh ( 72) XYLENOOH + hv -> OH + HO2 + 0.34*GLYOXAL + 0.54*CH3COCHO rate = ** User defined ** ( 72) + + 0.06*BIGALD1 + 0.2*BIGALD2 + 0.15*BIGALD3 + + 0.21*BIGALD4 + jxylolooh ( 73) XYLOLOOH + hv -> OH + 0.17*GLYOXAL + 0.51*CH3COCHO + HO2 rate = ** User defined ** ( 73) + jbrcl ( 74) BRCL + hv -> BR + CL rate = ** User defined ** ( 74) + jbro ( 75) BRO + hv -> BR + O rate = ** User defined ** ( 75) + jbrono2_b ( 76) BRONO2 + hv -> BRO + NO2 rate = ** User defined ** ( 76) + jbrono2_a ( 77) BRONO2 + hv -> BR + NO3 rate = ** User defined ** ( 77) + jccl4 ( 78) CCL4 + hv -> 4*CL rate = ** User defined ** ( 78) + jcf2clbr ( 79) CF2CLBR + hv -> BR + CL + COF2 rate = ** User defined ** ( 79) + jcf3br ( 80) CF3BR + hv -> BR + F + COF2 rate = ** User defined ** ( 80) + jcfcl3 ( 81) CFC11 + hv -> 2*CL + COFCL rate = ** User defined ** ( 81) + jcfc113 ( 82) CFC113 + hv -> 2*CL + COFCL + COF2 rate = ** User defined ** ( 82) + jcfc114 ( 83) CFC114 + hv -> 2*CL + 2*COF2 rate = ** User defined ** ( 83) + jcfc115 ( 84) CFC115 + hv -> CL + F + 2*COF2 rate = ** User defined ** ( 84) + jcf2cl2 ( 85) CFC12 + hv -> 2*CL + COF2 rate = ** User defined ** ( 85) + jch2br2 ( 86) CH2BR2 + hv -> 2*BR rate = ** User defined ** ( 86) + jch3br ( 87) CH3BR + hv -> BR + CH3O2 rate = ** User defined ** ( 87) + jch3ccl3 ( 88) CH3CCL3 + hv -> 3*CL rate = ** User defined ** ( 88) + jch3cl ( 89) CH3CL + hv -> CL + CH3O2 rate = ** User defined ** ( 89) + jchbr3 ( 90) CHBR3 + hv -> 3*BR rate = ** User defined ** ( 90) + jcl2 ( 91) CL2 + hv -> 2*CL rate = ** User defined ** ( 91) + jcl2o2 ( 92) CL2O2 + hv -> 2*CL rate = ** User defined ** ( 92) + jclo ( 93) CLO + hv -> CL + O rate = ** User defined ** ( 93) + jclono2_a ( 94) CLONO2 + hv -> CL + NO3 rate = ** User defined ** ( 94) + jclono2_b ( 95) CLONO2 + hv -> CLO + NO2 rate = ** User defined ** ( 95) + jcof2 ( 96) COF2 + hv -> 2*F rate = ** User defined ** ( 96) + jcofcl ( 97) COFCL + hv -> F + CL rate = ** User defined ** ( 97) + jh2402 ( 98) H2402 + hv -> 2*BR + 2*COF2 rate = ** User defined ** ( 98) + jhbr ( 99) HBR + hv -> BR + H rate = ** User defined ** ( 99) + jhcfc141b (100) HCFC141B + hv -> CL + COFCL rate = ** User defined ** (100) + jhcfc142b (101) HCFC142B + hv -> CL + COF2 rate = ** User defined ** (101) + jhcfc22 (102) HCFC22 + hv -> CL + COF2 rate = ** User defined ** (102) + jhcl (103) HCL + hv -> H + CL rate = ** User defined ** (103) + jhf (104) HF + hv -> H + F rate = ** User defined ** (104) + jhobr (105) HOBR + hv -> BR + OH rate = ** User defined ** (105) + jhocl (106) HOCL + hv -> OH + CL rate = ** User defined ** (106) + joclo (107) OCLO + hv -> O + CLO rate = ** User defined ** (107) + jsf6 (108) SF6 + hv -> {sink} rate = ** User defined ** (108) + jh2so4 (109) H2SO4 + hv -> SO3 + H2O rate = ** User defined ** (109) + jocs (110) OCS + hv -> S + CO rate = ** User defined ** (110) + jso (111) SO + hv -> S + O rate = ** User defined ** (111) + jso2 (112) SO2 + hv -> SO + O rate = ** User defined ** (112) + jso3 (113) SO3 + hv -> SO2 + O rate = ** User defined ** (113) + + Reactions + O1D_H2 ( 1) O1D + H2 -> H + OH rate = 1.20E-10 (114) + O1D_H2O ( 2) O1D + H2O -> 2*OH rate = 1.63E-10*exp( 60./t) (115) + O1D_N2 ( 3) O1D + N2 -> O + N2 rate = 2.15E-11*exp( 110./t) (116) + O1D_O2ab ( 4) O1D + O2 -> O + O2 rate = 3.30E-11*exp( 55./t) (117) + O1D_O3 ( 5) O1D + O3 -> O2 + O2 rate = 1.20E-10 (118) + O_O3 ( 6) O + O3 -> 2*O2 rate = 8.00E-12*exp( -2060./t) (119) + usr_O_O ( 7) O + O + M -> O2 + M rate = ** User defined ** (120) + usr_O_O2 ( 8) O + O2 + M -> O3 + M rate = ** User defined ** (121) + H2_O ( 9) H2 + O -> OH + H rate = 1.60E-11*exp( -4570./t) (122) + H2O2_O ( 10) H2O2 + O -> OH + HO2 rate = 1.40E-12*exp( -2000./t) (123) + H_HO2 ( 11) H + HO2 -> H2 + O2 rate = 6.90E-12 (124) + H_HO2a ( 12) H + HO2 -> 2*OH rate = 7.20E-11 (125) + H_HO2b ( 13) H + HO2 -> H2O + O rate = 1.60E-12 (126) + H_O2 ( 14) H + O2 + M -> HO2 + M troe : ko=4.40E-32*(300/t)**1.30 (127) + ki=7.50E-11*(300/t)**-0.20 + f=0.60 + HO2_O ( 15) HO2 + O -> OH + O2 rate = 3.00E-11*exp( 200./t) (128) + HO2_O3 ( 16) HO2 + O3 -> OH + 2*O2 rate = 1.00E-14*exp( -490./t) (129) + H_O3 ( 17) H + O3 -> OH + O2 rate = 1.40E-10*exp( -470./t) (130) + OH_H2 ( 18) OH + H2 -> H2O + H rate = 2.80E-12*exp( -1800./t) (131) + OH_H2O2 ( 19) OH + H2O2 -> H2O + HO2 rate = 1.80E-12 (132) + OH_HO2 ( 20) OH + HO2 -> H2O + O2 rate = 4.80E-11*exp( 250./t) (133) + OH_O ( 21) OH + O -> H + O2 rate = 1.80E-11*exp( 180./t) (134) + OH_O3 ( 22) OH + O3 -> HO2 + O2 rate = 1.70E-12*exp( -940./t) (135) + OH_OH ( 23) OH + OH -> H2O + O rate = 1.80E-12 (136) + OH_OH_M ( 24) OH + OH + M -> H2O2 + M troe : ko=6.90E-31*(300/t)**1.00 (137) + ki=2.60E-11 + f=0.60 + usr_HO2_HO2 ( 25) HO2 + HO2 -> H2O2 + O2 rate = ** User defined ** (138) + HO2NO2_OH ( 26) HO2NO2 + OH -> H2O + NO2 + O2 rate = 1.30E-12*exp( 380./t) (139) + N_NO ( 27) N + NO -> N2 + O rate = 2.10E-11*exp( 100./t) (140) + N_NO2a ( 28) N + NO2 -> N2O + O rate = 2.90E-12*exp( 220./t) (141) + N_NO2b ( 29) N + NO2 -> 2*NO rate = 1.45E-12*exp( 220./t) (142) + N_NO2c ( 30) N + NO2 -> N2 + O2 rate = 1.45E-12*exp( 220./t) (143) + N_O2 ( 31) N + O2 -> NO + O rate = 1.50E-11*exp( -3600./t) (144) + NO2_O ( 32) NO2 + O -> NO + O2 rate = 5.10E-12*exp( 210./t) (145) + NO2_O3 ( 33) NO2 + O3 -> NO3 + O2 rate = 1.20E-13*exp( -2450./t) (146) + NO2_O_M ( 34) NO2 + O + M -> NO3 + M troe : ko=2.50E-31*(300/t)**1.80 (147) + ki=2.20E-11*(300/t)**0.70 + f=0.60 + NO3_HO2 ( 35) NO3 + HO2 -> OH + NO2 + O2 rate = 3.50E-12 (148) + NO3_NO ( 36) NO3 + NO -> 2*NO2 rate = 1.50E-11*exp( 170./t) (149) + NO3_O ( 37) NO3 + O -> NO2 + O2 rate = 1.00E-11 (150) + NO3_OH ( 38) NO3 + OH -> HO2 + NO2 rate = 2.20E-11 (151) + N_OH ( 39) N + OH -> NO + H rate = 5.00E-11 (152) + NO_HO2 ( 40) NO + HO2 -> NO2 + OH rate = 3.30E-12*exp( 270./t) (153) + NO_O3 ( 41) NO + O3 -> NO2 + O2 rate = 3.00E-12*exp( -1500./t) (154) + NO_O_M ( 42) NO + O + M -> NO2 + M troe : ko=9.00E-32*(300/t)**1.50 (155) + ki=3.00E-11 + f=0.60 + O1D_N2Oa ( 43) O1D + N2O -> 2*NO rate = 7.26E-11*exp( 20./t) (156) + O1D_N2Ob ( 44) O1D + N2O -> N2 + O2 rate = 4.64E-11*exp( 20./t) (157) + tag_NO2_HO2 ( 45) NO2 + HO2 + M -> HO2NO2 + M troe : ko=1.90E-31*(300/t)**3.40 (158) + ki=4.00E-12*(300/t)**0.30 + f=0.60 + tag_NO2_NO3 ( 46) NO2 + NO3 + M -> N2O5 + M troe : ko=2.40E-30*(300/t)**3.00 (159) + ki=1.60E-12*(300/t)**-0.10 + f=0.60 + tag_NO2_OH ( 47) NO2 + OH + M -> HNO3 + M troe : ko=1.80E-30*(300/t)**3.00 (160) + ki=2.80E-11 + f=0.60 + usr_HNO3_OH ( 48) HNO3 + OH -> NO3 + H2O rate = ** User defined ** (161) + usr_HO2NO2_M ( 49) HO2NO2 + M -> HO2 + NO2 + M rate = ** User defined ** (162) + usr_N2O5_M ( 50) N2O5 + M -> NO2 + NO3 + M rate = ** User defined ** (163) + CL_CH2O ( 51) CL + CH2O -> HCL + HO2 + CO rate = 8.10E-11*exp( -30./t) (164) + CL_CH4 ( 52) CL + CH4 -> CH3O2 + HCL rate = 7.10E-12*exp( -1270./t) (165) + CL_H2 ( 53) CL + H2 -> HCL + H rate = 3.05E-11*exp( -2270./t) (166) + CL_H2O2 ( 54) CL + H2O2 -> HCL + HO2 rate = 1.10E-11*exp( -980./t) (167) + CL_HO2a ( 55) CL + HO2 -> HCL + O2 rate = 1.40E-11*exp( 270./t) (168) + CL_HO2b ( 56) CL + HO2 -> OH + CLO rate = 3.60E-11*exp( -375./t) (169) + CL_O3 ( 57) CL + O3 -> CLO + O2 rate = 2.30E-11*exp( -200./t) (170) + CLO_CH3O2 ( 58) CLO + CH3O2 -> CL + HO2 + CH2O rate = 3.30E-12*exp( -115./t) (171) + CLO_CLOa ( 59) CLO + CLO -> 2*CL + O2 rate = 3.00E-11*exp( -2450./t) (172) + CLO_CLOb ( 60) CLO + CLO -> CL2 + O2 rate = 1.00E-12*exp( -1590./t) (173) + CLO_CLOc ( 61) CLO + CLO -> CL + OCLO rate = 3.50E-13*exp( -1370./t) (174) + CLO_HO2 ( 62) CLO + HO2 -> O2 + HOCL rate = 2.60E-12*exp( 290./t) (175) + CLO_NO ( 63) CLO + NO -> NO2 + CL rate = 6.40E-12*exp( 290./t) (176) + CLONO2_CL ( 64) CLONO2 + CL -> CL2 + NO3 rate = 6.50E-12*exp( 135./t) (177) + CLO_NO2_M ( 65) CLO + NO2 + M -> CLONO2 + M troe : ko=1.80E-31*(300/t)**3.40 (178) + ki=1.50E-11*(300/t)**1.90 + f=0.60 + CLONO2_O ( 66) CLONO2 + O -> CLO + NO3 rate = 3.60E-12*exp( -840./t) (179) + CLONO2_OH ( 67) CLONO2 + OH -> HOCL + NO3 rate = 1.20E-12*exp( -330./t) (180) + CLO_O ( 68) CLO + O -> CL + O2 rate = 2.80E-11*exp( 85./t) (181) + CLO_OHa ( 69) CLO + OH -> CL + HO2 rate = 7.40E-12*exp( 270./t) (182) + CLO_OHb ( 70) CLO + OH -> HCL + O2 rate = 6.00E-13*exp( 230./t) (183) + HCL_O ( 71) HCL + O -> CL + OH rate = 1.00E-11*exp( -3300./t) (184) + HCL_OH ( 72) HCL + OH -> H2O + CL rate = 1.80E-12*exp( -250./t) (185) + HOCL_CL ( 73) HOCL + CL -> HCL + CLO rate = 3.40E-12*exp( -130./t) (186) + HOCL_O ( 74) HOCL + O -> CLO + OH rate = 1.70E-13 (187) + HOCL_OH ( 75) HOCL + OH -> H2O + CLO rate = 3.00E-12*exp( -500./t) (188) + O1D_CCL4 ( 76) O1D + CCL4 -> 4*CL rate = 2.61E-10 (189) + O1D_CF2CLBR ( 77) O1D + CF2CLBR -> CL + BR + COF2 rate = 9.75E-11 (190) + O1D_CFC11 ( 78) O1D + CFC11 -> 2*CL + COFCL rate = 2.07E-10 (191) + O1D_CFC113 ( 79) O1D + CFC113 -> 2*CL + COFCL + COF2 rate = 2.09E-10 (192) + O1D_CFC114 ( 80) O1D + CFC114 -> 2*CL + 2*COF2 rate = 1.17E-10 (193) + O1D_CFC115 ( 81) O1D + CFC115 -> CL + F + 2*COF2 rate = 4.64E-11 (194) + O1D_CFC12 ( 82) O1D + CFC12 -> 2*CL + COF2 rate = 1.20E-10 (195) + O1D_HCLa ( 83) O1D + HCL -> CL + OH rate = 9.90E-11 (196) + O1D_HCLb ( 84) O1D + HCL -> CLO + H rate = 3.30E-12 (197) + tag_CLO_CLO_M ( 85) CLO + CLO + M -> CL2O2 + M troe : ko=1.90E-32*(300/t)**3.60 (198) + ki=3.70E-12*(300/t)**1.60 + f=0.60 + usr_CL2O2_M ( 86) CL2O2 + M -> CLO + CLO + M rate = ** User defined ** (199) + BR_CH2O ( 87) BR + CH2O -> HBR + HO2 + CO rate = 1.70E-11*exp( -800./t) (200) + BR_HO2 ( 88) BR + HO2 -> HBR + O2 rate = 4.80E-12*exp( -310./t) (201) + BR_O3 ( 89) BR + O3 -> BRO + O2 rate = 1.60E-11*exp( -780./t) (202) + BRO_BRO ( 90) BRO + BRO -> 2*BR + O2 rate = 1.50E-12*exp( 230./t) (203) + BRO_CLOa ( 91) BRO + CLO -> BR + OCLO rate = 9.50E-13*exp( 550./t) (204) + BRO_CLOb ( 92) BRO + CLO -> BR + CL + O2 rate = 2.30E-12*exp( 260./t) (205) + BRO_CLOc ( 93) BRO + CLO -> BRCL + O2 rate = 4.10E-13*exp( 290./t) (206) + BRO_HO2 ( 94) BRO + HO2 -> HOBR + O2 rate = 4.50E-12*exp( 460./t) (207) + BRO_NO ( 95) BRO + NO -> BR + NO2 rate = 8.80E-12*exp( 260./t) (208) + BRO_NO2_M ( 96) BRO + NO2 + M -> BRONO2 + M troe : ko=5.20E-31*(300/t)**3.20 (209) + ki=6.90E-12*(300/t)**2.90 + f=0.60 + BRONO2_O ( 97) BRONO2 + O -> BRO + NO3 rate = 1.90E-11*exp( 215./t) (210) + BRO_O ( 98) BRO + O -> BR + O2 rate = 1.90E-11*exp( 230./t) (211) + BRO_OH ( 99) BRO + OH -> BR + HO2 rate = 1.70E-11*exp( 250./t) (212) + HBR_O (100) HBR + O -> BR + OH rate = 5.80E-12*exp( -1500./t) (213) + HBR_OH (101) HBR + OH -> BR + H2O rate = 5.50E-12*exp( 200./t) (214) + HOBR_O (102) HOBR + O -> BRO + OH rate = 1.20E-10*exp( -430./t) (215) + O1D_CF3BR (103) O1D + CF3BR -> BR + F + COF2 rate = 4.50E-11 (216) + O1D_CHBR3 (104) O1D + CHBR3 -> 3*BR rate = 4.62E-10 (217) + O1D_H2402 (105) O1D + H2402 -> 2*BR + 2*COF2 rate = 1.20E-10 (218) + O1D_HBRa (106) O1D + HBR -> BR + OH rate = 9.00E-11 (219) + O1D_HBRb (107) O1D + HBR -> BRO + H rate = 3.00E-11 (220) + F_CH4 (108) F + CH4 -> HF + CH3O2 rate = 1.60E-10*exp( -260./t) (221) + F_H2 (109) F + H2 -> HF + H rate = 1.40E-10*exp( -500./t) (222) + F_H2O (110) F + H2O -> HF + OH rate = 1.40E-11 (223) + F_HNO3 (111) F + HNO3 -> HF + NO3 rate = 6.00E-12*exp( 400./t) (224) + O1D_COF2 (112) O1D + COF2 -> 2*F rate = 2.14E-11 (225) + O1D_COFCL (113) O1D + COFCL -> F + CL rate = 1.90E-10 (226) + CH2BR2_CL (114) CH2BR2 + CL -> 2*BR + HCL rate = 6.30E-12*exp( -800./t) (227) + CH2BR2_OH (115) CH2BR2 + OH -> 2*BR + H2O rate = 2.00E-12*exp( -840./t) (228) + CH3BR_CL (116) CH3BR + CL -> HCL + HO2 + BR rate = 1.46E-11*exp( -1040./t) (229) + CH3BR_OH (117) CH3BR + OH -> BR + H2O + HO2 rate = 1.42E-12*exp( -1150./t) (230) + CH3CCL3_OH (118) CH3CCL3 + OH -> H2O + 3*CL rate = 1.64E-12*exp( -1520./t) (231) + CH3CL_CL (119) CH3CL + CL -> HO2 + CO + 2*HCL rate = 2.03E-11*exp( -1100./t) (232) + CH3CL_OH (120) CH3CL + OH -> CL + H2O + HO2 rate = 1.96E-12*exp( -1200./t) (233) + CHBR3_CL (121) CHBR3 + CL -> 3*BR + HCL rate = 4.85E-12*exp( -850./t) (234) + CHBR3_OH (122) CHBR3 + OH -> 3*BR rate = 9.00E-13*exp( -360./t) (235) + HCFC141B_OH (123) HCFC141B + OH -> CL + COFCL rate = 1.25E-12*exp( -1600./t) (236) + HCFC142B_OH (124) HCFC142B + OH -> CL + COF2 rate = 1.30E-12*exp( -1770./t) (237) + HCFC22_OH (125) HCFC22 + OH -> H2O + CL + COF2 rate = 9.20E-13*exp( -1560./t) (238) + O1D_CH2BR2 (126) O1D + CH2BR2 -> 2*BR rate = 2.57E-10 (239) + O1D_CH3BR (127) O1D + CH3BR -> BR rate = 1.80E-10 (240) + O1D_HCFC141B (128) O1D + HCFC141B -> CL + COFCL rate = 1.79E-10 (241) + O1D_HCFC142B (129) O1D + HCFC142B -> CL + COF2 rate = 1.30E-10 (242) + O1D_HCFC22 (130) O1D + HCFC22 -> CL + COF2 rate = 7.65E-11 (243) + CH2O_HO2 (131) CH2O + HO2 -> HOCH2OO rate = 9.70E-15*exp( 625./t) (244) + CH2O_NO3 (132) CH2O + NO3 -> CO + HO2 + HNO3 rate = 6.00E-13*exp( -2058./t) (245) + CH2O_O (133) CH2O + O -> HO2 + OH + CO rate = 3.40E-11*exp( -1600./t) (246) + CH2O_OH (134) CH2O + OH -> CO + H2O + H rate = 5.50E-12*exp( 125./t) (247) + CH3O2_CH3O2a (135) CH3O2 + CH3O2 -> 2*CH2O + 2*HO2 rate = 5.00E-13*exp( -424./t) (248) + CH3O2_CH3O2b (136) CH3O2 + CH3O2 -> CH2O + CH3OH rate = 1.90E-14*exp( 706./t) (249) + CH3O2_HO2 (137) CH3O2 + HO2 -> CH3OOH + O2 rate = 4.10E-13*exp( 750./t) (250) + CH3O2_NO (138) CH3O2 + NO -> CH2O + NO2 + HO2 rate = 2.80E-12*exp( 300./t) (251) + CH3OH_OH (139) CH3OH + OH -> HO2 + CH2O rate = 2.90E-12*exp( -345./t) (252) + CH3OOH_OH (140) CH3OOH + OH -> 0.7*CH3O2 + 0.3*OH + 0.3*CH2O + H2O rate = 3.80E-12*exp( 200./t) (253) + CH4_OH (141) CH4 + OH -> CH3O2 + H2O rate = 2.45E-12*exp( -1775./t) (254) + CO_OH_M (142) CO + OH + M -> CO2 + HO2 + M troe : ko=5.90E-33*(300/t)**1.00 (255) + ki=1.10E-12*(300/t)**-1.30 + f=0.60 + HCN_OH (143) HCN + OH + M -> HO2 + M troe : ko=4.28E-33 (256) + ki=9.30E-15*(300/t)**-4.42 + f=0.80 + HCOOH_OH (144) HCOOH + OH -> HO2 + CO2 + H2O rate = 4.00E-13 (257) + HOCH2OO_HO2 (145) HOCH2OO + HO2 -> HCOOH rate = 7.50E-13*exp( 700./t) (258) + HOCH2OO_M (146) HOCH2OO -> CH2O + HO2 rate = 2.40E+12*exp( -7000./t) (259) + HOCH2OO_NO (147) HOCH2OO + NO -> HCOOH + NO2 + HO2 rate = 2.60E-12*exp( 265./t) (260) + O1D_CH4a (148) O1D + CH4 -> CH3O2 + OH rate = 1.31E-10 (261) + O1D_CH4b (149) O1D + CH4 -> CH2O + H + HO2 rate = 3.50E-11 (262) + O1D_CH4c (150) O1D + CH4 -> CH2O + H2 rate = 9.00E-12 (263) + O1D_HCN (151) O1D + HCN -> OH rate = 1.08E-10*exp( 105./t) (264) + usr_CO_OH_b (152) CO + OH -> CO2 + H rate = ** User defined ** (265) + C2H2_CL_M (153) C2H2 + CL + M -> CL + M troe : ko=5.20E-30*(300/t)**2.40 (266) + ki=2.20E-10*(300/t)**0.70 + f=0.60 + C2H2_OH_M (154) C2H2 + OH + M -> 0.65*GLYOXAL + 0.65*OH + 0.35*HCOOH + 0.35*HO2 troe : ko=5.50E-30 (267) + + 0.35*CO + M ki=8.30E-13*(300/t)**-2.00 + f=0.60 + C2H4_CL_M (155) C2H4 + CL + M -> CL + M troe : ko=1.60E-29*(300/t)**3.30 (268) + ki=3.10E-10*(300/t) + f=0.60 + C2H4_O3 (156) C2H4 + O3 -> 0.63*CO + 0.13*OH + 0.13*HO2 + 0.37*HCOOH + CH2O rate = 1.20E-14*exp( -2630./t) (269) + C2H5O2_C2H5O2 (157) C2H5O2 + C2H5O2 -> 1.6*CH3CHO + 1.2*HO2 + 0.4*C2H5OH rate = 6.80E-14 (270) + C2H5O2_CH3O2 (158) C2H5O2 + CH3O2 -> 0.7*CH2O + 0.8*CH3CHO + HO2 + 0.3*CH3OH rate = 2.00E-13 (271) + + 0.2*C2H5OH + C2H5O2_HO2 (159) C2H5O2 + HO2 -> C2H5OOH + O2 rate = 7.50E-13*exp( 700./t) (272) + C2H5O2_NO (160) C2H5O2 + NO -> CH3CHO + HO2 + NO2 rate = 2.60E-12*exp( 365./t) (273) + C2H5OH_OH (161) C2H5OH + OH -> HO2 + CH3CHO rate = 6.90E-12*exp( -230./t) (274) + C2H5OOH_OH (162) C2H5OOH + OH -> 0.5*C2H5O2 + 0.5*CH3CHO + 0.5*OH rate = 3.80E-12*exp( 200./t) (275) + C2H6_CL (163) C2H6 + CL -> HCL + C2H5O2 rate = 7.20E-11*exp( -70./t) (276) + C2H6_OH (164) C2H6 + OH -> C2H5O2 + H2O rate = 7.66E-12*exp( -1020./t) (277) + CH3CHO_NO3 (165) CH3CHO + NO3 -> CH3CO3 + HNO3 rate = 1.40E-12*exp( -1900./t) (278) + CH3CHO_OH (166) CH3CHO + OH -> CH3CO3 + H2O rate = 4.63E-12*exp( 350./t) (279) + CH3CN_OH (167) CH3CN + OH -> HO2 rate = 7.80E-13*exp( -1050./t) (280) + CH3CO3_CH3CO3 (168) CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 rate = 2.90E-12*exp( 500./t) (281) + CH3CO3_CH3O2 (169) CH3CO3 + CH3O2 -> 0.9*CH3O2 + CH2O + 0.9*HO2 + 0.9*CO2 rate = 2.00E-12*exp( 500./t) (282) + + 0.1*CH3COOH + CH3CO3_HO2 (170) CH3CO3 + HO2 -> 0.4*CH3COOOH + 0.15*CH3COOH + 0.15*O3 + 0.45*OH rate = 4.30E-13*exp( 1040./t) (283) + + 0.45*CH3O2 + CH3CO3_NO (171) CH3CO3 + NO -> CH3O2 + CO2 + NO2 rate = 8.10E-12*exp( 270./t) (284) + CH3COOH_OH (172) CH3COOH + OH -> CH3O2 + CO2 + H2O rate = 7.00E-13 (285) + CH3COOOH_OH (173) CH3COOOH + OH -> 0.5*CH3CO3 + 0.5*CH2O + 0.5*CO2 + H2O rate = 1.00E-12 (286) + EO2_HO2 (174) EO2 + HO2 -> EOOH rate = 7.50E-13*exp( 700./t) (287) + EO2_NO (175) EO2 + NO -> 0.5*CH2O + 0.25*HO2 + 0.75*EO + NO2 rate = 4.20E-12*exp( 180./t) (288) + EO_M (176) EO -> 2*CH2O + HO2 rate = 1.60E+11*exp( -4150./t) (289) + EO_O2 (177) EO + O2 -> GLYALD + HO2 rate = 1.00E-14 (290) + GLYALD_OH (178) GLYALD + OH -> HO2 + 0.2*GLYOXAL + 0.8*CH2O + 0.8*CO2 rate = 1.00E-11 (291) + GLYOXAL_OH (179) GLYOXAL + OH -> HO2 + CO + CO2 rate = 1.15E-11 (292) + PAN_OH (180) PAN + OH -> CH2O + NO3 rate = 4.00E-14 (293) + tag_C2H4_OH (181) C2H4 + OH + M -> EO2 + M troe : ko=8.60E-29*(300/t)**3.10 (294) + ki=9.00E-12*(300/t)**0.85 + f=0.48 + tag_CH3CO3_NO2 (182) CH3CO3 + NO2 + M -> PAN + M troe : ko=9.70E-29*(300/t)**5.60 (295) + ki=9.30E-12*(300/t)**1.50 + f=0.60 + usr_PAN_M (183) PAN + M -> CH3CO3 + NO2 + M rate = ** User defined ** (296) + C3H6_NO3 (184) C3H6 + NO3 -> NOA rate = 4.60E-13*exp( -1156./t) (297) + C3H6_O3 (185) C3H6 + O3 -> 0.5*CH2O + 0.12*HCOOH + 0.12*CH3COOH + 0.5*CH3CHO rate = 6.50E-15*exp( -1900./t) (298) + + 0.56*CO + 0.28*CH3O2 + 0.1*CH4 + 0.2*CO2 + 0.28*HO2 + + 0.36*OH + C3H7O2_CH3O2 (186) C3H7O2 + CH3O2 -> CH2O + HO2 + 0.82*CH3COCH3 rate = 3.75E-13*exp( -40./t) (299) + C3H7O2_HO2 (187) C3H7O2 + HO2 -> C3H7OOH + O2 rate = 7.50E-13*exp( 700./t) (300) + C3H7O2_NO (188) C3H7O2 + NO -> 0.82*CH3COCH3 + NO2 + HO2 + 0.27*CH3CHO rate = 4.20E-12*exp( 180./t) (301) + C3H7OOH_OH (189) C3H7OOH + OH -> H2O + C3H7O2 rate = 3.80E-12*exp( 200./t) (302) + C3H8_OH (190) C3H8 + OH -> C3H7O2 + H2O rate = 8.70E-12*exp( -615./t) (303) + CH3COCHO_NO3 (191) CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 rate = 1.40E-12*exp( -1860./t) (304) + CH3COCHO_OH (192) CH3COCHO + OH -> CH3CO3 + CO + H2O rate = 8.40E-13*exp( 830./t) (305) + HYAC_OH (193) HYAC + OH -> CH3COCHO + HO2 rate = 3.00E-12 (306) + NOA_OH (194) NOA + OH -> NO2 + CH3COCHO rate = 6.70E-13 (307) + PO2_HO2 (195) PO2 + HO2 -> POOH + O2 rate = 7.50E-13*exp( 700./t) (308) + PO2_NO (196) PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 rate = 4.20E-12*exp( 180./t) (309) + POOH_OH (197) POOH + OH -> 0.5*PO2 + 0.5*OH + 0.5*HYAC + H2O rate = 3.80E-12*exp( 200./t) (310) + RO2_CH3O2 (198) RO2 + CH3O2 -> 0.3*CH3CO3 + 0.8*CH2O + 0.3*HO2 + 0.2*HYAC rate = 7.10E-13*exp( 500./t) (311) + + 0.5*CH3COCHO + 0.5*CH3OH + RO2_HO2 (199) RO2 + HO2 -> 0.85*ROOH + 0.15*OH + 0.15*CH2O + 0.15*CH3CO3 rate = 8.60E-13*exp( 700./t) (312) + RO2_NO (200) RO2 + NO -> CH3CO3 + CH2O + NO2 rate = 2.90E-12*exp( 300./t) (313) + ROOH_OH (201) ROOH + OH -> RO2 + H2O rate = 3.80E-12*exp( 200./t) (314) + tag_C3H6_OH (202) C3H6 + OH + M -> PO2 + M troe : ko=8.00E-27*(300/t)**3.50 (315) + ki=3.00E-11 + f=0.50 + usr_CH3COCH3_OH (203) CH3COCH3 + OH -> RO2 + H2O rate = ** User defined ** (316) + BIGENE_NO3 (204) BIGENE + NO3 -> NO2 + CH3CHO + 0.5*CH2O + 0.5*CH3COCH3 rate = 3.50E-13 (317) + BIGENE_OH (205) BIGENE + OH -> ENEO2 rate = 5.40E-11 (318) + ENEO2_NO (206) ENEO2 + NO -> CH3CHO + 0.5*CH2O + 0.5*CH3COCH3 + HO2 + NO2 rate = 4.80E-12*exp( 120./t) (319) + ENEO2_NOb (207) ENEO2 + NO -> HONITR rate = 5.10E-14*exp( 693./t) (320) + HONITR_OH (208) HONITR + OH -> ONITR + HO2 rate = 2.00E-12 (321) + MACRO2_CH3CO3 (209) MACRO2 + CH3CO3 -> 0.25*CH3COCHO + CH3O2 + 0.22*CO + 0.47*HO2 rate = 1.40E-11 (322) + + 0.53*GLYALD + 0.22*HYAC + 0.25*CH2O + + 0.53*CH3CO3 + MACRO2_CH3O2 (210) MACRO2 + CH3O2 -> 0.73*HO2 + 0.88*CH2O + 0.11*CO + 0.24*CH3COCHO rate = 5.00E-13*exp( 400./t) (323) + + 0.26*GLYALD + 0.26*CH3CO3 + 0.25*CH3OH + + 0.23*HYAC + MACRO2_HO2 (211) MACRO2 + HO2 -> MACROOH rate = 8.00E-13*exp( 700./t) (324) + MACRO2_NO3 (212) MACRO2 + NO3 -> NO2 + 0.47*HO2 + 0.25*CH2O + 0.25*CH3COCHO rate = 2.40E-12 (325) + + 0.22*CO + 0.53*GLYALD + 0.22*HYAC + 0.53*CH3CO3 + MACRO2_NOa (213) MACRO2 + NO -> NO2 + 0.47*HO2 + 0.25*CH2O + 0.53*GLYALD rate = 2.70E-12*exp( 360./t) (326) + + 0.25*CH3COCHO + 0.53*CH3CO3 + 0.22*HYAC + 0.22*CO + MACRO2_NOb (214) MACRO2 + NO -> HONITR rate = 1.30E-13*exp( 360./t) (327) + MACR_O3 (215) MACR + O3 -> 0.12*CH2O + 0.24*OH + 0.65*CO + 0.1*CH3CO3 rate = 1.50E-15*exp( -2100./t) (328) + + 0.88*CH3COCHO + 0.33*HCOOH + 0.14*HO2 + MACR_OH (216) MACR + OH -> 0.5*MACRO2 + 0.5*H2O + 0.5*MCO3 rate = 9.60E-12*exp( 360./t) (329) + MACROOH_OH (217) MACROOH + OH -> 0.5*MCO3 + 0.2*MACRO2 + 0.1*OH + 0.2*HO2 rate = 2.30E-11*exp( 200./t) (330) + MCO3_CH3CO3 (218) MCO3 + CH3CO3 -> 2*CO2 + CH3O2 + CH2O + CH3CO3 rate = 4.60E-12*exp( 530./t) (331) + MCO3_CH3O2 (219) MCO3 + CH3O2 -> 2*CH2O + HO2 + CO2 + CH3CO3 rate = 2.00E-12*exp( 500./t) (332) + MCO3_HO2 (220) MCO3 + HO2 -> 0.15*O3 + 0.15*CH3COOH + 0.4*CH3COOOH + 0.45*OH rate = 4.30E-13*exp( 1040./t) (333) + + 0.45*CO2 + 0.45*CH2O + 0.45*CH3CO3 + MCO3_MCO3 (221) MCO3 + MCO3 -> 2*CO2 + 2*CH2O + 2*CH3CO3 rate = 2.30E-12*exp( 530./t) (334) + MCO3_NO (222) MCO3 + NO -> NO2 + CH2O + CH3CO3 rate = 5.30E-12*exp( 360./t) (335) + MCO3_NO3 (223) MCO3 + NO3 -> NO2 + CH2O + CH3CO3 rate = 5.00E-12 (336) + MEKO2_HO2 (224) MEKO2 + HO2 -> 0.8*MEKOOH + 0.2*OH + 0.2*CH3CHO + 0.2*CH3CO3 rate = 7.50E-13*exp( 700./t) (337) + MEKO2_NO (225) MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 rate = 4.20E-12*exp( 180./t) (338) + MEK_OH (226) MEK + OH -> MEKO2 rate = 2.30E-12*exp( -170./t) (339) + MEKOOH_OH (227) MEKOOH + OH -> MEKO2 rate = 3.80E-12*exp( 200./t) (340) + MPAN_OH_M (228) MPAN + OH + M -> 0.5*HYAC + 0.5*NO3 + 0.5*CH2O + 0.5*HO2 + 0.5*CO2 troe : ko=8.00E-27*(300/t)**3.50 (341) + + M + 0.5*NDEP ki=3.00E-11 + f=0.50 + MVK_O3 (229) MVK + O3 -> 0.6*CH2O + 0.56*CO + 0.1*CH3CHO + 0.1*CO2 + 0.28*CH3CO3 rate = 8.50E-16*exp( -1520./t) (342) + + 0.5*CH3COCHO + 0.28*HO2 + 0.36*OH + 0.12*HCOOH + MVK_OH (230) MVK + OH -> MACRO2 rate = 4.13E-12*exp( 452./t) (343) + usr_MCO3_NO2 (231) MCO3 + NO2 + M -> MPAN + M rate = ** User defined ** (344) + usr_MPAN_M (232) MPAN + M -> MCO3 + NO2 + M rate = ** User defined ** (345) + ALKNIT_OH (233) ALKNIT + OH -> 0.4*CH2O + 0.8*CH3CHO + 0.8*CH3COCH3 + NO2 rate = 1.60E-12 (346) + ALKO2_HO2 (234) ALKO2 + HO2 -> ALKOOH rate = 7.50E-13*exp( 700./t) (347) + ALKO2_NO (235) ALKO2 + NO -> 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + HO2 + 0.8*MEK rate = 6.70E-12 (348) + + NO2 + ALKO2_NOb (236) ALKO2 + NO -> ALKNIT rate = 5.40E-14*exp( 870./t) (349) + ALKOOH_OH (237) ALKOOH + OH -> ALKO2 rate = 3.80E-12*exp( 200./t) (350) + BIGALK_OH (238) BIGALK + OH -> ALKO2 rate = 3.50E-12 (351) + HPALD_OH (239) HPALD + OH -> XO2 rate = 1.86E-11*exp( 175./t) (352) + HYDRALD_OH (240) HYDRALD + OH -> XO2 rate = 1.86E-11*exp( 175./t) (353) + IEPOX_OH (241) IEPOX + OH -> XO2 rate = 1.30E-11 (354) + ISOPAO2_CH3CO3 (242) ISOPAO2 + CH3CO3 -> CH3O2 + HO2 + CH2O + 0.39*MACR + 0.61*MVK + CO2 rate = 1.40E-11 (355) + ISOPAO2_CH3O2 (243) ISOPAO2 + CH3O2 -> 0.25*CH3OH + HO2 + 1.5*CH2O + 0.31*MACR rate = 5.00E-13*exp( 400./t) (356) + + 0.44*MVK + ISOPAO2_HO2 (244) ISOPAO2 + HO2 -> ISOPOOH rate = 8.00E-13*exp( 700./t) (357) + ISOPAO2_NO (245) ISOPAO2 + NO -> 0.08*ISOPNITA + 0.92*NO2 + 0.36*MACR + 0.56*MVK rate = 4.40E-12*exp( 180./t) (358) + + 0.92*CH2O + 0.92*HO2 + ISOPAO2_NO3 (246) ISOPAO2 + NO3 -> NO2 + 0.4*MACR + 0.6*MVK + CH2O + HO2 rate = 2.40E-12 (359) + ISOPBO2_CH3CO3 (247) ISOPBO2 + CH3CO3 -> HYDRALD + CH3O2 + HO2 rate = 1.40E-11 (360) + ISOPBO2_CH3O2 (248) ISOPBO2 + CH3O2 -> 0.25*CH3OH + HO2 + 0.75*CH2O + 0.75*HYDRALD rate = 5.00E-13*exp( 400./t) (361) + ISOPBO2_HO2 (249) ISOPBO2 + HO2 -> ISOPOOH rate = 8.00E-13*exp( 700./t) (362) + ISOPBO2_M (250) ISOPBO2 -> HPALD + HO2 rate = 1.60E+09*exp( -8300./t) (363) + ISOPBO2_NO (251) ISOPBO2 + NO -> 0.87*HYDRALD + 0.08*ISOPNITB + 0.92*NO2 + 0.92*HO2 rate = 4.40E-12*exp( 180./t) (364) + + 0.05*GLYOXAL + 0.05*GLYALD + 0.05*CH3COCHO + + 0.05*HYAC + ISOPBO2_NO3 (252) ISOPBO2 + NO3 -> NO2 + 0.95*HYDRALD + HO2 + 0.05*GLYOXAL rate = 2.40E-12 (365) + + 0.05*GLYALD + 0.05*CH3COCHO + 0.05*HYAC + ISOPNITA_OH (253) ISOPNITA + OH -> 0.7*HYAC + 0.7*GLYALD + 0.7*NO2 + 0.3*CH2O rate = 4.00E-11 (366) + + 0.3*HONITR + 0.3*HO2 + ISOPNITB_OH (254) ISOPNITB + OH -> 0.5*HYAC + 0.5*GLYALD + 0.5*NOA + HO2 + 0.5*HONITR rate = 4.00E-11 (367) + ISOP_NO3 (255) ISOP + NO3 -> ISOPNO3 rate = 3.03E-12*exp( -446./t) (368) + ISOPNO3_CH3CO3 (256) ISOPNO3 + CH3CO3 -> NC4CHO + CH3O2 + HO2 rate = 1.40E-11 (369) + ISOPNO3_CH3O2 (257) ISOPNO3 + CH3O2 -> 0.8*NC4CHO + 1.2*HO2 + 0.8*CH2O + 0.2*CH3OH rate = 5.00E-13*exp( 400./t) (370) + + 0.2*NC4CH2OH + ISOPNO3_HO2 (258) ISOPNO3 + HO2 -> ISOPNOOH rate = 8.00E-13*exp( 700./t) (371) + ISOPNO3_NO (259) ISOPNO3 + NO -> NC4CHO + NO2 + HO2 rate = 2.70E-12*exp( 360./t) (372) + ISOPNO3_NO3 (260) ISOPNO3 + NO3 -> NC4CHO + NO2 + HO2 rate = 2.40E-12 (373) + ISOPNOOH_OH (261) ISOPNOOH + OH -> NOA + HO2 rate = 4.00E-11 (374) + ISOP_O3 (262) ISOP + O3 -> 0.3*MACR + 0.2*MVK + 0.11*HCOOH + 0.62*CO + 0.32*OH rate = 1.05E-14*exp( -2000./t) (375) + + 0.37*HO2 + 0.91*CH2O + 0.08*CH3CO3 + 0.13*C3H6 + + 0.05*CH3O2 + ISOP_OH (263) ISOP + OH -> 0.6*ISOPAO2 + 0.4*ISOPBO2 rate = 2.54E-11*exp( 410./t) (376) + ISOPOOH_OH (264) ISOPOOH + OH -> 0.4*XO2 + 0.6*IEPOX + 0.6*OH rate = 1.52E-11*exp( 200./t) (377) + NC4CH2OH_OH (265) NC4CH2OH + OH -> GLYALD + NOA + HO2 rate = 7.00E-11 (378) + NC4CHO_OH (266) NC4CHO + OH -> GLYOXAL + NOA + HO2 rate = 1.00E-10 (379) + XO2_CH3CO3 (267) XO2 + CH3CO3 -> 0.25*CO + 0.25*CH2O + 0.25*GLYOXAL + CH3O2 + HO2 rate = 1.30E-12*exp( 640./t) (380) + + 0.25*CH3COCHO + 0.25*HYAC + 0.25*GLYALD + CO2 + XO2_CH3O2 (268) XO2 + CH3O2 -> 0.3*CH3OH + 0.8*HO2 + 0.8*CH2O + 0.2*CO rate = 5.00E-13*exp( 400./t) (381) + + 0.1*GLYOXAL + 0.1*CH3COCHO + 0.1*HYAC + 0.1*GLYALD + XO2_HO2 (269) XO2 + HO2 -> XOOH rate = 8.00E-13*exp( 700./t) (382) + XO2_NO (270) XO2 + NO -> NO2 + HO2 + 0.25*CO + 0.25*CH2O + 0.25*GLYOXAL rate = 2.70E-12*exp( 360./t) (383) + + 0.25*CH3COCHO + 0.25*HYAC + 0.25*GLYALD + XO2_NO3 (271) XO2 + NO3 -> NO2 + HO2 + 0.5*CO + 0.25*HYAC + 0.25*GLYOXAL rate = 2.40E-12 (384) + + 0.25*CH3COCHO + 0.25*GLYALD + XOOH_OH (272) XOOH + OH -> 0.5*XO2 + 0.5*OH rate = 1.52E-12*exp( 200./t) (385) + ACBZO2_HO2 (273) ACBZO2 + HO2 -> 0.4*C6H5O2 + 0.4*OH rate = 4.30E-13*exp( 1040./t) (386) + ACBZO2_NO (274) ACBZO2 + NO -> C6H5O2 + NO2 rate = 7.50E-12*exp( 290./t) (387) + BENZENE_OH (275) BENZENE + OH -> 0.53*PHENOL + 0.12*BEPOMUC + 0.65*HO2 + 0.35*BENZO2 rate = 2.30E-12*exp( -193./t) (388) + BENZO2_HO2 (276) BENZO2 + HO2 -> BENZOOH rate = 7.50E-13*exp( 700./t) (389) + BENZO2_NO (277) BENZO2 + NO -> NO2 + GLYOXAL + 0.5*BIGALD1 + HO2 rate = 2.60E-12*exp( 365./t) (390) + BENZOOH_OH (278) BENZOOH + OH -> BENZO2 rate = 3.80E-12*exp( 200./t) (391) + BZALD_OH (279) BZALD + OH -> ACBZO2 rate = 5.90E-12*exp( 225./t) (392) + BZOO_HO2 (280) BZOO + HO2 -> BZOOH rate = 7.50E-13*exp( 700./t) (393) + BZOOH_OH (281) BZOOH + OH -> BZOO rate = 3.80E-12*exp( 200./t) (394) + BZOO_NO (282) BZOO + NO -> BZALD + NO2 + HO2 rate = 2.60E-12*exp( 365./t) (395) + C6H5O2_HO2 (283) C6H5O2 + HO2 -> C6H5OOH rate = 7.50E-13*exp( 700./t) (396) + C6H5O2_NO (284) C6H5O2 + NO -> PHENO + NO2 rate = 2.60E-12*exp( 365./t) (397) + C6H5OOH_OH (285) C6H5OOH + OH -> C6H5O2 rate = 3.80E-12*exp( 200./t) (398) + CRESOL_OH (286) CRESOL + OH -> 0.2*PHENO2 + 0.73*HO2 + 0.07*PHENO rate = 4.70E-11 (399) + DICARBO2_HO2 (287) DICARBO2 + HO2 -> 0.4*OH + 0.07*HO2 + 0.07*CH3COCHO + 0.07*CO rate = 4.30E-13*exp( 1040./t) (400) + + 0.33*CH3O2 + DICARBO2_NO (288) DICARBO2 + NO -> NO2 + 0.17*HO2 + 0.17*CH3COCHO + 0.17*CO rate = 7.50E-12*exp( 290./t) (401) + + 0.83*CH3O2 + DICARBO2_NO2 (289) DICARBO2 + NO2 + M -> M + NDEP troe : ko=9.70E-29*(300/t)**5.60 (402) + ki=9.30E-12*(300/t)**1.50 + f=0.60 + MALO2_HO2 (290) MALO2 + HO2 -> 0.16*GLYOXAL + 0.16*HO2 + 0.16*CO rate = 4.30E-13*exp( 1040./t) (403) + MALO2_NO (291) MALO2 + NO -> 0.4*GLYOXAL + 0.4*HO2 + 0.4*CO + NO2 rate = 7.50E-12*exp( 290./t) (404) + MALO2_NO2 (292) MALO2 + NO2 + M -> M + NDEP troe : ko=9.70E-29*(300/t)**5.60 (405) + ki=9.30E-12*(300/t)**1.50 + f=0.60 + MDIALO2_HO2 (293) MDIALO2 + HO2 -> 0.4*OH + 0.33*HO2 + 0.07*CH3COCHO + 0.14*CO rate = 4.30E-13*exp( 1040./t) (406) + + 0.07*CH3O2 + 0.07*GLYOXAL + MDIALO2_NO (294) MDIALO2 + NO -> NO2 + 0.83*HO2 + 0.17*CH3COCHO + 0.35*CO rate = 7.50E-12*exp( 290./t) (407) + + 0.17*CH3O2 + 0.17*GLYOXAL + MDIALO2_NO2 (295) MDIALO2 + NO2 + M -> M + NDEP troe : ko=9.70E-29*(300/t)**5.60 (408) + ki=9.30E-12*(300/t)**1.50 + f=0.60 + PHENO2_HO2 (296) PHENO2 + HO2 -> PHENOOH rate = 7.50E-13*exp( 700./t) (409) + PHENO2_NO (297) PHENO2 + NO -> HO2 + 0.7*GLYOXAL + NO2 rate = 2.60E-12*exp( 365./t) (410) + PHENOL_OH (298) PHENOL + OH -> 0.14*PHENO2 + 0.8*HO2 + 0.06*PHENO rate = 4.70E-13*exp( 1220./t) (411) + PHENO_NO2 (299) PHENO + NO2 -> NDEP rate = 2.10E-12 (412) + PHENO_O3 (300) PHENO + O3 -> C6H5O2 rate = 2.80E-13 (413) + PHENOOH_OH (301) PHENOOH + OH -> PHENO2 rate = 3.80E-12*exp( 200./t) (414) + tag_ACBZO2_NO2 (302) ACBZO2 + NO2 + M -> PBZNIT + M troe : ko=9.70E-29*(300/t)**5.60 (415) + ki=9.30E-12*(300/t)**1.50 + f=0.60 + TOLO2_HO2 (303) TOLO2 + HO2 -> TOLOOH rate = 7.50E-13*exp( 700./t) (416) + TOLO2_NO (304) TOLO2 + NO -> NO2 + 0.6*GLYOXAL + 0.4*CH3COCHO + HO2 + 0.2*BIGALD1 rate = 2.60E-12*exp( 365./t) (417) + + 0.2*BIGALD2 + 0.2*BIGALD3 + TOLOOH_OH (305) TOLOOH + OH -> TOLO2 rate = 3.80E-12*exp( 200./t) (418) + TOLUENE_OH (306) TOLUENE + OH -> 0.18*CRESOL + 0.1*TEPOMUC + 0.07*BZOO + 0.65*TOLO2 rate = 1.70E-12*exp( 352./t) (419) + + 0.28*HO2 + usr_PBZNIT_M (307) PBZNIT + M -> ACBZO2 + NO2 + M rate = ** User defined ** (420) + XYLENES_OH (308) XYLENES + OH -> 0.15*XYLOL + 0.23*TEPOMUC + 0.06*BZOO rate = 1.70E-11 (421) + + 0.56*XYLENO2 + 0.38*HO2 + XYLENO2_HO2 (309) XYLENO2 + HO2 -> XYLENOOH rate = 7.50E-13*exp( 700./t) (422) + XYLENO2_NO (310) XYLENO2 + NO -> NO2 + HO2 + 0.34*GLYOXAL + 0.54*CH3COCHO rate = 2.60E-12*exp( 365./t) (423) + + 0.06*BIGALD1 + 0.2*BIGALD2 + 0.15*BIGALD3 + + 0.21*BIGALD4 + XYLENOOH_OH (311) XYLENOOH + OH -> XYLENO2 rate = 3.80E-12*exp( 200./t) (424) + XYLOLO2_HO2 (312) XYLOLO2 + HO2 -> XYLOLOOH rate = 7.50E-13*exp( 700./t) (425) + XYLOLO2_NO (313) XYLOLO2 + NO -> HO2 + NO2 + 0.17*GLYOXAL + 0.51*CH3COCHO rate = 2.60E-12*exp( 365./t) (426) + XYLOL_OH (314) XYLOL + OH -> 0.3*XYLOLO2 + 0.63*HO2 + 0.07*PHENO rate = 8.40E-11 (427) + XYLOLOOH_OH (315) XYLOLOOH + OH -> XYLOLO2 rate = 3.80E-12*exp( 200./t) (428) + BCARY_NO3 (316) BCARY + NO3 -> NTERPO2 rate = 1.90E-11 (429) + BCARY_O3 (317) BCARY + O3 -> 0.33*TERPROD1 + 0.3*TERPROD2 + 0.63*OH + 0.57*HO2 rate = 1.20E-14 (430) + + 0.23*CO + 0.27*CO2 + 0.52*CH3COCH3 + 0.34*CH2O + + 0.1*BIGALD + 0.05*HCOOH + 0.05*BIGALK + 0.06*CH3CO3 + + 0.06*RO2 + BCARY_OH (318) BCARY + OH -> TERPO2 rate = 2.00E-10 (431) + MTERP_NO3 (319) MTERP + NO3 -> NTERPO2 rate = 1.20E-12*exp( 490./t) (432) + MTERP_O3 (320) MTERP + O3 -> 0.33*TERPROD1 + 0.3*TERPROD2 + 0.63*OH + 0.57*HO2 rate = 6.30E-16*exp( -580./t) (433) + + 0.23*CO + 0.27*CO2 + 0.52*CH3COCH3 + 0.34*CH2O + + 0.1*BIGALD + 0.05*HCOOH + 0.05*BIGALK + 0.06*CH3CO3 + + 0.06*RO2 + MTERP_OH (321) MTERP + OH -> TERPO2 rate = 1.20E-11*exp( 440./t) (434) + NTERPO2_CH3O2 (322) NTERPO2 + CH3O2 -> 0.5*TERPNIT + 0.75*CH2O + 0.25*CH3OH + 0.5*HO2 rate = 2.00E-12*exp( 500./t) (435) + + 0.5*TERPROD1 + 0.5*NO2 + NTERPO2_HO2 (323) NTERPO2 + HO2 -> NTERPOOH rate = 7.50E-13*exp( 700./t) (436) + NTERPO2_NO (324) NTERPO2 + NO -> 0.2*TERPNIT + 1.6*NO2 + 0.8*TERPROD1 + 0.2*NDEP rate = 4.20E-12*exp( 180./t) (437) + NTERPO2_NO3 (325) NTERPO2 + NO3 -> 2*NO2 + TERPROD1 rate = 2.40E-12 (438) + NTERPOOH_OH (326) NTERPOOH + OH -> NTERPO2 rate = 2.00E-11 (439) + TERP2O2_CH3O2 (327) TERP2O2 + CH3O2 -> TERPROD2 + 0.93*CH2O + 0.25*CH3OH + HO2 rate = 2.00E-12*exp( 500./t) (440) + + 0.5*CO2 + 0.125*CO + 0.125*GLYALD + + 0.15*CH3COCH3 + TERP2O2_HO2 (328) TERP2O2 + HO2 -> TERP2OOH rate = 7.50E-13*exp( 700./t) (441) + TERP2O2_NO (329) TERP2O2 + NO -> 0.1*ONITR + 0.9*NO2 + 0.34*CH2O + 0.27*CH3COCH3 rate = 4.20E-12*exp( 180./t) (442) + + 0.225*CO + 0.9*CO2 + 0.9*TERPROD2 + 0.9*HO2 + + 0.225*GLYALD + TERP2OOH_OH (330) TERP2OOH + OH -> TERP2O2 rate = 2.30E-11 (443) + TERPNIT_OH (331) TERPNIT + OH -> NO2 + TERPROD1 rate = 2.00E-11 (444) + TERPO2_CH3O2 (332) TERPO2 + CH3O2 -> TERPROD1 + 0.95*CH2O + 0.25*CH3OH + HO2 rate = 2.00E-12*exp( 500./t) (445) + + 0.025*CH3COCH3 + TERPO2_HO2 (333) TERPO2 + HO2 -> TERPOOH rate = 7.50E-13*exp( 700./t) (446) + TERPO2_NO (334) TERPO2 + NO -> 0.2*TERPNIT + 0.8*NO2 + 0.32*CH2O + 0.04*CH3COCH3 rate = 4.20E-12*exp( 180./t) (447) + + 0.8*TERPROD1 + 0.8*HO2 + TERPOOH_OH (335) TERPOOH + OH -> TERPO2 rate = 3.30E-11 (448) + TERPROD1_NO3 (336) TERPROD1 + NO3 -> 0.5*TERP2O2 + 0.5*NTERPO2 + 0.5*NDEP rate = 1.00E-12 (449) + TERPROD1_OH (337) TERPROD1 + OH -> TERP2O2 rate = 5.70E-11 (450) + TERPROD2_OH (338) TERPROD2 + OH -> 0.15*RO2 + 0.68*CH2O + 1.8*CO2 + 0.5*CH3COCH3 rate = 3.40E-11 (451) + + 0.65*CH3CO3 + 0.2*HO2 + 0.7*CO + DMS_NO3 (339) DMS + NO3 -> SO2 + HNO3 rate = 1.90E-13*exp( 520./t) (452) + DMS_OHa (340) DMS + OH -> SO2 rate = 9.60E-12*exp( -234./t) (453) + OCS_O (341) OCS + O -> SO + CO rate = 2.10E-11*exp( -2200./t) (454) + OCS_OH (342) OCS + OH -> SO2 + CO + H rate = 7.20E-14*exp( -1070./t) (455) + S_O2 (343) S + O2 -> SO + O rate = 2.30E-12 (456) + S_O3 (344) S + O3 -> SO + O2 rate = 1.20E-11 (457) + SO_BRO (345) SO + BRO -> SO2 + BR rate = 5.70E-11 (458) + SO_CLO (346) SO + CLO -> SO2 + CL rate = 2.80E-11 (459) + S_OH (347) S + OH -> SO + H rate = 6.60E-11 (460) + SO_NO2 (348) SO + NO2 -> SO2 + NO rate = 1.40E-11 (461) + SO_O2 (349) SO + O2 -> SO2 + O rate = 1.60E-13*exp( -2280./t) (462) + SO_O3 (350) SO + O3 -> SO2 + O2 rate = 3.40E-12*exp( -1100./t) (463) + SO_OCLO (351) SO + OCLO -> SO2 + CLO rate = 1.90E-12 (464) + SO_OH (352) SO + OH -> SO2 + H rate = 2.70E-11*exp( 335./t) (465) + usr_DMS_OH (353) DMS + OH -> 0.5*SO2 + 0.5*HO2 rate = ** User defined ** (466) + usr_SO2_OH (354) SO2 + OH -> SO3 + HO2 rate = ** User defined ** (467) + usr_SO3_H2O (355) SO3 + H2O -> H2SO4 rate = ** User defined ** (468) + NH3_OH (356) NH3 + OH -> H2O + NHDEP rate = 1.70E-12*exp( -710./t) (469) + usr_GLYOXAL_aer (357) GLYOXAL -> SOAG0 rate = ** User defined ** (470) + usr_HO2_aer (358) HO2 -> H2O rate = ** User defined ** (471) + usr_HONITR_aer (359) HONITR -> HNO3 rate = ** User defined ** (472) + usr_ISOPNITA_aer (360) ISOPNITA -> HNO3 rate = ** User defined ** (473) + usr_ISOPNITB_aer (361) ISOPNITB -> HNO3 rate = ** User defined ** (474) + usr_N2O5_aer (362) N2O5 -> 2*HNO3 rate = ** User defined ** (475) + usr_NC4CH2OH_aer (363) NC4CH2OH -> HNO3 rate = ** User defined ** (476) + usr_NC4CHO_aer (364) NC4CHO -> HNO3 rate = ** User defined ** (477) + usr_NH4_strat_ta (365) NH4 -> NHDEP rate = 6.34E-08 (478) + usr_NO2_aer (366) NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3 rate = ** User defined ** (479) + usr_NO3_aer (367) NO3 -> HNO3 rate = ** User defined ** (480) + usr_NTERPOOH_aer (368) NTERPOOH -> HNO3 rate = ** User defined ** (481) + usr_ONITR_aer (369) ONITR -> HNO3 rate = ** User defined ** (482) + usr_TERPNIT_aer (370) TERPNIT -> HNO3 rate = ** User defined ** (483) + BCARY_NO3_vbs (371) BCARY + NO3 -> BCARY + NO3 + 0.17493*SOAG3 + 0.59019*SOAG4 rate = 1.90E-11 (484) + BCARYO2_HO2_vbs (372) BCARYO2VBS + HO2 -> HO2 + 0.2202*SOAG0 + 0.2067*SOAG1 rate = 2.75E-13*exp( 1300./t) (485) + + 0.0653*SOAG2 + 0.1284*SOAG3 + 0.114*SOAG4 + BCARYO2_NO_vbs (373) BCARYO2VBS + NO -> NO + 0.1279*SOAG0 + 0.1792*SOAG1 + 0.0676*SOAG2 rate = 2.70E-12*exp( 360./t) (486) + + 0.079*SOAG3 + 0.1254*SOAG4 + BCARY_O3_vbs (374) BCARY + O3 -> BCARY + O3 + 0.2202*SOAG0 + 0.2067*SOAG1 rate = 1.20E-14 (487) + + 0.0653*SOAG2 + 0.1284*SOAG3 + 0.114*SOAG4 + BCARY_OH_vbs (375) BCARY + OH -> BCARY + OH + BCARYO2VBS rate = 2.00E-10 (488) + BENZENE_OH_vbs (376) BENZENE + OH -> BENZENE + OH + BENZO2VBS rate = 2.30E-12*exp( -193./t) (489) + BENZO2_HO2_vbs (377) BENZO2VBS + HO2 -> HO2 + 0.0023*SOAG0 + 0.0008*SOAG1 + 0.0843*SOAG2 rate = 7.50E-13*exp( 700./t) (490) + + 0.0443*SOAG3 + 0.1621*SOAG4 + BENZO2_NO_vbs (378) BENZO2VBS + NO -> NO + 0.0097*SOAG0 + 0.0034*SOAG1 + 0.1579*SOAG2 rate = 2.60E-12*exp( 365./t) (491) + + 0.0059*SOAG3 + 0.0536*SOAG4 + ISOP_NO3_vbs (379) ISOP + NO3 -> ISOP + NO3 + 0.059024*SOAG3 + 0.025024*SOAG4 rate = 3.03E-12*exp( -446./t) (492) + ISOPO2_HO2_vbs (380) ISOPO2VBS + HO2 -> HO2 + 0.0031*SOAG0 + 0.0035*SOAG1 + 0.0003*SOAG2 rate = 2.12E-13*exp( 1300./t) (493) + + 0.0271*SOAG3 + 0.0474*SOAG4 + ISOPO2_NO_vbs (381) ISOPO2VBS + NO -> NO + 0.0003*SOAG0 + 0.0003*SOAG1 + 0.0073*SOAG2 rate = 2.70E-12*exp( 350./t) (494) + + 0.0057*SOAG3 + 0.0623*SOAG4 + ISOP_O3_vbs (382) ISOP + O3 -> ISOP + O3 + 0.0033*SOAG3 rate = 1.05E-14*exp( -2000./t) (495) + ISOP_OH_vbs (383) ISOP + OH -> ISOP + OH + ISOPO2VBS rate = 2.54E-11*exp( 410./t) (496) + IVOCO2_HO2_vbs (384) IVOCO2VBS + HO2 -> HO2 + 0.2381*SOAG0 + 0.1308*SOAG1 + 0.0348*SOAG2 rate = 7.50E-13*exp( 700./t) (497) + + 0.0076*SOAG3 + 0.0113*SOAG4 + IVOCO2_NO_vbs (385) IVOCO2VBS + NO -> NO + 0.1056*SOAG0 + 0.1026*SOAG1 + 0.0521*SOAG2 rate = 2.60E-12*exp( 365./t) (498) + + 0.0143*SOAG3 + 0.0166*SOAG4 + IVOC_OH_vbs (386) IVOC + OH -> OH + IVOCO2VBS rate = 1.34E-11 (499) + MTERP_NO3_vbs (387) MTERP + NO3 -> MTERP + NO3 + 0.17493*SOAG3 + 0.59019*SOAG4 rate = 1.20E-12*exp( 490./t) (500) + MTERPO2_HO2_vbs (388) MTERPO2VBS + HO2 -> HO2 + 0.0508*SOAG0 + 0.1149*SOAG1 rate = 2.60E-13*exp( 1300./t) (501) + + 0.0348*SOAG2 + 0.0554*SOAG3 + 0.1278*SOAG4 + MTERPO2_NO_vbs (389) MTERPO2VBS + NO -> NO + 0.0245*SOAG0 + 0.0082*SOAG1 + 0.0772*SOAG2 rate = 2.70E-12*exp( 360./t) (502) + + 0.0332*SOAG3 + 0.13*SOAG4 + MTERP_O3_vbs (390) MTERP + O3 -> MTERP + O3 + 0.0508*SOAG0 + 0.1149*SOAG1 rate = 6.30E-16*exp( -580./t) (503) + + 0.0348*SOAG2 + 0.0554*SOAG3 + 0.1278*SOAG4 + MTERP_OH_vbs (391) MTERP + OH -> MTERP + OH + MTERPO2VBS rate = 1.20E-11*exp( 440./t) (504) + SVOC_OH (392) SVOC + OH -> OH + 0.5931*SOAG0 + 0.1534*SOAG1 + 0.0459*SOAG2 rate = 1.34E-11 (505) + + 0.0085*SOAG3 + 0.0128*SOAG4 + TOLUENE_OH_vbs (393) TOLUENE + OH -> TOLUENE + OH + TOLUO2VBS rate = 1.70E-12*exp( 352./t) (506) + TOLUO2_HO2_vbs (394) TOLUO2VBS + HO2 -> HO2 + 0.1364*SOAG0 + 0.0101*SOAG1 + 0.0763*SOAG2 rate = 7.50E-13*exp( 700./t) (507) + + 0.2157*SOAG3 + 0.0738*SOAG4 + TOLUO2_NO_vbs (395) TOLUO2VBS + NO -> NO + 0.0154*SOAG0 + 0.0452*SOAG1 + 0.0966*SOAG2 rate = 2.60E-12*exp( 365./t) (508) + + 0.0073*SOAG3 + 0.238*SOAG4 + XYLENES_OH_vbs (396) XYLENES + OH -> XYLENES + OH + XYLEO2VBS rate = 1.70E-11 (509) + XYLEO2_HO2_vbs (397) XYLEO2VBS + HO2 -> HO2 + 0.1677*SOAG0 + 0.0174*SOAG1 + 0.086*SOAG2 rate = 7.50E-13*exp( 700./t) (510) + + 0.0512*SOAG3 + 0.1598*SOAG4 + XYLEO2_NO_vbs (398) XYLEO2VBS + NO -> NO + 0.0063*SOAG0 + 0.0237*SOAG1 + 0.0025*SOAG2 rate = 2.60E-12*exp( 365./t) (511) + + 0.011*SOAG3 + 0.1185*SOAG4 + het1 (399) N2O5 -> 2*HNO3 rate = ** User defined ** (512) + het10 (400) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (513) + het11 (401) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (514) + het12 (402) N2O5 -> 2*HNO3 rate = ** User defined ** (515) + het13 (403) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (516) + het14 (404) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (517) + het15 (405) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (518) + het16 (406) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (519) + het17 (407) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (520) + het2 (408) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (521) + het3 (409) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (522) + het4 (410) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (523) + het5 (411) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (524) + het6 (412) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (525) + het7 (413) N2O5 -> 2*HNO3 rate = ** User defined ** (526) + het8 (414) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (527) + het9 (415) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (528) + E90_tau (416) E90 -> {sink} rate = 1.29E-07 (529) + NH_50_tau (417) NH_50 -> (No products) rate = 2.31E-07 (530) + NH_5_tau (418) NH_5 -> (No products) rate = 2.31E-06 (531) + ST80_25_tau (419) ST80_25 -> (No products) rate = 4.63E-07 (532) + +Extraneous prod/loss species + ( 1) CO (dataset) + ( 2) NO (dataset) + ( 3) NO2 (dataset) + ( 4) SO2 (dataset) + ( 5) AOA_NH + ( 6) N + + + Equation Report + + d(ALKNIT)/dt = r236*ALKO2*NO + - j19*ALKNIT - r233*OH*ALKNIT + d(ALKOOH)/dt = r234*ALKO2*HO2 + - j20*ALKOOH - r237*OH*ALKOOH + d(AOA_NH)/dt = 0 + d(BCARY)/dt = - r316*NO3*BCARY - r317*O3*BCARY - r318*OH*BCARY + d(BENZENE)/dt = - r275*OH*BENZENE + d(BENZOOH)/dt = r276*BENZO2*HO2 + - j21*BENZOOH - r278*OH*BENZOOH + d(BEPOMUC)/dt = .12*r275*BENZENE*OH + - j22*BEPOMUC + d(BIGALD)/dt = .1*r317*BCARY*O3 + .1*r320*MTERP*O3 + - j23*BIGALD + d(BIGALD1)/dt = .5*j21*BENZOOH + j22*BEPOMUC + .2*j70*TOLOOH + .06*j72*XYLENOOH + .5*r277*BENZO2*NO + + .2*r304*TOLO2*NO + .06*r310*XYLENO2*NO + - j24*BIGALD1 + d(BIGALD2)/dt = .2*j70*TOLOOH + .2*j72*XYLENOOH + .2*r304*TOLO2*NO + .2*r310*XYLENO2*NO + - j25*BIGALD2 + d(BIGALD3)/dt = j46*HPALD + j56*NC4CHO + .2*j70*TOLOOH + .15*j72*XYLENOOH + .2*r304*TOLO2*NO + + .15*r310*XYLENO2*NO + - j26*BIGALD3 + d(BIGALD4)/dt = .21*j72*XYLENOOH + .21*r310*XYLENO2*NO + - j27*BIGALD4 + d(BIGALK)/dt = .05*r317*BCARY*O3 + .05*r320*MTERP*O3 + - r238*OH*BIGALK + d(BIGENE)/dt = - r204*NO3*BIGENE - r205*OH*BIGENE + d(BR)/dt = j74*BRCL + j75*BRO + j77*BRONO2 + j79*CF2CLBR + j80*CF3BR + 2*j86*CH2BR2 + j87*CH3BR + + 3*j90*CHBR3 + 2*j98*H2402 + j99*HBR + j105*HOBR + r77*O1D*CF2CLBR + 2*r90*BRO*BRO + + r91*BRO*CLO + r92*BRO*CLO + r95*BRO*NO + r98*BRO*O + r99*BRO*OH + r100*HBR*O + r101*HBR*OH + + r103*O1D*CF3BR + 3*r104*O1D*CHBR3 + 2*r105*O1D*H2402 + r106*O1D*HBR + 2*r114*CH2BR2*CL + + 2*r115*CH2BR2*OH + r116*CH3BR*CL + r117*CH3BR*OH + 3*r121*CHBR3*CL + 3*r122*CHBR3*OH + + 2*r126*O1D*CH2BR2 + r127*O1D*CH3BR + r345*SO*BRO + - r87*CH2O*BR - r88*HO2*BR - r89*O3*BR + d(BRCL)/dt = r93*BRO*CLO + r407*HOBR*HCL + r412*HOBR*HCL + - j74*BRCL + d(BRO)/dt = j76*BRONO2 + r89*BR*O3 + r97*BRONO2*O + r102*HOBR*O + r107*O1D*HBR + - j75*BRO - 2*r90*BRO*BRO - r91*CLO*BRO - r92*CLO*BRO - r93*CLO*BRO - r94*HO2*BRO - r95*NO*BRO + - r96*M*NO2*BRO - r98*O*BRO - r99*OH*BRO - r345*SO*BRO + d(BRONO2)/dt = r96*M*BRO*NO2 + - j76*BRONO2 - j77*BRONO2 - r401*BRONO2 - r404*BRONO2 - r409*BRONO2 - r97*O*BRONO2 + d(BRY)/dt = 0 + d(BZALD)/dt = j28*BZOOH + r282*BZOO*NO + - r279*OH*BZALD + d(BZOOH)/dt = r280*BZOO*HO2 + - j28*BZOOH - r281*OH*BZOOH + d(C2H2)/dt = - r153*M*CL*C2H2 - r154*M*OH*C2H2 + d(C2H4)/dt = - r155*M*CL*C2H4 - r156*O3*C2H4 - r181*M*OH*C2H4 + d(C2H5OH)/dt = .4*r157*C2H5O2*C2H5O2 + .2*r158*C2H5O2*CH3O2 + - r161*OH*C2H5OH + d(C2H5OOH)/dt = r159*C2H5O2*HO2 + - j29*C2H5OOH - r162*OH*C2H5OOH + d(C2H6)/dt = - r163*CL*C2H6 - r164*OH*C2H6 + d(C3H6)/dt = .7*j55*MVK + .13*r262*ISOP*O3 + - r184*NO3*C3H6 - r185*O3*C3H6 - r202*M*OH*C3H6 + d(C3H7OOH)/dt = r187*C3H7O2*HO2 + - j30*C3H7OOH - r189*OH*C3H7OOH + d(C3H8)/dt = - r190*OH*C3H8 + d(C6H5OOH)/dt = r283*C6H5O2*HO2 + - j31*C6H5OOH - r285*OH*C6H5OOH + d(CCL4)/dt = - j78*CCL4 - r76*O1D*CCL4 + d(CF2CLBR)/dt = - j79*CF2CLBR - r77*O1D*CF2CLBR + d(CF3BR)/dt = - j80*CF3BR - r103*O1D*CF3BR + d(CFC11)/dt = - j81*CFC11 - r78*O1D*CFC11 + d(CFC113)/dt = - j82*CFC113 - r79*O1D*CFC113 + d(CFC114)/dt = - j83*CFC114 - r80*O1D*CFC114 + d(CFC115)/dt = - j84*CFC115 - r81*O1D*CFC115 + d(CFC12)/dt = - j85*CFC12 - r82*O1D*CFC12 + d(CH2BR2)/dt = - j86*CH2BR2 - r114*CL*CH2BR2 - r115*OH*CH2BR2 - r126*O1D*CH2BR2 + d(CH2O)/dt = .1*j19*ALKNIT + .1*j20*ALKOOH + j38*CH3OOH + .18*j40*CH4 + j43*GLYALD + .33*j45*HONITR + + j47*HYAC + .69*j49*ISOPOOH + 1.34*j50*MACR + j57*NOA + j62*POOH + j63*ROOH + + .375*j65*TERP2OOH + .4*j67*TERPOOH + .68*j69*TERPROD2 + r146*HOCH2OO + 2*r176*EO + + r58*CLO*CH3O2 + 2*r135*CH3O2*CH3O2 + r136*CH3O2*CH3O2 + r138*CH3O2*NO + r139*CH3OH*OH + + .3*r140*CH3OOH*OH + r149*O1D*CH4 + r150*O1D*CH4 + r156*C2H4*O3 + .7*r158*C2H5O2*CH3O2 + + r169*CH3CO3*CH3O2 + .5*r173*CH3COOOH*OH + .5*r175*EO2*NO + .8*r178*GLYALD*OH + r180*PAN*OH + + .5*r185*C3H6*O3 + r186*C3H7O2*CH3O2 + r196*PO2*NO + .8*r198*RO2*CH3O2 + .15*r199*RO2*HO2 + + r200*RO2*NO + .5*r204*BIGENE*NO3 + .5*r206*ENEO2*NO + .25*r209*MACRO2*CH3CO3 + + .88*r210*MACRO2*CH3O2 + .25*r212*MACRO2*NO3 + .25*r213*MACRO2*NO + .12*r215*MACR*O3 + + r218*MCO3*CH3CO3 + 2*r219*MCO3*CH3O2 + .45*r220*MCO3*HO2 + 2*r221*MCO3*MCO3 + r222*MCO3*NO + + r223*MCO3*NO3 + .5*r228*M*MPAN*OH + .6*r229*MVK*O3 + .4*r233*ALKNIT*OH + .1*r235*ALKO2*NO + + r242*ISOPAO2*CH3CO3 + 1.5*r243*ISOPAO2*CH3O2 + .92*r245*ISOPAO2*NO + r246*ISOPAO2*NO3 + + .75*r248*ISOPBO2*CH3O2 + .3*r253*ISOPNITA*OH + .8*r257*ISOPNO3*CH3O2 + .91*r262*ISOP*O3 + + .25*r267*XO2*CH3CO3 + .8*r268*XO2*CH3O2 + .25*r270*XO2*NO + .34*r317*BCARY*O3 + + .34*r320*MTERP*O3 + .75*r322*NTERPO2*CH3O2 + .93*r327*TERP2O2*CH3O2 + .34*r329*TERP2O2*NO + + .95*r332*TERPO2*CH3O2 + .32*r334*TERPO2*NO + .68*r338*TERPROD2*OH + - j32*CH2O - j33*CH2O - r51*CL*CH2O - r87*BR*CH2O - r131*HO2*CH2O - r132*NO3*CH2O + - r133*O*CH2O - r134*OH*CH2O + d(CH3BR)/dt = - j87*CH3BR - r116*CL*CH3BR - r117*OH*CH3BR - r127*O1D*CH3BR + d(CH3CCL3)/dt = - j88*CH3CCL3 - r118*OH*CH3CCL3 + d(CH3CHO)/dt = .4*j19*ALKNIT + .4*j20*ALKOOH + j29*C2H5OOH + .33*j45*HONITR + j53*MEKOOH + j62*POOH + + 1.6*r157*C2H5O2*C2H5O2 + .8*r158*C2H5O2*CH3O2 + r160*C2H5O2*NO + r161*C2H5OH*OH + + .5*r162*C2H5OOH*OH + .5*r185*C3H6*O3 + .27*r188*C3H7O2*NO + r196*PO2*NO + r204*BIGENE*NO3 + + r206*ENEO2*NO + .2*r224*MEKO2*HO2 + r225*MEKO2*NO + .1*r229*MVK*O3 + .8*r233*ALKNIT*OH + + .4*r235*ALKO2*NO + - j34*CH3CHO - r165*NO3*CH3CHO - r166*OH*CH3CHO + d(CH3CL)/dt = - j89*CH3CL - r119*CL*CH3CL - r120*OH*CH3CL + d(CH3CN)/dt = - r167*OH*CH3CN + d(CH3COCH3)/dt = .25*j19*ALKNIT + .25*j20*ALKOOH + .82*j30*C3H7OOH + .17*j45*HONITR + .3*j65*TERP2OOH + + .05*j67*TERPOOH + .5*j69*TERPROD2 + .82*r186*C3H7O2*CH3O2 + .82*r188*C3H7O2*NO + + .5*r204*BIGENE*NO3 + .5*r206*ENEO2*NO + .8*r233*ALKNIT*OH + .25*r235*ALKO2*NO + + .52*r317*BCARY*O3 + .52*r320*MTERP*O3 + .15*r327*TERP2O2*CH3O2 + .27*r329*TERP2O2*NO + + .025*r332*TERPO2*CH3O2 + .04*r334*TERPO2*NO + .5*r338*TERPROD2*OH + - j35*CH3COCH3 - r203*OH*CH3COCH3 + d(CH3COCHO)/dt = .18*j23*BIGALD + j27*BIGALD4 + .4*j70*TOLOOH + .54*j72*XYLENOOH + .51*j73*XYLOLOOH + + r193*HYAC*OH + r194*NOA*OH + .5*r198*RO2*CH3O2 + .25*r209*MACRO2*CH3CO3 + + .24*r210*MACRO2*CH3O2 + .25*r212*MACRO2*NO3 + .25*r213*MACRO2*NO + .88*r215*MACR*O3 + + .5*r229*MVK*O3 + .05*r251*ISOPBO2*NO + .05*r252*ISOPBO2*NO3 + .25*r267*XO2*CH3CO3 + + .1*r268*XO2*CH3O2 + .25*r270*XO2*NO + .25*r271*XO2*NO3 + .07*r287*DICARBO2*HO2 + + .17*r288*DICARBO2*NO + .07*r293*MDIALO2*HO2 + .17*r294*MDIALO2*NO + .4*r304*TOLO2*NO + + .54*r310*XYLENO2*NO + .51*r313*XYLOLO2*NO + - j36*CH3COCHO - r191*NO3*CH3COCHO - r192*OH*CH3COCHO + d(CH3COOH)/dt = .1*r169*CH3CO3*CH3O2 + .15*r170*CH3CO3*HO2 + .12*r185*C3H6*O3 + .15*r220*MCO3*HO2 + - r172*OH*CH3COOH + d(CH3COOOH)/dt = .4*r170*CH3CO3*HO2 + .4*r220*MCO3*HO2 + - j37*CH3COOOH - r173*OH*CH3COOOH + d(CH3OH)/dt = r136*CH3O2*CH3O2 + .3*r158*C2H5O2*CH3O2 + .5*r198*RO2*CH3O2 + .25*r210*MACRO2*CH3O2 + + .25*r243*ISOPAO2*CH3O2 + .25*r248*ISOPBO2*CH3O2 + .2*r257*ISOPNO3*CH3O2 + .3*r268*XO2*CH3O2 + + .25*r322*NTERPO2*CH3O2 + .25*r327*TERP2O2*CH3O2 + .25*r332*TERPO2*CH3O2 + - r139*OH*CH3OH + d(CH3OOH)/dt = r137*CH3O2*HO2 + - j38*CH3OOH - r140*OH*CH3OOH + d(CH4)/dt = .1*r185*C3H6*O3 + - j39*CH4 - j40*CH4 - r52*CL*CH4 - r108*F*CH4 - r141*OH*CH4 - r148*O1D*CH4 - r149*O1D*CH4 + - r150*O1D*CH4 + d(CHBR3)/dt = - j90*CHBR3 - r104*O1D*CHBR3 - r121*CL*CHBR3 - r122*OH*CHBR3 + d(CL)/dt = j74*BRCL + 4*j78*CCL4 + j79*CF2CLBR + 2*j81*CFC11 + 2*j82*CFC113 + 2*j83*CFC114 + j84*CFC115 + + 2*j85*CFC12 + 3*j88*CH3CCL3 + j89*CH3CL + 2*j91*CL2 + 2*j92*CL2O2 + j93*CLO + j94*CLONO2 + + j97*COFCL + j100*HCFC141B + j101*HCFC142B + j102*HCFC22 + j103*HCL + j106*HOCL + r58*CLO*CH3O2 + + 2*r59*CLO*CLO + r61*CLO*CLO + r63*CLO*NO + r68*CLO*O + r69*CLO*OH + r71*HCL*O + r72*HCL*OH + + 4*r76*O1D*CCL4 + r77*O1D*CF2CLBR + 2*r78*O1D*CFC11 + 2*r79*O1D*CFC113 + 2*r80*O1D*CFC114 + + r81*O1D*CFC115 + 2*r82*O1D*CFC12 + r83*O1D*HCL + r92*BRO*CLO + r113*O1D*COFCL + + 3*r118*CH3CCL3*OH + r120*CH3CL*OH + r123*HCFC141B*OH + r124*HCFC142B*OH + r125*HCFC22*OH + + r128*O1D*HCFC141B + r129*O1D*HCFC142B + r130*O1D*HCFC22 + r346*SO*CLO + - r51*CH2O*CL - r52*CH4*CL - r53*H2*CL - r54*H2O2*CL - r55*HO2*CL - r56*HO2*CL - r57*O3*CL + - r64*CLONO2*CL - r73*HOCL*CL - r114*CH2BR2*CL - r116*CH3BR*CL - r119*CH3CL*CL - r121*CHBR3*CL + - r163*C2H6*CL + d(CL2)/dt = r60*CLO*CLO + r64*CLONO2*CL + r400*HOCL*HCL + r405*CLONO2*HCL + r406*HOCL*HCL + r410*CLONO2*HCL + + r411*HOCL*HCL + r415*CLONO2*HCL + - j91*CL2 + d(CL2O2)/dt = r85*M*CLO*CLO + - j92*CL2O2 - r86*M*CL2O2 + d(CLO)/dt = j95*CLONO2 + j107*OCLO + r86*M*CL2O2 + r86*M*CL2O2 + r56*CL*HO2 + r57*CL*O3 + r66*CLONO2*O + + r73*HOCL*CL + r74*HOCL*O + r75*HOCL*OH + r84*O1D*HCL + r351*SO*OCLO + - j93*CLO - r58*CH3O2*CLO - 2*r59*CLO*CLO - 2*r60*CLO*CLO - 2*r61*CLO*CLO - r62*HO2*CLO + - r63*NO*CLO - r65*M*NO2*CLO - r68*O*CLO - r69*OH*CLO - r70*OH*CLO - 2*r85*M*CLO*CLO + - r91*BRO*CLO - r92*BRO*CLO - r93*BRO*CLO - r346*SO*CLO + d(CLONO2)/dt = r65*M*CLO*NO2 + - j94*CLONO2 - j95*CLONO2 - r403*CLONO2 - r408*CLONO2 - r414*CLONO2 - r64*CL*CLONO2 + - r66*O*CLONO2 - r67*OH*CLONO2 - r405*HCL*CLONO2 - r410*HCL*CLONO2 - r415*HCL*CLONO2 + d(CLY)/dt = 0 + d(CO)/dt = 1.5*j22*BEPOMUC + .45*j23*BIGALD + .6*j26*BIGALD3 + j27*BIGALD4 + j32*CH2O + j33*CH2O + + j34*CH3CHO + j36*CH3COCHO + .38*j40*CH4 + j41*CO2 + j43*GLYALD + 2*j44*GLYOXAL + + .33*j45*HONITR + 1.34*j51*MACR + .7*j55*MVK + 1.5*j64*TEPOMUC + .25*j65*TERP2OOH + j68*TERPROD1 + + 1.7*j69*TERPROD2 + j110*OCS + r51*CL*CH2O + r87*BR*CH2O + r119*CH3CL*CL + r132*CH2O*NO3 + + r133*CH2O*O + r134*CH2O*OH + .35*r154*M*C2H2*OH + .63*r156*C2H4*O3 + r179*GLYOXAL*OH + + .56*r185*C3H6*O3 + r191*CH3COCHO*NO3 + r192*CH3COCHO*OH + .22*r209*MACRO2*CH3CO3 + + .11*r210*MACRO2*CH3O2 + .22*r212*MACRO2*NO3 + .22*r213*MACRO2*NO + .65*r215*MACR*O3 + + .56*r229*MVK*O3 + .62*r262*ISOP*O3 + .25*r267*XO2*CH3CO3 + .2*r268*XO2*CH3O2 + .25*r270*XO2*NO + + .5*r271*XO2*NO3 + .07*r287*DICARBO2*HO2 + .17*r288*DICARBO2*NO + .16*r290*MALO2*HO2 + + .4*r291*MALO2*NO + .14*r293*MDIALO2*HO2 + .35*r294*MDIALO2*NO + .23*r317*BCARY*O3 + + .23*r320*MTERP*O3 + .125*r327*TERP2O2*CH3O2 + .225*r329*TERP2O2*NO + .7*r338*TERPROD2*OH + + r341*OCS*O + r342*OCS*OH + - r142*M*OH*CO - r152*OH*CO + d(CO2)/dt = j37*CH3COOOH + .44*j40*CH4 + .4*j60*PAN + j65*TERP2OOH + .8*j69*TERPROD2 + r142*M*CO*OH + + r144*HCOOH*OH + r152*CO*OH + 2*r168*CH3CO3*CH3CO3 + .9*r169*CH3CO3*CH3O2 + r171*CH3CO3*NO + + r172*CH3COOH*OH + .5*r173*CH3COOOH*OH + .8*r178*GLYALD*OH + r179*GLYOXAL*OH + .2*r185*C3H6*O3 + + 2*r218*MCO3*CH3CO3 + r219*MCO3*CH3O2 + .45*r220*MCO3*HO2 + 2*r221*MCO3*MCO3 + .5*r228*M*MPAN*OH + + .1*r229*MVK*O3 + r242*ISOPAO2*CH3CO3 + r267*XO2*CH3CO3 + .27*r317*BCARY*O3 + .27*r320*MTERP*O3 + + .5*r327*TERP2O2*CH3O2 + .9*r329*TERP2O2*NO + 1.8*r338*TERPROD2*OH + - j41*CO2 + d(COF2)/dt = j79*CF2CLBR + j80*CF3BR + j82*CFC113 + 2*j83*CFC114 + 2*j84*CFC115 + j85*CFC12 + 2*j98*H2402 + + j101*HCFC142B + j102*HCFC22 + r77*O1D*CF2CLBR + r79*O1D*CFC113 + 2*r80*O1D*CFC114 + + 2*r81*O1D*CFC115 + r82*O1D*CFC12 + r103*O1D*CF3BR + 2*r105*O1D*H2402 + r124*HCFC142B*OH + + r125*HCFC22*OH + r129*O1D*HCFC142B + r130*O1D*HCFC22 + - j96*COF2 - r112*O1D*COF2 + d(COFCL)/dt = j81*CFC11 + j82*CFC113 + j100*HCFC141B + r78*O1D*CFC11 + r79*O1D*CFC113 + r123*HCFC141B*OH + + r128*O1D*HCFC141B + - j97*COFCL - r113*O1D*COFCL + d(CRESOL)/dt = .18*r306*TOLUENE*OH + - r286*OH*CRESOL + d(DMS)/dt = - r339*NO3*DMS - r340*OH*DMS - r353*OH*DMS + d(E90)/dt = - r416*E90 + d(EOOH)/dt = r174*EO2*HO2 + - j42*EOOH + d(F)/dt = j80*CF3BR + j84*CFC115 + 2*j96*COF2 + j97*COFCL + j104*HF + r81*O1D*CFC115 + r103*O1D*CF3BR + + 2*r112*O1D*COF2 + r113*O1D*COFCL + - r108*CH4*F - r109*H2*F - r110*H2O*F - r111*HNO3*F + d(GLYALD)/dt = .33*j45*HONITR + .25*j65*TERP2OOH + r177*O2*EO + .53*r209*MACRO2*CH3CO3 + .26*r210*MACRO2*CH3O2 + + .53*r212*MACRO2*NO3 + .53*r213*MACRO2*NO + .05*r251*ISOPBO2*NO + .05*r252*ISOPBO2*NO3 + + .7*r253*ISOPNITA*OH + .5*r254*ISOPNITB*OH + r265*NC4CH2OH*OH + .25*r267*XO2*CH3CO3 + + .1*r268*XO2*CH3O2 + .25*r270*XO2*NO + .25*r271*XO2*NO3 + .125*r327*TERP2O2*CH3O2 + + .225*r329*TERP2O2*NO + - j43*GLYALD - r178*OH*GLYALD + d(GLYOXAL)/dt = j21*BENZOOH + .13*j23*BIGALD + .7*j61*PHENOOH + .6*j70*TOLOOH + .34*j72*XYLENOOH + + .17*j73*XYLOLOOH + .65*r154*M*C2H2*OH + .2*r178*GLYALD*OH + .05*r251*ISOPBO2*NO + + .05*r252*ISOPBO2*NO3 + r266*NC4CHO*OH + .25*r267*XO2*CH3CO3 + .1*r268*XO2*CH3O2 + + .25*r270*XO2*NO + .25*r271*XO2*NO3 + r277*BENZO2*NO + .16*r290*MALO2*HO2 + .4*r291*MALO2*NO + + .07*r293*MDIALO2*HO2 + .17*r294*MDIALO2*NO + .7*r297*PHENO2*NO + .6*r304*TOLO2*NO + + .34*r310*XYLENO2*NO + .17*r313*XYLOLO2*NO + - j44*GLYOXAL - r357*GLYOXAL - r179*OH*GLYOXAL + d(H)/dt = j2*H2O + 2*j3*H2O + 2*j32*CH2O + j38*CH3OOH + j39*CH4 + .33*j40*CH4 + j99*HBR + j103*HCL + + j104*HF + r1*O1D*H2 + r9*H2*O + r18*OH*H2 + r21*OH*O + r39*N*OH + r53*CL*H2 + r84*O1D*HCL + + r107*O1D*HBR + r109*F*H2 + r134*CH2O*OH + r149*O1D*CH4 + r152*CO*OH + r342*OCS*OH + r347*S*OH + + r352*SO*OH + - r14*O2*M*H - r11*HO2*H - r12*HO2*H - r13*HO2*H - r17*O3*H + d(H2)/dt = j1*H2O + j33*CH2O + 1.4400001*j40*CH4 + r11*H*HO2 + r150*O1D*CH4 + - r1*O1D*H2 - r9*O*H2 - r18*OH*H2 - r53*CL*H2 - r109*F*H2 + d(H2402)/dt = - j98*H2402 - r105*O1D*H2402 + d(H2O2)/dt = r24*M*OH*OH + r25*HO2*HO2 + - j4*H2O2 - r10*O*H2O2 - r19*OH*H2O2 - r54*CL*H2O2 + d(H2SO4)/dt = r355*SO3*H2O + - j109*H2SO4 + d(HBR)/dt = r87*BR*CH2O + r88*BR*HO2 + - j99*HBR - r100*O*HBR - r101*OH*HBR - r106*O1D*HBR - r107*O1D*HBR + d(HCFC141B)/dt = - j100*HCFC141B - r123*OH*HCFC141B - r128*O1D*HCFC141B + d(HCFC142B)/dt = - j101*HCFC142B - r124*OH*HCFC142B - r129*O1D*HCFC142B + d(HCFC22)/dt = - j102*HCFC22 - r125*OH*HCFC22 - r130*O1D*HCFC22 + d(HCL)/dt = r51*CL*CH2O + r52*CL*CH4 + r53*CL*H2 + r54*CL*H2O2 + r55*CL*HO2 + r70*CLO*OH + r73*HOCL*CL + + r114*CH2BR2*CL + r116*CH3BR*CL + 2*r119*CH3CL*CL + r121*CHBR3*CL + r163*C2H6*CL + - j103*HCL - r71*O*HCL - r72*OH*HCL - r83*O1D*HCL - r84*O1D*HCL - r400*HOCL*HCL + - r405*CLONO2*HCL - r406*HOCL*HCL - r407*HOBR*HCL - r410*CLONO2*HCL - r411*HOCL*HCL + - r412*HOBR*HCL - r415*CLONO2*HCL + d(HCN)/dt = - r143*M*OH*HCN - r151*O1D*HCN + d(HCOOH)/dt = r145*HOCH2OO*HO2 + r147*HOCH2OO*NO + .35*r154*M*C2H2*OH + .37*r156*C2H4*O3 + .12*r185*C3H6*O3 + + .33*r215*MACR*O3 + .12*r229*MVK*O3 + .11*r262*ISOP*O3 + .05*r317*BCARY*O3 + .05*r320*MTERP*O3 + - r144*OH*HCOOH + d(HF)/dt = r108*F*CH4 + r109*F*H2 + r110*F*H2O + r111*F*HNO3 + - j104*HF + d(HNO3)/dt = r359*HONITR + r360*ISOPNITA + r361*ISOPNITB + 2*r362*N2O5 + r363*NC4CH2OH + r364*NC4CHO + + .5*r366*NO2 + r367*NO3 + r368*NTERPOOH + r369*ONITR + r370*TERPNIT + 2*r399*N2O5 + + r401*BRONO2 + 2*r402*N2O5 + r403*CLONO2 + r404*BRONO2 + r408*CLONO2 + r409*BRONO2 + + 2*r413*N2O5 + r414*CLONO2 + r47*M*NO2*OH + r132*CH2O*NO3 + r165*CH3CHO*NO3 + + r191*CH3COCHO*NO3 + r339*DMS*NO3 + r405*CLONO2*HCL + r410*CLONO2*HCL + r415*CLONO2*HCL + - j9*HNO3 - r48*OH*HNO3 - r111*F*HNO3 + d(HO2NO2)/dt = r45*M*NO2*HO2 + - j10*HO2NO2 - j11*HO2NO2 - r49*M*HO2NO2 - r26*OH*HO2NO2 + d(HOBR)/dt = r401*BRONO2 + r404*BRONO2 + r409*BRONO2 + r94*BRO*HO2 + - j105*HOBR - r102*O*HOBR - r407*HCL*HOBR - r412*HCL*HOBR + d(HOCL)/dt = r403*CLONO2 + r408*CLONO2 + r414*CLONO2 + r62*CLO*HO2 + r67*CLONO2*OH + - j106*HOCL - r73*CL*HOCL - r74*O*HOCL - r75*OH*HOCL - r400*HCL*HOCL - r406*HCL*HOCL + - r411*HCL*HOCL + d(HONITR)/dt = r207*ENEO2*NO + r214*MACRO2*NO + .3*r253*ISOPNITA*OH + .5*r254*ISOPNITB*OH + - j45*HONITR - r359*HONITR - r208*OH*HONITR + d(HPALD)/dt = r250*ISOPBO2 + - j46*HPALD - r239*OH*HPALD + d(HYAC)/dt = .17*j45*HONITR + .5*r197*POOH*OH + .2*r198*RO2*CH3O2 + .22*r209*MACRO2*CH3CO3 + + .23*r210*MACRO2*CH3O2 + .22*r212*MACRO2*NO3 + .22*r213*MACRO2*NO + .5*r228*M*MPAN*OH + + .05*r251*ISOPBO2*NO + .05*r252*ISOPBO2*NO3 + .7*r253*ISOPNITA*OH + .5*r254*ISOPNITB*OH + + .25*r267*XO2*CH3CO3 + .1*r268*XO2*CH3O2 + .25*r270*XO2*NO + .25*r271*XO2*NO3 + - j47*HYAC - r193*OH*HYAC + d(HYDRALD)/dt = r247*ISOPBO2*CH3CO3 + .75*r248*ISOPBO2*CH3O2 + .87*r251*ISOPBO2*NO + .95*r252*ISOPBO2*NO3 + - r240*OH*HYDRALD + d(IEPOX)/dt = .6*r264*ISOPOOH*OH + - r241*OH*IEPOX + d(ISOP)/dt = - r255*NO3*ISOP - r262*O3*ISOP - r263*OH*ISOP + d(ISOPNITA)/dt = .08*r245*ISOPAO2*NO + - r360*ISOPNITA - r253*OH*ISOPNITA + d(ISOPNITB)/dt = .08*r251*ISOPBO2*NO + - r361*ISOPNITB - r254*OH*ISOPNITB + d(ISOPNO3)/dt = r255*ISOP*NO3 + - r256*CH3CO3*ISOPNO3 - r257*CH3O2*ISOPNO3 - r258*HO2*ISOPNO3 - r259*NO*ISOPNO3 + - r260*NO3*ISOPNO3 + d(ISOPNOOH)/dt = r258*ISOPNO3*HO2 + - j48*ISOPNOOH - r261*OH*ISOPNOOH + d(ISOPOOH)/dt = j48*ISOPNOOH + r244*ISOPAO2*HO2 + r249*ISOPBO2*HO2 + - j49*ISOPOOH - r264*OH*ISOPOOH + d(IVOC)/dt = - r386*OH*IVOC + d(MACR)/dt = .288*j49*ISOPOOH + .39*r242*ISOPAO2*CH3CO3 + .31*r243*ISOPAO2*CH3O2 + .36*r245*ISOPAO2*NO + + .4*r246*ISOPAO2*NO3 + .3*r262*ISOP*O3 + - j50*MACR - j51*MACR - r215*O3*MACR - r216*OH*MACR + d(MACROOH)/dt = r211*MACRO2*HO2 + - r217*OH*MACROOH + d(MEK)/dt = .8*j19*ALKNIT + .8*j20*ALKOOH + .8*r235*ALKO2*NO + - j52*MEK - r226*OH*MEK + d(MEKOOH)/dt = .8*r224*MEKO2*HO2 + - j53*MEKOOH - r227*OH*MEKOOH + d(MPAN)/dt = r231*M*MCO3*NO2 + - j54*MPAN - r232*M*MPAN - r228*M*OH*MPAN + d(MTERP)/dt = - r319*NO3*MTERP - r320*O3*MTERP - r321*OH*MTERP + d(MVK)/dt = .402*j49*ISOPOOH + .61*r242*ISOPAO2*CH3CO3 + .44*r243*ISOPAO2*CH3O2 + .56*r245*ISOPAO2*NO + + .6*r246*ISOPAO2*NO3 + .2*r262*ISOP*O3 + - j55*MVK - r229*O3*MVK - r230*OH*MVK + d(N)/dt = j15*NO + - r31*O2*N - r27*NO*N - r28*NO2*N - r29*NO2*N - r30*NO2*N - r39*OH*N + d(N2O)/dt = r28*N*NO2 + - j12*N2O - r43*O1D*N2O - r44*O1D*N2O + d(N2O5)/dt = r46*M*NO2*NO3 + - j13*N2O5 - j14*N2O5 - r50*M*N2O5 - r362*N2O5 - r399*N2O5 - r402*N2O5 - r413*N2O5 + d(NC4CH2OH)/dt = .2*r257*ISOPNO3*CH3O2 + - r363*NC4CH2OH - r265*OH*NC4CH2OH + d(NC4CHO)/dt = r256*ISOPNO3*CH3CO3 + .8*r257*ISOPNO3*CH3O2 + r259*ISOPNO3*NO + r260*ISOPNO3*NO3 + - j56*NC4CHO - r364*NC4CHO - r266*OH*NC4CHO + d(NH3)/dt = - r356*OH*NH3 + d(NH4)/dt = - r365*NH4 + d(NH_5)/dt = - r418*NH_5 + d(NH_50)/dt = - r417*NH_50 + d(NO)/dt = j14*N2O5 + j16*NO2 + j17*NO3 + r31*O2*N + .5*r366*NO2 + 2*r29*N*NO2 + r32*NO2*O + r39*N*OH + + 2*r43*O1D*N2O + r348*SO*NO2 + - j15*NO - r27*N*NO - r36*NO3*NO - r40*HO2*NO - r41*O3*NO - r42*M*O*NO - r63*CLO*NO + - r95*BRO*NO - r138*CH3O2*NO - r147*HOCH2OO*NO - r160*C2H5O2*NO - r171*CH3CO3*NO - r175*EO2*NO + - r188*C3H7O2*NO - r196*PO2*NO - r200*RO2*NO - r206*ENEO2*NO - r207*ENEO2*NO - r213*MACRO2*NO + - r214*MACRO2*NO - r222*MCO3*NO - r225*MEKO2*NO - r235*ALKO2*NO - r236*ALKO2*NO - r245*ISOPAO2*NO + - r251*ISOPBO2*NO - r259*ISOPNO3*NO - r270*XO2*NO - r274*ACBZO2*NO - r277*BENZO2*NO + - r282*BZOO*NO - r284*C6H5O2*NO - r288*DICARBO2*NO - r291*MALO2*NO - r294*MDIALO2*NO + - r297*PHENO2*NO - r304*TOLO2*NO - r310*XYLENO2*NO - r313*XYLOLO2*NO - r324*NTERPO2*NO + - r329*TERP2O2*NO - r334*TERPO2*NO + d(NO2)/dt = j9*HNO3 + j11*HO2NO2 + j13*N2O5 + j18*NO3 + j19*ALKNIT + j45*HONITR + j48*ISOPNOOH + j54*MPAN + + j56*NC4CHO + j57*NOA + j58*NTERPOOH + j59*ONITR + .6*j60*PAN + j66*TERPNIT + j76*BRONO2 + + j95*CLONO2 + r49*M*HO2NO2 + r50*M*N2O5 + r183*M*PAN + r232*M*MPAN + r307*M*PBZNIT + + r26*HO2NO2*OH + r35*NO3*HO2 + 2*r36*NO3*NO + r37*NO3*O + r38*NO3*OH + r40*NO*HO2 + r41*NO*O3 + + r42*M*NO*O + r63*CLO*NO + r95*BRO*NO + r138*CH3O2*NO + r147*HOCH2OO*NO + r160*C2H5O2*NO + + r171*CH3CO3*NO + r175*EO2*NO + r188*C3H7O2*NO + r194*NOA*OH + r196*PO2*NO + r200*RO2*NO + + r204*BIGENE*NO3 + r206*ENEO2*NO + r212*MACRO2*NO3 + r213*MACRO2*NO + r222*MCO3*NO + + r223*MCO3*NO3 + r225*MEKO2*NO + r233*ALKNIT*OH + r235*ALKO2*NO + .92*r245*ISOPAO2*NO + + r246*ISOPAO2*NO3 + .92*r251*ISOPBO2*NO + r252*ISOPBO2*NO3 + .7*r253*ISOPNITA*OH + + r259*ISOPNO3*NO + r260*ISOPNO3*NO3 + r270*XO2*NO + r271*XO2*NO3 + r274*ACBZO2*NO + + r277*BENZO2*NO + r282*BZOO*NO + r284*C6H5O2*NO + r288*DICARBO2*NO + r291*MALO2*NO + + r294*MDIALO2*NO + r297*PHENO2*NO + r304*TOLO2*NO + r310*XYLENO2*NO + r313*XYLOLO2*NO + + .5*r322*NTERPO2*CH3O2 + 1.6*r324*NTERPO2*NO + 2*r325*NTERPO2*NO3 + .9*r329*TERP2O2*NO + + r331*TERPNIT*OH + .8*r334*TERPO2*NO + - j16*NO2 - r366*NO2 - r28*N*NO2 - r29*N*NO2 - r30*N*NO2 - r32*O*NO2 - r33*O3*NO2 + - r34*M*O*NO2 - r45*M*HO2*NO2 - r46*M*NO3*NO2 - r47*M*OH*NO2 - r65*M*CLO*NO2 - r96*M*BRO*NO2 + - r182*M*CH3CO3*NO2 - r231*M*MCO3*NO2 - r289*M*DICARBO2*NO2 - r292*M*MALO2*NO2 + - r295*M*MDIALO2*NO2 - r299*PHENO*NO2 - r302*M*ACBZO2*NO2 - r348*SO*NO2 + d(NO3)/dt = j10*HO2NO2 + j13*N2O5 + j14*N2O5 + .4*j60*PAN + j77*BRONO2 + j94*CLONO2 + r50*M*N2O5 + + r33*NO2*O3 + r34*M*NO2*O + r48*HNO3*OH + r64*CLONO2*CL + r66*CLONO2*O + r67*CLONO2*OH + + r97*BRONO2*O + r111*F*HNO3 + r180*PAN*OH + .5*r228*M*MPAN*OH + - j17*NO3 - j18*NO3 - r367*NO3 - r35*HO2*NO3 - r36*NO*NO3 - r37*O*NO3 - r38*OH*NO3 + - r46*M*NO2*NO3 - r132*CH2O*NO3 - r165*CH3CHO*NO3 - r184*C3H6*NO3 - r191*CH3COCHO*NO3 + - r204*BIGENE*NO3 - r212*MACRO2*NO3 - r223*MCO3*NO3 - r246*ISOPAO2*NO3 - r252*ISOPBO2*NO3 + - r255*ISOP*NO3 - r260*ISOPNO3*NO3 - r271*XO2*NO3 - r316*BCARY*NO3 - r319*MTERP*NO3 + - r325*NTERPO2*NO3 - r336*TERPROD1*NO3 - r339*DMS*NO3 + d(NOA)/dt = r184*C3H6*NO3 + .5*r254*ISOPNITB*OH + r261*ISOPNOOH*OH + r265*NC4CH2OH*OH + r266*NC4CHO*OH + - j57*NOA - r194*OH*NOA + d(NTERPOOH)/dt = r323*NTERPO2*HO2 + - j58*NTERPOOH - r368*NTERPOOH - r326*OH*NTERPOOH + d(O)/dt = j5*O2 + 2*j6*O2 + j3*H2O + j8*O3 + j14*N2O5 + j15*NO + j16*NO2 + j18*NO3 + .18*j40*CH4 + + j41*CO2 + j75*BRO + j93*CLO + j107*OCLO + j111*SO + j112*SO2 + j113*SO3 + r3*N2*O1D + + r4*O2*O1D + r31*O2*N + r343*O2*S + r349*O2*SO + r13*H*HO2 + r23*OH*OH + r27*N*NO + r28*N*NO2 + - r8*O2*M*O - r6*O3*O - 2*r7*M*O*O - r9*H2*O - r10*H2O2*O - r15*HO2*O - r21*OH*O - r32*NO2*O + - r34*M*NO2*O - r37*NO3*O - r42*M*NO*O - r66*CLONO2*O - r68*CLO*O - r71*HCL*O - r74*HOCL*O + - r97*BRONO2*O - r98*BRO*O - r100*HBR*O - r102*HOBR*O - r133*CH2O*O - r341*OCS*O + d(O3)/dt = r8*O2*M*O + .15*r170*CH3CO3*HO2 + .15*r220*MCO3*HO2 + - j7*O3 - j8*O3 - r5*O1D*O3 - r6*O*O3 - r16*HO2*O3 - r17*H*O3 - r22*OH*O3 - r33*NO2*O3 + - r41*NO*O3 - r57*CL*O3 - r89*BR*O3 - r156*C2H4*O3 - r185*C3H6*O3 - r215*MACR*O3 - r229*MVK*O3 + - r262*ISOP*O3 - r300*PHENO*O3 - r317*BCARY*O3 - r320*MTERP*O3 - r344*S*O3 - r350*SO*O3 + d(O3S)/dt = 0 + d(OCLO)/dt = r61*CLO*CLO + r91*BRO*CLO + - j107*OCLO - r351*SO*OCLO + d(OCS)/dt = - j110*OCS - r341*O*OCS - r342*OH*OCS + d(ONITR)/dt = r208*HONITR*OH + .1*r329*TERP2O2*NO + - j59*ONITR - r369*ONITR + d(PAN)/dt = r182*M*CH3CO3*NO2 + - j60*PAN - r183*M*PAN - r180*OH*PAN + d(PBZNIT)/dt = r302*M*ACBZO2*NO2 + - r307*M*PBZNIT + d(PHENO)/dt = j31*C6H5OOH + r284*C6H5O2*NO + .07*r286*CRESOL*OH + .06*r298*PHENOL*OH + .07*r314*XYLOL*OH + - r299*NO2*PHENO - r300*O3*PHENO + d(PHENOL)/dt = .53*r275*BENZENE*OH + - r298*OH*PHENOL + d(PHENOOH)/dt = r296*PHENO2*HO2 + - j61*PHENOOH - r301*OH*PHENOOH + d(POOH)/dt = r195*PO2*HO2 + - j62*POOH - r197*OH*POOH + d(ROOH)/dt = .85*r199*RO2*HO2 + - j63*ROOH - r201*OH*ROOH + d(S)/dt = j110*OCS + j111*SO + - r343*O2*S - r344*O3*S - r347*OH*S + d(SF6)/dt = - j108*SF6 + d(SO)/dt = j112*SO2 + r343*O2*S + r341*OCS*O + r344*S*O3 + r347*S*OH + - j111*SO - r349*O2*SO - r345*BRO*SO - r346*CLO*SO - r348*NO2*SO - r350*O3*SO - r351*OCLO*SO + - r352*OH*SO + d(SO2)/dt = j113*SO3 + r349*O2*SO + r339*DMS*NO3 + r340*DMS*OH + r342*OCS*OH + r345*SO*BRO + r346*SO*CLO + + r348*SO*NO2 + r350*SO*O3 + r351*SO*OCLO + r352*SO*OH + .5*r353*DMS*OH + - j112*SO2 - r354*OH*SO2 + d(SO3)/dt = j109*H2SO4 + r354*SO2*OH + - j113*SO3 - r355*H2O*SO3 + d(SOAG0)/dt = r357*GLYOXAL + .2202*r372*BCARYO2VBS*HO2 + .1279*r373*BCARYO2VBS*NO + .2202*r374*BCARY*O3 + + .0023*r377*BENZO2VBS*HO2 + .0097*r378*BENZO2VBS*NO + .0031*r380*ISOPO2VBS*HO2 + + .0003*r381*ISOPO2VBS*NO + .2381*r384*IVOCO2VBS*HO2 + .1056*r385*IVOCO2VBS*NO + + .0508*r388*MTERPO2VBS*HO2 + .0245*r389*MTERPO2VBS*NO + .0508*r390*MTERP*O3 + + .5931*r392*SVOC*OH + .1364*r394*TOLUO2VBS*HO2 + .0154*r395*TOLUO2VBS*NO + + .1677*r397*XYLEO2VBS*HO2 + .0063*r398*XYLEO2VBS*NO + d(SOAG1)/dt = .2067*r372*BCARYO2VBS*HO2 + .1792*r373*BCARYO2VBS*NO + .2067*r374*BCARY*O3 + + .0008*r377*BENZO2VBS*HO2 + .0034*r378*BENZO2VBS*NO + .0035*r380*ISOPO2VBS*HO2 + + .0003*r381*ISOPO2VBS*NO + .1308*r384*IVOCO2VBS*HO2 + .1026*r385*IVOCO2VBS*NO + + .1149*r388*MTERPO2VBS*HO2 + .0082*r389*MTERPO2VBS*NO + .1149*r390*MTERP*O3 + + .1534*r392*SVOC*OH + .0101*r394*TOLUO2VBS*HO2 + .0452*r395*TOLUO2VBS*NO + + .0174*r397*XYLEO2VBS*HO2 + .0237*r398*XYLEO2VBS*NO + d(SOAG2)/dt = .0653*r372*BCARYO2VBS*HO2 + .0676*r373*BCARYO2VBS*NO + .0653*r374*BCARY*O3 + + .0843*r377*BENZO2VBS*HO2 + .1579*r378*BENZO2VBS*NO + .0003*r380*ISOPO2VBS*HO2 + + .0073*r381*ISOPO2VBS*NO + .0348*r384*IVOCO2VBS*HO2 + .0521*r385*IVOCO2VBS*NO + + .0348*r388*MTERPO2VBS*HO2 + .0772*r389*MTERPO2VBS*NO + .0348*r390*MTERP*O3 + + .0459*r392*SVOC*OH + .0763*r394*TOLUO2VBS*HO2 + .0966*r395*TOLUO2VBS*NO + + .086*r397*XYLEO2VBS*HO2 + .0025*r398*XYLEO2VBS*NO + d(SOAG3)/dt = .17493*r371*BCARY*NO3 + .1284*r372*BCARYO2VBS*HO2 + .079*r373*BCARYO2VBS*NO + .1284*r374*BCARY*O3 + + .0443*r377*BENZO2VBS*HO2 + .0059*r378*BENZO2VBS*NO + .059024*r379*ISOP*NO3 + + .0271*r380*ISOPO2VBS*HO2 + .0057*r381*ISOPO2VBS*NO + .0033*r382*ISOP*O3 + + .0076*r384*IVOCO2VBS*HO2 + .0143*r385*IVOCO2VBS*NO + .17493*r387*MTERP*NO3 + + .0554*r388*MTERPO2VBS*HO2 + .0332*r389*MTERPO2VBS*NO + .0554*r390*MTERP*O3 + + .0085*r392*SVOC*OH + .2157*r394*TOLUO2VBS*HO2 + .0073*r395*TOLUO2VBS*NO + + .0512*r397*XYLEO2VBS*HO2 + .011*r398*XYLEO2VBS*NO + d(SOAG4)/dt = .59019*r371*BCARY*NO3 + .114*r372*BCARYO2VBS*HO2 + .1254*r373*BCARYO2VBS*NO + .114*r374*BCARY*O3 + + .1621*r377*BENZO2VBS*HO2 + .0536*r378*BENZO2VBS*NO + .025024*r379*ISOP*NO3 + + .0474*r380*ISOPO2VBS*HO2 + .0623*r381*ISOPO2VBS*NO + .0113*r384*IVOCO2VBS*HO2 + + .0166*r385*IVOCO2VBS*NO + .59019*r387*MTERP*NO3 + .1278*r388*MTERPO2VBS*HO2 + + .13*r389*MTERPO2VBS*NO + .1278*r390*MTERP*O3 + .0128*r392*SVOC*OH + .0738*r394*TOLUO2VBS*HO2 + + .238*r395*TOLUO2VBS*NO + .1598*r397*XYLEO2VBS*HO2 + .1185*r398*XYLEO2VBS*NO + d(ST80_25)/dt = - r419*ST80_25 + d(SVOC)/dt = - r392*OH*SVOC + d(TEPOMUC)/dt = .1*r306*TOLUENE*OH + .23*r308*XYLENES*OH + - j64*TEPOMUC + d(TERP2OOH)/dt = r328*TERP2O2*HO2 + - j65*TERP2OOH - r330*OH*TERP2OOH + d(TERPNIT)/dt = .5*r322*NTERPO2*CH3O2 + .2*r324*NTERPO2*NO + .2*r334*TERPO2*NO + - j66*TERPNIT - r370*TERPNIT - r331*OH*TERPNIT + d(TERPOOH)/dt = r333*TERPO2*HO2 + - j67*TERPOOH - r335*OH*TERPOOH + d(TERPROD1)/dt = j58*NTERPOOH + j66*TERPNIT + j67*TERPOOH + .33*r317*BCARY*O3 + .33*r320*MTERP*O3 + + .5*r322*NTERPO2*CH3O2 + .8*r324*NTERPO2*NO + r325*NTERPO2*NO3 + r331*TERPNIT*OH + + r332*TERPO2*CH3O2 + .8*r334*TERPO2*NO + - j68*TERPROD1 - r336*NO3*TERPROD1 - r337*OH*TERPROD1 + d(TERPROD2)/dt = j65*TERP2OOH + j68*TERPROD1 + .3*r317*BCARY*O3 + .3*r320*MTERP*O3 + r327*TERP2O2*CH3O2 + + .9*r329*TERP2O2*NO + - j69*TERPROD2 - r338*OH*TERPROD2 + d(TOLOOH)/dt = r303*TOLO2*HO2 + - j70*TOLOOH - r305*OH*TOLOOH + d(TOLUENE)/dt = - r306*OH*TOLUENE + d(XOOH)/dt = r269*XO2*HO2 + - j71*XOOH - r272*OH*XOOH + d(XYLENES)/dt = - r308*OH*XYLENES + d(XYLENOOH)/dt = r309*XYLENO2*HO2 + - j72*XYLENOOH - r311*OH*XYLENOOH + d(XYLOL)/dt = .15*r308*XYLENES*OH + - r314*OH*XYLOL + d(XYLOLOOH)/dt = r312*XYLOLO2*HO2 + - j73*XYLOLOOH - r315*OH*XYLOLOOH + d(NHDEP)/dt = r365*NH4 + r356*NH3*OH + d(NDEP)/dt = .5*r228*M*MPAN*OH + r289*M*DICARBO2*NO2 + r292*M*MALO2*NO2 + r295*M*MDIALO2*NO2 + r299*PHENO*NO2 + + .2*r324*NTERPO2*NO + .5*r336*TERPROD1*NO3 + d(ACBZO2)/dt = r307*M*PBZNIT + r279*BZALD*OH + - r273*HO2*ACBZO2 - r274*NO*ACBZO2 - r302*M*NO2*ACBZO2 + d(ALKO2)/dt = r237*ALKOOH*OH + r238*BIGALK*OH + - r234*HO2*ALKO2 - r235*NO*ALKO2 - r236*NO*ALKO2 + d(BCARYO2VBS)/dt = r375*BCARY*OH + - r372*HO2*BCARYO2VBS - r373*NO*BCARYO2VBS + d(BENZO2)/dt = .35*r275*BENZENE*OH + r278*BENZOOH*OH + - r276*HO2*BENZO2 - r277*NO*BENZO2 + d(BENZO2VBS)/dt = r376*BENZENE*OH + - r377*HO2*BENZO2VBS - r378*NO*BENZO2VBS + d(BZOO)/dt = r281*BZOOH*OH + .07*r306*TOLUENE*OH + .06*r308*XYLENES*OH + - r280*HO2*BZOO - r282*NO*BZOO + d(C2H5O2)/dt = j52*MEK + .5*r162*C2H5OOH*OH + r163*C2H6*CL + r164*C2H6*OH + - 2*r157*C2H5O2*C2H5O2 - r158*CH3O2*C2H5O2 - r159*HO2*C2H5O2 - r160*NO*C2H5O2 + d(C3H7O2)/dt = r189*C3H7OOH*OH + r190*C3H8*OH + - r186*CH3O2*C3H7O2 - r187*HO2*C3H7O2 - r188*NO*C3H7O2 + d(C6H5O2)/dt = .4*r273*ACBZO2*HO2 + r274*ACBZO2*NO + r285*C6H5OOH*OH + r300*PHENO*O3 + - r283*HO2*C6H5O2 - r284*NO*C6H5O2 + d(CH3CO3)/dt = .13*j23*BIGALD + j27*BIGALD4 + j35*CH3COCH3 + j36*CH3COCHO + .33*j45*HONITR + j47*HYAC + + 1.34*j50*MACR + j52*MEK + j53*MEKOOH + .3*j55*MVK + j57*NOA + .6*j60*PAN + j63*ROOH + + .5*j64*TEPOMUC + .65*j69*TERPROD2 + r183*M*PAN + r165*CH3CHO*NO3 + r166*CH3CHO*OH + + .5*r173*CH3COOOH*OH + r191*CH3COCHO*NO3 + r192*CH3COCHO*OH + .3*r198*RO2*CH3O2 + + .15*r199*RO2*HO2 + r200*RO2*NO + .53*r209*MACRO2*CH3CO3 + .26*r210*MACRO2*CH3O2 + + .53*r212*MACRO2*NO3 + .53*r213*MACRO2*NO + .1*r215*MACR*O3 + r219*MCO3*CH3O2 + + .45*r220*MCO3*HO2 + 2*r221*MCO3*MCO3 + r222*MCO3*NO + r223*MCO3*NO3 + .2*r224*MEKO2*HO2 + + r225*MEKO2*NO + .28*r229*MVK*O3 + .08*r262*ISOP*O3 + .06*r317*BCARY*O3 + .06*r320*MTERP*O3 + + .65*r338*TERPROD2*OH + - 2*r168*CH3CO3*CH3CO3 - r169*CH3O2*CH3CO3 - r170*HO2*CH3CO3 - r171*NO*CH3CO3 + - r182*M*NO2*CH3CO3 - r209*MACRO2*CH3CO3 - r242*ISOPAO2*CH3CO3 - r247*ISOPBO2*CH3CO3 + - r256*ISOPNO3*CH3CO3 - r267*XO2*CH3CO3 + d(CH3O2)/dt = j34*CH3CHO + j35*CH3COCH3 + j37*CH3COOOH + j39*CH4 + .3*j55*MVK + .4*j60*PAN + j87*CH3BR + + j89*CH3CL + r52*CL*CH4 + r108*F*CH4 + .7*r140*CH3OOH*OH + r141*CH4*OH + r148*O1D*CH4 + + 2*r168*CH3CO3*CH3CO3 + .9*r169*CH3CO3*CH3O2 + .45*r170*CH3CO3*HO2 + r171*CH3CO3*NO + + r172*CH3COOH*OH + .28*r185*C3H6*O3 + r209*MACRO2*CH3CO3 + r218*MCO3*CH3CO3 + + r242*ISOPAO2*CH3CO3 + r247*ISOPBO2*CH3CO3 + r256*ISOPNO3*CH3CO3 + .05*r262*ISOP*O3 + + r267*XO2*CH3CO3 + .33*r287*DICARBO2*HO2 + .83*r288*DICARBO2*NO + .07*r293*MDIALO2*HO2 + + .17*r294*MDIALO2*NO + - r58*CLO*CH3O2 - 2*r135*CH3O2*CH3O2 - 2*r136*CH3O2*CH3O2 - r137*HO2*CH3O2 - r138*NO*CH3O2 + - r158*C2H5O2*CH3O2 - r169*CH3CO3*CH3O2 - r186*C3H7O2*CH3O2 - r198*RO2*CH3O2 + - r210*MACRO2*CH3O2 - r219*MCO3*CH3O2 - r243*ISOPAO2*CH3O2 - r248*ISOPBO2*CH3O2 + - r257*ISOPNO3*CH3O2 - r268*XO2*CH3O2 - r322*NTERPO2*CH3O2 - r327*TERP2O2*CH3O2 + - r332*TERPO2*CH3O2 + d(DICARBO2)/dt = .6*j25*BIGALD2 + - r287*HO2*DICARBO2 - r288*NO*DICARBO2 - r289*M*NO2*DICARBO2 + d(ENEO2)/dt = r205*BIGENE*OH + - r206*NO*ENEO2 - r207*NO*ENEO2 + d(EO)/dt = j42*EOOH + .75*r175*EO2*NO + - r176*EO - r177*O2*EO + d(EO2)/dt = r181*M*C2H4*OH + - r174*HO2*EO2 - r175*NO*EO2 + d(HO2)/dt = j11*HO2NO2 + j19*ALKNIT + .9*j20*ALKOOH + j21*BENZOOH + 1.5*j22*BEPOMUC + .56*j23*BIGALD + + j24*BIGALD1 + .6*j25*BIGALD2 + .6*j26*BIGALD3 + j27*BIGALD4 + j28*BZOOH + j29*C2H5OOH + + j30*C3H7OOH + j34*CH3CHO + j36*CH3COCHO + 2*j43*GLYALD + 2*j44*GLYOXAL + .67*j45*HONITR + + j46*HPALD + j47*HYAC + j48*ISOPNOOH + j49*ISOPOOH + 1.34*j50*MACR + .66*j51*MACR + j56*NC4CHO + + j61*PHENOOH + j62*POOH + j64*TEPOMUC + j65*TERP2OOH + j66*TERPNIT + j67*TERPOOH + + j68*TERPROD1 + 1.2*j69*TERPROD2 + j70*TOLOOH + j72*XYLENOOH + j73*XYLOLOOH + r14*O2*M*H + + r49*M*HO2NO2 + r146*HOCH2OO + r176*EO + r177*O2*EO + r250*ISOPBO2 + r10*H2O2*O + r19*OH*H2O2 + + r22*OH*O3 + r38*NO3*OH + r51*CL*CH2O + r54*CL*H2O2 + r58*CLO*CH3O2 + r69*CLO*OH + r87*BR*CH2O + + r99*BRO*OH + r116*CH3BR*CL + r117*CH3BR*OH + r119*CH3CL*CL + r120*CH3CL*OH + r132*CH2O*NO3 + + r133*CH2O*O + 2*r135*CH3O2*CH3O2 + r138*CH3O2*NO + r139*CH3OH*OH + r142*M*CO*OH + + r143*M*HCN*OH + r144*HCOOH*OH + r147*HOCH2OO*NO + r149*O1D*CH4 + .35*r154*M*C2H2*OH + + .13*r156*C2H4*O3 + 1.2*r157*C2H5O2*C2H5O2 + r158*C2H5O2*CH3O2 + r160*C2H5O2*NO + r161*C2H5OH*OH + + r167*CH3CN*OH + .9*r169*CH3CO3*CH3O2 + .25*r175*EO2*NO + r178*GLYALD*OH + r179*GLYOXAL*OH + + .28*r185*C3H6*O3 + r186*C3H7O2*CH3O2 + r188*C3H7O2*NO + r193*HYAC*OH + r196*PO2*NO + + .3*r198*RO2*CH3O2 + r206*ENEO2*NO + r208*HONITR*OH + .47*r209*MACRO2*CH3CO3 + + .73*r210*MACRO2*CH3O2 + .47*r212*MACRO2*NO3 + .47*r213*MACRO2*NO + .14*r215*MACR*O3 + + .2*r217*MACROOH*OH + r219*MCO3*CH3O2 + .5*r228*M*MPAN*OH + .28*r229*MVK*O3 + r235*ALKO2*NO + + r242*ISOPAO2*CH3CO3 + r243*ISOPAO2*CH3O2 + .92*r245*ISOPAO2*NO + r246*ISOPAO2*NO3 + + r247*ISOPBO2*CH3CO3 + r248*ISOPBO2*CH3O2 + .92*r251*ISOPBO2*NO + r252*ISOPBO2*NO3 + + .3*r253*ISOPNITA*OH + r254*ISOPNITB*OH + r256*ISOPNO3*CH3CO3 + 1.2*r257*ISOPNO3*CH3O2 + + r259*ISOPNO3*NO + r260*ISOPNO3*NO3 + r261*ISOPNOOH*OH + .37*r262*ISOP*O3 + r265*NC4CH2OH*OH + + r266*NC4CHO*OH + r267*XO2*CH3CO3 + .8*r268*XO2*CH3O2 + r270*XO2*NO + r271*XO2*NO3 + + .65*r275*BENZENE*OH + r277*BENZO2*NO + r282*BZOO*NO + .73*r286*CRESOL*OH + + .07*r287*DICARBO2*HO2 + .17*r288*DICARBO2*NO + .16*r290*MALO2*HO2 + .4*r291*MALO2*NO + + .33*r293*MDIALO2*HO2 + .83*r294*MDIALO2*NO + r297*PHENO2*NO + .8*r298*PHENOL*OH + r304*TOLO2*NO + + .28*r306*TOLUENE*OH + .38*r308*XYLENES*OH + r310*XYLENO2*NO + r313*XYLOLO2*NO + + .63*r314*XYLOL*OH + .57*r317*BCARY*O3 + .57*r320*MTERP*O3 + .5*r322*NTERPO2*CH3O2 + + r327*TERP2O2*CH3O2 + .9*r329*TERP2O2*NO + r332*TERPO2*CH3O2 + .8*r334*TERPO2*NO + + .2*r338*TERPROD2*OH + .5*r353*DMS*OH + r354*SO2*OH + - r358*HO2 - r11*H*HO2 - r12*H*HO2 - r13*H*HO2 - r15*O*HO2 - r16*O3*HO2 - r20*OH*HO2 + - 2*r25*HO2*HO2 - r35*NO3*HO2 - r40*NO*HO2 - r45*M*NO2*HO2 - r55*CL*HO2 - r56*CL*HO2 + - r62*CLO*HO2 - r88*BR*HO2 - r94*BRO*HO2 - r131*CH2O*HO2 - r137*CH3O2*HO2 - r145*HOCH2OO*HO2 + - r159*C2H5O2*HO2 - r170*CH3CO3*HO2 - r174*EO2*HO2 - r187*C3H7O2*HO2 - r195*PO2*HO2 + - r199*RO2*HO2 - r211*MACRO2*HO2 - r220*MCO3*HO2 - r224*MEKO2*HO2 - r234*ALKO2*HO2 + - r244*ISOPAO2*HO2 - r249*ISOPBO2*HO2 - r258*ISOPNO3*HO2 - r269*XO2*HO2 - r273*ACBZO2*HO2 + - r276*BENZO2*HO2 - r280*BZOO*HO2 - r283*C6H5O2*HO2 - r287*DICARBO2*HO2 - r290*MALO2*HO2 + - r293*MDIALO2*HO2 - r296*PHENO2*HO2 - r303*TOLO2*HO2 - r309*XYLENO2*HO2 - r312*XYLOLO2*HO2 + - r323*NTERPO2*HO2 - r328*TERP2O2*HO2 - r333*TERPO2*HO2 + d(HOCH2OO)/dt = r131*CH2O*HO2 + - r146*HOCH2OO - r145*HO2*HOCH2OO - r147*NO*HOCH2OO + d(ISOPAO2)/dt = .6*r263*ISOP*OH + - r242*CH3CO3*ISOPAO2 - r243*CH3O2*ISOPAO2 - r244*HO2*ISOPAO2 - r245*NO*ISOPAO2 + - r246*NO3*ISOPAO2 + d(ISOPBO2)/dt = .4*r263*ISOP*OH + - r250*ISOPBO2 - r247*CH3CO3*ISOPBO2 - r248*CH3O2*ISOPBO2 - r249*HO2*ISOPBO2 + - r251*NO*ISOPBO2 - r252*NO3*ISOPBO2 + d(ISOPO2VBS)/dt = r383*ISOP*OH + - r380*HO2*ISOPO2VBS - r381*NO*ISOPO2VBS + d(IVOCO2VBS)/dt = r386*IVOC*OH + - r384*HO2*IVOCO2VBS - r385*NO*IVOCO2VBS + d(MACRO2)/dt = .5*r216*MACR*OH + .2*r217*MACROOH*OH + r230*MVK*OH + - r209*CH3CO3*MACRO2 - r210*CH3O2*MACRO2 - r211*HO2*MACRO2 - r212*NO3*MACRO2 - r213*NO*MACRO2 + - r214*NO*MACRO2 + d(MALO2)/dt = .6*j24*BIGALD1 + - r290*HO2*MALO2 - r291*NO*MALO2 - r292*M*NO2*MALO2 + d(MCO3)/dt = .66*j50*MACR + j54*MPAN + r232*M*MPAN + .5*r216*MACR*OH + .5*r217*MACROOH*OH + - r218*CH3CO3*MCO3 - r219*CH3O2*MCO3 - r220*HO2*MCO3 - 2*r221*MCO3*MCO3 - r222*NO*MCO3 + - r223*NO3*MCO3 - r231*M*NO2*MCO3 + d(MDIALO2)/dt = .6*j26*BIGALD3 + - r293*HO2*MDIALO2 - r294*NO*MDIALO2 - r295*M*NO2*MDIALO2 + d(MEKO2)/dt = r226*MEK*OH + r227*MEKOOH*OH + - r224*HO2*MEKO2 - r225*NO*MEKO2 + d(MTERPO2VBS)/dt = r391*MTERP*OH + - r388*HO2*MTERPO2VBS - r389*NO*MTERPO2VBS + d(NTERPO2)/dt = r316*BCARY*NO3 + r319*MTERP*NO3 + r326*NTERPOOH*OH + .5*r336*TERPROD1*NO3 + - r322*CH3O2*NTERPO2 - r323*HO2*NTERPO2 - r324*NO*NTERPO2 - r325*NO3*NTERPO2 + d(O1D)/dt = j5*O2 + j1*H2O + j7*O3 + j12*N2O + - r3*N2*O1D - r4*O2*O1D - r1*H2*O1D - r2*H2O*O1D - r5*O3*O1D - r43*N2O*O1D - r44*N2O*O1D + - r76*CCL4*O1D - r77*CF2CLBR*O1D - r78*CFC11*O1D - r79*CFC113*O1D - r80*CFC114*O1D + - r81*CFC115*O1D - r82*CFC12*O1D - r83*HCL*O1D - r84*HCL*O1D - r103*CF3BR*O1D - r104*CHBR3*O1D + - r105*H2402*O1D - r106*HBR*O1D - r107*HBR*O1D - r112*COF2*O1D - r113*COFCL*O1D + - r126*CH2BR2*O1D - r127*CH3BR*O1D - r128*HCFC141B*O1D - r129*HCFC142B*O1D - r130*HCFC22*O1D + - r148*CH4*O1D - r149*CH4*O1D - r150*CH4*O1D - r151*HCN*O1D + d(OH)/dt = j2*H2O + 2*j4*H2O2 + j9*HNO3 + j10*HO2NO2 + j20*ALKOOH + j21*BENZOOH + j28*BZOOH + j29*C2H5OOH + + j30*C3H7OOH + j31*C6H5OOH + j37*CH3COOOH + j38*CH3OOH + .33*j40*CH4 + j42*EOOH + j46*HPALD + + j53*MEKOOH + j58*NTERPOOH + j61*PHENOOH + j62*POOH + j63*ROOH + j65*TERP2OOH + j67*TERPOOH + + j70*TOLOOH + j71*XOOH + j72*XYLENOOH + j73*XYLOLOOH + j105*HOBR + j106*HOCL + .5*r366*NO2 + + r1*O1D*H2 + 2*r2*O1D*H2O + r9*H2*O + r10*H2O2*O + 2*r12*H*HO2 + r15*HO2*O + r16*HO2*O3 + + r17*H*O3 + r35*NO3*HO2 + r40*NO*HO2 + r56*CL*HO2 + r71*HCL*O + r74*HOCL*O + r83*O1D*HCL + + r100*HBR*O + r102*HOBR*O + r106*O1D*HBR + r110*F*H2O + r133*CH2O*O + .3*r140*CH3OOH*OH + + r148*O1D*CH4 + r151*O1D*HCN + .65*r154*M*C2H2*OH + .13*r156*C2H4*O3 + .5*r162*C2H5OOH*OH + + .45*r170*CH3CO3*HO2 + .36*r185*C3H6*O3 + .5*r197*POOH*OH + .15*r199*RO2*HO2 + .24*r215*MACR*O3 + + .1*r217*MACROOH*OH + .45*r220*MCO3*HO2 + .2*r224*MEKO2*HO2 + .36*r229*MVK*O3 + .32*r262*ISOP*O3 + + .6*r264*ISOPOOH*OH + .5*r272*XOOH*OH + .4*r273*ACBZO2*HO2 + .4*r287*DICARBO2*HO2 + + .4*r293*MDIALO2*HO2 + .63*r317*BCARY*O3 + .63*r320*MTERP*O3 + - r18*H2*OH - r19*H2O2*OH - r20*HO2*OH - r21*O*OH - r22*O3*OH - 2*r23*OH*OH - 2*r24*M*OH*OH + - r26*HO2NO2*OH - r38*NO3*OH - r39*N*OH - r47*M*NO2*OH - r48*HNO3*OH - r67*CLONO2*OH + - r69*CLO*OH - r70*CLO*OH - r72*HCL*OH - r75*HOCL*OH - r99*BRO*OH - r101*HBR*OH - r115*CH2BR2*OH + - r117*CH3BR*OH - r118*CH3CCL3*OH - r120*CH3CL*OH - r122*CHBR3*OH - r123*HCFC141B*OH + - r124*HCFC142B*OH - r125*HCFC22*OH - r134*CH2O*OH - r139*CH3OH*OH - r140*CH3OOH*OH - r141*CH4*OH + - r142*M*CO*OH - r143*M*HCN*OH - r144*HCOOH*OH - r152*CO*OH - r154*M*C2H2*OH - r161*C2H5OH*OH + - r162*C2H5OOH*OH - r164*C2H6*OH - r166*CH3CHO*OH - r167*CH3CN*OH - r172*CH3COOH*OH + - r173*CH3COOOH*OH - r178*GLYALD*OH - r179*GLYOXAL*OH - r180*PAN*OH - r181*M*C2H4*OH + - r189*C3H7OOH*OH - r190*C3H8*OH - r192*CH3COCHO*OH - r193*HYAC*OH - r194*NOA*OH - r197*POOH*OH + - r201*ROOH*OH - r202*M*C3H6*OH - r203*CH3COCH3*OH - r205*BIGENE*OH - r208*HONITR*OH + - r216*MACR*OH - r217*MACROOH*OH - r226*MEK*OH - r227*MEKOOH*OH - r228*M*MPAN*OH - r230*MVK*OH + - r233*ALKNIT*OH - r237*ALKOOH*OH - r238*BIGALK*OH - r239*HPALD*OH - r240*HYDRALD*OH + - r241*IEPOX*OH - r253*ISOPNITA*OH - r254*ISOPNITB*OH - r261*ISOPNOOH*OH - r263*ISOP*OH + - r264*ISOPOOH*OH - r265*NC4CH2OH*OH - r266*NC4CHO*OH - r272*XOOH*OH - r275*BENZENE*OH + - r278*BENZOOH*OH - r279*BZALD*OH - r281*BZOOH*OH - r285*C6H5OOH*OH - r286*CRESOL*OH + - r298*PHENOL*OH - r301*PHENOOH*OH - r305*TOLOOH*OH - r306*TOLUENE*OH - r308*XYLENES*OH + - r311*XYLENOOH*OH - r314*XYLOL*OH - r315*XYLOLOOH*OH - r318*BCARY*OH - r321*MTERP*OH + - r326*NTERPOOH*OH - r330*TERP2OOH*OH - r331*TERPNIT*OH - r335*TERPOOH*OH - r337*TERPROD1*OH + - r338*TERPROD2*OH - r340*DMS*OH - r342*OCS*OH - r347*S*OH - r352*SO*OH - r353*DMS*OH + - r354*SO2*OH - r356*NH3*OH + d(PHENO2)/dt = .2*r286*CRESOL*OH + .14*r298*PHENOL*OH + r301*PHENOOH*OH + - r296*HO2*PHENO2 - r297*NO*PHENO2 + d(PO2)/dt = .5*r197*POOH*OH + r202*M*C3H6*OH + - r195*HO2*PO2 - r196*NO*PO2 + d(RO2)/dt = .15*j69*TERPROD2 + r201*ROOH*OH + r203*CH3COCH3*OH + .06*r317*BCARY*O3 + .06*r320*MTERP*O3 + + .15*r338*TERPROD2*OH + - r198*CH3O2*RO2 - r199*HO2*RO2 - r200*NO*RO2 + d(TERP2O2)/dt = r330*TERP2OOH*OH + .5*r336*TERPROD1*NO3 + r337*TERPROD1*OH + - r327*CH3O2*TERP2O2 - r328*HO2*TERP2O2 - r329*NO*TERP2O2 + d(TERPO2)/dt = r318*BCARY*OH + r321*MTERP*OH + r335*TERPOOH*OH + - r332*CH3O2*TERPO2 - r333*HO2*TERPO2 - r334*NO*TERPO2 + d(TOLO2)/dt = r305*TOLOOH*OH + .65*r306*TOLUENE*OH + - r303*HO2*TOLO2 - r304*NO*TOLO2 + d(TOLUO2VBS)/dt = r393*TOLUENE*OH + - r394*HO2*TOLUO2VBS - r395*NO*TOLUO2VBS + d(XO2)/dt = r239*HPALD*OH + r240*HYDRALD*OH + r241*IEPOX*OH + .4*r264*ISOPOOH*OH + .5*r272*XOOH*OH + - r267*CH3CO3*XO2 - r268*CH3O2*XO2 - r269*HO2*XO2 - r270*NO*XO2 - r271*NO3*XO2 + d(XYLENO2)/dt = .56*r308*XYLENES*OH + r311*XYLENOOH*OH + - r309*HO2*XYLENO2 - r310*NO*XYLENO2 + d(XYLEO2VBS)/dt = r396*XYLENES*OH + - r397*HO2*XYLEO2VBS - r398*NO*XYLEO2VBS + d(XYLOLO2)/dt = .3*r314*XYLOL*OH + r315*XYLOLOOH*OH + - r312*HO2*XYLOLO2 - r313*NO*XYLOLO2 + d(H2O)/dt = .05*j40*CH4 + j109*H2SO4 + r358*HO2 + r13*H*HO2 + r18*OH*H2 + r19*OH*H2O2 + r20*OH*HO2 + + r23*OH*OH + r26*HO2NO2*OH + r48*HNO3*OH + r72*HCL*OH + r75*HOCL*OH + r101*HBR*OH + + r115*CH2BR2*OH + r117*CH3BR*OH + r118*CH3CCL3*OH + r120*CH3CL*OH + r125*HCFC22*OH + + r134*CH2O*OH + r140*CH3OOH*OH + r141*CH4*OH + r144*HCOOH*OH + r164*C2H6*OH + r166*CH3CHO*OH + + r172*CH3COOH*OH + r173*CH3COOOH*OH + r189*C3H7OOH*OH + r190*C3H8*OH + r192*CH3COCHO*OH + + r197*POOH*OH + r201*ROOH*OH + r203*CH3COCH3*OH + .5*r216*MACR*OH + r356*NH3*OH + r400*HOCL*HCL + + r406*HOCL*HCL + r407*HOBR*HCL + r411*HOCL*HCL + r412*HOBR*HCL + - j1*H2O - j2*H2O - j3*H2O - r2*O1D*H2O - r110*F*H2O - r355*SO3*H2O diff --git a/src/chemistry/pp_trop_strat_noaero/chem_mech.in b/src/chemistry/pp_trop_strat_noaero/chem_mech.in new file mode 100644 index 0000000000..f2f7c46be0 --- /dev/null +++ b/src/chemistry/pp_trop_strat_noaero/chem_mech.in @@ -0,0 +1,1121 @@ +* Comments +* User-given Tag Description: TS1.1-simple-NOxdep-VBS +* Tag database identifier : MZ272_TS1.1_simpleVBS_20200302 +* Tag created by : lke +* Tag created from branch : TS1.1-simpleVBS +* Tag created on : 2020-03-02 16:38:42.063276-07 +* Comments for this tag follow: +* lke : 2020-03-02 : Update VBS-SOA for NOx-dependence + + SPECIES + + Solution + ALKNIT -> C5H11ONO2, + ALKOOH -> C5H12O2, + AOA_NH -> CO, + BCARY -> C15H24, + BENZENE -> C6H6, + BENZOOH -> C6H8O5, + BEPOMUC -> C6H6O3, + BIGALD -> C5H6O2, + BIGALD1 -> C4H4O2, + BIGALD2 -> C5H6O2, + BIGALD3 -> C5H6O2, + BIGALD4 -> C6H8O2, + BIGALK -> C5H12, + BIGENE -> C4H8, + BR -> Br, + BRCL -> BrCl, + BRO -> BrO, + BRONO2 -> BrONO2, + BRY, + BZALD -> C7H6O, + BZOOH -> C7H8O2, + C2H2, + C2H4, + C2H5OH, + C2H5OOH, + C2H6, + C3H6, + C3H7OOH, + C3H8, + C6H5OOH -> C6H5OOH, + CCL4 -> CCl4, + CF2CLBR -> CF2ClBr, + CF3BR -> CF3Br, + CFC11 -> CFCl3, + CFC113 -> CCl2FCClF2, + CFC114 -> CClF2CClF2, + CFC115 -> CClF2CF3, + CFC12 -> CF2Cl2, + CH2BR2 -> CH2Br2, + CH2O, + CH3BR -> CH3Br, + CH3CCL3 -> CH3CCl3, + CH3CHO, + CH3CL -> CH3Cl, + CH3CN, + CH3COCH3, + CH3COCHO, + CH3COOH, + CH3COOOH, + CH3OH, + CH3OOH, + CH4, + CHBR3 -> CHBr3, + CL -> Cl, + CL2 -> Cl2, + CL2O2 -> Cl2O2, + CLO -> ClO, + CLONO2 -> ClONO2, + CLY, + CO, + CO2, + COF2, + COFCL -> COFCl, + CRESOL -> C7H8O, + DMS -> CH3SCH3, + E90 -> CO, + EOOH -> HOCH2CH2OOH, + F, + GLYALD -> HOCH2CHO, + GLYOXAL -> C2H2O2, + H, + H2, + H2402 -> CBrF2CBrF2, + H2O2, + H2SO4 -> H2SO4, + HBR -> HBr, + HCFC141B -> CH3CCl2F, + HCFC142B -> CH3CClF2, + HCFC22 -> CHF2Cl, + HCL -> HCl, + HCN, + HCOOH, + HF, + HNO3, + HO2NO2, + HOBR -> HOBr, + HOCL -> HOCl, + HONITR -> C4H9NO4, + HPALD -> HOOCH2CCH3CHCHO, + HYAC -> CH3COCH2OH, + HYDRALD -> HOCH2CCH3CHCHO, + IEPOX -> C5H10O3, + ISOP -> C5H8, + ISOPNITA -> C5H9NO4, + ISOPNITB -> C5H9NO4, + ISOPNO3 -> CH2CHCCH3OOCH2ONO2, + ISOPNOOH -> C5H9NO5, + ISOPOOH -> HOCH2COOHCH3CHCH2, + IVOC -> C13H28, + MACR -> CH2CCH3CHO, + MACROOH -> CH3COCHOOHCH2OH, + MEK -> C4H8O, + MEKOOH -> C4H8O3, + MPAN -> CH2CCH3CO3NO2, + MTERP -> C10H16, + MVK -> CH2CHCOCH3, + N, + N2O, + N2O5, + NC4CH2OH -> C5H9NO4, + NC4CHO -> C5H7NO4, + NH3, + NH4, + NH_5 -> CO, + NH_50 -> CO, + NO, + NO2, + NO3, + NOA -> CH3COCH2ONO2, + NTERPOOH -> C10H17NO5, + O, + O3, + O3S -> O3, + OCLO -> OClO, + OCS -> OCS, + ONITR -> C4H7NO4, + PAN -> CH3CO3NO2, + PBZNIT -> C7H5O3NO2, + PHENO -> C6H5O, + PHENOL -> C6H5OH, + PHENOOH -> C6H8O6, + POOH -> C3H6OHOOH, + ROOH -> CH3COCH2OOH, + S -> S, + SF6, + SO -> SO, + SO2, + SO3 -> SO3, + SOAG0 -> C15H38O2, + SOAG1 -> C15H38O2, + SOAG2 -> C15H38O2, + SOAG3 -> C15H38O2, + SOAG4 -> C15H38O2, + ST80_25 -> CO, + SVOC -> C22H46, + TEPOMUC -> C7H8O3, + TERP2OOH -> C10H16O4, + TERPNIT -> C10H17NO4, + TERPOOH -> C10H18O3, + TERPROD1 -> C10H16O2, + TERPROD2 -> C9H14O2, + TOLOOH -> C7H10O5, + TOLUENE -> C7H8, + XOOH -> HOCH2COOHCH3CHOHCHO, + XYLENES -> C8H10, + XYLENOOH -> C8H12O5, + XYLOL -> C8H10O, + XYLOLOOH -> C8H12O6, + NHDEP -> N, + NDEP -> N, + ACBZO2 -> C7H5O3, + ALKO2 -> C5H11O2, + BCARYO2VBS -> C15H25O3, + BENZO2 -> C6H7O5, + BENZO2VBS -> C6H7O5, + BZOO -> C7H7O2, + C2H5O2, + C3H7O2, + C6H5O2, + CH3CO3, + CH3O2, + DICARBO2 -> C5H5O4, + ENEO2 -> C4H9O3, + EO -> HOCH2CH2O, + EO2 -> HOCH2CH2O2, + HO2, + HOCH2OO, + ISOPAO2 -> HOC5H8O2, + ISOPBO2 -> HOC5H8O2, + ISOPO2VBS -> C5H9O3, + IVOCO2VBS -> C13H29O3, + MACRO2 -> CH3COCHO2CH2OH, + MALO2 -> C4H3O4, + MCO3 -> CH2CCH3CO3, + MDIALO2 -> C4H5O4, + MEKO2 -> C4H7O3, + MTERPO2VBS -> C10H17O3, + NTERPO2 -> C10H16NO5, + O1D -> O, + OH, + PHENO2 -> C6H7O6, + PO2 -> C3H6OHO2, + RO2 -> CH3COCH2O2, + TERP2O2 -> C10H15O4, + TERPO2 -> C10H17O3, + TOLO2 -> C7H9O5, + TOLUO2VBS -> C7H9O5, + XO2 -> HOCH2COOCH3CHOHCHO, + XYLENO2 -> C8H11O5, + XYLEO2VBS -> C8H11O5, + XYLOLO2 -> C8H11O6, + H2O + + End Solution + + + Fixed + M, O2, N2 + End Fixed + + Col-int + O3 = 0. + O2 = 0. + End Col-int + + Not-Transported + ACBZO2, + ALKO2, + BCARYO2VBS, + BENZO2, + BENZO2VBS, + BZOO, + C2H5O2, + C3H7O2, + C6H5O2, + CH3CO3, + CH3O2, + DICARBO2, + ENEO2, + EO, + EO2, + HO2, + HOCH2OO, + ISOPAO2, + ISOPBO2, + ISOPO2VBS, + IVOCO2VBS, + MACRO2, + MALO2, + MCO3, + MDIALO2, + MEKO2, + MTERPO2VBS, + NTERPO2, + O1D, + OH, + PHENO2, + PO2, + RO2, + TERP2O2, + TERPO2, + TOLO2, + TOLUO2VBS, + XO2, + XYLENO2, + XYLEO2VBS, + XYLOLO2 + End Not-Transported + + END Species + + + Solution classes + Explicit + AOA_NH + BRY + CCL4 + CF2CLBR + CF3BR + CFC11 + CFC113 + CFC114 + CFC115 + CFC12 + CH2BR2 + CH3BR + CH3CCL3 + CH3CL + CH4 + CHBR3 + CLY + CO2 + E90 + H2402 + HCFC141B + HCFC142B + HCFC22 + N2O + NH_5 + NH_50 + O3S + SF6 + ST80_25 + NHDEP + NDEP + End Explicit + + Implicit + ALKNIT + ALKOOH + BCARY + BENZENE + BENZOOH + BEPOMUC + BIGALD + BIGALD1 + BIGALD2 + BIGALD3 + BIGALD4 + BIGALK + BIGENE + BR + BRCL + BRO + BRONO2 + BZALD + BZOOH + C2H2 + C2H4 + C2H5OH + C2H5OOH + C2H6 + C3H6 + C3H7OOH + C3H8 + C6H5OOH + CH2O + CH3CHO + CH3CN + CH3COCH3 + CH3COCHO + CH3COOH + CH3COOOH + CH3OH + CH3OOH + CL + CL2 + CL2O2 + CLO + CLONO2 + CO + COF2 + COFCL + CRESOL + DMS + EOOH + F + GLYALD + GLYOXAL + H + H2 + H2O2 + H2SO4 + HBR + HCL + HCN + HCOOH + HF + HNO3 + HO2NO2 + HOBR + HOCL + HONITR + HPALD + HYAC + HYDRALD + IEPOX + ISOP + ISOPNITA + ISOPNITB + ISOPNO3 + ISOPNOOH + ISOPOOH + IVOC + MACR + MACROOH + MEK + MEKOOH + MPAN + MTERP + MVK + N + N2O5 + NC4CH2OH + NC4CHO + NH3 + NH4 + NO + NO2 + NO3 + NOA + NTERPOOH + O + O3 + OCLO + OCS + ONITR + PAN + PBZNIT + PHENO + PHENOL + PHENOOH + POOH + ROOH + S + SO + SO2 + SO3 + SOAG0 + SOAG1 + SOAG2 + SOAG3 + SOAG4 + SVOC + TEPOMUC + TERP2OOH + TERPNIT + TERPOOH + TERPROD1 + TERPROD2 + TOLOOH + TOLUENE + XOOH + XYLENES + XYLENOOH + XYLOL + XYLOLOOH + ACBZO2 + ALKO2 + BCARYO2VBS + BENZO2 + BENZO2VBS + BZOO + C2H5O2 + C3H7O2 + C6H5O2 + CH3CO3 + CH3O2 + DICARBO2 + ENEO2 + EO + EO2 + HO2 + HOCH2OO + ISOPAO2 + ISOPBO2 + ISOPO2VBS + IVOCO2VBS + MACRO2 + MALO2 + MCO3 + MDIALO2 + MEKO2 + MTERPO2VBS + NTERPO2 + O1D + OH + PHENO2 + PO2 + RO2 + TERP2O2 + TERPO2 + TOLO2 + TOLUO2VBS + XO2 + XYLENO2 + XYLEO2VBS + XYLOLO2 + H2O + End Implicit + + End Solution classes + + + CHEMISTRY + Photolysis +********************************* +*** odd-oxygen +********************************* +[jh2o_b] H2O + hv -> H2 + O1D +[jh2o_a] H2O + hv -> OH + H +[jh2o_c] H2O + hv -> 2*H + O +[jh2o2] H2O2 + hv -> 2*OH +[jo2_a=userdefined,] O2 + hv -> O + O1D +[jo2_b=userdefined,] O2 + hv -> 2*O +[jo3_a] O3 + hv -> O1D + O2 +[jo3_b] O3 + hv -> O + O2 +********************************* +*** odd-nitrogen +********************************* +[jhno3] HNO3 + hv -> NO2 + OH +[jho2no2_a] HO2NO2 + hv -> OH + NO3 +[jho2no2_b] HO2NO2 + hv -> NO2 + HO2 +[jn2o] N2O + hv -> O1D + N2 +[jn2o5_a] N2O5 + hv -> NO2 + NO3 +[jn2o5_b] N2O5 + hv -> NO + O + NO3 +[jno=userdefined,] NO + hv -> N + O +[jno2] NO2 + hv -> NO + O +[jno3_b] NO3 + hv -> NO + O2 +[jno3_a] NO3 + hv -> NO2 + O +********************************* +*** organics +********************************* +[jalknit->,jch3ooh] ALKNIT + hv -> NO2 + 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + HO2 + 0.8*MEK +[jalkooh->,jch3ooh] ALKOOH + hv -> 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + 0.9*HO2 + 0.8*MEK + OH +[jbenzooh->,jch3ooh] BENZOOH + hv -> OH + GLYOXAL + 0.5*BIGALD1 + HO2 +[jbepomuc->,.10*jno2] BEPOMUC + hv -> BIGALD1 + 1.5*HO2 + 1.5*CO +[jbigald->,0.2*jno2] BIGALD + hv -> 0.45*CO + 0.13*GLYOXAL + 0.56*HO2 + 0.13*CH3CO3 + 0.18*CH3COCHO +[jbigald1->,.14*jno2] BIGALD1 + hv -> 0.6*MALO2 + HO2 +[jbigald2->,.20*jno2] BIGALD2 + hv -> 0.6*HO2 + 0.6*DICARBO2 +[jbigald3->,.20*jno2] BIGALD3 + hv -> 0.6*HO2 + 0.6*CO + 0.6*MDIALO2 +[jbigald4->,.006*jno2] BIGALD4 + hv -> HO2 + CO + CH3COCHO + CH3CO3 +[jbzooh->,jch3ooh] BZOOH + hv -> BZALD + OH + HO2 +[jc2h5ooh->,jch3ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH +[jc3h7ooh->,jch3ooh] C3H7OOH + hv -> 0.82*CH3COCH3 + OH + HO2 +[jc6h5ooh->,jch3ooh] C6H5OOH + hv -> PHENO + OH +[jch2o_a] CH2O + hv -> CO + 2*H +[jch2o_b] CH2O + hv -> CO + H2 +[jch3cho] CH3CHO + hv -> CH3O2 + CO + HO2 +[jacet] CH3COCH3 + hv -> CH3CO3 + CH3O2 +[jmgly] CH3COCHO + hv -> CH3CO3 + CO + HO2 +[jch3co3h->,0.28*jh2o2] CH3COOOH + hv -> CH3O2 + OH + CO2 +[jch3ooh] CH3OOH + hv -> CH2O + H + OH +[jch4_a] CH4 + hv -> H + CH3O2 +[jch4_b] CH4 + hv -> 1.44*H2 + 0.18*CH2O + 0.18*O + 0.33*OH + 0.33*H + 0.44*CO2 + 0.38*CO + 0.05*H2O +[jco2] CO2 + hv -> CO + O +[jeooh->,jch3ooh] EOOH + hv -> EO + OH +[jglyald] GLYALD + hv -> 2*HO2 + CO + CH2O +[jglyoxal->,jmgly] GLYOXAL + hv -> 2*CO + 2*HO2 +[jhonitr->,jch2o_a] HONITR + hv -> NO2 + 0.67*HO2 + 0.33*CH3CHO + 0.33*CH2O + 0.33*CO + 0.33*GLYALD + 0.33*CH3CO3 + 0.17*HYAC + 0.17*CH3COCH3 +[jhpald->,.006*jno2] HPALD + hv -> BIGALD3 + OH + HO2 +[jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O +[jisopnooh->,jch3ooh] ISOPNOOH + hv -> NO2 + HO2 + ISOPOOH +[jisopooh->,jch3ooh] ISOPOOH + hv -> 0.402*MVK + 0.288*MACR + 0.69*CH2O + HO2 +[jmacr_a] MACR + hv -> 1.34*HO2 + 0.66*MCO3 + 1.34*CH2O + 1.34*CH3CO3 +[jmacr_b] MACR + hv -> 0.66*HO2 + 1.34*CO +[jmek->,jacet] MEK + hv -> CH3CO3 + C2H5O2 +[jmekooh->,jch3ooh] MEKOOH + hv -> OH + CH3CO3 + CH3CHO +[jmpan->,jpan] MPAN + hv -> MCO3 + NO2 +[jmvk] MVK + hv -> 0.7*C3H6 + 0.7*CO + 0.3*CH3O2 + 0.3*CH3CO3 +[jnc4cho->,jch2o_a] NC4CHO + hv -> BIGALD3 + NO2 + HO2 +[jnoa->,jch2o_a] NOA + hv -> NO2 + CH2O + CH3CO3 +[jnterpooh->,jch3ooh] NTERPOOH + hv -> TERPROD1 + NO2 + OH +[jonitr->,jch3cho] ONITR + hv -> NO2 +[jpan] PAN + hv -> 0.6*CH3CO3 + 0.6*NO2 + 0.4*CH3O2 + 0.4*NO3 + 0.4*CO2 +[jphenooh->,jch3ooh] PHENOOH + hv -> OH + HO2 + 0.7*GLYOXAL +[jpooh->,jch3ooh] POOH + hv -> CH3CHO + CH2O + HO2 + OH +[jrooh->,jch3ooh] ROOH + hv -> CH3CO3 + CH2O + OH +[jtepomuc->,.10*jno2] TEPOMUC + hv -> 0.5*CH3CO3 + HO2 + 1.5*CO +[jterp2ooh->,jch3ooh] TERP2OOH + hv -> OH + 0.375*CH2O + 0.3*CH3COCH3 + 0.25*CO + CO2 + TERPROD2 + HO2 + 0.25*GLYALD +[jterpnit->,jch3ooh] TERPNIT + hv -> TERPROD1 + NO2 + HO2 +[jterpooh->,jch3ooh] TERPOOH + hv -> 0.4*CH2O + 0.05*CH3COCH3 + TERPROD1 + HO2 + OH +[jterprd1->,jch3cho] TERPROD1 + hv -> HO2 + CO + TERPROD2 +[jterprd2->,jch3cho] TERPROD2 + hv -> 0.15*RO2 + 0.68*CH2O + 0.8*CO2 + 0.5*CH3COCH3 + 0.65*CH3CO3 + 1.2*HO2 + 1.7*CO +[jtolooh->,jch3ooh] TOLOOH + hv -> OH + 0.6*GLYOXAL + 0.4*CH3COCHO + HO2 + 0.2*BIGALD1 + 0.2*BIGALD2 + 0.2*BIGALD3 +[jxooh->,jch3ooh] XOOH + hv -> OH +[jxylenooh->,jch3ooh] XYLENOOH + hv -> OH + HO2 + 0.34*GLYOXAL + 0.54*CH3COCHO + 0.06*BIGALD1 + 0.2*BIGALD2 + 0.15*BIGALD3 + 0.21*BIGALD4 +[jxylolooh->,jch3ooh] XYLOLOOH + hv -> OH + 0.17*GLYOXAL + 0.51*CH3COCHO + HO2 +********************************* +*** halogens +********************************* +[jbrcl] BRCL + hv -> BR + CL +[jbro] BRO + hv -> BR + O +[jbrono2_b] BRONO2 + hv -> BRO + NO2 +[jbrono2_a] BRONO2 + hv -> BR + NO3 +[jccl4] CCL4 + hv -> 4*CL +[jcf2clbr] CF2CLBR + hv -> BR + CL + COF2 +[jcf3br] CF3BR + hv -> BR + F + COF2 +[jcfcl3] CFC11 + hv -> 2*CL + COFCL +[jcfc113] CFC113 + hv -> 2*CL + COFCL + COF2 +[jcfc114] CFC114 + hv -> 2*CL + 2*COF2 +[jcfc115] CFC115 + hv -> CL + F + 2*COF2 +[jcf2cl2] CFC12 + hv -> 2*CL + COF2 +[jch2br2] CH2BR2 + hv -> 2*BR +[jch3br] CH3BR + hv -> BR + CH3O2 +[jch3ccl3] CH3CCL3 + hv -> 3*CL +[jch3cl] CH3CL + hv -> CL + CH3O2 +[jchbr3] CHBR3 + hv -> 3*BR +[jcl2] CL2 + hv -> 2*CL +[jcl2o2] CL2O2 + hv -> 2*CL +[jclo] CLO + hv -> CL + O +[jclono2_a] CLONO2 + hv -> CL + NO3 +[jclono2_b] CLONO2 + hv -> CLO + NO2 +[jcof2] COF2 + hv -> 2*F +[jcofcl] COFCL + hv -> F + CL +[jh2402] H2402 + hv -> 2*BR + 2*COF2 +[jhbr] HBR + hv -> BR + H +[jhcfc141b] HCFC141B + hv -> CL + COFCL +[jhcfc142b] HCFC142B + hv -> CL + COF2 +[jhcfc22] HCFC22 + hv -> CL + COF2 +[jhcl] HCL + hv -> H + CL +[jhf] HF + hv -> H + F +[jhobr] HOBR + hv -> BR + OH +[jhocl] HOCL + hv -> OH + CL +[joclo] OCLO + hv -> O + CLO +[jsf6] SF6 + hv -> sink +********************************* +*** sulfur +********************************* +[jh2so4] H2SO4 + hv -> SO3 + H2O +[jocs] OCS + hv -> S + CO +[jso] SO + hv -> S + O +[jso2] SO2 + hv -> SO + O +[jso3] SO3 + hv -> SO2 + O + End Photolysis + + Reactions +********************************* +*** odd-oxygen +********************************* +[O1D_H2] O1D + H2 -> H + OH ; 1.2e-10 +[O1D_H2O] O1D + H2O -> 2*OH ; 1.63e-10, 60 +[O1D_N2,cph=189.81] O1D + N2 -> O + N2 ; 2.15e-11, 110 +[O1D_O2ab] O1D + O2 -> O + O2 ; 3.3e-11, 55 +[O1D_O3] O1D + O3 -> O2 + O2 ; 1.2e-10 +[O_O3,cph=392.19] O + O3 -> 2*O2 ; 8e-12, -2060 +[usr_O_O,cph=493.58] O + O + M -> O2 + M +[usr_O_O2,cph=101.39] O + O2 + M -> O3 + M +********************************* +*** odd-hydrogen +********************************* +[H2_O] H2 + O -> OH + H ; 1.6e-11, -4570 +[H2O2_O] H2O2 + O -> OH + HO2 ; 1.4e-12, -2000 +[H_HO2,cph=232.59] H + HO2 -> H2 + O2 ; 6.9e-12 +[H_HO2a] H + HO2 -> 2*OH ; 7.2e-11 +[H_HO2b] H + HO2 -> H2O + O ; 1.6e-12 +[H_O2,cph=203.4] H + O2 + M -> HO2 + M ; 4.4e-32, 1.3, 7.5e-11, -0.2, 0.6 +[HO2_O,cph=226.58] HO2 + O -> OH + O2 ; 3e-11, 200 +[HO2_O3,cph=120.1] HO2 + O3 -> OH + 2*O2 ; 1e-14, -490 +[H_O3,cph=194.71] H + O3 -> OH + O2 ; 1.4e-10, -470 +[OH_H2] OH + H2 -> H2O + H ; 2.8e-12, -1800 +[OH_H2O2] OH + H2O2 -> H2O + HO2 ; 1.8e-12 +[OH_HO2,cph=293.62] OH + HO2 -> H2O + O2 ; 4.8e-11, 250 +[OH_O,cph=67.67] OH + O -> H + O2 ; 1.8e-11, 180 +[OH_O3,cph=165.3] OH + O3 -> HO2 + O2 ; 1.7e-12, -940 +[OH_OH] OH + OH -> H2O + O ; 1.8e-12 +[OH_OH_M] OH + OH + M -> H2O2 + M ; 6.9e-31, 1, 2.6e-11, 0, 0.6 +[usr_HO2_HO2,cph=165.51] HO2 + HO2 -> H2O2 + O2 +********************************* +*** odd-nitrogen +********************************* +[HO2NO2_OH] HO2NO2 + OH -> H2O + NO2 + O2 ; 1.3e-12, 380 +[N_NO,cph=313.75] N + NO -> N2 + O ; 2.1e-11, 100 +[N_NO2a] N + NO2 -> N2O + O ; 2.9e-12, 220 +[N_NO2b] N + NO2 -> 2*NO ; 1.45e-12, 220 +[N_NO2c] N + NO2 -> N2 + O2 ; 1.45e-12, 220 +[N_O2,cph=133.75] N + O2 -> NO + O ; 1.5e-11, -3600 +[NO2_O,cph=193.02] NO2 + O -> NO + O2 ; 5.1e-12, 210 +[NO2_O3] NO2 + O3 -> NO3 + O2 ; 1.2e-13, -2450 +[NO2_O_M] NO2 + O + M -> NO3 + M ; 2.5e-31, 1.8, 2.2e-11, 0.7, 0.6 +[NO3_HO2] NO3 + HO2 -> OH + NO2 + O2 ; 3.5e-12 +[NO3_NO] NO3 + NO -> 2*NO2 ; 1.5e-11, 170 +[NO3_O] NO3 + O -> NO2 + O2 ; 1e-11 +[NO3_OH] NO3 + OH -> HO2 + NO2 ; 2.2e-11 +[N_OH] N + OH -> NO + H ; 5e-11 +[NO_HO2,cph=34.47] NO + HO2 -> NO2 + OH ; 3.3e-12, 270 +[NO_O3,cph=199.17] NO + O3 -> NO2 + O2 ; 3e-12, -1500 +[NO_O_M] NO + O + M -> NO2 + M ; 9e-32, 1.5, 3e-11, 0, 0.6 +[O1D_N2Oa] O1D + N2O -> 2*NO ; 7.26e-11, 20 +[O1D_N2Ob] O1D + N2O -> N2 + O2 ; 4.64e-11, 20 +[tag_NO2_HO2] NO2 + HO2 + M -> HO2NO2 + M ; 1.9e-31, 3.4, 4e-12, 0.3, 0.6 +[tag_NO2_NO3] NO2 + NO3 + M -> N2O5 + M ; 2.4e-30, 3, 1.6e-12, -0.1, 0.6 +[tag_NO2_OH] NO2 + OH + M -> HNO3 + M ; 1.8e-30, 3, 2.8e-11, 0, 0.6 +[usr_HNO3_OH] HNO3 + OH -> NO3 + H2O +[usr_HO2NO2_M] HO2NO2 + M -> HO2 + NO2 + M +[usr_N2O5_M] N2O5 + M -> NO2 + NO3 + M +********************************* +*** odd-chlorine +********************************* +[CL_CH2O] CL + CH2O -> HCL + HO2 + CO ; 8.1e-11, -30 +[CL_CH4] CL + CH4 -> CH3O2 + HCL ; 7.1e-12, -1270 +[CL_H2] CL + H2 -> HCL + H ; 3.05e-11, -2270 +[CL_H2O2] CL + H2O2 -> HCL + HO2 ; 1.1e-11, -980 +[CL_HO2a] CL + HO2 -> HCL + O2 ; 1.4e-11, 270 +[CL_HO2b] CL + HO2 -> OH + CLO ; 3.6e-11, -375 +[CL_O3] CL + O3 -> CLO + O2 ; 2.3e-11, -200 +[CLO_CH3O2] CLO + CH3O2 -> CL + HO2 + CH2O ; 3.3e-12, -115 +[CLO_CLOa] CLO + CLO -> 2*CL + O2 ; 3e-11, -2450 +[CLO_CLOb] CLO + CLO -> CL2 + O2 ; 1e-12, -1590 +[CLO_CLOc] CLO + CLO -> CL + OCLO ; 3.5e-13, -1370 +[CLO_HO2] CLO + HO2 -> O2 + HOCL ; 2.6e-12, 290 +[CLO_NO] CLO + NO -> NO2 + CL ; 6.4e-12, 290 +[CLONO2_CL] CLONO2 + CL -> CL2 + NO3 ; 6.5e-12, 135 +[CLO_NO2_M] CLO + NO2 + M -> CLONO2 + M ; 1.8e-31, 3.4, 1.5e-11, 1.9, 0.6 +[CLONO2_O] CLONO2 + O -> CLO + NO3 ; 3.6e-12, -840 +[CLONO2_OH] CLONO2 + OH -> HOCL + NO3 ; 1.2e-12, -330 +[CLO_O] CLO + O -> CL + O2 ; 2.8e-11, 85 +[CLO_OHa] CLO + OH -> CL + HO2 ; 7.4e-12, 270 +[CLO_OHb] CLO + OH -> HCL + O2 ; 6e-13, 230 +[HCL_O] HCL + O -> CL + OH ; 1e-11, -3300 +[HCL_OH] HCL + OH -> H2O + CL ; 1.8e-12, -250 +[HOCL_CL] HOCL + CL -> HCL + CLO ; 3.4e-12, -130 +[HOCL_O] HOCL + O -> CLO + OH ; 1.7e-13 +[HOCL_OH] HOCL + OH -> H2O + CLO ; 3e-12, -500 +[O1D_CCL4] O1D + CCL4 -> 4*CL ; 2.607e-10 +[O1D_CF2CLBR] O1D + CF2CLBR -> CL + BR + COF2 ; 9.75e-11 +[O1D_CFC11] O1D + CFC11 -> 2*CL + COFCL ; 2.07e-10 +[O1D_CFC113] O1D + CFC113 -> 2*CL + COFCL + COF2 ; 2.088e-10 +[O1D_CFC114] O1D + CFC114 -> 2*CL + 2*COF2 ; 1.17e-10 +[O1D_CFC115] O1D + CFC115 -> CL + F + 2*COF2 ; 4.644e-11 +[O1D_CFC12] O1D + CFC12 -> 2*CL + COF2 ; 1.204e-10 +[O1D_HCLa] O1D + HCL -> CL + OH ; 9.9e-11 +[O1D_HCLb] O1D + HCL -> CLO + H ; 3.3e-12 +[tag_CLO_CLO_M] CLO + CLO + M -> CL2O2 + M ; 1.9e-32, 3.6, 3.7e-12, 1.6, 0.6 +[usr_CL2O2_M] CL2O2 + M -> CLO + CLO + M +********************************* +*** odd-bromine +********************************* +[BR_CH2O] BR + CH2O -> HBR + HO2 + CO ; 1.7e-11, -800 +[BR_HO2] BR + HO2 -> HBR + O2 ; 4.8e-12, -310 +[BR_O3] BR + O3 -> BRO + O2 ; 1.6e-11, -780 +[BRO_BRO] BRO + BRO -> 2*BR + O2 ; 1.5e-12, 230 +[BRO_CLOa] BRO + CLO -> BR + OCLO ; 9.5e-13, 550 +[BRO_CLOb] BRO + CLO -> BR + CL + O2 ; 2.3e-12, 260 +[BRO_CLOc] BRO + CLO -> BRCL + O2 ; 4.1e-13, 290 +[BRO_HO2] BRO + HO2 -> HOBR + O2 ; 4.5e-12, 460 +[BRO_NO] BRO + NO -> BR + NO2 ; 8.8e-12, 260 +[BRO_NO2_M] BRO + NO2 + M -> BRONO2 + M ; 5.2e-31, 3.2, 6.9e-12, 2.9, 0.6 +[BRONO2_O] BRONO2 + O -> BRO + NO3 ; 1.9e-11, 215 +[BRO_O] BRO + O -> BR + O2 ; 1.9e-11, 230 +[BRO_OH] BRO + OH -> BR + HO2 ; 1.7e-11, 250 +[HBR_O] HBR + O -> BR + OH ; 5.8e-12, -1500 +[HBR_OH] HBR + OH -> BR + H2O ; 5.5e-12, 200 +[HOBR_O] HOBR + O -> BRO + OH ; 1.2e-10, -430 +[O1D_CF3BR] O1D + CF3BR -> BR + F + COF2 ; 4.5e-11 +[O1D_CHBR3] O1D + CHBR3 -> 3*BR ; 4.62e-10 +[O1D_H2402] O1D + H2402 -> 2*BR + 2*COF2 ; 1.2e-10 +[O1D_HBRa] O1D + HBR -> BR + OH ; 9e-11 +[O1D_HBRb] O1D + HBR -> BRO + H ; 3e-11 +********************************* +*** odd-fluorine +********************************* +[F_CH4] F + CH4 -> HF + CH3O2 ; 1.6e-10, -260 +[F_H2] F + H2 -> HF + H ; 1.4e-10, -500 +[F_H2O] F + H2O -> HF + OH ; 1.4e-11, 0 +[F_HNO3] F + HNO3 -> HF + NO3 ; 6e-12, 400 +[O1D_COF2] O1D + COF2 -> 2*F ; 2.14e-11 +[O1D_COFCL] O1D + COFCL -> F + CL ; 1.9e-10 +********************************* +*** organic-halogens +********************************* +[CH2BR2_CL] CH2BR2 + CL -> 2*BR + HCL ; 6.3e-12, -800 +[CH2BR2_OH] CH2BR2 + OH -> 2*BR + H2O ; 2e-12, -840 +[CH3BR_CL] CH3BR + CL -> HCL + HO2 + BR ; 1.46e-11, -1040 +[CH3BR_OH] CH3BR + OH -> BR + H2O + HO2 ; 1.42e-12, -1150 +[CH3CCL3_OH] CH3CCL3 + OH -> H2O + 3*CL ; 1.64e-12, -1520 +[CH3CL_CL] CH3CL + CL -> HO2 + CO + 2*HCL ; 2.03e-11, -1100 +[CH3CL_OH] CH3CL + OH -> CL + H2O + HO2 ; 1.96e-12, -1200 +[CHBR3_CL] CHBR3 + CL -> 3*BR + HCL ; 4.85e-12, -850 +[CHBR3_OH] CHBR3 + OH -> 3*BR ; 9e-13, -360 +[HCFC141B_OH] HCFC141B + OH -> CL + COFCL ; 1.25e-12, -1600 +[HCFC142B_OH] HCFC142B + OH -> CL + COF2 ; 1.3e-12, -1770 +[HCFC22_OH] HCFC22 + OH -> H2O + CL + COF2 ; 9.2e-13, -1560 +[O1D_CH2BR2] O1D + CH2BR2 -> 2*BR ; 2.57e-10 +[O1D_CH3BR] O1D + CH3BR -> BR ; 1.8e-10 +[O1D_HCFC141B] O1D + HCFC141B -> CL + COFCL ; 1.794e-10 +[O1D_HCFC142B] O1D + HCFC142B -> CL + COF2 ; 1.3e-10 +[O1D_HCFC22] O1D + HCFC22 -> CL + COF2 ; 7.65e-11 +********************************* +*** C1 +********************************* +[CH2O_HO2] CH2O + HO2 -> HOCH2OO ; 9.7e-15, 625 +[CH2O_NO3] CH2O + NO3 -> CO + HO2 + HNO3 ; 6e-13, -2058 +[CH2O_O] CH2O + O -> HO2 + OH + CO ; 3.4e-11, -1600 +[CH2O_OH] CH2O + OH -> CO + H2O + H ; 5.5e-12, 125 +[CH3O2_CH3O2a] CH3O2 + CH3O2 -> 2*CH2O + 2*HO2 ; 5e-13, -424 +[CH3O2_CH3O2b] CH3O2 + CH3O2 -> CH2O + CH3OH ; 1.9e-14, 706 +[CH3O2_HO2] CH3O2 + HO2 -> CH3OOH + O2 ; 4.1e-13, 750 +[CH3O2_NO] CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.8e-12, 300 +[CH3OH_OH] CH3OH + OH -> HO2 + CH2O ; 2.9e-12, -345 +[CH3OOH_OH] CH3OOH + OH -> 0.7*CH3O2 + 0.3*OH + 0.3*CH2O + H2O ; 3.8e-12, 200 +[CH4_OH] CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775 +[CO_OH_M] CO + OH + M -> CO2 + HO2 + M ; 5.9e-33, 1, 1.1e-12, -1.3, 0.6 +[HCN_OH] HCN + OH + M -> HO2 + M ; 4.28e-33, 0, 9.3e-15, -4.42, 0.8 +[HCOOH_OH] HCOOH + OH -> HO2 + CO2 + H2O ; 4e-13 +[HOCH2OO_HO2] HOCH2OO + HO2 -> HCOOH ; 7.5e-13, 700 +[HOCH2OO_M] HOCH2OO -> CH2O + HO2 ; 2.4e+12, -7000 +[HOCH2OO_NO] HOCH2OO + NO -> HCOOH + NO2 + HO2 ; 2.6e-12, 265 +[O1D_CH4a] O1D + CH4 -> CH3O2 + OH ; 1.31e-10 +[O1D_CH4b] O1D + CH4 -> CH2O + H + HO2 ; 3.5e-11 +[O1D_CH4c] O1D + CH4 -> CH2O + H2 ; 9e-12 +[O1D_HCN] O1D + HCN -> OH ; 1.08e-10, 105 +[usr_CO_OH_b] CO + OH -> CO2 + H +********************************* +*** C2 +********************************* +[C2H2_CL_M] C2H2 + CL + M -> CL + M ; 5.2e-30, 2.4, 2.2e-10, 0.7, 0.6 +[C2H2_OH_M] C2H2 + OH + M -> 0.65*GLYOXAL + 0.65*OH + 0.35*HCOOH + 0.35*HO2 + 0.35*CO + M ; 5.5e-30, 0, 8.3e-13, -2, 0.6 +[C2H4_CL_M] C2H4 + CL + M -> CL + M ; 1.6e-29, 3.3, 3.1e-10, 1, 0.6 +[C2H4_O3] C2H4 + O3 -> 0.63*CO + 0.13*OH + 0.13*HO2 + 0.37*HCOOH + CH2O ; 1.2e-14, -2630 +[C2H5O2_C2H5O2] C2H5O2 + C2H5O2 -> 1.6*CH3CHO + 1.2*HO2 + 0.4*C2H5OH ; 6.8e-14 +[C2H5O2_CH3O2] C2H5O2 + CH3O2 -> 0.7*CH2O + 0.8*CH3CHO + HO2 + 0.3*CH3OH + 0.2*C2H5OH ; 2e-13 +[C2H5O2_HO2] C2H5O2 + HO2 -> C2H5OOH + O2 ; 7.5e-13, 700 +[C2H5O2_NO] C2H5O2 + NO -> CH3CHO + HO2 + NO2 ; 2.6e-12, 365 +[C2H5OH_OH] C2H5OH + OH -> HO2 + CH3CHO ; 6.9e-12, -230 +[C2H5OOH_OH] C2H5OOH + OH -> 0.5*C2H5O2 + 0.5*CH3CHO + 0.5*OH ; 3.8e-12, 200 +[C2H6_CL] C2H6 + CL -> HCL + C2H5O2 ; 7.2e-11, -70 +[C2H6_OH] C2H6 + OH -> C2H5O2 + H2O ; 7.66e-12, -1020 +[CH3CHO_NO3] CH3CHO + NO3 -> CH3CO3 + HNO3 ; 1.4e-12, -1900 +[CH3CHO_OH] CH3CHO + OH -> CH3CO3 + H2O ; 4.63e-12, 350 +[CH3CN_OH] CH3CN + OH -> HO2 ; 7.8e-13, -1050 +[CH3CO3_CH3CO3] CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 ; 2.9e-12, 500 +[CH3CO3_CH3O2] CH3CO3 + CH3O2 -> 0.9*CH3O2 + CH2O + 0.9*HO2 + 0.9*CO2 + 0.1*CH3COOH ; 2e-12, 500 +[CH3CO3_HO2] CH3CO3 + HO2 -> 0.4*CH3COOOH + 0.15*CH3COOH + 0.15*O3 + 0.45*OH + 0.45*CH3O2 ; 4.3e-13, 1040 +[CH3CO3_NO] CH3CO3 + NO -> CH3O2 + CO2 + NO2 ; 8.1e-12, 270 +[CH3COOH_OH] CH3COOH + OH -> CH3O2 + CO2 + H2O ; 7e-13 +[CH3COOOH_OH] CH3COOOH + OH -> 0.5*CH3CO3 + 0.5*CH2O + 0.5*CO2 + H2O ; 1e-12 +[EO2_HO2] EO2 + HO2 -> EOOH ; 7.5e-13, 700 +[EO2_NO] EO2 + NO -> 0.5*CH2O + 0.25*HO2 + 0.75*EO + NO2 ; 4.2e-12, 180 +[EO_M] EO -> 2*CH2O + HO2 ; 1.6e+11, -4150 +[EO_O2] EO + O2 -> GLYALD + HO2 ; 1e-14 +[GLYALD_OH] GLYALD + OH -> HO2 + 0.2*GLYOXAL + 0.8*CH2O + 0.8*CO2 ; 1e-11 +[GLYOXAL_OH] GLYOXAL + OH -> HO2 + CO + CO2 ; 1.15e-11 +[PAN_OH] PAN + OH -> CH2O + NO3 ; 4e-14 +[tag_C2H4_OH] C2H4 + OH + M -> EO2 + M ; 8.6e-29, 3.1, 9e-12, 0.85, 0.48 +[tag_CH3CO3_NO2] CH3CO3 + NO2 + M -> PAN + M ; 9.7e-29, 5.6, 9.3e-12, 1.5, 0.6 +[usr_PAN_M] PAN + M -> CH3CO3 + NO2 + M +********************************* +*** C3 +********************************* +[C3H6_NO3] C3H6 + NO3 -> NOA ; 4.6e-13, -1156 +[C3H6_O3] C3H6 + O3 -> 0.5*CH2O + 0.12*HCOOH + 0.12*CH3COOH + 0.5*CH3CHO + 0.56*CO + 0.28*CH3O2 + 0.1*CH4 + 0.2*CO2 + 0.28*HO2 + 0.36*OH ; 6.5e-15, -1900 +[C3H7O2_CH3O2] C3H7O2 + CH3O2 -> CH2O + HO2 + 0.82*CH3COCH3 ; 3.75e-13, -40 +[C3H7O2_HO2] C3H7O2 + HO2 -> C3H7OOH + O2 ; 7.5e-13, 700 +[C3H7O2_NO] C3H7O2 + NO -> 0.82*CH3COCH3 + NO2 + HO2 + 0.27*CH3CHO ; 4.2e-12, 180 +[C3H7OOH_OH] C3H7OOH + OH -> H2O + C3H7O2 ; 3.8e-12, 200 +[C3H8_OH] C3H8 + OH -> C3H7O2 + H2O ; 8.7e-12, -615 +[CH3COCHO_NO3] CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 ; 1.4e-12, -1860 +[CH3COCHO_OH] CH3COCHO + OH -> CH3CO3 + CO + H2O ; 8.4e-13, 830 +[HYAC_OH] HYAC + OH -> CH3COCHO + HO2 ; 3e-12 +[NOA_OH] NOA + OH -> NO2 + CH3COCHO ; 6.7e-13 +[PO2_HO2] PO2 + HO2 -> POOH + O2 ; 7.5e-13, 700 +[PO2_NO] PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 ; 4.2e-12, 180 +[POOH_OH] POOH + OH -> 0.5*PO2 + 0.5*OH + 0.5*HYAC + H2O ; 3.8e-12, 200 +[RO2_CH3O2] RO2 + CH3O2 -> 0.3*CH3CO3 + 0.8*CH2O + 0.3*HO2 + 0.2*HYAC + 0.5*CH3COCHO + 0.5*CH3OH ; 7.1e-13, 500 +[RO2_HO2] RO2 + HO2 -> 0.85*ROOH + 0.15*OH + 0.15*CH2O + 0.15*CH3CO3 ; 8.6e-13, 700 +[RO2_NO] RO2 + NO -> CH3CO3 + CH2O + NO2 ; 2.9e-12, 300 +[ROOH_OH] ROOH + OH -> RO2 + H2O ; 3.8e-12, 200 +[tag_C3H6_OH] C3H6 + OH + M -> PO2 + M ; 8e-27, 3.5, 3e-11, 0, 0.5 +[usr_CH3COCH3_OH] CH3COCH3 + OH -> RO2 + H2O +********************************* +*** C4 +********************************* +[BIGENE_NO3] BIGENE + NO3 -> NO2 + CH3CHO + 0.5*CH2O + 0.5*CH3COCH3 ; 3.5e-13 +[BIGENE_OH] BIGENE + OH -> ENEO2 ; 5.4e-11 +[ENEO2_NO] ENEO2 + NO -> CH3CHO + 0.5*CH2O + 0.5*CH3COCH3 + HO2 + NO2 ; 4.8e-12, 120 +[ENEO2_NOb] ENEO2 + NO -> HONITR ; 5.1e-14, 693 +[HONITR_OH] HONITR + OH -> ONITR + HO2 ; 2e-12 +[MACRO2_CH3CO3] MACRO2 + CH3CO3 -> 0.25*CH3COCHO + CH3O2 + 0.22*CO + 0.47*HO2 + 0.53*GLYALD + 0.22*HYAC + 0.25*CH2O + 0.53*CH3CO3 ; 1.4e-11 +[MACRO2_CH3O2] MACRO2 + CH3O2 -> 0.73*HO2 + 0.88*CH2O + 0.11*CO + 0.24*CH3COCHO + 0.26*GLYALD + 0.26*CH3CO3 + 0.25*CH3OH + 0.23*HYAC ; 5e-13, 400 +[MACRO2_HO2] MACRO2 + HO2 -> MACROOH ; 8e-13, 700 +[MACRO2_NO3] MACRO2 + NO3 -> NO2 + 0.47*HO2 + 0.25*CH2O + 0.25*CH3COCHO + 0.22*CO + 0.53*GLYALD + 0.22*HYAC + 0.53*CH3CO3 ; 2.4e-12 +[MACRO2_NOa] MACRO2 + NO -> NO2 + 0.47*HO2 + 0.25*CH2O + 0.53*GLYALD + 0.25*CH3COCHO + 0.53*CH3CO3 + 0.22*HYAC + 0.22*CO ; 2.7e-12, 360 +[MACRO2_NOb] MACRO2 + NO -> HONITR ; 1.3e-13, 360 +[MACR_O3] MACR + O3 -> 0.12*CH2O + 0.24*OH + 0.65*CO + 0.1*CH3CO3 + 0.88*CH3COCHO + 0.33*HCOOH + 0.14*HO2 ; 1.5e-15, -2100 +[MACR_OH] MACR + OH -> 0.5*MACRO2 + 0.5*H2O + 0.5*MCO3 ; 9.6e-12, 360 +[MACROOH_OH] MACROOH + OH -> 0.5*MCO3 + 0.2*MACRO2 + 0.1*OH + 0.2*HO2 ; 2.3e-11, 200 +[MCO3_CH3CO3] MCO3 + CH3CO3 -> 2*CO2 + CH3O2 + CH2O + CH3CO3 ; 4.6e-12, 530 +[MCO3_CH3O2] MCO3 + CH3O2 -> 2*CH2O + HO2 + CO2 + CH3CO3 ; 2e-12, 500 +[MCO3_HO2] MCO3 + HO2 -> 0.15*O3 + 0.15*CH3COOH + 0.4*CH3COOOH + 0.45*OH + 0.45*CO2 + 0.45*CH2O + 0.45*CH3CO3 ; 4.3e-13, 1040 +[MCO3_MCO3] MCO3 + MCO3 -> 2*CO2 + 2*CH2O + 2*CH3CO3 ; 2.3e-12, 530 +[MCO3_NO] MCO3 + NO -> NO2 + CH2O + CH3CO3 ; 5.3e-12, 360 +[MCO3_NO3] MCO3 + NO3 -> NO2 + CH2O + CH3CO3 ; 5e-12 +[MEKO2_HO2] MEKO2 + HO2 -> 0.8*MEKOOH + 0.2*OH + 0.2*CH3CHO + 0.2*CH3CO3 ; 7.5e-13, 700 +[MEKO2_NO] MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 ; 4.2e-12, 180 +[MEK_OH] MEK + OH -> MEKO2 ; 2.3e-12, -170 +[MEKOOH_OH] MEKOOH + OH -> MEKO2 ; 3.8e-12, 200 +[MPAN_OH_M] MPAN + OH + M -> 0.5*HYAC + 0.5*NO3 + 0.5*CH2O + 0.5*HO2 + 0.5*CO2 + M + 0.5*NDEP ; 8e-27, 3.5, 3e-11, 0, 0.5 +[MVK_O3] MVK + O3 -> 0.6*CH2O + 0.56*CO + 0.1*CH3CHO + 0.1*CO2 + 0.28*CH3CO3 + 0.5*CH3COCHO + 0.28*HO2 + 0.36*OH + 0.12*HCOOH ; 8.5e-16, -1520 +[MVK_OH] MVK + OH -> MACRO2 ; 4.13e-12, 452 +[usr_MCO3_NO2] MCO3 + NO2 + M -> MPAN + M +[usr_MPAN_M] MPAN + M -> MCO3 + NO2 + M +********************************* +*** C5 +********************************* +[ALKNIT_OH] ALKNIT + OH -> 0.4*CH2O + 0.8*CH3CHO + 0.8*CH3COCH3 + NO2 ; 1.6e-12 +[ALKO2_HO2] ALKO2 + HO2 -> ALKOOH ; 7.5e-13, 700 +[ALKO2_NO] ALKO2 + NO -> 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + HO2 + 0.8*MEK + NO2 ; 6.7e-12 +[ALKO2_NOb] ALKO2 + NO -> ALKNIT ; 5.4e-14, 870 +[ALKOOH_OH] ALKOOH + OH -> ALKO2 ; 3.8e-12, 200 +[BIGALK_OH] BIGALK + OH -> ALKO2 ; 3.5e-12 +[HPALD_OH] HPALD + OH -> XO2 ; 1.86e-11, 175 +[HYDRALD_OH] HYDRALD + OH -> XO2 ; 1.86e-11, 175 +[IEPOX_OH] IEPOX + OH -> XO2 ; 1.3e-11 +[ISOPAO2_CH3CO3] ISOPAO2 + CH3CO3 -> CH3O2 + HO2 + CH2O + 0.39*MACR + 0.61*MVK + CO2 ; 1.4e-11 +[ISOPAO2_CH3O2] ISOPAO2 + CH3O2 -> 0.25*CH3OH + HO2 + 1.5*CH2O + 0.31*MACR + 0.44*MVK ; 5e-13, 400 +[ISOPAO2_HO2] ISOPAO2 + HO2 -> ISOPOOH ; 8e-13, 700 +[ISOPAO2_NO] ISOPAO2 + NO -> 0.08*ISOPNITA + 0.92*NO2 + 0.36*MACR + 0.56*MVK + 0.92*CH2O + 0.92*HO2 ; 4.4e-12, 180 +[ISOPAO2_NO3] ISOPAO2 + NO3 -> NO2 + 0.4*MACR + 0.6*MVK + CH2O + HO2 ; 2.4e-12 +[ISOPBO2_CH3CO3] ISOPBO2 + CH3CO3 -> HYDRALD + CH3O2 + HO2 ; 1.4e-11 +[ISOPBO2_CH3O2] ISOPBO2 + CH3O2 -> 0.25*CH3OH + HO2 + 0.75*CH2O + 0.75*HYDRALD ; 5e-13, 400 +[ISOPBO2_HO2] ISOPBO2 + HO2 -> ISOPOOH ; 8e-13, 700 +[ISOPBO2_M] ISOPBO2 -> HPALD + HO2 ; 1.6e+09, -8300 +[ISOPBO2_NO] ISOPBO2 + NO -> 0.87*HYDRALD + 0.08*ISOPNITB + 0.92*NO2 + 0.92*HO2 + 0.05*GLYOXAL + 0.05*GLYALD + 0.05*CH3COCHO + 0.05*HYAC ; 4.4e-12, 180 +[ISOPBO2_NO3] ISOPBO2 + NO3 -> NO2 + 0.95*HYDRALD + HO2 + 0.05*GLYOXAL + 0.05*GLYALD + 0.05*CH3COCHO + 0.05*HYAC ; 2.4e-12 +[ISOPNITA_OH] ISOPNITA + OH -> 0.7*HYAC + 0.7*GLYALD + 0.7*NO2 + 0.3*CH2O + 0.3*HONITR + 0.3*HO2 ; 4e-11 +[ISOPNITB_OH] ISOPNITB + OH -> 0.5*HYAC + 0.5*GLYALD + 0.5*NOA + HO2 + 0.5*HONITR ; 4e-11 +[ISOP_NO3] ISOP + NO3 -> ISOPNO3 ; 3.03e-12, -446 +[ISOPNO3_CH3CO3] ISOPNO3 + CH3CO3 -> NC4CHO + CH3O2 + HO2 ; 1.4e-11 +[ISOPNO3_CH3O2] ISOPNO3 + CH3O2 -> 0.8*NC4CHO + 1.2*HO2 + 0.8*CH2O + 0.2*CH3OH + 0.2*NC4CH2OH ; 5e-13, 400 +[ISOPNO3_HO2] ISOPNO3 + HO2 -> ISOPNOOH ; 8e-13, 700 +[ISOPNO3_NO] ISOPNO3 + NO -> NC4CHO + NO2 + HO2 ; 2.7e-12, 360 +[ISOPNO3_NO3] ISOPNO3 + NO3 -> NC4CHO + NO2 + HO2 ; 2.4e-12 +[ISOPNOOH_OH] ISOPNOOH + OH -> NOA + HO2 ; 4e-11 +[ISOP_O3] ISOP + O3 -> 0.3*MACR + 0.2*MVK + 0.11*HCOOH + 0.62*CO + 0.32*OH + 0.37*HO2 + 0.91*CH2O + 0.08*CH3CO3 + 0.13*C3H6 + 0.05*CH3O2 ; 1.05e-14, -2000 +[ISOP_OH] ISOP + OH -> 0.6*ISOPAO2 + 0.4*ISOPBO2 ; 2.54e-11, 410 +[ISOPOOH_OH] ISOPOOH + OH -> 0.4*XO2 + 0.6*IEPOX + 0.6*OH ; 1.52e-11, 200 +[NC4CH2OH_OH] NC4CH2OH + OH -> GLYALD + NOA + HO2 ; 7e-11 +[NC4CHO_OH] NC4CHO + OH -> GLYOXAL + NOA + HO2 ; 1e-10 +[XO2_CH3CO3] XO2 + CH3CO3 -> 0.25*CO + 0.25*CH2O + 0.25*GLYOXAL + CH3O2 + HO2 + 0.25*CH3COCHO + 0.25*HYAC + 0.25*GLYALD + CO2 ; 1.3e-12, 640 +[XO2_CH3O2] XO2 + CH3O2 -> 0.3*CH3OH + 0.8*HO2 + 0.8*CH2O + 0.2*CO + 0.1*GLYOXAL + 0.1*CH3COCHO + 0.1*HYAC + 0.1*GLYALD ; 5e-13, 400 +[XO2_HO2] XO2 + HO2 -> XOOH ; 8e-13, 700 +[XO2_NO] XO2 + NO -> NO2 + HO2 + 0.25*CO + 0.25*CH2O + 0.25*GLYOXAL + 0.25*CH3COCHO + 0.25*HYAC + 0.25*GLYALD ; 2.7e-12, 360 +[XO2_NO3] XO2 + NO3 -> NO2 + HO2 + 0.5*CO + 0.25*HYAC + 0.25*GLYOXAL + 0.25*CH3COCHO + 0.25*GLYALD ; 2.4e-12 +[XOOH_OH] XOOH + OH -> 0.5*XO2 + 0.5*OH ; 1.52e-12, 200 +********************************* +*** C7 +********************************* +[ACBZO2_HO2] ACBZO2 + HO2 -> 0.4*C6H5O2 + 0.4*OH ; 4.3e-13, 1040 +[ACBZO2_NO] ACBZO2 + NO -> C6H5O2 + NO2 ; 7.5e-12, 290 +[BENZENE_OH] BENZENE + OH -> 0.53*PHENOL + 0.12*BEPOMUC + 0.65*HO2 + 0.35*BENZO2 ; 2.3e-12, -193 +[BENZO2_HO2] BENZO2 + HO2 -> BENZOOH ; 7.5e-13, 700 +[BENZO2_NO] BENZO2 + NO -> NO2 + GLYOXAL + 0.5*BIGALD1 + HO2 ; 2.6e-12, 365 +[BENZOOH_OH] BENZOOH + OH -> BENZO2 ; 3.8e-12, 200 +[BZALD_OH] BZALD + OH -> ACBZO2 ; 5.9e-12, 225 +[BZOO_HO2] BZOO + HO2 -> BZOOH ; 7.5e-13, 700 +[BZOOH_OH] BZOOH + OH -> BZOO ; 3.8e-12, 200 +[BZOO_NO] BZOO + NO -> BZALD + NO2 + HO2 ; 2.6e-12, 365 +[C6H5O2_HO2] C6H5O2 + HO2 -> C6H5OOH ; 7.5e-13, 700 +[C6H5O2_NO] C6H5O2 + NO -> PHENO + NO2 ; 2.6e-12, 365 +[C6H5OOH_OH] C6H5OOH + OH -> C6H5O2 ; 3.8e-12, 200 +[CRESOL_OH] CRESOL + OH -> 0.2*PHENO2 + 0.73*HO2 + 0.07*PHENO ; 4.7e-11 +[DICARBO2_HO2] DICARBO2 + HO2 -> 0.4*OH + 0.07*HO2 + 0.07*CH3COCHO + 0.07*CO + 0.33*CH3O2 ; 4.3e-13, 1040 +[DICARBO2_NO] DICARBO2 + NO -> NO2 + 0.17*HO2 + 0.17*CH3COCHO + 0.17*CO + 0.83*CH3O2 ; 7.5e-12, 290 +[DICARBO2_NO2] DICARBO2 + NO2 + M -> M + 1*NDEP ; 9.7e-29, 5.6, 9.3e-12, 1.5, 0.6 +[MALO2_HO2] MALO2 + HO2 -> 0.16*GLYOXAL + 0.16*HO2 + 0.16*CO ; 4.3e-13, 1040 +[MALO2_NO] MALO2 + NO -> 0.4*GLYOXAL + 0.4*HO2 + 0.4*CO + NO2 ; 7.5e-12, 290 +[MALO2_NO2] MALO2 + NO2 + M -> M + 1*NDEP ; 9.7e-29, 5.6, 9.3e-12, 1.5, 0.6 +[MDIALO2_HO2] MDIALO2 + HO2 -> 0.4*OH + 0.33*HO2 + 0.07*CH3COCHO + 0.14*CO + 0.07*CH3O2 + 0.07*GLYOXAL ; 4.3e-13, 1040 +[MDIALO2_NO] MDIALO2 + NO -> NO2 + 0.83*HO2 + 0.17*CH3COCHO + 0.35*CO + 0.17*CH3O2 + 0.17*GLYOXAL ; 7.5e-12, 290 +[MDIALO2_NO2] MDIALO2 + NO2 + M -> M + 1*NDEP ; 9.7e-29, 5.6, 9.3e-12, 1.5, 0.6 +[PHENO2_HO2] PHENO2 + HO2 -> PHENOOH ; 7.5e-13, 700 +[PHENO2_NO] PHENO2 + NO -> HO2 + 0.7*GLYOXAL + NO2 ; 2.6e-12, 365 +[PHENOL_OH] PHENOL + OH -> 0.14*PHENO2 + 0.8*HO2 + 0.06*PHENO ; 4.7e-13, 1220 +[PHENO_NO2] PHENO + NO2 -> 1*NDEP ; 2.1e-12 +[PHENO_O3] PHENO + O3 -> C6H5O2 ; 2.8e-13 +[PHENOOH_OH] PHENOOH + OH -> PHENO2 ; 3.8e-12, 200 +[tag_ACBZO2_NO2] ACBZO2 + NO2 + M -> PBZNIT + M ; 9.7e-29, 5.6, 9.3e-12, 1.5, 0.6 +[TOLO2_HO2] TOLO2 + HO2 -> TOLOOH ; 7.5e-13, 700 +[TOLO2_NO] TOLO2 + NO -> NO2 + 0.6*GLYOXAL + 0.4*CH3COCHO + HO2 + 0.2*BIGALD1 + 0.2*BIGALD2 + 0.2*BIGALD3 ; 2.6e-12, 365 +[TOLOOH_OH] TOLOOH + OH -> TOLO2 ; 3.8e-12, 200 +[TOLUENE_OH] TOLUENE + OH -> 0.18*CRESOL + 0.1*TEPOMUC + 0.07*BZOO + 0.65*TOLO2 + 0.28*HO2 ; 1.7e-12, 352 +[usr_PBZNIT_M] PBZNIT + M -> ACBZO2 + NO2 + M +[XYLENES_OH] XYLENES + OH -> 0.15*XYLOL + 0.23*TEPOMUC + 0.06*BZOO + 0.56*XYLENO2 + 0.38*HO2 ; 1.7e-11 +[XYLENO2_HO2] XYLENO2 + HO2 -> XYLENOOH ; 7.5e-13, 700 +[XYLENO2_NO] XYLENO2 + NO -> NO2 + HO2 + 0.34*GLYOXAL + 0.54*CH3COCHO + 0.06*BIGALD1 + 0.2*BIGALD2 + 0.15*BIGALD3 + 0.21*BIGALD4 ; 2.6e-12, 365 +[XYLENOOH_OH] XYLENOOH + OH -> XYLENO2 ; 3.8e-12, 200 +[XYLOLO2_HO2] XYLOLO2 + HO2 -> XYLOLOOH ; 7.5e-13, 700 +[XYLOLO2_NO] XYLOLO2 + NO -> HO2 + NO2 + 0.17*GLYOXAL + 0.51*CH3COCHO ; 2.6e-12, 365 +[XYLOL_OH] XYLOL + OH -> 0.3*XYLOLO2 + 0.63*HO2 + 0.07*PHENO ; 8.4e-11 +[XYLOLOOH_OH] XYLOLOOH + OH -> XYLOLO2 ; 3.8e-12, 200 +********************************* +*** C10 +********************************* +[BCARY_NO3] BCARY + NO3 -> NTERPO2 ; 1.9e-11 +[BCARY_O3] BCARY + O3 -> 0.33*TERPROD1 + 0.3*TERPROD2 + 0.63*OH + 0.57*HO2 + 0.23*CO + 0.27*CO2 + 0.52*CH3COCH3 + 0.34*CH2O + 0.1*BIGALD + 0.05*HCOOH + 0.05*BIGALK + 0.06*CH3CO3 + 0.06*RO2 ; 1.2e-14 +[BCARY_OH] BCARY + OH -> TERPO2 ; 2e-10 +[MTERP_NO3] MTERP + NO3 -> NTERPO2 ; 1.2e-12, 490 +[MTERP_O3] MTERP + O3 -> 0.33*TERPROD1 + 0.3*TERPROD2 + 0.63*OH + 0.57*HO2 + 0.23*CO + 0.27*CO2 + 0.52*CH3COCH3 + 0.34*CH2O + 0.1*BIGALD + 0.05*HCOOH + 0.05*BIGALK + 0.06*CH3CO3 + 0.06*RO2 ; 6.3e-16, -580 +[MTERP_OH] MTERP + OH -> TERPO2 ; 1.2e-11, 440 +[NTERPO2_CH3O2] NTERPO2 + CH3O2 -> 0.5*TERPNIT + 0.75*CH2O + 0.25*CH3OH + 0.5*HO2 + 0.5*TERPROD1 + 0.5*NO2 ; 2e-12, 500 +[NTERPO2_HO2] NTERPO2 + HO2 -> NTERPOOH ; 7.5e-13, 700 +[NTERPO2_NO] NTERPO2 + NO -> 0.2*TERPNIT + 1.6*NO2 + 0.8*TERPROD1 + 0.2*NDEP ; 4.2e-12, 180 +[NTERPO2_NO3] NTERPO2 + NO3 -> 2*NO2 + TERPROD1 ; 2.4e-12 +[NTERPOOH_OH] NTERPOOH + OH -> NTERPO2 ; 2e-11 +[TERP2O2_CH3O2] TERP2O2 + CH3O2 -> TERPROD2 + 0.93*CH2O + 0.25*CH3OH + HO2 + 0.5*CO2 + 0.125*CO + 0.125*GLYALD + 0.15*CH3COCH3 ; 2e-12, 500 +[TERP2O2_HO2] TERP2O2 + HO2 -> TERP2OOH ; 7.5e-13, 700 +[TERP2O2_NO] TERP2O2 + NO -> 0.1*ONITR + 0.9*NO2 + 0.34*CH2O + 0.27*CH3COCH3 + 0.225*CO + 0.9*CO2 + 0.9*TERPROD2 + 0.9*HO2 + 0.225*GLYALD ; 4.2e-12, 180 +[TERP2OOH_OH] TERP2OOH + OH -> TERP2O2 ; 2.3e-11 +[TERPNIT_OH] TERPNIT + OH -> NO2 + TERPROD1 ; 2e-11 +[TERPO2_CH3O2] TERPO2 + CH3O2 -> TERPROD1 + 0.95*CH2O + 0.25*CH3OH + HO2 + 0.025*CH3COCH3 ; 2e-12, 500 +[TERPO2_HO2] TERPO2 + HO2 -> TERPOOH ; 7.5e-13, 700 +[TERPO2_NO] TERPO2 + NO -> 0.2*TERPNIT + 0.8*NO2 + 0.32*CH2O + 0.04*CH3COCH3 + 0.8*TERPROD1 + 0.8*HO2 ; 4.2e-12, 180 +[TERPOOH_OH] TERPOOH + OH -> TERPO2 ; 3.3e-11 +[TERPROD1_NO3] TERPROD1 + NO3 -> 0.5*TERP2O2 + 0.5*NTERPO2 + 0.5*NDEP ; 1e-12 +[TERPROD1_OH] TERPROD1 + OH -> TERP2O2 ; 5.7e-11 +[TERPROD2_OH] TERPROD2 + OH -> 0.15*RO2 + 0.68*CH2O + 1.8*CO2 + 0.5*CH3COCH3 + 0.65*CH3CO3 + 0.2*HO2 + 0.7*CO ; 3.4e-11 +********************************* +*** Sulfur +********************************* +[DMS_NO3] DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520 +[DMS_OHa] DMS + OH -> SO2 ; 9.6e-12, -234 +[OCS_O] OCS + O -> SO + CO ; 2.1e-11, -2200 +[OCS_OH] OCS + OH -> SO2 + CO + H ; 7.2e-14, -1070 +[S_O2] S + O2 -> SO + O ; 2.3e-12 +[S_O3] S + O3 -> SO + O2 ; 1.2e-11 +[SO_BRO] SO + BRO -> SO2 + BR ; 5.7e-11 +[SO_CLO] SO + CLO -> SO2 + CL ; 2.8e-11 +[S_OH] S + OH -> SO + H ; 6.6e-11 +[SO_NO2] SO + NO2 -> SO2 + NO ; 1.4e-11 +[SO_O2] SO + O2 -> SO2 + O ; 1.6e-13, -2280 +[SO_O3] SO + O3 -> SO2 + O2 ; 3.4e-12, -1100 +[SO_OCLO] SO + OCLO -> SO2 + CLO ; 1.9e-12 +[SO_OH] SO + OH -> SO2 + H ; 2.7e-11, 335 +[usr_DMS_OH] DMS + OH -> 0.5*SO2 + 0.5*HO2 +[usr_SO2_OH] SO2 + OH -> SO3 + HO2 +[usr_SO3_H2O] SO3 + H2O -> H2SO4 +********************************* +*** Tropospheric Aerosol +********************************* +[NH3_OH] NH3 + OH -> H2O + 1*NHDEP ; 1.7e-12, -710 +[usr_GLYOXAL_aer] GLYOXAL -> SOAG0 +[usr_HO2_aer] HO2 -> H2O +[usr_HONITR_aer] HONITR -> HNO3 +[usr_ISOPNITA_aer] ISOPNITA -> HNO3 +[usr_ISOPNITB_aer] ISOPNITB -> HNO3 +[usr_N2O5_aer] N2O5 -> 2*HNO3 +[usr_NC4CH2OH_aer] NC4CH2OH -> HNO3 +[usr_NC4CHO_aer] NC4CHO -> HNO3 +[usr_NH4_strat_tau] NH4 -> 1*NHDEP ; 6.34e-08 +[usr_NO2_aer] NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3 +[usr_NO3_aer] NO3 -> HNO3 +[usr_NTERPOOH_aer] NTERPOOH -> HNO3 +[usr_ONITR_aer] ONITR -> HNO3 +[usr_TERPNIT_aer] TERPNIT -> HNO3 +********************************* +*** SOA +********************************* +[BCARY_NO3_vbs] BCARY + NO3 -> BCARY + NO3 + 0.17493*SOAG3 + 0.59019*SOAG4 ; 1.9e-11 +[BCARYO2_HO2_vbs] BCARYO2VBS + HO2 -> HO2 + 0.2202*SOAG0 + 0.2067*SOAG1 + 0.0653*SOAG2 + 0.1284*SOAG3 + 0.114*SOAG4 ; 2.75e-13, 1300 +[BCARYO2_NO_vbs] BCARYO2VBS + NO -> NO + 0.1279*SOAG0 + 0.1792*SOAG1 + 0.0676*SOAG2 + 0.079*SOAG3 + 0.1254*SOAG4 ; 2.7e-12, 360 +[BCARY_O3_vbs] BCARY + O3 -> BCARY + O3 + 0.2202*SOAG0 + 0.2067*SOAG1 + 0.0653*SOAG2 + 0.1284*SOAG3 + 0.114*SOAG4 ; 1.2e-14 +[BCARY_OH_vbs] BCARY + OH -> BCARY + OH + BCARYO2VBS ; 2e-10 +[BENZENE_OH_vbs] BENZENE + OH -> BENZENE + OH + BENZO2VBS ; 2.3e-12, -193 +[BENZO2_HO2_vbs] BENZO2VBS + HO2 -> HO2 + 0.0023*SOAG0 + 0.0008*SOAG1 + 0.0843*SOAG2 + 0.0443*SOAG3 + 0.1621*SOAG4 ; 7.5e-13, 700 +[BENZO2_NO_vbs] BENZO2VBS + NO -> NO + 0.0097*SOAG0 + 0.0034*SOAG1 + 0.1579*SOAG2 + 0.0059*SOAG3 + 0.0536*SOAG4 ; 2.6e-12, 365 +[ISOP_NO3_vbs] ISOP + NO3 -> ISOP + NO3 + 0.059024*SOAG3 + 0.025024*SOAG4 ; 3.03e-12, -446 +[ISOPO2_HO2_vbs] ISOPO2VBS + HO2 -> HO2 + 0.0031*SOAG0 + 0.0035*SOAG1 + 0.0003*SOAG2 + 0.0271*SOAG3 + 0.0474*SOAG4 ; 2.12e-13, 1300 +[ISOPO2_NO_vbs] ISOPO2VBS + NO -> NO + 0.0003*SOAG0 + 0.0003*SOAG1 + 0.0073*SOAG2 + 0.0057*SOAG3 + 0.0623*SOAG4 ; 2.7e-12, 350 +[ISOP_O3_vbs] ISOP + O3 -> ISOP + O3 + 0.0033*SOAG3 ; 1.05e-14, -2000 +[ISOP_OH_vbs] ISOP + OH -> ISOP + OH + ISOPO2VBS ; 2.54e-11, 410 +[IVOCO2_HO2_vbs] IVOCO2VBS + HO2 -> HO2 + 0.2381*SOAG0 + 0.1308*SOAG1 + 0.0348*SOAG2 + 0.0076*SOAG3 + 0.0113*SOAG4 ; 7.5e-13, 700 +[IVOCO2_NO_vbs] IVOCO2VBS + NO -> NO + 0.1056*SOAG0 + 0.1026*SOAG1 + 0.0521*SOAG2 + 0.0143*SOAG3 + 0.0166*SOAG4 ; 2.6e-12, 365 +[IVOC_OH_vbs] IVOC + OH -> OH + IVOCO2VBS ; 1.34e-11 +[MTERP_NO3_vbs] MTERP + NO3 -> MTERP + NO3 + 0.17493*SOAG3 + 0.59019*SOAG4 ; 1.2e-12, 490 +[MTERPO2_HO2_vbs] MTERPO2VBS + HO2 -> HO2 + 0.0508*SOAG0 + 0.1149*SOAG1 + 0.0348*SOAG2 + 0.0554*SOAG3 + 0.1278*SOAG4 ; 2.6e-13, 1300 +[MTERPO2_NO_vbs] MTERPO2VBS + NO -> NO + 0.0245*SOAG0 + 0.0082*SOAG1 + 0.0772*SOAG2 + 0.0332*SOAG3 + 0.13*SOAG4 ; 2.7e-12, 360 +[MTERP_O3_vbs] MTERP + O3 -> MTERP + O3 + 0.0508*SOAG0 + 0.1149*SOAG1 + 0.0348*SOAG2 + 0.0554*SOAG3 + 0.1278*SOAG4 ; 6.3e-16, -580 +[MTERP_OH_vbs] MTERP + OH -> MTERP + OH + MTERPO2VBS ; 1.2e-11, 440 +[SVOC_OH] SVOC + OH -> OH + 0.5931*SOAG0 + 0.1534*SOAG1 + 0.0459*SOAG2 + 0.0085*SOAG3 + 0.0128*SOAG4 ; 1.34e-11 +[TOLUENE_OH_vbs] TOLUENE + OH -> TOLUENE + OH + TOLUO2VBS ; 1.7e-12, 352 +[TOLUO2_HO2_vbs] TOLUO2VBS + HO2 -> HO2 + 0.1364*SOAG0 + 0.0101*SOAG1 + 0.0763*SOAG2 + 0.2157*SOAG3 + 0.0738*SOAG4 ; 7.5e-13, 700 +[TOLUO2_NO_vbs] TOLUO2VBS + NO -> NO + 0.0154*SOAG0 + 0.0452*SOAG1 + 0.0966*SOAG2 + 0.0073*SOAG3 + 0.238*SOAG4 ; 2.6e-12, 365 +[XYLENES_OH_vbs] XYLENES + OH -> XYLENES + OH + XYLEO2VBS ; 1.7e-11 +[XYLEO2_HO2_vbs] XYLEO2VBS + HO2 -> HO2 + 0.1677*SOAG0 + 0.0174*SOAG1 + 0.086*SOAG2 + 0.0512*SOAG3 + 0.1598*SOAG4 ; 7.5e-13, 700 +[XYLEO2_NO_vbs] XYLEO2VBS + NO -> NO + 0.0063*SOAG0 + 0.0237*SOAG1 + 0.0025*SOAG2 + 0.011*SOAG3 + 0.1185*SOAG4 ; 2.6e-12, 365 +********************************* +*** Stratospheric Aerosol +********************************* +[het1] N2O5 -> 2*HNO3 +[het10] HOCL + HCL -> CL2 + H2O +[het11] BRONO2 -> HOBR + HNO3 +[het12] N2O5 -> 2*HNO3 +[het13] CLONO2 -> HOCL + HNO3 +[het14] BRONO2 -> HOBR + HNO3 +[het15] CLONO2 + HCL -> CL2 + HNO3 +[het16] HOCL + HCL -> CL2 + H2O +[het17] HOBR + HCL -> BRCL + H2O +[het2] CLONO2 -> HOCL + HNO3 +[het3] BRONO2 -> HOBR + HNO3 +[het4] CLONO2 + HCL -> CL2 + HNO3 +[het5] HOCL + HCL -> CL2 + H2O +[het6] HOBR + HCL -> BRCL + H2O +[het7] N2O5 -> 2*HNO3 +[het8] CLONO2 -> HOCL + HNO3 +[het9] CLONO2 + HCL -> CL2 + HNO3 +********************************* +*** Tracers +********************************* +[E90_tau] E90 -> sink ; 1.29e-07 +[NH_50_tau] NH_50 -> ; 2.31e-07 +[NH_5_tau] NH_5 -> ; 2.31e-06 +[ST80_25_tau] ST80_25 -> ; 4.63e-07 + End Reactions + + Ext Forcing + CO <- dataset + NO <- dataset + NO2 <- dataset + SO2 <- dataset + AOA_NH + N + End Ext Forcing + + End Chemistry + + SIMULATION PARAMETERS + + Version Options + machine = nec + model = cam + model_architecture = VECTOR + vector_length = 32 + architecture = hybrid + namemod = on + End Version Options + + + End Simulation Parameters diff --git a/src/chemistry/pp_trop_strat_noaero/chem_mods.F90 b/src/chemistry/pp_trop_strat_noaero/chem_mods.F90 new file mode 100644 index 0000000000..9809a188bd --- /dev/null +++ b/src/chemistry/pp_trop_strat_noaero/chem_mods.F90 @@ -0,0 +1,51 @@ + module chem_mods +!-------------------------------------------------------------- +! ... Basic chemistry parameters and arrays +!-------------------------------------------------------------- + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + save + integer, parameter :: phtcnt = 113, & ! number of photolysis reactions + rxntot = 532, & ! number of total reactions + gascnt = 419, & ! number of gas phase reactions + nabscol = 2, & ! number of absorbing column densities + gas_pcnst = 202, & ! number of "gas phase" species + nfs = 3, & ! number of "fixed" species + relcnt = 0, & ! number of relationship species + grpcnt = 0, & ! number of group members + nzcnt = 2050, & ! number of non-zero matrix entries + extcnt = 6, & ! number of species with external forcing + clscnt1 = 31, & ! number of species in explicit class + clscnt2 = 0, & ! number of species in hov class + clscnt3 = 0, & ! number of species in ebi class + clscnt4 = 171, & ! number of species in implicit class + clscnt5 = 0, & ! number of species in rodas class + indexm = 1, & ! index of total atm density in invariant array + indexh2o = 0, & ! index of water vapor density + clsze = 1, & ! loop length for implicit chemistry + rxt_tag_cnt = 532, & + enthalpy_cnt = 18, & + nslvd = 41 + integer :: clscnt(5) = 0 + integer :: cls_rxt_cnt(4,5) = 0 + integer :: clsmap(gas_pcnst,5) = 0 + integer :: permute(gas_pcnst,5) = 0 + integer :: diag_map(clscnt4) = 0 + real(r8) :: adv_mass(gas_pcnst) = 0._r8 + real(r8) :: crb_mass(gas_pcnst) = 0._r8 + real(r8) :: fix_mass(max(1,nfs)) + real(r8), allocatable :: cph_enthalpy(:) + integer, allocatable :: cph_rid(:) + integer, allocatable :: num_rnts(:) + integer, allocatable :: rxt_tag_map(:) + real(r8), allocatable :: pht_alias_mult(:,:) + character(len=32), allocatable :: rxt_tag_lst(:) + character(len=16), allocatable :: pht_alias_lst(:,:) + character(len=16) :: inv_lst(max(1,nfs)) + character(len=16) :: extfrc_lst(max(1,extcnt)) + logical :: frc_from_dataset(max(1,extcnt)) + logical :: is_vector + logical :: is_scalar + character(len=16) :: slvd_lst(max(1,nslvd)) + integer, parameter :: veclen = 32 + end module chem_mods diff --git a/src/chemistry/pp_trop_strat_noaero/m_rxt_id.F90 b/src/chemistry/pp_trop_strat_noaero/m_rxt_id.F90 new file mode 100644 index 0000000000..fa73bae0e4 --- /dev/null +++ b/src/chemistry/pp_trop_strat_noaero/m_rxt_id.F90 @@ -0,0 +1,535 @@ + module m_rxt_id + implicit none + integer, parameter :: rid_jh2o_b = 1 + integer, parameter :: rid_jh2o_a = 2 + integer, parameter :: rid_jh2o_c = 3 + integer, parameter :: rid_jh2o2 = 4 + integer, parameter :: rid_jo2_a = 5 + integer, parameter :: rid_jo2_b = 6 + integer, parameter :: rid_jo3_a = 7 + integer, parameter :: rid_jo3_b = 8 + integer, parameter :: rid_jhno3 = 9 + integer, parameter :: rid_jho2no2_a = 10 + integer, parameter :: rid_jho2no2_b = 11 + integer, parameter :: rid_jn2o = 12 + integer, parameter :: rid_jn2o5_a = 13 + integer, parameter :: rid_jn2o5_b = 14 + integer, parameter :: rid_jno = 15 + integer, parameter :: rid_jno2 = 16 + integer, parameter :: rid_jno3_b = 17 + integer, parameter :: rid_jno3_a = 18 + integer, parameter :: rid_jalknit = 19 + integer, parameter :: rid_jalkooh = 20 + integer, parameter :: rid_jbenzooh = 21 + integer, parameter :: rid_jbepomuc = 22 + integer, parameter :: rid_jbigald = 23 + integer, parameter :: rid_jbigald1 = 24 + integer, parameter :: rid_jbigald2 = 25 + integer, parameter :: rid_jbigald3 = 26 + integer, parameter :: rid_jbigald4 = 27 + integer, parameter :: rid_jbzooh = 28 + integer, parameter :: rid_jc2h5ooh = 29 + integer, parameter :: rid_jc3h7ooh = 30 + integer, parameter :: rid_jc6h5ooh = 31 + integer, parameter :: rid_jch2o_a = 32 + integer, parameter :: rid_jch2o_b = 33 + integer, parameter :: rid_jch3cho = 34 + integer, parameter :: rid_jacet = 35 + integer, parameter :: rid_jmgly = 36 + integer, parameter :: rid_jch3co3h = 37 + integer, parameter :: rid_jch3ooh = 38 + integer, parameter :: rid_jch4_a = 39 + integer, parameter :: rid_jch4_b = 40 + integer, parameter :: rid_jco2 = 41 + integer, parameter :: rid_jeooh = 42 + integer, parameter :: rid_jglyald = 43 + integer, parameter :: rid_jglyoxal = 44 + integer, parameter :: rid_jhonitr = 45 + integer, parameter :: rid_jhpald = 46 + integer, parameter :: rid_jhyac = 47 + integer, parameter :: rid_jisopnooh = 48 + integer, parameter :: rid_jisopooh = 49 + integer, parameter :: rid_jmacr_a = 50 + integer, parameter :: rid_jmacr_b = 51 + integer, parameter :: rid_jmek = 52 + integer, parameter :: rid_jmekooh = 53 + integer, parameter :: rid_jmpan = 54 + integer, parameter :: rid_jmvk = 55 + integer, parameter :: rid_jnc4cho = 56 + integer, parameter :: rid_jnoa = 57 + integer, parameter :: rid_jnterpooh = 58 + integer, parameter :: rid_jonitr = 59 + integer, parameter :: rid_jpan = 60 + integer, parameter :: rid_jphenooh = 61 + integer, parameter :: rid_jpooh = 62 + integer, parameter :: rid_jrooh = 63 + integer, parameter :: rid_jtepomuc = 64 + integer, parameter :: rid_jterp2ooh = 65 + integer, parameter :: rid_jterpnit = 66 + integer, parameter :: rid_jterpooh = 67 + integer, parameter :: rid_jterprd1 = 68 + integer, parameter :: rid_jterprd2 = 69 + integer, parameter :: rid_jtolooh = 70 + integer, parameter :: rid_jxooh = 71 + integer, parameter :: rid_jxylenooh = 72 + integer, parameter :: rid_jxylolooh = 73 + integer, parameter :: rid_jbrcl = 74 + integer, parameter :: rid_jbro = 75 + integer, parameter :: rid_jbrono2_b = 76 + integer, parameter :: rid_jbrono2_a = 77 + integer, parameter :: rid_jccl4 = 78 + integer, parameter :: rid_jcf2clbr = 79 + integer, parameter :: rid_jcf3br = 80 + integer, parameter :: rid_jcfcl3 = 81 + integer, parameter :: rid_jcfc113 = 82 + integer, parameter :: rid_jcfc114 = 83 + integer, parameter :: rid_jcfc115 = 84 + integer, parameter :: rid_jcf2cl2 = 85 + integer, parameter :: rid_jch2br2 = 86 + integer, parameter :: rid_jch3br = 87 + integer, parameter :: rid_jch3ccl3 = 88 + integer, parameter :: rid_jch3cl = 89 + integer, parameter :: rid_jchbr3 = 90 + integer, parameter :: rid_jcl2 = 91 + integer, parameter :: rid_jcl2o2 = 92 + integer, parameter :: rid_jclo = 93 + integer, parameter :: rid_jclono2_a = 94 + integer, parameter :: rid_jclono2_b = 95 + integer, parameter :: rid_jcof2 = 96 + integer, parameter :: rid_jcofcl = 97 + integer, parameter :: rid_jh2402 = 98 + integer, parameter :: rid_jhbr = 99 + integer, parameter :: rid_jhcfc141b = 100 + integer, parameter :: rid_jhcfc142b = 101 + integer, parameter :: rid_jhcfc22 = 102 + integer, parameter :: rid_jhcl = 103 + integer, parameter :: rid_jhf = 104 + integer, parameter :: rid_jhobr = 105 + integer, parameter :: rid_jhocl = 106 + integer, parameter :: rid_joclo = 107 + integer, parameter :: rid_jsf6 = 108 + integer, parameter :: rid_jh2so4 = 109 + integer, parameter :: rid_jocs = 110 + integer, parameter :: rid_jso = 111 + integer, parameter :: rid_jso2 = 112 + integer, parameter :: rid_jso3 = 113 + integer, parameter :: rid_O1D_H2 = 114 + integer, parameter :: rid_O1D_H2O = 115 + integer, parameter :: rid_O1D_N2 = 116 + integer, parameter :: rid_O1D_O2ab = 117 + integer, parameter :: rid_O1D_O3 = 118 + integer, parameter :: rid_O_O3 = 119 + integer, parameter :: rid_usr_O_O = 120 + integer, parameter :: rid_usr_O_O2 = 121 + integer, parameter :: rid_H2_O = 122 + integer, parameter :: rid_H2O2_O = 123 + integer, parameter :: rid_H_HO2 = 124 + integer, parameter :: rid_H_HO2a = 125 + integer, parameter :: rid_H_HO2b = 126 + integer, parameter :: rid_H_O2 = 127 + integer, parameter :: rid_HO2_O = 128 + integer, parameter :: rid_HO2_O3 = 129 + integer, parameter :: rid_H_O3 = 130 + integer, parameter :: rid_OH_H2 = 131 + integer, parameter :: rid_OH_H2O2 = 132 + integer, parameter :: rid_OH_HO2 = 133 + integer, parameter :: rid_OH_O = 134 + integer, parameter :: rid_OH_O3 = 135 + integer, parameter :: rid_OH_OH = 136 + integer, parameter :: rid_OH_OH_M = 137 + integer, parameter :: rid_usr_HO2_HO2 = 138 + integer, parameter :: rid_HO2NO2_OH = 139 + integer, parameter :: rid_N_NO = 140 + integer, parameter :: rid_N_NO2a = 141 + integer, parameter :: rid_N_NO2b = 142 + integer, parameter :: rid_N_NO2c = 143 + integer, parameter :: rid_N_O2 = 144 + integer, parameter :: rid_NO2_O = 145 + integer, parameter :: rid_NO2_O3 = 146 + integer, parameter :: rid_NO2_O_M = 147 + integer, parameter :: rid_NO3_HO2 = 148 + integer, parameter :: rid_NO3_NO = 149 + integer, parameter :: rid_NO3_O = 150 + integer, parameter :: rid_NO3_OH = 151 + integer, parameter :: rid_N_OH = 152 + integer, parameter :: rid_NO_HO2 = 153 + integer, parameter :: rid_NO_O3 = 154 + integer, parameter :: rid_NO_O_M = 155 + integer, parameter :: rid_O1D_N2Oa = 156 + integer, parameter :: rid_O1D_N2Ob = 157 + integer, parameter :: rid_tag_NO2_HO2 = 158 + integer, parameter :: rid_tag_NO2_NO3 = 159 + integer, parameter :: rid_tag_NO2_OH = 160 + integer, parameter :: rid_usr_HNO3_OH = 161 + integer, parameter :: rid_usr_HO2NO2_M = 162 + integer, parameter :: rid_usr_N2O5_M = 163 + integer, parameter :: rid_CL_CH2O = 164 + integer, parameter :: rid_CL_CH4 = 165 + integer, parameter :: rid_CL_H2 = 166 + integer, parameter :: rid_CL_H2O2 = 167 + integer, parameter :: rid_CL_HO2a = 168 + integer, parameter :: rid_CL_HO2b = 169 + integer, parameter :: rid_CL_O3 = 170 + integer, parameter :: rid_CLO_CH3O2 = 171 + integer, parameter :: rid_CLO_CLOa = 172 + integer, parameter :: rid_CLO_CLOb = 173 + integer, parameter :: rid_CLO_CLOc = 174 + integer, parameter :: rid_CLO_HO2 = 175 + integer, parameter :: rid_CLO_NO = 176 + integer, parameter :: rid_CLONO2_CL = 177 + integer, parameter :: rid_CLO_NO2_M = 178 + integer, parameter :: rid_CLONO2_O = 179 + integer, parameter :: rid_CLONO2_OH = 180 + integer, parameter :: rid_CLO_O = 181 + integer, parameter :: rid_CLO_OHa = 182 + integer, parameter :: rid_CLO_OHb = 183 + integer, parameter :: rid_HCL_O = 184 + integer, parameter :: rid_HCL_OH = 185 + integer, parameter :: rid_HOCL_CL = 186 + integer, parameter :: rid_HOCL_O = 187 + integer, parameter :: rid_HOCL_OH = 188 + integer, parameter :: rid_O1D_CCL4 = 189 + integer, parameter :: rid_O1D_CF2CLBR = 190 + integer, parameter :: rid_O1D_CFC11 = 191 + integer, parameter :: rid_O1D_CFC113 = 192 + integer, parameter :: rid_O1D_CFC114 = 193 + integer, parameter :: rid_O1D_CFC115 = 194 + integer, parameter :: rid_O1D_CFC12 = 195 + integer, parameter :: rid_O1D_HCLa = 196 + integer, parameter :: rid_O1D_HCLb = 197 + integer, parameter :: rid_tag_CLO_CLO_M = 198 + integer, parameter :: rid_usr_CL2O2_M = 199 + integer, parameter :: rid_BR_CH2O = 200 + integer, parameter :: rid_BR_HO2 = 201 + integer, parameter :: rid_BR_O3 = 202 + integer, parameter :: rid_BRO_BRO = 203 + integer, parameter :: rid_BRO_CLOa = 204 + integer, parameter :: rid_BRO_CLOb = 205 + integer, parameter :: rid_BRO_CLOc = 206 + integer, parameter :: rid_BRO_HO2 = 207 + integer, parameter :: rid_BRO_NO = 208 + integer, parameter :: rid_BRO_NO2_M = 209 + integer, parameter :: rid_BRONO2_O = 210 + integer, parameter :: rid_BRO_O = 211 + integer, parameter :: rid_BRO_OH = 212 + integer, parameter :: rid_HBR_O = 213 + integer, parameter :: rid_HBR_OH = 214 + integer, parameter :: rid_HOBR_O = 215 + integer, parameter :: rid_O1D_CF3BR = 216 + integer, parameter :: rid_O1D_CHBR3 = 217 + integer, parameter :: rid_O1D_H2402 = 218 + integer, parameter :: rid_O1D_HBRa = 219 + integer, parameter :: rid_O1D_HBRb = 220 + integer, parameter :: rid_F_CH4 = 221 + integer, parameter :: rid_F_H2 = 222 + integer, parameter :: rid_F_H2O = 223 + integer, parameter :: rid_F_HNO3 = 224 + integer, parameter :: rid_O1D_COF2 = 225 + integer, parameter :: rid_O1D_COFCL = 226 + integer, parameter :: rid_CH2BR2_CL = 227 + integer, parameter :: rid_CH2BR2_OH = 228 + integer, parameter :: rid_CH3BR_CL = 229 + integer, parameter :: rid_CH3BR_OH = 230 + integer, parameter :: rid_CH3CCL3_OH = 231 + integer, parameter :: rid_CH3CL_CL = 232 + integer, parameter :: rid_CH3CL_OH = 233 + integer, parameter :: rid_CHBR3_CL = 234 + integer, parameter :: rid_CHBR3_OH = 235 + integer, parameter :: rid_HCFC141B_OH = 236 + integer, parameter :: rid_HCFC142B_OH = 237 + integer, parameter :: rid_HCFC22_OH = 238 + integer, parameter :: rid_O1D_CH2BR2 = 239 + integer, parameter :: rid_O1D_CH3BR = 240 + integer, parameter :: rid_O1D_HCFC141B = 241 + integer, parameter :: rid_O1D_HCFC142B = 242 + integer, parameter :: rid_O1D_HCFC22 = 243 + integer, parameter :: rid_CH2O_HO2 = 244 + integer, parameter :: rid_CH2O_NO3 = 245 + integer, parameter :: rid_CH2O_O = 246 + integer, parameter :: rid_CH2O_OH = 247 + integer, parameter :: rid_CH3O2_CH3O2a = 248 + integer, parameter :: rid_CH3O2_CH3O2b = 249 + integer, parameter :: rid_CH3O2_HO2 = 250 + integer, parameter :: rid_CH3O2_NO = 251 + integer, parameter :: rid_CH3OH_OH = 252 + integer, parameter :: rid_CH3OOH_OH = 253 + integer, parameter :: rid_CH4_OH = 254 + integer, parameter :: rid_CO_OH_M = 255 + integer, parameter :: rid_HCN_OH = 256 + integer, parameter :: rid_HCOOH_OH = 257 + integer, parameter :: rid_HOCH2OO_HO2 = 258 + integer, parameter :: rid_HOCH2OO_M = 259 + integer, parameter :: rid_HOCH2OO_NO = 260 + integer, parameter :: rid_O1D_CH4a = 261 + integer, parameter :: rid_O1D_CH4b = 262 + integer, parameter :: rid_O1D_CH4c = 263 + integer, parameter :: rid_O1D_HCN = 264 + integer, parameter :: rid_usr_CO_OH_b = 265 + integer, parameter :: rid_C2H2_CL_M = 266 + integer, parameter :: rid_C2H2_OH_M = 267 + integer, parameter :: rid_C2H4_CL_M = 268 + integer, parameter :: rid_C2H4_O3 = 269 + integer, parameter :: rid_C2H5O2_C2H5O2 = 270 + integer, parameter :: rid_C2H5O2_CH3O2 = 271 + integer, parameter :: rid_C2H5O2_HO2 = 272 + integer, parameter :: rid_C2H5O2_NO = 273 + integer, parameter :: rid_C2H5OH_OH = 274 + integer, parameter :: rid_C2H5OOH_OH = 275 + integer, parameter :: rid_C2H6_CL = 276 + integer, parameter :: rid_C2H6_OH = 277 + integer, parameter :: rid_CH3CHO_NO3 = 278 + integer, parameter :: rid_CH3CHO_OH = 279 + integer, parameter :: rid_CH3CN_OH = 280 + integer, parameter :: rid_CH3CO3_CH3CO3 = 281 + integer, parameter :: rid_CH3CO3_CH3O2 = 282 + integer, parameter :: rid_CH3CO3_HO2 = 283 + integer, parameter :: rid_CH3CO3_NO = 284 + integer, parameter :: rid_CH3COOH_OH = 285 + integer, parameter :: rid_CH3COOOH_OH = 286 + integer, parameter :: rid_EO2_HO2 = 287 + integer, parameter :: rid_EO2_NO = 288 + integer, parameter :: rid_EO_M = 289 + integer, parameter :: rid_EO_O2 = 290 + integer, parameter :: rid_GLYALD_OH = 291 + integer, parameter :: rid_GLYOXAL_OH = 292 + integer, parameter :: rid_PAN_OH = 293 + integer, parameter :: rid_tag_C2H4_OH = 294 + integer, parameter :: rid_tag_CH3CO3_NO2 = 295 + integer, parameter :: rid_usr_PAN_M = 296 + integer, parameter :: rid_C3H6_NO3 = 297 + integer, parameter :: rid_C3H6_O3 = 298 + integer, parameter :: rid_C3H7O2_CH3O2 = 299 + integer, parameter :: rid_C3H7O2_HO2 = 300 + integer, parameter :: rid_C3H7O2_NO = 301 + integer, parameter :: rid_C3H7OOH_OH = 302 + integer, parameter :: rid_C3H8_OH = 303 + integer, parameter :: rid_CH3COCHO_NO3 = 304 + integer, parameter :: rid_CH3COCHO_OH = 305 + integer, parameter :: rid_HYAC_OH = 306 + integer, parameter :: rid_NOA_OH = 307 + integer, parameter :: rid_PO2_HO2 = 308 + integer, parameter :: rid_PO2_NO = 309 + integer, parameter :: rid_POOH_OH = 310 + integer, parameter :: rid_RO2_CH3O2 = 311 + integer, parameter :: rid_RO2_HO2 = 312 + integer, parameter :: rid_RO2_NO = 313 + integer, parameter :: rid_ROOH_OH = 314 + integer, parameter :: rid_tag_C3H6_OH = 315 + integer, parameter :: rid_usr_CH3COCH3_OH = 316 + integer, parameter :: rid_BIGENE_NO3 = 317 + integer, parameter :: rid_BIGENE_OH = 318 + integer, parameter :: rid_ENEO2_NO = 319 + integer, parameter :: rid_ENEO2_NOb = 320 + integer, parameter :: rid_HONITR_OH = 321 + integer, parameter :: rid_MACRO2_CH3CO3 = 322 + integer, parameter :: rid_MACRO2_CH3O2 = 323 + integer, parameter :: rid_MACRO2_HO2 = 324 + integer, parameter :: rid_MACRO2_NO3 = 325 + integer, parameter :: rid_MACRO2_NOa = 326 + integer, parameter :: rid_MACRO2_NOb = 327 + integer, parameter :: rid_MACR_O3 = 328 + integer, parameter :: rid_MACR_OH = 329 + integer, parameter :: rid_MACROOH_OH = 330 + integer, parameter :: rid_MCO3_CH3CO3 = 331 + integer, parameter :: rid_MCO3_CH3O2 = 332 + integer, parameter :: rid_MCO3_HO2 = 333 + integer, parameter :: rid_MCO3_MCO3 = 334 + integer, parameter :: rid_MCO3_NO = 335 + integer, parameter :: rid_MCO3_NO3 = 336 + integer, parameter :: rid_MEKO2_HO2 = 337 + integer, parameter :: rid_MEKO2_NO = 338 + integer, parameter :: rid_MEK_OH = 339 + integer, parameter :: rid_MEKOOH_OH = 340 + integer, parameter :: rid_MPAN_OH_M = 341 + integer, parameter :: rid_MVK_O3 = 342 + integer, parameter :: rid_MVK_OH = 343 + integer, parameter :: rid_usr_MCO3_NO2 = 344 + integer, parameter :: rid_usr_MPAN_M = 345 + integer, parameter :: rid_ALKNIT_OH = 346 + integer, parameter :: rid_ALKO2_HO2 = 347 + integer, parameter :: rid_ALKO2_NO = 348 + integer, parameter :: rid_ALKO2_NOb = 349 + integer, parameter :: rid_ALKOOH_OH = 350 + integer, parameter :: rid_BIGALK_OH = 351 + integer, parameter :: rid_HPALD_OH = 352 + integer, parameter :: rid_HYDRALD_OH = 353 + integer, parameter :: rid_IEPOX_OH = 354 + integer, parameter :: rid_ISOPAO2_CH3CO3 = 355 + integer, parameter :: rid_ISOPAO2_CH3O2 = 356 + integer, parameter :: rid_ISOPAO2_HO2 = 357 + integer, parameter :: rid_ISOPAO2_NO = 358 + integer, parameter :: rid_ISOPAO2_NO3 = 359 + integer, parameter :: rid_ISOPBO2_CH3CO3 = 360 + integer, parameter :: rid_ISOPBO2_CH3O2 = 361 + integer, parameter :: rid_ISOPBO2_HO2 = 362 + integer, parameter :: rid_ISOPBO2_M = 363 + integer, parameter :: rid_ISOPBO2_NO = 364 + integer, parameter :: rid_ISOPBO2_NO3 = 365 + integer, parameter :: rid_ISOPNITA_OH = 366 + integer, parameter :: rid_ISOPNITB_OH = 367 + integer, parameter :: rid_ISOP_NO3 = 368 + integer, parameter :: rid_ISOPNO3_CH3CO3 = 369 + integer, parameter :: rid_ISOPNO3_CH3O2 = 370 + integer, parameter :: rid_ISOPNO3_HO2 = 371 + integer, parameter :: rid_ISOPNO3_NO = 372 + integer, parameter :: rid_ISOPNO3_NO3 = 373 + integer, parameter :: rid_ISOPNOOH_OH = 374 + integer, parameter :: rid_ISOP_O3 = 375 + integer, parameter :: rid_ISOP_OH = 376 + integer, parameter :: rid_ISOPOOH_OH = 377 + integer, parameter :: rid_NC4CH2OH_OH = 378 + integer, parameter :: rid_NC4CHO_OH = 379 + integer, parameter :: rid_XO2_CH3CO3 = 380 + integer, parameter :: rid_XO2_CH3O2 = 381 + integer, parameter :: rid_XO2_HO2 = 382 + integer, parameter :: rid_XO2_NO = 383 + integer, parameter :: rid_XO2_NO3 = 384 + integer, parameter :: rid_XOOH_OH = 385 + integer, parameter :: rid_ACBZO2_HO2 = 386 + integer, parameter :: rid_ACBZO2_NO = 387 + integer, parameter :: rid_BENZENE_OH = 388 + integer, parameter :: rid_BENZO2_HO2 = 389 + integer, parameter :: rid_BENZO2_NO = 390 + integer, parameter :: rid_BENZOOH_OH = 391 + integer, parameter :: rid_BZALD_OH = 392 + integer, parameter :: rid_BZOO_HO2 = 393 + integer, parameter :: rid_BZOOH_OH = 394 + integer, parameter :: rid_BZOO_NO = 395 + integer, parameter :: rid_C6H5O2_HO2 = 396 + integer, parameter :: rid_C6H5O2_NO = 397 + integer, parameter :: rid_C6H5OOH_OH = 398 + integer, parameter :: rid_CRESOL_OH = 399 + integer, parameter :: rid_DICARBO2_HO2 = 400 + integer, parameter :: rid_DICARBO2_NO = 401 + integer, parameter :: rid_DICARBO2_NO2 = 402 + integer, parameter :: rid_MALO2_HO2 = 403 + integer, parameter :: rid_MALO2_NO = 404 + integer, parameter :: rid_MALO2_NO2 = 405 + integer, parameter :: rid_MDIALO2_HO2 = 406 + integer, parameter :: rid_MDIALO2_NO = 407 + integer, parameter :: rid_MDIALO2_NO2 = 408 + integer, parameter :: rid_PHENO2_HO2 = 409 + integer, parameter :: rid_PHENO2_NO = 410 + integer, parameter :: rid_PHENOL_OH = 411 + integer, parameter :: rid_PHENO_NO2 = 412 + integer, parameter :: rid_PHENO_O3 = 413 + integer, parameter :: rid_PHENOOH_OH = 414 + integer, parameter :: rid_tag_ACBZO2_NO2 = 415 + integer, parameter :: rid_TOLO2_HO2 = 416 + integer, parameter :: rid_TOLO2_NO = 417 + integer, parameter :: rid_TOLOOH_OH = 418 + integer, parameter :: rid_TOLUENE_OH = 419 + integer, parameter :: rid_usr_PBZNIT_M = 420 + integer, parameter :: rid_XYLENES_OH = 421 + integer, parameter :: rid_XYLENO2_HO2 = 422 + integer, parameter :: rid_XYLENO2_NO = 423 + integer, parameter :: rid_XYLENOOH_OH = 424 + integer, parameter :: rid_XYLOLO2_HO2 = 425 + integer, parameter :: rid_XYLOLO2_NO = 426 + integer, parameter :: rid_XYLOL_OH = 427 + integer, parameter :: rid_XYLOLOOH_OH = 428 + integer, parameter :: rid_BCARY_NO3 = 429 + integer, parameter :: rid_BCARY_O3 = 430 + integer, parameter :: rid_BCARY_OH = 431 + integer, parameter :: rid_MTERP_NO3 = 432 + integer, parameter :: rid_MTERP_O3 = 433 + integer, parameter :: rid_MTERP_OH = 434 + integer, parameter :: rid_NTERPO2_CH3O2 = 435 + integer, parameter :: rid_NTERPO2_HO2 = 436 + integer, parameter :: rid_NTERPO2_NO = 437 + integer, parameter :: rid_NTERPO2_NO3 = 438 + integer, parameter :: rid_NTERPOOH_OH = 439 + integer, parameter :: rid_TERP2O2_CH3O2 = 440 + integer, parameter :: rid_TERP2O2_HO2 = 441 + integer, parameter :: rid_TERP2O2_NO = 442 + integer, parameter :: rid_TERP2OOH_OH = 443 + integer, parameter :: rid_TERPNIT_OH = 444 + integer, parameter :: rid_TERPO2_CH3O2 = 445 + integer, parameter :: rid_TERPO2_HO2 = 446 + integer, parameter :: rid_TERPO2_NO = 447 + integer, parameter :: rid_TERPOOH_OH = 448 + integer, parameter :: rid_TERPROD1_NO3 = 449 + integer, parameter :: rid_TERPROD1_OH = 450 + integer, parameter :: rid_TERPROD2_OH = 451 + integer, parameter :: rid_DMS_NO3 = 452 + integer, parameter :: rid_DMS_OHa = 453 + integer, parameter :: rid_OCS_O = 454 + integer, parameter :: rid_OCS_OH = 455 + integer, parameter :: rid_S_O2 = 456 + integer, parameter :: rid_S_O3 = 457 + integer, parameter :: rid_SO_BRO = 458 + integer, parameter :: rid_SO_CLO = 459 + integer, parameter :: rid_S_OH = 460 + integer, parameter :: rid_SO_NO2 = 461 + integer, parameter :: rid_SO_O2 = 462 + integer, parameter :: rid_SO_O3 = 463 + integer, parameter :: rid_SO_OCLO = 464 + integer, parameter :: rid_SO_OH = 465 + integer, parameter :: rid_usr_DMS_OH = 466 + integer, parameter :: rid_usr_SO2_OH = 467 + integer, parameter :: rid_usr_SO3_H2O = 468 + integer, parameter :: rid_NH3_OH = 469 + integer, parameter :: rid_usr_GLYOXAL_aer = 470 + integer, parameter :: rid_usr_HO2_aer = 471 + integer, parameter :: rid_usr_HONITR_aer = 472 + integer, parameter :: rid_usr_ISOPNITA_aer = 473 + integer, parameter :: rid_usr_ISOPNITB_aer = 474 + integer, parameter :: rid_usr_N2O5_aer = 475 + integer, parameter :: rid_usr_NC4CH2OH_aer = 476 + integer, parameter :: rid_usr_NC4CHO_aer = 477 + integer, parameter :: rid_usr_NH4_strat_tau = 478 + integer, parameter :: rid_usr_NO2_aer = 479 + integer, parameter :: rid_usr_NO3_aer = 480 + integer, parameter :: rid_usr_NTERPOOH_aer = 481 + integer, parameter :: rid_usr_ONITR_aer = 482 + integer, parameter :: rid_usr_TERPNIT_aer = 483 + integer, parameter :: rid_BCARY_NO3_vbs = 484 + integer, parameter :: rid_BCARYO2_HO2_vbs = 485 + integer, parameter :: rid_BCARYO2_NO_vbs = 486 + integer, parameter :: rid_BCARY_O3_vbs = 487 + integer, parameter :: rid_BCARY_OH_vbs = 488 + integer, parameter :: rid_BENZENE_OH_vbs = 489 + integer, parameter :: rid_BENZO2_HO2_vbs = 490 + integer, parameter :: rid_BENZO2_NO_vbs = 491 + integer, parameter :: rid_ISOP_NO3_vbs = 492 + integer, parameter :: rid_ISOPO2_HO2_vbs = 493 + integer, parameter :: rid_ISOPO2_NO_vbs = 494 + integer, parameter :: rid_ISOP_O3_vbs = 495 + integer, parameter :: rid_ISOP_OH_vbs = 496 + integer, parameter :: rid_IVOCO2_HO2_vbs = 497 + integer, parameter :: rid_IVOCO2_NO_vbs = 498 + integer, parameter :: rid_IVOC_OH_vbs = 499 + integer, parameter :: rid_MTERP_NO3_vbs = 500 + integer, parameter :: rid_MTERPO2_HO2_vbs = 501 + integer, parameter :: rid_MTERPO2_NO_vbs = 502 + integer, parameter :: rid_MTERP_O3_vbs = 503 + integer, parameter :: rid_MTERP_OH_vbs = 504 + integer, parameter :: rid_SVOC_OH = 505 + integer, parameter :: rid_TOLUENE_OH_vbs = 506 + integer, parameter :: rid_TOLUO2_HO2_vbs = 507 + integer, parameter :: rid_TOLUO2_NO_vbs = 508 + integer, parameter :: rid_XYLENES_OH_vbs = 509 + integer, parameter :: rid_XYLEO2_HO2_vbs = 510 + integer, parameter :: rid_XYLEO2_NO_vbs = 511 + integer, parameter :: rid_het1 = 512 + integer, parameter :: rid_het10 = 513 + integer, parameter :: rid_het11 = 514 + integer, parameter :: rid_het12 = 515 + integer, parameter :: rid_het13 = 516 + integer, parameter :: rid_het14 = 517 + integer, parameter :: rid_het15 = 518 + integer, parameter :: rid_het16 = 519 + integer, parameter :: rid_het17 = 520 + integer, parameter :: rid_het2 = 521 + integer, parameter :: rid_het3 = 522 + integer, parameter :: rid_het4 = 523 + integer, parameter :: rid_het5 = 524 + integer, parameter :: rid_het6 = 525 + integer, parameter :: rid_het7 = 526 + integer, parameter :: rid_het8 = 527 + integer, parameter :: rid_het9 = 528 + integer, parameter :: rid_E90_tau = 529 + integer, parameter :: rid_NH_50_tau = 530 + integer, parameter :: rid_NH_5_tau = 531 + integer, parameter :: rid_ST80_25_tau = 532 + end module m_rxt_id diff --git a/src/chemistry/pp_trop_strat_noaero/m_spc_id.F90 b/src/chemistry/pp_trop_strat_noaero/m_spc_id.F90 new file mode 100644 index 0000000000..4e7e9d1f6d --- /dev/null +++ b/src/chemistry/pp_trop_strat_noaero/m_spc_id.F90 @@ -0,0 +1,205 @@ + module m_spc_id + implicit none + integer, parameter :: id_ALKNIT = 1 + integer, parameter :: id_ALKOOH = 2 + integer, parameter :: id_AOA_NH = 3 + integer, parameter :: id_BCARY = 4 + integer, parameter :: id_BENZENE = 5 + integer, parameter :: id_BENZOOH = 6 + integer, parameter :: id_BEPOMUC = 7 + integer, parameter :: id_BIGALD = 8 + integer, parameter :: id_BIGALD1 = 9 + integer, parameter :: id_BIGALD2 = 10 + integer, parameter :: id_BIGALD3 = 11 + integer, parameter :: id_BIGALD4 = 12 + integer, parameter :: id_BIGALK = 13 + integer, parameter :: id_BIGENE = 14 + integer, parameter :: id_BR = 15 + integer, parameter :: id_BRCL = 16 + integer, parameter :: id_BRO = 17 + integer, parameter :: id_BRONO2 = 18 + integer, parameter :: id_BRY = 19 + integer, parameter :: id_BZALD = 20 + integer, parameter :: id_BZOOH = 21 + integer, parameter :: id_C2H2 = 22 + integer, parameter :: id_C2H4 = 23 + integer, parameter :: id_C2H5OH = 24 + integer, parameter :: id_C2H5OOH = 25 + integer, parameter :: id_C2H6 = 26 + integer, parameter :: id_C3H6 = 27 + integer, parameter :: id_C3H7OOH = 28 + integer, parameter :: id_C3H8 = 29 + integer, parameter :: id_C6H5OOH = 30 + integer, parameter :: id_CCL4 = 31 + integer, parameter :: id_CF2CLBR = 32 + integer, parameter :: id_CF3BR = 33 + integer, parameter :: id_CFC11 = 34 + integer, parameter :: id_CFC113 = 35 + integer, parameter :: id_CFC114 = 36 + integer, parameter :: id_CFC115 = 37 + integer, parameter :: id_CFC12 = 38 + integer, parameter :: id_CH2BR2 = 39 + integer, parameter :: id_CH2O = 40 + integer, parameter :: id_CH3BR = 41 + integer, parameter :: id_CH3CCL3 = 42 + integer, parameter :: id_CH3CHO = 43 + integer, parameter :: id_CH3CL = 44 + integer, parameter :: id_CH3CN = 45 + integer, parameter :: id_CH3COCH3 = 46 + integer, parameter :: id_CH3COCHO = 47 + integer, parameter :: id_CH3COOH = 48 + integer, parameter :: id_CH3COOOH = 49 + integer, parameter :: id_CH3OH = 50 + integer, parameter :: id_CH3OOH = 51 + integer, parameter :: id_CH4 = 52 + integer, parameter :: id_CHBR3 = 53 + integer, parameter :: id_CL = 54 + integer, parameter :: id_CL2 = 55 + integer, parameter :: id_CL2O2 = 56 + integer, parameter :: id_CLO = 57 + integer, parameter :: id_CLONO2 = 58 + integer, parameter :: id_CLY = 59 + integer, parameter :: id_CO = 60 + integer, parameter :: id_CO2 = 61 + integer, parameter :: id_COF2 = 62 + integer, parameter :: id_COFCL = 63 + integer, parameter :: id_CRESOL = 64 + integer, parameter :: id_DMS = 65 + integer, parameter :: id_E90 = 66 + integer, parameter :: id_EOOH = 67 + integer, parameter :: id_F = 68 + integer, parameter :: id_GLYALD = 69 + integer, parameter :: id_GLYOXAL = 70 + integer, parameter :: id_H = 71 + integer, parameter :: id_H2 = 72 + integer, parameter :: id_H2402 = 73 + integer, parameter :: id_H2O2 = 74 + integer, parameter :: id_H2SO4 = 75 + integer, parameter :: id_HBR = 76 + integer, parameter :: id_HCFC141B = 77 + integer, parameter :: id_HCFC142B = 78 + integer, parameter :: id_HCFC22 = 79 + integer, parameter :: id_HCL = 80 + integer, parameter :: id_HCN = 81 + integer, parameter :: id_HCOOH = 82 + integer, parameter :: id_HF = 83 + integer, parameter :: id_HNO3 = 84 + integer, parameter :: id_HO2NO2 = 85 + integer, parameter :: id_HOBR = 86 + integer, parameter :: id_HOCL = 87 + integer, parameter :: id_HONITR = 88 + integer, parameter :: id_HPALD = 89 + integer, parameter :: id_HYAC = 90 + integer, parameter :: id_HYDRALD = 91 + integer, parameter :: id_IEPOX = 92 + integer, parameter :: id_ISOP = 93 + integer, parameter :: id_ISOPNITA = 94 + integer, parameter :: id_ISOPNITB = 95 + integer, parameter :: id_ISOPNO3 = 96 + integer, parameter :: id_ISOPNOOH = 97 + integer, parameter :: id_ISOPOOH = 98 + integer, parameter :: id_IVOC = 99 + integer, parameter :: id_MACR = 100 + integer, parameter :: id_MACROOH = 101 + integer, parameter :: id_MEK = 102 + integer, parameter :: id_MEKOOH = 103 + integer, parameter :: id_MPAN = 104 + integer, parameter :: id_MTERP = 105 + integer, parameter :: id_MVK = 106 + integer, parameter :: id_N = 107 + integer, parameter :: id_N2O = 108 + integer, parameter :: id_N2O5 = 109 + integer, parameter :: id_NC4CH2OH = 110 + integer, parameter :: id_NC4CHO = 111 + integer, parameter :: id_NH3 = 112 + integer, parameter :: id_NH4 = 113 + integer, parameter :: id_NH_5 = 114 + integer, parameter :: id_NH_50 = 115 + integer, parameter :: id_NO = 116 + integer, parameter :: id_NO2 = 117 + integer, parameter :: id_NO3 = 118 + integer, parameter :: id_NOA = 119 + integer, parameter :: id_NTERPOOH = 120 + integer, parameter :: id_O = 121 + integer, parameter :: id_O3 = 122 + integer, parameter :: id_O3S = 123 + integer, parameter :: id_OCLO = 124 + integer, parameter :: id_OCS = 125 + integer, parameter :: id_ONITR = 126 + integer, parameter :: id_PAN = 127 + integer, parameter :: id_PBZNIT = 128 + integer, parameter :: id_PHENO = 129 + integer, parameter :: id_PHENOL = 130 + integer, parameter :: id_PHENOOH = 131 + integer, parameter :: id_POOH = 132 + integer, parameter :: id_ROOH = 133 + integer, parameter :: id_S = 134 + integer, parameter :: id_SF6 = 135 + integer, parameter :: id_SO = 136 + integer, parameter :: id_SO2 = 137 + integer, parameter :: id_SO3 = 138 + integer, parameter :: id_SOAG0 = 139 + integer, parameter :: id_SOAG1 = 140 + integer, parameter :: id_SOAG2 = 141 + integer, parameter :: id_SOAG3 = 142 + integer, parameter :: id_SOAG4 = 143 + integer, parameter :: id_ST80_25 = 144 + integer, parameter :: id_SVOC = 145 + integer, parameter :: id_TEPOMUC = 146 + integer, parameter :: id_TERP2OOH = 147 + integer, parameter :: id_TERPNIT = 148 + integer, parameter :: id_TERPOOH = 149 + integer, parameter :: id_TERPROD1 = 150 + integer, parameter :: id_TERPROD2 = 151 + integer, parameter :: id_TOLOOH = 152 + integer, parameter :: id_TOLUENE = 153 + integer, parameter :: id_XOOH = 154 + integer, parameter :: id_XYLENES = 155 + integer, parameter :: id_XYLENOOH = 156 + integer, parameter :: id_XYLOL = 157 + integer, parameter :: id_XYLOLOOH = 158 + integer, parameter :: id_NHDEP = 159 + integer, parameter :: id_NDEP = 160 + integer, parameter :: id_ACBZO2 = 161 + integer, parameter :: id_ALKO2 = 162 + integer, parameter :: id_BCARYO2VBS = 163 + integer, parameter :: id_BENZO2 = 164 + integer, parameter :: id_BENZO2VBS = 165 + integer, parameter :: id_BZOO = 166 + integer, parameter :: id_C2H5O2 = 167 + integer, parameter :: id_C3H7O2 = 168 + integer, parameter :: id_C6H5O2 = 169 + integer, parameter :: id_CH3CO3 = 170 + integer, parameter :: id_CH3O2 = 171 + integer, parameter :: id_DICARBO2 = 172 + integer, parameter :: id_ENEO2 = 173 + integer, parameter :: id_EO = 174 + integer, parameter :: id_EO2 = 175 + integer, parameter :: id_HO2 = 176 + integer, parameter :: id_HOCH2OO = 177 + integer, parameter :: id_ISOPAO2 = 178 + integer, parameter :: id_ISOPBO2 = 179 + integer, parameter :: id_ISOPO2VBS = 180 + integer, parameter :: id_IVOCO2VBS = 181 + integer, parameter :: id_MACRO2 = 182 + integer, parameter :: id_MALO2 = 183 + integer, parameter :: id_MCO3 = 184 + integer, parameter :: id_MDIALO2 = 185 + integer, parameter :: id_MEKO2 = 186 + integer, parameter :: id_MTERPO2VBS = 187 + integer, parameter :: id_NTERPO2 = 188 + integer, parameter :: id_O1D = 189 + integer, parameter :: id_OH = 190 + integer, parameter :: id_PHENO2 = 191 + integer, parameter :: id_PO2 = 192 + integer, parameter :: id_RO2 = 193 + integer, parameter :: id_TERP2O2 = 194 + integer, parameter :: id_TERPO2 = 195 + integer, parameter :: id_TOLO2 = 196 + integer, parameter :: id_TOLUO2VBS = 197 + integer, parameter :: id_XO2 = 198 + integer, parameter :: id_XYLENO2 = 199 + integer, parameter :: id_XYLEO2VBS = 200 + integer, parameter :: id_XYLOLO2 = 201 + integer, parameter :: id_H2O = 202 + end module m_spc_id diff --git a/src/chemistry/pp_trop_strat_noaero/mo_adjrxt.F90 b/src/chemistry/pp_trop_strat_noaero/mo_adjrxt.F90 new file mode 100644 index 0000000000..d7aa7227bd --- /dev/null +++ b/src/chemistry/pp_trop_strat_noaero/mo_adjrxt.F90 @@ -0,0 +1,430 @@ + module mo_adjrxt + private + public :: adjrxt + contains + subroutine adjrxt( rate, inv, m, ncol, nlev ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : nfs, rxntot + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: ncol, nlev + real(r8), intent(in) :: inv(ncol,nlev,nfs) + real(r8), intent(in) :: m(ncol,nlev) + real(r8), intent(inout) :: rate(ncol,nlev,rxntot) + rate(:,:, 116) = rate(:,:, 116) * inv(:,:, 3) + rate(:,:, 117) = rate(:,:, 117) * inv(:,:, 2) + rate(:,:, 120) = rate(:,:, 120) * inv(:,:, 1) + rate(:,:, 137) = rate(:,:, 137) * inv(:,:, 1) + rate(:,:, 144) = rate(:,:, 144) * inv(:,:, 2) + rate(:,:, 147) = rate(:,:, 147) * inv(:,:, 1) + rate(:,:, 155) = rate(:,:, 155) * inv(:,:, 1) + rate(:,:, 158) = rate(:,:, 158) * inv(:,:, 1) + rate(:,:, 159) = rate(:,:, 159) * inv(:,:, 1) + rate(:,:, 160) = rate(:,:, 160) * inv(:,:, 1) + rate(:,:, 162) = rate(:,:, 162) * inv(:,:, 1) + rate(:,:, 163) = rate(:,:, 163) * inv(:,:, 1) + rate(:,:, 178) = rate(:,:, 178) * inv(:,:, 1) + rate(:,:, 198) = rate(:,:, 198) * inv(:,:, 1) + rate(:,:, 199) = rate(:,:, 199) * inv(:,:, 1) + rate(:,:, 209) = rate(:,:, 209) * inv(:,:, 1) + rate(:,:, 255) = rate(:,:, 255) * inv(:,:, 1) + rate(:,:, 256) = rate(:,:, 256) * inv(:,:, 1) + rate(:,:, 266) = rate(:,:, 266) * inv(:,:, 1) + rate(:,:, 267) = rate(:,:, 267) * inv(:,:, 1) + rate(:,:, 268) = rate(:,:, 268) * inv(:,:, 1) + rate(:,:, 290) = rate(:,:, 290) * inv(:,:, 2) + rate(:,:, 294) = rate(:,:, 294) * inv(:,:, 1) + rate(:,:, 295) = rate(:,:, 295) * inv(:,:, 1) + rate(:,:, 296) = rate(:,:, 296) * inv(:,:, 1) + rate(:,:, 315) = rate(:,:, 315) * inv(:,:, 1) + rate(:,:, 341) = rate(:,:, 341) * inv(:,:, 1) + rate(:,:, 344) = rate(:,:, 344) * inv(:,:, 1) + rate(:,:, 345) = rate(:,:, 345) * inv(:,:, 1) + rate(:,:, 402) = rate(:,:, 402) * inv(:,:, 1) + rate(:,:, 405) = rate(:,:, 405) * inv(:,:, 1) + rate(:,:, 408) = rate(:,:, 408) * inv(:,:, 1) + rate(:,:, 415) = rate(:,:, 415) * inv(:,:, 1) + rate(:,:, 420) = rate(:,:, 420) * inv(:,:, 1) + rate(:,:, 456) = rate(:,:, 456) * inv(:,:, 2) + rate(:,:, 462) = rate(:,:, 462) * inv(:,:, 2) + rate(:,:, 121) = rate(:,:, 121) * inv(:,:, 2) * inv(:,:, 1) + rate(:,:, 127) = rate(:,:, 127) * inv(:,:, 2) * inv(:,:, 1) + rate(:,:, 114) = rate(:,:, 114) * m(:,:) + rate(:,:, 115) = rate(:,:, 115) * m(:,:) + rate(:,:, 118) = rate(:,:, 118) * m(:,:) + rate(:,:, 119) = rate(:,:, 119) * m(:,:) + rate(:,:, 120) = rate(:,:, 120) * m(:,:) + rate(:,:, 122) = rate(:,:, 122) * m(:,:) + rate(:,:, 123) = rate(:,:, 123) * m(:,:) + rate(:,:, 124) = rate(:,:, 124) * m(:,:) + rate(:,:, 125) = rate(:,:, 125) * m(:,:) + rate(:,:, 126) = rate(:,:, 126) * m(:,:) + rate(:,:, 128) = rate(:,:, 128) * m(:,:) + rate(:,:, 129) = rate(:,:, 129) * m(:,:) + rate(:,:, 130) = rate(:,:, 130) * m(:,:) + rate(:,:, 131) = rate(:,:, 131) * m(:,:) + rate(:,:, 132) = rate(:,:, 132) * m(:,:) + rate(:,:, 133) = rate(:,:, 133) * m(:,:) + rate(:,:, 134) = rate(:,:, 134) * m(:,:) + rate(:,:, 135) = rate(:,:, 135) * m(:,:) + rate(:,:, 136) = rate(:,:, 136) * m(:,:) + rate(:,:, 137) = rate(:,:, 137) * m(:,:) + rate(:,:, 138) = rate(:,:, 138) * m(:,:) + rate(:,:, 139) = rate(:,:, 139) * m(:,:) + rate(:,:, 140) = rate(:,:, 140) * m(:,:) + rate(:,:, 141) = rate(:,:, 141) * m(:,:) + rate(:,:, 142) = rate(:,:, 142) * m(:,:) + rate(:,:, 143) = rate(:,:, 143) * m(:,:) + rate(:,:, 145) = rate(:,:, 145) * m(:,:) + rate(:,:, 146) = rate(:,:, 146) * m(:,:) + rate(:,:, 147) = rate(:,:, 147) * m(:,:) + rate(:,:, 148) = rate(:,:, 148) * m(:,:) + rate(:,:, 149) = rate(:,:, 149) * m(:,:) + rate(:,:, 150) = rate(:,:, 150) * m(:,:) + rate(:,:, 151) = rate(:,:, 151) * m(:,:) + rate(:,:, 152) = rate(:,:, 152) * m(:,:) + rate(:,:, 153) = rate(:,:, 153) * m(:,:) + rate(:,:, 154) = rate(:,:, 154) * m(:,:) + rate(:,:, 155) = rate(:,:, 155) * m(:,:) + rate(:,:, 156) = rate(:,:, 156) * m(:,:) + rate(:,:, 157) = rate(:,:, 157) * m(:,:) + rate(:,:, 158) = rate(:,:, 158) * m(:,:) + rate(:,:, 159) = rate(:,:, 159) * m(:,:) + rate(:,:, 160) = rate(:,:, 160) * m(:,:) + rate(:,:, 161) = rate(:,:, 161) * m(:,:) + rate(:,:, 164) = rate(:,:, 164) * m(:,:) + rate(:,:, 165) = rate(:,:, 165) * m(:,:) + rate(:,:, 166) = rate(:,:, 166) * m(:,:) + rate(:,:, 167) = rate(:,:, 167) * m(:,:) + rate(:,:, 168) = rate(:,:, 168) * m(:,:) + rate(:,:, 169) = rate(:,:, 169) * m(:,:) + rate(:,:, 170) = rate(:,:, 170) * m(:,:) + rate(:,:, 171) = rate(:,:, 171) * m(:,:) + rate(:,:, 172) = rate(:,:, 172) * m(:,:) + rate(:,:, 173) = rate(:,:, 173) * m(:,:) + rate(:,:, 174) = rate(:,:, 174) * m(:,:) + rate(:,:, 175) = rate(:,:, 175) * m(:,:) + rate(:,:, 176) = rate(:,:, 176) * m(:,:) + rate(:,:, 177) = rate(:,:, 177) * m(:,:) + rate(:,:, 178) = rate(:,:, 178) * m(:,:) + rate(:,:, 179) = rate(:,:, 179) * m(:,:) + rate(:,:, 180) = rate(:,:, 180) * m(:,:) + rate(:,:, 181) = rate(:,:, 181) * m(:,:) + rate(:,:, 182) = rate(:,:, 182) * m(:,:) + rate(:,:, 183) = rate(:,:, 183) * m(:,:) + rate(:,:, 184) = rate(:,:, 184) * m(:,:) + rate(:,:, 185) = rate(:,:, 185) * m(:,:) + rate(:,:, 186) = rate(:,:, 186) * m(:,:) + rate(:,:, 187) = rate(:,:, 187) * m(:,:) + rate(:,:, 188) = rate(:,:, 188) * m(:,:) + rate(:,:, 189) = rate(:,:, 189) * m(:,:) + rate(:,:, 190) = rate(:,:, 190) * m(:,:) + rate(:,:, 191) = rate(:,:, 191) * m(:,:) + rate(:,:, 192) = rate(:,:, 192) * m(:,:) + rate(:,:, 193) = rate(:,:, 193) * m(:,:) + rate(:,:, 194) = rate(:,:, 194) * m(:,:) + rate(:,:, 195) = rate(:,:, 195) * m(:,:) + rate(:,:, 196) = rate(:,:, 196) * m(:,:) + rate(:,:, 197) = rate(:,:, 197) * m(:,:) + rate(:,:, 198) = rate(:,:, 198) * m(:,:) + rate(:,:, 200) = rate(:,:, 200) * m(:,:) + rate(:,:, 201) = rate(:,:, 201) * m(:,:) + rate(:,:, 202) = rate(:,:, 202) * m(:,:) + rate(:,:, 203) = rate(:,:, 203) * m(:,:) + rate(:,:, 204) = rate(:,:, 204) * m(:,:) + rate(:,:, 205) = rate(:,:, 205) * m(:,:) + rate(:,:, 206) = rate(:,:, 206) * m(:,:) + rate(:,:, 207) = rate(:,:, 207) * m(:,:) + rate(:,:, 208) = rate(:,:, 208) * m(:,:) + rate(:,:, 209) = rate(:,:, 209) * m(:,:) + rate(:,:, 210) = rate(:,:, 210) * m(:,:) + rate(:,:, 211) = rate(:,:, 211) * m(:,:) + rate(:,:, 212) = rate(:,:, 212) * m(:,:) + rate(:,:, 213) = rate(:,:, 213) * m(:,:) + rate(:,:, 214) = rate(:,:, 214) * m(:,:) + rate(:,:, 215) = rate(:,:, 215) * m(:,:) + rate(:,:, 216) = rate(:,:, 216) * m(:,:) + rate(:,:, 217) = rate(:,:, 217) * m(:,:) + rate(:,:, 218) = rate(:,:, 218) * m(:,:) + rate(:,:, 219) = rate(:,:, 219) * m(:,:) + rate(:,:, 220) = rate(:,:, 220) * m(:,:) + rate(:,:, 221) = rate(:,:, 221) * m(:,:) + rate(:,:, 222) = rate(:,:, 222) * m(:,:) + rate(:,:, 223) = rate(:,:, 223) * m(:,:) + rate(:,:, 224) = rate(:,:, 224) * m(:,:) + rate(:,:, 225) = rate(:,:, 225) * m(:,:) + rate(:,:, 226) = rate(:,:, 226) * m(:,:) + rate(:,:, 227) = rate(:,:, 227) * m(:,:) + rate(:,:, 228) = rate(:,:, 228) * m(:,:) + rate(:,:, 229) = rate(:,:, 229) * m(:,:) + rate(:,:, 230) = rate(:,:, 230) * m(:,:) + rate(:,:, 231) = rate(:,:, 231) * m(:,:) + rate(:,:, 232) = rate(:,:, 232) * m(:,:) + rate(:,:, 233) = rate(:,:, 233) * m(:,:) + rate(:,:, 234) = rate(:,:, 234) * m(:,:) + rate(:,:, 235) = rate(:,:, 235) * m(:,:) + rate(:,:, 236) = rate(:,:, 236) * m(:,:) + rate(:,:, 237) = rate(:,:, 237) * m(:,:) + rate(:,:, 238) = rate(:,:, 238) * m(:,:) + rate(:,:, 239) = rate(:,:, 239) * m(:,:) + rate(:,:, 240) = rate(:,:, 240) * m(:,:) + rate(:,:, 241) = rate(:,:, 241) * m(:,:) + rate(:,:, 242) = rate(:,:, 242) * m(:,:) + rate(:,:, 243) = rate(:,:, 243) * m(:,:) + rate(:,:, 244) = rate(:,:, 244) * m(:,:) + rate(:,:, 245) = rate(:,:, 245) * m(:,:) + rate(:,:, 246) = rate(:,:, 246) * m(:,:) + rate(:,:, 247) = rate(:,:, 247) * m(:,:) + rate(:,:, 248) = rate(:,:, 248) * m(:,:) + rate(:,:, 249) = rate(:,:, 249) * m(:,:) + rate(:,:, 250) = rate(:,:, 250) * m(:,:) + rate(:,:, 251) = rate(:,:, 251) * m(:,:) + rate(:,:, 252) = rate(:,:, 252) * m(:,:) + rate(:,:, 253) = rate(:,:, 253) * m(:,:) + rate(:,:, 254) = rate(:,:, 254) * m(:,:) + rate(:,:, 255) = rate(:,:, 255) * m(:,:) + rate(:,:, 256) = rate(:,:, 256) * m(:,:) + rate(:,:, 257) = rate(:,:, 257) * m(:,:) + rate(:,:, 258) = rate(:,:, 258) * m(:,:) + rate(:,:, 260) = rate(:,:, 260) * m(:,:) + rate(:,:, 261) = rate(:,:, 261) * m(:,:) + rate(:,:, 262) = rate(:,:, 262) * m(:,:) + rate(:,:, 263) = rate(:,:, 263) * m(:,:) + rate(:,:, 264) = rate(:,:, 264) * m(:,:) + rate(:,:, 265) = rate(:,:, 265) * m(:,:) + rate(:,:, 266) = rate(:,:, 266) * m(:,:) + rate(:,:, 267) = rate(:,:, 267) * m(:,:) + rate(:,:, 268) = rate(:,:, 268) * m(:,:) + rate(:,:, 269) = rate(:,:, 269) * m(:,:) + rate(:,:, 270) = rate(:,:, 270) * m(:,:) + rate(:,:, 271) = rate(:,:, 271) * m(:,:) + rate(:,:, 272) = rate(:,:, 272) * m(:,:) + rate(:,:, 273) = rate(:,:, 273) * m(:,:) + rate(:,:, 274) = rate(:,:, 274) * m(:,:) + rate(:,:, 275) = rate(:,:, 275) * m(:,:) + rate(:,:, 276) = rate(:,:, 276) * m(:,:) + rate(:,:, 277) = rate(:,:, 277) * m(:,:) + rate(:,:, 278) = rate(:,:, 278) * m(:,:) + rate(:,:, 279) = rate(:,:, 279) * m(:,:) + rate(:,:, 280) = rate(:,:, 280) * m(:,:) + rate(:,:, 281) = rate(:,:, 281) * m(:,:) + rate(:,:, 282) = rate(:,:, 282) * m(:,:) + rate(:,:, 283) = rate(:,:, 283) * m(:,:) + rate(:,:, 284) = rate(:,:, 284) * m(:,:) + rate(:,:, 285) = rate(:,:, 285) * m(:,:) + rate(:,:, 286) = rate(:,:, 286) * m(:,:) + rate(:,:, 287) = rate(:,:, 287) * m(:,:) + rate(:,:, 288) = rate(:,:, 288) * m(:,:) + rate(:,:, 291) = rate(:,:, 291) * m(:,:) + rate(:,:, 292) = rate(:,:, 292) * m(:,:) + rate(:,:, 293) = rate(:,:, 293) * m(:,:) + rate(:,:, 294) = rate(:,:, 294) * m(:,:) + rate(:,:, 295) = rate(:,:, 295) * m(:,:) + rate(:,:, 297) = rate(:,:, 297) * m(:,:) + rate(:,:, 298) = rate(:,:, 298) * m(:,:) + rate(:,:, 299) = rate(:,:, 299) * m(:,:) + rate(:,:, 300) = rate(:,:, 300) * m(:,:) + rate(:,:, 301) = rate(:,:, 301) * m(:,:) + rate(:,:, 302) = rate(:,:, 302) * m(:,:) + rate(:,:, 303) = rate(:,:, 303) * m(:,:) + rate(:,:, 304) = rate(:,:, 304) * m(:,:) + rate(:,:, 305) = rate(:,:, 305) * m(:,:) + rate(:,:, 306) = rate(:,:, 306) * m(:,:) + rate(:,:, 307) = rate(:,:, 307) * m(:,:) + rate(:,:, 308) = rate(:,:, 308) * m(:,:) + rate(:,:, 309) = rate(:,:, 309) * m(:,:) + rate(:,:, 310) = rate(:,:, 310) * m(:,:) + rate(:,:, 311) = rate(:,:, 311) * m(:,:) + rate(:,:, 312) = rate(:,:, 312) * m(:,:) + rate(:,:, 313) = rate(:,:, 313) * m(:,:) + rate(:,:, 314) = rate(:,:, 314) * m(:,:) + rate(:,:, 315) = rate(:,:, 315) * m(:,:) + rate(:,:, 316) = rate(:,:, 316) * m(:,:) + rate(:,:, 317) = rate(:,:, 317) * m(:,:) + rate(:,:, 318) = rate(:,:, 318) * m(:,:) + rate(:,:, 319) = rate(:,:, 319) * m(:,:) + rate(:,:, 320) = rate(:,:, 320) * m(:,:) + rate(:,:, 321) = rate(:,:, 321) * m(:,:) + rate(:,:, 322) = rate(:,:, 322) * m(:,:) + rate(:,:, 323) = rate(:,:, 323) * m(:,:) + rate(:,:, 324) = rate(:,:, 324) * m(:,:) + rate(:,:, 325) = rate(:,:, 325) * m(:,:) + rate(:,:, 326) = rate(:,:, 326) * m(:,:) + rate(:,:, 327) = rate(:,:, 327) * m(:,:) + rate(:,:, 328) = rate(:,:, 328) * m(:,:) + rate(:,:, 329) = rate(:,:, 329) * m(:,:) + rate(:,:, 330) = rate(:,:, 330) * m(:,:) + rate(:,:, 331) = rate(:,:, 331) * m(:,:) + rate(:,:, 332) = rate(:,:, 332) * m(:,:) + rate(:,:, 333) = rate(:,:, 333) * m(:,:) + rate(:,:, 334) = rate(:,:, 334) * m(:,:) + rate(:,:, 335) = rate(:,:, 335) * m(:,:) + rate(:,:, 336) = rate(:,:, 336) * m(:,:) + rate(:,:, 337) = rate(:,:, 337) * m(:,:) + rate(:,:, 338) = rate(:,:, 338) * m(:,:) + rate(:,:, 339) = rate(:,:, 339) * m(:,:) + rate(:,:, 340) = rate(:,:, 340) * m(:,:) + rate(:,:, 341) = rate(:,:, 341) * m(:,:) + rate(:,:, 342) = rate(:,:, 342) * m(:,:) + rate(:,:, 343) = rate(:,:, 343) * m(:,:) + rate(:,:, 344) = rate(:,:, 344) * m(:,:) + rate(:,:, 346) = rate(:,:, 346) * m(:,:) + rate(:,:, 347) = rate(:,:, 347) * m(:,:) + rate(:,:, 348) = rate(:,:, 348) * m(:,:) + rate(:,:, 349) = rate(:,:, 349) * m(:,:) + rate(:,:, 350) = rate(:,:, 350) * m(:,:) + rate(:,:, 351) = rate(:,:, 351) * m(:,:) + rate(:,:, 352) = rate(:,:, 352) * m(:,:) + rate(:,:, 353) = rate(:,:, 353) * m(:,:) + rate(:,:, 354) = rate(:,:, 354) * m(:,:) + rate(:,:, 355) = rate(:,:, 355) * m(:,:) + rate(:,:, 356) = rate(:,:, 356) * m(:,:) + rate(:,:, 357) = rate(:,:, 357) * m(:,:) + rate(:,:, 358) = rate(:,:, 358) * m(:,:) + rate(:,:, 359) = rate(:,:, 359) * m(:,:) + rate(:,:, 360) = rate(:,:, 360) * m(:,:) + rate(:,:, 361) = rate(:,:, 361) * m(:,:) + rate(:,:, 362) = rate(:,:, 362) * m(:,:) + rate(:,:, 364) = rate(:,:, 364) * m(:,:) + rate(:,:, 365) = rate(:,:, 365) * m(:,:) + rate(:,:, 366) = rate(:,:, 366) * m(:,:) + rate(:,:, 367) = rate(:,:, 367) * m(:,:) + rate(:,:, 368) = rate(:,:, 368) * m(:,:) + rate(:,:, 369) = rate(:,:, 369) * m(:,:) + rate(:,:, 370) = rate(:,:, 370) * m(:,:) + rate(:,:, 371) = rate(:,:, 371) * m(:,:) + rate(:,:, 372) = rate(:,:, 372) * m(:,:) + rate(:,:, 373) = rate(:,:, 373) * m(:,:) + rate(:,:, 374) = rate(:,:, 374) * m(:,:) + rate(:,:, 375) = rate(:,:, 375) * m(:,:) + rate(:,:, 376) = rate(:,:, 376) * m(:,:) + rate(:,:, 377) = rate(:,:, 377) * m(:,:) + rate(:,:, 378) = rate(:,:, 378) * m(:,:) + rate(:,:, 379) = rate(:,:, 379) * m(:,:) + rate(:,:, 380) = rate(:,:, 380) * m(:,:) + rate(:,:, 381) = rate(:,:, 381) * m(:,:) + rate(:,:, 382) = rate(:,:, 382) * m(:,:) + rate(:,:, 383) = rate(:,:, 383) * m(:,:) + rate(:,:, 384) = rate(:,:, 384) * m(:,:) + rate(:,:, 385) = rate(:,:, 385) * m(:,:) + rate(:,:, 386) = rate(:,:, 386) * m(:,:) + rate(:,:, 387) = rate(:,:, 387) * m(:,:) + rate(:,:, 388) = rate(:,:, 388) * m(:,:) + rate(:,:, 389) = rate(:,:, 389) * m(:,:) + rate(:,:, 390) = rate(:,:, 390) * m(:,:) + rate(:,:, 391) = rate(:,:, 391) * m(:,:) + rate(:,:, 392) = rate(:,:, 392) * m(:,:) + rate(:,:, 393) = rate(:,:, 393) * m(:,:) + rate(:,:, 394) = rate(:,:, 394) * m(:,:) + rate(:,:, 395) = rate(:,:, 395) * m(:,:) + rate(:,:, 396) = rate(:,:, 396) * m(:,:) + rate(:,:, 397) = rate(:,:, 397) * m(:,:) + rate(:,:, 398) = rate(:,:, 398) * m(:,:) + rate(:,:, 399) = rate(:,:, 399) * m(:,:) + rate(:,:, 400) = rate(:,:, 400) * m(:,:) + rate(:,:, 401) = rate(:,:, 401) * m(:,:) + rate(:,:, 402) = rate(:,:, 402) * m(:,:) + rate(:,:, 403) = rate(:,:, 403) * m(:,:) + rate(:,:, 404) = rate(:,:, 404) * m(:,:) + rate(:,:, 405) = rate(:,:, 405) * m(:,:) + rate(:,:, 406) = rate(:,:, 406) * m(:,:) + rate(:,:, 407) = rate(:,:, 407) * m(:,:) + rate(:,:, 408) = rate(:,:, 408) * m(:,:) + rate(:,:, 409) = rate(:,:, 409) * m(:,:) + rate(:,:, 410) = rate(:,:, 410) * m(:,:) + rate(:,:, 411) = rate(:,:, 411) * m(:,:) + rate(:,:, 412) = rate(:,:, 412) * m(:,:) + rate(:,:, 413) = rate(:,:, 413) * m(:,:) + rate(:,:, 414) = rate(:,:, 414) * m(:,:) + rate(:,:, 415) = rate(:,:, 415) * m(:,:) + rate(:,:, 416) = rate(:,:, 416) * m(:,:) + rate(:,:, 417) = rate(:,:, 417) * m(:,:) + rate(:,:, 418) = rate(:,:, 418) * m(:,:) + rate(:,:, 419) = rate(:,:, 419) * m(:,:) + rate(:,:, 421) = rate(:,:, 421) * m(:,:) + rate(:,:, 422) = rate(:,:, 422) * m(:,:) + rate(:,:, 423) = rate(:,:, 423) * m(:,:) + rate(:,:, 424) = rate(:,:, 424) * m(:,:) + rate(:,:, 425) = rate(:,:, 425) * m(:,:) + rate(:,:, 426) = rate(:,:, 426) * m(:,:) + rate(:,:, 427) = rate(:,:, 427) * m(:,:) + rate(:,:, 428) = rate(:,:, 428) * m(:,:) + rate(:,:, 429) = rate(:,:, 429) * m(:,:) + rate(:,:, 430) = rate(:,:, 430) * m(:,:) + rate(:,:, 431) = rate(:,:, 431) * m(:,:) + rate(:,:, 432) = rate(:,:, 432) * m(:,:) + rate(:,:, 433) = rate(:,:, 433) * m(:,:) + rate(:,:, 434) = rate(:,:, 434) * m(:,:) + rate(:,:, 435) = rate(:,:, 435) * m(:,:) + rate(:,:, 436) = rate(:,:, 436) * m(:,:) + rate(:,:, 437) = rate(:,:, 437) * m(:,:) + rate(:,:, 438) = rate(:,:, 438) * m(:,:) + rate(:,:, 439) = rate(:,:, 439) * m(:,:) + rate(:,:, 440) = rate(:,:, 440) * m(:,:) + rate(:,:, 441) = rate(:,:, 441) * m(:,:) + rate(:,:, 442) = rate(:,:, 442) * m(:,:) + rate(:,:, 443) = rate(:,:, 443) * m(:,:) + rate(:,:, 444) = rate(:,:, 444) * m(:,:) + rate(:,:, 445) = rate(:,:, 445) * m(:,:) + rate(:,:, 446) = rate(:,:, 446) * m(:,:) + rate(:,:, 447) = rate(:,:, 447) * m(:,:) + rate(:,:, 448) = rate(:,:, 448) * m(:,:) + rate(:,:, 449) = rate(:,:, 449) * m(:,:) + rate(:,:, 450) = rate(:,:, 450) * m(:,:) + rate(:,:, 451) = rate(:,:, 451) * m(:,:) + rate(:,:, 452) = rate(:,:, 452) * m(:,:) + rate(:,:, 453) = rate(:,:, 453) * m(:,:) + rate(:,:, 454) = rate(:,:, 454) * m(:,:) + rate(:,:, 455) = rate(:,:, 455) * m(:,:) + rate(:,:, 457) = rate(:,:, 457) * m(:,:) + rate(:,:, 458) = rate(:,:, 458) * m(:,:) + rate(:,:, 459) = rate(:,:, 459) * m(:,:) + rate(:,:, 460) = rate(:,:, 460) * m(:,:) + rate(:,:, 461) = rate(:,:, 461) * m(:,:) + rate(:,:, 463) = rate(:,:, 463) * m(:,:) + rate(:,:, 464) = rate(:,:, 464) * m(:,:) + rate(:,:, 465) = rate(:,:, 465) * m(:,:) + rate(:,:, 466) = rate(:,:, 466) * m(:,:) + rate(:,:, 467) = rate(:,:, 467) * m(:,:) + rate(:,:, 468) = rate(:,:, 468) * m(:,:) + rate(:,:, 469) = rate(:,:, 469) * m(:,:) + rate(:,:, 484) = rate(:,:, 484) * m(:,:) + rate(:,:, 485) = rate(:,:, 485) * m(:,:) + rate(:,:, 486) = rate(:,:, 486) * m(:,:) + rate(:,:, 487) = rate(:,:, 487) * m(:,:) + rate(:,:, 488) = rate(:,:, 488) * m(:,:) + rate(:,:, 489) = rate(:,:, 489) * m(:,:) + rate(:,:, 490) = rate(:,:, 490) * m(:,:) + rate(:,:, 491) = rate(:,:, 491) * m(:,:) + rate(:,:, 492) = rate(:,:, 492) * m(:,:) + rate(:,:, 493) = rate(:,:, 493) * m(:,:) + rate(:,:, 494) = rate(:,:, 494) * m(:,:) + rate(:,:, 495) = rate(:,:, 495) * m(:,:) + rate(:,:, 496) = rate(:,:, 496) * m(:,:) + rate(:,:, 497) = rate(:,:, 497) * m(:,:) + rate(:,:, 498) = rate(:,:, 498) * m(:,:) + rate(:,:, 499) = rate(:,:, 499) * m(:,:) + rate(:,:, 500) = rate(:,:, 500) * m(:,:) + rate(:,:, 501) = rate(:,:, 501) * m(:,:) + rate(:,:, 502) = rate(:,:, 502) * m(:,:) + rate(:,:, 503) = rate(:,:, 503) * m(:,:) + rate(:,:, 504) = rate(:,:, 504) * m(:,:) + rate(:,:, 505) = rate(:,:, 505) * m(:,:) + rate(:,:, 506) = rate(:,:, 506) * m(:,:) + rate(:,:, 507) = rate(:,:, 507) * m(:,:) + rate(:,:, 508) = rate(:,:, 508) * m(:,:) + rate(:,:, 509) = rate(:,:, 509) * m(:,:) + rate(:,:, 510) = rate(:,:, 510) * m(:,:) + rate(:,:, 511) = rate(:,:, 511) * m(:,:) + rate(:,:, 513) = rate(:,:, 513) * m(:,:) + rate(:,:, 518) = rate(:,:, 518) * m(:,:) + rate(:,:, 519) = rate(:,:, 519) * m(:,:) + rate(:,:, 520) = rate(:,:, 520) * m(:,:) + rate(:,:, 523) = rate(:,:, 523) * m(:,:) + rate(:,:, 524) = rate(:,:, 524) * m(:,:) + rate(:,:, 525) = rate(:,:, 525) * m(:,:) + rate(:,:, 528) = rate(:,:, 528) * m(:,:) + end subroutine adjrxt + end module mo_adjrxt diff --git a/src/chemistry/pp_trop_strat_noaero/mo_exp_sol.F90 b/src/chemistry/pp_trop_strat_noaero/mo_exp_sol.F90 new file mode 100644 index 0000000000..c1cde93fa7 --- /dev/null +++ b/src/chemistry/pp_trop_strat_noaero/mo_exp_sol.F90 @@ -0,0 +1,81 @@ +module mo_exp_sol + private + public :: exp_sol + public :: exp_sol_inti +contains + subroutine exp_sol_inti + use mo_tracname, only : solsym + use chem_mods, only : clscnt1, clsmap + use cam_history, only : addfld + implicit none + integer :: i,j + do i = 1,clscnt1 + j = clsmap(i,1) + call addfld( trim(solsym(j))//'_CHMP', (/ 'lev' /), 'I', '/cm3/s', 'chemical production rate' ) + call addfld( trim(solsym(j))//'_CHML', (/ 'lev' /), 'I', '/cm3/s', 'chemical loss rate' ) + enddo + end subroutine exp_sol_inti + subroutine exp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, xhnm, ncol, lchnk, ltrop ) + !----------------------------------------------------------------------- + ! ... Exp_sol advances the volumetric mixing ratio + ! forward one time step via the fully explicit + ! Euler scheme + !----------------------------------------------------------------------- + use chem_mods, only : clscnt1, extcnt, gas_pcnst, clsmap, rxntot + use ppgrid, only : pcols, pver + use mo_prod_loss, only : exp_prod_loss + use mo_indprd, only : indprd + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_history, only : outfld + use mo_tracname, only : solsym + implicit none + !----------------------------------------------------------------------- + ! ... Dummy arguments + !----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunck + integer, intent(in) :: lchnk ! chunk id + real(r8), intent(in) :: delt ! time step (s) + real(r8), intent(in) :: het_rates(ncol,pver,max(1,gas_pcnst)) ! het rates (1/cm^3/s) + real(r8), intent(in) :: reaction_rates(ncol,pver,rxntot) ! rxt rates (1/cm^3/s) + real(r8), intent(in) :: extfrc(ncol,pver,extcnt) ! "external insitu forcing" (1/cm^3/s) + real(r8), intent(in) :: xhnm(ncol,pver) + integer, intent(in) :: ltrop(pcols) ! chemistry troposphere boundary (index) + real(r8), intent(inout) :: base_sol(ncol,pver,gas_pcnst) ! working mixing ratios (vmr) + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: i, k, l, m + integer :: chnkpnts + real(r8), dimension(ncol,pver,max(1,clscnt1)) :: & + prod, & + loss + real(r8), dimension(ncol,pver,clscnt1) :: ind_prd + real(r8), dimension(ncol,pver) :: wrk + chnkpnts = ncol*pver + !----------------------------------------------------------------------- + ! ... Put "independent" production in the forcing + !----------------------------------------------------------------------- + call indprd( 1, ind_prd, clscnt1, base_sol, extfrc, & + reaction_rates, chnkpnts ) + !----------------------------------------------------------------------- + ! ... Form F(y) + !----------------------------------------------------------------------- + call exp_prod_loss( 1, chnkpnts, prod, loss, base_sol, reaction_rates, & + het_rates, chnkpnts ) + !----------------------------------------------------------------------- + ! ... Solve for the mixing ratio at t(n+1) + !----------------------------------------------------------------------- + do m = 1,clscnt1 + l = clsmap(m,1) + do i = 1,ncol + do k = ltrop(i)+1,pver + base_sol(i,k,l) = base_sol(i,k,l) + delt * (prod(i,k,m) + ind_prd(i,k,m) - loss(i,k,m)) + end do + end do + wrk(:,:) = (prod(:,:,m) + ind_prd(:,:,m))*xhnm + call outfld( trim(solsym(l))//'_CHMP', wrk(:,:), ncol, lchnk ) + wrk(:,:) = (loss(:,:,m))*xhnm + call outfld( trim(solsym(l))//'_CHML', wrk(:,:), ncol, lchnk ) + end do + end subroutine exp_sol +end module mo_exp_sol diff --git a/src/chemistry/pp_trop_strat_noaero/mo_imp_sol.F90 b/src/chemistry/pp_trop_strat_noaero/mo_imp_sol.F90 new file mode 100644 index 0000000000..98cadb9050 --- /dev/null +++ b/src/chemistry/pp_trop_strat_noaero/mo_imp_sol.F90 @@ -0,0 +1,435 @@ +module mo_imp_sol + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, gas_pcnst, clsmap, veclen + use cam_logfile, only : iulog + implicit none + private + public :: imp_slv_inti, imp_sol + save + real(r8), parameter :: rel_err = 1.e-3_r8 + real(r8), parameter :: high_rel_err = 1.e-4_r8 + !----------------------------------------------------------------------- + ! Newton-Raphson iteration limits + !----------------------------------------------------------------------- + integer, parameter :: itermax = 11 + integer, parameter :: cut_limit = 5 + real(r8), parameter :: sol_min = 1.e-20_r8 + real(r8), parameter :: small = 1.e-40_r8 + real(r8) :: epsilon(clscnt4) + logical :: factor(itermax) +contains + subroutine imp_slv_inti + !----------------------------------------------------------------------- + ! ... Initialize the implict solver + !----------------------------------------------------------------------- + use mo_chem_utls, only : get_spc_ndx + implicit none + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: m, ox_ndx, o3a_ndx + real(r8) :: eps(gas_pcnst) + factor(:) = .true. + eps(:) = rel_err + ox_ndx = get_spc_ndx( 'OX' ) + if( ox_ndx < 1 ) then + ox_ndx = get_spc_ndx( 'O3' ) + end if + if( ox_ndx > 0 ) then + eps(ox_ndx) = high_rel_err + end if + m = get_spc_ndx( 'NO' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HO2NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'N2O5' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'OH' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + o3a_ndx = get_spc_ndx( 'O3A' ) + if( o3a_ndx > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XHNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XHO2NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO2NO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO2XNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + do m = 1,clscnt4 + epsilon(m) = eps(clsmap(m,4)) + end do + end subroutine imp_slv_inti + subroutine imp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, & + ncol, nlev, lchnk, prod_out, loss_out ) + !----------------------------------------------------------------------- + ! ... imp_sol advances the volumetric mixing ratio + ! forward one time step via the fully implicit euler scheme. + ! this source is meant for vector architectures such as the + ! nec sx6 and cray x1 + !----------------------------------------------------------------------- + use chem_mods, only : rxntot, extcnt, nzcnt, permute, cls_rxt_cnt + use mo_tracname, only : solsym + use mo_lin_matrix, only : linmat + use mo_nln_matrix, only : nlnmat + use mo_lu_factor, only : lu_fac + use mo_lu_solve, only : lu_slv + use mo_prod_loss, only : imp_prod_loss + use mo_indprd, only : indprd + use time_manager, only : get_nstep + use perf_mod, only : t_startf, t_stopf + implicit none + !----------------------------------------------------------------------- + ! ... dummy args + !----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunck + integer, intent(in) :: nlev + integer, intent(in) :: lchnk ! chunk id + real(r8), intent(in) :: delt ! time step (s) + real(r8), intent(in) :: reaction_rates(ncol*nlev,max(1,rxntot)) ! rxt rates (1/cm^3/s) + real(r8), intent(in) :: extfrc(ncol*nlev,max(1,extcnt)) ! external in-situ forcing (1/cm^3/s) + real(r8), intent(in) :: het_rates(ncol*nlev,max(1,gas_pcnst)) ! washout rates (1/s) + real(r8), intent(inout) :: base_sol(ncol*nlev,gas_pcnst) ! species mixing ratios (vmr) + real(r8), intent(out) :: prod_out(ncol*nlev,max(1,clscnt4)) + real(r8), intent(out) :: loss_out(ncol*nlev,max(1,clscnt4)) + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: nr_iter + integer :: ofl + integer :: ofu + integer :: avec_len + integer :: bndx ! base index + integer :: cndx ! class index + integer :: pndx ! permuted class index + integer :: i,m + integer :: fail_cnt(veclen) + integer :: cut_cnt(veclen) + integer :: stp_con_cnt(veclen) + integer :: nstep + real(r8) :: interval_done(veclen) + real(r8) :: dt(veclen) + real(r8) :: dti(veclen) + real(r8) :: max_delta(max(1,clscnt4)) + real(r8) :: ind_prd(ncol*nlev,max(1,clscnt4)) + logical :: convergence + integer :: chnkpnts ! total spatial points in chunk; ncol*ncol + logical :: diags_out(ncol*nlev,max(1,clscnt4)) + real(r8) :: sys_jac_blk(veclen,max(1,nzcnt)) + real(r8) :: lin_jac_blk(veclen,max(1,nzcnt)) + real(r8) :: solution_blk(veclen,max(1,clscnt4)) + real(r8) :: forcing_blk(veclen,max(1,clscnt4)) + real(r8) :: iter_invariant_blk(veclen,max(1,clscnt4)) + real(r8) :: prod_blk(veclen,max(1,clscnt4)) + real(r8) :: loss_blk(veclen,max(1,clscnt4)) + real(r8) :: ind_prd_blk(veclen,max(1,clscnt4)) + real(r8) :: sbase_sol_blk(veclen,gas_pcnst) + real(r8) :: wrk_blk(veclen) + logical :: spc_conv_blk(veclen,max(1,clscnt4)) + logical :: cls_conv_blk(veclen) + logical :: time_stp_done_blk(veclen) + real(r8) :: reaction_rates_blk(veclen,max(1,rxntot)) + real(r8) :: extfrc_blk(veclen,max(1,extcnt)) + real(r8) :: het_rates_blk(veclen,max(1,gas_pcnst)) + real(r8) :: base_sol_blk(veclen,gas_pcnst) + chnkpnts = ncol*nlev + prod_out = 0._r8 + loss_out = 0._r8 + diags_out = .false. + !----------------------------------------------------------------------- + ! ... class independent forcing + !----------------------------------------------------------------------- + if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then + call indprd( 4, ind_prd, clscnt4, base_sol, extfrc, & + reaction_rates, chnkpnts ) + else + do m = 1,clscnt4 + ind_prd(:,m) = 0._r8 + end do + end if + nstep = get_nstep() + ofl = 1 + chnkpnts_loop : do + ofu = min( chnkpnts,ofl + veclen - 1 ) + avec_len = (ofu - ofl) + 1 + reaction_rates_blk(1:avec_len,:) = reaction_rates(ofl:ofu,:) + extfrc_blk(1:avec_len,:) = extfrc(ofl:ofu,:) + het_rates_blk(1:avec_len,:) = het_rates(ofl:ofu,:) + ind_prd_blk(1:avec_len,:) = ind_prd(ofl:ofu,:) + base_sol_blk(1:avec_len,:) = base_sol(ofl:ofu,:) + cls_conv_blk(1:avec_len) = .false. + dt(1:avec_len) = delt + cut_cnt(1:avec_len) = 0 + fail_cnt(1:avec_len) = 0 + stp_con_cnt(1:avec_len) = 0 + interval_done(1:avec_len) = 0._r8 + time_stp_done_blk(1:avec_len) = .false. + !----------------------------------------------------------------------- + ! ... time step loop + !----------------------------------------------------------------------- + time_step_loop : do + dti(1:avec_len) = 1._r8 / dt(1:avec_len) + !----------------------------------------------------------------------- + ! ... transfer from base to class array + !----------------------------------------------------------------------- + do cndx = 1,clscnt4 + bndx = clsmap(cndx,4) + pndx = permute(cndx,4) + do i = 1, avec_len + solution_blk(i,pndx) = base_sol_blk(i,bndx) + end do + end do + do m = 1,gas_pcnst + sbase_sol_blk(1:avec_len,m) = base_sol_blk(1:avec_len,m) + end do + !----------------------------------------------------------------------- + ! ... set the iteration invariant part of the function f(y) + !----------------------------------------------------------------------- + if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then + do m = 1,clscnt4 + do i = 1, avec_len + iter_invariant_blk(i,m) = dti(i) * solution_blk(i,m) + ind_prd_blk(i,m) + end do + end do + else + do m = 1,clscnt4 + do i = 1, avec_len + iter_invariant_blk(i,m) = dti(i) * solution_blk(i,m) + end do + end do + end if + !----------------------------------------------------------------------- + ! ... the linear component + !----------------------------------------------------------------------- + if( cls_rxt_cnt(2,4) > 0 ) then + call t_startf( 'lin_mat' ) + call linmat( avec_len, lin_jac_blk, base_sol_blk, & + reaction_rates_blk, het_rates_blk ) + call t_stopf( 'lin_mat' ) + end if + !======================================================================= + ! the newton-raphson iteration for f(y) = 0 + !======================================================================= + iter_loop : do nr_iter = 1,itermax + !----------------------------------------------------------------------- + ! ... the non-linear component + !----------------------------------------------------------------------- + if( factor(nr_iter) ) then + call t_startf( 'nln_mat' ) + call nlnmat( avec_len, sys_jac_blk, base_sol_blk, & + reaction_rates_blk, lin_jac_blk, dti ) + call t_stopf( 'nln_mat' ) + !----------------------------------------------------------------------- + ! ... factor the "system" matrix + !----------------------------------------------------------------------- + call t_startf( 'lu_fac' ) + call lu_fac( avec_len, sys_jac_blk ) + call t_stopf( 'lu_fac' ) + end if + !----------------------------------------------------------------------- + ! ... form f(y) + !----------------------------------------------------------------------- + call t_startf( 'prod_loss' ) + call imp_prod_loss( avec_len, prod_blk, loss_blk, & + base_sol_blk, reaction_rates_blk, het_rates_blk ) + call t_stopf( 'prod_loss' ) + do m = 1,clscnt4 + do i = 1, avec_len + forcing_blk(i,m) = solution_blk(i,m)*dti(i) & + - (iter_invariant_blk(i,m) + prod_blk(i,m) - loss_blk(i,m)) + end do + end do + !----------------------------------------------------------------------- + ! ... solve for the mixing ratio at t(n+1) + !----------------------------------------------------------------------- + call t_startf( 'lu_slv' ) + call lu_slv( avec_len, sys_jac_blk, forcing_blk ) + call t_stopf( 'lu_slv' ) + do m = 1,clscnt4 + do i = 1, avec_len + if( .not. cls_conv_blk(i) )then + solution_blk(i,m) = solution_blk(i,m) + forcing_blk(i,m) + else + forcing_blk(i,m) = 0._r8 + endif + end do + end do + !----------------------------------------------------------------------- + ! ... convergence measures and test + !----------------------------------------------------------------------- + conv_chk : if( nr_iter > 1 ) then + !----------------------------------------------------------------------- + ! ... check for convergence + !----------------------------------------------------------------------- + do cndx = 1,clscnt4 + pndx = permute(cndx,4) + bndx = clsmap(cndx,4) + do i = 1, avec_len + if ( abs( solution_blk(i,pndx) ) > sol_min ) then + wrk_blk(i) = abs( forcing_blk(i,pndx)/solution_blk(i,pndx) ) + else + wrk_blk(i) = 0._r8 + endif + enddo + max_delta(cndx) = maxval( wrk_blk(1:avec_len) ) + do i = 1, avec_len + solution_blk(i,pndx) = max( 0._r8,solution_blk(i,pndx) ) + base_sol_blk(i,bndx) = solution_blk(i,pndx) + if ( abs( forcing_blk(i,pndx) ) > small ) then + spc_conv_blk(i,cndx) = abs(forcing_blk(i,pndx)) <= epsilon(cndx)*abs(solution_blk(i,pndx)) + else + spc_conv_blk(i,cndx) = .true. + endif + enddo + where( spc_conv_blk(1:avec_len,cndx) .and. .not.diags_out(ofl:ofu,cndx) ) + ! capture output production and loss diagnostics at converged ponits + prod_out(ofl:ofu,cndx) = prod_blk(1:avec_len,cndx) + ind_prd_blk(1:avec_len,cndx) + loss_out(ofl:ofu,cndx) = loss_blk(1:avec_len,cndx) + diags_out(ofl:ofu,cndx) = .true. + endwhere + end do + do i = 1, avec_len + if( .not. cls_conv_blk(i) ) then + cls_conv_blk(i) = all( spc_conv_blk(i,:) ) + end if + end do + convergence = all( cls_conv_blk(:) ) + if( convergence ) then + exit iter_loop + end if + else conv_chk +!----------------------------------------------------------------------- +! ... limit iterate +!----------------------------------------------------------------------- + do m = 1,clscnt4 + do i = 1, avec_len + solution_blk(i,m) = max( 0._r8,solution_blk(i,m) ) + end do + end do +!----------------------------------------------------------------------- +! ... transfer latest solution back to base array +!----------------------------------------------------------------------- + do cndx = 1,clscnt4 + pndx = permute(cndx,4) + bndx = clsmap(cndx,4) + do i = 1, avec_len + base_sol_blk(i,bndx) = solution_blk(i,pndx) + end do + end do + end if conv_chk + end do iter_loop + !----------------------------------------------------------------------- + ! ... check for newton-raphson convergence + !----------------------------------------------------------------------- + do i = 1,avec_len + if( .not. cls_conv_blk(i) ) then + fail_cnt(i) = fail_cnt(i) + 1 + write(iulog,'('' imp_sol: time step '',1p,g15.7,'' failed to converge @ (lchnk,vctrpos,nstep) = '',3i8)') & + dt(i),lchnk,ofl+i-1,nstep + stp_con_cnt(i) = 0 + if( cut_cnt(i) < cut_limit ) then + cut_cnt(i) = cut_cnt(i) + 1 + if( cut_cnt(i) < cut_limit ) then + dt(i) = .5_r8 * dt(i) + else + dt(i) = .1_r8 * dt(i) + end if + base_sol_blk(i,:) = sbase_sol_blk(i,:) + else + write(iulog,'('' imp_sol: step failed to converge @ (lchnk,vctrpos,nstep,dt,time) = '',3i8,1p,2g15.7)') & + lchnk,ofl+i-1,nstep,dt(i),interval_done+dt(i) + do m = 1,clscnt4 + if( .not. spc_conv_blk(i,m) ) then + write(iulog,'(1x,a16,1x,1pe10.3)') solsym(clsmap(m,4)), max_delta(m) + end if + end do + cls_conv_blk(i) = .true. + if( .not. time_stp_done_blk(i) ) then + interval_done(i) = interval_done(i) + dt(i) + time_stp_done_blk(i) = abs( delt - interval_done(i) ) <= .0001_r8 + endif + end if + elseif( .not. time_stp_done_blk(i) ) then + interval_done(i) = interval_done(i) + dt(i) + time_stp_done_blk(i) = abs( delt - interval_done(i) ) <= .0001_r8 + stp_con_cnt(i) = stp_con_cnt(i) + 1 + if( .not. time_stp_done_blk(i) ) then + if( stp_con_cnt(i) >= 2 ) then + dt(i) = 2._r8*dt(i) + stp_con_cnt(i) = 0 + end if + dt(i) = min( dt(i),delt-interval_done(i) ) + else + base_sol(ofl+i-1,1:gas_pcnst) = base_sol_blk(i,1:gas_pcnst) + endif + endif + end do + convergence = all( cls_conv_blk(:) ) + do i = 1,avec_len + if( cls_conv_blk(i) .and. .not. time_stp_done_blk(i) ) then + cls_conv_blk(i) = .false. + endif + end do + if( .not. convergence ) then + cycle time_step_loop + endif + !----------------------------------------------------------------------- + ! ... check for time step done + !----------------------------------------------------------------------- + if( all( time_stp_done_blk(1:avec_len) ) ) then + exit time_step_loop + end if + end do time_step_loop + ofl = ofu + 1 + if( ofl > chnkpnts ) then + exit chnkpnts_loop + end if + end do chnkpnts_loop + end subroutine imp_sol +end module mo_imp_sol diff --git a/src/chemistry/pp_trop_strat_noaero/mo_indprd.F90 b/src/chemistry/pp_trop_strat_noaero/mo_indprd.F90 new file mode 100644 index 0000000000..795b9653b4 --- /dev/null +++ b/src/chemistry/pp_trop_strat_noaero/mo_indprd.F90 @@ -0,0 +1,257 @@ + module mo_indprd + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: indprd + contains + subroutine indprd( class, prod, nprod, y, extfrc, rxt, chnkpnts ) + use chem_mods, only : gas_pcnst, extcnt, rxntot + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: class + integer, intent(in) :: chnkpnts + integer, intent(in) :: nprod + real(r8), intent(in) :: y(chnkpnts,gas_pcnst) + real(r8), intent(in) :: rxt(chnkpnts,rxntot) + real(r8), intent(in) :: extfrc(chnkpnts,extcnt) + real(r8), intent(inout) :: prod(chnkpnts,nprod) +!-------------------------------------------------------------------- +! ... "independent" production for Explicit species +!-------------------------------------------------------------------- + if( class == 1 ) then + prod(:,1) = + extfrc(:,5) + prod(:,2) = 0._r8 + prod(:,3) = 0._r8 + prod(:,4) = 0._r8 + prod(:,5) = 0._r8 + prod(:,6) = 0._r8 + prod(:,7) = 0._r8 + prod(:,8) = 0._r8 + prod(:,9) = 0._r8 + prod(:,10) = 0._r8 + prod(:,11) = 0._r8 + prod(:,12) = 0._r8 + prod(:,13) = 0._r8 + prod(:,14) = 0._r8 + prod(:,15) =.100_r8*rxt(:,298)*y(:,122)*y(:,27) + prod(:,16) = 0._r8 + prod(:,17) = 0._r8 + prod(:,18) = (rxt(:,255)*y(:,60) +rxt(:,257)*y(:,82) +rxt(:,265)*y(:,60) + & + rxt(:,285)*y(:,48) +.500_r8*rxt(:,286)*y(:,49) + & + .800_r8*rxt(:,291)*y(:,69) +rxt(:,292)*y(:,70) + & + .500_r8*rxt(:,341)*y(:,104) +1.800_r8*rxt(:,451)*y(:,151))*y(:,190) & + + (2.000_r8*rxt(:,281)*y(:,170) +.900_r8*rxt(:,282)*y(:,171) + & + rxt(:,284)*y(:,116) +2.000_r8*rxt(:,331)*y(:,184) + & + rxt(:,355)*y(:,178) +rxt(:,380)*y(:,198))*y(:,170) & + + (.200_r8*rxt(:,298)*y(:,27) +.100_r8*rxt(:,342)*y(:,106) + & + .270_r8*rxt(:,430)*y(:,4) +.270_r8*rxt(:,433)*y(:,105))*y(:,122) & + + (rxt(:,332)*y(:,171) +.450_r8*rxt(:,333)*y(:,176) + & + 2.000_r8*rxt(:,334)*y(:,184))*y(:,184) & + + (.500_r8*rxt(:,440)*y(:,171) +.900_r8*rxt(:,442)*y(:,116)) & + *y(:,194) +rxt(:,37)*y(:,49) +.400_r8*rxt(:,60)*y(:,127) +rxt(:,65) & + *y(:,147) +.800_r8*rxt(:,69)*y(:,151) + prod(:,19) = 0._r8 + prod(:,20) = 0._r8 + prod(:,21) = 0._r8 + prod(:,22) = 0._r8 + prod(:,23) = 0._r8 + prod(:,24) =rxt(:,141)*y(:,117)*y(:,107) + prod(:,25) = 0._r8 + prod(:,26) = 0._r8 + prod(:,27) = 0._r8 + prod(:,28) = 0._r8 + prod(:,29) = 0._r8 + prod(:,30) =rxt(:,469)*y(:,190)*y(:,112) +rxt(:,478)*y(:,113) + prod(:,31) = (rxt(:,402)*y(:,172) +rxt(:,405)*y(:,183) +rxt(:,408)*y(:,185) + & + rxt(:,412)*y(:,129))*y(:,117) +.500_r8*rxt(:,341)*y(:,190)*y(:,104) & + +.200_r8*rxt(:,437)*y(:,188)*y(:,116) +.500_r8*rxt(:,449)*y(:,150) & + *y(:,118) +!-------------------------------------------------------------------- +! ... "independent" production for Implicit species +!-------------------------------------------------------------------- + else if( class == 4 ) then + prod(:,101) = 0._r8 + prod(:,100) = 0._r8 + prod(:,124) = 0._r8 + prod(:,26) = 0._r8 + prod(:,70) = 0._r8 + prod(:,27) = 0._r8 + prod(:,71) = 0._r8 + prod(:,76) = 0._r8 + prod(:,51) = 0._r8 + prod(:,97) = 0._r8 + prod(:,59) = 0._r8 + prod(:,39) = 0._r8 + prod(:,61) = 0._r8 + prod(:,154) =rxt(:,79)*y(:,32) +rxt(:,80)*y(:,33) +2.000_r8*rxt(:,86)*y(:,39) & + +rxt(:,87)*y(:,41) +3.000_r8*rxt(:,90)*y(:,53) +2.000_r8*rxt(:,98) & + *y(:,73) + prod(:,42) = 0._r8 + prod(:,160) = 0._r8 + prod(:,86) = 0._r8 + prod(:,40) = 0._r8 + prod(:,58) = 0._r8 + prod(:,50) = 0._r8 + prod(:,90) = 0._r8 + prod(:,43) = 0._r8 + prod(:,53) = 0._r8 + prod(:,49) = 0._r8 + prod(:,129) = 0._r8 + prod(:,69) = 0._r8 + prod(:,19) = 0._r8 + prod(:,44) = 0._r8 + prod(:,161) =.180_r8*rxt(:,40)*y(:,52) + prod(:,134) = 0._r8 + prod(:,16) = 0._r8 + prod(:,127) = 0._r8 + prod(:,146) = 0._r8 + prod(:,88) = 0._r8 + prod(:,84) = 0._r8 + prod(:,113) = 0._r8 + prod(:,67) = 0._r8 + prod(:,169) =4.000_r8*rxt(:,78)*y(:,31) +rxt(:,79)*y(:,32) & + +2.000_r8*rxt(:,81)*y(:,34) +2.000_r8*rxt(:,82)*y(:,35) & + +2.000_r8*rxt(:,83)*y(:,36) +rxt(:,84)*y(:,37) +2.000_r8*rxt(:,85) & + *y(:,38) +3.000_r8*rxt(:,88)*y(:,42) +rxt(:,89)*y(:,44) +rxt(:,100) & + *y(:,77) +rxt(:,101)*y(:,78) +rxt(:,102)*y(:,79) + prod(:,25) = 0._r8 + prod(:,17) = 0._r8 + prod(:,164) = 0._r8 + prod(:,128) = 0._r8 + prod(:,135) =.380_r8*rxt(:,40)*y(:,52) +rxt(:,41)*y(:,61) + extfrc(:,1) + prod(:,20) =rxt(:,79)*y(:,32) +rxt(:,80)*y(:,33) +rxt(:,82)*y(:,35) & + +2.000_r8*rxt(:,83)*y(:,36) +2.000_r8*rxt(:,84)*y(:,37) +rxt(:,85) & + *y(:,38) +2.000_r8*rxt(:,98)*y(:,73) +rxt(:,101)*y(:,78) +rxt(:,102) & + *y(:,79) + prod(:,29) =rxt(:,81)*y(:,34) +rxt(:,82)*y(:,35) +rxt(:,100)*y(:,77) + prod(:,32) = 0._r8 + prod(:,47) = 0._r8 + prod(:,21) = 0._r8 + prod(:,111) =rxt(:,80)*y(:,33) +rxt(:,84)*y(:,37) + prod(:,131) = 0._r8 + prod(:,122) = 0._r8 + prod(:,156) = (rxt(:,39) +.330_r8*rxt(:,40))*y(:,52) + prod(:,143) =1.440_r8*rxt(:,40)*y(:,52) + prod(:,93) = 0._r8 + prod(:,22) = 0._r8 + prod(:,118) = 0._r8 + prod(:,168) = 0._r8 + prod(:,30) = 0._r8 + prod(:,115) = 0._r8 + prod(:,37) = 0._r8 + prod(:,155) = 0._r8 + prod(:,62) = 0._r8 + prod(:,112) = 0._r8 + prod(:,116) = 0._r8 + prod(:,136) = 0._r8 + prod(:,38) = 0._r8 + prod(:,137) = 0._r8 + prod(:,52) = 0._r8 + prod(:,23) = 0._r8 + prod(:,119) = 0._r8 + prod(:,94) = 0._r8 + prod(:,89) = 0._r8 + prod(:,144) = 0._r8 + prod(:,63) = 0._r8 + prod(:,107) = 0._r8 + prod(:,12) = 0._r8 + prod(:,145) = 0._r8 + prod(:,54) = 0._r8 + prod(:,83) = 0._r8 + prod(:,55) = 0._r8 + prod(:,92) = 0._r8 + prod(:,125) = 0._r8 + prod(:,149) = 0._r8 + prod(:,64) = + extfrc(:,6) + prod(:,48) = 0._r8 + prod(:,65) = 0._r8 + prod(:,132) = 0._r8 + prod(:,18) = 0._r8 + prod(:,1) = 0._r8 + prod(:,165) = + extfrc(:,2) + prod(:,167) = + extfrc(:,3) + prod(:,170) = 0._r8 + prod(:,121) = 0._r8 + prod(:,66) = 0._r8 + prod(:,162) =.180_r8*rxt(:,40)*y(:,52) +rxt(:,41)*y(:,61) + (rxt(:,5) + & + 2.000_r8*rxt(:,6)) + prod(:,166) = 0._r8 + prod(:,56) = 0._r8 + prod(:,60) = 0._r8 + prod(:,41) = 0._r8 + prod(:,77) = 0._r8 + prod(:,24) = 0._r8 + prod(:,78) = 0._r8 + prod(:,28) = 0._r8 + prod(:,57) = 0._r8 + prod(:,87) = 0._r8 + prod(:,68) = 0._r8 + prod(:,82) = 0._r8 + prod(:,147) = 0._r8 + prod(:,120) = + extfrc(:,4) + prod(:,45) = 0._r8 + prod(:,2) = 0._r8 + prod(:,3) = 0._r8 + prod(:,4) = 0._r8 + prod(:,5) = 0._r8 + prod(:,6) = 0._r8 + prod(:,7) = 0._r8 + prod(:,33) = 0._r8 + prod(:,95) = 0._r8 + prod(:,98) = 0._r8 + prod(:,79) = 0._r8 + prod(:,130) = 0._r8 + prod(:,133) = 0._r8 + prod(:,96) = 0._r8 + prod(:,31) = 0._r8 + prod(:,34) = 0._r8 + prod(:,35) = 0._r8 + prod(:,103) = 0._r8 + prod(:,36) = 0._r8 + prod(:,72) = 0._r8 + prod(:,85) = 0._r8 + prod(:,126) = 0._r8 + prod(:,8) = 0._r8 + prod(:,80) = 0._r8 + prod(:,9) = 0._r8 + prod(:,73) = 0._r8 + prod(:,117) = 0._r8 + prod(:,114) = 0._r8 + prod(:,99) = 0._r8 + prod(:,153) = 0._r8 + prod(:,157) =rxt(:,87)*y(:,41) +rxt(:,89)*y(:,44) +rxt(:,39)*y(:,52) + prod(:,109) = 0._r8 + prod(:,91) = 0._r8 + prod(:,46) = 0._r8 + prod(:,104) = 0._r8 + prod(:,163) = 0._r8 + prod(:,74) = 0._r8 + prod(:,151) = 0._r8 + prod(:,148) = 0._r8 + prod(:,10) = 0._r8 + prod(:,11) = 0._r8 + prod(:,150) = 0._r8 + prod(:,105) = 0._r8 + prod(:,152) = 0._r8 + prod(:,123) = 0._r8 + prod(:,102) = 0._r8 + prod(:,13) = 0._r8 + prod(:,140) = 0._r8 + prod(:,158) =rxt(:,12)*y(:,108) +rxt(:,5) + prod(:,159) =.330_r8*rxt(:,40)*y(:,52) + prod(:,75) = 0._r8 + prod(:,110) = 0._r8 + prod(:,141) = 0._r8 + prod(:,139) = 0._r8 + prod(:,138) = 0._r8 + prod(:,106) = 0._r8 + prod(:,14) = 0._r8 + prod(:,142) = 0._r8 + prod(:,108) = 0._r8 + prod(:,15) = 0._r8 + prod(:,81) = 0._r8 + prod(:,171) =.050_r8*rxt(:,40)*y(:,52) + end if + end subroutine indprd + end module mo_indprd diff --git a/src/chemistry/pp_trop_strat_noaero/mo_lin_matrix.F90 b/src/chemistry/pp_trop_strat_noaero/mo_lin_matrix.F90 new file mode 100644 index 0000000000..76344bb631 --- /dev/null +++ b/src/chemistry/pp_trop_strat_noaero/mo_lin_matrix.F90 @@ -0,0 +1,598 @@ + module mo_lin_matrix + use chem_mods, only: veclen + private + public :: linmat + contains + subroutine linmat01( avec_len, mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(in) :: het_rates(veclen,gas_pcnst) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k + do k = 1,avec_len + mat(k,532) = -( rxt(k,19) + het_rates(k,1) ) + mat(k,521) = -( rxt(k,20) + het_rates(k,2) ) + mat(k,759) = -( het_rates(k,4) ) + mat(k,88) = -( het_rates(k,5) ) + mat(k,313) = -( rxt(k,21) + het_rates(k,6) ) + mat(k,94) = -( rxt(k,22) + het_rates(k,7) ) + mat(k,319) = -( rxt(k,23) + het_rates(k,8) ) + mat(k,352) = -( rxt(k,24) + het_rates(k,9) ) + mat(k,314) = .500_r8*rxt(k,21) + mat(k,95) = rxt(k,22) + mat(k,492) = .200_r8*rxt(k,70) + mat(k,552) = .060_r8*rxt(k,72) + mat(k,207) = -( rxt(k,25) + het_rates(k,10) ) + mat(k,491) = .200_r8*rxt(k,70) + mat(k,550) = .200_r8*rxt(k,72) + mat(k,502) = -( rxt(k,26) + het_rates(k,11) ) + mat(k,150) = rxt(k,46) + mat(k,869) = rxt(k,56) + mat(k,494) = .200_r8*rxt(k,70) + mat(k,553) = .150_r8*rxt(k,72) + mat(k,244) = -( rxt(k,27) + het_rates(k,12) ) + mat(k,551) = .210_r8*rxt(k,72) + mat(k,154) = -( het_rates(k,13) ) + mat(k,257) = -( het_rates(k,14) ) + mat(k,1247) = -( het_rates(k,15) ) + mat(k,164) = rxt(k,74) + mat(k,1518) = rxt(k,75) + mat(k,416) = rxt(k,77) + mat(k,695) = rxt(k,99) + mat(k,649) = rxt(k,105) + mat(k,1340) = rxt(k,190)*y(k,32) + rxt(k,216)*y(k,33) & + + 3.000_r8*rxt(k,217)*y(k,53) + 2.000_r8*rxt(k,218)*y(k,73) & + + 2.000_r8*rxt(k,239)*y(k,39) + rxt(k,240)*y(k,41) + mat(k,1951) = 2.000_r8*rxt(k,227)*y(k,39) + rxt(k,229)*y(k,41) & + + 3.000_r8*rxt(k,234)*y(k,53) + mat(k,1494) = 2.000_r8*rxt(k,228)*y(k,39) + rxt(k,230)*y(k,41) & + + 3.000_r8*rxt(k,235)*y(k,53) + mat(k,163) = -( rxt(k,74) + het_rates(k,16) ) + mat(k,1524) = -( rxt(k,75) + het_rates(k,17) ) + mat(k,418) = rxt(k,76) + mat(k,414) = -( rxt(k,76) + rxt(k,77) + rxt(k,514) + rxt(k,517) + rxt(k,522) & + + het_rates(k,18) ) + mat(k,157) = -( het_rates(k,20) ) + mat(k,238) = rxt(k,28) + mat(k,239) = -( rxt(k,28) + het_rates(k,21) ) + mat(k,201) = -( het_rates(k,22) ) + mat(k,442) = -( het_rates(k,23) ) + mat(k,166) = -( het_rates(k,24) ) + mat(k,213) = -( rxt(k,29) + het_rates(k,25) ) + mat(k,195) = -( het_rates(k,26) ) + mat(k,840) = -( het_rates(k,27) ) + mat(k,1130) = .700_r8*rxt(k,55) + mat(k,307) = -( rxt(k,30) + het_rates(k,28) ) + mat(k,66) = -( het_rates(k,29) ) + mat(k,170) = -( rxt(k,31) + het_rates(k,30) ) + mat(k,1548) = -( rxt(k,32) + rxt(k,33) + het_rates(k,40) ) + mat(k,539) = .100_r8*rxt(k,19) + mat(k,529) = .100_r8*rxt(k,20) + mat(k,299) = rxt(k,38) + mat(k,867) = rxt(k,43) + mat(k,920) = .330_r8*rxt(k,45) + mat(k,929) = rxt(k,47) + mat(k,601) = .690_r8*rxt(k,49) + mat(k,1067) = 1.340_r8*rxt(k,50) + mat(k,733) = rxt(k,57) + mat(k,427) = rxt(k,62) + mat(k,305) = rxt(k,63) + mat(k,489) = .375_r8*rxt(k,65) + mat(k,371) = .400_r8*rxt(k,67) + mat(k,891) = .680_r8*rxt(k,69) + mat(k,341) = rxt(k,259) + mat(k,181) = 2.000_r8*rxt(k,289) + mat(k,1347) = rxt(k,262)*y(k,52) + rxt(k,263)*y(k,52) + mat(k,894) = -( rxt(k,34) + het_rates(k,43) ) + mat(k,536) = .400_r8*rxt(k,19) + mat(k,526) = .400_r8*rxt(k,20) + mat(k,215) = rxt(k,29) + mat(k,910) = .330_r8*rxt(k,45) + mat(k,225) = rxt(k,53) + mat(k,424) = rxt(k,62) + mat(k,57) = -( het_rates(k,45) ) + mat(k,818) = -( rxt(k,35) + het_rates(k,46) ) + mat(k,535) = .250_r8*rxt(k,19) + mat(k,525) = .250_r8*rxt(k,20) + mat(k,309) = .820_r8*rxt(k,30) + mat(k,908) = .170_r8*rxt(k,45) + mat(k,483) = .300_r8*rxt(k,65) + mat(k,367) = .050_r8*rxt(k,67) + mat(k,884) = .500_r8*rxt(k,69) + mat(k,1072) = -( rxt(k,36) + het_rates(k,47) ) + mat(k,322) = .180_r8*rxt(k,23) + mat(k,246) = rxt(k,27) + mat(k,499) = .400_r8*rxt(k,70) + mat(k,561) = .540_r8*rxt(k,72) + mat(k,328) = .510_r8*rxt(k,73) + mat(k,430) = -( het_rates(k,48) ) + mat(k,401) = -( rxt(k,37) + het_rates(k,49) ) + mat(k,656) = -( het_rates(k,50) ) + mat(k,295) = -( rxt(k,38) + het_rates(k,51) ) + mat(k,1966) = -( rxt(k,165)*y(k,52) + rxt(k,227)*y(k,39) + rxt(k,229)*y(k,41) & + + rxt(k,232)*y(k,44) + rxt(k,234)*y(k,53) + het_rates(k,54) ) + mat(k,165) = rxt(k,74) + mat(k,86) = 2.000_r8*rxt(k,91) + mat(k,62) = 2.000_r8*rxt(k,92) + mat(k,1718) = rxt(k,93) + mat(k,833) = rxt(k,94) + mat(k,106) = rxt(k,97) + mat(k,1932) = rxt(k,103) + mat(k,681) = rxt(k,106) + mat(k,1355) = 4.000_r8*rxt(k,189)*y(k,31) + rxt(k,190)*y(k,32) & + + 2.000_r8*rxt(k,191)*y(k,34) + 2.000_r8*rxt(k,192)*y(k,35) & + + 2.000_r8*rxt(k,193)*y(k,36) + rxt(k,194)*y(k,37) & + + 2.000_r8*rxt(k,195)*y(k,38) + rxt(k,241)*y(k,77) & + + rxt(k,242)*y(k,78) + rxt(k,243)*y(k,79) + mat(k,1509) = 3.000_r8*rxt(k,231)*y(k,42) + rxt(k,233)*y(k,44) & + + rxt(k,236)*y(k,77) + rxt(k,237)*y(k,78) + rxt(k,238)*y(k,79) + mat(k,85) = -( rxt(k,91) + het_rates(k,55) ) + mat(k,60) = -( rxt(k,92) + rxt(k,199) + het_rates(k,56) ) + mat(k,1713) = -( rxt(k,93) + het_rates(k,57) ) + mat(k,830) = rxt(k,95) + mat(k,232) = rxt(k,107) + mat(k,61) = 2.000_r8*rxt(k,199) + mat(k,826) = -( rxt(k,94) + rxt(k,95) + rxt(k,516) + rxt(k,521) + rxt(k,527) & + + het_rates(k,58) ) + mat(k,903) = -( het_rates(k,60) ) + mat(k,96) = 1.500_r8*rxt(k,22) + mat(k,321) = .450_r8*rxt(k,23) + mat(k,504) = .600_r8*rxt(k,26) + mat(k,245) = rxt(k,27) + mat(k,1539) = rxt(k,32) + rxt(k,33) + mat(k,895) = rxt(k,34) + mat(k,1071) = rxt(k,36) + mat(k,865) = rxt(k,43) + mat(k,737) = 2.000_r8*rxt(k,44) + mat(k,911) = .330_r8*rxt(k,45) + mat(k,1059) = 1.340_r8*rxt(k,51) + mat(k,1132) = .700_r8*rxt(k,55) + mat(k,125) = 1.500_r8*rxt(k,64) + mat(k,486) = .250_r8*rxt(k,65) + mat(k,857) = rxt(k,68) + mat(k,886) = 1.700_r8*rxt(k,69) + mat(k,252) = rxt(k,110) + mat(k,1948) = rxt(k,232)*y(k,44) + mat(k,70) = -( rxt(k,96) + het_rates(k,62) ) + mat(k,1334) = rxt(k,190)*y(k,32) + rxt(k,192)*y(k,35) & + + 2.000_r8*rxt(k,193)*y(k,36) + 2.000_r8*rxt(k,194)*y(k,37) & + + rxt(k,195)*y(k,38) + rxt(k,216)*y(k,33) & + + 2.000_r8*rxt(k,218)*y(k,73) + rxt(k,242)*y(k,78) & + + rxt(k,243)*y(k,79) + mat(k,1375) = rxt(k,237)*y(k,78) + rxt(k,238)*y(k,79) + mat(k,103) = -( rxt(k,97) + het_rates(k,63) ) + mat(k,1335) = rxt(k,191)*y(k,34) + rxt(k,192)*y(k,35) + rxt(k,241)*y(k,77) + mat(k,1380) = rxt(k,236)*y(k,77) + mat(k,119) = -( het_rates(k,64) ) + mat(k,183) = -( het_rates(k,65) ) + mat(k,73) = -( rxt(k,42) + het_rates(k,67) ) + mat(k,639) = -( rxt(k,221)*y(k,52) + het_rates(k,68) ) + mat(k,71) = 2.000_r8*rxt(k,96) + mat(k,104) = rxt(k,97) + mat(k,147) = rxt(k,104) + mat(k,1337) = rxt(k,194)*y(k,37) + rxt(k,216)*y(k,33) + mat(k,864) = -( rxt(k,43) + het_rates(k,69) ) + mat(k,909) = .330_r8*rxt(k,45) + mat(k,484) = .250_r8*rxt(k,65) + mat(k,180) = rxt(k,290) + mat(k,736) = -( rxt(k,44) + rxt(k,470) + het_rates(k,70) ) + mat(k,316) = rxt(k,21) + mat(k,320) = .130_r8*rxt(k,23) + mat(k,235) = .700_r8*rxt(k,61) + mat(k,498) = .600_r8*rxt(k,70) + mat(k,558) = .340_r8*rxt(k,72) + mat(k,327) = .170_r8*rxt(k,73) + mat(k,1273) = -( rxt(k,127) + het_rates(k,71) ) + mat(k,2035) = rxt(k,2) + 2.000_r8*rxt(k,3) + mat(k,1543) = 2.000_r8*rxt(k,32) + mat(k,296) = rxt(k,38) + mat(k,696) = rxt(k,99) + mat(k,1919) = rxt(k,103) + mat(k,148) = rxt(k,104) + mat(k,1342) = rxt(k,262)*y(k,52) + mat(k,1024) = -( het_rates(k,72) ) + mat(k,2031) = rxt(k,1) + mat(k,1540) = rxt(k,33) + mat(k,1339) = rxt(k,263)*y(k,52) + mat(k,466) = -( rxt(k,4) + het_rates(k,74) ) + mat(k,76) = -( rxt(k,109) + het_rates(k,75) ) + mat(k,694) = -( rxt(k,99) + het_rates(k,76) ) + mat(k,1931) = -( rxt(k,103) + het_rates(k,80) ) + mat(k,1965) = rxt(k,165)*y(k,52) + rxt(k,227)*y(k,39) + rxt(k,229)*y(k,41) & + + 2.000_r8*rxt(k,232)*y(k,44) + rxt(k,234)*y(k,53) + mat(k,107) = -( het_rates(k,81) ) + mat(k,671) = -( het_rates(k,82) ) + mat(k,146) = -( rxt(k,104) + het_rates(k,83) ) + mat(k,638) = rxt(k,221)*y(k,52) + mat(k,1260) = -( rxt(k,9) + het_rates(k,84) ) + mat(k,916) = rxt(k,472) + mat(k,477) = rxt(k,473) + mat(k,439) = rxt(k,474) + mat(k,190) = 2.000_r8*rxt(k,475) + 2.000_r8*rxt(k,512) + 2.000_r8*rxt(k,515) & + + 2.000_r8*rxt(k,526) + mat(k,286) = rxt(k,476) + mat(k,877) = rxt(k,477) + mat(k,1895) = .500_r8*rxt(k,479) + mat(k,2009) = rxt(k,480) + mat(k,292) = rxt(k,481) + mat(k,161) = rxt(k,482) + mat(k,508) = rxt(k,483) + mat(k,417) = rxt(k,514) + rxt(k,517) + rxt(k,522) + mat(k,827) = rxt(k,516) + rxt(k,521) + rxt(k,527) + end do + end subroutine linmat01 + subroutine linmat02( avec_len, mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(in) :: het_rates(veclen,gas_pcnst) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k + do k = 1,avec_len + mat(k,265) = -( rxt(k,10) + rxt(k,11) + rxt(k,162) + het_rates(k,85) ) + mat(k,648) = -( rxt(k,105) + het_rates(k,86) ) + mat(k,415) = rxt(k,514) + rxt(k,517) + rxt(k,522) + mat(k,676) = -( rxt(k,106) + het_rates(k,87) ) + mat(k,825) = rxt(k,516) + rxt(k,521) + rxt(k,527) + mat(k,912) = -( rxt(k,45) + rxt(k,472) + het_rates(k,88) ) + mat(k,149) = -( rxt(k,46) + het_rates(k,89) ) + mat(k,1096) = rxt(k,363) + mat(k,925) = -( rxt(k,47) + het_rates(k,90) ) + mat(k,913) = .170_r8*rxt(k,45) + mat(k,210) = -( het_rates(k,91) ) + mat(k,79) = -( het_rates(k,92) ) + mat(k,706) = -( het_rates(k,93) ) + mat(k,473) = -( rxt(k,473) + het_rates(k,94) ) + mat(k,434) = -( rxt(k,474) + het_rates(k,95) ) + mat(k,1044) = -( het_rates(k,96) ) + mat(k,271) = -( rxt(k,48) + het_rates(k,97) ) + mat(k,596) = -( rxt(k,49) + het_rates(k,98) ) + mat(k,272) = rxt(k,48) + mat(k,38) = -( het_rates(k,99) ) + mat(k,1060) = -( rxt(k,50) + rxt(k,51) + het_rates(k,100) ) + mat(k,598) = .288_r8*rxt(k,49) + mat(k,218) = -( het_rates(k,101) ) + mat(k,396) = -( rxt(k,52) + het_rates(k,102) ) + mat(k,531) = .800_r8*rxt(k,19) + mat(k,520) = .800_r8*rxt(k,20) + mat(k,223) = -( rxt(k,53) + het_rates(k,103) ) + mat(k,458) = -( rxt(k,54) + rxt(k,345) + het_rates(k,104) ) + mat(k,786) = -( het_rates(k,105) ) + mat(k,1135) = -( rxt(k,55) + het_rates(k,106) ) + mat(k,599) = .402_r8*rxt(k,49) + mat(k,277) = -( rxt(k,144) + het_rates(k,107) ) + mat(k,1739) = rxt(k,15) + mat(k,189) = -( rxt(k,13) + rxt(k,14) + rxt(k,163) + rxt(k,475) + rxt(k,512) & + + rxt(k,515) + rxt(k,526) + het_rates(k,109) ) + mat(k,283) = -( rxt(k,476) + het_rates(k,110) ) + mat(k,873) = -( rxt(k,56) + rxt(k,477) + het_rates(k,111) ) + mat(k,63) = -( het_rates(k,112) ) + mat(k,1) = -( rxt(k,478) + het_rates(k,113) ) + mat(k,1804) = -( rxt(k,15) + het_rates(k,116) ) + mat(k,192) = rxt(k,14) + mat(k,1905) = rxt(k,16) + .500_r8*rxt(k,479) + mat(k,2019) = rxt(k,17) + mat(k,281) = rxt(k,144) + mat(k,1351) = 2.000_r8*rxt(k,156)*y(k,108) + mat(k,1907) = -( rxt(k,16) + rxt(k,479) + het_rates(k,117) ) + mat(k,1266) = rxt(k,9) + mat(k,268) = rxt(k,11) + rxt(k,162) + mat(k,193) = rxt(k,13) + rxt(k,163) + mat(k,2021) = rxt(k,18) + mat(k,541) = rxt(k,19) + mat(k,922) = rxt(k,45) + mat(k,276) = rxt(k,48) + mat(k,464) = rxt(k,54) + rxt(k,345) + mat(k,883) = rxt(k,56) + mat(k,734) = rxt(k,57) + mat(k,294) = rxt(k,58) + mat(k,162) = rxt(k,59) + mat(k,360) = .600_r8*rxt(k,60) + rxt(k,296) + mat(k,511) = rxt(k,66) + mat(k,420) = rxt(k,76) + mat(k,831) = rxt(k,95) + mat(k,84) = rxt(k,420) + mat(k,2024) = -( rxt(k,17) + rxt(k,18) + rxt(k,480) + het_rates(k,118) ) + mat(k,269) = rxt(k,10) + mat(k,194) = rxt(k,13) + rxt(k,14) + rxt(k,163) + mat(k,361) = .400_r8*rxt(k,60) + mat(k,421) = rxt(k,77) + mat(k,834) = rxt(k,94) + mat(k,729) = -( rxt(k,57) + het_rates(k,119) ) + mat(k,289) = -( rxt(k,58) + rxt(k,481) + het_rates(k,120) ) + mat(k,1579) = -( rxt(k,121) + het_rates(k,121) ) + mat(k,2041) = rxt(k,3) + mat(k,1861) = rxt(k,8) + mat(k,191) = rxt(k,14) + mat(k,1801) = rxt(k,15) + mat(k,1902) = rxt(k,16) + mat(k,2016) = rxt(k,18) + mat(k,1526) = rxt(k,75) + mat(k,1711) = rxt(k,93) + mat(k,231) = rxt(k,107) + mat(k,1088) = rxt(k,111) + rxt(k,462) + mat(k,726) = rxt(k,112) + mat(k,177) = rxt(k,113) + mat(k,1348) = rxt(k,116) + rxt(k,117) + mat(k,280) = rxt(k,144) + mat(k,394) = rxt(k,456) + mat(k,1865) = -( rxt(k,7) + rxt(k,8) + het_rates(k,122) ) + mat(k,1583) = rxt(k,121) + mat(k,228) = -( rxt(k,107) + het_rates(k,124) ) + mat(k,249) = -( rxt(k,110) + het_rates(k,125) ) + mat(k,160) = -( rxt(k,59) + rxt(k,482) + het_rates(k,126) ) + mat(k,355) = -( rxt(k,60) + rxt(k,296) + het_rates(k,127) ) + mat(k,82) = -( rxt(k,420) + het_rates(k,128) ) + mat(k,362) = -( het_rates(k,129) ) + mat(k,171) = rxt(k,31) + mat(k,98) = -( het_rates(k,130) ) + mat(k,233) = -( rxt(k,61) + het_rates(k,131) ) + mat(k,422) = -( rxt(k,62) + het_rates(k,132) ) + mat(k,301) = -( rxt(k,63) + het_rates(k,133) ) + mat(k,390) = -( rxt(k,456) + het_rates(k,134) ) + mat(k,250) = rxt(k,110) + mat(k,1081) = rxt(k,111) + mat(k,1083) = -( rxt(k,111) + rxt(k,462) + het_rates(k,136) ) + mat(k,724) = rxt(k,112) + mat(k,391) = rxt(k,456) + mat(k,723) = -( rxt(k,112) + het_rates(k,137) ) + mat(k,176) = rxt(k,113) + mat(k,1082) = rxt(k,462) + mat(k,175) = -( rxt(k,113) + het_rates(k,138) ) + mat(k,77) = rxt(k,109) + mat(k,2) = -( het_rates(k,139) ) + mat(k,735) = rxt(k,470) + mat(k,3) = -( het_rates(k,140) ) + mat(k,4) = -( het_rates(k,141) ) + mat(k,5) = -( het_rates(k,142) ) + mat(k,6) = -( het_rates(k,143) ) + mat(k,12) = -( het_rates(k,145) ) + mat(k,124) = -( rxt(k,64) + het_rates(k,146) ) + mat(k,482) = -( rxt(k,65) + het_rates(k,147) ) + mat(k,506) = -( rxt(k,66) + rxt(k,483) + het_rates(k,148) ) + mat(k,366) = -( rxt(k,67) + het_rates(k,149) ) + mat(k,855) = -( rxt(k,68) + het_rates(k,150) ) + mat(k,290) = rxt(k,58) + mat(k,507) = rxt(k,66) + mat(k,368) = rxt(k,67) + mat(k,885) = -( rxt(k,69) + het_rates(k,151) ) + mat(k,485) = rxt(k,65) + mat(k,856) = rxt(k,68) + mat(k,493) = -( rxt(k,70) + het_rates(k,152) ) + mat(k,112) = -( het_rates(k,153) ) + mat(k,128) = -( rxt(k,71) + het_rates(k,154) ) + mat(k,133) = -( het_rates(k,155) ) + mat(k,554) = -( rxt(k,72) + het_rates(k,156) ) + mat(k,141) = -( het_rates(k,157) ) + mat(k,325) = -( rxt(k,73) + het_rates(k,158) ) + mat(k,408) = -( het_rates(k,161) ) + mat(k,83) = rxt(k,420) + mat(k,808) = -( het_rates(k,162) ) + mat(k,18) = -( het_rates(k,163) ) + mat(k,375) = -( het_rates(k,164) ) + mat(k,24) = -( het_rates(k,165) ) + mat(k,333) = -( het_rates(k,166) ) + mat(k,686) = -( het_rates(k,167) ) + mat(k,398) = rxt(k,52) + mat(k,661) = -( het_rates(k,168) ) + mat(k,514) = -( het_rates(k,169) ) + mat(k,1233) = -( het_rates(k,170) ) + mat(k,323) = .130_r8*rxt(k,23) + mat(k,247) = rxt(k,27) + mat(k,820) = rxt(k,35) + mat(k,1073) = rxt(k,36) + mat(k,915) = .330_r8*rxt(k,45) + mat(k,927) = rxt(k,47) + mat(k,1064) = 1.340_r8*rxt(k,50) + mat(k,399) = rxt(k,52) + mat(k,226) = rxt(k,53) + mat(k,1137) = .300_r8*rxt(k,55) + mat(k,731) = rxt(k,57) + mat(k,356) = .600_r8*rxt(k,60) + rxt(k,296) + mat(k,303) = rxt(k,63) + mat(k,126) = .500_r8*rxt(k,64) + mat(k,888) = .650_r8*rxt(k,69) + mat(k,1320) = -( het_rates(k,171) ) + mat(k,898) = rxt(k,34) + mat(k,821) = rxt(k,35) + mat(k,403) = rxt(k,37) + mat(k,1140) = .300_r8*rxt(k,55) + mat(k,357) = .400_r8*rxt(k,60) + mat(k,1954) = rxt(k,165)*y(k,52) + mat(k,643) = rxt(k,221)*y(k,52) + mat(k,1497) = rxt(k,254)*y(k,52) + mat(k,1343) = rxt(k,261)*y(k,52) + mat(k,620) = -( het_rates(k,172) ) + mat(k,208) = .600_r8*rxt(k,25) + mat(k,450) = -( het_rates(k,173) ) + mat(k,179) = -( rxt(k,289) + rxt(k,290) + het_rates(k,174) ) + mat(k,74) = rxt(k,42) + mat(k,567) = -( het_rates(k,175) ) + mat(k,1686) = -( rxt(k,471) + het_rates(k,176) ) + mat(k,267) = rxt(k,11) + rxt(k,162) + mat(k,540) = rxt(k,19) + mat(k,530) = .900_r8*rxt(k,20) + mat(k,318) = rxt(k,21) + mat(k,97) = 1.500_r8*rxt(k,22) + mat(k,324) = .560_r8*rxt(k,23) + mat(k,354) = rxt(k,24) + mat(k,209) = .600_r8*rxt(k,25) + mat(k,505) = .600_r8*rxt(k,26) + mat(k,248) = rxt(k,27) + mat(k,243) = rxt(k,28) + mat(k,217) = rxt(k,29) + mat(k,311) = rxt(k,30) + mat(k,900) = rxt(k,34) + mat(k,1077) = rxt(k,36) + mat(k,868) = 2.000_r8*rxt(k,43) + mat(k,739) = 2.000_r8*rxt(k,44) + mat(k,921) = .670_r8*rxt(k,45) + mat(k,153) = rxt(k,46) + mat(k,930) = rxt(k,47) + mat(k,275) = rxt(k,48) + mat(k,602) = rxt(k,49) + mat(k,1068) = 1.340_r8*rxt(k,50) + .660_r8*rxt(k,51) + mat(k,881) = rxt(k,56) + mat(k,237) = rxt(k,61) + mat(k,428) = rxt(k,62) + mat(k,127) = rxt(k,64) + mat(k,490) = rxt(k,65) + mat(k,510) = rxt(k,66) + mat(k,372) = rxt(k,67) + mat(k,861) = rxt(k,68) + mat(k,892) = 1.200_r8*rxt(k,69) + mat(k,501) = rxt(k,70) + mat(k,564) = rxt(k,72) + mat(k,330) = rxt(k,73) + mat(k,1278) = rxt(k,127) + mat(k,342) = rxt(k,259) + mat(k,182) = rxt(k,289) + rxt(k,290) + mat(k,1123) = rxt(k,363) + mat(k,1960) = rxt(k,229)*y(k,41) + rxt(k,232)*y(k,44) + mat(k,1503) = rxt(k,230)*y(k,41) + rxt(k,233)*y(k,44) + mat(k,1349) = rxt(k,262)*y(k,52) + end do + end subroutine linmat02 + subroutine linmat03( avec_len, mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(in) :: het_rates(veclen,gas_pcnst) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k + do k = 1,avec_len + mat(k,339) = -( rxt(k,259) + het_rates(k,177) ) + mat(k,1183) = -( het_rates(k,178) ) + mat(k,1113) = -( rxt(k,363) + het_rates(k,179) ) + mat(k,30) = -( het_rates(k,180) ) + mat(k,36) = -( het_rates(k,181) ) + mat(k,1157) = -( het_rates(k,182) ) + mat(k,574) = -( het_rates(k,183) ) + mat(k,353) = .600_r8*rxt(k,24) + mat(k,1202) = -( het_rates(k,184) ) + mat(k,1063) = .660_r8*rxt(k,50) + mat(k,460) = rxt(k,54) + rxt(k,345) + mat(k,741) = -( het_rates(k,185) ) + mat(k,503) = .600_r8*rxt(k,26) + mat(k,543) = -( het_rates(k,186) ) + mat(k,44) = -( het_rates(k,187) ) + mat(k,979) = -( het_rates(k,188) ) + mat(k,1344) = -( rxt(k,116) + rxt(k,117) + rxt(k,156)*y(k,108) & + + rxt(k,157)*y(k,108) + rxt(k,189)*y(k,31) + rxt(k,190)*y(k,32) & + + rxt(k,191)*y(k,34) + rxt(k,192)*y(k,35) + rxt(k,193)*y(k,36) & + + rxt(k,194)*y(k,37) + rxt(k,195)*y(k,38) + rxt(k,216)*y(k,33) & + + rxt(k,217)*y(k,53) + rxt(k,218)*y(k,73) + rxt(k,239)*y(k,39) & + + rxt(k,240)*y(k,41) + rxt(k,241)*y(k,77) + rxt(k,242)*y(k,78) & + + rxt(k,243)*y(k,79) + rxt(k,261)*y(k,52) + rxt(k,262)*y(k,52) & + + rxt(k,263)*y(k,52) + het_rates(k,189) ) + mat(k,2037) = rxt(k,1) + mat(k,1857) = rxt(k,7) + mat(k,1499) = -( rxt(k,228)*y(k,39) + rxt(k,230)*y(k,41) + rxt(k,231)*y(k,42) & + + rxt(k,233)*y(k,44) + rxt(k,235)*y(k,53) + rxt(k,236)*y(k,77) & + + rxt(k,237)*y(k,78) + rxt(k,238)*y(k,79) + rxt(k,254)*y(k,52) & + + het_rates(k,190) ) + mat(k,2038) = rxt(k,2) + mat(k,467) = 2.000_r8*rxt(k,4) + mat(k,1264) = rxt(k,9) + mat(k,266) = rxt(k,10) + mat(k,528) = rxt(k,20) + mat(k,317) = rxt(k,21) + mat(k,242) = rxt(k,28) + mat(k,216) = rxt(k,29) + mat(k,310) = rxt(k,30) + mat(k,173) = rxt(k,31) + mat(k,404) = rxt(k,37) + mat(k,298) = rxt(k,38) + mat(k,75) = rxt(k,42) + mat(k,152) = rxt(k,46) + mat(k,227) = rxt(k,53) + mat(k,293) = rxt(k,58) + mat(k,236) = rxt(k,61) + mat(k,426) = rxt(k,62) + mat(k,304) = rxt(k,63) + mat(k,488) = rxt(k,65) + mat(k,370) = rxt(k,67) + mat(k,500) = rxt(k,70) + mat(k,130) = rxt(k,71) + mat(k,563) = rxt(k,72) + mat(k,329) = rxt(k,73) + mat(k,650) = rxt(k,105) + mat(k,677) = rxt(k,106) + mat(k,1899) = .500_r8*rxt(k,479) + mat(k,1345) = rxt(k,261)*y(k,52) + mat(k,346) = -( het_rates(k,191) ) + mat(k,629) = -( het_rates(k,192) ) + mat(k,995) = -( het_rates(k,193) ) + mat(k,887) = .150_r8*rxt(k,69) + mat(k,960) = -( het_rates(k,194) ) + mat(k,938) = -( het_rates(k,195) ) + mat(k,585) = -( het_rates(k,196) ) + mat(k,50) = -( het_rates(k,197) ) + mat(k,1011) = -( het_rates(k,198) ) + mat(k,609) = -( het_rates(k,199) ) + mat(k,56) = -( het_rates(k,200) ) + mat(k,383) = -( het_rates(k,201) ) + mat(k,2050) = -( rxt(k,1) + rxt(k,2) + rxt(k,3) + het_rates(k,202) ) + mat(k,78) = rxt(k,109) + mat(k,1694) = rxt(k,471) + mat(k,1511) = rxt(k,228)*y(k,39) + rxt(k,230)*y(k,41) + rxt(k,231)*y(k,42) & + + rxt(k,233)*y(k,44) + rxt(k,238)*y(k,79) + rxt(k,254)*y(k,52) + end do + end subroutine linmat03 + subroutine linmat( avec_len, mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(in) :: het_rates(veclen,gas_pcnst) + real(r8), intent(inout) :: mat(veclen,nzcnt) + call linmat01( avec_len, mat, y, rxt, het_rates ) + call linmat02( avec_len, mat, y, rxt, het_rates ) + call linmat03( avec_len, mat, y, rxt, het_rates ) + end subroutine linmat + end module mo_lin_matrix diff --git a/src/chemistry/pp_trop_strat_noaero/mo_lu_factor.F90 b/src/chemistry/pp_trop_strat_noaero/mo_lu_factor.F90 new file mode 100644 index 0000000000..07fda6300b --- /dev/null +++ b/src/chemistry/pp_trop_strat_noaero/mo_lu_factor.F90 @@ -0,0 +1,7261 @@ + module mo_lu_factor + use chem_mods, only: veclen + private + public :: lu_fac + contains + subroutine lu_fac01( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,1) = 1._r8 / lu(k,1) + lu(k,2) = 1._r8 / lu(k,2) + lu(k,3) = 1._r8 / lu(k,3) + lu(k,4) = 1._r8 / lu(k,4) + lu(k,5) = 1._r8 / lu(k,5) + lu(k,6) = 1._r8 / lu(k,6) + lu(k,12) = 1._r8 / lu(k,12) + lu(k,18) = 1._r8 / lu(k,18) + lu(k,24) = 1._r8 / lu(k,24) + lu(k,30) = 1._r8 / lu(k,30) + lu(k,36) = 1._r8 / lu(k,36) + lu(k,38) = 1._r8 / lu(k,38) + lu(k,44) = 1._r8 / lu(k,44) + lu(k,50) = 1._r8 / lu(k,50) + lu(k,56) = 1._r8 / lu(k,56) + lu(k,57) = 1._r8 / lu(k,57) + lu(k,58) = lu(k,58) * lu(k,57) + lu(k,59) = lu(k,59) * lu(k,57) + lu(k,1499) = lu(k,1499) - lu(k,58) * lu(k,1372) + lu(k,1503) = lu(k,1503) - lu(k,59) * lu(k,1372) + lu(k,60) = 1._r8 / lu(k,60) + lu(k,61) = lu(k,61) * lu(k,60) + lu(k,62) = lu(k,62) * lu(k,60) + lu(k,1713) = lu(k,1713) - lu(k,61) * lu(k,1695) + lu(k,1718) = lu(k,1718) - lu(k,62) * lu(k,1695) + lu(k,63) = 1._r8 / lu(k,63) + lu(k,64) = lu(k,64) * lu(k,63) + lu(k,65) = lu(k,65) * lu(k,63) + lu(k,1499) = lu(k,1499) - lu(k,64) * lu(k,1373) + lu(k,1511) = lu(k,1511) - lu(k,65) * lu(k,1373) + lu(k,66) = 1._r8 / lu(k,66) + lu(k,67) = lu(k,67) * lu(k,66) + lu(k,68) = lu(k,68) * lu(k,66) + lu(k,69) = lu(k,69) * lu(k,66) + lu(k,1454) = lu(k,1454) - lu(k,67) * lu(k,1374) + lu(k,1499) = lu(k,1499) - lu(k,68) * lu(k,1374) + lu(k,1511) = lu(k,1511) - lu(k,69) * lu(k,1374) + lu(k,70) = 1._r8 / lu(k,70) + lu(k,71) = lu(k,71) * lu(k,70) + lu(k,72) = lu(k,72) * lu(k,70) + lu(k,1337) = lu(k,1337) - lu(k,71) * lu(k,1334) + lu(k,1344) = lu(k,1344) - lu(k,72) * lu(k,1334) + lu(k,1452) = - lu(k,71) * lu(k,1375) + lu(k,1498) = - lu(k,72) * lu(k,1375) + lu(k,73) = 1._r8 / lu(k,73) + lu(k,74) = lu(k,74) * lu(k,73) + lu(k,75) = lu(k,75) * lu(k,73) + lu(k,566) = lu(k,566) - lu(k,74) * lu(k,565) + lu(k,569) = - lu(k,75) * lu(k,565) + lu(k,1604) = - lu(k,74) * lu(k,1601) + lu(k,1682) = lu(k,1682) - lu(k,75) * lu(k,1601) + lu(k,76) = 1._r8 / lu(k,76) + lu(k,77) = lu(k,77) * lu(k,76) + lu(k,78) = lu(k,78) * lu(k,76) + lu(k,175) = lu(k,175) - lu(k,77) * lu(k,174) + lu(k,178) = lu(k,178) - lu(k,78) * lu(k,174) + lu(k,2028) = lu(k,2028) - lu(k,77) * lu(k,2026) + lu(k,2050) = lu(k,2050) - lu(k,78) * lu(k,2026) + lu(k,79) = 1._r8 / lu(k,79) + lu(k,80) = lu(k,80) * lu(k,79) + lu(k,81) = lu(k,81) * lu(k,79) + lu(k,597) = lu(k,597) - lu(k,80) * lu(k,595) + lu(k,600) = lu(k,600) - lu(k,81) * lu(k,595) + lu(k,1482) = lu(k,1482) - lu(k,80) * lu(k,1376) + lu(k,1499) = lu(k,1499) - lu(k,81) * lu(k,1376) + lu(k,82) = 1._r8 / lu(k,82) + lu(k,83) = lu(k,83) * lu(k,82) + lu(k,84) = lu(k,84) * lu(k,82) + lu(k,408) = lu(k,408) - lu(k,83) * lu(k,407) + lu(k,413) = lu(k,413) - lu(k,84) * lu(k,407) + lu(k,1877) = lu(k,1877) - lu(k,83) * lu(k,1871) + lu(k,1907) = lu(k,1907) - lu(k,84) * lu(k,1871) + lu(k,85) = 1._r8 / lu(k,85) + lu(k,86) = lu(k,86) * lu(k,85) + lu(k,681) = lu(k,681) - lu(k,86) * lu(k,675) + lu(k,833) = lu(k,833) - lu(k,86) * lu(k,824) + lu(k,1718) = lu(k,1718) - lu(k,86) * lu(k,1696) + lu(k,1932) = lu(k,1932) - lu(k,86) * lu(k,1912) + lu(k,1966) = lu(k,1966) - lu(k,86) * lu(k,1935) + lu(k,88) = 1._r8 / lu(k,88) + lu(k,89) = lu(k,89) * lu(k,88) + lu(k,90) = lu(k,90) * lu(k,88) + lu(k,91) = lu(k,91) * lu(k,88) + lu(k,92) = lu(k,92) * lu(k,88) + lu(k,93) = lu(k,93) * lu(k,88) + lu(k,1378) = lu(k,1378) - lu(k,89) * lu(k,1377) + lu(k,1379) = lu(k,1379) - lu(k,90) * lu(k,1377) + lu(k,1422) = lu(k,1422) - lu(k,91) * lu(k,1377) + lu(k,1499) = lu(k,1499) - lu(k,92) * lu(k,1377) + lu(k,1503) = lu(k,1503) - lu(k,93) * lu(k,1377) + end do + end subroutine lu_fac01 + subroutine lu_fac02( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,94) = 1._r8 / lu(k,94) + lu(k,95) = lu(k,95) * lu(k,94) + lu(k,96) = lu(k,96) * lu(k,94) + lu(k,97) = lu(k,97) * lu(k,94) + lu(k,1418) = - lu(k,95) * lu(k,1378) + lu(k,1475) = lu(k,1475) - lu(k,96) * lu(k,1378) + lu(k,1503) = lu(k,1503) - lu(k,97) * lu(k,1378) + lu(k,98) = 1._r8 / lu(k,98) + lu(k,99) = lu(k,99) * lu(k,98) + lu(k,100) = lu(k,100) * lu(k,98) + lu(k,101) = lu(k,101) * lu(k,98) + lu(k,102) = lu(k,102) * lu(k,98) + lu(k,1417) = lu(k,1417) - lu(k,99) * lu(k,1379) + lu(k,1420) = lu(k,1420) - lu(k,100) * lu(k,1379) + lu(k,1499) = lu(k,1499) - lu(k,101) * lu(k,1379) + lu(k,1503) = lu(k,1503) - lu(k,102) * lu(k,1379) + lu(k,103) = 1._r8 / lu(k,103) + lu(k,104) = lu(k,104) * lu(k,103) + lu(k,105) = lu(k,105) * lu(k,103) + lu(k,106) = lu(k,106) * lu(k,103) + lu(k,1337) = lu(k,1337) - lu(k,104) * lu(k,1335) + lu(k,1344) = lu(k,1344) - lu(k,105) * lu(k,1335) + lu(k,1355) = lu(k,1355) - lu(k,106) * lu(k,1335) + lu(k,1452) = lu(k,1452) - lu(k,104) * lu(k,1380) + lu(k,1498) = lu(k,1498) - lu(k,105) * lu(k,1380) + lu(k,1509) = lu(k,1509) - lu(k,106) * lu(k,1380) + lu(k,107) = 1._r8 / lu(k,107) + lu(k,108) = lu(k,108) * lu(k,107) + lu(k,109) = lu(k,109) * lu(k,107) + lu(k,110) = lu(k,110) * lu(k,107) + lu(k,1344) = lu(k,1344) - lu(k,108) * lu(k,1336) + lu(k,1345) = lu(k,1345) - lu(k,109) * lu(k,1336) + lu(k,1349) = lu(k,1349) - lu(k,110) * lu(k,1336) + lu(k,1498) = lu(k,1498) - lu(k,108) * lu(k,1381) + lu(k,1499) = lu(k,1499) - lu(k,109) * lu(k,1381) + lu(k,1503) = lu(k,1503) - lu(k,110) * lu(k,1381) + lu(k,112) = 1._r8 / lu(k,112) + lu(k,113) = lu(k,113) * lu(k,112) + lu(k,114) = lu(k,114) * lu(k,112) + lu(k,115) = lu(k,115) * lu(k,112) + lu(k,116) = lu(k,116) * lu(k,112) + lu(k,117) = lu(k,117) * lu(k,112) + lu(k,118) = lu(k,118) * lu(k,112) + lu(k,1383) = lu(k,1383) - lu(k,113) * lu(k,1382) + lu(k,1384) = lu(k,1384) - lu(k,114) * lu(k,1382) + lu(k,1416) = lu(k,1416) - lu(k,115) * lu(k,1382) + lu(k,1447) = lu(k,1447) - lu(k,116) * lu(k,1382) + lu(k,1499) = lu(k,1499) - lu(k,117) * lu(k,1382) + lu(k,1503) = lu(k,1503) - lu(k,118) * lu(k,1382) + lu(k,119) = 1._r8 / lu(k,119) + lu(k,120) = lu(k,120) * lu(k,119) + lu(k,121) = lu(k,121) * lu(k,119) + lu(k,122) = lu(k,122) * lu(k,119) + lu(k,123) = lu(k,123) * lu(k,119) + lu(k,1417) = lu(k,1417) - lu(k,120) * lu(k,1383) + lu(k,1420) = lu(k,1420) - lu(k,121) * lu(k,1383) + lu(k,1499) = lu(k,1499) - lu(k,122) * lu(k,1383) + lu(k,1503) = lu(k,1503) - lu(k,123) * lu(k,1383) + lu(k,124) = 1._r8 / lu(k,124) + lu(k,125) = lu(k,125) * lu(k,124) + lu(k,126) = lu(k,126) * lu(k,124) + lu(k,127) = lu(k,127) * lu(k,124) + lu(k,137) = - lu(k,125) * lu(k,132) + lu(k,138) = - lu(k,126) * lu(k,132) + lu(k,140) = lu(k,140) - lu(k,127) * lu(k,132) + lu(k,1475) = lu(k,1475) - lu(k,125) * lu(k,1384) + lu(k,1493) = lu(k,1493) - lu(k,126) * lu(k,1384) + lu(k,1503) = lu(k,1503) - lu(k,127) * lu(k,1384) + lu(k,128) = 1._r8 / lu(k,128) + lu(k,129) = lu(k,129) * lu(k,128) + lu(k,130) = lu(k,130) * lu(k,128) + lu(k,1011) = lu(k,1011) - lu(k,129) * lu(k,1005) + lu(k,1016) = - lu(k,130) * lu(k,1005) + lu(k,1482) = lu(k,1482) - lu(k,129) * lu(k,1385) + lu(k,1499) = lu(k,1499) - lu(k,130) * lu(k,1385) + lu(k,1666) = lu(k,1666) - lu(k,129) * lu(k,1602) + lu(k,1682) = lu(k,1682) - lu(k,130) * lu(k,1602) + lu(k,133) = 1._r8 / lu(k,133) + lu(k,134) = lu(k,134) * lu(k,133) + lu(k,135) = lu(k,135) * lu(k,133) + lu(k,136) = lu(k,136) * lu(k,133) + lu(k,137) = lu(k,137) * lu(k,133) + lu(k,138) = lu(k,138) * lu(k,133) + lu(k,139) = lu(k,139) * lu(k,133) + lu(k,140) = lu(k,140) * lu(k,133) + lu(k,1387) = lu(k,1387) - lu(k,134) * lu(k,1386) + lu(k,1416) = lu(k,1416) - lu(k,135) * lu(k,1386) + lu(k,1449) = lu(k,1449) - lu(k,136) * lu(k,1386) + lu(k,1475) = lu(k,1475) - lu(k,137) * lu(k,1386) + lu(k,1493) = lu(k,1493) - lu(k,138) * lu(k,1386) + lu(k,1499) = lu(k,1499) - lu(k,139) * lu(k,1386) + lu(k,1503) = lu(k,1503) - lu(k,140) * lu(k,1386) + lu(k,141) = 1._r8 / lu(k,141) + lu(k,142) = lu(k,142) * lu(k,141) + lu(k,143) = lu(k,143) * lu(k,141) + lu(k,144) = lu(k,144) * lu(k,141) + lu(k,145) = lu(k,145) * lu(k,141) + lu(k,1420) = lu(k,1420) - lu(k,142) * lu(k,1387) + lu(k,1423) = lu(k,1423) - lu(k,143) * lu(k,1387) + lu(k,1499) = lu(k,1499) - lu(k,144) * lu(k,1387) + lu(k,1503) = lu(k,1503) - lu(k,145) * lu(k,1387) + end do + end subroutine lu_fac02 + subroutine lu_fac03( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,146) = 1._r8 / lu(k,146) + lu(k,147) = lu(k,147) * lu(k,146) + lu(k,148) = lu(k,148) * lu(k,146) + lu(k,639) = lu(k,639) - lu(k,147) * lu(k,638) + lu(k,642) = lu(k,642) - lu(k,148) * lu(k,638) + lu(k,1023) = lu(k,1023) - lu(k,147) * lu(k,1022) + lu(k,1026) = lu(k,1026) - lu(k,148) * lu(k,1022) + lu(k,1258) = lu(k,1258) - lu(k,147) * lu(k,1257) + lu(k,1261) = - lu(k,148) * lu(k,1257) + lu(k,2029) = lu(k,2029) - lu(k,147) * lu(k,2027) + lu(k,2035) = lu(k,2035) - lu(k,148) * lu(k,2027) + lu(k,149) = 1._r8 / lu(k,149) + lu(k,150) = lu(k,150) * lu(k,149) + lu(k,151) = lu(k,151) * lu(k,149) + lu(k,152) = lu(k,152) * lu(k,149) + lu(k,153) = lu(k,153) * lu(k,149) + lu(k,1099) = - lu(k,150) * lu(k,1096) + lu(k,1110) = - lu(k,151) * lu(k,1096) + lu(k,1121) = - lu(k,152) * lu(k,1096) + lu(k,1123) = lu(k,1123) - lu(k,153) * lu(k,1096) + lu(k,1438) = - lu(k,150) * lu(k,1388) + lu(k,1482) = lu(k,1482) - lu(k,151) * lu(k,1388) + lu(k,1499) = lu(k,1499) - lu(k,152) * lu(k,1388) + lu(k,1503) = lu(k,1503) - lu(k,153) * lu(k,1388) + lu(k,154) = 1._r8 / lu(k,154) + lu(k,155) = lu(k,155) * lu(k,154) + lu(k,156) = lu(k,156) * lu(k,154) + lu(k,760) = - lu(k,155) * lu(k,755) + lu(k,770) = lu(k,770) - lu(k,156) * lu(k,755) + lu(k,787) = - lu(k,155) * lu(k,782) + lu(k,797) = lu(k,797) - lu(k,156) * lu(k,782) + lu(k,1466) = lu(k,1466) - lu(k,155) * lu(k,1389) + lu(k,1499) = lu(k,1499) - lu(k,156) * lu(k,1389) + lu(k,1830) = - lu(k,155) * lu(k,1816) + lu(k,1858) = lu(k,1858) - lu(k,156) * lu(k,1816) + lu(k,157) = 1._r8 / lu(k,157) + lu(k,158) = lu(k,158) * lu(k,157) + lu(k,159) = lu(k,159) * lu(k,157) + lu(k,241) = - lu(k,158) * lu(k,238) + lu(k,242) = lu(k,242) - lu(k,159) * lu(k,238) + lu(k,334) = - lu(k,158) * lu(k,331) + lu(k,335) = - lu(k,159) * lu(k,331) + lu(k,1427) = lu(k,1427) - lu(k,158) * lu(k,1390) + lu(k,1499) = lu(k,1499) - lu(k,159) * lu(k,1390) + lu(k,1748) = lu(k,1748) - lu(k,158) * lu(k,1733) + lu(k,1798) = lu(k,1798) - lu(k,159) * lu(k,1733) + lu(k,160) = 1._r8 / lu(k,160) + lu(k,161) = lu(k,161) * lu(k,160) + lu(k,162) = lu(k,162) * lu(k,160) + lu(k,916) = lu(k,916) - lu(k,161) * lu(k,907) + lu(k,922) = lu(k,922) - lu(k,162) * lu(k,907) + lu(k,963) = - lu(k,161) * lu(k,953) + lu(k,970) = lu(k,970) - lu(k,162) * lu(k,953) + lu(k,1495) = lu(k,1495) - lu(k,161) * lu(k,1391) + lu(k,1507) = lu(k,1507) - lu(k,162) * lu(k,1391) + lu(k,1794) = - lu(k,161) * lu(k,1734) + lu(k,1806) = lu(k,1806) - lu(k,162) * lu(k,1734) + lu(k,163) = 1._r8 / lu(k,163) + lu(k,164) = lu(k,164) * lu(k,163) + lu(k,165) = lu(k,165) * lu(k,163) + lu(k,649) = lu(k,649) - lu(k,164) * lu(k,647) + lu(k,654) = - lu(k,165) * lu(k,647) + lu(k,1518) = lu(k,1518) - lu(k,164) * lu(k,1512) + lu(k,1533) = lu(k,1533) - lu(k,165) * lu(k,1512) + lu(k,1703) = lu(k,1703) - lu(k,164) * lu(k,1697) + lu(k,1718) = lu(k,1718) - lu(k,165) * lu(k,1697) + lu(k,1917) = - lu(k,164) * lu(k,1913) + lu(k,1932) = lu(k,1932) - lu(k,165) * lu(k,1913) + lu(k,166) = 1._r8 / lu(k,166) + lu(k,167) = lu(k,167) * lu(k,166) + lu(k,168) = lu(k,168) * lu(k,166) + lu(k,169) = lu(k,169) * lu(k,166) + lu(k,687) = lu(k,687) - lu(k,167) * lu(k,683) + lu(k,689) = - lu(k,168) * lu(k,683) + lu(k,691) = lu(k,691) - lu(k,169) * lu(k,683) + lu(k,1301) = lu(k,1301) - lu(k,167) * lu(k,1285) + lu(k,1322) = - lu(k,168) * lu(k,1285) + lu(k,1325) = lu(k,1325) - lu(k,169) * lu(k,1285) + lu(k,1474) = lu(k,1474) - lu(k,167) * lu(k,1392) + lu(k,1499) = lu(k,1499) - lu(k,168) * lu(k,1392) + lu(k,1503) = lu(k,1503) - lu(k,169) * lu(k,1392) + lu(k,170) = 1._r8 / lu(k,170) + lu(k,171) = lu(k,171) * lu(k,170) + lu(k,172) = lu(k,172) * lu(k,170) + lu(k,173) = lu(k,173) * lu(k,170) + lu(k,513) = lu(k,513) - lu(k,171) * lu(k,512) + lu(k,514) = lu(k,514) - lu(k,172) * lu(k,512) + lu(k,515) = - lu(k,173) * lu(k,512) + lu(k,1420) = lu(k,1420) - lu(k,171) * lu(k,1393) + lu(k,1440) = lu(k,1440) - lu(k,172) * lu(k,1393) + lu(k,1499) = lu(k,1499) - lu(k,173) * lu(k,1393) + lu(k,1622) = - lu(k,171) * lu(k,1603) + lu(k,1634) = lu(k,1634) - lu(k,172) * lu(k,1603) + lu(k,1682) = lu(k,1682) - lu(k,173) * lu(k,1603) + lu(k,175) = 1._r8 / lu(k,175) + lu(k,176) = lu(k,176) * lu(k,175) + lu(k,177) = lu(k,177) * lu(k,175) + lu(k,178) = lu(k,178) * lu(k,175) + lu(k,723) = lu(k,723) - lu(k,176) * lu(k,722) + lu(k,726) = lu(k,726) - lu(k,177) * lu(k,722) + lu(k,728) = - lu(k,178) * lu(k,722) + lu(k,1460) = lu(k,1460) - lu(k,176) * lu(k,1394) + lu(k,1502) = lu(k,1502) - lu(k,177) * lu(k,1394) + lu(k,1511) = lu(k,1511) - lu(k,178) * lu(k,1394) + lu(k,2030) = - lu(k,176) * lu(k,2028) + lu(k,2041) = lu(k,2041) - lu(k,177) * lu(k,2028) + lu(k,2050) = lu(k,2050) - lu(k,178) * lu(k,2028) + end do + end subroutine lu_fac03 + subroutine lu_fac04( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,179) = 1._r8 / lu(k,179) + lu(k,180) = lu(k,180) * lu(k,179) + lu(k,181) = lu(k,181) * lu(k,179) + lu(k,182) = lu(k,182) * lu(k,179) + lu(k,568) = - lu(k,180) * lu(k,566) + lu(k,570) = lu(k,570) - lu(k,181) * lu(k,566) + lu(k,571) = lu(k,571) - lu(k,182) * lu(k,566) + lu(k,1657) = - lu(k,180) * lu(k,1604) + lu(k,1684) = lu(k,1684) - lu(k,181) * lu(k,1604) + lu(k,1686) = lu(k,1686) - lu(k,182) * lu(k,1604) + lu(k,1772) = lu(k,1772) - lu(k,180) * lu(k,1735) + lu(k,1800) = lu(k,1800) - lu(k,181) * lu(k,1735) + lu(k,1802) = lu(k,1802) - lu(k,182) * lu(k,1735) + lu(k,183) = 1._r8 / lu(k,183) + lu(k,184) = lu(k,184) * lu(k,183) + lu(k,185) = lu(k,185) * lu(k,183) + lu(k,186) = lu(k,186) * lu(k,183) + lu(k,187) = lu(k,187) * lu(k,183) + lu(k,188) = lu(k,188) * lu(k,183) + lu(k,1460) = lu(k,1460) - lu(k,184) * lu(k,1395) + lu(k,1495) = lu(k,1495) - lu(k,185) * lu(k,1395) + lu(k,1499) = lu(k,1499) - lu(k,186) * lu(k,1395) + lu(k,1503) = lu(k,1503) - lu(k,187) * lu(k,1395) + lu(k,1510) = lu(k,1510) - lu(k,188) * lu(k,1395) + lu(k,1977) = lu(k,1977) - lu(k,184) * lu(k,1971) + lu(k,2009) = lu(k,2009) - lu(k,185) * lu(k,1971) + lu(k,2013) = lu(k,2013) - lu(k,186) * lu(k,1971) + lu(k,2017) = lu(k,2017) - lu(k,187) * lu(k,1971) + lu(k,2024) = lu(k,2024) - lu(k,188) * lu(k,1971) + lu(k,189) = 1._r8 / lu(k,189) + lu(k,190) = lu(k,190) * lu(k,189) + lu(k,191) = lu(k,191) * lu(k,189) + lu(k,192) = lu(k,192) * lu(k,189) + lu(k,193) = lu(k,193) * lu(k,189) + lu(k,194) = lu(k,194) * lu(k,189) + lu(k,1895) = lu(k,1895) - lu(k,190) * lu(k,1872) + lu(k,1902) = lu(k,1902) - lu(k,191) * lu(k,1872) + lu(k,1905) = lu(k,1905) - lu(k,192) * lu(k,1872) + lu(k,1907) = lu(k,1907) - lu(k,193) * lu(k,1872) + lu(k,1910) = lu(k,1910) - lu(k,194) * lu(k,1872) + lu(k,2009) = lu(k,2009) - lu(k,190) * lu(k,1972) + lu(k,2016) = lu(k,2016) - lu(k,191) * lu(k,1972) + lu(k,2019) = lu(k,2019) - lu(k,192) * lu(k,1972) + lu(k,2021) = lu(k,2021) - lu(k,193) * lu(k,1972) + lu(k,2024) = lu(k,2024) - lu(k,194) * lu(k,1972) + lu(k,195) = 1._r8 / lu(k,195) + lu(k,196) = lu(k,196) * lu(k,195) + lu(k,197) = lu(k,197) * lu(k,195) + lu(k,198) = lu(k,198) * lu(k,195) + lu(k,199) = lu(k,199) * lu(k,195) + lu(k,200) = lu(k,200) * lu(k,195) + lu(k,1457) = lu(k,1457) - lu(k,196) * lu(k,1396) + lu(k,1499) = lu(k,1499) - lu(k,197) * lu(k,1396) + lu(k,1508) = lu(k,1508) - lu(k,198) * lu(k,1396) + lu(k,1509) = lu(k,1509) - lu(k,199) * lu(k,1396) + lu(k,1511) = lu(k,1511) - lu(k,200) * lu(k,1396) + lu(k,1943) = lu(k,1943) - lu(k,196) * lu(k,1936) + lu(k,1956) = lu(k,1956) - lu(k,197) * lu(k,1936) + lu(k,1965) = lu(k,1965) - lu(k,198) * lu(k,1936) + lu(k,1966) = lu(k,1966) - lu(k,199) * lu(k,1936) + lu(k,1968) = - lu(k,200) * lu(k,1936) + lu(k,201) = 1._r8 / lu(k,201) + lu(k,202) = lu(k,202) * lu(k,201) + lu(k,203) = lu(k,203) * lu(k,201) + lu(k,204) = lu(k,204) * lu(k,201) + lu(k,205) = lu(k,205) * lu(k,201) + lu(k,206) = lu(k,206) * lu(k,201) + lu(k,1455) = lu(k,1455) - lu(k,202) * lu(k,1397) + lu(k,1462) = lu(k,1462) - lu(k,203) * lu(k,1397) + lu(k,1475) = lu(k,1475) - lu(k,204) * lu(k,1397) + lu(k,1499) = lu(k,1499) - lu(k,205) * lu(k,1397) + lu(k,1503) = lu(k,1503) - lu(k,206) * lu(k,1397) + lu(k,1941) = - lu(k,202) * lu(k,1937) + lu(k,1944) = - lu(k,203) * lu(k,1937) + lu(k,1948) = lu(k,1948) - lu(k,204) * lu(k,1937) + lu(k,1956) = lu(k,1956) - lu(k,205) * lu(k,1937) + lu(k,1960) = lu(k,1960) - lu(k,206) * lu(k,1937) + lu(k,207) = 1._r8 / lu(k,207) + lu(k,208) = lu(k,208) * lu(k,207) + lu(k,209) = lu(k,209) * lu(k,207) + lu(k,497) = - lu(k,208) * lu(k,491) + lu(k,501) = lu(k,501) - lu(k,209) * lu(k,491) + lu(k,557) = - lu(k,208) * lu(k,550) + lu(k,564) = lu(k,564) - lu(k,209) * lu(k,550) + lu(k,586) = - lu(k,208) * lu(k,580) + lu(k,592) = lu(k,592) - lu(k,209) * lu(k,580) + lu(k,610) = - lu(k,208) * lu(k,603) + lu(k,617) = lu(k,617) - lu(k,209) * lu(k,603) + lu(k,1761) = lu(k,1761) - lu(k,208) * lu(k,1736) + lu(k,1802) = lu(k,1802) - lu(k,209) * lu(k,1736) + lu(k,210) = 1._r8 / lu(k,210) + lu(k,211) = lu(k,211) * lu(k,210) + lu(k,212) = lu(k,212) * lu(k,210) + lu(k,1110) = lu(k,1110) - lu(k,211) * lu(k,1097) + lu(k,1121) = lu(k,1121) - lu(k,212) * lu(k,1097) + lu(k,1224) = lu(k,1224) - lu(k,211) * lu(k,1215) + lu(k,1237) = lu(k,1237) - lu(k,212) * lu(k,1215) + lu(k,1308) = lu(k,1308) - lu(k,211) * lu(k,1286) + lu(k,1322) = lu(k,1322) - lu(k,212) * lu(k,1286) + lu(k,1482) = lu(k,1482) - lu(k,211) * lu(k,1398) + lu(k,1499) = lu(k,1499) - lu(k,212) * lu(k,1398) + lu(k,1783) = lu(k,1783) - lu(k,211) * lu(k,1737) + lu(k,1798) = lu(k,1798) - lu(k,212) * lu(k,1737) + lu(k,1997) = lu(k,1997) - lu(k,211) * lu(k,1973) + lu(k,2013) = lu(k,2013) - lu(k,212) * lu(k,1973) + lu(k,213) = 1._r8 / lu(k,213) + lu(k,214) = lu(k,214) * lu(k,213) + lu(k,215) = lu(k,215) * lu(k,213) + lu(k,216) = lu(k,216) * lu(k,213) + lu(k,217) = lu(k,217) * lu(k,213) + lu(k,686) = lu(k,686) - lu(k,214) * lu(k,684) + lu(k,687) = lu(k,687) - lu(k,215) * lu(k,684) + lu(k,689) = lu(k,689) - lu(k,216) * lu(k,684) + lu(k,691) = lu(k,691) - lu(k,217) * lu(k,684) + lu(k,1457) = lu(k,1457) - lu(k,214) * lu(k,1399) + lu(k,1474) = lu(k,1474) - lu(k,215) * lu(k,1399) + lu(k,1499) = lu(k,1499) - lu(k,216) * lu(k,1399) + lu(k,1503) = lu(k,1503) - lu(k,217) * lu(k,1399) + lu(k,1649) = lu(k,1649) - lu(k,214) * lu(k,1605) + lu(k,1659) = lu(k,1659) - lu(k,215) * lu(k,1605) + lu(k,1682) = lu(k,1682) - lu(k,216) * lu(k,1605) + lu(k,1686) = lu(k,1686) - lu(k,217) * lu(k,1605) + lu(k,218) = 1._r8 / lu(k,218) + lu(k,219) = lu(k,219) * lu(k,218) + lu(k,220) = lu(k,220) * lu(k,218) + lu(k,221) = lu(k,221) * lu(k,218) + lu(k,222) = lu(k,222) * lu(k,218) + lu(k,1157) = lu(k,1157) - lu(k,219) * lu(k,1149) + lu(k,1158) = - lu(k,220) * lu(k,1149) + lu(k,1163) = - lu(k,221) * lu(k,1149) + lu(k,1165) = lu(k,1165) - lu(k,222) * lu(k,1149) + lu(k,1490) = lu(k,1490) - lu(k,219) * lu(k,1400) + lu(k,1492) = lu(k,1492) - lu(k,220) * lu(k,1400) + lu(k,1499) = lu(k,1499) - lu(k,221) * lu(k,1400) + lu(k,1503) = lu(k,1503) - lu(k,222) * lu(k,1400) + lu(k,1673) = lu(k,1673) - lu(k,219) * lu(k,1606) + lu(k,1675) = lu(k,1675) - lu(k,220) * lu(k,1606) + lu(k,1682) = lu(k,1682) - lu(k,221) * lu(k,1606) + lu(k,1686) = lu(k,1686) - lu(k,222) * lu(k,1606) + end do + end subroutine lu_fac04 + subroutine lu_fac05( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,223) = 1._r8 / lu(k,223) + lu(k,224) = lu(k,224) * lu(k,223) + lu(k,225) = lu(k,225) * lu(k,223) + lu(k,226) = lu(k,226) * lu(k,223) + lu(k,227) = lu(k,227) * lu(k,223) + lu(k,543) = lu(k,543) - lu(k,224) * lu(k,542) + lu(k,544) = lu(k,544) - lu(k,225) * lu(k,542) + lu(k,545) = lu(k,545) - lu(k,226) * lu(k,542) + lu(k,546) = lu(k,546) - lu(k,227) * lu(k,542) + lu(k,1443) = lu(k,1443) - lu(k,224) * lu(k,1401) + lu(k,1474) = lu(k,1474) - lu(k,225) * lu(k,1401) + lu(k,1493) = lu(k,1493) - lu(k,226) * lu(k,1401) + lu(k,1499) = lu(k,1499) - lu(k,227) * lu(k,1401) + lu(k,1636) = lu(k,1636) - lu(k,224) * lu(k,1607) + lu(k,1659) = lu(k,1659) - lu(k,225) * lu(k,1607) + lu(k,1676) = lu(k,1676) - lu(k,226) * lu(k,1607) + lu(k,1682) = lu(k,1682) - lu(k,227) * lu(k,1607) + lu(k,228) = 1._r8 / lu(k,228) + lu(k,229) = lu(k,229) * lu(k,228) + lu(k,230) = lu(k,230) * lu(k,228) + lu(k,231) = lu(k,231) * lu(k,228) + lu(k,232) = lu(k,232) * lu(k,228) + lu(k,1082) = lu(k,1082) - lu(k,229) * lu(k,1080) + lu(k,1083) = lu(k,1083) - lu(k,230) * lu(k,1080) + lu(k,1088) = lu(k,1088) - lu(k,231) * lu(k,1080) + lu(k,1090) = lu(k,1090) - lu(k,232) * lu(k,1080) + lu(k,1516) = lu(k,1516) - lu(k,229) * lu(k,1513) + lu(k,1517) = lu(k,1517) - lu(k,230) * lu(k,1513) + lu(k,1526) = lu(k,1526) - lu(k,231) * lu(k,1513) + lu(k,1528) = lu(k,1528) - lu(k,232) * lu(k,1513) + lu(k,1700) = lu(k,1700) - lu(k,229) * lu(k,1698) + lu(k,1702) = lu(k,1702) - lu(k,230) * lu(k,1698) + lu(k,1711) = lu(k,1711) - lu(k,231) * lu(k,1698) + lu(k,1713) = lu(k,1713) - lu(k,232) * lu(k,1698) + lu(k,233) = 1._r8 / lu(k,233) + lu(k,234) = lu(k,234) * lu(k,233) + lu(k,235) = lu(k,235) * lu(k,233) + lu(k,236) = lu(k,236) * lu(k,233) + lu(k,237) = lu(k,237) * lu(k,233) + lu(k,346) = lu(k,346) - lu(k,234) * lu(k,345) + lu(k,347) = lu(k,347) - lu(k,235) * lu(k,345) + lu(k,348) = - lu(k,236) * lu(k,345) + lu(k,349) = lu(k,349) - lu(k,237) * lu(k,345) + lu(k,1417) = lu(k,1417) - lu(k,234) * lu(k,1402) + lu(k,1462) = lu(k,1462) - lu(k,235) * lu(k,1402) + lu(k,1499) = lu(k,1499) - lu(k,236) * lu(k,1402) + lu(k,1503) = lu(k,1503) - lu(k,237) * lu(k,1402) + lu(k,1620) = lu(k,1620) - lu(k,234) * lu(k,1608) + lu(k,1652) = lu(k,1652) - lu(k,235) * lu(k,1608) + lu(k,1682) = lu(k,1682) - lu(k,236) * lu(k,1608) + lu(k,1686) = lu(k,1686) - lu(k,237) * lu(k,1608) + lu(k,239) = 1._r8 / lu(k,239) + lu(k,240) = lu(k,240) * lu(k,239) + lu(k,241) = lu(k,241) * lu(k,239) + lu(k,242) = lu(k,242) * lu(k,239) + lu(k,243) = lu(k,243) * lu(k,239) + lu(k,333) = lu(k,333) - lu(k,240) * lu(k,332) + lu(k,334) = lu(k,334) - lu(k,241) * lu(k,332) + lu(k,335) = lu(k,335) - lu(k,242) * lu(k,332) + lu(k,336) = lu(k,336) - lu(k,243) * lu(k,332) + lu(k,1416) = lu(k,1416) - lu(k,240) * lu(k,1403) + lu(k,1427) = lu(k,1427) - lu(k,241) * lu(k,1403) + lu(k,1499) = lu(k,1499) - lu(k,242) * lu(k,1403) + lu(k,1503) = lu(k,1503) - lu(k,243) * lu(k,1403) + lu(k,1618) = lu(k,1618) - lu(k,240) * lu(k,1609) + lu(k,1627) = lu(k,1627) - lu(k,241) * lu(k,1609) + lu(k,1682) = lu(k,1682) - lu(k,242) * lu(k,1609) + lu(k,1686) = lu(k,1686) - lu(k,243) * lu(k,1609) + lu(k,244) = 1._r8 / lu(k,244) + lu(k,245) = lu(k,245) * lu(k,244) + lu(k,246) = lu(k,246) * lu(k,244) + lu(k,247) = lu(k,247) * lu(k,244) + lu(k,248) = lu(k,248) * lu(k,244) + lu(k,560) = - lu(k,245) * lu(k,551) + lu(k,561) = lu(k,561) - lu(k,246) * lu(k,551) + lu(k,562) = - lu(k,247) * lu(k,551) + lu(k,564) = lu(k,564) - lu(k,248) * lu(k,551) + lu(k,613) = - lu(k,245) * lu(k,604) + lu(k,614) = lu(k,614) - lu(k,246) * lu(k,604) + lu(k,615) = - lu(k,247) * lu(k,604) + lu(k,617) = lu(k,617) - lu(k,248) * lu(k,604) + lu(k,1776) = lu(k,1776) - lu(k,245) * lu(k,1738) + lu(k,1786) = lu(k,1786) - lu(k,246) * lu(k,1738) + lu(k,1792) = lu(k,1792) - lu(k,247) * lu(k,1738) + lu(k,1802) = lu(k,1802) - lu(k,248) * lu(k,1738) + lu(k,249) = 1._r8 / lu(k,249) + lu(k,250) = lu(k,250) * lu(k,249) + lu(k,251) = lu(k,251) * lu(k,249) + lu(k,252) = lu(k,252) * lu(k,249) + lu(k,253) = lu(k,253) * lu(k,249) + lu(k,254) = lu(k,254) * lu(k,249) + lu(k,255) = lu(k,255) * lu(k,249) + lu(k,256) = lu(k,256) * lu(k,249) + lu(k,1424) = lu(k,1424) - lu(k,250) * lu(k,1404) + lu(k,1460) = lu(k,1460) - lu(k,251) * lu(k,1404) + lu(k,1475) = lu(k,1475) - lu(k,252) * lu(k,1404) + lu(k,1487) = lu(k,1487) - lu(k,253) * lu(k,1404) + lu(k,1496) = lu(k,1496) - lu(k,254) * lu(k,1404) + lu(k,1499) = lu(k,1499) - lu(k,255) * lu(k,1404) + lu(k,1502) = lu(k,1502) - lu(k,256) * lu(k,1404) + lu(k,1560) = - lu(k,250) * lu(k,1559) + lu(k,1566) = - lu(k,251) * lu(k,1559) + lu(k,1568) = lu(k,1568) - lu(k,252) * lu(k,1559) + lu(k,1570) = lu(k,1570) - lu(k,253) * lu(k,1559) + lu(k,1573) = lu(k,1573) - lu(k,254) * lu(k,1559) + lu(k,1576) = lu(k,1576) - lu(k,255) * lu(k,1559) + lu(k,1579) = lu(k,1579) - lu(k,256) * lu(k,1559) + lu(k,257) = 1._r8 / lu(k,257) + lu(k,258) = lu(k,258) * lu(k,257) + lu(k,259) = lu(k,259) * lu(k,257) + lu(k,260) = lu(k,260) * lu(k,257) + lu(k,261) = lu(k,261) * lu(k,257) + lu(k,262) = lu(k,262) * lu(k,257) + lu(k,263) = lu(k,263) * lu(k,257) + lu(k,264) = lu(k,264) * lu(k,257) + lu(k,1432) = lu(k,1432) - lu(k,258) * lu(k,1405) + lu(k,1467) = lu(k,1467) - lu(k,259) * lu(k,1405) + lu(k,1474) = lu(k,1474) - lu(k,260) * lu(k,1405) + lu(k,1499) = lu(k,1499) - lu(k,261) * lu(k,1405) + lu(k,1501) = lu(k,1501) - lu(k,262) * lu(k,1405) + lu(k,1507) = lu(k,1507) - lu(k,263) * lu(k,1405) + lu(k,1510) = lu(k,1510) - lu(k,264) * lu(k,1405) + lu(k,1975) = - lu(k,258) * lu(k,1974) + lu(k,1983) = lu(k,1983) - lu(k,259) * lu(k,1974) + lu(k,1989) = lu(k,1989) - lu(k,260) * lu(k,1974) + lu(k,2013) = lu(k,2013) - lu(k,261) * lu(k,1974) + lu(k,2015) = lu(k,2015) - lu(k,262) * lu(k,1974) + lu(k,2021) = lu(k,2021) - lu(k,263) * lu(k,1974) + lu(k,2024) = lu(k,2024) - lu(k,264) * lu(k,1974) + lu(k,265) = 1._r8 / lu(k,265) + lu(k,266) = lu(k,266) * lu(k,265) + lu(k,267) = lu(k,267) * lu(k,265) + lu(k,268) = lu(k,268) * lu(k,265) + lu(k,269) = lu(k,269) * lu(k,265) + lu(k,270) = lu(k,270) * lu(k,265) + lu(k,1499) = lu(k,1499) - lu(k,266) * lu(k,1406) + lu(k,1503) = lu(k,1503) - lu(k,267) * lu(k,1406) + lu(k,1507) = lu(k,1507) - lu(k,268) * lu(k,1406) + lu(k,1510) = lu(k,1510) - lu(k,269) * lu(k,1406) + lu(k,1511) = lu(k,1511) - lu(k,270) * lu(k,1406) + lu(k,1682) = lu(k,1682) - lu(k,266) * lu(k,1610) + lu(k,1686) = lu(k,1686) - lu(k,267) * lu(k,1610) + lu(k,1690) = lu(k,1690) - lu(k,268) * lu(k,1610) + lu(k,1693) = lu(k,1693) - lu(k,269) * lu(k,1610) + lu(k,1694) = lu(k,1694) - lu(k,270) * lu(k,1610) + lu(k,1899) = lu(k,1899) - lu(k,266) * lu(k,1873) + lu(k,1903) = lu(k,1903) - lu(k,267) * lu(k,1873) + lu(k,1907) = lu(k,1907) - lu(k,268) * lu(k,1873) + lu(k,1910) = lu(k,1910) - lu(k,269) * lu(k,1873) + lu(k,1911) = - lu(k,270) * lu(k,1873) + end do + end subroutine lu_fac05 + subroutine lu_fac06( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,271) = 1._r8 / lu(k,271) + lu(k,272) = lu(k,272) * lu(k,271) + lu(k,273) = lu(k,273) * lu(k,271) + lu(k,274) = lu(k,274) * lu(k,271) + lu(k,275) = lu(k,275) * lu(k,271) + lu(k,276) = lu(k,276) * lu(k,271) + lu(k,1037) = - lu(k,272) * lu(k,1035) + lu(k,1039) = - lu(k,273) * lu(k,1035) + lu(k,1052) = - lu(k,274) * lu(k,1035) + lu(k,1054) = lu(k,1054) - lu(k,275) * lu(k,1035) + lu(k,1056) = lu(k,1056) - lu(k,276) * lu(k,1035) + lu(k,1448) = lu(k,1448) - lu(k,272) * lu(k,1407) + lu(k,1461) = lu(k,1461) - lu(k,273) * lu(k,1407) + lu(k,1499) = lu(k,1499) - lu(k,274) * lu(k,1407) + lu(k,1503) = lu(k,1503) - lu(k,275) * lu(k,1407) + lu(k,1507) = lu(k,1507) - lu(k,276) * lu(k,1407) + lu(k,1641) = lu(k,1641) - lu(k,272) * lu(k,1611) + lu(k,1651) = - lu(k,273) * lu(k,1611) + lu(k,1682) = lu(k,1682) - lu(k,274) * lu(k,1611) + lu(k,1686) = lu(k,1686) - lu(k,275) * lu(k,1611) + lu(k,1690) = lu(k,1690) - lu(k,276) * lu(k,1611) + lu(k,277) = 1._r8 / lu(k,277) + lu(k,278) = lu(k,278) * lu(k,277) + lu(k,279) = lu(k,279) * lu(k,277) + lu(k,280) = lu(k,280) * lu(k,277) + lu(k,281) = lu(k,281) * lu(k,277) + lu(k,282) = lu(k,282) * lu(k,277) + lu(k,1496) = lu(k,1496) - lu(k,278) * lu(k,1408) + lu(k,1499) = lu(k,1499) - lu(k,279) * lu(k,1408) + lu(k,1502) = lu(k,1502) - lu(k,280) * lu(k,1408) + lu(k,1505) = lu(k,1505) - lu(k,281) * lu(k,1408) + lu(k,1507) = lu(k,1507) - lu(k,282) * lu(k,1408) + lu(k,1795) = - lu(k,278) * lu(k,1739) + lu(k,1798) = lu(k,1798) - lu(k,279) * lu(k,1739) + lu(k,1801) = lu(k,1801) - lu(k,280) * lu(k,1739) + lu(k,1804) = lu(k,1804) - lu(k,281) * lu(k,1739) + lu(k,1806) = lu(k,1806) - lu(k,282) * lu(k,1739) + lu(k,1896) = - lu(k,278) * lu(k,1874) + lu(k,1899) = lu(k,1899) - lu(k,279) * lu(k,1874) + lu(k,1902) = lu(k,1902) - lu(k,280) * lu(k,1874) + lu(k,1905) = lu(k,1905) - lu(k,281) * lu(k,1874) + lu(k,1907) = lu(k,1907) - lu(k,282) * lu(k,1874) + lu(k,283) = 1._r8 / lu(k,283) + lu(k,284) = lu(k,284) * lu(k,283) + lu(k,285) = lu(k,285) * lu(k,283) + lu(k,286) = lu(k,286) * lu(k,283) + lu(k,287) = lu(k,287) * lu(k,283) + lu(k,288) = lu(k,288) * lu(k,283) + lu(k,1039) = lu(k,1039) - lu(k,284) * lu(k,1036) + lu(k,1040) = - lu(k,285) * lu(k,1036) + lu(k,1049) = - lu(k,286) * lu(k,1036) + lu(k,1052) = lu(k,1052) - lu(k,287) * lu(k,1036) + lu(k,1054) = lu(k,1054) - lu(k,288) * lu(k,1036) + lu(k,1294) = - lu(k,284) * lu(k,1287) + lu(k,1298) = lu(k,1298) - lu(k,285) * lu(k,1287) + lu(k,1318) = - lu(k,286) * lu(k,1287) + lu(k,1322) = lu(k,1322) - lu(k,287) * lu(k,1287) + lu(k,1325) = lu(k,1325) - lu(k,288) * lu(k,1287) + lu(k,1461) = lu(k,1461) - lu(k,284) * lu(k,1409) + lu(k,1471) = lu(k,1471) - lu(k,285) * lu(k,1409) + lu(k,1495) = lu(k,1495) - lu(k,286) * lu(k,1409) + lu(k,1499) = lu(k,1499) - lu(k,287) * lu(k,1409) + lu(k,1503) = lu(k,1503) - lu(k,288) * lu(k,1409) + lu(k,289) = 1._r8 / lu(k,289) + lu(k,290) = lu(k,290) * lu(k,289) + lu(k,291) = lu(k,291) * lu(k,289) + lu(k,292) = lu(k,292) * lu(k,289) + lu(k,293) = lu(k,293) * lu(k,289) + lu(k,294) = lu(k,294) * lu(k,289) + lu(k,975) = lu(k,975) - lu(k,290) * lu(k,972) + lu(k,979) = lu(k,979) - lu(k,291) * lu(k,972) + lu(k,982) = - lu(k,292) * lu(k,972) + lu(k,985) = - lu(k,293) * lu(k,972) + lu(k,989) = lu(k,989) - lu(k,294) * lu(k,972) + lu(k,1470) = lu(k,1470) - lu(k,290) * lu(k,1410) + lu(k,1480) = lu(k,1480) - lu(k,291) * lu(k,1410) + lu(k,1495) = lu(k,1495) - lu(k,292) * lu(k,1410) + lu(k,1499) = lu(k,1499) - lu(k,293) * lu(k,1410) + lu(k,1507) = lu(k,1507) - lu(k,294) * lu(k,1410) + lu(k,1656) = - lu(k,290) * lu(k,1612) + lu(k,1664) = lu(k,1664) - lu(k,291) * lu(k,1612) + lu(k,1678) = - lu(k,292) * lu(k,1612) + lu(k,1682) = lu(k,1682) - lu(k,293) * lu(k,1612) + lu(k,1690) = lu(k,1690) - lu(k,294) * lu(k,1612) + lu(k,295) = 1._r8 / lu(k,295) + lu(k,296) = lu(k,296) * lu(k,295) + lu(k,297) = lu(k,297) * lu(k,295) + lu(k,298) = lu(k,298) * lu(k,295) + lu(k,299) = lu(k,299) * lu(k,295) + lu(k,300) = lu(k,300) * lu(k,295) + lu(k,1319) = - lu(k,296) * lu(k,1288) + lu(k,1320) = lu(k,1320) - lu(k,297) * lu(k,1288) + lu(k,1322) = lu(k,1322) - lu(k,298) * lu(k,1288) + lu(k,1323) = lu(k,1323) - lu(k,299) * lu(k,1288) + lu(k,1333) = - lu(k,300) * lu(k,1288) + lu(k,1496) = lu(k,1496) - lu(k,296) * lu(k,1411) + lu(k,1497) = lu(k,1497) - lu(k,297) * lu(k,1411) + lu(k,1499) = lu(k,1499) - lu(k,298) * lu(k,1411) + lu(k,1501) = lu(k,1501) - lu(k,299) * lu(k,1411) + lu(k,1511) = lu(k,1511) - lu(k,300) * lu(k,1411) + lu(k,1679) = lu(k,1679) - lu(k,296) * lu(k,1613) + lu(k,1680) = lu(k,1680) - lu(k,297) * lu(k,1613) + lu(k,1682) = lu(k,1682) - lu(k,298) * lu(k,1613) + lu(k,1684) = lu(k,1684) - lu(k,299) * lu(k,1613) + lu(k,1694) = lu(k,1694) - lu(k,300) * lu(k,1613) + lu(k,301) = 1._r8 / lu(k,301) + lu(k,302) = lu(k,302) * lu(k,301) + lu(k,303) = lu(k,303) * lu(k,301) + lu(k,304) = lu(k,304) * lu(k,301) + lu(k,305) = lu(k,305) * lu(k,301) + lu(k,306) = lu(k,306) * lu(k,301) + lu(k,995) = lu(k,995) - lu(k,302) * lu(k,992) + lu(k,997) = lu(k,997) - lu(k,303) * lu(k,992) + lu(k,999) = lu(k,999) - lu(k,304) * lu(k,992) + lu(k,1000) = lu(k,1000) - lu(k,305) * lu(k,992) + lu(k,1004) = - lu(k,306) * lu(k,992) + lu(k,1481) = lu(k,1481) - lu(k,302) * lu(k,1412) + lu(k,1493) = lu(k,1493) - lu(k,303) * lu(k,1412) + lu(k,1499) = lu(k,1499) - lu(k,304) * lu(k,1412) + lu(k,1501) = lu(k,1501) - lu(k,305) * lu(k,1412) + lu(k,1511) = lu(k,1511) - lu(k,306) * lu(k,1412) + lu(k,1665) = lu(k,1665) - lu(k,302) * lu(k,1614) + lu(k,1676) = lu(k,1676) - lu(k,303) * lu(k,1614) + lu(k,1682) = lu(k,1682) - lu(k,304) * lu(k,1614) + lu(k,1684) = lu(k,1684) - lu(k,305) * lu(k,1614) + lu(k,1694) = lu(k,1694) - lu(k,306) * lu(k,1614) + end do + end subroutine lu_fac06 + subroutine lu_fac07( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,307) = 1._r8 / lu(k,307) + lu(k,308) = lu(k,308) * lu(k,307) + lu(k,309) = lu(k,309) * lu(k,307) + lu(k,310) = lu(k,310) * lu(k,307) + lu(k,311) = lu(k,311) * lu(k,307) + lu(k,312) = lu(k,312) * lu(k,307) + lu(k,661) = lu(k,661) - lu(k,308) * lu(k,660) + lu(k,662) = lu(k,662) - lu(k,309) * lu(k,660) + lu(k,665) = - lu(k,310) * lu(k,660) + lu(k,667) = lu(k,667) - lu(k,311) * lu(k,660) + lu(k,670) = - lu(k,312) * lu(k,660) + lu(k,1454) = lu(k,1454) - lu(k,308) * lu(k,1413) + lu(k,1467) = lu(k,1467) - lu(k,309) * lu(k,1413) + lu(k,1499) = lu(k,1499) - lu(k,310) * lu(k,1413) + lu(k,1503) = lu(k,1503) - lu(k,311) * lu(k,1413) + lu(k,1511) = lu(k,1511) - lu(k,312) * lu(k,1413) + lu(k,1646) = lu(k,1646) - lu(k,308) * lu(k,1615) + lu(k,1655) = - lu(k,309) * lu(k,1615) + lu(k,1682) = lu(k,1682) - lu(k,310) * lu(k,1615) + lu(k,1686) = lu(k,1686) - lu(k,311) * lu(k,1615) + lu(k,1694) = lu(k,1694) - lu(k,312) * lu(k,1615) + lu(k,313) = 1._r8 / lu(k,313) + lu(k,314) = lu(k,314) * lu(k,313) + lu(k,315) = lu(k,315) * lu(k,313) + lu(k,316) = lu(k,316) * lu(k,313) + lu(k,317) = lu(k,317) * lu(k,313) + lu(k,318) = lu(k,318) * lu(k,313) + lu(k,374) = lu(k,374) - lu(k,314) * lu(k,373) + lu(k,375) = lu(k,375) - lu(k,315) * lu(k,373) + lu(k,377) = lu(k,377) - lu(k,316) * lu(k,373) + lu(k,378) = - lu(k,317) * lu(k,373) + lu(k,379) = lu(k,379) - lu(k,318) * lu(k,373) + lu(k,1418) = lu(k,1418) - lu(k,314) * lu(k,1414) + lu(k,1422) = lu(k,1422) - lu(k,315) * lu(k,1414) + lu(k,1462) = lu(k,1462) - lu(k,316) * lu(k,1414) + lu(k,1499) = lu(k,1499) - lu(k,317) * lu(k,1414) + lu(k,1503) = lu(k,1503) - lu(k,318) * lu(k,1414) + lu(k,1621) = - lu(k,314) * lu(k,1616) + lu(k,1624) = lu(k,1624) - lu(k,315) * lu(k,1616) + lu(k,1652) = lu(k,1652) - lu(k,316) * lu(k,1616) + lu(k,1682) = lu(k,1682) - lu(k,317) * lu(k,1616) + lu(k,1686) = lu(k,1686) - lu(k,318) * lu(k,1616) + lu(k,319) = 1._r8 / lu(k,319) + lu(k,320) = lu(k,320) * lu(k,319) + lu(k,321) = lu(k,321) * lu(k,319) + lu(k,322) = lu(k,322) * lu(k,319) + lu(k,323) = lu(k,323) * lu(k,319) + lu(k,324) = lu(k,324) * lu(k,319) + lu(k,758) = - lu(k,320) * lu(k,756) + lu(k,764) = lu(k,764) - lu(k,321) * lu(k,756) + lu(k,768) = - lu(k,322) * lu(k,756) + lu(k,769) = lu(k,769) - lu(k,323) * lu(k,756) + lu(k,772) = lu(k,772) - lu(k,324) * lu(k,756) + lu(k,785) = - lu(k,320) * lu(k,783) + lu(k,791) = lu(k,791) - lu(k,321) * lu(k,783) + lu(k,795) = - lu(k,322) * lu(k,783) + lu(k,796) = lu(k,796) - lu(k,323) * lu(k,783) + lu(k,799) = lu(k,799) - lu(k,324) * lu(k,783) + lu(k,1827) = - lu(k,320) * lu(k,1817) + lu(k,1837) = lu(k,1837) - lu(k,321) * lu(k,1817) + lu(k,1845) = lu(k,1845) - lu(k,322) * lu(k,1817) + lu(k,1852) = lu(k,1852) - lu(k,323) * lu(k,1817) + lu(k,1862) = lu(k,1862) - lu(k,324) * lu(k,1817) + lu(k,325) = 1._r8 / lu(k,325) + lu(k,326) = lu(k,326) * lu(k,325) + lu(k,327) = lu(k,327) * lu(k,325) + lu(k,328) = lu(k,328) * lu(k,325) + lu(k,329) = lu(k,329) * lu(k,325) + lu(k,330) = lu(k,330) * lu(k,325) + lu(k,383) = lu(k,383) - lu(k,326) * lu(k,382) + lu(k,384) = lu(k,384) - lu(k,327) * lu(k,382) + lu(k,385) = lu(k,385) - lu(k,328) * lu(k,382) + lu(k,386) = - lu(k,329) * lu(k,382) + lu(k,387) = lu(k,387) - lu(k,330) * lu(k,382) + lu(k,1423) = lu(k,1423) - lu(k,326) * lu(k,1415) + lu(k,1462) = lu(k,1462) - lu(k,327) * lu(k,1415) + lu(k,1486) = lu(k,1486) - lu(k,328) * lu(k,1415) + lu(k,1499) = lu(k,1499) - lu(k,329) * lu(k,1415) + lu(k,1503) = lu(k,1503) - lu(k,330) * lu(k,1415) + lu(k,1625) = lu(k,1625) - lu(k,326) * lu(k,1617) + lu(k,1652) = lu(k,1652) - lu(k,327) * lu(k,1617) + lu(k,1670) = lu(k,1670) - lu(k,328) * lu(k,1617) + lu(k,1682) = lu(k,1682) - lu(k,329) * lu(k,1617) + lu(k,1686) = lu(k,1686) - lu(k,330) * lu(k,1617) + lu(k,333) = 1._r8 / lu(k,333) + lu(k,334) = lu(k,334) * lu(k,333) + lu(k,335) = lu(k,335) * lu(k,333) + lu(k,336) = lu(k,336) * lu(k,333) + lu(k,337) = lu(k,337) * lu(k,333) + lu(k,338) = lu(k,338) * lu(k,333) + lu(k,1427) = lu(k,1427) - lu(k,334) * lu(k,1416) + lu(k,1499) = lu(k,1499) - lu(k,335) * lu(k,1416) + lu(k,1503) = lu(k,1503) - lu(k,336) * lu(k,1416) + lu(k,1505) = lu(k,1505) - lu(k,337) * lu(k,1416) + lu(k,1507) = lu(k,1507) - lu(k,338) * lu(k,1416) + lu(k,1627) = lu(k,1627) - lu(k,334) * lu(k,1618) + lu(k,1682) = lu(k,1682) - lu(k,335) * lu(k,1618) + lu(k,1686) = lu(k,1686) - lu(k,336) * lu(k,1618) + lu(k,1688) = lu(k,1688) - lu(k,337) * lu(k,1618) + lu(k,1690) = lu(k,1690) - lu(k,338) * lu(k,1618) + lu(k,1748) = lu(k,1748) - lu(k,334) * lu(k,1740) + lu(k,1798) = lu(k,1798) - lu(k,335) * lu(k,1740) + lu(k,1802) = lu(k,1802) - lu(k,336) * lu(k,1740) + lu(k,1804) = lu(k,1804) - lu(k,337) * lu(k,1740) + lu(k,1806) = lu(k,1806) - lu(k,338) * lu(k,1740) + lu(k,339) = 1._r8 / lu(k,339) + lu(k,340) = lu(k,340) * lu(k,339) + lu(k,341) = lu(k,341) * lu(k,339) + lu(k,342) = lu(k,342) * lu(k,339) + lu(k,343) = lu(k,343) * lu(k,339) + lu(k,344) = lu(k,344) * lu(k,339) + lu(k,1537) = - lu(k,340) * lu(k,1536) + lu(k,1548) = lu(k,1548) - lu(k,341) * lu(k,1536) + lu(k,1550) = lu(k,1550) - lu(k,342) * lu(k,1536) + lu(k,1552) = - lu(k,343) * lu(k,1536) + lu(k,1554) = - lu(k,344) * lu(k,1536) + lu(k,1647) = lu(k,1647) - lu(k,340) * lu(k,1619) + lu(k,1684) = lu(k,1684) - lu(k,341) * lu(k,1619) + lu(k,1686) = lu(k,1686) - lu(k,342) * lu(k,1619) + lu(k,1688) = lu(k,1688) - lu(k,343) * lu(k,1619) + lu(k,1690) = lu(k,1690) - lu(k,344) * lu(k,1619) + lu(k,1764) = lu(k,1764) - lu(k,340) * lu(k,1741) + lu(k,1800) = lu(k,1800) - lu(k,341) * lu(k,1741) + lu(k,1802) = lu(k,1802) - lu(k,342) * lu(k,1741) + lu(k,1804) = lu(k,1804) - lu(k,343) * lu(k,1741) + lu(k,1806) = lu(k,1806) - lu(k,344) * lu(k,1741) + lu(k,346) = 1._r8 / lu(k,346) + lu(k,347) = lu(k,347) * lu(k,346) + lu(k,348) = lu(k,348) * lu(k,346) + lu(k,349) = lu(k,349) * lu(k,346) + lu(k,350) = lu(k,350) * lu(k,346) + lu(k,351) = lu(k,351) * lu(k,346) + lu(k,1462) = lu(k,1462) - lu(k,347) * lu(k,1417) + lu(k,1499) = lu(k,1499) - lu(k,348) * lu(k,1417) + lu(k,1503) = lu(k,1503) - lu(k,349) * lu(k,1417) + lu(k,1505) = lu(k,1505) - lu(k,350) * lu(k,1417) + lu(k,1507) = lu(k,1507) - lu(k,351) * lu(k,1417) + lu(k,1652) = lu(k,1652) - lu(k,347) * lu(k,1620) + lu(k,1682) = lu(k,1682) - lu(k,348) * lu(k,1620) + lu(k,1686) = lu(k,1686) - lu(k,349) * lu(k,1620) + lu(k,1688) = lu(k,1688) - lu(k,350) * lu(k,1620) + lu(k,1690) = lu(k,1690) - lu(k,351) * lu(k,1620) + lu(k,1767) = lu(k,1767) - lu(k,347) * lu(k,1742) + lu(k,1798) = lu(k,1798) - lu(k,348) * lu(k,1742) + lu(k,1802) = lu(k,1802) - lu(k,349) * lu(k,1742) + lu(k,1804) = lu(k,1804) - lu(k,350) * lu(k,1742) + lu(k,1806) = lu(k,1806) - lu(k,351) * lu(k,1742) + end do + end subroutine lu_fac07 + subroutine lu_fac08( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,352) = 1._r8 / lu(k,352) + lu(k,353) = lu(k,353) * lu(k,352) + lu(k,354) = lu(k,354) * lu(k,352) + lu(k,376) = - lu(k,353) * lu(k,374) + lu(k,379) = lu(k,379) - lu(k,354) * lu(k,374) + lu(k,495) = - lu(k,353) * lu(k,492) + lu(k,501) = lu(k,501) - lu(k,354) * lu(k,492) + lu(k,555) = - lu(k,353) * lu(k,552) + lu(k,564) = lu(k,564) - lu(k,354) * lu(k,552) + lu(k,584) = - lu(k,353) * lu(k,581) + lu(k,592) = lu(k,592) - lu(k,354) * lu(k,581) + lu(k,608) = - lu(k,353) * lu(k,605) + lu(k,617) = lu(k,617) - lu(k,354) * lu(k,605) + lu(k,1446) = - lu(k,353) * lu(k,1418) + lu(k,1503) = lu(k,1503) - lu(k,354) * lu(k,1418) + lu(k,1639) = lu(k,1639) - lu(k,353) * lu(k,1621) + lu(k,1686) = lu(k,1686) - lu(k,354) * lu(k,1621) + lu(k,1758) = lu(k,1758) - lu(k,353) * lu(k,1743) + lu(k,1802) = lu(k,1802) - lu(k,354) * lu(k,1743) + lu(k,355) = 1._r8 / lu(k,355) + lu(k,356) = lu(k,356) * lu(k,355) + lu(k,357) = lu(k,357) * lu(k,355) + lu(k,358) = lu(k,358) * lu(k,355) + lu(k,359) = lu(k,359) * lu(k,355) + lu(k,360) = lu(k,360) * lu(k,355) + lu(k,361) = lu(k,361) * lu(k,355) + lu(k,1233) = lu(k,1233) - lu(k,356) * lu(k,1216) + lu(k,1236) = lu(k,1236) - lu(k,357) * lu(k,1216) + lu(k,1237) = lu(k,1237) - lu(k,358) * lu(k,1216) + lu(k,1238) = lu(k,1238) - lu(k,359) * lu(k,1216) + lu(k,1242) = lu(k,1242) - lu(k,360) * lu(k,1216) + lu(k,1243) = - lu(k,361) * lu(k,1216) + lu(k,1493) = lu(k,1493) - lu(k,356) * lu(k,1419) + lu(k,1497) = lu(k,1497) - lu(k,357) * lu(k,1419) + lu(k,1499) = lu(k,1499) - lu(k,358) * lu(k,1419) + lu(k,1501) = lu(k,1501) - lu(k,359) * lu(k,1419) + lu(k,1507) = lu(k,1507) - lu(k,360) * lu(k,1419) + lu(k,1510) = lu(k,1510) - lu(k,361) * lu(k,1419) + lu(k,1893) = lu(k,1893) - lu(k,356) * lu(k,1875) + lu(k,1897) = - lu(k,357) * lu(k,1875) + lu(k,1899) = lu(k,1899) - lu(k,358) * lu(k,1875) + lu(k,1901) = - lu(k,359) * lu(k,1875) + lu(k,1907) = lu(k,1907) - lu(k,360) * lu(k,1875) + lu(k,1910) = lu(k,1910) - lu(k,361) * lu(k,1875) + lu(k,362) = 1._r8 / lu(k,362) + lu(k,363) = lu(k,363) * lu(k,362) + lu(k,364) = lu(k,364) * lu(k,362) + lu(k,365) = lu(k,365) * lu(k,362) + lu(k,514) = lu(k,514) - lu(k,363) * lu(k,513) + lu(k,518) = - lu(k,364) * lu(k,513) + lu(k,519) = lu(k,519) - lu(k,365) * lu(k,513) + lu(k,1440) = lu(k,1440) - lu(k,363) * lu(k,1420) + lu(k,1506) = lu(k,1506) - lu(k,364) * lu(k,1420) + lu(k,1507) = lu(k,1507) - lu(k,365) * lu(k,1420) + lu(k,1634) = lu(k,1634) - lu(k,363) * lu(k,1622) + lu(k,1689) = lu(k,1689) - lu(k,364) * lu(k,1622) + lu(k,1690) = lu(k,1690) - lu(k,365) * lu(k,1622) + lu(k,1754) = lu(k,1754) - lu(k,363) * lu(k,1744) + lu(k,1805) = lu(k,1805) - lu(k,364) * lu(k,1744) + lu(k,1806) = lu(k,1806) - lu(k,365) * lu(k,1744) + lu(k,1822) = lu(k,1822) - lu(k,363) * lu(k,1818) + lu(k,1865) = lu(k,1865) - lu(k,364) * lu(k,1818) + lu(k,1866) = lu(k,1866) - lu(k,365) * lu(k,1818) + lu(k,1880) = - lu(k,363) * lu(k,1876) + lu(k,1906) = lu(k,1906) - lu(k,364) * lu(k,1876) + lu(k,1907) = lu(k,1907) - lu(k,365) * lu(k,1876) + lu(k,366) = 1._r8 / lu(k,366) + lu(k,367) = lu(k,367) * lu(k,366) + lu(k,368) = lu(k,368) * lu(k,366) + lu(k,369) = lu(k,369) * lu(k,366) + lu(k,370) = lu(k,370) * lu(k,366) + lu(k,371) = lu(k,371) * lu(k,366) + lu(k,372) = lu(k,372) * lu(k,366) + lu(k,934) = lu(k,934) - lu(k,367) * lu(k,931) + lu(k,935) = lu(k,935) - lu(k,368) * lu(k,931) + lu(k,938) = lu(k,938) - lu(k,369) * lu(k,931) + lu(k,946) = - lu(k,370) * lu(k,931) + lu(k,947) = lu(k,947) - lu(k,371) * lu(k,931) + lu(k,948) = lu(k,948) - lu(k,372) * lu(k,931) + lu(k,1467) = lu(k,1467) - lu(k,367) * lu(k,1421) + lu(k,1470) = lu(k,1470) - lu(k,368) * lu(k,1421) + lu(k,1478) = lu(k,1478) - lu(k,369) * lu(k,1421) + lu(k,1499) = lu(k,1499) - lu(k,370) * lu(k,1421) + lu(k,1501) = lu(k,1501) - lu(k,371) * lu(k,1421) + lu(k,1503) = lu(k,1503) - lu(k,372) * lu(k,1421) + lu(k,1655) = lu(k,1655) - lu(k,367) * lu(k,1623) + lu(k,1656) = lu(k,1656) - lu(k,368) * lu(k,1623) + lu(k,1662) = lu(k,1662) - lu(k,369) * lu(k,1623) + lu(k,1682) = lu(k,1682) - lu(k,370) * lu(k,1623) + lu(k,1684) = lu(k,1684) - lu(k,371) * lu(k,1623) + lu(k,1686) = lu(k,1686) - lu(k,372) * lu(k,1623) + lu(k,375) = 1._r8 / lu(k,375) + lu(k,376) = lu(k,376) * lu(k,375) + lu(k,377) = lu(k,377) * lu(k,375) + lu(k,378) = lu(k,378) * lu(k,375) + lu(k,379) = lu(k,379) * lu(k,375) + lu(k,380) = lu(k,380) * lu(k,375) + lu(k,381) = lu(k,381) * lu(k,375) + lu(k,1446) = lu(k,1446) - lu(k,376) * lu(k,1422) + lu(k,1462) = lu(k,1462) - lu(k,377) * lu(k,1422) + lu(k,1499) = lu(k,1499) - lu(k,378) * lu(k,1422) + lu(k,1503) = lu(k,1503) - lu(k,379) * lu(k,1422) + lu(k,1505) = lu(k,1505) - lu(k,380) * lu(k,1422) + lu(k,1507) = lu(k,1507) - lu(k,381) * lu(k,1422) + lu(k,1639) = lu(k,1639) - lu(k,376) * lu(k,1624) + lu(k,1652) = lu(k,1652) - lu(k,377) * lu(k,1624) + lu(k,1682) = lu(k,1682) - lu(k,378) * lu(k,1624) + lu(k,1686) = lu(k,1686) - lu(k,379) * lu(k,1624) + lu(k,1688) = lu(k,1688) - lu(k,380) * lu(k,1624) + lu(k,1690) = lu(k,1690) - lu(k,381) * lu(k,1624) + lu(k,1758) = lu(k,1758) - lu(k,376) * lu(k,1745) + lu(k,1767) = lu(k,1767) - lu(k,377) * lu(k,1745) + lu(k,1798) = lu(k,1798) - lu(k,378) * lu(k,1745) + lu(k,1802) = lu(k,1802) - lu(k,379) * lu(k,1745) + lu(k,1804) = lu(k,1804) - lu(k,380) * lu(k,1745) + lu(k,1806) = lu(k,1806) - lu(k,381) * lu(k,1745) + lu(k,383) = 1._r8 / lu(k,383) + lu(k,384) = lu(k,384) * lu(k,383) + lu(k,385) = lu(k,385) * lu(k,383) + lu(k,386) = lu(k,386) * lu(k,383) + lu(k,387) = lu(k,387) * lu(k,383) + lu(k,388) = lu(k,388) * lu(k,383) + lu(k,389) = lu(k,389) * lu(k,383) + lu(k,1462) = lu(k,1462) - lu(k,384) * lu(k,1423) + lu(k,1486) = lu(k,1486) - lu(k,385) * lu(k,1423) + lu(k,1499) = lu(k,1499) - lu(k,386) * lu(k,1423) + lu(k,1503) = lu(k,1503) - lu(k,387) * lu(k,1423) + lu(k,1505) = lu(k,1505) - lu(k,388) * lu(k,1423) + lu(k,1507) = lu(k,1507) - lu(k,389) * lu(k,1423) + lu(k,1652) = lu(k,1652) - lu(k,384) * lu(k,1625) + lu(k,1670) = lu(k,1670) - lu(k,385) * lu(k,1625) + lu(k,1682) = lu(k,1682) - lu(k,386) * lu(k,1625) + lu(k,1686) = lu(k,1686) - lu(k,387) * lu(k,1625) + lu(k,1688) = lu(k,1688) - lu(k,388) * lu(k,1625) + lu(k,1690) = lu(k,1690) - lu(k,389) * lu(k,1625) + lu(k,1767) = lu(k,1767) - lu(k,384) * lu(k,1746) + lu(k,1786) = lu(k,1786) - lu(k,385) * lu(k,1746) + lu(k,1798) = lu(k,1798) - lu(k,386) * lu(k,1746) + lu(k,1802) = lu(k,1802) - lu(k,387) * lu(k,1746) + lu(k,1804) = lu(k,1804) - lu(k,388) * lu(k,1746) + lu(k,1806) = lu(k,1806) - lu(k,389) * lu(k,1746) + lu(k,390) = 1._r8 / lu(k,390) + lu(k,391) = lu(k,391) * lu(k,390) + lu(k,392) = lu(k,392) * lu(k,390) + lu(k,393) = lu(k,393) * lu(k,390) + lu(k,394) = lu(k,394) * lu(k,390) + lu(k,395) = lu(k,395) * lu(k,390) + lu(k,1083) = lu(k,1083) - lu(k,391) * lu(k,1081) + lu(k,1085) = lu(k,1085) - lu(k,392) * lu(k,1081) + lu(k,1086) = lu(k,1086) - lu(k,393) * lu(k,1081) + lu(k,1088) = lu(k,1088) - lu(k,394) * lu(k,1081) + lu(k,1092) = lu(k,1092) - lu(k,395) * lu(k,1081) + lu(k,1487) = lu(k,1487) - lu(k,391) * lu(k,1424) + lu(k,1496) = lu(k,1496) - lu(k,392) * lu(k,1424) + lu(k,1499) = lu(k,1499) - lu(k,393) * lu(k,1424) + lu(k,1502) = lu(k,1502) - lu(k,394) * lu(k,1424) + lu(k,1506) = lu(k,1506) - lu(k,395) * lu(k,1424) + lu(k,1570) = lu(k,1570) - lu(k,391) * lu(k,1560) + lu(k,1573) = lu(k,1573) - lu(k,392) * lu(k,1560) + lu(k,1576) = lu(k,1576) - lu(k,393) * lu(k,1560) + lu(k,1579) = lu(k,1579) - lu(k,394) * lu(k,1560) + lu(k,1583) = lu(k,1583) - lu(k,395) * lu(k,1560) + lu(k,1846) = lu(k,1846) - lu(k,391) * lu(k,1819) + lu(k,1855) = lu(k,1855) - lu(k,392) * lu(k,1819) + lu(k,1858) = lu(k,1858) - lu(k,393) * lu(k,1819) + lu(k,1861) = lu(k,1861) - lu(k,394) * lu(k,1819) + lu(k,1865) = lu(k,1865) - lu(k,395) * lu(k,1819) + end do + end subroutine lu_fac08 + subroutine lu_fac09( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,396) = 1._r8 / lu(k,396) + lu(k,397) = lu(k,397) * lu(k,396) + lu(k,398) = lu(k,398) * lu(k,396) + lu(k,399) = lu(k,399) * lu(k,396) + lu(k,400) = lu(k,400) * lu(k,396) + lu(k,522) = - lu(k,397) * lu(k,520) + lu(k,523) = - lu(k,398) * lu(k,520) + lu(k,527) = - lu(k,399) * lu(k,520) + lu(k,528) = lu(k,528) - lu(k,400) * lu(k,520) + lu(k,533) = - lu(k,397) * lu(k,531) + lu(k,534) = - lu(k,398) * lu(k,531) + lu(k,537) = - lu(k,399) * lu(k,531) + lu(k,538) = lu(k,538) - lu(k,400) * lu(k,531) + lu(k,806) = - lu(k,397) * lu(k,803) + lu(k,807) = - lu(k,398) * lu(k,803) + lu(k,811) = - lu(k,399) * lu(k,803) + lu(k,813) = - lu(k,400) * lu(k,803) + lu(k,1443) = lu(k,1443) - lu(k,397) * lu(k,1425) + lu(k,1457) = lu(k,1457) - lu(k,398) * lu(k,1425) + lu(k,1493) = lu(k,1493) - lu(k,399) * lu(k,1425) + lu(k,1499) = lu(k,1499) - lu(k,400) * lu(k,1425) + lu(k,1756) = lu(k,1756) - lu(k,397) * lu(k,1747) + lu(k,1765) = lu(k,1765) - lu(k,398) * lu(k,1747) + lu(k,1792) = lu(k,1792) - lu(k,399) * lu(k,1747) + lu(k,1798) = lu(k,1798) - lu(k,400) * lu(k,1747) + lu(k,401) = 1._r8 / lu(k,401) + lu(k,402) = lu(k,402) * lu(k,401) + lu(k,403) = lu(k,403) * lu(k,401) + lu(k,404) = lu(k,404) * lu(k,401) + lu(k,405) = lu(k,405) * lu(k,401) + lu(k,406) = lu(k,406) * lu(k,401) + lu(k,1203) = lu(k,1203) - lu(k,402) * lu(k,1197) + lu(k,1206) = lu(k,1206) - lu(k,403) * lu(k,1197) + lu(k,1207) = lu(k,1207) - lu(k,404) * lu(k,1197) + lu(k,1208) = lu(k,1208) - lu(k,405) * lu(k,1197) + lu(k,1214) = - lu(k,406) * lu(k,1197) + lu(k,1233) = lu(k,1233) - lu(k,402) * lu(k,1217) + lu(k,1236) = lu(k,1236) - lu(k,403) * lu(k,1217) + lu(k,1237) = lu(k,1237) - lu(k,404) * lu(k,1217) + lu(k,1238) = lu(k,1238) - lu(k,405) * lu(k,1217) + lu(k,1244) = - lu(k,406) * lu(k,1217) + lu(k,1493) = lu(k,1493) - lu(k,402) * lu(k,1426) + lu(k,1497) = lu(k,1497) - lu(k,403) * lu(k,1426) + lu(k,1499) = lu(k,1499) - lu(k,404) * lu(k,1426) + lu(k,1501) = lu(k,1501) - lu(k,405) * lu(k,1426) + lu(k,1511) = lu(k,1511) - lu(k,406) * lu(k,1426) + lu(k,1676) = lu(k,1676) - lu(k,402) * lu(k,1626) + lu(k,1680) = lu(k,1680) - lu(k,403) * lu(k,1626) + lu(k,1682) = lu(k,1682) - lu(k,404) * lu(k,1626) + lu(k,1684) = lu(k,1684) - lu(k,405) * lu(k,1626) + lu(k,1694) = lu(k,1694) - lu(k,406) * lu(k,1626) + lu(k,408) = 1._r8 / lu(k,408) + lu(k,409) = lu(k,409) * lu(k,408) + lu(k,410) = lu(k,410) * lu(k,408) + lu(k,411) = lu(k,411) * lu(k,408) + lu(k,412) = lu(k,412) * lu(k,408) + lu(k,413) = lu(k,413) * lu(k,408) + lu(k,1440) = lu(k,1440) - lu(k,409) * lu(k,1427) + lu(k,1499) = lu(k,1499) - lu(k,410) * lu(k,1427) + lu(k,1503) = lu(k,1503) - lu(k,411) * lu(k,1427) + lu(k,1505) = lu(k,1505) - lu(k,412) * lu(k,1427) + lu(k,1507) = lu(k,1507) - lu(k,413) * lu(k,1427) + lu(k,1634) = lu(k,1634) - lu(k,409) * lu(k,1627) + lu(k,1682) = lu(k,1682) - lu(k,410) * lu(k,1627) + lu(k,1686) = lu(k,1686) - lu(k,411) * lu(k,1627) + lu(k,1688) = lu(k,1688) - lu(k,412) * lu(k,1627) + lu(k,1690) = lu(k,1690) - lu(k,413) * lu(k,1627) + lu(k,1754) = lu(k,1754) - lu(k,409) * lu(k,1748) + lu(k,1798) = lu(k,1798) - lu(k,410) * lu(k,1748) + lu(k,1802) = lu(k,1802) - lu(k,411) * lu(k,1748) + lu(k,1804) = lu(k,1804) - lu(k,412) * lu(k,1748) + lu(k,1806) = lu(k,1806) - lu(k,413) * lu(k,1748) + lu(k,1880) = lu(k,1880) - lu(k,409) * lu(k,1877) + lu(k,1899) = lu(k,1899) - lu(k,410) * lu(k,1877) + lu(k,1903) = lu(k,1903) - lu(k,411) * lu(k,1877) + lu(k,1905) = lu(k,1905) - lu(k,412) * lu(k,1877) + lu(k,1907) = lu(k,1907) - lu(k,413) * lu(k,1877) + lu(k,414) = 1._r8 / lu(k,414) + lu(k,415) = lu(k,415) * lu(k,414) + lu(k,416) = lu(k,416) * lu(k,414) + lu(k,417) = lu(k,417) * lu(k,414) + lu(k,418) = lu(k,418) * lu(k,414) + lu(k,419) = lu(k,419) * lu(k,414) + lu(k,420) = lu(k,420) * lu(k,414) + lu(k,421) = lu(k,421) * lu(k,414) + lu(k,1515) = lu(k,1515) - lu(k,415) * lu(k,1514) + lu(k,1518) = lu(k,1518) - lu(k,416) * lu(k,1514) + lu(k,1519) = - lu(k,417) * lu(k,1514) + lu(k,1524) = lu(k,1524) - lu(k,418) * lu(k,1514) + lu(k,1526) = lu(k,1526) - lu(k,419) * lu(k,1514) + lu(k,1531) = lu(k,1531) - lu(k,420) * lu(k,1514) + lu(k,1534) = - lu(k,421) * lu(k,1514) + lu(k,1563) = lu(k,1563) - lu(k,415) * lu(k,1561) + lu(k,1571) = lu(k,1571) - lu(k,416) * lu(k,1561) + lu(k,1572) = - lu(k,417) * lu(k,1561) + lu(k,1577) = lu(k,1577) - lu(k,418) * lu(k,1561) + lu(k,1579) = lu(k,1579) - lu(k,419) * lu(k,1561) + lu(k,1584) = lu(k,1584) - lu(k,420) * lu(k,1561) + lu(k,1587) = lu(k,1587) - lu(k,421) * lu(k,1561) + lu(k,1883) = - lu(k,415) * lu(k,1878) + lu(k,1894) = - lu(k,416) * lu(k,1878) + lu(k,1895) = lu(k,1895) - lu(k,417) * lu(k,1878) + lu(k,1900) = lu(k,1900) - lu(k,418) * lu(k,1878) + lu(k,1902) = lu(k,1902) - lu(k,419) * lu(k,1878) + lu(k,1907) = lu(k,1907) - lu(k,420) * lu(k,1878) + lu(k,1910) = lu(k,1910) - lu(k,421) * lu(k,1878) + lu(k,422) = 1._r8 / lu(k,422) + lu(k,423) = lu(k,423) * lu(k,422) + lu(k,424) = lu(k,424) * lu(k,422) + lu(k,425) = lu(k,425) * lu(k,422) + lu(k,426) = lu(k,426) * lu(k,422) + lu(k,427) = lu(k,427) * lu(k,422) + lu(k,428) = lu(k,428) * lu(k,422) + lu(k,429) = lu(k,429) * lu(k,422) + lu(k,629) = lu(k,629) - lu(k,423) * lu(k,628) + lu(k,630) = lu(k,630) - lu(k,424) * lu(k,628) + lu(k,631) = - lu(k,425) * lu(k,628) + lu(k,632) = - lu(k,426) * lu(k,628) + lu(k,633) = lu(k,633) - lu(k,427) * lu(k,628) + lu(k,634) = lu(k,634) - lu(k,428) * lu(k,628) + lu(k,637) = - lu(k,429) * lu(k,628) + lu(k,1451) = lu(k,1451) - lu(k,423) * lu(k,1428) + lu(k,1474) = lu(k,1474) - lu(k,424) * lu(k,1428) + lu(k,1477) = lu(k,1477) - lu(k,425) * lu(k,1428) + lu(k,1499) = lu(k,1499) - lu(k,426) * lu(k,1428) + lu(k,1501) = lu(k,1501) - lu(k,427) * lu(k,1428) + lu(k,1503) = lu(k,1503) - lu(k,428) * lu(k,1428) + lu(k,1511) = lu(k,1511) - lu(k,429) * lu(k,1428) + lu(k,1644) = lu(k,1644) - lu(k,423) * lu(k,1628) + lu(k,1659) = lu(k,1659) - lu(k,424) * lu(k,1628) + lu(k,1661) = - lu(k,425) * lu(k,1628) + lu(k,1682) = lu(k,1682) - lu(k,426) * lu(k,1628) + lu(k,1684) = lu(k,1684) - lu(k,427) * lu(k,1628) + lu(k,1686) = lu(k,1686) - lu(k,428) * lu(k,1628) + lu(k,1694) = lu(k,1694) - lu(k,429) * lu(k,1628) + end do + end subroutine lu_fac09 + subroutine lu_fac10( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,430) = 1._r8 / lu(k,430) + lu(k,431) = lu(k,431) * lu(k,430) + lu(k,432) = lu(k,432) * lu(k,430) + lu(k,433) = lu(k,433) * lu(k,430) + lu(k,846) = lu(k,846) - lu(k,431) * lu(k,836) + lu(k,847) = lu(k,847) - lu(k,432) * lu(k,836) + lu(k,854) = - lu(k,433) * lu(k,836) + lu(k,1206) = lu(k,1206) - lu(k,431) * lu(k,1198) + lu(k,1207) = lu(k,1207) - lu(k,432) * lu(k,1198) + lu(k,1214) = lu(k,1214) - lu(k,433) * lu(k,1198) + lu(k,1236) = lu(k,1236) - lu(k,431) * lu(k,1218) + lu(k,1237) = lu(k,1237) - lu(k,432) * lu(k,1218) + lu(k,1244) = lu(k,1244) - lu(k,433) * lu(k,1218) + lu(k,1320) = lu(k,1320) - lu(k,431) * lu(k,1289) + lu(k,1322) = lu(k,1322) - lu(k,432) * lu(k,1289) + lu(k,1333) = lu(k,1333) - lu(k,433) * lu(k,1289) + lu(k,1497) = lu(k,1497) - lu(k,431) * lu(k,1429) + lu(k,1499) = lu(k,1499) - lu(k,432) * lu(k,1429) + lu(k,1511) = lu(k,1511) - lu(k,433) * lu(k,1429) + lu(k,1680) = lu(k,1680) - lu(k,431) * lu(k,1629) + lu(k,1682) = lu(k,1682) - lu(k,432) * lu(k,1629) + lu(k,1694) = lu(k,1694) - lu(k,433) * lu(k,1629) + lu(k,1856) = lu(k,1856) - lu(k,431) * lu(k,1820) + lu(k,1858) = lu(k,1858) - lu(k,432) * lu(k,1820) + lu(k,1870) = - lu(k,433) * lu(k,1820) + lu(k,434) = 1._r8 / lu(k,434) + lu(k,435) = lu(k,435) * lu(k,434) + lu(k,436) = lu(k,436) * lu(k,434) + lu(k,437) = lu(k,437) * lu(k,434) + lu(k,438) = lu(k,438) * lu(k,434) + lu(k,439) = lu(k,439) * lu(k,434) + lu(k,440) = lu(k,440) * lu(k,434) + lu(k,441) = lu(k,441) * lu(k,434) + lu(k,1102) = - lu(k,435) * lu(k,1098) + lu(k,1105) = lu(k,1105) - lu(k,436) * lu(k,1098) + lu(k,1107) = - lu(k,437) * lu(k,1098) + lu(k,1108) = lu(k,1108) - lu(k,438) * lu(k,1098) + lu(k,1118) = - lu(k,439) * lu(k,1098) + lu(k,1121) = lu(k,1121) - lu(k,440) * lu(k,1098) + lu(k,1123) = lu(k,1123) - lu(k,441) * lu(k,1098) + lu(k,1461) = lu(k,1461) - lu(k,435) * lu(k,1430) + lu(k,1471) = lu(k,1471) - lu(k,436) * lu(k,1430) + lu(k,1476) = lu(k,1476) - lu(k,437) * lu(k,1430) + lu(k,1477) = lu(k,1477) - lu(k,438) * lu(k,1430) + lu(k,1495) = lu(k,1495) - lu(k,439) * lu(k,1430) + lu(k,1499) = lu(k,1499) - lu(k,440) * lu(k,1430) + lu(k,1503) = lu(k,1503) - lu(k,441) * lu(k,1430) + lu(k,1766) = - lu(k,435) * lu(k,1749) + lu(k,1772) = lu(k,1772) - lu(k,436) * lu(k,1749) + lu(k,1777) = lu(k,1777) - lu(k,437) * lu(k,1749) + lu(k,1778) = lu(k,1778) - lu(k,438) * lu(k,1749) + lu(k,1794) = lu(k,1794) - lu(k,439) * lu(k,1749) + lu(k,1798) = lu(k,1798) - lu(k,440) * lu(k,1749) + lu(k,1802) = lu(k,1802) - lu(k,441) * lu(k,1749) + lu(k,442) = 1._r8 / lu(k,442) + lu(k,443) = lu(k,443) * lu(k,442) + lu(k,444) = lu(k,444) * lu(k,442) + lu(k,445) = lu(k,445) * lu(k,442) + lu(k,446) = lu(k,446) * lu(k,442) + lu(k,447) = lu(k,447) * lu(k,442) + lu(k,448) = lu(k,448) * lu(k,442) + lu(k,449) = lu(k,449) * lu(k,442) + lu(k,1445) = lu(k,1445) - lu(k,443) * lu(k,1431) + lu(k,1455) = lu(k,1455) - lu(k,444) * lu(k,1431) + lu(k,1475) = lu(k,1475) - lu(k,445) * lu(k,1431) + lu(k,1499) = lu(k,1499) - lu(k,446) * lu(k,1431) + lu(k,1501) = lu(k,1501) - lu(k,447) * lu(k,1431) + lu(k,1503) = lu(k,1503) - lu(k,448) * lu(k,1431) + lu(k,1506) = lu(k,1506) - lu(k,449) * lu(k,1431) + lu(k,1823) = - lu(k,443) * lu(k,1821) + lu(k,1824) = lu(k,1824) - lu(k,444) * lu(k,1821) + lu(k,1837) = lu(k,1837) - lu(k,445) * lu(k,1821) + lu(k,1858) = lu(k,1858) - lu(k,446) * lu(k,1821) + lu(k,1860) = lu(k,1860) - lu(k,447) * lu(k,1821) + lu(k,1862) = lu(k,1862) - lu(k,448) * lu(k,1821) + lu(k,1865) = lu(k,1865) - lu(k,449) * lu(k,1821) + lu(k,1940) = - lu(k,443) * lu(k,1938) + lu(k,1941) = lu(k,1941) - lu(k,444) * lu(k,1938) + lu(k,1948) = lu(k,1948) - lu(k,445) * lu(k,1938) + lu(k,1956) = lu(k,1956) - lu(k,446) * lu(k,1938) + lu(k,1958) = lu(k,1958) - lu(k,447) * lu(k,1938) + lu(k,1960) = lu(k,1960) - lu(k,448) * lu(k,1938) + lu(k,1963) = lu(k,1963) - lu(k,449) * lu(k,1938) + lu(k,450) = 1._r8 / lu(k,450) + lu(k,451) = lu(k,451) * lu(k,450) + lu(k,452) = lu(k,452) * lu(k,450) + lu(k,453) = lu(k,453) * lu(k,450) + lu(k,454) = lu(k,454) * lu(k,450) + lu(k,455) = lu(k,455) * lu(k,450) + lu(k,456) = lu(k,456) * lu(k,450) + lu(k,457) = lu(k,457) * lu(k,450) + lu(k,1467) = lu(k,1467) - lu(k,451) * lu(k,1432) + lu(k,1474) = lu(k,1474) - lu(k,452) * lu(k,1432) + lu(k,1476) = lu(k,1476) - lu(k,453) * lu(k,1432) + lu(k,1501) = lu(k,1501) - lu(k,454) * lu(k,1432) + lu(k,1503) = lu(k,1503) - lu(k,455) * lu(k,1432) + lu(k,1505) = lu(k,1505) - lu(k,456) * lu(k,1432) + lu(k,1507) = lu(k,1507) - lu(k,457) * lu(k,1432) + lu(k,1770) = lu(k,1770) - lu(k,451) * lu(k,1750) + lu(k,1775) = lu(k,1775) - lu(k,452) * lu(k,1750) + lu(k,1777) = lu(k,1777) - lu(k,453) * lu(k,1750) + lu(k,1800) = lu(k,1800) - lu(k,454) * lu(k,1750) + lu(k,1802) = lu(k,1802) - lu(k,455) * lu(k,1750) + lu(k,1804) = lu(k,1804) - lu(k,456) * lu(k,1750) + lu(k,1806) = lu(k,1806) - lu(k,457) * lu(k,1750) + lu(k,1983) = lu(k,1983) - lu(k,451) * lu(k,1975) + lu(k,1989) = lu(k,1989) - lu(k,452) * lu(k,1975) + lu(k,1991) = - lu(k,453) * lu(k,1975) + lu(k,2015) = lu(k,2015) - lu(k,454) * lu(k,1975) + lu(k,2017) = lu(k,2017) - lu(k,455) * lu(k,1975) + lu(k,2019) = lu(k,2019) - lu(k,456) * lu(k,1975) + lu(k,2021) = lu(k,2021) - lu(k,457) * lu(k,1975) + lu(k,458) = 1._r8 / lu(k,458) + lu(k,459) = lu(k,459) * lu(k,458) + lu(k,460) = lu(k,460) * lu(k,458) + lu(k,461) = lu(k,461) * lu(k,458) + lu(k,462) = lu(k,462) * lu(k,458) + lu(k,463) = lu(k,463) * lu(k,458) + lu(k,464) = lu(k,464) * lu(k,458) + lu(k,465) = lu(k,465) * lu(k,458) + lu(k,1200) = - lu(k,459) * lu(k,1199) + lu(k,1202) = lu(k,1202) - lu(k,460) * lu(k,1199) + lu(k,1207) = lu(k,1207) - lu(k,461) * lu(k,1199) + lu(k,1208) = lu(k,1208) - lu(k,462) * lu(k,1199) + lu(k,1209) = lu(k,1209) - lu(k,463) * lu(k,1199) + lu(k,1212) = lu(k,1212) - lu(k,464) * lu(k,1199) + lu(k,1213) = lu(k,1213) - lu(k,465) * lu(k,1199) + lu(k,1477) = lu(k,1477) - lu(k,459) * lu(k,1433) + lu(k,1492) = lu(k,1492) - lu(k,460) * lu(k,1433) + lu(k,1499) = lu(k,1499) - lu(k,461) * lu(k,1433) + lu(k,1501) = lu(k,1501) - lu(k,462) * lu(k,1433) + lu(k,1503) = lu(k,1503) - lu(k,463) * lu(k,1433) + lu(k,1507) = lu(k,1507) - lu(k,464) * lu(k,1433) + lu(k,1510) = lu(k,1510) - lu(k,465) * lu(k,1433) + lu(k,1889) = - lu(k,459) * lu(k,1879) + lu(k,1892) = lu(k,1892) - lu(k,460) * lu(k,1879) + lu(k,1899) = lu(k,1899) - lu(k,461) * lu(k,1879) + lu(k,1901) = lu(k,1901) - lu(k,462) * lu(k,1879) + lu(k,1903) = lu(k,1903) - lu(k,463) * lu(k,1879) + lu(k,1907) = lu(k,1907) - lu(k,464) * lu(k,1879) + lu(k,1910) = lu(k,1910) - lu(k,465) * lu(k,1879) + lu(k,466) = 1._r8 / lu(k,466) + lu(k,467) = lu(k,467) * lu(k,466) + lu(k,468) = lu(k,468) * lu(k,466) + lu(k,469) = lu(k,469) * lu(k,466) + lu(k,470) = lu(k,470) * lu(k,466) + lu(k,471) = lu(k,471) * lu(k,466) + lu(k,472) = lu(k,472) * lu(k,466) + lu(k,1499) = lu(k,1499) - lu(k,467) * lu(k,1434) + lu(k,1502) = lu(k,1502) - lu(k,468) * lu(k,1434) + lu(k,1503) = lu(k,1503) - lu(k,469) * lu(k,1434) + lu(k,1508) = lu(k,1508) - lu(k,470) * lu(k,1434) + lu(k,1509) = lu(k,1509) - lu(k,471) * lu(k,1434) + lu(k,1511) = lu(k,1511) - lu(k,472) * lu(k,1434) + lu(k,1576) = lu(k,1576) - lu(k,467) * lu(k,1562) + lu(k,1579) = lu(k,1579) - lu(k,468) * lu(k,1562) + lu(k,1580) = lu(k,1580) - lu(k,469) * lu(k,1562) + lu(k,1585) = lu(k,1585) - lu(k,470) * lu(k,1562) + lu(k,1586) = lu(k,1586) - lu(k,471) * lu(k,1562) + lu(k,1588) = - lu(k,472) * lu(k,1562) + lu(k,1682) = lu(k,1682) - lu(k,467) * lu(k,1630) + lu(k,1685) = lu(k,1685) - lu(k,468) * lu(k,1630) + lu(k,1686) = lu(k,1686) - lu(k,469) * lu(k,1630) + lu(k,1691) = lu(k,1691) - lu(k,470) * lu(k,1630) + lu(k,1692) = lu(k,1692) - lu(k,471) * lu(k,1630) + lu(k,1694) = lu(k,1694) - lu(k,472) * lu(k,1630) + lu(k,1956) = lu(k,1956) - lu(k,467) * lu(k,1939) + lu(k,1959) = - lu(k,468) * lu(k,1939) + lu(k,1960) = lu(k,1960) - lu(k,469) * lu(k,1939) + lu(k,1965) = lu(k,1965) - lu(k,470) * lu(k,1939) + lu(k,1966) = lu(k,1966) - lu(k,471) * lu(k,1939) + lu(k,1968) = lu(k,1968) - lu(k,472) * lu(k,1939) + end do + end subroutine lu_fac10 + subroutine lu_fac11( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,473) = 1._r8 / lu(k,473) + lu(k,474) = lu(k,474) * lu(k,473) + lu(k,475) = lu(k,475) * lu(k,473) + lu(k,476) = lu(k,476) * lu(k,473) + lu(k,477) = lu(k,477) * lu(k,473) + lu(k,478) = lu(k,478) * lu(k,473) + lu(k,479) = lu(k,479) * lu(k,473) + lu(k,480) = lu(k,480) * lu(k,473) + lu(k,481) = lu(k,481) * lu(k,473) + lu(k,1173) = - lu(k,474) * lu(k,1170) + lu(k,1175) = - lu(k,475) * lu(k,1170) + lu(k,1176) = - lu(k,476) * lu(k,1170) + lu(k,1186) = - lu(k,477) * lu(k,1170) + lu(k,1189) = - lu(k,478) * lu(k,1170) + lu(k,1190) = lu(k,1190) - lu(k,479) * lu(k,1170) + lu(k,1191) = lu(k,1191) - lu(k,480) * lu(k,1170) + lu(k,1194) = lu(k,1194) - lu(k,481) * lu(k,1170) + lu(k,1471) = lu(k,1471) - lu(k,474) * lu(k,1435) + lu(k,1476) = lu(k,1476) - lu(k,475) * lu(k,1435) + lu(k,1477) = lu(k,1477) - lu(k,476) * lu(k,1435) + lu(k,1495) = lu(k,1495) - lu(k,477) * lu(k,1435) + lu(k,1499) = lu(k,1499) - lu(k,478) * lu(k,1435) + lu(k,1501) = lu(k,1501) - lu(k,479) * lu(k,1435) + lu(k,1503) = lu(k,1503) - lu(k,480) * lu(k,1435) + lu(k,1507) = lu(k,1507) - lu(k,481) * lu(k,1435) + lu(k,1772) = lu(k,1772) - lu(k,474) * lu(k,1751) + lu(k,1777) = lu(k,1777) - lu(k,475) * lu(k,1751) + lu(k,1778) = lu(k,1778) - lu(k,476) * lu(k,1751) + lu(k,1794) = lu(k,1794) - lu(k,477) * lu(k,1751) + lu(k,1798) = lu(k,1798) - lu(k,478) * lu(k,1751) + lu(k,1800) = lu(k,1800) - lu(k,479) * lu(k,1751) + lu(k,1802) = lu(k,1802) - lu(k,480) * lu(k,1751) + lu(k,1806) = lu(k,1806) - lu(k,481) * lu(k,1751) + lu(k,482) = 1._r8 / lu(k,482) + lu(k,483) = lu(k,483) * lu(k,482) + lu(k,484) = lu(k,484) * lu(k,482) + lu(k,485) = lu(k,485) * lu(k,482) + lu(k,486) = lu(k,486) * lu(k,482) + lu(k,487) = lu(k,487) * lu(k,482) + lu(k,488) = lu(k,488) * lu(k,482) + lu(k,489) = lu(k,489) * lu(k,482) + lu(k,490) = lu(k,490) * lu(k,482) + lu(k,956) = lu(k,956) - lu(k,483) * lu(k,954) + lu(k,957) = lu(k,957) - lu(k,484) * lu(k,954) + lu(k,958) = lu(k,958) - lu(k,485) * lu(k,954) + lu(k,959) = lu(k,959) - lu(k,486) * lu(k,954) + lu(k,960) = lu(k,960) - lu(k,487) * lu(k,954) + lu(k,966) = - lu(k,488) * lu(k,954) + lu(k,967) = lu(k,967) - lu(k,489) * lu(k,954) + lu(k,968) = lu(k,968) - lu(k,490) * lu(k,954) + lu(k,1467) = lu(k,1467) - lu(k,483) * lu(k,1436) + lu(k,1471) = lu(k,1471) - lu(k,484) * lu(k,1436) + lu(k,1473) = lu(k,1473) - lu(k,485) * lu(k,1436) + lu(k,1475) = lu(k,1475) - lu(k,486) * lu(k,1436) + lu(k,1479) = lu(k,1479) - lu(k,487) * lu(k,1436) + lu(k,1499) = lu(k,1499) - lu(k,488) * lu(k,1436) + lu(k,1501) = lu(k,1501) - lu(k,489) * lu(k,1436) + lu(k,1503) = lu(k,1503) - lu(k,490) * lu(k,1436) + lu(k,1655) = lu(k,1655) - lu(k,483) * lu(k,1631) + lu(k,1657) = lu(k,1657) - lu(k,484) * lu(k,1631) + lu(k,1658) = - lu(k,485) * lu(k,1631) + lu(k,1660) = lu(k,1660) - lu(k,486) * lu(k,1631) + lu(k,1663) = lu(k,1663) - lu(k,487) * lu(k,1631) + lu(k,1682) = lu(k,1682) - lu(k,488) * lu(k,1631) + lu(k,1684) = lu(k,1684) - lu(k,489) * lu(k,1631) + lu(k,1686) = lu(k,1686) - lu(k,490) * lu(k,1631) + lu(k,493) = 1._r8 / lu(k,493) + lu(k,494) = lu(k,494) * lu(k,493) + lu(k,495) = lu(k,495) * lu(k,493) + lu(k,496) = lu(k,496) * lu(k,493) + lu(k,497) = lu(k,497) * lu(k,493) + lu(k,498) = lu(k,498) * lu(k,493) + lu(k,499) = lu(k,499) * lu(k,493) + lu(k,500) = lu(k,500) * lu(k,493) + lu(k,501) = lu(k,501) * lu(k,493) + lu(k,583) = lu(k,583) - lu(k,494) * lu(k,582) + lu(k,584) = lu(k,584) - lu(k,495) * lu(k,582) + lu(k,585) = lu(k,585) - lu(k,496) * lu(k,582) + lu(k,586) = lu(k,586) - lu(k,497) * lu(k,582) + lu(k,587) = lu(k,587) - lu(k,498) * lu(k,582) + lu(k,590) = lu(k,590) - lu(k,499) * lu(k,582) + lu(k,591) = - lu(k,500) * lu(k,582) + lu(k,592) = lu(k,592) - lu(k,501) * lu(k,582) + lu(k,1438) = lu(k,1438) - lu(k,494) * lu(k,1437) + lu(k,1446) = lu(k,1446) - lu(k,495) * lu(k,1437) + lu(k,1447) = lu(k,1447) - lu(k,496) * lu(k,1437) + lu(k,1450) = - lu(k,497) * lu(k,1437) + lu(k,1462) = lu(k,1462) - lu(k,498) * lu(k,1437) + lu(k,1486) = lu(k,1486) - lu(k,499) * lu(k,1437) + lu(k,1499) = lu(k,1499) - lu(k,500) * lu(k,1437) + lu(k,1503) = lu(k,1503) - lu(k,501) * lu(k,1437) + lu(k,1633) = - lu(k,494) * lu(k,1632) + lu(k,1639) = lu(k,1639) - lu(k,495) * lu(k,1632) + lu(k,1640) = lu(k,1640) - lu(k,496) * lu(k,1632) + lu(k,1643) = lu(k,1643) - lu(k,497) * lu(k,1632) + lu(k,1652) = lu(k,1652) - lu(k,498) * lu(k,1632) + lu(k,1670) = lu(k,1670) - lu(k,499) * lu(k,1632) + lu(k,1682) = lu(k,1682) - lu(k,500) * lu(k,1632) + lu(k,1686) = lu(k,1686) - lu(k,501) * lu(k,1632) + lu(k,502) = 1._r8 / lu(k,502) + lu(k,503) = lu(k,503) * lu(k,502) + lu(k,504) = lu(k,504) * lu(k,502) + lu(k,505) = lu(k,505) * lu(k,502) + lu(k,559) = - lu(k,503) * lu(k,553) + lu(k,560) = lu(k,560) - lu(k,504) * lu(k,553) + lu(k,564) = lu(k,564) - lu(k,505) * lu(k,553) + lu(k,588) = - lu(k,503) * lu(k,583) + lu(k,589) = - lu(k,504) * lu(k,583) + lu(k,592) = lu(k,592) - lu(k,505) * lu(k,583) + lu(k,612) = - lu(k,503) * lu(k,606) + lu(k,613) = lu(k,613) - lu(k,504) * lu(k,606) + lu(k,617) = lu(k,617) - lu(k,505) * lu(k,606) + lu(k,872) = - lu(k,503) * lu(k,869) + lu(k,874) = - lu(k,504) * lu(k,869) + lu(k,881) = lu(k,881) - lu(k,505) * lu(k,869) + lu(k,1104) = - lu(k,503) * lu(k,1099) + lu(k,1106) = - lu(k,504) * lu(k,1099) + lu(k,1123) = lu(k,1123) - lu(k,505) * lu(k,1099) + lu(k,1463) = - lu(k,503) * lu(k,1438) + lu(k,1475) = lu(k,1475) - lu(k,504) * lu(k,1438) + lu(k,1503) = lu(k,1503) - lu(k,505) * lu(k,1438) + lu(k,1653) = lu(k,1653) - lu(k,503) * lu(k,1633) + lu(k,1660) = lu(k,1660) - lu(k,504) * lu(k,1633) + lu(k,1686) = lu(k,1686) - lu(k,505) * lu(k,1633) + lu(k,1768) = lu(k,1768) - lu(k,503) * lu(k,1752) + lu(k,1776) = lu(k,1776) - lu(k,504) * lu(k,1752) + lu(k,1802) = lu(k,1802) - lu(k,505) * lu(k,1752) + lu(k,506) = 1._r8 / lu(k,506) + lu(k,507) = lu(k,507) * lu(k,506) + lu(k,508) = lu(k,508) * lu(k,506) + lu(k,509) = lu(k,509) * lu(k,506) + lu(k,510) = lu(k,510) * lu(k,506) + lu(k,511) = lu(k,511) * lu(k,506) + lu(k,935) = lu(k,935) - lu(k,507) * lu(k,932) + lu(k,943) = - lu(k,508) * lu(k,932) + lu(k,946) = lu(k,946) - lu(k,509) * lu(k,932) + lu(k,948) = lu(k,948) - lu(k,510) * lu(k,932) + lu(k,950) = lu(k,950) - lu(k,511) * lu(k,932) + lu(k,975) = lu(k,975) - lu(k,507) * lu(k,973) + lu(k,982) = lu(k,982) - lu(k,508) * lu(k,973) + lu(k,985) = lu(k,985) - lu(k,509) * lu(k,973) + lu(k,987) = lu(k,987) - lu(k,510) * lu(k,973) + lu(k,989) = lu(k,989) - lu(k,511) * lu(k,973) + lu(k,1297) = lu(k,1297) - lu(k,507) * lu(k,1290) + lu(k,1318) = lu(k,1318) - lu(k,508) * lu(k,1290) + lu(k,1322) = lu(k,1322) - lu(k,509) * lu(k,1290) + lu(k,1325) = lu(k,1325) - lu(k,510) * lu(k,1290) + lu(k,1329) = lu(k,1329) - lu(k,511) * lu(k,1290) + lu(k,1470) = lu(k,1470) - lu(k,507) * lu(k,1439) + lu(k,1495) = lu(k,1495) - lu(k,508) * lu(k,1439) + lu(k,1499) = lu(k,1499) - lu(k,509) * lu(k,1439) + lu(k,1503) = lu(k,1503) - lu(k,510) * lu(k,1439) + lu(k,1507) = lu(k,1507) - lu(k,511) * lu(k,1439) + lu(k,1771) = lu(k,1771) - lu(k,507) * lu(k,1753) + lu(k,1794) = lu(k,1794) - lu(k,508) * lu(k,1753) + lu(k,1798) = lu(k,1798) - lu(k,509) * lu(k,1753) + lu(k,1802) = lu(k,1802) - lu(k,510) * lu(k,1753) + lu(k,1806) = lu(k,1806) - lu(k,511) * lu(k,1753) + end do + end subroutine lu_fac11 + subroutine lu_fac12( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,514) = 1._r8 / lu(k,514) + lu(k,515) = lu(k,515) * lu(k,514) + lu(k,516) = lu(k,516) * lu(k,514) + lu(k,517) = lu(k,517) * lu(k,514) + lu(k,518) = lu(k,518) * lu(k,514) + lu(k,519) = lu(k,519) * lu(k,514) + lu(k,1499) = lu(k,1499) - lu(k,515) * lu(k,1440) + lu(k,1503) = lu(k,1503) - lu(k,516) * lu(k,1440) + lu(k,1505) = lu(k,1505) - lu(k,517) * lu(k,1440) + lu(k,1506) = lu(k,1506) - lu(k,518) * lu(k,1440) + lu(k,1507) = lu(k,1507) - lu(k,519) * lu(k,1440) + lu(k,1682) = lu(k,1682) - lu(k,515) * lu(k,1634) + lu(k,1686) = lu(k,1686) - lu(k,516) * lu(k,1634) + lu(k,1688) = lu(k,1688) - lu(k,517) * lu(k,1634) + lu(k,1689) = lu(k,1689) - lu(k,518) * lu(k,1634) + lu(k,1690) = lu(k,1690) - lu(k,519) * lu(k,1634) + lu(k,1798) = lu(k,1798) - lu(k,515) * lu(k,1754) + lu(k,1802) = lu(k,1802) - lu(k,516) * lu(k,1754) + lu(k,1804) = lu(k,1804) - lu(k,517) * lu(k,1754) + lu(k,1805) = lu(k,1805) - lu(k,518) * lu(k,1754) + lu(k,1806) = lu(k,1806) - lu(k,519) * lu(k,1754) + lu(k,1858) = lu(k,1858) - lu(k,515) * lu(k,1822) + lu(k,1862) = lu(k,1862) - lu(k,516) * lu(k,1822) + lu(k,1864) = lu(k,1864) - lu(k,517) * lu(k,1822) + lu(k,1865) = lu(k,1865) - lu(k,518) * lu(k,1822) + lu(k,1866) = lu(k,1866) - lu(k,519) * lu(k,1822) + lu(k,1899) = lu(k,1899) - lu(k,515) * lu(k,1880) + lu(k,1903) = lu(k,1903) - lu(k,516) * lu(k,1880) + lu(k,1905) = lu(k,1905) - lu(k,517) * lu(k,1880) + lu(k,1906) = lu(k,1906) - lu(k,518) * lu(k,1880) + lu(k,1907) = lu(k,1907) - lu(k,519) * lu(k,1880) + lu(k,521) = 1._r8 / lu(k,521) + lu(k,522) = lu(k,522) * lu(k,521) + lu(k,523) = lu(k,523) * lu(k,521) + lu(k,524) = lu(k,524) * lu(k,521) + lu(k,525) = lu(k,525) * lu(k,521) + lu(k,526) = lu(k,526) * lu(k,521) + lu(k,527) = lu(k,527) * lu(k,521) + lu(k,528) = lu(k,528) * lu(k,521) + lu(k,529) = lu(k,529) * lu(k,521) + lu(k,530) = lu(k,530) * lu(k,521) + lu(k,806) = lu(k,806) - lu(k,522) * lu(k,804) + lu(k,807) = lu(k,807) - lu(k,523) * lu(k,804) + lu(k,808) = lu(k,808) - lu(k,524) * lu(k,804) + lu(k,809) = lu(k,809) - lu(k,525) * lu(k,804) + lu(k,810) = lu(k,810) - lu(k,526) * lu(k,804) + lu(k,811) = lu(k,811) - lu(k,527) * lu(k,804) + lu(k,813) = lu(k,813) - lu(k,528) * lu(k,804) + lu(k,814) = lu(k,814) - lu(k,529) * lu(k,804) + lu(k,815) = lu(k,815) - lu(k,530) * lu(k,804) + lu(k,1443) = lu(k,1443) - lu(k,522) * lu(k,1441) + lu(k,1457) = lu(k,1457) - lu(k,523) * lu(k,1441) + lu(k,1466) = lu(k,1466) - lu(k,524) * lu(k,1441) + lu(k,1467) = lu(k,1467) - lu(k,525) * lu(k,1441) + lu(k,1474) = lu(k,1474) - lu(k,526) * lu(k,1441) + lu(k,1493) = lu(k,1493) - lu(k,527) * lu(k,1441) + lu(k,1499) = lu(k,1499) - lu(k,528) * lu(k,1441) + lu(k,1501) = lu(k,1501) - lu(k,529) * lu(k,1441) + lu(k,1503) = lu(k,1503) - lu(k,530) * lu(k,1441) + lu(k,1636) = lu(k,1636) - lu(k,522) * lu(k,1635) + lu(k,1649) = lu(k,1649) - lu(k,523) * lu(k,1635) + lu(k,1654) = lu(k,1654) - lu(k,524) * lu(k,1635) + lu(k,1655) = lu(k,1655) - lu(k,525) * lu(k,1635) + lu(k,1659) = lu(k,1659) - lu(k,526) * lu(k,1635) + lu(k,1676) = lu(k,1676) - lu(k,527) * lu(k,1635) + lu(k,1682) = lu(k,1682) - lu(k,528) * lu(k,1635) + lu(k,1684) = lu(k,1684) - lu(k,529) * lu(k,1635) + lu(k,1686) = lu(k,1686) - lu(k,530) * lu(k,1635) + lu(k,532) = 1._r8 / lu(k,532) + lu(k,533) = lu(k,533) * lu(k,532) + lu(k,534) = lu(k,534) * lu(k,532) + lu(k,535) = lu(k,535) * lu(k,532) + lu(k,536) = lu(k,536) * lu(k,532) + lu(k,537) = lu(k,537) * lu(k,532) + lu(k,538) = lu(k,538) * lu(k,532) + lu(k,539) = lu(k,539) * lu(k,532) + lu(k,540) = lu(k,540) * lu(k,532) + lu(k,541) = lu(k,541) * lu(k,532) + lu(k,806) = lu(k,806) - lu(k,533) * lu(k,805) + lu(k,807) = lu(k,807) - lu(k,534) * lu(k,805) + lu(k,809) = lu(k,809) - lu(k,535) * lu(k,805) + lu(k,810) = lu(k,810) - lu(k,536) * lu(k,805) + lu(k,811) = lu(k,811) - lu(k,537) * lu(k,805) + lu(k,813) = lu(k,813) - lu(k,538) * lu(k,805) + lu(k,814) = lu(k,814) - lu(k,539) * lu(k,805) + lu(k,815) = lu(k,815) - lu(k,540) * lu(k,805) + lu(k,817) = lu(k,817) - lu(k,541) * lu(k,805) + lu(k,1443) = lu(k,1443) - lu(k,533) * lu(k,1442) + lu(k,1457) = lu(k,1457) - lu(k,534) * lu(k,1442) + lu(k,1467) = lu(k,1467) - lu(k,535) * lu(k,1442) + lu(k,1474) = lu(k,1474) - lu(k,536) * lu(k,1442) + lu(k,1493) = lu(k,1493) - lu(k,537) * lu(k,1442) + lu(k,1499) = lu(k,1499) - lu(k,538) * lu(k,1442) + lu(k,1501) = lu(k,1501) - lu(k,539) * lu(k,1442) + lu(k,1503) = lu(k,1503) - lu(k,540) * lu(k,1442) + lu(k,1507) = lu(k,1507) - lu(k,541) * lu(k,1442) + lu(k,1756) = lu(k,1756) - lu(k,533) * lu(k,1755) + lu(k,1765) = lu(k,1765) - lu(k,534) * lu(k,1755) + lu(k,1770) = lu(k,1770) - lu(k,535) * lu(k,1755) + lu(k,1775) = lu(k,1775) - lu(k,536) * lu(k,1755) + lu(k,1792) = lu(k,1792) - lu(k,537) * lu(k,1755) + lu(k,1798) = lu(k,1798) - lu(k,538) * lu(k,1755) + lu(k,1800) = lu(k,1800) - lu(k,539) * lu(k,1755) + lu(k,1802) = lu(k,1802) - lu(k,540) * lu(k,1755) + lu(k,1806) = lu(k,1806) - lu(k,541) * lu(k,1755) + lu(k,543) = 1._r8 / lu(k,543) + lu(k,544) = lu(k,544) * lu(k,543) + lu(k,545) = lu(k,545) * lu(k,543) + lu(k,546) = lu(k,546) * lu(k,543) + lu(k,547) = lu(k,547) * lu(k,543) + lu(k,548) = lu(k,548) * lu(k,543) + lu(k,549) = lu(k,549) * lu(k,543) + lu(k,810) = lu(k,810) - lu(k,544) * lu(k,806) + lu(k,811) = lu(k,811) - lu(k,545) * lu(k,806) + lu(k,813) = lu(k,813) - lu(k,546) * lu(k,806) + lu(k,815) = lu(k,815) - lu(k,547) * lu(k,806) + lu(k,816) = lu(k,816) - lu(k,548) * lu(k,806) + lu(k,817) = lu(k,817) - lu(k,549) * lu(k,806) + lu(k,1474) = lu(k,1474) - lu(k,544) * lu(k,1443) + lu(k,1493) = lu(k,1493) - lu(k,545) * lu(k,1443) + lu(k,1499) = lu(k,1499) - lu(k,546) * lu(k,1443) + lu(k,1503) = lu(k,1503) - lu(k,547) * lu(k,1443) + lu(k,1505) = lu(k,1505) - lu(k,548) * lu(k,1443) + lu(k,1507) = lu(k,1507) - lu(k,549) * lu(k,1443) + lu(k,1659) = lu(k,1659) - lu(k,544) * lu(k,1636) + lu(k,1676) = lu(k,1676) - lu(k,545) * lu(k,1636) + lu(k,1682) = lu(k,1682) - lu(k,546) * lu(k,1636) + lu(k,1686) = lu(k,1686) - lu(k,547) * lu(k,1636) + lu(k,1688) = lu(k,1688) - lu(k,548) * lu(k,1636) + lu(k,1690) = lu(k,1690) - lu(k,549) * lu(k,1636) + lu(k,1775) = lu(k,1775) - lu(k,544) * lu(k,1756) + lu(k,1792) = lu(k,1792) - lu(k,545) * lu(k,1756) + lu(k,1798) = lu(k,1798) - lu(k,546) * lu(k,1756) + lu(k,1802) = lu(k,1802) - lu(k,547) * lu(k,1756) + lu(k,1804) = lu(k,1804) - lu(k,548) * lu(k,1756) + lu(k,1806) = lu(k,1806) - lu(k,549) * lu(k,1756) + lu(k,554) = 1._r8 / lu(k,554) + lu(k,555) = lu(k,555) * lu(k,554) + lu(k,556) = lu(k,556) * lu(k,554) + lu(k,557) = lu(k,557) * lu(k,554) + lu(k,558) = lu(k,558) * lu(k,554) + lu(k,559) = lu(k,559) * lu(k,554) + lu(k,560) = lu(k,560) * lu(k,554) + lu(k,561) = lu(k,561) * lu(k,554) + lu(k,562) = lu(k,562) * lu(k,554) + lu(k,563) = lu(k,563) * lu(k,554) + lu(k,564) = lu(k,564) * lu(k,554) + lu(k,608) = lu(k,608) - lu(k,555) * lu(k,607) + lu(k,609) = lu(k,609) - lu(k,556) * lu(k,607) + lu(k,610) = lu(k,610) - lu(k,557) * lu(k,607) + lu(k,611) = lu(k,611) - lu(k,558) * lu(k,607) + lu(k,612) = lu(k,612) - lu(k,559) * lu(k,607) + lu(k,613) = lu(k,613) - lu(k,560) * lu(k,607) + lu(k,614) = lu(k,614) - lu(k,561) * lu(k,607) + lu(k,615) = lu(k,615) - lu(k,562) * lu(k,607) + lu(k,616) = - lu(k,563) * lu(k,607) + lu(k,617) = lu(k,617) - lu(k,564) * lu(k,607) + lu(k,1446) = lu(k,1446) - lu(k,555) * lu(k,1444) + lu(k,1449) = lu(k,1449) - lu(k,556) * lu(k,1444) + lu(k,1450) = lu(k,1450) - lu(k,557) * lu(k,1444) + lu(k,1462) = lu(k,1462) - lu(k,558) * lu(k,1444) + lu(k,1463) = lu(k,1463) - lu(k,559) * lu(k,1444) + lu(k,1475) = lu(k,1475) - lu(k,560) * lu(k,1444) + lu(k,1486) = lu(k,1486) - lu(k,561) * lu(k,1444) + lu(k,1493) = lu(k,1493) - lu(k,562) * lu(k,1444) + lu(k,1499) = lu(k,1499) - lu(k,563) * lu(k,1444) + lu(k,1503) = lu(k,1503) - lu(k,564) * lu(k,1444) + lu(k,1639) = lu(k,1639) - lu(k,555) * lu(k,1637) + lu(k,1642) = lu(k,1642) - lu(k,556) * lu(k,1637) + lu(k,1643) = lu(k,1643) - lu(k,557) * lu(k,1637) + lu(k,1652) = lu(k,1652) - lu(k,558) * lu(k,1637) + lu(k,1653) = lu(k,1653) - lu(k,559) * lu(k,1637) + lu(k,1660) = lu(k,1660) - lu(k,560) * lu(k,1637) + lu(k,1670) = lu(k,1670) - lu(k,561) * lu(k,1637) + lu(k,1676) = lu(k,1676) - lu(k,562) * lu(k,1637) + lu(k,1682) = lu(k,1682) - lu(k,563) * lu(k,1637) + lu(k,1686) = lu(k,1686) - lu(k,564) * lu(k,1637) + lu(k,567) = 1._r8 / lu(k,567) + lu(k,568) = lu(k,568) * lu(k,567) + lu(k,569) = lu(k,569) * lu(k,567) + lu(k,570) = lu(k,570) * lu(k,567) + lu(k,571) = lu(k,571) * lu(k,567) + lu(k,572) = lu(k,572) * lu(k,567) + lu(k,573) = lu(k,573) * lu(k,567) + lu(k,1471) = lu(k,1471) - lu(k,568) * lu(k,1445) + lu(k,1499) = lu(k,1499) - lu(k,569) * lu(k,1445) + lu(k,1501) = lu(k,1501) - lu(k,570) * lu(k,1445) + lu(k,1503) = lu(k,1503) - lu(k,571) * lu(k,1445) + lu(k,1505) = lu(k,1505) - lu(k,572) * lu(k,1445) + lu(k,1507) = lu(k,1507) - lu(k,573) * lu(k,1445) + lu(k,1657) = lu(k,1657) - lu(k,568) * lu(k,1638) + lu(k,1682) = lu(k,1682) - lu(k,569) * lu(k,1638) + lu(k,1684) = lu(k,1684) - lu(k,570) * lu(k,1638) + lu(k,1686) = lu(k,1686) - lu(k,571) * lu(k,1638) + lu(k,1688) = lu(k,1688) - lu(k,572) * lu(k,1638) + lu(k,1690) = lu(k,1690) - lu(k,573) * lu(k,1638) + lu(k,1772) = lu(k,1772) - lu(k,568) * lu(k,1757) + lu(k,1798) = lu(k,1798) - lu(k,569) * lu(k,1757) + lu(k,1800) = lu(k,1800) - lu(k,570) * lu(k,1757) + lu(k,1802) = lu(k,1802) - lu(k,571) * lu(k,1757) + lu(k,1804) = lu(k,1804) - lu(k,572) * lu(k,1757) + lu(k,1806) = lu(k,1806) - lu(k,573) * lu(k,1757) + lu(k,1834) = - lu(k,568) * lu(k,1823) + lu(k,1858) = lu(k,1858) - lu(k,569) * lu(k,1823) + lu(k,1860) = lu(k,1860) - lu(k,570) * lu(k,1823) + lu(k,1862) = lu(k,1862) - lu(k,571) * lu(k,1823) + lu(k,1864) = lu(k,1864) - lu(k,572) * lu(k,1823) + lu(k,1866) = lu(k,1866) - lu(k,573) * lu(k,1823) + lu(k,1946) = - lu(k,568) * lu(k,1940) + lu(k,1956) = lu(k,1956) - lu(k,569) * lu(k,1940) + lu(k,1958) = lu(k,1958) - lu(k,570) * lu(k,1940) + lu(k,1960) = lu(k,1960) - lu(k,571) * lu(k,1940) + lu(k,1962) = - lu(k,572) * lu(k,1940) + lu(k,1964) = - lu(k,573) * lu(k,1940) + end do + end subroutine lu_fac12 + subroutine lu_fac13( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,574) = 1._r8 / lu(k,574) + lu(k,575) = lu(k,575) * lu(k,574) + lu(k,576) = lu(k,576) * lu(k,574) + lu(k,577) = lu(k,577) * lu(k,574) + lu(k,578) = lu(k,578) * lu(k,574) + lu(k,579) = lu(k,579) * lu(k,574) + lu(k,587) = lu(k,587) - lu(k,575) * lu(k,584) + lu(k,589) = lu(k,589) - lu(k,576) * lu(k,584) + lu(k,592) = lu(k,592) - lu(k,577) * lu(k,584) + lu(k,593) = lu(k,593) - lu(k,578) * lu(k,584) + lu(k,594) = lu(k,594) - lu(k,579) * lu(k,584) + lu(k,611) = lu(k,611) - lu(k,575) * lu(k,608) + lu(k,613) = lu(k,613) - lu(k,576) * lu(k,608) + lu(k,617) = lu(k,617) - lu(k,577) * lu(k,608) + lu(k,618) = lu(k,618) - lu(k,578) * lu(k,608) + lu(k,619) = lu(k,619) - lu(k,579) * lu(k,608) + lu(k,1462) = lu(k,1462) - lu(k,575) * lu(k,1446) + lu(k,1475) = lu(k,1475) - lu(k,576) * lu(k,1446) + lu(k,1503) = lu(k,1503) - lu(k,577) * lu(k,1446) + lu(k,1505) = lu(k,1505) - lu(k,578) * lu(k,1446) + lu(k,1507) = lu(k,1507) - lu(k,579) * lu(k,1446) + lu(k,1652) = lu(k,1652) - lu(k,575) * lu(k,1639) + lu(k,1660) = lu(k,1660) - lu(k,576) * lu(k,1639) + lu(k,1686) = lu(k,1686) - lu(k,577) * lu(k,1639) + lu(k,1688) = lu(k,1688) - lu(k,578) * lu(k,1639) + lu(k,1690) = lu(k,1690) - lu(k,579) * lu(k,1639) + lu(k,1767) = lu(k,1767) - lu(k,575) * lu(k,1758) + lu(k,1776) = lu(k,1776) - lu(k,576) * lu(k,1758) + lu(k,1802) = lu(k,1802) - lu(k,577) * lu(k,1758) + lu(k,1804) = lu(k,1804) - lu(k,578) * lu(k,1758) + lu(k,1806) = lu(k,1806) - lu(k,579) * lu(k,1758) + lu(k,1885) = - lu(k,575) * lu(k,1881) + lu(k,1888) = - lu(k,576) * lu(k,1881) + lu(k,1903) = lu(k,1903) - lu(k,577) * lu(k,1881) + lu(k,1905) = lu(k,1905) - lu(k,578) * lu(k,1881) + lu(k,1907) = lu(k,1907) - lu(k,579) * lu(k,1881) + lu(k,585) = 1._r8 / lu(k,585) + lu(k,586) = lu(k,586) * lu(k,585) + lu(k,587) = lu(k,587) * lu(k,585) + lu(k,588) = lu(k,588) * lu(k,585) + lu(k,589) = lu(k,589) * lu(k,585) + lu(k,590) = lu(k,590) * lu(k,585) + lu(k,591) = lu(k,591) * lu(k,585) + lu(k,592) = lu(k,592) * lu(k,585) + lu(k,593) = lu(k,593) * lu(k,585) + lu(k,594) = lu(k,594) * lu(k,585) + lu(k,1450) = lu(k,1450) - lu(k,586) * lu(k,1447) + lu(k,1462) = lu(k,1462) - lu(k,587) * lu(k,1447) + lu(k,1463) = lu(k,1463) - lu(k,588) * lu(k,1447) + lu(k,1475) = lu(k,1475) - lu(k,589) * lu(k,1447) + lu(k,1486) = lu(k,1486) - lu(k,590) * lu(k,1447) + lu(k,1499) = lu(k,1499) - lu(k,591) * lu(k,1447) + lu(k,1503) = lu(k,1503) - lu(k,592) * lu(k,1447) + lu(k,1505) = lu(k,1505) - lu(k,593) * lu(k,1447) + lu(k,1507) = lu(k,1507) - lu(k,594) * lu(k,1447) + lu(k,1643) = lu(k,1643) - lu(k,586) * lu(k,1640) + lu(k,1652) = lu(k,1652) - lu(k,587) * lu(k,1640) + lu(k,1653) = lu(k,1653) - lu(k,588) * lu(k,1640) + lu(k,1660) = lu(k,1660) - lu(k,589) * lu(k,1640) + lu(k,1670) = lu(k,1670) - lu(k,590) * lu(k,1640) + lu(k,1682) = lu(k,1682) - lu(k,591) * lu(k,1640) + lu(k,1686) = lu(k,1686) - lu(k,592) * lu(k,1640) + lu(k,1688) = lu(k,1688) - lu(k,593) * lu(k,1640) + lu(k,1690) = lu(k,1690) - lu(k,594) * lu(k,1640) + lu(k,1761) = lu(k,1761) - lu(k,586) * lu(k,1759) + lu(k,1767) = lu(k,1767) - lu(k,587) * lu(k,1759) + lu(k,1768) = lu(k,1768) - lu(k,588) * lu(k,1759) + lu(k,1776) = lu(k,1776) - lu(k,589) * lu(k,1759) + lu(k,1786) = lu(k,1786) - lu(k,590) * lu(k,1759) + lu(k,1798) = lu(k,1798) - lu(k,591) * lu(k,1759) + lu(k,1802) = lu(k,1802) - lu(k,592) * lu(k,1759) + lu(k,1804) = lu(k,1804) - lu(k,593) * lu(k,1759) + lu(k,1806) = lu(k,1806) - lu(k,594) * lu(k,1759) + lu(k,596) = 1._r8 / lu(k,596) + lu(k,597) = lu(k,597) * lu(k,596) + lu(k,598) = lu(k,598) * lu(k,596) + lu(k,599) = lu(k,599) * lu(k,596) + lu(k,600) = lu(k,600) * lu(k,596) + lu(k,601) = lu(k,601) * lu(k,596) + lu(k,602) = lu(k,602) * lu(k,596) + lu(k,1043) = - lu(k,597) * lu(k,1037) + lu(k,1045) = - lu(k,598) * lu(k,1037) + lu(k,1047) = - lu(k,599) * lu(k,1037) + lu(k,1052) = lu(k,1052) - lu(k,600) * lu(k,1037) + lu(k,1053) = lu(k,1053) - lu(k,601) * lu(k,1037) + lu(k,1054) = lu(k,1054) - lu(k,602) * lu(k,1037) + lu(k,1110) = lu(k,1110) - lu(k,597) * lu(k,1100) + lu(k,1111) = - lu(k,598) * lu(k,1100) + lu(k,1114) = - lu(k,599) * lu(k,1100) + lu(k,1121) = lu(k,1121) - lu(k,600) * lu(k,1100) + lu(k,1122) = lu(k,1122) - lu(k,601) * lu(k,1100) + lu(k,1123) = lu(k,1123) - lu(k,602) * lu(k,1100) + lu(k,1178) = - lu(k,597) * lu(k,1171) + lu(k,1179) = lu(k,1179) - lu(k,598) * lu(k,1171) + lu(k,1181) = lu(k,1181) - lu(k,599) * lu(k,1171) + lu(k,1189) = lu(k,1189) - lu(k,600) * lu(k,1171) + lu(k,1190) = lu(k,1190) - lu(k,601) * lu(k,1171) + lu(k,1191) = lu(k,1191) - lu(k,602) * lu(k,1171) + lu(k,1482) = lu(k,1482) - lu(k,597) * lu(k,1448) + lu(k,1485) = lu(k,1485) - lu(k,598) * lu(k,1448) + lu(k,1489) = lu(k,1489) - lu(k,599) * lu(k,1448) + lu(k,1499) = lu(k,1499) - lu(k,600) * lu(k,1448) + lu(k,1501) = lu(k,1501) - lu(k,601) * lu(k,1448) + lu(k,1503) = lu(k,1503) - lu(k,602) * lu(k,1448) + lu(k,1666) = lu(k,1666) - lu(k,597) * lu(k,1641) + lu(k,1669) = - lu(k,598) * lu(k,1641) + lu(k,1672) = - lu(k,599) * lu(k,1641) + lu(k,1682) = lu(k,1682) - lu(k,600) * lu(k,1641) + lu(k,1684) = lu(k,1684) - lu(k,601) * lu(k,1641) + lu(k,1686) = lu(k,1686) - lu(k,602) * lu(k,1641) + lu(k,609) = 1._r8 / lu(k,609) + lu(k,610) = lu(k,610) * lu(k,609) + lu(k,611) = lu(k,611) * lu(k,609) + lu(k,612) = lu(k,612) * lu(k,609) + lu(k,613) = lu(k,613) * lu(k,609) + lu(k,614) = lu(k,614) * lu(k,609) + lu(k,615) = lu(k,615) * lu(k,609) + lu(k,616) = lu(k,616) * lu(k,609) + lu(k,617) = lu(k,617) * lu(k,609) + lu(k,618) = lu(k,618) * lu(k,609) + lu(k,619) = lu(k,619) * lu(k,609) + lu(k,1450) = lu(k,1450) - lu(k,610) * lu(k,1449) + lu(k,1462) = lu(k,1462) - lu(k,611) * lu(k,1449) + lu(k,1463) = lu(k,1463) - lu(k,612) * lu(k,1449) + lu(k,1475) = lu(k,1475) - lu(k,613) * lu(k,1449) + lu(k,1486) = lu(k,1486) - lu(k,614) * lu(k,1449) + lu(k,1493) = lu(k,1493) - lu(k,615) * lu(k,1449) + lu(k,1499) = lu(k,1499) - lu(k,616) * lu(k,1449) + lu(k,1503) = lu(k,1503) - lu(k,617) * lu(k,1449) + lu(k,1505) = lu(k,1505) - lu(k,618) * lu(k,1449) + lu(k,1507) = lu(k,1507) - lu(k,619) * lu(k,1449) + lu(k,1643) = lu(k,1643) - lu(k,610) * lu(k,1642) + lu(k,1652) = lu(k,1652) - lu(k,611) * lu(k,1642) + lu(k,1653) = lu(k,1653) - lu(k,612) * lu(k,1642) + lu(k,1660) = lu(k,1660) - lu(k,613) * lu(k,1642) + lu(k,1670) = lu(k,1670) - lu(k,614) * lu(k,1642) + lu(k,1676) = lu(k,1676) - lu(k,615) * lu(k,1642) + lu(k,1682) = lu(k,1682) - lu(k,616) * lu(k,1642) + lu(k,1686) = lu(k,1686) - lu(k,617) * lu(k,1642) + lu(k,1688) = lu(k,1688) - lu(k,618) * lu(k,1642) + lu(k,1690) = lu(k,1690) - lu(k,619) * lu(k,1642) + lu(k,1761) = lu(k,1761) - lu(k,610) * lu(k,1760) + lu(k,1767) = lu(k,1767) - lu(k,611) * lu(k,1760) + lu(k,1768) = lu(k,1768) - lu(k,612) * lu(k,1760) + lu(k,1776) = lu(k,1776) - lu(k,613) * lu(k,1760) + lu(k,1786) = lu(k,1786) - lu(k,614) * lu(k,1760) + lu(k,1792) = lu(k,1792) - lu(k,615) * lu(k,1760) + lu(k,1798) = lu(k,1798) - lu(k,616) * lu(k,1760) + lu(k,1802) = lu(k,1802) - lu(k,617) * lu(k,1760) + lu(k,1804) = lu(k,1804) - lu(k,618) * lu(k,1760) + lu(k,1806) = lu(k,1806) - lu(k,619) * lu(k,1760) + lu(k,620) = 1._r8 / lu(k,620) + lu(k,621) = lu(k,621) * lu(k,620) + lu(k,622) = lu(k,622) * lu(k,620) + lu(k,623) = lu(k,623) * lu(k,620) + lu(k,624) = lu(k,624) * lu(k,620) + lu(k,625) = lu(k,625) * lu(k,620) + lu(k,626) = lu(k,626) * lu(k,620) + lu(k,627) = lu(k,627) * lu(k,620) + lu(k,1475) = lu(k,1475) - lu(k,621) * lu(k,1450) + lu(k,1486) = lu(k,1486) - lu(k,622) * lu(k,1450) + lu(k,1497) = lu(k,1497) - lu(k,623) * lu(k,1450) + lu(k,1499) = lu(k,1499) - lu(k,624) * lu(k,1450) + lu(k,1503) = lu(k,1503) - lu(k,625) * lu(k,1450) + lu(k,1505) = lu(k,1505) - lu(k,626) * lu(k,1450) + lu(k,1507) = lu(k,1507) - lu(k,627) * lu(k,1450) + lu(k,1660) = lu(k,1660) - lu(k,621) * lu(k,1643) + lu(k,1670) = lu(k,1670) - lu(k,622) * lu(k,1643) + lu(k,1680) = lu(k,1680) - lu(k,623) * lu(k,1643) + lu(k,1682) = lu(k,1682) - lu(k,624) * lu(k,1643) + lu(k,1686) = lu(k,1686) - lu(k,625) * lu(k,1643) + lu(k,1688) = lu(k,1688) - lu(k,626) * lu(k,1643) + lu(k,1690) = lu(k,1690) - lu(k,627) * lu(k,1643) + lu(k,1776) = lu(k,1776) - lu(k,621) * lu(k,1761) + lu(k,1786) = lu(k,1786) - lu(k,622) * lu(k,1761) + lu(k,1796) = lu(k,1796) - lu(k,623) * lu(k,1761) + lu(k,1798) = lu(k,1798) - lu(k,624) * lu(k,1761) + lu(k,1802) = lu(k,1802) - lu(k,625) * lu(k,1761) + lu(k,1804) = lu(k,1804) - lu(k,626) * lu(k,1761) + lu(k,1806) = lu(k,1806) - lu(k,627) * lu(k,1761) + lu(k,1888) = lu(k,1888) - lu(k,621) * lu(k,1882) + lu(k,1890) = - lu(k,622) * lu(k,1882) + lu(k,1897) = lu(k,1897) - lu(k,623) * lu(k,1882) + lu(k,1899) = lu(k,1899) - lu(k,624) * lu(k,1882) + lu(k,1903) = lu(k,1903) - lu(k,625) * lu(k,1882) + lu(k,1905) = lu(k,1905) - lu(k,626) * lu(k,1882) + lu(k,1907) = lu(k,1907) - lu(k,627) * lu(k,1882) + end do + end subroutine lu_fac13 + subroutine lu_fac14( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,629) = 1._r8 / lu(k,629) + lu(k,630) = lu(k,630) * lu(k,629) + lu(k,631) = lu(k,631) * lu(k,629) + lu(k,632) = lu(k,632) * lu(k,629) + lu(k,633) = lu(k,633) * lu(k,629) + lu(k,634) = lu(k,634) * lu(k,629) + lu(k,635) = lu(k,635) * lu(k,629) + lu(k,636) = lu(k,636) * lu(k,629) + lu(k,637) = lu(k,637) * lu(k,629) + lu(k,841) = lu(k,841) - lu(k,630) * lu(k,837) + lu(k,843) = - lu(k,631) * lu(k,837) + lu(k,847) = lu(k,847) - lu(k,632) * lu(k,837) + lu(k,848) = lu(k,848) - lu(k,633) * lu(k,837) + lu(k,849) = lu(k,849) - lu(k,634) * lu(k,837) + lu(k,850) = - lu(k,635) * lu(k,837) + lu(k,852) = - lu(k,636) * lu(k,837) + lu(k,854) = lu(k,854) - lu(k,637) * lu(k,837) + lu(k,1474) = lu(k,1474) - lu(k,630) * lu(k,1451) + lu(k,1477) = lu(k,1477) - lu(k,631) * lu(k,1451) + lu(k,1499) = lu(k,1499) - lu(k,632) * lu(k,1451) + lu(k,1501) = lu(k,1501) - lu(k,633) * lu(k,1451) + lu(k,1503) = lu(k,1503) - lu(k,634) * lu(k,1451) + lu(k,1505) = lu(k,1505) - lu(k,635) * lu(k,1451) + lu(k,1507) = lu(k,1507) - lu(k,636) * lu(k,1451) + lu(k,1511) = lu(k,1511) - lu(k,637) * lu(k,1451) + lu(k,1659) = lu(k,1659) - lu(k,630) * lu(k,1644) + lu(k,1661) = lu(k,1661) - lu(k,631) * lu(k,1644) + lu(k,1682) = lu(k,1682) - lu(k,632) * lu(k,1644) + lu(k,1684) = lu(k,1684) - lu(k,633) * lu(k,1644) + lu(k,1686) = lu(k,1686) - lu(k,634) * lu(k,1644) + lu(k,1688) = lu(k,1688) - lu(k,635) * lu(k,1644) + lu(k,1690) = lu(k,1690) - lu(k,636) * lu(k,1644) + lu(k,1694) = lu(k,1694) - lu(k,637) * lu(k,1644) + lu(k,1775) = lu(k,1775) - lu(k,630) * lu(k,1762) + lu(k,1778) = lu(k,1778) - lu(k,631) * lu(k,1762) + lu(k,1798) = lu(k,1798) - lu(k,632) * lu(k,1762) + lu(k,1800) = lu(k,1800) - lu(k,633) * lu(k,1762) + lu(k,1802) = lu(k,1802) - lu(k,634) * lu(k,1762) + lu(k,1804) = lu(k,1804) - lu(k,635) * lu(k,1762) + lu(k,1806) = lu(k,1806) - lu(k,636) * lu(k,1762) + lu(k,1810) = - lu(k,637) * lu(k,1762) + lu(k,639) = 1._r8 / lu(k,639) + lu(k,640) = lu(k,640) * lu(k,639) + lu(k,641) = lu(k,641) * lu(k,639) + lu(k,642) = lu(k,642) * lu(k,639) + lu(k,643) = lu(k,643) * lu(k,639) + lu(k,644) = lu(k,644) * lu(k,639) + lu(k,645) = lu(k,645) * lu(k,639) + lu(k,646) = lu(k,646) * lu(k,639) + lu(k,1024) = lu(k,1024) - lu(k,640) * lu(k,1023) + lu(k,1025) = - lu(k,641) * lu(k,1023) + lu(k,1026) = lu(k,1026) - lu(k,642) * lu(k,1023) + lu(k,1027) = - lu(k,643) * lu(k,1023) + lu(k,1029) = lu(k,1029) - lu(k,644) * lu(k,1023) + lu(k,1033) = - lu(k,645) * lu(k,1023) + lu(k,1034) = lu(k,1034) - lu(k,646) * lu(k,1023) + lu(k,1259) = - lu(k,640) * lu(k,1258) + lu(k,1260) = lu(k,1260) - lu(k,641) * lu(k,1258) + lu(k,1261) = lu(k,1261) - lu(k,642) * lu(k,1258) + lu(k,1262) = - lu(k,643) * lu(k,1258) + lu(k,1264) = lu(k,1264) - lu(k,644) * lu(k,1258) + lu(k,1269) = lu(k,1269) - lu(k,645) * lu(k,1258) + lu(k,1270) = lu(k,1270) - lu(k,646) * lu(k,1258) + lu(k,1339) = lu(k,1339) - lu(k,640) * lu(k,1337) + lu(k,1341) = - lu(k,641) * lu(k,1337) + lu(k,1342) = lu(k,1342) - lu(k,642) * lu(k,1337) + lu(k,1343) = lu(k,1343) - lu(k,643) * lu(k,1337) + lu(k,1345) = lu(k,1345) - lu(k,644) * lu(k,1337) + lu(k,1356) = - lu(k,645) * lu(k,1337) + lu(k,1357) = lu(k,1357) - lu(k,646) * lu(k,1337) + lu(k,1483) = lu(k,1483) - lu(k,640) * lu(k,1452) + lu(k,1495) = lu(k,1495) - lu(k,641) * lu(k,1452) + lu(k,1496) = lu(k,1496) - lu(k,642) * lu(k,1452) + lu(k,1497) = lu(k,1497) - lu(k,643) * lu(k,1452) + lu(k,1499) = lu(k,1499) - lu(k,644) * lu(k,1452) + lu(k,1510) = lu(k,1510) - lu(k,645) * lu(k,1452) + lu(k,1511) = lu(k,1511) - lu(k,646) * lu(k,1452) + lu(k,2031) = lu(k,2031) - lu(k,640) * lu(k,2029) + lu(k,2034) = - lu(k,641) * lu(k,2029) + lu(k,2035) = lu(k,2035) - lu(k,642) * lu(k,2029) + lu(k,2036) = - lu(k,643) * lu(k,2029) + lu(k,2038) = lu(k,2038) - lu(k,644) * lu(k,2029) + lu(k,2049) = - lu(k,645) * lu(k,2029) + lu(k,2050) = lu(k,2050) - lu(k,646) * lu(k,2029) + lu(k,648) = 1._r8 / lu(k,648) + lu(k,649) = lu(k,649) * lu(k,648) + lu(k,650) = lu(k,650) * lu(k,648) + lu(k,651) = lu(k,651) * lu(k,648) + lu(k,652) = lu(k,652) * lu(k,648) + lu(k,653) = lu(k,653) * lu(k,648) + lu(k,654) = lu(k,654) * lu(k,648) + lu(k,655) = lu(k,655) * lu(k,648) + lu(k,1518) = lu(k,1518) - lu(k,649) * lu(k,1515) + lu(k,1523) = lu(k,1523) - lu(k,650) * lu(k,1515) + lu(k,1524) = lu(k,1524) - lu(k,651) * lu(k,1515) + lu(k,1526) = lu(k,1526) - lu(k,652) * lu(k,1515) + lu(k,1532) = - lu(k,653) * lu(k,1515) + lu(k,1533) = lu(k,1533) - lu(k,654) * lu(k,1515) + lu(k,1535) = - lu(k,655) * lu(k,1515) + lu(k,1571) = lu(k,1571) - lu(k,649) * lu(k,1563) + lu(k,1576) = lu(k,1576) - lu(k,650) * lu(k,1563) + lu(k,1577) = lu(k,1577) - lu(k,651) * lu(k,1563) + lu(k,1579) = lu(k,1579) - lu(k,652) * lu(k,1563) + lu(k,1585) = lu(k,1585) - lu(k,653) * lu(k,1563) + lu(k,1586) = lu(k,1586) - lu(k,654) * lu(k,1563) + lu(k,1588) = lu(k,1588) - lu(k,655) * lu(k,1563) + lu(k,1677) = lu(k,1677) - lu(k,649) * lu(k,1645) + lu(k,1682) = lu(k,1682) - lu(k,650) * lu(k,1645) + lu(k,1683) = lu(k,1683) - lu(k,651) * lu(k,1645) + lu(k,1685) = lu(k,1685) - lu(k,652) * lu(k,1645) + lu(k,1691) = lu(k,1691) - lu(k,653) * lu(k,1645) + lu(k,1692) = lu(k,1692) - lu(k,654) * lu(k,1645) + lu(k,1694) = lu(k,1694) - lu(k,655) * lu(k,1645) + lu(k,1894) = lu(k,1894) - lu(k,649) * lu(k,1883) + lu(k,1899) = lu(k,1899) - lu(k,650) * lu(k,1883) + lu(k,1900) = lu(k,1900) - lu(k,651) * lu(k,1883) + lu(k,1902) = lu(k,1902) - lu(k,652) * lu(k,1883) + lu(k,1908) = - lu(k,653) * lu(k,1883) + lu(k,1909) = - lu(k,654) * lu(k,1883) + lu(k,1911) = lu(k,1911) - lu(k,655) * lu(k,1883) + lu(k,1917) = lu(k,1917) - lu(k,649) * lu(k,1914) + lu(k,1922) = lu(k,1922) - lu(k,650) * lu(k,1914) + lu(k,1923) = - lu(k,651) * lu(k,1914) + lu(k,1925) = lu(k,1925) - lu(k,652) * lu(k,1914) + lu(k,1931) = lu(k,1931) - lu(k,653) * lu(k,1914) + lu(k,1932) = lu(k,1932) - lu(k,654) * lu(k,1914) + lu(k,1934) = lu(k,1934) - lu(k,655) * lu(k,1914) + lu(k,656) = 1._r8 / lu(k,656) + lu(k,657) = lu(k,657) * lu(k,656) + lu(k,658) = lu(k,658) * lu(k,656) + lu(k,659) = lu(k,659) * lu(k,656) + lu(k,689) = lu(k,689) - lu(k,657) * lu(k,685) + lu(k,690) = lu(k,690) - lu(k,658) * lu(k,685) + lu(k,691) = lu(k,691) - lu(k,659) * lu(k,685) + lu(k,946) = lu(k,946) - lu(k,657) * lu(k,933) + lu(k,947) = lu(k,947) - lu(k,658) * lu(k,933) + lu(k,948) = lu(k,948) - lu(k,659) * lu(k,933) + lu(k,966) = lu(k,966) - lu(k,657) * lu(k,955) + lu(k,967) = lu(k,967) - lu(k,658) * lu(k,955) + lu(k,968) = lu(k,968) - lu(k,659) * lu(k,955) + lu(k,985) = lu(k,985) - lu(k,657) * lu(k,974) + lu(k,986) = lu(k,986) - lu(k,658) * lu(k,974) + lu(k,987) = lu(k,987) - lu(k,659) * lu(k,974) + lu(k,999) = lu(k,999) - lu(k,657) * lu(k,993) + lu(k,1000) = lu(k,1000) - lu(k,658) * lu(k,993) + lu(k,1001) = lu(k,1001) - lu(k,659) * lu(k,993) + lu(k,1016) = lu(k,1016) - lu(k,657) * lu(k,1006) + lu(k,1017) = lu(k,1017) - lu(k,658) * lu(k,1006) + lu(k,1018) = lu(k,1018) - lu(k,659) * lu(k,1006) + lu(k,1052) = lu(k,1052) - lu(k,657) * lu(k,1038) + lu(k,1053) = lu(k,1053) - lu(k,658) * lu(k,1038) + lu(k,1054) = lu(k,1054) - lu(k,659) * lu(k,1038) + lu(k,1121) = lu(k,1121) - lu(k,657) * lu(k,1101) + lu(k,1122) = lu(k,1122) - lu(k,658) * lu(k,1101) + lu(k,1123) = lu(k,1123) - lu(k,659) * lu(k,1101) + lu(k,1163) = lu(k,1163) - lu(k,657) * lu(k,1150) + lu(k,1164) = lu(k,1164) - lu(k,658) * lu(k,1150) + lu(k,1165) = lu(k,1165) - lu(k,659) * lu(k,1150) + lu(k,1189) = lu(k,1189) - lu(k,657) * lu(k,1172) + lu(k,1190) = lu(k,1190) - lu(k,658) * lu(k,1172) + lu(k,1191) = lu(k,1191) - lu(k,659) * lu(k,1172) + lu(k,1322) = lu(k,1322) - lu(k,657) * lu(k,1291) + lu(k,1323) = lu(k,1323) - lu(k,658) * lu(k,1291) + lu(k,1325) = lu(k,1325) - lu(k,659) * lu(k,1291) + lu(k,1499) = lu(k,1499) - lu(k,657) * lu(k,1453) + lu(k,1501) = lu(k,1501) - lu(k,658) * lu(k,1453) + lu(k,1503) = lu(k,1503) - lu(k,659) * lu(k,1453) + lu(k,661) = 1._r8 / lu(k,661) + lu(k,662) = lu(k,662) * lu(k,661) + lu(k,663) = lu(k,663) * lu(k,661) + lu(k,664) = lu(k,664) * lu(k,661) + lu(k,665) = lu(k,665) * lu(k,661) + lu(k,666) = lu(k,666) * lu(k,661) + lu(k,667) = lu(k,667) * lu(k,661) + lu(k,668) = lu(k,668) * lu(k,661) + lu(k,669) = lu(k,669) * lu(k,661) + lu(k,670) = lu(k,670) * lu(k,661) + lu(k,1296) = lu(k,1296) - lu(k,662) * lu(k,1292) + lu(k,1301) = lu(k,1301) - lu(k,663) * lu(k,1292) + lu(k,1320) = lu(k,1320) - lu(k,664) * lu(k,1292) + lu(k,1322) = lu(k,1322) - lu(k,665) * lu(k,1292) + lu(k,1323) = lu(k,1323) - lu(k,666) * lu(k,1292) + lu(k,1325) = lu(k,1325) - lu(k,667) * lu(k,1292) + lu(k,1327) = lu(k,1327) - lu(k,668) * lu(k,1292) + lu(k,1329) = lu(k,1329) - lu(k,669) * lu(k,1292) + lu(k,1333) = lu(k,1333) - lu(k,670) * lu(k,1292) + lu(k,1467) = lu(k,1467) - lu(k,662) * lu(k,1454) + lu(k,1474) = lu(k,1474) - lu(k,663) * lu(k,1454) + lu(k,1497) = lu(k,1497) - lu(k,664) * lu(k,1454) + lu(k,1499) = lu(k,1499) - lu(k,665) * lu(k,1454) + lu(k,1501) = lu(k,1501) - lu(k,666) * lu(k,1454) + lu(k,1503) = lu(k,1503) - lu(k,667) * lu(k,1454) + lu(k,1505) = lu(k,1505) - lu(k,668) * lu(k,1454) + lu(k,1507) = lu(k,1507) - lu(k,669) * lu(k,1454) + lu(k,1511) = lu(k,1511) - lu(k,670) * lu(k,1454) + lu(k,1655) = lu(k,1655) - lu(k,662) * lu(k,1646) + lu(k,1659) = lu(k,1659) - lu(k,663) * lu(k,1646) + lu(k,1680) = lu(k,1680) - lu(k,664) * lu(k,1646) + lu(k,1682) = lu(k,1682) - lu(k,665) * lu(k,1646) + lu(k,1684) = lu(k,1684) - lu(k,666) * lu(k,1646) + lu(k,1686) = lu(k,1686) - lu(k,667) * lu(k,1646) + lu(k,1688) = lu(k,1688) - lu(k,668) * lu(k,1646) + lu(k,1690) = lu(k,1690) - lu(k,669) * lu(k,1646) + lu(k,1694) = lu(k,1694) - lu(k,670) * lu(k,1646) + lu(k,1770) = lu(k,1770) - lu(k,662) * lu(k,1763) + lu(k,1775) = lu(k,1775) - lu(k,663) * lu(k,1763) + lu(k,1796) = lu(k,1796) - lu(k,664) * lu(k,1763) + lu(k,1798) = lu(k,1798) - lu(k,665) * lu(k,1763) + lu(k,1800) = lu(k,1800) - lu(k,666) * lu(k,1763) + lu(k,1802) = lu(k,1802) - lu(k,667) * lu(k,1763) + lu(k,1804) = lu(k,1804) - lu(k,668) * lu(k,1763) + lu(k,1806) = lu(k,1806) - lu(k,669) * lu(k,1763) + lu(k,1810) = lu(k,1810) - lu(k,670) * lu(k,1763) + end do + end subroutine lu_fac14 + subroutine lu_fac15( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,671) = 1._r8 / lu(k,671) + lu(k,672) = lu(k,672) * lu(k,671) + lu(k,673) = lu(k,673) * lu(k,671) + lu(k,674) = lu(k,674) * lu(k,671) + lu(k,716) = lu(k,716) - lu(k,672) * lu(k,705) + lu(k,718) = lu(k,718) - lu(k,673) * lu(k,705) + lu(k,721) = - lu(k,674) * lu(k,705) + lu(k,770) = lu(k,770) - lu(k,672) * lu(k,757) + lu(k,772) = lu(k,772) - lu(k,673) * lu(k,757) + lu(k,775) = - lu(k,674) * lu(k,757) + lu(k,797) = lu(k,797) - lu(k,672) * lu(k,784) + lu(k,799) = lu(k,799) - lu(k,673) * lu(k,784) + lu(k,802) = - lu(k,674) * lu(k,784) + lu(k,847) = lu(k,847) - lu(k,672) * lu(k,838) + lu(k,849) = lu(k,849) - lu(k,673) * lu(k,838) + lu(k,854) = lu(k,854) - lu(k,674) * lu(k,838) + lu(k,1066) = lu(k,1066) - lu(k,672) * lu(k,1058) + lu(k,1068) = lu(k,1068) - lu(k,673) * lu(k,1058) + lu(k,1070) = lu(k,1070) - lu(k,674) * lu(k,1058) + lu(k,1141) = lu(k,1141) - lu(k,672) * lu(k,1129) + lu(k,1143) = lu(k,1143) - lu(k,673) * lu(k,1129) + lu(k,1148) = - lu(k,674) * lu(k,1129) + lu(k,1499) = lu(k,1499) - lu(k,672) * lu(k,1455) + lu(k,1503) = lu(k,1503) - lu(k,673) * lu(k,1455) + lu(k,1511) = lu(k,1511) - lu(k,674) * lu(k,1455) + lu(k,1546) = lu(k,1546) - lu(k,672) * lu(k,1537) + lu(k,1550) = lu(k,1550) - lu(k,673) * lu(k,1537) + lu(k,1558) = lu(k,1558) - lu(k,674) * lu(k,1537) + lu(k,1682) = lu(k,1682) - lu(k,672) * lu(k,1647) + lu(k,1686) = lu(k,1686) - lu(k,673) * lu(k,1647) + lu(k,1694) = lu(k,1694) - lu(k,674) * lu(k,1647) + lu(k,1798) = lu(k,1798) - lu(k,672) * lu(k,1764) + lu(k,1802) = lu(k,1802) - lu(k,673) * lu(k,1764) + lu(k,1810) = lu(k,1810) - lu(k,674) * lu(k,1764) + lu(k,1858) = lu(k,1858) - lu(k,672) * lu(k,1824) + lu(k,1862) = lu(k,1862) - lu(k,673) * lu(k,1824) + lu(k,1870) = lu(k,1870) - lu(k,674) * lu(k,1824) + lu(k,1956) = lu(k,1956) - lu(k,672) * lu(k,1941) + lu(k,1960) = lu(k,1960) - lu(k,673) * lu(k,1941) + lu(k,1968) = lu(k,1968) - lu(k,674) * lu(k,1941) + lu(k,676) = 1._r8 / lu(k,676) + lu(k,677) = lu(k,677) * lu(k,676) + lu(k,678) = lu(k,678) * lu(k,676) + lu(k,679) = lu(k,679) * lu(k,676) + lu(k,680) = lu(k,680) * lu(k,676) + lu(k,681) = lu(k,681) * lu(k,676) + lu(k,682) = lu(k,682) * lu(k,676) + lu(k,828) = lu(k,828) - lu(k,677) * lu(k,825) + lu(k,829) = lu(k,829) - lu(k,678) * lu(k,825) + lu(k,830) = lu(k,830) - lu(k,679) * lu(k,825) + lu(k,832) = lu(k,832) - lu(k,680) * lu(k,825) + lu(k,833) = lu(k,833) - lu(k,681) * lu(k,825) + lu(k,835) = - lu(k,682) * lu(k,825) + lu(k,1499) = lu(k,1499) - lu(k,677) * lu(k,1456) + lu(k,1502) = lu(k,1502) - lu(k,678) * lu(k,1456) + lu(k,1504) = lu(k,1504) - lu(k,679) * lu(k,1456) + lu(k,1508) = lu(k,1508) - lu(k,680) * lu(k,1456) + lu(k,1509) = lu(k,1509) - lu(k,681) * lu(k,1456) + lu(k,1511) = lu(k,1511) - lu(k,682) * lu(k,1456) + lu(k,1576) = lu(k,1576) - lu(k,677) * lu(k,1564) + lu(k,1579) = lu(k,1579) - lu(k,678) * lu(k,1564) + lu(k,1581) = lu(k,1581) - lu(k,679) * lu(k,1564) + lu(k,1585) = lu(k,1585) - lu(k,680) * lu(k,1564) + lu(k,1586) = lu(k,1586) - lu(k,681) * lu(k,1564) + lu(k,1588) = lu(k,1588) - lu(k,682) * lu(k,1564) + lu(k,1682) = lu(k,1682) - lu(k,677) * lu(k,1648) + lu(k,1685) = lu(k,1685) - lu(k,678) * lu(k,1648) + lu(k,1687) = lu(k,1687) - lu(k,679) * lu(k,1648) + lu(k,1691) = lu(k,1691) - lu(k,680) * lu(k,1648) + lu(k,1692) = lu(k,1692) - lu(k,681) * lu(k,1648) + lu(k,1694) = lu(k,1694) - lu(k,682) * lu(k,1648) + lu(k,1708) = lu(k,1708) - lu(k,677) * lu(k,1699) + lu(k,1711) = lu(k,1711) - lu(k,678) * lu(k,1699) + lu(k,1713) = lu(k,1713) - lu(k,679) * lu(k,1699) + lu(k,1717) = lu(k,1717) - lu(k,680) * lu(k,1699) + lu(k,1718) = lu(k,1718) - lu(k,681) * lu(k,1699) + lu(k,1720) = - lu(k,682) * lu(k,1699) + lu(k,1922) = lu(k,1922) - lu(k,677) * lu(k,1915) + lu(k,1925) = lu(k,1925) - lu(k,678) * lu(k,1915) + lu(k,1927) = lu(k,1927) - lu(k,679) * lu(k,1915) + lu(k,1931) = lu(k,1931) - lu(k,680) * lu(k,1915) + lu(k,1932) = lu(k,1932) - lu(k,681) * lu(k,1915) + lu(k,1934) = lu(k,1934) - lu(k,682) * lu(k,1915) + lu(k,1956) = lu(k,1956) - lu(k,677) * lu(k,1942) + lu(k,1959) = lu(k,1959) - lu(k,678) * lu(k,1942) + lu(k,1961) = lu(k,1961) - lu(k,679) * lu(k,1942) + lu(k,1965) = lu(k,1965) - lu(k,680) * lu(k,1942) + lu(k,1966) = lu(k,1966) - lu(k,681) * lu(k,1942) + lu(k,1968) = lu(k,1968) - lu(k,682) * lu(k,1942) + lu(k,686) = 1._r8 / lu(k,686) + lu(k,687) = lu(k,687) * lu(k,686) + lu(k,688) = lu(k,688) * lu(k,686) + lu(k,689) = lu(k,689) * lu(k,686) + lu(k,690) = lu(k,690) * lu(k,686) + lu(k,691) = lu(k,691) * lu(k,686) + lu(k,692) = lu(k,692) * lu(k,686) + lu(k,693) = lu(k,693) * lu(k,686) + lu(k,810) = lu(k,810) - lu(k,687) * lu(k,807) + lu(k,812) = - lu(k,688) * lu(k,807) + lu(k,813) = lu(k,813) - lu(k,689) * lu(k,807) + lu(k,814) = lu(k,814) - lu(k,690) * lu(k,807) + lu(k,815) = lu(k,815) - lu(k,691) * lu(k,807) + lu(k,816) = lu(k,816) - lu(k,692) * lu(k,807) + lu(k,817) = lu(k,817) - lu(k,693) * lu(k,807) + lu(k,1301) = lu(k,1301) - lu(k,687) * lu(k,1293) + lu(k,1320) = lu(k,1320) - lu(k,688) * lu(k,1293) + lu(k,1322) = lu(k,1322) - lu(k,689) * lu(k,1293) + lu(k,1323) = lu(k,1323) - lu(k,690) * lu(k,1293) + lu(k,1325) = lu(k,1325) - lu(k,691) * lu(k,1293) + lu(k,1327) = lu(k,1327) - lu(k,692) * lu(k,1293) + lu(k,1329) = lu(k,1329) - lu(k,693) * lu(k,1293) + lu(k,1474) = lu(k,1474) - lu(k,687) * lu(k,1457) + lu(k,1497) = lu(k,1497) - lu(k,688) * lu(k,1457) + lu(k,1499) = lu(k,1499) - lu(k,689) * lu(k,1457) + lu(k,1501) = lu(k,1501) - lu(k,690) * lu(k,1457) + lu(k,1503) = lu(k,1503) - lu(k,691) * lu(k,1457) + lu(k,1505) = lu(k,1505) - lu(k,692) * lu(k,1457) + lu(k,1507) = lu(k,1507) - lu(k,693) * lu(k,1457) + lu(k,1659) = lu(k,1659) - lu(k,687) * lu(k,1649) + lu(k,1680) = lu(k,1680) - lu(k,688) * lu(k,1649) + lu(k,1682) = lu(k,1682) - lu(k,689) * lu(k,1649) + lu(k,1684) = lu(k,1684) - lu(k,690) * lu(k,1649) + lu(k,1686) = lu(k,1686) - lu(k,691) * lu(k,1649) + lu(k,1688) = lu(k,1688) - lu(k,692) * lu(k,1649) + lu(k,1690) = lu(k,1690) - lu(k,693) * lu(k,1649) + lu(k,1775) = lu(k,1775) - lu(k,687) * lu(k,1765) + lu(k,1796) = lu(k,1796) - lu(k,688) * lu(k,1765) + lu(k,1798) = lu(k,1798) - lu(k,689) * lu(k,1765) + lu(k,1800) = lu(k,1800) - lu(k,690) * lu(k,1765) + lu(k,1802) = lu(k,1802) - lu(k,691) * lu(k,1765) + lu(k,1804) = lu(k,1804) - lu(k,692) * lu(k,1765) + lu(k,1806) = lu(k,1806) - lu(k,693) * lu(k,1765) + lu(k,1947) = - lu(k,687) * lu(k,1943) + lu(k,1954) = lu(k,1954) - lu(k,688) * lu(k,1943) + lu(k,1956) = lu(k,1956) - lu(k,689) * lu(k,1943) + lu(k,1958) = lu(k,1958) - lu(k,690) * lu(k,1943) + lu(k,1960) = lu(k,1960) - lu(k,691) * lu(k,1943) + lu(k,1962) = lu(k,1962) - lu(k,692) * lu(k,1943) + lu(k,1964) = lu(k,1964) - lu(k,693) * lu(k,1943) + lu(k,694) = 1._r8 / lu(k,694) + lu(k,695) = lu(k,695) * lu(k,694) + lu(k,696) = lu(k,696) * lu(k,694) + lu(k,697) = lu(k,697) * lu(k,694) + lu(k,698) = lu(k,698) * lu(k,694) + lu(k,699) = lu(k,699) * lu(k,694) + lu(k,700) = lu(k,700) * lu(k,694) + lu(k,701) = lu(k,701) * lu(k,694) + lu(k,1247) = lu(k,1247) - lu(k,695) * lu(k,1245) + lu(k,1248) = - lu(k,696) * lu(k,1245) + lu(k,1249) = - lu(k,697) * lu(k,1245) + lu(k,1250) = - lu(k,698) * lu(k,1245) + lu(k,1251) = lu(k,1251) - lu(k,699) * lu(k,1245) + lu(k,1253) = - lu(k,700) * lu(k,1245) + lu(k,1256) = - lu(k,701) * lu(k,1245) + lu(k,1340) = lu(k,1340) - lu(k,695) * lu(k,1338) + lu(k,1342) = lu(k,1342) - lu(k,696) * lu(k,1338) + lu(k,1344) = lu(k,1344) - lu(k,697) * lu(k,1338) + lu(k,1345) = lu(k,1345) - lu(k,698) * lu(k,1338) + lu(k,1346) = lu(k,1346) - lu(k,699) * lu(k,1338) + lu(k,1348) = lu(k,1348) - lu(k,700) * lu(k,1338) + lu(k,1357) = lu(k,1357) - lu(k,701) * lu(k,1338) + lu(k,1494) = lu(k,1494) - lu(k,695) * lu(k,1458) + lu(k,1496) = lu(k,1496) - lu(k,696) * lu(k,1458) + lu(k,1498) = lu(k,1498) - lu(k,697) * lu(k,1458) + lu(k,1499) = lu(k,1499) - lu(k,698) * lu(k,1458) + lu(k,1500) = lu(k,1500) - lu(k,699) * lu(k,1458) + lu(k,1502) = lu(k,1502) - lu(k,700) * lu(k,1458) + lu(k,1511) = lu(k,1511) - lu(k,701) * lu(k,1458) + lu(k,1541) = lu(k,1541) - lu(k,695) * lu(k,1538) + lu(k,1543) = lu(k,1543) - lu(k,696) * lu(k,1538) + lu(k,1545) = - lu(k,697) * lu(k,1538) + lu(k,1546) = lu(k,1546) - lu(k,698) * lu(k,1538) + lu(k,1547) = - lu(k,699) * lu(k,1538) + lu(k,1549) = lu(k,1549) - lu(k,700) * lu(k,1538) + lu(k,1558) = lu(k,1558) - lu(k,701) * lu(k,1538) + lu(k,1571) = lu(k,1571) - lu(k,695) * lu(k,1565) + lu(k,1573) = lu(k,1573) - lu(k,696) * lu(k,1565) + lu(k,1575) = - lu(k,697) * lu(k,1565) + lu(k,1576) = lu(k,1576) - lu(k,698) * lu(k,1565) + lu(k,1577) = lu(k,1577) - lu(k,699) * lu(k,1565) + lu(k,1579) = lu(k,1579) - lu(k,700) * lu(k,1565) + lu(k,1588) = lu(k,1588) - lu(k,701) * lu(k,1565) + lu(k,1677) = lu(k,1677) - lu(k,695) * lu(k,1650) + lu(k,1679) = lu(k,1679) - lu(k,696) * lu(k,1650) + lu(k,1681) = - lu(k,697) * lu(k,1650) + lu(k,1682) = lu(k,1682) - lu(k,698) * lu(k,1650) + lu(k,1683) = lu(k,1683) - lu(k,699) * lu(k,1650) + lu(k,1685) = lu(k,1685) - lu(k,700) * lu(k,1650) + lu(k,1694) = lu(k,1694) - lu(k,701) * lu(k,1650) + lu(k,706) = 1._r8 / lu(k,706) + lu(k,707) = lu(k,707) * lu(k,706) + lu(k,708) = lu(k,708) * lu(k,706) + lu(k,709) = lu(k,709) * lu(k,706) + lu(k,710) = lu(k,710) * lu(k,706) + lu(k,711) = lu(k,711) * lu(k,706) + lu(k,712) = lu(k,712) * lu(k,706) + lu(k,713) = lu(k,713) * lu(k,706) + lu(k,714) = lu(k,714) * lu(k,706) + lu(k,715) = lu(k,715) * lu(k,706) + lu(k,716) = lu(k,716) * lu(k,706) + lu(k,717) = lu(k,717) * lu(k,706) + lu(k,718) = lu(k,718) * lu(k,706) + lu(k,719) = lu(k,719) * lu(k,706) + lu(k,720) = lu(k,720) * lu(k,706) + lu(k,721) = lu(k,721) * lu(k,706) + lu(k,1469) = lu(k,1469) - lu(k,707) * lu(k,1459) + lu(k,1475) = lu(k,1475) - lu(k,708) * lu(k,1459) + lu(k,1484) = - lu(k,709) * lu(k,1459) + lu(k,1485) = lu(k,1485) - lu(k,710) * lu(k,1459) + lu(k,1488) = lu(k,1488) - lu(k,711) * lu(k,1459) + lu(k,1489) = lu(k,1489) - lu(k,712) * lu(k,1459) + lu(k,1491) = lu(k,1491) - lu(k,713) * lu(k,1459) + lu(k,1493) = lu(k,1493) - lu(k,714) * lu(k,1459) + lu(k,1497) = lu(k,1497) - lu(k,715) * lu(k,1459) + lu(k,1499) = lu(k,1499) - lu(k,716) * lu(k,1459) + lu(k,1501) = lu(k,1501) - lu(k,717) * lu(k,1459) + lu(k,1503) = lu(k,1503) - lu(k,718) * lu(k,1459) + lu(k,1506) = lu(k,1506) - lu(k,719) * lu(k,1459) + lu(k,1510) = lu(k,1510) - lu(k,720) * lu(k,1459) + lu(k,1511) = lu(k,1511) - lu(k,721) * lu(k,1459) + lu(k,1832) = lu(k,1832) - lu(k,707) * lu(k,1825) + lu(k,1837) = lu(k,1837) - lu(k,708) * lu(k,1825) + lu(k,1843) = - lu(k,709) * lu(k,1825) + lu(k,1844) = lu(k,1844) - lu(k,710) * lu(k,1825) + lu(k,1847) = - lu(k,711) * lu(k,1825) + lu(k,1848) = lu(k,1848) - lu(k,712) * lu(k,1825) + lu(k,1850) = - lu(k,713) * lu(k,1825) + lu(k,1852) = lu(k,1852) - lu(k,714) * lu(k,1825) + lu(k,1856) = lu(k,1856) - lu(k,715) * lu(k,1825) + lu(k,1858) = lu(k,1858) - lu(k,716) * lu(k,1825) + lu(k,1860) = lu(k,1860) - lu(k,717) * lu(k,1825) + lu(k,1862) = lu(k,1862) - lu(k,718) * lu(k,1825) + lu(k,1865) = lu(k,1865) - lu(k,719) * lu(k,1825) + lu(k,1869) = lu(k,1869) - lu(k,720) * lu(k,1825) + lu(k,1870) = lu(k,1870) - lu(k,721) * lu(k,1825) + lu(k,1984) = lu(k,1984) - lu(k,707) * lu(k,1976) + lu(k,1990) = lu(k,1990) - lu(k,708) * lu(k,1976) + lu(k,1998) = lu(k,1998) - lu(k,709) * lu(k,1976) + lu(k,1999) = lu(k,1999) - lu(k,710) * lu(k,1976) + lu(k,2002) = lu(k,2002) - lu(k,711) * lu(k,1976) + lu(k,2003) = lu(k,2003) - lu(k,712) * lu(k,1976) + lu(k,2005) = lu(k,2005) - lu(k,713) * lu(k,1976) + lu(k,2007) = lu(k,2007) - lu(k,714) * lu(k,1976) + lu(k,2011) = - lu(k,715) * lu(k,1976) + lu(k,2013) = lu(k,2013) - lu(k,716) * lu(k,1976) + lu(k,2015) = lu(k,2015) - lu(k,717) * lu(k,1976) + lu(k,2017) = lu(k,2017) - lu(k,718) * lu(k,1976) + lu(k,2020) = - lu(k,719) * lu(k,1976) + lu(k,2024) = lu(k,2024) - lu(k,720) * lu(k,1976) + lu(k,2025) = - lu(k,721) * lu(k,1976) + end do + end subroutine lu_fac15 + subroutine lu_fac16( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,723) = 1._r8 / lu(k,723) + lu(k,724) = lu(k,724) * lu(k,723) + lu(k,725) = lu(k,725) * lu(k,723) + lu(k,726) = lu(k,726) * lu(k,723) + lu(k,727) = lu(k,727) * lu(k,723) + lu(k,728) = lu(k,728) * lu(k,723) + lu(k,1083) = lu(k,1083) - lu(k,724) * lu(k,1082) + lu(k,1086) = lu(k,1086) - lu(k,725) * lu(k,1082) + lu(k,1088) = lu(k,1088) - lu(k,726) * lu(k,1082) + lu(k,1089) = - lu(k,727) * lu(k,1082) + lu(k,1095) = - lu(k,728) * lu(k,1082) + lu(k,1487) = lu(k,1487) - lu(k,724) * lu(k,1460) + lu(k,1499) = lu(k,1499) - lu(k,725) * lu(k,1460) + lu(k,1502) = lu(k,1502) - lu(k,726) * lu(k,1460) + lu(k,1503) = lu(k,1503) - lu(k,727) * lu(k,1460) + lu(k,1511) = lu(k,1511) - lu(k,728) * lu(k,1460) + lu(k,1517) = lu(k,1517) - lu(k,724) * lu(k,1516) + lu(k,1523) = lu(k,1523) - lu(k,725) * lu(k,1516) + lu(k,1526) = lu(k,1526) - lu(k,726) * lu(k,1516) + lu(k,1527) = lu(k,1527) - lu(k,727) * lu(k,1516) + lu(k,1535) = lu(k,1535) - lu(k,728) * lu(k,1516) + lu(k,1570) = lu(k,1570) - lu(k,724) * lu(k,1566) + lu(k,1576) = lu(k,1576) - lu(k,725) * lu(k,1566) + lu(k,1579) = lu(k,1579) - lu(k,726) * lu(k,1566) + lu(k,1580) = lu(k,1580) - lu(k,727) * lu(k,1566) + lu(k,1588) = lu(k,1588) - lu(k,728) * lu(k,1566) + lu(k,1702) = lu(k,1702) - lu(k,724) * lu(k,1700) + lu(k,1708) = lu(k,1708) - lu(k,725) * lu(k,1700) + lu(k,1711) = lu(k,1711) - lu(k,726) * lu(k,1700) + lu(k,1712) = lu(k,1712) - lu(k,727) * lu(k,1700) + lu(k,1720) = lu(k,1720) - lu(k,728) * lu(k,1700) + lu(k,1846) = lu(k,1846) - lu(k,724) * lu(k,1826) + lu(k,1858) = lu(k,1858) - lu(k,725) * lu(k,1826) + lu(k,1861) = lu(k,1861) - lu(k,726) * lu(k,1826) + lu(k,1862) = lu(k,1862) - lu(k,727) * lu(k,1826) + lu(k,1870) = lu(k,1870) - lu(k,728) * lu(k,1826) + lu(k,1891) = lu(k,1891) - lu(k,724) * lu(k,1884) + lu(k,1899) = lu(k,1899) - lu(k,725) * lu(k,1884) + lu(k,1902) = lu(k,1902) - lu(k,726) * lu(k,1884) + lu(k,1903) = lu(k,1903) - lu(k,727) * lu(k,1884) + lu(k,1911) = lu(k,1911) - lu(k,728) * lu(k,1884) + lu(k,2001) = - lu(k,724) * lu(k,1977) + lu(k,2013) = lu(k,2013) - lu(k,725) * lu(k,1977) + lu(k,2016) = lu(k,2016) - lu(k,726) * lu(k,1977) + lu(k,2017) = lu(k,2017) - lu(k,727) * lu(k,1977) + lu(k,2025) = lu(k,2025) - lu(k,728) * lu(k,1977) + lu(k,2032) = - lu(k,724) * lu(k,2030) + lu(k,2038) = lu(k,2038) - lu(k,725) * lu(k,2030) + lu(k,2041) = lu(k,2041) - lu(k,726) * lu(k,2030) + lu(k,2042) = - lu(k,727) * lu(k,2030) + lu(k,2050) = lu(k,2050) - lu(k,728) * lu(k,2030) + lu(k,729) = 1._r8 / lu(k,729) + lu(k,730) = lu(k,730) * lu(k,729) + lu(k,731) = lu(k,731) * lu(k,729) + lu(k,732) = lu(k,732) * lu(k,729) + lu(k,733) = lu(k,733) * lu(k,729) + lu(k,734) = lu(k,734) * lu(k,729) + lu(k,844) = - lu(k,730) * lu(k,839) + lu(k,845) = - lu(k,731) * lu(k,839) + lu(k,847) = lu(k,847) - lu(k,732) * lu(k,839) + lu(k,848) = lu(k,848) - lu(k,733) * lu(k,839) + lu(k,852) = lu(k,852) - lu(k,734) * lu(k,839) + lu(k,875) = - lu(k,730) * lu(k,870) + lu(k,876) = - lu(k,731) * lu(k,870) + lu(k,879) = lu(k,879) - lu(k,732) * lu(k,870) + lu(k,880) = - lu(k,733) * lu(k,870) + lu(k,883) = lu(k,883) - lu(k,734) * lu(k,870) + lu(k,1046) = - lu(k,730) * lu(k,1039) + lu(k,1048) = lu(k,1048) - lu(k,731) * lu(k,1039) + lu(k,1052) = lu(k,1052) - lu(k,732) * lu(k,1039) + lu(k,1053) = lu(k,1053) - lu(k,733) * lu(k,1039) + lu(k,1056) = lu(k,1056) - lu(k,734) * lu(k,1039) + lu(k,1112) = lu(k,1112) - lu(k,730) * lu(k,1102) + lu(k,1117) = lu(k,1117) - lu(k,731) * lu(k,1102) + lu(k,1121) = lu(k,1121) - lu(k,732) * lu(k,1102) + lu(k,1122) = lu(k,1122) - lu(k,733) * lu(k,1102) + lu(k,1126) = lu(k,1126) - lu(k,734) * lu(k,1102) + lu(k,1311) = lu(k,1311) - lu(k,730) * lu(k,1294) + lu(k,1317) = lu(k,1317) - lu(k,731) * lu(k,1294) + lu(k,1322) = lu(k,1322) - lu(k,732) * lu(k,1294) + lu(k,1323) = lu(k,1323) - lu(k,733) * lu(k,1294) + lu(k,1329) = lu(k,1329) - lu(k,734) * lu(k,1294) + lu(k,1486) = lu(k,1486) - lu(k,730) * lu(k,1461) + lu(k,1493) = lu(k,1493) - lu(k,731) * lu(k,1461) + lu(k,1499) = lu(k,1499) - lu(k,732) * lu(k,1461) + lu(k,1501) = lu(k,1501) - lu(k,733) * lu(k,1461) + lu(k,1507) = lu(k,1507) - lu(k,734) * lu(k,1461) + lu(k,1670) = lu(k,1670) - lu(k,730) * lu(k,1651) + lu(k,1676) = lu(k,1676) - lu(k,731) * lu(k,1651) + lu(k,1682) = lu(k,1682) - lu(k,732) * lu(k,1651) + lu(k,1684) = lu(k,1684) - lu(k,733) * lu(k,1651) + lu(k,1690) = lu(k,1690) - lu(k,734) * lu(k,1651) + lu(k,1786) = lu(k,1786) - lu(k,730) * lu(k,1766) + lu(k,1792) = lu(k,1792) - lu(k,731) * lu(k,1766) + lu(k,1798) = lu(k,1798) - lu(k,732) * lu(k,1766) + lu(k,1800) = lu(k,1800) - lu(k,733) * lu(k,1766) + lu(k,1806) = lu(k,1806) - lu(k,734) * lu(k,1766) + lu(k,2000) = lu(k,2000) - lu(k,730) * lu(k,1978) + lu(k,2007) = lu(k,2007) - lu(k,731) * lu(k,1978) + lu(k,2013) = lu(k,2013) - lu(k,732) * lu(k,1978) + lu(k,2015) = lu(k,2015) - lu(k,733) * lu(k,1978) + lu(k,2021) = lu(k,2021) - lu(k,734) * lu(k,1978) + lu(k,736) = 1._r8 / lu(k,736) + lu(k,737) = lu(k,737) * lu(k,736) + lu(k,738) = lu(k,738) * lu(k,736) + lu(k,739) = lu(k,739) * lu(k,736) + lu(k,742) = lu(k,742) - lu(k,737) * lu(k,740) + lu(k,745) = lu(k,745) - lu(k,738) * lu(k,740) + lu(k,746) = lu(k,746) - lu(k,739) * lu(k,740) + lu(k,764) = lu(k,764) - lu(k,737) * lu(k,758) + lu(k,770) = lu(k,770) - lu(k,738) * lu(k,758) + lu(k,772) = lu(k,772) - lu(k,739) * lu(k,758) + lu(k,791) = lu(k,791) - lu(k,737) * lu(k,785) + lu(k,797) = lu(k,797) - lu(k,738) * lu(k,785) + lu(k,799) = lu(k,799) - lu(k,739) * lu(k,785) + lu(k,865) = lu(k,865) - lu(k,737) * lu(k,863) + lu(k,866) = lu(k,866) - lu(k,738) * lu(k,863) + lu(k,868) = lu(k,868) - lu(k,739) * lu(k,863) + lu(k,874) = lu(k,874) - lu(k,737) * lu(k,871) + lu(k,879) = lu(k,879) - lu(k,738) * lu(k,871) + lu(k,881) = lu(k,881) - lu(k,739) * lu(k,871) + lu(k,1009) = lu(k,1009) - lu(k,737) * lu(k,1007) + lu(k,1016) = lu(k,1016) - lu(k,738) * lu(k,1007) + lu(k,1018) = lu(k,1018) - lu(k,739) * lu(k,1007) + lu(k,1106) = lu(k,1106) - lu(k,737) * lu(k,1103) + lu(k,1121) = lu(k,1121) - lu(k,738) * lu(k,1103) + lu(k,1123) = lu(k,1123) - lu(k,739) * lu(k,1103) + lu(k,1222) = lu(k,1222) - lu(k,737) * lu(k,1219) + lu(k,1237) = lu(k,1237) - lu(k,738) * lu(k,1219) + lu(k,1239) = lu(k,1239) - lu(k,739) * lu(k,1219) + lu(k,1302) = lu(k,1302) - lu(k,737) * lu(k,1295) + lu(k,1322) = lu(k,1322) - lu(k,738) * lu(k,1295) + lu(k,1325) = lu(k,1325) - lu(k,739) * lu(k,1295) + lu(k,1475) = lu(k,1475) - lu(k,737) * lu(k,1462) + lu(k,1499) = lu(k,1499) - lu(k,738) * lu(k,1462) + lu(k,1503) = lu(k,1503) - lu(k,739) * lu(k,1462) + lu(k,1660) = lu(k,1660) - lu(k,737) * lu(k,1652) + lu(k,1682) = lu(k,1682) - lu(k,738) * lu(k,1652) + lu(k,1686) = lu(k,1686) - lu(k,739) * lu(k,1652) + lu(k,1776) = lu(k,1776) - lu(k,737) * lu(k,1767) + lu(k,1798) = lu(k,1798) - lu(k,738) * lu(k,1767) + lu(k,1802) = lu(k,1802) - lu(k,739) * lu(k,1767) + lu(k,1837) = lu(k,1837) - lu(k,737) * lu(k,1827) + lu(k,1858) = lu(k,1858) - lu(k,738) * lu(k,1827) + lu(k,1862) = lu(k,1862) - lu(k,739) * lu(k,1827) + lu(k,1888) = lu(k,1888) - lu(k,737) * lu(k,1885) + lu(k,1899) = lu(k,1899) - lu(k,738) * lu(k,1885) + lu(k,1903) = lu(k,1903) - lu(k,739) * lu(k,1885) + lu(k,1948) = lu(k,1948) - lu(k,737) * lu(k,1944) + lu(k,1956) = lu(k,1956) - lu(k,738) * lu(k,1944) + lu(k,1960) = lu(k,1960) - lu(k,739) * lu(k,1944) + lu(k,1990) = lu(k,1990) - lu(k,737) * lu(k,1979) + lu(k,2013) = lu(k,2013) - lu(k,738) * lu(k,1979) + lu(k,2017) = lu(k,2017) - lu(k,739) * lu(k,1979) + lu(k,741) = 1._r8 / lu(k,741) + lu(k,742) = lu(k,742) * lu(k,741) + lu(k,743) = lu(k,743) * lu(k,741) + lu(k,744) = lu(k,744) * lu(k,741) + lu(k,745) = lu(k,745) * lu(k,741) + lu(k,746) = lu(k,746) * lu(k,741) + lu(k,747) = lu(k,747) * lu(k,741) + lu(k,748) = lu(k,748) * lu(k,741) + lu(k,874) = lu(k,874) - lu(k,742) * lu(k,872) + lu(k,875) = lu(k,875) - lu(k,743) * lu(k,872) + lu(k,878) = - lu(k,744) * lu(k,872) + lu(k,879) = lu(k,879) - lu(k,745) * lu(k,872) + lu(k,881) = lu(k,881) - lu(k,746) * lu(k,872) + lu(k,882) = - lu(k,747) * lu(k,872) + lu(k,883) = lu(k,883) - lu(k,748) * lu(k,872) + lu(k,1106) = lu(k,1106) - lu(k,742) * lu(k,1104) + lu(k,1112) = lu(k,1112) - lu(k,743) * lu(k,1104) + lu(k,1120) = lu(k,1120) - lu(k,744) * lu(k,1104) + lu(k,1121) = lu(k,1121) - lu(k,745) * lu(k,1104) + lu(k,1123) = lu(k,1123) - lu(k,746) * lu(k,1104) + lu(k,1124) = lu(k,1124) - lu(k,747) * lu(k,1104) + lu(k,1126) = lu(k,1126) - lu(k,748) * lu(k,1104) + lu(k,1475) = lu(k,1475) - lu(k,742) * lu(k,1463) + lu(k,1486) = lu(k,1486) - lu(k,743) * lu(k,1463) + lu(k,1497) = lu(k,1497) - lu(k,744) * lu(k,1463) + lu(k,1499) = lu(k,1499) - lu(k,745) * lu(k,1463) + lu(k,1503) = lu(k,1503) - lu(k,746) * lu(k,1463) + lu(k,1505) = lu(k,1505) - lu(k,747) * lu(k,1463) + lu(k,1507) = lu(k,1507) - lu(k,748) * lu(k,1463) + lu(k,1660) = lu(k,1660) - lu(k,742) * lu(k,1653) + lu(k,1670) = lu(k,1670) - lu(k,743) * lu(k,1653) + lu(k,1680) = lu(k,1680) - lu(k,744) * lu(k,1653) + lu(k,1682) = lu(k,1682) - lu(k,745) * lu(k,1653) + lu(k,1686) = lu(k,1686) - lu(k,746) * lu(k,1653) + lu(k,1688) = lu(k,1688) - lu(k,747) * lu(k,1653) + lu(k,1690) = lu(k,1690) - lu(k,748) * lu(k,1653) + lu(k,1776) = lu(k,1776) - lu(k,742) * lu(k,1768) + lu(k,1786) = lu(k,1786) - lu(k,743) * lu(k,1768) + lu(k,1796) = lu(k,1796) - lu(k,744) * lu(k,1768) + lu(k,1798) = lu(k,1798) - lu(k,745) * lu(k,1768) + lu(k,1802) = lu(k,1802) - lu(k,746) * lu(k,1768) + lu(k,1804) = lu(k,1804) - lu(k,747) * lu(k,1768) + lu(k,1806) = lu(k,1806) - lu(k,748) * lu(k,1768) + lu(k,1888) = lu(k,1888) - lu(k,742) * lu(k,1886) + lu(k,1890) = lu(k,1890) - lu(k,743) * lu(k,1886) + lu(k,1897) = lu(k,1897) - lu(k,744) * lu(k,1886) + lu(k,1899) = lu(k,1899) - lu(k,745) * lu(k,1886) + lu(k,1903) = lu(k,1903) - lu(k,746) * lu(k,1886) + lu(k,1905) = lu(k,1905) - lu(k,747) * lu(k,1886) + lu(k,1907) = lu(k,1907) - lu(k,748) * lu(k,1886) + lu(k,759) = 1._r8 / lu(k,759) + lu(k,760) = lu(k,760) * lu(k,759) + lu(k,761) = lu(k,761) * lu(k,759) + lu(k,762) = lu(k,762) * lu(k,759) + lu(k,763) = lu(k,763) * lu(k,759) + lu(k,764) = lu(k,764) * lu(k,759) + lu(k,765) = lu(k,765) * lu(k,759) + lu(k,766) = lu(k,766) * lu(k,759) + lu(k,767) = lu(k,767) * lu(k,759) + lu(k,768) = lu(k,768) * lu(k,759) + lu(k,769) = lu(k,769) * lu(k,759) + lu(k,770) = lu(k,770) * lu(k,759) + lu(k,771) = lu(k,771) * lu(k,759) + lu(k,772) = lu(k,772) * lu(k,759) + lu(k,773) = lu(k,773) * lu(k,759) + lu(k,774) = lu(k,774) * lu(k,759) + lu(k,775) = lu(k,775) * lu(k,759) + lu(k,1466) = lu(k,1466) - lu(k,760) * lu(k,1464) + lu(k,1467) = lu(k,1467) - lu(k,761) * lu(k,1464) + lu(k,1470) = lu(k,1470) - lu(k,762) * lu(k,1464) + lu(k,1473) = lu(k,1473) - lu(k,763) * lu(k,1464) + lu(k,1475) = lu(k,1475) - lu(k,764) * lu(k,1464) + lu(k,1478) = lu(k,1478) - lu(k,765) * lu(k,1464) + lu(k,1480) = lu(k,1480) - lu(k,766) * lu(k,1464) + lu(k,1481) = lu(k,1481) - lu(k,767) * lu(k,1464) + lu(k,1486) = lu(k,1486) - lu(k,768) * lu(k,1464) + lu(k,1493) = lu(k,1493) - lu(k,769) * lu(k,1464) + lu(k,1499) = lu(k,1499) - lu(k,770) * lu(k,1464) + lu(k,1501) = lu(k,1501) - lu(k,771) * lu(k,1464) + lu(k,1503) = lu(k,1503) - lu(k,772) * lu(k,1464) + lu(k,1506) = lu(k,1506) - lu(k,773) * lu(k,1464) + lu(k,1510) = lu(k,1510) - lu(k,774) * lu(k,1464) + lu(k,1511) = lu(k,1511) - lu(k,775) * lu(k,1464) + lu(k,1830) = lu(k,1830) - lu(k,760) * lu(k,1828) + lu(k,1831) = lu(k,1831) - lu(k,761) * lu(k,1828) + lu(k,1833) = lu(k,1833) - lu(k,762) * lu(k,1828) + lu(k,1835) = lu(k,1835) - lu(k,763) * lu(k,1828) + lu(k,1837) = lu(k,1837) - lu(k,764) * lu(k,1828) + lu(k,1839) = - lu(k,765) * lu(k,1828) + lu(k,1841) = - lu(k,766) * lu(k,1828) + lu(k,1842) = lu(k,1842) - lu(k,767) * lu(k,1828) + lu(k,1845) = lu(k,1845) - lu(k,768) * lu(k,1828) + lu(k,1852) = lu(k,1852) - lu(k,769) * lu(k,1828) + lu(k,1858) = lu(k,1858) - lu(k,770) * lu(k,1828) + lu(k,1860) = lu(k,1860) - lu(k,771) * lu(k,1828) + lu(k,1862) = lu(k,1862) - lu(k,772) * lu(k,1828) + lu(k,1865) = lu(k,1865) - lu(k,773) * lu(k,1828) + lu(k,1869) = lu(k,1869) - lu(k,774) * lu(k,1828) + lu(k,1870) = lu(k,1870) - lu(k,775) * lu(k,1828) + lu(k,1982) = - lu(k,760) * lu(k,1980) + lu(k,1983) = lu(k,1983) - lu(k,761) * lu(k,1980) + lu(k,1985) = lu(k,1985) - lu(k,762) * lu(k,1980) + lu(k,1988) = - lu(k,763) * lu(k,1980) + lu(k,1990) = lu(k,1990) - lu(k,764) * lu(k,1980) + lu(k,1993) = - lu(k,765) * lu(k,1980) + lu(k,1995) = lu(k,1995) - lu(k,766) * lu(k,1980) + lu(k,1996) = - lu(k,767) * lu(k,1980) + lu(k,2000) = lu(k,2000) - lu(k,768) * lu(k,1980) + lu(k,2007) = lu(k,2007) - lu(k,769) * lu(k,1980) + lu(k,2013) = lu(k,2013) - lu(k,770) * lu(k,1980) + lu(k,2015) = lu(k,2015) - lu(k,771) * lu(k,1980) + lu(k,2017) = lu(k,2017) - lu(k,772) * lu(k,1980) + lu(k,2020) = lu(k,2020) - lu(k,773) * lu(k,1980) + lu(k,2024) = lu(k,2024) - lu(k,774) * lu(k,1980) + lu(k,2025) = lu(k,2025) - lu(k,775) * lu(k,1980) + end do + end subroutine lu_fac16 + subroutine lu_fac17( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,786) = 1._r8 / lu(k,786) + lu(k,787) = lu(k,787) * lu(k,786) + lu(k,788) = lu(k,788) * lu(k,786) + lu(k,789) = lu(k,789) * lu(k,786) + lu(k,790) = lu(k,790) * lu(k,786) + lu(k,791) = lu(k,791) * lu(k,786) + lu(k,792) = lu(k,792) * lu(k,786) + lu(k,793) = lu(k,793) * lu(k,786) + lu(k,794) = lu(k,794) * lu(k,786) + lu(k,795) = lu(k,795) * lu(k,786) + lu(k,796) = lu(k,796) * lu(k,786) + lu(k,797) = lu(k,797) * lu(k,786) + lu(k,798) = lu(k,798) * lu(k,786) + lu(k,799) = lu(k,799) * lu(k,786) + lu(k,800) = lu(k,800) * lu(k,786) + lu(k,801) = lu(k,801) * lu(k,786) + lu(k,802) = lu(k,802) * lu(k,786) + lu(k,1466) = lu(k,1466) - lu(k,787) * lu(k,1465) + lu(k,1467) = lu(k,1467) - lu(k,788) * lu(k,1465) + lu(k,1470) = lu(k,1470) - lu(k,789) * lu(k,1465) + lu(k,1473) = lu(k,1473) - lu(k,790) * lu(k,1465) + lu(k,1475) = lu(k,1475) - lu(k,791) * lu(k,1465) + lu(k,1478) = lu(k,1478) - lu(k,792) * lu(k,1465) + lu(k,1480) = lu(k,1480) - lu(k,793) * lu(k,1465) + lu(k,1481) = lu(k,1481) - lu(k,794) * lu(k,1465) + lu(k,1486) = lu(k,1486) - lu(k,795) * lu(k,1465) + lu(k,1493) = lu(k,1493) - lu(k,796) * lu(k,1465) + lu(k,1499) = lu(k,1499) - lu(k,797) * lu(k,1465) + lu(k,1501) = lu(k,1501) - lu(k,798) * lu(k,1465) + lu(k,1503) = lu(k,1503) - lu(k,799) * lu(k,1465) + lu(k,1506) = lu(k,1506) - lu(k,800) * lu(k,1465) + lu(k,1510) = lu(k,1510) - lu(k,801) * lu(k,1465) + lu(k,1511) = lu(k,1511) - lu(k,802) * lu(k,1465) + lu(k,1830) = lu(k,1830) - lu(k,787) * lu(k,1829) + lu(k,1831) = lu(k,1831) - lu(k,788) * lu(k,1829) + lu(k,1833) = lu(k,1833) - lu(k,789) * lu(k,1829) + lu(k,1835) = lu(k,1835) - lu(k,790) * lu(k,1829) + lu(k,1837) = lu(k,1837) - lu(k,791) * lu(k,1829) + lu(k,1839) = lu(k,1839) - lu(k,792) * lu(k,1829) + lu(k,1841) = lu(k,1841) - lu(k,793) * lu(k,1829) + lu(k,1842) = lu(k,1842) - lu(k,794) * lu(k,1829) + lu(k,1845) = lu(k,1845) - lu(k,795) * lu(k,1829) + lu(k,1852) = lu(k,1852) - lu(k,796) * lu(k,1829) + lu(k,1858) = lu(k,1858) - lu(k,797) * lu(k,1829) + lu(k,1860) = lu(k,1860) - lu(k,798) * lu(k,1829) + lu(k,1862) = lu(k,1862) - lu(k,799) * lu(k,1829) + lu(k,1865) = lu(k,1865) - lu(k,800) * lu(k,1829) + lu(k,1869) = lu(k,1869) - lu(k,801) * lu(k,1829) + lu(k,1870) = lu(k,1870) - lu(k,802) * lu(k,1829) + lu(k,1982) = lu(k,1982) - lu(k,787) * lu(k,1981) + lu(k,1983) = lu(k,1983) - lu(k,788) * lu(k,1981) + lu(k,1985) = lu(k,1985) - lu(k,789) * lu(k,1981) + lu(k,1988) = lu(k,1988) - lu(k,790) * lu(k,1981) + lu(k,1990) = lu(k,1990) - lu(k,791) * lu(k,1981) + lu(k,1993) = lu(k,1993) - lu(k,792) * lu(k,1981) + lu(k,1995) = lu(k,1995) - lu(k,793) * lu(k,1981) + lu(k,1996) = lu(k,1996) - lu(k,794) * lu(k,1981) + lu(k,2000) = lu(k,2000) - lu(k,795) * lu(k,1981) + lu(k,2007) = lu(k,2007) - lu(k,796) * lu(k,1981) + lu(k,2013) = lu(k,2013) - lu(k,797) * lu(k,1981) + lu(k,2015) = lu(k,2015) - lu(k,798) * lu(k,1981) + lu(k,2017) = lu(k,2017) - lu(k,799) * lu(k,1981) + lu(k,2020) = lu(k,2020) - lu(k,800) * lu(k,1981) + lu(k,2024) = lu(k,2024) - lu(k,801) * lu(k,1981) + lu(k,2025) = lu(k,2025) - lu(k,802) * lu(k,1981) + lu(k,808) = 1._r8 / lu(k,808) + lu(k,809) = lu(k,809) * lu(k,808) + lu(k,810) = lu(k,810) * lu(k,808) + lu(k,811) = lu(k,811) * lu(k,808) + lu(k,812) = lu(k,812) * lu(k,808) + lu(k,813) = lu(k,813) * lu(k,808) + lu(k,814) = lu(k,814) * lu(k,808) + lu(k,815) = lu(k,815) * lu(k,808) + lu(k,816) = lu(k,816) * lu(k,808) + lu(k,817) = lu(k,817) * lu(k,808) + lu(k,1467) = lu(k,1467) - lu(k,809) * lu(k,1466) + lu(k,1474) = lu(k,1474) - lu(k,810) * lu(k,1466) + lu(k,1493) = lu(k,1493) - lu(k,811) * lu(k,1466) + lu(k,1497) = lu(k,1497) - lu(k,812) * lu(k,1466) + lu(k,1499) = lu(k,1499) - lu(k,813) * lu(k,1466) + lu(k,1501) = lu(k,1501) - lu(k,814) * lu(k,1466) + lu(k,1503) = lu(k,1503) - lu(k,815) * lu(k,1466) + lu(k,1505) = lu(k,1505) - lu(k,816) * lu(k,1466) + lu(k,1507) = lu(k,1507) - lu(k,817) * lu(k,1466) + lu(k,1655) = lu(k,1655) - lu(k,809) * lu(k,1654) + lu(k,1659) = lu(k,1659) - lu(k,810) * lu(k,1654) + lu(k,1676) = lu(k,1676) - lu(k,811) * lu(k,1654) + lu(k,1680) = lu(k,1680) - lu(k,812) * lu(k,1654) + lu(k,1682) = lu(k,1682) - lu(k,813) * lu(k,1654) + lu(k,1684) = lu(k,1684) - lu(k,814) * lu(k,1654) + lu(k,1686) = lu(k,1686) - lu(k,815) * lu(k,1654) + lu(k,1688) = lu(k,1688) - lu(k,816) * lu(k,1654) + lu(k,1690) = lu(k,1690) - lu(k,817) * lu(k,1654) + lu(k,1770) = lu(k,1770) - lu(k,809) * lu(k,1769) + lu(k,1775) = lu(k,1775) - lu(k,810) * lu(k,1769) + lu(k,1792) = lu(k,1792) - lu(k,811) * lu(k,1769) + lu(k,1796) = lu(k,1796) - lu(k,812) * lu(k,1769) + lu(k,1798) = lu(k,1798) - lu(k,813) * lu(k,1769) + lu(k,1800) = lu(k,1800) - lu(k,814) * lu(k,1769) + lu(k,1802) = lu(k,1802) - lu(k,815) * lu(k,1769) + lu(k,1804) = lu(k,1804) - lu(k,816) * lu(k,1769) + lu(k,1806) = lu(k,1806) - lu(k,817) * lu(k,1769) + lu(k,1831) = lu(k,1831) - lu(k,809) * lu(k,1830) + lu(k,1836) = lu(k,1836) - lu(k,810) * lu(k,1830) + lu(k,1852) = lu(k,1852) - lu(k,811) * lu(k,1830) + lu(k,1856) = lu(k,1856) - lu(k,812) * lu(k,1830) + lu(k,1858) = lu(k,1858) - lu(k,813) * lu(k,1830) + lu(k,1860) = lu(k,1860) - lu(k,814) * lu(k,1830) + lu(k,1862) = lu(k,1862) - lu(k,815) * lu(k,1830) + lu(k,1864) = lu(k,1864) - lu(k,816) * lu(k,1830) + lu(k,1866) = lu(k,1866) - lu(k,817) * lu(k,1830) + lu(k,1983) = lu(k,1983) - lu(k,809) * lu(k,1982) + lu(k,1989) = lu(k,1989) - lu(k,810) * lu(k,1982) + lu(k,2007) = lu(k,2007) - lu(k,811) * lu(k,1982) + lu(k,2011) = lu(k,2011) - lu(k,812) * lu(k,1982) + lu(k,2013) = lu(k,2013) - lu(k,813) * lu(k,1982) + lu(k,2015) = lu(k,2015) - lu(k,814) * lu(k,1982) + lu(k,2017) = lu(k,2017) - lu(k,815) * lu(k,1982) + lu(k,2019) = lu(k,2019) - lu(k,816) * lu(k,1982) + lu(k,2021) = lu(k,2021) - lu(k,817) * lu(k,1982) + lu(k,818) = 1._r8 / lu(k,818) + lu(k,819) = lu(k,819) * lu(k,818) + lu(k,820) = lu(k,820) * lu(k,818) + lu(k,821) = lu(k,821) * lu(k,818) + lu(k,822) = lu(k,822) * lu(k,818) + lu(k,823) = lu(k,823) * lu(k,818) + lu(k,887) = lu(k,887) - lu(k,819) * lu(k,884) + lu(k,888) = lu(k,888) - lu(k,820) * lu(k,884) + lu(k,889) = - lu(k,821) * lu(k,884) + lu(k,890) = lu(k,890) - lu(k,822) * lu(k,884) + lu(k,893) = - lu(k,823) * lu(k,884) + lu(k,914) = - lu(k,819) * lu(k,908) + lu(k,915) = lu(k,915) - lu(k,820) * lu(k,908) + lu(k,918) = - lu(k,821) * lu(k,908) + lu(k,919) = lu(k,919) - lu(k,822) * lu(k,908) + lu(k,924) = - lu(k,823) * lu(k,908) + lu(k,941) = - lu(k,819) * lu(k,934) + lu(k,942) = - lu(k,820) * lu(k,934) + lu(k,945) = lu(k,945) - lu(k,821) * lu(k,934) + lu(k,946) = lu(k,946) - lu(k,822) * lu(k,934) + lu(k,952) = - lu(k,823) * lu(k,934) + lu(k,961) = - lu(k,819) * lu(k,956) + lu(k,962) = - lu(k,820) * lu(k,956) + lu(k,965) = lu(k,965) - lu(k,821) * lu(k,956) + lu(k,966) = lu(k,966) - lu(k,822) * lu(k,956) + lu(k,971) = - lu(k,823) * lu(k,956) + lu(k,1307) = lu(k,1307) - lu(k,819) * lu(k,1296) + lu(k,1317) = lu(k,1317) - lu(k,820) * lu(k,1296) + lu(k,1320) = lu(k,1320) - lu(k,821) * lu(k,1296) + lu(k,1322) = lu(k,1322) - lu(k,822) * lu(k,1296) + lu(k,1333) = lu(k,1333) - lu(k,823) * lu(k,1296) + lu(k,1481) = lu(k,1481) - lu(k,819) * lu(k,1467) + lu(k,1493) = lu(k,1493) - lu(k,820) * lu(k,1467) + lu(k,1497) = lu(k,1497) - lu(k,821) * lu(k,1467) + lu(k,1499) = lu(k,1499) - lu(k,822) * lu(k,1467) + lu(k,1511) = lu(k,1511) - lu(k,823) * lu(k,1467) + lu(k,1665) = lu(k,1665) - lu(k,819) * lu(k,1655) + lu(k,1676) = lu(k,1676) - lu(k,820) * lu(k,1655) + lu(k,1680) = lu(k,1680) - lu(k,821) * lu(k,1655) + lu(k,1682) = lu(k,1682) - lu(k,822) * lu(k,1655) + lu(k,1694) = lu(k,1694) - lu(k,823) * lu(k,1655) + lu(k,1782) = lu(k,1782) - lu(k,819) * lu(k,1770) + lu(k,1792) = lu(k,1792) - lu(k,820) * lu(k,1770) + lu(k,1796) = lu(k,1796) - lu(k,821) * lu(k,1770) + lu(k,1798) = lu(k,1798) - lu(k,822) * lu(k,1770) + lu(k,1810) = lu(k,1810) - lu(k,823) * lu(k,1770) + lu(k,1842) = lu(k,1842) - lu(k,819) * lu(k,1831) + lu(k,1852) = lu(k,1852) - lu(k,820) * lu(k,1831) + lu(k,1856) = lu(k,1856) - lu(k,821) * lu(k,1831) + lu(k,1858) = lu(k,1858) - lu(k,822) * lu(k,1831) + lu(k,1870) = lu(k,1870) - lu(k,823) * lu(k,1831) + lu(k,1996) = lu(k,1996) - lu(k,819) * lu(k,1983) + lu(k,2007) = lu(k,2007) - lu(k,820) * lu(k,1983) + lu(k,2011) = lu(k,2011) - lu(k,821) * lu(k,1983) + lu(k,2013) = lu(k,2013) - lu(k,822) * lu(k,1983) + lu(k,2025) = lu(k,2025) - lu(k,823) * lu(k,1983) + lu(k,826) = 1._r8 / lu(k,826) + lu(k,827) = lu(k,827) * lu(k,826) + lu(k,828) = lu(k,828) * lu(k,826) + lu(k,829) = lu(k,829) * lu(k,826) + lu(k,830) = lu(k,830) * lu(k,826) + lu(k,831) = lu(k,831) * lu(k,826) + lu(k,832) = lu(k,832) * lu(k,826) + lu(k,833) = lu(k,833) * lu(k,826) + lu(k,834) = lu(k,834) * lu(k,826) + lu(k,835) = lu(k,835) * lu(k,826) + lu(k,1495) = lu(k,1495) - lu(k,827) * lu(k,1468) + lu(k,1499) = lu(k,1499) - lu(k,828) * lu(k,1468) + lu(k,1502) = lu(k,1502) - lu(k,829) * lu(k,1468) + lu(k,1504) = lu(k,1504) - lu(k,830) * lu(k,1468) + lu(k,1507) = lu(k,1507) - lu(k,831) * lu(k,1468) + lu(k,1508) = lu(k,1508) - lu(k,832) * lu(k,1468) + lu(k,1509) = lu(k,1509) - lu(k,833) * lu(k,1468) + lu(k,1510) = lu(k,1510) - lu(k,834) * lu(k,1468) + lu(k,1511) = lu(k,1511) - lu(k,835) * lu(k,1468) + lu(k,1572) = lu(k,1572) - lu(k,827) * lu(k,1567) + lu(k,1576) = lu(k,1576) - lu(k,828) * lu(k,1567) + lu(k,1579) = lu(k,1579) - lu(k,829) * lu(k,1567) + lu(k,1581) = lu(k,1581) - lu(k,830) * lu(k,1567) + lu(k,1584) = lu(k,1584) - lu(k,831) * lu(k,1567) + lu(k,1585) = lu(k,1585) - lu(k,832) * lu(k,1567) + lu(k,1586) = lu(k,1586) - lu(k,833) * lu(k,1567) + lu(k,1587) = lu(k,1587) - lu(k,834) * lu(k,1567) + lu(k,1588) = lu(k,1588) - lu(k,835) * lu(k,1567) + lu(k,1704) = - lu(k,827) * lu(k,1701) + lu(k,1708) = lu(k,1708) - lu(k,828) * lu(k,1701) + lu(k,1711) = lu(k,1711) - lu(k,829) * lu(k,1701) + lu(k,1713) = lu(k,1713) - lu(k,830) * lu(k,1701) + lu(k,1716) = lu(k,1716) - lu(k,831) * lu(k,1701) + lu(k,1717) = lu(k,1717) - lu(k,832) * lu(k,1701) + lu(k,1718) = lu(k,1718) - lu(k,833) * lu(k,1701) + lu(k,1719) = - lu(k,834) * lu(k,1701) + lu(k,1720) = lu(k,1720) - lu(k,835) * lu(k,1701) + lu(k,1895) = lu(k,1895) - lu(k,827) * lu(k,1887) + lu(k,1899) = lu(k,1899) - lu(k,828) * lu(k,1887) + lu(k,1902) = lu(k,1902) - lu(k,829) * lu(k,1887) + lu(k,1904) = lu(k,1904) - lu(k,830) * lu(k,1887) + lu(k,1907) = lu(k,1907) - lu(k,831) * lu(k,1887) + lu(k,1908) = lu(k,1908) - lu(k,832) * lu(k,1887) + lu(k,1909) = lu(k,1909) - lu(k,833) * lu(k,1887) + lu(k,1910) = lu(k,1910) - lu(k,834) * lu(k,1887) + lu(k,1911) = lu(k,1911) - lu(k,835) * lu(k,1887) + lu(k,1918) = lu(k,1918) - lu(k,827) * lu(k,1916) + lu(k,1922) = lu(k,1922) - lu(k,828) * lu(k,1916) + lu(k,1925) = lu(k,1925) - lu(k,829) * lu(k,1916) + lu(k,1927) = lu(k,1927) - lu(k,830) * lu(k,1916) + lu(k,1930) = - lu(k,831) * lu(k,1916) + lu(k,1931) = lu(k,1931) - lu(k,832) * lu(k,1916) + lu(k,1932) = lu(k,1932) - lu(k,833) * lu(k,1916) + lu(k,1933) = - lu(k,834) * lu(k,1916) + lu(k,1934) = lu(k,1934) - lu(k,835) * lu(k,1916) + lu(k,1952) = - lu(k,827) * lu(k,1945) + lu(k,1956) = lu(k,1956) - lu(k,828) * lu(k,1945) + lu(k,1959) = lu(k,1959) - lu(k,829) * lu(k,1945) + lu(k,1961) = lu(k,1961) - lu(k,830) * lu(k,1945) + lu(k,1964) = lu(k,1964) - lu(k,831) * lu(k,1945) + lu(k,1965) = lu(k,1965) - lu(k,832) * lu(k,1945) + lu(k,1966) = lu(k,1966) - lu(k,833) * lu(k,1945) + lu(k,1967) = lu(k,1967) - lu(k,834) * lu(k,1945) + lu(k,1968) = lu(k,1968) - lu(k,835) * lu(k,1945) + end do + end subroutine lu_fac17 + subroutine lu_fac18( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,840) = 1._r8 / lu(k,840) + lu(k,841) = lu(k,841) * lu(k,840) + lu(k,842) = lu(k,842) * lu(k,840) + lu(k,843) = lu(k,843) * lu(k,840) + lu(k,844) = lu(k,844) * lu(k,840) + lu(k,845) = lu(k,845) * lu(k,840) + lu(k,846) = lu(k,846) * lu(k,840) + lu(k,847) = lu(k,847) * lu(k,840) + lu(k,848) = lu(k,848) * lu(k,840) + lu(k,849) = lu(k,849) * lu(k,840) + lu(k,850) = lu(k,850) * lu(k,840) + lu(k,851) = lu(k,851) * lu(k,840) + lu(k,852) = lu(k,852) * lu(k,840) + lu(k,853) = lu(k,853) * lu(k,840) + lu(k,854) = lu(k,854) * lu(k,840) + lu(k,1131) = lu(k,1131) - lu(k,841) * lu(k,1130) + lu(k,1132) = lu(k,1132) - lu(k,842) * lu(k,1130) + lu(k,1133) = - lu(k,843) * lu(k,1130) + lu(k,1134) = lu(k,1134) - lu(k,844) * lu(k,1130) + lu(k,1137) = lu(k,1137) - lu(k,845) * lu(k,1130) + lu(k,1140) = lu(k,1140) - lu(k,846) * lu(k,1130) + lu(k,1141) = lu(k,1141) - lu(k,847) * lu(k,1130) + lu(k,1142) = lu(k,1142) - lu(k,848) * lu(k,1130) + lu(k,1143) = lu(k,1143) - lu(k,849) * lu(k,1130) + lu(k,1144) = - lu(k,850) * lu(k,1130) + lu(k,1145) = lu(k,1145) - lu(k,851) * lu(k,1130) + lu(k,1146) = - lu(k,852) * lu(k,1130) + lu(k,1147) = - lu(k,853) * lu(k,1130) + lu(k,1148) = lu(k,1148) - lu(k,854) * lu(k,1130) + lu(k,1474) = lu(k,1474) - lu(k,841) * lu(k,1469) + lu(k,1475) = lu(k,1475) - lu(k,842) * lu(k,1469) + lu(k,1477) = lu(k,1477) - lu(k,843) * lu(k,1469) + lu(k,1486) = lu(k,1486) - lu(k,844) * lu(k,1469) + lu(k,1493) = lu(k,1493) - lu(k,845) * lu(k,1469) + lu(k,1497) = lu(k,1497) - lu(k,846) * lu(k,1469) + lu(k,1499) = lu(k,1499) - lu(k,847) * lu(k,1469) + lu(k,1501) = lu(k,1501) - lu(k,848) * lu(k,1469) + lu(k,1503) = lu(k,1503) - lu(k,849) * lu(k,1469) + lu(k,1505) = lu(k,1505) - lu(k,850) * lu(k,1469) + lu(k,1506) = lu(k,1506) - lu(k,851) * lu(k,1469) + lu(k,1507) = lu(k,1507) - lu(k,852) * lu(k,1469) + lu(k,1510) = lu(k,1510) - lu(k,853) * lu(k,1469) + lu(k,1511) = lu(k,1511) - lu(k,854) * lu(k,1469) + lu(k,1836) = lu(k,1836) - lu(k,841) * lu(k,1832) + lu(k,1837) = lu(k,1837) - lu(k,842) * lu(k,1832) + lu(k,1838) = - lu(k,843) * lu(k,1832) + lu(k,1845) = lu(k,1845) - lu(k,844) * lu(k,1832) + lu(k,1852) = lu(k,1852) - lu(k,845) * lu(k,1832) + lu(k,1856) = lu(k,1856) - lu(k,846) * lu(k,1832) + lu(k,1858) = lu(k,1858) - lu(k,847) * lu(k,1832) + lu(k,1860) = lu(k,1860) - lu(k,848) * lu(k,1832) + lu(k,1862) = lu(k,1862) - lu(k,849) * lu(k,1832) + lu(k,1864) = lu(k,1864) - lu(k,850) * lu(k,1832) + lu(k,1865) = lu(k,1865) - lu(k,851) * lu(k,1832) + lu(k,1866) = lu(k,1866) - lu(k,852) * lu(k,1832) + lu(k,1869) = lu(k,1869) - lu(k,853) * lu(k,1832) + lu(k,1870) = lu(k,1870) - lu(k,854) * lu(k,1832) + lu(k,1989) = lu(k,1989) - lu(k,841) * lu(k,1984) + lu(k,1990) = lu(k,1990) - lu(k,842) * lu(k,1984) + lu(k,1992) = lu(k,1992) - lu(k,843) * lu(k,1984) + lu(k,2000) = lu(k,2000) - lu(k,844) * lu(k,1984) + lu(k,2007) = lu(k,2007) - lu(k,845) * lu(k,1984) + lu(k,2011) = lu(k,2011) - lu(k,846) * lu(k,1984) + lu(k,2013) = lu(k,2013) - lu(k,847) * lu(k,1984) + lu(k,2015) = lu(k,2015) - lu(k,848) * lu(k,1984) + lu(k,2017) = lu(k,2017) - lu(k,849) * lu(k,1984) + lu(k,2019) = lu(k,2019) - lu(k,850) * lu(k,1984) + lu(k,2020) = lu(k,2020) - lu(k,851) * lu(k,1984) + lu(k,2021) = lu(k,2021) - lu(k,852) * lu(k,1984) + lu(k,2024) = lu(k,2024) - lu(k,853) * lu(k,1984) + lu(k,2025) = lu(k,2025) - lu(k,854) * lu(k,1984) + lu(k,855) = 1._r8 / lu(k,855) + lu(k,856) = lu(k,856) * lu(k,855) + lu(k,857) = lu(k,857) * lu(k,855) + lu(k,858) = lu(k,858) * lu(k,855) + lu(k,859) = lu(k,859) * lu(k,855) + lu(k,860) = lu(k,860) * lu(k,855) + lu(k,861) = lu(k,861) * lu(k,855) + lu(k,862) = lu(k,862) * lu(k,855) + lu(k,936) = - lu(k,856) * lu(k,935) + lu(k,937) = - lu(k,857) * lu(k,935) + lu(k,939) = - lu(k,858) * lu(k,935) + lu(k,940) = - lu(k,859) * lu(k,935) + lu(k,946) = lu(k,946) - lu(k,860) * lu(k,935) + lu(k,948) = lu(k,948) - lu(k,861) * lu(k,935) + lu(k,951) = - lu(k,862) * lu(k,935) + lu(k,976) = - lu(k,856) * lu(k,975) + lu(k,977) = - lu(k,857) * lu(k,975) + lu(k,978) = - lu(k,858) * lu(k,975) + lu(k,979) = lu(k,979) - lu(k,859) * lu(k,975) + lu(k,985) = lu(k,985) - lu(k,860) * lu(k,975) + lu(k,987) = lu(k,987) - lu(k,861) * lu(k,975) + lu(k,990) = lu(k,990) - lu(k,862) * lu(k,975) + lu(k,1300) = lu(k,1300) - lu(k,856) * lu(k,1297) + lu(k,1302) = lu(k,1302) - lu(k,857) * lu(k,1297) + lu(k,1305) = lu(k,1305) - lu(k,858) * lu(k,1297) + lu(k,1306) = lu(k,1306) - lu(k,859) * lu(k,1297) + lu(k,1322) = lu(k,1322) - lu(k,860) * lu(k,1297) + lu(k,1325) = lu(k,1325) - lu(k,861) * lu(k,1297) + lu(k,1332) = - lu(k,862) * lu(k,1297) + lu(k,1473) = lu(k,1473) - lu(k,856) * lu(k,1470) + lu(k,1475) = lu(k,1475) - lu(k,857) * lu(k,1470) + lu(k,1479) = lu(k,1479) - lu(k,858) * lu(k,1470) + lu(k,1480) = lu(k,1480) - lu(k,859) * lu(k,1470) + lu(k,1499) = lu(k,1499) - lu(k,860) * lu(k,1470) + lu(k,1503) = lu(k,1503) - lu(k,861) * lu(k,1470) + lu(k,1510) = lu(k,1510) - lu(k,862) * lu(k,1470) + lu(k,1658) = lu(k,1658) - lu(k,856) * lu(k,1656) + lu(k,1660) = lu(k,1660) - lu(k,857) * lu(k,1656) + lu(k,1663) = lu(k,1663) - lu(k,858) * lu(k,1656) + lu(k,1664) = lu(k,1664) - lu(k,859) * lu(k,1656) + lu(k,1682) = lu(k,1682) - lu(k,860) * lu(k,1656) + lu(k,1686) = lu(k,1686) - lu(k,861) * lu(k,1656) + lu(k,1693) = lu(k,1693) - lu(k,862) * lu(k,1656) + lu(k,1774) = lu(k,1774) - lu(k,856) * lu(k,1771) + lu(k,1776) = lu(k,1776) - lu(k,857) * lu(k,1771) + lu(k,1780) = lu(k,1780) - lu(k,858) * lu(k,1771) + lu(k,1781) = lu(k,1781) - lu(k,859) * lu(k,1771) + lu(k,1798) = lu(k,1798) - lu(k,860) * lu(k,1771) + lu(k,1802) = lu(k,1802) - lu(k,861) * lu(k,1771) + lu(k,1809) = lu(k,1809) - lu(k,862) * lu(k,1771) + lu(k,1835) = lu(k,1835) - lu(k,856) * lu(k,1833) + lu(k,1837) = lu(k,1837) - lu(k,857) * lu(k,1833) + lu(k,1840) = - lu(k,858) * lu(k,1833) + lu(k,1841) = lu(k,1841) - lu(k,859) * lu(k,1833) + lu(k,1858) = lu(k,1858) - lu(k,860) * lu(k,1833) + lu(k,1862) = lu(k,1862) - lu(k,861) * lu(k,1833) + lu(k,1869) = lu(k,1869) - lu(k,862) * lu(k,1833) + lu(k,1988) = lu(k,1988) - lu(k,856) * lu(k,1985) + lu(k,1990) = lu(k,1990) - lu(k,857) * lu(k,1985) + lu(k,1994) = lu(k,1994) - lu(k,858) * lu(k,1985) + lu(k,1995) = lu(k,1995) - lu(k,859) * lu(k,1985) + lu(k,2013) = lu(k,2013) - lu(k,860) * lu(k,1985) + lu(k,2017) = lu(k,2017) - lu(k,861) * lu(k,1985) + lu(k,2024) = lu(k,2024) - lu(k,862) * lu(k,1985) + lu(k,864) = 1._r8 / lu(k,864) + lu(k,865) = lu(k,865) * lu(k,864) + lu(k,866) = lu(k,866) * lu(k,864) + lu(k,867) = lu(k,867) * lu(k,864) + lu(k,868) = lu(k,868) * lu(k,864) + lu(k,911) = lu(k,911) - lu(k,865) * lu(k,909) + lu(k,919) = lu(k,919) - lu(k,866) * lu(k,909) + lu(k,920) = lu(k,920) - lu(k,867) * lu(k,909) + lu(k,921) = lu(k,921) - lu(k,868) * lu(k,909) + lu(k,959) = lu(k,959) - lu(k,865) * lu(k,957) + lu(k,966) = lu(k,966) - lu(k,866) * lu(k,957) + lu(k,967) = lu(k,967) - lu(k,867) * lu(k,957) + lu(k,968) = lu(k,968) - lu(k,868) * lu(k,957) + lu(k,1009) = lu(k,1009) - lu(k,865) * lu(k,1008) + lu(k,1016) = lu(k,1016) - lu(k,866) * lu(k,1008) + lu(k,1017) = lu(k,1017) - lu(k,867) * lu(k,1008) + lu(k,1018) = lu(k,1018) - lu(k,868) * lu(k,1008) + lu(k,1042) = - lu(k,865) * lu(k,1040) + lu(k,1052) = lu(k,1052) - lu(k,866) * lu(k,1040) + lu(k,1053) = lu(k,1053) - lu(k,867) * lu(k,1040) + lu(k,1054) = lu(k,1054) - lu(k,868) * lu(k,1040) + lu(k,1106) = lu(k,1106) - lu(k,865) * lu(k,1105) + lu(k,1121) = lu(k,1121) - lu(k,866) * lu(k,1105) + lu(k,1122) = lu(k,1122) - lu(k,867) * lu(k,1105) + lu(k,1123) = lu(k,1123) - lu(k,868) * lu(k,1105) + lu(k,1152) = lu(k,1152) - lu(k,865) * lu(k,1151) + lu(k,1163) = lu(k,1163) - lu(k,866) * lu(k,1151) + lu(k,1164) = lu(k,1164) - lu(k,867) * lu(k,1151) + lu(k,1165) = lu(k,1165) - lu(k,868) * lu(k,1151) + lu(k,1174) = - lu(k,865) * lu(k,1173) + lu(k,1189) = lu(k,1189) - lu(k,866) * lu(k,1173) + lu(k,1190) = lu(k,1190) - lu(k,867) * lu(k,1173) + lu(k,1191) = lu(k,1191) - lu(k,868) * lu(k,1173) + lu(k,1222) = lu(k,1222) - lu(k,865) * lu(k,1220) + lu(k,1237) = lu(k,1237) - lu(k,866) * lu(k,1220) + lu(k,1238) = lu(k,1238) - lu(k,867) * lu(k,1220) + lu(k,1239) = lu(k,1239) - lu(k,868) * lu(k,1220) + lu(k,1302) = lu(k,1302) - lu(k,865) * lu(k,1298) + lu(k,1322) = lu(k,1322) - lu(k,866) * lu(k,1298) + lu(k,1323) = lu(k,1323) - lu(k,867) * lu(k,1298) + lu(k,1325) = lu(k,1325) - lu(k,868) * lu(k,1298) + lu(k,1475) = lu(k,1475) - lu(k,865) * lu(k,1471) + lu(k,1499) = lu(k,1499) - lu(k,866) * lu(k,1471) + lu(k,1501) = lu(k,1501) - lu(k,867) * lu(k,1471) + lu(k,1503) = lu(k,1503) - lu(k,868) * lu(k,1471) + lu(k,1660) = lu(k,1660) - lu(k,865) * lu(k,1657) + lu(k,1682) = lu(k,1682) - lu(k,866) * lu(k,1657) + lu(k,1684) = lu(k,1684) - lu(k,867) * lu(k,1657) + lu(k,1686) = lu(k,1686) - lu(k,868) * lu(k,1657) + lu(k,1776) = lu(k,1776) - lu(k,865) * lu(k,1772) + lu(k,1798) = lu(k,1798) - lu(k,866) * lu(k,1772) + lu(k,1800) = lu(k,1800) - lu(k,867) * lu(k,1772) + lu(k,1802) = lu(k,1802) - lu(k,868) * lu(k,1772) + lu(k,1837) = lu(k,1837) - lu(k,865) * lu(k,1834) + lu(k,1858) = lu(k,1858) - lu(k,866) * lu(k,1834) + lu(k,1860) = lu(k,1860) - lu(k,867) * lu(k,1834) + lu(k,1862) = lu(k,1862) - lu(k,868) * lu(k,1834) + lu(k,1948) = lu(k,1948) - lu(k,865) * lu(k,1946) + lu(k,1956) = lu(k,1956) - lu(k,866) * lu(k,1946) + lu(k,1958) = lu(k,1958) - lu(k,867) * lu(k,1946) + lu(k,1960) = lu(k,1960) - lu(k,868) * lu(k,1946) + lu(k,1990) = lu(k,1990) - lu(k,865) * lu(k,1986) + lu(k,2013) = lu(k,2013) - lu(k,866) * lu(k,1986) + lu(k,2015) = lu(k,2015) - lu(k,867) * lu(k,1986) + lu(k,2017) = lu(k,2017) - lu(k,868) * lu(k,1986) + lu(k,873) = 1._r8 / lu(k,873) + lu(k,874) = lu(k,874) * lu(k,873) + lu(k,875) = lu(k,875) * lu(k,873) + lu(k,876) = lu(k,876) * lu(k,873) + lu(k,877) = lu(k,877) * lu(k,873) + lu(k,878) = lu(k,878) * lu(k,873) + lu(k,879) = lu(k,879) * lu(k,873) + lu(k,880) = lu(k,880) * lu(k,873) + lu(k,881) = lu(k,881) * lu(k,873) + lu(k,882) = lu(k,882) * lu(k,873) + lu(k,883) = lu(k,883) * lu(k,873) + lu(k,1042) = lu(k,1042) - lu(k,874) * lu(k,1041) + lu(k,1046) = lu(k,1046) - lu(k,875) * lu(k,1041) + lu(k,1048) = lu(k,1048) - lu(k,876) * lu(k,1041) + lu(k,1049) = lu(k,1049) - lu(k,877) * lu(k,1041) + lu(k,1051) = lu(k,1051) - lu(k,878) * lu(k,1041) + lu(k,1052) = lu(k,1052) - lu(k,879) * lu(k,1041) + lu(k,1053) = lu(k,1053) - lu(k,880) * lu(k,1041) + lu(k,1054) = lu(k,1054) - lu(k,881) * lu(k,1041) + lu(k,1055) = lu(k,1055) - lu(k,882) * lu(k,1041) + lu(k,1056) = lu(k,1056) - lu(k,883) * lu(k,1041) + lu(k,1222) = lu(k,1222) - lu(k,874) * lu(k,1221) + lu(k,1227) = lu(k,1227) - lu(k,875) * lu(k,1221) + lu(k,1233) = lu(k,1233) - lu(k,876) * lu(k,1221) + lu(k,1234) = - lu(k,877) * lu(k,1221) + lu(k,1236) = lu(k,1236) - lu(k,878) * lu(k,1221) + lu(k,1237) = lu(k,1237) - lu(k,879) * lu(k,1221) + lu(k,1238) = lu(k,1238) - lu(k,880) * lu(k,1221) + lu(k,1239) = lu(k,1239) - lu(k,881) * lu(k,1221) + lu(k,1240) = lu(k,1240) - lu(k,882) * lu(k,1221) + lu(k,1242) = lu(k,1242) - lu(k,883) * lu(k,1221) + lu(k,1302) = lu(k,1302) - lu(k,874) * lu(k,1299) + lu(k,1311) = lu(k,1311) - lu(k,875) * lu(k,1299) + lu(k,1317) = lu(k,1317) - lu(k,876) * lu(k,1299) + lu(k,1318) = lu(k,1318) - lu(k,877) * lu(k,1299) + lu(k,1320) = lu(k,1320) - lu(k,878) * lu(k,1299) + lu(k,1322) = lu(k,1322) - lu(k,879) * lu(k,1299) + lu(k,1323) = lu(k,1323) - lu(k,880) * lu(k,1299) + lu(k,1325) = lu(k,1325) - lu(k,881) * lu(k,1299) + lu(k,1327) = lu(k,1327) - lu(k,882) * lu(k,1299) + lu(k,1329) = lu(k,1329) - lu(k,883) * lu(k,1299) + lu(k,1475) = lu(k,1475) - lu(k,874) * lu(k,1472) + lu(k,1486) = lu(k,1486) - lu(k,875) * lu(k,1472) + lu(k,1493) = lu(k,1493) - lu(k,876) * lu(k,1472) + lu(k,1495) = lu(k,1495) - lu(k,877) * lu(k,1472) + lu(k,1497) = lu(k,1497) - lu(k,878) * lu(k,1472) + lu(k,1499) = lu(k,1499) - lu(k,879) * lu(k,1472) + lu(k,1501) = lu(k,1501) - lu(k,880) * lu(k,1472) + lu(k,1503) = lu(k,1503) - lu(k,881) * lu(k,1472) + lu(k,1505) = lu(k,1505) - lu(k,882) * lu(k,1472) + lu(k,1507) = lu(k,1507) - lu(k,883) * lu(k,1472) + lu(k,1776) = lu(k,1776) - lu(k,874) * lu(k,1773) + lu(k,1786) = lu(k,1786) - lu(k,875) * lu(k,1773) + lu(k,1792) = lu(k,1792) - lu(k,876) * lu(k,1773) + lu(k,1794) = lu(k,1794) - lu(k,877) * lu(k,1773) + lu(k,1796) = lu(k,1796) - lu(k,878) * lu(k,1773) + lu(k,1798) = lu(k,1798) - lu(k,879) * lu(k,1773) + lu(k,1800) = lu(k,1800) - lu(k,880) * lu(k,1773) + lu(k,1802) = lu(k,1802) - lu(k,881) * lu(k,1773) + lu(k,1804) = lu(k,1804) - lu(k,882) * lu(k,1773) + lu(k,1806) = lu(k,1806) - lu(k,883) * lu(k,1773) + lu(k,1990) = lu(k,1990) - lu(k,874) * lu(k,1987) + lu(k,2000) = lu(k,2000) - lu(k,875) * lu(k,1987) + lu(k,2007) = lu(k,2007) - lu(k,876) * lu(k,1987) + lu(k,2009) = lu(k,2009) - lu(k,877) * lu(k,1987) + lu(k,2011) = lu(k,2011) - lu(k,878) * lu(k,1987) + lu(k,2013) = lu(k,2013) - lu(k,879) * lu(k,1987) + lu(k,2015) = lu(k,2015) - lu(k,880) * lu(k,1987) + lu(k,2017) = lu(k,2017) - lu(k,881) * lu(k,1987) + lu(k,2019) = lu(k,2019) - lu(k,882) * lu(k,1987) + lu(k,2021) = lu(k,2021) - lu(k,883) * lu(k,1987) + end do + end subroutine lu_fac18 + subroutine lu_fac19( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,885) = 1._r8 / lu(k,885) + lu(k,886) = lu(k,886) * lu(k,885) + lu(k,887) = lu(k,887) * lu(k,885) + lu(k,888) = lu(k,888) * lu(k,885) + lu(k,889) = lu(k,889) * lu(k,885) + lu(k,890) = lu(k,890) * lu(k,885) + lu(k,891) = lu(k,891) * lu(k,885) + lu(k,892) = lu(k,892) * lu(k,885) + lu(k,893) = lu(k,893) * lu(k,885) + lu(k,937) = lu(k,937) - lu(k,886) * lu(k,936) + lu(k,941) = lu(k,941) - lu(k,887) * lu(k,936) + lu(k,942) = lu(k,942) - lu(k,888) * lu(k,936) + lu(k,945) = lu(k,945) - lu(k,889) * lu(k,936) + lu(k,946) = lu(k,946) - lu(k,890) * lu(k,936) + lu(k,947) = lu(k,947) - lu(k,891) * lu(k,936) + lu(k,948) = lu(k,948) - lu(k,892) * lu(k,936) + lu(k,952) = lu(k,952) - lu(k,893) * lu(k,936) + lu(k,959) = lu(k,959) - lu(k,886) * lu(k,958) + lu(k,961) = lu(k,961) - lu(k,887) * lu(k,958) + lu(k,962) = lu(k,962) - lu(k,888) * lu(k,958) + lu(k,965) = lu(k,965) - lu(k,889) * lu(k,958) + lu(k,966) = lu(k,966) - lu(k,890) * lu(k,958) + lu(k,967) = lu(k,967) - lu(k,891) * lu(k,958) + lu(k,968) = lu(k,968) - lu(k,892) * lu(k,958) + lu(k,971) = lu(k,971) - lu(k,893) * lu(k,958) + lu(k,977) = lu(k,977) - lu(k,886) * lu(k,976) + lu(k,980) = - lu(k,887) * lu(k,976) + lu(k,981) = - lu(k,888) * lu(k,976) + lu(k,984) = lu(k,984) - lu(k,889) * lu(k,976) + lu(k,985) = lu(k,985) - lu(k,890) * lu(k,976) + lu(k,986) = lu(k,986) - lu(k,891) * lu(k,976) + lu(k,987) = lu(k,987) - lu(k,892) * lu(k,976) + lu(k,991) = - lu(k,893) * lu(k,976) + lu(k,1302) = lu(k,1302) - lu(k,886) * lu(k,1300) + lu(k,1307) = lu(k,1307) - lu(k,887) * lu(k,1300) + lu(k,1317) = lu(k,1317) - lu(k,888) * lu(k,1300) + lu(k,1320) = lu(k,1320) - lu(k,889) * lu(k,1300) + lu(k,1322) = lu(k,1322) - lu(k,890) * lu(k,1300) + lu(k,1323) = lu(k,1323) - lu(k,891) * lu(k,1300) + lu(k,1325) = lu(k,1325) - lu(k,892) * lu(k,1300) + lu(k,1333) = lu(k,1333) - lu(k,893) * lu(k,1300) + lu(k,1475) = lu(k,1475) - lu(k,886) * lu(k,1473) + lu(k,1481) = lu(k,1481) - lu(k,887) * lu(k,1473) + lu(k,1493) = lu(k,1493) - lu(k,888) * lu(k,1473) + lu(k,1497) = lu(k,1497) - lu(k,889) * lu(k,1473) + lu(k,1499) = lu(k,1499) - lu(k,890) * lu(k,1473) + lu(k,1501) = lu(k,1501) - lu(k,891) * lu(k,1473) + lu(k,1503) = lu(k,1503) - lu(k,892) * lu(k,1473) + lu(k,1511) = lu(k,1511) - lu(k,893) * lu(k,1473) + lu(k,1660) = lu(k,1660) - lu(k,886) * lu(k,1658) + lu(k,1665) = lu(k,1665) - lu(k,887) * lu(k,1658) + lu(k,1676) = lu(k,1676) - lu(k,888) * lu(k,1658) + lu(k,1680) = lu(k,1680) - lu(k,889) * lu(k,1658) + lu(k,1682) = lu(k,1682) - lu(k,890) * lu(k,1658) + lu(k,1684) = lu(k,1684) - lu(k,891) * lu(k,1658) + lu(k,1686) = lu(k,1686) - lu(k,892) * lu(k,1658) + lu(k,1694) = lu(k,1694) - lu(k,893) * lu(k,1658) + lu(k,1776) = lu(k,1776) - lu(k,886) * lu(k,1774) + lu(k,1782) = lu(k,1782) - lu(k,887) * lu(k,1774) + lu(k,1792) = lu(k,1792) - lu(k,888) * lu(k,1774) + lu(k,1796) = lu(k,1796) - lu(k,889) * lu(k,1774) + lu(k,1798) = lu(k,1798) - lu(k,890) * lu(k,1774) + lu(k,1800) = lu(k,1800) - lu(k,891) * lu(k,1774) + lu(k,1802) = lu(k,1802) - lu(k,892) * lu(k,1774) + lu(k,1810) = lu(k,1810) - lu(k,893) * lu(k,1774) + lu(k,1837) = lu(k,1837) - lu(k,886) * lu(k,1835) + lu(k,1842) = lu(k,1842) - lu(k,887) * lu(k,1835) + lu(k,1852) = lu(k,1852) - lu(k,888) * lu(k,1835) + lu(k,1856) = lu(k,1856) - lu(k,889) * lu(k,1835) + lu(k,1858) = lu(k,1858) - lu(k,890) * lu(k,1835) + lu(k,1860) = lu(k,1860) - lu(k,891) * lu(k,1835) + lu(k,1862) = lu(k,1862) - lu(k,892) * lu(k,1835) + lu(k,1870) = lu(k,1870) - lu(k,893) * lu(k,1835) + lu(k,1990) = lu(k,1990) - lu(k,886) * lu(k,1988) + lu(k,1996) = lu(k,1996) - lu(k,887) * lu(k,1988) + lu(k,2007) = lu(k,2007) - lu(k,888) * lu(k,1988) + lu(k,2011) = lu(k,2011) - lu(k,889) * lu(k,1988) + lu(k,2013) = lu(k,2013) - lu(k,890) * lu(k,1988) + lu(k,2015) = lu(k,2015) - lu(k,891) * lu(k,1988) + lu(k,2017) = lu(k,2017) - lu(k,892) * lu(k,1988) + lu(k,2025) = lu(k,2025) - lu(k,893) * lu(k,1988) + lu(k,894) = 1._r8 / lu(k,894) + lu(k,895) = lu(k,895) * lu(k,894) + lu(k,896) = lu(k,896) * lu(k,894) + lu(k,897) = lu(k,897) * lu(k,894) + lu(k,898) = lu(k,898) * lu(k,894) + lu(k,899) = lu(k,899) * lu(k,894) + lu(k,900) = lu(k,900) * lu(k,894) + lu(k,901) = lu(k,901) * lu(k,894) + lu(k,902) = lu(k,902) * lu(k,894) + lu(k,911) = lu(k,911) - lu(k,895) * lu(k,910) + lu(k,915) = lu(k,915) - lu(k,896) * lu(k,910) + lu(k,916) = lu(k,916) - lu(k,897) * lu(k,910) + lu(k,918) = lu(k,918) - lu(k,898) * lu(k,910) + lu(k,919) = lu(k,919) - lu(k,899) * lu(k,910) + lu(k,921) = lu(k,921) - lu(k,900) * lu(k,910) + lu(k,923) = - lu(k,901) * lu(k,910) + lu(k,924) = lu(k,924) - lu(k,902) * lu(k,910) + lu(k,1132) = lu(k,1132) - lu(k,895) * lu(k,1131) + lu(k,1137) = lu(k,1137) - lu(k,896) * lu(k,1131) + lu(k,1138) = - lu(k,897) * lu(k,1131) + lu(k,1140) = lu(k,1140) - lu(k,898) * lu(k,1131) + lu(k,1141) = lu(k,1141) - lu(k,899) * lu(k,1131) + lu(k,1143) = lu(k,1143) - lu(k,900) * lu(k,1131) + lu(k,1147) = lu(k,1147) - lu(k,901) * lu(k,1131) + lu(k,1148) = lu(k,1148) - lu(k,902) * lu(k,1131) + lu(k,1302) = lu(k,1302) - lu(k,895) * lu(k,1301) + lu(k,1317) = lu(k,1317) - lu(k,896) * lu(k,1301) + lu(k,1318) = lu(k,1318) - lu(k,897) * lu(k,1301) + lu(k,1320) = lu(k,1320) - lu(k,898) * lu(k,1301) + lu(k,1322) = lu(k,1322) - lu(k,899) * lu(k,1301) + lu(k,1325) = lu(k,1325) - lu(k,900) * lu(k,1301) + lu(k,1332) = lu(k,1332) - lu(k,901) * lu(k,1301) + lu(k,1333) = lu(k,1333) - lu(k,902) * lu(k,1301) + lu(k,1475) = lu(k,1475) - lu(k,895) * lu(k,1474) + lu(k,1493) = lu(k,1493) - lu(k,896) * lu(k,1474) + lu(k,1495) = lu(k,1495) - lu(k,897) * lu(k,1474) + lu(k,1497) = lu(k,1497) - lu(k,898) * lu(k,1474) + lu(k,1499) = lu(k,1499) - lu(k,899) * lu(k,1474) + lu(k,1503) = lu(k,1503) - lu(k,900) * lu(k,1474) + lu(k,1510) = lu(k,1510) - lu(k,901) * lu(k,1474) + lu(k,1511) = lu(k,1511) - lu(k,902) * lu(k,1474) + lu(k,1660) = lu(k,1660) - lu(k,895) * lu(k,1659) + lu(k,1676) = lu(k,1676) - lu(k,896) * lu(k,1659) + lu(k,1678) = lu(k,1678) - lu(k,897) * lu(k,1659) + lu(k,1680) = lu(k,1680) - lu(k,898) * lu(k,1659) + lu(k,1682) = lu(k,1682) - lu(k,899) * lu(k,1659) + lu(k,1686) = lu(k,1686) - lu(k,900) * lu(k,1659) + lu(k,1693) = lu(k,1693) - lu(k,901) * lu(k,1659) + lu(k,1694) = lu(k,1694) - lu(k,902) * lu(k,1659) + lu(k,1776) = lu(k,1776) - lu(k,895) * lu(k,1775) + lu(k,1792) = lu(k,1792) - lu(k,896) * lu(k,1775) + lu(k,1794) = lu(k,1794) - lu(k,897) * lu(k,1775) + lu(k,1796) = lu(k,1796) - lu(k,898) * lu(k,1775) + lu(k,1798) = lu(k,1798) - lu(k,899) * lu(k,1775) + lu(k,1802) = lu(k,1802) - lu(k,900) * lu(k,1775) + lu(k,1809) = lu(k,1809) - lu(k,901) * lu(k,1775) + lu(k,1810) = lu(k,1810) - lu(k,902) * lu(k,1775) + lu(k,1837) = lu(k,1837) - lu(k,895) * lu(k,1836) + lu(k,1852) = lu(k,1852) - lu(k,896) * lu(k,1836) + lu(k,1854) = - lu(k,897) * lu(k,1836) + lu(k,1856) = lu(k,1856) - lu(k,898) * lu(k,1836) + lu(k,1858) = lu(k,1858) - lu(k,899) * lu(k,1836) + lu(k,1862) = lu(k,1862) - lu(k,900) * lu(k,1836) + lu(k,1869) = lu(k,1869) - lu(k,901) * lu(k,1836) + lu(k,1870) = lu(k,1870) - lu(k,902) * lu(k,1836) + lu(k,1948) = lu(k,1948) - lu(k,895) * lu(k,1947) + lu(k,1950) = - lu(k,896) * lu(k,1947) + lu(k,1952) = lu(k,1952) - lu(k,897) * lu(k,1947) + lu(k,1954) = lu(k,1954) - lu(k,898) * lu(k,1947) + lu(k,1956) = lu(k,1956) - lu(k,899) * lu(k,1947) + lu(k,1960) = lu(k,1960) - lu(k,900) * lu(k,1947) + lu(k,1967) = lu(k,1967) - lu(k,901) * lu(k,1947) + lu(k,1968) = lu(k,1968) - lu(k,902) * lu(k,1947) + lu(k,1990) = lu(k,1990) - lu(k,895) * lu(k,1989) + lu(k,2007) = lu(k,2007) - lu(k,896) * lu(k,1989) + lu(k,2009) = lu(k,2009) - lu(k,897) * lu(k,1989) + lu(k,2011) = lu(k,2011) - lu(k,898) * lu(k,1989) + lu(k,2013) = lu(k,2013) - lu(k,899) * lu(k,1989) + lu(k,2017) = lu(k,2017) - lu(k,900) * lu(k,1989) + lu(k,2024) = lu(k,2024) - lu(k,901) * lu(k,1989) + lu(k,2025) = lu(k,2025) - lu(k,902) * lu(k,1989) + lu(k,903) = 1._r8 / lu(k,903) + lu(k,904) = lu(k,904) * lu(k,903) + lu(k,905) = lu(k,905) * lu(k,903) + lu(k,906) = lu(k,906) * lu(k,903) + lu(k,917) = - lu(k,904) * lu(k,911) + lu(k,919) = lu(k,919) - lu(k,905) * lu(k,911) + lu(k,921) = lu(k,921) - lu(k,906) * lu(k,911) + lu(k,944) = - lu(k,904) * lu(k,937) + lu(k,946) = lu(k,946) - lu(k,905) * lu(k,937) + lu(k,948) = lu(k,948) - lu(k,906) * lu(k,937) + lu(k,964) = - lu(k,904) * lu(k,959) + lu(k,966) = lu(k,966) - lu(k,905) * lu(k,959) + lu(k,968) = lu(k,968) - lu(k,906) * lu(k,959) + lu(k,983) = - lu(k,904) * lu(k,977) + lu(k,985) = lu(k,985) - lu(k,905) * lu(k,977) + lu(k,987) = lu(k,987) - lu(k,906) * lu(k,977) + lu(k,1014) = - lu(k,904) * lu(k,1009) + lu(k,1016) = lu(k,1016) - lu(k,905) * lu(k,1009) + lu(k,1018) = lu(k,1018) - lu(k,906) * lu(k,1009) + lu(k,1050) = - lu(k,904) * lu(k,1042) + lu(k,1052) = lu(k,1052) - lu(k,905) * lu(k,1042) + lu(k,1054) = lu(k,1054) - lu(k,906) * lu(k,1042) + lu(k,1065) = - lu(k,904) * lu(k,1059) + lu(k,1066) = lu(k,1066) - lu(k,905) * lu(k,1059) + lu(k,1068) = lu(k,1068) - lu(k,906) * lu(k,1059) + lu(k,1075) = - lu(k,904) * lu(k,1071) + lu(k,1076) = lu(k,1076) - lu(k,905) * lu(k,1071) + lu(k,1077) = lu(k,1077) - lu(k,906) * lu(k,1071) + lu(k,1119) = - lu(k,904) * lu(k,1106) + lu(k,1121) = lu(k,1121) - lu(k,905) * lu(k,1106) + lu(k,1123) = lu(k,1123) - lu(k,906) * lu(k,1106) + lu(k,1139) = - lu(k,904) * lu(k,1132) + lu(k,1141) = lu(k,1141) - lu(k,905) * lu(k,1132) + lu(k,1143) = lu(k,1143) - lu(k,906) * lu(k,1132) + lu(k,1161) = - lu(k,904) * lu(k,1152) + lu(k,1163) = lu(k,1163) - lu(k,905) * lu(k,1152) + lu(k,1165) = lu(k,1165) - lu(k,906) * lu(k,1152) + lu(k,1187) = - lu(k,904) * lu(k,1174) + lu(k,1189) = lu(k,1189) - lu(k,905) * lu(k,1174) + lu(k,1191) = lu(k,1191) - lu(k,906) * lu(k,1174) + lu(k,1235) = - lu(k,904) * lu(k,1222) + lu(k,1237) = lu(k,1237) - lu(k,905) * lu(k,1222) + lu(k,1239) = lu(k,1239) - lu(k,906) * lu(k,1222) + lu(k,1248) = lu(k,1248) - lu(k,904) * lu(k,1246) + lu(k,1250) = lu(k,1250) - lu(k,905) * lu(k,1246) + lu(k,1254) = lu(k,1254) - lu(k,906) * lu(k,1246) + lu(k,1319) = lu(k,1319) - lu(k,904) * lu(k,1302) + lu(k,1322) = lu(k,1322) - lu(k,905) * lu(k,1302) + lu(k,1325) = lu(k,1325) - lu(k,906) * lu(k,1302) + lu(k,1496) = lu(k,1496) - lu(k,904) * lu(k,1475) + lu(k,1499) = lu(k,1499) - lu(k,905) * lu(k,1475) + lu(k,1503) = lu(k,1503) - lu(k,906) * lu(k,1475) + lu(k,1543) = lu(k,1543) - lu(k,904) * lu(k,1539) + lu(k,1546) = lu(k,1546) - lu(k,905) * lu(k,1539) + lu(k,1550) = lu(k,1550) - lu(k,906) * lu(k,1539) + lu(k,1573) = lu(k,1573) - lu(k,904) * lu(k,1568) + lu(k,1576) = lu(k,1576) - lu(k,905) * lu(k,1568) + lu(k,1580) = lu(k,1580) - lu(k,906) * lu(k,1568) + lu(k,1679) = lu(k,1679) - lu(k,904) * lu(k,1660) + lu(k,1682) = lu(k,1682) - lu(k,905) * lu(k,1660) + lu(k,1686) = lu(k,1686) - lu(k,906) * lu(k,1660) + lu(k,1795) = lu(k,1795) - lu(k,904) * lu(k,1776) + lu(k,1798) = lu(k,1798) - lu(k,905) * lu(k,1776) + lu(k,1802) = lu(k,1802) - lu(k,906) * lu(k,1776) + lu(k,1855) = lu(k,1855) - lu(k,904) * lu(k,1837) + lu(k,1858) = lu(k,1858) - lu(k,905) * lu(k,1837) + lu(k,1862) = lu(k,1862) - lu(k,906) * lu(k,1837) + lu(k,1896) = lu(k,1896) - lu(k,904) * lu(k,1888) + lu(k,1899) = lu(k,1899) - lu(k,905) * lu(k,1888) + lu(k,1903) = lu(k,1903) - lu(k,906) * lu(k,1888) + lu(k,1953) = lu(k,1953) - lu(k,904) * lu(k,1948) + lu(k,1956) = lu(k,1956) - lu(k,905) * lu(k,1948) + lu(k,1960) = lu(k,1960) - lu(k,906) * lu(k,1948) + lu(k,2010) = - lu(k,904) * lu(k,1990) + lu(k,2013) = lu(k,2013) - lu(k,905) * lu(k,1990) + lu(k,2017) = lu(k,2017) - lu(k,906) * lu(k,1990) + lu(k,912) = 1._r8 / lu(k,912) + lu(k,913) = lu(k,913) * lu(k,912) + lu(k,914) = lu(k,914) * lu(k,912) + lu(k,915) = lu(k,915) * lu(k,912) + lu(k,916) = lu(k,916) * lu(k,912) + lu(k,917) = lu(k,917) * lu(k,912) + lu(k,918) = lu(k,918) * lu(k,912) + lu(k,919) = lu(k,919) * lu(k,912) + lu(k,920) = lu(k,920) * lu(k,912) + lu(k,921) = lu(k,921) * lu(k,912) + lu(k,922) = lu(k,922) * lu(k,912) + lu(k,923) = lu(k,923) * lu(k,912) + lu(k,924) = lu(k,924) * lu(k,912) + lu(k,1108) = lu(k,1108) - lu(k,913) * lu(k,1107) + lu(k,1109) = - lu(k,914) * lu(k,1107) + lu(k,1117) = lu(k,1117) - lu(k,915) * lu(k,1107) + lu(k,1118) = lu(k,1118) - lu(k,916) * lu(k,1107) + lu(k,1119) = lu(k,1119) - lu(k,917) * lu(k,1107) + lu(k,1120) = lu(k,1120) - lu(k,918) * lu(k,1107) + lu(k,1121) = lu(k,1121) - lu(k,919) * lu(k,1107) + lu(k,1122) = lu(k,1122) - lu(k,920) * lu(k,1107) + lu(k,1123) = lu(k,1123) - lu(k,921) * lu(k,1107) + lu(k,1126) = lu(k,1126) - lu(k,922) * lu(k,1107) + lu(k,1127) = lu(k,1127) - lu(k,923) * lu(k,1107) + lu(k,1128) = - lu(k,924) * lu(k,1107) + lu(k,1154) = lu(k,1154) - lu(k,913) * lu(k,1153) + lu(k,1155) = - lu(k,914) * lu(k,1153) + lu(k,1159) = lu(k,1159) - lu(k,915) * lu(k,1153) + lu(k,1160) = - lu(k,916) * lu(k,1153) + lu(k,1161) = lu(k,1161) - lu(k,917) * lu(k,1153) + lu(k,1162) = lu(k,1162) - lu(k,918) * lu(k,1153) + lu(k,1163) = lu(k,1163) - lu(k,919) * lu(k,1153) + lu(k,1164) = lu(k,1164) - lu(k,920) * lu(k,1153) + lu(k,1165) = lu(k,1165) - lu(k,921) * lu(k,1153) + lu(k,1167) = lu(k,1167) - lu(k,922) * lu(k,1153) + lu(k,1168) = lu(k,1168) - lu(k,923) * lu(k,1153) + lu(k,1169) = - lu(k,924) * lu(k,1153) + lu(k,1176) = lu(k,1176) - lu(k,913) * lu(k,1175) + lu(k,1177) = - lu(k,914) * lu(k,1175) + lu(k,1185) = lu(k,1185) - lu(k,915) * lu(k,1175) + lu(k,1186) = lu(k,1186) - lu(k,916) * lu(k,1175) + lu(k,1187) = lu(k,1187) - lu(k,917) * lu(k,1175) + lu(k,1188) = lu(k,1188) - lu(k,918) * lu(k,1175) + lu(k,1189) = lu(k,1189) - lu(k,919) * lu(k,1175) + lu(k,1190) = lu(k,1190) - lu(k,920) * lu(k,1175) + lu(k,1191) = lu(k,1191) - lu(k,921) * lu(k,1175) + lu(k,1194) = lu(k,1194) - lu(k,922) * lu(k,1175) + lu(k,1195) = lu(k,1195) - lu(k,923) * lu(k,1175) + lu(k,1196) = - lu(k,924) * lu(k,1175) + lu(k,1477) = lu(k,1477) - lu(k,913) * lu(k,1476) + lu(k,1481) = lu(k,1481) - lu(k,914) * lu(k,1476) + lu(k,1493) = lu(k,1493) - lu(k,915) * lu(k,1476) + lu(k,1495) = lu(k,1495) - lu(k,916) * lu(k,1476) + lu(k,1496) = lu(k,1496) - lu(k,917) * lu(k,1476) + lu(k,1497) = lu(k,1497) - lu(k,918) * lu(k,1476) + lu(k,1499) = lu(k,1499) - lu(k,919) * lu(k,1476) + lu(k,1501) = lu(k,1501) - lu(k,920) * lu(k,1476) + lu(k,1503) = lu(k,1503) - lu(k,921) * lu(k,1476) + lu(k,1507) = lu(k,1507) - lu(k,922) * lu(k,1476) + lu(k,1510) = lu(k,1510) - lu(k,923) * lu(k,1476) + lu(k,1511) = lu(k,1511) - lu(k,924) * lu(k,1476) + lu(k,1778) = lu(k,1778) - lu(k,913) * lu(k,1777) + lu(k,1782) = lu(k,1782) - lu(k,914) * lu(k,1777) + lu(k,1792) = lu(k,1792) - lu(k,915) * lu(k,1777) + lu(k,1794) = lu(k,1794) - lu(k,916) * lu(k,1777) + lu(k,1795) = lu(k,1795) - lu(k,917) * lu(k,1777) + lu(k,1796) = lu(k,1796) - lu(k,918) * lu(k,1777) + lu(k,1798) = lu(k,1798) - lu(k,919) * lu(k,1777) + lu(k,1800) = lu(k,1800) - lu(k,920) * lu(k,1777) + lu(k,1802) = lu(k,1802) - lu(k,921) * lu(k,1777) + lu(k,1806) = lu(k,1806) - lu(k,922) * lu(k,1777) + lu(k,1809) = lu(k,1809) - lu(k,923) * lu(k,1777) + lu(k,1810) = lu(k,1810) - lu(k,924) * lu(k,1777) + lu(k,1992) = lu(k,1992) - lu(k,913) * lu(k,1991) + lu(k,1996) = lu(k,1996) - lu(k,914) * lu(k,1991) + lu(k,2007) = lu(k,2007) - lu(k,915) * lu(k,1991) + lu(k,2009) = lu(k,2009) - lu(k,916) * lu(k,1991) + lu(k,2010) = lu(k,2010) - lu(k,917) * lu(k,1991) + lu(k,2011) = lu(k,2011) - lu(k,918) * lu(k,1991) + lu(k,2013) = lu(k,2013) - lu(k,919) * lu(k,1991) + lu(k,2015) = lu(k,2015) - lu(k,920) * lu(k,1991) + lu(k,2017) = lu(k,2017) - lu(k,921) * lu(k,1991) + lu(k,2021) = lu(k,2021) - lu(k,922) * lu(k,1991) + lu(k,2024) = lu(k,2024) - lu(k,923) * lu(k,1991) + lu(k,2025) = lu(k,2025) - lu(k,924) * lu(k,1991) + end do + end subroutine lu_fac19 + subroutine lu_fac20( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,925) = 1._r8 / lu(k,925) + lu(k,926) = lu(k,926) * lu(k,925) + lu(k,927) = lu(k,927) * lu(k,925) + lu(k,928) = lu(k,928) * lu(k,925) + lu(k,929) = lu(k,929) * lu(k,925) + lu(k,930) = lu(k,930) * lu(k,925) + lu(k,996) = lu(k,996) - lu(k,926) * lu(k,994) + lu(k,997) = lu(k,997) - lu(k,927) * lu(k,994) + lu(k,999) = lu(k,999) - lu(k,928) * lu(k,994) + lu(k,1000) = lu(k,1000) - lu(k,929) * lu(k,994) + lu(k,1001) = lu(k,1001) - lu(k,930) * lu(k,994) + lu(k,1012) = lu(k,1012) - lu(k,926) * lu(k,1010) + lu(k,1013) = lu(k,1013) - lu(k,927) * lu(k,1010) + lu(k,1016) = lu(k,1016) - lu(k,928) * lu(k,1010) + lu(k,1017) = lu(k,1017) - lu(k,929) * lu(k,1010) + lu(k,1018) = lu(k,1018) - lu(k,930) * lu(k,1010) + lu(k,1112) = lu(k,1112) - lu(k,926) * lu(k,1108) + lu(k,1117) = lu(k,1117) - lu(k,927) * lu(k,1108) + lu(k,1121) = lu(k,1121) - lu(k,928) * lu(k,1108) + lu(k,1122) = lu(k,1122) - lu(k,929) * lu(k,1108) + lu(k,1123) = lu(k,1123) - lu(k,930) * lu(k,1108) + lu(k,1134) = lu(k,1134) - lu(k,926) * lu(k,1133) + lu(k,1137) = lu(k,1137) - lu(k,927) * lu(k,1133) + lu(k,1141) = lu(k,1141) - lu(k,928) * lu(k,1133) + lu(k,1142) = lu(k,1142) - lu(k,929) * lu(k,1133) + lu(k,1143) = lu(k,1143) - lu(k,930) * lu(k,1133) + lu(k,1156) = lu(k,1156) - lu(k,926) * lu(k,1154) + lu(k,1159) = lu(k,1159) - lu(k,927) * lu(k,1154) + lu(k,1163) = lu(k,1163) - lu(k,928) * lu(k,1154) + lu(k,1164) = lu(k,1164) - lu(k,929) * lu(k,1154) + lu(k,1165) = lu(k,1165) - lu(k,930) * lu(k,1154) + lu(k,1180) = - lu(k,926) * lu(k,1176) + lu(k,1185) = lu(k,1185) - lu(k,927) * lu(k,1176) + lu(k,1189) = lu(k,1189) - lu(k,928) * lu(k,1176) + lu(k,1190) = lu(k,1190) - lu(k,929) * lu(k,1176) + lu(k,1191) = lu(k,1191) - lu(k,930) * lu(k,1176) + lu(k,1201) = - lu(k,926) * lu(k,1200) + lu(k,1203) = lu(k,1203) - lu(k,927) * lu(k,1200) + lu(k,1207) = lu(k,1207) - lu(k,928) * lu(k,1200) + lu(k,1208) = lu(k,1208) - lu(k,929) * lu(k,1200) + lu(k,1209) = lu(k,1209) - lu(k,930) * lu(k,1200) + lu(k,1227) = lu(k,1227) - lu(k,926) * lu(k,1223) + lu(k,1233) = lu(k,1233) - lu(k,927) * lu(k,1223) + lu(k,1237) = lu(k,1237) - lu(k,928) * lu(k,1223) + lu(k,1238) = lu(k,1238) - lu(k,929) * lu(k,1223) + lu(k,1239) = lu(k,1239) - lu(k,930) * lu(k,1223) + lu(k,1311) = lu(k,1311) - lu(k,926) * lu(k,1303) + lu(k,1317) = lu(k,1317) - lu(k,927) * lu(k,1303) + lu(k,1322) = lu(k,1322) - lu(k,928) * lu(k,1303) + lu(k,1323) = lu(k,1323) - lu(k,929) * lu(k,1303) + lu(k,1325) = lu(k,1325) - lu(k,930) * lu(k,1303) + lu(k,1486) = lu(k,1486) - lu(k,926) * lu(k,1477) + lu(k,1493) = lu(k,1493) - lu(k,927) * lu(k,1477) + lu(k,1499) = lu(k,1499) - lu(k,928) * lu(k,1477) + lu(k,1501) = lu(k,1501) - lu(k,929) * lu(k,1477) + lu(k,1503) = lu(k,1503) - lu(k,930) * lu(k,1477) + lu(k,1670) = lu(k,1670) - lu(k,926) * lu(k,1661) + lu(k,1676) = lu(k,1676) - lu(k,927) * lu(k,1661) + lu(k,1682) = lu(k,1682) - lu(k,928) * lu(k,1661) + lu(k,1684) = lu(k,1684) - lu(k,929) * lu(k,1661) + lu(k,1686) = lu(k,1686) - lu(k,930) * lu(k,1661) + lu(k,1786) = lu(k,1786) - lu(k,926) * lu(k,1778) + lu(k,1792) = lu(k,1792) - lu(k,927) * lu(k,1778) + lu(k,1798) = lu(k,1798) - lu(k,928) * lu(k,1778) + lu(k,1800) = lu(k,1800) - lu(k,929) * lu(k,1778) + lu(k,1802) = lu(k,1802) - lu(k,930) * lu(k,1778) + lu(k,1845) = lu(k,1845) - lu(k,926) * lu(k,1838) + lu(k,1852) = lu(k,1852) - lu(k,927) * lu(k,1838) + lu(k,1858) = lu(k,1858) - lu(k,928) * lu(k,1838) + lu(k,1860) = lu(k,1860) - lu(k,929) * lu(k,1838) + lu(k,1862) = lu(k,1862) - lu(k,930) * lu(k,1838) + lu(k,1890) = lu(k,1890) - lu(k,926) * lu(k,1889) + lu(k,1893) = lu(k,1893) - lu(k,927) * lu(k,1889) + lu(k,1899) = lu(k,1899) - lu(k,928) * lu(k,1889) + lu(k,1901) = lu(k,1901) - lu(k,929) * lu(k,1889) + lu(k,1903) = lu(k,1903) - lu(k,930) * lu(k,1889) + lu(k,2000) = lu(k,2000) - lu(k,926) * lu(k,1992) + lu(k,2007) = lu(k,2007) - lu(k,927) * lu(k,1992) + lu(k,2013) = lu(k,2013) - lu(k,928) * lu(k,1992) + lu(k,2015) = lu(k,2015) - lu(k,929) * lu(k,1992) + lu(k,2017) = lu(k,2017) - lu(k,930) * lu(k,1992) + lu(k,938) = 1._r8 / lu(k,938) + lu(k,939) = lu(k,939) * lu(k,938) + lu(k,940) = lu(k,940) * lu(k,938) + lu(k,941) = lu(k,941) * lu(k,938) + lu(k,942) = lu(k,942) * lu(k,938) + lu(k,943) = lu(k,943) * lu(k,938) + lu(k,944) = lu(k,944) * lu(k,938) + lu(k,945) = lu(k,945) * lu(k,938) + lu(k,946) = lu(k,946) * lu(k,938) + lu(k,947) = lu(k,947) * lu(k,938) + lu(k,948) = lu(k,948) * lu(k,938) + lu(k,949) = lu(k,949) * lu(k,938) + lu(k,950) = lu(k,950) * lu(k,938) + lu(k,951) = lu(k,951) * lu(k,938) + lu(k,952) = lu(k,952) * lu(k,938) + lu(k,1305) = lu(k,1305) - lu(k,939) * lu(k,1304) + lu(k,1306) = lu(k,1306) - lu(k,940) * lu(k,1304) + lu(k,1307) = lu(k,1307) - lu(k,941) * lu(k,1304) + lu(k,1317) = lu(k,1317) - lu(k,942) * lu(k,1304) + lu(k,1318) = lu(k,1318) - lu(k,943) * lu(k,1304) + lu(k,1319) = lu(k,1319) - lu(k,944) * lu(k,1304) + lu(k,1320) = lu(k,1320) - lu(k,945) * lu(k,1304) + lu(k,1322) = lu(k,1322) - lu(k,946) * lu(k,1304) + lu(k,1323) = lu(k,1323) - lu(k,947) * lu(k,1304) + lu(k,1325) = lu(k,1325) - lu(k,948) * lu(k,1304) + lu(k,1327) = lu(k,1327) - lu(k,949) * lu(k,1304) + lu(k,1329) = lu(k,1329) - lu(k,950) * lu(k,1304) + lu(k,1332) = lu(k,1332) - lu(k,951) * lu(k,1304) + lu(k,1333) = lu(k,1333) - lu(k,952) * lu(k,1304) + lu(k,1479) = lu(k,1479) - lu(k,939) * lu(k,1478) + lu(k,1480) = lu(k,1480) - lu(k,940) * lu(k,1478) + lu(k,1481) = lu(k,1481) - lu(k,941) * lu(k,1478) + lu(k,1493) = lu(k,1493) - lu(k,942) * lu(k,1478) + lu(k,1495) = lu(k,1495) - lu(k,943) * lu(k,1478) + lu(k,1496) = lu(k,1496) - lu(k,944) * lu(k,1478) + lu(k,1497) = lu(k,1497) - lu(k,945) * lu(k,1478) + lu(k,1499) = lu(k,1499) - lu(k,946) * lu(k,1478) + lu(k,1501) = lu(k,1501) - lu(k,947) * lu(k,1478) + lu(k,1503) = lu(k,1503) - lu(k,948) * lu(k,1478) + lu(k,1505) = lu(k,1505) - lu(k,949) * lu(k,1478) + lu(k,1507) = lu(k,1507) - lu(k,950) * lu(k,1478) + lu(k,1510) = lu(k,1510) - lu(k,951) * lu(k,1478) + lu(k,1511) = lu(k,1511) - lu(k,952) * lu(k,1478) + lu(k,1663) = lu(k,1663) - lu(k,939) * lu(k,1662) + lu(k,1664) = lu(k,1664) - lu(k,940) * lu(k,1662) + lu(k,1665) = lu(k,1665) - lu(k,941) * lu(k,1662) + lu(k,1676) = lu(k,1676) - lu(k,942) * lu(k,1662) + lu(k,1678) = lu(k,1678) - lu(k,943) * lu(k,1662) + lu(k,1679) = lu(k,1679) - lu(k,944) * lu(k,1662) + lu(k,1680) = lu(k,1680) - lu(k,945) * lu(k,1662) + lu(k,1682) = lu(k,1682) - lu(k,946) * lu(k,1662) + lu(k,1684) = lu(k,1684) - lu(k,947) * lu(k,1662) + lu(k,1686) = lu(k,1686) - lu(k,948) * lu(k,1662) + lu(k,1688) = lu(k,1688) - lu(k,949) * lu(k,1662) + lu(k,1690) = lu(k,1690) - lu(k,950) * lu(k,1662) + lu(k,1693) = lu(k,1693) - lu(k,951) * lu(k,1662) + lu(k,1694) = lu(k,1694) - lu(k,952) * lu(k,1662) + lu(k,1780) = lu(k,1780) - lu(k,939) * lu(k,1779) + lu(k,1781) = lu(k,1781) - lu(k,940) * lu(k,1779) + lu(k,1782) = lu(k,1782) - lu(k,941) * lu(k,1779) + lu(k,1792) = lu(k,1792) - lu(k,942) * lu(k,1779) + lu(k,1794) = lu(k,1794) - lu(k,943) * lu(k,1779) + lu(k,1795) = lu(k,1795) - lu(k,944) * lu(k,1779) + lu(k,1796) = lu(k,1796) - lu(k,945) * lu(k,1779) + lu(k,1798) = lu(k,1798) - lu(k,946) * lu(k,1779) + lu(k,1800) = lu(k,1800) - lu(k,947) * lu(k,1779) + lu(k,1802) = lu(k,1802) - lu(k,948) * lu(k,1779) + lu(k,1804) = lu(k,1804) - lu(k,949) * lu(k,1779) + lu(k,1806) = lu(k,1806) - lu(k,950) * lu(k,1779) + lu(k,1809) = lu(k,1809) - lu(k,951) * lu(k,1779) + lu(k,1810) = lu(k,1810) - lu(k,952) * lu(k,1779) + lu(k,1840) = lu(k,1840) - lu(k,939) * lu(k,1839) + lu(k,1841) = lu(k,1841) - lu(k,940) * lu(k,1839) + lu(k,1842) = lu(k,1842) - lu(k,941) * lu(k,1839) + lu(k,1852) = lu(k,1852) - lu(k,942) * lu(k,1839) + lu(k,1854) = lu(k,1854) - lu(k,943) * lu(k,1839) + lu(k,1855) = lu(k,1855) - lu(k,944) * lu(k,1839) + lu(k,1856) = lu(k,1856) - lu(k,945) * lu(k,1839) + lu(k,1858) = lu(k,1858) - lu(k,946) * lu(k,1839) + lu(k,1860) = lu(k,1860) - lu(k,947) * lu(k,1839) + lu(k,1862) = lu(k,1862) - lu(k,948) * lu(k,1839) + lu(k,1864) = lu(k,1864) - lu(k,949) * lu(k,1839) + lu(k,1866) = lu(k,1866) - lu(k,950) * lu(k,1839) + lu(k,1869) = lu(k,1869) - lu(k,951) * lu(k,1839) + lu(k,1870) = lu(k,1870) - lu(k,952) * lu(k,1839) + lu(k,1994) = lu(k,1994) - lu(k,939) * lu(k,1993) + lu(k,1995) = lu(k,1995) - lu(k,940) * lu(k,1993) + lu(k,1996) = lu(k,1996) - lu(k,941) * lu(k,1993) + lu(k,2007) = lu(k,2007) - lu(k,942) * lu(k,1993) + lu(k,2009) = lu(k,2009) - lu(k,943) * lu(k,1993) + lu(k,2010) = lu(k,2010) - lu(k,944) * lu(k,1993) + lu(k,2011) = lu(k,2011) - lu(k,945) * lu(k,1993) + lu(k,2013) = lu(k,2013) - lu(k,946) * lu(k,1993) + lu(k,2015) = lu(k,2015) - lu(k,947) * lu(k,1993) + lu(k,2017) = lu(k,2017) - lu(k,948) * lu(k,1993) + lu(k,2019) = lu(k,2019) - lu(k,949) * lu(k,1993) + lu(k,2021) = lu(k,2021) - lu(k,950) * lu(k,1993) + lu(k,2024) = lu(k,2024) - lu(k,951) * lu(k,1993) + lu(k,2025) = lu(k,2025) - lu(k,952) * lu(k,1993) + lu(k,960) = 1._r8 / lu(k,960) + lu(k,961) = lu(k,961) * lu(k,960) + lu(k,962) = lu(k,962) * lu(k,960) + lu(k,963) = lu(k,963) * lu(k,960) + lu(k,964) = lu(k,964) * lu(k,960) + lu(k,965) = lu(k,965) * lu(k,960) + lu(k,966) = lu(k,966) * lu(k,960) + lu(k,967) = lu(k,967) * lu(k,960) + lu(k,968) = lu(k,968) * lu(k,960) + lu(k,969) = lu(k,969) * lu(k,960) + lu(k,970) = lu(k,970) * lu(k,960) + lu(k,971) = lu(k,971) * lu(k,960) + lu(k,980) = lu(k,980) - lu(k,961) * lu(k,978) + lu(k,981) = lu(k,981) - lu(k,962) * lu(k,978) + lu(k,982) = lu(k,982) - lu(k,963) * lu(k,978) + lu(k,983) = lu(k,983) - lu(k,964) * lu(k,978) + lu(k,984) = lu(k,984) - lu(k,965) * lu(k,978) + lu(k,985) = lu(k,985) - lu(k,966) * lu(k,978) + lu(k,986) = lu(k,986) - lu(k,967) * lu(k,978) + lu(k,987) = lu(k,987) - lu(k,968) * lu(k,978) + lu(k,988) = lu(k,988) - lu(k,969) * lu(k,978) + lu(k,989) = lu(k,989) - lu(k,970) * lu(k,978) + lu(k,991) = lu(k,991) - lu(k,971) * lu(k,978) + lu(k,1307) = lu(k,1307) - lu(k,961) * lu(k,1305) + lu(k,1317) = lu(k,1317) - lu(k,962) * lu(k,1305) + lu(k,1318) = lu(k,1318) - lu(k,963) * lu(k,1305) + lu(k,1319) = lu(k,1319) - lu(k,964) * lu(k,1305) + lu(k,1320) = lu(k,1320) - lu(k,965) * lu(k,1305) + lu(k,1322) = lu(k,1322) - lu(k,966) * lu(k,1305) + lu(k,1323) = lu(k,1323) - lu(k,967) * lu(k,1305) + lu(k,1325) = lu(k,1325) - lu(k,968) * lu(k,1305) + lu(k,1327) = lu(k,1327) - lu(k,969) * lu(k,1305) + lu(k,1329) = lu(k,1329) - lu(k,970) * lu(k,1305) + lu(k,1333) = lu(k,1333) - lu(k,971) * lu(k,1305) + lu(k,1481) = lu(k,1481) - lu(k,961) * lu(k,1479) + lu(k,1493) = lu(k,1493) - lu(k,962) * lu(k,1479) + lu(k,1495) = lu(k,1495) - lu(k,963) * lu(k,1479) + lu(k,1496) = lu(k,1496) - lu(k,964) * lu(k,1479) + lu(k,1497) = lu(k,1497) - lu(k,965) * lu(k,1479) + lu(k,1499) = lu(k,1499) - lu(k,966) * lu(k,1479) + lu(k,1501) = lu(k,1501) - lu(k,967) * lu(k,1479) + lu(k,1503) = lu(k,1503) - lu(k,968) * lu(k,1479) + lu(k,1505) = lu(k,1505) - lu(k,969) * lu(k,1479) + lu(k,1507) = lu(k,1507) - lu(k,970) * lu(k,1479) + lu(k,1511) = lu(k,1511) - lu(k,971) * lu(k,1479) + lu(k,1665) = lu(k,1665) - lu(k,961) * lu(k,1663) + lu(k,1676) = lu(k,1676) - lu(k,962) * lu(k,1663) + lu(k,1678) = lu(k,1678) - lu(k,963) * lu(k,1663) + lu(k,1679) = lu(k,1679) - lu(k,964) * lu(k,1663) + lu(k,1680) = lu(k,1680) - lu(k,965) * lu(k,1663) + lu(k,1682) = lu(k,1682) - lu(k,966) * lu(k,1663) + lu(k,1684) = lu(k,1684) - lu(k,967) * lu(k,1663) + lu(k,1686) = lu(k,1686) - lu(k,968) * lu(k,1663) + lu(k,1688) = lu(k,1688) - lu(k,969) * lu(k,1663) + lu(k,1690) = lu(k,1690) - lu(k,970) * lu(k,1663) + lu(k,1694) = lu(k,1694) - lu(k,971) * lu(k,1663) + lu(k,1782) = lu(k,1782) - lu(k,961) * lu(k,1780) + lu(k,1792) = lu(k,1792) - lu(k,962) * lu(k,1780) + lu(k,1794) = lu(k,1794) - lu(k,963) * lu(k,1780) + lu(k,1795) = lu(k,1795) - lu(k,964) * lu(k,1780) + lu(k,1796) = lu(k,1796) - lu(k,965) * lu(k,1780) + lu(k,1798) = lu(k,1798) - lu(k,966) * lu(k,1780) + lu(k,1800) = lu(k,1800) - lu(k,967) * lu(k,1780) + lu(k,1802) = lu(k,1802) - lu(k,968) * lu(k,1780) + lu(k,1804) = lu(k,1804) - lu(k,969) * lu(k,1780) + lu(k,1806) = lu(k,1806) - lu(k,970) * lu(k,1780) + lu(k,1810) = lu(k,1810) - lu(k,971) * lu(k,1780) + lu(k,1842) = lu(k,1842) - lu(k,961) * lu(k,1840) + lu(k,1852) = lu(k,1852) - lu(k,962) * lu(k,1840) + lu(k,1854) = lu(k,1854) - lu(k,963) * lu(k,1840) + lu(k,1855) = lu(k,1855) - lu(k,964) * lu(k,1840) + lu(k,1856) = lu(k,1856) - lu(k,965) * lu(k,1840) + lu(k,1858) = lu(k,1858) - lu(k,966) * lu(k,1840) + lu(k,1860) = lu(k,1860) - lu(k,967) * lu(k,1840) + lu(k,1862) = lu(k,1862) - lu(k,968) * lu(k,1840) + lu(k,1864) = lu(k,1864) - lu(k,969) * lu(k,1840) + lu(k,1866) = lu(k,1866) - lu(k,970) * lu(k,1840) + lu(k,1870) = lu(k,1870) - lu(k,971) * lu(k,1840) + lu(k,1996) = lu(k,1996) - lu(k,961) * lu(k,1994) + lu(k,2007) = lu(k,2007) - lu(k,962) * lu(k,1994) + lu(k,2009) = lu(k,2009) - lu(k,963) * lu(k,1994) + lu(k,2010) = lu(k,2010) - lu(k,964) * lu(k,1994) + lu(k,2011) = lu(k,2011) - lu(k,965) * lu(k,1994) + lu(k,2013) = lu(k,2013) - lu(k,966) * lu(k,1994) + lu(k,2015) = lu(k,2015) - lu(k,967) * lu(k,1994) + lu(k,2017) = lu(k,2017) - lu(k,968) * lu(k,1994) + lu(k,2019) = lu(k,2019) - lu(k,969) * lu(k,1994) + lu(k,2021) = lu(k,2021) - lu(k,970) * lu(k,1994) + lu(k,2025) = lu(k,2025) - lu(k,971) * lu(k,1994) + lu(k,979) = 1._r8 / lu(k,979) + lu(k,980) = lu(k,980) * lu(k,979) + lu(k,981) = lu(k,981) * lu(k,979) + lu(k,982) = lu(k,982) * lu(k,979) + lu(k,983) = lu(k,983) * lu(k,979) + lu(k,984) = lu(k,984) * lu(k,979) + lu(k,985) = lu(k,985) * lu(k,979) + lu(k,986) = lu(k,986) * lu(k,979) + lu(k,987) = lu(k,987) * lu(k,979) + lu(k,988) = lu(k,988) * lu(k,979) + lu(k,989) = lu(k,989) * lu(k,979) + lu(k,990) = lu(k,990) * lu(k,979) + lu(k,991) = lu(k,991) * lu(k,979) + lu(k,1307) = lu(k,1307) - lu(k,980) * lu(k,1306) + lu(k,1317) = lu(k,1317) - lu(k,981) * lu(k,1306) + lu(k,1318) = lu(k,1318) - lu(k,982) * lu(k,1306) + lu(k,1319) = lu(k,1319) - lu(k,983) * lu(k,1306) + lu(k,1320) = lu(k,1320) - lu(k,984) * lu(k,1306) + lu(k,1322) = lu(k,1322) - lu(k,985) * lu(k,1306) + lu(k,1323) = lu(k,1323) - lu(k,986) * lu(k,1306) + lu(k,1325) = lu(k,1325) - lu(k,987) * lu(k,1306) + lu(k,1327) = lu(k,1327) - lu(k,988) * lu(k,1306) + lu(k,1329) = lu(k,1329) - lu(k,989) * lu(k,1306) + lu(k,1332) = lu(k,1332) - lu(k,990) * lu(k,1306) + lu(k,1333) = lu(k,1333) - lu(k,991) * lu(k,1306) + lu(k,1481) = lu(k,1481) - lu(k,980) * lu(k,1480) + lu(k,1493) = lu(k,1493) - lu(k,981) * lu(k,1480) + lu(k,1495) = lu(k,1495) - lu(k,982) * lu(k,1480) + lu(k,1496) = lu(k,1496) - lu(k,983) * lu(k,1480) + lu(k,1497) = lu(k,1497) - lu(k,984) * lu(k,1480) + lu(k,1499) = lu(k,1499) - lu(k,985) * lu(k,1480) + lu(k,1501) = lu(k,1501) - lu(k,986) * lu(k,1480) + lu(k,1503) = lu(k,1503) - lu(k,987) * lu(k,1480) + lu(k,1505) = lu(k,1505) - lu(k,988) * lu(k,1480) + lu(k,1507) = lu(k,1507) - lu(k,989) * lu(k,1480) + lu(k,1510) = lu(k,1510) - lu(k,990) * lu(k,1480) + lu(k,1511) = lu(k,1511) - lu(k,991) * lu(k,1480) + lu(k,1665) = lu(k,1665) - lu(k,980) * lu(k,1664) + lu(k,1676) = lu(k,1676) - lu(k,981) * lu(k,1664) + lu(k,1678) = lu(k,1678) - lu(k,982) * lu(k,1664) + lu(k,1679) = lu(k,1679) - lu(k,983) * lu(k,1664) + lu(k,1680) = lu(k,1680) - lu(k,984) * lu(k,1664) + lu(k,1682) = lu(k,1682) - lu(k,985) * lu(k,1664) + lu(k,1684) = lu(k,1684) - lu(k,986) * lu(k,1664) + lu(k,1686) = lu(k,1686) - lu(k,987) * lu(k,1664) + lu(k,1688) = lu(k,1688) - lu(k,988) * lu(k,1664) + lu(k,1690) = lu(k,1690) - lu(k,989) * lu(k,1664) + lu(k,1693) = lu(k,1693) - lu(k,990) * lu(k,1664) + lu(k,1694) = lu(k,1694) - lu(k,991) * lu(k,1664) + lu(k,1782) = lu(k,1782) - lu(k,980) * lu(k,1781) + lu(k,1792) = lu(k,1792) - lu(k,981) * lu(k,1781) + lu(k,1794) = lu(k,1794) - lu(k,982) * lu(k,1781) + lu(k,1795) = lu(k,1795) - lu(k,983) * lu(k,1781) + lu(k,1796) = lu(k,1796) - lu(k,984) * lu(k,1781) + lu(k,1798) = lu(k,1798) - lu(k,985) * lu(k,1781) + lu(k,1800) = lu(k,1800) - lu(k,986) * lu(k,1781) + lu(k,1802) = lu(k,1802) - lu(k,987) * lu(k,1781) + lu(k,1804) = lu(k,1804) - lu(k,988) * lu(k,1781) + lu(k,1806) = lu(k,1806) - lu(k,989) * lu(k,1781) + lu(k,1809) = lu(k,1809) - lu(k,990) * lu(k,1781) + lu(k,1810) = lu(k,1810) - lu(k,991) * lu(k,1781) + lu(k,1842) = lu(k,1842) - lu(k,980) * lu(k,1841) + lu(k,1852) = lu(k,1852) - lu(k,981) * lu(k,1841) + lu(k,1854) = lu(k,1854) - lu(k,982) * lu(k,1841) + lu(k,1855) = lu(k,1855) - lu(k,983) * lu(k,1841) + lu(k,1856) = lu(k,1856) - lu(k,984) * lu(k,1841) + lu(k,1858) = lu(k,1858) - lu(k,985) * lu(k,1841) + lu(k,1860) = lu(k,1860) - lu(k,986) * lu(k,1841) + lu(k,1862) = lu(k,1862) - lu(k,987) * lu(k,1841) + lu(k,1864) = lu(k,1864) - lu(k,988) * lu(k,1841) + lu(k,1866) = lu(k,1866) - lu(k,989) * lu(k,1841) + lu(k,1869) = lu(k,1869) - lu(k,990) * lu(k,1841) + lu(k,1870) = lu(k,1870) - lu(k,991) * lu(k,1841) + lu(k,1996) = lu(k,1996) - lu(k,980) * lu(k,1995) + lu(k,2007) = lu(k,2007) - lu(k,981) * lu(k,1995) + lu(k,2009) = lu(k,2009) - lu(k,982) * lu(k,1995) + lu(k,2010) = lu(k,2010) - lu(k,983) * lu(k,1995) + lu(k,2011) = lu(k,2011) - lu(k,984) * lu(k,1995) + lu(k,2013) = lu(k,2013) - lu(k,985) * lu(k,1995) + lu(k,2015) = lu(k,2015) - lu(k,986) * lu(k,1995) + lu(k,2017) = lu(k,2017) - lu(k,987) * lu(k,1995) + lu(k,2019) = lu(k,2019) - lu(k,988) * lu(k,1995) + lu(k,2021) = lu(k,2021) - lu(k,989) * lu(k,1995) + lu(k,2024) = lu(k,2024) - lu(k,990) * lu(k,1995) + lu(k,2025) = lu(k,2025) - lu(k,991) * lu(k,1995) + lu(k,995) = 1._r8 / lu(k,995) + lu(k,996) = lu(k,996) * lu(k,995) + lu(k,997) = lu(k,997) * lu(k,995) + lu(k,998) = lu(k,998) * lu(k,995) + lu(k,999) = lu(k,999) * lu(k,995) + lu(k,1000) = lu(k,1000) * lu(k,995) + lu(k,1001) = lu(k,1001) * lu(k,995) + lu(k,1002) = lu(k,1002) * lu(k,995) + lu(k,1003) = lu(k,1003) * lu(k,995) + lu(k,1004) = lu(k,1004) * lu(k,995) + lu(k,1112) = lu(k,1112) - lu(k,996) * lu(k,1109) + lu(k,1117) = lu(k,1117) - lu(k,997) * lu(k,1109) + lu(k,1120) = lu(k,1120) - lu(k,998) * lu(k,1109) + lu(k,1121) = lu(k,1121) - lu(k,999) * lu(k,1109) + lu(k,1122) = lu(k,1122) - lu(k,1000) * lu(k,1109) + lu(k,1123) = lu(k,1123) - lu(k,1001) * lu(k,1109) + lu(k,1124) = lu(k,1124) - lu(k,1002) * lu(k,1109) + lu(k,1126) = lu(k,1126) - lu(k,1003) * lu(k,1109) + lu(k,1128) = lu(k,1128) - lu(k,1004) * lu(k,1109) + lu(k,1156) = lu(k,1156) - lu(k,996) * lu(k,1155) + lu(k,1159) = lu(k,1159) - lu(k,997) * lu(k,1155) + lu(k,1162) = lu(k,1162) - lu(k,998) * lu(k,1155) + lu(k,1163) = lu(k,1163) - lu(k,999) * lu(k,1155) + lu(k,1164) = lu(k,1164) - lu(k,1000) * lu(k,1155) + lu(k,1165) = lu(k,1165) - lu(k,1001) * lu(k,1155) + lu(k,1166) = lu(k,1166) - lu(k,1002) * lu(k,1155) + lu(k,1167) = lu(k,1167) - lu(k,1003) * lu(k,1155) + lu(k,1169) = lu(k,1169) - lu(k,1004) * lu(k,1155) + lu(k,1180) = lu(k,1180) - lu(k,996) * lu(k,1177) + lu(k,1185) = lu(k,1185) - lu(k,997) * lu(k,1177) + lu(k,1188) = lu(k,1188) - lu(k,998) * lu(k,1177) + lu(k,1189) = lu(k,1189) - lu(k,999) * lu(k,1177) + lu(k,1190) = lu(k,1190) - lu(k,1000) * lu(k,1177) + lu(k,1191) = lu(k,1191) - lu(k,1001) * lu(k,1177) + lu(k,1192) = lu(k,1192) - lu(k,1002) * lu(k,1177) + lu(k,1194) = lu(k,1194) - lu(k,1003) * lu(k,1177) + lu(k,1196) = lu(k,1196) - lu(k,1004) * lu(k,1177) + lu(k,1311) = lu(k,1311) - lu(k,996) * lu(k,1307) + lu(k,1317) = lu(k,1317) - lu(k,997) * lu(k,1307) + lu(k,1320) = lu(k,1320) - lu(k,998) * lu(k,1307) + lu(k,1322) = lu(k,1322) - lu(k,999) * lu(k,1307) + lu(k,1323) = lu(k,1323) - lu(k,1000) * lu(k,1307) + lu(k,1325) = lu(k,1325) - lu(k,1001) * lu(k,1307) + lu(k,1327) = lu(k,1327) - lu(k,1002) * lu(k,1307) + lu(k,1329) = lu(k,1329) - lu(k,1003) * lu(k,1307) + lu(k,1333) = lu(k,1333) - lu(k,1004) * lu(k,1307) + lu(k,1486) = lu(k,1486) - lu(k,996) * lu(k,1481) + lu(k,1493) = lu(k,1493) - lu(k,997) * lu(k,1481) + lu(k,1497) = lu(k,1497) - lu(k,998) * lu(k,1481) + lu(k,1499) = lu(k,1499) - lu(k,999) * lu(k,1481) + lu(k,1501) = lu(k,1501) - lu(k,1000) * lu(k,1481) + lu(k,1503) = lu(k,1503) - lu(k,1001) * lu(k,1481) + lu(k,1505) = lu(k,1505) - lu(k,1002) * lu(k,1481) + lu(k,1507) = lu(k,1507) - lu(k,1003) * lu(k,1481) + lu(k,1511) = lu(k,1511) - lu(k,1004) * lu(k,1481) + lu(k,1670) = lu(k,1670) - lu(k,996) * lu(k,1665) + lu(k,1676) = lu(k,1676) - lu(k,997) * lu(k,1665) + lu(k,1680) = lu(k,1680) - lu(k,998) * lu(k,1665) + lu(k,1682) = lu(k,1682) - lu(k,999) * lu(k,1665) + lu(k,1684) = lu(k,1684) - lu(k,1000) * lu(k,1665) + lu(k,1686) = lu(k,1686) - lu(k,1001) * lu(k,1665) + lu(k,1688) = lu(k,1688) - lu(k,1002) * lu(k,1665) + lu(k,1690) = lu(k,1690) - lu(k,1003) * lu(k,1665) + lu(k,1694) = lu(k,1694) - lu(k,1004) * lu(k,1665) + lu(k,1786) = lu(k,1786) - lu(k,996) * lu(k,1782) + lu(k,1792) = lu(k,1792) - lu(k,997) * lu(k,1782) + lu(k,1796) = lu(k,1796) - lu(k,998) * lu(k,1782) + lu(k,1798) = lu(k,1798) - lu(k,999) * lu(k,1782) + lu(k,1800) = lu(k,1800) - lu(k,1000) * lu(k,1782) + lu(k,1802) = lu(k,1802) - lu(k,1001) * lu(k,1782) + lu(k,1804) = lu(k,1804) - lu(k,1002) * lu(k,1782) + lu(k,1806) = lu(k,1806) - lu(k,1003) * lu(k,1782) + lu(k,1810) = lu(k,1810) - lu(k,1004) * lu(k,1782) + lu(k,1845) = lu(k,1845) - lu(k,996) * lu(k,1842) + lu(k,1852) = lu(k,1852) - lu(k,997) * lu(k,1842) + lu(k,1856) = lu(k,1856) - lu(k,998) * lu(k,1842) + lu(k,1858) = lu(k,1858) - lu(k,999) * lu(k,1842) + lu(k,1860) = lu(k,1860) - lu(k,1000) * lu(k,1842) + lu(k,1862) = lu(k,1862) - lu(k,1001) * lu(k,1842) + lu(k,1864) = lu(k,1864) - lu(k,1002) * lu(k,1842) + lu(k,1866) = lu(k,1866) - lu(k,1003) * lu(k,1842) + lu(k,1870) = lu(k,1870) - lu(k,1004) * lu(k,1842) + lu(k,2000) = lu(k,2000) - lu(k,996) * lu(k,1996) + lu(k,2007) = lu(k,2007) - lu(k,997) * lu(k,1996) + lu(k,2011) = lu(k,2011) - lu(k,998) * lu(k,1996) + lu(k,2013) = lu(k,2013) - lu(k,999) * lu(k,1996) + lu(k,2015) = lu(k,2015) - lu(k,1000) * lu(k,1996) + lu(k,2017) = lu(k,2017) - lu(k,1001) * lu(k,1996) + lu(k,2019) = lu(k,2019) - lu(k,1002) * lu(k,1996) + lu(k,2021) = lu(k,2021) - lu(k,1003) * lu(k,1996) + lu(k,2025) = lu(k,2025) - lu(k,1004) * lu(k,1996) + end do + end subroutine lu_fac20 + subroutine lu_fac21( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,1011) = 1._r8 / lu(k,1011) + lu(k,1012) = lu(k,1012) * lu(k,1011) + lu(k,1013) = lu(k,1013) * lu(k,1011) + lu(k,1014) = lu(k,1014) * lu(k,1011) + lu(k,1015) = lu(k,1015) * lu(k,1011) + lu(k,1016) = lu(k,1016) * lu(k,1011) + lu(k,1017) = lu(k,1017) * lu(k,1011) + lu(k,1018) = lu(k,1018) * lu(k,1011) + lu(k,1019) = lu(k,1019) * lu(k,1011) + lu(k,1020) = lu(k,1020) * lu(k,1011) + lu(k,1021) = lu(k,1021) * lu(k,1011) + lu(k,1046) = lu(k,1046) - lu(k,1012) * lu(k,1043) + lu(k,1048) = lu(k,1048) - lu(k,1013) * lu(k,1043) + lu(k,1050) = lu(k,1050) - lu(k,1014) * lu(k,1043) + lu(k,1051) = lu(k,1051) - lu(k,1015) * lu(k,1043) + lu(k,1052) = lu(k,1052) - lu(k,1016) * lu(k,1043) + lu(k,1053) = lu(k,1053) - lu(k,1017) * lu(k,1043) + lu(k,1054) = lu(k,1054) - lu(k,1018) * lu(k,1043) + lu(k,1055) = lu(k,1055) - lu(k,1019) * lu(k,1043) + lu(k,1056) = lu(k,1056) - lu(k,1020) * lu(k,1043) + lu(k,1057) = lu(k,1057) - lu(k,1021) * lu(k,1043) + lu(k,1112) = lu(k,1112) - lu(k,1012) * lu(k,1110) + lu(k,1117) = lu(k,1117) - lu(k,1013) * lu(k,1110) + lu(k,1119) = lu(k,1119) - lu(k,1014) * lu(k,1110) + lu(k,1120) = lu(k,1120) - lu(k,1015) * lu(k,1110) + lu(k,1121) = lu(k,1121) - lu(k,1016) * lu(k,1110) + lu(k,1122) = lu(k,1122) - lu(k,1017) * lu(k,1110) + lu(k,1123) = lu(k,1123) - lu(k,1018) * lu(k,1110) + lu(k,1124) = lu(k,1124) - lu(k,1019) * lu(k,1110) + lu(k,1126) = lu(k,1126) - lu(k,1020) * lu(k,1110) + lu(k,1127) = lu(k,1127) - lu(k,1021) * lu(k,1110) + lu(k,1180) = lu(k,1180) - lu(k,1012) * lu(k,1178) + lu(k,1185) = lu(k,1185) - lu(k,1013) * lu(k,1178) + lu(k,1187) = lu(k,1187) - lu(k,1014) * lu(k,1178) + lu(k,1188) = lu(k,1188) - lu(k,1015) * lu(k,1178) + lu(k,1189) = lu(k,1189) - lu(k,1016) * lu(k,1178) + lu(k,1190) = lu(k,1190) - lu(k,1017) * lu(k,1178) + lu(k,1191) = lu(k,1191) - lu(k,1018) * lu(k,1178) + lu(k,1192) = lu(k,1192) - lu(k,1019) * lu(k,1178) + lu(k,1194) = lu(k,1194) - lu(k,1020) * lu(k,1178) + lu(k,1195) = lu(k,1195) - lu(k,1021) * lu(k,1178) + lu(k,1227) = lu(k,1227) - lu(k,1012) * lu(k,1224) + lu(k,1233) = lu(k,1233) - lu(k,1013) * lu(k,1224) + lu(k,1235) = lu(k,1235) - lu(k,1014) * lu(k,1224) + lu(k,1236) = lu(k,1236) - lu(k,1015) * lu(k,1224) + lu(k,1237) = lu(k,1237) - lu(k,1016) * lu(k,1224) + lu(k,1238) = lu(k,1238) - lu(k,1017) * lu(k,1224) + lu(k,1239) = lu(k,1239) - lu(k,1018) * lu(k,1224) + lu(k,1240) = lu(k,1240) - lu(k,1019) * lu(k,1224) + lu(k,1242) = lu(k,1242) - lu(k,1020) * lu(k,1224) + lu(k,1243) = lu(k,1243) - lu(k,1021) * lu(k,1224) + lu(k,1311) = lu(k,1311) - lu(k,1012) * lu(k,1308) + lu(k,1317) = lu(k,1317) - lu(k,1013) * lu(k,1308) + lu(k,1319) = lu(k,1319) - lu(k,1014) * lu(k,1308) + lu(k,1320) = lu(k,1320) - lu(k,1015) * lu(k,1308) + lu(k,1322) = lu(k,1322) - lu(k,1016) * lu(k,1308) + lu(k,1323) = lu(k,1323) - lu(k,1017) * lu(k,1308) + lu(k,1325) = lu(k,1325) - lu(k,1018) * lu(k,1308) + lu(k,1327) = lu(k,1327) - lu(k,1019) * lu(k,1308) + lu(k,1329) = lu(k,1329) - lu(k,1020) * lu(k,1308) + lu(k,1332) = lu(k,1332) - lu(k,1021) * lu(k,1308) + lu(k,1486) = lu(k,1486) - lu(k,1012) * lu(k,1482) + lu(k,1493) = lu(k,1493) - lu(k,1013) * lu(k,1482) + lu(k,1496) = lu(k,1496) - lu(k,1014) * lu(k,1482) + lu(k,1497) = lu(k,1497) - lu(k,1015) * lu(k,1482) + lu(k,1499) = lu(k,1499) - lu(k,1016) * lu(k,1482) + lu(k,1501) = lu(k,1501) - lu(k,1017) * lu(k,1482) + lu(k,1503) = lu(k,1503) - lu(k,1018) * lu(k,1482) + lu(k,1505) = lu(k,1505) - lu(k,1019) * lu(k,1482) + lu(k,1507) = lu(k,1507) - lu(k,1020) * lu(k,1482) + lu(k,1510) = lu(k,1510) - lu(k,1021) * lu(k,1482) + lu(k,1670) = lu(k,1670) - lu(k,1012) * lu(k,1666) + lu(k,1676) = lu(k,1676) - lu(k,1013) * lu(k,1666) + lu(k,1679) = lu(k,1679) - lu(k,1014) * lu(k,1666) + lu(k,1680) = lu(k,1680) - lu(k,1015) * lu(k,1666) + lu(k,1682) = lu(k,1682) - lu(k,1016) * lu(k,1666) + lu(k,1684) = lu(k,1684) - lu(k,1017) * lu(k,1666) + lu(k,1686) = lu(k,1686) - lu(k,1018) * lu(k,1666) + lu(k,1688) = lu(k,1688) - lu(k,1019) * lu(k,1666) + lu(k,1690) = lu(k,1690) - lu(k,1020) * lu(k,1666) + lu(k,1693) = lu(k,1693) - lu(k,1021) * lu(k,1666) + lu(k,1786) = lu(k,1786) - lu(k,1012) * lu(k,1783) + lu(k,1792) = lu(k,1792) - lu(k,1013) * lu(k,1783) + lu(k,1795) = lu(k,1795) - lu(k,1014) * lu(k,1783) + lu(k,1796) = lu(k,1796) - lu(k,1015) * lu(k,1783) + lu(k,1798) = lu(k,1798) - lu(k,1016) * lu(k,1783) + lu(k,1800) = lu(k,1800) - lu(k,1017) * lu(k,1783) + lu(k,1802) = lu(k,1802) - lu(k,1018) * lu(k,1783) + lu(k,1804) = lu(k,1804) - lu(k,1019) * lu(k,1783) + lu(k,1806) = lu(k,1806) - lu(k,1020) * lu(k,1783) + lu(k,1809) = lu(k,1809) - lu(k,1021) * lu(k,1783) + lu(k,2000) = lu(k,2000) - lu(k,1012) * lu(k,1997) + lu(k,2007) = lu(k,2007) - lu(k,1013) * lu(k,1997) + lu(k,2010) = lu(k,2010) - lu(k,1014) * lu(k,1997) + lu(k,2011) = lu(k,2011) - lu(k,1015) * lu(k,1997) + lu(k,2013) = lu(k,2013) - lu(k,1016) * lu(k,1997) + lu(k,2015) = lu(k,2015) - lu(k,1017) * lu(k,1997) + lu(k,2017) = lu(k,2017) - lu(k,1018) * lu(k,1997) + lu(k,2019) = lu(k,2019) - lu(k,1019) * lu(k,1997) + lu(k,2021) = lu(k,2021) - lu(k,1020) * lu(k,1997) + lu(k,2024) = lu(k,2024) - lu(k,1021) * lu(k,1997) + lu(k,1024) = 1._r8 / lu(k,1024) + lu(k,1025) = lu(k,1025) * lu(k,1024) + lu(k,1026) = lu(k,1026) * lu(k,1024) + lu(k,1027) = lu(k,1027) * lu(k,1024) + lu(k,1028) = lu(k,1028) * lu(k,1024) + lu(k,1029) = lu(k,1029) * lu(k,1024) + lu(k,1030) = lu(k,1030) * lu(k,1024) + lu(k,1031) = lu(k,1031) * lu(k,1024) + lu(k,1032) = lu(k,1032) * lu(k,1024) + lu(k,1033) = lu(k,1033) * lu(k,1024) + lu(k,1034) = lu(k,1034) * lu(k,1024) + lu(k,1260) = lu(k,1260) - lu(k,1025) * lu(k,1259) + lu(k,1261) = lu(k,1261) - lu(k,1026) * lu(k,1259) + lu(k,1262) = lu(k,1262) - lu(k,1027) * lu(k,1259) + lu(k,1263) = - lu(k,1028) * lu(k,1259) + lu(k,1264) = lu(k,1264) - lu(k,1029) * lu(k,1259) + lu(k,1265) = - lu(k,1030) * lu(k,1259) + lu(k,1267) = - lu(k,1031) * lu(k,1259) + lu(k,1268) = - lu(k,1032) * lu(k,1259) + lu(k,1269) = lu(k,1269) - lu(k,1033) * lu(k,1259) + lu(k,1270) = lu(k,1270) - lu(k,1034) * lu(k,1259) + lu(k,1272) = - lu(k,1025) * lu(k,1271) + lu(k,1273) = lu(k,1273) - lu(k,1026) * lu(k,1271) + lu(k,1274) = - lu(k,1027) * lu(k,1271) + lu(k,1275) = - lu(k,1028) * lu(k,1271) + lu(k,1276) = lu(k,1276) - lu(k,1029) * lu(k,1271) + lu(k,1277) = lu(k,1277) - lu(k,1030) * lu(k,1271) + lu(k,1281) = - lu(k,1031) * lu(k,1271) + lu(k,1282) = - lu(k,1032) * lu(k,1271) + lu(k,1283) = - lu(k,1033) * lu(k,1271) + lu(k,1284) = lu(k,1284) - lu(k,1034) * lu(k,1271) + lu(k,1341) = lu(k,1341) - lu(k,1025) * lu(k,1339) + lu(k,1342) = lu(k,1342) - lu(k,1026) * lu(k,1339) + lu(k,1343) = lu(k,1343) - lu(k,1027) * lu(k,1339) + lu(k,1344) = lu(k,1344) - lu(k,1028) * lu(k,1339) + lu(k,1345) = lu(k,1345) - lu(k,1029) * lu(k,1339) + lu(k,1348) = lu(k,1348) - lu(k,1030) * lu(k,1339) + lu(k,1354) = lu(k,1354) - lu(k,1031) * lu(k,1339) + lu(k,1355) = lu(k,1355) - lu(k,1032) * lu(k,1339) + lu(k,1356) = lu(k,1356) - lu(k,1033) * lu(k,1339) + lu(k,1357) = lu(k,1357) - lu(k,1034) * lu(k,1339) + lu(k,1495) = lu(k,1495) - lu(k,1025) * lu(k,1483) + lu(k,1496) = lu(k,1496) - lu(k,1026) * lu(k,1483) + lu(k,1497) = lu(k,1497) - lu(k,1027) * lu(k,1483) + lu(k,1498) = lu(k,1498) - lu(k,1028) * lu(k,1483) + lu(k,1499) = lu(k,1499) - lu(k,1029) * lu(k,1483) + lu(k,1502) = lu(k,1502) - lu(k,1030) * lu(k,1483) + lu(k,1508) = lu(k,1508) - lu(k,1031) * lu(k,1483) + lu(k,1509) = lu(k,1509) - lu(k,1032) * lu(k,1483) + lu(k,1510) = lu(k,1510) - lu(k,1033) * lu(k,1483) + lu(k,1511) = lu(k,1511) - lu(k,1034) * lu(k,1483) + lu(k,1542) = lu(k,1542) - lu(k,1025) * lu(k,1540) + lu(k,1543) = lu(k,1543) - lu(k,1026) * lu(k,1540) + lu(k,1544) = - lu(k,1027) * lu(k,1540) + lu(k,1545) = lu(k,1545) - lu(k,1028) * lu(k,1540) + lu(k,1546) = lu(k,1546) - lu(k,1029) * lu(k,1540) + lu(k,1549) = lu(k,1549) - lu(k,1030) * lu(k,1540) + lu(k,1555) = lu(k,1555) - lu(k,1031) * lu(k,1540) + lu(k,1556) = lu(k,1556) - lu(k,1032) * lu(k,1540) + lu(k,1557) = lu(k,1557) - lu(k,1033) * lu(k,1540) + lu(k,1558) = lu(k,1558) - lu(k,1034) * lu(k,1540) + lu(k,1572) = lu(k,1572) - lu(k,1025) * lu(k,1569) + lu(k,1573) = lu(k,1573) - lu(k,1026) * lu(k,1569) + lu(k,1574) = - lu(k,1027) * lu(k,1569) + lu(k,1575) = lu(k,1575) - lu(k,1028) * lu(k,1569) + lu(k,1576) = lu(k,1576) - lu(k,1029) * lu(k,1569) + lu(k,1579) = lu(k,1579) - lu(k,1030) * lu(k,1569) + lu(k,1585) = lu(k,1585) - lu(k,1031) * lu(k,1569) + lu(k,1586) = lu(k,1586) - lu(k,1032) * lu(k,1569) + lu(k,1587) = lu(k,1587) - lu(k,1033) * lu(k,1569) + lu(k,1588) = lu(k,1588) - lu(k,1034) * lu(k,1569) + lu(k,1678) = lu(k,1678) - lu(k,1025) * lu(k,1667) + lu(k,1679) = lu(k,1679) - lu(k,1026) * lu(k,1667) + lu(k,1680) = lu(k,1680) - lu(k,1027) * lu(k,1667) + lu(k,1681) = lu(k,1681) - lu(k,1028) * lu(k,1667) + lu(k,1682) = lu(k,1682) - lu(k,1029) * lu(k,1667) + lu(k,1685) = lu(k,1685) - lu(k,1030) * lu(k,1667) + lu(k,1691) = lu(k,1691) - lu(k,1031) * lu(k,1667) + lu(k,1692) = lu(k,1692) - lu(k,1032) * lu(k,1667) + lu(k,1693) = lu(k,1693) - lu(k,1033) * lu(k,1667) + lu(k,1694) = lu(k,1694) - lu(k,1034) * lu(k,1667) + lu(k,1952) = lu(k,1952) - lu(k,1025) * lu(k,1949) + lu(k,1953) = lu(k,1953) - lu(k,1026) * lu(k,1949) + lu(k,1954) = lu(k,1954) - lu(k,1027) * lu(k,1949) + lu(k,1955) = - lu(k,1028) * lu(k,1949) + lu(k,1956) = lu(k,1956) - lu(k,1029) * lu(k,1949) + lu(k,1959) = lu(k,1959) - lu(k,1030) * lu(k,1949) + lu(k,1965) = lu(k,1965) - lu(k,1031) * lu(k,1949) + lu(k,1966) = lu(k,1966) - lu(k,1032) * lu(k,1949) + lu(k,1967) = lu(k,1967) - lu(k,1033) * lu(k,1949) + lu(k,1968) = lu(k,1968) - lu(k,1034) * lu(k,1949) + lu(k,2034) = lu(k,2034) - lu(k,1025) * lu(k,2031) + lu(k,2035) = lu(k,2035) - lu(k,1026) * lu(k,2031) + lu(k,2036) = lu(k,2036) - lu(k,1027) * lu(k,2031) + lu(k,2037) = lu(k,2037) - lu(k,1028) * lu(k,2031) + lu(k,2038) = lu(k,2038) - lu(k,1029) * lu(k,2031) + lu(k,2041) = lu(k,2041) - lu(k,1030) * lu(k,2031) + lu(k,2047) = - lu(k,1031) * lu(k,2031) + lu(k,2048) = - lu(k,1032) * lu(k,2031) + lu(k,2049) = lu(k,2049) - lu(k,1033) * lu(k,2031) + lu(k,2050) = lu(k,2050) - lu(k,1034) * lu(k,2031) + lu(k,1044) = 1._r8 / lu(k,1044) + lu(k,1045) = lu(k,1045) * lu(k,1044) + lu(k,1046) = lu(k,1046) * lu(k,1044) + lu(k,1047) = lu(k,1047) * lu(k,1044) + lu(k,1048) = lu(k,1048) * lu(k,1044) + lu(k,1049) = lu(k,1049) * lu(k,1044) + lu(k,1050) = lu(k,1050) * lu(k,1044) + lu(k,1051) = lu(k,1051) * lu(k,1044) + lu(k,1052) = lu(k,1052) * lu(k,1044) + lu(k,1053) = lu(k,1053) * lu(k,1044) + lu(k,1054) = lu(k,1054) * lu(k,1044) + lu(k,1055) = lu(k,1055) * lu(k,1044) + lu(k,1056) = lu(k,1056) * lu(k,1044) + lu(k,1057) = lu(k,1057) * lu(k,1044) + lu(k,1226) = lu(k,1226) - lu(k,1045) * lu(k,1225) + lu(k,1227) = lu(k,1227) - lu(k,1046) * lu(k,1225) + lu(k,1229) = lu(k,1229) - lu(k,1047) * lu(k,1225) + lu(k,1233) = lu(k,1233) - lu(k,1048) * lu(k,1225) + lu(k,1234) = lu(k,1234) - lu(k,1049) * lu(k,1225) + lu(k,1235) = lu(k,1235) - lu(k,1050) * lu(k,1225) + lu(k,1236) = lu(k,1236) - lu(k,1051) * lu(k,1225) + lu(k,1237) = lu(k,1237) - lu(k,1052) * lu(k,1225) + lu(k,1238) = lu(k,1238) - lu(k,1053) * lu(k,1225) + lu(k,1239) = lu(k,1239) - lu(k,1054) * lu(k,1225) + lu(k,1240) = lu(k,1240) - lu(k,1055) * lu(k,1225) + lu(k,1242) = lu(k,1242) - lu(k,1056) * lu(k,1225) + lu(k,1243) = lu(k,1243) - lu(k,1057) * lu(k,1225) + lu(k,1310) = lu(k,1310) - lu(k,1045) * lu(k,1309) + lu(k,1311) = lu(k,1311) - lu(k,1046) * lu(k,1309) + lu(k,1313) = lu(k,1313) - lu(k,1047) * lu(k,1309) + lu(k,1317) = lu(k,1317) - lu(k,1048) * lu(k,1309) + lu(k,1318) = lu(k,1318) - lu(k,1049) * lu(k,1309) + lu(k,1319) = lu(k,1319) - lu(k,1050) * lu(k,1309) + lu(k,1320) = lu(k,1320) - lu(k,1051) * lu(k,1309) + lu(k,1322) = lu(k,1322) - lu(k,1052) * lu(k,1309) + lu(k,1323) = lu(k,1323) - lu(k,1053) * lu(k,1309) + lu(k,1325) = lu(k,1325) - lu(k,1054) * lu(k,1309) + lu(k,1327) = lu(k,1327) - lu(k,1055) * lu(k,1309) + lu(k,1329) = lu(k,1329) - lu(k,1056) * lu(k,1309) + lu(k,1332) = lu(k,1332) - lu(k,1057) * lu(k,1309) + lu(k,1485) = lu(k,1485) - lu(k,1045) * lu(k,1484) + lu(k,1486) = lu(k,1486) - lu(k,1046) * lu(k,1484) + lu(k,1489) = lu(k,1489) - lu(k,1047) * lu(k,1484) + lu(k,1493) = lu(k,1493) - lu(k,1048) * lu(k,1484) + lu(k,1495) = lu(k,1495) - lu(k,1049) * lu(k,1484) + lu(k,1496) = lu(k,1496) - lu(k,1050) * lu(k,1484) + lu(k,1497) = lu(k,1497) - lu(k,1051) * lu(k,1484) + lu(k,1499) = lu(k,1499) - lu(k,1052) * lu(k,1484) + lu(k,1501) = lu(k,1501) - lu(k,1053) * lu(k,1484) + lu(k,1503) = lu(k,1503) - lu(k,1054) * lu(k,1484) + lu(k,1505) = lu(k,1505) - lu(k,1055) * lu(k,1484) + lu(k,1507) = lu(k,1507) - lu(k,1056) * lu(k,1484) + lu(k,1510) = lu(k,1510) - lu(k,1057) * lu(k,1484) + lu(k,1669) = lu(k,1669) - lu(k,1045) * lu(k,1668) + lu(k,1670) = lu(k,1670) - lu(k,1046) * lu(k,1668) + lu(k,1672) = lu(k,1672) - lu(k,1047) * lu(k,1668) + lu(k,1676) = lu(k,1676) - lu(k,1048) * lu(k,1668) + lu(k,1678) = lu(k,1678) - lu(k,1049) * lu(k,1668) + lu(k,1679) = lu(k,1679) - lu(k,1050) * lu(k,1668) + lu(k,1680) = lu(k,1680) - lu(k,1051) * lu(k,1668) + lu(k,1682) = lu(k,1682) - lu(k,1052) * lu(k,1668) + lu(k,1684) = lu(k,1684) - lu(k,1053) * lu(k,1668) + lu(k,1686) = lu(k,1686) - lu(k,1054) * lu(k,1668) + lu(k,1688) = lu(k,1688) - lu(k,1055) * lu(k,1668) + lu(k,1690) = lu(k,1690) - lu(k,1056) * lu(k,1668) + lu(k,1693) = lu(k,1693) - lu(k,1057) * lu(k,1668) + lu(k,1785) = lu(k,1785) - lu(k,1045) * lu(k,1784) + lu(k,1786) = lu(k,1786) - lu(k,1046) * lu(k,1784) + lu(k,1788) = lu(k,1788) - lu(k,1047) * lu(k,1784) + lu(k,1792) = lu(k,1792) - lu(k,1048) * lu(k,1784) + lu(k,1794) = lu(k,1794) - lu(k,1049) * lu(k,1784) + lu(k,1795) = lu(k,1795) - lu(k,1050) * lu(k,1784) + lu(k,1796) = lu(k,1796) - lu(k,1051) * lu(k,1784) + lu(k,1798) = lu(k,1798) - lu(k,1052) * lu(k,1784) + lu(k,1800) = lu(k,1800) - lu(k,1053) * lu(k,1784) + lu(k,1802) = lu(k,1802) - lu(k,1054) * lu(k,1784) + lu(k,1804) = lu(k,1804) - lu(k,1055) * lu(k,1784) + lu(k,1806) = lu(k,1806) - lu(k,1056) * lu(k,1784) + lu(k,1809) = lu(k,1809) - lu(k,1057) * lu(k,1784) + lu(k,1844) = lu(k,1844) - lu(k,1045) * lu(k,1843) + lu(k,1845) = lu(k,1845) - lu(k,1046) * lu(k,1843) + lu(k,1848) = lu(k,1848) - lu(k,1047) * lu(k,1843) + lu(k,1852) = lu(k,1852) - lu(k,1048) * lu(k,1843) + lu(k,1854) = lu(k,1854) - lu(k,1049) * lu(k,1843) + lu(k,1855) = lu(k,1855) - lu(k,1050) * lu(k,1843) + lu(k,1856) = lu(k,1856) - lu(k,1051) * lu(k,1843) + lu(k,1858) = lu(k,1858) - lu(k,1052) * lu(k,1843) + lu(k,1860) = lu(k,1860) - lu(k,1053) * lu(k,1843) + lu(k,1862) = lu(k,1862) - lu(k,1054) * lu(k,1843) + lu(k,1864) = lu(k,1864) - lu(k,1055) * lu(k,1843) + lu(k,1866) = lu(k,1866) - lu(k,1056) * lu(k,1843) + lu(k,1869) = lu(k,1869) - lu(k,1057) * lu(k,1843) + lu(k,1999) = lu(k,1999) - lu(k,1045) * lu(k,1998) + lu(k,2000) = lu(k,2000) - lu(k,1046) * lu(k,1998) + lu(k,2003) = lu(k,2003) - lu(k,1047) * lu(k,1998) + lu(k,2007) = lu(k,2007) - lu(k,1048) * lu(k,1998) + lu(k,2009) = lu(k,2009) - lu(k,1049) * lu(k,1998) + lu(k,2010) = lu(k,2010) - lu(k,1050) * lu(k,1998) + lu(k,2011) = lu(k,2011) - lu(k,1051) * lu(k,1998) + lu(k,2013) = lu(k,2013) - lu(k,1052) * lu(k,1998) + lu(k,2015) = lu(k,2015) - lu(k,1053) * lu(k,1998) + lu(k,2017) = lu(k,2017) - lu(k,1054) * lu(k,1998) + lu(k,2019) = lu(k,2019) - lu(k,1055) * lu(k,1998) + lu(k,2021) = lu(k,2021) - lu(k,1056) * lu(k,1998) + lu(k,2024) = lu(k,2024) - lu(k,1057) * lu(k,1998) + end do + end subroutine lu_fac21 + subroutine lu_fac22( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,1060) = 1._r8 / lu(k,1060) + lu(k,1061) = lu(k,1061) * lu(k,1060) + lu(k,1062) = lu(k,1062) * lu(k,1060) + lu(k,1063) = lu(k,1063) * lu(k,1060) + lu(k,1064) = lu(k,1064) * lu(k,1060) + lu(k,1065) = lu(k,1065) * lu(k,1060) + lu(k,1066) = lu(k,1066) * lu(k,1060) + lu(k,1067) = lu(k,1067) * lu(k,1060) + lu(k,1068) = lu(k,1068) * lu(k,1060) + lu(k,1069) = lu(k,1069) * lu(k,1060) + lu(k,1070) = lu(k,1070) * lu(k,1060) + lu(k,1112) = lu(k,1112) - lu(k,1061) * lu(k,1111) + lu(k,1115) = - lu(k,1062) * lu(k,1111) + lu(k,1116) = - lu(k,1063) * lu(k,1111) + lu(k,1117) = lu(k,1117) - lu(k,1064) * lu(k,1111) + lu(k,1119) = lu(k,1119) - lu(k,1065) * lu(k,1111) + lu(k,1121) = lu(k,1121) - lu(k,1066) * lu(k,1111) + lu(k,1122) = lu(k,1122) - lu(k,1067) * lu(k,1111) + lu(k,1123) = lu(k,1123) - lu(k,1068) * lu(k,1111) + lu(k,1125) = - lu(k,1069) * lu(k,1111) + lu(k,1128) = lu(k,1128) - lu(k,1070) * lu(k,1111) + lu(k,1180) = lu(k,1180) - lu(k,1061) * lu(k,1179) + lu(k,1182) = - lu(k,1062) * lu(k,1179) + lu(k,1184) = - lu(k,1063) * lu(k,1179) + lu(k,1185) = lu(k,1185) - lu(k,1064) * lu(k,1179) + lu(k,1187) = lu(k,1187) - lu(k,1065) * lu(k,1179) + lu(k,1189) = lu(k,1189) - lu(k,1066) * lu(k,1179) + lu(k,1190) = lu(k,1190) - lu(k,1067) * lu(k,1179) + lu(k,1191) = lu(k,1191) - lu(k,1068) * lu(k,1179) + lu(k,1193) = - lu(k,1069) * lu(k,1179) + lu(k,1196) = lu(k,1196) - lu(k,1070) * lu(k,1179) + lu(k,1227) = lu(k,1227) - lu(k,1061) * lu(k,1226) + lu(k,1230) = lu(k,1230) - lu(k,1062) * lu(k,1226) + lu(k,1232) = lu(k,1232) - lu(k,1063) * lu(k,1226) + lu(k,1233) = lu(k,1233) - lu(k,1064) * lu(k,1226) + lu(k,1235) = lu(k,1235) - lu(k,1065) * lu(k,1226) + lu(k,1237) = lu(k,1237) - lu(k,1066) * lu(k,1226) + lu(k,1238) = lu(k,1238) - lu(k,1067) * lu(k,1226) + lu(k,1239) = lu(k,1239) - lu(k,1068) * lu(k,1226) + lu(k,1241) = lu(k,1241) - lu(k,1069) * lu(k,1226) + lu(k,1244) = lu(k,1244) - lu(k,1070) * lu(k,1226) + lu(k,1311) = lu(k,1311) - lu(k,1061) * lu(k,1310) + lu(k,1314) = lu(k,1314) - lu(k,1062) * lu(k,1310) + lu(k,1316) = lu(k,1316) - lu(k,1063) * lu(k,1310) + lu(k,1317) = lu(k,1317) - lu(k,1064) * lu(k,1310) + lu(k,1319) = lu(k,1319) - lu(k,1065) * lu(k,1310) + lu(k,1322) = lu(k,1322) - lu(k,1066) * lu(k,1310) + lu(k,1323) = lu(k,1323) - lu(k,1067) * lu(k,1310) + lu(k,1325) = lu(k,1325) - lu(k,1068) * lu(k,1310) + lu(k,1328) = - lu(k,1069) * lu(k,1310) + lu(k,1333) = lu(k,1333) - lu(k,1070) * lu(k,1310) + lu(k,1486) = lu(k,1486) - lu(k,1061) * lu(k,1485) + lu(k,1490) = lu(k,1490) - lu(k,1062) * lu(k,1485) + lu(k,1492) = lu(k,1492) - lu(k,1063) * lu(k,1485) + lu(k,1493) = lu(k,1493) - lu(k,1064) * lu(k,1485) + lu(k,1496) = lu(k,1496) - lu(k,1065) * lu(k,1485) + lu(k,1499) = lu(k,1499) - lu(k,1066) * lu(k,1485) + lu(k,1501) = lu(k,1501) - lu(k,1067) * lu(k,1485) + lu(k,1503) = lu(k,1503) - lu(k,1068) * lu(k,1485) + lu(k,1506) = lu(k,1506) - lu(k,1069) * lu(k,1485) + lu(k,1511) = lu(k,1511) - lu(k,1070) * lu(k,1485) + lu(k,1670) = lu(k,1670) - lu(k,1061) * lu(k,1669) + lu(k,1673) = lu(k,1673) - lu(k,1062) * lu(k,1669) + lu(k,1675) = lu(k,1675) - lu(k,1063) * lu(k,1669) + lu(k,1676) = lu(k,1676) - lu(k,1064) * lu(k,1669) + lu(k,1679) = lu(k,1679) - lu(k,1065) * lu(k,1669) + lu(k,1682) = lu(k,1682) - lu(k,1066) * lu(k,1669) + lu(k,1684) = lu(k,1684) - lu(k,1067) * lu(k,1669) + lu(k,1686) = lu(k,1686) - lu(k,1068) * lu(k,1669) + lu(k,1689) = lu(k,1689) - lu(k,1069) * lu(k,1669) + lu(k,1694) = lu(k,1694) - lu(k,1070) * lu(k,1669) + lu(k,1786) = lu(k,1786) - lu(k,1061) * lu(k,1785) + lu(k,1789) = lu(k,1789) - lu(k,1062) * lu(k,1785) + lu(k,1791) = lu(k,1791) - lu(k,1063) * lu(k,1785) + lu(k,1792) = lu(k,1792) - lu(k,1064) * lu(k,1785) + lu(k,1795) = lu(k,1795) - lu(k,1065) * lu(k,1785) + lu(k,1798) = lu(k,1798) - lu(k,1066) * lu(k,1785) + lu(k,1800) = lu(k,1800) - lu(k,1067) * lu(k,1785) + lu(k,1802) = lu(k,1802) - lu(k,1068) * lu(k,1785) + lu(k,1805) = lu(k,1805) - lu(k,1069) * lu(k,1785) + lu(k,1810) = lu(k,1810) - lu(k,1070) * lu(k,1785) + lu(k,1845) = lu(k,1845) - lu(k,1061) * lu(k,1844) + lu(k,1849) = - lu(k,1062) * lu(k,1844) + lu(k,1851) = - lu(k,1063) * lu(k,1844) + lu(k,1852) = lu(k,1852) - lu(k,1064) * lu(k,1844) + lu(k,1855) = lu(k,1855) - lu(k,1065) * lu(k,1844) + lu(k,1858) = lu(k,1858) - lu(k,1066) * lu(k,1844) + lu(k,1860) = lu(k,1860) - lu(k,1067) * lu(k,1844) + lu(k,1862) = lu(k,1862) - lu(k,1068) * lu(k,1844) + lu(k,1865) = lu(k,1865) - lu(k,1069) * lu(k,1844) + lu(k,1870) = lu(k,1870) - lu(k,1070) * lu(k,1844) + lu(k,2000) = lu(k,2000) - lu(k,1061) * lu(k,1999) + lu(k,2004) = lu(k,2004) - lu(k,1062) * lu(k,1999) + lu(k,2006) = lu(k,2006) - lu(k,1063) * lu(k,1999) + lu(k,2007) = lu(k,2007) - lu(k,1064) * lu(k,1999) + lu(k,2010) = lu(k,2010) - lu(k,1065) * lu(k,1999) + lu(k,2013) = lu(k,2013) - lu(k,1066) * lu(k,1999) + lu(k,2015) = lu(k,2015) - lu(k,1067) * lu(k,1999) + lu(k,2017) = lu(k,2017) - lu(k,1068) * lu(k,1999) + lu(k,2020) = lu(k,2020) - lu(k,1069) * lu(k,1999) + lu(k,2025) = lu(k,2025) - lu(k,1070) * lu(k,1999) + lu(k,1072) = 1._r8 / lu(k,1072) + lu(k,1073) = lu(k,1073) * lu(k,1072) + lu(k,1074) = lu(k,1074) * lu(k,1072) + lu(k,1075) = lu(k,1075) * lu(k,1072) + lu(k,1076) = lu(k,1076) * lu(k,1072) + lu(k,1077) = lu(k,1077) * lu(k,1072) + lu(k,1078) = lu(k,1078) * lu(k,1072) + lu(k,1079) = lu(k,1079) * lu(k,1072) + lu(k,1117) = lu(k,1117) - lu(k,1073) * lu(k,1112) + lu(k,1118) = lu(k,1118) - lu(k,1074) * lu(k,1112) + lu(k,1119) = lu(k,1119) - lu(k,1075) * lu(k,1112) + lu(k,1121) = lu(k,1121) - lu(k,1076) * lu(k,1112) + lu(k,1123) = lu(k,1123) - lu(k,1077) * lu(k,1112) + lu(k,1127) = lu(k,1127) - lu(k,1078) * lu(k,1112) + lu(k,1128) = lu(k,1128) - lu(k,1079) * lu(k,1112) + lu(k,1137) = lu(k,1137) - lu(k,1073) * lu(k,1134) + lu(k,1138) = lu(k,1138) - lu(k,1074) * lu(k,1134) + lu(k,1139) = lu(k,1139) - lu(k,1075) * lu(k,1134) + lu(k,1141) = lu(k,1141) - lu(k,1076) * lu(k,1134) + lu(k,1143) = lu(k,1143) - lu(k,1077) * lu(k,1134) + lu(k,1147) = lu(k,1147) - lu(k,1078) * lu(k,1134) + lu(k,1148) = lu(k,1148) - lu(k,1079) * lu(k,1134) + lu(k,1159) = lu(k,1159) - lu(k,1073) * lu(k,1156) + lu(k,1160) = lu(k,1160) - lu(k,1074) * lu(k,1156) + lu(k,1161) = lu(k,1161) - lu(k,1075) * lu(k,1156) + lu(k,1163) = lu(k,1163) - lu(k,1076) * lu(k,1156) + lu(k,1165) = lu(k,1165) - lu(k,1077) * lu(k,1156) + lu(k,1168) = lu(k,1168) - lu(k,1078) * lu(k,1156) + lu(k,1169) = lu(k,1169) - lu(k,1079) * lu(k,1156) + lu(k,1185) = lu(k,1185) - lu(k,1073) * lu(k,1180) + lu(k,1186) = lu(k,1186) - lu(k,1074) * lu(k,1180) + lu(k,1187) = lu(k,1187) - lu(k,1075) * lu(k,1180) + lu(k,1189) = lu(k,1189) - lu(k,1076) * lu(k,1180) + lu(k,1191) = lu(k,1191) - lu(k,1077) * lu(k,1180) + lu(k,1195) = lu(k,1195) - lu(k,1078) * lu(k,1180) + lu(k,1196) = lu(k,1196) - lu(k,1079) * lu(k,1180) + lu(k,1203) = lu(k,1203) - lu(k,1073) * lu(k,1201) + lu(k,1204) = - lu(k,1074) * lu(k,1201) + lu(k,1205) = - lu(k,1075) * lu(k,1201) + lu(k,1207) = lu(k,1207) - lu(k,1076) * lu(k,1201) + lu(k,1209) = lu(k,1209) - lu(k,1077) * lu(k,1201) + lu(k,1213) = lu(k,1213) - lu(k,1078) * lu(k,1201) + lu(k,1214) = lu(k,1214) - lu(k,1079) * lu(k,1201) + lu(k,1233) = lu(k,1233) - lu(k,1073) * lu(k,1227) + lu(k,1234) = lu(k,1234) - lu(k,1074) * lu(k,1227) + lu(k,1235) = lu(k,1235) - lu(k,1075) * lu(k,1227) + lu(k,1237) = lu(k,1237) - lu(k,1076) * lu(k,1227) + lu(k,1239) = lu(k,1239) - lu(k,1077) * lu(k,1227) + lu(k,1243) = lu(k,1243) - lu(k,1078) * lu(k,1227) + lu(k,1244) = lu(k,1244) - lu(k,1079) * lu(k,1227) + lu(k,1317) = lu(k,1317) - lu(k,1073) * lu(k,1311) + lu(k,1318) = lu(k,1318) - lu(k,1074) * lu(k,1311) + lu(k,1319) = lu(k,1319) - lu(k,1075) * lu(k,1311) + lu(k,1322) = lu(k,1322) - lu(k,1076) * lu(k,1311) + lu(k,1325) = lu(k,1325) - lu(k,1077) * lu(k,1311) + lu(k,1332) = lu(k,1332) - lu(k,1078) * lu(k,1311) + lu(k,1333) = lu(k,1333) - lu(k,1079) * lu(k,1311) + lu(k,1493) = lu(k,1493) - lu(k,1073) * lu(k,1486) + lu(k,1495) = lu(k,1495) - lu(k,1074) * lu(k,1486) + lu(k,1496) = lu(k,1496) - lu(k,1075) * lu(k,1486) + lu(k,1499) = lu(k,1499) - lu(k,1076) * lu(k,1486) + lu(k,1503) = lu(k,1503) - lu(k,1077) * lu(k,1486) + lu(k,1510) = lu(k,1510) - lu(k,1078) * lu(k,1486) + lu(k,1511) = lu(k,1511) - lu(k,1079) * lu(k,1486) + lu(k,1676) = lu(k,1676) - lu(k,1073) * lu(k,1670) + lu(k,1678) = lu(k,1678) - lu(k,1074) * lu(k,1670) + lu(k,1679) = lu(k,1679) - lu(k,1075) * lu(k,1670) + lu(k,1682) = lu(k,1682) - lu(k,1076) * lu(k,1670) + lu(k,1686) = lu(k,1686) - lu(k,1077) * lu(k,1670) + lu(k,1693) = lu(k,1693) - lu(k,1078) * lu(k,1670) + lu(k,1694) = lu(k,1694) - lu(k,1079) * lu(k,1670) + lu(k,1792) = lu(k,1792) - lu(k,1073) * lu(k,1786) + lu(k,1794) = lu(k,1794) - lu(k,1074) * lu(k,1786) + lu(k,1795) = lu(k,1795) - lu(k,1075) * lu(k,1786) + lu(k,1798) = lu(k,1798) - lu(k,1076) * lu(k,1786) + lu(k,1802) = lu(k,1802) - lu(k,1077) * lu(k,1786) + lu(k,1809) = lu(k,1809) - lu(k,1078) * lu(k,1786) + lu(k,1810) = lu(k,1810) - lu(k,1079) * lu(k,1786) + lu(k,1852) = lu(k,1852) - lu(k,1073) * lu(k,1845) + lu(k,1854) = lu(k,1854) - lu(k,1074) * lu(k,1845) + lu(k,1855) = lu(k,1855) - lu(k,1075) * lu(k,1845) + lu(k,1858) = lu(k,1858) - lu(k,1076) * lu(k,1845) + lu(k,1862) = lu(k,1862) - lu(k,1077) * lu(k,1845) + lu(k,1869) = lu(k,1869) - lu(k,1078) * lu(k,1845) + lu(k,1870) = lu(k,1870) - lu(k,1079) * lu(k,1845) + lu(k,1893) = lu(k,1893) - lu(k,1073) * lu(k,1890) + lu(k,1895) = lu(k,1895) - lu(k,1074) * lu(k,1890) + lu(k,1896) = lu(k,1896) - lu(k,1075) * lu(k,1890) + lu(k,1899) = lu(k,1899) - lu(k,1076) * lu(k,1890) + lu(k,1903) = lu(k,1903) - lu(k,1077) * lu(k,1890) + lu(k,1910) = lu(k,1910) - lu(k,1078) * lu(k,1890) + lu(k,1911) = lu(k,1911) - lu(k,1079) * lu(k,1890) + lu(k,2007) = lu(k,2007) - lu(k,1073) * lu(k,2000) + lu(k,2009) = lu(k,2009) - lu(k,1074) * lu(k,2000) + lu(k,2010) = lu(k,2010) - lu(k,1075) * lu(k,2000) + lu(k,2013) = lu(k,2013) - lu(k,1076) * lu(k,2000) + lu(k,2017) = lu(k,2017) - lu(k,1077) * lu(k,2000) + lu(k,2024) = lu(k,2024) - lu(k,1078) * lu(k,2000) + lu(k,2025) = lu(k,2025) - lu(k,1079) * lu(k,2000) + lu(k,1083) = 1._r8 / lu(k,1083) + lu(k,1084) = lu(k,1084) * lu(k,1083) + lu(k,1085) = lu(k,1085) * lu(k,1083) + lu(k,1086) = lu(k,1086) * lu(k,1083) + lu(k,1087) = lu(k,1087) * lu(k,1083) + lu(k,1088) = lu(k,1088) * lu(k,1083) + lu(k,1089) = lu(k,1089) * lu(k,1083) + lu(k,1090) = lu(k,1090) * lu(k,1083) + lu(k,1091) = lu(k,1091) * lu(k,1083) + lu(k,1092) = lu(k,1092) * lu(k,1083) + lu(k,1093) = lu(k,1093) * lu(k,1083) + lu(k,1094) = lu(k,1094) * lu(k,1083) + lu(k,1095) = lu(k,1095) * lu(k,1083) + lu(k,1494) = lu(k,1494) - lu(k,1084) * lu(k,1487) + lu(k,1496) = lu(k,1496) - lu(k,1085) * lu(k,1487) + lu(k,1499) = lu(k,1499) - lu(k,1086) * lu(k,1487) + lu(k,1500) = lu(k,1500) - lu(k,1087) * lu(k,1487) + lu(k,1502) = lu(k,1502) - lu(k,1088) * lu(k,1487) + lu(k,1503) = lu(k,1503) - lu(k,1089) * lu(k,1487) + lu(k,1504) = lu(k,1504) - lu(k,1090) * lu(k,1487) + lu(k,1505) = lu(k,1505) - lu(k,1091) * lu(k,1487) + lu(k,1506) = lu(k,1506) - lu(k,1092) * lu(k,1487) + lu(k,1507) = lu(k,1507) - lu(k,1093) * lu(k,1487) + lu(k,1509) = lu(k,1509) - lu(k,1094) * lu(k,1487) + lu(k,1511) = lu(k,1511) - lu(k,1095) * lu(k,1487) + lu(k,1518) = lu(k,1518) - lu(k,1084) * lu(k,1517) + lu(k,1520) = - lu(k,1085) * lu(k,1517) + lu(k,1523) = lu(k,1523) - lu(k,1086) * lu(k,1517) + lu(k,1524) = lu(k,1524) - lu(k,1087) * lu(k,1517) + lu(k,1526) = lu(k,1526) - lu(k,1088) * lu(k,1517) + lu(k,1527) = lu(k,1527) - lu(k,1089) * lu(k,1517) + lu(k,1528) = lu(k,1528) - lu(k,1090) * lu(k,1517) + lu(k,1529) = lu(k,1529) - lu(k,1091) * lu(k,1517) + lu(k,1530) = - lu(k,1092) * lu(k,1517) + lu(k,1531) = lu(k,1531) - lu(k,1093) * lu(k,1517) + lu(k,1533) = lu(k,1533) - lu(k,1094) * lu(k,1517) + lu(k,1535) = lu(k,1535) - lu(k,1095) * lu(k,1517) + lu(k,1571) = lu(k,1571) - lu(k,1084) * lu(k,1570) + lu(k,1573) = lu(k,1573) - lu(k,1085) * lu(k,1570) + lu(k,1576) = lu(k,1576) - lu(k,1086) * lu(k,1570) + lu(k,1577) = lu(k,1577) - lu(k,1087) * lu(k,1570) + lu(k,1579) = lu(k,1579) - lu(k,1088) * lu(k,1570) + lu(k,1580) = lu(k,1580) - lu(k,1089) * lu(k,1570) + lu(k,1581) = lu(k,1581) - lu(k,1090) * lu(k,1570) + lu(k,1582) = lu(k,1582) - lu(k,1091) * lu(k,1570) + lu(k,1583) = lu(k,1583) - lu(k,1092) * lu(k,1570) + lu(k,1584) = lu(k,1584) - lu(k,1093) * lu(k,1570) + lu(k,1586) = lu(k,1586) - lu(k,1094) * lu(k,1570) + lu(k,1588) = lu(k,1588) - lu(k,1095) * lu(k,1570) + lu(k,1703) = lu(k,1703) - lu(k,1084) * lu(k,1702) + lu(k,1705) = - lu(k,1085) * lu(k,1702) + lu(k,1708) = lu(k,1708) - lu(k,1086) * lu(k,1702) + lu(k,1709) = lu(k,1709) - lu(k,1087) * lu(k,1702) + lu(k,1711) = lu(k,1711) - lu(k,1088) * lu(k,1702) + lu(k,1712) = lu(k,1712) - lu(k,1089) * lu(k,1702) + lu(k,1713) = lu(k,1713) - lu(k,1090) * lu(k,1702) + lu(k,1714) = lu(k,1714) - lu(k,1091) * lu(k,1702) + lu(k,1715) = - lu(k,1092) * lu(k,1702) + lu(k,1716) = lu(k,1716) - lu(k,1093) * lu(k,1702) + lu(k,1718) = lu(k,1718) - lu(k,1094) * lu(k,1702) + lu(k,1720) = lu(k,1720) - lu(k,1095) * lu(k,1702) + lu(k,1853) = lu(k,1853) - lu(k,1084) * lu(k,1846) + lu(k,1855) = lu(k,1855) - lu(k,1085) * lu(k,1846) + lu(k,1858) = lu(k,1858) - lu(k,1086) * lu(k,1846) + lu(k,1859) = lu(k,1859) - lu(k,1087) * lu(k,1846) + lu(k,1861) = lu(k,1861) - lu(k,1088) * lu(k,1846) + lu(k,1862) = lu(k,1862) - lu(k,1089) * lu(k,1846) + lu(k,1863) = lu(k,1863) - lu(k,1090) * lu(k,1846) + lu(k,1864) = lu(k,1864) - lu(k,1091) * lu(k,1846) + lu(k,1865) = lu(k,1865) - lu(k,1092) * lu(k,1846) + lu(k,1866) = lu(k,1866) - lu(k,1093) * lu(k,1846) + lu(k,1868) = lu(k,1868) - lu(k,1094) * lu(k,1846) + lu(k,1870) = lu(k,1870) - lu(k,1095) * lu(k,1846) + lu(k,1894) = lu(k,1894) - lu(k,1084) * lu(k,1891) + lu(k,1896) = lu(k,1896) - lu(k,1085) * lu(k,1891) + lu(k,1899) = lu(k,1899) - lu(k,1086) * lu(k,1891) + lu(k,1900) = lu(k,1900) - lu(k,1087) * lu(k,1891) + lu(k,1902) = lu(k,1902) - lu(k,1088) * lu(k,1891) + lu(k,1903) = lu(k,1903) - lu(k,1089) * lu(k,1891) + lu(k,1904) = lu(k,1904) - lu(k,1090) * lu(k,1891) + lu(k,1905) = lu(k,1905) - lu(k,1091) * lu(k,1891) + lu(k,1906) = lu(k,1906) - lu(k,1092) * lu(k,1891) + lu(k,1907) = lu(k,1907) - lu(k,1093) * lu(k,1891) + lu(k,1909) = lu(k,1909) - lu(k,1094) * lu(k,1891) + lu(k,1911) = lu(k,1911) - lu(k,1095) * lu(k,1891) + lu(k,2008) = - lu(k,1084) * lu(k,2001) + lu(k,2010) = lu(k,2010) - lu(k,1085) * lu(k,2001) + lu(k,2013) = lu(k,2013) - lu(k,1086) * lu(k,2001) + lu(k,2014) = - lu(k,1087) * lu(k,2001) + lu(k,2016) = lu(k,2016) - lu(k,1088) * lu(k,2001) + lu(k,2017) = lu(k,2017) - lu(k,1089) * lu(k,2001) + lu(k,2018) = - lu(k,1090) * lu(k,2001) + lu(k,2019) = lu(k,2019) - lu(k,1091) * lu(k,2001) + lu(k,2020) = lu(k,2020) - lu(k,1092) * lu(k,2001) + lu(k,2021) = lu(k,2021) - lu(k,1093) * lu(k,2001) + lu(k,2023) = - lu(k,1094) * lu(k,2001) + lu(k,2025) = lu(k,2025) - lu(k,1095) * lu(k,2001) + lu(k,2033) = - lu(k,1084) * lu(k,2032) + lu(k,2035) = lu(k,2035) - lu(k,1085) * lu(k,2032) + lu(k,2038) = lu(k,2038) - lu(k,1086) * lu(k,2032) + lu(k,2039) = - lu(k,1087) * lu(k,2032) + lu(k,2041) = lu(k,2041) - lu(k,1088) * lu(k,2032) + lu(k,2042) = lu(k,2042) - lu(k,1089) * lu(k,2032) + lu(k,2043) = - lu(k,1090) * lu(k,2032) + lu(k,2044) = - lu(k,1091) * lu(k,2032) + lu(k,2045) = - lu(k,1092) * lu(k,2032) + lu(k,2046) = - lu(k,1093) * lu(k,2032) + lu(k,2048) = lu(k,2048) - lu(k,1094) * lu(k,2032) + lu(k,2050) = lu(k,2050) - lu(k,1095) * lu(k,2032) + end do + end subroutine lu_fac22 + subroutine lu_fac23( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,1113) = 1._r8 / lu(k,1113) + lu(k,1114) = lu(k,1114) * lu(k,1113) + lu(k,1115) = lu(k,1115) * lu(k,1113) + lu(k,1116) = lu(k,1116) * lu(k,1113) + lu(k,1117) = lu(k,1117) * lu(k,1113) + lu(k,1118) = lu(k,1118) * lu(k,1113) + lu(k,1119) = lu(k,1119) * lu(k,1113) + lu(k,1120) = lu(k,1120) * lu(k,1113) + lu(k,1121) = lu(k,1121) * lu(k,1113) + lu(k,1122) = lu(k,1122) * lu(k,1113) + lu(k,1123) = lu(k,1123) * lu(k,1113) + lu(k,1124) = lu(k,1124) * lu(k,1113) + lu(k,1125) = lu(k,1125) * lu(k,1113) + lu(k,1126) = lu(k,1126) * lu(k,1113) + lu(k,1127) = lu(k,1127) * lu(k,1113) + lu(k,1128) = lu(k,1128) * lu(k,1113) + lu(k,1229) = lu(k,1229) - lu(k,1114) * lu(k,1228) + lu(k,1230) = lu(k,1230) - lu(k,1115) * lu(k,1228) + lu(k,1232) = lu(k,1232) - lu(k,1116) * lu(k,1228) + lu(k,1233) = lu(k,1233) - lu(k,1117) * lu(k,1228) + lu(k,1234) = lu(k,1234) - lu(k,1118) * lu(k,1228) + lu(k,1235) = lu(k,1235) - lu(k,1119) * lu(k,1228) + lu(k,1236) = lu(k,1236) - lu(k,1120) * lu(k,1228) + lu(k,1237) = lu(k,1237) - lu(k,1121) * lu(k,1228) + lu(k,1238) = lu(k,1238) - lu(k,1122) * lu(k,1228) + lu(k,1239) = lu(k,1239) - lu(k,1123) * lu(k,1228) + lu(k,1240) = lu(k,1240) - lu(k,1124) * lu(k,1228) + lu(k,1241) = lu(k,1241) - lu(k,1125) * lu(k,1228) + lu(k,1242) = lu(k,1242) - lu(k,1126) * lu(k,1228) + lu(k,1243) = lu(k,1243) - lu(k,1127) * lu(k,1228) + lu(k,1244) = lu(k,1244) - lu(k,1128) * lu(k,1228) + lu(k,1313) = lu(k,1313) - lu(k,1114) * lu(k,1312) + lu(k,1314) = lu(k,1314) - lu(k,1115) * lu(k,1312) + lu(k,1316) = lu(k,1316) - lu(k,1116) * lu(k,1312) + lu(k,1317) = lu(k,1317) - lu(k,1117) * lu(k,1312) + lu(k,1318) = lu(k,1318) - lu(k,1118) * lu(k,1312) + lu(k,1319) = lu(k,1319) - lu(k,1119) * lu(k,1312) + lu(k,1320) = lu(k,1320) - lu(k,1120) * lu(k,1312) + lu(k,1322) = lu(k,1322) - lu(k,1121) * lu(k,1312) + lu(k,1323) = lu(k,1323) - lu(k,1122) * lu(k,1312) + lu(k,1325) = lu(k,1325) - lu(k,1123) * lu(k,1312) + lu(k,1327) = lu(k,1327) - lu(k,1124) * lu(k,1312) + lu(k,1328) = lu(k,1328) - lu(k,1125) * lu(k,1312) + lu(k,1329) = lu(k,1329) - lu(k,1126) * lu(k,1312) + lu(k,1332) = lu(k,1332) - lu(k,1127) * lu(k,1312) + lu(k,1333) = lu(k,1333) - lu(k,1128) * lu(k,1312) + lu(k,1489) = lu(k,1489) - lu(k,1114) * lu(k,1488) + lu(k,1490) = lu(k,1490) - lu(k,1115) * lu(k,1488) + lu(k,1492) = lu(k,1492) - lu(k,1116) * lu(k,1488) + lu(k,1493) = lu(k,1493) - lu(k,1117) * lu(k,1488) + lu(k,1495) = lu(k,1495) - lu(k,1118) * lu(k,1488) + lu(k,1496) = lu(k,1496) - lu(k,1119) * lu(k,1488) + lu(k,1497) = lu(k,1497) - lu(k,1120) * lu(k,1488) + lu(k,1499) = lu(k,1499) - lu(k,1121) * lu(k,1488) + lu(k,1501) = lu(k,1501) - lu(k,1122) * lu(k,1488) + lu(k,1503) = lu(k,1503) - lu(k,1123) * lu(k,1488) + lu(k,1505) = lu(k,1505) - lu(k,1124) * lu(k,1488) + lu(k,1506) = lu(k,1506) - lu(k,1125) * lu(k,1488) + lu(k,1507) = lu(k,1507) - lu(k,1126) * lu(k,1488) + lu(k,1510) = lu(k,1510) - lu(k,1127) * lu(k,1488) + lu(k,1511) = lu(k,1511) - lu(k,1128) * lu(k,1488) + lu(k,1672) = lu(k,1672) - lu(k,1114) * lu(k,1671) + lu(k,1673) = lu(k,1673) - lu(k,1115) * lu(k,1671) + lu(k,1675) = lu(k,1675) - lu(k,1116) * lu(k,1671) + lu(k,1676) = lu(k,1676) - lu(k,1117) * lu(k,1671) + lu(k,1678) = lu(k,1678) - lu(k,1118) * lu(k,1671) + lu(k,1679) = lu(k,1679) - lu(k,1119) * lu(k,1671) + lu(k,1680) = lu(k,1680) - lu(k,1120) * lu(k,1671) + lu(k,1682) = lu(k,1682) - lu(k,1121) * lu(k,1671) + lu(k,1684) = lu(k,1684) - lu(k,1122) * lu(k,1671) + lu(k,1686) = lu(k,1686) - lu(k,1123) * lu(k,1671) + lu(k,1688) = lu(k,1688) - lu(k,1124) * lu(k,1671) + lu(k,1689) = lu(k,1689) - lu(k,1125) * lu(k,1671) + lu(k,1690) = lu(k,1690) - lu(k,1126) * lu(k,1671) + lu(k,1693) = lu(k,1693) - lu(k,1127) * lu(k,1671) + lu(k,1694) = lu(k,1694) - lu(k,1128) * lu(k,1671) + lu(k,1788) = lu(k,1788) - lu(k,1114) * lu(k,1787) + lu(k,1789) = lu(k,1789) - lu(k,1115) * lu(k,1787) + lu(k,1791) = lu(k,1791) - lu(k,1116) * lu(k,1787) + lu(k,1792) = lu(k,1792) - lu(k,1117) * lu(k,1787) + lu(k,1794) = lu(k,1794) - lu(k,1118) * lu(k,1787) + lu(k,1795) = lu(k,1795) - lu(k,1119) * lu(k,1787) + lu(k,1796) = lu(k,1796) - lu(k,1120) * lu(k,1787) + lu(k,1798) = lu(k,1798) - lu(k,1121) * lu(k,1787) + lu(k,1800) = lu(k,1800) - lu(k,1122) * lu(k,1787) + lu(k,1802) = lu(k,1802) - lu(k,1123) * lu(k,1787) + lu(k,1804) = lu(k,1804) - lu(k,1124) * lu(k,1787) + lu(k,1805) = lu(k,1805) - lu(k,1125) * lu(k,1787) + lu(k,1806) = lu(k,1806) - lu(k,1126) * lu(k,1787) + lu(k,1809) = lu(k,1809) - lu(k,1127) * lu(k,1787) + lu(k,1810) = lu(k,1810) - lu(k,1128) * lu(k,1787) + lu(k,1848) = lu(k,1848) - lu(k,1114) * lu(k,1847) + lu(k,1849) = lu(k,1849) - lu(k,1115) * lu(k,1847) + lu(k,1851) = lu(k,1851) - lu(k,1116) * lu(k,1847) + lu(k,1852) = lu(k,1852) - lu(k,1117) * lu(k,1847) + lu(k,1854) = lu(k,1854) - lu(k,1118) * lu(k,1847) + lu(k,1855) = lu(k,1855) - lu(k,1119) * lu(k,1847) + lu(k,1856) = lu(k,1856) - lu(k,1120) * lu(k,1847) + lu(k,1858) = lu(k,1858) - lu(k,1121) * lu(k,1847) + lu(k,1860) = lu(k,1860) - lu(k,1122) * lu(k,1847) + lu(k,1862) = lu(k,1862) - lu(k,1123) * lu(k,1847) + lu(k,1864) = lu(k,1864) - lu(k,1124) * lu(k,1847) + lu(k,1865) = lu(k,1865) - lu(k,1125) * lu(k,1847) + lu(k,1866) = lu(k,1866) - lu(k,1126) * lu(k,1847) + lu(k,1869) = lu(k,1869) - lu(k,1127) * lu(k,1847) + lu(k,1870) = lu(k,1870) - lu(k,1128) * lu(k,1847) + lu(k,2003) = lu(k,2003) - lu(k,1114) * lu(k,2002) + lu(k,2004) = lu(k,2004) - lu(k,1115) * lu(k,2002) + lu(k,2006) = lu(k,2006) - lu(k,1116) * lu(k,2002) + lu(k,2007) = lu(k,2007) - lu(k,1117) * lu(k,2002) + lu(k,2009) = lu(k,2009) - lu(k,1118) * lu(k,2002) + lu(k,2010) = lu(k,2010) - lu(k,1119) * lu(k,2002) + lu(k,2011) = lu(k,2011) - lu(k,1120) * lu(k,2002) + lu(k,2013) = lu(k,2013) - lu(k,1121) * lu(k,2002) + lu(k,2015) = lu(k,2015) - lu(k,1122) * lu(k,2002) + lu(k,2017) = lu(k,2017) - lu(k,1123) * lu(k,2002) + lu(k,2019) = lu(k,2019) - lu(k,1124) * lu(k,2002) + lu(k,2020) = lu(k,2020) - lu(k,1125) * lu(k,2002) + lu(k,2021) = lu(k,2021) - lu(k,1126) * lu(k,2002) + lu(k,2024) = lu(k,2024) - lu(k,1127) * lu(k,2002) + lu(k,2025) = lu(k,2025) - lu(k,1128) * lu(k,2002) + lu(k,1135) = 1._r8 / lu(k,1135) + lu(k,1136) = lu(k,1136) * lu(k,1135) + lu(k,1137) = lu(k,1137) * lu(k,1135) + lu(k,1138) = lu(k,1138) * lu(k,1135) + lu(k,1139) = lu(k,1139) * lu(k,1135) + lu(k,1140) = lu(k,1140) * lu(k,1135) + lu(k,1141) = lu(k,1141) * lu(k,1135) + lu(k,1142) = lu(k,1142) * lu(k,1135) + lu(k,1143) = lu(k,1143) * lu(k,1135) + lu(k,1144) = lu(k,1144) * lu(k,1135) + lu(k,1145) = lu(k,1145) * lu(k,1135) + lu(k,1146) = lu(k,1146) * lu(k,1135) + lu(k,1147) = lu(k,1147) * lu(k,1135) + lu(k,1148) = lu(k,1148) * lu(k,1135) + lu(k,1182) = lu(k,1182) - lu(k,1136) * lu(k,1181) + lu(k,1185) = lu(k,1185) - lu(k,1137) * lu(k,1181) + lu(k,1186) = lu(k,1186) - lu(k,1138) * lu(k,1181) + lu(k,1187) = lu(k,1187) - lu(k,1139) * lu(k,1181) + lu(k,1188) = lu(k,1188) - lu(k,1140) * lu(k,1181) + lu(k,1189) = lu(k,1189) - lu(k,1141) * lu(k,1181) + lu(k,1190) = lu(k,1190) - lu(k,1142) * lu(k,1181) + lu(k,1191) = lu(k,1191) - lu(k,1143) * lu(k,1181) + lu(k,1192) = lu(k,1192) - lu(k,1144) * lu(k,1181) + lu(k,1193) = lu(k,1193) - lu(k,1145) * lu(k,1181) + lu(k,1194) = lu(k,1194) - lu(k,1146) * lu(k,1181) + lu(k,1195) = lu(k,1195) - lu(k,1147) * lu(k,1181) + lu(k,1196) = lu(k,1196) - lu(k,1148) * lu(k,1181) + lu(k,1230) = lu(k,1230) - lu(k,1136) * lu(k,1229) + lu(k,1233) = lu(k,1233) - lu(k,1137) * lu(k,1229) + lu(k,1234) = lu(k,1234) - lu(k,1138) * lu(k,1229) + lu(k,1235) = lu(k,1235) - lu(k,1139) * lu(k,1229) + lu(k,1236) = lu(k,1236) - lu(k,1140) * lu(k,1229) + lu(k,1237) = lu(k,1237) - lu(k,1141) * lu(k,1229) + lu(k,1238) = lu(k,1238) - lu(k,1142) * lu(k,1229) + lu(k,1239) = lu(k,1239) - lu(k,1143) * lu(k,1229) + lu(k,1240) = lu(k,1240) - lu(k,1144) * lu(k,1229) + lu(k,1241) = lu(k,1241) - lu(k,1145) * lu(k,1229) + lu(k,1242) = lu(k,1242) - lu(k,1146) * lu(k,1229) + lu(k,1243) = lu(k,1243) - lu(k,1147) * lu(k,1229) + lu(k,1244) = lu(k,1244) - lu(k,1148) * lu(k,1229) + lu(k,1314) = lu(k,1314) - lu(k,1136) * lu(k,1313) + lu(k,1317) = lu(k,1317) - lu(k,1137) * lu(k,1313) + lu(k,1318) = lu(k,1318) - lu(k,1138) * lu(k,1313) + lu(k,1319) = lu(k,1319) - lu(k,1139) * lu(k,1313) + lu(k,1320) = lu(k,1320) - lu(k,1140) * lu(k,1313) + lu(k,1322) = lu(k,1322) - lu(k,1141) * lu(k,1313) + lu(k,1323) = lu(k,1323) - lu(k,1142) * lu(k,1313) + lu(k,1325) = lu(k,1325) - lu(k,1143) * lu(k,1313) + lu(k,1327) = lu(k,1327) - lu(k,1144) * lu(k,1313) + lu(k,1328) = lu(k,1328) - lu(k,1145) * lu(k,1313) + lu(k,1329) = lu(k,1329) - lu(k,1146) * lu(k,1313) + lu(k,1332) = lu(k,1332) - lu(k,1147) * lu(k,1313) + lu(k,1333) = lu(k,1333) - lu(k,1148) * lu(k,1313) + lu(k,1490) = lu(k,1490) - lu(k,1136) * lu(k,1489) + lu(k,1493) = lu(k,1493) - lu(k,1137) * lu(k,1489) + lu(k,1495) = lu(k,1495) - lu(k,1138) * lu(k,1489) + lu(k,1496) = lu(k,1496) - lu(k,1139) * lu(k,1489) + lu(k,1497) = lu(k,1497) - lu(k,1140) * lu(k,1489) + lu(k,1499) = lu(k,1499) - lu(k,1141) * lu(k,1489) + lu(k,1501) = lu(k,1501) - lu(k,1142) * lu(k,1489) + lu(k,1503) = lu(k,1503) - lu(k,1143) * lu(k,1489) + lu(k,1505) = lu(k,1505) - lu(k,1144) * lu(k,1489) + lu(k,1506) = lu(k,1506) - lu(k,1145) * lu(k,1489) + lu(k,1507) = lu(k,1507) - lu(k,1146) * lu(k,1489) + lu(k,1510) = lu(k,1510) - lu(k,1147) * lu(k,1489) + lu(k,1511) = lu(k,1511) - lu(k,1148) * lu(k,1489) + lu(k,1673) = lu(k,1673) - lu(k,1136) * lu(k,1672) + lu(k,1676) = lu(k,1676) - lu(k,1137) * lu(k,1672) + lu(k,1678) = lu(k,1678) - lu(k,1138) * lu(k,1672) + lu(k,1679) = lu(k,1679) - lu(k,1139) * lu(k,1672) + lu(k,1680) = lu(k,1680) - lu(k,1140) * lu(k,1672) + lu(k,1682) = lu(k,1682) - lu(k,1141) * lu(k,1672) + lu(k,1684) = lu(k,1684) - lu(k,1142) * lu(k,1672) + lu(k,1686) = lu(k,1686) - lu(k,1143) * lu(k,1672) + lu(k,1688) = lu(k,1688) - lu(k,1144) * lu(k,1672) + lu(k,1689) = lu(k,1689) - lu(k,1145) * lu(k,1672) + lu(k,1690) = lu(k,1690) - lu(k,1146) * lu(k,1672) + lu(k,1693) = lu(k,1693) - lu(k,1147) * lu(k,1672) + lu(k,1694) = lu(k,1694) - lu(k,1148) * lu(k,1672) + lu(k,1789) = lu(k,1789) - lu(k,1136) * lu(k,1788) + lu(k,1792) = lu(k,1792) - lu(k,1137) * lu(k,1788) + lu(k,1794) = lu(k,1794) - lu(k,1138) * lu(k,1788) + lu(k,1795) = lu(k,1795) - lu(k,1139) * lu(k,1788) + lu(k,1796) = lu(k,1796) - lu(k,1140) * lu(k,1788) + lu(k,1798) = lu(k,1798) - lu(k,1141) * lu(k,1788) + lu(k,1800) = lu(k,1800) - lu(k,1142) * lu(k,1788) + lu(k,1802) = lu(k,1802) - lu(k,1143) * lu(k,1788) + lu(k,1804) = lu(k,1804) - lu(k,1144) * lu(k,1788) + lu(k,1805) = lu(k,1805) - lu(k,1145) * lu(k,1788) + lu(k,1806) = lu(k,1806) - lu(k,1146) * lu(k,1788) + lu(k,1809) = lu(k,1809) - lu(k,1147) * lu(k,1788) + lu(k,1810) = lu(k,1810) - lu(k,1148) * lu(k,1788) + lu(k,1849) = lu(k,1849) - lu(k,1136) * lu(k,1848) + lu(k,1852) = lu(k,1852) - lu(k,1137) * lu(k,1848) + lu(k,1854) = lu(k,1854) - lu(k,1138) * lu(k,1848) + lu(k,1855) = lu(k,1855) - lu(k,1139) * lu(k,1848) + lu(k,1856) = lu(k,1856) - lu(k,1140) * lu(k,1848) + lu(k,1858) = lu(k,1858) - lu(k,1141) * lu(k,1848) + lu(k,1860) = lu(k,1860) - lu(k,1142) * lu(k,1848) + lu(k,1862) = lu(k,1862) - lu(k,1143) * lu(k,1848) + lu(k,1864) = lu(k,1864) - lu(k,1144) * lu(k,1848) + lu(k,1865) = lu(k,1865) - lu(k,1145) * lu(k,1848) + lu(k,1866) = lu(k,1866) - lu(k,1146) * lu(k,1848) + lu(k,1869) = lu(k,1869) - lu(k,1147) * lu(k,1848) + lu(k,1870) = lu(k,1870) - lu(k,1148) * lu(k,1848) + lu(k,2004) = lu(k,2004) - lu(k,1136) * lu(k,2003) + lu(k,2007) = lu(k,2007) - lu(k,1137) * lu(k,2003) + lu(k,2009) = lu(k,2009) - lu(k,1138) * lu(k,2003) + lu(k,2010) = lu(k,2010) - lu(k,1139) * lu(k,2003) + lu(k,2011) = lu(k,2011) - lu(k,1140) * lu(k,2003) + lu(k,2013) = lu(k,2013) - lu(k,1141) * lu(k,2003) + lu(k,2015) = lu(k,2015) - lu(k,1142) * lu(k,2003) + lu(k,2017) = lu(k,2017) - lu(k,1143) * lu(k,2003) + lu(k,2019) = lu(k,2019) - lu(k,1144) * lu(k,2003) + lu(k,2020) = lu(k,2020) - lu(k,1145) * lu(k,2003) + lu(k,2021) = lu(k,2021) - lu(k,1146) * lu(k,2003) + lu(k,2024) = lu(k,2024) - lu(k,1147) * lu(k,2003) + lu(k,2025) = lu(k,2025) - lu(k,1148) * lu(k,2003) + lu(k,1157) = 1._r8 / lu(k,1157) + lu(k,1158) = lu(k,1158) * lu(k,1157) + lu(k,1159) = lu(k,1159) * lu(k,1157) + lu(k,1160) = lu(k,1160) * lu(k,1157) + lu(k,1161) = lu(k,1161) * lu(k,1157) + lu(k,1162) = lu(k,1162) * lu(k,1157) + lu(k,1163) = lu(k,1163) * lu(k,1157) + lu(k,1164) = lu(k,1164) * lu(k,1157) + lu(k,1165) = lu(k,1165) * lu(k,1157) + lu(k,1166) = lu(k,1166) * lu(k,1157) + lu(k,1167) = lu(k,1167) * lu(k,1157) + lu(k,1168) = lu(k,1168) * lu(k,1157) + lu(k,1169) = lu(k,1169) * lu(k,1157) + lu(k,1184) = lu(k,1184) - lu(k,1158) * lu(k,1182) + lu(k,1185) = lu(k,1185) - lu(k,1159) * lu(k,1182) + lu(k,1186) = lu(k,1186) - lu(k,1160) * lu(k,1182) + lu(k,1187) = lu(k,1187) - lu(k,1161) * lu(k,1182) + lu(k,1188) = lu(k,1188) - lu(k,1162) * lu(k,1182) + lu(k,1189) = lu(k,1189) - lu(k,1163) * lu(k,1182) + lu(k,1190) = lu(k,1190) - lu(k,1164) * lu(k,1182) + lu(k,1191) = lu(k,1191) - lu(k,1165) * lu(k,1182) + lu(k,1192) = lu(k,1192) - lu(k,1166) * lu(k,1182) + lu(k,1194) = lu(k,1194) - lu(k,1167) * lu(k,1182) + lu(k,1195) = lu(k,1195) - lu(k,1168) * lu(k,1182) + lu(k,1196) = lu(k,1196) - lu(k,1169) * lu(k,1182) + lu(k,1232) = lu(k,1232) - lu(k,1158) * lu(k,1230) + lu(k,1233) = lu(k,1233) - lu(k,1159) * lu(k,1230) + lu(k,1234) = lu(k,1234) - lu(k,1160) * lu(k,1230) + lu(k,1235) = lu(k,1235) - lu(k,1161) * lu(k,1230) + lu(k,1236) = lu(k,1236) - lu(k,1162) * lu(k,1230) + lu(k,1237) = lu(k,1237) - lu(k,1163) * lu(k,1230) + lu(k,1238) = lu(k,1238) - lu(k,1164) * lu(k,1230) + lu(k,1239) = lu(k,1239) - lu(k,1165) * lu(k,1230) + lu(k,1240) = lu(k,1240) - lu(k,1166) * lu(k,1230) + lu(k,1242) = lu(k,1242) - lu(k,1167) * lu(k,1230) + lu(k,1243) = lu(k,1243) - lu(k,1168) * lu(k,1230) + lu(k,1244) = lu(k,1244) - lu(k,1169) * lu(k,1230) + lu(k,1316) = lu(k,1316) - lu(k,1158) * lu(k,1314) + lu(k,1317) = lu(k,1317) - lu(k,1159) * lu(k,1314) + lu(k,1318) = lu(k,1318) - lu(k,1160) * lu(k,1314) + lu(k,1319) = lu(k,1319) - lu(k,1161) * lu(k,1314) + lu(k,1320) = lu(k,1320) - lu(k,1162) * lu(k,1314) + lu(k,1322) = lu(k,1322) - lu(k,1163) * lu(k,1314) + lu(k,1323) = lu(k,1323) - lu(k,1164) * lu(k,1314) + lu(k,1325) = lu(k,1325) - lu(k,1165) * lu(k,1314) + lu(k,1327) = lu(k,1327) - lu(k,1166) * lu(k,1314) + lu(k,1329) = lu(k,1329) - lu(k,1167) * lu(k,1314) + lu(k,1332) = lu(k,1332) - lu(k,1168) * lu(k,1314) + lu(k,1333) = lu(k,1333) - lu(k,1169) * lu(k,1314) + lu(k,1492) = lu(k,1492) - lu(k,1158) * lu(k,1490) + lu(k,1493) = lu(k,1493) - lu(k,1159) * lu(k,1490) + lu(k,1495) = lu(k,1495) - lu(k,1160) * lu(k,1490) + lu(k,1496) = lu(k,1496) - lu(k,1161) * lu(k,1490) + lu(k,1497) = lu(k,1497) - lu(k,1162) * lu(k,1490) + lu(k,1499) = lu(k,1499) - lu(k,1163) * lu(k,1490) + lu(k,1501) = lu(k,1501) - lu(k,1164) * lu(k,1490) + lu(k,1503) = lu(k,1503) - lu(k,1165) * lu(k,1490) + lu(k,1505) = lu(k,1505) - lu(k,1166) * lu(k,1490) + lu(k,1507) = lu(k,1507) - lu(k,1167) * lu(k,1490) + lu(k,1510) = lu(k,1510) - lu(k,1168) * lu(k,1490) + lu(k,1511) = lu(k,1511) - lu(k,1169) * lu(k,1490) + lu(k,1675) = lu(k,1675) - lu(k,1158) * lu(k,1673) + lu(k,1676) = lu(k,1676) - lu(k,1159) * lu(k,1673) + lu(k,1678) = lu(k,1678) - lu(k,1160) * lu(k,1673) + lu(k,1679) = lu(k,1679) - lu(k,1161) * lu(k,1673) + lu(k,1680) = lu(k,1680) - lu(k,1162) * lu(k,1673) + lu(k,1682) = lu(k,1682) - lu(k,1163) * lu(k,1673) + lu(k,1684) = lu(k,1684) - lu(k,1164) * lu(k,1673) + lu(k,1686) = lu(k,1686) - lu(k,1165) * lu(k,1673) + lu(k,1688) = lu(k,1688) - lu(k,1166) * lu(k,1673) + lu(k,1690) = lu(k,1690) - lu(k,1167) * lu(k,1673) + lu(k,1693) = lu(k,1693) - lu(k,1168) * lu(k,1673) + lu(k,1694) = lu(k,1694) - lu(k,1169) * lu(k,1673) + lu(k,1791) = lu(k,1791) - lu(k,1158) * lu(k,1789) + lu(k,1792) = lu(k,1792) - lu(k,1159) * lu(k,1789) + lu(k,1794) = lu(k,1794) - lu(k,1160) * lu(k,1789) + lu(k,1795) = lu(k,1795) - lu(k,1161) * lu(k,1789) + lu(k,1796) = lu(k,1796) - lu(k,1162) * lu(k,1789) + lu(k,1798) = lu(k,1798) - lu(k,1163) * lu(k,1789) + lu(k,1800) = lu(k,1800) - lu(k,1164) * lu(k,1789) + lu(k,1802) = lu(k,1802) - lu(k,1165) * lu(k,1789) + lu(k,1804) = lu(k,1804) - lu(k,1166) * lu(k,1789) + lu(k,1806) = lu(k,1806) - lu(k,1167) * lu(k,1789) + lu(k,1809) = lu(k,1809) - lu(k,1168) * lu(k,1789) + lu(k,1810) = lu(k,1810) - lu(k,1169) * lu(k,1789) + lu(k,1851) = lu(k,1851) - lu(k,1158) * lu(k,1849) + lu(k,1852) = lu(k,1852) - lu(k,1159) * lu(k,1849) + lu(k,1854) = lu(k,1854) - lu(k,1160) * lu(k,1849) + lu(k,1855) = lu(k,1855) - lu(k,1161) * lu(k,1849) + lu(k,1856) = lu(k,1856) - lu(k,1162) * lu(k,1849) + lu(k,1858) = lu(k,1858) - lu(k,1163) * lu(k,1849) + lu(k,1860) = lu(k,1860) - lu(k,1164) * lu(k,1849) + lu(k,1862) = lu(k,1862) - lu(k,1165) * lu(k,1849) + lu(k,1864) = lu(k,1864) - lu(k,1166) * lu(k,1849) + lu(k,1866) = lu(k,1866) - lu(k,1167) * lu(k,1849) + lu(k,1869) = lu(k,1869) - lu(k,1168) * lu(k,1849) + lu(k,1870) = lu(k,1870) - lu(k,1169) * lu(k,1849) + lu(k,2006) = lu(k,2006) - lu(k,1158) * lu(k,2004) + lu(k,2007) = lu(k,2007) - lu(k,1159) * lu(k,2004) + lu(k,2009) = lu(k,2009) - lu(k,1160) * lu(k,2004) + lu(k,2010) = lu(k,2010) - lu(k,1161) * lu(k,2004) + lu(k,2011) = lu(k,2011) - lu(k,1162) * lu(k,2004) + lu(k,2013) = lu(k,2013) - lu(k,1163) * lu(k,2004) + lu(k,2015) = lu(k,2015) - lu(k,1164) * lu(k,2004) + lu(k,2017) = lu(k,2017) - lu(k,1165) * lu(k,2004) + lu(k,2019) = lu(k,2019) - lu(k,1166) * lu(k,2004) + lu(k,2021) = lu(k,2021) - lu(k,1167) * lu(k,2004) + lu(k,2024) = lu(k,2024) - lu(k,1168) * lu(k,2004) + lu(k,2025) = lu(k,2025) - lu(k,1169) * lu(k,2004) + lu(k,1183) = 1._r8 / lu(k,1183) + lu(k,1184) = lu(k,1184) * lu(k,1183) + lu(k,1185) = lu(k,1185) * lu(k,1183) + lu(k,1186) = lu(k,1186) * lu(k,1183) + lu(k,1187) = lu(k,1187) * lu(k,1183) + lu(k,1188) = lu(k,1188) * lu(k,1183) + lu(k,1189) = lu(k,1189) * lu(k,1183) + lu(k,1190) = lu(k,1190) * lu(k,1183) + lu(k,1191) = lu(k,1191) * lu(k,1183) + lu(k,1192) = lu(k,1192) * lu(k,1183) + lu(k,1193) = lu(k,1193) * lu(k,1183) + lu(k,1194) = lu(k,1194) * lu(k,1183) + lu(k,1195) = lu(k,1195) * lu(k,1183) + lu(k,1196) = lu(k,1196) * lu(k,1183) + lu(k,1232) = lu(k,1232) - lu(k,1184) * lu(k,1231) + lu(k,1233) = lu(k,1233) - lu(k,1185) * lu(k,1231) + lu(k,1234) = lu(k,1234) - lu(k,1186) * lu(k,1231) + lu(k,1235) = lu(k,1235) - lu(k,1187) * lu(k,1231) + lu(k,1236) = lu(k,1236) - lu(k,1188) * lu(k,1231) + lu(k,1237) = lu(k,1237) - lu(k,1189) * lu(k,1231) + lu(k,1238) = lu(k,1238) - lu(k,1190) * lu(k,1231) + lu(k,1239) = lu(k,1239) - lu(k,1191) * lu(k,1231) + lu(k,1240) = lu(k,1240) - lu(k,1192) * lu(k,1231) + lu(k,1241) = lu(k,1241) - lu(k,1193) * lu(k,1231) + lu(k,1242) = lu(k,1242) - lu(k,1194) * lu(k,1231) + lu(k,1243) = lu(k,1243) - lu(k,1195) * lu(k,1231) + lu(k,1244) = lu(k,1244) - lu(k,1196) * lu(k,1231) + lu(k,1316) = lu(k,1316) - lu(k,1184) * lu(k,1315) + lu(k,1317) = lu(k,1317) - lu(k,1185) * lu(k,1315) + lu(k,1318) = lu(k,1318) - lu(k,1186) * lu(k,1315) + lu(k,1319) = lu(k,1319) - lu(k,1187) * lu(k,1315) + lu(k,1320) = lu(k,1320) - lu(k,1188) * lu(k,1315) + lu(k,1322) = lu(k,1322) - lu(k,1189) * lu(k,1315) + lu(k,1323) = lu(k,1323) - lu(k,1190) * lu(k,1315) + lu(k,1325) = lu(k,1325) - lu(k,1191) * lu(k,1315) + lu(k,1327) = lu(k,1327) - lu(k,1192) * lu(k,1315) + lu(k,1328) = lu(k,1328) - lu(k,1193) * lu(k,1315) + lu(k,1329) = lu(k,1329) - lu(k,1194) * lu(k,1315) + lu(k,1332) = lu(k,1332) - lu(k,1195) * lu(k,1315) + lu(k,1333) = lu(k,1333) - lu(k,1196) * lu(k,1315) + lu(k,1492) = lu(k,1492) - lu(k,1184) * lu(k,1491) + lu(k,1493) = lu(k,1493) - lu(k,1185) * lu(k,1491) + lu(k,1495) = lu(k,1495) - lu(k,1186) * lu(k,1491) + lu(k,1496) = lu(k,1496) - lu(k,1187) * lu(k,1491) + lu(k,1497) = lu(k,1497) - lu(k,1188) * lu(k,1491) + lu(k,1499) = lu(k,1499) - lu(k,1189) * lu(k,1491) + lu(k,1501) = lu(k,1501) - lu(k,1190) * lu(k,1491) + lu(k,1503) = lu(k,1503) - lu(k,1191) * lu(k,1491) + lu(k,1505) = lu(k,1505) - lu(k,1192) * lu(k,1491) + lu(k,1506) = lu(k,1506) - lu(k,1193) * lu(k,1491) + lu(k,1507) = lu(k,1507) - lu(k,1194) * lu(k,1491) + lu(k,1510) = lu(k,1510) - lu(k,1195) * lu(k,1491) + lu(k,1511) = lu(k,1511) - lu(k,1196) * lu(k,1491) + lu(k,1675) = lu(k,1675) - lu(k,1184) * lu(k,1674) + lu(k,1676) = lu(k,1676) - lu(k,1185) * lu(k,1674) + lu(k,1678) = lu(k,1678) - lu(k,1186) * lu(k,1674) + lu(k,1679) = lu(k,1679) - lu(k,1187) * lu(k,1674) + lu(k,1680) = lu(k,1680) - lu(k,1188) * lu(k,1674) + lu(k,1682) = lu(k,1682) - lu(k,1189) * lu(k,1674) + lu(k,1684) = lu(k,1684) - lu(k,1190) * lu(k,1674) + lu(k,1686) = lu(k,1686) - lu(k,1191) * lu(k,1674) + lu(k,1688) = lu(k,1688) - lu(k,1192) * lu(k,1674) + lu(k,1689) = lu(k,1689) - lu(k,1193) * lu(k,1674) + lu(k,1690) = lu(k,1690) - lu(k,1194) * lu(k,1674) + lu(k,1693) = lu(k,1693) - lu(k,1195) * lu(k,1674) + lu(k,1694) = lu(k,1694) - lu(k,1196) * lu(k,1674) + lu(k,1791) = lu(k,1791) - lu(k,1184) * lu(k,1790) + lu(k,1792) = lu(k,1792) - lu(k,1185) * lu(k,1790) + lu(k,1794) = lu(k,1794) - lu(k,1186) * lu(k,1790) + lu(k,1795) = lu(k,1795) - lu(k,1187) * lu(k,1790) + lu(k,1796) = lu(k,1796) - lu(k,1188) * lu(k,1790) + lu(k,1798) = lu(k,1798) - lu(k,1189) * lu(k,1790) + lu(k,1800) = lu(k,1800) - lu(k,1190) * lu(k,1790) + lu(k,1802) = lu(k,1802) - lu(k,1191) * lu(k,1790) + lu(k,1804) = lu(k,1804) - lu(k,1192) * lu(k,1790) + lu(k,1805) = lu(k,1805) - lu(k,1193) * lu(k,1790) + lu(k,1806) = lu(k,1806) - lu(k,1194) * lu(k,1790) + lu(k,1809) = lu(k,1809) - lu(k,1195) * lu(k,1790) + lu(k,1810) = lu(k,1810) - lu(k,1196) * lu(k,1790) + lu(k,1851) = lu(k,1851) - lu(k,1184) * lu(k,1850) + lu(k,1852) = lu(k,1852) - lu(k,1185) * lu(k,1850) + lu(k,1854) = lu(k,1854) - lu(k,1186) * lu(k,1850) + lu(k,1855) = lu(k,1855) - lu(k,1187) * lu(k,1850) + lu(k,1856) = lu(k,1856) - lu(k,1188) * lu(k,1850) + lu(k,1858) = lu(k,1858) - lu(k,1189) * lu(k,1850) + lu(k,1860) = lu(k,1860) - lu(k,1190) * lu(k,1850) + lu(k,1862) = lu(k,1862) - lu(k,1191) * lu(k,1850) + lu(k,1864) = lu(k,1864) - lu(k,1192) * lu(k,1850) + lu(k,1865) = lu(k,1865) - lu(k,1193) * lu(k,1850) + lu(k,1866) = lu(k,1866) - lu(k,1194) * lu(k,1850) + lu(k,1869) = lu(k,1869) - lu(k,1195) * lu(k,1850) + lu(k,1870) = lu(k,1870) - lu(k,1196) * lu(k,1850) + lu(k,2006) = lu(k,2006) - lu(k,1184) * lu(k,2005) + lu(k,2007) = lu(k,2007) - lu(k,1185) * lu(k,2005) + lu(k,2009) = lu(k,2009) - lu(k,1186) * lu(k,2005) + lu(k,2010) = lu(k,2010) - lu(k,1187) * lu(k,2005) + lu(k,2011) = lu(k,2011) - lu(k,1188) * lu(k,2005) + lu(k,2013) = lu(k,2013) - lu(k,1189) * lu(k,2005) + lu(k,2015) = lu(k,2015) - lu(k,1190) * lu(k,2005) + lu(k,2017) = lu(k,2017) - lu(k,1191) * lu(k,2005) + lu(k,2019) = lu(k,2019) - lu(k,1192) * lu(k,2005) + lu(k,2020) = lu(k,2020) - lu(k,1193) * lu(k,2005) + lu(k,2021) = lu(k,2021) - lu(k,1194) * lu(k,2005) + lu(k,2024) = lu(k,2024) - lu(k,1195) * lu(k,2005) + lu(k,2025) = lu(k,2025) - lu(k,1196) * lu(k,2005) + end do + end subroutine lu_fac23 + subroutine lu_fac24( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,1202) = 1._r8 / lu(k,1202) + lu(k,1203) = lu(k,1203) * lu(k,1202) + lu(k,1204) = lu(k,1204) * lu(k,1202) + lu(k,1205) = lu(k,1205) * lu(k,1202) + lu(k,1206) = lu(k,1206) * lu(k,1202) + lu(k,1207) = lu(k,1207) * lu(k,1202) + lu(k,1208) = lu(k,1208) * lu(k,1202) + lu(k,1209) = lu(k,1209) * lu(k,1202) + lu(k,1210) = lu(k,1210) * lu(k,1202) + lu(k,1211) = lu(k,1211) * lu(k,1202) + lu(k,1212) = lu(k,1212) * lu(k,1202) + lu(k,1213) = lu(k,1213) * lu(k,1202) + lu(k,1214) = lu(k,1214) * lu(k,1202) + lu(k,1233) = lu(k,1233) - lu(k,1203) * lu(k,1232) + lu(k,1234) = lu(k,1234) - lu(k,1204) * lu(k,1232) + lu(k,1235) = lu(k,1235) - lu(k,1205) * lu(k,1232) + lu(k,1236) = lu(k,1236) - lu(k,1206) * lu(k,1232) + lu(k,1237) = lu(k,1237) - lu(k,1207) * lu(k,1232) + lu(k,1238) = lu(k,1238) - lu(k,1208) * lu(k,1232) + lu(k,1239) = lu(k,1239) - lu(k,1209) * lu(k,1232) + lu(k,1240) = lu(k,1240) - lu(k,1210) * lu(k,1232) + lu(k,1241) = lu(k,1241) - lu(k,1211) * lu(k,1232) + lu(k,1242) = lu(k,1242) - lu(k,1212) * lu(k,1232) + lu(k,1243) = lu(k,1243) - lu(k,1213) * lu(k,1232) + lu(k,1244) = lu(k,1244) - lu(k,1214) * lu(k,1232) + lu(k,1317) = lu(k,1317) - lu(k,1203) * lu(k,1316) + lu(k,1318) = lu(k,1318) - lu(k,1204) * lu(k,1316) + lu(k,1319) = lu(k,1319) - lu(k,1205) * lu(k,1316) + lu(k,1320) = lu(k,1320) - lu(k,1206) * lu(k,1316) + lu(k,1322) = lu(k,1322) - lu(k,1207) * lu(k,1316) + lu(k,1323) = lu(k,1323) - lu(k,1208) * lu(k,1316) + lu(k,1325) = lu(k,1325) - lu(k,1209) * lu(k,1316) + lu(k,1327) = lu(k,1327) - lu(k,1210) * lu(k,1316) + lu(k,1328) = lu(k,1328) - lu(k,1211) * lu(k,1316) + lu(k,1329) = lu(k,1329) - lu(k,1212) * lu(k,1316) + lu(k,1332) = lu(k,1332) - lu(k,1213) * lu(k,1316) + lu(k,1333) = lu(k,1333) - lu(k,1214) * lu(k,1316) + lu(k,1493) = lu(k,1493) - lu(k,1203) * lu(k,1492) + lu(k,1495) = lu(k,1495) - lu(k,1204) * lu(k,1492) + lu(k,1496) = lu(k,1496) - lu(k,1205) * lu(k,1492) + lu(k,1497) = lu(k,1497) - lu(k,1206) * lu(k,1492) + lu(k,1499) = lu(k,1499) - lu(k,1207) * lu(k,1492) + lu(k,1501) = lu(k,1501) - lu(k,1208) * lu(k,1492) + lu(k,1503) = lu(k,1503) - lu(k,1209) * lu(k,1492) + lu(k,1505) = lu(k,1505) - lu(k,1210) * lu(k,1492) + lu(k,1506) = lu(k,1506) - lu(k,1211) * lu(k,1492) + lu(k,1507) = lu(k,1507) - lu(k,1212) * lu(k,1492) + lu(k,1510) = lu(k,1510) - lu(k,1213) * lu(k,1492) + lu(k,1511) = lu(k,1511) - lu(k,1214) * lu(k,1492) + lu(k,1676) = lu(k,1676) - lu(k,1203) * lu(k,1675) + lu(k,1678) = lu(k,1678) - lu(k,1204) * lu(k,1675) + lu(k,1679) = lu(k,1679) - lu(k,1205) * lu(k,1675) + lu(k,1680) = lu(k,1680) - lu(k,1206) * lu(k,1675) + lu(k,1682) = lu(k,1682) - lu(k,1207) * lu(k,1675) + lu(k,1684) = lu(k,1684) - lu(k,1208) * lu(k,1675) + lu(k,1686) = lu(k,1686) - lu(k,1209) * lu(k,1675) + lu(k,1688) = lu(k,1688) - lu(k,1210) * lu(k,1675) + lu(k,1689) = lu(k,1689) - lu(k,1211) * lu(k,1675) + lu(k,1690) = lu(k,1690) - lu(k,1212) * lu(k,1675) + lu(k,1693) = lu(k,1693) - lu(k,1213) * lu(k,1675) + lu(k,1694) = lu(k,1694) - lu(k,1214) * lu(k,1675) + lu(k,1792) = lu(k,1792) - lu(k,1203) * lu(k,1791) + lu(k,1794) = lu(k,1794) - lu(k,1204) * lu(k,1791) + lu(k,1795) = lu(k,1795) - lu(k,1205) * lu(k,1791) + lu(k,1796) = lu(k,1796) - lu(k,1206) * lu(k,1791) + lu(k,1798) = lu(k,1798) - lu(k,1207) * lu(k,1791) + lu(k,1800) = lu(k,1800) - lu(k,1208) * lu(k,1791) + lu(k,1802) = lu(k,1802) - lu(k,1209) * lu(k,1791) + lu(k,1804) = lu(k,1804) - lu(k,1210) * lu(k,1791) + lu(k,1805) = lu(k,1805) - lu(k,1211) * lu(k,1791) + lu(k,1806) = lu(k,1806) - lu(k,1212) * lu(k,1791) + lu(k,1809) = lu(k,1809) - lu(k,1213) * lu(k,1791) + lu(k,1810) = lu(k,1810) - lu(k,1214) * lu(k,1791) + lu(k,1852) = lu(k,1852) - lu(k,1203) * lu(k,1851) + lu(k,1854) = lu(k,1854) - lu(k,1204) * lu(k,1851) + lu(k,1855) = lu(k,1855) - lu(k,1205) * lu(k,1851) + lu(k,1856) = lu(k,1856) - lu(k,1206) * lu(k,1851) + lu(k,1858) = lu(k,1858) - lu(k,1207) * lu(k,1851) + lu(k,1860) = lu(k,1860) - lu(k,1208) * lu(k,1851) + lu(k,1862) = lu(k,1862) - lu(k,1209) * lu(k,1851) + lu(k,1864) = lu(k,1864) - lu(k,1210) * lu(k,1851) + lu(k,1865) = lu(k,1865) - lu(k,1211) * lu(k,1851) + lu(k,1866) = lu(k,1866) - lu(k,1212) * lu(k,1851) + lu(k,1869) = lu(k,1869) - lu(k,1213) * lu(k,1851) + lu(k,1870) = lu(k,1870) - lu(k,1214) * lu(k,1851) + lu(k,1893) = lu(k,1893) - lu(k,1203) * lu(k,1892) + lu(k,1895) = lu(k,1895) - lu(k,1204) * lu(k,1892) + lu(k,1896) = lu(k,1896) - lu(k,1205) * lu(k,1892) + lu(k,1897) = lu(k,1897) - lu(k,1206) * lu(k,1892) + lu(k,1899) = lu(k,1899) - lu(k,1207) * lu(k,1892) + lu(k,1901) = lu(k,1901) - lu(k,1208) * lu(k,1892) + lu(k,1903) = lu(k,1903) - lu(k,1209) * lu(k,1892) + lu(k,1905) = lu(k,1905) - lu(k,1210) * lu(k,1892) + lu(k,1906) = lu(k,1906) - lu(k,1211) * lu(k,1892) + lu(k,1907) = lu(k,1907) - lu(k,1212) * lu(k,1892) + lu(k,1910) = lu(k,1910) - lu(k,1213) * lu(k,1892) + lu(k,1911) = lu(k,1911) - lu(k,1214) * lu(k,1892) + lu(k,2007) = lu(k,2007) - lu(k,1203) * lu(k,2006) + lu(k,2009) = lu(k,2009) - lu(k,1204) * lu(k,2006) + lu(k,2010) = lu(k,2010) - lu(k,1205) * lu(k,2006) + lu(k,2011) = lu(k,2011) - lu(k,1206) * lu(k,2006) + lu(k,2013) = lu(k,2013) - lu(k,1207) * lu(k,2006) + lu(k,2015) = lu(k,2015) - lu(k,1208) * lu(k,2006) + lu(k,2017) = lu(k,2017) - lu(k,1209) * lu(k,2006) + lu(k,2019) = lu(k,2019) - lu(k,1210) * lu(k,2006) + lu(k,2020) = lu(k,2020) - lu(k,1211) * lu(k,2006) + lu(k,2021) = lu(k,2021) - lu(k,1212) * lu(k,2006) + lu(k,2024) = lu(k,2024) - lu(k,1213) * lu(k,2006) + lu(k,2025) = lu(k,2025) - lu(k,1214) * lu(k,2006) + lu(k,1233) = 1._r8 / lu(k,1233) + lu(k,1234) = lu(k,1234) * lu(k,1233) + lu(k,1235) = lu(k,1235) * lu(k,1233) + lu(k,1236) = lu(k,1236) * lu(k,1233) + lu(k,1237) = lu(k,1237) * lu(k,1233) + lu(k,1238) = lu(k,1238) * lu(k,1233) + lu(k,1239) = lu(k,1239) * lu(k,1233) + lu(k,1240) = lu(k,1240) * lu(k,1233) + lu(k,1241) = lu(k,1241) * lu(k,1233) + lu(k,1242) = lu(k,1242) * lu(k,1233) + lu(k,1243) = lu(k,1243) * lu(k,1233) + lu(k,1244) = lu(k,1244) * lu(k,1233) + lu(k,1318) = lu(k,1318) - lu(k,1234) * lu(k,1317) + lu(k,1319) = lu(k,1319) - lu(k,1235) * lu(k,1317) + lu(k,1320) = lu(k,1320) - lu(k,1236) * lu(k,1317) + lu(k,1322) = lu(k,1322) - lu(k,1237) * lu(k,1317) + lu(k,1323) = lu(k,1323) - lu(k,1238) * lu(k,1317) + lu(k,1325) = lu(k,1325) - lu(k,1239) * lu(k,1317) + lu(k,1327) = lu(k,1327) - lu(k,1240) * lu(k,1317) + lu(k,1328) = lu(k,1328) - lu(k,1241) * lu(k,1317) + lu(k,1329) = lu(k,1329) - lu(k,1242) * lu(k,1317) + lu(k,1332) = lu(k,1332) - lu(k,1243) * lu(k,1317) + lu(k,1333) = lu(k,1333) - lu(k,1244) * lu(k,1317) + lu(k,1495) = lu(k,1495) - lu(k,1234) * lu(k,1493) + lu(k,1496) = lu(k,1496) - lu(k,1235) * lu(k,1493) + lu(k,1497) = lu(k,1497) - lu(k,1236) * lu(k,1493) + lu(k,1499) = lu(k,1499) - lu(k,1237) * lu(k,1493) + lu(k,1501) = lu(k,1501) - lu(k,1238) * lu(k,1493) + lu(k,1503) = lu(k,1503) - lu(k,1239) * lu(k,1493) + lu(k,1505) = lu(k,1505) - lu(k,1240) * lu(k,1493) + lu(k,1506) = lu(k,1506) - lu(k,1241) * lu(k,1493) + lu(k,1507) = lu(k,1507) - lu(k,1242) * lu(k,1493) + lu(k,1510) = lu(k,1510) - lu(k,1243) * lu(k,1493) + lu(k,1511) = lu(k,1511) - lu(k,1244) * lu(k,1493) + lu(k,1678) = lu(k,1678) - lu(k,1234) * lu(k,1676) + lu(k,1679) = lu(k,1679) - lu(k,1235) * lu(k,1676) + lu(k,1680) = lu(k,1680) - lu(k,1236) * lu(k,1676) + lu(k,1682) = lu(k,1682) - lu(k,1237) * lu(k,1676) + lu(k,1684) = lu(k,1684) - lu(k,1238) * lu(k,1676) + lu(k,1686) = lu(k,1686) - lu(k,1239) * lu(k,1676) + lu(k,1688) = lu(k,1688) - lu(k,1240) * lu(k,1676) + lu(k,1689) = lu(k,1689) - lu(k,1241) * lu(k,1676) + lu(k,1690) = lu(k,1690) - lu(k,1242) * lu(k,1676) + lu(k,1693) = lu(k,1693) - lu(k,1243) * lu(k,1676) + lu(k,1694) = lu(k,1694) - lu(k,1244) * lu(k,1676) + lu(k,1794) = lu(k,1794) - lu(k,1234) * lu(k,1792) + lu(k,1795) = lu(k,1795) - lu(k,1235) * lu(k,1792) + lu(k,1796) = lu(k,1796) - lu(k,1236) * lu(k,1792) + lu(k,1798) = lu(k,1798) - lu(k,1237) * lu(k,1792) + lu(k,1800) = lu(k,1800) - lu(k,1238) * lu(k,1792) + lu(k,1802) = lu(k,1802) - lu(k,1239) * lu(k,1792) + lu(k,1804) = lu(k,1804) - lu(k,1240) * lu(k,1792) + lu(k,1805) = lu(k,1805) - lu(k,1241) * lu(k,1792) + lu(k,1806) = lu(k,1806) - lu(k,1242) * lu(k,1792) + lu(k,1809) = lu(k,1809) - lu(k,1243) * lu(k,1792) + lu(k,1810) = lu(k,1810) - lu(k,1244) * lu(k,1792) + lu(k,1854) = lu(k,1854) - lu(k,1234) * lu(k,1852) + lu(k,1855) = lu(k,1855) - lu(k,1235) * lu(k,1852) + lu(k,1856) = lu(k,1856) - lu(k,1236) * lu(k,1852) + lu(k,1858) = lu(k,1858) - lu(k,1237) * lu(k,1852) + lu(k,1860) = lu(k,1860) - lu(k,1238) * lu(k,1852) + lu(k,1862) = lu(k,1862) - lu(k,1239) * lu(k,1852) + lu(k,1864) = lu(k,1864) - lu(k,1240) * lu(k,1852) + lu(k,1865) = lu(k,1865) - lu(k,1241) * lu(k,1852) + lu(k,1866) = lu(k,1866) - lu(k,1242) * lu(k,1852) + lu(k,1869) = lu(k,1869) - lu(k,1243) * lu(k,1852) + lu(k,1870) = lu(k,1870) - lu(k,1244) * lu(k,1852) + lu(k,1895) = lu(k,1895) - lu(k,1234) * lu(k,1893) + lu(k,1896) = lu(k,1896) - lu(k,1235) * lu(k,1893) + lu(k,1897) = lu(k,1897) - lu(k,1236) * lu(k,1893) + lu(k,1899) = lu(k,1899) - lu(k,1237) * lu(k,1893) + lu(k,1901) = lu(k,1901) - lu(k,1238) * lu(k,1893) + lu(k,1903) = lu(k,1903) - lu(k,1239) * lu(k,1893) + lu(k,1905) = lu(k,1905) - lu(k,1240) * lu(k,1893) + lu(k,1906) = lu(k,1906) - lu(k,1241) * lu(k,1893) + lu(k,1907) = lu(k,1907) - lu(k,1242) * lu(k,1893) + lu(k,1910) = lu(k,1910) - lu(k,1243) * lu(k,1893) + lu(k,1911) = lu(k,1911) - lu(k,1244) * lu(k,1893) + lu(k,1952) = lu(k,1952) - lu(k,1234) * lu(k,1950) + lu(k,1953) = lu(k,1953) - lu(k,1235) * lu(k,1950) + lu(k,1954) = lu(k,1954) - lu(k,1236) * lu(k,1950) + lu(k,1956) = lu(k,1956) - lu(k,1237) * lu(k,1950) + lu(k,1958) = lu(k,1958) - lu(k,1238) * lu(k,1950) + lu(k,1960) = lu(k,1960) - lu(k,1239) * lu(k,1950) + lu(k,1962) = lu(k,1962) - lu(k,1240) * lu(k,1950) + lu(k,1963) = lu(k,1963) - lu(k,1241) * lu(k,1950) + lu(k,1964) = lu(k,1964) - lu(k,1242) * lu(k,1950) + lu(k,1967) = lu(k,1967) - lu(k,1243) * lu(k,1950) + lu(k,1968) = lu(k,1968) - lu(k,1244) * lu(k,1950) + lu(k,2009) = lu(k,2009) - lu(k,1234) * lu(k,2007) + lu(k,2010) = lu(k,2010) - lu(k,1235) * lu(k,2007) + lu(k,2011) = lu(k,2011) - lu(k,1236) * lu(k,2007) + lu(k,2013) = lu(k,2013) - lu(k,1237) * lu(k,2007) + lu(k,2015) = lu(k,2015) - lu(k,1238) * lu(k,2007) + lu(k,2017) = lu(k,2017) - lu(k,1239) * lu(k,2007) + lu(k,2019) = lu(k,2019) - lu(k,1240) * lu(k,2007) + lu(k,2020) = lu(k,2020) - lu(k,1241) * lu(k,2007) + lu(k,2021) = lu(k,2021) - lu(k,1242) * lu(k,2007) + lu(k,2024) = lu(k,2024) - lu(k,1243) * lu(k,2007) + lu(k,2025) = lu(k,2025) - lu(k,1244) * lu(k,2007) + lu(k,1247) = 1._r8 / lu(k,1247) + lu(k,1248) = lu(k,1248) * lu(k,1247) + lu(k,1249) = lu(k,1249) * lu(k,1247) + lu(k,1250) = lu(k,1250) * lu(k,1247) + lu(k,1251) = lu(k,1251) * lu(k,1247) + lu(k,1252) = lu(k,1252) * lu(k,1247) + lu(k,1253) = lu(k,1253) * lu(k,1247) + lu(k,1254) = lu(k,1254) * lu(k,1247) + lu(k,1255) = lu(k,1255) * lu(k,1247) + lu(k,1256) = lu(k,1256) * lu(k,1247) + lu(k,1342) = lu(k,1342) - lu(k,1248) * lu(k,1340) + lu(k,1344) = lu(k,1344) - lu(k,1249) * lu(k,1340) + lu(k,1345) = lu(k,1345) - lu(k,1250) * lu(k,1340) + lu(k,1346) = lu(k,1346) - lu(k,1251) * lu(k,1340) + lu(k,1347) = lu(k,1347) - lu(k,1252) * lu(k,1340) + lu(k,1348) = lu(k,1348) - lu(k,1253) * lu(k,1340) + lu(k,1349) = lu(k,1349) - lu(k,1254) * lu(k,1340) + lu(k,1352) = lu(k,1352) - lu(k,1255) * lu(k,1340) + lu(k,1357) = lu(k,1357) - lu(k,1256) * lu(k,1340) + lu(k,1496) = lu(k,1496) - lu(k,1248) * lu(k,1494) + lu(k,1498) = lu(k,1498) - lu(k,1249) * lu(k,1494) + lu(k,1499) = lu(k,1499) - lu(k,1250) * lu(k,1494) + lu(k,1500) = lu(k,1500) - lu(k,1251) * lu(k,1494) + lu(k,1501) = lu(k,1501) - lu(k,1252) * lu(k,1494) + lu(k,1502) = lu(k,1502) - lu(k,1253) * lu(k,1494) + lu(k,1503) = lu(k,1503) - lu(k,1254) * lu(k,1494) + lu(k,1506) = lu(k,1506) - lu(k,1255) * lu(k,1494) + lu(k,1511) = lu(k,1511) - lu(k,1256) * lu(k,1494) + lu(k,1520) = lu(k,1520) - lu(k,1248) * lu(k,1518) + lu(k,1522) = - lu(k,1249) * lu(k,1518) + lu(k,1523) = lu(k,1523) - lu(k,1250) * lu(k,1518) + lu(k,1524) = lu(k,1524) - lu(k,1251) * lu(k,1518) + lu(k,1525) = - lu(k,1252) * lu(k,1518) + lu(k,1526) = lu(k,1526) - lu(k,1253) * lu(k,1518) + lu(k,1527) = lu(k,1527) - lu(k,1254) * lu(k,1518) + lu(k,1530) = lu(k,1530) - lu(k,1255) * lu(k,1518) + lu(k,1535) = lu(k,1535) - lu(k,1256) * lu(k,1518) + lu(k,1543) = lu(k,1543) - lu(k,1248) * lu(k,1541) + lu(k,1545) = lu(k,1545) - lu(k,1249) * lu(k,1541) + lu(k,1546) = lu(k,1546) - lu(k,1250) * lu(k,1541) + lu(k,1547) = lu(k,1547) - lu(k,1251) * lu(k,1541) + lu(k,1548) = lu(k,1548) - lu(k,1252) * lu(k,1541) + lu(k,1549) = lu(k,1549) - lu(k,1253) * lu(k,1541) + lu(k,1550) = lu(k,1550) - lu(k,1254) * lu(k,1541) + lu(k,1553) = - lu(k,1255) * lu(k,1541) + lu(k,1558) = lu(k,1558) - lu(k,1256) * lu(k,1541) + lu(k,1573) = lu(k,1573) - lu(k,1248) * lu(k,1571) + lu(k,1575) = lu(k,1575) - lu(k,1249) * lu(k,1571) + lu(k,1576) = lu(k,1576) - lu(k,1250) * lu(k,1571) + lu(k,1577) = lu(k,1577) - lu(k,1251) * lu(k,1571) + lu(k,1578) = lu(k,1578) - lu(k,1252) * lu(k,1571) + lu(k,1579) = lu(k,1579) - lu(k,1253) * lu(k,1571) + lu(k,1580) = lu(k,1580) - lu(k,1254) * lu(k,1571) + lu(k,1583) = lu(k,1583) - lu(k,1255) * lu(k,1571) + lu(k,1588) = lu(k,1588) - lu(k,1256) * lu(k,1571) + lu(k,1679) = lu(k,1679) - lu(k,1248) * lu(k,1677) + lu(k,1681) = lu(k,1681) - lu(k,1249) * lu(k,1677) + lu(k,1682) = lu(k,1682) - lu(k,1250) * lu(k,1677) + lu(k,1683) = lu(k,1683) - lu(k,1251) * lu(k,1677) + lu(k,1684) = lu(k,1684) - lu(k,1252) * lu(k,1677) + lu(k,1685) = lu(k,1685) - lu(k,1253) * lu(k,1677) + lu(k,1686) = lu(k,1686) - lu(k,1254) * lu(k,1677) + lu(k,1689) = lu(k,1689) - lu(k,1255) * lu(k,1677) + lu(k,1694) = lu(k,1694) - lu(k,1256) * lu(k,1677) + lu(k,1705) = lu(k,1705) - lu(k,1248) * lu(k,1703) + lu(k,1707) = - lu(k,1249) * lu(k,1703) + lu(k,1708) = lu(k,1708) - lu(k,1250) * lu(k,1703) + lu(k,1709) = lu(k,1709) - lu(k,1251) * lu(k,1703) + lu(k,1710) = lu(k,1710) - lu(k,1252) * lu(k,1703) + lu(k,1711) = lu(k,1711) - lu(k,1253) * lu(k,1703) + lu(k,1712) = lu(k,1712) - lu(k,1254) * lu(k,1703) + lu(k,1715) = lu(k,1715) - lu(k,1255) * lu(k,1703) + lu(k,1720) = lu(k,1720) - lu(k,1256) * lu(k,1703) + lu(k,1795) = lu(k,1795) - lu(k,1248) * lu(k,1793) + lu(k,1797) = - lu(k,1249) * lu(k,1793) + lu(k,1798) = lu(k,1798) - lu(k,1250) * lu(k,1793) + lu(k,1799) = lu(k,1799) - lu(k,1251) * lu(k,1793) + lu(k,1800) = lu(k,1800) - lu(k,1252) * lu(k,1793) + lu(k,1801) = lu(k,1801) - lu(k,1253) * lu(k,1793) + lu(k,1802) = lu(k,1802) - lu(k,1254) * lu(k,1793) + lu(k,1805) = lu(k,1805) - lu(k,1255) * lu(k,1793) + lu(k,1810) = lu(k,1810) - lu(k,1256) * lu(k,1793) + lu(k,1855) = lu(k,1855) - lu(k,1248) * lu(k,1853) + lu(k,1857) = lu(k,1857) - lu(k,1249) * lu(k,1853) + lu(k,1858) = lu(k,1858) - lu(k,1250) * lu(k,1853) + lu(k,1859) = lu(k,1859) - lu(k,1251) * lu(k,1853) + lu(k,1860) = lu(k,1860) - lu(k,1252) * lu(k,1853) + lu(k,1861) = lu(k,1861) - lu(k,1253) * lu(k,1853) + lu(k,1862) = lu(k,1862) - lu(k,1254) * lu(k,1853) + lu(k,1865) = lu(k,1865) - lu(k,1255) * lu(k,1853) + lu(k,1870) = lu(k,1870) - lu(k,1256) * lu(k,1853) + lu(k,1896) = lu(k,1896) - lu(k,1248) * lu(k,1894) + lu(k,1898) = - lu(k,1249) * lu(k,1894) + lu(k,1899) = lu(k,1899) - lu(k,1250) * lu(k,1894) + lu(k,1900) = lu(k,1900) - lu(k,1251) * lu(k,1894) + lu(k,1901) = lu(k,1901) - lu(k,1252) * lu(k,1894) + lu(k,1902) = lu(k,1902) - lu(k,1253) * lu(k,1894) + lu(k,1903) = lu(k,1903) - lu(k,1254) * lu(k,1894) + lu(k,1906) = lu(k,1906) - lu(k,1255) * lu(k,1894) + lu(k,1911) = lu(k,1911) - lu(k,1256) * lu(k,1894) + lu(k,1919) = lu(k,1919) - lu(k,1248) * lu(k,1917) + lu(k,1921) = lu(k,1921) - lu(k,1249) * lu(k,1917) + lu(k,1922) = lu(k,1922) - lu(k,1250) * lu(k,1917) + lu(k,1923) = lu(k,1923) - lu(k,1251) * lu(k,1917) + lu(k,1924) = - lu(k,1252) * lu(k,1917) + lu(k,1925) = lu(k,1925) - lu(k,1253) * lu(k,1917) + lu(k,1926) = - lu(k,1254) * lu(k,1917) + lu(k,1929) = - lu(k,1255) * lu(k,1917) + lu(k,1934) = lu(k,1934) - lu(k,1256) * lu(k,1917) + lu(k,1953) = lu(k,1953) - lu(k,1248) * lu(k,1951) + lu(k,1955) = lu(k,1955) - lu(k,1249) * lu(k,1951) + lu(k,1956) = lu(k,1956) - lu(k,1250) * lu(k,1951) + lu(k,1957) = - lu(k,1251) * lu(k,1951) + lu(k,1958) = lu(k,1958) - lu(k,1252) * lu(k,1951) + lu(k,1959) = lu(k,1959) - lu(k,1253) * lu(k,1951) + lu(k,1960) = lu(k,1960) - lu(k,1254) * lu(k,1951) + lu(k,1963) = lu(k,1963) - lu(k,1255) * lu(k,1951) + lu(k,1968) = lu(k,1968) - lu(k,1256) * lu(k,1951) + lu(k,2010) = lu(k,2010) - lu(k,1248) * lu(k,2008) + lu(k,2012) = - lu(k,1249) * lu(k,2008) + lu(k,2013) = lu(k,2013) - lu(k,1250) * lu(k,2008) + lu(k,2014) = lu(k,2014) - lu(k,1251) * lu(k,2008) + lu(k,2015) = lu(k,2015) - lu(k,1252) * lu(k,2008) + lu(k,2016) = lu(k,2016) - lu(k,1253) * lu(k,2008) + lu(k,2017) = lu(k,2017) - lu(k,1254) * lu(k,2008) + lu(k,2020) = lu(k,2020) - lu(k,1255) * lu(k,2008) + lu(k,2025) = lu(k,2025) - lu(k,1256) * lu(k,2008) + lu(k,2035) = lu(k,2035) - lu(k,1248) * lu(k,2033) + lu(k,2037) = lu(k,2037) - lu(k,1249) * lu(k,2033) + lu(k,2038) = lu(k,2038) - lu(k,1250) * lu(k,2033) + lu(k,2039) = lu(k,2039) - lu(k,1251) * lu(k,2033) + lu(k,2040) = - lu(k,1252) * lu(k,2033) + lu(k,2041) = lu(k,2041) - lu(k,1253) * lu(k,2033) + lu(k,2042) = lu(k,2042) - lu(k,1254) * lu(k,2033) + lu(k,2045) = lu(k,2045) - lu(k,1255) * lu(k,2033) + lu(k,2050) = lu(k,2050) - lu(k,1256) * lu(k,2033) + lu(k,1260) = 1._r8 / lu(k,1260) + lu(k,1261) = lu(k,1261) * lu(k,1260) + lu(k,1262) = lu(k,1262) * lu(k,1260) + lu(k,1263) = lu(k,1263) * lu(k,1260) + lu(k,1264) = lu(k,1264) * lu(k,1260) + lu(k,1265) = lu(k,1265) * lu(k,1260) + lu(k,1266) = lu(k,1266) * lu(k,1260) + lu(k,1267) = lu(k,1267) * lu(k,1260) + lu(k,1268) = lu(k,1268) * lu(k,1260) + lu(k,1269) = lu(k,1269) * lu(k,1260) + lu(k,1270) = lu(k,1270) * lu(k,1260) + lu(k,1273) = lu(k,1273) - lu(k,1261) * lu(k,1272) + lu(k,1274) = lu(k,1274) - lu(k,1262) * lu(k,1272) + lu(k,1275) = lu(k,1275) - lu(k,1263) * lu(k,1272) + lu(k,1276) = lu(k,1276) - lu(k,1264) * lu(k,1272) + lu(k,1277) = lu(k,1277) - lu(k,1265) * lu(k,1272) + lu(k,1280) = - lu(k,1266) * lu(k,1272) + lu(k,1281) = lu(k,1281) - lu(k,1267) * lu(k,1272) + lu(k,1282) = lu(k,1282) - lu(k,1268) * lu(k,1272) + lu(k,1283) = lu(k,1283) - lu(k,1269) * lu(k,1272) + lu(k,1284) = lu(k,1284) - lu(k,1270) * lu(k,1272) + lu(k,1319) = lu(k,1319) - lu(k,1261) * lu(k,1318) + lu(k,1320) = lu(k,1320) - lu(k,1262) * lu(k,1318) + lu(k,1321) = - lu(k,1263) * lu(k,1318) + lu(k,1322) = lu(k,1322) - lu(k,1264) * lu(k,1318) + lu(k,1324) = - lu(k,1265) * lu(k,1318) + lu(k,1329) = lu(k,1329) - lu(k,1266) * lu(k,1318) + lu(k,1330) = - lu(k,1267) * lu(k,1318) + lu(k,1331) = lu(k,1331) - lu(k,1268) * lu(k,1318) + lu(k,1332) = lu(k,1332) - lu(k,1269) * lu(k,1318) + lu(k,1333) = lu(k,1333) - lu(k,1270) * lu(k,1318) + lu(k,1342) = lu(k,1342) - lu(k,1261) * lu(k,1341) + lu(k,1343) = lu(k,1343) - lu(k,1262) * lu(k,1341) + lu(k,1344) = lu(k,1344) - lu(k,1263) * lu(k,1341) + lu(k,1345) = lu(k,1345) - lu(k,1264) * lu(k,1341) + lu(k,1348) = lu(k,1348) - lu(k,1265) * lu(k,1341) + lu(k,1353) = - lu(k,1266) * lu(k,1341) + lu(k,1354) = lu(k,1354) - lu(k,1267) * lu(k,1341) + lu(k,1355) = lu(k,1355) - lu(k,1268) * lu(k,1341) + lu(k,1356) = lu(k,1356) - lu(k,1269) * lu(k,1341) + lu(k,1357) = lu(k,1357) - lu(k,1270) * lu(k,1341) + lu(k,1496) = lu(k,1496) - lu(k,1261) * lu(k,1495) + lu(k,1497) = lu(k,1497) - lu(k,1262) * lu(k,1495) + lu(k,1498) = lu(k,1498) - lu(k,1263) * lu(k,1495) + lu(k,1499) = lu(k,1499) - lu(k,1264) * lu(k,1495) + lu(k,1502) = lu(k,1502) - lu(k,1265) * lu(k,1495) + lu(k,1507) = lu(k,1507) - lu(k,1266) * lu(k,1495) + lu(k,1508) = lu(k,1508) - lu(k,1267) * lu(k,1495) + lu(k,1509) = lu(k,1509) - lu(k,1268) * lu(k,1495) + lu(k,1510) = lu(k,1510) - lu(k,1269) * lu(k,1495) + lu(k,1511) = lu(k,1511) - lu(k,1270) * lu(k,1495) + lu(k,1520) = lu(k,1520) - lu(k,1261) * lu(k,1519) + lu(k,1521) = - lu(k,1262) * lu(k,1519) + lu(k,1522) = lu(k,1522) - lu(k,1263) * lu(k,1519) + lu(k,1523) = lu(k,1523) - lu(k,1264) * lu(k,1519) + lu(k,1526) = lu(k,1526) - lu(k,1265) * lu(k,1519) + lu(k,1531) = lu(k,1531) - lu(k,1266) * lu(k,1519) + lu(k,1532) = lu(k,1532) - lu(k,1267) * lu(k,1519) + lu(k,1533) = lu(k,1533) - lu(k,1268) * lu(k,1519) + lu(k,1534) = lu(k,1534) - lu(k,1269) * lu(k,1519) + lu(k,1535) = lu(k,1535) - lu(k,1270) * lu(k,1519) + lu(k,1543) = lu(k,1543) - lu(k,1261) * lu(k,1542) + lu(k,1544) = lu(k,1544) - lu(k,1262) * lu(k,1542) + lu(k,1545) = lu(k,1545) - lu(k,1263) * lu(k,1542) + lu(k,1546) = lu(k,1546) - lu(k,1264) * lu(k,1542) + lu(k,1549) = lu(k,1549) - lu(k,1265) * lu(k,1542) + lu(k,1554) = lu(k,1554) - lu(k,1266) * lu(k,1542) + lu(k,1555) = lu(k,1555) - lu(k,1267) * lu(k,1542) + lu(k,1556) = lu(k,1556) - lu(k,1268) * lu(k,1542) + lu(k,1557) = lu(k,1557) - lu(k,1269) * lu(k,1542) + lu(k,1558) = lu(k,1558) - lu(k,1270) * lu(k,1542) + lu(k,1573) = lu(k,1573) - lu(k,1261) * lu(k,1572) + lu(k,1574) = lu(k,1574) - lu(k,1262) * lu(k,1572) + lu(k,1575) = lu(k,1575) - lu(k,1263) * lu(k,1572) + lu(k,1576) = lu(k,1576) - lu(k,1264) * lu(k,1572) + lu(k,1579) = lu(k,1579) - lu(k,1265) * lu(k,1572) + lu(k,1584) = lu(k,1584) - lu(k,1266) * lu(k,1572) + lu(k,1585) = lu(k,1585) - lu(k,1267) * lu(k,1572) + lu(k,1586) = lu(k,1586) - lu(k,1268) * lu(k,1572) + lu(k,1587) = lu(k,1587) - lu(k,1269) * lu(k,1572) + lu(k,1588) = lu(k,1588) - lu(k,1270) * lu(k,1572) + lu(k,1679) = lu(k,1679) - lu(k,1261) * lu(k,1678) + lu(k,1680) = lu(k,1680) - lu(k,1262) * lu(k,1678) + lu(k,1681) = lu(k,1681) - lu(k,1263) * lu(k,1678) + lu(k,1682) = lu(k,1682) - lu(k,1264) * lu(k,1678) + lu(k,1685) = lu(k,1685) - lu(k,1265) * lu(k,1678) + lu(k,1690) = lu(k,1690) - lu(k,1266) * lu(k,1678) + lu(k,1691) = lu(k,1691) - lu(k,1267) * lu(k,1678) + lu(k,1692) = lu(k,1692) - lu(k,1268) * lu(k,1678) + lu(k,1693) = lu(k,1693) - lu(k,1269) * lu(k,1678) + lu(k,1694) = lu(k,1694) - lu(k,1270) * lu(k,1678) + lu(k,1705) = lu(k,1705) - lu(k,1261) * lu(k,1704) + lu(k,1706) = lu(k,1706) - lu(k,1262) * lu(k,1704) + lu(k,1707) = lu(k,1707) - lu(k,1263) * lu(k,1704) + lu(k,1708) = lu(k,1708) - lu(k,1264) * lu(k,1704) + lu(k,1711) = lu(k,1711) - lu(k,1265) * lu(k,1704) + lu(k,1716) = lu(k,1716) - lu(k,1266) * lu(k,1704) + lu(k,1717) = lu(k,1717) - lu(k,1267) * lu(k,1704) + lu(k,1718) = lu(k,1718) - lu(k,1268) * lu(k,1704) + lu(k,1719) = lu(k,1719) - lu(k,1269) * lu(k,1704) + lu(k,1720) = lu(k,1720) - lu(k,1270) * lu(k,1704) + lu(k,1795) = lu(k,1795) - lu(k,1261) * lu(k,1794) + lu(k,1796) = lu(k,1796) - lu(k,1262) * lu(k,1794) + lu(k,1797) = lu(k,1797) - lu(k,1263) * lu(k,1794) + lu(k,1798) = lu(k,1798) - lu(k,1264) * lu(k,1794) + lu(k,1801) = lu(k,1801) - lu(k,1265) * lu(k,1794) + lu(k,1806) = lu(k,1806) - lu(k,1266) * lu(k,1794) + lu(k,1807) = - lu(k,1267) * lu(k,1794) + lu(k,1808) = lu(k,1808) - lu(k,1268) * lu(k,1794) + lu(k,1809) = lu(k,1809) - lu(k,1269) * lu(k,1794) + lu(k,1810) = lu(k,1810) - lu(k,1270) * lu(k,1794) + lu(k,1855) = lu(k,1855) - lu(k,1261) * lu(k,1854) + lu(k,1856) = lu(k,1856) - lu(k,1262) * lu(k,1854) + lu(k,1857) = lu(k,1857) - lu(k,1263) * lu(k,1854) + lu(k,1858) = lu(k,1858) - lu(k,1264) * lu(k,1854) + lu(k,1861) = lu(k,1861) - lu(k,1265) * lu(k,1854) + lu(k,1866) = lu(k,1866) - lu(k,1266) * lu(k,1854) + lu(k,1867) = - lu(k,1267) * lu(k,1854) + lu(k,1868) = lu(k,1868) - lu(k,1268) * lu(k,1854) + lu(k,1869) = lu(k,1869) - lu(k,1269) * lu(k,1854) + lu(k,1870) = lu(k,1870) - lu(k,1270) * lu(k,1854) + lu(k,1896) = lu(k,1896) - lu(k,1261) * lu(k,1895) + lu(k,1897) = lu(k,1897) - lu(k,1262) * lu(k,1895) + lu(k,1898) = lu(k,1898) - lu(k,1263) * lu(k,1895) + lu(k,1899) = lu(k,1899) - lu(k,1264) * lu(k,1895) + lu(k,1902) = lu(k,1902) - lu(k,1265) * lu(k,1895) + lu(k,1907) = lu(k,1907) - lu(k,1266) * lu(k,1895) + lu(k,1908) = lu(k,1908) - lu(k,1267) * lu(k,1895) + lu(k,1909) = lu(k,1909) - lu(k,1268) * lu(k,1895) + lu(k,1910) = lu(k,1910) - lu(k,1269) * lu(k,1895) + lu(k,1911) = lu(k,1911) - lu(k,1270) * lu(k,1895) + lu(k,1919) = lu(k,1919) - lu(k,1261) * lu(k,1918) + lu(k,1920) = - lu(k,1262) * lu(k,1918) + lu(k,1921) = lu(k,1921) - lu(k,1263) * lu(k,1918) + lu(k,1922) = lu(k,1922) - lu(k,1264) * lu(k,1918) + lu(k,1925) = lu(k,1925) - lu(k,1265) * lu(k,1918) + lu(k,1930) = lu(k,1930) - lu(k,1266) * lu(k,1918) + lu(k,1931) = lu(k,1931) - lu(k,1267) * lu(k,1918) + lu(k,1932) = lu(k,1932) - lu(k,1268) * lu(k,1918) + lu(k,1933) = lu(k,1933) - lu(k,1269) * lu(k,1918) + lu(k,1934) = lu(k,1934) - lu(k,1270) * lu(k,1918) + lu(k,1953) = lu(k,1953) - lu(k,1261) * lu(k,1952) + lu(k,1954) = lu(k,1954) - lu(k,1262) * lu(k,1952) + lu(k,1955) = lu(k,1955) - lu(k,1263) * lu(k,1952) + lu(k,1956) = lu(k,1956) - lu(k,1264) * lu(k,1952) + lu(k,1959) = lu(k,1959) - lu(k,1265) * lu(k,1952) + lu(k,1964) = lu(k,1964) - lu(k,1266) * lu(k,1952) + lu(k,1965) = lu(k,1965) - lu(k,1267) * lu(k,1952) + lu(k,1966) = lu(k,1966) - lu(k,1268) * lu(k,1952) + lu(k,1967) = lu(k,1967) - lu(k,1269) * lu(k,1952) + lu(k,1968) = lu(k,1968) - lu(k,1270) * lu(k,1952) + lu(k,2010) = lu(k,2010) - lu(k,1261) * lu(k,2009) + lu(k,2011) = lu(k,2011) - lu(k,1262) * lu(k,2009) + lu(k,2012) = lu(k,2012) - lu(k,1263) * lu(k,2009) + lu(k,2013) = lu(k,2013) - lu(k,1264) * lu(k,2009) + lu(k,2016) = lu(k,2016) - lu(k,1265) * lu(k,2009) + lu(k,2021) = lu(k,2021) - lu(k,1266) * lu(k,2009) + lu(k,2022) = - lu(k,1267) * lu(k,2009) + lu(k,2023) = lu(k,2023) - lu(k,1268) * lu(k,2009) + lu(k,2024) = lu(k,2024) - lu(k,1269) * lu(k,2009) + lu(k,2025) = lu(k,2025) - lu(k,1270) * lu(k,2009) + lu(k,2035) = lu(k,2035) - lu(k,1261) * lu(k,2034) + lu(k,2036) = lu(k,2036) - lu(k,1262) * lu(k,2034) + lu(k,2037) = lu(k,2037) - lu(k,1263) * lu(k,2034) + lu(k,2038) = lu(k,2038) - lu(k,1264) * lu(k,2034) + lu(k,2041) = lu(k,2041) - lu(k,1265) * lu(k,2034) + lu(k,2046) = lu(k,2046) - lu(k,1266) * lu(k,2034) + lu(k,2047) = lu(k,2047) - lu(k,1267) * lu(k,2034) + lu(k,2048) = lu(k,2048) - lu(k,1268) * lu(k,2034) + lu(k,2049) = lu(k,2049) - lu(k,1269) * lu(k,2034) + lu(k,2050) = lu(k,2050) - lu(k,1270) * lu(k,2034) + end do + end subroutine lu_fac24 + subroutine lu_fac25( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,1273) = 1._r8 / lu(k,1273) + lu(k,1274) = lu(k,1274) * lu(k,1273) + lu(k,1275) = lu(k,1275) * lu(k,1273) + lu(k,1276) = lu(k,1276) * lu(k,1273) + lu(k,1277) = lu(k,1277) * lu(k,1273) + lu(k,1278) = lu(k,1278) * lu(k,1273) + lu(k,1279) = lu(k,1279) * lu(k,1273) + lu(k,1280) = lu(k,1280) * lu(k,1273) + lu(k,1281) = lu(k,1281) * lu(k,1273) + lu(k,1282) = lu(k,1282) * lu(k,1273) + lu(k,1283) = lu(k,1283) * lu(k,1273) + lu(k,1284) = lu(k,1284) * lu(k,1273) + lu(k,1320) = lu(k,1320) - lu(k,1274) * lu(k,1319) + lu(k,1321) = lu(k,1321) - lu(k,1275) * lu(k,1319) + lu(k,1322) = lu(k,1322) - lu(k,1276) * lu(k,1319) + lu(k,1324) = lu(k,1324) - lu(k,1277) * lu(k,1319) + lu(k,1325) = lu(k,1325) - lu(k,1278) * lu(k,1319) + lu(k,1328) = lu(k,1328) - lu(k,1279) * lu(k,1319) + lu(k,1329) = lu(k,1329) - lu(k,1280) * lu(k,1319) + lu(k,1330) = lu(k,1330) - lu(k,1281) * lu(k,1319) + lu(k,1331) = lu(k,1331) - lu(k,1282) * lu(k,1319) + lu(k,1332) = lu(k,1332) - lu(k,1283) * lu(k,1319) + lu(k,1333) = lu(k,1333) - lu(k,1284) * lu(k,1319) + lu(k,1343) = lu(k,1343) - lu(k,1274) * lu(k,1342) + lu(k,1344) = lu(k,1344) - lu(k,1275) * lu(k,1342) + lu(k,1345) = lu(k,1345) - lu(k,1276) * lu(k,1342) + lu(k,1348) = lu(k,1348) - lu(k,1277) * lu(k,1342) + lu(k,1349) = lu(k,1349) - lu(k,1278) * lu(k,1342) + lu(k,1352) = lu(k,1352) - lu(k,1279) * lu(k,1342) + lu(k,1353) = lu(k,1353) - lu(k,1280) * lu(k,1342) + lu(k,1354) = lu(k,1354) - lu(k,1281) * lu(k,1342) + lu(k,1355) = lu(k,1355) - lu(k,1282) * lu(k,1342) + lu(k,1356) = lu(k,1356) - lu(k,1283) * lu(k,1342) + lu(k,1357) = lu(k,1357) - lu(k,1284) * lu(k,1342) + lu(k,1497) = lu(k,1497) - lu(k,1274) * lu(k,1496) + lu(k,1498) = lu(k,1498) - lu(k,1275) * lu(k,1496) + lu(k,1499) = lu(k,1499) - lu(k,1276) * lu(k,1496) + lu(k,1502) = lu(k,1502) - lu(k,1277) * lu(k,1496) + lu(k,1503) = lu(k,1503) - lu(k,1278) * lu(k,1496) + lu(k,1506) = lu(k,1506) - lu(k,1279) * lu(k,1496) + lu(k,1507) = lu(k,1507) - lu(k,1280) * lu(k,1496) + lu(k,1508) = lu(k,1508) - lu(k,1281) * lu(k,1496) + lu(k,1509) = lu(k,1509) - lu(k,1282) * lu(k,1496) + lu(k,1510) = lu(k,1510) - lu(k,1283) * lu(k,1496) + lu(k,1511) = lu(k,1511) - lu(k,1284) * lu(k,1496) + lu(k,1521) = lu(k,1521) - lu(k,1274) * lu(k,1520) + lu(k,1522) = lu(k,1522) - lu(k,1275) * lu(k,1520) + lu(k,1523) = lu(k,1523) - lu(k,1276) * lu(k,1520) + lu(k,1526) = lu(k,1526) - lu(k,1277) * lu(k,1520) + lu(k,1527) = lu(k,1527) - lu(k,1278) * lu(k,1520) + lu(k,1530) = lu(k,1530) - lu(k,1279) * lu(k,1520) + lu(k,1531) = lu(k,1531) - lu(k,1280) * lu(k,1520) + lu(k,1532) = lu(k,1532) - lu(k,1281) * lu(k,1520) + lu(k,1533) = lu(k,1533) - lu(k,1282) * lu(k,1520) + lu(k,1534) = lu(k,1534) - lu(k,1283) * lu(k,1520) + lu(k,1535) = lu(k,1535) - lu(k,1284) * lu(k,1520) + lu(k,1544) = lu(k,1544) - lu(k,1274) * lu(k,1543) + lu(k,1545) = lu(k,1545) - lu(k,1275) * lu(k,1543) + lu(k,1546) = lu(k,1546) - lu(k,1276) * lu(k,1543) + lu(k,1549) = lu(k,1549) - lu(k,1277) * lu(k,1543) + lu(k,1550) = lu(k,1550) - lu(k,1278) * lu(k,1543) + lu(k,1553) = lu(k,1553) - lu(k,1279) * lu(k,1543) + lu(k,1554) = lu(k,1554) - lu(k,1280) * lu(k,1543) + lu(k,1555) = lu(k,1555) - lu(k,1281) * lu(k,1543) + lu(k,1556) = lu(k,1556) - lu(k,1282) * lu(k,1543) + lu(k,1557) = lu(k,1557) - lu(k,1283) * lu(k,1543) + lu(k,1558) = lu(k,1558) - lu(k,1284) * lu(k,1543) + lu(k,1574) = lu(k,1574) - lu(k,1274) * lu(k,1573) + lu(k,1575) = lu(k,1575) - lu(k,1275) * lu(k,1573) + lu(k,1576) = lu(k,1576) - lu(k,1276) * lu(k,1573) + lu(k,1579) = lu(k,1579) - lu(k,1277) * lu(k,1573) + lu(k,1580) = lu(k,1580) - lu(k,1278) * lu(k,1573) + lu(k,1583) = lu(k,1583) - lu(k,1279) * lu(k,1573) + lu(k,1584) = lu(k,1584) - lu(k,1280) * lu(k,1573) + lu(k,1585) = lu(k,1585) - lu(k,1281) * lu(k,1573) + lu(k,1586) = lu(k,1586) - lu(k,1282) * lu(k,1573) + lu(k,1587) = lu(k,1587) - lu(k,1283) * lu(k,1573) + lu(k,1588) = lu(k,1588) - lu(k,1284) * lu(k,1573) + lu(k,1680) = lu(k,1680) - lu(k,1274) * lu(k,1679) + lu(k,1681) = lu(k,1681) - lu(k,1275) * lu(k,1679) + lu(k,1682) = lu(k,1682) - lu(k,1276) * lu(k,1679) + lu(k,1685) = lu(k,1685) - lu(k,1277) * lu(k,1679) + lu(k,1686) = lu(k,1686) - lu(k,1278) * lu(k,1679) + lu(k,1689) = lu(k,1689) - lu(k,1279) * lu(k,1679) + lu(k,1690) = lu(k,1690) - lu(k,1280) * lu(k,1679) + lu(k,1691) = lu(k,1691) - lu(k,1281) * lu(k,1679) + lu(k,1692) = lu(k,1692) - lu(k,1282) * lu(k,1679) + lu(k,1693) = lu(k,1693) - lu(k,1283) * lu(k,1679) + lu(k,1694) = lu(k,1694) - lu(k,1284) * lu(k,1679) + lu(k,1706) = lu(k,1706) - lu(k,1274) * lu(k,1705) + lu(k,1707) = lu(k,1707) - lu(k,1275) * lu(k,1705) + lu(k,1708) = lu(k,1708) - lu(k,1276) * lu(k,1705) + lu(k,1711) = lu(k,1711) - lu(k,1277) * lu(k,1705) + lu(k,1712) = lu(k,1712) - lu(k,1278) * lu(k,1705) + lu(k,1715) = lu(k,1715) - lu(k,1279) * lu(k,1705) + lu(k,1716) = lu(k,1716) - lu(k,1280) * lu(k,1705) + lu(k,1717) = lu(k,1717) - lu(k,1281) * lu(k,1705) + lu(k,1718) = lu(k,1718) - lu(k,1282) * lu(k,1705) + lu(k,1719) = lu(k,1719) - lu(k,1283) * lu(k,1705) + lu(k,1720) = lu(k,1720) - lu(k,1284) * lu(k,1705) + lu(k,1796) = lu(k,1796) - lu(k,1274) * lu(k,1795) + lu(k,1797) = lu(k,1797) - lu(k,1275) * lu(k,1795) + lu(k,1798) = lu(k,1798) - lu(k,1276) * lu(k,1795) + lu(k,1801) = lu(k,1801) - lu(k,1277) * lu(k,1795) + lu(k,1802) = lu(k,1802) - lu(k,1278) * lu(k,1795) + lu(k,1805) = lu(k,1805) - lu(k,1279) * lu(k,1795) + lu(k,1806) = lu(k,1806) - lu(k,1280) * lu(k,1795) + lu(k,1807) = lu(k,1807) - lu(k,1281) * lu(k,1795) + lu(k,1808) = lu(k,1808) - lu(k,1282) * lu(k,1795) + lu(k,1809) = lu(k,1809) - lu(k,1283) * lu(k,1795) + lu(k,1810) = lu(k,1810) - lu(k,1284) * lu(k,1795) + lu(k,1856) = lu(k,1856) - lu(k,1274) * lu(k,1855) + lu(k,1857) = lu(k,1857) - lu(k,1275) * lu(k,1855) + lu(k,1858) = lu(k,1858) - lu(k,1276) * lu(k,1855) + lu(k,1861) = lu(k,1861) - lu(k,1277) * lu(k,1855) + lu(k,1862) = lu(k,1862) - lu(k,1278) * lu(k,1855) + lu(k,1865) = lu(k,1865) - lu(k,1279) * lu(k,1855) + lu(k,1866) = lu(k,1866) - lu(k,1280) * lu(k,1855) + lu(k,1867) = lu(k,1867) - lu(k,1281) * lu(k,1855) + lu(k,1868) = lu(k,1868) - lu(k,1282) * lu(k,1855) + lu(k,1869) = lu(k,1869) - lu(k,1283) * lu(k,1855) + lu(k,1870) = lu(k,1870) - lu(k,1284) * lu(k,1855) + lu(k,1897) = lu(k,1897) - lu(k,1274) * lu(k,1896) + lu(k,1898) = lu(k,1898) - lu(k,1275) * lu(k,1896) + lu(k,1899) = lu(k,1899) - lu(k,1276) * lu(k,1896) + lu(k,1902) = lu(k,1902) - lu(k,1277) * lu(k,1896) + lu(k,1903) = lu(k,1903) - lu(k,1278) * lu(k,1896) + lu(k,1906) = lu(k,1906) - lu(k,1279) * lu(k,1896) + lu(k,1907) = lu(k,1907) - lu(k,1280) * lu(k,1896) + lu(k,1908) = lu(k,1908) - lu(k,1281) * lu(k,1896) + lu(k,1909) = lu(k,1909) - lu(k,1282) * lu(k,1896) + lu(k,1910) = lu(k,1910) - lu(k,1283) * lu(k,1896) + lu(k,1911) = lu(k,1911) - lu(k,1284) * lu(k,1896) + lu(k,1920) = lu(k,1920) - lu(k,1274) * lu(k,1919) + lu(k,1921) = lu(k,1921) - lu(k,1275) * lu(k,1919) + lu(k,1922) = lu(k,1922) - lu(k,1276) * lu(k,1919) + lu(k,1925) = lu(k,1925) - lu(k,1277) * lu(k,1919) + lu(k,1926) = lu(k,1926) - lu(k,1278) * lu(k,1919) + lu(k,1929) = lu(k,1929) - lu(k,1279) * lu(k,1919) + lu(k,1930) = lu(k,1930) - lu(k,1280) * lu(k,1919) + lu(k,1931) = lu(k,1931) - lu(k,1281) * lu(k,1919) + lu(k,1932) = lu(k,1932) - lu(k,1282) * lu(k,1919) + lu(k,1933) = lu(k,1933) - lu(k,1283) * lu(k,1919) + lu(k,1934) = lu(k,1934) - lu(k,1284) * lu(k,1919) + lu(k,1954) = lu(k,1954) - lu(k,1274) * lu(k,1953) + lu(k,1955) = lu(k,1955) - lu(k,1275) * lu(k,1953) + lu(k,1956) = lu(k,1956) - lu(k,1276) * lu(k,1953) + lu(k,1959) = lu(k,1959) - lu(k,1277) * lu(k,1953) + lu(k,1960) = lu(k,1960) - lu(k,1278) * lu(k,1953) + lu(k,1963) = lu(k,1963) - lu(k,1279) * lu(k,1953) + lu(k,1964) = lu(k,1964) - lu(k,1280) * lu(k,1953) + lu(k,1965) = lu(k,1965) - lu(k,1281) * lu(k,1953) + lu(k,1966) = lu(k,1966) - lu(k,1282) * lu(k,1953) + lu(k,1967) = lu(k,1967) - lu(k,1283) * lu(k,1953) + lu(k,1968) = lu(k,1968) - lu(k,1284) * lu(k,1953) + lu(k,2011) = lu(k,2011) - lu(k,1274) * lu(k,2010) + lu(k,2012) = lu(k,2012) - lu(k,1275) * lu(k,2010) + lu(k,2013) = lu(k,2013) - lu(k,1276) * lu(k,2010) + lu(k,2016) = lu(k,2016) - lu(k,1277) * lu(k,2010) + lu(k,2017) = lu(k,2017) - lu(k,1278) * lu(k,2010) + lu(k,2020) = lu(k,2020) - lu(k,1279) * lu(k,2010) + lu(k,2021) = lu(k,2021) - lu(k,1280) * lu(k,2010) + lu(k,2022) = lu(k,2022) - lu(k,1281) * lu(k,2010) + lu(k,2023) = lu(k,2023) - lu(k,1282) * lu(k,2010) + lu(k,2024) = lu(k,2024) - lu(k,1283) * lu(k,2010) + lu(k,2025) = lu(k,2025) - lu(k,1284) * lu(k,2010) + lu(k,2036) = lu(k,2036) - lu(k,1274) * lu(k,2035) + lu(k,2037) = lu(k,2037) - lu(k,1275) * lu(k,2035) + lu(k,2038) = lu(k,2038) - lu(k,1276) * lu(k,2035) + lu(k,2041) = lu(k,2041) - lu(k,1277) * lu(k,2035) + lu(k,2042) = lu(k,2042) - lu(k,1278) * lu(k,2035) + lu(k,2045) = lu(k,2045) - lu(k,1279) * lu(k,2035) + lu(k,2046) = lu(k,2046) - lu(k,1280) * lu(k,2035) + lu(k,2047) = lu(k,2047) - lu(k,1281) * lu(k,2035) + lu(k,2048) = lu(k,2048) - lu(k,1282) * lu(k,2035) + lu(k,2049) = lu(k,2049) - lu(k,1283) * lu(k,2035) + lu(k,2050) = lu(k,2050) - lu(k,1284) * lu(k,2035) + lu(k,1320) = 1._r8 / lu(k,1320) + lu(k,1321) = lu(k,1321) * lu(k,1320) + lu(k,1322) = lu(k,1322) * lu(k,1320) + lu(k,1323) = lu(k,1323) * lu(k,1320) + lu(k,1324) = lu(k,1324) * lu(k,1320) + lu(k,1325) = lu(k,1325) * lu(k,1320) + lu(k,1326) = lu(k,1326) * lu(k,1320) + lu(k,1327) = lu(k,1327) * lu(k,1320) + lu(k,1328) = lu(k,1328) * lu(k,1320) + lu(k,1329) = lu(k,1329) * lu(k,1320) + lu(k,1330) = lu(k,1330) * lu(k,1320) + lu(k,1331) = lu(k,1331) * lu(k,1320) + lu(k,1332) = lu(k,1332) * lu(k,1320) + lu(k,1333) = lu(k,1333) * lu(k,1320) + lu(k,1344) = lu(k,1344) - lu(k,1321) * lu(k,1343) + lu(k,1345) = lu(k,1345) - lu(k,1322) * lu(k,1343) + lu(k,1347) = lu(k,1347) - lu(k,1323) * lu(k,1343) + lu(k,1348) = lu(k,1348) - lu(k,1324) * lu(k,1343) + lu(k,1349) = lu(k,1349) - lu(k,1325) * lu(k,1343) + lu(k,1350) = lu(k,1350) - lu(k,1326) * lu(k,1343) + lu(k,1351) = lu(k,1351) - lu(k,1327) * lu(k,1343) + lu(k,1352) = lu(k,1352) - lu(k,1328) * lu(k,1343) + lu(k,1353) = lu(k,1353) - lu(k,1329) * lu(k,1343) + lu(k,1354) = lu(k,1354) - lu(k,1330) * lu(k,1343) + lu(k,1355) = lu(k,1355) - lu(k,1331) * lu(k,1343) + lu(k,1356) = lu(k,1356) - lu(k,1332) * lu(k,1343) + lu(k,1357) = lu(k,1357) - lu(k,1333) * lu(k,1343) + lu(k,1498) = lu(k,1498) - lu(k,1321) * lu(k,1497) + lu(k,1499) = lu(k,1499) - lu(k,1322) * lu(k,1497) + lu(k,1501) = lu(k,1501) - lu(k,1323) * lu(k,1497) + lu(k,1502) = lu(k,1502) - lu(k,1324) * lu(k,1497) + lu(k,1503) = lu(k,1503) - lu(k,1325) * lu(k,1497) + lu(k,1504) = lu(k,1504) - lu(k,1326) * lu(k,1497) + lu(k,1505) = lu(k,1505) - lu(k,1327) * lu(k,1497) + lu(k,1506) = lu(k,1506) - lu(k,1328) * lu(k,1497) + lu(k,1507) = lu(k,1507) - lu(k,1329) * lu(k,1497) + lu(k,1508) = lu(k,1508) - lu(k,1330) * lu(k,1497) + lu(k,1509) = lu(k,1509) - lu(k,1331) * lu(k,1497) + lu(k,1510) = lu(k,1510) - lu(k,1332) * lu(k,1497) + lu(k,1511) = lu(k,1511) - lu(k,1333) * lu(k,1497) + lu(k,1522) = lu(k,1522) - lu(k,1321) * lu(k,1521) + lu(k,1523) = lu(k,1523) - lu(k,1322) * lu(k,1521) + lu(k,1525) = lu(k,1525) - lu(k,1323) * lu(k,1521) + lu(k,1526) = lu(k,1526) - lu(k,1324) * lu(k,1521) + lu(k,1527) = lu(k,1527) - lu(k,1325) * lu(k,1521) + lu(k,1528) = lu(k,1528) - lu(k,1326) * lu(k,1521) + lu(k,1529) = lu(k,1529) - lu(k,1327) * lu(k,1521) + lu(k,1530) = lu(k,1530) - lu(k,1328) * lu(k,1521) + lu(k,1531) = lu(k,1531) - lu(k,1329) * lu(k,1521) + lu(k,1532) = lu(k,1532) - lu(k,1330) * lu(k,1521) + lu(k,1533) = lu(k,1533) - lu(k,1331) * lu(k,1521) + lu(k,1534) = lu(k,1534) - lu(k,1332) * lu(k,1521) + lu(k,1535) = lu(k,1535) - lu(k,1333) * lu(k,1521) + lu(k,1545) = lu(k,1545) - lu(k,1321) * lu(k,1544) + lu(k,1546) = lu(k,1546) - lu(k,1322) * lu(k,1544) + lu(k,1548) = lu(k,1548) - lu(k,1323) * lu(k,1544) + lu(k,1549) = lu(k,1549) - lu(k,1324) * lu(k,1544) + lu(k,1550) = lu(k,1550) - lu(k,1325) * lu(k,1544) + lu(k,1551) = - lu(k,1326) * lu(k,1544) + lu(k,1552) = lu(k,1552) - lu(k,1327) * lu(k,1544) + lu(k,1553) = lu(k,1553) - lu(k,1328) * lu(k,1544) + lu(k,1554) = lu(k,1554) - lu(k,1329) * lu(k,1544) + lu(k,1555) = lu(k,1555) - lu(k,1330) * lu(k,1544) + lu(k,1556) = lu(k,1556) - lu(k,1331) * lu(k,1544) + lu(k,1557) = lu(k,1557) - lu(k,1332) * lu(k,1544) + lu(k,1558) = lu(k,1558) - lu(k,1333) * lu(k,1544) + lu(k,1575) = lu(k,1575) - lu(k,1321) * lu(k,1574) + lu(k,1576) = lu(k,1576) - lu(k,1322) * lu(k,1574) + lu(k,1578) = lu(k,1578) - lu(k,1323) * lu(k,1574) + lu(k,1579) = lu(k,1579) - lu(k,1324) * lu(k,1574) + lu(k,1580) = lu(k,1580) - lu(k,1325) * lu(k,1574) + lu(k,1581) = lu(k,1581) - lu(k,1326) * lu(k,1574) + lu(k,1582) = lu(k,1582) - lu(k,1327) * lu(k,1574) + lu(k,1583) = lu(k,1583) - lu(k,1328) * lu(k,1574) + lu(k,1584) = lu(k,1584) - lu(k,1329) * lu(k,1574) + lu(k,1585) = lu(k,1585) - lu(k,1330) * lu(k,1574) + lu(k,1586) = lu(k,1586) - lu(k,1331) * lu(k,1574) + lu(k,1587) = lu(k,1587) - lu(k,1332) * lu(k,1574) + lu(k,1588) = lu(k,1588) - lu(k,1333) * lu(k,1574) + lu(k,1681) = lu(k,1681) - lu(k,1321) * lu(k,1680) + lu(k,1682) = lu(k,1682) - lu(k,1322) * lu(k,1680) + lu(k,1684) = lu(k,1684) - lu(k,1323) * lu(k,1680) + lu(k,1685) = lu(k,1685) - lu(k,1324) * lu(k,1680) + lu(k,1686) = lu(k,1686) - lu(k,1325) * lu(k,1680) + lu(k,1687) = lu(k,1687) - lu(k,1326) * lu(k,1680) + lu(k,1688) = lu(k,1688) - lu(k,1327) * lu(k,1680) + lu(k,1689) = lu(k,1689) - lu(k,1328) * lu(k,1680) + lu(k,1690) = lu(k,1690) - lu(k,1329) * lu(k,1680) + lu(k,1691) = lu(k,1691) - lu(k,1330) * lu(k,1680) + lu(k,1692) = lu(k,1692) - lu(k,1331) * lu(k,1680) + lu(k,1693) = lu(k,1693) - lu(k,1332) * lu(k,1680) + lu(k,1694) = lu(k,1694) - lu(k,1333) * lu(k,1680) + lu(k,1707) = lu(k,1707) - lu(k,1321) * lu(k,1706) + lu(k,1708) = lu(k,1708) - lu(k,1322) * lu(k,1706) + lu(k,1710) = lu(k,1710) - lu(k,1323) * lu(k,1706) + lu(k,1711) = lu(k,1711) - lu(k,1324) * lu(k,1706) + lu(k,1712) = lu(k,1712) - lu(k,1325) * lu(k,1706) + lu(k,1713) = lu(k,1713) - lu(k,1326) * lu(k,1706) + lu(k,1714) = lu(k,1714) - lu(k,1327) * lu(k,1706) + lu(k,1715) = lu(k,1715) - lu(k,1328) * lu(k,1706) + lu(k,1716) = lu(k,1716) - lu(k,1329) * lu(k,1706) + lu(k,1717) = lu(k,1717) - lu(k,1330) * lu(k,1706) + lu(k,1718) = lu(k,1718) - lu(k,1331) * lu(k,1706) + lu(k,1719) = lu(k,1719) - lu(k,1332) * lu(k,1706) + lu(k,1720) = lu(k,1720) - lu(k,1333) * lu(k,1706) + lu(k,1797) = lu(k,1797) - lu(k,1321) * lu(k,1796) + lu(k,1798) = lu(k,1798) - lu(k,1322) * lu(k,1796) + lu(k,1800) = lu(k,1800) - lu(k,1323) * lu(k,1796) + lu(k,1801) = lu(k,1801) - lu(k,1324) * lu(k,1796) + lu(k,1802) = lu(k,1802) - lu(k,1325) * lu(k,1796) + lu(k,1803) = lu(k,1803) - lu(k,1326) * lu(k,1796) + lu(k,1804) = lu(k,1804) - lu(k,1327) * lu(k,1796) + lu(k,1805) = lu(k,1805) - lu(k,1328) * lu(k,1796) + lu(k,1806) = lu(k,1806) - lu(k,1329) * lu(k,1796) + lu(k,1807) = lu(k,1807) - lu(k,1330) * lu(k,1796) + lu(k,1808) = lu(k,1808) - lu(k,1331) * lu(k,1796) + lu(k,1809) = lu(k,1809) - lu(k,1332) * lu(k,1796) + lu(k,1810) = lu(k,1810) - lu(k,1333) * lu(k,1796) + lu(k,1857) = lu(k,1857) - lu(k,1321) * lu(k,1856) + lu(k,1858) = lu(k,1858) - lu(k,1322) * lu(k,1856) + lu(k,1860) = lu(k,1860) - lu(k,1323) * lu(k,1856) + lu(k,1861) = lu(k,1861) - lu(k,1324) * lu(k,1856) + lu(k,1862) = lu(k,1862) - lu(k,1325) * lu(k,1856) + lu(k,1863) = lu(k,1863) - lu(k,1326) * lu(k,1856) + lu(k,1864) = lu(k,1864) - lu(k,1327) * lu(k,1856) + lu(k,1865) = lu(k,1865) - lu(k,1328) * lu(k,1856) + lu(k,1866) = lu(k,1866) - lu(k,1329) * lu(k,1856) + lu(k,1867) = lu(k,1867) - lu(k,1330) * lu(k,1856) + lu(k,1868) = lu(k,1868) - lu(k,1331) * lu(k,1856) + lu(k,1869) = lu(k,1869) - lu(k,1332) * lu(k,1856) + lu(k,1870) = lu(k,1870) - lu(k,1333) * lu(k,1856) + lu(k,1898) = lu(k,1898) - lu(k,1321) * lu(k,1897) + lu(k,1899) = lu(k,1899) - lu(k,1322) * lu(k,1897) + lu(k,1901) = lu(k,1901) - lu(k,1323) * lu(k,1897) + lu(k,1902) = lu(k,1902) - lu(k,1324) * lu(k,1897) + lu(k,1903) = lu(k,1903) - lu(k,1325) * lu(k,1897) + lu(k,1904) = lu(k,1904) - lu(k,1326) * lu(k,1897) + lu(k,1905) = lu(k,1905) - lu(k,1327) * lu(k,1897) + lu(k,1906) = lu(k,1906) - lu(k,1328) * lu(k,1897) + lu(k,1907) = lu(k,1907) - lu(k,1329) * lu(k,1897) + lu(k,1908) = lu(k,1908) - lu(k,1330) * lu(k,1897) + lu(k,1909) = lu(k,1909) - lu(k,1331) * lu(k,1897) + lu(k,1910) = lu(k,1910) - lu(k,1332) * lu(k,1897) + lu(k,1911) = lu(k,1911) - lu(k,1333) * lu(k,1897) + lu(k,1921) = lu(k,1921) - lu(k,1321) * lu(k,1920) + lu(k,1922) = lu(k,1922) - lu(k,1322) * lu(k,1920) + lu(k,1924) = lu(k,1924) - lu(k,1323) * lu(k,1920) + lu(k,1925) = lu(k,1925) - lu(k,1324) * lu(k,1920) + lu(k,1926) = lu(k,1926) - lu(k,1325) * lu(k,1920) + lu(k,1927) = lu(k,1927) - lu(k,1326) * lu(k,1920) + lu(k,1928) = - lu(k,1327) * lu(k,1920) + lu(k,1929) = lu(k,1929) - lu(k,1328) * lu(k,1920) + lu(k,1930) = lu(k,1930) - lu(k,1329) * lu(k,1920) + lu(k,1931) = lu(k,1931) - lu(k,1330) * lu(k,1920) + lu(k,1932) = lu(k,1932) - lu(k,1331) * lu(k,1920) + lu(k,1933) = lu(k,1933) - lu(k,1332) * lu(k,1920) + lu(k,1934) = lu(k,1934) - lu(k,1333) * lu(k,1920) + lu(k,1955) = lu(k,1955) - lu(k,1321) * lu(k,1954) + lu(k,1956) = lu(k,1956) - lu(k,1322) * lu(k,1954) + lu(k,1958) = lu(k,1958) - lu(k,1323) * lu(k,1954) + lu(k,1959) = lu(k,1959) - lu(k,1324) * lu(k,1954) + lu(k,1960) = lu(k,1960) - lu(k,1325) * lu(k,1954) + lu(k,1961) = lu(k,1961) - lu(k,1326) * lu(k,1954) + lu(k,1962) = lu(k,1962) - lu(k,1327) * lu(k,1954) + lu(k,1963) = lu(k,1963) - lu(k,1328) * lu(k,1954) + lu(k,1964) = lu(k,1964) - lu(k,1329) * lu(k,1954) + lu(k,1965) = lu(k,1965) - lu(k,1330) * lu(k,1954) + lu(k,1966) = lu(k,1966) - lu(k,1331) * lu(k,1954) + lu(k,1967) = lu(k,1967) - lu(k,1332) * lu(k,1954) + lu(k,1968) = lu(k,1968) - lu(k,1333) * lu(k,1954) + lu(k,2012) = lu(k,2012) - lu(k,1321) * lu(k,2011) + lu(k,2013) = lu(k,2013) - lu(k,1322) * lu(k,2011) + lu(k,2015) = lu(k,2015) - lu(k,1323) * lu(k,2011) + lu(k,2016) = lu(k,2016) - lu(k,1324) * lu(k,2011) + lu(k,2017) = lu(k,2017) - lu(k,1325) * lu(k,2011) + lu(k,2018) = lu(k,2018) - lu(k,1326) * lu(k,2011) + lu(k,2019) = lu(k,2019) - lu(k,1327) * lu(k,2011) + lu(k,2020) = lu(k,2020) - lu(k,1328) * lu(k,2011) + lu(k,2021) = lu(k,2021) - lu(k,1329) * lu(k,2011) + lu(k,2022) = lu(k,2022) - lu(k,1330) * lu(k,2011) + lu(k,2023) = lu(k,2023) - lu(k,1331) * lu(k,2011) + lu(k,2024) = lu(k,2024) - lu(k,1332) * lu(k,2011) + lu(k,2025) = lu(k,2025) - lu(k,1333) * lu(k,2011) + lu(k,2037) = lu(k,2037) - lu(k,1321) * lu(k,2036) + lu(k,2038) = lu(k,2038) - lu(k,1322) * lu(k,2036) + lu(k,2040) = lu(k,2040) - lu(k,1323) * lu(k,2036) + lu(k,2041) = lu(k,2041) - lu(k,1324) * lu(k,2036) + lu(k,2042) = lu(k,2042) - lu(k,1325) * lu(k,2036) + lu(k,2043) = lu(k,2043) - lu(k,1326) * lu(k,2036) + lu(k,2044) = lu(k,2044) - lu(k,1327) * lu(k,2036) + lu(k,2045) = lu(k,2045) - lu(k,1328) * lu(k,2036) + lu(k,2046) = lu(k,2046) - lu(k,1329) * lu(k,2036) + lu(k,2047) = lu(k,2047) - lu(k,1330) * lu(k,2036) + lu(k,2048) = lu(k,2048) - lu(k,1331) * lu(k,2036) + lu(k,2049) = lu(k,2049) - lu(k,1332) * lu(k,2036) + lu(k,2050) = lu(k,2050) - lu(k,1333) * lu(k,2036) + lu(k,1344) = 1._r8 / lu(k,1344) + lu(k,1345) = lu(k,1345) * lu(k,1344) + lu(k,1346) = lu(k,1346) * lu(k,1344) + lu(k,1347) = lu(k,1347) * lu(k,1344) + lu(k,1348) = lu(k,1348) * lu(k,1344) + lu(k,1349) = lu(k,1349) * lu(k,1344) + lu(k,1350) = lu(k,1350) * lu(k,1344) + lu(k,1351) = lu(k,1351) * lu(k,1344) + lu(k,1352) = lu(k,1352) * lu(k,1344) + lu(k,1353) = lu(k,1353) * lu(k,1344) + lu(k,1354) = lu(k,1354) * lu(k,1344) + lu(k,1355) = lu(k,1355) * lu(k,1344) + lu(k,1356) = lu(k,1356) * lu(k,1344) + lu(k,1357) = lu(k,1357) * lu(k,1344) + lu(k,1499) = lu(k,1499) - lu(k,1345) * lu(k,1498) + lu(k,1500) = lu(k,1500) - lu(k,1346) * lu(k,1498) + lu(k,1501) = lu(k,1501) - lu(k,1347) * lu(k,1498) + lu(k,1502) = lu(k,1502) - lu(k,1348) * lu(k,1498) + lu(k,1503) = lu(k,1503) - lu(k,1349) * lu(k,1498) + lu(k,1504) = lu(k,1504) - lu(k,1350) * lu(k,1498) + lu(k,1505) = lu(k,1505) - lu(k,1351) * lu(k,1498) + lu(k,1506) = lu(k,1506) - lu(k,1352) * lu(k,1498) + lu(k,1507) = lu(k,1507) - lu(k,1353) * lu(k,1498) + lu(k,1508) = lu(k,1508) - lu(k,1354) * lu(k,1498) + lu(k,1509) = lu(k,1509) - lu(k,1355) * lu(k,1498) + lu(k,1510) = lu(k,1510) - lu(k,1356) * lu(k,1498) + lu(k,1511) = lu(k,1511) - lu(k,1357) * lu(k,1498) + lu(k,1523) = lu(k,1523) - lu(k,1345) * lu(k,1522) + lu(k,1524) = lu(k,1524) - lu(k,1346) * lu(k,1522) + lu(k,1525) = lu(k,1525) - lu(k,1347) * lu(k,1522) + lu(k,1526) = lu(k,1526) - lu(k,1348) * lu(k,1522) + lu(k,1527) = lu(k,1527) - lu(k,1349) * lu(k,1522) + lu(k,1528) = lu(k,1528) - lu(k,1350) * lu(k,1522) + lu(k,1529) = lu(k,1529) - lu(k,1351) * lu(k,1522) + lu(k,1530) = lu(k,1530) - lu(k,1352) * lu(k,1522) + lu(k,1531) = lu(k,1531) - lu(k,1353) * lu(k,1522) + lu(k,1532) = lu(k,1532) - lu(k,1354) * lu(k,1522) + lu(k,1533) = lu(k,1533) - lu(k,1355) * lu(k,1522) + lu(k,1534) = lu(k,1534) - lu(k,1356) * lu(k,1522) + lu(k,1535) = lu(k,1535) - lu(k,1357) * lu(k,1522) + lu(k,1546) = lu(k,1546) - lu(k,1345) * lu(k,1545) + lu(k,1547) = lu(k,1547) - lu(k,1346) * lu(k,1545) + lu(k,1548) = lu(k,1548) - lu(k,1347) * lu(k,1545) + lu(k,1549) = lu(k,1549) - lu(k,1348) * lu(k,1545) + lu(k,1550) = lu(k,1550) - lu(k,1349) * lu(k,1545) + lu(k,1551) = lu(k,1551) - lu(k,1350) * lu(k,1545) + lu(k,1552) = lu(k,1552) - lu(k,1351) * lu(k,1545) + lu(k,1553) = lu(k,1553) - lu(k,1352) * lu(k,1545) + lu(k,1554) = lu(k,1554) - lu(k,1353) * lu(k,1545) + lu(k,1555) = lu(k,1555) - lu(k,1354) * lu(k,1545) + lu(k,1556) = lu(k,1556) - lu(k,1355) * lu(k,1545) + lu(k,1557) = lu(k,1557) - lu(k,1356) * lu(k,1545) + lu(k,1558) = lu(k,1558) - lu(k,1357) * lu(k,1545) + lu(k,1576) = lu(k,1576) - lu(k,1345) * lu(k,1575) + lu(k,1577) = lu(k,1577) - lu(k,1346) * lu(k,1575) + lu(k,1578) = lu(k,1578) - lu(k,1347) * lu(k,1575) + lu(k,1579) = lu(k,1579) - lu(k,1348) * lu(k,1575) + lu(k,1580) = lu(k,1580) - lu(k,1349) * lu(k,1575) + lu(k,1581) = lu(k,1581) - lu(k,1350) * lu(k,1575) + lu(k,1582) = lu(k,1582) - lu(k,1351) * lu(k,1575) + lu(k,1583) = lu(k,1583) - lu(k,1352) * lu(k,1575) + lu(k,1584) = lu(k,1584) - lu(k,1353) * lu(k,1575) + lu(k,1585) = lu(k,1585) - lu(k,1354) * lu(k,1575) + lu(k,1586) = lu(k,1586) - lu(k,1355) * lu(k,1575) + lu(k,1587) = lu(k,1587) - lu(k,1356) * lu(k,1575) + lu(k,1588) = lu(k,1588) - lu(k,1357) * lu(k,1575) + lu(k,1682) = lu(k,1682) - lu(k,1345) * lu(k,1681) + lu(k,1683) = lu(k,1683) - lu(k,1346) * lu(k,1681) + lu(k,1684) = lu(k,1684) - lu(k,1347) * lu(k,1681) + lu(k,1685) = lu(k,1685) - lu(k,1348) * lu(k,1681) + lu(k,1686) = lu(k,1686) - lu(k,1349) * lu(k,1681) + lu(k,1687) = lu(k,1687) - lu(k,1350) * lu(k,1681) + lu(k,1688) = lu(k,1688) - lu(k,1351) * lu(k,1681) + lu(k,1689) = lu(k,1689) - lu(k,1352) * lu(k,1681) + lu(k,1690) = lu(k,1690) - lu(k,1353) * lu(k,1681) + lu(k,1691) = lu(k,1691) - lu(k,1354) * lu(k,1681) + lu(k,1692) = lu(k,1692) - lu(k,1355) * lu(k,1681) + lu(k,1693) = lu(k,1693) - lu(k,1356) * lu(k,1681) + lu(k,1694) = lu(k,1694) - lu(k,1357) * lu(k,1681) + lu(k,1708) = lu(k,1708) - lu(k,1345) * lu(k,1707) + lu(k,1709) = lu(k,1709) - lu(k,1346) * lu(k,1707) + lu(k,1710) = lu(k,1710) - lu(k,1347) * lu(k,1707) + lu(k,1711) = lu(k,1711) - lu(k,1348) * lu(k,1707) + lu(k,1712) = lu(k,1712) - lu(k,1349) * lu(k,1707) + lu(k,1713) = lu(k,1713) - lu(k,1350) * lu(k,1707) + lu(k,1714) = lu(k,1714) - lu(k,1351) * lu(k,1707) + lu(k,1715) = lu(k,1715) - lu(k,1352) * lu(k,1707) + lu(k,1716) = lu(k,1716) - lu(k,1353) * lu(k,1707) + lu(k,1717) = lu(k,1717) - lu(k,1354) * lu(k,1707) + lu(k,1718) = lu(k,1718) - lu(k,1355) * lu(k,1707) + lu(k,1719) = lu(k,1719) - lu(k,1356) * lu(k,1707) + lu(k,1720) = lu(k,1720) - lu(k,1357) * lu(k,1707) + lu(k,1798) = lu(k,1798) - lu(k,1345) * lu(k,1797) + lu(k,1799) = lu(k,1799) - lu(k,1346) * lu(k,1797) + lu(k,1800) = lu(k,1800) - lu(k,1347) * lu(k,1797) + lu(k,1801) = lu(k,1801) - lu(k,1348) * lu(k,1797) + lu(k,1802) = lu(k,1802) - lu(k,1349) * lu(k,1797) + lu(k,1803) = lu(k,1803) - lu(k,1350) * lu(k,1797) + lu(k,1804) = lu(k,1804) - lu(k,1351) * lu(k,1797) + lu(k,1805) = lu(k,1805) - lu(k,1352) * lu(k,1797) + lu(k,1806) = lu(k,1806) - lu(k,1353) * lu(k,1797) + lu(k,1807) = lu(k,1807) - lu(k,1354) * lu(k,1797) + lu(k,1808) = lu(k,1808) - lu(k,1355) * lu(k,1797) + lu(k,1809) = lu(k,1809) - lu(k,1356) * lu(k,1797) + lu(k,1810) = lu(k,1810) - lu(k,1357) * lu(k,1797) + lu(k,1858) = lu(k,1858) - lu(k,1345) * lu(k,1857) + lu(k,1859) = lu(k,1859) - lu(k,1346) * lu(k,1857) + lu(k,1860) = lu(k,1860) - lu(k,1347) * lu(k,1857) + lu(k,1861) = lu(k,1861) - lu(k,1348) * lu(k,1857) + lu(k,1862) = lu(k,1862) - lu(k,1349) * lu(k,1857) + lu(k,1863) = lu(k,1863) - lu(k,1350) * lu(k,1857) + lu(k,1864) = lu(k,1864) - lu(k,1351) * lu(k,1857) + lu(k,1865) = lu(k,1865) - lu(k,1352) * lu(k,1857) + lu(k,1866) = lu(k,1866) - lu(k,1353) * lu(k,1857) + lu(k,1867) = lu(k,1867) - lu(k,1354) * lu(k,1857) + lu(k,1868) = lu(k,1868) - lu(k,1355) * lu(k,1857) + lu(k,1869) = lu(k,1869) - lu(k,1356) * lu(k,1857) + lu(k,1870) = lu(k,1870) - lu(k,1357) * lu(k,1857) + lu(k,1899) = lu(k,1899) - lu(k,1345) * lu(k,1898) + lu(k,1900) = lu(k,1900) - lu(k,1346) * lu(k,1898) + lu(k,1901) = lu(k,1901) - lu(k,1347) * lu(k,1898) + lu(k,1902) = lu(k,1902) - lu(k,1348) * lu(k,1898) + lu(k,1903) = lu(k,1903) - lu(k,1349) * lu(k,1898) + lu(k,1904) = lu(k,1904) - lu(k,1350) * lu(k,1898) + lu(k,1905) = lu(k,1905) - lu(k,1351) * lu(k,1898) + lu(k,1906) = lu(k,1906) - lu(k,1352) * lu(k,1898) + lu(k,1907) = lu(k,1907) - lu(k,1353) * lu(k,1898) + lu(k,1908) = lu(k,1908) - lu(k,1354) * lu(k,1898) + lu(k,1909) = lu(k,1909) - lu(k,1355) * lu(k,1898) + lu(k,1910) = lu(k,1910) - lu(k,1356) * lu(k,1898) + lu(k,1911) = lu(k,1911) - lu(k,1357) * lu(k,1898) + lu(k,1922) = lu(k,1922) - lu(k,1345) * lu(k,1921) + lu(k,1923) = lu(k,1923) - lu(k,1346) * lu(k,1921) + lu(k,1924) = lu(k,1924) - lu(k,1347) * lu(k,1921) + lu(k,1925) = lu(k,1925) - lu(k,1348) * lu(k,1921) + lu(k,1926) = lu(k,1926) - lu(k,1349) * lu(k,1921) + lu(k,1927) = lu(k,1927) - lu(k,1350) * lu(k,1921) + lu(k,1928) = lu(k,1928) - lu(k,1351) * lu(k,1921) + lu(k,1929) = lu(k,1929) - lu(k,1352) * lu(k,1921) + lu(k,1930) = lu(k,1930) - lu(k,1353) * lu(k,1921) + lu(k,1931) = lu(k,1931) - lu(k,1354) * lu(k,1921) + lu(k,1932) = lu(k,1932) - lu(k,1355) * lu(k,1921) + lu(k,1933) = lu(k,1933) - lu(k,1356) * lu(k,1921) + lu(k,1934) = lu(k,1934) - lu(k,1357) * lu(k,1921) + lu(k,1956) = lu(k,1956) - lu(k,1345) * lu(k,1955) + lu(k,1957) = lu(k,1957) - lu(k,1346) * lu(k,1955) + lu(k,1958) = lu(k,1958) - lu(k,1347) * lu(k,1955) + lu(k,1959) = lu(k,1959) - lu(k,1348) * lu(k,1955) + lu(k,1960) = lu(k,1960) - lu(k,1349) * lu(k,1955) + lu(k,1961) = lu(k,1961) - lu(k,1350) * lu(k,1955) + lu(k,1962) = lu(k,1962) - lu(k,1351) * lu(k,1955) + lu(k,1963) = lu(k,1963) - lu(k,1352) * lu(k,1955) + lu(k,1964) = lu(k,1964) - lu(k,1353) * lu(k,1955) + lu(k,1965) = lu(k,1965) - lu(k,1354) * lu(k,1955) + lu(k,1966) = lu(k,1966) - lu(k,1355) * lu(k,1955) + lu(k,1967) = lu(k,1967) - lu(k,1356) * lu(k,1955) + lu(k,1968) = lu(k,1968) - lu(k,1357) * lu(k,1955) + lu(k,2013) = lu(k,2013) - lu(k,1345) * lu(k,2012) + lu(k,2014) = lu(k,2014) - lu(k,1346) * lu(k,2012) + lu(k,2015) = lu(k,2015) - lu(k,1347) * lu(k,2012) + lu(k,2016) = lu(k,2016) - lu(k,1348) * lu(k,2012) + lu(k,2017) = lu(k,2017) - lu(k,1349) * lu(k,2012) + lu(k,2018) = lu(k,2018) - lu(k,1350) * lu(k,2012) + lu(k,2019) = lu(k,2019) - lu(k,1351) * lu(k,2012) + lu(k,2020) = lu(k,2020) - lu(k,1352) * lu(k,2012) + lu(k,2021) = lu(k,2021) - lu(k,1353) * lu(k,2012) + lu(k,2022) = lu(k,2022) - lu(k,1354) * lu(k,2012) + lu(k,2023) = lu(k,2023) - lu(k,1355) * lu(k,2012) + lu(k,2024) = lu(k,2024) - lu(k,1356) * lu(k,2012) + lu(k,2025) = lu(k,2025) - lu(k,1357) * lu(k,2012) + lu(k,2038) = lu(k,2038) - lu(k,1345) * lu(k,2037) + lu(k,2039) = lu(k,2039) - lu(k,1346) * lu(k,2037) + lu(k,2040) = lu(k,2040) - lu(k,1347) * lu(k,2037) + lu(k,2041) = lu(k,2041) - lu(k,1348) * lu(k,2037) + lu(k,2042) = lu(k,2042) - lu(k,1349) * lu(k,2037) + lu(k,2043) = lu(k,2043) - lu(k,1350) * lu(k,2037) + lu(k,2044) = lu(k,2044) - lu(k,1351) * lu(k,2037) + lu(k,2045) = lu(k,2045) - lu(k,1352) * lu(k,2037) + lu(k,2046) = lu(k,2046) - lu(k,1353) * lu(k,2037) + lu(k,2047) = lu(k,2047) - lu(k,1354) * lu(k,2037) + lu(k,2048) = lu(k,2048) - lu(k,1355) * lu(k,2037) + lu(k,2049) = lu(k,2049) - lu(k,1356) * lu(k,2037) + lu(k,2050) = lu(k,2050) - lu(k,1357) * lu(k,2037) + lu(k,1499) = 1._r8 / lu(k,1499) + lu(k,1500) = lu(k,1500) * lu(k,1499) + lu(k,1501) = lu(k,1501) * lu(k,1499) + lu(k,1502) = lu(k,1502) * lu(k,1499) + lu(k,1503) = lu(k,1503) * lu(k,1499) + lu(k,1504) = lu(k,1504) * lu(k,1499) + lu(k,1505) = lu(k,1505) * lu(k,1499) + lu(k,1506) = lu(k,1506) * lu(k,1499) + lu(k,1507) = lu(k,1507) * lu(k,1499) + lu(k,1508) = lu(k,1508) * lu(k,1499) + lu(k,1509) = lu(k,1509) * lu(k,1499) + lu(k,1510) = lu(k,1510) * lu(k,1499) + lu(k,1511) = lu(k,1511) * lu(k,1499) + lu(k,1524) = lu(k,1524) - lu(k,1500) * lu(k,1523) + lu(k,1525) = lu(k,1525) - lu(k,1501) * lu(k,1523) + lu(k,1526) = lu(k,1526) - lu(k,1502) * lu(k,1523) + lu(k,1527) = lu(k,1527) - lu(k,1503) * lu(k,1523) + lu(k,1528) = lu(k,1528) - lu(k,1504) * lu(k,1523) + lu(k,1529) = lu(k,1529) - lu(k,1505) * lu(k,1523) + lu(k,1530) = lu(k,1530) - lu(k,1506) * lu(k,1523) + lu(k,1531) = lu(k,1531) - lu(k,1507) * lu(k,1523) + lu(k,1532) = lu(k,1532) - lu(k,1508) * lu(k,1523) + lu(k,1533) = lu(k,1533) - lu(k,1509) * lu(k,1523) + lu(k,1534) = lu(k,1534) - lu(k,1510) * lu(k,1523) + lu(k,1535) = lu(k,1535) - lu(k,1511) * lu(k,1523) + lu(k,1547) = lu(k,1547) - lu(k,1500) * lu(k,1546) + lu(k,1548) = lu(k,1548) - lu(k,1501) * lu(k,1546) + lu(k,1549) = lu(k,1549) - lu(k,1502) * lu(k,1546) + lu(k,1550) = lu(k,1550) - lu(k,1503) * lu(k,1546) + lu(k,1551) = lu(k,1551) - lu(k,1504) * lu(k,1546) + lu(k,1552) = lu(k,1552) - lu(k,1505) * lu(k,1546) + lu(k,1553) = lu(k,1553) - lu(k,1506) * lu(k,1546) + lu(k,1554) = lu(k,1554) - lu(k,1507) * lu(k,1546) + lu(k,1555) = lu(k,1555) - lu(k,1508) * lu(k,1546) + lu(k,1556) = lu(k,1556) - lu(k,1509) * lu(k,1546) + lu(k,1557) = lu(k,1557) - lu(k,1510) * lu(k,1546) + lu(k,1558) = lu(k,1558) - lu(k,1511) * lu(k,1546) + lu(k,1577) = lu(k,1577) - lu(k,1500) * lu(k,1576) + lu(k,1578) = lu(k,1578) - lu(k,1501) * lu(k,1576) + lu(k,1579) = lu(k,1579) - lu(k,1502) * lu(k,1576) + lu(k,1580) = lu(k,1580) - lu(k,1503) * lu(k,1576) + lu(k,1581) = lu(k,1581) - lu(k,1504) * lu(k,1576) + lu(k,1582) = lu(k,1582) - lu(k,1505) * lu(k,1576) + lu(k,1583) = lu(k,1583) - lu(k,1506) * lu(k,1576) + lu(k,1584) = lu(k,1584) - lu(k,1507) * lu(k,1576) + lu(k,1585) = lu(k,1585) - lu(k,1508) * lu(k,1576) + lu(k,1586) = lu(k,1586) - lu(k,1509) * lu(k,1576) + lu(k,1587) = lu(k,1587) - lu(k,1510) * lu(k,1576) + lu(k,1588) = lu(k,1588) - lu(k,1511) * lu(k,1576) + lu(k,1683) = lu(k,1683) - lu(k,1500) * lu(k,1682) + lu(k,1684) = lu(k,1684) - lu(k,1501) * lu(k,1682) + lu(k,1685) = lu(k,1685) - lu(k,1502) * lu(k,1682) + lu(k,1686) = lu(k,1686) - lu(k,1503) * lu(k,1682) + lu(k,1687) = lu(k,1687) - lu(k,1504) * lu(k,1682) + lu(k,1688) = lu(k,1688) - lu(k,1505) * lu(k,1682) + lu(k,1689) = lu(k,1689) - lu(k,1506) * lu(k,1682) + lu(k,1690) = lu(k,1690) - lu(k,1507) * lu(k,1682) + lu(k,1691) = lu(k,1691) - lu(k,1508) * lu(k,1682) + lu(k,1692) = lu(k,1692) - lu(k,1509) * lu(k,1682) + lu(k,1693) = lu(k,1693) - lu(k,1510) * lu(k,1682) + lu(k,1694) = lu(k,1694) - lu(k,1511) * lu(k,1682) + lu(k,1709) = lu(k,1709) - lu(k,1500) * lu(k,1708) + lu(k,1710) = lu(k,1710) - lu(k,1501) * lu(k,1708) + lu(k,1711) = lu(k,1711) - lu(k,1502) * lu(k,1708) + lu(k,1712) = lu(k,1712) - lu(k,1503) * lu(k,1708) + lu(k,1713) = lu(k,1713) - lu(k,1504) * lu(k,1708) + lu(k,1714) = lu(k,1714) - lu(k,1505) * lu(k,1708) + lu(k,1715) = lu(k,1715) - lu(k,1506) * lu(k,1708) + lu(k,1716) = lu(k,1716) - lu(k,1507) * lu(k,1708) + lu(k,1717) = lu(k,1717) - lu(k,1508) * lu(k,1708) + lu(k,1718) = lu(k,1718) - lu(k,1509) * lu(k,1708) + lu(k,1719) = lu(k,1719) - lu(k,1510) * lu(k,1708) + lu(k,1720) = lu(k,1720) - lu(k,1511) * lu(k,1708) + lu(k,1799) = lu(k,1799) - lu(k,1500) * lu(k,1798) + lu(k,1800) = lu(k,1800) - lu(k,1501) * lu(k,1798) + lu(k,1801) = lu(k,1801) - lu(k,1502) * lu(k,1798) + lu(k,1802) = lu(k,1802) - lu(k,1503) * lu(k,1798) + lu(k,1803) = lu(k,1803) - lu(k,1504) * lu(k,1798) + lu(k,1804) = lu(k,1804) - lu(k,1505) * lu(k,1798) + lu(k,1805) = lu(k,1805) - lu(k,1506) * lu(k,1798) + lu(k,1806) = lu(k,1806) - lu(k,1507) * lu(k,1798) + lu(k,1807) = lu(k,1807) - lu(k,1508) * lu(k,1798) + lu(k,1808) = lu(k,1808) - lu(k,1509) * lu(k,1798) + lu(k,1809) = lu(k,1809) - lu(k,1510) * lu(k,1798) + lu(k,1810) = lu(k,1810) - lu(k,1511) * lu(k,1798) + lu(k,1859) = lu(k,1859) - lu(k,1500) * lu(k,1858) + lu(k,1860) = lu(k,1860) - lu(k,1501) * lu(k,1858) + lu(k,1861) = lu(k,1861) - lu(k,1502) * lu(k,1858) + lu(k,1862) = lu(k,1862) - lu(k,1503) * lu(k,1858) + lu(k,1863) = lu(k,1863) - lu(k,1504) * lu(k,1858) + lu(k,1864) = lu(k,1864) - lu(k,1505) * lu(k,1858) + lu(k,1865) = lu(k,1865) - lu(k,1506) * lu(k,1858) + lu(k,1866) = lu(k,1866) - lu(k,1507) * lu(k,1858) + lu(k,1867) = lu(k,1867) - lu(k,1508) * lu(k,1858) + lu(k,1868) = lu(k,1868) - lu(k,1509) * lu(k,1858) + lu(k,1869) = lu(k,1869) - lu(k,1510) * lu(k,1858) + lu(k,1870) = lu(k,1870) - lu(k,1511) * lu(k,1858) + lu(k,1900) = lu(k,1900) - lu(k,1500) * lu(k,1899) + lu(k,1901) = lu(k,1901) - lu(k,1501) * lu(k,1899) + lu(k,1902) = lu(k,1902) - lu(k,1502) * lu(k,1899) + lu(k,1903) = lu(k,1903) - lu(k,1503) * lu(k,1899) + lu(k,1904) = lu(k,1904) - lu(k,1504) * lu(k,1899) + lu(k,1905) = lu(k,1905) - lu(k,1505) * lu(k,1899) + lu(k,1906) = lu(k,1906) - lu(k,1506) * lu(k,1899) + lu(k,1907) = lu(k,1907) - lu(k,1507) * lu(k,1899) + lu(k,1908) = lu(k,1908) - lu(k,1508) * lu(k,1899) + lu(k,1909) = lu(k,1909) - lu(k,1509) * lu(k,1899) + lu(k,1910) = lu(k,1910) - lu(k,1510) * lu(k,1899) + lu(k,1911) = lu(k,1911) - lu(k,1511) * lu(k,1899) + lu(k,1923) = lu(k,1923) - lu(k,1500) * lu(k,1922) + lu(k,1924) = lu(k,1924) - lu(k,1501) * lu(k,1922) + lu(k,1925) = lu(k,1925) - lu(k,1502) * lu(k,1922) + lu(k,1926) = lu(k,1926) - lu(k,1503) * lu(k,1922) + lu(k,1927) = lu(k,1927) - lu(k,1504) * lu(k,1922) + lu(k,1928) = lu(k,1928) - lu(k,1505) * lu(k,1922) + lu(k,1929) = lu(k,1929) - lu(k,1506) * lu(k,1922) + lu(k,1930) = lu(k,1930) - lu(k,1507) * lu(k,1922) + lu(k,1931) = lu(k,1931) - lu(k,1508) * lu(k,1922) + lu(k,1932) = lu(k,1932) - lu(k,1509) * lu(k,1922) + lu(k,1933) = lu(k,1933) - lu(k,1510) * lu(k,1922) + lu(k,1934) = lu(k,1934) - lu(k,1511) * lu(k,1922) + lu(k,1957) = lu(k,1957) - lu(k,1500) * lu(k,1956) + lu(k,1958) = lu(k,1958) - lu(k,1501) * lu(k,1956) + lu(k,1959) = lu(k,1959) - lu(k,1502) * lu(k,1956) + lu(k,1960) = lu(k,1960) - lu(k,1503) * lu(k,1956) + lu(k,1961) = lu(k,1961) - lu(k,1504) * lu(k,1956) + lu(k,1962) = lu(k,1962) - lu(k,1505) * lu(k,1956) + lu(k,1963) = lu(k,1963) - lu(k,1506) * lu(k,1956) + lu(k,1964) = lu(k,1964) - lu(k,1507) * lu(k,1956) + lu(k,1965) = lu(k,1965) - lu(k,1508) * lu(k,1956) + lu(k,1966) = lu(k,1966) - lu(k,1509) * lu(k,1956) + lu(k,1967) = lu(k,1967) - lu(k,1510) * lu(k,1956) + lu(k,1968) = lu(k,1968) - lu(k,1511) * lu(k,1956) + lu(k,2014) = lu(k,2014) - lu(k,1500) * lu(k,2013) + lu(k,2015) = lu(k,2015) - lu(k,1501) * lu(k,2013) + lu(k,2016) = lu(k,2016) - lu(k,1502) * lu(k,2013) + lu(k,2017) = lu(k,2017) - lu(k,1503) * lu(k,2013) + lu(k,2018) = lu(k,2018) - lu(k,1504) * lu(k,2013) + lu(k,2019) = lu(k,2019) - lu(k,1505) * lu(k,2013) + lu(k,2020) = lu(k,2020) - lu(k,1506) * lu(k,2013) + lu(k,2021) = lu(k,2021) - lu(k,1507) * lu(k,2013) + lu(k,2022) = lu(k,2022) - lu(k,1508) * lu(k,2013) + lu(k,2023) = lu(k,2023) - lu(k,1509) * lu(k,2013) + lu(k,2024) = lu(k,2024) - lu(k,1510) * lu(k,2013) + lu(k,2025) = lu(k,2025) - lu(k,1511) * lu(k,2013) + lu(k,2039) = lu(k,2039) - lu(k,1500) * lu(k,2038) + lu(k,2040) = lu(k,2040) - lu(k,1501) * lu(k,2038) + lu(k,2041) = lu(k,2041) - lu(k,1502) * lu(k,2038) + lu(k,2042) = lu(k,2042) - lu(k,1503) * lu(k,2038) + lu(k,2043) = lu(k,2043) - lu(k,1504) * lu(k,2038) + lu(k,2044) = lu(k,2044) - lu(k,1505) * lu(k,2038) + lu(k,2045) = lu(k,2045) - lu(k,1506) * lu(k,2038) + lu(k,2046) = lu(k,2046) - lu(k,1507) * lu(k,2038) + lu(k,2047) = lu(k,2047) - lu(k,1508) * lu(k,2038) + lu(k,2048) = lu(k,2048) - lu(k,1509) * lu(k,2038) + lu(k,2049) = lu(k,2049) - lu(k,1510) * lu(k,2038) + lu(k,2050) = lu(k,2050) - lu(k,1511) * lu(k,2038) + end do + end subroutine lu_fac25 + subroutine lu_fac26( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,1524) = 1._r8 / lu(k,1524) + lu(k,1525) = lu(k,1525) * lu(k,1524) + lu(k,1526) = lu(k,1526) * lu(k,1524) + lu(k,1527) = lu(k,1527) * lu(k,1524) + lu(k,1528) = lu(k,1528) * lu(k,1524) + lu(k,1529) = lu(k,1529) * lu(k,1524) + lu(k,1530) = lu(k,1530) * lu(k,1524) + lu(k,1531) = lu(k,1531) * lu(k,1524) + lu(k,1532) = lu(k,1532) * lu(k,1524) + lu(k,1533) = lu(k,1533) * lu(k,1524) + lu(k,1534) = lu(k,1534) * lu(k,1524) + lu(k,1535) = lu(k,1535) * lu(k,1524) + lu(k,1548) = lu(k,1548) - lu(k,1525) * lu(k,1547) + lu(k,1549) = lu(k,1549) - lu(k,1526) * lu(k,1547) + lu(k,1550) = lu(k,1550) - lu(k,1527) * lu(k,1547) + lu(k,1551) = lu(k,1551) - lu(k,1528) * lu(k,1547) + lu(k,1552) = lu(k,1552) - lu(k,1529) * lu(k,1547) + lu(k,1553) = lu(k,1553) - lu(k,1530) * lu(k,1547) + lu(k,1554) = lu(k,1554) - lu(k,1531) * lu(k,1547) + lu(k,1555) = lu(k,1555) - lu(k,1532) * lu(k,1547) + lu(k,1556) = lu(k,1556) - lu(k,1533) * lu(k,1547) + lu(k,1557) = lu(k,1557) - lu(k,1534) * lu(k,1547) + lu(k,1558) = lu(k,1558) - lu(k,1535) * lu(k,1547) + lu(k,1578) = lu(k,1578) - lu(k,1525) * lu(k,1577) + lu(k,1579) = lu(k,1579) - lu(k,1526) * lu(k,1577) + lu(k,1580) = lu(k,1580) - lu(k,1527) * lu(k,1577) + lu(k,1581) = lu(k,1581) - lu(k,1528) * lu(k,1577) + lu(k,1582) = lu(k,1582) - lu(k,1529) * lu(k,1577) + lu(k,1583) = lu(k,1583) - lu(k,1530) * lu(k,1577) + lu(k,1584) = lu(k,1584) - lu(k,1531) * lu(k,1577) + lu(k,1585) = lu(k,1585) - lu(k,1532) * lu(k,1577) + lu(k,1586) = lu(k,1586) - lu(k,1533) * lu(k,1577) + lu(k,1587) = lu(k,1587) - lu(k,1534) * lu(k,1577) + lu(k,1588) = lu(k,1588) - lu(k,1535) * lu(k,1577) + lu(k,1684) = lu(k,1684) - lu(k,1525) * lu(k,1683) + lu(k,1685) = lu(k,1685) - lu(k,1526) * lu(k,1683) + lu(k,1686) = lu(k,1686) - lu(k,1527) * lu(k,1683) + lu(k,1687) = lu(k,1687) - lu(k,1528) * lu(k,1683) + lu(k,1688) = lu(k,1688) - lu(k,1529) * lu(k,1683) + lu(k,1689) = lu(k,1689) - lu(k,1530) * lu(k,1683) + lu(k,1690) = lu(k,1690) - lu(k,1531) * lu(k,1683) + lu(k,1691) = lu(k,1691) - lu(k,1532) * lu(k,1683) + lu(k,1692) = lu(k,1692) - lu(k,1533) * lu(k,1683) + lu(k,1693) = lu(k,1693) - lu(k,1534) * lu(k,1683) + lu(k,1694) = lu(k,1694) - lu(k,1535) * lu(k,1683) + lu(k,1710) = lu(k,1710) - lu(k,1525) * lu(k,1709) + lu(k,1711) = lu(k,1711) - lu(k,1526) * lu(k,1709) + lu(k,1712) = lu(k,1712) - lu(k,1527) * lu(k,1709) + lu(k,1713) = lu(k,1713) - lu(k,1528) * lu(k,1709) + lu(k,1714) = lu(k,1714) - lu(k,1529) * lu(k,1709) + lu(k,1715) = lu(k,1715) - lu(k,1530) * lu(k,1709) + lu(k,1716) = lu(k,1716) - lu(k,1531) * lu(k,1709) + lu(k,1717) = lu(k,1717) - lu(k,1532) * lu(k,1709) + lu(k,1718) = lu(k,1718) - lu(k,1533) * lu(k,1709) + lu(k,1719) = lu(k,1719) - lu(k,1534) * lu(k,1709) + lu(k,1720) = lu(k,1720) - lu(k,1535) * lu(k,1709) + lu(k,1800) = lu(k,1800) - lu(k,1525) * lu(k,1799) + lu(k,1801) = lu(k,1801) - lu(k,1526) * lu(k,1799) + lu(k,1802) = lu(k,1802) - lu(k,1527) * lu(k,1799) + lu(k,1803) = lu(k,1803) - lu(k,1528) * lu(k,1799) + lu(k,1804) = lu(k,1804) - lu(k,1529) * lu(k,1799) + lu(k,1805) = lu(k,1805) - lu(k,1530) * lu(k,1799) + lu(k,1806) = lu(k,1806) - lu(k,1531) * lu(k,1799) + lu(k,1807) = lu(k,1807) - lu(k,1532) * lu(k,1799) + lu(k,1808) = lu(k,1808) - lu(k,1533) * lu(k,1799) + lu(k,1809) = lu(k,1809) - lu(k,1534) * lu(k,1799) + lu(k,1810) = lu(k,1810) - lu(k,1535) * lu(k,1799) + lu(k,1860) = lu(k,1860) - lu(k,1525) * lu(k,1859) + lu(k,1861) = lu(k,1861) - lu(k,1526) * lu(k,1859) + lu(k,1862) = lu(k,1862) - lu(k,1527) * lu(k,1859) + lu(k,1863) = lu(k,1863) - lu(k,1528) * lu(k,1859) + lu(k,1864) = lu(k,1864) - lu(k,1529) * lu(k,1859) + lu(k,1865) = lu(k,1865) - lu(k,1530) * lu(k,1859) + lu(k,1866) = lu(k,1866) - lu(k,1531) * lu(k,1859) + lu(k,1867) = lu(k,1867) - lu(k,1532) * lu(k,1859) + lu(k,1868) = lu(k,1868) - lu(k,1533) * lu(k,1859) + lu(k,1869) = lu(k,1869) - lu(k,1534) * lu(k,1859) + lu(k,1870) = lu(k,1870) - lu(k,1535) * lu(k,1859) + lu(k,1901) = lu(k,1901) - lu(k,1525) * lu(k,1900) + lu(k,1902) = lu(k,1902) - lu(k,1526) * lu(k,1900) + lu(k,1903) = lu(k,1903) - lu(k,1527) * lu(k,1900) + lu(k,1904) = lu(k,1904) - lu(k,1528) * lu(k,1900) + lu(k,1905) = lu(k,1905) - lu(k,1529) * lu(k,1900) + lu(k,1906) = lu(k,1906) - lu(k,1530) * lu(k,1900) + lu(k,1907) = lu(k,1907) - lu(k,1531) * lu(k,1900) + lu(k,1908) = lu(k,1908) - lu(k,1532) * lu(k,1900) + lu(k,1909) = lu(k,1909) - lu(k,1533) * lu(k,1900) + lu(k,1910) = lu(k,1910) - lu(k,1534) * lu(k,1900) + lu(k,1911) = lu(k,1911) - lu(k,1535) * lu(k,1900) + lu(k,1924) = lu(k,1924) - lu(k,1525) * lu(k,1923) + lu(k,1925) = lu(k,1925) - lu(k,1526) * lu(k,1923) + lu(k,1926) = lu(k,1926) - lu(k,1527) * lu(k,1923) + lu(k,1927) = lu(k,1927) - lu(k,1528) * lu(k,1923) + lu(k,1928) = lu(k,1928) - lu(k,1529) * lu(k,1923) + lu(k,1929) = lu(k,1929) - lu(k,1530) * lu(k,1923) + lu(k,1930) = lu(k,1930) - lu(k,1531) * lu(k,1923) + lu(k,1931) = lu(k,1931) - lu(k,1532) * lu(k,1923) + lu(k,1932) = lu(k,1932) - lu(k,1533) * lu(k,1923) + lu(k,1933) = lu(k,1933) - lu(k,1534) * lu(k,1923) + lu(k,1934) = lu(k,1934) - lu(k,1535) * lu(k,1923) + lu(k,1958) = lu(k,1958) - lu(k,1525) * lu(k,1957) + lu(k,1959) = lu(k,1959) - lu(k,1526) * lu(k,1957) + lu(k,1960) = lu(k,1960) - lu(k,1527) * lu(k,1957) + lu(k,1961) = lu(k,1961) - lu(k,1528) * lu(k,1957) + lu(k,1962) = lu(k,1962) - lu(k,1529) * lu(k,1957) + lu(k,1963) = lu(k,1963) - lu(k,1530) * lu(k,1957) + lu(k,1964) = lu(k,1964) - lu(k,1531) * lu(k,1957) + lu(k,1965) = lu(k,1965) - lu(k,1532) * lu(k,1957) + lu(k,1966) = lu(k,1966) - lu(k,1533) * lu(k,1957) + lu(k,1967) = lu(k,1967) - lu(k,1534) * lu(k,1957) + lu(k,1968) = lu(k,1968) - lu(k,1535) * lu(k,1957) + lu(k,2015) = lu(k,2015) - lu(k,1525) * lu(k,2014) + lu(k,2016) = lu(k,2016) - lu(k,1526) * lu(k,2014) + lu(k,2017) = lu(k,2017) - lu(k,1527) * lu(k,2014) + lu(k,2018) = lu(k,2018) - lu(k,1528) * lu(k,2014) + lu(k,2019) = lu(k,2019) - lu(k,1529) * lu(k,2014) + lu(k,2020) = lu(k,2020) - lu(k,1530) * lu(k,2014) + lu(k,2021) = lu(k,2021) - lu(k,1531) * lu(k,2014) + lu(k,2022) = lu(k,2022) - lu(k,1532) * lu(k,2014) + lu(k,2023) = lu(k,2023) - lu(k,1533) * lu(k,2014) + lu(k,2024) = lu(k,2024) - lu(k,1534) * lu(k,2014) + lu(k,2025) = lu(k,2025) - lu(k,1535) * lu(k,2014) + lu(k,2040) = lu(k,2040) - lu(k,1525) * lu(k,2039) + lu(k,2041) = lu(k,2041) - lu(k,1526) * lu(k,2039) + lu(k,2042) = lu(k,2042) - lu(k,1527) * lu(k,2039) + lu(k,2043) = lu(k,2043) - lu(k,1528) * lu(k,2039) + lu(k,2044) = lu(k,2044) - lu(k,1529) * lu(k,2039) + lu(k,2045) = lu(k,2045) - lu(k,1530) * lu(k,2039) + lu(k,2046) = lu(k,2046) - lu(k,1531) * lu(k,2039) + lu(k,2047) = lu(k,2047) - lu(k,1532) * lu(k,2039) + lu(k,2048) = lu(k,2048) - lu(k,1533) * lu(k,2039) + lu(k,2049) = lu(k,2049) - lu(k,1534) * lu(k,2039) + lu(k,2050) = lu(k,2050) - lu(k,1535) * lu(k,2039) + lu(k,1548) = 1._r8 / lu(k,1548) + lu(k,1549) = lu(k,1549) * lu(k,1548) + lu(k,1550) = lu(k,1550) * lu(k,1548) + lu(k,1551) = lu(k,1551) * lu(k,1548) + lu(k,1552) = lu(k,1552) * lu(k,1548) + lu(k,1553) = lu(k,1553) * lu(k,1548) + lu(k,1554) = lu(k,1554) * lu(k,1548) + lu(k,1555) = lu(k,1555) * lu(k,1548) + lu(k,1556) = lu(k,1556) * lu(k,1548) + lu(k,1557) = lu(k,1557) * lu(k,1548) + lu(k,1558) = lu(k,1558) * lu(k,1548) + lu(k,1579) = lu(k,1579) - lu(k,1549) * lu(k,1578) + lu(k,1580) = lu(k,1580) - lu(k,1550) * lu(k,1578) + lu(k,1581) = lu(k,1581) - lu(k,1551) * lu(k,1578) + lu(k,1582) = lu(k,1582) - lu(k,1552) * lu(k,1578) + lu(k,1583) = lu(k,1583) - lu(k,1553) * lu(k,1578) + lu(k,1584) = lu(k,1584) - lu(k,1554) * lu(k,1578) + lu(k,1585) = lu(k,1585) - lu(k,1555) * lu(k,1578) + lu(k,1586) = lu(k,1586) - lu(k,1556) * lu(k,1578) + lu(k,1587) = lu(k,1587) - lu(k,1557) * lu(k,1578) + lu(k,1588) = lu(k,1588) - lu(k,1558) * lu(k,1578) + lu(k,1685) = lu(k,1685) - lu(k,1549) * lu(k,1684) + lu(k,1686) = lu(k,1686) - lu(k,1550) * lu(k,1684) + lu(k,1687) = lu(k,1687) - lu(k,1551) * lu(k,1684) + lu(k,1688) = lu(k,1688) - lu(k,1552) * lu(k,1684) + lu(k,1689) = lu(k,1689) - lu(k,1553) * lu(k,1684) + lu(k,1690) = lu(k,1690) - lu(k,1554) * lu(k,1684) + lu(k,1691) = lu(k,1691) - lu(k,1555) * lu(k,1684) + lu(k,1692) = lu(k,1692) - lu(k,1556) * lu(k,1684) + lu(k,1693) = lu(k,1693) - lu(k,1557) * lu(k,1684) + lu(k,1694) = lu(k,1694) - lu(k,1558) * lu(k,1684) + lu(k,1711) = lu(k,1711) - lu(k,1549) * lu(k,1710) + lu(k,1712) = lu(k,1712) - lu(k,1550) * lu(k,1710) + lu(k,1713) = lu(k,1713) - lu(k,1551) * lu(k,1710) + lu(k,1714) = lu(k,1714) - lu(k,1552) * lu(k,1710) + lu(k,1715) = lu(k,1715) - lu(k,1553) * lu(k,1710) + lu(k,1716) = lu(k,1716) - lu(k,1554) * lu(k,1710) + lu(k,1717) = lu(k,1717) - lu(k,1555) * lu(k,1710) + lu(k,1718) = lu(k,1718) - lu(k,1556) * lu(k,1710) + lu(k,1719) = lu(k,1719) - lu(k,1557) * lu(k,1710) + lu(k,1720) = lu(k,1720) - lu(k,1558) * lu(k,1710) + lu(k,1801) = lu(k,1801) - lu(k,1549) * lu(k,1800) + lu(k,1802) = lu(k,1802) - lu(k,1550) * lu(k,1800) + lu(k,1803) = lu(k,1803) - lu(k,1551) * lu(k,1800) + lu(k,1804) = lu(k,1804) - lu(k,1552) * lu(k,1800) + lu(k,1805) = lu(k,1805) - lu(k,1553) * lu(k,1800) + lu(k,1806) = lu(k,1806) - lu(k,1554) * lu(k,1800) + lu(k,1807) = lu(k,1807) - lu(k,1555) * lu(k,1800) + lu(k,1808) = lu(k,1808) - lu(k,1556) * lu(k,1800) + lu(k,1809) = lu(k,1809) - lu(k,1557) * lu(k,1800) + lu(k,1810) = lu(k,1810) - lu(k,1558) * lu(k,1800) + lu(k,1861) = lu(k,1861) - lu(k,1549) * lu(k,1860) + lu(k,1862) = lu(k,1862) - lu(k,1550) * lu(k,1860) + lu(k,1863) = lu(k,1863) - lu(k,1551) * lu(k,1860) + lu(k,1864) = lu(k,1864) - lu(k,1552) * lu(k,1860) + lu(k,1865) = lu(k,1865) - lu(k,1553) * lu(k,1860) + lu(k,1866) = lu(k,1866) - lu(k,1554) * lu(k,1860) + lu(k,1867) = lu(k,1867) - lu(k,1555) * lu(k,1860) + lu(k,1868) = lu(k,1868) - lu(k,1556) * lu(k,1860) + lu(k,1869) = lu(k,1869) - lu(k,1557) * lu(k,1860) + lu(k,1870) = lu(k,1870) - lu(k,1558) * lu(k,1860) + lu(k,1902) = lu(k,1902) - lu(k,1549) * lu(k,1901) + lu(k,1903) = lu(k,1903) - lu(k,1550) * lu(k,1901) + lu(k,1904) = lu(k,1904) - lu(k,1551) * lu(k,1901) + lu(k,1905) = lu(k,1905) - lu(k,1552) * lu(k,1901) + lu(k,1906) = lu(k,1906) - lu(k,1553) * lu(k,1901) + lu(k,1907) = lu(k,1907) - lu(k,1554) * lu(k,1901) + lu(k,1908) = lu(k,1908) - lu(k,1555) * lu(k,1901) + lu(k,1909) = lu(k,1909) - lu(k,1556) * lu(k,1901) + lu(k,1910) = lu(k,1910) - lu(k,1557) * lu(k,1901) + lu(k,1911) = lu(k,1911) - lu(k,1558) * lu(k,1901) + lu(k,1925) = lu(k,1925) - lu(k,1549) * lu(k,1924) + lu(k,1926) = lu(k,1926) - lu(k,1550) * lu(k,1924) + lu(k,1927) = lu(k,1927) - lu(k,1551) * lu(k,1924) + lu(k,1928) = lu(k,1928) - lu(k,1552) * lu(k,1924) + lu(k,1929) = lu(k,1929) - lu(k,1553) * lu(k,1924) + lu(k,1930) = lu(k,1930) - lu(k,1554) * lu(k,1924) + lu(k,1931) = lu(k,1931) - lu(k,1555) * lu(k,1924) + lu(k,1932) = lu(k,1932) - lu(k,1556) * lu(k,1924) + lu(k,1933) = lu(k,1933) - lu(k,1557) * lu(k,1924) + lu(k,1934) = lu(k,1934) - lu(k,1558) * lu(k,1924) + lu(k,1959) = lu(k,1959) - lu(k,1549) * lu(k,1958) + lu(k,1960) = lu(k,1960) - lu(k,1550) * lu(k,1958) + lu(k,1961) = lu(k,1961) - lu(k,1551) * lu(k,1958) + lu(k,1962) = lu(k,1962) - lu(k,1552) * lu(k,1958) + lu(k,1963) = lu(k,1963) - lu(k,1553) * lu(k,1958) + lu(k,1964) = lu(k,1964) - lu(k,1554) * lu(k,1958) + lu(k,1965) = lu(k,1965) - lu(k,1555) * lu(k,1958) + lu(k,1966) = lu(k,1966) - lu(k,1556) * lu(k,1958) + lu(k,1967) = lu(k,1967) - lu(k,1557) * lu(k,1958) + lu(k,1968) = lu(k,1968) - lu(k,1558) * lu(k,1958) + lu(k,2016) = lu(k,2016) - lu(k,1549) * lu(k,2015) + lu(k,2017) = lu(k,2017) - lu(k,1550) * lu(k,2015) + lu(k,2018) = lu(k,2018) - lu(k,1551) * lu(k,2015) + lu(k,2019) = lu(k,2019) - lu(k,1552) * lu(k,2015) + lu(k,2020) = lu(k,2020) - lu(k,1553) * lu(k,2015) + lu(k,2021) = lu(k,2021) - lu(k,1554) * lu(k,2015) + lu(k,2022) = lu(k,2022) - lu(k,1555) * lu(k,2015) + lu(k,2023) = lu(k,2023) - lu(k,1556) * lu(k,2015) + lu(k,2024) = lu(k,2024) - lu(k,1557) * lu(k,2015) + lu(k,2025) = lu(k,2025) - lu(k,1558) * lu(k,2015) + lu(k,2041) = lu(k,2041) - lu(k,1549) * lu(k,2040) + lu(k,2042) = lu(k,2042) - lu(k,1550) * lu(k,2040) + lu(k,2043) = lu(k,2043) - lu(k,1551) * lu(k,2040) + lu(k,2044) = lu(k,2044) - lu(k,1552) * lu(k,2040) + lu(k,2045) = lu(k,2045) - lu(k,1553) * lu(k,2040) + lu(k,2046) = lu(k,2046) - lu(k,1554) * lu(k,2040) + lu(k,2047) = lu(k,2047) - lu(k,1555) * lu(k,2040) + lu(k,2048) = lu(k,2048) - lu(k,1556) * lu(k,2040) + lu(k,2049) = lu(k,2049) - lu(k,1557) * lu(k,2040) + lu(k,2050) = lu(k,2050) - lu(k,1558) * lu(k,2040) + lu(k,1579) = 1._r8 / lu(k,1579) + lu(k,1580) = lu(k,1580) * lu(k,1579) + lu(k,1581) = lu(k,1581) * lu(k,1579) + lu(k,1582) = lu(k,1582) * lu(k,1579) + lu(k,1583) = lu(k,1583) * lu(k,1579) + lu(k,1584) = lu(k,1584) * lu(k,1579) + lu(k,1585) = lu(k,1585) * lu(k,1579) + lu(k,1586) = lu(k,1586) * lu(k,1579) + lu(k,1587) = lu(k,1587) * lu(k,1579) + lu(k,1588) = lu(k,1588) * lu(k,1579) + lu(k,1686) = lu(k,1686) - lu(k,1580) * lu(k,1685) + lu(k,1687) = lu(k,1687) - lu(k,1581) * lu(k,1685) + lu(k,1688) = lu(k,1688) - lu(k,1582) * lu(k,1685) + lu(k,1689) = lu(k,1689) - lu(k,1583) * lu(k,1685) + lu(k,1690) = lu(k,1690) - lu(k,1584) * lu(k,1685) + lu(k,1691) = lu(k,1691) - lu(k,1585) * lu(k,1685) + lu(k,1692) = lu(k,1692) - lu(k,1586) * lu(k,1685) + lu(k,1693) = lu(k,1693) - lu(k,1587) * lu(k,1685) + lu(k,1694) = lu(k,1694) - lu(k,1588) * lu(k,1685) + lu(k,1712) = lu(k,1712) - lu(k,1580) * lu(k,1711) + lu(k,1713) = lu(k,1713) - lu(k,1581) * lu(k,1711) + lu(k,1714) = lu(k,1714) - lu(k,1582) * lu(k,1711) + lu(k,1715) = lu(k,1715) - lu(k,1583) * lu(k,1711) + lu(k,1716) = lu(k,1716) - lu(k,1584) * lu(k,1711) + lu(k,1717) = lu(k,1717) - lu(k,1585) * lu(k,1711) + lu(k,1718) = lu(k,1718) - lu(k,1586) * lu(k,1711) + lu(k,1719) = lu(k,1719) - lu(k,1587) * lu(k,1711) + lu(k,1720) = lu(k,1720) - lu(k,1588) * lu(k,1711) + lu(k,1802) = lu(k,1802) - lu(k,1580) * lu(k,1801) + lu(k,1803) = lu(k,1803) - lu(k,1581) * lu(k,1801) + lu(k,1804) = lu(k,1804) - lu(k,1582) * lu(k,1801) + lu(k,1805) = lu(k,1805) - lu(k,1583) * lu(k,1801) + lu(k,1806) = lu(k,1806) - lu(k,1584) * lu(k,1801) + lu(k,1807) = lu(k,1807) - lu(k,1585) * lu(k,1801) + lu(k,1808) = lu(k,1808) - lu(k,1586) * lu(k,1801) + lu(k,1809) = lu(k,1809) - lu(k,1587) * lu(k,1801) + lu(k,1810) = lu(k,1810) - lu(k,1588) * lu(k,1801) + lu(k,1862) = lu(k,1862) - lu(k,1580) * lu(k,1861) + lu(k,1863) = lu(k,1863) - lu(k,1581) * lu(k,1861) + lu(k,1864) = lu(k,1864) - lu(k,1582) * lu(k,1861) + lu(k,1865) = lu(k,1865) - lu(k,1583) * lu(k,1861) + lu(k,1866) = lu(k,1866) - lu(k,1584) * lu(k,1861) + lu(k,1867) = lu(k,1867) - lu(k,1585) * lu(k,1861) + lu(k,1868) = lu(k,1868) - lu(k,1586) * lu(k,1861) + lu(k,1869) = lu(k,1869) - lu(k,1587) * lu(k,1861) + lu(k,1870) = lu(k,1870) - lu(k,1588) * lu(k,1861) + lu(k,1903) = lu(k,1903) - lu(k,1580) * lu(k,1902) + lu(k,1904) = lu(k,1904) - lu(k,1581) * lu(k,1902) + lu(k,1905) = lu(k,1905) - lu(k,1582) * lu(k,1902) + lu(k,1906) = lu(k,1906) - lu(k,1583) * lu(k,1902) + lu(k,1907) = lu(k,1907) - lu(k,1584) * lu(k,1902) + lu(k,1908) = lu(k,1908) - lu(k,1585) * lu(k,1902) + lu(k,1909) = lu(k,1909) - lu(k,1586) * lu(k,1902) + lu(k,1910) = lu(k,1910) - lu(k,1587) * lu(k,1902) + lu(k,1911) = lu(k,1911) - lu(k,1588) * lu(k,1902) + lu(k,1926) = lu(k,1926) - lu(k,1580) * lu(k,1925) + lu(k,1927) = lu(k,1927) - lu(k,1581) * lu(k,1925) + lu(k,1928) = lu(k,1928) - lu(k,1582) * lu(k,1925) + lu(k,1929) = lu(k,1929) - lu(k,1583) * lu(k,1925) + lu(k,1930) = lu(k,1930) - lu(k,1584) * lu(k,1925) + lu(k,1931) = lu(k,1931) - lu(k,1585) * lu(k,1925) + lu(k,1932) = lu(k,1932) - lu(k,1586) * lu(k,1925) + lu(k,1933) = lu(k,1933) - lu(k,1587) * lu(k,1925) + lu(k,1934) = lu(k,1934) - lu(k,1588) * lu(k,1925) + lu(k,1960) = lu(k,1960) - lu(k,1580) * lu(k,1959) + lu(k,1961) = lu(k,1961) - lu(k,1581) * lu(k,1959) + lu(k,1962) = lu(k,1962) - lu(k,1582) * lu(k,1959) + lu(k,1963) = lu(k,1963) - lu(k,1583) * lu(k,1959) + lu(k,1964) = lu(k,1964) - lu(k,1584) * lu(k,1959) + lu(k,1965) = lu(k,1965) - lu(k,1585) * lu(k,1959) + lu(k,1966) = lu(k,1966) - lu(k,1586) * lu(k,1959) + lu(k,1967) = lu(k,1967) - lu(k,1587) * lu(k,1959) + lu(k,1968) = lu(k,1968) - lu(k,1588) * lu(k,1959) + lu(k,2017) = lu(k,2017) - lu(k,1580) * lu(k,2016) + lu(k,2018) = lu(k,2018) - lu(k,1581) * lu(k,2016) + lu(k,2019) = lu(k,2019) - lu(k,1582) * lu(k,2016) + lu(k,2020) = lu(k,2020) - lu(k,1583) * lu(k,2016) + lu(k,2021) = lu(k,2021) - lu(k,1584) * lu(k,2016) + lu(k,2022) = lu(k,2022) - lu(k,1585) * lu(k,2016) + lu(k,2023) = lu(k,2023) - lu(k,1586) * lu(k,2016) + lu(k,2024) = lu(k,2024) - lu(k,1587) * lu(k,2016) + lu(k,2025) = lu(k,2025) - lu(k,1588) * lu(k,2016) + lu(k,2042) = lu(k,2042) - lu(k,1580) * lu(k,2041) + lu(k,2043) = lu(k,2043) - lu(k,1581) * lu(k,2041) + lu(k,2044) = lu(k,2044) - lu(k,1582) * lu(k,2041) + lu(k,2045) = lu(k,2045) - lu(k,1583) * lu(k,2041) + lu(k,2046) = lu(k,2046) - lu(k,1584) * lu(k,2041) + lu(k,2047) = lu(k,2047) - lu(k,1585) * lu(k,2041) + lu(k,2048) = lu(k,2048) - lu(k,1586) * lu(k,2041) + lu(k,2049) = lu(k,2049) - lu(k,1587) * lu(k,2041) + lu(k,2050) = lu(k,2050) - lu(k,1588) * lu(k,2041) + lu(k,1686) = 1._r8 / lu(k,1686) + lu(k,1687) = lu(k,1687) * lu(k,1686) + lu(k,1688) = lu(k,1688) * lu(k,1686) + lu(k,1689) = lu(k,1689) * lu(k,1686) + lu(k,1690) = lu(k,1690) * lu(k,1686) + lu(k,1691) = lu(k,1691) * lu(k,1686) + lu(k,1692) = lu(k,1692) * lu(k,1686) + lu(k,1693) = lu(k,1693) * lu(k,1686) + lu(k,1694) = lu(k,1694) * lu(k,1686) + lu(k,1713) = lu(k,1713) - lu(k,1687) * lu(k,1712) + lu(k,1714) = lu(k,1714) - lu(k,1688) * lu(k,1712) + lu(k,1715) = lu(k,1715) - lu(k,1689) * lu(k,1712) + lu(k,1716) = lu(k,1716) - lu(k,1690) * lu(k,1712) + lu(k,1717) = lu(k,1717) - lu(k,1691) * lu(k,1712) + lu(k,1718) = lu(k,1718) - lu(k,1692) * lu(k,1712) + lu(k,1719) = lu(k,1719) - lu(k,1693) * lu(k,1712) + lu(k,1720) = lu(k,1720) - lu(k,1694) * lu(k,1712) + lu(k,1803) = lu(k,1803) - lu(k,1687) * lu(k,1802) + lu(k,1804) = lu(k,1804) - lu(k,1688) * lu(k,1802) + lu(k,1805) = lu(k,1805) - lu(k,1689) * lu(k,1802) + lu(k,1806) = lu(k,1806) - lu(k,1690) * lu(k,1802) + lu(k,1807) = lu(k,1807) - lu(k,1691) * lu(k,1802) + lu(k,1808) = lu(k,1808) - lu(k,1692) * lu(k,1802) + lu(k,1809) = lu(k,1809) - lu(k,1693) * lu(k,1802) + lu(k,1810) = lu(k,1810) - lu(k,1694) * lu(k,1802) + lu(k,1863) = lu(k,1863) - lu(k,1687) * lu(k,1862) + lu(k,1864) = lu(k,1864) - lu(k,1688) * lu(k,1862) + lu(k,1865) = lu(k,1865) - lu(k,1689) * lu(k,1862) + lu(k,1866) = lu(k,1866) - lu(k,1690) * lu(k,1862) + lu(k,1867) = lu(k,1867) - lu(k,1691) * lu(k,1862) + lu(k,1868) = lu(k,1868) - lu(k,1692) * lu(k,1862) + lu(k,1869) = lu(k,1869) - lu(k,1693) * lu(k,1862) + lu(k,1870) = lu(k,1870) - lu(k,1694) * lu(k,1862) + lu(k,1904) = lu(k,1904) - lu(k,1687) * lu(k,1903) + lu(k,1905) = lu(k,1905) - lu(k,1688) * lu(k,1903) + lu(k,1906) = lu(k,1906) - lu(k,1689) * lu(k,1903) + lu(k,1907) = lu(k,1907) - lu(k,1690) * lu(k,1903) + lu(k,1908) = lu(k,1908) - lu(k,1691) * lu(k,1903) + lu(k,1909) = lu(k,1909) - lu(k,1692) * lu(k,1903) + lu(k,1910) = lu(k,1910) - lu(k,1693) * lu(k,1903) + lu(k,1911) = lu(k,1911) - lu(k,1694) * lu(k,1903) + lu(k,1927) = lu(k,1927) - lu(k,1687) * lu(k,1926) + lu(k,1928) = lu(k,1928) - lu(k,1688) * lu(k,1926) + lu(k,1929) = lu(k,1929) - lu(k,1689) * lu(k,1926) + lu(k,1930) = lu(k,1930) - lu(k,1690) * lu(k,1926) + lu(k,1931) = lu(k,1931) - lu(k,1691) * lu(k,1926) + lu(k,1932) = lu(k,1932) - lu(k,1692) * lu(k,1926) + lu(k,1933) = lu(k,1933) - lu(k,1693) * lu(k,1926) + lu(k,1934) = lu(k,1934) - lu(k,1694) * lu(k,1926) + lu(k,1961) = lu(k,1961) - lu(k,1687) * lu(k,1960) + lu(k,1962) = lu(k,1962) - lu(k,1688) * lu(k,1960) + lu(k,1963) = lu(k,1963) - lu(k,1689) * lu(k,1960) + lu(k,1964) = lu(k,1964) - lu(k,1690) * lu(k,1960) + lu(k,1965) = lu(k,1965) - lu(k,1691) * lu(k,1960) + lu(k,1966) = lu(k,1966) - lu(k,1692) * lu(k,1960) + lu(k,1967) = lu(k,1967) - lu(k,1693) * lu(k,1960) + lu(k,1968) = lu(k,1968) - lu(k,1694) * lu(k,1960) + lu(k,2018) = lu(k,2018) - lu(k,1687) * lu(k,2017) + lu(k,2019) = lu(k,2019) - lu(k,1688) * lu(k,2017) + lu(k,2020) = lu(k,2020) - lu(k,1689) * lu(k,2017) + lu(k,2021) = lu(k,2021) - lu(k,1690) * lu(k,2017) + lu(k,2022) = lu(k,2022) - lu(k,1691) * lu(k,2017) + lu(k,2023) = lu(k,2023) - lu(k,1692) * lu(k,2017) + lu(k,2024) = lu(k,2024) - lu(k,1693) * lu(k,2017) + lu(k,2025) = lu(k,2025) - lu(k,1694) * lu(k,2017) + lu(k,2043) = lu(k,2043) - lu(k,1687) * lu(k,2042) + lu(k,2044) = lu(k,2044) - lu(k,1688) * lu(k,2042) + lu(k,2045) = lu(k,2045) - lu(k,1689) * lu(k,2042) + lu(k,2046) = lu(k,2046) - lu(k,1690) * lu(k,2042) + lu(k,2047) = lu(k,2047) - lu(k,1691) * lu(k,2042) + lu(k,2048) = lu(k,2048) - lu(k,1692) * lu(k,2042) + lu(k,2049) = lu(k,2049) - lu(k,1693) * lu(k,2042) + lu(k,2050) = lu(k,2050) - lu(k,1694) * lu(k,2042) + lu(k,1713) = 1._r8 / lu(k,1713) + lu(k,1714) = lu(k,1714) * lu(k,1713) + lu(k,1715) = lu(k,1715) * lu(k,1713) + lu(k,1716) = lu(k,1716) * lu(k,1713) + lu(k,1717) = lu(k,1717) * lu(k,1713) + lu(k,1718) = lu(k,1718) * lu(k,1713) + lu(k,1719) = lu(k,1719) * lu(k,1713) + lu(k,1720) = lu(k,1720) * lu(k,1713) + lu(k,1804) = lu(k,1804) - lu(k,1714) * lu(k,1803) + lu(k,1805) = lu(k,1805) - lu(k,1715) * lu(k,1803) + lu(k,1806) = lu(k,1806) - lu(k,1716) * lu(k,1803) + lu(k,1807) = lu(k,1807) - lu(k,1717) * lu(k,1803) + lu(k,1808) = lu(k,1808) - lu(k,1718) * lu(k,1803) + lu(k,1809) = lu(k,1809) - lu(k,1719) * lu(k,1803) + lu(k,1810) = lu(k,1810) - lu(k,1720) * lu(k,1803) + lu(k,1864) = lu(k,1864) - lu(k,1714) * lu(k,1863) + lu(k,1865) = lu(k,1865) - lu(k,1715) * lu(k,1863) + lu(k,1866) = lu(k,1866) - lu(k,1716) * lu(k,1863) + lu(k,1867) = lu(k,1867) - lu(k,1717) * lu(k,1863) + lu(k,1868) = lu(k,1868) - lu(k,1718) * lu(k,1863) + lu(k,1869) = lu(k,1869) - lu(k,1719) * lu(k,1863) + lu(k,1870) = lu(k,1870) - lu(k,1720) * lu(k,1863) + lu(k,1905) = lu(k,1905) - lu(k,1714) * lu(k,1904) + lu(k,1906) = lu(k,1906) - lu(k,1715) * lu(k,1904) + lu(k,1907) = lu(k,1907) - lu(k,1716) * lu(k,1904) + lu(k,1908) = lu(k,1908) - lu(k,1717) * lu(k,1904) + lu(k,1909) = lu(k,1909) - lu(k,1718) * lu(k,1904) + lu(k,1910) = lu(k,1910) - lu(k,1719) * lu(k,1904) + lu(k,1911) = lu(k,1911) - lu(k,1720) * lu(k,1904) + lu(k,1928) = lu(k,1928) - lu(k,1714) * lu(k,1927) + lu(k,1929) = lu(k,1929) - lu(k,1715) * lu(k,1927) + lu(k,1930) = lu(k,1930) - lu(k,1716) * lu(k,1927) + lu(k,1931) = lu(k,1931) - lu(k,1717) * lu(k,1927) + lu(k,1932) = lu(k,1932) - lu(k,1718) * lu(k,1927) + lu(k,1933) = lu(k,1933) - lu(k,1719) * lu(k,1927) + lu(k,1934) = lu(k,1934) - lu(k,1720) * lu(k,1927) + lu(k,1962) = lu(k,1962) - lu(k,1714) * lu(k,1961) + lu(k,1963) = lu(k,1963) - lu(k,1715) * lu(k,1961) + lu(k,1964) = lu(k,1964) - lu(k,1716) * lu(k,1961) + lu(k,1965) = lu(k,1965) - lu(k,1717) * lu(k,1961) + lu(k,1966) = lu(k,1966) - lu(k,1718) * lu(k,1961) + lu(k,1967) = lu(k,1967) - lu(k,1719) * lu(k,1961) + lu(k,1968) = lu(k,1968) - lu(k,1720) * lu(k,1961) + lu(k,2019) = lu(k,2019) - lu(k,1714) * lu(k,2018) + lu(k,2020) = lu(k,2020) - lu(k,1715) * lu(k,2018) + lu(k,2021) = lu(k,2021) - lu(k,1716) * lu(k,2018) + lu(k,2022) = lu(k,2022) - lu(k,1717) * lu(k,2018) + lu(k,2023) = lu(k,2023) - lu(k,1718) * lu(k,2018) + lu(k,2024) = lu(k,2024) - lu(k,1719) * lu(k,2018) + lu(k,2025) = lu(k,2025) - lu(k,1720) * lu(k,2018) + lu(k,2044) = lu(k,2044) - lu(k,1714) * lu(k,2043) + lu(k,2045) = lu(k,2045) - lu(k,1715) * lu(k,2043) + lu(k,2046) = lu(k,2046) - lu(k,1716) * lu(k,2043) + lu(k,2047) = lu(k,2047) - lu(k,1717) * lu(k,2043) + lu(k,2048) = lu(k,2048) - lu(k,1718) * lu(k,2043) + lu(k,2049) = lu(k,2049) - lu(k,1719) * lu(k,2043) + lu(k,2050) = lu(k,2050) - lu(k,1720) * lu(k,2043) + lu(k,1804) = 1._r8 / lu(k,1804) + lu(k,1805) = lu(k,1805) * lu(k,1804) + lu(k,1806) = lu(k,1806) * lu(k,1804) + lu(k,1807) = lu(k,1807) * lu(k,1804) + lu(k,1808) = lu(k,1808) * lu(k,1804) + lu(k,1809) = lu(k,1809) * lu(k,1804) + lu(k,1810) = lu(k,1810) * lu(k,1804) + lu(k,1865) = lu(k,1865) - lu(k,1805) * lu(k,1864) + lu(k,1866) = lu(k,1866) - lu(k,1806) * lu(k,1864) + lu(k,1867) = lu(k,1867) - lu(k,1807) * lu(k,1864) + lu(k,1868) = lu(k,1868) - lu(k,1808) * lu(k,1864) + lu(k,1869) = lu(k,1869) - lu(k,1809) * lu(k,1864) + lu(k,1870) = lu(k,1870) - lu(k,1810) * lu(k,1864) + lu(k,1906) = lu(k,1906) - lu(k,1805) * lu(k,1905) + lu(k,1907) = lu(k,1907) - lu(k,1806) * lu(k,1905) + lu(k,1908) = lu(k,1908) - lu(k,1807) * lu(k,1905) + lu(k,1909) = lu(k,1909) - lu(k,1808) * lu(k,1905) + lu(k,1910) = lu(k,1910) - lu(k,1809) * lu(k,1905) + lu(k,1911) = lu(k,1911) - lu(k,1810) * lu(k,1905) + lu(k,1929) = lu(k,1929) - lu(k,1805) * lu(k,1928) + lu(k,1930) = lu(k,1930) - lu(k,1806) * lu(k,1928) + lu(k,1931) = lu(k,1931) - lu(k,1807) * lu(k,1928) + lu(k,1932) = lu(k,1932) - lu(k,1808) * lu(k,1928) + lu(k,1933) = lu(k,1933) - lu(k,1809) * lu(k,1928) + lu(k,1934) = lu(k,1934) - lu(k,1810) * lu(k,1928) + lu(k,1963) = lu(k,1963) - lu(k,1805) * lu(k,1962) + lu(k,1964) = lu(k,1964) - lu(k,1806) * lu(k,1962) + lu(k,1965) = lu(k,1965) - lu(k,1807) * lu(k,1962) + lu(k,1966) = lu(k,1966) - lu(k,1808) * lu(k,1962) + lu(k,1967) = lu(k,1967) - lu(k,1809) * lu(k,1962) + lu(k,1968) = lu(k,1968) - lu(k,1810) * lu(k,1962) + lu(k,2020) = lu(k,2020) - lu(k,1805) * lu(k,2019) + lu(k,2021) = lu(k,2021) - lu(k,1806) * lu(k,2019) + lu(k,2022) = lu(k,2022) - lu(k,1807) * lu(k,2019) + lu(k,2023) = lu(k,2023) - lu(k,1808) * lu(k,2019) + lu(k,2024) = lu(k,2024) - lu(k,1809) * lu(k,2019) + lu(k,2025) = lu(k,2025) - lu(k,1810) * lu(k,2019) + lu(k,2045) = lu(k,2045) - lu(k,1805) * lu(k,2044) + lu(k,2046) = lu(k,2046) - lu(k,1806) * lu(k,2044) + lu(k,2047) = lu(k,2047) - lu(k,1807) * lu(k,2044) + lu(k,2048) = lu(k,2048) - lu(k,1808) * lu(k,2044) + lu(k,2049) = lu(k,2049) - lu(k,1809) * lu(k,2044) + lu(k,2050) = lu(k,2050) - lu(k,1810) * lu(k,2044) + end do + end subroutine lu_fac26 + subroutine lu_fac27( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,1865) = 1._r8 / lu(k,1865) + lu(k,1866) = lu(k,1866) * lu(k,1865) + lu(k,1867) = lu(k,1867) * lu(k,1865) + lu(k,1868) = lu(k,1868) * lu(k,1865) + lu(k,1869) = lu(k,1869) * lu(k,1865) + lu(k,1870) = lu(k,1870) * lu(k,1865) + lu(k,1907) = lu(k,1907) - lu(k,1866) * lu(k,1906) + lu(k,1908) = lu(k,1908) - lu(k,1867) * lu(k,1906) + lu(k,1909) = lu(k,1909) - lu(k,1868) * lu(k,1906) + lu(k,1910) = lu(k,1910) - lu(k,1869) * lu(k,1906) + lu(k,1911) = lu(k,1911) - lu(k,1870) * lu(k,1906) + lu(k,1930) = lu(k,1930) - lu(k,1866) * lu(k,1929) + lu(k,1931) = lu(k,1931) - lu(k,1867) * lu(k,1929) + lu(k,1932) = lu(k,1932) - lu(k,1868) * lu(k,1929) + lu(k,1933) = lu(k,1933) - lu(k,1869) * lu(k,1929) + lu(k,1934) = lu(k,1934) - lu(k,1870) * lu(k,1929) + lu(k,1964) = lu(k,1964) - lu(k,1866) * lu(k,1963) + lu(k,1965) = lu(k,1965) - lu(k,1867) * lu(k,1963) + lu(k,1966) = lu(k,1966) - lu(k,1868) * lu(k,1963) + lu(k,1967) = lu(k,1967) - lu(k,1869) * lu(k,1963) + lu(k,1968) = lu(k,1968) - lu(k,1870) * lu(k,1963) + lu(k,2021) = lu(k,2021) - lu(k,1866) * lu(k,2020) + lu(k,2022) = lu(k,2022) - lu(k,1867) * lu(k,2020) + lu(k,2023) = lu(k,2023) - lu(k,1868) * lu(k,2020) + lu(k,2024) = lu(k,2024) - lu(k,1869) * lu(k,2020) + lu(k,2025) = lu(k,2025) - lu(k,1870) * lu(k,2020) + lu(k,2046) = lu(k,2046) - lu(k,1866) * lu(k,2045) + lu(k,2047) = lu(k,2047) - lu(k,1867) * lu(k,2045) + lu(k,2048) = lu(k,2048) - lu(k,1868) * lu(k,2045) + lu(k,2049) = lu(k,2049) - lu(k,1869) * lu(k,2045) + lu(k,2050) = lu(k,2050) - lu(k,1870) * lu(k,2045) + lu(k,1907) = 1._r8 / lu(k,1907) + lu(k,1908) = lu(k,1908) * lu(k,1907) + lu(k,1909) = lu(k,1909) * lu(k,1907) + lu(k,1910) = lu(k,1910) * lu(k,1907) + lu(k,1911) = lu(k,1911) * lu(k,1907) + lu(k,1931) = lu(k,1931) - lu(k,1908) * lu(k,1930) + lu(k,1932) = lu(k,1932) - lu(k,1909) * lu(k,1930) + lu(k,1933) = lu(k,1933) - lu(k,1910) * lu(k,1930) + lu(k,1934) = lu(k,1934) - lu(k,1911) * lu(k,1930) + lu(k,1965) = lu(k,1965) - lu(k,1908) * lu(k,1964) + lu(k,1966) = lu(k,1966) - lu(k,1909) * lu(k,1964) + lu(k,1967) = lu(k,1967) - lu(k,1910) * lu(k,1964) + lu(k,1968) = lu(k,1968) - lu(k,1911) * lu(k,1964) + lu(k,2022) = lu(k,2022) - lu(k,1908) * lu(k,2021) + lu(k,2023) = lu(k,2023) - lu(k,1909) * lu(k,2021) + lu(k,2024) = lu(k,2024) - lu(k,1910) * lu(k,2021) + lu(k,2025) = lu(k,2025) - lu(k,1911) * lu(k,2021) + lu(k,2047) = lu(k,2047) - lu(k,1908) * lu(k,2046) + lu(k,2048) = lu(k,2048) - lu(k,1909) * lu(k,2046) + lu(k,2049) = lu(k,2049) - lu(k,1910) * lu(k,2046) + lu(k,2050) = lu(k,2050) - lu(k,1911) * lu(k,2046) + lu(k,1931) = 1._r8 / lu(k,1931) + lu(k,1932) = lu(k,1932) * lu(k,1931) + lu(k,1933) = lu(k,1933) * lu(k,1931) + lu(k,1934) = lu(k,1934) * lu(k,1931) + lu(k,1966) = lu(k,1966) - lu(k,1932) * lu(k,1965) + lu(k,1967) = lu(k,1967) - lu(k,1933) * lu(k,1965) + lu(k,1968) = lu(k,1968) - lu(k,1934) * lu(k,1965) + lu(k,2023) = lu(k,2023) - lu(k,1932) * lu(k,2022) + lu(k,2024) = lu(k,2024) - lu(k,1933) * lu(k,2022) + lu(k,2025) = lu(k,2025) - lu(k,1934) * lu(k,2022) + lu(k,2048) = lu(k,2048) - lu(k,1932) * lu(k,2047) + lu(k,2049) = lu(k,2049) - lu(k,1933) * lu(k,2047) + lu(k,2050) = lu(k,2050) - lu(k,1934) * lu(k,2047) + lu(k,1966) = 1._r8 / lu(k,1966) + lu(k,1967) = lu(k,1967) * lu(k,1966) + lu(k,1968) = lu(k,1968) * lu(k,1966) + lu(k,2024) = lu(k,2024) - lu(k,1967) * lu(k,2023) + lu(k,2025) = lu(k,2025) - lu(k,1968) * lu(k,2023) + lu(k,2049) = lu(k,2049) - lu(k,1967) * lu(k,2048) + lu(k,2050) = lu(k,2050) - lu(k,1968) * lu(k,2048) + lu(k,2024) = 1._r8 / lu(k,2024) + lu(k,2025) = lu(k,2025) * lu(k,2024) + lu(k,2050) = lu(k,2050) - lu(k,2025) * lu(k,2049) + lu(k,2050) = 1._r8 / lu(k,2050) + end do + end subroutine lu_fac27 + subroutine lu_fac( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) + call lu_fac01( avec_len, lu ) + call lu_fac02( avec_len, lu ) + call lu_fac03( avec_len, lu ) + call lu_fac04( avec_len, lu ) + call lu_fac05( avec_len, lu ) + call lu_fac06( avec_len, lu ) + call lu_fac07( avec_len, lu ) + call lu_fac08( avec_len, lu ) + call lu_fac09( avec_len, lu ) + call lu_fac10( avec_len, lu ) + call lu_fac11( avec_len, lu ) + call lu_fac12( avec_len, lu ) + call lu_fac13( avec_len, lu ) + call lu_fac14( avec_len, lu ) + call lu_fac15( avec_len, lu ) + call lu_fac16( avec_len, lu ) + call lu_fac17( avec_len, lu ) + call lu_fac18( avec_len, lu ) + call lu_fac19( avec_len, lu ) + call lu_fac20( avec_len, lu ) + call lu_fac21( avec_len, lu ) + call lu_fac22( avec_len, lu ) + call lu_fac23( avec_len, lu ) + call lu_fac24( avec_len, lu ) + call lu_fac25( avec_len, lu ) + call lu_fac26( avec_len, lu ) + call lu_fac27( avec_len, lu ) + end subroutine lu_fac + end module mo_lu_factor diff --git a/src/chemistry/pp_trop_strat_noaero/mo_lu_solve.F90 b/src/chemistry/pp_trop_strat_noaero/mo_lu_solve.F90 new file mode 100644 index 0000000000..ce342ee7bd --- /dev/null +++ b/src/chemistry/pp_trop_strat_noaero/mo_lu_solve.F90 @@ -0,0 +1,2301 @@ + module mo_lu_solve + use chem_mods, only: veclen + private + public :: lu_slv + contains + subroutine lu_slv01( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: k +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + do k = 1,avec_len + b(k,159) = b(k,159) - lu(k,58) * b(k,16) + b(k,163) = b(k,163) - lu(k,59) * b(k,16) + b(k,164) = b(k,164) - lu(k,61) * b(k,17) + b(k,169) = b(k,169) - lu(k,62) * b(k,17) + b(k,159) = b(k,159) - lu(k,64) * b(k,18) + b(k,171) = b(k,171) - lu(k,65) * b(k,18) + b(k,114) = b(k,114) - lu(k,67) * b(k,19) + b(k,159) = b(k,159) - lu(k,68) * b(k,19) + b(k,171) = b(k,171) - lu(k,69) * b(k,19) + b(k,111) = b(k,111) - lu(k,71) * b(k,20) + b(k,158) = b(k,158) - lu(k,72) * b(k,20) + b(k,46) = b(k,46) - lu(k,74) * b(k,21) + b(k,159) = b(k,159) - lu(k,75) * b(k,21) + b(k,45) = b(k,45) - lu(k,77) * b(k,22) + b(k,171) = b(k,171) - lu(k,78) * b(k,22) + b(k,142) = b(k,142) - lu(k,80) * b(k,23) + b(k,159) = b(k,159) - lu(k,81) * b(k,23) + b(k,85) = b(k,85) - lu(k,83) * b(k,24) + b(k,167) = b(k,167) - lu(k,84) * b(k,24) + b(k,169) = b(k,169) - lu(k,86) * b(k,25) + b(k,27) = b(k,27) - lu(k,89) * b(k,26) + b(k,28) = b(k,28) - lu(k,90) * b(k,26) + b(k,80) = b(k,80) - lu(k,91) * b(k,26) + b(k,159) = b(k,159) - lu(k,92) * b(k,26) + b(k,163) = b(k,163) - lu(k,93) * b(k,26) + b(k,76) = b(k,76) - lu(k,95) * b(k,27) + b(k,135) = b(k,135) - lu(k,96) * b(k,27) + b(k,163) = b(k,163) - lu(k,97) * b(k,27) + b(k,75) = b(k,75) - lu(k,99) * b(k,28) + b(k,78) = b(k,78) - lu(k,100) * b(k,28) + b(k,159) = b(k,159) - lu(k,101) * b(k,28) + b(k,163) = b(k,163) - lu(k,102) * b(k,28) + b(k,111) = b(k,111) - lu(k,104) * b(k,29) + b(k,158) = b(k,158) - lu(k,105) * b(k,29) + b(k,169) = b(k,169) - lu(k,106) * b(k,29) + b(k,158) = b(k,158) - lu(k,108) * b(k,30) + b(k,159) = b(k,159) - lu(k,109) * b(k,30) + b(k,163) = b(k,163) - lu(k,110) * b(k,30) + b(k,32) = b(k,32) - lu(k,113) * b(k,31) + b(k,33) = b(k,33) - lu(k,114) * b(k,31) + b(k,73) = b(k,73) - lu(k,115) * b(k,31) + b(k,106) = b(k,106) - lu(k,116) * b(k,31) + b(k,159) = b(k,159) - lu(k,117) * b(k,31) + b(k,163) = b(k,163) - lu(k,118) * b(k,31) + b(k,75) = b(k,75) - lu(k,120) * b(k,32) + b(k,78) = b(k,78) - lu(k,121) * b(k,32) + b(k,159) = b(k,159) - lu(k,122) * b(k,32) + b(k,163) = b(k,163) - lu(k,123) * b(k,32) + b(k,135) = b(k,135) - lu(k,125) * b(k,33) + b(k,153) = b(k,153) - lu(k,126) * b(k,33) + b(k,163) = b(k,163) - lu(k,127) * b(k,33) + b(k,142) = b(k,142) - lu(k,129) * b(k,34) + b(k,159) = b(k,159) - lu(k,130) * b(k,34) + b(k,36) = b(k,36) - lu(k,134) * b(k,35) + b(k,73) = b(k,73) - lu(k,135) * b(k,35) + b(k,108) = b(k,108) - lu(k,136) * b(k,35) + b(k,135) = b(k,135) - lu(k,137) * b(k,35) + b(k,153) = b(k,153) - lu(k,138) * b(k,35) + b(k,159) = b(k,159) - lu(k,139) * b(k,35) + b(k,163) = b(k,163) - lu(k,140) * b(k,35) + b(k,78) = b(k,78) - lu(k,142) * b(k,36) + b(k,81) = b(k,81) - lu(k,143) * b(k,36) + b(k,159) = b(k,159) - lu(k,144) * b(k,36) + b(k,163) = b(k,163) - lu(k,145) * b(k,36) + b(k,111) = b(k,111) - lu(k,147) * b(k,37) + b(k,156) = b(k,156) - lu(k,148) * b(k,37) + b(k,97) = b(k,97) - lu(k,150) * b(k,38) + b(k,142) = b(k,142) - lu(k,151) * b(k,38) + b(k,159) = b(k,159) - lu(k,152) * b(k,38) + b(k,163) = b(k,163) - lu(k,153) * b(k,38) + b(k,126) = b(k,126) - lu(k,155) * b(k,39) + b(k,159) = b(k,159) - lu(k,156) * b(k,39) + b(k,85) = b(k,85) - lu(k,158) * b(k,40) + b(k,159) = b(k,159) - lu(k,159) * b(k,40) + b(k,155) = b(k,155) - lu(k,161) * b(k,41) + b(k,167) = b(k,167) - lu(k,162) * b(k,41) + b(k,154) = b(k,154) - lu(k,164) * b(k,42) + b(k,169) = b(k,169) - lu(k,165) * b(k,42) + b(k,134) = b(k,134) - lu(k,167) * b(k,43) + b(k,159) = b(k,159) - lu(k,168) * b(k,43) + b(k,163) = b(k,163) - lu(k,169) * b(k,43) + b(k,78) = b(k,78) - lu(k,171) * b(k,44) + b(k,99) = b(k,99) - lu(k,172) * b(k,44) + b(k,159) = b(k,159) - lu(k,173) * b(k,44) + b(k,120) = b(k,120) - lu(k,176) * b(k,45) + b(k,162) = b(k,162) - lu(k,177) * b(k,45) + b(k,171) = b(k,171) - lu(k,178) * b(k,45) + b(k,131) = b(k,131) - lu(k,180) * b(k,46) + b(k,161) = b(k,161) - lu(k,181) * b(k,46) + b(k,163) = b(k,163) - lu(k,182) * b(k,46) + b(k,120) = b(k,120) - lu(k,184) * b(k,47) + b(k,155) = b(k,155) - lu(k,185) * b(k,47) + b(k,159) = b(k,159) - lu(k,186) * b(k,47) + b(k,163) = b(k,163) - lu(k,187) * b(k,47) + b(k,170) = b(k,170) - lu(k,188) * b(k,47) + b(k,155) = b(k,155) - lu(k,190) * b(k,48) + b(k,162) = b(k,162) - lu(k,191) * b(k,48) + b(k,165) = b(k,165) - lu(k,192) * b(k,48) + b(k,167) = b(k,167) - lu(k,193) * b(k,48) + b(k,170) = b(k,170) - lu(k,194) * b(k,48) + b(k,117) = b(k,117) - lu(k,196) * b(k,49) + b(k,159) = b(k,159) - lu(k,197) * b(k,49) + b(k,168) = b(k,168) - lu(k,198) * b(k,49) + b(k,169) = b(k,169) - lu(k,199) * b(k,49) + b(k,171) = b(k,171) - lu(k,200) * b(k,49) + b(k,115) = b(k,115) - lu(k,202) * b(k,50) + b(k,122) = b(k,122) - lu(k,203) * b(k,50) + b(k,135) = b(k,135) - lu(k,204) * b(k,50) + b(k,159) = b(k,159) - lu(k,205) * b(k,50) + b(k,163) = b(k,163) - lu(k,206) * b(k,50) + b(k,109) = b(k,109) - lu(k,208) * b(k,51) + b(k,163) = b(k,163) - lu(k,209) * b(k,51) + b(k,142) = b(k,142) - lu(k,211) * b(k,52) + b(k,159) = b(k,159) - lu(k,212) * b(k,52) + b(k,117) = b(k,117) - lu(k,214) * b(k,53) + b(k,134) = b(k,134) - lu(k,215) * b(k,53) + b(k,159) = b(k,159) - lu(k,216) * b(k,53) + b(k,163) = b(k,163) - lu(k,217) * b(k,53) + b(k,150) = b(k,150) - lu(k,219) * b(k,54) + b(k,152) = b(k,152) - lu(k,220) * b(k,54) + b(k,159) = b(k,159) - lu(k,221) * b(k,54) + b(k,163) = b(k,163) - lu(k,222) * b(k,54) + b(k,102) = b(k,102) - lu(k,224) * b(k,55) + b(k,134) = b(k,134) - lu(k,225) * b(k,55) + b(k,153) = b(k,153) - lu(k,226) * b(k,55) + b(k,159) = b(k,159) - lu(k,227) * b(k,55) + b(k,120) = b(k,120) - lu(k,229) * b(k,56) + b(k,147) = b(k,147) - lu(k,230) * b(k,56) + b(k,162) = b(k,162) - lu(k,231) * b(k,56) + b(k,164) = b(k,164) - lu(k,232) * b(k,56) + b(k,75) = b(k,75) - lu(k,234) * b(k,57) + b(k,122) = b(k,122) - lu(k,235) * b(k,57) + b(k,159) = b(k,159) - lu(k,236) * b(k,57) + b(k,163) = b(k,163) - lu(k,237) * b(k,57) + b(k,73) = b(k,73) - lu(k,240) * b(k,58) + b(k,85) = b(k,85) - lu(k,241) * b(k,58) + b(k,159) = b(k,159) - lu(k,242) * b(k,58) + b(k,163) = b(k,163) - lu(k,243) * b(k,58) + b(k,135) = b(k,135) - lu(k,245) * b(k,59) + b(k,146) = b(k,146) - lu(k,246) * b(k,59) + b(k,153) = b(k,153) - lu(k,247) * b(k,59) + b(k,163) = b(k,163) - lu(k,248) * b(k,59) + b(k,82) = b(k,82) - lu(k,250) * b(k,60) + b(k,120) = b(k,120) - lu(k,251) * b(k,60) + b(k,135) = b(k,135) - lu(k,252) * b(k,60) + b(k,147) = b(k,147) - lu(k,253) * b(k,60) + b(k,156) = b(k,156) - lu(k,254) * b(k,60) + b(k,159) = b(k,159) - lu(k,255) * b(k,60) + b(k,162) = b(k,162) - lu(k,256) * b(k,60) + b(k,91) = b(k,91) - lu(k,258) * b(k,61) + b(k,127) = b(k,127) - lu(k,259) * b(k,61) + b(k,134) = b(k,134) - lu(k,260) * b(k,61) + b(k,159) = b(k,159) - lu(k,261) * b(k,61) + b(k,161) = b(k,161) - lu(k,262) * b(k,61) + b(k,167) = b(k,167) - lu(k,263) * b(k,61) + b(k,170) = b(k,170) - lu(k,264) * b(k,61) + b(k,159) = b(k,159) - lu(k,266) * b(k,62) + b(k,163) = b(k,163) - lu(k,267) * b(k,62) + b(k,167) = b(k,167) - lu(k,268) * b(k,62) + b(k,170) = b(k,170) - lu(k,269) * b(k,62) + b(k,171) = b(k,171) - lu(k,270) * b(k,62) + b(k,107) = b(k,107) - lu(k,272) * b(k,63) + b(k,121) = b(k,121) - lu(k,273) * b(k,63) + b(k,159) = b(k,159) - lu(k,274) * b(k,63) + b(k,163) = b(k,163) - lu(k,275) * b(k,63) + b(k,167) = b(k,167) - lu(k,276) * b(k,63) + b(k,156) = b(k,156) - lu(k,278) * b(k,64) + b(k,159) = b(k,159) - lu(k,279) * b(k,64) + b(k,162) = b(k,162) - lu(k,280) * b(k,64) + b(k,165) = b(k,165) - lu(k,281) * b(k,64) + b(k,167) = b(k,167) - lu(k,282) * b(k,64) + b(k,121) = b(k,121) - lu(k,284) * b(k,65) + b(k,131) = b(k,131) - lu(k,285) * b(k,65) + b(k,155) = b(k,155) - lu(k,286) * b(k,65) + b(k,159) = b(k,159) - lu(k,287) * b(k,65) + b(k,163) = b(k,163) - lu(k,288) * b(k,65) + b(k,130) = b(k,130) - lu(k,290) * b(k,66) + b(k,140) = b(k,140) - lu(k,291) * b(k,66) + b(k,155) = b(k,155) - lu(k,292) * b(k,66) + b(k,159) = b(k,159) - lu(k,293) * b(k,66) + b(k,167) = b(k,167) - lu(k,294) * b(k,66) + b(k,156) = b(k,156) - lu(k,296) * b(k,67) + b(k,157) = b(k,157) - lu(k,297) * b(k,67) + b(k,159) = b(k,159) - lu(k,298) * b(k,67) + b(k,161) = b(k,161) - lu(k,299) * b(k,67) + b(k,171) = b(k,171) - lu(k,300) * b(k,67) + b(k,141) = b(k,141) - lu(k,302) * b(k,68) + b(k,153) = b(k,153) - lu(k,303) * b(k,68) + b(k,159) = b(k,159) - lu(k,304) * b(k,68) + b(k,161) = b(k,161) - lu(k,305) * b(k,68) + b(k,171) = b(k,171) - lu(k,306) * b(k,68) + b(k,114) = b(k,114) - lu(k,308) * b(k,69) + b(k,127) = b(k,127) - lu(k,309) * b(k,69) + b(k,159) = b(k,159) - lu(k,310) * b(k,69) + b(k,163) = b(k,163) - lu(k,311) * b(k,69) + b(k,171) = b(k,171) - lu(k,312) * b(k,69) + b(k,76) = b(k,76) - lu(k,314) * b(k,70) + b(k,80) = b(k,80) - lu(k,315) * b(k,70) + b(k,122) = b(k,122) - lu(k,316) * b(k,70) + b(k,159) = b(k,159) - lu(k,317) * b(k,70) + b(k,163) = b(k,163) - lu(k,318) * b(k,70) + end do + end subroutine lu_slv01 + subroutine lu_slv02( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: k +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + do k = 1,avec_len + b(k,122) = b(k,122) - lu(k,320) * b(k,71) + b(k,135) = b(k,135) - lu(k,321) * b(k,71) + b(k,146) = b(k,146) - lu(k,322) * b(k,71) + b(k,153) = b(k,153) - lu(k,323) * b(k,71) + b(k,163) = b(k,163) - lu(k,324) * b(k,71) + b(k,81) = b(k,81) - lu(k,326) * b(k,72) + b(k,122) = b(k,122) - lu(k,327) * b(k,72) + b(k,146) = b(k,146) - lu(k,328) * b(k,72) + b(k,159) = b(k,159) - lu(k,329) * b(k,72) + b(k,163) = b(k,163) - lu(k,330) * b(k,72) + b(k,85) = b(k,85) - lu(k,334) * b(k,73) + b(k,159) = b(k,159) - lu(k,335) * b(k,73) + b(k,163) = b(k,163) - lu(k,336) * b(k,73) + b(k,165) = b(k,165) - lu(k,337) * b(k,73) + b(k,167) = b(k,167) - lu(k,338) * b(k,73) + b(k,115) = b(k,115) - lu(k,340) * b(k,74) + b(k,161) = b(k,161) - lu(k,341) * b(k,74) + b(k,163) = b(k,163) - lu(k,342) * b(k,74) + b(k,165) = b(k,165) - lu(k,343) * b(k,74) + b(k,167) = b(k,167) - lu(k,344) * b(k,74) + b(k,122) = b(k,122) - lu(k,347) * b(k,75) + b(k,159) = b(k,159) - lu(k,348) * b(k,75) + b(k,163) = b(k,163) - lu(k,349) * b(k,75) + b(k,165) = b(k,165) - lu(k,350) * b(k,75) + b(k,167) = b(k,167) - lu(k,351) * b(k,75) + b(k,105) = b(k,105) - lu(k,353) * b(k,76) + b(k,163) = b(k,163) - lu(k,354) * b(k,76) + b(k,153) = b(k,153) - lu(k,356) * b(k,77) + b(k,157) = b(k,157) - lu(k,357) * b(k,77) + b(k,159) = b(k,159) - lu(k,358) * b(k,77) + b(k,161) = b(k,161) - lu(k,359) * b(k,77) + b(k,167) = b(k,167) - lu(k,360) * b(k,77) + b(k,170) = b(k,170) - lu(k,361) * b(k,77) + b(k,99) = b(k,99) - lu(k,363) * b(k,78) + b(k,166) = b(k,166) - lu(k,364) * b(k,78) + b(k,167) = b(k,167) - lu(k,365) * b(k,78) + b(k,127) = b(k,127) - lu(k,367) * b(k,79) + b(k,130) = b(k,130) - lu(k,368) * b(k,79) + b(k,138) = b(k,138) - lu(k,369) * b(k,79) + b(k,159) = b(k,159) - lu(k,370) * b(k,79) + b(k,161) = b(k,161) - lu(k,371) * b(k,79) + b(k,163) = b(k,163) - lu(k,372) * b(k,79) + b(k,105) = b(k,105) - lu(k,376) * b(k,80) + b(k,122) = b(k,122) - lu(k,377) * b(k,80) + b(k,159) = b(k,159) - lu(k,378) * b(k,80) + b(k,163) = b(k,163) - lu(k,379) * b(k,80) + b(k,165) = b(k,165) - lu(k,380) * b(k,80) + b(k,167) = b(k,167) - lu(k,381) * b(k,80) + b(k,122) = b(k,122) - lu(k,384) * b(k,81) + b(k,146) = b(k,146) - lu(k,385) * b(k,81) + b(k,159) = b(k,159) - lu(k,386) * b(k,81) + b(k,163) = b(k,163) - lu(k,387) * b(k,81) + b(k,165) = b(k,165) - lu(k,388) * b(k,81) + b(k,167) = b(k,167) - lu(k,389) * b(k,81) + b(k,147) = b(k,147) - lu(k,391) * b(k,82) + b(k,156) = b(k,156) - lu(k,392) * b(k,82) + b(k,159) = b(k,159) - lu(k,393) * b(k,82) + b(k,162) = b(k,162) - lu(k,394) * b(k,82) + b(k,166) = b(k,166) - lu(k,395) * b(k,82) + b(k,102) = b(k,102) - lu(k,397) * b(k,83) + b(k,117) = b(k,117) - lu(k,398) * b(k,83) + b(k,153) = b(k,153) - lu(k,399) * b(k,83) + b(k,159) = b(k,159) - lu(k,400) * b(k,83) + b(k,153) = b(k,153) - lu(k,402) * b(k,84) + b(k,157) = b(k,157) - lu(k,403) * b(k,84) + b(k,159) = b(k,159) - lu(k,404) * b(k,84) + b(k,161) = b(k,161) - lu(k,405) * b(k,84) + b(k,171) = b(k,171) - lu(k,406) * b(k,84) + b(k,99) = b(k,99) - lu(k,409) * b(k,85) + b(k,159) = b(k,159) - lu(k,410) * b(k,85) + b(k,163) = b(k,163) - lu(k,411) * b(k,85) + b(k,165) = b(k,165) - lu(k,412) * b(k,85) + b(k,167) = b(k,167) - lu(k,413) * b(k,85) + b(k,112) = b(k,112) - lu(k,415) * b(k,86) + b(k,154) = b(k,154) - lu(k,416) * b(k,86) + b(k,155) = b(k,155) - lu(k,417) * b(k,86) + b(k,160) = b(k,160) - lu(k,418) * b(k,86) + b(k,162) = b(k,162) - lu(k,419) * b(k,86) + b(k,167) = b(k,167) - lu(k,420) * b(k,86) + b(k,170) = b(k,170) - lu(k,421) * b(k,86) + b(k,110) = b(k,110) - lu(k,423) * b(k,87) + b(k,134) = b(k,134) - lu(k,424) * b(k,87) + b(k,137) = b(k,137) - lu(k,425) * b(k,87) + b(k,159) = b(k,159) - lu(k,426) * b(k,87) + b(k,161) = b(k,161) - lu(k,427) * b(k,87) + b(k,163) = b(k,163) - lu(k,428) * b(k,87) + b(k,171) = b(k,171) - lu(k,429) * b(k,87) + b(k,157) = b(k,157) - lu(k,431) * b(k,88) + b(k,159) = b(k,159) - lu(k,432) * b(k,88) + b(k,171) = b(k,171) - lu(k,433) * b(k,88) + b(k,121) = b(k,121) - lu(k,435) * b(k,89) + b(k,131) = b(k,131) - lu(k,436) * b(k,89) + b(k,136) = b(k,136) - lu(k,437) * b(k,89) + b(k,137) = b(k,137) - lu(k,438) * b(k,89) + b(k,155) = b(k,155) - lu(k,439) * b(k,89) + b(k,159) = b(k,159) - lu(k,440) * b(k,89) + b(k,163) = b(k,163) - lu(k,441) * b(k,89) + b(k,104) = b(k,104) - lu(k,443) * b(k,90) + b(k,115) = b(k,115) - lu(k,444) * b(k,90) + b(k,135) = b(k,135) - lu(k,445) * b(k,90) + b(k,159) = b(k,159) - lu(k,446) * b(k,90) + b(k,161) = b(k,161) - lu(k,447) * b(k,90) + b(k,163) = b(k,163) - lu(k,448) * b(k,90) + b(k,166) = b(k,166) - lu(k,449) * b(k,90) + b(k,127) = b(k,127) - lu(k,451) * b(k,91) + b(k,134) = b(k,134) - lu(k,452) * b(k,91) + b(k,136) = b(k,136) - lu(k,453) * b(k,91) + b(k,161) = b(k,161) - lu(k,454) * b(k,91) + b(k,163) = b(k,163) - lu(k,455) * b(k,91) + b(k,165) = b(k,165) - lu(k,456) * b(k,91) + b(k,167) = b(k,167) - lu(k,457) * b(k,91) + b(k,137) = b(k,137) - lu(k,459) * b(k,92) + b(k,152) = b(k,152) - lu(k,460) * b(k,92) + b(k,159) = b(k,159) - lu(k,461) * b(k,92) + b(k,161) = b(k,161) - lu(k,462) * b(k,92) + b(k,163) = b(k,163) - lu(k,463) * b(k,92) + b(k,167) = b(k,167) - lu(k,464) * b(k,92) + b(k,170) = b(k,170) - lu(k,465) * b(k,92) + b(k,159) = b(k,159) - lu(k,467) * b(k,93) + b(k,162) = b(k,162) - lu(k,468) * b(k,93) + b(k,163) = b(k,163) - lu(k,469) * b(k,93) + b(k,168) = b(k,168) - lu(k,470) * b(k,93) + b(k,169) = b(k,169) - lu(k,471) * b(k,93) + b(k,171) = b(k,171) - lu(k,472) * b(k,93) + b(k,131) = b(k,131) - lu(k,474) * b(k,94) + b(k,136) = b(k,136) - lu(k,475) * b(k,94) + b(k,137) = b(k,137) - lu(k,476) * b(k,94) + b(k,155) = b(k,155) - lu(k,477) * b(k,94) + b(k,159) = b(k,159) - lu(k,478) * b(k,94) + b(k,161) = b(k,161) - lu(k,479) * b(k,94) + b(k,163) = b(k,163) - lu(k,480) * b(k,94) + b(k,167) = b(k,167) - lu(k,481) * b(k,94) + b(k,127) = b(k,127) - lu(k,483) * b(k,95) + b(k,131) = b(k,131) - lu(k,484) * b(k,95) + b(k,133) = b(k,133) - lu(k,485) * b(k,95) + b(k,135) = b(k,135) - lu(k,486) * b(k,95) + b(k,139) = b(k,139) - lu(k,487) * b(k,95) + b(k,159) = b(k,159) - lu(k,488) * b(k,95) + b(k,161) = b(k,161) - lu(k,489) * b(k,95) + b(k,163) = b(k,163) - lu(k,490) * b(k,95) + b(k,97) = b(k,97) - lu(k,494) * b(k,96) + b(k,105) = b(k,105) - lu(k,495) * b(k,96) + b(k,106) = b(k,106) - lu(k,496) * b(k,96) + b(k,109) = b(k,109) - lu(k,497) * b(k,96) + b(k,122) = b(k,122) - lu(k,498) * b(k,96) + b(k,146) = b(k,146) - lu(k,499) * b(k,96) + b(k,159) = b(k,159) - lu(k,500) * b(k,96) + b(k,163) = b(k,163) - lu(k,501) * b(k,96) + b(k,123) = b(k,123) - lu(k,503) * b(k,97) + b(k,135) = b(k,135) - lu(k,504) * b(k,97) + b(k,163) = b(k,163) - lu(k,505) * b(k,97) + b(k,130) = b(k,130) - lu(k,507) * b(k,98) + b(k,155) = b(k,155) - lu(k,508) * b(k,98) + b(k,159) = b(k,159) - lu(k,509) * b(k,98) + b(k,163) = b(k,163) - lu(k,510) * b(k,98) + b(k,167) = b(k,167) - lu(k,511) * b(k,98) + b(k,159) = b(k,159) - lu(k,515) * b(k,99) + b(k,163) = b(k,163) - lu(k,516) * b(k,99) + b(k,165) = b(k,165) - lu(k,517) * b(k,99) + b(k,166) = b(k,166) - lu(k,518) * b(k,99) + b(k,167) = b(k,167) - lu(k,519) * b(k,99) + b(k,102) = b(k,102) - lu(k,522) * b(k,100) + b(k,117) = b(k,117) - lu(k,523) * b(k,100) + b(k,126) = b(k,126) - lu(k,524) * b(k,100) + b(k,127) = b(k,127) - lu(k,525) * b(k,100) + b(k,134) = b(k,134) - lu(k,526) * b(k,100) + b(k,153) = b(k,153) - lu(k,527) * b(k,100) + b(k,159) = b(k,159) - lu(k,528) * b(k,100) + b(k,161) = b(k,161) - lu(k,529) * b(k,100) + b(k,163) = b(k,163) - lu(k,530) * b(k,100) + b(k,102) = b(k,102) - lu(k,533) * b(k,101) + b(k,117) = b(k,117) - lu(k,534) * b(k,101) + b(k,127) = b(k,127) - lu(k,535) * b(k,101) + b(k,134) = b(k,134) - lu(k,536) * b(k,101) + b(k,153) = b(k,153) - lu(k,537) * b(k,101) + b(k,159) = b(k,159) - lu(k,538) * b(k,101) + b(k,161) = b(k,161) - lu(k,539) * b(k,101) + b(k,163) = b(k,163) - lu(k,540) * b(k,101) + b(k,167) = b(k,167) - lu(k,541) * b(k,101) + b(k,134) = b(k,134) - lu(k,544) * b(k,102) + b(k,153) = b(k,153) - lu(k,545) * b(k,102) + b(k,159) = b(k,159) - lu(k,546) * b(k,102) + b(k,163) = b(k,163) - lu(k,547) * b(k,102) + b(k,165) = b(k,165) - lu(k,548) * b(k,102) + b(k,167) = b(k,167) - lu(k,549) * b(k,102) + b(k,105) = b(k,105) - lu(k,555) * b(k,103) + b(k,108) = b(k,108) - lu(k,556) * b(k,103) + b(k,109) = b(k,109) - lu(k,557) * b(k,103) + b(k,122) = b(k,122) - lu(k,558) * b(k,103) + b(k,123) = b(k,123) - lu(k,559) * b(k,103) + b(k,135) = b(k,135) - lu(k,560) * b(k,103) + b(k,146) = b(k,146) - lu(k,561) * b(k,103) + b(k,153) = b(k,153) - lu(k,562) * b(k,103) + b(k,159) = b(k,159) - lu(k,563) * b(k,103) + b(k,163) = b(k,163) - lu(k,564) * b(k,103) + b(k,131) = b(k,131) - lu(k,568) * b(k,104) + b(k,159) = b(k,159) - lu(k,569) * b(k,104) + b(k,161) = b(k,161) - lu(k,570) * b(k,104) + b(k,163) = b(k,163) - lu(k,571) * b(k,104) + b(k,165) = b(k,165) - lu(k,572) * b(k,104) + b(k,167) = b(k,167) - lu(k,573) * b(k,104) + end do + end subroutine lu_slv02 + subroutine lu_slv03( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: k +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + do k = 1,avec_len + b(k,122) = b(k,122) - lu(k,575) * b(k,105) + b(k,135) = b(k,135) - lu(k,576) * b(k,105) + b(k,163) = b(k,163) - lu(k,577) * b(k,105) + b(k,165) = b(k,165) - lu(k,578) * b(k,105) + b(k,167) = b(k,167) - lu(k,579) * b(k,105) + b(k,109) = b(k,109) - lu(k,586) * b(k,106) + b(k,122) = b(k,122) - lu(k,587) * b(k,106) + b(k,123) = b(k,123) - lu(k,588) * b(k,106) + b(k,135) = b(k,135) - lu(k,589) * b(k,106) + b(k,146) = b(k,146) - lu(k,590) * b(k,106) + b(k,159) = b(k,159) - lu(k,591) * b(k,106) + b(k,163) = b(k,163) - lu(k,592) * b(k,106) + b(k,165) = b(k,165) - lu(k,593) * b(k,106) + b(k,167) = b(k,167) - lu(k,594) * b(k,106) + b(k,142) = b(k,142) - lu(k,597) * b(k,107) + b(k,145) = b(k,145) - lu(k,598) * b(k,107) + b(k,149) = b(k,149) - lu(k,599) * b(k,107) + b(k,159) = b(k,159) - lu(k,600) * b(k,107) + b(k,161) = b(k,161) - lu(k,601) * b(k,107) + b(k,163) = b(k,163) - lu(k,602) * b(k,107) + b(k,109) = b(k,109) - lu(k,610) * b(k,108) + b(k,122) = b(k,122) - lu(k,611) * b(k,108) + b(k,123) = b(k,123) - lu(k,612) * b(k,108) + b(k,135) = b(k,135) - lu(k,613) * b(k,108) + b(k,146) = b(k,146) - lu(k,614) * b(k,108) + b(k,153) = b(k,153) - lu(k,615) * b(k,108) + b(k,159) = b(k,159) - lu(k,616) * b(k,108) + b(k,163) = b(k,163) - lu(k,617) * b(k,108) + b(k,165) = b(k,165) - lu(k,618) * b(k,108) + b(k,167) = b(k,167) - lu(k,619) * b(k,108) + b(k,135) = b(k,135) - lu(k,621) * b(k,109) + b(k,146) = b(k,146) - lu(k,622) * b(k,109) + b(k,157) = b(k,157) - lu(k,623) * b(k,109) + b(k,159) = b(k,159) - lu(k,624) * b(k,109) + b(k,163) = b(k,163) - lu(k,625) * b(k,109) + b(k,165) = b(k,165) - lu(k,626) * b(k,109) + b(k,167) = b(k,167) - lu(k,627) * b(k,109) + b(k,134) = b(k,134) - lu(k,630) * b(k,110) + b(k,137) = b(k,137) - lu(k,631) * b(k,110) + b(k,159) = b(k,159) - lu(k,632) * b(k,110) + b(k,161) = b(k,161) - lu(k,633) * b(k,110) + b(k,163) = b(k,163) - lu(k,634) * b(k,110) + b(k,165) = b(k,165) - lu(k,635) * b(k,110) + b(k,167) = b(k,167) - lu(k,636) * b(k,110) + b(k,171) = b(k,171) - lu(k,637) * b(k,110) + b(k,143) = b(k,143) - lu(k,640) * b(k,111) + b(k,155) = b(k,155) - lu(k,641) * b(k,111) + b(k,156) = b(k,156) - lu(k,642) * b(k,111) + b(k,157) = b(k,157) - lu(k,643) * b(k,111) + b(k,159) = b(k,159) - lu(k,644) * b(k,111) + b(k,170) = b(k,170) - lu(k,645) * b(k,111) + b(k,171) = b(k,171) - lu(k,646) * b(k,111) + b(k,154) = b(k,154) - lu(k,649) * b(k,112) + b(k,159) = b(k,159) - lu(k,650) * b(k,112) + b(k,160) = b(k,160) - lu(k,651) * b(k,112) + b(k,162) = b(k,162) - lu(k,652) * b(k,112) + b(k,168) = b(k,168) - lu(k,653) * b(k,112) + b(k,169) = b(k,169) - lu(k,654) * b(k,112) + b(k,171) = b(k,171) - lu(k,655) * b(k,112) + b(k,159) = b(k,159) - lu(k,657) * b(k,113) + b(k,161) = b(k,161) - lu(k,658) * b(k,113) + b(k,163) = b(k,163) - lu(k,659) * b(k,113) + b(k,127) = b(k,127) - lu(k,662) * b(k,114) + b(k,134) = b(k,134) - lu(k,663) * b(k,114) + b(k,157) = b(k,157) - lu(k,664) * b(k,114) + b(k,159) = b(k,159) - lu(k,665) * b(k,114) + b(k,161) = b(k,161) - lu(k,666) * b(k,114) + b(k,163) = b(k,163) - lu(k,667) * b(k,114) + b(k,165) = b(k,165) - lu(k,668) * b(k,114) + b(k,167) = b(k,167) - lu(k,669) * b(k,114) + b(k,171) = b(k,171) - lu(k,670) * b(k,114) + b(k,159) = b(k,159) - lu(k,672) * b(k,115) + b(k,163) = b(k,163) - lu(k,673) * b(k,115) + b(k,171) = b(k,171) - lu(k,674) * b(k,115) + b(k,159) = b(k,159) - lu(k,677) * b(k,116) + b(k,162) = b(k,162) - lu(k,678) * b(k,116) + b(k,164) = b(k,164) - lu(k,679) * b(k,116) + b(k,168) = b(k,168) - lu(k,680) * b(k,116) + b(k,169) = b(k,169) - lu(k,681) * b(k,116) + b(k,171) = b(k,171) - lu(k,682) * b(k,116) + b(k,134) = b(k,134) - lu(k,687) * b(k,117) + b(k,157) = b(k,157) - lu(k,688) * b(k,117) + b(k,159) = b(k,159) - lu(k,689) * b(k,117) + b(k,161) = b(k,161) - lu(k,690) * b(k,117) + b(k,163) = b(k,163) - lu(k,691) * b(k,117) + b(k,165) = b(k,165) - lu(k,692) * b(k,117) + b(k,167) = b(k,167) - lu(k,693) * b(k,117) + b(k,154) = b(k,154) - lu(k,695) * b(k,118) + b(k,156) = b(k,156) - lu(k,696) * b(k,118) + b(k,158) = b(k,158) - lu(k,697) * b(k,118) + b(k,159) = b(k,159) - lu(k,698) * b(k,118) + b(k,160) = b(k,160) - lu(k,699) * b(k,118) + b(k,162) = b(k,162) - lu(k,700) * b(k,118) + b(k,171) = b(k,171) - lu(k,701) * b(k,118) + b(k,129) = b(k,129) - lu(k,707) * b(k,119) + b(k,135) = b(k,135) - lu(k,708) * b(k,119) + b(k,144) = b(k,144) - lu(k,709) * b(k,119) + b(k,145) = b(k,145) - lu(k,710) * b(k,119) + b(k,148) = b(k,148) - lu(k,711) * b(k,119) + b(k,149) = b(k,149) - lu(k,712) * b(k,119) + b(k,151) = b(k,151) - lu(k,713) * b(k,119) + b(k,153) = b(k,153) - lu(k,714) * b(k,119) + b(k,157) = b(k,157) - lu(k,715) * b(k,119) + b(k,159) = b(k,159) - lu(k,716) * b(k,119) + b(k,161) = b(k,161) - lu(k,717) * b(k,119) + b(k,163) = b(k,163) - lu(k,718) * b(k,119) + b(k,166) = b(k,166) - lu(k,719) * b(k,119) + b(k,170) = b(k,170) - lu(k,720) * b(k,119) + b(k,171) = b(k,171) - lu(k,721) * b(k,119) + b(k,147) = b(k,147) - lu(k,724) * b(k,120) + b(k,159) = b(k,159) - lu(k,725) * b(k,120) + b(k,162) = b(k,162) - lu(k,726) * b(k,120) + b(k,163) = b(k,163) - lu(k,727) * b(k,120) + b(k,171) = b(k,171) - lu(k,728) * b(k,120) + b(k,146) = b(k,146) - lu(k,730) * b(k,121) + b(k,153) = b(k,153) - lu(k,731) * b(k,121) + b(k,159) = b(k,159) - lu(k,732) * b(k,121) + b(k,161) = b(k,161) - lu(k,733) * b(k,121) + b(k,167) = b(k,167) - lu(k,734) * b(k,121) + b(k,135) = b(k,135) - lu(k,737) * b(k,122) + b(k,159) = b(k,159) - lu(k,738) * b(k,122) + b(k,163) = b(k,163) - lu(k,739) * b(k,122) + b(k,135) = b(k,135) - lu(k,742) * b(k,123) + b(k,146) = b(k,146) - lu(k,743) * b(k,123) + b(k,157) = b(k,157) - lu(k,744) * b(k,123) + b(k,159) = b(k,159) - lu(k,745) * b(k,123) + b(k,163) = b(k,163) - lu(k,746) * b(k,123) + b(k,165) = b(k,165) - lu(k,747) * b(k,123) + b(k,167) = b(k,167) - lu(k,748) * b(k,123) + b(k,126) = b(k,126) - lu(k,760) * b(k,124) + b(k,127) = b(k,127) - lu(k,761) * b(k,124) + b(k,130) = b(k,130) - lu(k,762) * b(k,124) + b(k,133) = b(k,133) - lu(k,763) * b(k,124) + b(k,135) = b(k,135) - lu(k,764) * b(k,124) + b(k,138) = b(k,138) - lu(k,765) * b(k,124) + b(k,140) = b(k,140) - lu(k,766) * b(k,124) + b(k,141) = b(k,141) - lu(k,767) * b(k,124) + b(k,146) = b(k,146) - lu(k,768) * b(k,124) + b(k,153) = b(k,153) - lu(k,769) * b(k,124) + b(k,159) = b(k,159) - lu(k,770) * b(k,124) + b(k,161) = b(k,161) - lu(k,771) * b(k,124) + b(k,163) = b(k,163) - lu(k,772) * b(k,124) + b(k,166) = b(k,166) - lu(k,773) * b(k,124) + b(k,170) = b(k,170) - lu(k,774) * b(k,124) + b(k,171) = b(k,171) - lu(k,775) * b(k,124) + b(k,126) = b(k,126) - lu(k,787) * b(k,125) + b(k,127) = b(k,127) - lu(k,788) * b(k,125) + b(k,130) = b(k,130) - lu(k,789) * b(k,125) + b(k,133) = b(k,133) - lu(k,790) * b(k,125) + b(k,135) = b(k,135) - lu(k,791) * b(k,125) + b(k,138) = b(k,138) - lu(k,792) * b(k,125) + b(k,140) = b(k,140) - lu(k,793) * b(k,125) + b(k,141) = b(k,141) - lu(k,794) * b(k,125) + b(k,146) = b(k,146) - lu(k,795) * b(k,125) + b(k,153) = b(k,153) - lu(k,796) * b(k,125) + b(k,159) = b(k,159) - lu(k,797) * b(k,125) + b(k,161) = b(k,161) - lu(k,798) * b(k,125) + b(k,163) = b(k,163) - lu(k,799) * b(k,125) + b(k,166) = b(k,166) - lu(k,800) * b(k,125) + b(k,170) = b(k,170) - lu(k,801) * b(k,125) + b(k,171) = b(k,171) - lu(k,802) * b(k,125) + b(k,127) = b(k,127) - lu(k,809) * b(k,126) + b(k,134) = b(k,134) - lu(k,810) * b(k,126) + b(k,153) = b(k,153) - lu(k,811) * b(k,126) + b(k,157) = b(k,157) - lu(k,812) * b(k,126) + b(k,159) = b(k,159) - lu(k,813) * b(k,126) + b(k,161) = b(k,161) - lu(k,814) * b(k,126) + b(k,163) = b(k,163) - lu(k,815) * b(k,126) + b(k,165) = b(k,165) - lu(k,816) * b(k,126) + b(k,167) = b(k,167) - lu(k,817) * b(k,126) + b(k,141) = b(k,141) - lu(k,819) * b(k,127) + b(k,153) = b(k,153) - lu(k,820) * b(k,127) + b(k,157) = b(k,157) - lu(k,821) * b(k,127) + b(k,159) = b(k,159) - lu(k,822) * b(k,127) + b(k,171) = b(k,171) - lu(k,823) * b(k,127) + b(k,155) = b(k,155) - lu(k,827) * b(k,128) + b(k,159) = b(k,159) - lu(k,828) * b(k,128) + b(k,162) = b(k,162) - lu(k,829) * b(k,128) + b(k,164) = b(k,164) - lu(k,830) * b(k,128) + b(k,167) = b(k,167) - lu(k,831) * b(k,128) + b(k,168) = b(k,168) - lu(k,832) * b(k,128) + b(k,169) = b(k,169) - lu(k,833) * b(k,128) + b(k,170) = b(k,170) - lu(k,834) * b(k,128) + b(k,171) = b(k,171) - lu(k,835) * b(k,128) + b(k,134) = b(k,134) - lu(k,841) * b(k,129) + b(k,135) = b(k,135) - lu(k,842) * b(k,129) + b(k,137) = b(k,137) - lu(k,843) * b(k,129) + b(k,146) = b(k,146) - lu(k,844) * b(k,129) + b(k,153) = b(k,153) - lu(k,845) * b(k,129) + b(k,157) = b(k,157) - lu(k,846) * b(k,129) + b(k,159) = b(k,159) - lu(k,847) * b(k,129) + b(k,161) = b(k,161) - lu(k,848) * b(k,129) + b(k,163) = b(k,163) - lu(k,849) * b(k,129) + b(k,165) = b(k,165) - lu(k,850) * b(k,129) + b(k,166) = b(k,166) - lu(k,851) * b(k,129) + b(k,167) = b(k,167) - lu(k,852) * b(k,129) + b(k,170) = b(k,170) - lu(k,853) * b(k,129) + b(k,171) = b(k,171) - lu(k,854) * b(k,129) + b(k,133) = b(k,133) - lu(k,856) * b(k,130) + b(k,135) = b(k,135) - lu(k,857) * b(k,130) + b(k,139) = b(k,139) - lu(k,858) * b(k,130) + b(k,140) = b(k,140) - lu(k,859) * b(k,130) + b(k,159) = b(k,159) - lu(k,860) * b(k,130) + b(k,163) = b(k,163) - lu(k,861) * b(k,130) + b(k,170) = b(k,170) - lu(k,862) * b(k,130) + end do + end subroutine lu_slv03 + subroutine lu_slv04( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: k +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + do k = 1,avec_len + b(k,135) = b(k,135) - lu(k,865) * b(k,131) + b(k,159) = b(k,159) - lu(k,866) * b(k,131) + b(k,161) = b(k,161) - lu(k,867) * b(k,131) + b(k,163) = b(k,163) - lu(k,868) * b(k,131) + b(k,135) = b(k,135) - lu(k,874) * b(k,132) + b(k,146) = b(k,146) - lu(k,875) * b(k,132) + b(k,153) = b(k,153) - lu(k,876) * b(k,132) + b(k,155) = b(k,155) - lu(k,877) * b(k,132) + b(k,157) = b(k,157) - lu(k,878) * b(k,132) + b(k,159) = b(k,159) - lu(k,879) * b(k,132) + b(k,161) = b(k,161) - lu(k,880) * b(k,132) + b(k,163) = b(k,163) - lu(k,881) * b(k,132) + b(k,165) = b(k,165) - lu(k,882) * b(k,132) + b(k,167) = b(k,167) - lu(k,883) * b(k,132) + b(k,135) = b(k,135) - lu(k,886) * b(k,133) + b(k,141) = b(k,141) - lu(k,887) * b(k,133) + b(k,153) = b(k,153) - lu(k,888) * b(k,133) + b(k,157) = b(k,157) - lu(k,889) * b(k,133) + b(k,159) = b(k,159) - lu(k,890) * b(k,133) + b(k,161) = b(k,161) - lu(k,891) * b(k,133) + b(k,163) = b(k,163) - lu(k,892) * b(k,133) + b(k,171) = b(k,171) - lu(k,893) * b(k,133) + b(k,135) = b(k,135) - lu(k,895) * b(k,134) + b(k,153) = b(k,153) - lu(k,896) * b(k,134) + b(k,155) = b(k,155) - lu(k,897) * b(k,134) + b(k,157) = b(k,157) - lu(k,898) * b(k,134) + b(k,159) = b(k,159) - lu(k,899) * b(k,134) + b(k,163) = b(k,163) - lu(k,900) * b(k,134) + b(k,170) = b(k,170) - lu(k,901) * b(k,134) + b(k,171) = b(k,171) - lu(k,902) * b(k,134) + b(k,156) = b(k,156) - lu(k,904) * b(k,135) + b(k,159) = b(k,159) - lu(k,905) * b(k,135) + b(k,163) = b(k,163) - lu(k,906) * b(k,135) + b(k,137) = b(k,137) - lu(k,913) * b(k,136) + b(k,141) = b(k,141) - lu(k,914) * b(k,136) + b(k,153) = b(k,153) - lu(k,915) * b(k,136) + b(k,155) = b(k,155) - lu(k,916) * b(k,136) + b(k,156) = b(k,156) - lu(k,917) * b(k,136) + b(k,157) = b(k,157) - lu(k,918) * b(k,136) + b(k,159) = b(k,159) - lu(k,919) * b(k,136) + b(k,161) = b(k,161) - lu(k,920) * b(k,136) + b(k,163) = b(k,163) - lu(k,921) * b(k,136) + b(k,167) = b(k,167) - lu(k,922) * b(k,136) + b(k,170) = b(k,170) - lu(k,923) * b(k,136) + b(k,171) = b(k,171) - lu(k,924) * b(k,136) + b(k,146) = b(k,146) - lu(k,926) * b(k,137) + b(k,153) = b(k,153) - lu(k,927) * b(k,137) + b(k,159) = b(k,159) - lu(k,928) * b(k,137) + b(k,161) = b(k,161) - lu(k,929) * b(k,137) + b(k,163) = b(k,163) - lu(k,930) * b(k,137) + b(k,139) = b(k,139) - lu(k,939) * b(k,138) + b(k,140) = b(k,140) - lu(k,940) * b(k,138) + b(k,141) = b(k,141) - lu(k,941) * b(k,138) + b(k,153) = b(k,153) - lu(k,942) * b(k,138) + b(k,155) = b(k,155) - lu(k,943) * b(k,138) + b(k,156) = b(k,156) - lu(k,944) * b(k,138) + b(k,157) = b(k,157) - lu(k,945) * b(k,138) + b(k,159) = b(k,159) - lu(k,946) * b(k,138) + b(k,161) = b(k,161) - lu(k,947) * b(k,138) + b(k,163) = b(k,163) - lu(k,948) * b(k,138) + b(k,165) = b(k,165) - lu(k,949) * b(k,138) + b(k,167) = b(k,167) - lu(k,950) * b(k,138) + b(k,170) = b(k,170) - lu(k,951) * b(k,138) + b(k,171) = b(k,171) - lu(k,952) * b(k,138) + b(k,141) = b(k,141) - lu(k,961) * b(k,139) + b(k,153) = b(k,153) - lu(k,962) * b(k,139) + b(k,155) = b(k,155) - lu(k,963) * b(k,139) + b(k,156) = b(k,156) - lu(k,964) * b(k,139) + b(k,157) = b(k,157) - lu(k,965) * b(k,139) + b(k,159) = b(k,159) - lu(k,966) * b(k,139) + b(k,161) = b(k,161) - lu(k,967) * b(k,139) + b(k,163) = b(k,163) - lu(k,968) * b(k,139) + b(k,165) = b(k,165) - lu(k,969) * b(k,139) + b(k,167) = b(k,167) - lu(k,970) * b(k,139) + b(k,171) = b(k,171) - lu(k,971) * b(k,139) + b(k,141) = b(k,141) - lu(k,980) * b(k,140) + b(k,153) = b(k,153) - lu(k,981) * b(k,140) + b(k,155) = b(k,155) - lu(k,982) * b(k,140) + b(k,156) = b(k,156) - lu(k,983) * b(k,140) + b(k,157) = b(k,157) - lu(k,984) * b(k,140) + b(k,159) = b(k,159) - lu(k,985) * b(k,140) + b(k,161) = b(k,161) - lu(k,986) * b(k,140) + b(k,163) = b(k,163) - lu(k,987) * b(k,140) + b(k,165) = b(k,165) - lu(k,988) * b(k,140) + b(k,167) = b(k,167) - lu(k,989) * b(k,140) + b(k,170) = b(k,170) - lu(k,990) * b(k,140) + b(k,171) = b(k,171) - lu(k,991) * b(k,140) + b(k,146) = b(k,146) - lu(k,996) * b(k,141) + b(k,153) = b(k,153) - lu(k,997) * b(k,141) + b(k,157) = b(k,157) - lu(k,998) * b(k,141) + b(k,159) = b(k,159) - lu(k,999) * b(k,141) + b(k,161) = b(k,161) - lu(k,1000) * b(k,141) + b(k,163) = b(k,163) - lu(k,1001) * b(k,141) + b(k,165) = b(k,165) - lu(k,1002) * b(k,141) + b(k,167) = b(k,167) - lu(k,1003) * b(k,141) + b(k,171) = b(k,171) - lu(k,1004) * b(k,141) + b(k,146) = b(k,146) - lu(k,1012) * b(k,142) + b(k,153) = b(k,153) - lu(k,1013) * b(k,142) + b(k,156) = b(k,156) - lu(k,1014) * b(k,142) + b(k,157) = b(k,157) - lu(k,1015) * b(k,142) + b(k,159) = b(k,159) - lu(k,1016) * b(k,142) + b(k,161) = b(k,161) - lu(k,1017) * b(k,142) + b(k,163) = b(k,163) - lu(k,1018) * b(k,142) + b(k,165) = b(k,165) - lu(k,1019) * b(k,142) + b(k,167) = b(k,167) - lu(k,1020) * b(k,142) + b(k,170) = b(k,170) - lu(k,1021) * b(k,142) + b(k,155) = b(k,155) - lu(k,1025) * b(k,143) + b(k,156) = b(k,156) - lu(k,1026) * b(k,143) + b(k,157) = b(k,157) - lu(k,1027) * b(k,143) + b(k,158) = b(k,158) - lu(k,1028) * b(k,143) + b(k,159) = b(k,159) - lu(k,1029) * b(k,143) + b(k,162) = b(k,162) - lu(k,1030) * b(k,143) + b(k,168) = b(k,168) - lu(k,1031) * b(k,143) + b(k,169) = b(k,169) - lu(k,1032) * b(k,143) + b(k,170) = b(k,170) - lu(k,1033) * b(k,143) + b(k,171) = b(k,171) - lu(k,1034) * b(k,143) + b(k,145) = b(k,145) - lu(k,1045) * b(k,144) + b(k,146) = b(k,146) - lu(k,1046) * b(k,144) + b(k,149) = b(k,149) - lu(k,1047) * b(k,144) + b(k,153) = b(k,153) - lu(k,1048) * b(k,144) + b(k,155) = b(k,155) - lu(k,1049) * b(k,144) + b(k,156) = b(k,156) - lu(k,1050) * b(k,144) + b(k,157) = b(k,157) - lu(k,1051) * b(k,144) + b(k,159) = b(k,159) - lu(k,1052) * b(k,144) + b(k,161) = b(k,161) - lu(k,1053) * b(k,144) + b(k,163) = b(k,163) - lu(k,1054) * b(k,144) + b(k,165) = b(k,165) - lu(k,1055) * b(k,144) + b(k,167) = b(k,167) - lu(k,1056) * b(k,144) + b(k,170) = b(k,170) - lu(k,1057) * b(k,144) + b(k,146) = b(k,146) - lu(k,1061) * b(k,145) + b(k,150) = b(k,150) - lu(k,1062) * b(k,145) + b(k,152) = b(k,152) - lu(k,1063) * b(k,145) + b(k,153) = b(k,153) - lu(k,1064) * b(k,145) + b(k,156) = b(k,156) - lu(k,1065) * b(k,145) + b(k,159) = b(k,159) - lu(k,1066) * b(k,145) + b(k,161) = b(k,161) - lu(k,1067) * b(k,145) + b(k,163) = b(k,163) - lu(k,1068) * b(k,145) + b(k,166) = b(k,166) - lu(k,1069) * b(k,145) + b(k,171) = b(k,171) - lu(k,1070) * b(k,145) + b(k,153) = b(k,153) - lu(k,1073) * b(k,146) + b(k,155) = b(k,155) - lu(k,1074) * b(k,146) + b(k,156) = b(k,156) - lu(k,1075) * b(k,146) + b(k,159) = b(k,159) - lu(k,1076) * b(k,146) + b(k,163) = b(k,163) - lu(k,1077) * b(k,146) + b(k,170) = b(k,170) - lu(k,1078) * b(k,146) + b(k,171) = b(k,171) - lu(k,1079) * b(k,146) + b(k,154) = b(k,154) - lu(k,1084) * b(k,147) + b(k,156) = b(k,156) - lu(k,1085) * b(k,147) + b(k,159) = b(k,159) - lu(k,1086) * b(k,147) + b(k,160) = b(k,160) - lu(k,1087) * b(k,147) + b(k,162) = b(k,162) - lu(k,1088) * b(k,147) + b(k,163) = b(k,163) - lu(k,1089) * b(k,147) + b(k,164) = b(k,164) - lu(k,1090) * b(k,147) + b(k,165) = b(k,165) - lu(k,1091) * b(k,147) + b(k,166) = b(k,166) - lu(k,1092) * b(k,147) + b(k,167) = b(k,167) - lu(k,1093) * b(k,147) + b(k,169) = b(k,169) - lu(k,1094) * b(k,147) + b(k,171) = b(k,171) - lu(k,1095) * b(k,147) + b(k,149) = b(k,149) - lu(k,1114) * b(k,148) + b(k,150) = b(k,150) - lu(k,1115) * b(k,148) + b(k,152) = b(k,152) - lu(k,1116) * b(k,148) + b(k,153) = b(k,153) - lu(k,1117) * b(k,148) + b(k,155) = b(k,155) - lu(k,1118) * b(k,148) + b(k,156) = b(k,156) - lu(k,1119) * b(k,148) + b(k,157) = b(k,157) - lu(k,1120) * b(k,148) + b(k,159) = b(k,159) - lu(k,1121) * b(k,148) + b(k,161) = b(k,161) - lu(k,1122) * b(k,148) + b(k,163) = b(k,163) - lu(k,1123) * b(k,148) + b(k,165) = b(k,165) - lu(k,1124) * b(k,148) + b(k,166) = b(k,166) - lu(k,1125) * b(k,148) + b(k,167) = b(k,167) - lu(k,1126) * b(k,148) + b(k,170) = b(k,170) - lu(k,1127) * b(k,148) + b(k,171) = b(k,171) - lu(k,1128) * b(k,148) + b(k,150) = b(k,150) - lu(k,1136) * b(k,149) + b(k,153) = b(k,153) - lu(k,1137) * b(k,149) + b(k,155) = b(k,155) - lu(k,1138) * b(k,149) + b(k,156) = b(k,156) - lu(k,1139) * b(k,149) + b(k,157) = b(k,157) - lu(k,1140) * b(k,149) + b(k,159) = b(k,159) - lu(k,1141) * b(k,149) + b(k,161) = b(k,161) - lu(k,1142) * b(k,149) + b(k,163) = b(k,163) - lu(k,1143) * b(k,149) + b(k,165) = b(k,165) - lu(k,1144) * b(k,149) + b(k,166) = b(k,166) - lu(k,1145) * b(k,149) + b(k,167) = b(k,167) - lu(k,1146) * b(k,149) + b(k,170) = b(k,170) - lu(k,1147) * b(k,149) + b(k,171) = b(k,171) - lu(k,1148) * b(k,149) + b(k,152) = b(k,152) - lu(k,1158) * b(k,150) + b(k,153) = b(k,153) - lu(k,1159) * b(k,150) + b(k,155) = b(k,155) - lu(k,1160) * b(k,150) + b(k,156) = b(k,156) - lu(k,1161) * b(k,150) + b(k,157) = b(k,157) - lu(k,1162) * b(k,150) + b(k,159) = b(k,159) - lu(k,1163) * b(k,150) + b(k,161) = b(k,161) - lu(k,1164) * b(k,150) + b(k,163) = b(k,163) - lu(k,1165) * b(k,150) + b(k,165) = b(k,165) - lu(k,1166) * b(k,150) + b(k,167) = b(k,167) - lu(k,1167) * b(k,150) + b(k,170) = b(k,170) - lu(k,1168) * b(k,150) + b(k,171) = b(k,171) - lu(k,1169) * b(k,150) + b(k,152) = b(k,152) - lu(k,1184) * b(k,151) + b(k,153) = b(k,153) - lu(k,1185) * b(k,151) + b(k,155) = b(k,155) - lu(k,1186) * b(k,151) + b(k,156) = b(k,156) - lu(k,1187) * b(k,151) + b(k,157) = b(k,157) - lu(k,1188) * b(k,151) + b(k,159) = b(k,159) - lu(k,1189) * b(k,151) + b(k,161) = b(k,161) - lu(k,1190) * b(k,151) + b(k,163) = b(k,163) - lu(k,1191) * b(k,151) + b(k,165) = b(k,165) - lu(k,1192) * b(k,151) + b(k,166) = b(k,166) - lu(k,1193) * b(k,151) + b(k,167) = b(k,167) - lu(k,1194) * b(k,151) + b(k,170) = b(k,170) - lu(k,1195) * b(k,151) + b(k,171) = b(k,171) - lu(k,1196) * b(k,151) + end do + end subroutine lu_slv04 + subroutine lu_slv05( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: k +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + do k = 1,avec_len + b(k,153) = b(k,153) - lu(k,1203) * b(k,152) + b(k,155) = b(k,155) - lu(k,1204) * b(k,152) + b(k,156) = b(k,156) - lu(k,1205) * b(k,152) + b(k,157) = b(k,157) - lu(k,1206) * b(k,152) + b(k,159) = b(k,159) - lu(k,1207) * b(k,152) + b(k,161) = b(k,161) - lu(k,1208) * b(k,152) + b(k,163) = b(k,163) - lu(k,1209) * b(k,152) + b(k,165) = b(k,165) - lu(k,1210) * b(k,152) + b(k,166) = b(k,166) - lu(k,1211) * b(k,152) + b(k,167) = b(k,167) - lu(k,1212) * b(k,152) + b(k,170) = b(k,170) - lu(k,1213) * b(k,152) + b(k,171) = b(k,171) - lu(k,1214) * b(k,152) + b(k,155) = b(k,155) - lu(k,1234) * b(k,153) + b(k,156) = b(k,156) - lu(k,1235) * b(k,153) + b(k,157) = b(k,157) - lu(k,1236) * b(k,153) + b(k,159) = b(k,159) - lu(k,1237) * b(k,153) + b(k,161) = b(k,161) - lu(k,1238) * b(k,153) + b(k,163) = b(k,163) - lu(k,1239) * b(k,153) + b(k,165) = b(k,165) - lu(k,1240) * b(k,153) + b(k,166) = b(k,166) - lu(k,1241) * b(k,153) + b(k,167) = b(k,167) - lu(k,1242) * b(k,153) + b(k,170) = b(k,170) - lu(k,1243) * b(k,153) + b(k,171) = b(k,171) - lu(k,1244) * b(k,153) + b(k,156) = b(k,156) - lu(k,1248) * b(k,154) + b(k,158) = b(k,158) - lu(k,1249) * b(k,154) + b(k,159) = b(k,159) - lu(k,1250) * b(k,154) + b(k,160) = b(k,160) - lu(k,1251) * b(k,154) + b(k,161) = b(k,161) - lu(k,1252) * b(k,154) + b(k,162) = b(k,162) - lu(k,1253) * b(k,154) + b(k,163) = b(k,163) - lu(k,1254) * b(k,154) + b(k,166) = b(k,166) - lu(k,1255) * b(k,154) + b(k,171) = b(k,171) - lu(k,1256) * b(k,154) + b(k,156) = b(k,156) - lu(k,1261) * b(k,155) + b(k,157) = b(k,157) - lu(k,1262) * b(k,155) + b(k,158) = b(k,158) - lu(k,1263) * b(k,155) + b(k,159) = b(k,159) - lu(k,1264) * b(k,155) + b(k,162) = b(k,162) - lu(k,1265) * b(k,155) + b(k,167) = b(k,167) - lu(k,1266) * b(k,155) + b(k,168) = b(k,168) - lu(k,1267) * b(k,155) + b(k,169) = b(k,169) - lu(k,1268) * b(k,155) + b(k,170) = b(k,170) - lu(k,1269) * b(k,155) + b(k,171) = b(k,171) - lu(k,1270) * b(k,155) + b(k,157) = b(k,157) - lu(k,1274) * b(k,156) + b(k,158) = b(k,158) - lu(k,1275) * b(k,156) + b(k,159) = b(k,159) - lu(k,1276) * b(k,156) + b(k,162) = b(k,162) - lu(k,1277) * b(k,156) + b(k,163) = b(k,163) - lu(k,1278) * b(k,156) + b(k,166) = b(k,166) - lu(k,1279) * b(k,156) + b(k,167) = b(k,167) - lu(k,1280) * b(k,156) + b(k,168) = b(k,168) - lu(k,1281) * b(k,156) + b(k,169) = b(k,169) - lu(k,1282) * b(k,156) + b(k,170) = b(k,170) - lu(k,1283) * b(k,156) + b(k,171) = b(k,171) - lu(k,1284) * b(k,156) + b(k,158) = b(k,158) - lu(k,1321) * b(k,157) + b(k,159) = b(k,159) - lu(k,1322) * b(k,157) + b(k,161) = b(k,161) - lu(k,1323) * b(k,157) + b(k,162) = b(k,162) - lu(k,1324) * b(k,157) + b(k,163) = b(k,163) - lu(k,1325) * b(k,157) + b(k,164) = b(k,164) - lu(k,1326) * b(k,157) + b(k,165) = b(k,165) - lu(k,1327) * b(k,157) + b(k,166) = b(k,166) - lu(k,1328) * b(k,157) + b(k,167) = b(k,167) - lu(k,1329) * b(k,157) + b(k,168) = b(k,168) - lu(k,1330) * b(k,157) + b(k,169) = b(k,169) - lu(k,1331) * b(k,157) + b(k,170) = b(k,170) - lu(k,1332) * b(k,157) + b(k,171) = b(k,171) - lu(k,1333) * b(k,157) + b(k,159) = b(k,159) - lu(k,1345) * b(k,158) + b(k,160) = b(k,160) - lu(k,1346) * b(k,158) + b(k,161) = b(k,161) - lu(k,1347) * b(k,158) + b(k,162) = b(k,162) - lu(k,1348) * b(k,158) + b(k,163) = b(k,163) - lu(k,1349) * b(k,158) + b(k,164) = b(k,164) - lu(k,1350) * b(k,158) + b(k,165) = b(k,165) - lu(k,1351) * b(k,158) + b(k,166) = b(k,166) - lu(k,1352) * b(k,158) + b(k,167) = b(k,167) - lu(k,1353) * b(k,158) + b(k,168) = b(k,168) - lu(k,1354) * b(k,158) + b(k,169) = b(k,169) - lu(k,1355) * b(k,158) + b(k,170) = b(k,170) - lu(k,1356) * b(k,158) + b(k,171) = b(k,171) - lu(k,1357) * b(k,158) + b(k,160) = b(k,160) - lu(k,1500) * b(k,159) + b(k,161) = b(k,161) - lu(k,1501) * b(k,159) + b(k,162) = b(k,162) - lu(k,1502) * b(k,159) + b(k,163) = b(k,163) - lu(k,1503) * b(k,159) + b(k,164) = b(k,164) - lu(k,1504) * b(k,159) + b(k,165) = b(k,165) - lu(k,1505) * b(k,159) + b(k,166) = b(k,166) - lu(k,1506) * b(k,159) + b(k,167) = b(k,167) - lu(k,1507) * b(k,159) + b(k,168) = b(k,168) - lu(k,1508) * b(k,159) + b(k,169) = b(k,169) - lu(k,1509) * b(k,159) + b(k,170) = b(k,170) - lu(k,1510) * b(k,159) + b(k,171) = b(k,171) - lu(k,1511) * b(k,159) + b(k,161) = b(k,161) - lu(k,1525) * b(k,160) + b(k,162) = b(k,162) - lu(k,1526) * b(k,160) + b(k,163) = b(k,163) - lu(k,1527) * b(k,160) + b(k,164) = b(k,164) - lu(k,1528) * b(k,160) + b(k,165) = b(k,165) - lu(k,1529) * b(k,160) + b(k,166) = b(k,166) - lu(k,1530) * b(k,160) + b(k,167) = b(k,167) - lu(k,1531) * b(k,160) + b(k,168) = b(k,168) - lu(k,1532) * b(k,160) + b(k,169) = b(k,169) - lu(k,1533) * b(k,160) + b(k,170) = b(k,170) - lu(k,1534) * b(k,160) + b(k,171) = b(k,171) - lu(k,1535) * b(k,160) + b(k,162) = b(k,162) - lu(k,1549) * b(k,161) + b(k,163) = b(k,163) - lu(k,1550) * b(k,161) + b(k,164) = b(k,164) - lu(k,1551) * b(k,161) + b(k,165) = b(k,165) - lu(k,1552) * b(k,161) + b(k,166) = b(k,166) - lu(k,1553) * b(k,161) + b(k,167) = b(k,167) - lu(k,1554) * b(k,161) + b(k,168) = b(k,168) - lu(k,1555) * b(k,161) + b(k,169) = b(k,169) - lu(k,1556) * b(k,161) + b(k,170) = b(k,170) - lu(k,1557) * b(k,161) + b(k,171) = b(k,171) - lu(k,1558) * b(k,161) + b(k,163) = b(k,163) - lu(k,1580) * b(k,162) + b(k,164) = b(k,164) - lu(k,1581) * b(k,162) + b(k,165) = b(k,165) - lu(k,1582) * b(k,162) + b(k,166) = b(k,166) - lu(k,1583) * b(k,162) + b(k,167) = b(k,167) - lu(k,1584) * b(k,162) + b(k,168) = b(k,168) - lu(k,1585) * b(k,162) + b(k,169) = b(k,169) - lu(k,1586) * b(k,162) + b(k,170) = b(k,170) - lu(k,1587) * b(k,162) + b(k,171) = b(k,171) - lu(k,1588) * b(k,162) + b(k,164) = b(k,164) - lu(k,1687) * b(k,163) + b(k,165) = b(k,165) - lu(k,1688) * b(k,163) + b(k,166) = b(k,166) - lu(k,1689) * b(k,163) + b(k,167) = b(k,167) - lu(k,1690) * b(k,163) + b(k,168) = b(k,168) - lu(k,1691) * b(k,163) + b(k,169) = b(k,169) - lu(k,1692) * b(k,163) + b(k,170) = b(k,170) - lu(k,1693) * b(k,163) + b(k,171) = b(k,171) - lu(k,1694) * b(k,163) + b(k,165) = b(k,165) - lu(k,1714) * b(k,164) + b(k,166) = b(k,166) - lu(k,1715) * b(k,164) + b(k,167) = b(k,167) - lu(k,1716) * b(k,164) + b(k,168) = b(k,168) - lu(k,1717) * b(k,164) + b(k,169) = b(k,169) - lu(k,1718) * b(k,164) + b(k,170) = b(k,170) - lu(k,1719) * b(k,164) + b(k,171) = b(k,171) - lu(k,1720) * b(k,164) + b(k,166) = b(k,166) - lu(k,1805) * b(k,165) + b(k,167) = b(k,167) - lu(k,1806) * b(k,165) + b(k,168) = b(k,168) - lu(k,1807) * b(k,165) + b(k,169) = b(k,169) - lu(k,1808) * b(k,165) + b(k,170) = b(k,170) - lu(k,1809) * b(k,165) + b(k,171) = b(k,171) - lu(k,1810) * b(k,165) + b(k,167) = b(k,167) - lu(k,1866) * b(k,166) + b(k,168) = b(k,168) - lu(k,1867) * b(k,166) + b(k,169) = b(k,169) - lu(k,1868) * b(k,166) + b(k,170) = b(k,170) - lu(k,1869) * b(k,166) + b(k,171) = b(k,171) - lu(k,1870) * b(k,166) + b(k,168) = b(k,168) - lu(k,1908) * b(k,167) + b(k,169) = b(k,169) - lu(k,1909) * b(k,167) + b(k,170) = b(k,170) - lu(k,1910) * b(k,167) + b(k,171) = b(k,171) - lu(k,1911) * b(k,167) + b(k,169) = b(k,169) - lu(k,1932) * b(k,168) + b(k,170) = b(k,170) - lu(k,1933) * b(k,168) + b(k,171) = b(k,171) - lu(k,1934) * b(k,168) + b(k,170) = b(k,170) - lu(k,1967) * b(k,169) + b(k,171) = b(k,171) - lu(k,1968) * b(k,169) + b(k,171) = b(k,171) - lu(k,2025) * b(k,170) + end do + end subroutine lu_slv05 + subroutine lu_slv06( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: k +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + do k = 1,avec_len +!----------------------------------------------------------------------- +! ... Solve U * x = y +!----------------------------------------------------------------------- + b(k,171) = b(k,171) * lu(k,2050) + b(k,170) = b(k,170) - lu(k,2049) * b(k,171) + b(k,169) = b(k,169) - lu(k,2048) * b(k,171) + b(k,168) = b(k,168) - lu(k,2047) * b(k,171) + b(k,167) = b(k,167) - lu(k,2046) * b(k,171) + b(k,166) = b(k,166) - lu(k,2045) * b(k,171) + b(k,165) = b(k,165) - lu(k,2044) * b(k,171) + b(k,164) = b(k,164) - lu(k,2043) * b(k,171) + b(k,163) = b(k,163) - lu(k,2042) * b(k,171) + b(k,162) = b(k,162) - lu(k,2041) * b(k,171) + b(k,161) = b(k,161) - lu(k,2040) * b(k,171) + b(k,160) = b(k,160) - lu(k,2039) * b(k,171) + b(k,159) = b(k,159) - lu(k,2038) * b(k,171) + b(k,158) = b(k,158) - lu(k,2037) * b(k,171) + b(k,157) = b(k,157) - lu(k,2036) * b(k,171) + b(k,156) = b(k,156) - lu(k,2035) * b(k,171) + b(k,155) = b(k,155) - lu(k,2034) * b(k,171) + b(k,154) = b(k,154) - lu(k,2033) * b(k,171) + b(k,147) = b(k,147) - lu(k,2032) * b(k,171) + b(k,143) = b(k,143) - lu(k,2031) * b(k,171) + b(k,120) = b(k,120) - lu(k,2030) * b(k,171) + b(k,111) = b(k,111) - lu(k,2029) * b(k,171) + b(k,45) = b(k,45) - lu(k,2028) * b(k,171) + b(k,37) = b(k,37) - lu(k,2027) * b(k,171) + b(k,22) = b(k,22) - lu(k,2026) * b(k,171) + b(k,170) = b(k,170) * lu(k,2024) + b(k,169) = b(k,169) - lu(k,2023) * b(k,170) + b(k,168) = b(k,168) - lu(k,2022) * b(k,170) + b(k,167) = b(k,167) - lu(k,2021) * b(k,170) + b(k,166) = b(k,166) - lu(k,2020) * b(k,170) + b(k,165) = b(k,165) - lu(k,2019) * b(k,170) + b(k,164) = b(k,164) - lu(k,2018) * b(k,170) + b(k,163) = b(k,163) - lu(k,2017) * b(k,170) + b(k,162) = b(k,162) - lu(k,2016) * b(k,170) + b(k,161) = b(k,161) - lu(k,2015) * b(k,170) + b(k,160) = b(k,160) - lu(k,2014) * b(k,170) + b(k,159) = b(k,159) - lu(k,2013) * b(k,170) + b(k,158) = b(k,158) - lu(k,2012) * b(k,170) + b(k,157) = b(k,157) - lu(k,2011) * b(k,170) + b(k,156) = b(k,156) - lu(k,2010) * b(k,170) + b(k,155) = b(k,155) - lu(k,2009) * b(k,170) + b(k,154) = b(k,154) - lu(k,2008) * b(k,170) + b(k,153) = b(k,153) - lu(k,2007) * b(k,170) + b(k,152) = b(k,152) - lu(k,2006) * b(k,170) + b(k,151) = b(k,151) - lu(k,2005) * b(k,170) + b(k,150) = b(k,150) - lu(k,2004) * b(k,170) + b(k,149) = b(k,149) - lu(k,2003) * b(k,170) + b(k,148) = b(k,148) - lu(k,2002) * b(k,170) + b(k,147) = b(k,147) - lu(k,2001) * b(k,170) + b(k,146) = b(k,146) - lu(k,2000) * b(k,170) + b(k,145) = b(k,145) - lu(k,1999) * b(k,170) + b(k,144) = b(k,144) - lu(k,1998) * b(k,170) + b(k,142) = b(k,142) - lu(k,1997) * b(k,170) + b(k,141) = b(k,141) - lu(k,1996) * b(k,170) + b(k,140) = b(k,140) - lu(k,1995) * b(k,170) + b(k,139) = b(k,139) - lu(k,1994) * b(k,170) + b(k,138) = b(k,138) - lu(k,1993) * b(k,170) + b(k,137) = b(k,137) - lu(k,1992) * b(k,170) + b(k,136) = b(k,136) - lu(k,1991) * b(k,170) + b(k,135) = b(k,135) - lu(k,1990) * b(k,170) + b(k,134) = b(k,134) - lu(k,1989) * b(k,170) + b(k,133) = b(k,133) - lu(k,1988) * b(k,170) + b(k,132) = b(k,132) - lu(k,1987) * b(k,170) + b(k,131) = b(k,131) - lu(k,1986) * b(k,170) + b(k,130) = b(k,130) - lu(k,1985) * b(k,170) + b(k,129) = b(k,129) - lu(k,1984) * b(k,170) + b(k,127) = b(k,127) - lu(k,1983) * b(k,170) + b(k,126) = b(k,126) - lu(k,1982) * b(k,170) + b(k,125) = b(k,125) - lu(k,1981) * b(k,170) + b(k,124) = b(k,124) - lu(k,1980) * b(k,170) + b(k,122) = b(k,122) - lu(k,1979) * b(k,170) + b(k,121) = b(k,121) - lu(k,1978) * b(k,170) + b(k,120) = b(k,120) - lu(k,1977) * b(k,170) + b(k,119) = b(k,119) - lu(k,1976) * b(k,170) + b(k,91) = b(k,91) - lu(k,1975) * b(k,170) + b(k,61) = b(k,61) - lu(k,1974) * b(k,170) + b(k,52) = b(k,52) - lu(k,1973) * b(k,170) + b(k,48) = b(k,48) - lu(k,1972) * b(k,170) + b(k,47) = b(k,47) - lu(k,1971) * b(k,170) + b(k,6) = b(k,6) - lu(k,1970) * b(k,170) + b(k,5) = b(k,5) - lu(k,1969) * b(k,170) + b(k,169) = b(k,169) * lu(k,1966) + b(k,168) = b(k,168) - lu(k,1965) * b(k,169) + b(k,167) = b(k,167) - lu(k,1964) * b(k,169) + b(k,166) = b(k,166) - lu(k,1963) * b(k,169) + b(k,165) = b(k,165) - lu(k,1962) * b(k,169) + b(k,164) = b(k,164) - lu(k,1961) * b(k,169) + b(k,163) = b(k,163) - lu(k,1960) * b(k,169) + b(k,162) = b(k,162) - lu(k,1959) * b(k,169) + b(k,161) = b(k,161) - lu(k,1958) * b(k,169) + b(k,160) = b(k,160) - lu(k,1957) * b(k,169) + b(k,159) = b(k,159) - lu(k,1956) * b(k,169) + b(k,158) = b(k,158) - lu(k,1955) * b(k,169) + b(k,157) = b(k,157) - lu(k,1954) * b(k,169) + b(k,156) = b(k,156) - lu(k,1953) * b(k,169) + b(k,155) = b(k,155) - lu(k,1952) * b(k,169) + b(k,154) = b(k,154) - lu(k,1951) * b(k,169) + b(k,153) = b(k,153) - lu(k,1950) * b(k,169) + b(k,143) = b(k,143) - lu(k,1949) * b(k,169) + b(k,135) = b(k,135) - lu(k,1948) * b(k,169) + b(k,134) = b(k,134) - lu(k,1947) * b(k,169) + b(k,131) = b(k,131) - lu(k,1946) * b(k,169) + b(k,128) = b(k,128) - lu(k,1945) * b(k,169) + b(k,122) = b(k,122) - lu(k,1944) * b(k,169) + b(k,117) = b(k,117) - lu(k,1943) * b(k,169) + b(k,116) = b(k,116) - lu(k,1942) * b(k,169) + b(k,115) = b(k,115) - lu(k,1941) * b(k,169) + b(k,104) = b(k,104) - lu(k,1940) * b(k,169) + b(k,93) = b(k,93) - lu(k,1939) * b(k,169) + b(k,90) = b(k,90) - lu(k,1938) * b(k,169) + b(k,50) = b(k,50) - lu(k,1937) * b(k,169) + b(k,49) = b(k,49) - lu(k,1936) * b(k,169) + b(k,25) = b(k,25) - lu(k,1935) * b(k,169) + b(k,168) = b(k,168) * lu(k,1931) + b(k,167) = b(k,167) - lu(k,1930) * b(k,168) + b(k,166) = b(k,166) - lu(k,1929) * b(k,168) + b(k,165) = b(k,165) - lu(k,1928) * b(k,168) + b(k,164) = b(k,164) - lu(k,1927) * b(k,168) + b(k,163) = b(k,163) - lu(k,1926) * b(k,168) + b(k,162) = b(k,162) - lu(k,1925) * b(k,168) + b(k,161) = b(k,161) - lu(k,1924) * b(k,168) + b(k,160) = b(k,160) - lu(k,1923) * b(k,168) + b(k,159) = b(k,159) - lu(k,1922) * b(k,168) + b(k,158) = b(k,158) - lu(k,1921) * b(k,168) + b(k,157) = b(k,157) - lu(k,1920) * b(k,168) + b(k,156) = b(k,156) - lu(k,1919) * b(k,168) + b(k,155) = b(k,155) - lu(k,1918) * b(k,168) + b(k,154) = b(k,154) - lu(k,1917) * b(k,168) + b(k,128) = b(k,128) - lu(k,1916) * b(k,168) + b(k,116) = b(k,116) - lu(k,1915) * b(k,168) + b(k,112) = b(k,112) - lu(k,1914) * b(k,168) + b(k,42) = b(k,42) - lu(k,1913) * b(k,168) + b(k,25) = b(k,25) - lu(k,1912) * b(k,168) + b(k,167) = b(k,167) * lu(k,1907) + b(k,166) = b(k,166) - lu(k,1906) * b(k,167) + b(k,165) = b(k,165) - lu(k,1905) * b(k,167) + b(k,164) = b(k,164) - lu(k,1904) * b(k,167) + b(k,163) = b(k,163) - lu(k,1903) * b(k,167) + b(k,162) = b(k,162) - lu(k,1902) * b(k,167) + b(k,161) = b(k,161) - lu(k,1901) * b(k,167) + b(k,160) = b(k,160) - lu(k,1900) * b(k,167) + b(k,159) = b(k,159) - lu(k,1899) * b(k,167) + b(k,158) = b(k,158) - lu(k,1898) * b(k,167) + b(k,157) = b(k,157) - lu(k,1897) * b(k,167) + b(k,156) = b(k,156) - lu(k,1896) * b(k,167) + b(k,155) = b(k,155) - lu(k,1895) * b(k,167) + b(k,154) = b(k,154) - lu(k,1894) * b(k,167) + b(k,153) = b(k,153) - lu(k,1893) * b(k,167) + b(k,152) = b(k,152) - lu(k,1892) * b(k,167) + b(k,147) = b(k,147) - lu(k,1891) * b(k,167) + b(k,146) = b(k,146) - lu(k,1890) * b(k,167) + b(k,137) = b(k,137) - lu(k,1889) * b(k,167) + b(k,135) = b(k,135) - lu(k,1888) * b(k,167) + b(k,128) = b(k,128) - lu(k,1887) * b(k,167) + b(k,123) = b(k,123) - lu(k,1886) * b(k,167) + b(k,122) = b(k,122) - lu(k,1885) * b(k,167) + b(k,120) = b(k,120) - lu(k,1884) * b(k,167) + b(k,112) = b(k,112) - lu(k,1883) * b(k,167) + b(k,109) = b(k,109) - lu(k,1882) * b(k,167) + b(k,105) = b(k,105) - lu(k,1881) * b(k,167) + b(k,99) = b(k,99) - lu(k,1880) * b(k,167) + b(k,92) = b(k,92) - lu(k,1879) * b(k,167) + b(k,86) = b(k,86) - lu(k,1878) * b(k,167) + b(k,85) = b(k,85) - lu(k,1877) * b(k,167) + b(k,78) = b(k,78) - lu(k,1876) * b(k,167) + b(k,77) = b(k,77) - lu(k,1875) * b(k,167) + b(k,64) = b(k,64) - lu(k,1874) * b(k,167) + b(k,62) = b(k,62) - lu(k,1873) * b(k,167) + b(k,48) = b(k,48) - lu(k,1872) * b(k,167) + b(k,24) = b(k,24) - lu(k,1871) * b(k,167) + b(k,166) = b(k,166) * lu(k,1865) + b(k,165) = b(k,165) - lu(k,1864) * b(k,166) + b(k,164) = b(k,164) - lu(k,1863) * b(k,166) + b(k,163) = b(k,163) - lu(k,1862) * b(k,166) + b(k,162) = b(k,162) - lu(k,1861) * b(k,166) + b(k,161) = b(k,161) - lu(k,1860) * b(k,166) + b(k,160) = b(k,160) - lu(k,1859) * b(k,166) + b(k,159) = b(k,159) - lu(k,1858) * b(k,166) + b(k,158) = b(k,158) - lu(k,1857) * b(k,166) + b(k,157) = b(k,157) - lu(k,1856) * b(k,166) + b(k,156) = b(k,156) - lu(k,1855) * b(k,166) + b(k,155) = b(k,155) - lu(k,1854) * b(k,166) + b(k,154) = b(k,154) - lu(k,1853) * b(k,166) + b(k,153) = b(k,153) - lu(k,1852) * b(k,166) + b(k,152) = b(k,152) - lu(k,1851) * b(k,166) + b(k,151) = b(k,151) - lu(k,1850) * b(k,166) + b(k,150) = b(k,150) - lu(k,1849) * b(k,166) + b(k,149) = b(k,149) - lu(k,1848) * b(k,166) + b(k,148) = b(k,148) - lu(k,1847) * b(k,166) + b(k,147) = b(k,147) - lu(k,1846) * b(k,166) + b(k,146) = b(k,146) - lu(k,1845) * b(k,166) + b(k,145) = b(k,145) - lu(k,1844) * b(k,166) + b(k,144) = b(k,144) - lu(k,1843) * b(k,166) + b(k,141) = b(k,141) - lu(k,1842) * b(k,166) + b(k,140) = b(k,140) - lu(k,1841) * b(k,166) + b(k,139) = b(k,139) - lu(k,1840) * b(k,166) + b(k,138) = b(k,138) - lu(k,1839) * b(k,166) + b(k,137) = b(k,137) - lu(k,1838) * b(k,166) + b(k,135) = b(k,135) - lu(k,1837) * b(k,166) + b(k,134) = b(k,134) - lu(k,1836) * b(k,166) + b(k,133) = b(k,133) - lu(k,1835) * b(k,166) + b(k,131) = b(k,131) - lu(k,1834) * b(k,166) + b(k,130) = b(k,130) - lu(k,1833) * b(k,166) + b(k,129) = b(k,129) - lu(k,1832) * b(k,166) + b(k,127) = b(k,127) - lu(k,1831) * b(k,166) + b(k,126) = b(k,126) - lu(k,1830) * b(k,166) + b(k,125) = b(k,125) - lu(k,1829) * b(k,166) + b(k,124) = b(k,124) - lu(k,1828) * b(k,166) + b(k,122) = b(k,122) - lu(k,1827) * b(k,166) + b(k,120) = b(k,120) - lu(k,1826) * b(k,166) + b(k,119) = b(k,119) - lu(k,1825) * b(k,166) + b(k,115) = b(k,115) - lu(k,1824) * b(k,166) + b(k,104) = b(k,104) - lu(k,1823) * b(k,166) + b(k,99) = b(k,99) - lu(k,1822) * b(k,166) + b(k,90) = b(k,90) - lu(k,1821) * b(k,166) + b(k,88) = b(k,88) - lu(k,1820) * b(k,166) + b(k,82) = b(k,82) - lu(k,1819) * b(k,166) + b(k,78) = b(k,78) - lu(k,1818) * b(k,166) + b(k,71) = b(k,71) - lu(k,1817) * b(k,166) + b(k,39) = b(k,39) - lu(k,1816) * b(k,166) + b(k,6) = b(k,6) - lu(k,1815) * b(k,166) + b(k,5) = b(k,5) - lu(k,1814) * b(k,166) + b(k,4) = b(k,4) - lu(k,1813) * b(k,166) + b(k,3) = b(k,3) - lu(k,1812) * b(k,166) + b(k,2) = b(k,2) - lu(k,1811) * b(k,166) + end do + end subroutine lu_slv06 + subroutine lu_slv07( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: k +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + do k = 1,avec_len + b(k,165) = b(k,165) * lu(k,1804) + b(k,164) = b(k,164) - lu(k,1803) * b(k,165) + b(k,163) = b(k,163) - lu(k,1802) * b(k,165) + b(k,162) = b(k,162) - lu(k,1801) * b(k,165) + b(k,161) = b(k,161) - lu(k,1800) * b(k,165) + b(k,160) = b(k,160) - lu(k,1799) * b(k,165) + b(k,159) = b(k,159) - lu(k,1798) * b(k,165) + b(k,158) = b(k,158) - lu(k,1797) * b(k,165) + b(k,157) = b(k,157) - lu(k,1796) * b(k,165) + b(k,156) = b(k,156) - lu(k,1795) * b(k,165) + b(k,155) = b(k,155) - lu(k,1794) * b(k,165) + b(k,154) = b(k,154) - lu(k,1793) * b(k,165) + b(k,153) = b(k,153) - lu(k,1792) * b(k,165) + b(k,152) = b(k,152) - lu(k,1791) * b(k,165) + b(k,151) = b(k,151) - lu(k,1790) * b(k,165) + b(k,150) = b(k,150) - lu(k,1789) * b(k,165) + b(k,149) = b(k,149) - lu(k,1788) * b(k,165) + b(k,148) = b(k,148) - lu(k,1787) * b(k,165) + b(k,146) = b(k,146) - lu(k,1786) * b(k,165) + b(k,145) = b(k,145) - lu(k,1785) * b(k,165) + b(k,144) = b(k,144) - lu(k,1784) * b(k,165) + b(k,142) = b(k,142) - lu(k,1783) * b(k,165) + b(k,141) = b(k,141) - lu(k,1782) * b(k,165) + b(k,140) = b(k,140) - lu(k,1781) * b(k,165) + b(k,139) = b(k,139) - lu(k,1780) * b(k,165) + b(k,138) = b(k,138) - lu(k,1779) * b(k,165) + b(k,137) = b(k,137) - lu(k,1778) * b(k,165) + b(k,136) = b(k,136) - lu(k,1777) * b(k,165) + b(k,135) = b(k,135) - lu(k,1776) * b(k,165) + b(k,134) = b(k,134) - lu(k,1775) * b(k,165) + b(k,133) = b(k,133) - lu(k,1774) * b(k,165) + b(k,132) = b(k,132) - lu(k,1773) * b(k,165) + b(k,131) = b(k,131) - lu(k,1772) * b(k,165) + b(k,130) = b(k,130) - lu(k,1771) * b(k,165) + b(k,127) = b(k,127) - lu(k,1770) * b(k,165) + b(k,126) = b(k,126) - lu(k,1769) * b(k,165) + b(k,123) = b(k,123) - lu(k,1768) * b(k,165) + b(k,122) = b(k,122) - lu(k,1767) * b(k,165) + b(k,121) = b(k,121) - lu(k,1766) * b(k,165) + b(k,117) = b(k,117) - lu(k,1765) * b(k,165) + b(k,115) = b(k,115) - lu(k,1764) * b(k,165) + b(k,114) = b(k,114) - lu(k,1763) * b(k,165) + b(k,110) = b(k,110) - lu(k,1762) * b(k,165) + b(k,109) = b(k,109) - lu(k,1761) * b(k,165) + b(k,108) = b(k,108) - lu(k,1760) * b(k,165) + b(k,106) = b(k,106) - lu(k,1759) * b(k,165) + b(k,105) = b(k,105) - lu(k,1758) * b(k,165) + b(k,104) = b(k,104) - lu(k,1757) * b(k,165) + b(k,102) = b(k,102) - lu(k,1756) * b(k,165) + b(k,101) = b(k,101) - lu(k,1755) * b(k,165) + b(k,99) = b(k,99) - lu(k,1754) * b(k,165) + b(k,98) = b(k,98) - lu(k,1753) * b(k,165) + b(k,97) = b(k,97) - lu(k,1752) * b(k,165) + b(k,94) = b(k,94) - lu(k,1751) * b(k,165) + b(k,91) = b(k,91) - lu(k,1750) * b(k,165) + b(k,89) = b(k,89) - lu(k,1749) * b(k,165) + b(k,85) = b(k,85) - lu(k,1748) * b(k,165) + b(k,83) = b(k,83) - lu(k,1747) * b(k,165) + b(k,81) = b(k,81) - lu(k,1746) * b(k,165) + b(k,80) = b(k,80) - lu(k,1745) * b(k,165) + b(k,78) = b(k,78) - lu(k,1744) * b(k,165) + b(k,76) = b(k,76) - lu(k,1743) * b(k,165) + b(k,75) = b(k,75) - lu(k,1742) * b(k,165) + b(k,74) = b(k,74) - lu(k,1741) * b(k,165) + b(k,73) = b(k,73) - lu(k,1740) * b(k,165) + b(k,64) = b(k,64) - lu(k,1739) * b(k,165) + b(k,59) = b(k,59) - lu(k,1738) * b(k,165) + b(k,52) = b(k,52) - lu(k,1737) * b(k,165) + b(k,51) = b(k,51) - lu(k,1736) * b(k,165) + b(k,46) = b(k,46) - lu(k,1735) * b(k,165) + b(k,41) = b(k,41) - lu(k,1734) * b(k,165) + b(k,40) = b(k,40) - lu(k,1733) * b(k,165) + b(k,15) = b(k,15) - lu(k,1732) * b(k,165) + b(k,14) = b(k,14) - lu(k,1731) * b(k,165) + b(k,13) = b(k,13) - lu(k,1730) * b(k,165) + b(k,11) = b(k,11) - lu(k,1729) * b(k,165) + b(k,10) = b(k,10) - lu(k,1728) * b(k,165) + b(k,9) = b(k,9) - lu(k,1727) * b(k,165) + b(k,8) = b(k,8) - lu(k,1726) * b(k,165) + b(k,6) = b(k,6) - lu(k,1725) * b(k,165) + b(k,5) = b(k,5) - lu(k,1724) * b(k,165) + b(k,4) = b(k,4) - lu(k,1723) * b(k,165) + b(k,3) = b(k,3) - lu(k,1722) * b(k,165) + b(k,2) = b(k,2) - lu(k,1721) * b(k,165) + b(k,164) = b(k,164) * lu(k,1713) + b(k,163) = b(k,163) - lu(k,1712) * b(k,164) + b(k,162) = b(k,162) - lu(k,1711) * b(k,164) + b(k,161) = b(k,161) - lu(k,1710) * b(k,164) + b(k,160) = b(k,160) - lu(k,1709) * b(k,164) + b(k,159) = b(k,159) - lu(k,1708) * b(k,164) + b(k,158) = b(k,158) - lu(k,1707) * b(k,164) + b(k,157) = b(k,157) - lu(k,1706) * b(k,164) + b(k,156) = b(k,156) - lu(k,1705) * b(k,164) + b(k,155) = b(k,155) - lu(k,1704) * b(k,164) + b(k,154) = b(k,154) - lu(k,1703) * b(k,164) + b(k,147) = b(k,147) - lu(k,1702) * b(k,164) + b(k,128) = b(k,128) - lu(k,1701) * b(k,164) + b(k,120) = b(k,120) - lu(k,1700) * b(k,164) + b(k,116) = b(k,116) - lu(k,1699) * b(k,164) + b(k,56) = b(k,56) - lu(k,1698) * b(k,164) + b(k,42) = b(k,42) - lu(k,1697) * b(k,164) + b(k,25) = b(k,25) - lu(k,1696) * b(k,164) + b(k,17) = b(k,17) - lu(k,1695) * b(k,164) + b(k,163) = b(k,163) * lu(k,1686) + b(k,162) = b(k,162) - lu(k,1685) * b(k,163) + b(k,161) = b(k,161) - lu(k,1684) * b(k,163) + b(k,160) = b(k,160) - lu(k,1683) * b(k,163) + b(k,159) = b(k,159) - lu(k,1682) * b(k,163) + b(k,158) = b(k,158) - lu(k,1681) * b(k,163) + b(k,157) = b(k,157) - lu(k,1680) * b(k,163) + b(k,156) = b(k,156) - lu(k,1679) * b(k,163) + b(k,155) = b(k,155) - lu(k,1678) * b(k,163) + b(k,154) = b(k,154) - lu(k,1677) * b(k,163) + b(k,153) = b(k,153) - lu(k,1676) * b(k,163) + b(k,152) = b(k,152) - lu(k,1675) * b(k,163) + b(k,151) = b(k,151) - lu(k,1674) * b(k,163) + b(k,150) = b(k,150) - lu(k,1673) * b(k,163) + b(k,149) = b(k,149) - lu(k,1672) * b(k,163) + b(k,148) = b(k,148) - lu(k,1671) * b(k,163) + b(k,146) = b(k,146) - lu(k,1670) * b(k,163) + b(k,145) = b(k,145) - lu(k,1669) * b(k,163) + b(k,144) = b(k,144) - lu(k,1668) * b(k,163) + b(k,143) = b(k,143) - lu(k,1667) * b(k,163) + b(k,142) = b(k,142) - lu(k,1666) * b(k,163) + b(k,141) = b(k,141) - lu(k,1665) * b(k,163) + b(k,140) = b(k,140) - lu(k,1664) * b(k,163) + b(k,139) = b(k,139) - lu(k,1663) * b(k,163) + b(k,138) = b(k,138) - lu(k,1662) * b(k,163) + b(k,137) = b(k,137) - lu(k,1661) * b(k,163) + b(k,135) = b(k,135) - lu(k,1660) * b(k,163) + b(k,134) = b(k,134) - lu(k,1659) * b(k,163) + b(k,133) = b(k,133) - lu(k,1658) * b(k,163) + b(k,131) = b(k,131) - lu(k,1657) * b(k,163) + b(k,130) = b(k,130) - lu(k,1656) * b(k,163) + b(k,127) = b(k,127) - lu(k,1655) * b(k,163) + b(k,126) = b(k,126) - lu(k,1654) * b(k,163) + b(k,123) = b(k,123) - lu(k,1653) * b(k,163) + b(k,122) = b(k,122) - lu(k,1652) * b(k,163) + b(k,121) = b(k,121) - lu(k,1651) * b(k,163) + b(k,118) = b(k,118) - lu(k,1650) * b(k,163) + b(k,117) = b(k,117) - lu(k,1649) * b(k,163) + b(k,116) = b(k,116) - lu(k,1648) * b(k,163) + b(k,115) = b(k,115) - lu(k,1647) * b(k,163) + b(k,114) = b(k,114) - lu(k,1646) * b(k,163) + b(k,112) = b(k,112) - lu(k,1645) * b(k,163) + b(k,110) = b(k,110) - lu(k,1644) * b(k,163) + b(k,109) = b(k,109) - lu(k,1643) * b(k,163) + b(k,108) = b(k,108) - lu(k,1642) * b(k,163) + b(k,107) = b(k,107) - lu(k,1641) * b(k,163) + b(k,106) = b(k,106) - lu(k,1640) * b(k,163) + b(k,105) = b(k,105) - lu(k,1639) * b(k,163) + b(k,104) = b(k,104) - lu(k,1638) * b(k,163) + b(k,103) = b(k,103) - lu(k,1637) * b(k,163) + b(k,102) = b(k,102) - lu(k,1636) * b(k,163) + b(k,100) = b(k,100) - lu(k,1635) * b(k,163) + b(k,99) = b(k,99) - lu(k,1634) * b(k,163) + b(k,97) = b(k,97) - lu(k,1633) * b(k,163) + b(k,96) = b(k,96) - lu(k,1632) * b(k,163) + b(k,95) = b(k,95) - lu(k,1631) * b(k,163) + b(k,93) = b(k,93) - lu(k,1630) * b(k,163) + b(k,88) = b(k,88) - lu(k,1629) * b(k,163) + b(k,87) = b(k,87) - lu(k,1628) * b(k,163) + b(k,85) = b(k,85) - lu(k,1627) * b(k,163) + b(k,84) = b(k,84) - lu(k,1626) * b(k,163) + b(k,81) = b(k,81) - lu(k,1625) * b(k,163) + b(k,80) = b(k,80) - lu(k,1624) * b(k,163) + b(k,79) = b(k,79) - lu(k,1623) * b(k,163) + b(k,78) = b(k,78) - lu(k,1622) * b(k,163) + b(k,76) = b(k,76) - lu(k,1621) * b(k,163) + b(k,75) = b(k,75) - lu(k,1620) * b(k,163) + b(k,74) = b(k,74) - lu(k,1619) * b(k,163) + b(k,73) = b(k,73) - lu(k,1618) * b(k,163) + b(k,72) = b(k,72) - lu(k,1617) * b(k,163) + b(k,70) = b(k,70) - lu(k,1616) * b(k,163) + b(k,69) = b(k,69) - lu(k,1615) * b(k,163) + b(k,68) = b(k,68) - lu(k,1614) * b(k,163) + b(k,67) = b(k,67) - lu(k,1613) * b(k,163) + b(k,66) = b(k,66) - lu(k,1612) * b(k,163) + b(k,63) = b(k,63) - lu(k,1611) * b(k,163) + b(k,62) = b(k,62) - lu(k,1610) * b(k,163) + b(k,58) = b(k,58) - lu(k,1609) * b(k,163) + b(k,57) = b(k,57) - lu(k,1608) * b(k,163) + b(k,55) = b(k,55) - lu(k,1607) * b(k,163) + b(k,54) = b(k,54) - lu(k,1606) * b(k,163) + b(k,53) = b(k,53) - lu(k,1605) * b(k,163) + b(k,46) = b(k,46) - lu(k,1604) * b(k,163) + b(k,44) = b(k,44) - lu(k,1603) * b(k,163) + b(k,34) = b(k,34) - lu(k,1602) * b(k,163) + b(k,21) = b(k,21) - lu(k,1601) * b(k,163) + b(k,15) = b(k,15) - lu(k,1600) * b(k,163) + b(k,14) = b(k,14) - lu(k,1599) * b(k,163) + b(k,13) = b(k,13) - lu(k,1598) * b(k,163) + b(k,11) = b(k,11) - lu(k,1597) * b(k,163) + b(k,10) = b(k,10) - lu(k,1596) * b(k,163) + b(k,9) = b(k,9) - lu(k,1595) * b(k,163) + b(k,8) = b(k,8) - lu(k,1594) * b(k,163) + b(k,6) = b(k,6) - lu(k,1593) * b(k,163) + b(k,5) = b(k,5) - lu(k,1592) * b(k,163) + b(k,4) = b(k,4) - lu(k,1591) * b(k,163) + b(k,3) = b(k,3) - lu(k,1590) * b(k,163) + b(k,2) = b(k,2) - lu(k,1589) * b(k,163) + end do + end subroutine lu_slv07 + subroutine lu_slv08( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: k +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + do k = 1,avec_len + b(k,162) = b(k,162) * lu(k,1579) + b(k,161) = b(k,161) - lu(k,1578) * b(k,162) + b(k,160) = b(k,160) - lu(k,1577) * b(k,162) + b(k,159) = b(k,159) - lu(k,1576) * b(k,162) + b(k,158) = b(k,158) - lu(k,1575) * b(k,162) + b(k,157) = b(k,157) - lu(k,1574) * b(k,162) + b(k,156) = b(k,156) - lu(k,1573) * b(k,162) + b(k,155) = b(k,155) - lu(k,1572) * b(k,162) + b(k,154) = b(k,154) - lu(k,1571) * b(k,162) + b(k,147) = b(k,147) - lu(k,1570) * b(k,162) + b(k,143) = b(k,143) - lu(k,1569) * b(k,162) + b(k,135) = b(k,135) - lu(k,1568) * b(k,162) + b(k,128) = b(k,128) - lu(k,1567) * b(k,162) + b(k,120) = b(k,120) - lu(k,1566) * b(k,162) + b(k,118) = b(k,118) - lu(k,1565) * b(k,162) + b(k,116) = b(k,116) - lu(k,1564) * b(k,162) + b(k,112) = b(k,112) - lu(k,1563) * b(k,162) + b(k,93) = b(k,93) - lu(k,1562) * b(k,162) + b(k,86) = b(k,86) - lu(k,1561) * b(k,162) + b(k,82) = b(k,82) - lu(k,1560) * b(k,162) + b(k,60) = b(k,60) - lu(k,1559) * b(k,162) + b(k,161) = b(k,161) * lu(k,1548) + b(k,160) = b(k,160) - lu(k,1547) * b(k,161) + b(k,159) = b(k,159) - lu(k,1546) * b(k,161) + b(k,158) = b(k,158) - lu(k,1545) * b(k,161) + b(k,157) = b(k,157) - lu(k,1544) * b(k,161) + b(k,156) = b(k,156) - lu(k,1543) * b(k,161) + b(k,155) = b(k,155) - lu(k,1542) * b(k,161) + b(k,154) = b(k,154) - lu(k,1541) * b(k,161) + b(k,143) = b(k,143) - lu(k,1540) * b(k,161) + b(k,135) = b(k,135) - lu(k,1539) * b(k,161) + b(k,118) = b(k,118) - lu(k,1538) * b(k,161) + b(k,115) = b(k,115) - lu(k,1537) * b(k,161) + b(k,74) = b(k,74) - lu(k,1536) * b(k,161) + b(k,160) = b(k,160) * lu(k,1524) + b(k,159) = b(k,159) - lu(k,1523) * b(k,160) + b(k,158) = b(k,158) - lu(k,1522) * b(k,160) + b(k,157) = b(k,157) - lu(k,1521) * b(k,160) + b(k,156) = b(k,156) - lu(k,1520) * b(k,160) + b(k,155) = b(k,155) - lu(k,1519) * b(k,160) + b(k,154) = b(k,154) - lu(k,1518) * b(k,160) + b(k,147) = b(k,147) - lu(k,1517) * b(k,160) + b(k,120) = b(k,120) - lu(k,1516) * b(k,160) + b(k,112) = b(k,112) - lu(k,1515) * b(k,160) + b(k,86) = b(k,86) - lu(k,1514) * b(k,160) + b(k,56) = b(k,56) - lu(k,1513) * b(k,160) + b(k,42) = b(k,42) - lu(k,1512) * b(k,160) + b(k,159) = b(k,159) * lu(k,1499) + b(k,158) = b(k,158) - lu(k,1498) * b(k,159) + b(k,157) = b(k,157) - lu(k,1497) * b(k,159) + b(k,156) = b(k,156) - lu(k,1496) * b(k,159) + b(k,155) = b(k,155) - lu(k,1495) * b(k,159) + b(k,154) = b(k,154) - lu(k,1494) * b(k,159) + b(k,153) = b(k,153) - lu(k,1493) * b(k,159) + b(k,152) = b(k,152) - lu(k,1492) * b(k,159) + b(k,151) = b(k,151) - lu(k,1491) * b(k,159) + b(k,150) = b(k,150) - lu(k,1490) * b(k,159) + b(k,149) = b(k,149) - lu(k,1489) * b(k,159) + b(k,148) = b(k,148) - lu(k,1488) * b(k,159) + b(k,147) = b(k,147) - lu(k,1487) * b(k,159) + b(k,146) = b(k,146) - lu(k,1486) * b(k,159) + b(k,145) = b(k,145) - lu(k,1485) * b(k,159) + b(k,144) = b(k,144) - lu(k,1484) * b(k,159) + b(k,143) = b(k,143) - lu(k,1483) * b(k,159) + b(k,142) = b(k,142) - lu(k,1482) * b(k,159) + b(k,141) = b(k,141) - lu(k,1481) * b(k,159) + b(k,140) = b(k,140) - lu(k,1480) * b(k,159) + b(k,139) = b(k,139) - lu(k,1479) * b(k,159) + b(k,138) = b(k,138) - lu(k,1478) * b(k,159) + b(k,137) = b(k,137) - lu(k,1477) * b(k,159) + b(k,136) = b(k,136) - lu(k,1476) * b(k,159) + b(k,135) = b(k,135) - lu(k,1475) * b(k,159) + b(k,134) = b(k,134) - lu(k,1474) * b(k,159) + b(k,133) = b(k,133) - lu(k,1473) * b(k,159) + b(k,132) = b(k,132) - lu(k,1472) * b(k,159) + b(k,131) = b(k,131) - lu(k,1471) * b(k,159) + b(k,130) = b(k,130) - lu(k,1470) * b(k,159) + b(k,129) = b(k,129) - lu(k,1469) * b(k,159) + b(k,128) = b(k,128) - lu(k,1468) * b(k,159) + b(k,127) = b(k,127) - lu(k,1467) * b(k,159) + b(k,126) = b(k,126) - lu(k,1466) * b(k,159) + b(k,125) = b(k,125) - lu(k,1465) * b(k,159) + b(k,124) = b(k,124) - lu(k,1464) * b(k,159) + b(k,123) = b(k,123) - lu(k,1463) * b(k,159) + b(k,122) = b(k,122) - lu(k,1462) * b(k,159) + b(k,121) = b(k,121) - lu(k,1461) * b(k,159) + b(k,120) = b(k,120) - lu(k,1460) * b(k,159) + b(k,119) = b(k,119) - lu(k,1459) * b(k,159) + b(k,118) = b(k,118) - lu(k,1458) * b(k,159) + b(k,117) = b(k,117) - lu(k,1457) * b(k,159) + b(k,116) = b(k,116) - lu(k,1456) * b(k,159) + b(k,115) = b(k,115) - lu(k,1455) * b(k,159) + b(k,114) = b(k,114) - lu(k,1454) * b(k,159) + b(k,113) = b(k,113) - lu(k,1453) * b(k,159) + b(k,111) = b(k,111) - lu(k,1452) * b(k,159) + b(k,110) = b(k,110) - lu(k,1451) * b(k,159) + b(k,109) = b(k,109) - lu(k,1450) * b(k,159) + b(k,108) = b(k,108) - lu(k,1449) * b(k,159) + b(k,107) = b(k,107) - lu(k,1448) * b(k,159) + b(k,106) = b(k,106) - lu(k,1447) * b(k,159) + b(k,105) = b(k,105) - lu(k,1446) * b(k,159) + b(k,104) = b(k,104) - lu(k,1445) * b(k,159) + b(k,103) = b(k,103) - lu(k,1444) * b(k,159) + b(k,102) = b(k,102) - lu(k,1443) * b(k,159) + b(k,101) = b(k,101) - lu(k,1442) * b(k,159) + b(k,100) = b(k,100) - lu(k,1441) * b(k,159) + b(k,99) = b(k,99) - lu(k,1440) * b(k,159) + b(k,98) = b(k,98) - lu(k,1439) * b(k,159) + b(k,97) = b(k,97) - lu(k,1438) * b(k,159) + b(k,96) = b(k,96) - lu(k,1437) * b(k,159) + b(k,95) = b(k,95) - lu(k,1436) * b(k,159) + b(k,94) = b(k,94) - lu(k,1435) * b(k,159) + b(k,93) = b(k,93) - lu(k,1434) * b(k,159) + b(k,92) = b(k,92) - lu(k,1433) * b(k,159) + b(k,91) = b(k,91) - lu(k,1432) * b(k,159) + b(k,90) = b(k,90) - lu(k,1431) * b(k,159) + b(k,89) = b(k,89) - lu(k,1430) * b(k,159) + b(k,88) = b(k,88) - lu(k,1429) * b(k,159) + b(k,87) = b(k,87) - lu(k,1428) * b(k,159) + b(k,85) = b(k,85) - lu(k,1427) * b(k,159) + b(k,84) = b(k,84) - lu(k,1426) * b(k,159) + b(k,83) = b(k,83) - lu(k,1425) * b(k,159) + b(k,82) = b(k,82) - lu(k,1424) * b(k,159) + b(k,81) = b(k,81) - lu(k,1423) * b(k,159) + b(k,80) = b(k,80) - lu(k,1422) * b(k,159) + b(k,79) = b(k,79) - lu(k,1421) * b(k,159) + b(k,78) = b(k,78) - lu(k,1420) * b(k,159) + b(k,77) = b(k,77) - lu(k,1419) * b(k,159) + b(k,76) = b(k,76) - lu(k,1418) * b(k,159) + b(k,75) = b(k,75) - lu(k,1417) * b(k,159) + b(k,73) = b(k,73) - lu(k,1416) * b(k,159) + b(k,72) = b(k,72) - lu(k,1415) * b(k,159) + b(k,70) = b(k,70) - lu(k,1414) * b(k,159) + b(k,69) = b(k,69) - lu(k,1413) * b(k,159) + b(k,68) = b(k,68) - lu(k,1412) * b(k,159) + b(k,67) = b(k,67) - lu(k,1411) * b(k,159) + b(k,66) = b(k,66) - lu(k,1410) * b(k,159) + b(k,65) = b(k,65) - lu(k,1409) * b(k,159) + b(k,64) = b(k,64) - lu(k,1408) * b(k,159) + b(k,63) = b(k,63) - lu(k,1407) * b(k,159) + b(k,62) = b(k,62) - lu(k,1406) * b(k,159) + b(k,61) = b(k,61) - lu(k,1405) * b(k,159) + b(k,60) = b(k,60) - lu(k,1404) * b(k,159) + b(k,58) = b(k,58) - lu(k,1403) * b(k,159) + b(k,57) = b(k,57) - lu(k,1402) * b(k,159) + b(k,55) = b(k,55) - lu(k,1401) * b(k,159) + b(k,54) = b(k,54) - lu(k,1400) * b(k,159) + b(k,53) = b(k,53) - lu(k,1399) * b(k,159) + b(k,52) = b(k,52) - lu(k,1398) * b(k,159) + b(k,50) = b(k,50) - lu(k,1397) * b(k,159) + b(k,49) = b(k,49) - lu(k,1396) * b(k,159) + b(k,47) = b(k,47) - lu(k,1395) * b(k,159) + b(k,45) = b(k,45) - lu(k,1394) * b(k,159) + b(k,44) = b(k,44) - lu(k,1393) * b(k,159) + b(k,43) = b(k,43) - lu(k,1392) * b(k,159) + b(k,41) = b(k,41) - lu(k,1391) * b(k,159) + b(k,40) = b(k,40) - lu(k,1390) * b(k,159) + b(k,39) = b(k,39) - lu(k,1389) * b(k,159) + b(k,38) = b(k,38) - lu(k,1388) * b(k,159) + b(k,36) = b(k,36) - lu(k,1387) * b(k,159) + b(k,35) = b(k,35) - lu(k,1386) * b(k,159) + b(k,34) = b(k,34) - lu(k,1385) * b(k,159) + b(k,33) = b(k,33) - lu(k,1384) * b(k,159) + b(k,32) = b(k,32) - lu(k,1383) * b(k,159) + b(k,31) = b(k,31) - lu(k,1382) * b(k,159) + b(k,30) = b(k,30) - lu(k,1381) * b(k,159) + b(k,29) = b(k,29) - lu(k,1380) * b(k,159) + b(k,28) = b(k,28) - lu(k,1379) * b(k,159) + b(k,27) = b(k,27) - lu(k,1378) * b(k,159) + b(k,26) = b(k,26) - lu(k,1377) * b(k,159) + b(k,23) = b(k,23) - lu(k,1376) * b(k,159) + b(k,20) = b(k,20) - lu(k,1375) * b(k,159) + b(k,19) = b(k,19) - lu(k,1374) * b(k,159) + b(k,18) = b(k,18) - lu(k,1373) * b(k,159) + b(k,16) = b(k,16) - lu(k,1372) * b(k,159) + b(k,15) = b(k,15) - lu(k,1371) * b(k,159) + b(k,14) = b(k,14) - lu(k,1370) * b(k,159) + b(k,13) = b(k,13) - lu(k,1369) * b(k,159) + b(k,12) = b(k,12) - lu(k,1368) * b(k,159) + b(k,11) = b(k,11) - lu(k,1367) * b(k,159) + b(k,10) = b(k,10) - lu(k,1366) * b(k,159) + b(k,9) = b(k,9) - lu(k,1365) * b(k,159) + b(k,8) = b(k,8) - lu(k,1364) * b(k,159) + b(k,7) = b(k,7) - lu(k,1363) * b(k,159) + b(k,6) = b(k,6) - lu(k,1362) * b(k,159) + b(k,5) = b(k,5) - lu(k,1361) * b(k,159) + b(k,4) = b(k,4) - lu(k,1360) * b(k,159) + b(k,3) = b(k,3) - lu(k,1359) * b(k,159) + b(k,2) = b(k,2) - lu(k,1358) * b(k,159) + b(k,158) = b(k,158) * lu(k,1344) + b(k,157) = b(k,157) - lu(k,1343) * b(k,158) + b(k,156) = b(k,156) - lu(k,1342) * b(k,158) + b(k,155) = b(k,155) - lu(k,1341) * b(k,158) + b(k,154) = b(k,154) - lu(k,1340) * b(k,158) + b(k,143) = b(k,143) - lu(k,1339) * b(k,158) + b(k,118) = b(k,118) - lu(k,1338) * b(k,158) + b(k,111) = b(k,111) - lu(k,1337) * b(k,158) + b(k,30) = b(k,30) - lu(k,1336) * b(k,158) + b(k,29) = b(k,29) - lu(k,1335) * b(k,158) + b(k,20) = b(k,20) - lu(k,1334) * b(k,158) + b(k,157) = b(k,157) * lu(k,1320) + b(k,156) = b(k,156) - lu(k,1319) * b(k,157) + b(k,155) = b(k,155) - lu(k,1318) * b(k,157) + b(k,153) = b(k,153) - lu(k,1317) * b(k,157) + b(k,152) = b(k,152) - lu(k,1316) * b(k,157) + b(k,151) = b(k,151) - lu(k,1315) * b(k,157) + b(k,150) = b(k,150) - lu(k,1314) * b(k,157) + b(k,149) = b(k,149) - lu(k,1313) * b(k,157) + b(k,148) = b(k,148) - lu(k,1312) * b(k,157) + b(k,146) = b(k,146) - lu(k,1311) * b(k,157) + b(k,145) = b(k,145) - lu(k,1310) * b(k,157) + b(k,144) = b(k,144) - lu(k,1309) * b(k,157) + b(k,142) = b(k,142) - lu(k,1308) * b(k,157) + b(k,141) = b(k,141) - lu(k,1307) * b(k,157) + b(k,140) = b(k,140) - lu(k,1306) * b(k,157) + b(k,139) = b(k,139) - lu(k,1305) * b(k,157) + b(k,138) = b(k,138) - lu(k,1304) * b(k,157) + b(k,137) = b(k,137) - lu(k,1303) * b(k,157) + b(k,135) = b(k,135) - lu(k,1302) * b(k,157) + b(k,134) = b(k,134) - lu(k,1301) * b(k,157) + b(k,133) = b(k,133) - lu(k,1300) * b(k,157) + b(k,132) = b(k,132) - lu(k,1299) * b(k,157) + b(k,131) = b(k,131) - lu(k,1298) * b(k,157) + b(k,130) = b(k,130) - lu(k,1297) * b(k,157) + b(k,127) = b(k,127) - lu(k,1296) * b(k,157) + b(k,122) = b(k,122) - lu(k,1295) * b(k,157) + b(k,121) = b(k,121) - lu(k,1294) * b(k,157) + b(k,117) = b(k,117) - lu(k,1293) * b(k,157) + b(k,114) = b(k,114) - lu(k,1292) * b(k,157) + b(k,113) = b(k,113) - lu(k,1291) * b(k,157) + b(k,98) = b(k,98) - lu(k,1290) * b(k,157) + b(k,88) = b(k,88) - lu(k,1289) * b(k,157) + b(k,67) = b(k,67) - lu(k,1288) * b(k,157) + b(k,65) = b(k,65) - lu(k,1287) * b(k,157) + b(k,52) = b(k,52) - lu(k,1286) * b(k,157) + b(k,43) = b(k,43) - lu(k,1285) * b(k,157) + end do + end subroutine lu_slv08 + subroutine lu_slv09( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: k +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + do k = 1,avec_len + b(k,156) = b(k,156) * lu(k,1273) + b(k,155) = b(k,155) - lu(k,1272) * b(k,156) + b(k,143) = b(k,143) - lu(k,1271) * b(k,156) + b(k,155) = b(k,155) * lu(k,1260) + b(k,143) = b(k,143) - lu(k,1259) * b(k,155) + b(k,111) = b(k,111) - lu(k,1258) * b(k,155) + b(k,37) = b(k,37) - lu(k,1257) * b(k,155) + b(k,154) = b(k,154) * lu(k,1247) + b(k,135) = b(k,135) - lu(k,1246) * b(k,154) + b(k,118) = b(k,118) - lu(k,1245) * b(k,154) + b(k,153) = b(k,153) * lu(k,1233) + b(k,152) = b(k,152) - lu(k,1232) * b(k,153) + b(k,151) = b(k,151) - lu(k,1231) * b(k,153) + b(k,150) = b(k,150) - lu(k,1230) * b(k,153) + b(k,149) = b(k,149) - lu(k,1229) * b(k,153) + b(k,148) = b(k,148) - lu(k,1228) * b(k,153) + b(k,146) = b(k,146) - lu(k,1227) * b(k,153) + b(k,145) = b(k,145) - lu(k,1226) * b(k,153) + b(k,144) = b(k,144) - lu(k,1225) * b(k,153) + b(k,142) = b(k,142) - lu(k,1224) * b(k,153) + b(k,137) = b(k,137) - lu(k,1223) * b(k,153) + b(k,135) = b(k,135) - lu(k,1222) * b(k,153) + b(k,132) = b(k,132) - lu(k,1221) * b(k,153) + b(k,131) = b(k,131) - lu(k,1220) * b(k,153) + b(k,122) = b(k,122) - lu(k,1219) * b(k,153) + b(k,88) = b(k,88) - lu(k,1218) * b(k,153) + b(k,84) = b(k,84) - lu(k,1217) * b(k,153) + b(k,77) = b(k,77) - lu(k,1216) * b(k,153) + b(k,52) = b(k,52) - lu(k,1215) * b(k,153) + b(k,152) = b(k,152) * lu(k,1202) + b(k,146) = b(k,146) - lu(k,1201) * b(k,152) + b(k,137) = b(k,137) - lu(k,1200) * b(k,152) + b(k,92) = b(k,92) - lu(k,1199) * b(k,152) + b(k,88) = b(k,88) - lu(k,1198) * b(k,152) + b(k,84) = b(k,84) - lu(k,1197) * b(k,152) + b(k,151) = b(k,151) * lu(k,1183) + b(k,150) = b(k,150) - lu(k,1182) * b(k,151) + b(k,149) = b(k,149) - lu(k,1181) * b(k,151) + b(k,146) = b(k,146) - lu(k,1180) * b(k,151) + b(k,145) = b(k,145) - lu(k,1179) * b(k,151) + b(k,142) = b(k,142) - lu(k,1178) * b(k,151) + b(k,141) = b(k,141) - lu(k,1177) * b(k,151) + b(k,137) = b(k,137) - lu(k,1176) * b(k,151) + b(k,136) = b(k,136) - lu(k,1175) * b(k,151) + b(k,135) = b(k,135) - lu(k,1174) * b(k,151) + b(k,131) = b(k,131) - lu(k,1173) * b(k,151) + b(k,113) = b(k,113) - lu(k,1172) * b(k,151) + b(k,107) = b(k,107) - lu(k,1171) * b(k,151) + b(k,94) = b(k,94) - lu(k,1170) * b(k,151) + b(k,150) = b(k,150) * lu(k,1157) + b(k,146) = b(k,146) - lu(k,1156) * b(k,150) + b(k,141) = b(k,141) - lu(k,1155) * b(k,150) + b(k,137) = b(k,137) - lu(k,1154) * b(k,150) + b(k,136) = b(k,136) - lu(k,1153) * b(k,150) + b(k,135) = b(k,135) - lu(k,1152) * b(k,150) + b(k,131) = b(k,131) - lu(k,1151) * b(k,150) + b(k,113) = b(k,113) - lu(k,1150) * b(k,150) + b(k,54) = b(k,54) - lu(k,1149) * b(k,150) + b(k,149) = b(k,149) * lu(k,1135) + b(k,146) = b(k,146) - lu(k,1134) * b(k,149) + b(k,137) = b(k,137) - lu(k,1133) * b(k,149) + b(k,135) = b(k,135) - lu(k,1132) * b(k,149) + b(k,134) = b(k,134) - lu(k,1131) * b(k,149) + b(k,129) = b(k,129) - lu(k,1130) * b(k,149) + b(k,115) = b(k,115) - lu(k,1129) * b(k,149) + b(k,148) = b(k,148) * lu(k,1113) + b(k,146) = b(k,146) - lu(k,1112) * b(k,148) + b(k,145) = b(k,145) - lu(k,1111) * b(k,148) + b(k,142) = b(k,142) - lu(k,1110) * b(k,148) + b(k,141) = b(k,141) - lu(k,1109) * b(k,148) + b(k,137) = b(k,137) - lu(k,1108) * b(k,148) + b(k,136) = b(k,136) - lu(k,1107) * b(k,148) + b(k,135) = b(k,135) - lu(k,1106) * b(k,148) + b(k,131) = b(k,131) - lu(k,1105) * b(k,148) + b(k,123) = b(k,123) - lu(k,1104) * b(k,148) + b(k,122) = b(k,122) - lu(k,1103) * b(k,148) + b(k,121) = b(k,121) - lu(k,1102) * b(k,148) + b(k,113) = b(k,113) - lu(k,1101) * b(k,148) + b(k,107) = b(k,107) - lu(k,1100) * b(k,148) + b(k,97) = b(k,97) - lu(k,1099) * b(k,148) + b(k,89) = b(k,89) - lu(k,1098) * b(k,148) + b(k,52) = b(k,52) - lu(k,1097) * b(k,148) + b(k,38) = b(k,38) - lu(k,1096) * b(k,148) + b(k,147) = b(k,147) * lu(k,1083) + b(k,120) = b(k,120) - lu(k,1082) * b(k,147) + b(k,82) = b(k,82) - lu(k,1081) * b(k,147) + b(k,56) = b(k,56) - lu(k,1080) * b(k,147) + b(k,146) = b(k,146) * lu(k,1072) + b(k,135) = b(k,135) - lu(k,1071) * b(k,146) + b(k,145) = b(k,145) * lu(k,1060) + b(k,135) = b(k,135) - lu(k,1059) * b(k,145) + b(k,115) = b(k,115) - lu(k,1058) * b(k,145) + b(k,144) = b(k,144) * lu(k,1044) + b(k,142) = b(k,142) - lu(k,1043) * b(k,144) + b(k,135) = b(k,135) - lu(k,1042) * b(k,144) + b(k,132) = b(k,132) - lu(k,1041) * b(k,144) + b(k,131) = b(k,131) - lu(k,1040) * b(k,144) + b(k,121) = b(k,121) - lu(k,1039) * b(k,144) + b(k,113) = b(k,113) - lu(k,1038) * b(k,144) + b(k,107) = b(k,107) - lu(k,1037) * b(k,144) + b(k,65) = b(k,65) - lu(k,1036) * b(k,144) + b(k,63) = b(k,63) - lu(k,1035) * b(k,144) + b(k,143) = b(k,143) * lu(k,1024) + b(k,111) = b(k,111) - lu(k,1023) * b(k,143) + b(k,37) = b(k,37) - lu(k,1022) * b(k,143) + b(k,142) = b(k,142) * lu(k,1011) + b(k,137) = b(k,137) - lu(k,1010) * b(k,142) + b(k,135) = b(k,135) - lu(k,1009) * b(k,142) + b(k,131) = b(k,131) - lu(k,1008) * b(k,142) + b(k,122) = b(k,122) - lu(k,1007) * b(k,142) + b(k,113) = b(k,113) - lu(k,1006) * b(k,142) + b(k,34) = b(k,34) - lu(k,1005) * b(k,142) + b(k,141) = b(k,141) * lu(k,995) + b(k,137) = b(k,137) - lu(k,994) * b(k,141) + b(k,113) = b(k,113) - lu(k,993) * b(k,141) + b(k,68) = b(k,68) - lu(k,992) * b(k,141) + b(k,140) = b(k,140) * lu(k,979) + b(k,139) = b(k,139) - lu(k,978) * b(k,140) + b(k,135) = b(k,135) - lu(k,977) * b(k,140) + b(k,133) = b(k,133) - lu(k,976) * b(k,140) + b(k,130) = b(k,130) - lu(k,975) * b(k,140) + b(k,113) = b(k,113) - lu(k,974) * b(k,140) + b(k,98) = b(k,98) - lu(k,973) * b(k,140) + b(k,66) = b(k,66) - lu(k,972) * b(k,140) + b(k,139) = b(k,139) * lu(k,960) + b(k,135) = b(k,135) - lu(k,959) * b(k,139) + b(k,133) = b(k,133) - lu(k,958) * b(k,139) + b(k,131) = b(k,131) - lu(k,957) * b(k,139) + b(k,127) = b(k,127) - lu(k,956) * b(k,139) + b(k,113) = b(k,113) - lu(k,955) * b(k,139) + b(k,95) = b(k,95) - lu(k,954) * b(k,139) + b(k,41) = b(k,41) - lu(k,953) * b(k,139) + b(k,138) = b(k,138) * lu(k,938) + b(k,135) = b(k,135) - lu(k,937) * b(k,138) + b(k,133) = b(k,133) - lu(k,936) * b(k,138) + b(k,130) = b(k,130) - lu(k,935) * b(k,138) + b(k,127) = b(k,127) - lu(k,934) * b(k,138) + b(k,113) = b(k,113) - lu(k,933) * b(k,138) + b(k,98) = b(k,98) - lu(k,932) * b(k,138) + b(k,79) = b(k,79) - lu(k,931) * b(k,138) + b(k,137) = b(k,137) * lu(k,925) + b(k,136) = b(k,136) * lu(k,912) + b(k,135) = b(k,135) - lu(k,911) * b(k,136) + b(k,134) = b(k,134) - lu(k,910) * b(k,136) + b(k,131) = b(k,131) - lu(k,909) * b(k,136) + b(k,127) = b(k,127) - lu(k,908) * b(k,136) + b(k,41) = b(k,41) - lu(k,907) * b(k,136) + b(k,135) = b(k,135) * lu(k,903) + b(k,134) = b(k,134) * lu(k,894) + b(k,133) = b(k,133) * lu(k,885) + b(k,127) = b(k,127) - lu(k,884) * b(k,133) + b(k,132) = b(k,132) * lu(k,873) + b(k,123) = b(k,123) - lu(k,872) * b(k,132) + b(k,122) = b(k,122) - lu(k,871) * b(k,132) + b(k,121) = b(k,121) - lu(k,870) * b(k,132) + b(k,97) = b(k,97) - lu(k,869) * b(k,132) + b(k,131) = b(k,131) * lu(k,864) + b(k,122) = b(k,122) - lu(k,863) * b(k,131) + b(k,130) = b(k,130) * lu(k,855) + b(k,129) = b(k,129) * lu(k,840) + b(k,121) = b(k,121) - lu(k,839) * b(k,129) + b(k,115) = b(k,115) - lu(k,838) * b(k,129) + b(k,110) = b(k,110) - lu(k,837) * b(k,129) + b(k,88) = b(k,88) - lu(k,836) * b(k,129) + b(k,128) = b(k,128) * lu(k,826) + b(k,116) = b(k,116) - lu(k,825) * b(k,128) + b(k,25) = b(k,25) - lu(k,824) * b(k,128) + b(k,127) = b(k,127) * lu(k,818) + b(k,126) = b(k,126) * lu(k,808) + b(k,117) = b(k,117) - lu(k,807) * b(k,126) + b(k,102) = b(k,102) - lu(k,806) * b(k,126) + b(k,101) = b(k,101) - lu(k,805) * b(k,126) + b(k,100) = b(k,100) - lu(k,804) * b(k,126) + b(k,83) = b(k,83) - lu(k,803) * b(k,126) + b(k,125) = b(k,125) * lu(k,786) + b(k,122) = b(k,122) - lu(k,785) * b(k,125) + b(k,115) = b(k,115) - lu(k,784) * b(k,125) + b(k,71) = b(k,71) - lu(k,783) * b(k,125) + b(k,39) = b(k,39) - lu(k,782) * b(k,125) + b(k,13) = b(k,13) - lu(k,781) * b(k,125) + b(k,6) = b(k,6) - lu(k,780) * b(k,125) + b(k,5) = b(k,5) - lu(k,779) * b(k,125) + b(k,4) = b(k,4) - lu(k,778) * b(k,125) + b(k,3) = b(k,3) - lu(k,777) * b(k,125) + b(k,2) = b(k,2) - lu(k,776) * b(k,125) + b(k,124) = b(k,124) * lu(k,759) + b(k,122) = b(k,122) - lu(k,758) * b(k,124) + b(k,115) = b(k,115) - lu(k,757) * b(k,124) + b(k,71) = b(k,71) - lu(k,756) * b(k,124) + b(k,39) = b(k,39) - lu(k,755) * b(k,124) + b(k,8) = b(k,8) - lu(k,754) * b(k,124) + b(k,6) = b(k,6) - lu(k,753) * b(k,124) + b(k,5) = b(k,5) - lu(k,752) * b(k,124) + b(k,4) = b(k,4) - lu(k,751) * b(k,124) + b(k,3) = b(k,3) - lu(k,750) * b(k,124) + b(k,2) = b(k,2) - lu(k,749) * b(k,124) + b(k,123) = b(k,123) * lu(k,741) + b(k,122) = b(k,122) - lu(k,740) * b(k,123) + b(k,122) = b(k,122) * lu(k,736) + b(k,2) = b(k,2) - lu(k,735) * b(k,122) + b(k,121) = b(k,121) * lu(k,729) + end do + end subroutine lu_slv09 + subroutine lu_slv10( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: k +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + do k = 1,avec_len + b(k,120) = b(k,120) * lu(k,723) + b(k,45) = b(k,45) - lu(k,722) * b(k,120) + b(k,119) = b(k,119) * lu(k,706) + b(k,115) = b(k,115) - lu(k,705) * b(k,119) + b(k,10) = b(k,10) - lu(k,704) * b(k,119) + b(k,6) = b(k,6) - lu(k,703) * b(k,119) + b(k,5) = b(k,5) - lu(k,702) * b(k,119) + b(k,118) = b(k,118) * lu(k,694) + b(k,117) = b(k,117) * lu(k,686) + b(k,113) = b(k,113) - lu(k,685) * b(k,117) + b(k,53) = b(k,53) - lu(k,684) * b(k,117) + b(k,43) = b(k,43) - lu(k,683) * b(k,117) + b(k,116) = b(k,116) * lu(k,676) + b(k,25) = b(k,25) - lu(k,675) * b(k,116) + b(k,115) = b(k,115) * lu(k,671) + b(k,114) = b(k,114) * lu(k,661) + b(k,69) = b(k,69) - lu(k,660) * b(k,114) + b(k,113) = b(k,113) * lu(k,656) + b(k,112) = b(k,112) * lu(k,648) + b(k,42) = b(k,42) - lu(k,647) * b(k,112) + b(k,111) = b(k,111) * lu(k,639) + b(k,37) = b(k,37) - lu(k,638) * b(k,111) + b(k,110) = b(k,110) * lu(k,629) + b(k,87) = b(k,87) - lu(k,628) * b(k,110) + b(k,109) = b(k,109) * lu(k,620) + b(k,108) = b(k,108) * lu(k,609) + b(k,105) = b(k,105) - lu(k,608) * b(k,108) + b(k,103) = b(k,103) - lu(k,607) * b(k,108) + b(k,97) = b(k,97) - lu(k,606) * b(k,108) + b(k,76) = b(k,76) - lu(k,605) * b(k,108) + b(k,59) = b(k,59) - lu(k,604) * b(k,108) + b(k,51) = b(k,51) - lu(k,603) * b(k,108) + b(k,107) = b(k,107) * lu(k,596) + b(k,23) = b(k,23) - lu(k,595) * b(k,107) + b(k,106) = b(k,106) * lu(k,585) + b(k,105) = b(k,105) - lu(k,584) * b(k,106) + b(k,97) = b(k,97) - lu(k,583) * b(k,106) + b(k,96) = b(k,96) - lu(k,582) * b(k,106) + b(k,76) = b(k,76) - lu(k,581) * b(k,106) + b(k,51) = b(k,51) - lu(k,580) * b(k,106) + b(k,105) = b(k,105) * lu(k,574) + b(k,104) = b(k,104) * lu(k,567) + b(k,46) = b(k,46) - lu(k,566) * b(k,104) + b(k,21) = b(k,21) - lu(k,565) * b(k,104) + b(k,103) = b(k,103) * lu(k,554) + b(k,97) = b(k,97) - lu(k,553) * b(k,103) + b(k,76) = b(k,76) - lu(k,552) * b(k,103) + b(k,59) = b(k,59) - lu(k,551) * b(k,103) + b(k,51) = b(k,51) - lu(k,550) * b(k,103) + b(k,102) = b(k,102) * lu(k,543) + b(k,55) = b(k,55) - lu(k,542) * b(k,102) + b(k,101) = b(k,101) * lu(k,532) + b(k,83) = b(k,83) - lu(k,531) * b(k,101) + b(k,100) = b(k,100) * lu(k,521) + b(k,83) = b(k,83) - lu(k,520) * b(k,100) + b(k,99) = b(k,99) * lu(k,514) + b(k,78) = b(k,78) - lu(k,513) * b(k,99) + b(k,44) = b(k,44) - lu(k,512) * b(k,99) + b(k,98) = b(k,98) * lu(k,506) + b(k,97) = b(k,97) * lu(k,502) + b(k,96) = b(k,96) * lu(k,493) + b(k,76) = b(k,76) - lu(k,492) * b(k,96) + b(k,51) = b(k,51) - lu(k,491) * b(k,96) + b(k,95) = b(k,95) * lu(k,482) + b(k,94) = b(k,94) * lu(k,473) + b(k,93) = b(k,93) * lu(k,466) + b(k,92) = b(k,92) * lu(k,458) + b(k,91) = b(k,91) * lu(k,450) + b(k,90) = b(k,90) * lu(k,442) + b(k,89) = b(k,89) * lu(k,434) + b(k,88) = b(k,88) * lu(k,430) + b(k,87) = b(k,87) * lu(k,422) + b(k,86) = b(k,86) * lu(k,414) + b(k,85) = b(k,85) * lu(k,408) + b(k,24) = b(k,24) - lu(k,407) * b(k,85) + b(k,84) = b(k,84) * lu(k,401) + b(k,83) = b(k,83) * lu(k,396) + b(k,82) = b(k,82) * lu(k,390) + b(k,81) = b(k,81) * lu(k,383) + b(k,72) = b(k,72) - lu(k,382) * b(k,81) + b(k,80) = b(k,80) * lu(k,375) + b(k,76) = b(k,76) - lu(k,374) * b(k,80) + b(k,70) = b(k,70) - lu(k,373) * b(k,80) + b(k,79) = b(k,79) * lu(k,366) + b(k,78) = b(k,78) * lu(k,362) + b(k,77) = b(k,77) * lu(k,355) + b(k,76) = b(k,76) * lu(k,352) + b(k,75) = b(k,75) * lu(k,346) + b(k,57) = b(k,57) - lu(k,345) * b(k,75) + b(k,74) = b(k,74) * lu(k,339) + b(k,73) = b(k,73) * lu(k,333) + b(k,58) = b(k,58) - lu(k,332) * b(k,73) + b(k,40) = b(k,40) - lu(k,331) * b(k,73) + b(k,72) = b(k,72) * lu(k,325) + b(k,71) = b(k,71) * lu(k,319) + b(k,70) = b(k,70) * lu(k,313) + b(k,69) = b(k,69) * lu(k,307) + b(k,68) = b(k,68) * lu(k,301) + b(k,67) = b(k,67) * lu(k,295) + b(k,66) = b(k,66) * lu(k,289) + b(k,65) = b(k,65) * lu(k,283) + b(k,64) = b(k,64) * lu(k,277) + b(k,63) = b(k,63) * lu(k,271) + b(k,62) = b(k,62) * lu(k,265) + b(k,61) = b(k,61) * lu(k,257) + b(k,60) = b(k,60) * lu(k,249) + b(k,59) = b(k,59) * lu(k,244) + b(k,58) = b(k,58) * lu(k,239) + b(k,40) = b(k,40) - lu(k,238) * b(k,58) + b(k,57) = b(k,57) * lu(k,233) + b(k,56) = b(k,56) * lu(k,228) + b(k,55) = b(k,55) * lu(k,223) + b(k,54) = b(k,54) * lu(k,218) + b(k,53) = b(k,53) * lu(k,213) + b(k,52) = b(k,52) * lu(k,210) + b(k,51) = b(k,51) * lu(k,207) + b(k,50) = b(k,50) * lu(k,201) + b(k,49) = b(k,49) * lu(k,195) + b(k,48) = b(k,48) * lu(k,189) + b(k,47) = b(k,47) * lu(k,183) + b(k,46) = b(k,46) * lu(k,179) + b(k,45) = b(k,45) * lu(k,175) + b(k,22) = b(k,22) - lu(k,174) * b(k,45) + b(k,44) = b(k,44) * lu(k,170) + b(k,43) = b(k,43) * lu(k,166) + b(k,42) = b(k,42) * lu(k,163) + b(k,41) = b(k,41) * lu(k,160) + b(k,40) = b(k,40) * lu(k,157) + b(k,39) = b(k,39) * lu(k,154) + b(k,38) = b(k,38) * lu(k,149) + b(k,37) = b(k,37) * lu(k,146) + b(k,36) = b(k,36) * lu(k,141) + b(k,35) = b(k,35) * lu(k,133) + b(k,33) = b(k,33) - lu(k,132) * b(k,35) + b(k,15) = b(k,15) - lu(k,131) * b(k,35) + b(k,34) = b(k,34) * lu(k,128) + b(k,33) = b(k,33) * lu(k,124) + b(k,32) = b(k,32) * lu(k,119) + b(k,31) = b(k,31) * lu(k,112) + b(k,14) = b(k,14) - lu(k,111) * b(k,31) + b(k,30) = b(k,30) * lu(k,107) + b(k,29) = b(k,29) * lu(k,103) + b(k,28) = b(k,28) * lu(k,98) + b(k,27) = b(k,27) * lu(k,94) + b(k,26) = b(k,26) * lu(k,88) + b(k,9) = b(k,9) - lu(k,87) * b(k,26) + b(k,25) = b(k,25) * lu(k,85) + b(k,24) = b(k,24) * lu(k,82) + b(k,23) = b(k,23) * lu(k,79) + b(k,22) = b(k,22) * lu(k,76) + b(k,21) = b(k,21) * lu(k,73) + b(k,20) = b(k,20) * lu(k,70) + b(k,19) = b(k,19) * lu(k,66) + b(k,18) = b(k,18) * lu(k,63) + b(k,17) = b(k,17) * lu(k,60) + b(k,16) = b(k,16) * lu(k,57) + b(k,15) = b(k,15) * lu(k,56) + b(k,6) = b(k,6) - lu(k,55) * b(k,15) + b(k,5) = b(k,5) - lu(k,54) * b(k,15) + b(k,4) = b(k,4) - lu(k,53) * b(k,15) + b(k,3) = b(k,3) - lu(k,52) * b(k,15) + b(k,2) = b(k,2) - lu(k,51) * b(k,15) + b(k,14) = b(k,14) * lu(k,50) + b(k,6) = b(k,6) - lu(k,49) * b(k,14) + b(k,5) = b(k,5) - lu(k,48) * b(k,14) + b(k,4) = b(k,4) - lu(k,47) * b(k,14) + b(k,3) = b(k,3) - lu(k,46) * b(k,14) + b(k,2) = b(k,2) - lu(k,45) * b(k,14) + b(k,13) = b(k,13) * lu(k,44) + b(k,6) = b(k,6) - lu(k,43) * b(k,13) + b(k,5) = b(k,5) - lu(k,42) * b(k,13) + b(k,4) = b(k,4) - lu(k,41) * b(k,13) + b(k,3) = b(k,3) - lu(k,40) * b(k,13) + b(k,2) = b(k,2) - lu(k,39) * b(k,13) + b(k,12) = b(k,12) * lu(k,38) + b(k,11) = b(k,11) - lu(k,37) * b(k,12) + b(k,11) = b(k,11) * lu(k,36) + b(k,6) = b(k,6) - lu(k,35) * b(k,11) + b(k,5) = b(k,5) - lu(k,34) * b(k,11) + b(k,4) = b(k,4) - lu(k,33) * b(k,11) + b(k,3) = b(k,3) - lu(k,32) * b(k,11) + b(k,2) = b(k,2) - lu(k,31) * b(k,11) + b(k,10) = b(k,10) * lu(k,30) + b(k,6) = b(k,6) - lu(k,29) * b(k,10) + b(k,5) = b(k,5) - lu(k,28) * b(k,10) + b(k,4) = b(k,4) - lu(k,27) * b(k,10) + b(k,3) = b(k,3) - lu(k,26) * b(k,10) + b(k,2) = b(k,2) - lu(k,25) * b(k,10) + b(k,9) = b(k,9) * lu(k,24) + b(k,6) = b(k,6) - lu(k,23) * b(k,9) + b(k,5) = b(k,5) - lu(k,22) * b(k,9) + b(k,4) = b(k,4) - lu(k,21) * b(k,9) + b(k,3) = b(k,3) - lu(k,20) * b(k,9) + b(k,2) = b(k,2) - lu(k,19) * b(k,9) + b(k,8) = b(k,8) * lu(k,18) + b(k,6) = b(k,6) - lu(k,17) * b(k,8) + b(k,5) = b(k,5) - lu(k,16) * b(k,8) + b(k,4) = b(k,4) - lu(k,15) * b(k,8) + b(k,3) = b(k,3) - lu(k,14) * b(k,8) + b(k,2) = b(k,2) - lu(k,13) * b(k,8) + b(k,7) = b(k,7) * lu(k,12) + b(k,6) = b(k,6) - lu(k,11) * b(k,7) + b(k,5) = b(k,5) - lu(k,10) * b(k,7) + b(k,4) = b(k,4) - lu(k,9) * b(k,7) + b(k,3) = b(k,3) - lu(k,8) * b(k,7) + b(k,2) = b(k,2) - lu(k,7) * b(k,7) + end do + end subroutine lu_slv10 + subroutine lu_slv11( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: k +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + do k = 1,avec_len + b(k,6) = b(k,6) * lu(k,6) + b(k,5) = b(k,5) * lu(k,5) + b(k,4) = b(k,4) * lu(k,4) + b(k,3) = b(k,3) * lu(k,3) + b(k,2) = b(k,2) * lu(k,2) + b(k,1) = b(k,1) * lu(k,1) + end do + end subroutine lu_slv11 + subroutine lu_slv( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) + call lu_slv01( avec_len, lu, b ) + call lu_slv02( avec_len, lu, b ) + call lu_slv03( avec_len, lu, b ) + call lu_slv04( avec_len, lu, b ) + call lu_slv05( avec_len, lu, b ) + call lu_slv06( avec_len, lu, b ) + call lu_slv07( avec_len, lu, b ) + call lu_slv08( avec_len, lu, b ) + call lu_slv09( avec_len, lu, b ) + call lu_slv10( avec_len, lu, b ) + call lu_slv11( avec_len, lu, b ) + end subroutine lu_slv + end module mo_lu_solve diff --git a/src/chemistry/pp_trop_strat_noaero/mo_nln_matrix.F90 b/src/chemistry/pp_trop_strat_noaero/mo_nln_matrix.F90 new file mode 100644 index 0000000000..c3df974ee3 --- /dev/null +++ b/src/chemistry/pp_trop_strat_noaero/mo_nln_matrix.F90 @@ -0,0 +1,3282 @@ + module mo_nln_matrix + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only: veclen + private + public :: nlnmat + contains + subroutine nlnmat01( avec_len, mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + do k = 1,avec_len + mat(k,532) = -(rxt(k,346)*y(k,190)) + mat(k,1442) = -rxt(k,346)*y(k,1) + mat(k,1755) = rxt(k,349)*y(k,162) + mat(k,805) = rxt(k,349)*y(k,116) + mat(k,521) = -(rxt(k,350)*y(k,190)) + mat(k,1441) = -rxt(k,350)*y(k,2) + mat(k,804) = rxt(k,347)*y(k,176) + mat(k,1635) = rxt(k,347)*y(k,162) + mat(k,759) = -(rxt(k,429)*y(k,118) + rxt(k,430)*y(k,122) + rxt(k,431) & + *y(k,190)) + mat(k,1980) = -rxt(k,429)*y(k,4) + mat(k,1828) = -rxt(k,430)*y(k,4) + mat(k,1464) = -rxt(k,431)*y(k,4) + mat(k,88) = -(rxt(k,388)*y(k,190)) + mat(k,1377) = -rxt(k,388)*y(k,5) + mat(k,313) = -(rxt(k,391)*y(k,190)) + mat(k,1414) = -rxt(k,391)*y(k,6) + mat(k,373) = rxt(k,389)*y(k,176) + mat(k,1616) = rxt(k,389)*y(k,164) + mat(k,89) = .120_r8*rxt(k,388)*y(k,190) + mat(k,1378) = .120_r8*rxt(k,388)*y(k,5) + mat(k,756) = .100_r8*rxt(k,430)*y(k,122) + mat(k,783) = .100_r8*rxt(k,433)*y(k,122) + mat(k,1817) = .100_r8*rxt(k,430)*y(k,4) + .100_r8*rxt(k,433)*y(k,105) + mat(k,1743) = .500_r8*rxt(k,390)*y(k,164) + .200_r8*rxt(k,417)*y(k,196) & + + .060_r8*rxt(k,423)*y(k,199) + mat(k,374) = .500_r8*rxt(k,390)*y(k,116) + mat(k,581) = .200_r8*rxt(k,417)*y(k,116) + mat(k,605) = .060_r8*rxt(k,423)*y(k,116) + mat(k,1736) = .200_r8*rxt(k,417)*y(k,196) + .200_r8*rxt(k,423)*y(k,199) + mat(k,580) = .200_r8*rxt(k,417)*y(k,116) + mat(k,603) = .200_r8*rxt(k,423)*y(k,116) + mat(k,1752) = .200_r8*rxt(k,417)*y(k,196) + .150_r8*rxt(k,423)*y(k,199) + mat(k,583) = .200_r8*rxt(k,417)*y(k,116) + mat(k,606) = .150_r8*rxt(k,423)*y(k,116) + mat(k,1738) = .210_r8*rxt(k,423)*y(k,199) + mat(k,604) = .210_r8*rxt(k,423)*y(k,116) + mat(k,154) = -(rxt(k,351)*y(k,190)) + mat(k,1389) = -rxt(k,351)*y(k,13) + mat(k,755) = .050_r8*rxt(k,430)*y(k,122) + mat(k,782) = .050_r8*rxt(k,433)*y(k,122) + mat(k,1816) = .050_r8*rxt(k,430)*y(k,4) + .050_r8*rxt(k,433)*y(k,105) + mat(k,257) = -(rxt(k,317)*y(k,118) + rxt(k,318)*y(k,190)) + mat(k,1974) = -rxt(k,317)*y(k,14) + mat(k,1405) = -rxt(k,318)*y(k,14) + mat(k,1247) = -(rxt(k,200)*y(k,40) + rxt(k,201)*y(k,176) + rxt(k,202) & + *y(k,122)) + mat(k,1541) = -rxt(k,200)*y(k,15) + mat(k,1677) = -rxt(k,201)*y(k,15) + mat(k,1853) = -rxt(k,202)*y(k,15) + mat(k,1518) = 4.000_r8*rxt(k,203)*y(k,17) + (rxt(k,204)+rxt(k,205))*y(k,57) & + + rxt(k,208)*y(k,116) + rxt(k,211)*y(k,121) + rxt(k,458) & + *y(k,136) + rxt(k,212)*y(k,190) + mat(k,1703) = (rxt(k,204)+rxt(k,205))*y(k,17) + mat(k,695) = rxt(k,213)*y(k,121) + rxt(k,219)*y(k,189) + rxt(k,214)*y(k,190) + mat(k,1793) = rxt(k,208)*y(k,17) + mat(k,1571) = rxt(k,211)*y(k,17) + rxt(k,213)*y(k,76) + mat(k,1084) = rxt(k,458)*y(k,17) + mat(k,1340) = rxt(k,219)*y(k,76) + mat(k,1494) = rxt(k,212)*y(k,17) + rxt(k,214)*y(k,76) + mat(k,1512) = rxt(k,206)*y(k,57) + mat(k,1697) = rxt(k,206)*y(k,17) + mat(k,1913) = (rxt(k,520)+rxt(k,525))*y(k,86) + mat(k,647) = (rxt(k,520)+rxt(k,525))*y(k,80) + mat(k,1524) = -(4._r8*rxt(k,203)*y(k,17) + (rxt(k,204) + rxt(k,205) + rxt(k,206) & + ) * y(k,57) + rxt(k,207)*y(k,176) + rxt(k,208)*y(k,116) & + + rxt(k,209)*y(k,117) + rxt(k,211)*y(k,121) + rxt(k,212) & + *y(k,190) + rxt(k,458)*y(k,136)) + mat(k,1709) = -(rxt(k,204) + rxt(k,205) + rxt(k,206)) * y(k,17) + mat(k,1683) = -rxt(k,207)*y(k,17) + mat(k,1799) = -rxt(k,208)*y(k,17) + mat(k,1900) = -rxt(k,209)*y(k,17) + mat(k,1577) = -rxt(k,211)*y(k,17) + mat(k,1500) = -rxt(k,212)*y(k,17) + mat(k,1087) = -rxt(k,458)*y(k,17) + mat(k,1251) = rxt(k,202)*y(k,122) + mat(k,418) = rxt(k,210)*y(k,121) + mat(k,699) = rxt(k,220)*y(k,189) + mat(k,651) = rxt(k,215)*y(k,121) + mat(k,1577) = mat(k,1577) + rxt(k,210)*y(k,18) + rxt(k,215)*y(k,86) + mat(k,1859) = rxt(k,202)*y(k,15) + mat(k,1346) = rxt(k,220)*y(k,76) + mat(k,414) = -(rxt(k,210)*y(k,121)) + mat(k,1561) = -rxt(k,210)*y(k,18) + mat(k,1514) = rxt(k,209)*y(k,117) + mat(k,1878) = rxt(k,209)*y(k,17) + mat(k,157) = -(rxt(k,392)*y(k,190)) + mat(k,1390) = -rxt(k,392)*y(k,20) + mat(k,1733) = rxt(k,395)*y(k,166) + mat(k,331) = rxt(k,395)*y(k,116) + mat(k,239) = -(rxt(k,394)*y(k,190)) + mat(k,1403) = -rxt(k,394)*y(k,21) + mat(k,332) = rxt(k,393)*y(k,176) + mat(k,1609) = rxt(k,393)*y(k,166) + mat(k,201) = -(rxt(k,266)*y(k,54) + rxt(k,267)*y(k,190)) + mat(k,1937) = -rxt(k,266)*y(k,22) + mat(k,1397) = -rxt(k,267)*y(k,22) + mat(k,442) = -(rxt(k,268)*y(k,54) + rxt(k,269)*y(k,122) + rxt(k,294)*y(k,190)) + mat(k,1938) = -rxt(k,268)*y(k,23) + mat(k,1821) = -rxt(k,269)*y(k,23) + mat(k,1431) = -rxt(k,294)*y(k,23) + mat(k,166) = -(rxt(k,274)*y(k,190)) + mat(k,1392) = -rxt(k,274)*y(k,24) + mat(k,683) = .800_r8*rxt(k,270)*y(k,167) + .200_r8*rxt(k,271)*y(k,171) + mat(k,1285) = .200_r8*rxt(k,271)*y(k,167) + mat(k,213) = -(rxt(k,275)*y(k,190)) + mat(k,1399) = -rxt(k,275)*y(k,25) + mat(k,684) = rxt(k,272)*y(k,176) + mat(k,1605) = rxt(k,272)*y(k,167) + mat(k,195) = -(rxt(k,276)*y(k,54) + rxt(k,277)*y(k,190)) + mat(k,1936) = -rxt(k,276)*y(k,26) + mat(k,1396) = -rxt(k,277)*y(k,26) + mat(k,840) = -(rxt(k,297)*y(k,118) + rxt(k,298)*y(k,122) + rxt(k,315) & + *y(k,190)) + mat(k,1984) = -rxt(k,297)*y(k,27) + mat(k,1832) = -rxt(k,298)*y(k,27) + mat(k,1469) = -rxt(k,315)*y(k,27) + mat(k,707) = .130_r8*rxt(k,375)*y(k,122) + mat(k,1832) = mat(k,1832) + .130_r8*rxt(k,375)*y(k,93) + mat(k,307) = -(rxt(k,302)*y(k,190)) + mat(k,1413) = -rxt(k,302)*y(k,28) + mat(k,660) = rxt(k,300)*y(k,176) + mat(k,1615) = rxt(k,300)*y(k,168) + mat(k,66) = -(rxt(k,303)*y(k,190)) + mat(k,1374) = -rxt(k,303)*y(k,29) + mat(k,170) = -(rxt(k,398)*y(k,190)) + mat(k,1393) = -rxt(k,398)*y(k,30) + mat(k,512) = rxt(k,396)*y(k,176) + mat(k,1603) = rxt(k,396)*y(k,169) + mat(k,1548) = -(rxt(k,164)*y(k,54) + rxt(k,200)*y(k,15) + rxt(k,244)*y(k,176) & + + rxt(k,245)*y(k,118) + rxt(k,246)*y(k,121) + rxt(k,247) & + *y(k,190)) + mat(k,1958) = -rxt(k,164)*y(k,40) + mat(k,1252) = -rxt(k,200)*y(k,40) + mat(k,1684) = -rxt(k,244)*y(k,40) + mat(k,2015) = -rxt(k,245)*y(k,40) + mat(k,1578) = -rxt(k,246)*y(k,40) + mat(k,1501) = -rxt(k,247)*y(k,40) + mat(k,539) = .400_r8*rxt(k,346)*y(k,190) + mat(k,771) = .340_r8*rxt(k,430)*y(k,122) + mat(k,262) = .500_r8*rxt(k,317)*y(k,118) + mat(k,447) = rxt(k,269)*y(k,122) + mat(k,848) = .500_r8*rxt(k,298)*y(k,122) + mat(k,405) = .500_r8*rxt(k,286)*y(k,190) + mat(k,658) = rxt(k,252)*y(k,190) + mat(k,299) = .300_r8*rxt(k,253)*y(k,190) + mat(k,1710) = rxt(k,171)*y(k,171) + mat(k,867) = .800_r8*rxt(k,291)*y(k,190) + mat(k,717) = .910_r8*rxt(k,375)*y(k,122) + mat(k,479) = .300_r8*rxt(k,366)*y(k,190) + mat(k,1053) = .800_r8*rxt(k,370)*y(k,171) + mat(k,1067) = .120_r8*rxt(k,328)*y(k,122) + mat(k,462) = .500_r8*rxt(k,341)*y(k,190) + mat(k,798) = .340_r8*rxt(k,433)*y(k,122) + mat(k,1142) = .600_r8*rxt(k,342)*y(k,122) + mat(k,1800) = .100_r8*rxt(k,348)*y(k,162) + rxt(k,251)*y(k,171) & + + .500_r8*rxt(k,319)*y(k,173) + .500_r8*rxt(k,288)*y(k,175) & + + .920_r8*rxt(k,358)*y(k,178) + .250_r8*rxt(k,326)*y(k,182) & + + rxt(k,335)*y(k,184) + rxt(k,309)*y(k,192) + rxt(k,313) & + *y(k,193) + .340_r8*rxt(k,442)*y(k,194) + .320_r8*rxt(k,447) & + *y(k,195) + .250_r8*rxt(k,383)*y(k,198) + mat(k,2015) = mat(k,2015) + .500_r8*rxt(k,317)*y(k,14) + rxt(k,359)*y(k,178) & + + .250_r8*rxt(k,325)*y(k,182) + rxt(k,336)*y(k,184) + mat(k,1860) = .340_r8*rxt(k,430)*y(k,4) + rxt(k,269)*y(k,23) & + + .500_r8*rxt(k,298)*y(k,27) + .910_r8*rxt(k,375)*y(k,93) & + + .120_r8*rxt(k,328)*y(k,100) + .340_r8*rxt(k,433)*y(k,105) & + + .600_r8*rxt(k,342)*y(k,106) + mat(k,359) = rxt(k,293)*y(k,190) + mat(k,891) = .680_r8*rxt(k,451)*y(k,190) + mat(k,814) = .100_r8*rxt(k,348)*y(k,116) + mat(k,690) = .700_r8*rxt(k,271)*y(k,171) + mat(k,666) = rxt(k,299)*y(k,171) + mat(k,1238) = rxt(k,282)*y(k,171) + rxt(k,355)*y(k,178) + .250_r8*rxt(k,322) & + *y(k,182) + rxt(k,331)*y(k,184) + .250_r8*rxt(k,380)*y(k,198) + mat(k,1323) = rxt(k,171)*y(k,57) + .800_r8*rxt(k,370)*y(k,96) + rxt(k,251) & + *y(k,116) + .700_r8*rxt(k,271)*y(k,167) + rxt(k,299)*y(k,168) & + + rxt(k,282)*y(k,170) + (4.000_r8*rxt(k,248)+2.000_r8*rxt(k,249)) & + *y(k,171) + 1.500_r8*rxt(k,356)*y(k,178) + .750_r8*rxt(k,361) & + *y(k,179) + .880_r8*rxt(k,323)*y(k,182) + 2.000_r8*rxt(k,332) & + *y(k,184) + .750_r8*rxt(k,435)*y(k,188) + .800_r8*rxt(k,311) & + *y(k,193) + .930_r8*rxt(k,440)*y(k,194) + .950_r8*rxt(k,445) & + *y(k,195) + .800_r8*rxt(k,381)*y(k,198) + mat(k,454) = .500_r8*rxt(k,319)*y(k,116) + mat(k,570) = .500_r8*rxt(k,288)*y(k,116) + mat(k,1684) = mat(k,1684) + .450_r8*rxt(k,333)*y(k,184) + .150_r8*rxt(k,312) & + *y(k,193) + mat(k,1190) = .920_r8*rxt(k,358)*y(k,116) + rxt(k,359)*y(k,118) + rxt(k,355) & + *y(k,170) + 1.500_r8*rxt(k,356)*y(k,171) + mat(k,1122) = .750_r8*rxt(k,361)*y(k,171) + mat(k,1164) = .250_r8*rxt(k,326)*y(k,116) + .250_r8*rxt(k,325)*y(k,118) & + + .250_r8*rxt(k,322)*y(k,170) + .880_r8*rxt(k,323)*y(k,171) + mat(k,1208) = rxt(k,335)*y(k,116) + rxt(k,336)*y(k,118) + rxt(k,331)*y(k,170) & + + 2.000_r8*rxt(k,332)*y(k,171) + .450_r8*rxt(k,333)*y(k,176) & + + 4.000_r8*rxt(k,334)*y(k,184) + mat(k,986) = .750_r8*rxt(k,435)*y(k,171) + mat(k,1501) = mat(k,1501) + .400_r8*rxt(k,346)*y(k,1) + .500_r8*rxt(k,286) & + *y(k,49) + rxt(k,252)*y(k,50) + .300_r8*rxt(k,253)*y(k,51) & + + .800_r8*rxt(k,291)*y(k,69) + .300_r8*rxt(k,366)*y(k,94) & + + .500_r8*rxt(k,341)*y(k,104) + rxt(k,293)*y(k,127) & + + .680_r8*rxt(k,451)*y(k,151) + mat(k,633) = rxt(k,309)*y(k,116) + mat(k,1000) = rxt(k,313)*y(k,116) + .800_r8*rxt(k,311)*y(k,171) & + + .150_r8*rxt(k,312)*y(k,176) + mat(k,967) = .340_r8*rxt(k,442)*y(k,116) + .930_r8*rxt(k,440)*y(k,171) + mat(k,947) = .320_r8*rxt(k,447)*y(k,116) + .950_r8*rxt(k,445)*y(k,171) + mat(k,1017) = .250_r8*rxt(k,383)*y(k,116) + .250_r8*rxt(k,380)*y(k,170) & + + .800_r8*rxt(k,381)*y(k,171) + end do + end subroutine nlnmat01 + subroutine nlnmat02( avec_len, mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + do k = 1,avec_len + mat(k,894) = -(rxt(k,278)*y(k,118) + rxt(k,279)*y(k,190)) + mat(k,1989) = -rxt(k,278)*y(k,43) + mat(k,1474) = -rxt(k,279)*y(k,43) + mat(k,536) = .800_r8*rxt(k,346)*y(k,190) + mat(k,260) = rxt(k,317)*y(k,118) + mat(k,167) = rxt(k,274)*y(k,190) + mat(k,215) = .500_r8*rxt(k,275)*y(k,190) + mat(k,841) = .500_r8*rxt(k,298)*y(k,122) + mat(k,1131) = .100_r8*rxt(k,342)*y(k,122) + mat(k,1775) = .400_r8*rxt(k,348)*y(k,162) + rxt(k,273)*y(k,167) & + + .270_r8*rxt(k,301)*y(k,168) + rxt(k,319)*y(k,173) + rxt(k,338) & + *y(k,186) + rxt(k,309)*y(k,192) + mat(k,1989) = mat(k,1989) + rxt(k,317)*y(k,14) + mat(k,1836) = .500_r8*rxt(k,298)*y(k,27) + .100_r8*rxt(k,342)*y(k,106) + mat(k,810) = .400_r8*rxt(k,348)*y(k,116) + mat(k,687) = rxt(k,273)*y(k,116) + 3.200_r8*rxt(k,270)*y(k,167) & + + .800_r8*rxt(k,271)*y(k,171) + mat(k,663) = .270_r8*rxt(k,301)*y(k,116) + mat(k,1301) = .800_r8*rxt(k,271)*y(k,167) + mat(k,452) = rxt(k,319)*y(k,116) + mat(k,1659) = .200_r8*rxt(k,337)*y(k,186) + mat(k,544) = rxt(k,338)*y(k,116) + .200_r8*rxt(k,337)*y(k,176) + mat(k,1474) = mat(k,1474) + .800_r8*rxt(k,346)*y(k,1) + rxt(k,274)*y(k,24) & + + .500_r8*rxt(k,275)*y(k,25) + mat(k,630) = rxt(k,309)*y(k,116) + mat(k,57) = -(rxt(k,280)*y(k,190)) + mat(k,1372) = -rxt(k,280)*y(k,45) + mat(k,818) = -(rxt(k,316)*y(k,190)) + mat(k,1467) = -rxt(k,316)*y(k,46) + mat(k,535) = .800_r8*rxt(k,346)*y(k,190) + mat(k,761) = .520_r8*rxt(k,430)*y(k,122) + mat(k,259) = .500_r8*rxt(k,317)*y(k,118) + mat(k,788) = .520_r8*rxt(k,433)*y(k,122) + mat(k,1770) = .250_r8*rxt(k,348)*y(k,162) + .820_r8*rxt(k,301)*y(k,168) & + + .500_r8*rxt(k,319)*y(k,173) + .270_r8*rxt(k,442)*y(k,194) & + + .040_r8*rxt(k,447)*y(k,195) + mat(k,1983) = .500_r8*rxt(k,317)*y(k,14) + mat(k,1831) = .520_r8*rxt(k,430)*y(k,4) + .520_r8*rxt(k,433)*y(k,105) + mat(k,884) = .500_r8*rxt(k,451)*y(k,190) + mat(k,809) = .250_r8*rxt(k,348)*y(k,116) + mat(k,662) = .820_r8*rxt(k,301)*y(k,116) + .820_r8*rxt(k,299)*y(k,171) + mat(k,1296) = .820_r8*rxt(k,299)*y(k,168) + .150_r8*rxt(k,440)*y(k,194) & + + .025_r8*rxt(k,445)*y(k,195) + mat(k,451) = .500_r8*rxt(k,319)*y(k,116) + mat(k,1467) = mat(k,1467) + .800_r8*rxt(k,346)*y(k,1) + .500_r8*rxt(k,451) & + *y(k,151) + mat(k,956) = .270_r8*rxt(k,442)*y(k,116) + .150_r8*rxt(k,440)*y(k,171) + mat(k,934) = .040_r8*rxt(k,447)*y(k,116) + .025_r8*rxt(k,445)*y(k,171) + mat(k,1072) = -(rxt(k,304)*y(k,118) + rxt(k,305)*y(k,190)) + mat(k,2000) = -rxt(k,304)*y(k,47) + mat(k,1486) = -rxt(k,305)*y(k,47) + mat(k,926) = rxt(k,306)*y(k,190) + mat(k,1061) = .880_r8*rxt(k,328)*y(k,122) + mat(k,1134) = .500_r8*rxt(k,342)*y(k,122) + mat(k,1786) = .170_r8*rxt(k,401)*y(k,172) + .050_r8*rxt(k,364)*y(k,179) & + + .250_r8*rxt(k,326)*y(k,182) + .170_r8*rxt(k,407)*y(k,185) & + + .400_r8*rxt(k,417)*y(k,196) + .250_r8*rxt(k,383)*y(k,198) & + + .540_r8*rxt(k,423)*y(k,199) + .510_r8*rxt(k,426)*y(k,201) + mat(k,2000) = mat(k,2000) + .050_r8*rxt(k,365)*y(k,179) + .250_r8*rxt(k,325) & + *y(k,182) + .250_r8*rxt(k,384)*y(k,198) + mat(k,730) = rxt(k,307)*y(k,190) + mat(k,1845) = .880_r8*rxt(k,328)*y(k,100) + .500_r8*rxt(k,342)*y(k,106) + mat(k,1227) = .250_r8*rxt(k,322)*y(k,182) + .250_r8*rxt(k,380)*y(k,198) + mat(k,1311) = .240_r8*rxt(k,323)*y(k,182) + .500_r8*rxt(k,311)*y(k,193) & + + .100_r8*rxt(k,381)*y(k,198) + mat(k,622) = .170_r8*rxt(k,401)*y(k,116) + .070_r8*rxt(k,400)*y(k,176) + mat(k,1670) = .070_r8*rxt(k,400)*y(k,172) + .070_r8*rxt(k,406)*y(k,185) + mat(k,1112) = .050_r8*rxt(k,364)*y(k,116) + .050_r8*rxt(k,365)*y(k,118) + mat(k,1156) = .250_r8*rxt(k,326)*y(k,116) + .250_r8*rxt(k,325)*y(k,118) & + + .250_r8*rxt(k,322)*y(k,170) + .240_r8*rxt(k,323)*y(k,171) + mat(k,743) = .170_r8*rxt(k,407)*y(k,116) + .070_r8*rxt(k,406)*y(k,176) + mat(k,1486) = mat(k,1486) + rxt(k,306)*y(k,90) + rxt(k,307)*y(k,119) + mat(k,996) = .500_r8*rxt(k,311)*y(k,171) + mat(k,590) = .400_r8*rxt(k,417)*y(k,116) + mat(k,1012) = .250_r8*rxt(k,383)*y(k,116) + .250_r8*rxt(k,384)*y(k,118) & + + .250_r8*rxt(k,380)*y(k,170) + .100_r8*rxt(k,381)*y(k,171) + mat(k,614) = .540_r8*rxt(k,423)*y(k,116) + mat(k,385) = .510_r8*rxt(k,426)*y(k,116) + mat(k,430) = -(rxt(k,285)*y(k,190)) + mat(k,1429) = -rxt(k,285)*y(k,48) + mat(k,836) = .120_r8*rxt(k,298)*y(k,122) + mat(k,1820) = .120_r8*rxt(k,298)*y(k,27) + mat(k,1218) = .100_r8*rxt(k,282)*y(k,171) + .150_r8*rxt(k,283)*y(k,176) + mat(k,1289) = .100_r8*rxt(k,282)*y(k,170) + mat(k,1629) = .150_r8*rxt(k,283)*y(k,170) + .150_r8*rxt(k,333)*y(k,184) + mat(k,1198) = .150_r8*rxt(k,333)*y(k,176) + mat(k,401) = -(rxt(k,286)*y(k,190)) + mat(k,1426) = -rxt(k,286)*y(k,49) + mat(k,1217) = .400_r8*rxt(k,283)*y(k,176) + mat(k,1626) = .400_r8*rxt(k,283)*y(k,170) + .400_r8*rxt(k,333)*y(k,184) + mat(k,1197) = .400_r8*rxt(k,333)*y(k,176) + mat(k,656) = -(rxt(k,252)*y(k,190)) + mat(k,1453) = -rxt(k,252)*y(k,50) + mat(k,1038) = .200_r8*rxt(k,370)*y(k,171) + mat(k,685) = .300_r8*rxt(k,271)*y(k,171) + mat(k,1291) = .200_r8*rxt(k,370)*y(k,96) + .300_r8*rxt(k,271)*y(k,167) & + + 2.000_r8*rxt(k,249)*y(k,171) + .250_r8*rxt(k,356)*y(k,178) & + + .250_r8*rxt(k,361)*y(k,179) + .250_r8*rxt(k,323)*y(k,182) & + + .250_r8*rxt(k,435)*y(k,188) + .500_r8*rxt(k,311)*y(k,193) & + + .250_r8*rxt(k,440)*y(k,194) + .250_r8*rxt(k,445)*y(k,195) & + + .300_r8*rxt(k,381)*y(k,198) + mat(k,1172) = .250_r8*rxt(k,356)*y(k,171) + mat(k,1101) = .250_r8*rxt(k,361)*y(k,171) + mat(k,1150) = .250_r8*rxt(k,323)*y(k,171) + mat(k,974) = .250_r8*rxt(k,435)*y(k,171) + mat(k,993) = .500_r8*rxt(k,311)*y(k,171) + mat(k,955) = .250_r8*rxt(k,440)*y(k,171) + mat(k,933) = .250_r8*rxt(k,445)*y(k,171) + mat(k,1006) = .300_r8*rxt(k,381)*y(k,171) + mat(k,295) = -(rxt(k,253)*y(k,190)) + mat(k,1411) = -rxt(k,253)*y(k,51) + mat(k,1288) = rxt(k,250)*y(k,176) + mat(k,1613) = rxt(k,250)*y(k,171) + mat(k,1966) = -(rxt(k,164)*y(k,40) + rxt(k,166)*y(k,72) + rxt(k,167)*y(k,74) & + + (rxt(k,168) + rxt(k,169)) * y(k,176) + rxt(k,170)*y(k,122) & + + rxt(k,177)*y(k,58) + rxt(k,186)*y(k,87) + rxt(k,276)*y(k,26)) + mat(k,1556) = -rxt(k,164)*y(k,54) + mat(k,1032) = -rxt(k,166)*y(k,54) + mat(k,471) = -rxt(k,167)*y(k,54) + mat(k,1692) = -(rxt(k,168) + rxt(k,169)) * y(k,54) + mat(k,1868) = -rxt(k,170)*y(k,54) + mat(k,833) = -rxt(k,177)*y(k,54) + mat(k,681) = -rxt(k,186)*y(k,54) + mat(k,199) = -rxt(k,276)*y(k,54) + mat(k,1533) = rxt(k,205)*y(k,57) + mat(k,1718) = rxt(k,205)*y(k,17) + (4.000_r8*rxt(k,172)+2.000_r8*rxt(k,174)) & + *y(k,57) + rxt(k,176)*y(k,116) + rxt(k,181)*y(k,121) & + + rxt(k,459)*y(k,136) + rxt(k,171)*y(k,171) + rxt(k,182) & + *y(k,190) + mat(k,106) = rxt(k,226)*y(k,189) + mat(k,1932) = rxt(k,184)*y(k,121) + rxt(k,196)*y(k,189) + rxt(k,185)*y(k,190) + mat(k,1808) = rxt(k,176)*y(k,57) + mat(k,1586) = rxt(k,181)*y(k,57) + rxt(k,184)*y(k,80) + mat(k,1094) = rxt(k,459)*y(k,57) + mat(k,1331) = rxt(k,171)*y(k,57) + mat(k,1355) = rxt(k,226)*y(k,63) + rxt(k,196)*y(k,80) + mat(k,1509) = rxt(k,182)*y(k,57) + rxt(k,185)*y(k,80) + mat(k,1935) = rxt(k,177)*y(k,58) + mat(k,1696) = 2.000_r8*rxt(k,173)*y(k,57) + mat(k,824) = rxt(k,177)*y(k,54) + (rxt(k,518)+rxt(k,523)+rxt(k,528))*y(k,80) + mat(k,1912) = (rxt(k,518)+rxt(k,523)+rxt(k,528))*y(k,58) + (rxt(k,513) & + +rxt(k,519)+rxt(k,524))*y(k,87) + mat(k,675) = (rxt(k,513)+rxt(k,519)+rxt(k,524))*y(k,80) + mat(k,1695) = 2.000_r8*rxt(k,198)*y(k,57) + mat(k,1713) = -(rxt(k,171)*y(k,171) + (4._r8*rxt(k,172) + 4._r8*rxt(k,173) & + + 4._r8*rxt(k,174) + 4._r8*rxt(k,198)) * y(k,57) + rxt(k,175) & + *y(k,176) + rxt(k,176)*y(k,116) + rxt(k,178)*y(k,117) + rxt(k,181) & + *y(k,121) + (rxt(k,182) + rxt(k,183)) * y(k,190) + (rxt(k,204) & + + rxt(k,205) + rxt(k,206)) * y(k,17) + rxt(k,459)*y(k,136)) + mat(k,1326) = -rxt(k,171)*y(k,57) + mat(k,1687) = -rxt(k,175)*y(k,57) + mat(k,1803) = -rxt(k,176)*y(k,57) + mat(k,1904) = -rxt(k,178)*y(k,57) + mat(k,1581) = -rxt(k,181)*y(k,57) + mat(k,1504) = -(rxt(k,182) + rxt(k,183)) * y(k,57) + mat(k,1528) = -(rxt(k,204) + rxt(k,205) + rxt(k,206)) * y(k,57) + mat(k,1090) = -rxt(k,459)*y(k,57) + mat(k,1961) = rxt(k,186)*y(k,87) + rxt(k,170)*y(k,122) + rxt(k,169)*y(k,176) + mat(k,830) = rxt(k,179)*y(k,121) + mat(k,1927) = rxt(k,197)*y(k,189) + mat(k,679) = rxt(k,186)*y(k,54) + rxt(k,187)*y(k,121) + rxt(k,188)*y(k,190) + mat(k,1581) = mat(k,1581) + rxt(k,179)*y(k,58) + rxt(k,187)*y(k,87) + mat(k,1863) = rxt(k,170)*y(k,54) + mat(k,232) = rxt(k,464)*y(k,136) + mat(k,1090) = mat(k,1090) + rxt(k,464)*y(k,124) + mat(k,1687) = mat(k,1687) + rxt(k,169)*y(k,54) + mat(k,1350) = rxt(k,197)*y(k,80) + mat(k,1504) = mat(k,1504) + rxt(k,188)*y(k,87) + mat(k,826) = -(rxt(k,177)*y(k,54) + rxt(k,179)*y(k,121) + rxt(k,180)*y(k,190) & + + (rxt(k,518) + rxt(k,523) + rxt(k,528)) * y(k,80)) + mat(k,1945) = -rxt(k,177)*y(k,58) + mat(k,1567) = -rxt(k,179)*y(k,58) + mat(k,1468) = -rxt(k,180)*y(k,58) + mat(k,1916) = -(rxt(k,518) + rxt(k,523) + rxt(k,528)) * y(k,58) + mat(k,1701) = rxt(k,178)*y(k,117) + mat(k,1887) = rxt(k,178)*y(k,57) + mat(k,903) = -((rxt(k,255) + rxt(k,265)) * y(k,190)) + mat(k,1475) = -(rxt(k,255) + rxt(k,265)) * y(k,60) + mat(k,764) = .230_r8*rxt(k,430)*y(k,122) + mat(k,1246) = rxt(k,200)*y(k,40) + mat(k,204) = .350_r8*rxt(k,267)*y(k,190) + mat(k,445) = .630_r8*rxt(k,269)*y(k,122) + mat(k,842) = .560_r8*rxt(k,298)*y(k,122) + mat(k,1539) = rxt(k,200)*y(k,15) + rxt(k,164)*y(k,54) + rxt(k,245)*y(k,118) & + + rxt(k,246)*y(k,121) + rxt(k,247)*y(k,190) + mat(k,1071) = rxt(k,304)*y(k,118) + rxt(k,305)*y(k,190) + mat(k,1948) = rxt(k,164)*y(k,40) + mat(k,737) = rxt(k,292)*y(k,190) + mat(k,708) = .620_r8*rxt(k,375)*y(k,122) + mat(k,1059) = .650_r8*rxt(k,328)*y(k,122) + mat(k,791) = .230_r8*rxt(k,433)*y(k,122) + mat(k,1132) = .560_r8*rxt(k,342)*y(k,122) + mat(k,1776) = .170_r8*rxt(k,401)*y(k,172) + .220_r8*rxt(k,326)*y(k,182) & + + .400_r8*rxt(k,404)*y(k,183) + .350_r8*rxt(k,407)*y(k,185) & + + .225_r8*rxt(k,442)*y(k,194) + .250_r8*rxt(k,383)*y(k,198) + mat(k,1990) = rxt(k,245)*y(k,40) + rxt(k,304)*y(k,47) + .220_r8*rxt(k,325) & + *y(k,182) + .500_r8*rxt(k,384)*y(k,198) + mat(k,1568) = rxt(k,246)*y(k,40) + rxt(k,454)*y(k,125) + mat(k,1837) = .230_r8*rxt(k,430)*y(k,4) + .630_r8*rxt(k,269)*y(k,23) & + + .560_r8*rxt(k,298)*y(k,27) + .620_r8*rxt(k,375)*y(k,93) & + + .650_r8*rxt(k,328)*y(k,100) + .230_r8*rxt(k,433)*y(k,105) & + + .560_r8*rxt(k,342)*y(k,106) + mat(k,252) = rxt(k,454)*y(k,121) + rxt(k,455)*y(k,190) + mat(k,886) = .700_r8*rxt(k,451)*y(k,190) + mat(k,1222) = .220_r8*rxt(k,322)*y(k,182) + .250_r8*rxt(k,380)*y(k,198) + mat(k,1302) = .110_r8*rxt(k,323)*y(k,182) + .125_r8*rxt(k,440)*y(k,194) & + + .200_r8*rxt(k,381)*y(k,198) + mat(k,621) = .170_r8*rxt(k,401)*y(k,116) + .070_r8*rxt(k,400)*y(k,176) + mat(k,1660) = .070_r8*rxt(k,400)*y(k,172) + .160_r8*rxt(k,403)*y(k,183) & + + .140_r8*rxt(k,406)*y(k,185) + mat(k,1152) = .220_r8*rxt(k,326)*y(k,116) + .220_r8*rxt(k,325)*y(k,118) & + + .220_r8*rxt(k,322)*y(k,170) + .110_r8*rxt(k,323)*y(k,171) + mat(k,576) = .400_r8*rxt(k,404)*y(k,116) + .160_r8*rxt(k,403)*y(k,176) + mat(k,742) = .350_r8*rxt(k,407)*y(k,116) + .140_r8*rxt(k,406)*y(k,176) + mat(k,1475) = mat(k,1475) + .350_r8*rxt(k,267)*y(k,22) + rxt(k,247)*y(k,40) & + + rxt(k,305)*y(k,47) + rxt(k,292)*y(k,70) + rxt(k,455)*y(k,125) & + + .700_r8*rxt(k,451)*y(k,151) + mat(k,959) = .225_r8*rxt(k,442)*y(k,116) + .125_r8*rxt(k,440)*y(k,171) + mat(k,1009) = .250_r8*rxt(k,383)*y(k,116) + .500_r8*rxt(k,384)*y(k,118) & + + .250_r8*rxt(k,380)*y(k,170) + .200_r8*rxt(k,381)*y(k,171) + end do + end subroutine nlnmat02 + subroutine nlnmat03( avec_len, mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + do k = 1,avec_len + mat(k,70) = -(rxt(k,225)*y(k,189)) + mat(k,1334) = -rxt(k,225)*y(k,62) + mat(k,103) = -(rxt(k,226)*y(k,189)) + mat(k,1335) = -rxt(k,226)*y(k,63) + mat(k,119) = -(rxt(k,399)*y(k,190)) + mat(k,1383) = -rxt(k,399)*y(k,64) + mat(k,113) = .180_r8*rxt(k,419)*y(k,190) + mat(k,1383) = mat(k,1383) + .180_r8*rxt(k,419)*y(k,153) + mat(k,183) = -(rxt(k,452)*y(k,118) + (rxt(k,453) + rxt(k,466)) * y(k,190)) + mat(k,1971) = -rxt(k,452)*y(k,65) + mat(k,1395) = -(rxt(k,453) + rxt(k,466)) * y(k,65) + mat(k,565) = rxt(k,287)*y(k,176) + mat(k,1601) = rxt(k,287)*y(k,175) + mat(k,639) = -(rxt(k,222)*y(k,72) + rxt(k,223)*y(k,202) + rxt(k,224)*y(k,84)) + mat(k,1023) = -rxt(k,222)*y(k,68) + mat(k,2029) = -rxt(k,223)*y(k,68) + mat(k,1258) = -rxt(k,224)*y(k,68) + mat(k,71) = 2.000_r8*rxt(k,225)*y(k,189) + mat(k,104) = rxt(k,226)*y(k,189) + mat(k,1337) = 2.000_r8*rxt(k,225)*y(k,62) + rxt(k,226)*y(k,63) + mat(k,864) = -(rxt(k,291)*y(k,190)) + mat(k,1471) = -rxt(k,291)*y(k,69) + mat(k,474) = .700_r8*rxt(k,366)*y(k,190) + mat(k,436) = .500_r8*rxt(k,367)*y(k,190) + mat(k,285) = rxt(k,378)*y(k,190) + mat(k,1772) = .050_r8*rxt(k,364)*y(k,179) + .530_r8*rxt(k,326)*y(k,182) & + + .225_r8*rxt(k,442)*y(k,194) + .250_r8*rxt(k,383)*y(k,198) + mat(k,1986) = .050_r8*rxt(k,365)*y(k,179) + .530_r8*rxt(k,325)*y(k,182) & + + .250_r8*rxt(k,384)*y(k,198) + mat(k,1220) = .530_r8*rxt(k,322)*y(k,182) + .250_r8*rxt(k,380)*y(k,198) + mat(k,1298) = .260_r8*rxt(k,323)*y(k,182) + .125_r8*rxt(k,440)*y(k,194) & + + .100_r8*rxt(k,381)*y(k,198) + mat(k,1105) = .050_r8*rxt(k,364)*y(k,116) + .050_r8*rxt(k,365)*y(k,118) + mat(k,1151) = .530_r8*rxt(k,326)*y(k,116) + .530_r8*rxt(k,325)*y(k,118) & + + .530_r8*rxt(k,322)*y(k,170) + .260_r8*rxt(k,323)*y(k,171) + mat(k,1471) = mat(k,1471) + .700_r8*rxt(k,366)*y(k,94) + .500_r8*rxt(k,367) & + *y(k,95) + rxt(k,378)*y(k,110) + mat(k,957) = .225_r8*rxt(k,442)*y(k,116) + .125_r8*rxt(k,440)*y(k,171) + mat(k,1008) = .250_r8*rxt(k,383)*y(k,116) + .250_r8*rxt(k,384)*y(k,118) & + + .250_r8*rxt(k,380)*y(k,170) + .100_r8*rxt(k,381)*y(k,171) + mat(k,736) = -(rxt(k,292)*y(k,190)) + mat(k,1462) = -rxt(k,292)*y(k,70) + mat(k,203) = .650_r8*rxt(k,267)*y(k,190) + mat(k,863) = .200_r8*rxt(k,291)*y(k,190) + mat(k,871) = rxt(k,379)*y(k,190) + mat(k,1767) = rxt(k,390)*y(k,164) + .050_r8*rxt(k,364)*y(k,179) & + + .400_r8*rxt(k,404)*y(k,183) + .170_r8*rxt(k,407)*y(k,185) & + + .700_r8*rxt(k,410)*y(k,191) + .600_r8*rxt(k,417)*y(k,196) & + + .250_r8*rxt(k,383)*y(k,198) + .340_r8*rxt(k,423)*y(k,199) & + + .170_r8*rxt(k,426)*y(k,201) + mat(k,1979) = .050_r8*rxt(k,365)*y(k,179) + .250_r8*rxt(k,384)*y(k,198) + mat(k,377) = rxt(k,390)*y(k,116) + mat(k,1219) = .250_r8*rxt(k,380)*y(k,198) + mat(k,1295) = .100_r8*rxt(k,381)*y(k,198) + mat(k,1652) = .160_r8*rxt(k,403)*y(k,183) + .070_r8*rxt(k,406)*y(k,185) + mat(k,1103) = .050_r8*rxt(k,364)*y(k,116) + .050_r8*rxt(k,365)*y(k,118) + mat(k,575) = .400_r8*rxt(k,404)*y(k,116) + .160_r8*rxt(k,403)*y(k,176) + mat(k,740) = .170_r8*rxt(k,407)*y(k,116) + .070_r8*rxt(k,406)*y(k,176) + mat(k,1462) = mat(k,1462) + .650_r8*rxt(k,267)*y(k,22) + .200_r8*rxt(k,291) & + *y(k,69) + rxt(k,379)*y(k,111) + mat(k,347) = .700_r8*rxt(k,410)*y(k,116) + mat(k,587) = .600_r8*rxt(k,417)*y(k,116) + mat(k,1007) = .250_r8*rxt(k,383)*y(k,116) + .250_r8*rxt(k,384)*y(k,118) & + + .250_r8*rxt(k,380)*y(k,170) + .100_r8*rxt(k,381)*y(k,171) + mat(k,611) = .340_r8*rxt(k,423)*y(k,116) + mat(k,384) = .170_r8*rxt(k,426)*y(k,116) + mat(k,1273) = -((rxt(k,124) + rxt(k,125) + rxt(k,126)) * y(k,176) + rxt(k,130) & + *y(k,122)) + mat(k,1679) = -(rxt(k,124) + rxt(k,125) + rxt(k,126)) * y(k,71) + mat(k,1855) = -rxt(k,130)*y(k,71) + mat(k,1543) = rxt(k,247)*y(k,190) + mat(k,1953) = rxt(k,166)*y(k,72) + mat(k,904) = rxt(k,265)*y(k,190) + mat(k,642) = rxt(k,222)*y(k,72) + mat(k,1026) = rxt(k,166)*y(k,54) + rxt(k,222)*y(k,68) + rxt(k,122)*y(k,121) & + + rxt(k,114)*y(k,189) + rxt(k,131)*y(k,190) + mat(k,696) = rxt(k,220)*y(k,189) + mat(k,1919) = rxt(k,197)*y(k,189) + mat(k,278) = rxt(k,152)*y(k,190) + mat(k,1573) = rxt(k,122)*y(k,72) + rxt(k,134)*y(k,190) + mat(k,254) = rxt(k,455)*y(k,190) + mat(k,392) = rxt(k,460)*y(k,190) + mat(k,1085) = rxt(k,465)*y(k,190) + mat(k,1342) = rxt(k,114)*y(k,72) + rxt(k,220)*y(k,76) + rxt(k,197)*y(k,80) + mat(k,1496) = rxt(k,247)*y(k,40) + rxt(k,265)*y(k,60) + rxt(k,131)*y(k,72) & + + rxt(k,152)*y(k,107) + rxt(k,134)*y(k,121) + rxt(k,455) & + *y(k,125) + rxt(k,460)*y(k,134) + rxt(k,465)*y(k,136) + mat(k,1024) = -(rxt(k,114)*y(k,189) + rxt(k,122)*y(k,121) + rxt(k,131) & + *y(k,190) + rxt(k,166)*y(k,54) + rxt(k,222)*y(k,68)) + mat(k,1339) = -rxt(k,114)*y(k,72) + mat(k,1569) = -rxt(k,122)*y(k,72) + mat(k,1483) = -rxt(k,131)*y(k,72) + mat(k,1949) = -rxt(k,166)*y(k,72) + mat(k,640) = -rxt(k,222)*y(k,72) + mat(k,1271) = rxt(k,124)*y(k,176) + mat(k,1667) = rxt(k,124)*y(k,71) + mat(k,466) = -(rxt(k,123)*y(k,121) + rxt(k,132)*y(k,190) + rxt(k,167)*y(k,54)) + mat(k,1562) = -rxt(k,123)*y(k,74) + mat(k,1434) = -rxt(k,132)*y(k,74) + mat(k,1939) = -rxt(k,167)*y(k,74) + mat(k,1630) = 2.000_r8*rxt(k,138)*y(k,176) + mat(k,1434) = mat(k,1434) + 2.000_r8*rxt(k,137)*y(k,190) + mat(k,174) = rxt(k,468)*y(k,202) + mat(k,2026) = rxt(k,468)*y(k,138) + mat(k,694) = -(rxt(k,213)*y(k,121) + rxt(k,214)*y(k,190) + (rxt(k,219) & + + rxt(k,220)) * y(k,189)) + mat(k,1565) = -rxt(k,213)*y(k,76) + mat(k,1458) = -rxt(k,214)*y(k,76) + mat(k,1338) = -(rxt(k,219) + rxt(k,220)) * y(k,76) + mat(k,1245) = rxt(k,200)*y(k,40) + rxt(k,201)*y(k,176) + mat(k,1538) = rxt(k,200)*y(k,15) + mat(k,1650) = rxt(k,201)*y(k,15) + mat(k,1931) = -(rxt(k,184)*y(k,121) + rxt(k,185)*y(k,190) + (rxt(k,196) & + + rxt(k,197)) * y(k,189) + (rxt(k,513) + rxt(k,519) + rxt(k,524) & + ) * y(k,87) + (rxt(k,518) + rxt(k,523) + rxt(k,528)) * y(k,58) & + + (rxt(k,520) + rxt(k,525)) * y(k,86)) + mat(k,1585) = -rxt(k,184)*y(k,80) + mat(k,1508) = -rxt(k,185)*y(k,80) + mat(k,1354) = -(rxt(k,196) + rxt(k,197)) * y(k,80) + mat(k,680) = -(rxt(k,513) + rxt(k,519) + rxt(k,524)) * y(k,80) + mat(k,832) = -(rxt(k,518) + rxt(k,523) + rxt(k,528)) * y(k,80) + mat(k,653) = -(rxt(k,520) + rxt(k,525)) * y(k,80) + mat(k,198) = rxt(k,276)*y(k,54) + mat(k,1555) = rxt(k,164)*y(k,54) + mat(k,1965) = rxt(k,276)*y(k,26) + rxt(k,164)*y(k,40) + rxt(k,166)*y(k,72) & + + rxt(k,167)*y(k,74) + rxt(k,186)*y(k,87) + rxt(k,168)*y(k,176) + mat(k,1717) = rxt(k,183)*y(k,190) + mat(k,1031) = rxt(k,166)*y(k,54) + mat(k,470) = rxt(k,167)*y(k,54) + mat(k,680) = mat(k,680) + rxt(k,186)*y(k,54) + mat(k,1691) = rxt(k,168)*y(k,54) + mat(k,1508) = mat(k,1508) + rxt(k,183)*y(k,57) + mat(k,107) = -(rxt(k,256)*y(k,190) + rxt(k,264)*y(k,189)) + mat(k,1381) = -rxt(k,256)*y(k,81) + mat(k,1336) = -rxt(k,264)*y(k,81) + mat(k,671) = -(rxt(k,257)*y(k,190)) + mat(k,1455) = -rxt(k,257)*y(k,82) + mat(k,757) = .050_r8*rxt(k,430)*y(k,122) + mat(k,202) = .350_r8*rxt(k,267)*y(k,190) + mat(k,444) = .370_r8*rxt(k,269)*y(k,122) + mat(k,838) = .120_r8*rxt(k,298)*y(k,122) + mat(k,705) = .110_r8*rxt(k,375)*y(k,122) + mat(k,1058) = .330_r8*rxt(k,328)*y(k,122) + mat(k,784) = .050_r8*rxt(k,433)*y(k,122) + mat(k,1129) = .120_r8*rxt(k,342)*y(k,122) + mat(k,1764) = rxt(k,260)*y(k,177) + mat(k,1824) = .050_r8*rxt(k,430)*y(k,4) + .370_r8*rxt(k,269)*y(k,23) & + + .120_r8*rxt(k,298)*y(k,27) + .110_r8*rxt(k,375)*y(k,93) & + + .330_r8*rxt(k,328)*y(k,100) + .050_r8*rxt(k,433)*y(k,105) & + + .120_r8*rxt(k,342)*y(k,106) + mat(k,1647) = rxt(k,258)*y(k,177) + mat(k,340) = rxt(k,260)*y(k,116) + rxt(k,258)*y(k,176) + mat(k,1455) = mat(k,1455) + .350_r8*rxt(k,267)*y(k,22) + mat(k,638) = rxt(k,222)*y(k,72) + rxt(k,224)*y(k,84) + rxt(k,223)*y(k,202) + mat(k,1022) = rxt(k,222)*y(k,68) + mat(k,1257) = rxt(k,224)*y(k,68) + mat(k,2027) = rxt(k,223)*y(k,68) + mat(k,1260) = -(rxt(k,161)*y(k,190) + rxt(k,224)*y(k,68)) + mat(k,1495) = -rxt(k,161)*y(k,84) + mat(k,641) = -rxt(k,224)*y(k,84) + mat(k,1542) = rxt(k,245)*y(k,118) + mat(k,897) = rxt(k,278)*y(k,118) + mat(k,1074) = rxt(k,304)*y(k,118) + mat(k,827) = (rxt(k,518)+rxt(k,523)+rxt(k,528))*y(k,80) + mat(k,185) = rxt(k,452)*y(k,118) + mat(k,1918) = (rxt(k,518)+rxt(k,523)+rxt(k,528))*y(k,58) + mat(k,1895) = rxt(k,160)*y(k,190) + mat(k,2009) = rxt(k,245)*y(k,40) + rxt(k,278)*y(k,43) + rxt(k,304)*y(k,47) & + + rxt(k,452)*y(k,65) + mat(k,1495) = mat(k,1495) + rxt(k,160)*y(k,117) + mat(k,265) = -(rxt(k,139)*y(k,190)) + mat(k,1406) = -rxt(k,139)*y(k,85) + mat(k,1873) = rxt(k,158)*y(k,176) + mat(k,1610) = rxt(k,158)*y(k,117) + mat(k,648) = -(rxt(k,215)*y(k,121) + (rxt(k,520) + rxt(k,525)) * y(k,80)) + mat(k,1563) = -rxt(k,215)*y(k,86) + mat(k,1914) = -(rxt(k,520) + rxt(k,525)) * y(k,86) + mat(k,1515) = rxt(k,207)*y(k,176) + mat(k,1645) = rxt(k,207)*y(k,17) + mat(k,676) = -(rxt(k,186)*y(k,54) + rxt(k,187)*y(k,121) + rxt(k,188)*y(k,190) & + + (rxt(k,513) + rxt(k,519) + rxt(k,524)) * y(k,80)) + mat(k,1942) = -rxt(k,186)*y(k,87) + mat(k,1564) = -rxt(k,187)*y(k,87) + mat(k,1456) = -rxt(k,188)*y(k,87) + mat(k,1915) = -(rxt(k,513) + rxt(k,519) + rxt(k,524)) * y(k,87) + mat(k,1699) = rxt(k,175)*y(k,176) + mat(k,825) = rxt(k,180)*y(k,190) + mat(k,1648) = rxt(k,175)*y(k,57) + mat(k,1456) = mat(k,1456) + rxt(k,180)*y(k,58) + mat(k,912) = -(rxt(k,321)*y(k,190)) + mat(k,1476) = -rxt(k,321)*y(k,88) + mat(k,475) = .300_r8*rxt(k,366)*y(k,190) + mat(k,437) = .500_r8*rxt(k,367)*y(k,190) + mat(k,1777) = rxt(k,320)*y(k,173) + rxt(k,327)*y(k,182) + mat(k,453) = rxt(k,320)*y(k,116) + mat(k,1153) = rxt(k,327)*y(k,116) + mat(k,1476) = mat(k,1476) + .300_r8*rxt(k,366)*y(k,94) + .500_r8*rxt(k,367) & + *y(k,95) + mat(k,149) = -(rxt(k,352)*y(k,190)) + mat(k,1388) = -rxt(k,352)*y(k,89) + mat(k,925) = -(rxt(k,306)*y(k,190)) + mat(k,1477) = -rxt(k,306)*y(k,90) + mat(k,476) = .700_r8*rxt(k,366)*y(k,190) + mat(k,438) = .500_r8*rxt(k,367)*y(k,190) + mat(k,459) = .500_r8*rxt(k,341)*y(k,190) + mat(k,1778) = .050_r8*rxt(k,364)*y(k,179) + .220_r8*rxt(k,326)*y(k,182) & + + .250_r8*rxt(k,383)*y(k,198) + mat(k,1992) = .050_r8*rxt(k,365)*y(k,179) + .220_r8*rxt(k,325)*y(k,182) & + + .250_r8*rxt(k,384)*y(k,198) + mat(k,425) = .500_r8*rxt(k,310)*y(k,190) + mat(k,1223) = .220_r8*rxt(k,322)*y(k,182) + .250_r8*rxt(k,380)*y(k,198) + mat(k,1303) = .230_r8*rxt(k,323)*y(k,182) + .200_r8*rxt(k,311)*y(k,193) & + + .100_r8*rxt(k,381)*y(k,198) + mat(k,1108) = .050_r8*rxt(k,364)*y(k,116) + .050_r8*rxt(k,365)*y(k,118) + mat(k,1154) = .220_r8*rxt(k,326)*y(k,116) + .220_r8*rxt(k,325)*y(k,118) & + + .220_r8*rxt(k,322)*y(k,170) + .230_r8*rxt(k,323)*y(k,171) + mat(k,1477) = mat(k,1477) + .700_r8*rxt(k,366)*y(k,94) + .500_r8*rxt(k,367) & + *y(k,95) + .500_r8*rxt(k,341)*y(k,104) + .500_r8*rxt(k,310) & + *y(k,132) + mat(k,994) = .200_r8*rxt(k,311)*y(k,171) + mat(k,1010) = .250_r8*rxt(k,383)*y(k,116) + .250_r8*rxt(k,384)*y(k,118) & + + .250_r8*rxt(k,380)*y(k,170) + .100_r8*rxt(k,381)*y(k,171) + end do + end subroutine nlnmat03 + subroutine nlnmat04( avec_len, mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + do k = 1,avec_len + mat(k,210) = -(rxt(k,353)*y(k,190)) + mat(k,1398) = -rxt(k,353)*y(k,91) + mat(k,1737) = .870_r8*rxt(k,364)*y(k,179) + mat(k,1973) = .950_r8*rxt(k,365)*y(k,179) + mat(k,1215) = rxt(k,360)*y(k,179) + mat(k,1286) = .750_r8*rxt(k,361)*y(k,179) + mat(k,1097) = .870_r8*rxt(k,364)*y(k,116) + .950_r8*rxt(k,365)*y(k,118) & + + rxt(k,360)*y(k,170) + .750_r8*rxt(k,361)*y(k,171) + mat(k,79) = -(rxt(k,354)*y(k,190)) + mat(k,1376) = -rxt(k,354)*y(k,92) + mat(k,595) = .600_r8*rxt(k,377)*y(k,190) + mat(k,1376) = mat(k,1376) + .600_r8*rxt(k,377)*y(k,98) + mat(k,706) = -(rxt(k,368)*y(k,118) + rxt(k,375)*y(k,122) + rxt(k,376) & + *y(k,190)) + mat(k,1976) = -rxt(k,368)*y(k,93) + mat(k,1825) = -rxt(k,375)*y(k,93) + mat(k,1459) = -rxt(k,376)*y(k,93) + mat(k,473) = -(rxt(k,366)*y(k,190)) + mat(k,1435) = -rxt(k,366)*y(k,94) + mat(k,1751) = .080_r8*rxt(k,358)*y(k,178) + mat(k,1170) = .080_r8*rxt(k,358)*y(k,116) + mat(k,434) = -(rxt(k,367)*y(k,190)) + mat(k,1430) = -rxt(k,367)*y(k,95) + mat(k,1749) = .080_r8*rxt(k,364)*y(k,179) + mat(k,1098) = .080_r8*rxt(k,364)*y(k,116) + mat(k,1044) = -(rxt(k,369)*y(k,170) + rxt(k,370)*y(k,171) + rxt(k,371) & + *y(k,176) + rxt(k,372)*y(k,116) + rxt(k,373)*y(k,118)) + mat(k,1225) = -rxt(k,369)*y(k,96) + mat(k,1309) = -rxt(k,370)*y(k,96) + mat(k,1668) = -rxt(k,371)*y(k,96) + mat(k,1784) = -rxt(k,372)*y(k,96) + mat(k,1998) = -rxt(k,373)*y(k,96) + mat(k,709) = rxt(k,368)*y(k,118) + mat(k,1998) = mat(k,1998) + rxt(k,368)*y(k,93) + mat(k,271) = -(rxt(k,374)*y(k,190)) + mat(k,1407) = -rxt(k,374)*y(k,97) + mat(k,1035) = rxt(k,371)*y(k,176) + mat(k,1611) = rxt(k,371)*y(k,96) + mat(k,596) = -(rxt(k,377)*y(k,190)) + mat(k,1448) = -rxt(k,377)*y(k,98) + mat(k,1641) = rxt(k,357)*y(k,178) + rxt(k,362)*y(k,179) + mat(k,1171) = rxt(k,357)*y(k,176) + mat(k,1100) = rxt(k,362)*y(k,176) + mat(k,38) = -(rxt(k,499)*y(k,190)) + mat(k,1368) = -rxt(k,499)*y(k,99) + mat(k,1060) = -(rxt(k,328)*y(k,122) + rxt(k,329)*y(k,190)) + mat(k,1844) = -rxt(k,328)*y(k,100) + mat(k,1485) = -rxt(k,329)*y(k,100) + mat(k,710) = .300_r8*rxt(k,375)*y(k,122) + mat(k,1785) = .360_r8*rxt(k,358)*y(k,178) + mat(k,1999) = .400_r8*rxt(k,359)*y(k,178) + mat(k,1844) = mat(k,1844) + .300_r8*rxt(k,375)*y(k,93) + mat(k,1226) = .390_r8*rxt(k,355)*y(k,178) + mat(k,1310) = .310_r8*rxt(k,356)*y(k,178) + mat(k,1179) = .360_r8*rxt(k,358)*y(k,116) + .400_r8*rxt(k,359)*y(k,118) & + + .390_r8*rxt(k,355)*y(k,170) + .310_r8*rxt(k,356)*y(k,171) + mat(k,218) = -(rxt(k,330)*y(k,190)) + mat(k,1400) = -rxt(k,330)*y(k,101) + mat(k,1606) = rxt(k,324)*y(k,182) + mat(k,1149) = rxt(k,324)*y(k,176) + mat(k,396) = -(rxt(k,339)*y(k,190)) + mat(k,1425) = -rxt(k,339)*y(k,102) + mat(k,1747) = .800_r8*rxt(k,348)*y(k,162) + mat(k,803) = .800_r8*rxt(k,348)*y(k,116) + mat(k,223) = -(rxt(k,340)*y(k,190)) + mat(k,1401) = -rxt(k,340)*y(k,103) + mat(k,1607) = .800_r8*rxt(k,337)*y(k,186) + mat(k,542) = .800_r8*rxt(k,337)*y(k,176) + mat(k,458) = -(rxt(k,341)*y(k,190)) + mat(k,1433) = -rxt(k,341)*y(k,104) + mat(k,1879) = rxt(k,344)*y(k,184) + mat(k,1199) = rxt(k,344)*y(k,117) + mat(k,786) = -(rxt(k,432)*y(k,118) + rxt(k,433)*y(k,122) + rxt(k,434) & + *y(k,190)) + mat(k,1981) = -rxt(k,432)*y(k,105) + mat(k,1829) = -rxt(k,433)*y(k,105) + mat(k,1465) = -rxt(k,434)*y(k,105) + mat(k,1135) = -(rxt(k,342)*y(k,122) + rxt(k,343)*y(k,190)) + mat(k,1848) = -rxt(k,342)*y(k,106) + mat(k,1489) = -rxt(k,343)*y(k,106) + mat(k,712) = .200_r8*rxt(k,375)*y(k,122) + mat(k,1788) = .560_r8*rxt(k,358)*y(k,178) + mat(k,2003) = .600_r8*rxt(k,359)*y(k,178) + mat(k,1848) = mat(k,1848) + .200_r8*rxt(k,375)*y(k,93) + mat(k,1229) = .610_r8*rxt(k,355)*y(k,178) + mat(k,1313) = .440_r8*rxt(k,356)*y(k,178) + mat(k,1181) = .560_r8*rxt(k,358)*y(k,116) + .600_r8*rxt(k,359)*y(k,118) & + + .610_r8*rxt(k,355)*y(k,170) + .440_r8*rxt(k,356)*y(k,171) + mat(k,277) = -(rxt(k,140)*y(k,116) + (rxt(k,141) + rxt(k,142) + rxt(k,143) & + ) * y(k,117) + rxt(k,152)*y(k,190)) + mat(k,1739) = -rxt(k,140)*y(k,107) + mat(k,1874) = -(rxt(k,141) + rxt(k,142) + rxt(k,143)) * y(k,107) + mat(k,1408) = -rxt(k,152)*y(k,107) + mat(k,1872) = rxt(k,159)*y(k,118) + mat(k,1972) = rxt(k,159)*y(k,117) + mat(k,283) = -(rxt(k,378)*y(k,190)) + mat(k,1409) = -rxt(k,378)*y(k,110) + mat(k,1036) = .200_r8*rxt(k,370)*y(k,171) + mat(k,1287) = .200_r8*rxt(k,370)*y(k,96) + mat(k,873) = -(rxt(k,379)*y(k,190)) + mat(k,1472) = -rxt(k,379)*y(k,111) + mat(k,1041) = rxt(k,372)*y(k,116) + rxt(k,373)*y(k,118) + rxt(k,369)*y(k,170) & + + .800_r8*rxt(k,370)*y(k,171) + mat(k,1773) = rxt(k,372)*y(k,96) + mat(k,1987) = rxt(k,373)*y(k,96) + mat(k,1221) = rxt(k,369)*y(k,96) + mat(k,1299) = .800_r8*rxt(k,370)*y(k,96) + mat(k,63) = -(rxt(k,469)*y(k,190)) + mat(k,1373) = -rxt(k,469)*y(k,112) + mat(k,1804) = -(rxt(k,140)*y(k,107) + rxt(k,149)*y(k,118) + rxt(k,153) & + *y(k,176) + rxt(k,154)*y(k,122) + rxt(k,155)*y(k,121) + rxt(k,176) & + *y(k,57) + rxt(k,208)*y(k,17) + rxt(k,251)*y(k,171) + rxt(k,260) & + *y(k,177) + rxt(k,273)*y(k,167) + rxt(k,284)*y(k,170) + rxt(k,288) & + *y(k,175) + rxt(k,301)*y(k,168) + rxt(k,309)*y(k,192) + rxt(k,313) & + *y(k,193) + (rxt(k,319) + rxt(k,320)) * y(k,173) + (rxt(k,326) & + + rxt(k,327)) * y(k,182) + rxt(k,335)*y(k,184) + rxt(k,338) & + *y(k,186) + (rxt(k,348) + rxt(k,349)) * y(k,162) + rxt(k,358) & + *y(k,178) + rxt(k,364)*y(k,179) + rxt(k,372)*y(k,96) + rxt(k,383) & + *y(k,198) + rxt(k,387)*y(k,161) + rxt(k,390)*y(k,164) + rxt(k,395) & + *y(k,166) + rxt(k,397)*y(k,169) + rxt(k,401)*y(k,172) + rxt(k,404) & + *y(k,183) + rxt(k,407)*y(k,185) + rxt(k,410)*y(k,191) + rxt(k,417) & + *y(k,196) + rxt(k,423)*y(k,199) + rxt(k,426)*y(k,201) + rxt(k,437) & + *y(k,188) + rxt(k,442)*y(k,194) + rxt(k,447)*y(k,195)) + mat(k,281) = -rxt(k,140)*y(k,116) + mat(k,2019) = -rxt(k,149)*y(k,116) + mat(k,1688) = -rxt(k,153)*y(k,116) + mat(k,1864) = -rxt(k,154)*y(k,116) + mat(k,1582) = -rxt(k,155)*y(k,116) + mat(k,1714) = -rxt(k,176)*y(k,116) + mat(k,1529) = -rxt(k,208)*y(k,116) + mat(k,1327) = -rxt(k,251)*y(k,116) + mat(k,343) = -rxt(k,260)*y(k,116) + mat(k,692) = -rxt(k,273)*y(k,116) + mat(k,1240) = -rxt(k,284)*y(k,116) + mat(k,572) = -rxt(k,288)*y(k,116) + mat(k,668) = -rxt(k,301)*y(k,116) + mat(k,635) = -rxt(k,309)*y(k,116) + mat(k,1002) = -rxt(k,313)*y(k,116) + mat(k,456) = -(rxt(k,319) + rxt(k,320)) * y(k,116) + mat(k,1166) = -(rxt(k,326) + rxt(k,327)) * y(k,116) + mat(k,1210) = -rxt(k,335)*y(k,116) + mat(k,548) = -rxt(k,338)*y(k,116) + mat(k,816) = -(rxt(k,348) + rxt(k,349)) * y(k,116) + mat(k,1192) = -rxt(k,358)*y(k,116) + mat(k,1124) = -rxt(k,364)*y(k,116) + mat(k,1055) = -rxt(k,372)*y(k,116) + mat(k,1019) = -rxt(k,383)*y(k,116) + mat(k,412) = -rxt(k,387)*y(k,116) + mat(k,380) = -rxt(k,390)*y(k,116) + mat(k,337) = -rxt(k,395)*y(k,116) + mat(k,517) = -rxt(k,397)*y(k,116) + mat(k,626) = -rxt(k,401)*y(k,116) + mat(k,578) = -rxt(k,404)*y(k,116) + mat(k,747) = -rxt(k,407)*y(k,116) + mat(k,350) = -rxt(k,410)*y(k,116) + mat(k,593) = -rxt(k,417)*y(k,116) + mat(k,618) = -rxt(k,423)*y(k,116) + mat(k,388) = -rxt(k,426)*y(k,116) + mat(k,988) = -rxt(k,437)*y(k,116) + mat(k,969) = -rxt(k,442)*y(k,116) + mat(k,949) = -rxt(k,447)*y(k,116) + mat(k,281) = mat(k,281) + 2.000_r8*rxt(k,142)*y(k,117) + rxt(k,152)*y(k,190) + mat(k,1905) = 2.000_r8*rxt(k,142)*y(k,107) + rxt(k,145)*y(k,121) + rxt(k,461) & + *y(k,136) + mat(k,1582) = mat(k,1582) + rxt(k,145)*y(k,117) + mat(k,1091) = rxt(k,461)*y(k,117) + mat(k,1505) = rxt(k,152)*y(k,107) + mat(k,1907) = -((rxt(k,141) + rxt(k,142) + rxt(k,143)) * y(k,107) + (rxt(k,145) & + + rxt(k,147)) * y(k,121) + rxt(k,146)*y(k,122) + rxt(k,158) & + *y(k,176) + rxt(k,159)*y(k,118) + rxt(k,160)*y(k,190) + rxt(k,178) & + *y(k,57) + rxt(k,209)*y(k,17) + rxt(k,295)*y(k,170) + rxt(k,344) & + *y(k,184) + rxt(k,402)*y(k,172) + rxt(k,405)*y(k,183) + rxt(k,408) & + *y(k,185) + rxt(k,412)*y(k,129) + rxt(k,415)*y(k,161) + rxt(k,461) & + *y(k,136)) + mat(k,282) = -(rxt(k,141) + rxt(k,142) + rxt(k,143)) * y(k,117) + mat(k,1584) = -(rxt(k,145) + rxt(k,147)) * y(k,117) + mat(k,1866) = -rxt(k,146)*y(k,117) + mat(k,1690) = -rxt(k,158)*y(k,117) + mat(k,2021) = -rxt(k,159)*y(k,117) + mat(k,1507) = -rxt(k,160)*y(k,117) + mat(k,1716) = -rxt(k,178)*y(k,117) + mat(k,1531) = -rxt(k,209)*y(k,117) + mat(k,1242) = -rxt(k,295)*y(k,117) + mat(k,1212) = -rxt(k,344)*y(k,117) + mat(k,627) = -rxt(k,402)*y(k,117) + mat(k,579) = -rxt(k,405)*y(k,117) + mat(k,748) = -rxt(k,408)*y(k,117) + mat(k,365) = -rxt(k,412)*y(k,117) + mat(k,413) = -rxt(k,415)*y(k,117) + mat(k,1093) = -rxt(k,461)*y(k,117) + mat(k,541) = rxt(k,346)*y(k,190) + mat(k,263) = rxt(k,317)*y(k,118) + mat(k,1531) = mat(k,1531) + rxt(k,208)*y(k,116) + mat(k,1716) = mat(k,1716) + rxt(k,176)*y(k,116) + mat(k,268) = rxt(k,139)*y(k,190) + mat(k,481) = .700_r8*rxt(k,366)*y(k,190) + mat(k,1056) = rxt(k,372)*y(k,116) + rxt(k,373)*y(k,118) + mat(k,1806) = rxt(k,208)*y(k,17) + rxt(k,176)*y(k,57) + rxt(k,372)*y(k,96) & + + 2.000_r8*rxt(k,149)*y(k,118) + rxt(k,155)*y(k,121) & + + rxt(k,154)*y(k,122) + rxt(k,387)*y(k,161) + rxt(k,348) & + *y(k,162) + rxt(k,390)*y(k,164) + rxt(k,395)*y(k,166) & + + rxt(k,273)*y(k,167) + rxt(k,301)*y(k,168) + rxt(k,397) & + *y(k,169) + rxt(k,284)*y(k,170) + rxt(k,251)*y(k,171) & + + rxt(k,401)*y(k,172) + rxt(k,319)*y(k,173) + rxt(k,288) & + *y(k,175) + rxt(k,153)*y(k,176) + rxt(k,260)*y(k,177) & + + .920_r8*rxt(k,358)*y(k,178) + .920_r8*rxt(k,364)*y(k,179) & + + rxt(k,326)*y(k,182) + rxt(k,404)*y(k,183) + rxt(k,335) & + *y(k,184) + rxt(k,407)*y(k,185) + rxt(k,338)*y(k,186) & + + 1.600_r8*rxt(k,437)*y(k,188) + rxt(k,410)*y(k,191) & + + rxt(k,309)*y(k,192) + rxt(k,313)*y(k,193) + .900_r8*rxt(k,442) & + *y(k,194) + .800_r8*rxt(k,447)*y(k,195) + rxt(k,417)*y(k,196) & + + rxt(k,383)*y(k,198) + rxt(k,423)*y(k,199) + rxt(k,426) & + *y(k,201) + mat(k,2021) = mat(k,2021) + rxt(k,317)*y(k,14) + rxt(k,373)*y(k,96) & + + 2.000_r8*rxt(k,149)*y(k,116) + rxt(k,150)*y(k,121) & + + rxt(k,148)*y(k,176) + rxt(k,359)*y(k,178) + rxt(k,365) & + *y(k,179) + rxt(k,325)*y(k,182) + rxt(k,336)*y(k,184) & + + 2.000_r8*rxt(k,438)*y(k,188) + rxt(k,151)*y(k,190) & + + rxt(k,384)*y(k,198) + mat(k,734) = rxt(k,307)*y(k,190) + mat(k,1584) = mat(k,1584) + rxt(k,155)*y(k,116) + rxt(k,150)*y(k,118) + mat(k,1866) = mat(k,1866) + rxt(k,154)*y(k,116) + mat(k,511) = rxt(k,444)*y(k,190) + mat(k,413) = mat(k,413) + rxt(k,387)*y(k,116) + mat(k,817) = rxt(k,348)*y(k,116) + mat(k,381) = rxt(k,390)*y(k,116) + mat(k,338) = rxt(k,395)*y(k,116) + mat(k,693) = rxt(k,273)*y(k,116) + mat(k,669) = rxt(k,301)*y(k,116) + mat(k,519) = rxt(k,397)*y(k,116) + mat(k,1242) = mat(k,1242) + rxt(k,284)*y(k,116) + mat(k,1329) = rxt(k,251)*y(k,116) + .500_r8*rxt(k,435)*y(k,188) + mat(k,627) = mat(k,627) + rxt(k,401)*y(k,116) + mat(k,457) = rxt(k,319)*y(k,116) + mat(k,573) = rxt(k,288)*y(k,116) + mat(k,1690) = mat(k,1690) + rxt(k,153)*y(k,116) + rxt(k,148)*y(k,118) + mat(k,344) = rxt(k,260)*y(k,116) + mat(k,1194) = .920_r8*rxt(k,358)*y(k,116) + rxt(k,359)*y(k,118) + mat(k,1126) = .920_r8*rxt(k,364)*y(k,116) + rxt(k,365)*y(k,118) + mat(k,1167) = rxt(k,326)*y(k,116) + rxt(k,325)*y(k,118) + mat(k,579) = mat(k,579) + rxt(k,404)*y(k,116) + mat(k,1212) = mat(k,1212) + rxt(k,335)*y(k,116) + rxt(k,336)*y(k,118) + mat(k,748) = mat(k,748) + rxt(k,407)*y(k,116) + mat(k,549) = rxt(k,338)*y(k,116) + mat(k,989) = 1.600_r8*rxt(k,437)*y(k,116) + 2.000_r8*rxt(k,438)*y(k,118) & + + .500_r8*rxt(k,435)*y(k,171) + mat(k,1507) = mat(k,1507) + rxt(k,346)*y(k,1) + rxt(k,139)*y(k,85) & + + .700_r8*rxt(k,366)*y(k,94) + rxt(k,151)*y(k,118) + rxt(k,307) & + *y(k,119) + rxt(k,444)*y(k,148) + mat(k,351) = rxt(k,410)*y(k,116) + mat(k,636) = rxt(k,309)*y(k,116) + mat(k,1003) = rxt(k,313)*y(k,116) + mat(k,970) = .900_r8*rxt(k,442)*y(k,116) + mat(k,950) = .800_r8*rxt(k,447)*y(k,116) + mat(k,594) = rxt(k,417)*y(k,116) + mat(k,1020) = rxt(k,383)*y(k,116) + rxt(k,384)*y(k,118) + mat(k,619) = rxt(k,423)*y(k,116) + mat(k,389) = rxt(k,426)*y(k,116) + end do + end subroutine nlnmat04 + subroutine nlnmat05( avec_len, mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + do k = 1,avec_len + mat(k,2024) = -(rxt(k,148)*y(k,176) + rxt(k,149)*y(k,116) + rxt(k,150) & + *y(k,121) + rxt(k,151)*y(k,190) + rxt(k,159)*y(k,117) + rxt(k,245) & + *y(k,40) + rxt(k,278)*y(k,43) + rxt(k,297)*y(k,27) + rxt(k,304) & + *y(k,47) + rxt(k,317)*y(k,14) + rxt(k,325)*y(k,182) + rxt(k,336) & + *y(k,184) + rxt(k,359)*y(k,178) + rxt(k,365)*y(k,179) + rxt(k,368) & + *y(k,93) + rxt(k,373)*y(k,96) + rxt(k,384)*y(k,198) + rxt(k,429) & + *y(k,4) + rxt(k,432)*y(k,105) + rxt(k,438)*y(k,188) + rxt(k,449) & + *y(k,150) + rxt(k,452)*y(k,65)) + mat(k,1693) = -rxt(k,148)*y(k,118) + mat(k,1809) = -rxt(k,149)*y(k,118) + mat(k,1587) = -rxt(k,150)*y(k,118) + mat(k,1510) = -rxt(k,151)*y(k,118) + mat(k,1910) = -rxt(k,159)*y(k,118) + mat(k,1557) = -rxt(k,245)*y(k,118) + mat(k,901) = -rxt(k,278)*y(k,118) + mat(k,853) = -rxt(k,297)*y(k,118) + mat(k,1078) = -rxt(k,304)*y(k,118) + mat(k,264) = -rxt(k,317)*y(k,118) + mat(k,1168) = -rxt(k,325)*y(k,118) + mat(k,1213) = -rxt(k,336)*y(k,118) + mat(k,1195) = -rxt(k,359)*y(k,118) + mat(k,1127) = -rxt(k,365)*y(k,118) + mat(k,720) = -rxt(k,368)*y(k,118) + mat(k,1057) = -rxt(k,373)*y(k,118) + mat(k,1021) = -rxt(k,384)*y(k,118) + mat(k,774) = -rxt(k,429)*y(k,118) + mat(k,801) = -rxt(k,432)*y(k,118) + mat(k,990) = -rxt(k,438)*y(k,118) + mat(k,862) = -rxt(k,449)*y(k,118) + mat(k,188) = -rxt(k,452)*y(k,118) + mat(k,421) = rxt(k,210)*y(k,121) + mat(k,1967) = rxt(k,177)*y(k,58) + mat(k,834) = rxt(k,177)*y(k,54) + rxt(k,179)*y(k,121) + rxt(k,180)*y(k,190) + mat(k,645) = rxt(k,224)*y(k,84) + mat(k,1269) = rxt(k,224)*y(k,68) + rxt(k,161)*y(k,190) + mat(k,465) = .500_r8*rxt(k,341)*y(k,190) + mat(k,1910) = mat(k,1910) + rxt(k,147)*y(k,121) + rxt(k,146)*y(k,122) + mat(k,1587) = mat(k,1587) + rxt(k,210)*y(k,18) + rxt(k,179)*y(k,58) & + + rxt(k,147)*y(k,117) + mat(k,1869) = rxt(k,146)*y(k,117) + mat(k,361) = rxt(k,293)*y(k,190) + mat(k,1510) = mat(k,1510) + rxt(k,180)*y(k,58) + rxt(k,161)*y(k,84) & + + .500_r8*rxt(k,341)*y(k,104) + rxt(k,293)*y(k,127) + mat(k,729) = -(rxt(k,307)*y(k,190)) + mat(k,1461) = -rxt(k,307)*y(k,119) + mat(k,839) = rxt(k,297)*y(k,118) + mat(k,435) = .500_r8*rxt(k,367)*y(k,190) + mat(k,273) = rxt(k,374)*y(k,190) + mat(k,284) = rxt(k,378)*y(k,190) + mat(k,870) = rxt(k,379)*y(k,190) + mat(k,1978) = rxt(k,297)*y(k,27) + mat(k,1461) = mat(k,1461) + .500_r8*rxt(k,367)*y(k,95) + rxt(k,374)*y(k,97) & + + rxt(k,378)*y(k,110) + rxt(k,379)*y(k,111) + mat(k,289) = -(rxt(k,439)*y(k,190)) + mat(k,1410) = -rxt(k,439)*y(k,120) + mat(k,1612) = rxt(k,436)*y(k,188) + mat(k,972) = rxt(k,436)*y(k,176) + mat(k,1579) = -(rxt(k,119)*y(k,122) + 4._r8*rxt(k,120)*y(k,121) + rxt(k,122) & + *y(k,72) + rxt(k,123)*y(k,74) + rxt(k,128)*y(k,176) + rxt(k,134) & + *y(k,190) + (rxt(k,145) + rxt(k,147)) * y(k,117) + rxt(k,150) & + *y(k,118) + rxt(k,155)*y(k,116) + rxt(k,179)*y(k,58) + rxt(k,181) & + *y(k,57) + rxt(k,184)*y(k,80) + rxt(k,187)*y(k,87) + rxt(k,210) & + *y(k,18) + rxt(k,211)*y(k,17) + rxt(k,213)*y(k,76) + rxt(k,215) & + *y(k,86) + rxt(k,246)*y(k,40) + rxt(k,454)*y(k,125)) + mat(k,1861) = -rxt(k,119)*y(k,121) + mat(k,1030) = -rxt(k,122)*y(k,121) + mat(k,468) = -rxt(k,123)*y(k,121) + mat(k,1685) = -rxt(k,128)*y(k,121) + mat(k,1502) = -rxt(k,134)*y(k,121) + mat(k,1902) = -(rxt(k,145) + rxt(k,147)) * y(k,121) + mat(k,2016) = -rxt(k,150)*y(k,121) + mat(k,1801) = -rxt(k,155)*y(k,121) + mat(k,829) = -rxt(k,179)*y(k,121) + mat(k,1711) = -rxt(k,181)*y(k,121) + mat(k,1925) = -rxt(k,184)*y(k,121) + mat(k,678) = -rxt(k,187)*y(k,121) + mat(k,419) = -rxt(k,210)*y(k,121) + mat(k,1526) = -rxt(k,211)*y(k,121) + mat(k,700) = -rxt(k,213)*y(k,121) + mat(k,652) = -rxt(k,215)*y(k,121) + mat(k,1549) = -rxt(k,246)*y(k,121) + mat(k,256) = -rxt(k,454)*y(k,121) + mat(k,1277) = rxt(k,126)*y(k,176) + mat(k,280) = rxt(k,140)*y(k,116) + rxt(k,141)*y(k,117) + mat(k,1801) = mat(k,1801) + rxt(k,140)*y(k,107) + mat(k,1902) = mat(k,1902) + rxt(k,141)*y(k,107) + mat(k,1685) = mat(k,1685) + rxt(k,126)*y(k,71) + mat(k,1502) = mat(k,1502) + 2.000_r8*rxt(k,136)*y(k,190) + mat(k,1865) = -(rxt(k,118)*y(k,189) + rxt(k,119)*y(k,121) + rxt(k,129) & + *y(k,176) + rxt(k,130)*y(k,71) + rxt(k,135)*y(k,190) + rxt(k,146) & + *y(k,117) + rxt(k,154)*y(k,116) + rxt(k,170)*y(k,54) + rxt(k,202) & + *y(k,15) + rxt(k,269)*y(k,23) + rxt(k,298)*y(k,27) + rxt(k,328) & + *y(k,100) + rxt(k,342)*y(k,106) + rxt(k,375)*y(k,93) + rxt(k,413) & + *y(k,129) + rxt(k,430)*y(k,4) + rxt(k,433)*y(k,105) + rxt(k,457) & + *y(k,134) + rxt(k,463)*y(k,136)) + mat(k,1352) = -rxt(k,118)*y(k,122) + mat(k,1583) = -rxt(k,119)*y(k,122) + mat(k,1689) = -rxt(k,129)*y(k,122) + mat(k,1279) = -rxt(k,130)*y(k,122) + mat(k,1506) = -rxt(k,135)*y(k,122) + mat(k,1906) = -rxt(k,146)*y(k,122) + mat(k,1805) = -rxt(k,154)*y(k,122) + mat(k,1963) = -rxt(k,170)*y(k,122) + mat(k,1255) = -rxt(k,202)*y(k,122) + mat(k,449) = -rxt(k,269)*y(k,122) + mat(k,851) = -rxt(k,298)*y(k,122) + mat(k,1069) = -rxt(k,328)*y(k,122) + mat(k,1145) = -rxt(k,342)*y(k,122) + mat(k,719) = -rxt(k,375)*y(k,122) + mat(k,364) = -rxt(k,413)*y(k,122) + mat(k,773) = -rxt(k,430)*y(k,122) + mat(k,800) = -rxt(k,433)*y(k,122) + mat(k,395) = -rxt(k,457)*y(k,122) + mat(k,1092) = -rxt(k,463)*y(k,122) + mat(k,1241) = .150_r8*rxt(k,283)*y(k,176) + mat(k,1689) = mat(k,1689) + .150_r8*rxt(k,283)*y(k,170) + .150_r8*rxt(k,333) & + *y(k,184) + mat(k,1211) = .150_r8*rxt(k,333)*y(k,176) + mat(k,228) = -(rxt(k,464)*y(k,136)) + mat(k,1080) = -rxt(k,464)*y(k,124) + mat(k,1513) = rxt(k,204)*y(k,57) + mat(k,1698) = rxt(k,204)*y(k,17) + 2.000_r8*rxt(k,174)*y(k,57) + mat(k,249) = -(rxt(k,454)*y(k,121) + rxt(k,455)*y(k,190)) + mat(k,1559) = -rxt(k,454)*y(k,125) + mat(k,1404) = -rxt(k,455)*y(k,125) + mat(k,907) = rxt(k,321)*y(k,190) + mat(k,1734) = .100_r8*rxt(k,442)*y(k,194) + mat(k,1391) = rxt(k,321)*y(k,88) + mat(k,953) = .100_r8*rxt(k,442)*y(k,116) + mat(k,355) = -(rxt(k,293)*y(k,190)) + mat(k,1419) = -rxt(k,293)*y(k,127) + mat(k,1875) = rxt(k,295)*y(k,170) + mat(k,1216) = rxt(k,295)*y(k,117) + mat(k,1871) = rxt(k,415)*y(k,161) + mat(k,407) = rxt(k,415)*y(k,117) + mat(k,362) = -(rxt(k,412)*y(k,117) + rxt(k,413)*y(k,122)) + mat(k,1876) = -rxt(k,412)*y(k,129) + mat(k,1818) = -rxt(k,413)*y(k,129) + mat(k,121) = .070_r8*rxt(k,399)*y(k,190) + mat(k,1744) = rxt(k,397)*y(k,169) + mat(k,100) = .060_r8*rxt(k,411)*y(k,190) + mat(k,142) = .070_r8*rxt(k,427)*y(k,190) + mat(k,513) = rxt(k,397)*y(k,116) + mat(k,1420) = .070_r8*rxt(k,399)*y(k,64) + .060_r8*rxt(k,411)*y(k,130) & + + .070_r8*rxt(k,427)*y(k,157) + mat(k,98) = -(rxt(k,411)*y(k,190)) + mat(k,1379) = -rxt(k,411)*y(k,130) + mat(k,90) = .530_r8*rxt(k,388)*y(k,190) + mat(k,1379) = mat(k,1379) + .530_r8*rxt(k,388)*y(k,5) + mat(k,233) = -(rxt(k,414)*y(k,190)) + mat(k,1402) = -rxt(k,414)*y(k,131) + mat(k,1608) = rxt(k,409)*y(k,191) + mat(k,345) = rxt(k,409)*y(k,176) + mat(k,422) = -(rxt(k,310)*y(k,190)) + mat(k,1428) = -rxt(k,310)*y(k,132) + mat(k,1628) = rxt(k,308)*y(k,192) + mat(k,628) = rxt(k,308)*y(k,176) + mat(k,301) = -(rxt(k,314)*y(k,190)) + mat(k,1412) = -rxt(k,314)*y(k,133) + mat(k,1614) = .850_r8*rxt(k,312)*y(k,193) + mat(k,992) = .850_r8*rxt(k,312)*y(k,176) + mat(k,390) = -(rxt(k,457)*y(k,122) + rxt(k,460)*y(k,190)) + mat(k,1819) = -rxt(k,457)*y(k,134) + mat(k,1424) = -rxt(k,460)*y(k,134) + mat(k,1083) = -(rxt(k,458)*y(k,17) + rxt(k,459)*y(k,57) + rxt(k,461)*y(k,117) & + + rxt(k,463)*y(k,122) + rxt(k,464)*y(k,124) + rxt(k,465) & + *y(k,190)) + mat(k,1517) = -rxt(k,458)*y(k,136) + mat(k,1702) = -rxt(k,459)*y(k,136) + mat(k,1891) = -rxt(k,461)*y(k,136) + mat(k,1846) = -rxt(k,463)*y(k,136) + mat(k,230) = -rxt(k,464)*y(k,136) + mat(k,1487) = -rxt(k,465)*y(k,136) + mat(k,1570) = rxt(k,454)*y(k,125) + mat(k,1846) = mat(k,1846) + rxt(k,457)*y(k,134) + mat(k,253) = rxt(k,454)*y(k,121) + mat(k,391) = rxt(k,457)*y(k,122) + rxt(k,460)*y(k,190) + mat(k,1487) = mat(k,1487) + rxt(k,460)*y(k,134) + mat(k,723) = -(rxt(k,467)*y(k,190)) + mat(k,1460) = -rxt(k,467)*y(k,137) + mat(k,1516) = rxt(k,458)*y(k,136) + mat(k,1700) = rxt(k,459)*y(k,136) + mat(k,184) = rxt(k,452)*y(k,118) + (rxt(k,453)+.500_r8*rxt(k,466))*y(k,190) + mat(k,1884) = rxt(k,461)*y(k,136) + mat(k,1977) = rxt(k,452)*y(k,65) + mat(k,1826) = rxt(k,463)*y(k,136) + mat(k,229) = rxt(k,464)*y(k,136) + mat(k,251) = rxt(k,455)*y(k,190) + mat(k,1082) = rxt(k,458)*y(k,17) + rxt(k,459)*y(k,57) + rxt(k,461)*y(k,117) & + + rxt(k,463)*y(k,122) + rxt(k,464)*y(k,124) + rxt(k,465) & + *y(k,190) + mat(k,1460) = mat(k,1460) + (rxt(k,453)+.500_r8*rxt(k,466))*y(k,65) & + + rxt(k,455)*y(k,125) + rxt(k,465)*y(k,136) + mat(k,175) = -(rxt(k,468)*y(k,202)) + mat(k,2028) = -rxt(k,468)*y(k,138) + mat(k,722) = rxt(k,467)*y(k,190) + mat(k,1394) = rxt(k,467)*y(k,137) + mat(k,749) = .2202005_r8*rxt(k,487)*y(k,122) + mat(k,776) = .0508005_r8*rxt(k,503)*y(k,122) + mat(k,1721) = .1279005_r8*rxt(k,486)*y(k,163) + .0097005_r8*rxt(k,491) & + *y(k,165) + .0003005_r8*rxt(k,494)*y(k,180) & + + .1056005_r8*rxt(k,498)*y(k,181) + .0245005_r8*rxt(k,502) & + *y(k,187) + .0154005_r8*rxt(k,508)*y(k,197) & + + .0063005_r8*rxt(k,511)*y(k,200) + mat(k,1811) = .2202005_r8*rxt(k,487)*y(k,4) + .0508005_r8*rxt(k,503)*y(k,105) + mat(k,7) = .5931005_r8*rxt(k,505)*y(k,190) + mat(k,13) = .1279005_r8*rxt(k,486)*y(k,116) + .2202005_r8*rxt(k,485)*y(k,176) + mat(k,19) = .0097005_r8*rxt(k,491)*y(k,116) + .0023005_r8*rxt(k,490)*y(k,176) + mat(k,1589) = .2202005_r8*rxt(k,485)*y(k,163) + .0023005_r8*rxt(k,490) & + *y(k,165) + .0031005_r8*rxt(k,493)*y(k,180) & + + .2381005_r8*rxt(k,497)*y(k,181) + .0508005_r8*rxt(k,501) & + *y(k,187) + .1364005_r8*rxt(k,507)*y(k,197) & + + .1677005_r8*rxt(k,510)*y(k,200) + mat(k,25) = .0003005_r8*rxt(k,494)*y(k,116) + .0031005_r8*rxt(k,493)*y(k,176) + mat(k,31) = .1056005_r8*rxt(k,498)*y(k,116) + .2381005_r8*rxt(k,497)*y(k,176) + mat(k,39) = .0245005_r8*rxt(k,502)*y(k,116) + .0508005_r8*rxt(k,501)*y(k,176) + mat(k,1358) = .5931005_r8*rxt(k,505)*y(k,145) + mat(k,45) = .0154005_r8*rxt(k,508)*y(k,116) + .1364005_r8*rxt(k,507)*y(k,176) + mat(k,51) = .0063005_r8*rxt(k,511)*y(k,116) + .1677005_r8*rxt(k,510)*y(k,176) + end do + end subroutine nlnmat05 + subroutine nlnmat06( avec_len, mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + do k = 1,avec_len + mat(k,750) = .2067005_r8*rxt(k,487)*y(k,122) + mat(k,777) = .1149005_r8*rxt(k,503)*y(k,122) + mat(k,1722) = .1792005_r8*rxt(k,486)*y(k,163) + .0034005_r8*rxt(k,491) & + *y(k,165) + .0003005_r8*rxt(k,494)*y(k,180) & + + .1026005_r8*rxt(k,498)*y(k,181) + .0082005_r8*rxt(k,502) & + *y(k,187) + .0452005_r8*rxt(k,508)*y(k,197) & + + .0237005_r8*rxt(k,511)*y(k,200) + mat(k,1812) = .2067005_r8*rxt(k,487)*y(k,4) + .1149005_r8*rxt(k,503)*y(k,105) + mat(k,8) = .1534005_r8*rxt(k,505)*y(k,190) + mat(k,14) = .1792005_r8*rxt(k,486)*y(k,116) + .2067005_r8*rxt(k,485)*y(k,176) + mat(k,20) = .0034005_r8*rxt(k,491)*y(k,116) + .0008005_r8*rxt(k,490)*y(k,176) + mat(k,1590) = .2067005_r8*rxt(k,485)*y(k,163) + .0008005_r8*rxt(k,490) & + *y(k,165) + .0035005_r8*rxt(k,493)*y(k,180) & + + .1308005_r8*rxt(k,497)*y(k,181) + .1149005_r8*rxt(k,501) & + *y(k,187) + .0101005_r8*rxt(k,507)*y(k,197) & + + .0174005_r8*rxt(k,510)*y(k,200) + mat(k,26) = .0003005_r8*rxt(k,494)*y(k,116) + .0035005_r8*rxt(k,493)*y(k,176) + mat(k,32) = .1026005_r8*rxt(k,498)*y(k,116) + .1308005_r8*rxt(k,497)*y(k,176) + mat(k,40) = .0082005_r8*rxt(k,502)*y(k,116) + .1149005_r8*rxt(k,501)*y(k,176) + mat(k,1359) = .1534005_r8*rxt(k,505)*y(k,145) + mat(k,46) = .0452005_r8*rxt(k,508)*y(k,116) + .0101005_r8*rxt(k,507)*y(k,176) + mat(k,52) = .0237005_r8*rxt(k,511)*y(k,116) + .0174005_r8*rxt(k,510)*y(k,176) + mat(k,751) = .0653005_r8*rxt(k,487)*y(k,122) + mat(k,778) = .0348005_r8*rxt(k,503)*y(k,122) + mat(k,1723) = .0676005_r8*rxt(k,486)*y(k,163) + .1579005_r8*rxt(k,491) & + *y(k,165) + .0073005_r8*rxt(k,494)*y(k,180) & + + .0521005_r8*rxt(k,498)*y(k,181) + .0772005_r8*rxt(k,502) & + *y(k,187) + .0966005_r8*rxt(k,508)*y(k,197) & + + .0025005_r8*rxt(k,511)*y(k,200) + mat(k,1813) = .0653005_r8*rxt(k,487)*y(k,4) + .0348005_r8*rxt(k,503)*y(k,105) + mat(k,9) = .0459005_r8*rxt(k,505)*y(k,190) + mat(k,15) = .0676005_r8*rxt(k,486)*y(k,116) + .0653005_r8*rxt(k,485)*y(k,176) + mat(k,21) = .1579005_r8*rxt(k,491)*y(k,116) + .0843005_r8*rxt(k,490)*y(k,176) + mat(k,1591) = .0653005_r8*rxt(k,485)*y(k,163) + .0843005_r8*rxt(k,490) & + *y(k,165) + .0003005_r8*rxt(k,493)*y(k,180) & + + .0348005_r8*rxt(k,497)*y(k,181) + .0348005_r8*rxt(k,501) & + *y(k,187) + .0763005_r8*rxt(k,507)*y(k,197) + .086_r8*rxt(k,510) & + *y(k,200) + mat(k,27) = .0073005_r8*rxt(k,494)*y(k,116) + .0003005_r8*rxt(k,493)*y(k,176) + mat(k,33) = .0521005_r8*rxt(k,498)*y(k,116) + .0348005_r8*rxt(k,497)*y(k,176) + mat(k,41) = .0772005_r8*rxt(k,502)*y(k,116) + .0348005_r8*rxt(k,501)*y(k,176) + mat(k,1360) = .0459005_r8*rxt(k,505)*y(k,145) + mat(k,47) = .0966005_r8*rxt(k,508)*y(k,116) + .0763005_r8*rxt(k,507)*y(k,176) + mat(k,53) = .0025005_r8*rxt(k,511)*y(k,116) + .086_r8*rxt(k,510)*y(k,176) + mat(k,752) = .1749305_r8*rxt(k,484)*y(k,118) + .1284005_r8*rxt(k,487) & + *y(k,122) + mat(k,702) = .0590245_r8*rxt(k,492)*y(k,118) + .0033005_r8*rxt(k,495) & + *y(k,122) + mat(k,779) = .1749305_r8*rxt(k,500)*y(k,118) + .0554005_r8*rxt(k,503) & + *y(k,122) + mat(k,1724) = .079_r8*rxt(k,486)*y(k,163) + .0059005_r8*rxt(k,491)*y(k,165) & + + .0057005_r8*rxt(k,494)*y(k,180) + .0143005_r8*rxt(k,498) & + *y(k,181) + .0332005_r8*rxt(k,502)*y(k,187) & + + .0073005_r8*rxt(k,508)*y(k,197) + .011_r8*rxt(k,511)*y(k,200) + mat(k,1969) = .1749305_r8*rxt(k,484)*y(k,4) + .0590245_r8*rxt(k,492)*y(k,93) & + + .1749305_r8*rxt(k,500)*y(k,105) + mat(k,1814) = .1284005_r8*rxt(k,487)*y(k,4) + .0033005_r8*rxt(k,495)*y(k,93) & + + .0554005_r8*rxt(k,503)*y(k,105) + mat(k,10) = .0085005_r8*rxt(k,505)*y(k,190) + mat(k,16) = .079_r8*rxt(k,486)*y(k,116) + .1284005_r8*rxt(k,485)*y(k,176) + mat(k,22) = .0059005_r8*rxt(k,491)*y(k,116) + .0443005_r8*rxt(k,490)*y(k,176) + mat(k,1592) = .1284005_r8*rxt(k,485)*y(k,163) + .0443005_r8*rxt(k,490) & + *y(k,165) + .0271005_r8*rxt(k,493)*y(k,180) & + + .0076005_r8*rxt(k,497)*y(k,181) + .0554005_r8*rxt(k,501) & + *y(k,187) + .2157005_r8*rxt(k,507)*y(k,197) & + + .0512005_r8*rxt(k,510)*y(k,200) + mat(k,28) = .0057005_r8*rxt(k,494)*y(k,116) + .0271005_r8*rxt(k,493)*y(k,176) + mat(k,34) = .0143005_r8*rxt(k,498)*y(k,116) + .0076005_r8*rxt(k,497)*y(k,176) + mat(k,42) = .0332005_r8*rxt(k,502)*y(k,116) + .0554005_r8*rxt(k,501)*y(k,176) + mat(k,1361) = .0085005_r8*rxt(k,505)*y(k,145) + mat(k,48) = .0073005_r8*rxt(k,508)*y(k,116) + .2157005_r8*rxt(k,507)*y(k,176) + mat(k,54) = .011_r8*rxt(k,511)*y(k,116) + .0512005_r8*rxt(k,510)*y(k,176) + mat(k,753) = .5901905_r8*rxt(k,484)*y(k,118) + .114_r8*rxt(k,487)*y(k,122) + mat(k,703) = .0250245_r8*rxt(k,492)*y(k,118) + mat(k,780) = .5901905_r8*rxt(k,500)*y(k,118) + .1278005_r8*rxt(k,503) & + *y(k,122) + mat(k,1725) = .1254005_r8*rxt(k,486)*y(k,163) + .0536005_r8*rxt(k,491) & + *y(k,165) + .0623005_r8*rxt(k,494)*y(k,180) & + + .0166005_r8*rxt(k,498)*y(k,181) + .130_r8*rxt(k,502)*y(k,187) & + + .238_r8*rxt(k,508)*y(k,197) + .1185005_r8*rxt(k,511)*y(k,200) + mat(k,1970) = .5901905_r8*rxt(k,484)*y(k,4) + .0250245_r8*rxt(k,492)*y(k,93) & + + .5901905_r8*rxt(k,500)*y(k,105) + mat(k,1815) = .114_r8*rxt(k,487)*y(k,4) + .1278005_r8*rxt(k,503)*y(k,105) + mat(k,11) = .0128005_r8*rxt(k,505)*y(k,190) + mat(k,17) = .1254005_r8*rxt(k,486)*y(k,116) + .114_r8*rxt(k,485)*y(k,176) + mat(k,23) = .0536005_r8*rxt(k,491)*y(k,116) + .1621005_r8*rxt(k,490)*y(k,176) + mat(k,1593) = .114_r8*rxt(k,485)*y(k,163) + .1621005_r8*rxt(k,490)*y(k,165) & + + .0474005_r8*rxt(k,493)*y(k,180) + .0113005_r8*rxt(k,497) & + *y(k,181) + .1278005_r8*rxt(k,501)*y(k,187) & + + .0738005_r8*rxt(k,507)*y(k,197) + .1598005_r8*rxt(k,510) & + *y(k,200) + mat(k,29) = .0623005_r8*rxt(k,494)*y(k,116) + .0474005_r8*rxt(k,493)*y(k,176) + mat(k,35) = .0166005_r8*rxt(k,498)*y(k,116) + .0113005_r8*rxt(k,497)*y(k,176) + mat(k,43) = .130_r8*rxt(k,502)*y(k,116) + .1278005_r8*rxt(k,501)*y(k,176) + mat(k,1362) = .0128005_r8*rxt(k,505)*y(k,145) + mat(k,49) = .238_r8*rxt(k,508)*y(k,116) + .0738005_r8*rxt(k,507)*y(k,176) + mat(k,55) = .1185005_r8*rxt(k,511)*y(k,116) + .1598005_r8*rxt(k,510)*y(k,176) + mat(k,12) = -(rxt(k,505)*y(k,190)) + mat(k,1363) = -rxt(k,505)*y(k,145) + mat(k,114) = .100_r8*rxt(k,419)*y(k,190) + mat(k,132) = .230_r8*rxt(k,421)*y(k,190) + mat(k,1384) = .100_r8*rxt(k,419)*y(k,153) + .230_r8*rxt(k,421)*y(k,155) + mat(k,482) = -(rxt(k,443)*y(k,190)) + mat(k,1436) = -rxt(k,443)*y(k,147) + mat(k,1631) = rxt(k,441)*y(k,194) + mat(k,954) = rxt(k,441)*y(k,176) + mat(k,506) = -(rxt(k,444)*y(k,190)) + mat(k,1439) = -rxt(k,444)*y(k,148) + mat(k,1753) = .200_r8*rxt(k,437)*y(k,188) + .200_r8*rxt(k,447)*y(k,195) + mat(k,1290) = .500_r8*rxt(k,435)*y(k,188) + mat(k,973) = .200_r8*rxt(k,437)*y(k,116) + .500_r8*rxt(k,435)*y(k,171) + mat(k,932) = .200_r8*rxt(k,447)*y(k,116) + mat(k,366) = -(rxt(k,448)*y(k,190)) + mat(k,1421) = -rxt(k,448)*y(k,149) + mat(k,1623) = rxt(k,446)*y(k,195) + mat(k,931) = rxt(k,446)*y(k,176) + mat(k,855) = -(rxt(k,449)*y(k,118) + rxt(k,450)*y(k,190)) + mat(k,1985) = -rxt(k,449)*y(k,150) + mat(k,1470) = -rxt(k,450)*y(k,150) + mat(k,762) = .330_r8*rxt(k,430)*y(k,122) + mat(k,789) = .330_r8*rxt(k,433)*y(k,122) + mat(k,1771) = .800_r8*rxt(k,437)*y(k,188) + .800_r8*rxt(k,447)*y(k,195) + mat(k,1985) = mat(k,1985) + rxt(k,438)*y(k,188) + mat(k,1833) = .330_r8*rxt(k,430)*y(k,4) + .330_r8*rxt(k,433)*y(k,105) + mat(k,507) = rxt(k,444)*y(k,190) + mat(k,1297) = .500_r8*rxt(k,435)*y(k,188) + rxt(k,445)*y(k,195) + mat(k,975) = .800_r8*rxt(k,437)*y(k,116) + rxt(k,438)*y(k,118) & + + .500_r8*rxt(k,435)*y(k,171) + mat(k,1470) = mat(k,1470) + rxt(k,444)*y(k,148) + mat(k,935) = .800_r8*rxt(k,447)*y(k,116) + rxt(k,445)*y(k,171) + mat(k,885) = -(rxt(k,451)*y(k,190)) + mat(k,1473) = -rxt(k,451)*y(k,151) + mat(k,763) = .300_r8*rxt(k,430)*y(k,122) + mat(k,790) = .300_r8*rxt(k,433)*y(k,122) + mat(k,1774) = .900_r8*rxt(k,442)*y(k,194) + mat(k,1835) = .300_r8*rxt(k,430)*y(k,4) + .300_r8*rxt(k,433)*y(k,105) + mat(k,1300) = rxt(k,440)*y(k,194) + mat(k,958) = .900_r8*rxt(k,442)*y(k,116) + rxt(k,440)*y(k,171) + mat(k,493) = -(rxt(k,418)*y(k,190)) + mat(k,1437) = -rxt(k,418)*y(k,152) + mat(k,1632) = rxt(k,416)*y(k,196) + mat(k,582) = rxt(k,416)*y(k,176) + mat(k,112) = -(rxt(k,419)*y(k,190)) + mat(k,1382) = -rxt(k,419)*y(k,153) + mat(k,128) = -(rxt(k,385)*y(k,190)) + mat(k,1385) = -rxt(k,385)*y(k,154) + mat(k,1602) = rxt(k,382)*y(k,198) + mat(k,1005) = rxt(k,382)*y(k,176) + mat(k,133) = -(rxt(k,421)*y(k,190)) + mat(k,1386) = -rxt(k,421)*y(k,155) + mat(k,554) = -(rxt(k,424)*y(k,190)) + mat(k,1444) = -rxt(k,424)*y(k,156) + mat(k,1637) = rxt(k,422)*y(k,199) + mat(k,607) = rxt(k,422)*y(k,176) + mat(k,141) = -(rxt(k,427)*y(k,190)) + mat(k,1387) = -rxt(k,427)*y(k,157) + mat(k,134) = .150_r8*rxt(k,421)*y(k,190) + mat(k,1387) = mat(k,1387) + .150_r8*rxt(k,421)*y(k,155) + mat(k,325) = -(rxt(k,428)*y(k,190)) + mat(k,1415) = -rxt(k,428)*y(k,158) + mat(k,1617) = rxt(k,425)*y(k,201) + mat(k,382) = rxt(k,425)*y(k,176) + mat(k,408) = -(rxt(k,386)*y(k,176) + rxt(k,387)*y(k,116) + rxt(k,415) & + *y(k,117)) + mat(k,1627) = -rxt(k,386)*y(k,161) + mat(k,1748) = -rxt(k,387)*y(k,161) + mat(k,1877) = -rxt(k,415)*y(k,161) + mat(k,158) = rxt(k,392)*y(k,190) + mat(k,1427) = rxt(k,392)*y(k,20) + mat(k,808) = -(rxt(k,347)*y(k,176) + (rxt(k,348) + rxt(k,349)) * y(k,116)) + mat(k,1654) = -rxt(k,347)*y(k,162) + mat(k,1769) = -(rxt(k,348) + rxt(k,349)) * y(k,162) + mat(k,524) = rxt(k,350)*y(k,190) + mat(k,155) = rxt(k,351)*y(k,190) + mat(k,1466) = rxt(k,350)*y(k,2) + rxt(k,351)*y(k,13) + mat(k,18) = -(rxt(k,485)*y(k,176) + rxt(k,486)*y(k,116)) + mat(k,1594) = -rxt(k,485)*y(k,163) + mat(k,1726) = -rxt(k,486)*y(k,163) + mat(k,754) = rxt(k,488)*y(k,190) + mat(k,1364) = rxt(k,488)*y(k,4) + mat(k,375) = -(rxt(k,389)*y(k,176) + rxt(k,390)*y(k,116)) + mat(k,1624) = -rxt(k,389)*y(k,164) + mat(k,1745) = -rxt(k,390)*y(k,164) + mat(k,91) = .350_r8*rxt(k,388)*y(k,190) + mat(k,315) = rxt(k,391)*y(k,190) + mat(k,1422) = .350_r8*rxt(k,388)*y(k,5) + rxt(k,391)*y(k,6) + mat(k,24) = -(rxt(k,490)*y(k,176) + rxt(k,491)*y(k,116)) + mat(k,1595) = -rxt(k,490)*y(k,165) + mat(k,1727) = -rxt(k,491)*y(k,165) + mat(k,87) = rxt(k,489)*y(k,190) + mat(k,1365) = rxt(k,489)*y(k,5) + mat(k,333) = -(rxt(k,393)*y(k,176) + rxt(k,395)*y(k,116)) + mat(k,1618) = -rxt(k,393)*y(k,166) + mat(k,1740) = -rxt(k,395)*y(k,166) + mat(k,240) = rxt(k,394)*y(k,190) + mat(k,115) = .070_r8*rxt(k,419)*y(k,190) + mat(k,135) = .060_r8*rxt(k,421)*y(k,190) + mat(k,1416) = rxt(k,394)*y(k,21) + .070_r8*rxt(k,419)*y(k,153) & + + .060_r8*rxt(k,421)*y(k,155) + mat(k,686) = -(4._r8*rxt(k,270)*y(k,167) + rxt(k,271)*y(k,171) + rxt(k,272) & + *y(k,176) + rxt(k,273)*y(k,116)) + mat(k,1293) = -rxt(k,271)*y(k,167) + mat(k,1649) = -rxt(k,272)*y(k,167) + mat(k,1765) = -rxt(k,273)*y(k,167) + mat(k,214) = .500_r8*rxt(k,275)*y(k,190) + mat(k,196) = rxt(k,276)*y(k,54) + rxt(k,277)*y(k,190) + mat(k,1943) = rxt(k,276)*y(k,26) + mat(k,1457) = .500_r8*rxt(k,275)*y(k,25) + rxt(k,277)*y(k,26) + end do + end subroutine nlnmat06 + subroutine nlnmat07( avec_len, mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + do k = 1,avec_len + mat(k,661) = -(rxt(k,299)*y(k,171) + rxt(k,300)*y(k,176) + rxt(k,301) & + *y(k,116)) + mat(k,1292) = -rxt(k,299)*y(k,168) + mat(k,1646) = -rxt(k,300)*y(k,168) + mat(k,1763) = -rxt(k,301)*y(k,168) + mat(k,308) = rxt(k,302)*y(k,190) + mat(k,67) = rxt(k,303)*y(k,190) + mat(k,1454) = rxt(k,302)*y(k,28) + rxt(k,303)*y(k,29) + mat(k,514) = -(rxt(k,396)*y(k,176) + rxt(k,397)*y(k,116)) + mat(k,1634) = -rxt(k,396)*y(k,169) + mat(k,1754) = -rxt(k,397)*y(k,169) + mat(k,172) = rxt(k,398)*y(k,190) + mat(k,1754) = mat(k,1754) + rxt(k,387)*y(k,161) + mat(k,1822) = rxt(k,413)*y(k,129) + mat(k,363) = rxt(k,413)*y(k,122) + mat(k,409) = rxt(k,387)*y(k,116) + .400_r8*rxt(k,386)*y(k,176) + mat(k,1634) = mat(k,1634) + .400_r8*rxt(k,386)*y(k,161) + mat(k,1440) = rxt(k,398)*y(k,30) + mat(k,1233) = -(4._r8*rxt(k,281)*y(k,170) + rxt(k,282)*y(k,171) + rxt(k,283) & + *y(k,176) + rxt(k,284)*y(k,116) + rxt(k,295)*y(k,117) + rxt(k,322) & + *y(k,182) + rxt(k,355)*y(k,178) + rxt(k,360)*y(k,179) + rxt(k,369) & + *y(k,96) + rxt(k,380)*y(k,198)) + mat(k,1317) = -rxt(k,282)*y(k,170) + mat(k,1676) = -rxt(k,283)*y(k,170) + mat(k,1792) = -rxt(k,284)*y(k,170) + mat(k,1893) = -rxt(k,295)*y(k,170) + mat(k,1159) = -rxt(k,322)*y(k,170) + mat(k,1185) = -rxt(k,355)*y(k,170) + mat(k,1117) = -rxt(k,360)*y(k,170) + mat(k,1048) = -rxt(k,369)*y(k,170) + mat(k,1013) = -rxt(k,380)*y(k,170) + mat(k,769) = .060_r8*rxt(k,430)*y(k,122) + mat(k,896) = rxt(k,278)*y(k,118) + rxt(k,279)*y(k,190) + mat(k,1073) = rxt(k,304)*y(k,118) + rxt(k,305)*y(k,190) + mat(k,402) = .500_r8*rxt(k,286)*y(k,190) + mat(k,714) = .080_r8*rxt(k,375)*y(k,122) + mat(k,1064) = .100_r8*rxt(k,328)*y(k,122) + mat(k,796) = .060_r8*rxt(k,433)*y(k,122) + mat(k,1137) = .280_r8*rxt(k,342)*y(k,122) + mat(k,1792) = mat(k,1792) + .530_r8*rxt(k,326)*y(k,182) + rxt(k,335)*y(k,184) & + + rxt(k,338)*y(k,186) + rxt(k,313)*y(k,193) + mat(k,2007) = rxt(k,278)*y(k,43) + rxt(k,304)*y(k,47) + .530_r8*rxt(k,325) & + *y(k,182) + rxt(k,336)*y(k,184) + mat(k,1852) = .060_r8*rxt(k,430)*y(k,4) + .080_r8*rxt(k,375)*y(k,93) & + + .100_r8*rxt(k,328)*y(k,100) + .060_r8*rxt(k,433)*y(k,105) & + + .280_r8*rxt(k,342)*y(k,106) + mat(k,888) = .650_r8*rxt(k,451)*y(k,190) + mat(k,1233) = mat(k,1233) + .530_r8*rxt(k,322)*y(k,182) + mat(k,1317) = mat(k,1317) + .260_r8*rxt(k,323)*y(k,182) + rxt(k,332)*y(k,184) & + + .300_r8*rxt(k,311)*y(k,193) + mat(k,1676) = mat(k,1676) + .450_r8*rxt(k,333)*y(k,184) + .200_r8*rxt(k,337) & + *y(k,186) + .150_r8*rxt(k,312)*y(k,193) + mat(k,1159) = mat(k,1159) + .530_r8*rxt(k,326)*y(k,116) + .530_r8*rxt(k,325) & + *y(k,118) + .530_r8*rxt(k,322)*y(k,170) + .260_r8*rxt(k,323) & + *y(k,171) + mat(k,1203) = rxt(k,335)*y(k,116) + rxt(k,336)*y(k,118) + rxt(k,332)*y(k,171) & + + .450_r8*rxt(k,333)*y(k,176) + 4.000_r8*rxt(k,334)*y(k,184) + mat(k,545) = rxt(k,338)*y(k,116) + .200_r8*rxt(k,337)*y(k,176) + mat(k,1493) = rxt(k,279)*y(k,43) + rxt(k,305)*y(k,47) + .500_r8*rxt(k,286) & + *y(k,49) + .650_r8*rxt(k,451)*y(k,151) + mat(k,997) = rxt(k,313)*y(k,116) + .300_r8*rxt(k,311)*y(k,171) & + + .150_r8*rxt(k,312)*y(k,176) + mat(k,1320) = -(rxt(k,171)*y(k,57) + (4._r8*rxt(k,248) + 4._r8*rxt(k,249) & + ) * y(k,171) + rxt(k,250)*y(k,176) + rxt(k,251)*y(k,116) & + + rxt(k,271)*y(k,167) + rxt(k,282)*y(k,170) + rxt(k,299) & + *y(k,168) + rxt(k,311)*y(k,193) + rxt(k,323)*y(k,182) + rxt(k,332) & + *y(k,184) + rxt(k,356)*y(k,178) + rxt(k,361)*y(k,179) + rxt(k,370) & + *y(k,96) + rxt(k,381)*y(k,198) + rxt(k,435)*y(k,188) + rxt(k,440) & + *y(k,194) + rxt(k,445)*y(k,195)) + mat(k,1706) = -rxt(k,171)*y(k,171) + mat(k,1680) = -rxt(k,250)*y(k,171) + mat(k,1796) = -rxt(k,251)*y(k,171) + mat(k,688) = -rxt(k,271)*y(k,171) + mat(k,1236) = -rxt(k,282)*y(k,171) + mat(k,664) = -rxt(k,299)*y(k,171) + mat(k,998) = -rxt(k,311)*y(k,171) + mat(k,1162) = -rxt(k,323)*y(k,171) + mat(k,1206) = -rxt(k,332)*y(k,171) + mat(k,1188) = -rxt(k,356)*y(k,171) + mat(k,1120) = -rxt(k,361)*y(k,171) + mat(k,1051) = -rxt(k,370)*y(k,171) + mat(k,1015) = -rxt(k,381)*y(k,171) + mat(k,984) = -rxt(k,435)*y(k,171) + mat(k,965) = -rxt(k,440)*y(k,171) + mat(k,945) = -rxt(k,445)*y(k,171) + mat(k,846) = .280_r8*rxt(k,298)*y(k,122) + mat(k,431) = rxt(k,285)*y(k,190) + mat(k,297) = .700_r8*rxt(k,253)*y(k,190) + mat(k,715) = .050_r8*rxt(k,375)*y(k,122) + mat(k,1051) = mat(k,1051) + rxt(k,369)*y(k,170) + mat(k,1796) = mat(k,1796) + rxt(k,284)*y(k,170) + .830_r8*rxt(k,401)*y(k,172) & + + .170_r8*rxt(k,407)*y(k,185) + mat(k,1856) = .280_r8*rxt(k,298)*y(k,27) + .050_r8*rxt(k,375)*y(k,93) + mat(k,1236) = mat(k,1236) + rxt(k,369)*y(k,96) + rxt(k,284)*y(k,116) & + + 4.000_r8*rxt(k,281)*y(k,170) + .900_r8*rxt(k,282)*y(k,171) & + + .450_r8*rxt(k,283)*y(k,176) + rxt(k,355)*y(k,178) + rxt(k,360) & + *y(k,179) + rxt(k,322)*y(k,182) + rxt(k,331)*y(k,184) & + + rxt(k,380)*y(k,198) + mat(k,1320) = mat(k,1320) + .900_r8*rxt(k,282)*y(k,170) + mat(k,623) = .830_r8*rxt(k,401)*y(k,116) + .330_r8*rxt(k,400)*y(k,176) + mat(k,1680) = mat(k,1680) + .450_r8*rxt(k,283)*y(k,170) + .330_r8*rxt(k,400) & + *y(k,172) + .070_r8*rxt(k,406)*y(k,185) + mat(k,1188) = mat(k,1188) + rxt(k,355)*y(k,170) + mat(k,1120) = mat(k,1120) + rxt(k,360)*y(k,170) + mat(k,1162) = mat(k,1162) + rxt(k,322)*y(k,170) + mat(k,1206) = mat(k,1206) + rxt(k,331)*y(k,170) + mat(k,744) = .170_r8*rxt(k,407)*y(k,116) + .070_r8*rxt(k,406)*y(k,176) + mat(k,1497) = rxt(k,285)*y(k,48) + .700_r8*rxt(k,253)*y(k,51) + mat(k,1015) = mat(k,1015) + rxt(k,380)*y(k,170) + mat(k,620) = -(rxt(k,400)*y(k,176) + rxt(k,401)*y(k,116) + rxt(k,402) & + *y(k,117)) + mat(k,1643) = -rxt(k,400)*y(k,172) + mat(k,1761) = -rxt(k,401)*y(k,172) + mat(k,1882) = -rxt(k,402)*y(k,172) + mat(k,450) = -((rxt(k,319) + rxt(k,320)) * y(k,116)) + mat(k,1750) = -(rxt(k,319) + rxt(k,320)) * y(k,173) + mat(k,258) = rxt(k,318)*y(k,190) + mat(k,1432) = rxt(k,318)*y(k,14) + mat(k,1735) = .750_r8*rxt(k,288)*y(k,175) + mat(k,566) = .750_r8*rxt(k,288)*y(k,116) + mat(k,567) = -(rxt(k,287)*y(k,176) + rxt(k,288)*y(k,116)) + mat(k,1638) = -rxt(k,287)*y(k,175) + mat(k,1757) = -rxt(k,288)*y(k,175) + mat(k,443) = rxt(k,294)*y(k,190) + mat(k,1445) = rxt(k,294)*y(k,23) + mat(k,1686) = -((rxt(k,124) + rxt(k,125) + rxt(k,126)) * y(k,71) + rxt(k,128) & + *y(k,121) + rxt(k,129)*y(k,122) + rxt(k,133)*y(k,190) & + + 4._r8*rxt(k,138)*y(k,176) + rxt(k,148)*y(k,118) + rxt(k,153) & + *y(k,116) + rxt(k,158)*y(k,117) + (rxt(k,168) + rxt(k,169) & + ) * y(k,54) + rxt(k,175)*y(k,57) + rxt(k,201)*y(k,15) + rxt(k,207) & + *y(k,17) + rxt(k,244)*y(k,40) + rxt(k,250)*y(k,171) + rxt(k,258) & + *y(k,177) + rxt(k,272)*y(k,167) + rxt(k,283)*y(k,170) + rxt(k,287) & + *y(k,175) + rxt(k,300)*y(k,168) + rxt(k,308)*y(k,192) + rxt(k,312) & + *y(k,193) + rxt(k,324)*y(k,182) + rxt(k,333)*y(k,184) + rxt(k,337) & + *y(k,186) + rxt(k,347)*y(k,162) + rxt(k,357)*y(k,178) + rxt(k,362) & + *y(k,179) + rxt(k,371)*y(k,96) + rxt(k,382)*y(k,198) + rxt(k,386) & + *y(k,161) + rxt(k,389)*y(k,164) + rxt(k,393)*y(k,166) + rxt(k,396) & + *y(k,169) + rxt(k,400)*y(k,172) + rxt(k,403)*y(k,183) + rxt(k,406) & + *y(k,185) + rxt(k,409)*y(k,191) + rxt(k,416)*y(k,196) + rxt(k,422) & + *y(k,199) + rxt(k,425)*y(k,201) + rxt(k,436)*y(k,188) + rxt(k,441) & + *y(k,194) + rxt(k,446)*y(k,195)) + mat(k,1278) = -(rxt(k,124) + rxt(k,125) + rxt(k,126)) * y(k,176) + mat(k,1580) = -rxt(k,128)*y(k,176) + mat(k,1862) = -rxt(k,129)*y(k,176) + mat(k,1503) = -rxt(k,133)*y(k,176) + mat(k,2017) = -rxt(k,148)*y(k,176) + mat(k,1802) = -rxt(k,153)*y(k,176) + mat(k,1903) = -rxt(k,158)*y(k,176) + mat(k,1960) = -(rxt(k,168) + rxt(k,169)) * y(k,176) + mat(k,1712) = -rxt(k,175)*y(k,176) + mat(k,1254) = -rxt(k,201)*y(k,176) + mat(k,1527) = -rxt(k,207)*y(k,176) + mat(k,1550) = -rxt(k,244)*y(k,176) + mat(k,1325) = -rxt(k,250)*y(k,176) + mat(k,342) = -rxt(k,258)*y(k,176) + mat(k,691) = -rxt(k,272)*y(k,176) + mat(k,1239) = -rxt(k,283)*y(k,176) + mat(k,571) = -rxt(k,287)*y(k,176) + mat(k,667) = -rxt(k,300)*y(k,176) + mat(k,634) = -rxt(k,308)*y(k,176) + mat(k,1001) = -rxt(k,312)*y(k,176) + mat(k,1165) = -rxt(k,324)*y(k,176) + mat(k,1209) = -rxt(k,333)*y(k,176) + mat(k,547) = -rxt(k,337)*y(k,176) + mat(k,815) = -rxt(k,347)*y(k,176) + mat(k,1191) = -rxt(k,357)*y(k,176) + mat(k,1123) = -rxt(k,362)*y(k,176) + mat(k,1054) = -rxt(k,371)*y(k,176) + mat(k,1018) = -rxt(k,382)*y(k,176) + mat(k,411) = -rxt(k,386)*y(k,176) + mat(k,379) = -rxt(k,389)*y(k,176) + mat(k,336) = -rxt(k,393)*y(k,176) + mat(k,516) = -rxt(k,396)*y(k,176) + mat(k,625) = -rxt(k,400)*y(k,176) + mat(k,577) = -rxt(k,403)*y(k,176) + mat(k,746) = -rxt(k,406)*y(k,176) + mat(k,349) = -rxt(k,409)*y(k,176) + mat(k,592) = -rxt(k,416)*y(k,176) + mat(k,617) = -rxt(k,422)*y(k,176) + mat(k,387) = -rxt(k,425)*y(k,176) + mat(k,987) = -rxt(k,436)*y(k,176) + mat(k,968) = -rxt(k,441)*y(k,176) + mat(k,948) = -rxt(k,446)*y(k,176) + mat(k,772) = .570_r8*rxt(k,430)*y(k,122) + mat(k,93) = .650_r8*rxt(k,388)*y(k,190) + mat(k,1254) = mat(k,1254) + rxt(k,200)*y(k,40) + mat(k,1527) = mat(k,1527) + rxt(k,212)*y(k,190) + mat(k,206) = .350_r8*rxt(k,267)*y(k,190) + mat(k,448) = .130_r8*rxt(k,269)*y(k,122) + mat(k,169) = rxt(k,274)*y(k,190) + mat(k,849) = .280_r8*rxt(k,298)*y(k,122) + mat(k,1550) = mat(k,1550) + rxt(k,200)*y(k,15) + rxt(k,164)*y(k,54) & + + rxt(k,245)*y(k,118) + rxt(k,246)*y(k,121) + mat(k,59) = rxt(k,280)*y(k,190) + mat(k,659) = rxt(k,252)*y(k,190) + mat(k,1960) = mat(k,1960) + rxt(k,164)*y(k,40) + rxt(k,167)*y(k,74) + mat(k,1712) = mat(k,1712) + rxt(k,171)*y(k,171) + rxt(k,182)*y(k,190) + mat(k,906) = rxt(k,255)*y(k,190) + mat(k,123) = .730_r8*rxt(k,399)*y(k,190) + mat(k,187) = .500_r8*rxt(k,466)*y(k,190) + mat(k,868) = rxt(k,291)*y(k,190) + mat(k,739) = rxt(k,292)*y(k,190) + mat(k,469) = rxt(k,167)*y(k,54) + rxt(k,123)*y(k,121) + rxt(k,132)*y(k,190) + mat(k,110) = rxt(k,256)*y(k,190) + mat(k,673) = rxt(k,257)*y(k,190) + mat(k,921) = rxt(k,321)*y(k,190) + mat(k,930) = rxt(k,306)*y(k,190) + mat(k,718) = .370_r8*rxt(k,375)*y(k,122) + mat(k,480) = .300_r8*rxt(k,366)*y(k,190) + mat(k,441) = rxt(k,367)*y(k,190) + mat(k,1054) = mat(k,1054) + rxt(k,372)*y(k,116) + rxt(k,373)*y(k,118) & + + rxt(k,369)*y(k,170) + 1.200_r8*rxt(k,370)*y(k,171) + mat(k,275) = rxt(k,374)*y(k,190) + mat(k,1068) = .140_r8*rxt(k,328)*y(k,122) + mat(k,222) = .200_r8*rxt(k,330)*y(k,190) + mat(k,463) = .500_r8*rxt(k,341)*y(k,190) + mat(k,799) = .570_r8*rxt(k,433)*y(k,122) + mat(k,1143) = .280_r8*rxt(k,342)*y(k,122) + mat(k,288) = rxt(k,378)*y(k,190) + mat(k,881) = rxt(k,379)*y(k,190) + mat(k,1802) = mat(k,1802) + rxt(k,372)*y(k,96) + rxt(k,348)*y(k,162) & + + rxt(k,390)*y(k,164) + rxt(k,395)*y(k,166) + rxt(k,273) & + *y(k,167) + rxt(k,301)*y(k,168) + rxt(k,251)*y(k,171) & + + .170_r8*rxt(k,401)*y(k,172) + rxt(k,319)*y(k,173) & + + .250_r8*rxt(k,288)*y(k,175) + rxt(k,260)*y(k,177) & + + .920_r8*rxt(k,358)*y(k,178) + .920_r8*rxt(k,364)*y(k,179) & + + .470_r8*rxt(k,326)*y(k,182) + .400_r8*rxt(k,404)*y(k,183) & + + .830_r8*rxt(k,407)*y(k,185) + rxt(k,410)*y(k,191) + rxt(k,309) & + *y(k,192) + .900_r8*rxt(k,442)*y(k,194) + .800_r8*rxt(k,447) & + *y(k,195) + rxt(k,417)*y(k,196) + rxt(k,383)*y(k,198) & + + rxt(k,423)*y(k,199) + rxt(k,426)*y(k,201) + mat(k,2017) = mat(k,2017) + rxt(k,245)*y(k,40) + rxt(k,373)*y(k,96) & + + rxt(k,359)*y(k,178) + rxt(k,365)*y(k,179) + .470_r8*rxt(k,325) & + *y(k,182) + rxt(k,151)*y(k,190) + rxt(k,384)*y(k,198) + mat(k,1580) = mat(k,1580) + rxt(k,246)*y(k,40) + rxt(k,123)*y(k,74) + mat(k,1862) = mat(k,1862) + .570_r8*rxt(k,430)*y(k,4) + .130_r8*rxt(k,269) & + *y(k,23) + .280_r8*rxt(k,298)*y(k,27) + .370_r8*rxt(k,375) & + *y(k,93) + .140_r8*rxt(k,328)*y(k,100) + .570_r8*rxt(k,433) & + *y(k,105) + .280_r8*rxt(k,342)*y(k,106) + rxt(k,135)*y(k,190) + mat(k,102) = .800_r8*rxt(k,411)*y(k,190) + mat(k,727) = rxt(k,467)*y(k,190) + mat(k,892) = .200_r8*rxt(k,451)*y(k,190) + mat(k,118) = .280_r8*rxt(k,419)*y(k,190) + mat(k,140) = .380_r8*rxt(k,421)*y(k,190) + mat(k,145) = .630_r8*rxt(k,427)*y(k,190) + mat(k,815) = mat(k,815) + rxt(k,348)*y(k,116) + mat(k,379) = mat(k,379) + rxt(k,390)*y(k,116) + mat(k,336) = mat(k,336) + rxt(k,395)*y(k,116) + mat(k,691) = mat(k,691) + rxt(k,273)*y(k,116) + 2.400_r8*rxt(k,270)*y(k,167) & + + rxt(k,271)*y(k,171) + mat(k,667) = mat(k,667) + rxt(k,301)*y(k,116) + rxt(k,299)*y(k,171) + mat(k,1239) = mat(k,1239) + rxt(k,369)*y(k,96) + .900_r8*rxt(k,282)*y(k,171) & + + rxt(k,355)*y(k,178) + rxt(k,360)*y(k,179) + .470_r8*rxt(k,322) & + *y(k,182) + rxt(k,380)*y(k,198) + mat(k,1325) = mat(k,1325) + rxt(k,171)*y(k,57) + 1.200_r8*rxt(k,370)*y(k,96) & + + rxt(k,251)*y(k,116) + rxt(k,271)*y(k,167) + rxt(k,299) & + *y(k,168) + .900_r8*rxt(k,282)*y(k,170) + 4.000_r8*rxt(k,248) & + *y(k,171) + rxt(k,356)*y(k,178) + rxt(k,361)*y(k,179) & + + .730_r8*rxt(k,323)*y(k,182) + rxt(k,332)*y(k,184) & + + .500_r8*rxt(k,435)*y(k,188) + .300_r8*rxt(k,311)*y(k,193) & + + rxt(k,440)*y(k,194) + rxt(k,445)*y(k,195) + .800_r8*rxt(k,381) & + *y(k,198) + mat(k,625) = mat(k,625) + .170_r8*rxt(k,401)*y(k,116) + .070_r8*rxt(k,400) & + *y(k,176) + mat(k,455) = rxt(k,319)*y(k,116) + mat(k,571) = mat(k,571) + .250_r8*rxt(k,288)*y(k,116) + mat(k,1686) = mat(k,1686) + .070_r8*rxt(k,400)*y(k,172) + .160_r8*rxt(k,403) & + *y(k,183) + .330_r8*rxt(k,406)*y(k,185) + mat(k,342) = mat(k,342) + rxt(k,260)*y(k,116) + mat(k,1191) = mat(k,1191) + .920_r8*rxt(k,358)*y(k,116) + rxt(k,359)*y(k,118) & + + rxt(k,355)*y(k,170) + rxt(k,356)*y(k,171) + mat(k,1123) = mat(k,1123) + .920_r8*rxt(k,364)*y(k,116) + rxt(k,365)*y(k,118) & + + rxt(k,360)*y(k,170) + rxt(k,361)*y(k,171) + mat(k,1165) = mat(k,1165) + .470_r8*rxt(k,326)*y(k,116) + .470_r8*rxt(k,325) & + *y(k,118) + .470_r8*rxt(k,322)*y(k,170) + .730_r8*rxt(k,323) & + *y(k,171) + mat(k,577) = mat(k,577) + .400_r8*rxt(k,404)*y(k,116) + .160_r8*rxt(k,403) & + *y(k,176) + mat(k,1209) = mat(k,1209) + rxt(k,332)*y(k,171) + mat(k,746) = mat(k,746) + .830_r8*rxt(k,407)*y(k,116) + .330_r8*rxt(k,406) & + *y(k,176) + mat(k,987) = mat(k,987) + .500_r8*rxt(k,435)*y(k,171) + mat(k,1503) = mat(k,1503) + .650_r8*rxt(k,388)*y(k,5) + rxt(k,212)*y(k,17) & + + .350_r8*rxt(k,267)*y(k,22) + rxt(k,274)*y(k,24) + rxt(k,280) & + *y(k,45) + rxt(k,252)*y(k,50) + rxt(k,182)*y(k,57) + rxt(k,255) & + *y(k,60) + .730_r8*rxt(k,399)*y(k,64) + .500_r8*rxt(k,466) & + *y(k,65) + rxt(k,291)*y(k,69) + rxt(k,292)*y(k,70) + rxt(k,132) & + *y(k,74) + rxt(k,256)*y(k,81) + rxt(k,257)*y(k,82) + rxt(k,321) & + *y(k,88) + rxt(k,306)*y(k,90) + .300_r8*rxt(k,366)*y(k,94) & + + rxt(k,367)*y(k,95) + rxt(k,374)*y(k,97) + .200_r8*rxt(k,330) & + *y(k,101) + .500_r8*rxt(k,341)*y(k,104) + rxt(k,378)*y(k,110) & + + rxt(k,379)*y(k,111) + rxt(k,151)*y(k,118) + rxt(k,135) & + *y(k,122) + .800_r8*rxt(k,411)*y(k,130) + rxt(k,467)*y(k,137) & + + .200_r8*rxt(k,451)*y(k,151) + .280_r8*rxt(k,419)*y(k,153) & + + .380_r8*rxt(k,421)*y(k,155) + .630_r8*rxt(k,427)*y(k,157) + mat(k,349) = mat(k,349) + rxt(k,410)*y(k,116) + mat(k,634) = mat(k,634) + rxt(k,309)*y(k,116) + mat(k,1001) = mat(k,1001) + .300_r8*rxt(k,311)*y(k,171) + mat(k,968) = mat(k,968) + .900_r8*rxt(k,442)*y(k,116) + rxt(k,440)*y(k,171) + mat(k,948) = mat(k,948) + .800_r8*rxt(k,447)*y(k,116) + rxt(k,445)*y(k,171) + mat(k,592) = mat(k,592) + rxt(k,417)*y(k,116) + mat(k,1018) = mat(k,1018) + rxt(k,383)*y(k,116) + rxt(k,384)*y(k,118) & + + rxt(k,380)*y(k,170) + .800_r8*rxt(k,381)*y(k,171) + mat(k,617) = mat(k,617) + rxt(k,423)*y(k,116) + mat(k,387) = mat(k,387) + rxt(k,426)*y(k,116) + end do + end subroutine nlnmat07 + subroutine nlnmat08( avec_len, mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + do k = 1,avec_len + mat(k,339) = -(rxt(k,258)*y(k,176) + rxt(k,260)*y(k,116)) + mat(k,1619) = -rxt(k,258)*y(k,177) + mat(k,1741) = -rxt(k,260)*y(k,177) + mat(k,1536) = rxt(k,244)*y(k,176) + mat(k,1619) = mat(k,1619) + rxt(k,244)*y(k,40) + mat(k,1183) = -(rxt(k,355)*y(k,170) + rxt(k,356)*y(k,171) + rxt(k,357) & + *y(k,176) + rxt(k,358)*y(k,116) + rxt(k,359)*y(k,118)) + mat(k,1231) = -rxt(k,355)*y(k,178) + mat(k,1315) = -rxt(k,356)*y(k,178) + mat(k,1674) = -rxt(k,357)*y(k,178) + mat(k,1790) = -rxt(k,358)*y(k,178) + mat(k,2005) = -rxt(k,359)*y(k,178) + mat(k,713) = .600_r8*rxt(k,376)*y(k,190) + mat(k,1491) = .600_r8*rxt(k,376)*y(k,93) + mat(k,1113) = -(rxt(k,360)*y(k,170) + rxt(k,361)*y(k,171) + rxt(k,362) & + *y(k,176) + rxt(k,364)*y(k,116) + rxt(k,365)*y(k,118)) + mat(k,1228) = -rxt(k,360)*y(k,179) + mat(k,1312) = -rxt(k,361)*y(k,179) + mat(k,1671) = -rxt(k,362)*y(k,179) + mat(k,1787) = -rxt(k,364)*y(k,179) + mat(k,2002) = -rxt(k,365)*y(k,179) + mat(k,711) = .400_r8*rxt(k,376)*y(k,190) + mat(k,1488) = .400_r8*rxt(k,376)*y(k,93) + mat(k,30) = -(rxt(k,493)*y(k,176) + rxt(k,494)*y(k,116)) + mat(k,1596) = -rxt(k,493)*y(k,180) + mat(k,1728) = -rxt(k,494)*y(k,180) + mat(k,704) = rxt(k,496)*y(k,190) + mat(k,1366) = rxt(k,496)*y(k,93) + mat(k,36) = -(rxt(k,497)*y(k,176) + rxt(k,498)*y(k,116)) + mat(k,1597) = -rxt(k,497)*y(k,181) + mat(k,1729) = -rxt(k,498)*y(k,181) + mat(k,37) = rxt(k,499)*y(k,190) + mat(k,1367) = rxt(k,499)*y(k,99) + mat(k,1157) = -(rxt(k,322)*y(k,170) + rxt(k,323)*y(k,171) + rxt(k,324) & + *y(k,176) + rxt(k,325)*y(k,118) + (rxt(k,326) + rxt(k,327) & + ) * y(k,116)) + mat(k,1230) = -rxt(k,322)*y(k,182) + mat(k,1314) = -rxt(k,323)*y(k,182) + mat(k,1673) = -rxt(k,324)*y(k,182) + mat(k,2004) = -rxt(k,325)*y(k,182) + mat(k,1789) = -(rxt(k,326) + rxt(k,327)) * y(k,182) + mat(k,1062) = .500_r8*rxt(k,329)*y(k,190) + mat(k,219) = .200_r8*rxt(k,330)*y(k,190) + mat(k,1136) = rxt(k,343)*y(k,190) + mat(k,1490) = .500_r8*rxt(k,329)*y(k,100) + .200_r8*rxt(k,330)*y(k,101) & + + rxt(k,343)*y(k,106) + mat(k,574) = -(rxt(k,403)*y(k,176) + rxt(k,404)*y(k,116) + rxt(k,405) & + *y(k,117)) + mat(k,1639) = -rxt(k,403)*y(k,183) + mat(k,1758) = -rxt(k,404)*y(k,183) + mat(k,1881) = -rxt(k,405)*y(k,183) + mat(k,1202) = -(rxt(k,331)*y(k,170) + rxt(k,332)*y(k,171) + rxt(k,333) & + *y(k,176) + 4._r8*rxt(k,334)*y(k,184) + rxt(k,335)*y(k,116) & + + rxt(k,336)*y(k,118) + rxt(k,344)*y(k,117)) + mat(k,1232) = -rxt(k,331)*y(k,184) + mat(k,1316) = -rxt(k,332)*y(k,184) + mat(k,1675) = -rxt(k,333)*y(k,184) + mat(k,1791) = -rxt(k,335)*y(k,184) + mat(k,2006) = -rxt(k,336)*y(k,184) + mat(k,1892) = -rxt(k,344)*y(k,184) + mat(k,1063) = .500_r8*rxt(k,329)*y(k,190) + mat(k,220) = .500_r8*rxt(k,330)*y(k,190) + mat(k,1492) = .500_r8*rxt(k,329)*y(k,100) + .500_r8*rxt(k,330)*y(k,101) + mat(k,741) = -(rxt(k,406)*y(k,176) + rxt(k,407)*y(k,116) + rxt(k,408) & + *y(k,117)) + mat(k,1653) = -rxt(k,406)*y(k,185) + mat(k,1768) = -rxt(k,407)*y(k,185) + mat(k,1886) = -rxt(k,408)*y(k,185) + mat(k,543) = -(rxt(k,337)*y(k,176) + rxt(k,338)*y(k,116)) + mat(k,1636) = -rxt(k,337)*y(k,186) + mat(k,1756) = -rxt(k,338)*y(k,186) + mat(k,397) = rxt(k,339)*y(k,190) + mat(k,224) = rxt(k,340)*y(k,190) + mat(k,1443) = rxt(k,339)*y(k,102) + rxt(k,340)*y(k,103) + mat(k,44) = -(rxt(k,501)*y(k,176) + rxt(k,502)*y(k,116)) + mat(k,1598) = -rxt(k,501)*y(k,187) + mat(k,1730) = -rxt(k,502)*y(k,187) + mat(k,781) = rxt(k,504)*y(k,190) + mat(k,1369) = rxt(k,504)*y(k,105) + mat(k,979) = -(rxt(k,435)*y(k,171) + rxt(k,436)*y(k,176) + rxt(k,437) & + *y(k,116) + rxt(k,438)*y(k,118)) + mat(k,1306) = -rxt(k,435)*y(k,188) + mat(k,1664) = -rxt(k,436)*y(k,188) + mat(k,1781) = -rxt(k,437)*y(k,188) + mat(k,1995) = -rxt(k,438)*y(k,188) + mat(k,766) = rxt(k,429)*y(k,118) + mat(k,793) = rxt(k,432)*y(k,118) + mat(k,1995) = mat(k,1995) + rxt(k,429)*y(k,4) + rxt(k,432)*y(k,105) & + + .500_r8*rxt(k,449)*y(k,150) + mat(k,291) = rxt(k,439)*y(k,190) + mat(k,859) = .500_r8*rxt(k,449)*y(k,118) + mat(k,1480) = rxt(k,439)*y(k,120) + mat(k,1344) = -(rxt(k,114)*y(k,72) + rxt(k,115)*y(k,202) + rxt(k,118) & + *y(k,122) + (rxt(k,196) + rxt(k,197)) * y(k,80) + (rxt(k,219) & + + rxt(k,220)) * y(k,76) + rxt(k,225)*y(k,62) + rxt(k,226) & + *y(k,63) + rxt(k,264)*y(k,81)) + mat(k,1028) = -rxt(k,114)*y(k,189) + mat(k,2037) = -rxt(k,115)*y(k,189) + mat(k,1857) = -rxt(k,118)*y(k,189) + mat(k,1921) = -(rxt(k,196) + rxt(k,197)) * y(k,189) + mat(k,697) = -(rxt(k,219) + rxt(k,220)) * y(k,189) + mat(k,72) = -rxt(k,225)*y(k,189) + mat(k,105) = -rxt(k,226)*y(k,189) + mat(k,108) = -rxt(k,264)*y(k,189) + mat(k,1499) = -(rxt(k,131)*y(k,72) + rxt(k,132)*y(k,74) + rxt(k,133)*y(k,176) & + + rxt(k,134)*y(k,121) + rxt(k,135)*y(k,122) + (4._r8*rxt(k,136) & + + 4._r8*rxt(k,137)) * y(k,190) + rxt(k,139)*y(k,85) + rxt(k,151) & + *y(k,118) + rxt(k,152)*y(k,107) + rxt(k,160)*y(k,117) + rxt(k,161) & + *y(k,84) + rxt(k,180)*y(k,58) + (rxt(k,182) + rxt(k,183) & + ) * y(k,57) + rxt(k,185)*y(k,80) + rxt(k,188)*y(k,87) + rxt(k,212) & + *y(k,17) + rxt(k,214)*y(k,76) + rxt(k,247)*y(k,40) + rxt(k,252) & + *y(k,50) + rxt(k,253)*y(k,51) + (rxt(k,255) + rxt(k,265) & + ) * y(k,60) + rxt(k,256)*y(k,81) + rxt(k,257)*y(k,82) + rxt(k,267) & + *y(k,22) + rxt(k,274)*y(k,24) + rxt(k,275)*y(k,25) + rxt(k,277) & + *y(k,26) + rxt(k,279)*y(k,43) + rxt(k,280)*y(k,45) + rxt(k,285) & + *y(k,48) + rxt(k,286)*y(k,49) + rxt(k,291)*y(k,69) + rxt(k,292) & + *y(k,70) + rxt(k,293)*y(k,127) + rxt(k,294)*y(k,23) + rxt(k,302) & + *y(k,28) + rxt(k,303)*y(k,29) + rxt(k,305)*y(k,47) + rxt(k,306) & + *y(k,90) + rxt(k,307)*y(k,119) + rxt(k,310)*y(k,132) + rxt(k,314) & + *y(k,133) + rxt(k,315)*y(k,27) + rxt(k,316)*y(k,46) + rxt(k,318) & + *y(k,14) + rxt(k,321)*y(k,88) + rxt(k,329)*y(k,100) + rxt(k,330) & + *y(k,101) + rxt(k,339)*y(k,102) + rxt(k,340)*y(k,103) + rxt(k,341) & + *y(k,104) + rxt(k,343)*y(k,106) + rxt(k,346)*y(k,1) + rxt(k,350) & + *y(k,2) + rxt(k,351)*y(k,13) + rxt(k,352)*y(k,89) + rxt(k,353) & + *y(k,91) + rxt(k,354)*y(k,92) + rxt(k,366)*y(k,94) + rxt(k,367) & + *y(k,95) + rxt(k,374)*y(k,97) + rxt(k,376)*y(k,93) + rxt(k,377) & + *y(k,98) + rxt(k,378)*y(k,110) + rxt(k,379)*y(k,111) + rxt(k,385) & + *y(k,154) + rxt(k,388)*y(k,5) + rxt(k,391)*y(k,6) + rxt(k,392) & + *y(k,20) + rxt(k,394)*y(k,21) + rxt(k,398)*y(k,30) + rxt(k,399) & + *y(k,64) + rxt(k,411)*y(k,130) + rxt(k,414)*y(k,131) + rxt(k,418) & + *y(k,152) + rxt(k,419)*y(k,153) + rxt(k,421)*y(k,155) + rxt(k,424) & + *y(k,156) + rxt(k,427)*y(k,157) + rxt(k,428)*y(k,158) + rxt(k,431) & + *y(k,4) + rxt(k,434)*y(k,105) + rxt(k,439)*y(k,120) + rxt(k,443) & + *y(k,147) + rxt(k,444)*y(k,148) + rxt(k,448)*y(k,149) + rxt(k,450) & + *y(k,150) + rxt(k,451)*y(k,151) + (rxt(k,453) + rxt(k,466) & + ) * y(k,65) + rxt(k,455)*y(k,125) + rxt(k,460)*y(k,134) & + + rxt(k,465)*y(k,136) + rxt(k,467)*y(k,137) + rxt(k,469) & + *y(k,112)) + mat(k,1029) = -rxt(k,131)*y(k,190) + mat(k,467) = -rxt(k,132)*y(k,190) + mat(k,1682) = -rxt(k,133)*y(k,190) + mat(k,1576) = -rxt(k,134)*y(k,190) + mat(k,1858) = -rxt(k,135)*y(k,190) + mat(k,266) = -rxt(k,139)*y(k,190) + mat(k,2013) = -rxt(k,151)*y(k,190) + mat(k,279) = -rxt(k,152)*y(k,190) + mat(k,1899) = -rxt(k,160)*y(k,190) + mat(k,1264) = -rxt(k,161)*y(k,190) + mat(k,828) = -rxt(k,180)*y(k,190) + mat(k,1708) = -(rxt(k,182) + rxt(k,183)) * y(k,190) + mat(k,1922) = -rxt(k,185)*y(k,190) + mat(k,677) = -rxt(k,188)*y(k,190) + mat(k,1523) = -rxt(k,212)*y(k,190) + mat(k,698) = -rxt(k,214)*y(k,190) + mat(k,1546) = -rxt(k,247)*y(k,190) + mat(k,657) = -rxt(k,252)*y(k,190) + mat(k,298) = -rxt(k,253)*y(k,190) + mat(k,905) = -(rxt(k,255) + rxt(k,265)) * y(k,190) + mat(k,109) = -rxt(k,256)*y(k,190) + mat(k,672) = -rxt(k,257)*y(k,190) + mat(k,205) = -rxt(k,267)*y(k,190) + mat(k,168) = -rxt(k,274)*y(k,190) + mat(k,216) = -rxt(k,275)*y(k,190) + mat(k,197) = -rxt(k,277)*y(k,190) + mat(k,899) = -rxt(k,279)*y(k,190) + mat(k,58) = -rxt(k,280)*y(k,190) + mat(k,432) = -rxt(k,285)*y(k,190) + mat(k,404) = -rxt(k,286)*y(k,190) + mat(k,866) = -rxt(k,291)*y(k,190) + mat(k,738) = -rxt(k,292)*y(k,190) + mat(k,358) = -rxt(k,293)*y(k,190) + mat(k,446) = -rxt(k,294)*y(k,190) + mat(k,310) = -rxt(k,302)*y(k,190) + mat(k,68) = -rxt(k,303)*y(k,190) + mat(k,1076) = -rxt(k,305)*y(k,190) + mat(k,928) = -rxt(k,306)*y(k,190) + mat(k,732) = -rxt(k,307)*y(k,190) + mat(k,426) = -rxt(k,310)*y(k,190) + mat(k,304) = -rxt(k,314)*y(k,190) + mat(k,847) = -rxt(k,315)*y(k,190) + mat(k,822) = -rxt(k,316)*y(k,190) + mat(k,261) = -rxt(k,318)*y(k,190) + mat(k,919) = -rxt(k,321)*y(k,190) + mat(k,1066) = -rxt(k,329)*y(k,190) + mat(k,221) = -rxt(k,330)*y(k,190) + mat(k,400) = -rxt(k,339)*y(k,190) + mat(k,227) = -rxt(k,340)*y(k,190) + mat(k,461) = -rxt(k,341)*y(k,190) + mat(k,1141) = -rxt(k,343)*y(k,190) + mat(k,538) = -rxt(k,346)*y(k,190) + mat(k,528) = -rxt(k,350)*y(k,190) + mat(k,156) = -rxt(k,351)*y(k,190) + mat(k,152) = -rxt(k,352)*y(k,190) + mat(k,212) = -rxt(k,353)*y(k,190) + mat(k,81) = -rxt(k,354)*y(k,190) + mat(k,478) = -rxt(k,366)*y(k,190) + mat(k,440) = -rxt(k,367)*y(k,190) + mat(k,274) = -rxt(k,374)*y(k,190) + mat(k,716) = -rxt(k,376)*y(k,190) + mat(k,600) = -rxt(k,377)*y(k,190) + mat(k,287) = -rxt(k,378)*y(k,190) + mat(k,879) = -rxt(k,379)*y(k,190) + mat(k,130) = -rxt(k,385)*y(k,190) + mat(k,92) = -rxt(k,388)*y(k,190) + mat(k,317) = -rxt(k,391)*y(k,190) + mat(k,159) = -rxt(k,392)*y(k,190) + mat(k,242) = -rxt(k,394)*y(k,190) + mat(k,173) = -rxt(k,398)*y(k,190) + mat(k,122) = -rxt(k,399)*y(k,190) + mat(k,101) = -rxt(k,411)*y(k,190) + mat(k,236) = -rxt(k,414)*y(k,190) + mat(k,500) = -rxt(k,418)*y(k,190) + mat(k,117) = -rxt(k,419)*y(k,190) + mat(k,139) = -rxt(k,421)*y(k,190) + mat(k,563) = -rxt(k,424)*y(k,190) + mat(k,144) = -rxt(k,427)*y(k,190) + mat(k,329) = -rxt(k,428)*y(k,190) + mat(k,770) = -rxt(k,431)*y(k,190) + mat(k,797) = -rxt(k,434)*y(k,190) + mat(k,293) = -rxt(k,439)*y(k,190) + mat(k,488) = -rxt(k,443)*y(k,190) + mat(k,509) = -rxt(k,444)*y(k,190) + mat(k,370) = -rxt(k,448)*y(k,190) + mat(k,860) = -rxt(k,450)*y(k,190) + mat(k,890) = -rxt(k,451)*y(k,190) + mat(k,186) = -(rxt(k,453) + rxt(k,466)) * y(k,190) + mat(k,255) = -rxt(k,455)*y(k,190) + mat(k,393) = -rxt(k,460)*y(k,190) + mat(k,1086) = -rxt(k,465)*y(k,190) + mat(k,725) = -rxt(k,467)*y(k,190) + mat(k,64) = -rxt(k,469)*y(k,190) + mat(k,770) = mat(k,770) + .630_r8*rxt(k,430)*y(k,122) + mat(k,205) = mat(k,205) + .650_r8*rxt(k,267)*y(k,190) + mat(k,446) = mat(k,446) + .130_r8*rxt(k,269)*y(k,122) + mat(k,216) = mat(k,216) + .500_r8*rxt(k,275)*y(k,190) + mat(k,847) = mat(k,847) + .360_r8*rxt(k,298)*y(k,122) + mat(k,1546) = mat(k,1546) + rxt(k,246)*y(k,121) + mat(k,298) = mat(k,298) + .300_r8*rxt(k,253)*y(k,190) + mat(k,1956) = rxt(k,169)*y(k,176) + mat(k,644) = rxt(k,223)*y(k,202) + mat(k,1276) = rxt(k,130)*y(k,122) + 2.000_r8*rxt(k,125)*y(k,176) + mat(k,1029) = mat(k,1029) + rxt(k,122)*y(k,121) + rxt(k,114)*y(k,189) + mat(k,467) = mat(k,467) + rxt(k,123)*y(k,121) + mat(k,698) = mat(k,698) + rxt(k,213)*y(k,121) + rxt(k,219)*y(k,189) + mat(k,1922) = mat(k,1922) + rxt(k,184)*y(k,121) + rxt(k,196)*y(k,189) + mat(k,109) = mat(k,109) + rxt(k,264)*y(k,189) + mat(k,650) = rxt(k,215)*y(k,121) + mat(k,677) = mat(k,677) + rxt(k,187)*y(k,121) + mat(k,716) = mat(k,716) + .320_r8*rxt(k,375)*y(k,122) + mat(k,600) = mat(k,600) + .600_r8*rxt(k,377)*y(k,190) + mat(k,1066) = mat(k,1066) + .240_r8*rxt(k,328)*y(k,122) + mat(k,221) = mat(k,221) + .100_r8*rxt(k,330)*y(k,190) + mat(k,797) = mat(k,797) + .630_r8*rxt(k,433)*y(k,122) + mat(k,1141) = mat(k,1141) + .360_r8*rxt(k,342)*y(k,122) + mat(k,1798) = rxt(k,153)*y(k,176) + mat(k,2013) = mat(k,2013) + rxt(k,148)*y(k,176) + mat(k,1576) = mat(k,1576) + rxt(k,246)*y(k,40) + rxt(k,122)*y(k,72) & + + rxt(k,123)*y(k,74) + rxt(k,213)*y(k,76) + rxt(k,184)*y(k,80) & + + rxt(k,215)*y(k,86) + rxt(k,187)*y(k,87) + rxt(k,128)*y(k,176) + mat(k,1858) = mat(k,1858) + .630_r8*rxt(k,430)*y(k,4) + .130_r8*rxt(k,269) & + *y(k,23) + .360_r8*rxt(k,298)*y(k,27) + rxt(k,130)*y(k,71) & + + .320_r8*rxt(k,375)*y(k,93) + .240_r8*rxt(k,328)*y(k,100) & + + .630_r8*rxt(k,433)*y(k,105) + .360_r8*rxt(k,342)*y(k,106) & + + rxt(k,129)*y(k,176) + mat(k,426) = mat(k,426) + .500_r8*rxt(k,310)*y(k,190) + mat(k,130) = mat(k,130) + .500_r8*rxt(k,385)*y(k,190) + mat(k,410) = .400_r8*rxt(k,386)*y(k,176) + mat(k,1237) = .450_r8*rxt(k,283)*y(k,176) + mat(k,624) = .400_r8*rxt(k,400)*y(k,176) + mat(k,1682) = mat(k,1682) + rxt(k,169)*y(k,54) + 2.000_r8*rxt(k,125)*y(k,71) & + + rxt(k,153)*y(k,116) + rxt(k,148)*y(k,118) + rxt(k,128) & + *y(k,121) + rxt(k,129)*y(k,122) + .400_r8*rxt(k,386)*y(k,161) & + + .450_r8*rxt(k,283)*y(k,170) + .400_r8*rxt(k,400)*y(k,172) & + + .450_r8*rxt(k,333)*y(k,184) + .400_r8*rxt(k,406)*y(k,185) & + + .200_r8*rxt(k,337)*y(k,186) + .150_r8*rxt(k,312)*y(k,193) + mat(k,1207) = .450_r8*rxt(k,333)*y(k,176) + mat(k,745) = .400_r8*rxt(k,406)*y(k,176) + mat(k,546) = .200_r8*rxt(k,337)*y(k,176) + mat(k,1345) = rxt(k,114)*y(k,72) + rxt(k,219)*y(k,76) + rxt(k,196)*y(k,80) & + + rxt(k,264)*y(k,81) + 2.000_r8*rxt(k,115)*y(k,202) + mat(k,1499) = mat(k,1499) + .650_r8*rxt(k,267)*y(k,22) + .500_r8*rxt(k,275) & + *y(k,25) + .300_r8*rxt(k,253)*y(k,51) + .600_r8*rxt(k,377) & + *y(k,98) + .100_r8*rxt(k,330)*y(k,101) + .500_r8*rxt(k,310) & + *y(k,132) + .500_r8*rxt(k,385)*y(k,154) + mat(k,999) = .150_r8*rxt(k,312)*y(k,176) + mat(k,2038) = rxt(k,223)*y(k,68) + 2.000_r8*rxt(k,115)*y(k,189) + end do + end subroutine nlnmat08 + subroutine nlnmat09( avec_len, mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + do k = 1,avec_len + mat(k,346) = -(rxt(k,409)*y(k,176) + rxt(k,410)*y(k,116)) + mat(k,1620) = -rxt(k,409)*y(k,191) + mat(k,1742) = -rxt(k,410)*y(k,191) + mat(k,120) = .200_r8*rxt(k,399)*y(k,190) + mat(k,99) = .140_r8*rxt(k,411)*y(k,190) + mat(k,234) = rxt(k,414)*y(k,190) + mat(k,1417) = .200_r8*rxt(k,399)*y(k,64) + .140_r8*rxt(k,411)*y(k,130) & + + rxt(k,414)*y(k,131) + mat(k,629) = -(rxt(k,308)*y(k,176) + rxt(k,309)*y(k,116)) + mat(k,1644) = -rxt(k,308)*y(k,192) + mat(k,1762) = -rxt(k,309)*y(k,192) + mat(k,837) = rxt(k,315)*y(k,190) + mat(k,423) = .500_r8*rxt(k,310)*y(k,190) + mat(k,1451) = rxt(k,315)*y(k,27) + .500_r8*rxt(k,310)*y(k,132) + mat(k,995) = -(rxt(k,311)*y(k,171) + rxt(k,312)*y(k,176) + rxt(k,313) & + *y(k,116)) + mat(k,1307) = -rxt(k,311)*y(k,193) + mat(k,1665) = -rxt(k,312)*y(k,193) + mat(k,1782) = -rxt(k,313)*y(k,193) + mat(k,767) = .060_r8*rxt(k,430)*y(k,122) + mat(k,819) = rxt(k,316)*y(k,190) + mat(k,794) = .060_r8*rxt(k,433)*y(k,122) + mat(k,1842) = .060_r8*rxt(k,430)*y(k,4) + .060_r8*rxt(k,433)*y(k,105) + mat(k,302) = rxt(k,314)*y(k,190) + mat(k,887) = .150_r8*rxt(k,451)*y(k,190) + mat(k,1481) = rxt(k,316)*y(k,46) + rxt(k,314)*y(k,133) + .150_r8*rxt(k,451) & + *y(k,151) + mat(k,960) = -(rxt(k,440)*y(k,171) + rxt(k,441)*y(k,176) + rxt(k,442) & + *y(k,116)) + mat(k,1305) = -rxt(k,440)*y(k,194) + mat(k,1663) = -rxt(k,441)*y(k,194) + mat(k,1780) = -rxt(k,442)*y(k,194) + mat(k,1994) = .500_r8*rxt(k,449)*y(k,150) + mat(k,487) = rxt(k,443)*y(k,190) + mat(k,858) = .500_r8*rxt(k,449)*y(k,118) + rxt(k,450)*y(k,190) + mat(k,1479) = rxt(k,443)*y(k,147) + rxt(k,450)*y(k,150) + mat(k,938) = -(rxt(k,445)*y(k,171) + rxt(k,446)*y(k,176) + rxt(k,447) & + *y(k,116)) + mat(k,1304) = -rxt(k,445)*y(k,195) + mat(k,1662) = -rxt(k,446)*y(k,195) + mat(k,1779) = -rxt(k,447)*y(k,195) + mat(k,765) = rxt(k,431)*y(k,190) + mat(k,792) = rxt(k,434)*y(k,190) + mat(k,369) = rxt(k,448)*y(k,190) + mat(k,1478) = rxt(k,431)*y(k,4) + rxt(k,434)*y(k,105) + rxt(k,448)*y(k,149) + mat(k,585) = -(rxt(k,416)*y(k,176) + rxt(k,417)*y(k,116)) + mat(k,1640) = -rxt(k,416)*y(k,196) + mat(k,1759) = -rxt(k,417)*y(k,196) + mat(k,496) = rxt(k,418)*y(k,190) + mat(k,116) = .650_r8*rxt(k,419)*y(k,190) + mat(k,1447) = rxt(k,418)*y(k,152) + .650_r8*rxt(k,419)*y(k,153) + mat(k,50) = -(rxt(k,507)*y(k,176) + rxt(k,508)*y(k,116)) + mat(k,1599) = -rxt(k,507)*y(k,197) + mat(k,1731) = -rxt(k,508)*y(k,197) + mat(k,111) = rxt(k,506)*y(k,190) + mat(k,1370) = rxt(k,506)*y(k,153) + mat(k,1011) = -(rxt(k,380)*y(k,170) + rxt(k,381)*y(k,171) + rxt(k,382) & + *y(k,176) + rxt(k,383)*y(k,116) + rxt(k,384)*y(k,118)) + mat(k,1224) = -rxt(k,380)*y(k,198) + mat(k,1308) = -rxt(k,381)*y(k,198) + mat(k,1666) = -rxt(k,382)*y(k,198) + mat(k,1783) = -rxt(k,383)*y(k,198) + mat(k,1997) = -rxt(k,384)*y(k,198) + mat(k,151) = rxt(k,352)*y(k,190) + mat(k,211) = rxt(k,353)*y(k,190) + mat(k,80) = rxt(k,354)*y(k,190) + mat(k,597) = .400_r8*rxt(k,377)*y(k,190) + mat(k,129) = .500_r8*rxt(k,385)*y(k,190) + mat(k,1482) = rxt(k,352)*y(k,89) + rxt(k,353)*y(k,91) + rxt(k,354)*y(k,92) & + + .400_r8*rxt(k,377)*y(k,98) + .500_r8*rxt(k,385)*y(k,154) + mat(k,609) = -(rxt(k,422)*y(k,176) + rxt(k,423)*y(k,116)) + mat(k,1642) = -rxt(k,422)*y(k,199) + mat(k,1760) = -rxt(k,423)*y(k,199) + mat(k,136) = .560_r8*rxt(k,421)*y(k,190) + mat(k,556) = rxt(k,424)*y(k,190) + mat(k,1449) = .560_r8*rxt(k,421)*y(k,155) + rxt(k,424)*y(k,156) + mat(k,56) = -(rxt(k,510)*y(k,176) + rxt(k,511)*y(k,116)) + mat(k,1600) = -rxt(k,510)*y(k,200) + mat(k,1732) = -rxt(k,511)*y(k,200) + mat(k,131) = rxt(k,509)*y(k,190) + mat(k,1371) = rxt(k,509)*y(k,155) + mat(k,383) = -(rxt(k,425)*y(k,176) + rxt(k,426)*y(k,116)) + mat(k,1625) = -rxt(k,425)*y(k,201) + mat(k,1746) = -rxt(k,426)*y(k,201) + mat(k,143) = .300_r8*rxt(k,427)*y(k,190) + mat(k,326) = rxt(k,428)*y(k,190) + mat(k,1423) = .300_r8*rxt(k,427)*y(k,157) + rxt(k,428)*y(k,158) + mat(k,2050) = -(rxt(k,115)*y(k,189) + rxt(k,223)*y(k,68) + rxt(k,468) & + *y(k,138)) + mat(k,1357) = -rxt(k,115)*y(k,202) + mat(k,646) = -rxt(k,223)*y(k,202) + mat(k,178) = -rxt(k,468)*y(k,202) + mat(k,200) = rxt(k,277)*y(k,190) + mat(k,312) = rxt(k,302)*y(k,190) + mat(k,69) = rxt(k,303)*y(k,190) + mat(k,1558) = rxt(k,247)*y(k,190) + mat(k,902) = rxt(k,279)*y(k,190) + mat(k,823) = rxt(k,316)*y(k,190) + mat(k,1079) = rxt(k,305)*y(k,190) + mat(k,433) = rxt(k,285)*y(k,190) + mat(k,406) = rxt(k,286)*y(k,190) + mat(k,300) = rxt(k,253)*y(k,190) + mat(k,1284) = rxt(k,126)*y(k,176) + mat(k,1034) = rxt(k,131)*y(k,190) + mat(k,472) = rxt(k,132)*y(k,190) + mat(k,701) = rxt(k,214)*y(k,190) + mat(k,1934) = (rxt(k,520)+rxt(k,525))*y(k,86) + (rxt(k,513)+rxt(k,519) & + +rxt(k,524))*y(k,87) + rxt(k,185)*y(k,190) + mat(k,674) = rxt(k,257)*y(k,190) + mat(k,1270) = rxt(k,161)*y(k,190) + mat(k,270) = rxt(k,139)*y(k,190) + mat(k,655) = (rxt(k,520)+rxt(k,525))*y(k,80) + mat(k,682) = (rxt(k,513)+rxt(k,519)+rxt(k,524))*y(k,80) + rxt(k,188)*y(k,190) + mat(k,1070) = .500_r8*rxt(k,329)*y(k,190) + mat(k,65) = rxt(k,469)*y(k,190) + mat(k,429) = rxt(k,310)*y(k,190) + mat(k,306) = rxt(k,314)*y(k,190) + mat(k,1694) = rxt(k,126)*y(k,71) + rxt(k,133)*y(k,190) + mat(k,1511) = rxt(k,277)*y(k,26) + rxt(k,302)*y(k,28) + rxt(k,303)*y(k,29) & + + rxt(k,247)*y(k,40) + rxt(k,279)*y(k,43) + rxt(k,316)*y(k,46) & + + rxt(k,305)*y(k,47) + rxt(k,285)*y(k,48) + rxt(k,286)*y(k,49) & + + rxt(k,253)*y(k,51) + rxt(k,131)*y(k,72) + rxt(k,132)*y(k,74) & + + rxt(k,214)*y(k,76) + rxt(k,185)*y(k,80) + rxt(k,257)*y(k,82) & + + rxt(k,161)*y(k,84) + rxt(k,139)*y(k,85) + rxt(k,188)*y(k,87) & + + .500_r8*rxt(k,329)*y(k,100) + rxt(k,469)*y(k,112) + rxt(k,310) & + *y(k,132) + rxt(k,314)*y(k,133) + rxt(k,133)*y(k,176) & + + 2.000_r8*rxt(k,136)*y(k,190) + end do + end subroutine nlnmat09 + subroutine nlnmat_finit( avec_len, mat, lmat, dti ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: dti(veclen) + real(r8), intent(in) :: lmat(veclen,nzcnt) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + do k = 1,avec_len + mat(k, 1) = lmat(k, 1) + mat(k, 2) = lmat(k, 2) + mat(k, 3) = lmat(k, 3) + mat(k, 4) = lmat(k, 4) + mat(k, 5) = lmat(k, 5) + mat(k, 6) = lmat(k, 6) + mat(k, 12) = mat(k, 12) + lmat(k, 12) + mat(k, 18) = mat(k, 18) + lmat(k, 18) + mat(k, 24) = mat(k, 24) + lmat(k, 24) + mat(k, 30) = mat(k, 30) + lmat(k, 30) + mat(k, 36) = mat(k, 36) + lmat(k, 36) + mat(k, 38) = mat(k, 38) + lmat(k, 38) + mat(k, 44) = mat(k, 44) + lmat(k, 44) + mat(k, 50) = mat(k, 50) + lmat(k, 50) + mat(k, 56) = mat(k, 56) + lmat(k, 56) + mat(k, 57) = mat(k, 57) + lmat(k, 57) + mat(k, 60) = lmat(k, 60) + mat(k, 61) = lmat(k, 61) + mat(k, 62) = lmat(k, 62) + mat(k, 63) = mat(k, 63) + lmat(k, 63) + mat(k, 66) = mat(k, 66) + lmat(k, 66) + mat(k, 70) = mat(k, 70) + lmat(k, 70) + mat(k, 71) = mat(k, 71) + lmat(k, 71) + mat(k, 73) = lmat(k, 73) + mat(k, 74) = lmat(k, 74) + mat(k, 75) = lmat(k, 75) + mat(k, 76) = lmat(k, 76) + mat(k, 77) = lmat(k, 77) + mat(k, 78) = lmat(k, 78) + mat(k, 79) = mat(k, 79) + lmat(k, 79) + mat(k, 82) = lmat(k, 82) + mat(k, 83) = lmat(k, 83) + mat(k, 84) = lmat(k, 84) + mat(k, 85) = lmat(k, 85) + mat(k, 86) = lmat(k, 86) + mat(k, 88) = mat(k, 88) + lmat(k, 88) + mat(k, 94) = lmat(k, 94) + mat(k, 95) = lmat(k, 95) + mat(k, 96) = lmat(k, 96) + mat(k, 97) = lmat(k, 97) + mat(k, 98) = mat(k, 98) + lmat(k, 98) + mat(k, 103) = mat(k, 103) + lmat(k, 103) + mat(k, 104) = mat(k, 104) + lmat(k, 104) + mat(k, 106) = mat(k, 106) + lmat(k, 106) + mat(k, 107) = mat(k, 107) + lmat(k, 107) + mat(k, 112) = mat(k, 112) + lmat(k, 112) + mat(k, 119) = mat(k, 119) + lmat(k, 119) + mat(k, 124) = lmat(k, 124) + mat(k, 125) = lmat(k, 125) + mat(k, 126) = lmat(k, 126) + mat(k, 127) = lmat(k, 127) + mat(k, 128) = mat(k, 128) + lmat(k, 128) + mat(k, 130) = mat(k, 130) + lmat(k, 130) + mat(k, 133) = mat(k, 133) + lmat(k, 133) + mat(k, 141) = mat(k, 141) + lmat(k, 141) + mat(k, 146) = lmat(k, 146) + mat(k, 147) = lmat(k, 147) + mat(k, 148) = lmat(k, 148) + mat(k, 149) = mat(k, 149) + lmat(k, 149) + mat(k, 150) = lmat(k, 150) + mat(k, 152) = mat(k, 152) + lmat(k, 152) + mat(k, 153) = lmat(k, 153) + mat(k, 154) = mat(k, 154) + lmat(k, 154) + mat(k, 157) = mat(k, 157) + lmat(k, 157) + mat(k, 160) = lmat(k, 160) + mat(k, 161) = lmat(k, 161) + mat(k, 162) = lmat(k, 162) + mat(k, 163) = lmat(k, 163) + mat(k, 164) = lmat(k, 164) + mat(k, 165) = lmat(k, 165) + mat(k, 166) = mat(k, 166) + lmat(k, 166) + mat(k, 170) = mat(k, 170) + lmat(k, 170) + mat(k, 171) = lmat(k, 171) + mat(k, 173) = mat(k, 173) + lmat(k, 173) + mat(k, 175) = mat(k, 175) + lmat(k, 175) + mat(k, 176) = lmat(k, 176) + mat(k, 177) = lmat(k, 177) + mat(k, 179) = lmat(k, 179) + mat(k, 180) = lmat(k, 180) + mat(k, 181) = lmat(k, 181) + mat(k, 182) = lmat(k, 182) + mat(k, 183) = mat(k, 183) + lmat(k, 183) + mat(k, 189) = lmat(k, 189) + mat(k, 190) = lmat(k, 190) + mat(k, 191) = lmat(k, 191) + mat(k, 192) = lmat(k, 192) + mat(k, 193) = lmat(k, 193) + mat(k, 194) = lmat(k, 194) + mat(k, 195) = mat(k, 195) + lmat(k, 195) + mat(k, 201) = mat(k, 201) + lmat(k, 201) + mat(k, 207) = lmat(k, 207) + mat(k, 208) = lmat(k, 208) + mat(k, 209) = lmat(k, 209) + mat(k, 210) = mat(k, 210) + lmat(k, 210) + mat(k, 213) = mat(k, 213) + lmat(k, 213) + mat(k, 215) = mat(k, 215) + lmat(k, 215) + mat(k, 216) = mat(k, 216) + lmat(k, 216) + mat(k, 217) = lmat(k, 217) + mat(k, 218) = mat(k, 218) + lmat(k, 218) + mat(k, 223) = mat(k, 223) + lmat(k, 223) + mat(k, 225) = lmat(k, 225) + mat(k, 226) = lmat(k, 226) + mat(k, 227) = mat(k, 227) + lmat(k, 227) + mat(k, 228) = mat(k, 228) + lmat(k, 228) + mat(k, 231) = lmat(k, 231) + mat(k, 232) = mat(k, 232) + lmat(k, 232) + mat(k, 233) = mat(k, 233) + lmat(k, 233) + mat(k, 235) = lmat(k, 235) + mat(k, 236) = mat(k, 236) + lmat(k, 236) + mat(k, 237) = lmat(k, 237) + mat(k, 238) = lmat(k, 238) + mat(k, 239) = mat(k, 239) + lmat(k, 239) + mat(k, 242) = mat(k, 242) + lmat(k, 242) + mat(k, 243) = lmat(k, 243) + mat(k, 244) = lmat(k, 244) + mat(k, 245) = lmat(k, 245) + mat(k, 246) = lmat(k, 246) + mat(k, 247) = lmat(k, 247) + mat(k, 248) = lmat(k, 248) + mat(k, 249) = mat(k, 249) + lmat(k, 249) + mat(k, 250) = lmat(k, 250) + mat(k, 252) = mat(k, 252) + lmat(k, 252) + mat(k, 257) = mat(k, 257) + lmat(k, 257) + mat(k, 265) = mat(k, 265) + lmat(k, 265) + mat(k, 266) = mat(k, 266) + lmat(k, 266) + mat(k, 267) = lmat(k, 267) + mat(k, 268) = mat(k, 268) + lmat(k, 268) + mat(k, 269) = lmat(k, 269) + mat(k, 271) = mat(k, 271) + lmat(k, 271) + mat(k, 272) = lmat(k, 272) + mat(k, 275) = mat(k, 275) + lmat(k, 275) + mat(k, 276) = lmat(k, 276) + mat(k, 277) = mat(k, 277) + lmat(k, 277) + mat(k, 280) = mat(k, 280) + lmat(k, 280) + mat(k, 281) = mat(k, 281) + lmat(k, 281) + mat(k, 283) = mat(k, 283) + lmat(k, 283) + mat(k, 286) = lmat(k, 286) + mat(k, 289) = mat(k, 289) + lmat(k, 289) + mat(k, 290) = lmat(k, 290) + mat(k, 292) = lmat(k, 292) + mat(k, 293) = mat(k, 293) + lmat(k, 293) + mat(k, 294) = lmat(k, 294) + mat(k, 295) = mat(k, 295) + lmat(k, 295) + mat(k, 296) = lmat(k, 296) + mat(k, 298) = mat(k, 298) + lmat(k, 298) + mat(k, 299) = mat(k, 299) + lmat(k, 299) + mat(k, 301) = mat(k, 301) + lmat(k, 301) + mat(k, 303) = lmat(k, 303) + mat(k, 304) = mat(k, 304) + lmat(k, 304) + mat(k, 305) = lmat(k, 305) + mat(k, 307) = mat(k, 307) + lmat(k, 307) + mat(k, 309) = lmat(k, 309) + mat(k, 310) = mat(k, 310) + lmat(k, 310) + mat(k, 311) = lmat(k, 311) + mat(k, 313) = mat(k, 313) + lmat(k, 313) + mat(k, 314) = lmat(k, 314) + mat(k, 316) = lmat(k, 316) + mat(k, 317) = mat(k, 317) + lmat(k, 317) + mat(k, 318) = lmat(k, 318) + mat(k, 319) = lmat(k, 319) + mat(k, 320) = lmat(k, 320) + mat(k, 321) = lmat(k, 321) + mat(k, 322) = lmat(k, 322) + mat(k, 323) = lmat(k, 323) + mat(k, 324) = lmat(k, 324) + mat(k, 325) = mat(k, 325) + lmat(k, 325) + mat(k, 327) = lmat(k, 327) + mat(k, 328) = lmat(k, 328) + mat(k, 329) = mat(k, 329) + lmat(k, 329) + mat(k, 330) = lmat(k, 330) + mat(k, 333) = mat(k, 333) + lmat(k, 333) + mat(k, 339) = mat(k, 339) + lmat(k, 339) + mat(k, 341) = lmat(k, 341) + mat(k, 342) = mat(k, 342) + lmat(k, 342) + mat(k, 346) = mat(k, 346) + lmat(k, 346) + mat(k, 352) = lmat(k, 352) + mat(k, 353) = lmat(k, 353) + mat(k, 354) = lmat(k, 354) + mat(k, 355) = mat(k, 355) + lmat(k, 355) + mat(k, 356) = lmat(k, 356) + mat(k, 357) = lmat(k, 357) + mat(k, 360) = lmat(k, 360) + mat(k, 361) = mat(k, 361) + lmat(k, 361) + mat(k, 362) = mat(k, 362) + lmat(k, 362) + mat(k, 366) = mat(k, 366) + lmat(k, 366) + mat(k, 367) = lmat(k, 367) + mat(k, 368) = lmat(k, 368) + mat(k, 370) = mat(k, 370) + lmat(k, 370) + mat(k, 371) = lmat(k, 371) + mat(k, 372) = lmat(k, 372) + mat(k, 375) = mat(k, 375) + lmat(k, 375) + mat(k, 383) = mat(k, 383) + lmat(k, 383) + mat(k, 390) = mat(k, 390) + lmat(k, 390) + mat(k, 391) = mat(k, 391) + lmat(k, 391) + mat(k, 394) = lmat(k, 394) + mat(k, 396) = mat(k, 396) + lmat(k, 396) + mat(k, 398) = lmat(k, 398) + mat(k, 399) = lmat(k, 399) + mat(k, 401) = mat(k, 401) + lmat(k, 401) + mat(k, 403) = lmat(k, 403) + mat(k, 404) = mat(k, 404) + lmat(k, 404) + mat(k, 408) = mat(k, 408) + lmat(k, 408) + mat(k, 414) = mat(k, 414) + lmat(k, 414) + mat(k, 415) = lmat(k, 415) + mat(k, 416) = lmat(k, 416) + mat(k, 417) = lmat(k, 417) + mat(k, 418) = mat(k, 418) + lmat(k, 418) + mat(k, 420) = lmat(k, 420) + mat(k, 421) = mat(k, 421) + lmat(k, 421) + mat(k, 422) = mat(k, 422) + lmat(k, 422) + mat(k, 424) = lmat(k, 424) + mat(k, 426) = mat(k, 426) + lmat(k, 426) + mat(k, 427) = lmat(k, 427) + mat(k, 428) = lmat(k, 428) + mat(k, 430) = mat(k, 430) + lmat(k, 430) + mat(k, 434) = mat(k, 434) + lmat(k, 434) + mat(k, 439) = lmat(k, 439) + mat(k, 442) = mat(k, 442) + lmat(k, 442) + mat(k, 450) = mat(k, 450) + lmat(k, 450) + mat(k, 458) = mat(k, 458) + lmat(k, 458) + mat(k, 460) = lmat(k, 460) + mat(k, 464) = lmat(k, 464) + mat(k, 466) = mat(k, 466) + lmat(k, 466) + mat(k, 467) = mat(k, 467) + lmat(k, 467) + mat(k, 473) = mat(k, 473) + lmat(k, 473) + mat(k, 477) = lmat(k, 477) + mat(k, 482) = mat(k, 482) + lmat(k, 482) + mat(k, 483) = lmat(k, 483) + mat(k, 484) = lmat(k, 484) + mat(k, 485) = lmat(k, 485) + mat(k, 486) = lmat(k, 486) + mat(k, 488) = mat(k, 488) + lmat(k, 488) + mat(k, 489) = lmat(k, 489) + mat(k, 490) = lmat(k, 490) + mat(k, 491) = lmat(k, 491) + mat(k, 492) = lmat(k, 492) + mat(k, 493) = mat(k, 493) + lmat(k, 493) + mat(k, 494) = lmat(k, 494) + mat(k, 498) = lmat(k, 498) + mat(k, 499) = lmat(k, 499) + mat(k, 500) = mat(k, 500) + lmat(k, 500) + mat(k, 501) = lmat(k, 501) + mat(k, 502) = lmat(k, 502) + mat(k, 503) = lmat(k, 503) + mat(k, 504) = lmat(k, 504) + mat(k, 505) = lmat(k, 505) + mat(k, 506) = mat(k, 506) + lmat(k, 506) + mat(k, 507) = mat(k, 507) + lmat(k, 507) + mat(k, 508) = lmat(k, 508) + mat(k, 510) = lmat(k, 510) + mat(k, 511) = mat(k, 511) + lmat(k, 511) + mat(k, 514) = mat(k, 514) + lmat(k, 514) + mat(k, 520) = lmat(k, 520) + mat(k, 521) = mat(k, 521) + lmat(k, 521) + mat(k, 525) = lmat(k, 525) + mat(k, 526) = lmat(k, 526) + mat(k, 528) = mat(k, 528) + lmat(k, 528) + mat(k, 529) = lmat(k, 529) + mat(k, 530) = lmat(k, 530) + mat(k, 531) = lmat(k, 531) + mat(k, 532) = mat(k, 532) + lmat(k, 532) + mat(k, 535) = mat(k, 535) + lmat(k, 535) + mat(k, 536) = mat(k, 536) + lmat(k, 536) + mat(k, 539) = mat(k, 539) + lmat(k, 539) + mat(k, 540) = lmat(k, 540) + mat(k, 541) = mat(k, 541) + lmat(k, 541) + mat(k, 543) = mat(k, 543) + lmat(k, 543) + mat(k, 550) = lmat(k, 550) + mat(k, 551) = lmat(k, 551) + mat(k, 552) = lmat(k, 552) + mat(k, 553) = lmat(k, 553) + mat(k, 554) = mat(k, 554) + lmat(k, 554) + mat(k, 558) = lmat(k, 558) + mat(k, 561) = lmat(k, 561) + mat(k, 563) = mat(k, 563) + lmat(k, 563) + mat(k, 564) = lmat(k, 564) + mat(k, 567) = mat(k, 567) + lmat(k, 567) + mat(k, 574) = mat(k, 574) + lmat(k, 574) + mat(k, 585) = mat(k, 585) + lmat(k, 585) + mat(k, 596) = mat(k, 596) + lmat(k, 596) + mat(k, 598) = lmat(k, 598) + mat(k, 599) = lmat(k, 599) + mat(k, 601) = lmat(k, 601) + mat(k, 602) = lmat(k, 602) + mat(k, 609) = mat(k, 609) + lmat(k, 609) + mat(k, 620) = mat(k, 620) + lmat(k, 620) + mat(k, 629) = mat(k, 629) + lmat(k, 629) + mat(k, 638) = mat(k, 638) + lmat(k, 638) + mat(k, 639) = mat(k, 639) + lmat(k, 639) + mat(k, 643) = lmat(k, 643) + mat(k, 648) = mat(k, 648) + lmat(k, 648) + mat(k, 649) = lmat(k, 649) + mat(k, 650) = mat(k, 650) + lmat(k, 650) + mat(k, 656) = mat(k, 656) + lmat(k, 656) + mat(k, 661) = mat(k, 661) + lmat(k, 661) + mat(k, 671) = mat(k, 671) + lmat(k, 671) + mat(k, 676) = mat(k, 676) + lmat(k, 676) + mat(k, 677) = mat(k, 677) + lmat(k, 677) + mat(k, 681) = mat(k, 681) + lmat(k, 681) + mat(k, 686) = mat(k, 686) + lmat(k, 686) + mat(k, 694) = mat(k, 694) + lmat(k, 694) + mat(k, 695) = mat(k, 695) + lmat(k, 695) + mat(k, 696) = mat(k, 696) + lmat(k, 696) + mat(k, 706) = mat(k, 706) + lmat(k, 706) + mat(k, 723) = mat(k, 723) + lmat(k, 723) + mat(k, 724) = lmat(k, 724) + mat(k, 726) = lmat(k, 726) + mat(k, 729) = mat(k, 729) + lmat(k, 729) + mat(k, 731) = lmat(k, 731) + mat(k, 733) = lmat(k, 733) + mat(k, 734) = mat(k, 734) + lmat(k, 734) + mat(k, 735) = lmat(k, 735) + mat(k, 736) = mat(k, 736) + lmat(k, 736) + mat(k, 737) = mat(k, 737) + lmat(k, 737) + mat(k, 739) = mat(k, 739) + lmat(k, 739) + mat(k, 741) = mat(k, 741) + lmat(k, 741) + mat(k, 759) = mat(k, 759) + lmat(k, 759) + mat(k, 786) = mat(k, 786) + lmat(k, 786) + mat(k, 808) = mat(k, 808) + lmat(k, 808) + mat(k, 818) = mat(k, 818) + lmat(k, 818) + mat(k, 820) = lmat(k, 820) + mat(k, 821) = lmat(k, 821) + mat(k, 825) = mat(k, 825) + lmat(k, 825) + mat(k, 826) = mat(k, 826) + lmat(k, 826) + mat(k, 827) = mat(k, 827) + lmat(k, 827) + mat(k, 830) = mat(k, 830) + lmat(k, 830) + mat(k, 831) = lmat(k, 831) + mat(k, 833) = mat(k, 833) + lmat(k, 833) + mat(k, 834) = mat(k, 834) + lmat(k, 834) + mat(k, 840) = mat(k, 840) + lmat(k, 840) + mat(k, 855) = mat(k, 855) + lmat(k, 855) + mat(k, 856) = lmat(k, 856) + mat(k, 857) = lmat(k, 857) + mat(k, 861) = lmat(k, 861) + mat(k, 864) = mat(k, 864) + lmat(k, 864) + mat(k, 865) = lmat(k, 865) + mat(k, 867) = mat(k, 867) + lmat(k, 867) + mat(k, 868) = mat(k, 868) + lmat(k, 868) + mat(k, 869) = lmat(k, 869) + mat(k, 873) = mat(k, 873) + lmat(k, 873) + mat(k, 877) = lmat(k, 877) + mat(k, 881) = mat(k, 881) + lmat(k, 881) + mat(k, 883) = lmat(k, 883) + mat(k, 884) = mat(k, 884) + lmat(k, 884) + mat(k, 885) = mat(k, 885) + lmat(k, 885) + mat(k, 886) = mat(k, 886) + lmat(k, 886) + mat(k, 887) = mat(k, 887) + lmat(k, 887) + mat(k, 888) = mat(k, 888) + lmat(k, 888) + mat(k, 891) = mat(k, 891) + lmat(k, 891) + mat(k, 892) = mat(k, 892) + lmat(k, 892) + mat(k, 894) = mat(k, 894) + lmat(k, 894) + mat(k, 895) = lmat(k, 895) + mat(k, 898) = lmat(k, 898) + mat(k, 900) = lmat(k, 900) + mat(k, 903) = mat(k, 903) + lmat(k, 903) + mat(k, 908) = lmat(k, 908) + mat(k, 909) = lmat(k, 909) + mat(k, 910) = lmat(k, 910) + mat(k, 911) = lmat(k, 911) + mat(k, 912) = mat(k, 912) + lmat(k, 912) + mat(k, 913) = lmat(k, 913) + mat(k, 915) = lmat(k, 915) + mat(k, 916) = lmat(k, 916) + mat(k, 920) = lmat(k, 920) + mat(k, 921) = mat(k, 921) + lmat(k, 921) + mat(k, 922) = lmat(k, 922) + mat(k, 925) = mat(k, 925) + lmat(k, 925) + mat(k, 927) = lmat(k, 927) + mat(k, 929) = lmat(k, 929) + mat(k, 930) = mat(k, 930) + lmat(k, 930) + mat(k, 938) = mat(k, 938) + lmat(k, 938) + mat(k, 960) = mat(k, 960) + lmat(k, 960) + mat(k, 979) = mat(k, 979) + lmat(k, 979) + mat(k, 995) = mat(k, 995) + lmat(k, 995) + mat(k,1011) = mat(k,1011) + lmat(k,1011) + mat(k,1024) = mat(k,1024) + lmat(k,1024) + mat(k,1044) = mat(k,1044) + lmat(k,1044) + mat(k,1059) = mat(k,1059) + lmat(k,1059) + mat(k,1060) = mat(k,1060) + lmat(k,1060) + mat(k,1063) = mat(k,1063) + lmat(k,1063) + mat(k,1064) = mat(k,1064) + lmat(k,1064) + mat(k,1067) = mat(k,1067) + lmat(k,1067) + mat(k,1068) = mat(k,1068) + lmat(k,1068) + mat(k,1071) = mat(k,1071) + lmat(k,1071) + mat(k,1072) = mat(k,1072) + lmat(k,1072) + mat(k,1073) = mat(k,1073) + lmat(k,1073) + mat(k,1077) = lmat(k,1077) + mat(k,1081) = lmat(k,1081) + mat(k,1082) = mat(k,1082) + lmat(k,1082) + mat(k,1083) = mat(k,1083) + lmat(k,1083) + mat(k,1088) = lmat(k,1088) + mat(k,1096) = lmat(k,1096) + mat(k,1113) = mat(k,1113) + lmat(k,1113) + mat(k,1123) = mat(k,1123) + lmat(k,1123) + mat(k,1130) = lmat(k,1130) + mat(k,1132) = mat(k,1132) + lmat(k,1132) + mat(k,1135) = mat(k,1135) + lmat(k,1135) + mat(k,1137) = mat(k,1137) + lmat(k,1137) + mat(k,1140) = lmat(k,1140) + mat(k,1157) = mat(k,1157) + lmat(k,1157) + mat(k,1183) = mat(k,1183) + lmat(k,1183) + mat(k,1202) = mat(k,1202) + lmat(k,1202) + mat(k,1233) = mat(k,1233) + lmat(k,1233) + mat(k,1247) = mat(k,1247) + lmat(k,1247) + mat(k,1260) = mat(k,1260) + lmat(k,1260) + mat(k,1264) = mat(k,1264) + lmat(k,1264) + mat(k,1266) = lmat(k,1266) + mat(k,1273) = mat(k,1273) + lmat(k,1273) + mat(k,1278) = mat(k,1278) + lmat(k,1278) + mat(k,1320) = mat(k,1320) + lmat(k,1320) + mat(k,1334) = mat(k,1334) + lmat(k,1334) + mat(k,1335) = mat(k,1335) + lmat(k,1335) + mat(k,1337) = mat(k,1337) + lmat(k,1337) + mat(k,1339) = mat(k,1339) + lmat(k,1339) + mat(k,1340) = mat(k,1340) + lmat(k,1340) + mat(k,1342) = mat(k,1342) + lmat(k,1342) + mat(k,1343) = lmat(k,1343) + mat(k,1344) = mat(k,1344) + lmat(k,1344) + mat(k,1345) = mat(k,1345) + lmat(k,1345) + mat(k,1347) = lmat(k,1347) + mat(k,1348) = lmat(k,1348) + mat(k,1349) = lmat(k,1349) + mat(k,1351) = lmat(k,1351) + mat(k,1355) = mat(k,1355) + lmat(k,1355) + mat(k,1375) = lmat(k,1375) + mat(k,1380) = lmat(k,1380) + mat(k,1494) = mat(k,1494) + lmat(k,1494) + mat(k,1497) = mat(k,1497) + lmat(k,1497) + mat(k,1499) = mat(k,1499) + lmat(k,1499) + mat(k,1503) = mat(k,1503) + lmat(k,1503) + mat(k,1509) = mat(k,1509) + lmat(k,1509) + mat(k,1511) = mat(k,1511) + lmat(k,1511) + mat(k,1518) = mat(k,1518) + lmat(k,1518) + mat(k,1524) = mat(k,1524) + lmat(k,1524) + mat(k,1526) = mat(k,1526) + lmat(k,1526) + mat(k,1539) = mat(k,1539) + lmat(k,1539) + mat(k,1540) = lmat(k,1540) + mat(k,1543) = mat(k,1543) + lmat(k,1543) + mat(k,1548) = mat(k,1548) + lmat(k,1548) + mat(k,1579) = mat(k,1579) + lmat(k,1579) + mat(k,1583) = mat(k,1583) + lmat(k,1583) + mat(k,1686) = mat(k,1686) + lmat(k,1686) + mat(k,1694) = mat(k,1694) + lmat(k,1694) + mat(k,1711) = mat(k,1711) + lmat(k,1711) + mat(k,1713) = mat(k,1713) + lmat(k,1713) + mat(k,1718) = mat(k,1718) + lmat(k,1718) + mat(k,1739) = mat(k,1739) + lmat(k,1739) + mat(k,1801) = mat(k,1801) + lmat(k,1801) + mat(k,1804) = mat(k,1804) + lmat(k,1804) + mat(k,1857) = mat(k,1857) + lmat(k,1857) + mat(k,1861) = mat(k,1861) + lmat(k,1861) + mat(k,1865) = mat(k,1865) + lmat(k,1865) + mat(k,1895) = mat(k,1895) + lmat(k,1895) + mat(k,1899) = mat(k,1899) + lmat(k,1899) + mat(k,1902) = mat(k,1902) + lmat(k,1902) + mat(k,1905) = mat(k,1905) + lmat(k,1905) + mat(k,1907) = mat(k,1907) + lmat(k,1907) + mat(k,1919) = mat(k,1919) + lmat(k,1919) + mat(k,1931) = mat(k,1931) + lmat(k,1931) + mat(k,1932) = mat(k,1932) + lmat(k,1932) + mat(k,1948) = mat(k,1948) + lmat(k,1948) + mat(k,1951) = lmat(k,1951) + mat(k,1954) = lmat(k,1954) + mat(k,1960) = mat(k,1960) + lmat(k,1960) + mat(k,1965) = mat(k,1965) + lmat(k,1965) + mat(k,1966) = mat(k,1966) + lmat(k,1966) + mat(k,2009) = mat(k,2009) + lmat(k,2009) + mat(k,2016) = mat(k,2016) + lmat(k,2016) + mat(k,2019) = mat(k,2019) + lmat(k,2019) + mat(k,2021) = mat(k,2021) + lmat(k,2021) + mat(k,2024) = mat(k,2024) + lmat(k,2024) + mat(k,2031) = lmat(k,2031) + mat(k,2035) = lmat(k,2035) + mat(k,2037) = mat(k,2037) + lmat(k,2037) + mat(k,2038) = mat(k,2038) + lmat(k,2038) + mat(k,2041) = lmat(k,2041) + mat(k,2050) = mat(k,2050) + lmat(k,2050) + mat(k, 137) = 0._r8 + mat(k, 138) = 0._r8 + mat(k, 241) = 0._r8 + mat(k, 334) = 0._r8 + mat(k, 335) = 0._r8 + mat(k, 348) = 0._r8 + mat(k, 376) = 0._r8 + mat(k, 378) = 0._r8 + mat(k, 386) = 0._r8 + mat(k, 495) = 0._r8 + mat(k, 497) = 0._r8 + mat(k, 515) = 0._r8 + mat(k, 518) = 0._r8 + mat(k, 522) = 0._r8 + mat(k, 523) = 0._r8 + mat(k, 527) = 0._r8 + mat(k, 533) = 0._r8 + mat(k, 534) = 0._r8 + mat(k, 537) = 0._r8 + mat(k, 555) = 0._r8 + mat(k, 557) = 0._r8 + mat(k, 559) = 0._r8 + mat(k, 560) = 0._r8 + mat(k, 562) = 0._r8 + mat(k, 568) = 0._r8 + mat(k, 569) = 0._r8 + mat(k, 584) = 0._r8 + mat(k, 586) = 0._r8 + mat(k, 588) = 0._r8 + mat(k, 589) = 0._r8 + mat(k, 591) = 0._r8 + mat(k, 608) = 0._r8 + mat(k, 610) = 0._r8 + mat(k, 612) = 0._r8 + mat(k, 613) = 0._r8 + mat(k, 615) = 0._r8 + mat(k, 616) = 0._r8 + mat(k, 631) = 0._r8 + mat(k, 632) = 0._r8 + mat(k, 637) = 0._r8 + mat(k, 654) = 0._r8 + mat(k, 665) = 0._r8 + mat(k, 670) = 0._r8 + mat(k, 689) = 0._r8 + mat(k, 721) = 0._r8 + mat(k, 728) = 0._r8 + mat(k, 758) = 0._r8 + mat(k, 760) = 0._r8 + mat(k, 768) = 0._r8 + mat(k, 775) = 0._r8 + mat(k, 785) = 0._r8 + mat(k, 787) = 0._r8 + mat(k, 795) = 0._r8 + mat(k, 802) = 0._r8 + mat(k, 806) = 0._r8 + mat(k, 807) = 0._r8 + mat(k, 811) = 0._r8 + mat(k, 812) = 0._r8 + mat(k, 813) = 0._r8 + mat(k, 835) = 0._r8 + mat(k, 843) = 0._r8 + mat(k, 844) = 0._r8 + mat(k, 845) = 0._r8 + mat(k, 850) = 0._r8 + mat(k, 852) = 0._r8 + mat(k, 854) = 0._r8 + mat(k, 872) = 0._r8 + mat(k, 874) = 0._r8 + mat(k, 875) = 0._r8 + mat(k, 876) = 0._r8 + mat(k, 878) = 0._r8 + mat(k, 880) = 0._r8 + mat(k, 882) = 0._r8 + mat(k, 889) = 0._r8 + mat(k, 893) = 0._r8 + mat(k, 914) = 0._r8 + mat(k, 917) = 0._r8 + mat(k, 918) = 0._r8 + mat(k, 923) = 0._r8 + mat(k, 924) = 0._r8 + mat(k, 936) = 0._r8 + mat(k, 937) = 0._r8 + mat(k, 939) = 0._r8 + mat(k, 940) = 0._r8 + mat(k, 941) = 0._r8 + mat(k, 942) = 0._r8 + mat(k, 943) = 0._r8 + mat(k, 944) = 0._r8 + mat(k, 946) = 0._r8 + mat(k, 951) = 0._r8 + mat(k, 952) = 0._r8 + mat(k, 961) = 0._r8 + mat(k, 962) = 0._r8 + mat(k, 963) = 0._r8 + mat(k, 964) = 0._r8 + mat(k, 966) = 0._r8 + mat(k, 971) = 0._r8 + mat(k, 976) = 0._r8 + mat(k, 977) = 0._r8 + mat(k, 978) = 0._r8 + mat(k, 980) = 0._r8 + mat(k, 981) = 0._r8 + mat(k, 982) = 0._r8 + mat(k, 983) = 0._r8 + mat(k, 985) = 0._r8 + mat(k, 991) = 0._r8 + mat(k,1004) = 0._r8 + mat(k,1014) = 0._r8 + mat(k,1016) = 0._r8 + mat(k,1025) = 0._r8 + mat(k,1027) = 0._r8 + mat(k,1033) = 0._r8 + mat(k,1037) = 0._r8 + mat(k,1039) = 0._r8 + mat(k,1040) = 0._r8 + mat(k,1042) = 0._r8 + mat(k,1043) = 0._r8 + mat(k,1045) = 0._r8 + mat(k,1046) = 0._r8 + mat(k,1047) = 0._r8 + mat(k,1049) = 0._r8 + mat(k,1050) = 0._r8 + mat(k,1052) = 0._r8 + mat(k,1065) = 0._r8 + mat(k,1075) = 0._r8 + mat(k,1089) = 0._r8 + mat(k,1095) = 0._r8 + mat(k,1099) = 0._r8 + mat(k,1102) = 0._r8 + mat(k,1104) = 0._r8 + mat(k,1106) = 0._r8 + mat(k,1107) = 0._r8 + mat(k,1109) = 0._r8 + mat(k,1110) = 0._r8 + mat(k,1111) = 0._r8 + mat(k,1114) = 0._r8 + mat(k,1115) = 0._r8 + mat(k,1116) = 0._r8 + mat(k,1118) = 0._r8 + mat(k,1119) = 0._r8 + mat(k,1121) = 0._r8 + mat(k,1125) = 0._r8 + mat(k,1128) = 0._r8 + mat(k,1133) = 0._r8 + mat(k,1138) = 0._r8 + mat(k,1139) = 0._r8 + mat(k,1144) = 0._r8 + mat(k,1146) = 0._r8 + mat(k,1147) = 0._r8 + mat(k,1148) = 0._r8 + mat(k,1155) = 0._r8 + mat(k,1158) = 0._r8 + mat(k,1160) = 0._r8 + mat(k,1161) = 0._r8 + mat(k,1163) = 0._r8 + mat(k,1169) = 0._r8 + mat(k,1173) = 0._r8 + mat(k,1174) = 0._r8 + mat(k,1175) = 0._r8 + mat(k,1176) = 0._r8 + mat(k,1177) = 0._r8 + mat(k,1178) = 0._r8 + mat(k,1180) = 0._r8 + mat(k,1182) = 0._r8 + mat(k,1184) = 0._r8 + mat(k,1186) = 0._r8 + mat(k,1187) = 0._r8 + mat(k,1189) = 0._r8 + mat(k,1193) = 0._r8 + mat(k,1196) = 0._r8 + mat(k,1200) = 0._r8 + mat(k,1201) = 0._r8 + mat(k,1204) = 0._r8 + mat(k,1205) = 0._r8 + mat(k,1214) = 0._r8 + mat(k,1234) = 0._r8 + mat(k,1235) = 0._r8 + mat(k,1243) = 0._r8 + mat(k,1244) = 0._r8 + mat(k,1248) = 0._r8 + mat(k,1249) = 0._r8 + mat(k,1250) = 0._r8 + mat(k,1253) = 0._r8 + mat(k,1256) = 0._r8 + mat(k,1259) = 0._r8 + mat(k,1261) = 0._r8 + mat(k,1262) = 0._r8 + mat(k,1263) = 0._r8 + mat(k,1265) = 0._r8 + mat(k,1267) = 0._r8 + mat(k,1268) = 0._r8 + mat(k,1272) = 0._r8 + mat(k,1274) = 0._r8 + mat(k,1275) = 0._r8 + mat(k,1280) = 0._r8 + mat(k,1281) = 0._r8 + mat(k,1282) = 0._r8 + mat(k,1283) = 0._r8 + mat(k,1294) = 0._r8 + mat(k,1318) = 0._r8 + mat(k,1319) = 0._r8 + mat(k,1321) = 0._r8 + mat(k,1322) = 0._r8 + mat(k,1324) = 0._r8 + mat(k,1328) = 0._r8 + mat(k,1330) = 0._r8 + mat(k,1332) = 0._r8 + mat(k,1333) = 0._r8 + mat(k,1341) = 0._r8 + mat(k,1353) = 0._r8 + mat(k,1356) = 0._r8 + mat(k,1418) = 0._r8 + mat(k,1438) = 0._r8 + mat(k,1446) = 0._r8 + mat(k,1450) = 0._r8 + mat(k,1452) = 0._r8 + mat(k,1463) = 0._r8 + mat(k,1484) = 0._r8 + mat(k,1498) = 0._r8 + mat(k,1519) = 0._r8 + mat(k,1520) = 0._r8 + mat(k,1521) = 0._r8 + mat(k,1522) = 0._r8 + mat(k,1525) = 0._r8 + mat(k,1530) = 0._r8 + mat(k,1532) = 0._r8 + mat(k,1534) = 0._r8 + mat(k,1535) = 0._r8 + mat(k,1537) = 0._r8 + mat(k,1544) = 0._r8 + mat(k,1545) = 0._r8 + mat(k,1547) = 0._r8 + mat(k,1551) = 0._r8 + mat(k,1552) = 0._r8 + mat(k,1553) = 0._r8 + mat(k,1554) = 0._r8 + mat(k,1560) = 0._r8 + mat(k,1566) = 0._r8 + mat(k,1572) = 0._r8 + mat(k,1574) = 0._r8 + mat(k,1575) = 0._r8 + mat(k,1588) = 0._r8 + mat(k,1604) = 0._r8 + mat(k,1621) = 0._r8 + mat(k,1622) = 0._r8 + mat(k,1633) = 0._r8 + mat(k,1651) = 0._r8 + mat(k,1655) = 0._r8 + mat(k,1656) = 0._r8 + mat(k,1657) = 0._r8 + mat(k,1658) = 0._r8 + mat(k,1661) = 0._r8 + mat(k,1669) = 0._r8 + mat(k,1672) = 0._r8 + mat(k,1678) = 0._r8 + mat(k,1681) = 0._r8 + mat(k,1704) = 0._r8 + mat(k,1705) = 0._r8 + mat(k,1707) = 0._r8 + mat(k,1715) = 0._r8 + mat(k,1719) = 0._r8 + mat(k,1720) = 0._r8 + mat(k,1766) = 0._r8 + mat(k,1794) = 0._r8 + mat(k,1795) = 0._r8 + mat(k,1797) = 0._r8 + mat(k,1807) = 0._r8 + mat(k,1810) = 0._r8 + mat(k,1823) = 0._r8 + mat(k,1827) = 0._r8 + mat(k,1830) = 0._r8 + mat(k,1834) = 0._r8 + mat(k,1838) = 0._r8 + mat(k,1839) = 0._r8 + mat(k,1840) = 0._r8 + mat(k,1841) = 0._r8 + mat(k,1843) = 0._r8 + mat(k,1847) = 0._r8 + mat(k,1849) = 0._r8 + mat(k,1850) = 0._r8 + mat(k,1851) = 0._r8 + mat(k,1854) = 0._r8 + mat(k,1867) = 0._r8 + mat(k,1870) = 0._r8 + mat(k,1880) = 0._r8 + mat(k,1883) = 0._r8 + mat(k,1885) = 0._r8 + mat(k,1888) = 0._r8 + mat(k,1889) = 0._r8 + mat(k,1890) = 0._r8 + mat(k,1894) = 0._r8 + mat(k,1896) = 0._r8 + mat(k,1897) = 0._r8 + mat(k,1898) = 0._r8 + mat(k,1901) = 0._r8 + mat(k,1908) = 0._r8 + mat(k,1909) = 0._r8 + mat(k,1911) = 0._r8 + mat(k,1917) = 0._r8 + mat(k,1920) = 0._r8 + mat(k,1923) = 0._r8 + mat(k,1924) = 0._r8 + mat(k,1926) = 0._r8 + mat(k,1928) = 0._r8 + mat(k,1929) = 0._r8 + mat(k,1930) = 0._r8 + mat(k,1933) = 0._r8 + mat(k,1940) = 0._r8 + mat(k,1941) = 0._r8 + mat(k,1944) = 0._r8 + mat(k,1946) = 0._r8 + mat(k,1947) = 0._r8 + mat(k,1950) = 0._r8 + mat(k,1952) = 0._r8 + mat(k,1955) = 0._r8 + mat(k,1957) = 0._r8 + mat(k,1959) = 0._r8 + mat(k,1962) = 0._r8 + mat(k,1964) = 0._r8 + mat(k,1968) = 0._r8 + mat(k,1975) = 0._r8 + mat(k,1982) = 0._r8 + mat(k,1988) = 0._r8 + mat(k,1991) = 0._r8 + mat(k,1993) = 0._r8 + mat(k,1996) = 0._r8 + mat(k,2001) = 0._r8 + mat(k,2008) = 0._r8 + mat(k,2010) = 0._r8 + mat(k,2011) = 0._r8 + mat(k,2012) = 0._r8 + mat(k,2014) = 0._r8 + mat(k,2018) = 0._r8 + mat(k,2020) = 0._r8 + mat(k,2022) = 0._r8 + mat(k,2023) = 0._r8 + mat(k,2025) = 0._r8 + mat(k,2030) = 0._r8 + mat(k,2032) = 0._r8 + mat(k,2033) = 0._r8 + mat(k,2034) = 0._r8 + mat(k,2036) = 0._r8 + mat(k,2039) = 0._r8 + mat(k,2040) = 0._r8 + mat(k,2042) = 0._r8 + mat(k,2043) = 0._r8 + mat(k,2044) = 0._r8 + mat(k,2045) = 0._r8 + mat(k,2046) = 0._r8 + mat(k,2047) = 0._r8 + mat(k,2048) = 0._r8 + mat(k,2049) = 0._r8 + mat(k, 1) = mat(k, 1) - dti(k) + mat(k, 2) = mat(k, 2) - dti(k) + mat(k, 3) = mat(k, 3) - dti(k) + mat(k, 4) = mat(k, 4) - dti(k) + mat(k, 5) = mat(k, 5) - dti(k) + mat(k, 6) = mat(k, 6) - dti(k) + mat(k, 12) = mat(k, 12) - dti(k) + mat(k, 18) = mat(k, 18) - dti(k) + mat(k, 24) = mat(k, 24) - dti(k) + mat(k, 30) = mat(k, 30) - dti(k) + mat(k, 36) = mat(k, 36) - dti(k) + mat(k, 38) = mat(k, 38) - dti(k) + mat(k, 44) = mat(k, 44) - dti(k) + mat(k, 50) = mat(k, 50) - dti(k) + mat(k, 56) = mat(k, 56) - dti(k) + mat(k, 57) = mat(k, 57) - dti(k) + mat(k, 60) = mat(k, 60) - dti(k) + mat(k, 63) = mat(k, 63) - dti(k) + mat(k, 66) = mat(k, 66) - dti(k) + mat(k, 70) = mat(k, 70) - dti(k) + mat(k, 73) = mat(k, 73) - dti(k) + mat(k, 76) = mat(k, 76) - dti(k) + mat(k, 79) = mat(k, 79) - dti(k) + mat(k, 82) = mat(k, 82) - dti(k) + mat(k, 85) = mat(k, 85) - dti(k) + mat(k, 88) = mat(k, 88) - dti(k) + mat(k, 94) = mat(k, 94) - dti(k) + mat(k, 98) = mat(k, 98) - dti(k) + mat(k, 103) = mat(k, 103) - dti(k) + mat(k, 107) = mat(k, 107) - dti(k) + mat(k, 112) = mat(k, 112) - dti(k) + mat(k, 119) = mat(k, 119) - dti(k) + mat(k, 124) = mat(k, 124) - dti(k) + mat(k, 128) = mat(k, 128) - dti(k) + mat(k, 133) = mat(k, 133) - dti(k) + mat(k, 141) = mat(k, 141) - dti(k) + mat(k, 146) = mat(k, 146) - dti(k) + mat(k, 149) = mat(k, 149) - dti(k) + mat(k, 154) = mat(k, 154) - dti(k) + mat(k, 157) = mat(k, 157) - dti(k) + mat(k, 160) = mat(k, 160) - dti(k) + mat(k, 163) = mat(k, 163) - dti(k) + mat(k, 166) = mat(k, 166) - dti(k) + mat(k, 170) = mat(k, 170) - dti(k) + mat(k, 175) = mat(k, 175) - dti(k) + mat(k, 179) = mat(k, 179) - dti(k) + mat(k, 183) = mat(k, 183) - dti(k) + mat(k, 189) = mat(k, 189) - dti(k) + mat(k, 195) = mat(k, 195) - dti(k) + mat(k, 201) = mat(k, 201) - dti(k) + mat(k, 207) = mat(k, 207) - dti(k) + mat(k, 210) = mat(k, 210) - dti(k) + mat(k, 213) = mat(k, 213) - dti(k) + mat(k, 218) = mat(k, 218) - dti(k) + mat(k, 223) = mat(k, 223) - dti(k) + mat(k, 228) = mat(k, 228) - dti(k) + mat(k, 233) = mat(k, 233) - dti(k) + mat(k, 239) = mat(k, 239) - dti(k) + mat(k, 244) = mat(k, 244) - dti(k) + mat(k, 249) = mat(k, 249) - dti(k) + mat(k, 257) = mat(k, 257) - dti(k) + mat(k, 265) = mat(k, 265) - dti(k) + mat(k, 271) = mat(k, 271) - dti(k) + mat(k, 277) = mat(k, 277) - dti(k) + mat(k, 283) = mat(k, 283) - dti(k) + mat(k, 289) = mat(k, 289) - dti(k) + mat(k, 295) = mat(k, 295) - dti(k) + mat(k, 301) = mat(k, 301) - dti(k) + mat(k, 307) = mat(k, 307) - dti(k) + mat(k, 313) = mat(k, 313) - dti(k) + mat(k, 319) = mat(k, 319) - dti(k) + mat(k, 325) = mat(k, 325) - dti(k) + mat(k, 333) = mat(k, 333) - dti(k) + mat(k, 339) = mat(k, 339) - dti(k) + mat(k, 346) = mat(k, 346) - dti(k) + mat(k, 352) = mat(k, 352) - dti(k) + mat(k, 355) = mat(k, 355) - dti(k) + mat(k, 362) = mat(k, 362) - dti(k) + mat(k, 366) = mat(k, 366) - dti(k) + mat(k, 375) = mat(k, 375) - dti(k) + mat(k, 383) = mat(k, 383) - dti(k) + mat(k, 390) = mat(k, 390) - dti(k) + mat(k, 396) = mat(k, 396) - dti(k) + mat(k, 401) = mat(k, 401) - dti(k) + mat(k, 408) = mat(k, 408) - dti(k) + mat(k, 414) = mat(k, 414) - dti(k) + mat(k, 422) = mat(k, 422) - dti(k) + mat(k, 430) = mat(k, 430) - dti(k) + mat(k, 434) = mat(k, 434) - dti(k) + mat(k, 442) = mat(k, 442) - dti(k) + mat(k, 450) = mat(k, 450) - dti(k) + mat(k, 458) = mat(k, 458) - dti(k) + mat(k, 466) = mat(k, 466) - dti(k) + mat(k, 473) = mat(k, 473) - dti(k) + mat(k, 482) = mat(k, 482) - dti(k) + mat(k, 493) = mat(k, 493) - dti(k) + mat(k, 502) = mat(k, 502) - dti(k) + mat(k, 506) = mat(k, 506) - dti(k) + mat(k, 514) = mat(k, 514) - dti(k) + mat(k, 521) = mat(k, 521) - dti(k) + mat(k, 532) = mat(k, 532) - dti(k) + mat(k, 543) = mat(k, 543) - dti(k) + mat(k, 554) = mat(k, 554) - dti(k) + mat(k, 567) = mat(k, 567) - dti(k) + mat(k, 574) = mat(k, 574) - dti(k) + mat(k, 585) = mat(k, 585) - dti(k) + mat(k, 596) = mat(k, 596) - dti(k) + mat(k, 609) = mat(k, 609) - dti(k) + mat(k, 620) = mat(k, 620) - dti(k) + mat(k, 629) = mat(k, 629) - dti(k) + mat(k, 639) = mat(k, 639) - dti(k) + mat(k, 648) = mat(k, 648) - dti(k) + mat(k, 656) = mat(k, 656) - dti(k) + mat(k, 661) = mat(k, 661) - dti(k) + mat(k, 671) = mat(k, 671) - dti(k) + mat(k, 676) = mat(k, 676) - dti(k) + mat(k, 686) = mat(k, 686) - dti(k) + mat(k, 694) = mat(k, 694) - dti(k) + mat(k, 706) = mat(k, 706) - dti(k) + mat(k, 723) = mat(k, 723) - dti(k) + mat(k, 729) = mat(k, 729) - dti(k) + mat(k, 736) = mat(k, 736) - dti(k) + mat(k, 741) = mat(k, 741) - dti(k) + mat(k, 759) = mat(k, 759) - dti(k) + mat(k, 786) = mat(k, 786) - dti(k) + mat(k, 808) = mat(k, 808) - dti(k) + mat(k, 818) = mat(k, 818) - dti(k) + mat(k, 826) = mat(k, 826) - dti(k) + mat(k, 840) = mat(k, 840) - dti(k) + mat(k, 855) = mat(k, 855) - dti(k) + mat(k, 864) = mat(k, 864) - dti(k) + mat(k, 873) = mat(k, 873) - dti(k) + mat(k, 885) = mat(k, 885) - dti(k) + mat(k, 894) = mat(k, 894) - dti(k) + mat(k, 903) = mat(k, 903) - dti(k) + mat(k, 912) = mat(k, 912) - dti(k) + mat(k, 925) = mat(k, 925) - dti(k) + mat(k, 938) = mat(k, 938) - dti(k) + mat(k, 960) = mat(k, 960) - dti(k) + mat(k, 979) = mat(k, 979) - dti(k) + mat(k, 995) = mat(k, 995) - dti(k) + mat(k,1011) = mat(k,1011) - dti(k) + mat(k,1024) = mat(k,1024) - dti(k) + mat(k,1044) = mat(k,1044) - dti(k) + mat(k,1060) = mat(k,1060) - dti(k) + mat(k,1072) = mat(k,1072) - dti(k) + mat(k,1083) = mat(k,1083) - dti(k) + mat(k,1113) = mat(k,1113) - dti(k) + mat(k,1135) = mat(k,1135) - dti(k) + mat(k,1157) = mat(k,1157) - dti(k) + mat(k,1183) = mat(k,1183) - dti(k) + mat(k,1202) = mat(k,1202) - dti(k) + mat(k,1233) = mat(k,1233) - dti(k) + mat(k,1247) = mat(k,1247) - dti(k) + mat(k,1260) = mat(k,1260) - dti(k) + mat(k,1273) = mat(k,1273) - dti(k) + mat(k,1320) = mat(k,1320) - dti(k) + mat(k,1344) = mat(k,1344) - dti(k) + mat(k,1499) = mat(k,1499) - dti(k) + mat(k,1524) = mat(k,1524) - dti(k) + mat(k,1548) = mat(k,1548) - dti(k) + mat(k,1579) = mat(k,1579) - dti(k) + mat(k,1686) = mat(k,1686) - dti(k) + mat(k,1713) = mat(k,1713) - dti(k) + mat(k,1804) = mat(k,1804) - dti(k) + mat(k,1865) = mat(k,1865) - dti(k) + mat(k,1907) = mat(k,1907) - dti(k) + mat(k,1931) = mat(k,1931) - dti(k) + mat(k,1966) = mat(k,1966) - dti(k) + mat(k,2024) = mat(k,2024) - dti(k) + mat(k,2050) = mat(k,2050) - dti(k) + end do + end subroutine nlnmat_finit + subroutine nlnmat( avec_len, mat, y, rxt, lmat, dti ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: dti(veclen) + real(r8), intent(in) :: lmat(veclen,nzcnt) + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(inout) :: mat(veclen,nzcnt) + call nlnmat01( avec_len, mat, y, rxt ) + call nlnmat02( avec_len, mat, y, rxt ) + call nlnmat03( avec_len, mat, y, rxt ) + call nlnmat04( avec_len, mat, y, rxt ) + call nlnmat05( avec_len, mat, y, rxt ) + call nlnmat06( avec_len, mat, y, rxt ) + call nlnmat07( avec_len, mat, y, rxt ) + call nlnmat08( avec_len, mat, y, rxt ) + call nlnmat09( avec_len, mat, y, rxt ) + call nlnmat_finit( avec_len, mat, lmat, dti ) + end subroutine nlnmat + end module mo_nln_matrix diff --git a/src/chemistry/pp_trop_strat_noaero/mo_phtadj.F90 b/src/chemistry/pp_trop_strat_noaero/mo_phtadj.F90 new file mode 100644 index 0000000000..6698bf2f2b --- /dev/null +++ b/src/chemistry/pp_trop_strat_noaero/mo_phtadj.F90 @@ -0,0 +1,27 @@ + module mo_phtadj + private + public :: phtadj + contains + subroutine phtadj( p_rate, inv, m, ncol, nlev ) + use chem_mods, only : nfs, phtcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: ncol, nlev + real(r8), intent(in) :: inv(ncol,nlev,max(1,nfs)) + real(r8), intent(in) :: m(ncol,nlev) + real(r8), intent(inout) :: p_rate(ncol,nlev,max(1,phtcnt)) +!-------------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------------- + integer :: k + real(r8) :: im(ncol,nlev) + do k = 1,nlev + im(:ncol,k) = 1._r8 / m(:ncol,k) + p_rate(:,k, 5) = p_rate(:,k, 5) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 6) = p_rate(:,k, 6) * inv(:,k, 2) * im(:,k) + end do + end subroutine phtadj + end module mo_phtadj diff --git a/src/chemistry/pp_trop_strat_noaero/mo_prod_loss.F90 b/src/chemistry/pp_trop_strat_noaero/mo_prod_loss.F90 new file mode 100644 index 0000000000..e75d19c1a8 --- /dev/null +++ b/src/chemistry/pp_trop_strat_noaero/mo_prod_loss.F90 @@ -0,0 +1,1159 @@ + module mo_prod_loss + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : veclen + private + public :: exp_prod_loss + public :: imp_prod_loss + contains + subroutine exp_prod_loss( ofl, ofu, prod, loss, y, & + rxt, het_rates, chnkpnts ) + use chem_mods, only : gas_pcnst,rxntot,clscnt1 + implicit none +!-------------------------------------------------------------------- +! ... dummy args +!-------------------------------------------------------------------- + integer, intent(in) :: ofl, ofu, chnkpnts + real(r8), dimension(chnkpnts,max(1,clscnt1)), intent(out) :: & + prod, & + loss + real(r8), intent(in) :: y(chnkpnts,gas_pcnst) + real(r8), intent(in) :: rxt(chnkpnts,rxntot) + real(r8), intent(in) :: het_rates(chnkpnts,gas_pcnst) +!-------------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------------- + integer :: k +!-------------------------------------------------------------------- +! ... loss and production for Explicit method +!-------------------------------------------------------------------- + do k = ofl,ofu + loss(k,1) = ( + het_rates(k,3))* y(k,3) + prod(k,1) = 0._r8 + loss(k,2) = ( + het_rates(k,19))* y(k,19) + prod(k,2) = 0._r8 + loss(k,3) = (rxt(k,189)* y(k,189) + rxt(k,78) + het_rates(k,31))* y(k,31) + prod(k,3) = 0._r8 + loss(k,4) = (rxt(k,190)* y(k,189) + rxt(k,79) + het_rates(k,32))* y(k,32) + prod(k,4) = 0._r8 + loss(k,5) = (rxt(k,216)* y(k,189) + rxt(k,80) + het_rates(k,33))* y(k,33) + prod(k,5) = 0._r8 + loss(k,6) = (rxt(k,191)* y(k,189) + rxt(k,81) + het_rates(k,34))* y(k,34) + prod(k,6) = 0._r8 + loss(k,7) = (rxt(k,192)* y(k,189) + rxt(k,82) + het_rates(k,35))* y(k,35) + prod(k,7) = 0._r8 + loss(k,8) = (rxt(k,193)* y(k,189) + rxt(k,83) + het_rates(k,36))* y(k,36) + prod(k,8) = 0._r8 + loss(k,9) = (rxt(k,194)* y(k,189) + rxt(k,84) + het_rates(k,37))* y(k,37) + prod(k,9) = 0._r8 + loss(k,10) = (rxt(k,195)* y(k,189) + rxt(k,85) + het_rates(k,38))* y(k,38) + prod(k,10) = 0._r8 + loss(k,11) = (rxt(k,227)* y(k,54) +rxt(k,239)* y(k,189) +rxt(k,228)* y(k,190) & + + rxt(k,86) + het_rates(k,39))* y(k,39) + prod(k,11) = 0._r8 + loss(k,12) = (rxt(k,229)* y(k,54) +rxt(k,240)* y(k,189) +rxt(k,230)* y(k,190) & + + rxt(k,87) + het_rates(k,41))* y(k,41) + prod(k,12) = 0._r8 + loss(k,13) = (rxt(k,231)* y(k,190) + rxt(k,88) + het_rates(k,42))* y(k,42) + prod(k,13) = 0._r8 + loss(k,14) = (rxt(k,232)* y(k,54) +rxt(k,233)* y(k,190) + rxt(k,89) & + + het_rates(k,44))* y(k,44) + prod(k,14) = 0._r8 + loss(k,15) = (rxt(k,165)* y(k,54) +rxt(k,221)* y(k,68) + (rxt(k,261) + & + rxt(k,262) +rxt(k,263))* y(k,189) +rxt(k,254)* y(k,190) + rxt(k,39) & + + rxt(k,40) + het_rates(k,52))* y(k,52) + prod(k,15) = 0._r8 + loss(k,16) = (rxt(k,234)* y(k,54) +rxt(k,217)* y(k,189) +rxt(k,235)* y(k,190) & + + rxt(k,90) + het_rates(k,53))* y(k,53) + prod(k,16) = 0._r8 + loss(k,17) = ( + het_rates(k,59))* y(k,59) + prod(k,17) = 0._r8 + loss(k,18) = ( + rxt(k,41) + het_rates(k,61))* y(k,61) + prod(k,18) =.440_r8*rxt(k,40)*y(k,52) + loss(k,19) = ( + rxt(k,529) + het_rates(k,66))* y(k,66) + prod(k,19) = 0._r8 + loss(k,20) = (rxt(k,218)* y(k,189) + rxt(k,98) + het_rates(k,73))* y(k,73) + prod(k,20) = 0._r8 + loss(k,21) = (rxt(k,241)* y(k,189) +rxt(k,236)* y(k,190) + rxt(k,100) & + + het_rates(k,77))* y(k,77) + prod(k,21) = 0._r8 + loss(k,22) = (rxt(k,242)* y(k,189) +rxt(k,237)* y(k,190) + rxt(k,101) & + + het_rates(k,78))* y(k,78) + prod(k,22) = 0._r8 + loss(k,23) = (rxt(k,243)* y(k,189) +rxt(k,238)* y(k,190) + rxt(k,102) & + + het_rates(k,79))* y(k,79) + prod(k,23) = 0._r8 + loss(k,24) = ((rxt(k,156) +rxt(k,157))* y(k,189) + rxt(k,12) & + + het_rates(k,108))* y(k,108) + prod(k,24) = 0._r8 + loss(k,25) = ( + rxt(k,531) + het_rates(k,114))* y(k,114) + prod(k,25) = 0._r8 + loss(k,26) = ( + rxt(k,530) + het_rates(k,115))* y(k,115) + prod(k,26) = 0._r8 + loss(k,27) = ( + het_rates(k,123))* y(k,123) + prod(k,27) = 0._r8 + loss(k,28) = ( + rxt(k,108) + het_rates(k,135))* y(k,135) + prod(k,28) = 0._r8 + loss(k,29) = ( + rxt(k,532) + het_rates(k,144))* y(k,144) + prod(k,29) = 0._r8 + loss(k,30) = ( + het_rates(k,159))* y(k,159) + prod(k,30) = 0._r8 + loss(k,31) = ( + het_rates(k,160))* y(k,160) + prod(k,31) = 0._r8 + end do + end subroutine exp_prod_loss + subroutine imp_prod_loss( avec_len, prod, loss, y, & + rxt, het_rates ) + use chem_mods, only : gas_pcnst,rxntot,clscnt4 + implicit none +!-------------------------------------------------------------------- +! ... dummy args +!-------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), dimension(veclen,clscnt4), intent(out) :: & + prod, & + loss + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(in) :: het_rates(veclen,gas_pcnst) +!-------------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------------- + integer :: k +!-------------------------------------------------------------------- +! ... loss and production for Implicit method +!-------------------------------------------------------------------- + do k = 1,avec_len + loss(k,101) = (rxt(k,346)* y(k,190) + rxt(k,19) + het_rates(k,1))* y(k,1) + prod(k,101) =rxt(k,349)*y(k,162)*y(k,116) + loss(k,100) = (rxt(k,350)* y(k,190) + rxt(k,20) + het_rates(k,2))* y(k,2) + prod(k,100) =rxt(k,347)*y(k,176)*y(k,162) + loss(k,124) = (rxt(k,429)* y(k,118) +rxt(k,430)* y(k,122) +rxt(k,431) & + * y(k,190) + het_rates(k,4))* y(k,4) + prod(k,124) = 0._r8 + loss(k,26) = (rxt(k,388)* y(k,190) + het_rates(k,5))* y(k,5) + prod(k,26) = 0._r8 + loss(k,70) = (rxt(k,391)* y(k,190) + rxt(k,21) + het_rates(k,6))* y(k,6) + prod(k,70) =rxt(k,389)*y(k,176)*y(k,164) + loss(k,27) = ( + rxt(k,22) + het_rates(k,7))* y(k,7) + prod(k,27) =.120_r8*rxt(k,388)*y(k,190)*y(k,5) + loss(k,71) = ( + rxt(k,23) + het_rates(k,8))* y(k,8) + prod(k,71) = (.100_r8*rxt(k,430)*y(k,4) +.100_r8*rxt(k,433)*y(k,105)) & + *y(k,122) + loss(k,76) = ( + rxt(k,24) + het_rates(k,9))* y(k,9) + prod(k,76) = (.500_r8*rxt(k,390)*y(k,164) +.200_r8*rxt(k,417)*y(k,196) + & + .060_r8*rxt(k,423)*y(k,199))*y(k,116) +.500_r8*rxt(k,21)*y(k,6) & + +rxt(k,22)*y(k,7) +.200_r8*rxt(k,70)*y(k,152) +.060_r8*rxt(k,72) & + *y(k,156) + loss(k,51) = ( + rxt(k,25) + het_rates(k,10))* y(k,10) + prod(k,51) = (.200_r8*rxt(k,417)*y(k,196) +.200_r8*rxt(k,423)*y(k,199)) & + *y(k,116) +.200_r8*rxt(k,70)*y(k,152) +.200_r8*rxt(k,72)*y(k,156) + loss(k,97) = ( + rxt(k,26) + het_rates(k,11))* y(k,11) + prod(k,97) = (.200_r8*rxt(k,417)*y(k,196) +.150_r8*rxt(k,423)*y(k,199)) & + *y(k,116) +rxt(k,46)*y(k,89) +rxt(k,56)*y(k,111) +.200_r8*rxt(k,70) & + *y(k,152) +.150_r8*rxt(k,72)*y(k,156) + loss(k,59) = ( + rxt(k,27) + het_rates(k,12))* y(k,12) + prod(k,59) =.210_r8*rxt(k,423)*y(k,199)*y(k,116) +.210_r8*rxt(k,72)*y(k,156) + loss(k,39) = (rxt(k,351)* y(k,190) + het_rates(k,13))* y(k,13) + prod(k,39) = (.050_r8*rxt(k,430)*y(k,4) +.050_r8*rxt(k,433)*y(k,105)) & + *y(k,122) + loss(k,61) = (rxt(k,317)* y(k,118) +rxt(k,318)* y(k,190) + het_rates(k,14)) & + * y(k,14) + prod(k,61) = 0._r8 + loss(k,154) = (rxt(k,200)* y(k,40) +rxt(k,202)* y(k,122) +rxt(k,201) & + * y(k,176) + het_rates(k,15))* y(k,15) + prod(k,154) = (rxt(k,75) +2.000_r8*rxt(k,203)*y(k,17) +rxt(k,204)*y(k,57) + & + rxt(k,205)*y(k,57) +rxt(k,208)*y(k,116) +rxt(k,211)*y(k,121) + & + rxt(k,212)*y(k,190) +rxt(k,458)*y(k,136))*y(k,17) & + + (rxt(k,190)*y(k,32) +rxt(k,216)*y(k,33) + & + 3.000_r8*rxt(k,217)*y(k,53) +2.000_r8*rxt(k,218)*y(k,73) + & + 2.000_r8*rxt(k,239)*y(k,39) +rxt(k,240)*y(k,41) +rxt(k,219)*y(k,76)) & + *y(k,189) + (2.000_r8*rxt(k,228)*y(k,39) +rxt(k,230)*y(k,41) + & + 3.000_r8*rxt(k,235)*y(k,53) +rxt(k,214)*y(k,76))*y(k,190) & + + (2.000_r8*rxt(k,227)*y(k,39) +rxt(k,229)*y(k,41) + & + 3.000_r8*rxt(k,234)*y(k,53))*y(k,54) + (rxt(k,99) + & + rxt(k,213)*y(k,121))*y(k,76) +rxt(k,74)*y(k,16) +rxt(k,77)*y(k,18) & + +rxt(k,105)*y(k,86) + loss(k,42) = ( + rxt(k,74) + het_rates(k,16))* y(k,16) + prod(k,42) = (rxt(k,520)*y(k,86) +rxt(k,525)*y(k,86))*y(k,80) & + +rxt(k,206)*y(k,57)*y(k,17) + loss(k,160) = (2._r8*rxt(k,203)* y(k,17) + (rxt(k,204) +rxt(k,205) + & + rxt(k,206))* y(k,57) +rxt(k,208)* y(k,116) +rxt(k,209)* y(k,117) & + +rxt(k,211)* y(k,121) +rxt(k,458)* y(k,136) +rxt(k,207)* y(k,176) & + +rxt(k,212)* y(k,190) + rxt(k,75) + het_rates(k,17))* y(k,17) + prod(k,160) = (rxt(k,76) +rxt(k,210)*y(k,121))*y(k,18) +rxt(k,202)*y(k,122) & + *y(k,15) +rxt(k,220)*y(k,189)*y(k,76) +rxt(k,215)*y(k,121)*y(k,86) + loss(k,86) = (rxt(k,210)* y(k,121) + rxt(k,76) + rxt(k,77) + rxt(k,514) & + + rxt(k,517) + rxt(k,522) + het_rates(k,18))* y(k,18) + prod(k,86) =rxt(k,209)*y(k,117)*y(k,17) + loss(k,40) = (rxt(k,392)* y(k,190) + het_rates(k,20))* y(k,20) + prod(k,40) =rxt(k,28)*y(k,21) +rxt(k,395)*y(k,166)*y(k,116) + loss(k,58) = (rxt(k,394)* y(k,190) + rxt(k,28) + het_rates(k,21))* y(k,21) + prod(k,58) =rxt(k,393)*y(k,176)*y(k,166) + loss(k,50) = (rxt(k,266)* y(k,54) +rxt(k,267)* y(k,190) + het_rates(k,22)) & + * y(k,22) + prod(k,50) = 0._r8 + loss(k,90) = (rxt(k,268)* y(k,54) +rxt(k,269)* y(k,122) +rxt(k,294)* y(k,190) & + + het_rates(k,23))* y(k,23) + prod(k,90) = 0._r8 + loss(k,43) = (rxt(k,274)* y(k,190) + het_rates(k,24))* y(k,24) + prod(k,43) = (.400_r8*rxt(k,270)*y(k,167) +.200_r8*rxt(k,271)*y(k,171)) & + *y(k,167) + loss(k,53) = (rxt(k,275)* y(k,190) + rxt(k,29) + het_rates(k,25))* y(k,25) + prod(k,53) =rxt(k,272)*y(k,176)*y(k,167) + loss(k,49) = (rxt(k,276)* y(k,54) +rxt(k,277)* y(k,190) + het_rates(k,26)) & + * y(k,26) + prod(k,49) = 0._r8 + loss(k,129) = (rxt(k,297)* y(k,118) +rxt(k,298)* y(k,122) +rxt(k,315) & + * y(k,190) + het_rates(k,27))* y(k,27) + prod(k,129) =.130_r8*rxt(k,375)*y(k,122)*y(k,93) +.700_r8*rxt(k,55)*y(k,106) + loss(k,69) = (rxt(k,302)* y(k,190) + rxt(k,30) + het_rates(k,28))* y(k,28) + prod(k,69) =rxt(k,300)*y(k,176)*y(k,168) + loss(k,19) = (rxt(k,303)* y(k,190) + het_rates(k,29))* y(k,29) + prod(k,19) = 0._r8 + loss(k,44) = (rxt(k,398)* y(k,190) + rxt(k,31) + het_rates(k,30))* y(k,30) + prod(k,44) =rxt(k,396)*y(k,176)*y(k,169) + loss(k,161) = (rxt(k,200)* y(k,15) +rxt(k,164)* y(k,54) +rxt(k,245)* y(k,118) & + +rxt(k,246)* y(k,121) +rxt(k,244)* y(k,176) +rxt(k,247)* y(k,190) & + + rxt(k,32) + rxt(k,33) + het_rates(k,40))* y(k,40) + prod(k,161) = (rxt(k,171)*y(k,57) +2.000_r8*rxt(k,248)*y(k,171) + & + rxt(k,249)*y(k,171) +rxt(k,251)*y(k,116) + & + .700_r8*rxt(k,271)*y(k,167) +rxt(k,282)*y(k,170) + & + rxt(k,299)*y(k,168) +.800_r8*rxt(k,311)*y(k,193) + & + .880_r8*rxt(k,323)*y(k,182) +2.000_r8*rxt(k,332)*y(k,184) + & + 1.500_r8*rxt(k,356)*y(k,178) +.750_r8*rxt(k,361)*y(k,179) + & + .800_r8*rxt(k,370)*y(k,96) +.800_r8*rxt(k,381)*y(k,198) + & + .750_r8*rxt(k,435)*y(k,188) +.930_r8*rxt(k,440)*y(k,194) + & + .950_r8*rxt(k,445)*y(k,195))*y(k,171) & + + (.500_r8*rxt(k,288)*y(k,175) +rxt(k,309)*y(k,192) + & + rxt(k,313)*y(k,193) +.500_r8*rxt(k,319)*y(k,173) + & + .250_r8*rxt(k,326)*y(k,182) +rxt(k,335)*y(k,184) + & + .100_r8*rxt(k,348)*y(k,162) +.920_r8*rxt(k,358)*y(k,178) + & + .250_r8*rxt(k,383)*y(k,198) +.340_r8*rxt(k,442)*y(k,194) + & + .320_r8*rxt(k,447)*y(k,195))*y(k,116) + (rxt(k,252)*y(k,50) + & + .300_r8*rxt(k,253)*y(k,51) +.500_r8*rxt(k,286)*y(k,49) + & + .800_r8*rxt(k,291)*y(k,69) +rxt(k,293)*y(k,127) + & + .500_r8*rxt(k,341)*y(k,104) +.400_r8*rxt(k,346)*y(k,1) + & + .300_r8*rxt(k,366)*y(k,94) +.680_r8*rxt(k,451)*y(k,151))*y(k,190) & + + (rxt(k,269)*y(k,23) +.500_r8*rxt(k,298)*y(k,27) + & + .120_r8*rxt(k,328)*y(k,100) +.600_r8*rxt(k,342)*y(k,106) + & + .910_r8*rxt(k,375)*y(k,93) +.340_r8*rxt(k,430)*y(k,4) + & + .340_r8*rxt(k,433)*y(k,105))*y(k,122) + (.500_r8*rxt(k,317)*y(k,14) + & + .250_r8*rxt(k,325)*y(k,182) +rxt(k,336)*y(k,184) + & + rxt(k,359)*y(k,178))*y(k,118) + (.250_r8*rxt(k,322)*y(k,182) + & + rxt(k,331)*y(k,184) +rxt(k,355)*y(k,178) + & + .250_r8*rxt(k,380)*y(k,198))*y(k,170) + (rxt(k,262)*y(k,189) + & + rxt(k,263)*y(k,189))*y(k,52) + (.150_r8*rxt(k,312)*y(k,193) + & + .450_r8*rxt(k,333)*y(k,184))*y(k,176) +.100_r8*rxt(k,19)*y(k,1) & + +.100_r8*rxt(k,20)*y(k,2) +rxt(k,38)*y(k,51) +rxt(k,43)*y(k,69) & + +.330_r8*rxt(k,45)*y(k,88) +rxt(k,47)*y(k,90) +.690_r8*rxt(k,49) & + *y(k,98) +1.340_r8*rxt(k,50)*y(k,100) +rxt(k,57)*y(k,119) +rxt(k,62) & + *y(k,132) +rxt(k,63)*y(k,133) +.375_r8*rxt(k,65)*y(k,147) & + +.400_r8*rxt(k,67)*y(k,149) +.680_r8*rxt(k,69)*y(k,151) & + +2.000_r8*rxt(k,289)*y(k,174) +rxt(k,259)*y(k,177) & + +2.000_r8*rxt(k,334)*y(k,184)*y(k,184) + loss(k,134) = (rxt(k,278)* y(k,118) +rxt(k,279)* y(k,190) + rxt(k,34) & + + het_rates(k,43))* y(k,43) + prod(k,134) = (rxt(k,273)*y(k,167) +.270_r8*rxt(k,301)*y(k,168) + & + rxt(k,309)*y(k,192) +rxt(k,319)*y(k,173) +rxt(k,338)*y(k,186) + & + .400_r8*rxt(k,348)*y(k,162))*y(k,116) + (rxt(k,274)*y(k,24) + & + .500_r8*rxt(k,275)*y(k,25) +.800_r8*rxt(k,346)*y(k,1))*y(k,190) & + + (.500_r8*rxt(k,298)*y(k,27) +.100_r8*rxt(k,342)*y(k,106))*y(k,122) & + + (1.600_r8*rxt(k,270)*y(k,167) +.800_r8*rxt(k,271)*y(k,171)) & + *y(k,167) +.400_r8*rxt(k,19)*y(k,1) +.400_r8*rxt(k,20)*y(k,2) & + +rxt(k,317)*y(k,118)*y(k,14) +rxt(k,29)*y(k,25) +.330_r8*rxt(k,45) & + *y(k,88) +rxt(k,53)*y(k,103) +rxt(k,62)*y(k,132) & + +.200_r8*rxt(k,337)*y(k,186)*y(k,176) + loss(k,16) = (rxt(k,280)* y(k,190) + het_rates(k,45))* y(k,45) + prod(k,16) = 0._r8 + loss(k,127) = (rxt(k,316)* y(k,190) + rxt(k,35) + het_rates(k,46))* y(k,46) + prod(k,127) = (.820_r8*rxt(k,301)*y(k,168) +.500_r8*rxt(k,319)*y(k,173) + & + .250_r8*rxt(k,348)*y(k,162) +.270_r8*rxt(k,442)*y(k,194) + & + .040_r8*rxt(k,447)*y(k,195))*y(k,116) & + + (.820_r8*rxt(k,299)*y(k,168) +.150_r8*rxt(k,440)*y(k,194) + & + .025_r8*rxt(k,445)*y(k,195))*y(k,171) + (.250_r8*rxt(k,19) + & + .800_r8*rxt(k,346)*y(k,190))*y(k,1) + (.520_r8*rxt(k,430)*y(k,4) + & + .520_r8*rxt(k,433)*y(k,105))*y(k,122) + (.500_r8*rxt(k,69) + & + .500_r8*rxt(k,451)*y(k,190))*y(k,151) +.250_r8*rxt(k,20)*y(k,2) & + +.500_r8*rxt(k,317)*y(k,118)*y(k,14) +.820_r8*rxt(k,30)*y(k,28) & + +.170_r8*rxt(k,45)*y(k,88) +.300_r8*rxt(k,65)*y(k,147) & + +.050_r8*rxt(k,67)*y(k,149) + loss(k,146) = (rxt(k,304)* y(k,118) +rxt(k,305)* y(k,190) + rxt(k,36) & + + het_rates(k,47))* y(k,47) + prod(k,146) = (.250_r8*rxt(k,326)*y(k,182) +.050_r8*rxt(k,364)*y(k,179) + & + .250_r8*rxt(k,383)*y(k,198) +.170_r8*rxt(k,401)*y(k,172) + & + .170_r8*rxt(k,407)*y(k,185) +.400_r8*rxt(k,417)*y(k,196) + & + .540_r8*rxt(k,423)*y(k,199) +.510_r8*rxt(k,426)*y(k,201))*y(k,116) & + + (.250_r8*rxt(k,325)*y(k,182) +.050_r8*rxt(k,365)*y(k,179) + & + .250_r8*rxt(k,384)*y(k,198))*y(k,118) & + + (.500_r8*rxt(k,311)*y(k,193) +.240_r8*rxt(k,323)*y(k,182) + & + .100_r8*rxt(k,381)*y(k,198))*y(k,171) & + + (.880_r8*rxt(k,328)*y(k,100) +.500_r8*rxt(k,342)*y(k,106)) & + *y(k,122) + (.250_r8*rxt(k,322)*y(k,182) + & + .250_r8*rxt(k,380)*y(k,198))*y(k,170) & + + (.070_r8*rxt(k,400)*y(k,172) +.070_r8*rxt(k,406)*y(k,185)) & + *y(k,176) + (rxt(k,306)*y(k,90) +rxt(k,307)*y(k,119))*y(k,190) & + +.180_r8*rxt(k,23)*y(k,8) +rxt(k,27)*y(k,12) +.400_r8*rxt(k,70) & + *y(k,152) +.540_r8*rxt(k,72)*y(k,156) +.510_r8*rxt(k,73)*y(k,158) + loss(k,88) = (rxt(k,285)* y(k,190) + het_rates(k,48))* y(k,48) + prod(k,88) = (.100_r8*rxt(k,282)*y(k,171) +.150_r8*rxt(k,283)*y(k,176)) & + *y(k,170) +.120_r8*rxt(k,298)*y(k,122)*y(k,27) & + +.150_r8*rxt(k,333)*y(k,184)*y(k,176) + loss(k,84) = (rxt(k,286)* y(k,190) + rxt(k,37) + het_rates(k,49))* y(k,49) + prod(k,84) = (.400_r8*rxt(k,283)*y(k,170) +.400_r8*rxt(k,333)*y(k,184)) & + *y(k,176) + loss(k,113) = (rxt(k,252)* y(k,190) + het_rates(k,50))* y(k,50) + prod(k,113) = (rxt(k,249)*y(k,171) +.300_r8*rxt(k,271)*y(k,167) + & + .500_r8*rxt(k,311)*y(k,193) +.250_r8*rxt(k,323)*y(k,182) + & + .250_r8*rxt(k,356)*y(k,178) +.250_r8*rxt(k,361)*y(k,179) + & + .200_r8*rxt(k,370)*y(k,96) +.300_r8*rxt(k,381)*y(k,198) + & + .250_r8*rxt(k,435)*y(k,188) +.250_r8*rxt(k,440)*y(k,194) + & + .250_r8*rxt(k,445)*y(k,195))*y(k,171) + loss(k,67) = (rxt(k,253)* y(k,190) + rxt(k,38) + het_rates(k,51))* y(k,51) + prod(k,67) =rxt(k,250)*y(k,176)*y(k,171) + loss(k,169) = (rxt(k,276)* y(k,26) +rxt(k,227)* y(k,39) +rxt(k,164)* y(k,40) & + +rxt(k,229)* y(k,41) +rxt(k,232)* y(k,44) +rxt(k,165)* y(k,52) & + +rxt(k,234)* y(k,53) +rxt(k,177)* y(k,58) +rxt(k,166)* y(k,72) & + +rxt(k,167)* y(k,74) +rxt(k,186)* y(k,87) +rxt(k,170)* y(k,122) & + + (rxt(k,168) +rxt(k,169))* y(k,176) + het_rates(k,54))* y(k,54) + prod(k,169) = (4.000_r8*rxt(k,189)*y(k,31) +rxt(k,190)*y(k,32) + & + 2.000_r8*rxt(k,191)*y(k,34) +2.000_r8*rxt(k,192)*y(k,35) + & + 2.000_r8*rxt(k,193)*y(k,36) +rxt(k,194)*y(k,37) + & + 2.000_r8*rxt(k,195)*y(k,38) +rxt(k,241)*y(k,77) +rxt(k,242)*y(k,78) + & + rxt(k,243)*y(k,79) +rxt(k,196)*y(k,80) +rxt(k,226)*y(k,63))*y(k,189) & + + (rxt(k,93) +rxt(k,171)*y(k,171) +2.000_r8*rxt(k,172)*y(k,57) + & + rxt(k,174)*y(k,57) +rxt(k,176)*y(k,116) +rxt(k,181)*y(k,121) + & + rxt(k,182)*y(k,190) +rxt(k,205)*y(k,17) +rxt(k,459)*y(k,136))*y(k,57) & + + (3.000_r8*rxt(k,231)*y(k,42) +rxt(k,233)*y(k,44) + & + rxt(k,236)*y(k,77) +rxt(k,237)*y(k,78) +rxt(k,238)*y(k,79) + & + rxt(k,185)*y(k,80))*y(k,190) + (rxt(k,103) +rxt(k,184)*y(k,121)) & + *y(k,80) +rxt(k,74)*y(k,16) +2.000_r8*rxt(k,91)*y(k,55) & + +2.000_r8*rxt(k,92)*y(k,56) +rxt(k,94)*y(k,58) +rxt(k,97)*y(k,63) & + +rxt(k,106)*y(k,87) + loss(k,25) = ( + rxt(k,91) + het_rates(k,55))* y(k,55) + prod(k,25) = (rxt(k,513)*y(k,87) +rxt(k,518)*y(k,58) +rxt(k,519)*y(k,87) + & + rxt(k,523)*y(k,58) +rxt(k,524)*y(k,87) +rxt(k,528)*y(k,58))*y(k,80) & + +rxt(k,177)*y(k,58)*y(k,54) +rxt(k,173)*y(k,57)*y(k,57) + loss(k,17) = ( + rxt(k,92) + rxt(k,199) + het_rates(k,56))* y(k,56) + prod(k,17) =rxt(k,198)*y(k,57)*y(k,57) + loss(k,164) = ((rxt(k,204) +rxt(k,205) +rxt(k,206))* y(k,17) & + + 2._r8*(rxt(k,172) +rxt(k,173) +rxt(k,174) +rxt(k,198))* y(k,57) & + +rxt(k,176)* y(k,116) +rxt(k,178)* y(k,117) +rxt(k,181)* y(k,121) & + +rxt(k,459)* y(k,136) +rxt(k,171)* y(k,171) +rxt(k,175)* y(k,176) & + + (rxt(k,182) +rxt(k,183))* y(k,190) + rxt(k,93) + het_rates(k,57)) & + * y(k,57) + prod(k,164) = (rxt(k,169)*y(k,176) +rxt(k,170)*y(k,122) +rxt(k,186)*y(k,87)) & + *y(k,54) + (rxt(k,95) +rxt(k,179)*y(k,121))*y(k,58) & + + (rxt(k,187)*y(k,121) +rxt(k,188)*y(k,190))*y(k,87) + (rxt(k,107) + & + rxt(k,464)*y(k,136))*y(k,124) +2.000_r8*rxt(k,199)*y(k,56) & + +rxt(k,197)*y(k,189)*y(k,80) + loss(k,128) = (rxt(k,177)* y(k,54) + (rxt(k,518) +rxt(k,523) +rxt(k,528)) & + * y(k,80) +rxt(k,179)* y(k,121) +rxt(k,180)* y(k,190) + rxt(k,94) & + + rxt(k,95) + rxt(k,516) + rxt(k,521) + rxt(k,527) & + + het_rates(k,58))* y(k,58) + prod(k,128) =rxt(k,178)*y(k,117)*y(k,57) + loss(k,135) = ((rxt(k,255) +rxt(k,265))* y(k,190) + het_rates(k,60))* y(k,60) + prod(k,135) = (rxt(k,32) +rxt(k,33) +rxt(k,164)*y(k,54) +rxt(k,200)*y(k,15) + & + rxt(k,245)*y(k,118) +rxt(k,246)*y(k,121) +rxt(k,247)*y(k,190)) & + *y(k,40) + (.630_r8*rxt(k,269)*y(k,23) +.560_r8*rxt(k,298)*y(k,27) + & + .650_r8*rxt(k,328)*y(k,100) +.560_r8*rxt(k,342)*y(k,106) + & + .620_r8*rxt(k,375)*y(k,93) +.230_r8*rxt(k,430)*y(k,4) + & + .230_r8*rxt(k,433)*y(k,105))*y(k,122) & + + (.220_r8*rxt(k,326)*y(k,182) +.250_r8*rxt(k,383)*y(k,198) + & + .170_r8*rxt(k,401)*y(k,172) +.400_r8*rxt(k,404)*y(k,183) + & + .350_r8*rxt(k,407)*y(k,185) +.225_r8*rxt(k,442)*y(k,194))*y(k,116) & + + (.350_r8*rxt(k,267)*y(k,22) +rxt(k,292)*y(k,70) + & + rxt(k,305)*y(k,47) +.700_r8*rxt(k,451)*y(k,151) +rxt(k,455)*y(k,125)) & + *y(k,190) + (rxt(k,304)*y(k,47) +.220_r8*rxt(k,325)*y(k,182) + & + .500_r8*rxt(k,384)*y(k,198))*y(k,118) & + + (.110_r8*rxt(k,323)*y(k,182) +.200_r8*rxt(k,381)*y(k,198) + & + .125_r8*rxt(k,440)*y(k,194))*y(k,171) & + + (.070_r8*rxt(k,400)*y(k,172) +.160_r8*rxt(k,403)*y(k,183) + & + .140_r8*rxt(k,406)*y(k,185))*y(k,176) + (rxt(k,110) + & + rxt(k,454)*y(k,121))*y(k,125) + (.220_r8*rxt(k,322)*y(k,182) + & + .250_r8*rxt(k,380)*y(k,198))*y(k,170) +1.500_r8*rxt(k,22)*y(k,7) & + +.450_r8*rxt(k,23)*y(k,8) +.600_r8*rxt(k,26)*y(k,11) +rxt(k,27) & + *y(k,12) +rxt(k,34)*y(k,43) +rxt(k,232)*y(k,54)*y(k,44) +rxt(k,36) & + *y(k,47) +rxt(k,43)*y(k,69) +2.000_r8*rxt(k,44)*y(k,70) & + +.330_r8*rxt(k,45)*y(k,88) +1.340_r8*rxt(k,51)*y(k,100) & + +.700_r8*rxt(k,55)*y(k,106) +1.500_r8*rxt(k,64)*y(k,146) & + +.250_r8*rxt(k,65)*y(k,147) +rxt(k,68)*y(k,150) +1.700_r8*rxt(k,69) & + *y(k,151) + loss(k,20) = (rxt(k,225)* y(k,189) + rxt(k,96) + het_rates(k,62))* y(k,62) + prod(k,20) = (rxt(k,190)*y(k,32) +rxt(k,192)*y(k,35) + & + 2.000_r8*rxt(k,193)*y(k,36) +2.000_r8*rxt(k,194)*y(k,37) + & + rxt(k,195)*y(k,38) +rxt(k,216)*y(k,33) +2.000_r8*rxt(k,218)*y(k,73) + & + rxt(k,242)*y(k,78) +rxt(k,243)*y(k,79))*y(k,189) & + + (rxt(k,237)*y(k,78) +rxt(k,238)*y(k,79))*y(k,190) + loss(k,29) = (rxt(k,226)* y(k,189) + rxt(k,97) + het_rates(k,63))* y(k,63) + prod(k,29) = (rxt(k,191)*y(k,34) +rxt(k,192)*y(k,35) +rxt(k,241)*y(k,77)) & + *y(k,189) +rxt(k,236)*y(k,190)*y(k,77) + loss(k,32) = (rxt(k,399)* y(k,190) + het_rates(k,64))* y(k,64) + prod(k,32) =.180_r8*rxt(k,419)*y(k,190)*y(k,153) + loss(k,47) = (rxt(k,452)* y(k,118) + (rxt(k,453) +rxt(k,466))* y(k,190) & + + het_rates(k,65))* y(k,65) + prod(k,47) = 0._r8 + loss(k,21) = ( + rxt(k,42) + het_rates(k,67))* y(k,67) + prod(k,21) =rxt(k,287)*y(k,176)*y(k,175) + loss(k,111) = (rxt(k,221)* y(k,52) +rxt(k,222)* y(k,72) +rxt(k,224)* y(k,84) & + +rxt(k,223)* y(k,202) + het_rates(k,68))* y(k,68) + prod(k,111) = (rxt(k,194)*y(k,37) +rxt(k,216)*y(k,33) + & + 2.000_r8*rxt(k,225)*y(k,62) +rxt(k,226)*y(k,63))*y(k,189) & + +2.000_r8*rxt(k,96)*y(k,62) +rxt(k,97)*y(k,63) +rxt(k,104)*y(k,83) + loss(k,131) = (rxt(k,291)* y(k,190) + rxt(k,43) + het_rates(k,69))* y(k,69) + prod(k,131) = (.530_r8*rxt(k,326)*y(k,182) +.050_r8*rxt(k,364)*y(k,179) + & + .250_r8*rxt(k,383)*y(k,198) +.225_r8*rxt(k,442)*y(k,194))*y(k,116) & + + (.530_r8*rxt(k,325)*y(k,182) +.050_r8*rxt(k,365)*y(k,179) + & + .250_r8*rxt(k,384)*y(k,198))*y(k,118) & + + (.260_r8*rxt(k,323)*y(k,182) +.100_r8*rxt(k,381)*y(k,198) + & + .125_r8*rxt(k,440)*y(k,194))*y(k,171) + (.700_r8*rxt(k,366)*y(k,94) + & + .500_r8*rxt(k,367)*y(k,95) +rxt(k,378)*y(k,110))*y(k,190) & + + (.530_r8*rxt(k,322)*y(k,182) +.250_r8*rxt(k,380)*y(k,198)) & + *y(k,170) +.330_r8*rxt(k,45)*y(k,88) +.250_r8*rxt(k,65)*y(k,147) & + +rxt(k,290)*y(k,174) + loss(k,122) = (rxt(k,292)* y(k,190) + rxt(k,44) + rxt(k,470) & + + het_rates(k,70))* y(k,70) + prod(k,122) = (.050_r8*rxt(k,364)*y(k,179) +.250_r8*rxt(k,383)*y(k,198) + & + rxt(k,390)*y(k,164) +.400_r8*rxt(k,404)*y(k,183) + & + .170_r8*rxt(k,407)*y(k,185) +.700_r8*rxt(k,410)*y(k,191) + & + .600_r8*rxt(k,417)*y(k,196) +.340_r8*rxt(k,423)*y(k,199) + & + .170_r8*rxt(k,426)*y(k,201))*y(k,116) + (.650_r8*rxt(k,267)*y(k,22) + & + .200_r8*rxt(k,291)*y(k,69) +rxt(k,379)*y(k,111))*y(k,190) & + + (.250_r8*rxt(k,380)*y(k,170) +.100_r8*rxt(k,381)*y(k,171) + & + .250_r8*rxt(k,384)*y(k,118))*y(k,198) & + + (.160_r8*rxt(k,403)*y(k,183) +.070_r8*rxt(k,406)*y(k,185)) & + *y(k,176) +rxt(k,21)*y(k,6) +.130_r8*rxt(k,23)*y(k,8) & + +.050_r8*rxt(k,365)*y(k,179)*y(k,118) +.700_r8*rxt(k,61)*y(k,131) & + +.600_r8*rxt(k,70)*y(k,152) +.340_r8*rxt(k,72)*y(k,156) & + +.170_r8*rxt(k,73)*y(k,158) + loss(k,156) = (rxt(k,130)* y(k,122) + (rxt(k,124) +rxt(k,125) +rxt(k,126)) & + * y(k,176) + rxt(k,127) + het_rates(k,71))* y(k,71) + prod(k,156) = (rxt(k,131)*y(k,72) +rxt(k,134)*y(k,121) +rxt(k,152)*y(k,107) + & + rxt(k,247)*y(k,40) +rxt(k,265)*y(k,60) +rxt(k,455)*y(k,125) + & + rxt(k,460)*y(k,134) +rxt(k,465)*y(k,136))*y(k,190) & + + (rxt(k,114)*y(k,189) +rxt(k,122)*y(k,121) +rxt(k,166)*y(k,54) + & + rxt(k,222)*y(k,68))*y(k,72) + (rxt(k,262)*y(k,52) + & + rxt(k,197)*y(k,80) +rxt(k,220)*y(k,76))*y(k,189) + (rxt(k,2) + & + 2.000_r8*rxt(k,3))*y(k,202) +2.000_r8*rxt(k,32)*y(k,40) +rxt(k,38) & + *y(k,51) +rxt(k,99)*y(k,76) +rxt(k,103)*y(k,80) +rxt(k,104)*y(k,83) + loss(k,143) = (rxt(k,166)* y(k,54) +rxt(k,222)* y(k,68) +rxt(k,122)* y(k,121) & + +rxt(k,114)* y(k,189) +rxt(k,131)* y(k,190) + het_rates(k,72)) & + * y(k,72) + prod(k,143) =rxt(k,33)*y(k,40) +rxt(k,263)*y(k,189)*y(k,52) & + +rxt(k,124)*y(k,176)*y(k,71) +rxt(k,1)*y(k,202) + loss(k,93) = (rxt(k,167)* y(k,54) +rxt(k,123)* y(k,121) +rxt(k,132)* y(k,190) & + + rxt(k,4) + het_rates(k,74))* y(k,74) + prod(k,93) =rxt(k,138)*y(k,176)*y(k,176) +rxt(k,137)*y(k,190)*y(k,190) + loss(k,22) = ( + rxt(k,109) + het_rates(k,75))* y(k,75) + prod(k,22) =rxt(k,468)*y(k,202)*y(k,138) + loss(k,118) = (rxt(k,213)* y(k,121) + (rxt(k,219) +rxt(k,220))* y(k,189) & + +rxt(k,214)* y(k,190) + rxt(k,99) + het_rates(k,76))* y(k,76) + prod(k,118) = (rxt(k,200)*y(k,40) +rxt(k,201)*y(k,176))*y(k,15) + loss(k,168) = ((rxt(k,518) +rxt(k,523) +rxt(k,528))* y(k,58) + (rxt(k,520) + & + rxt(k,525))* y(k,86) + (rxt(k,513) +rxt(k,519) +rxt(k,524))* y(k,87) & + +rxt(k,184)* y(k,121) + (rxt(k,196) +rxt(k,197))* y(k,189) & + +rxt(k,185)* y(k,190) + rxt(k,103) + het_rates(k,80))* y(k,80) + prod(k,168) = (rxt(k,165)*y(k,52) +rxt(k,227)*y(k,39) +rxt(k,229)*y(k,41) + & + 2.000_r8*rxt(k,232)*y(k,44) +rxt(k,234)*y(k,53) +rxt(k,164)*y(k,40) + & + rxt(k,166)*y(k,72) +rxt(k,167)*y(k,74) +rxt(k,168)*y(k,176) + & + rxt(k,186)*y(k,87) +rxt(k,276)*y(k,26))*y(k,54) +rxt(k,183)*y(k,190) & + *y(k,57) + loss(k,30) = (rxt(k,264)* y(k,189) +rxt(k,256)* y(k,190) + het_rates(k,81)) & + * y(k,81) + prod(k,30) = 0._r8 + loss(k,115) = (rxt(k,257)* y(k,190) + het_rates(k,82))* y(k,82) + prod(k,115) = (.370_r8*rxt(k,269)*y(k,23) +.120_r8*rxt(k,298)*y(k,27) + & + .330_r8*rxt(k,328)*y(k,100) +.120_r8*rxt(k,342)*y(k,106) + & + .110_r8*rxt(k,375)*y(k,93) +.050_r8*rxt(k,430)*y(k,4) + & + .050_r8*rxt(k,433)*y(k,105))*y(k,122) + (rxt(k,258)*y(k,176) + & + rxt(k,260)*y(k,116))*y(k,177) +.350_r8*rxt(k,267)*y(k,190)*y(k,22) + loss(k,37) = ( + rxt(k,104) + het_rates(k,83))* y(k,83) + prod(k,37) = (rxt(k,221)*y(k,52) +rxt(k,222)*y(k,72) +rxt(k,223)*y(k,202) + & + rxt(k,224)*y(k,84))*y(k,68) + loss(k,155) = (rxt(k,224)* y(k,68) +rxt(k,161)* y(k,190) + rxt(k,9) & + + het_rates(k,84))* y(k,84) + prod(k,155) = (rxt(k,516) +rxt(k,521) +rxt(k,527) +rxt(k,518)*y(k,80) + & + rxt(k,523)*y(k,80) +rxt(k,528)*y(k,80))*y(k,58) + (rxt(k,480) + & + rxt(k,245)*y(k,40) +rxt(k,278)*y(k,43) +rxt(k,304)*y(k,47) + & + rxt(k,452)*y(k,65))*y(k,118) + (2.000_r8*rxt(k,475) + & + 2.000_r8*rxt(k,512) +2.000_r8*rxt(k,515) +2.000_r8*rxt(k,526)) & + *y(k,109) + (rxt(k,514) +rxt(k,517) +rxt(k,522))*y(k,18) & + + (.500_r8*rxt(k,479) +rxt(k,160)*y(k,190))*y(k,117) +rxt(k,472) & + *y(k,88) +rxt(k,473)*y(k,94) +rxt(k,474)*y(k,95) +rxt(k,476)*y(k,110) & + +rxt(k,477)*y(k,111) +rxt(k,481)*y(k,120) +rxt(k,482)*y(k,126) & + +rxt(k,483)*y(k,148) + loss(k,62) = (rxt(k,139)* y(k,190) + rxt(k,10) + rxt(k,11) + rxt(k,162) & + + het_rates(k,85))* y(k,85) + prod(k,62) =rxt(k,158)*y(k,176)*y(k,117) + loss(k,112) = ((rxt(k,520) +rxt(k,525))* y(k,80) +rxt(k,215)* y(k,121) & + + rxt(k,105) + het_rates(k,86))* y(k,86) + prod(k,112) = (rxt(k,514) +rxt(k,517) +rxt(k,522))*y(k,18) & + +rxt(k,207)*y(k,176)*y(k,17) + loss(k,116) = (rxt(k,186)* y(k,54) + (rxt(k,513) +rxt(k,519) +rxt(k,524)) & + * y(k,80) +rxt(k,187)* y(k,121) +rxt(k,188)* y(k,190) + rxt(k,106) & + + het_rates(k,87))* y(k,87) + prod(k,116) = (rxt(k,516) +rxt(k,521) +rxt(k,527) +rxt(k,180)*y(k,190)) & + *y(k,58) +rxt(k,175)*y(k,176)*y(k,57) + loss(k,136) = (rxt(k,321)* y(k,190) + rxt(k,45) + rxt(k,472) & + + het_rates(k,88))* y(k,88) + prod(k,136) = (rxt(k,320)*y(k,173) +rxt(k,327)*y(k,182))*y(k,116) & + + (.300_r8*rxt(k,366)*y(k,94) +.500_r8*rxt(k,367)*y(k,95))*y(k,190) + loss(k,38) = (rxt(k,352)* y(k,190) + rxt(k,46) + het_rates(k,89))* y(k,89) + prod(k,38) =rxt(k,363)*y(k,179) + loss(k,137) = (rxt(k,306)* y(k,190) + rxt(k,47) + het_rates(k,90))* y(k,90) + prod(k,137) = (.220_r8*rxt(k,322)*y(k,170) +.230_r8*rxt(k,323)*y(k,171) + & + .220_r8*rxt(k,325)*y(k,118) +.220_r8*rxt(k,326)*y(k,116))*y(k,182) & + + (.500_r8*rxt(k,310)*y(k,132) +.500_r8*rxt(k,341)*y(k,104) + & + .700_r8*rxt(k,366)*y(k,94) +.500_r8*rxt(k,367)*y(k,95))*y(k,190) & + + (.250_r8*rxt(k,380)*y(k,170) +.100_r8*rxt(k,381)*y(k,171) + & + .250_r8*rxt(k,383)*y(k,116) +.250_r8*rxt(k,384)*y(k,118))*y(k,198) & + + (.050_r8*rxt(k,364)*y(k,116) +.050_r8*rxt(k,365)*y(k,118)) & + *y(k,179) +.170_r8*rxt(k,45)*y(k,88) +.200_r8*rxt(k,311)*y(k,193) & + *y(k,171) + loss(k,52) = (rxt(k,353)* y(k,190) + het_rates(k,91))* y(k,91) + prod(k,52) = (rxt(k,360)*y(k,170) +.750_r8*rxt(k,361)*y(k,171) + & + .870_r8*rxt(k,364)*y(k,116) +.950_r8*rxt(k,365)*y(k,118))*y(k,179) + loss(k,23) = (rxt(k,354)* y(k,190) + het_rates(k,92))* y(k,92) + prod(k,23) =.600_r8*rxt(k,377)*y(k,190)*y(k,98) + loss(k,119) = (rxt(k,368)* y(k,118) +rxt(k,375)* y(k,122) +rxt(k,376) & + * y(k,190) + het_rates(k,93))* y(k,93) + prod(k,119) = 0._r8 + loss(k,94) = (rxt(k,366)* y(k,190) + rxt(k,473) + het_rates(k,94))* y(k,94) + prod(k,94) =.080_r8*rxt(k,358)*y(k,178)*y(k,116) + loss(k,89) = (rxt(k,367)* y(k,190) + rxt(k,474) + het_rates(k,95))* y(k,95) + prod(k,89) =.080_r8*rxt(k,364)*y(k,179)*y(k,116) + loss(k,144) = (rxt(k,372)* y(k,116) +rxt(k,373)* y(k,118) +rxt(k,369) & + * y(k,170) +rxt(k,370)* y(k,171) +rxt(k,371)* y(k,176) & + + het_rates(k,96))* y(k,96) + prod(k,144) =rxt(k,368)*y(k,118)*y(k,93) + loss(k,63) = (rxt(k,374)* y(k,190) + rxt(k,48) + het_rates(k,97))* y(k,97) + prod(k,63) =rxt(k,371)*y(k,176)*y(k,96) + loss(k,107) = (rxt(k,377)* y(k,190) + rxt(k,49) + het_rates(k,98))* y(k,98) + prod(k,107) = (rxt(k,357)*y(k,178) +rxt(k,362)*y(k,179))*y(k,176) +rxt(k,48) & + *y(k,97) + loss(k,12) = (rxt(k,499)* y(k,190) + het_rates(k,99))* y(k,99) + prod(k,12) = 0._r8 + loss(k,145) = (rxt(k,328)* y(k,122) +rxt(k,329)* y(k,190) + rxt(k,50) & + + rxt(k,51) + het_rates(k,100))* y(k,100) + prod(k,145) = (.390_r8*rxt(k,355)*y(k,170) +.310_r8*rxt(k,356)*y(k,171) + & + .360_r8*rxt(k,358)*y(k,116) +.400_r8*rxt(k,359)*y(k,118))*y(k,178) & + +.300_r8*rxt(k,375)*y(k,122)*y(k,93) +.288_r8*rxt(k,49)*y(k,98) + loss(k,54) = (rxt(k,330)* y(k,190) + het_rates(k,101))* y(k,101) + prod(k,54) =rxt(k,324)*y(k,182)*y(k,176) + loss(k,83) = (rxt(k,339)* y(k,190) + rxt(k,52) + het_rates(k,102))* y(k,102) + prod(k,83) =.800_r8*rxt(k,19)*y(k,1) +.800_r8*rxt(k,20)*y(k,2) & + +.800_r8*rxt(k,348)*y(k,162)*y(k,116) + loss(k,55) = (rxt(k,340)* y(k,190) + rxt(k,53) + het_rates(k,103))* y(k,103) + prod(k,55) =.800_r8*rxt(k,337)*y(k,186)*y(k,176) + loss(k,92) = (rxt(k,341)* y(k,190) + rxt(k,54) + rxt(k,345) & + + het_rates(k,104))* y(k,104) + prod(k,92) =rxt(k,344)*y(k,184)*y(k,117) + loss(k,125) = (rxt(k,432)* y(k,118) +rxt(k,433)* y(k,122) +rxt(k,434) & + * y(k,190) + het_rates(k,105))* y(k,105) + prod(k,125) = 0._r8 + loss(k,149) = (rxt(k,342)* y(k,122) +rxt(k,343)* y(k,190) + rxt(k,55) & + + het_rates(k,106))* y(k,106) + prod(k,149) = (.610_r8*rxt(k,355)*y(k,170) +.440_r8*rxt(k,356)*y(k,171) + & + .560_r8*rxt(k,358)*y(k,116) +.600_r8*rxt(k,359)*y(k,118))*y(k,178) & + +.200_r8*rxt(k,375)*y(k,122)*y(k,93) +.402_r8*rxt(k,49)*y(k,98) + loss(k,64) = (rxt(k,140)* y(k,116) + (rxt(k,141) +rxt(k,142) +rxt(k,143)) & + * y(k,117) +rxt(k,152)* y(k,190) + rxt(k,144) + het_rates(k,107)) & + * y(k,107) + prod(k,64) =rxt(k,15)*y(k,116) + loss(k,48) = ( + rxt(k,13) + rxt(k,14) + rxt(k,163) + rxt(k,475) + rxt(k,512) & + + rxt(k,515) + rxt(k,526) + het_rates(k,109))* y(k,109) + prod(k,48) =rxt(k,159)*y(k,118)*y(k,117) + loss(k,65) = (rxt(k,378)* y(k,190) + rxt(k,476) + het_rates(k,110))* y(k,110) + prod(k,65) =.200_r8*rxt(k,370)*y(k,171)*y(k,96) + loss(k,132) = (rxt(k,379)* y(k,190) + rxt(k,56) + rxt(k,477) & + + het_rates(k,111))* y(k,111) + prod(k,132) = (rxt(k,369)*y(k,170) +.800_r8*rxt(k,370)*y(k,171) + & + rxt(k,372)*y(k,116) +rxt(k,373)*y(k,118))*y(k,96) + loss(k,18) = (rxt(k,469)* y(k,190) + het_rates(k,112))* y(k,112) + prod(k,18) = 0._r8 + loss(k,1) = ( + rxt(k,478) + het_rates(k,113))* y(k,113) + prod(k,1) = 0._r8 + loss(k,165) = (rxt(k,208)* y(k,17) +rxt(k,176)* y(k,57) +rxt(k,372)* y(k,96) & + +rxt(k,140)* y(k,107) +rxt(k,149)* y(k,118) +rxt(k,155)* y(k,121) & + +rxt(k,154)* y(k,122) +rxt(k,387)* y(k,161) + (rxt(k,348) + & + rxt(k,349))* y(k,162) +rxt(k,390)* y(k,164) +rxt(k,395)* y(k,166) & + +rxt(k,273)* y(k,167) +rxt(k,301)* y(k,168) +rxt(k,397)* y(k,169) & + +rxt(k,284)* y(k,170) +rxt(k,251)* y(k,171) +rxt(k,401)* y(k,172) & + + (rxt(k,319) +rxt(k,320))* y(k,173) +rxt(k,288)* y(k,175) & + +rxt(k,153)* y(k,176) +rxt(k,260)* y(k,177) +rxt(k,358)* y(k,178) & + +rxt(k,364)* y(k,179) + (rxt(k,326) +rxt(k,327))* y(k,182) & + +rxt(k,404)* y(k,183) +rxt(k,335)* y(k,184) +rxt(k,407)* y(k,185) & + +rxt(k,338)* y(k,186) +rxt(k,437)* y(k,188) +rxt(k,410)* y(k,191) & + +rxt(k,309)* y(k,192) +rxt(k,313)* y(k,193) +rxt(k,442)* y(k,194) & + +rxt(k,447)* y(k,195) +rxt(k,417)* y(k,196) +rxt(k,383)* y(k,198) & + +rxt(k,423)* y(k,199) +rxt(k,426)* y(k,201) + rxt(k,15) & + + het_rates(k,116))* y(k,116) + prod(k,165) = (rxt(k,16) +.500_r8*rxt(k,479) +2.000_r8*rxt(k,142)*y(k,107) + & + rxt(k,145)*y(k,121) +rxt(k,461)*y(k,136))*y(k,117) + (rxt(k,144) + & + rxt(k,152)*y(k,190))*y(k,107) +2.000_r8*rxt(k,156)*y(k,189)*y(k,108) & + +rxt(k,14)*y(k,109) +rxt(k,17)*y(k,118) + loss(k,167) = (rxt(k,209)* y(k,17) +rxt(k,178)* y(k,57) + (rxt(k,141) + & + rxt(k,142) +rxt(k,143))* y(k,107) +rxt(k,159)* y(k,118) & + + (rxt(k,145) +rxt(k,147))* y(k,121) +rxt(k,146)* y(k,122) & + +rxt(k,412)* y(k,129) +rxt(k,461)* y(k,136) +rxt(k,415)* y(k,161) & + +rxt(k,295)* y(k,170) +rxt(k,402)* y(k,172) +rxt(k,158)* y(k,176) & + +rxt(k,405)* y(k,183) +rxt(k,344)* y(k,184) +rxt(k,408)* y(k,185) & + +rxt(k,160)* y(k,190) + rxt(k,16) + rxt(k,479) + het_rates(k,117)) & + * y(k,117) + prod(k,167) = (2.000_r8*rxt(k,149)*y(k,118) +rxt(k,153)*y(k,176) + & + rxt(k,154)*y(k,122) +rxt(k,155)*y(k,121) +rxt(k,176)*y(k,57) + & + rxt(k,208)*y(k,17) +rxt(k,251)*y(k,171) +rxt(k,260)*y(k,177) + & + rxt(k,273)*y(k,167) +rxt(k,284)*y(k,170) +rxt(k,288)*y(k,175) + & + rxt(k,301)*y(k,168) +rxt(k,309)*y(k,192) +rxt(k,313)*y(k,193) + & + rxt(k,319)*y(k,173) +rxt(k,326)*y(k,182) +rxt(k,335)*y(k,184) + & + rxt(k,338)*y(k,186) +rxt(k,348)*y(k,162) + & + .920_r8*rxt(k,358)*y(k,178) +.920_r8*rxt(k,364)*y(k,179) + & + rxt(k,372)*y(k,96) +rxt(k,383)*y(k,198) +rxt(k,387)*y(k,161) + & + rxt(k,390)*y(k,164) +rxt(k,395)*y(k,166) +rxt(k,397)*y(k,169) + & + rxt(k,401)*y(k,172) +rxt(k,404)*y(k,183) +rxt(k,407)*y(k,185) + & + rxt(k,410)*y(k,191) +rxt(k,417)*y(k,196) +rxt(k,423)*y(k,199) + & + rxt(k,426)*y(k,201) +1.600_r8*rxt(k,437)*y(k,188) + & + .900_r8*rxt(k,442)*y(k,194) +.800_r8*rxt(k,447)*y(k,195))*y(k,116) & + + (rxt(k,18) +rxt(k,148)*y(k,176) +rxt(k,150)*y(k,121) + & + rxt(k,151)*y(k,190) +rxt(k,317)*y(k,14) +rxt(k,325)*y(k,182) + & + rxt(k,336)*y(k,184) +rxt(k,359)*y(k,178) +rxt(k,365)*y(k,179) + & + rxt(k,373)*y(k,96) +rxt(k,384)*y(k,198) + & + 2.000_r8*rxt(k,438)*y(k,188))*y(k,118) + (rxt(k,139)*y(k,85) + & + rxt(k,307)*y(k,119) +rxt(k,346)*y(k,1) +.700_r8*rxt(k,366)*y(k,94) + & + rxt(k,444)*y(k,148))*y(k,190) + (rxt(k,11) +rxt(k,162))*y(k,85) & + + (rxt(k,54) +rxt(k,345))*y(k,104) + (rxt(k,13) +rxt(k,163)) & + *y(k,109) + (.600_r8*rxt(k,60) +rxt(k,296))*y(k,127) +rxt(k,19) & + *y(k,1) +rxt(k,76)*y(k,18) +rxt(k,95)*y(k,58) +rxt(k,9)*y(k,84) & + +rxt(k,45)*y(k,88) +rxt(k,48)*y(k,97) +rxt(k,56)*y(k,111) +rxt(k,57) & + *y(k,119) +rxt(k,58)*y(k,120) +rxt(k,59)*y(k,126) +rxt(k,420) & + *y(k,128) +rxt(k,66)*y(k,148) +.500_r8*rxt(k,435)*y(k,188)*y(k,171) + loss(k,170) = (rxt(k,429)* y(k,4) +rxt(k,317)* y(k,14) +rxt(k,297)* y(k,27) & + +rxt(k,245)* y(k,40) +rxt(k,278)* y(k,43) +rxt(k,304)* y(k,47) & + +rxt(k,452)* y(k,65) +rxt(k,368)* y(k,93) +rxt(k,373)* y(k,96) & + +rxt(k,432)* y(k,105) +rxt(k,149)* y(k,116) +rxt(k,159)* y(k,117) & + +rxt(k,150)* y(k,121) +rxt(k,449)* y(k,150) +rxt(k,148)* y(k,176) & + +rxt(k,359)* y(k,178) +rxt(k,365)* y(k,179) +rxt(k,325)* y(k,182) & + +rxt(k,336)* y(k,184) +rxt(k,438)* y(k,188) +rxt(k,151)* y(k,190) & + +rxt(k,384)* y(k,198) + rxt(k,17) + rxt(k,18) + rxt(k,480) & + + het_rates(k,118))* y(k,118) + prod(k,170) = (rxt(k,94) +rxt(k,177)*y(k,54) +rxt(k,179)*y(k,121) + & + rxt(k,180)*y(k,190))*y(k,58) + (rxt(k,13) +rxt(k,14) +rxt(k,163)) & + *y(k,109) + (rxt(k,161)*y(k,84) +rxt(k,293)*y(k,127) + & + .500_r8*rxt(k,341)*y(k,104))*y(k,190) + (rxt(k,77) + & + rxt(k,210)*y(k,121))*y(k,18) + (rxt(k,146)*y(k,122) + & + rxt(k,147)*y(k,121))*y(k,117) +rxt(k,224)*y(k,84)*y(k,68) +rxt(k,10) & + *y(k,85) +.400_r8*rxt(k,60)*y(k,127) + loss(k,121) = (rxt(k,307)* y(k,190) + rxt(k,57) + het_rates(k,119))* y(k,119) + prod(k,121) = (.500_r8*rxt(k,367)*y(k,95) +rxt(k,374)*y(k,97) + & + rxt(k,378)*y(k,110) +rxt(k,379)*y(k,111))*y(k,190) & + +rxt(k,297)*y(k,118)*y(k,27) + loss(k,66) = (rxt(k,439)* y(k,190) + rxt(k,58) + rxt(k,481) & + + het_rates(k,120))* y(k,120) + prod(k,66) =rxt(k,436)*y(k,188)*y(k,176) + loss(k,162) = (rxt(k,211)* y(k,17) +rxt(k,210)* y(k,18) +rxt(k,246)* y(k,40) & + +rxt(k,181)* y(k,57) +rxt(k,179)* y(k,58) +rxt(k,122)* y(k,72) & + +rxt(k,123)* y(k,74) +rxt(k,213)* y(k,76) +rxt(k,184)* y(k,80) & + +rxt(k,215)* y(k,86) +rxt(k,187)* y(k,87) +rxt(k,155)* y(k,116) & + + (rxt(k,145) +rxt(k,147))* y(k,117) +rxt(k,150)* y(k,118) & + + 2._r8*rxt(k,120)* y(k,121) +rxt(k,119)* y(k,122) +rxt(k,454) & + * y(k,125) +rxt(k,128)* y(k,176) +rxt(k,134)* y(k,190) + rxt(k,121) & + + het_rates(k,121))* y(k,121) + prod(k,162) = (rxt(k,144) +rxt(k,140)*y(k,116) +rxt(k,141)*y(k,117))*y(k,107) & + + (rxt(k,111) +rxt(k,462))*y(k,136) + (rxt(k,116) +rxt(k,117)) & + *y(k,189) +rxt(k,75)*y(k,17) +rxt(k,93)*y(k,57) +rxt(k,126)*y(k,176) & + *y(k,71) +rxt(k,14)*y(k,109) +rxt(k,15)*y(k,116) +rxt(k,16)*y(k,117) & + +rxt(k,18)*y(k,118) +rxt(k,8)*y(k,122) +rxt(k,107)*y(k,124) & + +rxt(k,456)*y(k,134) +rxt(k,112)*y(k,137) +rxt(k,113)*y(k,138) & + +rxt(k,136)*y(k,190)*y(k,190) +rxt(k,3)*y(k,202) + loss(k,166) = (rxt(k,430)* y(k,4) +rxt(k,202)* y(k,15) +rxt(k,269)* y(k,23) & + +rxt(k,298)* y(k,27) +rxt(k,170)* y(k,54) +rxt(k,130)* y(k,71) & + +rxt(k,375)* y(k,93) +rxt(k,328)* y(k,100) +rxt(k,433)* y(k,105) & + +rxt(k,342)* y(k,106) +rxt(k,154)* y(k,116) +rxt(k,146)* y(k,117) & + +rxt(k,119)* y(k,121) +rxt(k,413)* y(k,129) +rxt(k,457)* y(k,134) & + +rxt(k,463)* y(k,136) +rxt(k,129)* y(k,176) +rxt(k,118)* y(k,189) & + +rxt(k,135)* y(k,190) + rxt(k,7) + rxt(k,8) + het_rates(k,122)) & + * y(k,122) + prod(k,166) = (.150_r8*rxt(k,283)*y(k,170) +.150_r8*rxt(k,333)*y(k,184)) & + *y(k,176) +rxt(k,121)*y(k,121) + loss(k,56) = (rxt(k,464)* y(k,136) + rxt(k,107) + het_rates(k,124))* y(k,124) + prod(k,56) = (rxt(k,174)*y(k,57) +rxt(k,204)*y(k,17))*y(k,57) + loss(k,60) = (rxt(k,454)* y(k,121) +rxt(k,455)* y(k,190) + rxt(k,110) & + + het_rates(k,125))* y(k,125) + prod(k,60) = 0._r8 + loss(k,41) = ( + rxt(k,59) + rxt(k,482) + het_rates(k,126))* y(k,126) + prod(k,41) =rxt(k,321)*y(k,190)*y(k,88) +.100_r8*rxt(k,442)*y(k,194)*y(k,116) + loss(k,77) = (rxt(k,293)* y(k,190) + rxt(k,60) + rxt(k,296) & + + het_rates(k,127))* y(k,127) + prod(k,77) =rxt(k,295)*y(k,170)*y(k,117) + loss(k,24) = ( + rxt(k,420) + het_rates(k,128))* y(k,128) + prod(k,24) =rxt(k,415)*y(k,161)*y(k,117) + loss(k,78) = (rxt(k,412)* y(k,117) +rxt(k,413)* y(k,122) + het_rates(k,129)) & + * y(k,129) + prod(k,78) = (.070_r8*rxt(k,399)*y(k,64) +.060_r8*rxt(k,411)*y(k,130) + & + .070_r8*rxt(k,427)*y(k,157))*y(k,190) +rxt(k,31)*y(k,30) & + +rxt(k,397)*y(k,169)*y(k,116) + loss(k,28) = (rxt(k,411)* y(k,190) + het_rates(k,130))* y(k,130) + prod(k,28) =.530_r8*rxt(k,388)*y(k,190)*y(k,5) + loss(k,57) = (rxt(k,414)* y(k,190) + rxt(k,61) + het_rates(k,131))* y(k,131) + prod(k,57) =rxt(k,409)*y(k,191)*y(k,176) + loss(k,87) = (rxt(k,310)* y(k,190) + rxt(k,62) + het_rates(k,132))* y(k,132) + prod(k,87) =rxt(k,308)*y(k,192)*y(k,176) + loss(k,68) = (rxt(k,314)* y(k,190) + rxt(k,63) + het_rates(k,133))* y(k,133) + prod(k,68) =.850_r8*rxt(k,312)*y(k,193)*y(k,176) + loss(k,82) = (rxt(k,457)* y(k,122) +rxt(k,460)* y(k,190) + rxt(k,456) & + + het_rates(k,134))* y(k,134) + prod(k,82) =rxt(k,110)*y(k,125) +rxt(k,111)*y(k,136) + loss(k,147) = (rxt(k,458)* y(k,17) +rxt(k,459)* y(k,57) +rxt(k,461)* y(k,117) & + +rxt(k,463)* y(k,122) +rxt(k,464)* y(k,124) +rxt(k,465)* y(k,190) & + + rxt(k,111) + rxt(k,462) + het_rates(k,136))* y(k,136) + prod(k,147) = (rxt(k,456) +rxt(k,457)*y(k,122) +rxt(k,460)*y(k,190))*y(k,134) & + +rxt(k,454)*y(k,125)*y(k,121) +rxt(k,112)*y(k,137) + loss(k,120) = (rxt(k,467)* y(k,190) + rxt(k,112) + het_rates(k,137)) & + * y(k,137) + prod(k,120) = (rxt(k,462) +rxt(k,458)*y(k,17) +rxt(k,459)*y(k,57) + & + rxt(k,461)*y(k,117) +rxt(k,463)*y(k,122) +rxt(k,464)*y(k,124) + & + rxt(k,465)*y(k,190))*y(k,136) + (rxt(k,452)*y(k,118) + & + rxt(k,453)*y(k,190) +.500_r8*rxt(k,466)*y(k,190))*y(k,65) & + +rxt(k,455)*y(k,190)*y(k,125) +rxt(k,113)*y(k,138) + loss(k,45) = (rxt(k,468)* y(k,202) + rxt(k,113) + het_rates(k,138))* y(k,138) + prod(k,45) =rxt(k,109)*y(k,75) +rxt(k,467)*y(k,190)*y(k,137) + loss(k,2) = ( + het_rates(k,139))* y(k,139) + prod(k,2) = (.1279005_r8*rxt(k,486)*y(k,163) + & + .0097005_r8*rxt(k,491)*y(k,165) +.0003005_r8*rxt(k,494)*y(k,180) + & + .1056005_r8*rxt(k,498)*y(k,181) +.0245005_r8*rxt(k,502)*y(k,187) + & + .0154005_r8*rxt(k,508)*y(k,197) +.0063005_r8*rxt(k,511)*y(k,200)) & + *y(k,116) + (.2202005_r8*rxt(k,485)*y(k,163) + & + .0023005_r8*rxt(k,490)*y(k,165) +.0031005_r8*rxt(k,493)*y(k,180) + & + .2381005_r8*rxt(k,497)*y(k,181) +.0508005_r8*rxt(k,501)*y(k,187) + & + .1364005_r8*rxt(k,507)*y(k,197) +.1677005_r8*rxt(k,510)*y(k,200)) & + *y(k,176) + (.2202005_r8*rxt(k,487)*y(k,4) + & + .0508005_r8*rxt(k,503)*y(k,105))*y(k,122) +rxt(k,470)*y(k,70) & + +.5931005_r8*rxt(k,505)*y(k,190)*y(k,145) + loss(k,3) = ( + het_rates(k,140))* y(k,140) + prod(k,3) = (.1792005_r8*rxt(k,486)*y(k,163) + & + .0034005_r8*rxt(k,491)*y(k,165) +.0003005_r8*rxt(k,494)*y(k,180) + & + .1026005_r8*rxt(k,498)*y(k,181) +.0082005_r8*rxt(k,502)*y(k,187) + & + .0452005_r8*rxt(k,508)*y(k,197) +.0237005_r8*rxt(k,511)*y(k,200)) & + *y(k,116) + (.2067005_r8*rxt(k,485)*y(k,163) + & + .0008005_r8*rxt(k,490)*y(k,165) +.0035005_r8*rxt(k,493)*y(k,180) + & + .1308005_r8*rxt(k,497)*y(k,181) +.1149005_r8*rxt(k,501)*y(k,187) + & + .0101005_r8*rxt(k,507)*y(k,197) +.0174005_r8*rxt(k,510)*y(k,200)) & + *y(k,176) + (.2067005_r8*rxt(k,487)*y(k,4) + & + .1149005_r8*rxt(k,503)*y(k,105))*y(k,122) & + +.1534005_r8*rxt(k,505)*y(k,190)*y(k,145) + loss(k,4) = ( + het_rates(k,141))* y(k,141) + prod(k,4) = (.0676005_r8*rxt(k,486)*y(k,163) + & + .1579005_r8*rxt(k,491)*y(k,165) +.0073005_r8*rxt(k,494)*y(k,180) + & + .0521005_r8*rxt(k,498)*y(k,181) +.0772005_r8*rxt(k,502)*y(k,187) + & + .0966005_r8*rxt(k,508)*y(k,197) +.0025005_r8*rxt(k,511)*y(k,200)) & + *y(k,116) + (.0653005_r8*rxt(k,485)*y(k,163) + & + .0843005_r8*rxt(k,490)*y(k,165) +.0003005_r8*rxt(k,493)*y(k,180) + & + .0348005_r8*rxt(k,497)*y(k,181) +.0348005_r8*rxt(k,501)*y(k,187) + & + .0763005_r8*rxt(k,507)*y(k,197) +.086_r8*rxt(k,510)*y(k,200)) & + *y(k,176) + (.0653005_r8*rxt(k,487)*y(k,4) + & + .0348005_r8*rxt(k,503)*y(k,105))*y(k,122) & + +.0459005_r8*rxt(k,505)*y(k,190)*y(k,145) + loss(k,5) = ( + het_rates(k,142))* y(k,142) + prod(k,5) = (.079_r8*rxt(k,486)*y(k,163) +.0059005_r8*rxt(k,491)*y(k,165) + & + .0057005_r8*rxt(k,494)*y(k,180) +.0143005_r8*rxt(k,498)*y(k,181) + & + .0332005_r8*rxt(k,502)*y(k,187) +.0073005_r8*rxt(k,508)*y(k,197) + & + .011_r8*rxt(k,511)*y(k,200))*y(k,116) & + + (.1284005_r8*rxt(k,485)*y(k,163) + & + .0443005_r8*rxt(k,490)*y(k,165) +.0271005_r8*rxt(k,493)*y(k,180) + & + .0076005_r8*rxt(k,497)*y(k,181) +.0554005_r8*rxt(k,501)*y(k,187) + & + .2157005_r8*rxt(k,507)*y(k,197) +.0512005_r8*rxt(k,510)*y(k,200)) & + *y(k,176) + (.1749305_r8*rxt(k,484)*y(k,4) + & + .0590245_r8*rxt(k,492)*y(k,93) +.1749305_r8*rxt(k,500)*y(k,105)) & + *y(k,118) + (.1284005_r8*rxt(k,487)*y(k,4) + & + .0033005_r8*rxt(k,495)*y(k,93) +.0554005_r8*rxt(k,503)*y(k,105)) & + *y(k,122) +.0085005_r8*rxt(k,505)*y(k,190)*y(k,145) + loss(k,6) = ( + het_rates(k,143))* y(k,143) + prod(k,6) = (.1254005_r8*rxt(k,486)*y(k,163) + & + .0536005_r8*rxt(k,491)*y(k,165) +.0623005_r8*rxt(k,494)*y(k,180) + & + .0166005_r8*rxt(k,498)*y(k,181) +.130_r8*rxt(k,502)*y(k,187) + & + .238_r8*rxt(k,508)*y(k,197) +.1185005_r8*rxt(k,511)*y(k,200)) & + *y(k,116) + (.114_r8*rxt(k,485)*y(k,163) + & + .1621005_r8*rxt(k,490)*y(k,165) +.0474005_r8*rxt(k,493)*y(k,180) + & + .0113005_r8*rxt(k,497)*y(k,181) +.1278005_r8*rxt(k,501)*y(k,187) + & + .0738005_r8*rxt(k,507)*y(k,197) +.1598005_r8*rxt(k,510)*y(k,200)) & + *y(k,176) + (.5901905_r8*rxt(k,484)*y(k,4) + & + .0250245_r8*rxt(k,492)*y(k,93) +.5901905_r8*rxt(k,500)*y(k,105)) & + *y(k,118) + (.114_r8*rxt(k,487)*y(k,4) + & + .1278005_r8*rxt(k,503)*y(k,105))*y(k,122) & + +.0128005_r8*rxt(k,505)*y(k,190)*y(k,145) + loss(k,7) = (rxt(k,505)* y(k,190) + het_rates(k,145))* y(k,145) + prod(k,7) = 0._r8 + loss(k,33) = ( + rxt(k,64) + het_rates(k,146))* y(k,146) + prod(k,33) = (.100_r8*rxt(k,419)*y(k,153) +.230_r8*rxt(k,421)*y(k,155)) & + *y(k,190) + loss(k,95) = (rxt(k,443)* y(k,190) + rxt(k,65) + het_rates(k,147))* y(k,147) + prod(k,95) =rxt(k,441)*y(k,194)*y(k,176) + loss(k,98) = (rxt(k,444)* y(k,190) + rxt(k,66) + rxt(k,483) & + + het_rates(k,148))* y(k,148) + prod(k,98) = (.200_r8*rxt(k,437)*y(k,188) +.200_r8*rxt(k,447)*y(k,195)) & + *y(k,116) +.500_r8*rxt(k,435)*y(k,188)*y(k,171) + loss(k,79) = (rxt(k,448)* y(k,190) + rxt(k,67) + het_rates(k,149))* y(k,149) + prod(k,79) =rxt(k,446)*y(k,195)*y(k,176) + loss(k,130) = (rxt(k,449)* y(k,118) +rxt(k,450)* y(k,190) + rxt(k,68) & + + het_rates(k,150))* y(k,150) + prod(k,130) = (.500_r8*rxt(k,435)*y(k,171) +.800_r8*rxt(k,437)*y(k,116) + & + rxt(k,438)*y(k,118))*y(k,188) + (.330_r8*rxt(k,430)*y(k,4) + & + .330_r8*rxt(k,433)*y(k,105))*y(k,122) + (rxt(k,66) + & + rxt(k,444)*y(k,190))*y(k,148) + (rxt(k,445)*y(k,171) + & + .800_r8*rxt(k,447)*y(k,116))*y(k,195) +rxt(k,58)*y(k,120) +rxt(k,67) & + *y(k,149) + loss(k,133) = (rxt(k,451)* y(k,190) + rxt(k,69) + het_rates(k,151))* y(k,151) + prod(k,133) = (.300_r8*rxt(k,430)*y(k,4) +.300_r8*rxt(k,433)*y(k,105)) & + *y(k,122) + (rxt(k,440)*y(k,171) +.900_r8*rxt(k,442)*y(k,116)) & + *y(k,194) +rxt(k,65)*y(k,147) +rxt(k,68)*y(k,150) + loss(k,96) = (rxt(k,418)* y(k,190) + rxt(k,70) + het_rates(k,152))* y(k,152) + prod(k,96) =rxt(k,416)*y(k,196)*y(k,176) + loss(k,31) = (rxt(k,419)* y(k,190) + het_rates(k,153))* y(k,153) + prod(k,31) = 0._r8 + loss(k,34) = (rxt(k,385)* y(k,190) + rxt(k,71) + het_rates(k,154))* y(k,154) + prod(k,34) =rxt(k,382)*y(k,198)*y(k,176) + loss(k,35) = (rxt(k,421)* y(k,190) + het_rates(k,155))* y(k,155) + prod(k,35) = 0._r8 + loss(k,103) = (rxt(k,424)* y(k,190) + rxt(k,72) + het_rates(k,156))* y(k,156) + prod(k,103) =rxt(k,422)*y(k,199)*y(k,176) + loss(k,36) = (rxt(k,427)* y(k,190) + het_rates(k,157))* y(k,157) + prod(k,36) =.150_r8*rxt(k,421)*y(k,190)*y(k,155) + loss(k,72) = (rxt(k,428)* y(k,190) + rxt(k,73) + het_rates(k,158))* y(k,158) + prod(k,72) =rxt(k,425)*y(k,201)*y(k,176) + loss(k,85) = (rxt(k,387)* y(k,116) +rxt(k,415)* y(k,117) +rxt(k,386) & + * y(k,176) + het_rates(k,161))* y(k,161) + prod(k,85) =rxt(k,392)*y(k,190)*y(k,20) +rxt(k,420)*y(k,128) + loss(k,126) = ((rxt(k,348) +rxt(k,349))* y(k,116) +rxt(k,347)* y(k,176) & + + het_rates(k,162))* y(k,162) + prod(k,126) = (rxt(k,350)*y(k,2) +rxt(k,351)*y(k,13))*y(k,190) + loss(k,8) = (rxt(k,486)* y(k,116) +rxt(k,485)* y(k,176) + het_rates(k,163)) & + * y(k,163) + prod(k,8) =rxt(k,488)*y(k,190)*y(k,4) + loss(k,80) = (rxt(k,390)* y(k,116) +rxt(k,389)* y(k,176) + het_rates(k,164)) & + * y(k,164) + prod(k,80) = (.350_r8*rxt(k,388)*y(k,5) +rxt(k,391)*y(k,6))*y(k,190) + loss(k,9) = (rxt(k,491)* y(k,116) +rxt(k,490)* y(k,176) + het_rates(k,165)) & + * y(k,165) + prod(k,9) =rxt(k,489)*y(k,190)*y(k,5) + loss(k,73) = (rxt(k,395)* y(k,116) +rxt(k,393)* y(k,176) + het_rates(k,166)) & + * y(k,166) + prod(k,73) = (rxt(k,394)*y(k,21) +.070_r8*rxt(k,419)*y(k,153) + & + .060_r8*rxt(k,421)*y(k,155))*y(k,190) + loss(k,117) = (rxt(k,273)* y(k,116) + 2._r8*rxt(k,270)* y(k,167) +rxt(k,271) & + * y(k,171) +rxt(k,272)* y(k,176) + het_rates(k,167))* y(k,167) + prod(k,117) = (rxt(k,276)*y(k,54) +rxt(k,277)*y(k,190))*y(k,26) & + +.500_r8*rxt(k,275)*y(k,190)*y(k,25) +rxt(k,52)*y(k,102) + loss(k,114) = (rxt(k,301)* y(k,116) +rxt(k,299)* y(k,171) +rxt(k,300) & + * y(k,176) + het_rates(k,168))* y(k,168) + prod(k,114) = (rxt(k,302)*y(k,28) +rxt(k,303)*y(k,29))*y(k,190) + loss(k,99) = (rxt(k,397)* y(k,116) +rxt(k,396)* y(k,176) + het_rates(k,169)) & + * y(k,169) + prod(k,99) = (.400_r8*rxt(k,386)*y(k,176) +rxt(k,387)*y(k,116))*y(k,161) & + +rxt(k,398)*y(k,190)*y(k,30) +rxt(k,413)*y(k,129)*y(k,122) + loss(k,153) = (rxt(k,369)* y(k,96) +rxt(k,284)* y(k,116) +rxt(k,295) & + * y(k,117) + 2._r8*rxt(k,281)* y(k,170) +rxt(k,282)* y(k,171) & + +rxt(k,283)* y(k,176) +rxt(k,355)* y(k,178) +rxt(k,360)* y(k,179) & + +rxt(k,322)* y(k,182) +rxt(k,380)* y(k,198) + het_rates(k,170)) & + * y(k,170) + prod(k,153) = (.100_r8*rxt(k,328)*y(k,100) +.280_r8*rxt(k,342)*y(k,106) + & + .080_r8*rxt(k,375)*y(k,93) +.060_r8*rxt(k,430)*y(k,4) + & + .060_r8*rxt(k,433)*y(k,105))*y(k,122) + (rxt(k,332)*y(k,171) + & + .450_r8*rxt(k,333)*y(k,176) +2.000_r8*rxt(k,334)*y(k,184) + & + rxt(k,335)*y(k,116) +rxt(k,336)*y(k,118))*y(k,184) & + + (.530_r8*rxt(k,322)*y(k,170) +.260_r8*rxt(k,323)*y(k,171) + & + .530_r8*rxt(k,325)*y(k,118) +.530_r8*rxt(k,326)*y(k,116))*y(k,182) & + + (rxt(k,279)*y(k,43) +.500_r8*rxt(k,286)*y(k,49) + & + rxt(k,305)*y(k,47) +.650_r8*rxt(k,451)*y(k,151))*y(k,190) & + + (.300_r8*rxt(k,311)*y(k,171) +.150_r8*rxt(k,312)*y(k,176) + & + rxt(k,313)*y(k,116))*y(k,193) + (rxt(k,36) +rxt(k,304)*y(k,118)) & + *y(k,47) + (.600_r8*rxt(k,60) +rxt(k,296))*y(k,127) & + + (.200_r8*rxt(k,337)*y(k,176) +rxt(k,338)*y(k,116))*y(k,186) & + +.130_r8*rxt(k,23)*y(k,8) +rxt(k,27)*y(k,12) +rxt(k,278)*y(k,118) & + *y(k,43) +rxt(k,35)*y(k,46) +.330_r8*rxt(k,45)*y(k,88) +rxt(k,47) & + *y(k,90) +1.340_r8*rxt(k,50)*y(k,100) +rxt(k,52)*y(k,102) +rxt(k,53) & + *y(k,103) +.300_r8*rxt(k,55)*y(k,106) +rxt(k,57)*y(k,119) +rxt(k,63) & + *y(k,133) +.500_r8*rxt(k,64)*y(k,146) +.650_r8*rxt(k,69)*y(k,151) + loss(k,157) = (rxt(k,171)* y(k,57) +rxt(k,370)* y(k,96) +rxt(k,251)* y(k,116) & + +rxt(k,271)* y(k,167) +rxt(k,299)* y(k,168) +rxt(k,282)* y(k,170) & + + 2._r8*(rxt(k,248) +rxt(k,249))* y(k,171) +rxt(k,250)* y(k,176) & + +rxt(k,356)* y(k,178) +rxt(k,361)* y(k,179) +rxt(k,323)* y(k,182) & + +rxt(k,332)* y(k,184) +rxt(k,435)* y(k,188) +rxt(k,311)* y(k,193) & + +rxt(k,440)* y(k,194) +rxt(k,445)* y(k,195) +rxt(k,381)* y(k,198) & + + het_rates(k,171))* y(k,171) + prod(k,157) = (2.000_r8*rxt(k,281)*y(k,170) +.900_r8*rxt(k,282)*y(k,171) + & + .450_r8*rxt(k,283)*y(k,176) +rxt(k,284)*y(k,116) + & + rxt(k,322)*y(k,182) +rxt(k,331)*y(k,184) +rxt(k,355)*y(k,178) + & + rxt(k,360)*y(k,179) +rxt(k,369)*y(k,96) +rxt(k,380)*y(k,198)) & + *y(k,170) + (rxt(k,165)*y(k,54) +rxt(k,221)*y(k,68) + & + rxt(k,254)*y(k,190) +rxt(k,261)*y(k,189))*y(k,52) & + + (.830_r8*rxt(k,401)*y(k,172) +.170_r8*rxt(k,407)*y(k,185)) & + *y(k,116) + (.280_r8*rxt(k,298)*y(k,27) +.050_r8*rxt(k,375)*y(k,93)) & + *y(k,122) + (.330_r8*rxt(k,400)*y(k,172) + & + .070_r8*rxt(k,406)*y(k,185))*y(k,176) + (.700_r8*rxt(k,253)*y(k,51) + & + rxt(k,285)*y(k,48))*y(k,190) +rxt(k,34)*y(k,43) +rxt(k,35)*y(k,46) & + +rxt(k,37)*y(k,49) +.300_r8*rxt(k,55)*y(k,106) +.400_r8*rxt(k,60) & + *y(k,127) + loss(k,109) = (rxt(k,401)* y(k,116) +rxt(k,402)* y(k,117) +rxt(k,400) & + * y(k,176) + het_rates(k,172))* y(k,172) + prod(k,109) =.600_r8*rxt(k,25)*y(k,10) + loss(k,91) = ((rxt(k,319) +rxt(k,320))* y(k,116) + het_rates(k,173)) & + * y(k,173) + prod(k,91) =rxt(k,318)*y(k,190)*y(k,14) + loss(k,46) = ( + rxt(k,289) + rxt(k,290) + het_rates(k,174))* y(k,174) + prod(k,46) =rxt(k,42)*y(k,67) +.750_r8*rxt(k,288)*y(k,175)*y(k,116) + loss(k,104) = (rxt(k,288)* y(k,116) +rxt(k,287)* y(k,176) + het_rates(k,175)) & + * y(k,175) + prod(k,104) =rxt(k,294)*y(k,190)*y(k,23) + loss(k,163) = (rxt(k,201)* y(k,15) +rxt(k,207)* y(k,17) +rxt(k,244)* y(k,40) & + + (rxt(k,168) +rxt(k,169))* y(k,54) +rxt(k,175)* y(k,57) & + + (rxt(k,124) +rxt(k,125) +rxt(k,126))* y(k,71) +rxt(k,371)* y(k,96) & + +rxt(k,153)* y(k,116) +rxt(k,158)* y(k,117) +rxt(k,148)* y(k,118) & + +rxt(k,128)* y(k,121) +rxt(k,129)* y(k,122) +rxt(k,386)* y(k,161) & + +rxt(k,347)* y(k,162) +rxt(k,389)* y(k,164) +rxt(k,393)* y(k,166) & + +rxt(k,272)* y(k,167) +rxt(k,300)* y(k,168) +rxt(k,396)* y(k,169) & + +rxt(k,283)* y(k,170) +rxt(k,250)* y(k,171) +rxt(k,400)* y(k,172) & + +rxt(k,287)* y(k,175) + 2._r8*rxt(k,138)* y(k,176) +rxt(k,258) & + * y(k,177) +rxt(k,357)* y(k,178) +rxt(k,362)* y(k,179) +rxt(k,324) & + * y(k,182) +rxt(k,403)* y(k,183) +rxt(k,333)* y(k,184) +rxt(k,406) & + * y(k,185) +rxt(k,337)* y(k,186) +rxt(k,436)* y(k,188) +rxt(k,133) & + * y(k,190) +rxt(k,409)* y(k,191) +rxt(k,308)* y(k,192) +rxt(k,312) & + * y(k,193) +rxt(k,441)* y(k,194) +rxt(k,446)* y(k,195) +rxt(k,416) & + * y(k,196) +rxt(k,382)* y(k,198) +rxt(k,422)* y(k,199) +rxt(k,425) & + * y(k,201) + rxt(k,471) + het_rates(k,176))* y(k,176) + prod(k,163) = (rxt(k,230)*y(k,41) +rxt(k,233)*y(k,44) +rxt(k,132)*y(k,74) + & + rxt(k,135)*y(k,122) +rxt(k,151)*y(k,118) +rxt(k,182)*y(k,57) + & + rxt(k,212)*y(k,17) +rxt(k,252)*y(k,50) +rxt(k,255)*y(k,60) + & + rxt(k,256)*y(k,81) +rxt(k,257)*y(k,82) +.350_r8*rxt(k,267)*y(k,22) + & + rxt(k,274)*y(k,24) +rxt(k,280)*y(k,45) +rxt(k,291)*y(k,69) + & + rxt(k,292)*y(k,70) +rxt(k,306)*y(k,90) +rxt(k,321)*y(k,88) + & + .200_r8*rxt(k,330)*y(k,101) +.500_r8*rxt(k,341)*y(k,104) + & + .300_r8*rxt(k,366)*y(k,94) +rxt(k,367)*y(k,95) +rxt(k,374)*y(k,97) + & + rxt(k,378)*y(k,110) +rxt(k,379)*y(k,111) +.650_r8*rxt(k,388)*y(k,5) + & + .730_r8*rxt(k,399)*y(k,64) +.800_r8*rxt(k,411)*y(k,130) + & + .280_r8*rxt(k,419)*y(k,153) +.380_r8*rxt(k,421)*y(k,155) + & + .630_r8*rxt(k,427)*y(k,157) +.200_r8*rxt(k,451)*y(k,151) + & + .500_r8*rxt(k,466)*y(k,65) +rxt(k,467)*y(k,137))*y(k,190) & + + (rxt(k,251)*y(k,171) +rxt(k,260)*y(k,177) +rxt(k,273)*y(k,167) + & + .250_r8*rxt(k,288)*y(k,175) +rxt(k,301)*y(k,168) + & + rxt(k,309)*y(k,192) +rxt(k,319)*y(k,173) + & + .470_r8*rxt(k,326)*y(k,182) +rxt(k,348)*y(k,162) + & + .920_r8*rxt(k,358)*y(k,178) +.920_r8*rxt(k,364)*y(k,179) + & + rxt(k,372)*y(k,96) +rxt(k,383)*y(k,198) +rxt(k,390)*y(k,164) + & + rxt(k,395)*y(k,166) +.170_r8*rxt(k,401)*y(k,172) + & + .400_r8*rxt(k,404)*y(k,183) +.830_r8*rxt(k,407)*y(k,185) + & + rxt(k,410)*y(k,191) +rxt(k,417)*y(k,196) +rxt(k,423)*y(k,199) + & + rxt(k,426)*y(k,201) +.900_r8*rxt(k,442)*y(k,194) + & + .800_r8*rxt(k,447)*y(k,195))*y(k,116) + (rxt(k,171)*y(k,57) + & + 2.000_r8*rxt(k,248)*y(k,171) +rxt(k,271)*y(k,167) + & + .900_r8*rxt(k,282)*y(k,170) +rxt(k,299)*y(k,168) + & + .300_r8*rxt(k,311)*y(k,193) +.730_r8*rxt(k,323)*y(k,182) + & + rxt(k,332)*y(k,184) +rxt(k,356)*y(k,178) +rxt(k,361)*y(k,179) + & + 1.200_r8*rxt(k,370)*y(k,96) +.800_r8*rxt(k,381)*y(k,198) + & + .500_r8*rxt(k,435)*y(k,188) +rxt(k,440)*y(k,194) + & + rxt(k,445)*y(k,195))*y(k,171) + (.130_r8*rxt(k,269)*y(k,23) + & + .280_r8*rxt(k,298)*y(k,27) +.140_r8*rxt(k,328)*y(k,100) + & + .280_r8*rxt(k,342)*y(k,106) +.370_r8*rxt(k,375)*y(k,93) + & + .570_r8*rxt(k,430)*y(k,4) +.570_r8*rxt(k,433)*y(k,105))*y(k,122) & + + (rxt(k,245)*y(k,40) +.470_r8*rxt(k,325)*y(k,182) + & + rxt(k,359)*y(k,178) +rxt(k,365)*y(k,179) +rxt(k,373)*y(k,96) + & + rxt(k,384)*y(k,198))*y(k,118) + (.470_r8*rxt(k,322)*y(k,182) + & + rxt(k,355)*y(k,178) +rxt(k,360)*y(k,179) +rxt(k,369)*y(k,96) + & + rxt(k,380)*y(k,198))*y(k,170) + (rxt(k,229)*y(k,41) + & + rxt(k,232)*y(k,44) +rxt(k,164)*y(k,40) +rxt(k,167)*y(k,74))*y(k,54) & + + (.070_r8*rxt(k,400)*y(k,172) +.160_r8*rxt(k,403)*y(k,183) + & + .330_r8*rxt(k,406)*y(k,185))*y(k,176) + (rxt(k,200)*y(k,15) + & + rxt(k,246)*y(k,121))*y(k,40) + (rxt(k,11) +rxt(k,162))*y(k,85) & + + (1.340_r8*rxt(k,50) +.660_r8*rxt(k,51))*y(k,100) + (rxt(k,289) + & + rxt(k,290))*y(k,174) +rxt(k,19)*y(k,1) +.900_r8*rxt(k,20)*y(k,2) & + +rxt(k,21)*y(k,6) +1.500_r8*rxt(k,22)*y(k,7) +.560_r8*rxt(k,23) & + *y(k,8) +rxt(k,24)*y(k,9) +.600_r8*rxt(k,25)*y(k,10) & + +.600_r8*rxt(k,26)*y(k,11) +rxt(k,27)*y(k,12) +rxt(k,28)*y(k,21) & + +rxt(k,29)*y(k,25) +rxt(k,30)*y(k,28) +rxt(k,34)*y(k,43) +rxt(k,36) & + *y(k,47) +rxt(k,262)*y(k,189)*y(k,52) +2.000_r8*rxt(k,43)*y(k,69) & + +2.000_r8*rxt(k,44)*y(k,70) +rxt(k,127)*y(k,71) +rxt(k,123)*y(k,121) & + *y(k,74) +.670_r8*rxt(k,45)*y(k,88) +rxt(k,46)*y(k,89) +rxt(k,47) & + *y(k,90) +rxt(k,48)*y(k,97) +rxt(k,49)*y(k,98) +rxt(k,56)*y(k,111) & + +rxt(k,61)*y(k,131) +rxt(k,62)*y(k,132) +rxt(k,64)*y(k,146) & + +rxt(k,65)*y(k,147) +rxt(k,66)*y(k,148) +rxt(k,67)*y(k,149) & + +rxt(k,68)*y(k,150) +1.200_r8*rxt(k,69)*y(k,151) +rxt(k,70)*y(k,152) & + +rxt(k,72)*y(k,156) +rxt(k,73)*y(k,158) & + +1.200_r8*rxt(k,270)*y(k,167)*y(k,167) +rxt(k,259)*y(k,177) & + +rxt(k,363)*y(k,179) + loss(k,74) = (rxt(k,260)* y(k,116) +rxt(k,258)* y(k,176) + rxt(k,259) & + + het_rates(k,177))* y(k,177) + prod(k,74) =rxt(k,244)*y(k,176)*y(k,40) + loss(k,151) = (rxt(k,358)* y(k,116) +rxt(k,359)* y(k,118) +rxt(k,355) & + * y(k,170) +rxt(k,356)* y(k,171) +rxt(k,357)* y(k,176) & + + het_rates(k,178))* y(k,178) + prod(k,151) =.600_r8*rxt(k,376)*y(k,190)*y(k,93) + loss(k,148) = (rxt(k,364)* y(k,116) +rxt(k,365)* y(k,118) +rxt(k,360) & + * y(k,170) +rxt(k,361)* y(k,171) +rxt(k,362)* y(k,176) + rxt(k,363) & + + het_rates(k,179))* y(k,179) + prod(k,148) =.400_r8*rxt(k,376)*y(k,190)*y(k,93) + loss(k,10) = (rxt(k,494)* y(k,116) +rxt(k,493)* y(k,176) + het_rates(k,180)) & + * y(k,180) + prod(k,10) =rxt(k,496)*y(k,190)*y(k,93) + loss(k,11) = (rxt(k,498)* y(k,116) +rxt(k,497)* y(k,176) + het_rates(k,181)) & + * y(k,181) + prod(k,11) =rxt(k,499)*y(k,190)*y(k,99) + loss(k,150) = ((rxt(k,326) +rxt(k,327))* y(k,116) +rxt(k,325)* y(k,118) & + +rxt(k,322)* y(k,170) +rxt(k,323)* y(k,171) +rxt(k,324)* y(k,176) & + + het_rates(k,182))* y(k,182) + prod(k,150) = (.500_r8*rxt(k,329)*y(k,100) +.200_r8*rxt(k,330)*y(k,101) + & + rxt(k,343)*y(k,106))*y(k,190) + loss(k,105) = (rxt(k,404)* y(k,116) +rxt(k,405)* y(k,117) +rxt(k,403) & + * y(k,176) + het_rates(k,183))* y(k,183) + prod(k,105) =.600_r8*rxt(k,24)*y(k,9) + loss(k,152) = (rxt(k,335)* y(k,116) +rxt(k,344)* y(k,117) +rxt(k,336) & + * y(k,118) +rxt(k,331)* y(k,170) +rxt(k,332)* y(k,171) +rxt(k,333) & + * y(k,176) + 2._r8*rxt(k,334)* y(k,184) + het_rates(k,184))* y(k,184) + prod(k,152) = (.660_r8*rxt(k,50) +.500_r8*rxt(k,329)*y(k,190))*y(k,100) & + + (rxt(k,54) +rxt(k,345))*y(k,104) +.500_r8*rxt(k,330)*y(k,190) & + *y(k,101) + loss(k,123) = (rxt(k,407)* y(k,116) +rxt(k,408)* y(k,117) +rxt(k,406) & + * y(k,176) + het_rates(k,185))* y(k,185) + prod(k,123) =.600_r8*rxt(k,26)*y(k,11) + loss(k,102) = (rxt(k,338)* y(k,116) +rxt(k,337)* y(k,176) + het_rates(k,186)) & + * y(k,186) + prod(k,102) = (rxt(k,339)*y(k,102) +rxt(k,340)*y(k,103))*y(k,190) + loss(k,13) = (rxt(k,502)* y(k,116) +rxt(k,501)* y(k,176) + het_rates(k,187)) & + * y(k,187) + prod(k,13) =rxt(k,504)*y(k,190)*y(k,105) + loss(k,140) = (rxt(k,437)* y(k,116) +rxt(k,438)* y(k,118) +rxt(k,435) & + * y(k,171) +rxt(k,436)* y(k,176) + het_rates(k,188))* y(k,188) + prod(k,140) = (rxt(k,429)*y(k,4) +rxt(k,432)*y(k,105) + & + .500_r8*rxt(k,449)*y(k,150))*y(k,118) +rxt(k,439)*y(k,190)*y(k,120) + loss(k,158) = (rxt(k,189)* y(k,31) +rxt(k,190)* y(k,32) +rxt(k,216)* y(k,33) & + +rxt(k,191)* y(k,34) +rxt(k,192)* y(k,35) +rxt(k,193)* y(k,36) & + +rxt(k,194)* y(k,37) +rxt(k,195)* y(k,38) +rxt(k,239)* y(k,39) & + +rxt(k,240)* y(k,41) + (rxt(k,261) +rxt(k,262) +rxt(k,263))* y(k,52) & + +rxt(k,217)* y(k,53) +rxt(k,225)* y(k,62) +rxt(k,226)* y(k,63) & + +rxt(k,114)* y(k,72) +rxt(k,218)* y(k,73) + (rxt(k,219) +rxt(k,220)) & + * y(k,76) +rxt(k,241)* y(k,77) +rxt(k,242)* y(k,78) +rxt(k,243) & + * y(k,79) + (rxt(k,196) +rxt(k,197))* y(k,80) +rxt(k,264)* y(k,81) & + + (rxt(k,156) +rxt(k,157))* y(k,108) +rxt(k,118)* y(k,122) & + +rxt(k,115)* y(k,202) + rxt(k,116) + rxt(k,117) + het_rates(k,189)) & + * y(k,189) + prod(k,158) =rxt(k,7)*y(k,122) +rxt(k,1)*y(k,202) + loss(k,159) = (rxt(k,346)* y(k,1) +rxt(k,350)* y(k,2) +rxt(k,431)* y(k,4) & + +rxt(k,388)* y(k,5) +rxt(k,391)* y(k,6) +rxt(k,351)* y(k,13) & + +rxt(k,318)* y(k,14) +rxt(k,212)* y(k,17) +rxt(k,392)* y(k,20) & + +rxt(k,394)* y(k,21) +rxt(k,267)* y(k,22) +rxt(k,294)* y(k,23) & + +rxt(k,274)* y(k,24) +rxt(k,275)* y(k,25) +rxt(k,277)* y(k,26) & + +rxt(k,315)* y(k,27) +rxt(k,302)* y(k,28) +rxt(k,303)* y(k,29) & + +rxt(k,398)* y(k,30) +rxt(k,228)* y(k,39) +rxt(k,247)* y(k,40) & + +rxt(k,230)* y(k,41) +rxt(k,231)* y(k,42) +rxt(k,279)* y(k,43) & + +rxt(k,233)* y(k,44) +rxt(k,280)* y(k,45) +rxt(k,316)* y(k,46) & + +rxt(k,305)* y(k,47) +rxt(k,285)* y(k,48) +rxt(k,286)* y(k,49) & + +rxt(k,252)* y(k,50) +rxt(k,253)* y(k,51) +rxt(k,254)* y(k,52) & + +rxt(k,235)* y(k,53) + (rxt(k,182) +rxt(k,183))* y(k,57) +rxt(k,180) & + * y(k,58) + (rxt(k,255) +rxt(k,265))* y(k,60) +rxt(k,399)* y(k,64) & + + (rxt(k,453) +rxt(k,466))* y(k,65) +rxt(k,291)* y(k,69) +rxt(k,292) & + * y(k,70) +rxt(k,131)* y(k,72) +rxt(k,132)* y(k,74) +rxt(k,214) & + * y(k,76) +rxt(k,236)* y(k,77) +rxt(k,237)* y(k,78) +rxt(k,238) & + * y(k,79) +rxt(k,185)* y(k,80) +rxt(k,256)* y(k,81) +rxt(k,257) & + * y(k,82) +rxt(k,161)* y(k,84) +rxt(k,139)* y(k,85) +rxt(k,188) & + * y(k,87) +rxt(k,321)* y(k,88) +rxt(k,352)* y(k,89) +rxt(k,306) & + * y(k,90) +rxt(k,353)* y(k,91) +rxt(k,354)* y(k,92) +rxt(k,376) & + * y(k,93) +rxt(k,366)* y(k,94) +rxt(k,367)* y(k,95) +rxt(k,374) & + * y(k,97) +rxt(k,377)* y(k,98) +rxt(k,329)* y(k,100) +rxt(k,330) & + * y(k,101) +rxt(k,339)* y(k,102) +rxt(k,340)* y(k,103) +rxt(k,341) & + * y(k,104) +rxt(k,434)* y(k,105) +rxt(k,343)* y(k,106) +rxt(k,152) & + * y(k,107) +rxt(k,378)* y(k,110) +rxt(k,379)* y(k,111) +rxt(k,469) & + * y(k,112) +rxt(k,160)* y(k,117) +rxt(k,151)* y(k,118) +rxt(k,307) & + * y(k,119) +rxt(k,439)* y(k,120) +rxt(k,134)* y(k,121) +rxt(k,135) & + * y(k,122) +rxt(k,455)* y(k,125) +rxt(k,293)* y(k,127) +rxt(k,411) & + * y(k,130) +rxt(k,414)* y(k,131) +rxt(k,310)* y(k,132) +rxt(k,314) & + * y(k,133) +rxt(k,460)* y(k,134) +rxt(k,465)* y(k,136) +rxt(k,467) & + * y(k,137) +rxt(k,443)* y(k,147) +rxt(k,444)* y(k,148) +rxt(k,448) & + * y(k,149) +rxt(k,450)* y(k,150) +rxt(k,451)* y(k,151) +rxt(k,418) & + * y(k,152) +rxt(k,419)* y(k,153) +rxt(k,385)* y(k,154) +rxt(k,421) & + * y(k,155) +rxt(k,424)* y(k,156) +rxt(k,427)* y(k,157) +rxt(k,428) & + * y(k,158) +rxt(k,133)* y(k,176) + 2._r8*(rxt(k,136) +rxt(k,137)) & + * y(k,190) + het_rates(k,190))* y(k,190) + prod(k,159) = (2.000_r8*rxt(k,125)*y(k,71) +rxt(k,128)*y(k,121) + & + rxt(k,129)*y(k,122) +rxt(k,148)*y(k,118) +rxt(k,153)*y(k,116) + & + rxt(k,169)*y(k,54) +.450_r8*rxt(k,283)*y(k,170) + & + .150_r8*rxt(k,312)*y(k,193) +.450_r8*rxt(k,333)*y(k,184) + & + .200_r8*rxt(k,337)*y(k,186) +.400_r8*rxt(k,386)*y(k,161) + & + .400_r8*rxt(k,400)*y(k,172) +.400_r8*rxt(k,406)*y(k,185))*y(k,176) & + + (rxt(k,130)*y(k,71) +.130_r8*rxt(k,269)*y(k,23) + & + .360_r8*rxt(k,298)*y(k,27) +.240_r8*rxt(k,328)*y(k,100) + & + .360_r8*rxt(k,342)*y(k,106) +.320_r8*rxt(k,375)*y(k,93) + & + .630_r8*rxt(k,430)*y(k,4) +.630_r8*rxt(k,433)*y(k,105))*y(k,122) & + + (rxt(k,122)*y(k,72) +rxt(k,123)*y(k,74) +rxt(k,184)*y(k,80) + & + rxt(k,187)*y(k,87) +rxt(k,213)*y(k,76) +rxt(k,215)*y(k,86) + & + rxt(k,246)*y(k,40))*y(k,121) + (.300_r8*rxt(k,253)*y(k,51) + & + .650_r8*rxt(k,267)*y(k,22) +.500_r8*rxt(k,275)*y(k,25) + & + .500_r8*rxt(k,310)*y(k,132) +.100_r8*rxt(k,330)*y(k,101) + & + .600_r8*rxt(k,377)*y(k,98) +.500_r8*rxt(k,385)*y(k,154))*y(k,190) & + + (rxt(k,261)*y(k,52) +rxt(k,114)*y(k,72) + & + 2.000_r8*rxt(k,115)*y(k,202) +rxt(k,196)*y(k,80) + & + rxt(k,219)*y(k,76) +rxt(k,264)*y(k,81))*y(k,189) + (rxt(k,2) + & + rxt(k,223)*y(k,68))*y(k,202) +rxt(k,20)*y(k,2) +rxt(k,21)*y(k,6) & + +rxt(k,28)*y(k,21) +rxt(k,29)*y(k,25) +rxt(k,30)*y(k,28) +rxt(k,31) & + *y(k,30) +rxt(k,37)*y(k,49) +rxt(k,38)*y(k,51) +rxt(k,42)*y(k,67) & + +2.000_r8*rxt(k,4)*y(k,74) +rxt(k,9)*y(k,84) +rxt(k,10)*y(k,85) & + +rxt(k,105)*y(k,86) +rxt(k,106)*y(k,87) +rxt(k,46)*y(k,89) & + +rxt(k,53)*y(k,103) +.500_r8*rxt(k,479)*y(k,117) +rxt(k,58)*y(k,120) & + +rxt(k,61)*y(k,131) +rxt(k,62)*y(k,132) +rxt(k,63)*y(k,133) & + +rxt(k,65)*y(k,147) +rxt(k,67)*y(k,149) +rxt(k,70)*y(k,152) & + +rxt(k,71)*y(k,154) +rxt(k,72)*y(k,156) +rxt(k,73)*y(k,158) + loss(k,75) = (rxt(k,410)* y(k,116) +rxt(k,409)* y(k,176) + het_rates(k,191)) & + * y(k,191) + prod(k,75) = (.200_r8*rxt(k,399)*y(k,64) +.140_r8*rxt(k,411)*y(k,130) + & + rxt(k,414)*y(k,131))*y(k,190) + loss(k,110) = (rxt(k,309)* y(k,116) +rxt(k,308)* y(k,176) + het_rates(k,192)) & + * y(k,192) + prod(k,110) = (.500_r8*rxt(k,310)*y(k,132) +rxt(k,315)*y(k,27))*y(k,190) + loss(k,141) = (rxt(k,313)* y(k,116) +rxt(k,311)* y(k,171) +rxt(k,312) & + * y(k,176) + het_rates(k,193))* y(k,193) + prod(k,141) = (rxt(k,314)*y(k,133) +rxt(k,316)*y(k,46) + & + .150_r8*rxt(k,451)*y(k,151))*y(k,190) + (.060_r8*rxt(k,430)*y(k,4) + & + .060_r8*rxt(k,433)*y(k,105))*y(k,122) +.150_r8*rxt(k,69)*y(k,151) + loss(k,139) = (rxt(k,442)* y(k,116) +rxt(k,440)* y(k,171) +rxt(k,441) & + * y(k,176) + het_rates(k,194))* y(k,194) + prod(k,139) = (.500_r8*rxt(k,449)*y(k,118) +rxt(k,450)*y(k,190))*y(k,150) & + +rxt(k,443)*y(k,190)*y(k,147) + loss(k,138) = (rxt(k,447)* y(k,116) +rxt(k,445)* y(k,171) +rxt(k,446) & + * y(k,176) + het_rates(k,195))* y(k,195) + prod(k,138) = (rxt(k,431)*y(k,4) +rxt(k,434)*y(k,105) +rxt(k,448)*y(k,149)) & + *y(k,190) + loss(k,106) = (rxt(k,417)* y(k,116) +rxt(k,416)* y(k,176) + het_rates(k,196)) & + * y(k,196) + prod(k,106) = (rxt(k,418)*y(k,152) +.650_r8*rxt(k,419)*y(k,153))*y(k,190) + loss(k,14) = (rxt(k,508)* y(k,116) +rxt(k,507)* y(k,176) + het_rates(k,197)) & + * y(k,197) + prod(k,14) =rxt(k,506)*y(k,190)*y(k,153) + loss(k,142) = (rxt(k,383)* y(k,116) +rxt(k,384)* y(k,118) +rxt(k,380) & + * y(k,170) +rxt(k,381)* y(k,171) +rxt(k,382)* y(k,176) & + + het_rates(k,198))* y(k,198) + prod(k,142) = (rxt(k,352)*y(k,89) +rxt(k,353)*y(k,91) +rxt(k,354)*y(k,92) + & + .400_r8*rxt(k,377)*y(k,98) +.500_r8*rxt(k,385)*y(k,154))*y(k,190) + loss(k,108) = (rxt(k,423)* y(k,116) +rxt(k,422)* y(k,176) + het_rates(k,199)) & + * y(k,199) + prod(k,108) = (.560_r8*rxt(k,421)*y(k,155) +rxt(k,424)*y(k,156))*y(k,190) + loss(k,15) = (rxt(k,511)* y(k,116) +rxt(k,510)* y(k,176) + het_rates(k,200)) & + * y(k,200) + prod(k,15) =rxt(k,509)*y(k,190)*y(k,155) + loss(k,81) = (rxt(k,426)* y(k,116) +rxt(k,425)* y(k,176) + het_rates(k,201)) & + * y(k,201) + prod(k,81) = (.300_r8*rxt(k,427)*y(k,157) +rxt(k,428)*y(k,158))*y(k,190) + loss(k,171) = (rxt(k,223)* y(k,68) +rxt(k,468)* y(k,138) +rxt(k,115) & + * y(k,189) + rxt(k,1) + rxt(k,2) + rxt(k,3) + het_rates(k,202)) & + * y(k,202) + prod(k,171) = (rxt(k,228)*y(k,39) +rxt(k,230)*y(k,41) +rxt(k,231)*y(k,42) + & + rxt(k,233)*y(k,44) +rxt(k,238)*y(k,79) +rxt(k,254)*y(k,52) + & + rxt(k,131)*y(k,72) +rxt(k,132)*y(k,74) +rxt(k,133)*y(k,176) + & + rxt(k,136)*y(k,190) +rxt(k,139)*y(k,85) +rxt(k,161)*y(k,84) + & + rxt(k,185)*y(k,80) +rxt(k,188)*y(k,87) +rxt(k,214)*y(k,76) + & + rxt(k,247)*y(k,40) +rxt(k,253)*y(k,51) +rxt(k,257)*y(k,82) + & + rxt(k,277)*y(k,26) +rxt(k,279)*y(k,43) +rxt(k,285)*y(k,48) + & + rxt(k,286)*y(k,49) +rxt(k,302)*y(k,28) +rxt(k,303)*y(k,29) + & + rxt(k,305)*y(k,47) +rxt(k,310)*y(k,132) +rxt(k,314)*y(k,133) + & + rxt(k,316)*y(k,46) +.500_r8*rxt(k,329)*y(k,100) +rxt(k,469)*y(k,112)) & + *y(k,190) + (rxt(k,513)*y(k,87) +rxt(k,519)*y(k,87) + & + rxt(k,520)*y(k,86) +rxt(k,524)*y(k,87) +rxt(k,525)*y(k,86))*y(k,80) & + + (rxt(k,471) +rxt(k,126)*y(k,71))*y(k,176) +rxt(k,109)*y(k,75) + end do + end subroutine imp_prod_loss + end module mo_prod_loss diff --git a/src/chemistry/pp_trop_strat_noaero/mo_rxt_rates_conv.F90 b/src/chemistry/pp_trop_strat_noaero/mo_rxt_rates_conv.F90 new file mode 100644 index 0000000000..643af9e990 --- /dev/null +++ b/src/chemistry/pp_trop_strat_noaero/mo_rxt_rates_conv.F90 @@ -0,0 +1,544 @@ +module mo_rxt_rates_conv + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + private + public :: set_rates +contains + subroutine set_rates( rxt_rates, sol, ncol ) + real(r8), intent(inout) :: rxt_rates(:,:,:) + real(r8), intent(in) :: sol(:,:,:) + integer, intent(in) :: ncol + rxt_rates(:ncol,:, 1) = rxt_rates(:ncol,:, 1)*sol(:ncol,:, 202) ! rate_const*H2O + rxt_rates(:ncol,:, 2) = rxt_rates(:ncol,:, 2)*sol(:ncol,:, 202) ! rate_const*H2O + rxt_rates(:ncol,:, 3) = rxt_rates(:ncol,:, 3)*sol(:ncol,:, 202) ! rate_const*H2O + rxt_rates(:ncol,:, 4) = rxt_rates(:ncol,:, 4)*sol(:ncol,:, 74) ! rate_const*H2O2 + ! rate_const*O2 + ! rate_const*O2 + rxt_rates(:ncol,:, 7) = rxt_rates(:ncol,:, 7)*sol(:ncol,:, 122) ! rate_const*O3 + rxt_rates(:ncol,:, 8) = rxt_rates(:ncol,:, 8)*sol(:ncol,:, 122) ! rate_const*O3 + rxt_rates(:ncol,:, 9) = rxt_rates(:ncol,:, 9)*sol(:ncol,:, 84) ! rate_const*HNO3 + rxt_rates(:ncol,:, 10) = rxt_rates(:ncol,:, 10)*sol(:ncol,:, 85) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 11) = rxt_rates(:ncol,:, 11)*sol(:ncol,:, 85) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 12) = rxt_rates(:ncol,:, 12)*sol(:ncol,:, 108) ! rate_const*N2O + rxt_rates(:ncol,:, 13) = rxt_rates(:ncol,:, 13)*sol(:ncol,:, 109) ! rate_const*N2O5 + rxt_rates(:ncol,:, 14) = rxt_rates(:ncol,:, 14)*sol(:ncol,:, 109) ! rate_const*N2O5 + rxt_rates(:ncol,:, 15) = rxt_rates(:ncol,:, 15)*sol(:ncol,:, 116) ! rate_const*NO + rxt_rates(:ncol,:, 16) = rxt_rates(:ncol,:, 16)*sol(:ncol,:, 117) ! rate_const*NO2 + rxt_rates(:ncol,:, 17) = rxt_rates(:ncol,:, 17)*sol(:ncol,:, 118) ! rate_const*NO3 + rxt_rates(:ncol,:, 18) = rxt_rates(:ncol,:, 18)*sol(:ncol,:, 118) ! rate_const*NO3 + rxt_rates(:ncol,:, 19) = rxt_rates(:ncol,:, 19)*sol(:ncol,:, 1) ! rate_const*ALKNIT + rxt_rates(:ncol,:, 20) = rxt_rates(:ncol,:, 20)*sol(:ncol,:, 2) ! rate_const*ALKOOH + rxt_rates(:ncol,:, 21) = rxt_rates(:ncol,:, 21)*sol(:ncol,:, 6) ! rate_const*BENZOOH + rxt_rates(:ncol,:, 22) = rxt_rates(:ncol,:, 22)*sol(:ncol,:, 7) ! rate_const*BEPOMUC + rxt_rates(:ncol,:, 23) = rxt_rates(:ncol,:, 23)*sol(:ncol,:, 8) ! rate_const*BIGALD + rxt_rates(:ncol,:, 24) = rxt_rates(:ncol,:, 24)*sol(:ncol,:, 9) ! rate_const*BIGALD1 + rxt_rates(:ncol,:, 25) = rxt_rates(:ncol,:, 25)*sol(:ncol,:, 10) ! rate_const*BIGALD2 + rxt_rates(:ncol,:, 26) = rxt_rates(:ncol,:, 26)*sol(:ncol,:, 11) ! rate_const*BIGALD3 + rxt_rates(:ncol,:, 27) = rxt_rates(:ncol,:, 27)*sol(:ncol,:, 12) ! rate_const*BIGALD4 + rxt_rates(:ncol,:, 28) = rxt_rates(:ncol,:, 28)*sol(:ncol,:, 21) ! rate_const*BZOOH + rxt_rates(:ncol,:, 29) = rxt_rates(:ncol,:, 29)*sol(:ncol,:, 25) ! rate_const*C2H5OOH + rxt_rates(:ncol,:, 30) = rxt_rates(:ncol,:, 30)*sol(:ncol,:, 28) ! rate_const*C3H7OOH + rxt_rates(:ncol,:, 31) = rxt_rates(:ncol,:, 31)*sol(:ncol,:, 30) ! rate_const*C6H5OOH + rxt_rates(:ncol,:, 32) = rxt_rates(:ncol,:, 32)*sol(:ncol,:, 40) ! rate_const*CH2O + rxt_rates(:ncol,:, 33) = rxt_rates(:ncol,:, 33)*sol(:ncol,:, 40) ! rate_const*CH2O + rxt_rates(:ncol,:, 34) = rxt_rates(:ncol,:, 34)*sol(:ncol,:, 43) ! rate_const*CH3CHO + rxt_rates(:ncol,:, 35) = rxt_rates(:ncol,:, 35)*sol(:ncol,:, 46) ! rate_const*CH3COCH3 + rxt_rates(:ncol,:, 36) = rxt_rates(:ncol,:, 36)*sol(:ncol,:, 47) ! rate_const*CH3COCHO + rxt_rates(:ncol,:, 37) = rxt_rates(:ncol,:, 37)*sol(:ncol,:, 49) ! rate_const*CH3COOOH + rxt_rates(:ncol,:, 38) = rxt_rates(:ncol,:, 38)*sol(:ncol,:, 51) ! rate_const*CH3OOH + rxt_rates(:ncol,:, 39) = rxt_rates(:ncol,:, 39)*sol(:ncol,:, 52) ! rate_const*CH4 + rxt_rates(:ncol,:, 40) = rxt_rates(:ncol,:, 40)*sol(:ncol,:, 52) ! rate_const*CH4 + rxt_rates(:ncol,:, 41) = rxt_rates(:ncol,:, 41)*sol(:ncol,:, 61) ! rate_const*CO2 + rxt_rates(:ncol,:, 42) = rxt_rates(:ncol,:, 42)*sol(:ncol,:, 67) ! rate_const*EOOH + rxt_rates(:ncol,:, 43) = rxt_rates(:ncol,:, 43)*sol(:ncol,:, 69) ! rate_const*GLYALD + rxt_rates(:ncol,:, 44) = rxt_rates(:ncol,:, 44)*sol(:ncol,:, 70) ! rate_const*GLYOXAL + rxt_rates(:ncol,:, 45) = rxt_rates(:ncol,:, 45)*sol(:ncol,:, 88) ! rate_const*HONITR + rxt_rates(:ncol,:, 46) = rxt_rates(:ncol,:, 46)*sol(:ncol,:, 89) ! rate_const*HPALD + rxt_rates(:ncol,:, 47) = rxt_rates(:ncol,:, 47)*sol(:ncol,:, 90) ! rate_const*HYAC + rxt_rates(:ncol,:, 48) = rxt_rates(:ncol,:, 48)*sol(:ncol,:, 97) ! rate_const*ISOPNOOH + rxt_rates(:ncol,:, 49) = rxt_rates(:ncol,:, 49)*sol(:ncol,:, 98) ! rate_const*ISOPOOH + rxt_rates(:ncol,:, 50) = rxt_rates(:ncol,:, 50)*sol(:ncol,:, 100) ! rate_const*MACR + rxt_rates(:ncol,:, 51) = rxt_rates(:ncol,:, 51)*sol(:ncol,:, 100) ! rate_const*MACR + rxt_rates(:ncol,:, 52) = rxt_rates(:ncol,:, 52)*sol(:ncol,:, 102) ! rate_const*MEK + rxt_rates(:ncol,:, 53) = rxt_rates(:ncol,:, 53)*sol(:ncol,:, 103) ! rate_const*MEKOOH + rxt_rates(:ncol,:, 54) = rxt_rates(:ncol,:, 54)*sol(:ncol,:, 104) ! rate_const*MPAN + rxt_rates(:ncol,:, 55) = rxt_rates(:ncol,:, 55)*sol(:ncol,:, 106) ! rate_const*MVK + rxt_rates(:ncol,:, 56) = rxt_rates(:ncol,:, 56)*sol(:ncol,:, 111) ! rate_const*NC4CHO + rxt_rates(:ncol,:, 57) = rxt_rates(:ncol,:, 57)*sol(:ncol,:, 119) ! rate_const*NOA + rxt_rates(:ncol,:, 58) = rxt_rates(:ncol,:, 58)*sol(:ncol,:, 120) ! rate_const*NTERPOOH + rxt_rates(:ncol,:, 59) = rxt_rates(:ncol,:, 59)*sol(:ncol,:, 126) ! rate_const*ONITR + rxt_rates(:ncol,:, 60) = rxt_rates(:ncol,:, 60)*sol(:ncol,:, 127) ! rate_const*PAN + rxt_rates(:ncol,:, 61) = rxt_rates(:ncol,:, 61)*sol(:ncol,:, 131) ! rate_const*PHENOOH + rxt_rates(:ncol,:, 62) = rxt_rates(:ncol,:, 62)*sol(:ncol,:, 132) ! rate_const*POOH + rxt_rates(:ncol,:, 63) = rxt_rates(:ncol,:, 63)*sol(:ncol,:, 133) ! rate_const*ROOH + rxt_rates(:ncol,:, 64) = rxt_rates(:ncol,:, 64)*sol(:ncol,:, 146) ! rate_const*TEPOMUC + rxt_rates(:ncol,:, 65) = rxt_rates(:ncol,:, 65)*sol(:ncol,:, 147) ! rate_const*TERP2OOH + rxt_rates(:ncol,:, 66) = rxt_rates(:ncol,:, 66)*sol(:ncol,:, 148) ! rate_const*TERPNIT + rxt_rates(:ncol,:, 67) = rxt_rates(:ncol,:, 67)*sol(:ncol,:, 149) ! rate_const*TERPOOH + rxt_rates(:ncol,:, 68) = rxt_rates(:ncol,:, 68)*sol(:ncol,:, 150) ! rate_const*TERPROD1 + rxt_rates(:ncol,:, 69) = rxt_rates(:ncol,:, 69)*sol(:ncol,:, 151) ! rate_const*TERPROD2 + rxt_rates(:ncol,:, 70) = rxt_rates(:ncol,:, 70)*sol(:ncol,:, 152) ! rate_const*TOLOOH + rxt_rates(:ncol,:, 71) = rxt_rates(:ncol,:, 71)*sol(:ncol,:, 154) ! rate_const*XOOH + rxt_rates(:ncol,:, 72) = rxt_rates(:ncol,:, 72)*sol(:ncol,:, 156) ! rate_const*XYLENOOH + rxt_rates(:ncol,:, 73) = rxt_rates(:ncol,:, 73)*sol(:ncol,:, 158) ! rate_const*XYLOLOOH + rxt_rates(:ncol,:, 74) = rxt_rates(:ncol,:, 74)*sol(:ncol,:, 16) ! rate_const*BRCL + rxt_rates(:ncol,:, 75) = rxt_rates(:ncol,:, 75)*sol(:ncol,:, 17) ! rate_const*BRO + rxt_rates(:ncol,:, 76) = rxt_rates(:ncol,:, 76)*sol(:ncol,:, 18) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 77) = rxt_rates(:ncol,:, 77)*sol(:ncol,:, 18) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 78) = rxt_rates(:ncol,:, 78)*sol(:ncol,:, 31) ! rate_const*CCL4 + rxt_rates(:ncol,:, 79) = rxt_rates(:ncol,:, 79)*sol(:ncol,:, 32) ! rate_const*CF2CLBR + rxt_rates(:ncol,:, 80) = rxt_rates(:ncol,:, 80)*sol(:ncol,:, 33) ! rate_const*CF3BR + rxt_rates(:ncol,:, 81) = rxt_rates(:ncol,:, 81)*sol(:ncol,:, 34) ! rate_const*CFC11 + rxt_rates(:ncol,:, 82) = rxt_rates(:ncol,:, 82)*sol(:ncol,:, 35) ! rate_const*CFC113 + rxt_rates(:ncol,:, 83) = rxt_rates(:ncol,:, 83)*sol(:ncol,:, 36) ! rate_const*CFC114 + rxt_rates(:ncol,:, 84) = rxt_rates(:ncol,:, 84)*sol(:ncol,:, 37) ! rate_const*CFC115 + rxt_rates(:ncol,:, 85) = rxt_rates(:ncol,:, 85)*sol(:ncol,:, 38) ! rate_const*CFC12 + rxt_rates(:ncol,:, 86) = rxt_rates(:ncol,:, 86)*sol(:ncol,:, 39) ! rate_const*CH2BR2 + rxt_rates(:ncol,:, 87) = rxt_rates(:ncol,:, 87)*sol(:ncol,:, 41) ! rate_const*CH3BR + rxt_rates(:ncol,:, 88) = rxt_rates(:ncol,:, 88)*sol(:ncol,:, 42) ! rate_const*CH3CCL3 + rxt_rates(:ncol,:, 89) = rxt_rates(:ncol,:, 89)*sol(:ncol,:, 44) ! rate_const*CH3CL + rxt_rates(:ncol,:, 90) = rxt_rates(:ncol,:, 90)*sol(:ncol,:, 53) ! rate_const*CHBR3 + rxt_rates(:ncol,:, 91) = rxt_rates(:ncol,:, 91)*sol(:ncol,:, 55) ! rate_const*CL2 + rxt_rates(:ncol,:, 92) = rxt_rates(:ncol,:, 92)*sol(:ncol,:, 56) ! rate_const*CL2O2 + rxt_rates(:ncol,:, 93) = rxt_rates(:ncol,:, 93)*sol(:ncol,:, 57) ! rate_const*CLO + rxt_rates(:ncol,:, 94) = rxt_rates(:ncol,:, 94)*sol(:ncol,:, 58) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 95) = rxt_rates(:ncol,:, 95)*sol(:ncol,:, 58) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 96) = rxt_rates(:ncol,:, 96)*sol(:ncol,:, 62) ! rate_const*COF2 + rxt_rates(:ncol,:, 97) = rxt_rates(:ncol,:, 97)*sol(:ncol,:, 63) ! rate_const*COFCL + rxt_rates(:ncol,:, 98) = rxt_rates(:ncol,:, 98)*sol(:ncol,:, 73) ! rate_const*H2402 + rxt_rates(:ncol,:, 99) = rxt_rates(:ncol,:, 99)*sol(:ncol,:, 76) ! rate_const*HBR + rxt_rates(:ncol,:, 100) = rxt_rates(:ncol,:, 100)*sol(:ncol,:, 77) ! rate_const*HCFC141B + rxt_rates(:ncol,:, 101) = rxt_rates(:ncol,:, 101)*sol(:ncol,:, 78) ! rate_const*HCFC142B + rxt_rates(:ncol,:, 102) = rxt_rates(:ncol,:, 102)*sol(:ncol,:, 79) ! rate_const*HCFC22 + rxt_rates(:ncol,:, 103) = rxt_rates(:ncol,:, 103)*sol(:ncol,:, 80) ! rate_const*HCL + rxt_rates(:ncol,:, 104) = rxt_rates(:ncol,:, 104)*sol(:ncol,:, 83) ! rate_const*HF + rxt_rates(:ncol,:, 105) = rxt_rates(:ncol,:, 105)*sol(:ncol,:, 86) ! rate_const*HOBR + rxt_rates(:ncol,:, 106) = rxt_rates(:ncol,:, 106)*sol(:ncol,:, 87) ! rate_const*HOCL + rxt_rates(:ncol,:, 107) = rxt_rates(:ncol,:, 107)*sol(:ncol,:, 124) ! rate_const*OCLO + rxt_rates(:ncol,:, 108) = rxt_rates(:ncol,:, 108)*sol(:ncol,:, 135) ! rate_const*SF6 + rxt_rates(:ncol,:, 109) = rxt_rates(:ncol,:, 109)*sol(:ncol,:, 75) ! rate_const*H2SO4 + rxt_rates(:ncol,:, 110) = rxt_rates(:ncol,:, 110)*sol(:ncol,:, 125) ! rate_const*OCS + rxt_rates(:ncol,:, 111) = rxt_rates(:ncol,:, 111)*sol(:ncol,:, 136) ! rate_const*SO + rxt_rates(:ncol,:, 112) = rxt_rates(:ncol,:, 112)*sol(:ncol,:, 137) ! rate_const*SO2 + rxt_rates(:ncol,:, 113) = rxt_rates(:ncol,:, 113)*sol(:ncol,:, 138) ! rate_const*SO3 + rxt_rates(:ncol,:, 114) = rxt_rates(:ncol,:, 114)*sol(:ncol,:, 189)*sol(:ncol,:, 72) ! rate_const*O1D*H2 + rxt_rates(:ncol,:, 115) = rxt_rates(:ncol,:, 115)*sol(:ncol,:, 189)*sol(:ncol,:, 202) ! rate_const*O1D*H2O + rxt_rates(:ncol,:, 116) = rxt_rates(:ncol,:, 116)*sol(:ncol,:, 189) ! rate_const*N2*O1D + rxt_rates(:ncol,:, 117) = rxt_rates(:ncol,:, 117)*sol(:ncol,:, 189) ! rate_const*O2*O1D + rxt_rates(:ncol,:, 118) = rxt_rates(:ncol,:, 118)*sol(:ncol,:, 189)*sol(:ncol,:, 122) ! rate_const*O1D*O3 + rxt_rates(:ncol,:, 119) = rxt_rates(:ncol,:, 119)*sol(:ncol,:, 121)*sol(:ncol,:, 122) ! rate_const*O*O3 + rxt_rates(:ncol,:, 120) = rxt_rates(:ncol,:, 120)*sol(:ncol,:, 121)*sol(:ncol,:, 121) ! rate_const*M*O*O + rxt_rates(:ncol,:, 121) = rxt_rates(:ncol,:, 121)*sol(:ncol,:, 121) ! rate_const*O2*M*O + rxt_rates(:ncol,:, 122) = rxt_rates(:ncol,:, 122)*sol(:ncol,:, 72)*sol(:ncol,:, 121) ! rate_const*H2*O + rxt_rates(:ncol,:, 123) = rxt_rates(:ncol,:, 123)*sol(:ncol,:, 74)*sol(:ncol,:, 121) ! rate_const*H2O2*O + rxt_rates(:ncol,:, 124) = rxt_rates(:ncol,:, 124)*sol(:ncol,:, 71)*sol(:ncol,:, 176) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 125) = rxt_rates(:ncol,:, 125)*sol(:ncol,:, 71)*sol(:ncol,:, 176) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 126) = rxt_rates(:ncol,:, 126)*sol(:ncol,:, 71)*sol(:ncol,:, 176) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 127) = rxt_rates(:ncol,:, 127)*sol(:ncol,:, 71) ! rate_const*O2*M*H + rxt_rates(:ncol,:, 128) = rxt_rates(:ncol,:, 128)*sol(:ncol,:, 176)*sol(:ncol,:, 121) ! rate_const*HO2*O + rxt_rates(:ncol,:, 129) = rxt_rates(:ncol,:, 129)*sol(:ncol,:, 176)*sol(:ncol,:, 122) ! rate_const*HO2*O3 + rxt_rates(:ncol,:, 130) = rxt_rates(:ncol,:, 130)*sol(:ncol,:, 71)*sol(:ncol,:, 122) ! rate_const*H*O3 + rxt_rates(:ncol,:, 131) = rxt_rates(:ncol,:, 131)*sol(:ncol,:, 190)*sol(:ncol,:, 72) ! rate_const*OH*H2 + rxt_rates(:ncol,:, 132) = rxt_rates(:ncol,:, 132)*sol(:ncol,:, 190)*sol(:ncol,:, 74) ! rate_const*OH*H2O2 + rxt_rates(:ncol,:, 133) = rxt_rates(:ncol,:, 133)*sol(:ncol,:, 190)*sol(:ncol,:, 176) ! rate_const*OH*HO2 + rxt_rates(:ncol,:, 134) = rxt_rates(:ncol,:, 134)*sol(:ncol,:, 190)*sol(:ncol,:, 121) ! rate_const*OH*O + rxt_rates(:ncol,:, 135) = rxt_rates(:ncol,:, 135)*sol(:ncol,:, 190)*sol(:ncol,:, 122) ! rate_const*OH*O3 + rxt_rates(:ncol,:, 136) = rxt_rates(:ncol,:, 136)*sol(:ncol,:, 190)*sol(:ncol,:, 190) ! rate_const*OH*OH + rxt_rates(:ncol,:, 137) = rxt_rates(:ncol,:, 137)*sol(:ncol,:, 190)*sol(:ncol,:, 190) ! rate_const*M*OH*OH + rxt_rates(:ncol,:, 138) = rxt_rates(:ncol,:, 138)*sol(:ncol,:, 176)*sol(:ncol,:, 176) ! rate_const*HO2*HO2 + rxt_rates(:ncol,:, 139) = rxt_rates(:ncol,:, 139)*sol(:ncol,:, 85)*sol(:ncol,:, 190) ! rate_const*HO2NO2*OH + rxt_rates(:ncol,:, 140) = rxt_rates(:ncol,:, 140)*sol(:ncol,:, 107)*sol(:ncol,:, 116) ! rate_const*N*NO + rxt_rates(:ncol,:, 141) = rxt_rates(:ncol,:, 141)*sol(:ncol,:, 107)*sol(:ncol,:, 117) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 142) = rxt_rates(:ncol,:, 142)*sol(:ncol,:, 107)*sol(:ncol,:, 117) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 143) = rxt_rates(:ncol,:, 143)*sol(:ncol,:, 107)*sol(:ncol,:, 117) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 144) = rxt_rates(:ncol,:, 144)*sol(:ncol,:, 107) ! rate_const*O2*N + rxt_rates(:ncol,:, 145) = rxt_rates(:ncol,:, 145)*sol(:ncol,:, 117)*sol(:ncol,:, 121) ! rate_const*NO2*O + rxt_rates(:ncol,:, 146) = rxt_rates(:ncol,:, 146)*sol(:ncol,:, 117)*sol(:ncol,:, 122) ! rate_const*NO2*O3 + rxt_rates(:ncol,:, 147) = rxt_rates(:ncol,:, 147)*sol(:ncol,:, 117)*sol(:ncol,:, 121) ! rate_const*M*NO2*O + rxt_rates(:ncol,:, 148) = rxt_rates(:ncol,:, 148)*sol(:ncol,:, 118)*sol(:ncol,:, 176) ! rate_const*NO3*HO2 + rxt_rates(:ncol,:, 149) = rxt_rates(:ncol,:, 149)*sol(:ncol,:, 118)*sol(:ncol,:, 116) ! rate_const*NO3*NO + rxt_rates(:ncol,:, 150) = rxt_rates(:ncol,:, 150)*sol(:ncol,:, 118)*sol(:ncol,:, 121) ! rate_const*NO3*O + rxt_rates(:ncol,:, 151) = rxt_rates(:ncol,:, 151)*sol(:ncol,:, 118)*sol(:ncol,:, 190) ! rate_const*NO3*OH + rxt_rates(:ncol,:, 152) = rxt_rates(:ncol,:, 152)*sol(:ncol,:, 107)*sol(:ncol,:, 190) ! rate_const*N*OH + rxt_rates(:ncol,:, 153) = rxt_rates(:ncol,:, 153)*sol(:ncol,:, 116)*sol(:ncol,:, 176) ! rate_const*NO*HO2 + rxt_rates(:ncol,:, 154) = rxt_rates(:ncol,:, 154)*sol(:ncol,:, 116)*sol(:ncol,:, 122) ! rate_const*NO*O3 + rxt_rates(:ncol,:, 155) = rxt_rates(:ncol,:, 155)*sol(:ncol,:, 116)*sol(:ncol,:, 121) ! rate_const*M*NO*O + rxt_rates(:ncol,:, 156) = rxt_rates(:ncol,:, 156)*sol(:ncol,:, 189)*sol(:ncol,:, 108) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 157) = rxt_rates(:ncol,:, 157)*sol(:ncol,:, 189)*sol(:ncol,:, 108) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 158) = rxt_rates(:ncol,:, 158)*sol(:ncol,:, 117)*sol(:ncol,:, 176) ! rate_const*M*NO2*HO2 + rxt_rates(:ncol,:, 159) = rxt_rates(:ncol,:, 159)*sol(:ncol,:, 117)*sol(:ncol,:, 118) ! rate_const*M*NO2*NO3 + rxt_rates(:ncol,:, 160) = rxt_rates(:ncol,:, 160)*sol(:ncol,:, 117)*sol(:ncol,:, 190) ! rate_const*M*NO2*OH + rxt_rates(:ncol,:, 161) = rxt_rates(:ncol,:, 161)*sol(:ncol,:, 84)*sol(:ncol,:, 190) ! rate_const*HNO3*OH + rxt_rates(:ncol,:, 162) = rxt_rates(:ncol,:, 162)*sol(:ncol,:, 85) ! rate_const*M*HO2NO2 + rxt_rates(:ncol,:, 163) = rxt_rates(:ncol,:, 163)*sol(:ncol,:, 109) ! rate_const*M*N2O5 + rxt_rates(:ncol,:, 164) = rxt_rates(:ncol,:, 164)*sol(:ncol,:, 54)*sol(:ncol,:, 40) ! rate_const*CL*CH2O + rxt_rates(:ncol,:, 165) = rxt_rates(:ncol,:, 165)*sol(:ncol,:, 54)*sol(:ncol,:, 52) ! rate_const*CL*CH4 + rxt_rates(:ncol,:, 166) = rxt_rates(:ncol,:, 166)*sol(:ncol,:, 54)*sol(:ncol,:, 72) ! rate_const*CL*H2 + rxt_rates(:ncol,:, 167) = rxt_rates(:ncol,:, 167)*sol(:ncol,:, 54)*sol(:ncol,:, 74) ! rate_const*CL*H2O2 + rxt_rates(:ncol,:, 168) = rxt_rates(:ncol,:, 168)*sol(:ncol,:, 54)*sol(:ncol,:, 176) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 169) = rxt_rates(:ncol,:, 169)*sol(:ncol,:, 54)*sol(:ncol,:, 176) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 170) = rxt_rates(:ncol,:, 170)*sol(:ncol,:, 54)*sol(:ncol,:, 122) ! rate_const*CL*O3 + rxt_rates(:ncol,:, 171) = rxt_rates(:ncol,:, 171)*sol(:ncol,:, 57)*sol(:ncol,:, 171) ! rate_const*CLO*CH3O2 + rxt_rates(:ncol,:, 172) = rxt_rates(:ncol,:, 172)*sol(:ncol,:, 57)*sol(:ncol,:, 57) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 173) = rxt_rates(:ncol,:, 173)*sol(:ncol,:, 57)*sol(:ncol,:, 57) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 174) = rxt_rates(:ncol,:, 174)*sol(:ncol,:, 57)*sol(:ncol,:, 57) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 175) = rxt_rates(:ncol,:, 175)*sol(:ncol,:, 57)*sol(:ncol,:, 176) ! rate_const*CLO*HO2 + rxt_rates(:ncol,:, 176) = rxt_rates(:ncol,:, 176)*sol(:ncol,:, 57)*sol(:ncol,:, 116) ! rate_const*CLO*NO + rxt_rates(:ncol,:, 177) = rxt_rates(:ncol,:, 177)*sol(:ncol,:, 58)*sol(:ncol,:, 54) ! rate_const*CLONO2*CL + rxt_rates(:ncol,:, 178) = rxt_rates(:ncol,:, 178)*sol(:ncol,:, 57)*sol(:ncol,:, 117) ! rate_const*M*CLO*NO2 + rxt_rates(:ncol,:, 179) = rxt_rates(:ncol,:, 179)*sol(:ncol,:, 58)*sol(:ncol,:, 121) ! rate_const*CLONO2*O + rxt_rates(:ncol,:, 180) = rxt_rates(:ncol,:, 180)*sol(:ncol,:, 58)*sol(:ncol,:, 190) ! rate_const*CLONO2*OH + rxt_rates(:ncol,:, 181) = rxt_rates(:ncol,:, 181)*sol(:ncol,:, 57)*sol(:ncol,:, 121) ! rate_const*CLO*O + rxt_rates(:ncol,:, 182) = rxt_rates(:ncol,:, 182)*sol(:ncol,:, 57)*sol(:ncol,:, 190) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 183) = rxt_rates(:ncol,:, 183)*sol(:ncol,:, 57)*sol(:ncol,:, 190) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 184) = rxt_rates(:ncol,:, 184)*sol(:ncol,:, 80)*sol(:ncol,:, 121) ! rate_const*HCL*O + rxt_rates(:ncol,:, 185) = rxt_rates(:ncol,:, 185)*sol(:ncol,:, 80)*sol(:ncol,:, 190) ! rate_const*HCL*OH + rxt_rates(:ncol,:, 186) = rxt_rates(:ncol,:, 186)*sol(:ncol,:, 87)*sol(:ncol,:, 54) ! rate_const*HOCL*CL + rxt_rates(:ncol,:, 187) = rxt_rates(:ncol,:, 187)*sol(:ncol,:, 87)*sol(:ncol,:, 121) ! rate_const*HOCL*O + rxt_rates(:ncol,:, 188) = rxt_rates(:ncol,:, 188)*sol(:ncol,:, 87)*sol(:ncol,:, 190) ! rate_const*HOCL*OH + rxt_rates(:ncol,:, 189) = rxt_rates(:ncol,:, 189)*sol(:ncol,:, 189)*sol(:ncol,:, 31) ! rate_const*O1D*CCL4 + rxt_rates(:ncol,:, 190) = rxt_rates(:ncol,:, 190)*sol(:ncol,:, 189)*sol(:ncol,:, 32) ! rate_const*O1D*CF2CLBR + rxt_rates(:ncol,:, 191) = rxt_rates(:ncol,:, 191)*sol(:ncol,:, 189)*sol(:ncol,:, 34) ! rate_const*O1D*CFC11 + rxt_rates(:ncol,:, 192) = rxt_rates(:ncol,:, 192)*sol(:ncol,:, 189)*sol(:ncol,:, 35) ! rate_const*O1D*CFC113 + rxt_rates(:ncol,:, 193) = rxt_rates(:ncol,:, 193)*sol(:ncol,:, 189)*sol(:ncol,:, 36) ! rate_const*O1D*CFC114 + rxt_rates(:ncol,:, 194) = rxt_rates(:ncol,:, 194)*sol(:ncol,:, 189)*sol(:ncol,:, 37) ! rate_const*O1D*CFC115 + rxt_rates(:ncol,:, 195) = rxt_rates(:ncol,:, 195)*sol(:ncol,:, 189)*sol(:ncol,:, 38) ! rate_const*O1D*CFC12 + rxt_rates(:ncol,:, 196) = rxt_rates(:ncol,:, 196)*sol(:ncol,:, 189)*sol(:ncol,:, 80) ! rate_const*O1D*HCL + rxt_rates(:ncol,:, 197) = rxt_rates(:ncol,:, 197)*sol(:ncol,:, 189)*sol(:ncol,:, 80) ! rate_const*O1D*HCL + rxt_rates(:ncol,:, 198) = rxt_rates(:ncol,:, 198)*sol(:ncol,:, 57)*sol(:ncol,:, 57) ! rate_const*M*CLO*CLO + rxt_rates(:ncol,:, 199) = rxt_rates(:ncol,:, 199)*sol(:ncol,:, 56) ! rate_const*M*CL2O2 + rxt_rates(:ncol,:, 200) = rxt_rates(:ncol,:, 200)*sol(:ncol,:, 15)*sol(:ncol,:, 40) ! rate_const*BR*CH2O + rxt_rates(:ncol,:, 201) = rxt_rates(:ncol,:, 201)*sol(:ncol,:, 15)*sol(:ncol,:, 176) ! rate_const*BR*HO2 + rxt_rates(:ncol,:, 202) = rxt_rates(:ncol,:, 202)*sol(:ncol,:, 15)*sol(:ncol,:, 122) ! rate_const*BR*O3 + rxt_rates(:ncol,:, 203) = rxt_rates(:ncol,:, 203)*sol(:ncol,:, 17)*sol(:ncol,:, 17) ! rate_const*BRO*BRO + rxt_rates(:ncol,:, 204) = rxt_rates(:ncol,:, 204)*sol(:ncol,:, 17)*sol(:ncol,:, 57) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 205) = rxt_rates(:ncol,:, 205)*sol(:ncol,:, 17)*sol(:ncol,:, 57) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 206) = rxt_rates(:ncol,:, 206)*sol(:ncol,:, 17)*sol(:ncol,:, 57) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 207) = rxt_rates(:ncol,:, 207)*sol(:ncol,:, 17)*sol(:ncol,:, 176) ! rate_const*BRO*HO2 + rxt_rates(:ncol,:, 208) = rxt_rates(:ncol,:, 208)*sol(:ncol,:, 17)*sol(:ncol,:, 116) ! rate_const*BRO*NO + rxt_rates(:ncol,:, 209) = rxt_rates(:ncol,:, 209)*sol(:ncol,:, 17)*sol(:ncol,:, 117) ! rate_const*M*BRO*NO2 + rxt_rates(:ncol,:, 210) = rxt_rates(:ncol,:, 210)*sol(:ncol,:, 18)*sol(:ncol,:, 121) ! rate_const*BRONO2*O + rxt_rates(:ncol,:, 211) = rxt_rates(:ncol,:, 211)*sol(:ncol,:, 17)*sol(:ncol,:, 121) ! rate_const*BRO*O + rxt_rates(:ncol,:, 212) = rxt_rates(:ncol,:, 212)*sol(:ncol,:, 17)*sol(:ncol,:, 190) ! rate_const*BRO*OH + rxt_rates(:ncol,:, 213) = rxt_rates(:ncol,:, 213)*sol(:ncol,:, 76)*sol(:ncol,:, 121) ! rate_const*HBR*O + rxt_rates(:ncol,:, 214) = rxt_rates(:ncol,:, 214)*sol(:ncol,:, 76)*sol(:ncol,:, 190) ! rate_const*HBR*OH + rxt_rates(:ncol,:, 215) = rxt_rates(:ncol,:, 215)*sol(:ncol,:, 86)*sol(:ncol,:, 121) ! rate_const*HOBR*O + rxt_rates(:ncol,:, 216) = rxt_rates(:ncol,:, 216)*sol(:ncol,:, 189)*sol(:ncol,:, 33) ! rate_const*O1D*CF3BR + rxt_rates(:ncol,:, 217) = rxt_rates(:ncol,:, 217)*sol(:ncol,:, 189)*sol(:ncol,:, 53) ! rate_const*O1D*CHBR3 + rxt_rates(:ncol,:, 218) = rxt_rates(:ncol,:, 218)*sol(:ncol,:, 189)*sol(:ncol,:, 73) ! rate_const*O1D*H2402 + rxt_rates(:ncol,:, 219) = rxt_rates(:ncol,:, 219)*sol(:ncol,:, 189)*sol(:ncol,:, 76) ! rate_const*O1D*HBR + rxt_rates(:ncol,:, 220) = rxt_rates(:ncol,:, 220)*sol(:ncol,:, 189)*sol(:ncol,:, 76) ! rate_const*O1D*HBR + rxt_rates(:ncol,:, 221) = rxt_rates(:ncol,:, 221)*sol(:ncol,:, 68)*sol(:ncol,:, 52) ! rate_const*F*CH4 + rxt_rates(:ncol,:, 222) = rxt_rates(:ncol,:, 222)*sol(:ncol,:, 68)*sol(:ncol,:, 72) ! rate_const*F*H2 + rxt_rates(:ncol,:, 223) = rxt_rates(:ncol,:, 223)*sol(:ncol,:, 68)*sol(:ncol,:, 202) ! rate_const*F*H2O + rxt_rates(:ncol,:, 224) = rxt_rates(:ncol,:, 224)*sol(:ncol,:, 68)*sol(:ncol,:, 84) ! rate_const*F*HNO3 + rxt_rates(:ncol,:, 225) = rxt_rates(:ncol,:, 225)*sol(:ncol,:, 189)*sol(:ncol,:, 62) ! rate_const*O1D*COF2 + rxt_rates(:ncol,:, 226) = rxt_rates(:ncol,:, 226)*sol(:ncol,:, 189)*sol(:ncol,:, 63) ! rate_const*O1D*COFCL + rxt_rates(:ncol,:, 227) = rxt_rates(:ncol,:, 227)*sol(:ncol,:, 39)*sol(:ncol,:, 54) ! rate_const*CH2BR2*CL + rxt_rates(:ncol,:, 228) = rxt_rates(:ncol,:, 228)*sol(:ncol,:, 39)*sol(:ncol,:, 190) ! rate_const*CH2BR2*OH + rxt_rates(:ncol,:, 229) = rxt_rates(:ncol,:, 229)*sol(:ncol,:, 41)*sol(:ncol,:, 54) ! rate_const*CH3BR*CL + rxt_rates(:ncol,:, 230) = rxt_rates(:ncol,:, 230)*sol(:ncol,:, 41)*sol(:ncol,:, 190) ! rate_const*CH3BR*OH + rxt_rates(:ncol,:, 231) = rxt_rates(:ncol,:, 231)*sol(:ncol,:, 42)*sol(:ncol,:, 190) ! rate_const*CH3CCL3*OH + rxt_rates(:ncol,:, 232) = rxt_rates(:ncol,:, 232)*sol(:ncol,:, 44)*sol(:ncol,:, 54) ! rate_const*CH3CL*CL + rxt_rates(:ncol,:, 233) = rxt_rates(:ncol,:, 233)*sol(:ncol,:, 44)*sol(:ncol,:, 190) ! rate_const*CH3CL*OH + rxt_rates(:ncol,:, 234) = rxt_rates(:ncol,:, 234)*sol(:ncol,:, 53)*sol(:ncol,:, 54) ! rate_const*CHBR3*CL + rxt_rates(:ncol,:, 235) = rxt_rates(:ncol,:, 235)*sol(:ncol,:, 53)*sol(:ncol,:, 190) ! rate_const*CHBR3*OH + rxt_rates(:ncol,:, 236) = rxt_rates(:ncol,:, 236)*sol(:ncol,:, 77)*sol(:ncol,:, 190) ! rate_const*HCFC141B*OH + rxt_rates(:ncol,:, 237) = rxt_rates(:ncol,:, 237)*sol(:ncol,:, 78)*sol(:ncol,:, 190) ! rate_const*HCFC142B*OH + rxt_rates(:ncol,:, 238) = rxt_rates(:ncol,:, 238)*sol(:ncol,:, 79)*sol(:ncol,:, 190) ! rate_const*HCFC22*OH + rxt_rates(:ncol,:, 239) = rxt_rates(:ncol,:, 239)*sol(:ncol,:, 189)*sol(:ncol,:, 39) ! rate_const*O1D*CH2BR2 + rxt_rates(:ncol,:, 240) = rxt_rates(:ncol,:, 240)*sol(:ncol,:, 189)*sol(:ncol,:, 41) ! rate_const*O1D*CH3BR + rxt_rates(:ncol,:, 241) = rxt_rates(:ncol,:, 241)*sol(:ncol,:, 189)*sol(:ncol,:, 77) ! rate_const*O1D*HCFC141B + rxt_rates(:ncol,:, 242) = rxt_rates(:ncol,:, 242)*sol(:ncol,:, 189)*sol(:ncol,:, 78) ! rate_const*O1D*HCFC142B + rxt_rates(:ncol,:, 243) = rxt_rates(:ncol,:, 243)*sol(:ncol,:, 189)*sol(:ncol,:, 79) ! rate_const*O1D*HCFC22 + rxt_rates(:ncol,:, 244) = rxt_rates(:ncol,:, 244)*sol(:ncol,:, 40)*sol(:ncol,:, 176) ! rate_const*CH2O*HO2 + rxt_rates(:ncol,:, 245) = rxt_rates(:ncol,:, 245)*sol(:ncol,:, 40)*sol(:ncol,:, 118) ! rate_const*CH2O*NO3 + rxt_rates(:ncol,:, 246) = rxt_rates(:ncol,:, 246)*sol(:ncol,:, 40)*sol(:ncol,:, 121) ! rate_const*CH2O*O + rxt_rates(:ncol,:, 247) = rxt_rates(:ncol,:, 247)*sol(:ncol,:, 40)*sol(:ncol,:, 190) ! rate_const*CH2O*OH + rxt_rates(:ncol,:, 248) = rxt_rates(:ncol,:, 248)*sol(:ncol,:, 171)*sol(:ncol,:, 171) ! rate_const*CH3O2*CH3O2 + rxt_rates(:ncol,:, 249) = rxt_rates(:ncol,:, 249)*sol(:ncol,:, 171)*sol(:ncol,:, 171) ! rate_const*CH3O2*CH3O2 + rxt_rates(:ncol,:, 250) = rxt_rates(:ncol,:, 250)*sol(:ncol,:, 171)*sol(:ncol,:, 176) ! rate_const*CH3O2*HO2 + rxt_rates(:ncol,:, 251) = rxt_rates(:ncol,:, 251)*sol(:ncol,:, 171)*sol(:ncol,:, 116) ! rate_const*CH3O2*NO + rxt_rates(:ncol,:, 252) = rxt_rates(:ncol,:, 252)*sol(:ncol,:, 50)*sol(:ncol,:, 190) ! rate_const*CH3OH*OH + rxt_rates(:ncol,:, 253) = rxt_rates(:ncol,:, 253)*sol(:ncol,:, 51)*sol(:ncol,:, 190) ! rate_const*CH3OOH*OH + rxt_rates(:ncol,:, 254) = rxt_rates(:ncol,:, 254)*sol(:ncol,:, 52)*sol(:ncol,:, 190) ! rate_const*CH4*OH + rxt_rates(:ncol,:, 255) = rxt_rates(:ncol,:, 255)*sol(:ncol,:, 60)*sol(:ncol,:, 190) ! rate_const*M*CO*OH + rxt_rates(:ncol,:, 256) = rxt_rates(:ncol,:, 256)*sol(:ncol,:, 81)*sol(:ncol,:, 190) ! rate_const*M*HCN*OH + rxt_rates(:ncol,:, 257) = rxt_rates(:ncol,:, 257)*sol(:ncol,:, 82)*sol(:ncol,:, 190) ! rate_const*HCOOH*OH + rxt_rates(:ncol,:, 258) = rxt_rates(:ncol,:, 258)*sol(:ncol,:, 177)*sol(:ncol,:, 176) ! rate_const*HOCH2OO*HO2 + rxt_rates(:ncol,:, 259) = rxt_rates(:ncol,:, 259)*sol(:ncol,:, 177) ! rate_const*HOCH2OO + rxt_rates(:ncol,:, 260) = rxt_rates(:ncol,:, 260)*sol(:ncol,:, 177)*sol(:ncol,:, 116) ! rate_const*HOCH2OO*NO + rxt_rates(:ncol,:, 261) = rxt_rates(:ncol,:, 261)*sol(:ncol,:, 189)*sol(:ncol,:, 52) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 262) = rxt_rates(:ncol,:, 262)*sol(:ncol,:, 189)*sol(:ncol,:, 52) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 263) = rxt_rates(:ncol,:, 263)*sol(:ncol,:, 189)*sol(:ncol,:, 52) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 264) = rxt_rates(:ncol,:, 264)*sol(:ncol,:, 189)*sol(:ncol,:, 81) ! rate_const*O1D*HCN + rxt_rates(:ncol,:, 265) = rxt_rates(:ncol,:, 265)*sol(:ncol,:, 60)*sol(:ncol,:, 190) ! rate_const*CO*OH + rxt_rates(:ncol,:, 266) = rxt_rates(:ncol,:, 266)*sol(:ncol,:, 22)*sol(:ncol,:, 54) ! rate_const*M*C2H2*CL + rxt_rates(:ncol,:, 267) = rxt_rates(:ncol,:, 267)*sol(:ncol,:, 22)*sol(:ncol,:, 190) ! rate_const*M*C2H2*OH + rxt_rates(:ncol,:, 268) = rxt_rates(:ncol,:, 268)*sol(:ncol,:, 23)*sol(:ncol,:, 54) ! rate_const*M*C2H4*CL + rxt_rates(:ncol,:, 269) = rxt_rates(:ncol,:, 269)*sol(:ncol,:, 23)*sol(:ncol,:, 122) ! rate_const*C2H4*O3 + rxt_rates(:ncol,:, 270) = rxt_rates(:ncol,:, 270)*sol(:ncol,:, 167)*sol(:ncol,:, 167) ! rate_const*C2H5O2*C2H5O2 + rxt_rates(:ncol,:, 271) = rxt_rates(:ncol,:, 271)*sol(:ncol,:, 167)*sol(:ncol,:, 171) ! rate_const*C2H5O2*CH3O2 + rxt_rates(:ncol,:, 272) = rxt_rates(:ncol,:, 272)*sol(:ncol,:, 167)*sol(:ncol,:, 176) ! rate_const*C2H5O2*HO2 + rxt_rates(:ncol,:, 273) = rxt_rates(:ncol,:, 273)*sol(:ncol,:, 167)*sol(:ncol,:, 116) ! rate_const*C2H5O2*NO + rxt_rates(:ncol,:, 274) = rxt_rates(:ncol,:, 274)*sol(:ncol,:, 24)*sol(:ncol,:, 190) ! rate_const*C2H5OH*OH + rxt_rates(:ncol,:, 275) = rxt_rates(:ncol,:, 275)*sol(:ncol,:, 25)*sol(:ncol,:, 190) ! rate_const*C2H5OOH*OH + rxt_rates(:ncol,:, 276) = rxt_rates(:ncol,:, 276)*sol(:ncol,:, 26)*sol(:ncol,:, 54) ! rate_const*C2H6*CL + rxt_rates(:ncol,:, 277) = rxt_rates(:ncol,:, 277)*sol(:ncol,:, 26)*sol(:ncol,:, 190) ! rate_const*C2H6*OH + rxt_rates(:ncol,:, 278) = rxt_rates(:ncol,:, 278)*sol(:ncol,:, 43)*sol(:ncol,:, 118) ! rate_const*CH3CHO*NO3 + rxt_rates(:ncol,:, 279) = rxt_rates(:ncol,:, 279)*sol(:ncol,:, 43)*sol(:ncol,:, 190) ! rate_const*CH3CHO*OH + rxt_rates(:ncol,:, 280) = rxt_rates(:ncol,:, 280)*sol(:ncol,:, 45)*sol(:ncol,:, 190) ! rate_const*CH3CN*OH + rxt_rates(:ncol,:, 281) = rxt_rates(:ncol,:, 281)*sol(:ncol,:, 170)*sol(:ncol,:, 170) ! rate_const*CH3CO3*CH3CO3 + rxt_rates(:ncol,:, 282) = rxt_rates(:ncol,:, 282)*sol(:ncol,:, 170)*sol(:ncol,:, 171) ! rate_const*CH3CO3*CH3O2 + rxt_rates(:ncol,:, 283) = rxt_rates(:ncol,:, 283)*sol(:ncol,:, 170)*sol(:ncol,:, 176) ! rate_const*CH3CO3*HO2 + rxt_rates(:ncol,:, 284) = rxt_rates(:ncol,:, 284)*sol(:ncol,:, 170)*sol(:ncol,:, 116) ! rate_const*CH3CO3*NO + rxt_rates(:ncol,:, 285) = rxt_rates(:ncol,:, 285)*sol(:ncol,:, 48)*sol(:ncol,:, 190) ! rate_const*CH3COOH*OH + rxt_rates(:ncol,:, 286) = rxt_rates(:ncol,:, 286)*sol(:ncol,:, 49)*sol(:ncol,:, 190) ! rate_const*CH3COOOH*OH + rxt_rates(:ncol,:, 287) = rxt_rates(:ncol,:, 287)*sol(:ncol,:, 175)*sol(:ncol,:, 176) ! rate_const*EO2*HO2 + rxt_rates(:ncol,:, 288) = rxt_rates(:ncol,:, 288)*sol(:ncol,:, 175)*sol(:ncol,:, 116) ! rate_const*EO2*NO + rxt_rates(:ncol,:, 289) = rxt_rates(:ncol,:, 289)*sol(:ncol,:, 174) ! rate_const*EO + rxt_rates(:ncol,:, 290) = rxt_rates(:ncol,:, 290)*sol(:ncol,:, 174) ! rate_const*O2*EO + rxt_rates(:ncol,:, 291) = rxt_rates(:ncol,:, 291)*sol(:ncol,:, 69)*sol(:ncol,:, 190) ! rate_const*GLYALD*OH + rxt_rates(:ncol,:, 292) = rxt_rates(:ncol,:, 292)*sol(:ncol,:, 70)*sol(:ncol,:, 190) ! rate_const*GLYOXAL*OH + rxt_rates(:ncol,:, 293) = rxt_rates(:ncol,:, 293)*sol(:ncol,:, 127)*sol(:ncol,:, 190) ! rate_const*PAN*OH + rxt_rates(:ncol,:, 294) = rxt_rates(:ncol,:, 294)*sol(:ncol,:, 23)*sol(:ncol,:, 190) ! rate_const*M*C2H4*OH + rxt_rates(:ncol,:, 295) = rxt_rates(:ncol,:, 295)*sol(:ncol,:, 170)*sol(:ncol,:, 117) ! rate_const*M*CH3CO3*NO2 + rxt_rates(:ncol,:, 296) = rxt_rates(:ncol,:, 296)*sol(:ncol,:, 127) ! rate_const*M*PAN + rxt_rates(:ncol,:, 297) = rxt_rates(:ncol,:, 297)*sol(:ncol,:, 27)*sol(:ncol,:, 118) ! rate_const*C3H6*NO3 + rxt_rates(:ncol,:, 298) = rxt_rates(:ncol,:, 298)*sol(:ncol,:, 27)*sol(:ncol,:, 122) ! rate_const*C3H6*O3 + rxt_rates(:ncol,:, 299) = rxt_rates(:ncol,:, 299)*sol(:ncol,:, 168)*sol(:ncol,:, 171) ! rate_const*C3H7O2*CH3O2 + rxt_rates(:ncol,:, 300) = rxt_rates(:ncol,:, 300)*sol(:ncol,:, 168)*sol(:ncol,:, 176) ! rate_const*C3H7O2*HO2 + rxt_rates(:ncol,:, 301) = rxt_rates(:ncol,:, 301)*sol(:ncol,:, 168)*sol(:ncol,:, 116) ! rate_const*C3H7O2*NO + rxt_rates(:ncol,:, 302) = rxt_rates(:ncol,:, 302)*sol(:ncol,:, 28)*sol(:ncol,:, 190) ! rate_const*C3H7OOH*OH + rxt_rates(:ncol,:, 303) = rxt_rates(:ncol,:, 303)*sol(:ncol,:, 29)*sol(:ncol,:, 190) ! rate_const*C3H8*OH + rxt_rates(:ncol,:, 304) = rxt_rates(:ncol,:, 304)*sol(:ncol,:, 47)*sol(:ncol,:, 118) ! rate_const*CH3COCHO*NO3 + rxt_rates(:ncol,:, 305) = rxt_rates(:ncol,:, 305)*sol(:ncol,:, 47)*sol(:ncol,:, 190) ! rate_const*CH3COCHO*OH + rxt_rates(:ncol,:, 306) = rxt_rates(:ncol,:, 306)*sol(:ncol,:, 90)*sol(:ncol,:, 190) ! rate_const*HYAC*OH + rxt_rates(:ncol,:, 307) = rxt_rates(:ncol,:, 307)*sol(:ncol,:, 119)*sol(:ncol,:, 190) ! rate_const*NOA*OH + rxt_rates(:ncol,:, 308) = rxt_rates(:ncol,:, 308)*sol(:ncol,:, 192)*sol(:ncol,:, 176) ! rate_const*PO2*HO2 + rxt_rates(:ncol,:, 309) = rxt_rates(:ncol,:, 309)*sol(:ncol,:, 192)*sol(:ncol,:, 116) ! rate_const*PO2*NO + rxt_rates(:ncol,:, 310) = rxt_rates(:ncol,:, 310)*sol(:ncol,:, 132)*sol(:ncol,:, 190) ! rate_const*POOH*OH + rxt_rates(:ncol,:, 311) = rxt_rates(:ncol,:, 311)*sol(:ncol,:, 193)*sol(:ncol,:, 171) ! rate_const*RO2*CH3O2 + rxt_rates(:ncol,:, 312) = rxt_rates(:ncol,:, 312)*sol(:ncol,:, 193)*sol(:ncol,:, 176) ! rate_const*RO2*HO2 + rxt_rates(:ncol,:, 313) = rxt_rates(:ncol,:, 313)*sol(:ncol,:, 193)*sol(:ncol,:, 116) ! rate_const*RO2*NO + rxt_rates(:ncol,:, 314) = rxt_rates(:ncol,:, 314)*sol(:ncol,:, 133)*sol(:ncol,:, 190) ! rate_const*ROOH*OH + rxt_rates(:ncol,:, 315) = rxt_rates(:ncol,:, 315)*sol(:ncol,:, 27)*sol(:ncol,:, 190) ! rate_const*M*C3H6*OH + rxt_rates(:ncol,:, 316) = rxt_rates(:ncol,:, 316)*sol(:ncol,:, 46)*sol(:ncol,:, 190) ! rate_const*CH3COCH3*OH + rxt_rates(:ncol,:, 317) = rxt_rates(:ncol,:, 317)*sol(:ncol,:, 14)*sol(:ncol,:, 118) ! rate_const*BIGENE*NO3 + rxt_rates(:ncol,:, 318) = rxt_rates(:ncol,:, 318)*sol(:ncol,:, 14)*sol(:ncol,:, 190) ! rate_const*BIGENE*OH + rxt_rates(:ncol,:, 319) = rxt_rates(:ncol,:, 319)*sol(:ncol,:, 173)*sol(:ncol,:, 116) ! rate_const*ENEO2*NO + rxt_rates(:ncol,:, 320) = rxt_rates(:ncol,:, 320)*sol(:ncol,:, 173)*sol(:ncol,:, 116) ! rate_const*ENEO2*NO + rxt_rates(:ncol,:, 321) = rxt_rates(:ncol,:, 321)*sol(:ncol,:, 88)*sol(:ncol,:, 190) ! rate_const*HONITR*OH + rxt_rates(:ncol,:, 322) = rxt_rates(:ncol,:, 322)*sol(:ncol,:, 182)*sol(:ncol,:, 170) ! rate_const*MACRO2*CH3CO3 + rxt_rates(:ncol,:, 323) = rxt_rates(:ncol,:, 323)*sol(:ncol,:, 182)*sol(:ncol,:, 171) ! rate_const*MACRO2*CH3O2 + rxt_rates(:ncol,:, 324) = rxt_rates(:ncol,:, 324)*sol(:ncol,:, 182)*sol(:ncol,:, 176) ! rate_const*MACRO2*HO2 + rxt_rates(:ncol,:, 325) = rxt_rates(:ncol,:, 325)*sol(:ncol,:, 182)*sol(:ncol,:, 118) ! rate_const*MACRO2*NO3 + rxt_rates(:ncol,:, 326) = rxt_rates(:ncol,:, 326)*sol(:ncol,:, 182)*sol(:ncol,:, 116) ! rate_const*MACRO2*NO + rxt_rates(:ncol,:, 327) = rxt_rates(:ncol,:, 327)*sol(:ncol,:, 182)*sol(:ncol,:, 116) ! rate_const*MACRO2*NO + rxt_rates(:ncol,:, 328) = rxt_rates(:ncol,:, 328)*sol(:ncol,:, 100)*sol(:ncol,:, 122) ! rate_const*MACR*O3 + rxt_rates(:ncol,:, 329) = rxt_rates(:ncol,:, 329)*sol(:ncol,:, 100)*sol(:ncol,:, 190) ! rate_const*MACR*OH + rxt_rates(:ncol,:, 330) = rxt_rates(:ncol,:, 330)*sol(:ncol,:, 101)*sol(:ncol,:, 190) ! rate_const*MACROOH*OH + rxt_rates(:ncol,:, 331) = rxt_rates(:ncol,:, 331)*sol(:ncol,:, 184)*sol(:ncol,:, 170) ! rate_const*MCO3*CH3CO3 + rxt_rates(:ncol,:, 332) = rxt_rates(:ncol,:, 332)*sol(:ncol,:, 184)*sol(:ncol,:, 171) ! rate_const*MCO3*CH3O2 + rxt_rates(:ncol,:, 333) = rxt_rates(:ncol,:, 333)*sol(:ncol,:, 184)*sol(:ncol,:, 176) ! rate_const*MCO3*HO2 + rxt_rates(:ncol,:, 334) = rxt_rates(:ncol,:, 334)*sol(:ncol,:, 184)*sol(:ncol,:, 184) ! rate_const*MCO3*MCO3 + rxt_rates(:ncol,:, 335) = rxt_rates(:ncol,:, 335)*sol(:ncol,:, 184)*sol(:ncol,:, 116) ! rate_const*MCO3*NO + rxt_rates(:ncol,:, 336) = rxt_rates(:ncol,:, 336)*sol(:ncol,:, 184)*sol(:ncol,:, 118) ! rate_const*MCO3*NO3 + rxt_rates(:ncol,:, 337) = rxt_rates(:ncol,:, 337)*sol(:ncol,:, 186)*sol(:ncol,:, 176) ! rate_const*MEKO2*HO2 + rxt_rates(:ncol,:, 338) = rxt_rates(:ncol,:, 338)*sol(:ncol,:, 186)*sol(:ncol,:, 116) ! rate_const*MEKO2*NO + rxt_rates(:ncol,:, 339) = rxt_rates(:ncol,:, 339)*sol(:ncol,:, 102)*sol(:ncol,:, 190) ! rate_const*MEK*OH + rxt_rates(:ncol,:, 340) = rxt_rates(:ncol,:, 340)*sol(:ncol,:, 103)*sol(:ncol,:, 190) ! rate_const*MEKOOH*OH + rxt_rates(:ncol,:, 341) = rxt_rates(:ncol,:, 341)*sol(:ncol,:, 104)*sol(:ncol,:, 190) ! rate_const*M*MPAN*OH + rxt_rates(:ncol,:, 342) = rxt_rates(:ncol,:, 342)*sol(:ncol,:, 106)*sol(:ncol,:, 122) ! rate_const*MVK*O3 + rxt_rates(:ncol,:, 343) = rxt_rates(:ncol,:, 343)*sol(:ncol,:, 106)*sol(:ncol,:, 190) ! rate_const*MVK*OH + rxt_rates(:ncol,:, 344) = rxt_rates(:ncol,:, 344)*sol(:ncol,:, 184)*sol(:ncol,:, 117) ! rate_const*M*MCO3*NO2 + rxt_rates(:ncol,:, 345) = rxt_rates(:ncol,:, 345)*sol(:ncol,:, 104) ! rate_const*M*MPAN + rxt_rates(:ncol,:, 346) = rxt_rates(:ncol,:, 346)*sol(:ncol,:, 1)*sol(:ncol,:, 190) ! rate_const*ALKNIT*OH + rxt_rates(:ncol,:, 347) = rxt_rates(:ncol,:, 347)*sol(:ncol,:, 162)*sol(:ncol,:, 176) ! rate_const*ALKO2*HO2 + rxt_rates(:ncol,:, 348) = rxt_rates(:ncol,:, 348)*sol(:ncol,:, 162)*sol(:ncol,:, 116) ! rate_const*ALKO2*NO + rxt_rates(:ncol,:, 349) = rxt_rates(:ncol,:, 349)*sol(:ncol,:, 162)*sol(:ncol,:, 116) ! rate_const*ALKO2*NO + rxt_rates(:ncol,:, 350) = rxt_rates(:ncol,:, 350)*sol(:ncol,:, 2)*sol(:ncol,:, 190) ! rate_const*ALKOOH*OH + rxt_rates(:ncol,:, 351) = rxt_rates(:ncol,:, 351)*sol(:ncol,:, 13)*sol(:ncol,:, 190) ! rate_const*BIGALK*OH + rxt_rates(:ncol,:, 352) = rxt_rates(:ncol,:, 352)*sol(:ncol,:, 89)*sol(:ncol,:, 190) ! rate_const*HPALD*OH + rxt_rates(:ncol,:, 353) = rxt_rates(:ncol,:, 353)*sol(:ncol,:, 91)*sol(:ncol,:, 190) ! rate_const*HYDRALD*OH + rxt_rates(:ncol,:, 354) = rxt_rates(:ncol,:, 354)*sol(:ncol,:, 92)*sol(:ncol,:, 190) ! rate_const*IEPOX*OH + rxt_rates(:ncol,:, 355) = rxt_rates(:ncol,:, 355)*sol(:ncol,:, 178)*sol(:ncol,:, 170) ! rate_const*ISOPAO2*CH3CO3 + rxt_rates(:ncol,:, 356) = rxt_rates(:ncol,:, 356)*sol(:ncol,:, 178)*sol(:ncol,:, 171) ! rate_const*ISOPAO2*CH3O2 + rxt_rates(:ncol,:, 357) = rxt_rates(:ncol,:, 357)*sol(:ncol,:, 178)*sol(:ncol,:, 176) ! rate_const*ISOPAO2*HO2 + rxt_rates(:ncol,:, 358) = rxt_rates(:ncol,:, 358)*sol(:ncol,:, 178)*sol(:ncol,:, 116) ! rate_const*ISOPAO2*NO + rxt_rates(:ncol,:, 359) = rxt_rates(:ncol,:, 359)*sol(:ncol,:, 178)*sol(:ncol,:, 118) ! rate_const*ISOPAO2*NO3 + rxt_rates(:ncol,:, 360) = rxt_rates(:ncol,:, 360)*sol(:ncol,:, 179)*sol(:ncol,:, 170) ! rate_const*ISOPBO2*CH3CO3 + rxt_rates(:ncol,:, 361) = rxt_rates(:ncol,:, 361)*sol(:ncol,:, 179)*sol(:ncol,:, 171) ! rate_const*ISOPBO2*CH3O2 + rxt_rates(:ncol,:, 362) = rxt_rates(:ncol,:, 362)*sol(:ncol,:, 179)*sol(:ncol,:, 176) ! rate_const*ISOPBO2*HO2 + rxt_rates(:ncol,:, 363) = rxt_rates(:ncol,:, 363)*sol(:ncol,:, 179) ! rate_const*ISOPBO2 + rxt_rates(:ncol,:, 364) = rxt_rates(:ncol,:, 364)*sol(:ncol,:, 179)*sol(:ncol,:, 116) ! rate_const*ISOPBO2*NO + rxt_rates(:ncol,:, 365) = rxt_rates(:ncol,:, 365)*sol(:ncol,:, 179)*sol(:ncol,:, 118) ! rate_const*ISOPBO2*NO3 + rxt_rates(:ncol,:, 366) = rxt_rates(:ncol,:, 366)*sol(:ncol,:, 94)*sol(:ncol,:, 190) ! rate_const*ISOPNITA*OH + rxt_rates(:ncol,:, 367) = rxt_rates(:ncol,:, 367)*sol(:ncol,:, 95)*sol(:ncol,:, 190) ! rate_const*ISOPNITB*OH + rxt_rates(:ncol,:, 368) = rxt_rates(:ncol,:, 368)*sol(:ncol,:, 93)*sol(:ncol,:, 118) ! rate_const*ISOP*NO3 + rxt_rates(:ncol,:, 369) = rxt_rates(:ncol,:, 369)*sol(:ncol,:, 96)*sol(:ncol,:, 170) ! rate_const*ISOPNO3*CH3CO3 + rxt_rates(:ncol,:, 370) = rxt_rates(:ncol,:, 370)*sol(:ncol,:, 96)*sol(:ncol,:, 171) ! rate_const*ISOPNO3*CH3O2 + rxt_rates(:ncol,:, 371) = rxt_rates(:ncol,:, 371)*sol(:ncol,:, 96)*sol(:ncol,:, 176) ! rate_const*ISOPNO3*HO2 + rxt_rates(:ncol,:, 372) = rxt_rates(:ncol,:, 372)*sol(:ncol,:, 96)*sol(:ncol,:, 116) ! rate_const*ISOPNO3*NO + rxt_rates(:ncol,:, 373) = rxt_rates(:ncol,:, 373)*sol(:ncol,:, 96)*sol(:ncol,:, 118) ! rate_const*ISOPNO3*NO3 + rxt_rates(:ncol,:, 374) = rxt_rates(:ncol,:, 374)*sol(:ncol,:, 97)*sol(:ncol,:, 190) ! rate_const*ISOPNOOH*OH + rxt_rates(:ncol,:, 375) = rxt_rates(:ncol,:, 375)*sol(:ncol,:, 93)*sol(:ncol,:, 122) ! rate_const*ISOP*O3 + rxt_rates(:ncol,:, 376) = rxt_rates(:ncol,:, 376)*sol(:ncol,:, 93)*sol(:ncol,:, 190) ! rate_const*ISOP*OH + rxt_rates(:ncol,:, 377) = rxt_rates(:ncol,:, 377)*sol(:ncol,:, 98)*sol(:ncol,:, 190) ! rate_const*ISOPOOH*OH + rxt_rates(:ncol,:, 378) = rxt_rates(:ncol,:, 378)*sol(:ncol,:, 110)*sol(:ncol,:, 190) ! rate_const*NC4CH2OH*OH + rxt_rates(:ncol,:, 379) = rxt_rates(:ncol,:, 379)*sol(:ncol,:, 111)*sol(:ncol,:, 190) ! rate_const*NC4CHO*OH + rxt_rates(:ncol,:, 380) = rxt_rates(:ncol,:, 380)*sol(:ncol,:, 198)*sol(:ncol,:, 170) ! rate_const*XO2*CH3CO3 + rxt_rates(:ncol,:, 381) = rxt_rates(:ncol,:, 381)*sol(:ncol,:, 198)*sol(:ncol,:, 171) ! rate_const*XO2*CH3O2 + rxt_rates(:ncol,:, 382) = rxt_rates(:ncol,:, 382)*sol(:ncol,:, 198)*sol(:ncol,:, 176) ! rate_const*XO2*HO2 + rxt_rates(:ncol,:, 383) = rxt_rates(:ncol,:, 383)*sol(:ncol,:, 198)*sol(:ncol,:, 116) ! rate_const*XO2*NO + rxt_rates(:ncol,:, 384) = rxt_rates(:ncol,:, 384)*sol(:ncol,:, 198)*sol(:ncol,:, 118) ! rate_const*XO2*NO3 + rxt_rates(:ncol,:, 385) = rxt_rates(:ncol,:, 385)*sol(:ncol,:, 154)*sol(:ncol,:, 190) ! rate_const*XOOH*OH + rxt_rates(:ncol,:, 386) = rxt_rates(:ncol,:, 386)*sol(:ncol,:, 161)*sol(:ncol,:, 176) ! rate_const*ACBZO2*HO2 + rxt_rates(:ncol,:, 387) = rxt_rates(:ncol,:, 387)*sol(:ncol,:, 161)*sol(:ncol,:, 116) ! rate_const*ACBZO2*NO + rxt_rates(:ncol,:, 388) = rxt_rates(:ncol,:, 388)*sol(:ncol,:, 5)*sol(:ncol,:, 190) ! rate_const*BENZENE*OH + rxt_rates(:ncol,:, 389) = rxt_rates(:ncol,:, 389)*sol(:ncol,:, 164)*sol(:ncol,:, 176) ! rate_const*BENZO2*HO2 + rxt_rates(:ncol,:, 390) = rxt_rates(:ncol,:, 390)*sol(:ncol,:, 164)*sol(:ncol,:, 116) ! rate_const*BENZO2*NO + rxt_rates(:ncol,:, 391) = rxt_rates(:ncol,:, 391)*sol(:ncol,:, 6)*sol(:ncol,:, 190) ! rate_const*BENZOOH*OH + rxt_rates(:ncol,:, 392) = rxt_rates(:ncol,:, 392)*sol(:ncol,:, 20)*sol(:ncol,:, 190) ! rate_const*BZALD*OH + rxt_rates(:ncol,:, 393) = rxt_rates(:ncol,:, 393)*sol(:ncol,:, 166)*sol(:ncol,:, 176) ! rate_const*BZOO*HO2 + rxt_rates(:ncol,:, 394) = rxt_rates(:ncol,:, 394)*sol(:ncol,:, 21)*sol(:ncol,:, 190) ! rate_const*BZOOH*OH + rxt_rates(:ncol,:, 395) = rxt_rates(:ncol,:, 395)*sol(:ncol,:, 166)*sol(:ncol,:, 116) ! rate_const*BZOO*NO + rxt_rates(:ncol,:, 396) = rxt_rates(:ncol,:, 396)*sol(:ncol,:, 169)*sol(:ncol,:, 176) ! rate_const*C6H5O2*HO2 + rxt_rates(:ncol,:, 397) = rxt_rates(:ncol,:, 397)*sol(:ncol,:, 169)*sol(:ncol,:, 116) ! rate_const*C6H5O2*NO + rxt_rates(:ncol,:, 398) = rxt_rates(:ncol,:, 398)*sol(:ncol,:, 30)*sol(:ncol,:, 190) ! rate_const*C6H5OOH*OH + rxt_rates(:ncol,:, 399) = rxt_rates(:ncol,:, 399)*sol(:ncol,:, 64)*sol(:ncol,:, 190) ! rate_const*CRESOL*OH + rxt_rates(:ncol,:, 400) = rxt_rates(:ncol,:, 400)*sol(:ncol,:, 172)*sol(:ncol,:, 176) ! rate_const*DICARBO2*HO2 + rxt_rates(:ncol,:, 401) = rxt_rates(:ncol,:, 401)*sol(:ncol,:, 172)*sol(:ncol,:, 116) ! rate_const*DICARBO2*NO + rxt_rates(:ncol,:, 402) = rxt_rates(:ncol,:, 402)*sol(:ncol,:, 172)*sol(:ncol,:, 117) ! rate_const*M*DICARBO2*NO2 + rxt_rates(:ncol,:, 403) = rxt_rates(:ncol,:, 403)*sol(:ncol,:, 183)*sol(:ncol,:, 176) ! rate_const*MALO2*HO2 + rxt_rates(:ncol,:, 404) = rxt_rates(:ncol,:, 404)*sol(:ncol,:, 183)*sol(:ncol,:, 116) ! rate_const*MALO2*NO + rxt_rates(:ncol,:, 405) = rxt_rates(:ncol,:, 405)*sol(:ncol,:, 183)*sol(:ncol,:, 117) ! rate_const*M*MALO2*NO2 + rxt_rates(:ncol,:, 406) = rxt_rates(:ncol,:, 406)*sol(:ncol,:, 185)*sol(:ncol,:, 176) ! rate_const*MDIALO2*HO2 + rxt_rates(:ncol,:, 407) = rxt_rates(:ncol,:, 407)*sol(:ncol,:, 185)*sol(:ncol,:, 116) ! rate_const*MDIALO2*NO + rxt_rates(:ncol,:, 408) = rxt_rates(:ncol,:, 408)*sol(:ncol,:, 185)*sol(:ncol,:, 117) ! rate_const*M*MDIALO2*NO2 + rxt_rates(:ncol,:, 409) = rxt_rates(:ncol,:, 409)*sol(:ncol,:, 191)*sol(:ncol,:, 176) ! rate_const*PHENO2*HO2 + rxt_rates(:ncol,:, 410) = rxt_rates(:ncol,:, 410)*sol(:ncol,:, 191)*sol(:ncol,:, 116) ! rate_const*PHENO2*NO + rxt_rates(:ncol,:, 411) = rxt_rates(:ncol,:, 411)*sol(:ncol,:, 130)*sol(:ncol,:, 190) ! rate_const*PHENOL*OH + rxt_rates(:ncol,:, 412) = rxt_rates(:ncol,:, 412)*sol(:ncol,:, 129)*sol(:ncol,:, 117) ! rate_const*PHENO*NO2 + rxt_rates(:ncol,:, 413) = rxt_rates(:ncol,:, 413)*sol(:ncol,:, 129)*sol(:ncol,:, 122) ! rate_const*PHENO*O3 + rxt_rates(:ncol,:, 414) = rxt_rates(:ncol,:, 414)*sol(:ncol,:, 131)*sol(:ncol,:, 190) ! rate_const*PHENOOH*OH + rxt_rates(:ncol,:, 415) = rxt_rates(:ncol,:, 415)*sol(:ncol,:, 161)*sol(:ncol,:, 117) ! rate_const*M*ACBZO2*NO2 + rxt_rates(:ncol,:, 416) = rxt_rates(:ncol,:, 416)*sol(:ncol,:, 196)*sol(:ncol,:, 176) ! rate_const*TOLO2*HO2 + rxt_rates(:ncol,:, 417) = rxt_rates(:ncol,:, 417)*sol(:ncol,:, 196)*sol(:ncol,:, 116) ! rate_const*TOLO2*NO + rxt_rates(:ncol,:, 418) = rxt_rates(:ncol,:, 418)*sol(:ncol,:, 152)*sol(:ncol,:, 190) ! rate_const*TOLOOH*OH + rxt_rates(:ncol,:, 419) = rxt_rates(:ncol,:, 419)*sol(:ncol,:, 153)*sol(:ncol,:, 190) ! rate_const*TOLUENE*OH + rxt_rates(:ncol,:, 420) = rxt_rates(:ncol,:, 420)*sol(:ncol,:, 128) ! rate_const*M*PBZNIT + rxt_rates(:ncol,:, 421) = rxt_rates(:ncol,:, 421)*sol(:ncol,:, 155)*sol(:ncol,:, 190) ! rate_const*XYLENES*OH + rxt_rates(:ncol,:, 422) = rxt_rates(:ncol,:, 422)*sol(:ncol,:, 199)*sol(:ncol,:, 176) ! rate_const*XYLENO2*HO2 + rxt_rates(:ncol,:, 423) = rxt_rates(:ncol,:, 423)*sol(:ncol,:, 199)*sol(:ncol,:, 116) ! rate_const*XYLENO2*NO + rxt_rates(:ncol,:, 424) = rxt_rates(:ncol,:, 424)*sol(:ncol,:, 156)*sol(:ncol,:, 190) ! rate_const*XYLENOOH*OH + rxt_rates(:ncol,:, 425) = rxt_rates(:ncol,:, 425)*sol(:ncol,:, 201)*sol(:ncol,:, 176) ! rate_const*XYLOLO2*HO2 + rxt_rates(:ncol,:, 426) = rxt_rates(:ncol,:, 426)*sol(:ncol,:, 201)*sol(:ncol,:, 116) ! rate_const*XYLOLO2*NO + rxt_rates(:ncol,:, 427) = rxt_rates(:ncol,:, 427)*sol(:ncol,:, 157)*sol(:ncol,:, 190) ! rate_const*XYLOL*OH + rxt_rates(:ncol,:, 428) = rxt_rates(:ncol,:, 428)*sol(:ncol,:, 158)*sol(:ncol,:, 190) ! rate_const*XYLOLOOH*OH + rxt_rates(:ncol,:, 429) = rxt_rates(:ncol,:, 429)*sol(:ncol,:, 4)*sol(:ncol,:, 118) ! rate_const*BCARY*NO3 + rxt_rates(:ncol,:, 430) = rxt_rates(:ncol,:, 430)*sol(:ncol,:, 4)*sol(:ncol,:, 122) ! rate_const*BCARY*O3 + rxt_rates(:ncol,:, 431) = rxt_rates(:ncol,:, 431)*sol(:ncol,:, 4)*sol(:ncol,:, 190) ! rate_const*BCARY*OH + rxt_rates(:ncol,:, 432) = rxt_rates(:ncol,:, 432)*sol(:ncol,:, 105)*sol(:ncol,:, 118) ! rate_const*MTERP*NO3 + rxt_rates(:ncol,:, 433) = rxt_rates(:ncol,:, 433)*sol(:ncol,:, 105)*sol(:ncol,:, 122) ! rate_const*MTERP*O3 + rxt_rates(:ncol,:, 434) = rxt_rates(:ncol,:, 434)*sol(:ncol,:, 105)*sol(:ncol,:, 190) ! rate_const*MTERP*OH + rxt_rates(:ncol,:, 435) = rxt_rates(:ncol,:, 435)*sol(:ncol,:, 188)*sol(:ncol,:, 171) ! rate_const*NTERPO2*CH3O2 + rxt_rates(:ncol,:, 436) = rxt_rates(:ncol,:, 436)*sol(:ncol,:, 188)*sol(:ncol,:, 176) ! rate_const*NTERPO2*HO2 + rxt_rates(:ncol,:, 437) = rxt_rates(:ncol,:, 437)*sol(:ncol,:, 188)*sol(:ncol,:, 116) ! rate_const*NTERPO2*NO + rxt_rates(:ncol,:, 438) = rxt_rates(:ncol,:, 438)*sol(:ncol,:, 188)*sol(:ncol,:, 118) ! rate_const*NTERPO2*NO3 + rxt_rates(:ncol,:, 439) = rxt_rates(:ncol,:, 439)*sol(:ncol,:, 120)*sol(:ncol,:, 190) ! rate_const*NTERPOOH*OH + rxt_rates(:ncol,:, 440) = rxt_rates(:ncol,:, 440)*sol(:ncol,:, 194)*sol(:ncol,:, 171) ! rate_const*TERP2O2*CH3O2 + rxt_rates(:ncol,:, 441) = rxt_rates(:ncol,:, 441)*sol(:ncol,:, 194)*sol(:ncol,:, 176) ! rate_const*TERP2O2*HO2 + rxt_rates(:ncol,:, 442) = rxt_rates(:ncol,:, 442)*sol(:ncol,:, 194)*sol(:ncol,:, 116) ! rate_const*TERP2O2*NO + rxt_rates(:ncol,:, 443) = rxt_rates(:ncol,:, 443)*sol(:ncol,:, 147)*sol(:ncol,:, 190) ! rate_const*TERP2OOH*OH + rxt_rates(:ncol,:, 444) = rxt_rates(:ncol,:, 444)*sol(:ncol,:, 148)*sol(:ncol,:, 190) ! rate_const*TERPNIT*OH + rxt_rates(:ncol,:, 445) = rxt_rates(:ncol,:, 445)*sol(:ncol,:, 195)*sol(:ncol,:, 171) ! rate_const*TERPO2*CH3O2 + rxt_rates(:ncol,:, 446) = rxt_rates(:ncol,:, 446)*sol(:ncol,:, 195)*sol(:ncol,:, 176) ! rate_const*TERPO2*HO2 + rxt_rates(:ncol,:, 447) = rxt_rates(:ncol,:, 447)*sol(:ncol,:, 195)*sol(:ncol,:, 116) ! rate_const*TERPO2*NO + rxt_rates(:ncol,:, 448) = rxt_rates(:ncol,:, 448)*sol(:ncol,:, 149)*sol(:ncol,:, 190) ! rate_const*TERPOOH*OH + rxt_rates(:ncol,:, 449) = rxt_rates(:ncol,:, 449)*sol(:ncol,:, 150)*sol(:ncol,:, 118) ! rate_const*TERPROD1*NO3 + rxt_rates(:ncol,:, 450) = rxt_rates(:ncol,:, 450)*sol(:ncol,:, 150)*sol(:ncol,:, 190) ! rate_const*TERPROD1*OH + rxt_rates(:ncol,:, 451) = rxt_rates(:ncol,:, 451)*sol(:ncol,:, 151)*sol(:ncol,:, 190) ! rate_const*TERPROD2*OH + rxt_rates(:ncol,:, 452) = rxt_rates(:ncol,:, 452)*sol(:ncol,:, 65)*sol(:ncol,:, 118) ! rate_const*DMS*NO3 + rxt_rates(:ncol,:, 453) = rxt_rates(:ncol,:, 453)*sol(:ncol,:, 65)*sol(:ncol,:, 190) ! rate_const*DMS*OH + rxt_rates(:ncol,:, 454) = rxt_rates(:ncol,:, 454)*sol(:ncol,:, 125)*sol(:ncol,:, 121) ! rate_const*OCS*O + rxt_rates(:ncol,:, 455) = rxt_rates(:ncol,:, 455)*sol(:ncol,:, 125)*sol(:ncol,:, 190) ! rate_const*OCS*OH + rxt_rates(:ncol,:, 456) = rxt_rates(:ncol,:, 456)*sol(:ncol,:, 134) ! rate_const*O2*S + rxt_rates(:ncol,:, 457) = rxt_rates(:ncol,:, 457)*sol(:ncol,:, 134)*sol(:ncol,:, 122) ! rate_const*S*O3 + rxt_rates(:ncol,:, 458) = rxt_rates(:ncol,:, 458)*sol(:ncol,:, 136)*sol(:ncol,:, 17) ! rate_const*SO*BRO + rxt_rates(:ncol,:, 459) = rxt_rates(:ncol,:, 459)*sol(:ncol,:, 136)*sol(:ncol,:, 57) ! rate_const*SO*CLO + rxt_rates(:ncol,:, 460) = rxt_rates(:ncol,:, 460)*sol(:ncol,:, 134)*sol(:ncol,:, 190) ! rate_const*S*OH + rxt_rates(:ncol,:, 461) = rxt_rates(:ncol,:, 461)*sol(:ncol,:, 136)*sol(:ncol,:, 117) ! rate_const*SO*NO2 + rxt_rates(:ncol,:, 462) = rxt_rates(:ncol,:, 462)*sol(:ncol,:, 136) ! rate_const*O2*SO + rxt_rates(:ncol,:, 463) = rxt_rates(:ncol,:, 463)*sol(:ncol,:, 136)*sol(:ncol,:, 122) ! rate_const*SO*O3 + rxt_rates(:ncol,:, 464) = rxt_rates(:ncol,:, 464)*sol(:ncol,:, 136)*sol(:ncol,:, 124) ! rate_const*SO*OCLO + rxt_rates(:ncol,:, 465) = rxt_rates(:ncol,:, 465)*sol(:ncol,:, 136)*sol(:ncol,:, 190) ! rate_const*SO*OH + rxt_rates(:ncol,:, 466) = rxt_rates(:ncol,:, 466)*sol(:ncol,:, 65)*sol(:ncol,:, 190) ! rate_const*DMS*OH + rxt_rates(:ncol,:, 467) = rxt_rates(:ncol,:, 467)*sol(:ncol,:, 137)*sol(:ncol,:, 190) ! rate_const*SO2*OH + rxt_rates(:ncol,:, 468) = rxt_rates(:ncol,:, 468)*sol(:ncol,:, 138)*sol(:ncol,:, 202) ! rate_const*SO3*H2O + rxt_rates(:ncol,:, 469) = rxt_rates(:ncol,:, 469)*sol(:ncol,:, 112)*sol(:ncol,:, 190) ! rate_const*NH3*OH + rxt_rates(:ncol,:, 470) = rxt_rates(:ncol,:, 470)*sol(:ncol,:, 70) ! rate_const*GLYOXAL + rxt_rates(:ncol,:, 471) = rxt_rates(:ncol,:, 471)*sol(:ncol,:, 176) ! rate_const*HO2 + rxt_rates(:ncol,:, 472) = rxt_rates(:ncol,:, 472)*sol(:ncol,:, 88) ! rate_const*HONITR + rxt_rates(:ncol,:, 473) = rxt_rates(:ncol,:, 473)*sol(:ncol,:, 94) ! rate_const*ISOPNITA + rxt_rates(:ncol,:, 474) = rxt_rates(:ncol,:, 474)*sol(:ncol,:, 95) ! rate_const*ISOPNITB + rxt_rates(:ncol,:, 475) = rxt_rates(:ncol,:, 475)*sol(:ncol,:, 109) ! rate_const*N2O5 + rxt_rates(:ncol,:, 476) = rxt_rates(:ncol,:, 476)*sol(:ncol,:, 110) ! rate_const*NC4CH2OH + rxt_rates(:ncol,:, 477) = rxt_rates(:ncol,:, 477)*sol(:ncol,:, 111) ! rate_const*NC4CHO + rxt_rates(:ncol,:, 478) = rxt_rates(:ncol,:, 478)*sol(:ncol,:, 113) ! rate_const*NH4 + rxt_rates(:ncol,:, 479) = rxt_rates(:ncol,:, 479)*sol(:ncol,:, 117) ! rate_const*NO2 + rxt_rates(:ncol,:, 480) = rxt_rates(:ncol,:, 480)*sol(:ncol,:, 118) ! rate_const*NO3 + rxt_rates(:ncol,:, 481) = rxt_rates(:ncol,:, 481)*sol(:ncol,:, 120) ! rate_const*NTERPOOH + rxt_rates(:ncol,:, 482) = rxt_rates(:ncol,:, 482)*sol(:ncol,:, 126) ! rate_const*ONITR + rxt_rates(:ncol,:, 483) = rxt_rates(:ncol,:, 483)*sol(:ncol,:, 148) ! rate_const*TERPNIT + rxt_rates(:ncol,:, 484) = rxt_rates(:ncol,:, 484)*sol(:ncol,:, 4)*sol(:ncol,:, 118) ! rate_const*BCARY*NO3 + rxt_rates(:ncol,:, 485) = rxt_rates(:ncol,:, 485)*sol(:ncol,:, 163)*sol(:ncol,:, 176) ! rate_const*BCARYO2VBS*HO2 + rxt_rates(:ncol,:, 486) = rxt_rates(:ncol,:, 486)*sol(:ncol,:, 163)*sol(:ncol,:, 116) ! rate_const*BCARYO2VBS*NO + rxt_rates(:ncol,:, 487) = rxt_rates(:ncol,:, 487)*sol(:ncol,:, 4)*sol(:ncol,:, 122) ! rate_const*BCARY*O3 + rxt_rates(:ncol,:, 488) = rxt_rates(:ncol,:, 488)*sol(:ncol,:, 4)*sol(:ncol,:, 190) ! rate_const*BCARY*OH + rxt_rates(:ncol,:, 489) = rxt_rates(:ncol,:, 489)*sol(:ncol,:, 5)*sol(:ncol,:, 190) ! rate_const*BENZENE*OH + rxt_rates(:ncol,:, 490) = rxt_rates(:ncol,:, 490)*sol(:ncol,:, 165)*sol(:ncol,:, 176) ! rate_const*BENZO2VBS*HO2 + rxt_rates(:ncol,:, 491) = rxt_rates(:ncol,:, 491)*sol(:ncol,:, 165)*sol(:ncol,:, 116) ! rate_const*BENZO2VBS*NO + rxt_rates(:ncol,:, 492) = rxt_rates(:ncol,:, 492)*sol(:ncol,:, 93)*sol(:ncol,:, 118) ! rate_const*ISOP*NO3 + rxt_rates(:ncol,:, 493) = rxt_rates(:ncol,:, 493)*sol(:ncol,:, 180)*sol(:ncol,:, 176) ! rate_const*ISOPO2VBS*HO2 + rxt_rates(:ncol,:, 494) = rxt_rates(:ncol,:, 494)*sol(:ncol,:, 180)*sol(:ncol,:, 116) ! rate_const*ISOPO2VBS*NO + rxt_rates(:ncol,:, 495) = rxt_rates(:ncol,:, 495)*sol(:ncol,:, 93)*sol(:ncol,:, 122) ! rate_const*ISOP*O3 + rxt_rates(:ncol,:, 496) = rxt_rates(:ncol,:, 496)*sol(:ncol,:, 93)*sol(:ncol,:, 190) ! rate_const*ISOP*OH + rxt_rates(:ncol,:, 497) = rxt_rates(:ncol,:, 497)*sol(:ncol,:, 181)*sol(:ncol,:, 176) ! rate_const*IVOCO2VBS*HO2 + rxt_rates(:ncol,:, 498) = rxt_rates(:ncol,:, 498)*sol(:ncol,:, 181)*sol(:ncol,:, 116) ! rate_const*IVOCO2VBS*NO + rxt_rates(:ncol,:, 499) = rxt_rates(:ncol,:, 499)*sol(:ncol,:, 99)*sol(:ncol,:, 190) ! rate_const*IVOC*OH + rxt_rates(:ncol,:, 500) = rxt_rates(:ncol,:, 500)*sol(:ncol,:, 105)*sol(:ncol,:, 118) ! rate_const*MTERP*NO3 + rxt_rates(:ncol,:, 501) = rxt_rates(:ncol,:, 501)*sol(:ncol,:, 187)*sol(:ncol,:, 176) ! rate_const*MTERPO2VBS*HO2 + rxt_rates(:ncol,:, 502) = rxt_rates(:ncol,:, 502)*sol(:ncol,:, 187)*sol(:ncol,:, 116) ! rate_const*MTERPO2VBS*NO + rxt_rates(:ncol,:, 503) = rxt_rates(:ncol,:, 503)*sol(:ncol,:, 105)*sol(:ncol,:, 122) ! rate_const*MTERP*O3 + rxt_rates(:ncol,:, 504) = rxt_rates(:ncol,:, 504)*sol(:ncol,:, 105)*sol(:ncol,:, 190) ! rate_const*MTERP*OH + rxt_rates(:ncol,:, 505) = rxt_rates(:ncol,:, 505)*sol(:ncol,:, 145)*sol(:ncol,:, 190) ! rate_const*SVOC*OH + rxt_rates(:ncol,:, 506) = rxt_rates(:ncol,:, 506)*sol(:ncol,:, 153)*sol(:ncol,:, 190) ! rate_const*TOLUENE*OH + rxt_rates(:ncol,:, 507) = rxt_rates(:ncol,:, 507)*sol(:ncol,:, 197)*sol(:ncol,:, 176) ! rate_const*TOLUO2VBS*HO2 + rxt_rates(:ncol,:, 508) = rxt_rates(:ncol,:, 508)*sol(:ncol,:, 197)*sol(:ncol,:, 116) ! rate_const*TOLUO2VBS*NO + rxt_rates(:ncol,:, 509) = rxt_rates(:ncol,:, 509)*sol(:ncol,:, 155)*sol(:ncol,:, 190) ! rate_const*XYLENES*OH + rxt_rates(:ncol,:, 510) = rxt_rates(:ncol,:, 510)*sol(:ncol,:, 200)*sol(:ncol,:, 176) ! rate_const*XYLEO2VBS*HO2 + rxt_rates(:ncol,:, 511) = rxt_rates(:ncol,:, 511)*sol(:ncol,:, 200)*sol(:ncol,:, 116) ! rate_const*XYLEO2VBS*NO + rxt_rates(:ncol,:, 512) = rxt_rates(:ncol,:, 512)*sol(:ncol,:, 109) ! rate_const*N2O5 + rxt_rates(:ncol,:, 513) = rxt_rates(:ncol,:, 513)*sol(:ncol,:, 87)*sol(:ncol,:, 80) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 514) = rxt_rates(:ncol,:, 514)*sol(:ncol,:, 18) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 515) = rxt_rates(:ncol,:, 515)*sol(:ncol,:, 109) ! rate_const*N2O5 + rxt_rates(:ncol,:, 516) = rxt_rates(:ncol,:, 516)*sol(:ncol,:, 58) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 517) = rxt_rates(:ncol,:, 517)*sol(:ncol,:, 18) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 518) = rxt_rates(:ncol,:, 518)*sol(:ncol,:, 58)*sol(:ncol,:, 80) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 519) = rxt_rates(:ncol,:, 519)*sol(:ncol,:, 87)*sol(:ncol,:, 80) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 520) = rxt_rates(:ncol,:, 520)*sol(:ncol,:, 86)*sol(:ncol,:, 80) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 521) = rxt_rates(:ncol,:, 521)*sol(:ncol,:, 58) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 522) = rxt_rates(:ncol,:, 522)*sol(:ncol,:, 18) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 523) = rxt_rates(:ncol,:, 523)*sol(:ncol,:, 58)*sol(:ncol,:, 80) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 524) = rxt_rates(:ncol,:, 524)*sol(:ncol,:, 87)*sol(:ncol,:, 80) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 525) = rxt_rates(:ncol,:, 525)*sol(:ncol,:, 86)*sol(:ncol,:, 80) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 526) = rxt_rates(:ncol,:, 526)*sol(:ncol,:, 109) ! rate_const*N2O5 + rxt_rates(:ncol,:, 527) = rxt_rates(:ncol,:, 527)*sol(:ncol,:, 58) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 528) = rxt_rates(:ncol,:, 528)*sol(:ncol,:, 58)*sol(:ncol,:, 80) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 529) = rxt_rates(:ncol,:, 529)*sol(:ncol,:, 66) ! rate_const*E90 + rxt_rates(:ncol,:, 530) = rxt_rates(:ncol,:, 530)*sol(:ncol,:, 115) ! rate_const*NH_50 + rxt_rates(:ncol,:, 531) = rxt_rates(:ncol,:, 531)*sol(:ncol,:, 114) ! rate_const*NH_5 + rxt_rates(:ncol,:, 532) = rxt_rates(:ncol,:, 532)*sol(:ncol,:, 144) ! rate_const*ST80_25 + end subroutine set_rates +end module mo_rxt_rates_conv diff --git a/src/chemistry/pp_trop_strat_noaero/mo_setrxt.F90 b/src/chemistry/pp_trop_strat_noaero/mo_setrxt.F90 new file mode 100644 index 0000000000..97ab3f40b2 --- /dev/null +++ b/src/chemistry/pp_trop_strat_noaero/mo_setrxt.F90 @@ -0,0 +1,696 @@ + + module mo_setrxt + + use shr_kind_mod, only : r8 => shr_kind_r8 + + private + public :: setrxt + public :: setrxt_hrates + + contains + + subroutine setrxt( rate, temp, m, ncol ) + + use ppgrid, only : pcols, pver + + + use chem_mods, only : rxntot + use mo_jpl, only : jpl + + implicit none + +!------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------- + integer, intent(in) :: ncol + real(r8), intent(in) :: temp(pcols,pver) + real(r8), intent(in) :: m(ncol*pver) + real(r8), intent(inout) :: rate(ncol*pver,max(1,rxntot)) + +!------------------------------------------------------- +! ... local variables +!------------------------------------------------------- + integer :: n + integer :: offset + real(r8) :: itemp(ncol*pver) + real(r8) :: exp_fac(ncol*pver) + real(r8) :: ko(ncol*pver) + real(r8) :: kinf(ncol*pver) + + rate(:,114) = 1.2e-10_r8 + rate(:,118) = 1.2e-10_r8 + rate(:,124) = 6.9e-12_r8 + rate(:,125) = 7.2e-11_r8 + rate(:,126) = 1.6e-12_r8 + rate(:,132) = 1.8e-12_r8 + rate(:,136) = 1.8e-12_r8 + rate(:,148) = 3.5e-12_r8 + rate(:,150) = 1e-11_r8 + rate(:,151) = 2.2e-11_r8 + rate(:,152) = 5e-11_r8 + rate(:,187) = 1.7e-13_r8 + rate(:,189) = 2.607e-10_r8 + rate(:,190) = 9.75e-11_r8 + rate(:,191) = 2.07e-10_r8 + rate(:,192) = 2.088e-10_r8 + rate(:,193) = 1.17e-10_r8 + rate(:,194) = 4.644e-11_r8 + rate(:,195) = 1.204e-10_r8 + rate(:,196) = 9.9e-11_r8 + rate(:,197) = 3.3e-12_r8 + rate(:,216) = 4.5e-11_r8 + rate(:,217) = 4.62e-10_r8 + rate(:,218) = 1.2e-10_r8 + rate(:,219) = 9e-11_r8 + rate(:,220) = 3e-11_r8 + rate(:,225) = 2.14e-11_r8 + rate(:,226) = 1.9e-10_r8 + rate(:,239) = 2.57e-10_r8 + rate(:,240) = 1.8e-10_r8 + rate(:,241) = 1.794e-10_r8 + rate(:,242) = 1.3e-10_r8 + rate(:,243) = 7.65e-11_r8 + rate(:,257) = 4e-13_r8 + rate(:,261) = 1.31e-10_r8 + rate(:,262) = 3.5e-11_r8 + rate(:,263) = 9e-12_r8 + rate(:,270) = 6.8e-14_r8 + rate(:,271) = 2e-13_r8 + rate(:,285) = 7e-13_r8 + rate(:,286) = 1e-12_r8 + rate(:,290) = 1e-14_r8 + rate(:,291) = 1e-11_r8 + rate(:,292) = 1.15e-11_r8 + rate(:,293) = 4e-14_r8 + rate(:,306) = 3e-12_r8 + rate(:,307) = 6.7e-13_r8 + rate(:,317) = 3.5e-13_r8 + rate(:,318) = 5.4e-11_r8 + rate(:,321) = 2e-12_r8 + rate(:,322) = 1.4e-11_r8 + rate(:,325) = 2.4e-12_r8 + rate(:,336) = 5e-12_r8 + rate(:,346) = 1.6e-12_r8 + rate(:,348) = 6.7e-12_r8 + rate(:,351) = 3.5e-12_r8 + rate(:,354) = 1.3e-11_r8 + rate(:,355) = 1.4e-11_r8 + rate(:,359) = 2.4e-12_r8 + rate(:,360) = 1.4e-11_r8 + rate(:,365) = 2.4e-12_r8 + rate(:,366) = 4e-11_r8 + rate(:,367) = 4e-11_r8 + rate(:,369) = 1.4e-11_r8 + rate(:,373) = 2.4e-12_r8 + rate(:,374) = 4e-11_r8 + rate(:,378) = 7e-11_r8 + rate(:,379) = 1e-10_r8 + rate(:,384) = 2.4e-12_r8 + rate(:,399) = 4.7e-11_r8 + rate(:,412) = 2.1e-12_r8 + rate(:,413) = 2.8e-13_r8 + rate(:,421) = 1.7e-11_r8 + rate(:,427) = 8.4e-11_r8 + rate(:,429) = 1.9e-11_r8 + rate(:,430) = 1.2e-14_r8 + rate(:,431) = 2e-10_r8 + rate(:,438) = 2.4e-12_r8 + rate(:,439) = 2e-11_r8 + rate(:,443) = 2.3e-11_r8 + rate(:,444) = 2e-11_r8 + rate(:,448) = 3.3e-11_r8 + rate(:,449) = 1e-12_r8 + rate(:,450) = 5.7e-11_r8 + rate(:,451) = 3.4e-11_r8 + rate(:,456) = 2.3e-12_r8 + rate(:,457) = 1.2e-11_r8 + rate(:,458) = 5.7e-11_r8 + rate(:,459) = 2.8e-11_r8 + rate(:,460) = 6.6e-11_r8 + rate(:,461) = 1.4e-11_r8 + rate(:,464) = 1.9e-12_r8 + rate(:,478) = 6.34e-08_r8 + rate(:,484) = 1.9e-11_r8 + rate(:,487) = 1.2e-14_r8 + rate(:,488) = 2e-10_r8 + rate(:,499) = 1.34e-11_r8 + rate(:,505) = 1.34e-11_r8 + rate(:,509) = 1.7e-11_r8 + rate(:,529) = 1.29e-07_r8 + rate(:,530) = 2.31e-07_r8 + rate(:,531) = 2.31e-06_r8 + rate(:,532) = 4.63e-07_r8 + + do n = 1,pver + offset = (n-1)*ncol + itemp(offset+1:offset+ncol) = 1._r8 / temp(:ncol,n) + end do + + rate(:,115) = 1.63e-10_r8 * exp( 60._r8 * itemp(:) ) + rate(:,116) = 2.15e-11_r8 * exp( 110._r8 * itemp(:) ) + rate(:,117) = 3.3e-11_r8 * exp( 55._r8 * itemp(:) ) + rate(:,119) = 8e-12_r8 * exp( -2060._r8 * itemp(:) ) + rate(:,122) = 1.6e-11_r8 * exp( -4570._r8 * itemp(:) ) + exp_fac(:) = exp( -2000._r8 * itemp(:) ) + rate(:,123) = 1.4e-12_r8 * exp_fac(:) + rate(:,375) = 1.05e-14_r8 * exp_fac(:) + rate(:,495) = 1.05e-14_r8 * exp_fac(:) + exp_fac(:) = exp( 200._r8 * itemp(:) ) + rate(:,128) = 3e-11_r8 * exp_fac(:) + rate(:,214) = 5.5e-12_r8 * exp_fac(:) + rate(:,253) = 3.8e-12_r8 * exp_fac(:) + rate(:,275) = 3.8e-12_r8 * exp_fac(:) + rate(:,302) = 3.8e-12_r8 * exp_fac(:) + rate(:,310) = 3.8e-12_r8 * exp_fac(:) + rate(:,314) = 3.8e-12_r8 * exp_fac(:) + rate(:,330) = 2.3e-11_r8 * exp_fac(:) + rate(:,340) = 3.8e-12_r8 * exp_fac(:) + rate(:,350) = 3.8e-12_r8 * exp_fac(:) + rate(:,377) = 1.52e-11_r8 * exp_fac(:) + rate(:,385) = 1.52e-12_r8 * exp_fac(:) + rate(:,391) = 3.8e-12_r8 * exp_fac(:) + rate(:,394) = 3.8e-12_r8 * exp_fac(:) + rate(:,398) = 3.8e-12_r8 * exp_fac(:) + rate(:,414) = 3.8e-12_r8 * exp_fac(:) + rate(:,418) = 3.8e-12_r8 * exp_fac(:) + rate(:,424) = 3.8e-12_r8 * exp_fac(:) + rate(:,428) = 3.8e-12_r8 * exp_fac(:) + rate(:,129) = 1e-14_r8 * exp( -490._r8 * itemp(:) ) + rate(:,130) = 1.4e-10_r8 * exp( -470._r8 * itemp(:) ) + rate(:,131) = 2.8e-12_r8 * exp( -1800._r8 * itemp(:) ) + exp_fac(:) = exp( 250._r8 * itemp(:) ) + rate(:,133) = 4.8e-11_r8 * exp_fac(:) + rate(:,212) = 1.7e-11_r8 * exp_fac(:) + exp_fac(:) = exp( 180._r8 * itemp(:) ) + rate(:,134) = 1.8e-11_r8 * exp_fac(:) + rate(:,288) = 4.2e-12_r8 * exp_fac(:) + rate(:,301) = 4.2e-12_r8 * exp_fac(:) + rate(:,309) = 4.2e-12_r8 * exp_fac(:) + rate(:,338) = 4.2e-12_r8 * exp_fac(:) + rate(:,358) = 4.4e-12_r8 * exp_fac(:) + rate(:,364) = 4.4e-12_r8 * exp_fac(:) + rate(:,437) = 4.2e-12_r8 * exp_fac(:) + rate(:,442) = 4.2e-12_r8 * exp_fac(:) + rate(:,447) = 4.2e-12_r8 * exp_fac(:) + rate(:,135) = 1.7e-12_r8 * exp( -940._r8 * itemp(:) ) + rate(:,139) = 1.3e-12_r8 * exp( 380._r8 * itemp(:) ) + rate(:,140) = 2.1e-11_r8 * exp( 100._r8 * itemp(:) ) + exp_fac(:) = exp( 220._r8 * itemp(:) ) + rate(:,141) = 2.9e-12_r8 * exp_fac(:) + rate(:,142) = 1.45e-12_r8 * exp_fac(:) + rate(:,143) = 1.45e-12_r8 * exp_fac(:) + rate(:,144) = 1.5e-11_r8 * exp( -3600._r8 * itemp(:) ) + rate(:,145) = 5.1e-12_r8 * exp( 210._r8 * itemp(:) ) + exp_fac(:) = exp( -2450._r8 * itemp(:) ) + rate(:,146) = 1.2e-13_r8 * exp_fac(:) + rate(:,172) = 3e-11_r8 * exp_fac(:) + rate(:,149) = 1.5e-11_r8 * exp( 170._r8 * itemp(:) ) + exp_fac(:) = exp( 270._r8 * itemp(:) ) + rate(:,153) = 3.3e-12_r8 * exp_fac(:) + rate(:,168) = 1.4e-11_r8 * exp_fac(:) + rate(:,182) = 7.4e-12_r8 * exp_fac(:) + rate(:,284) = 8.1e-12_r8 * exp_fac(:) + exp_fac(:) = exp( -1500._r8 * itemp(:) ) + rate(:,154) = 3e-12_r8 * exp_fac(:) + rate(:,213) = 5.8e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 20._r8 * itemp(:) ) + rate(:,156) = 7.26e-11_r8 * exp_fac(:) + rate(:,157) = 4.64e-11_r8 * exp_fac(:) + rate(:,164) = 8.1e-11_r8 * exp( -30._r8 * itemp(:) ) + rate(:,165) = 7.1e-12_r8 * exp( -1270._r8 * itemp(:) ) + rate(:,166) = 3.05e-11_r8 * exp( -2270._r8 * itemp(:) ) + rate(:,167) = 1.1e-11_r8 * exp( -980._r8 * itemp(:) ) + rate(:,169) = 3.6e-11_r8 * exp( -375._r8 * itemp(:) ) + rate(:,170) = 2.3e-11_r8 * exp( -200._r8 * itemp(:) ) + rate(:,171) = 3.3e-12_r8 * exp( -115._r8 * itemp(:) ) + rate(:,173) = 1e-12_r8 * exp( -1590._r8 * itemp(:) ) + rate(:,174) = 3.5e-13_r8 * exp( -1370._r8 * itemp(:) ) + exp_fac(:) = exp( 290._r8 * itemp(:) ) + rate(:,175) = 2.6e-12_r8 * exp_fac(:) + rate(:,176) = 6.4e-12_r8 * exp_fac(:) + rate(:,206) = 4.1e-13_r8 * exp_fac(:) + rate(:,387) = 7.5e-12_r8 * exp_fac(:) + rate(:,401) = 7.5e-12_r8 * exp_fac(:) + rate(:,404) = 7.5e-12_r8 * exp_fac(:) + rate(:,407) = 7.5e-12_r8 * exp_fac(:) + rate(:,177) = 6.5e-12_r8 * exp( 135._r8 * itemp(:) ) + exp_fac(:) = exp( -840._r8 * itemp(:) ) + rate(:,179) = 3.6e-12_r8 * exp_fac(:) + rate(:,228) = 2e-12_r8 * exp_fac(:) + rate(:,180) = 1.2e-12_r8 * exp( -330._r8 * itemp(:) ) + rate(:,181) = 2.8e-11_r8 * exp( 85._r8 * itemp(:) ) + exp_fac(:) = exp( 230._r8 * itemp(:) ) + rate(:,183) = 6e-13_r8 * exp_fac(:) + rate(:,203) = 1.5e-12_r8 * exp_fac(:) + rate(:,211) = 1.9e-11_r8 * exp_fac(:) + rate(:,184) = 1e-11_r8 * exp( -3300._r8 * itemp(:) ) + rate(:,185) = 1.8e-12_r8 * exp( -250._r8 * itemp(:) ) + rate(:,186) = 3.4e-12_r8 * exp( -130._r8 * itemp(:) ) + exp_fac(:) = exp( -500._r8 * itemp(:) ) + rate(:,188) = 3e-12_r8 * exp_fac(:) + rate(:,222) = 1.4e-10_r8 * exp_fac(:) + exp_fac(:) = exp( -800._r8 * itemp(:) ) + rate(:,200) = 1.7e-11_r8 * exp_fac(:) + rate(:,227) = 6.3e-12_r8 * exp_fac(:) + rate(:,201) = 4.8e-12_r8 * exp( -310._r8 * itemp(:) ) + rate(:,202) = 1.6e-11_r8 * exp( -780._r8 * itemp(:) ) + rate(:,204) = 9.5e-13_r8 * exp( 550._r8 * itemp(:) ) + exp_fac(:) = exp( 260._r8 * itemp(:) ) + rate(:,205) = 2.3e-12_r8 * exp_fac(:) + rate(:,208) = 8.8e-12_r8 * exp_fac(:) + rate(:,207) = 4.5e-12_r8 * exp( 460._r8 * itemp(:) ) + rate(:,210) = 1.9e-11_r8 * exp( 215._r8 * itemp(:) ) + rate(:,215) = 1.2e-10_r8 * exp( -430._r8 * itemp(:) ) + rate(:,221) = 1.6e-10_r8 * exp( -260._r8 * itemp(:) ) + exp_fac(:) = exp( 0._r8 * itemp(:) ) + rate(:,223) = 1.4e-11_r8 * exp_fac(:) + rate(:,225) = 2.14e-11_r8 * exp_fac(:) + rate(:,226) = 1.9e-10_r8 * exp_fac(:) + rate(:,239) = 2.57e-10_r8 * exp_fac(:) + rate(:,240) = 1.8e-10_r8 * exp_fac(:) + rate(:,241) = 1.794e-10_r8 * exp_fac(:) + rate(:,242) = 1.3e-10_r8 * exp_fac(:) + rate(:,243) = 7.65e-11_r8 * exp_fac(:) + rate(:,257) = 4e-13_r8 * exp_fac(:) + rate(:,261) = 1.31e-10_r8 * exp_fac(:) + rate(:,262) = 3.5e-11_r8 * exp_fac(:) + rate(:,263) = 9e-12_r8 * exp_fac(:) + rate(:,270) = 6.8e-14_r8 * exp_fac(:) + rate(:,271) = 2e-13_r8 * exp_fac(:) + rate(:,285) = 7e-13_r8 * exp_fac(:) + rate(:,286) = 1e-12_r8 * exp_fac(:) + rate(:,290) = 1e-14_r8 * exp_fac(:) + rate(:,291) = 1e-11_r8 * exp_fac(:) + rate(:,292) = 1.15e-11_r8 * exp_fac(:) + rate(:,293) = 4e-14_r8 * exp_fac(:) + rate(:,306) = 3e-12_r8 * exp_fac(:) + rate(:,307) = 6.7e-13_r8 * exp_fac(:) + rate(:,317) = 3.5e-13_r8 * exp_fac(:) + rate(:,318) = 5.4e-11_r8 * exp_fac(:) + rate(:,321) = 2e-12_r8 * exp_fac(:) + rate(:,322) = 1.4e-11_r8 * exp_fac(:) + rate(:,325) = 2.4e-12_r8 * exp_fac(:) + rate(:,336) = 5e-12_r8 * exp_fac(:) + rate(:,346) = 1.6e-12_r8 * exp_fac(:) + rate(:,348) = 6.7e-12_r8 * exp_fac(:) + rate(:,351) = 3.5e-12_r8 * exp_fac(:) + rate(:,354) = 1.3e-11_r8 * exp_fac(:) + rate(:,355) = 1.4e-11_r8 * exp_fac(:) + rate(:,359) = 2.4e-12_r8 * exp_fac(:) + rate(:,360) = 1.4e-11_r8 * exp_fac(:) + rate(:,365) = 2.4e-12_r8 * exp_fac(:) + rate(:,366) = 4e-11_r8 * exp_fac(:) + rate(:,367) = 4e-11_r8 * exp_fac(:) + rate(:,369) = 1.4e-11_r8 * exp_fac(:) + rate(:,373) = 2.4e-12_r8 * exp_fac(:) + rate(:,374) = 4e-11_r8 * exp_fac(:) + rate(:,378) = 7e-11_r8 * exp_fac(:) + rate(:,379) = 1e-10_r8 * exp_fac(:) + rate(:,384) = 2.4e-12_r8 * exp_fac(:) + rate(:,399) = 4.7e-11_r8 * exp_fac(:) + rate(:,412) = 2.1e-12_r8 * exp_fac(:) + rate(:,413) = 2.8e-13_r8 * exp_fac(:) + rate(:,421) = 1.7e-11_r8 * exp_fac(:) + rate(:,427) = 8.4e-11_r8 * exp_fac(:) + rate(:,429) = 1.9e-11_r8 * exp_fac(:) + rate(:,430) = 1.2e-14_r8 * exp_fac(:) + rate(:,431) = 2e-10_r8 * exp_fac(:) + rate(:,438) = 2.4e-12_r8 * exp_fac(:) + rate(:,439) = 2e-11_r8 * exp_fac(:) + rate(:,443) = 2.3e-11_r8 * exp_fac(:) + rate(:,444) = 2e-11_r8 * exp_fac(:) + rate(:,448) = 3.3e-11_r8 * exp_fac(:) + rate(:,449) = 1e-12_r8 * exp_fac(:) + rate(:,450) = 5.7e-11_r8 * exp_fac(:) + rate(:,451) = 3.4e-11_r8 * exp_fac(:) + rate(:,456) = 2.3e-12_r8 * exp_fac(:) + rate(:,457) = 1.2e-11_r8 * exp_fac(:) + rate(:,458) = 5.7e-11_r8 * exp_fac(:) + rate(:,459) = 2.8e-11_r8 * exp_fac(:) + rate(:,460) = 6.6e-11_r8 * exp_fac(:) + rate(:,461) = 1.4e-11_r8 * exp_fac(:) + rate(:,464) = 1.9e-12_r8 * exp_fac(:) + rate(:,478) = 6.34e-08_r8 * exp_fac(:) + rate(:,484) = 1.9e-11_r8 * exp_fac(:) + rate(:,487) = 1.2e-14_r8 * exp_fac(:) + rate(:,488) = 2e-10_r8 * exp_fac(:) + rate(:,499) = 1.34e-11_r8 * exp_fac(:) + rate(:,505) = 1.34e-11_r8 * exp_fac(:) + rate(:,509) = 1.7e-11_r8 * exp_fac(:) + rate(:,529) = 1.29e-07_r8 * exp_fac(:) + rate(:,530) = 2.31e-07_r8 * exp_fac(:) + rate(:,531) = 2.31e-06_r8 * exp_fac(:) + rate(:,532) = 4.63e-07_r8 * exp_fac(:) + exp_fac(:) = exp( 400._r8 * itemp(:) ) + rate(:,224) = 6e-12_r8 * exp_fac(:) + rate(:,323) = 5e-13_r8 * exp_fac(:) + rate(:,356) = 5e-13_r8 * exp_fac(:) + rate(:,361) = 5e-13_r8 * exp_fac(:) + rate(:,370) = 5e-13_r8 * exp_fac(:) + rate(:,381) = 5e-13_r8 * exp_fac(:) + rate(:,229) = 1.46e-11_r8 * exp( -1040._r8 * itemp(:) ) + rate(:,230) = 1.42e-12_r8 * exp( -1150._r8 * itemp(:) ) + exp_fac(:) = exp( -1520._r8 * itemp(:) ) + rate(:,231) = 1.64e-12_r8 * exp_fac(:) + rate(:,342) = 8.5e-16_r8 * exp_fac(:) + exp_fac(:) = exp( -1100._r8 * itemp(:) ) + rate(:,232) = 2.03e-11_r8 * exp_fac(:) + rate(:,463) = 3.4e-12_r8 * exp_fac(:) + rate(:,233) = 1.96e-12_r8 * exp( -1200._r8 * itemp(:) ) + rate(:,234) = 4.85e-12_r8 * exp( -850._r8 * itemp(:) ) + rate(:,235) = 9e-13_r8 * exp( -360._r8 * itemp(:) ) + exp_fac(:) = exp( -1600._r8 * itemp(:) ) + rate(:,236) = 1.25e-12_r8 * exp_fac(:) + rate(:,246) = 3.4e-11_r8 * exp_fac(:) + rate(:,237) = 1.3e-12_r8 * exp( -1770._r8 * itemp(:) ) + rate(:,238) = 9.2e-13_r8 * exp( -1560._r8 * itemp(:) ) + rate(:,244) = 9.7e-15_r8 * exp( 625._r8 * itemp(:) ) + rate(:,245) = 6e-13_r8 * exp( -2058._r8 * itemp(:) ) + rate(:,247) = 5.5e-12_r8 * exp( 125._r8 * itemp(:) ) + rate(:,248) = 5e-13_r8 * exp( -424._r8 * itemp(:) ) + rate(:,249) = 1.9e-14_r8 * exp( 706._r8 * itemp(:) ) + rate(:,250) = 4.1e-13_r8 * exp( 750._r8 * itemp(:) ) + exp_fac(:) = exp( 300._r8 * itemp(:) ) + rate(:,251) = 2.8e-12_r8 * exp_fac(:) + rate(:,313) = 2.9e-12_r8 * exp_fac(:) + rate(:,252) = 2.9e-12_r8 * exp( -345._r8 * itemp(:) ) + rate(:,254) = 2.45e-12_r8 * exp( -1775._r8 * itemp(:) ) + exp_fac(:) = exp( 700._r8 * itemp(:) ) + rate(:,258) = 7.5e-13_r8 * exp_fac(:) + rate(:,272) = 7.5e-13_r8 * exp_fac(:) + rate(:,287) = 7.5e-13_r8 * exp_fac(:) + rate(:,300) = 7.5e-13_r8 * exp_fac(:) + rate(:,308) = 7.5e-13_r8 * exp_fac(:) + rate(:,312) = 8.6e-13_r8 * exp_fac(:) + rate(:,324) = 8e-13_r8 * exp_fac(:) + rate(:,337) = 7.5e-13_r8 * exp_fac(:) + rate(:,347) = 7.5e-13_r8 * exp_fac(:) + rate(:,357) = 8e-13_r8 * exp_fac(:) + rate(:,362) = 8e-13_r8 * exp_fac(:) + rate(:,371) = 8e-13_r8 * exp_fac(:) + rate(:,382) = 8e-13_r8 * exp_fac(:) + rate(:,389) = 7.5e-13_r8 * exp_fac(:) + rate(:,393) = 7.5e-13_r8 * exp_fac(:) + rate(:,396) = 7.5e-13_r8 * exp_fac(:) + rate(:,409) = 7.5e-13_r8 * exp_fac(:) + rate(:,416) = 7.5e-13_r8 * exp_fac(:) + rate(:,422) = 7.5e-13_r8 * exp_fac(:) + rate(:,425) = 7.5e-13_r8 * exp_fac(:) + rate(:,436) = 7.5e-13_r8 * exp_fac(:) + rate(:,441) = 7.5e-13_r8 * exp_fac(:) + rate(:,446) = 7.5e-13_r8 * exp_fac(:) + rate(:,490) = 7.5e-13_r8 * exp_fac(:) + rate(:,497) = 7.5e-13_r8 * exp_fac(:) + rate(:,507) = 7.5e-13_r8 * exp_fac(:) + rate(:,510) = 7.5e-13_r8 * exp_fac(:) + rate(:,259) = 2.4e+12_r8 * exp( -7000._r8 * itemp(:) ) + rate(:,260) = 2.6e-12_r8 * exp( 265._r8 * itemp(:) ) + rate(:,264) = 1.08e-10_r8 * exp( 105._r8 * itemp(:) ) + rate(:,269) = 1.2e-14_r8 * exp( -2630._r8 * itemp(:) ) + exp_fac(:) = exp( 365._r8 * itemp(:) ) + rate(:,273) = 2.6e-12_r8 * exp_fac(:) + rate(:,390) = 2.6e-12_r8 * exp_fac(:) + rate(:,395) = 2.6e-12_r8 * exp_fac(:) + rate(:,397) = 2.6e-12_r8 * exp_fac(:) + rate(:,410) = 2.6e-12_r8 * exp_fac(:) + rate(:,417) = 2.6e-12_r8 * exp_fac(:) + rate(:,423) = 2.6e-12_r8 * exp_fac(:) + rate(:,426) = 2.6e-12_r8 * exp_fac(:) + rate(:,491) = 2.6e-12_r8 * exp_fac(:) + rate(:,498) = 2.6e-12_r8 * exp_fac(:) + rate(:,508) = 2.6e-12_r8 * exp_fac(:) + rate(:,511) = 2.6e-12_r8 * exp_fac(:) + rate(:,274) = 6.9e-12_r8 * exp( -230._r8 * itemp(:) ) + rate(:,276) = 7.2e-11_r8 * exp( -70._r8 * itemp(:) ) + rate(:,277) = 7.66e-12_r8 * exp( -1020._r8 * itemp(:) ) + exp_fac(:) = exp( -1900._r8 * itemp(:) ) + rate(:,278) = 1.4e-12_r8 * exp_fac(:) + rate(:,298) = 6.5e-15_r8 * exp_fac(:) + exp_fac(:) = exp( 350._r8 * itemp(:) ) + rate(:,279) = 4.63e-12_r8 * exp_fac(:) + rate(:,494) = 2.7e-12_r8 * exp_fac(:) + rate(:,280) = 7.8e-13_r8 * exp( -1050._r8 * itemp(:) ) + exp_fac(:) = exp( 500._r8 * itemp(:) ) + rate(:,281) = 2.9e-12_r8 * exp_fac(:) + rate(:,282) = 2e-12_r8 * exp_fac(:) + rate(:,311) = 7.1e-13_r8 * exp_fac(:) + rate(:,332) = 2e-12_r8 * exp_fac(:) + rate(:,435) = 2e-12_r8 * exp_fac(:) + rate(:,440) = 2e-12_r8 * exp_fac(:) + rate(:,445) = 2e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 1040._r8 * itemp(:) ) + rate(:,283) = 4.3e-13_r8 * exp_fac(:) + rate(:,333) = 4.3e-13_r8 * exp_fac(:) + rate(:,386) = 4.3e-13_r8 * exp_fac(:) + rate(:,400) = 4.3e-13_r8 * exp_fac(:) + rate(:,403) = 4.3e-13_r8 * exp_fac(:) + rate(:,406) = 4.3e-13_r8 * exp_fac(:) + rate(:,289) = 1.6e+11_r8 * exp( -4150._r8 * itemp(:) ) + rate(:,297) = 4.6e-13_r8 * exp( -1156._r8 * itemp(:) ) + rate(:,299) = 3.75e-13_r8 * exp( -40._r8 * itemp(:) ) + rate(:,303) = 8.7e-12_r8 * exp( -615._r8 * itemp(:) ) + rate(:,304) = 1.4e-12_r8 * exp( -1860._r8 * itemp(:) ) + rate(:,305) = 8.4e-13_r8 * exp( 830._r8 * itemp(:) ) + rate(:,319) = 4.8e-12_r8 * exp( 120._r8 * itemp(:) ) + rate(:,320) = 5.1e-14_r8 * exp( 693._r8 * itemp(:) ) + exp_fac(:) = exp( 360._r8 * itemp(:) ) + rate(:,326) = 2.7e-12_r8 * exp_fac(:) + rate(:,327) = 1.3e-13_r8 * exp_fac(:) + rate(:,329) = 9.6e-12_r8 * exp_fac(:) + rate(:,335) = 5.3e-12_r8 * exp_fac(:) + rate(:,372) = 2.7e-12_r8 * exp_fac(:) + rate(:,383) = 2.7e-12_r8 * exp_fac(:) + rate(:,486) = 2.7e-12_r8 * exp_fac(:) + rate(:,502) = 2.7e-12_r8 * exp_fac(:) + rate(:,328) = 1.5e-15_r8 * exp( -2100._r8 * itemp(:) ) + exp_fac(:) = exp( 530._r8 * itemp(:) ) + rate(:,331) = 4.6e-12_r8 * exp_fac(:) + rate(:,334) = 2.3e-12_r8 * exp_fac(:) + rate(:,339) = 2.3e-12_r8 * exp( -170._r8 * itemp(:) ) + rate(:,343) = 4.13e-12_r8 * exp( 452._r8 * itemp(:) ) + rate(:,349) = 5.4e-14_r8 * exp( 870._r8 * itemp(:) ) + exp_fac(:) = exp( 175._r8 * itemp(:) ) + rate(:,352) = 1.86e-11_r8 * exp_fac(:) + rate(:,353) = 1.86e-11_r8 * exp_fac(:) + rate(:,363) = 1.6e+09_r8 * exp( -8300._r8 * itemp(:) ) + exp_fac(:) = exp( -446._r8 * itemp(:) ) + rate(:,368) = 3.03e-12_r8 * exp_fac(:) + rate(:,492) = 3.03e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 410._r8 * itemp(:) ) + rate(:,376) = 2.54e-11_r8 * exp_fac(:) + rate(:,496) = 2.54e-11_r8 * exp_fac(:) + rate(:,380) = 1.3e-12_r8 * exp( 640._r8 * itemp(:) ) + exp_fac(:) = exp( -193._r8 * itemp(:) ) + rate(:,388) = 2.3e-12_r8 * exp_fac(:) + rate(:,489) = 2.3e-12_r8 * exp_fac(:) + rate(:,392) = 5.9e-12_r8 * exp( 225._r8 * itemp(:) ) + rate(:,411) = 4.7e-13_r8 * exp( 1220._r8 * itemp(:) ) + exp_fac(:) = exp( 352._r8 * itemp(:) ) + rate(:,419) = 1.7e-12_r8 * exp_fac(:) + rate(:,506) = 1.7e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 490._r8 * itemp(:) ) + rate(:,432) = 1.2e-12_r8 * exp_fac(:) + rate(:,500) = 1.2e-12_r8 * exp_fac(:) + exp_fac(:) = exp( -580._r8 * itemp(:) ) + rate(:,433) = 6.3e-16_r8 * exp_fac(:) + rate(:,503) = 6.3e-16_r8 * exp_fac(:) + exp_fac(:) = exp( 440._r8 * itemp(:) ) + rate(:,434) = 1.2e-11_r8 * exp_fac(:) + rate(:,504) = 1.2e-11_r8 * exp_fac(:) + rate(:,452) = 1.9e-13_r8 * exp( 520._r8 * itemp(:) ) + rate(:,453) = 9.6e-12_r8 * exp( -234._r8 * itemp(:) ) + rate(:,454) = 2.1e-11_r8 * exp( -2200._r8 * itemp(:) ) + rate(:,455) = 7.2e-14_r8 * exp( -1070._r8 * itemp(:) ) + rate(:,462) = 1.6e-13_r8 * exp( -2280._r8 * itemp(:) ) + rate(:,465) = 2.7e-11_r8 * exp( 335._r8 * itemp(:) ) + rate(:,469) = 1.7e-12_r8 * exp( -710._r8 * itemp(:) ) + exp_fac(:) = exp( 1300._r8 * itemp(:) ) + rate(:,485) = 2.75e-13_r8 * exp_fac(:) + rate(:,493) = 2.12e-13_r8 * exp_fac(:) + rate(:,501) = 2.6e-13_r8 * exp_fac(:) + + itemp(:) = 300._r8 * itemp(:) + + n = ncol*pver + + ko(:) = 4.4e-32_r8 * itemp(:)**1.3_r8 + kinf(:) = 7.5e-11_r8 * itemp(:)**(-0.2_r8) + call jpl( rate(:,127), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 6.9e-31_r8 * itemp(:)**1._r8 + kinf(:) = 2.6e-11_r8 + call jpl( rate(:,137), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 2.5e-31_r8 * itemp(:)**1.8_r8 + kinf(:) = 2.2e-11_r8 * itemp(:)**0.7_r8 + call jpl( rate(:,147), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 9e-32_r8 * itemp(:)**1.5_r8 + kinf(:) = 3e-11_r8 + call jpl( rate(:,155), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 1.9e-31_r8 * itemp(:)**3.4_r8 + kinf(:) = 4e-12_r8 * itemp(:)**0.3_r8 + call jpl( rate(:,158), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 2.4e-30_r8 * itemp(:)**3._r8 + kinf(:) = 1.6e-12_r8 * itemp(:)**(-0.1_r8) + call jpl( rate(:,159), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 1.8e-30_r8 * itemp(:)**3._r8 + kinf(:) = 2.8e-11_r8 + call jpl( rate(:,160), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 1.8e-31_r8 * itemp(:)**3.4_r8 + kinf(:) = 1.5e-11_r8 * itemp(:)**1.9_r8 + call jpl( rate(:,178), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 1.9e-32_r8 * itemp(:)**3.6_r8 + kinf(:) = 3.7e-12_r8 * itemp(:)**1.6_r8 + call jpl( rate(:,198), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 5.2e-31_r8 * itemp(:)**3.2_r8 + kinf(:) = 6.9e-12_r8 * itemp(:)**2.9_r8 + call jpl( rate(:,209), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 5.9e-33_r8 * itemp(:)**1._r8 + kinf(:) = 1.1e-12_r8 * itemp(:)**(-1.3_r8) + call jpl( rate(:,255), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 4.28e-33_r8 + kinf(:) = 9.3e-15_r8 * itemp(:)**(-4.42_r8) + call jpl( rate(:,256), m, 0.8_r8, ko, kinf, n ) + + ko(:) = 5.2e-30_r8 * itemp(:)**2.4_r8 + kinf(:) = 2.2e-10_r8 * itemp(:)**0.7_r8 + call jpl( rate(:,266), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 5.5e-30_r8 + kinf(:) = 8.3e-13_r8 * itemp(:)**(-2._r8) + call jpl( rate(:,267), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 1.6e-29_r8 * itemp(:)**3.3_r8 + kinf(:) = 3.1e-10_r8 * itemp(:) + call jpl( rate(:,268), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 8.6e-29_r8 * itemp(:)**3.1_r8 + kinf(:) = 9e-12_r8 * itemp(:)**0.85_r8 + call jpl( rate(:,294), m, 0.48_r8, ko, kinf, n ) + + ko(:) = 9.7e-29_r8 * itemp(:)**5.6_r8 + kinf(:) = 9.3e-12_r8 * itemp(:)**1.5_r8 + call jpl( rate(:,295), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 8e-27_r8 * itemp(:)**3.5_r8 + kinf(:) = 3e-11_r8 + call jpl( rate(:,315), m, 0.5_r8, ko, kinf, n ) + + ko(:) = 8e-27_r8 * itemp(:)**3.5_r8 + kinf(:) = 3e-11_r8 + call jpl( rate(:,341), m, 0.5_r8, ko, kinf, n ) + + ko(:) = 9.7e-29_r8 * itemp(:)**5.6_r8 + kinf(:) = 9.3e-12_r8 * itemp(:)**1.5_r8 + call jpl( rate(:,402), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 9.7e-29_r8 * itemp(:)**5.6_r8 + kinf(:) = 9.3e-12_r8 * itemp(:)**1.5_r8 + call jpl( rate(:,405), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 9.7e-29_r8 * itemp(:)**5.6_r8 + kinf(:) = 9.3e-12_r8 * itemp(:)**1.5_r8 + call jpl( rate(:,408), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 9.7e-29_r8 * itemp(:)**5.6_r8 + kinf(:) = 9.3e-12_r8 * itemp(:)**1.5_r8 + call jpl( rate(:,415), m, 0.6_r8, ko, kinf, n ) + + end subroutine setrxt + + + subroutine setrxt_hrates( rate, temp, m, ncol, kbot ) + + use ppgrid, only : pcols, pver + + + use chem_mods, only : rxntot + use mo_jpl, only : jpl + + implicit none + +!------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------- + integer, intent(in) :: ncol + integer, intent(in) :: kbot + real(r8), intent(in) :: temp(pcols,pver) + real(r8), intent(in) :: m(ncol*pver) + real(r8), intent(inout) :: rate(ncol*pver,max(1,rxntot)) + +!------------------------------------------------------- +! ... local variables +!------------------------------------------------------- + integer :: n + integer :: offset + integer :: k + real(r8) :: itemp(ncol*kbot) + real(r8) :: exp_fac(ncol*kbot) + real(r8) :: ko(ncol*kbot) + real(r8) :: kinf(ncol*kbot) + real(r8) :: wrk(ncol*kbot) + + n = ncol*kbot + + rate(:n,124) = 6.9e-12_r8 + + do k = 1,kbot + offset = (k-1)*ncol + itemp(offset+1:offset+ncol) = 1._r8 / temp(:ncol,k) + end do + + rate(:n,116) = 2.15e-11_r8 * exp( 110._r8 * itemp(:) ) + rate(:n,119) = 8e-12_r8 * exp( -2060._r8 * itemp(:) ) + rate(:n,128) = 3e-11_r8 * exp( 200._r8 * itemp(:) ) + rate(:n,129) = 1e-14_r8 * exp( -490._r8 * itemp(:) ) + rate(:n,130) = 1.4e-10_r8 * exp( -470._r8 * itemp(:) ) + rate(:n,133) = 4.8e-11_r8 * exp( 250._r8 * itemp(:) ) + rate(:n,134) = 1.8e-11_r8 * exp( 180._r8 * itemp(:) ) + rate(:n,135) = 1.7e-12_r8 * exp( -940._r8 * itemp(:) ) + rate(:n,140) = 2.1e-11_r8 * exp( 100._r8 * itemp(:) ) + rate(:n,144) = 1.5e-11_r8 * exp( -3600._r8 * itemp(:) ) + rate(:n,145) = 5.1e-12_r8 * exp( 210._r8 * itemp(:) ) + rate(:n,153) = 3.3e-12_r8 * exp( 270._r8 * itemp(:) ) + rate(:n,154) = 3e-12_r8 * exp( -1500._r8 * itemp(:) ) + + itemp(:) = 300._r8 * itemp(:) + + ko(:) = 4.4e-32_r8 * itemp(:)**1.3_r8 + kinf(:) = 7.5e-11_r8 * itemp(:)**(-0.2_r8) + call jpl( wrk, m, 0.6_r8, ko, kinf, n ) + rate(:n,127) = wrk(:) + + + + + + + + + + + + + + + + + + + + + + + + end subroutine setrxt_hrates + + end module mo_setrxt diff --git a/src/chemistry/pp_trop_strat_noaero/mo_sim_dat.F90 b/src/chemistry/pp_trop_strat_noaero/mo_sim_dat.F90 new file mode 100644 index 0000000000..16304e8155 --- /dev/null +++ b/src/chemistry/pp_trop_strat_noaero/mo_sim_dat.F90 @@ -0,0 +1,770 @@ + + module mo_sim_dat + + private + public :: set_sim_dat + + contains + + subroutine set_sim_dat + + use chem_mods, only : clscnt, cls_rxt_cnt, clsmap, permute, adv_mass, fix_mass, crb_mass + use chem_mods, only : diag_map + use chem_mods, only : phtcnt, rxt_tag_cnt, rxt_tag_lst, rxt_tag_map + use chem_mods, only : pht_alias_lst, pht_alias_mult + use chem_mods, only : extfrc_lst, inv_lst, slvd_lst + use chem_mods, only : enthalpy_cnt, cph_enthalpy, cph_rid, num_rnts, rxntot + use cam_abortutils,only : endrun + use mo_tracname, only : solsym + use chem_mods, only : frc_from_dataset + use chem_mods, only : is_scalar, is_vector + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_logfile, only : iulog + + implicit none + +!-------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------- + integer :: ios + + is_scalar = .false. + is_vector = .true. + + clscnt(:) = (/ 31, 0, 0, 171, 0 /) + + cls_rxt_cnt(:,1) = (/ 37, 61, 0, 31 /) + cls_rxt_cnt(:,4) = (/ 23, 164, 340, 171 /) + + solsym(:202) = (/ 'ALKNIT ','ALKOOH ','AOA_NH ','BCARY ','BENZENE ', & + 'BENZOOH ','BEPOMUC ','BIGALD ','BIGALD1 ','BIGALD2 ', & + 'BIGALD3 ','BIGALD4 ','BIGALK ','BIGENE ','BR ', & + 'BRCL ','BRO ','BRONO2 ','BRY ','BZALD ', & + 'BZOOH ','C2H2 ','C2H4 ','C2H5OH ','C2H5OOH ', & + 'C2H6 ','C3H6 ','C3H7OOH ','C3H8 ','C6H5OOH ', & + 'CCL4 ','CF2CLBR ','CF3BR ','CFC11 ','CFC113 ', & + 'CFC114 ','CFC115 ','CFC12 ','CH2BR2 ','CH2O ', & + 'CH3BR ','CH3CCL3 ','CH3CHO ','CH3CL ','CH3CN ', & + 'CH3COCH3 ','CH3COCHO ','CH3COOH ','CH3COOOH ','CH3OH ', & + 'CH3OOH ','CH4 ','CHBR3 ','CL ','CL2 ', & + 'CL2O2 ','CLO ','CLONO2 ','CLY ','CO ', & + 'CO2 ','COF2 ','COFCL ','CRESOL ','DMS ', & + 'E90 ','EOOH ','F ','GLYALD ','GLYOXAL ', & + 'H ','H2 ','H2402 ','H2O2 ','H2SO4 ', & + 'HBR ','HCFC141B ','HCFC142B ','HCFC22 ','HCL ', & + 'HCN ','HCOOH ','HF ','HNO3 ','HO2NO2 ', & + 'HOBR ','HOCL ','HONITR ','HPALD ','HYAC ', & + 'HYDRALD ','IEPOX ','ISOP ','ISOPNITA ','ISOPNITB ', & + 'ISOPNO3 ','ISOPNOOH ','ISOPOOH ','IVOC ','MACR ', & + 'MACROOH ','MEK ','MEKOOH ','MPAN ','MTERP ', & + 'MVK ','N ','N2O ','N2O5 ','NC4CH2OH ', & + 'NC4CHO ','NH3 ','NH4 ','NH_5 ','NH_50 ', & + 'NO ','NO2 ','NO3 ','NOA ','NTERPOOH ', & + 'O ','O3 ','O3S ','OCLO ','OCS ', & + 'ONITR ','PAN ','PBZNIT ','PHENO ','PHENOL ', & + 'PHENOOH ','POOH ','ROOH ','S ','SF6 ', & + 'SO ','SO2 ','SO3 ','SOAG0 ','SOAG1 ', & + 'SOAG2 ','SOAG3 ','SOAG4 ','ST80_25 ','SVOC ', & + 'TEPOMUC ','TERP2OOH ','TERPNIT ','TERPOOH ','TERPROD1 ', & + 'TERPROD2 ','TOLOOH ','TOLUENE ','XOOH ','XYLENES ', & + 'XYLENOOH ','XYLOL ','XYLOLOOH ','NHDEP ','NDEP ', & + 'ACBZO2 ','ALKO2 ','BCARYO2VBS ','BENZO2 ','BENZO2VBS ', & + 'BZOO ','C2H5O2 ','C3H7O2 ','C6H5O2 ','CH3CO3 ', & + 'CH3O2 ','DICARBO2 ','ENEO2 ','EO ','EO2 ', & + 'HO2 ','HOCH2OO ','ISOPAO2 ','ISOPBO2 ','ISOPO2VBS ', & + 'IVOCO2VBS ','MACRO2 ','MALO2 ','MCO3 ','MDIALO2 ', & + 'MEKO2 ','MTERPO2VBS ','NTERPO2 ','O1D ','OH ', & + 'PHENO2 ','PO2 ','RO2 ','TERP2O2 ','TERPO2 ', & + 'TOLO2 ','TOLUO2VBS ','XO2 ','XYLENO2 ','XYLEO2VBS ', & + 'XYLOLO2 ','H2O ' /) + + adv_mass(:202) = (/ 133.141340_r8, 104.142600_r8, 28.010400_r8, 204.342600_r8, 78.110400_r8, & + 160.122200_r8, 126.108600_r8, 98.098200_r8, 84.072400_r8, 98.098200_r8, & + 98.098200_r8, 112.124000_r8, 72.143800_r8, 56.103200_r8, 79.904000_r8, & + 115.356700_r8, 95.903400_r8, 141.908940_r8, 99.716850_r8, 106.120800_r8, & + 124.135000_r8, 26.036800_r8, 28.051600_r8, 46.065800_r8, 62.065200_r8, & + 30.066400_r8, 42.077400_r8, 76.091000_r8, 44.092200_r8, 110.109200_r8, & + 153.821800_r8, 165.364506_r8, 148.910210_r8, 137.367503_r8, 187.375310_r8, & + 170.921013_r8, 154.466716_r8, 120.913206_r8, 173.833800_r8, 30.025200_r8, & + 94.937200_r8, 133.402300_r8, 44.051000_r8, 50.485900_r8, 41.050940_r8, & + 58.076800_r8, 72.061400_r8, 60.050400_r8, 76.049800_r8, 32.040000_r8, & + 48.039400_r8, 16.040600_r8, 252.730400_r8, 35.452700_r8, 70.905400_r8, & + 102.904200_r8, 51.452100_r8, 97.457640_r8, 100.916850_r8, 28.010400_r8, & + 44.009800_r8, 66.007206_r8, 82.461503_r8, 108.135600_r8, 62.132400_r8, & + 28.010400_r8, 78.064600_r8, 18.998403_r8, 60.050400_r8, 58.035600_r8, & + 1.007400_r8, 2.014800_r8, 259.823613_r8, 34.013600_r8, 98.078400_r8, & + 80.911400_r8, 116.948003_r8, 100.493706_r8, 86.467906_r8, 36.460100_r8, & + 27.025140_r8, 46.024600_r8, 20.005803_r8, 63.012340_r8, 79.011740_r8, & + 96.910800_r8, 52.459500_r8, 135.114940_r8, 116.112400_r8, 74.076200_r8, & + 100.113000_r8, 118.127200_r8, 68.114200_r8, 147.125940_r8, 147.125940_r8, & + 162.117940_r8, 163.125340_r8, 118.127200_r8, 184.350200_r8, 70.087800_r8, & + 120.100800_r8, 72.102600_r8, 104.101400_r8, 147.084740_r8, 136.228400_r8, & + 70.087800_r8, 14.006740_r8, 44.012880_r8, 108.010480_r8, 147.125940_r8, & + 145.111140_r8, 17.028940_r8, 18.036340_r8, 28.010400_r8, 28.010400_r8, & + 30.006140_r8, 46.005540_r8, 62.004940_r8, 119.074340_r8, 231.239540_r8, & + 15.999400_r8, 47.998200_r8, 47.998200_r8, 67.451500_r8, 60.076400_r8, & + 133.100140_r8, 121.047940_r8, 183.117740_r8, 93.102400_r8, 94.109800_r8, & + 176.121600_r8, 92.090400_r8, 90.075600_r8, 32.066000_r8, 146.056419_r8, & + 48.065400_r8, 64.064800_r8, 80.064200_r8, 250.445000_r8, 250.445000_r8, & + 250.445000_r8, 250.445000_r8, 250.445000_r8, 28.010400_r8, 310.582400_r8, & + 140.134400_r8, 200.226000_r8, 215.240140_r8, 186.241400_r8, 168.227200_r8, & + 154.201400_r8, 174.148000_r8, 92.136200_r8, 150.126000_r8, 106.162000_r8, & + 188.173800_r8, 122.161400_r8, 204.173200_r8, 14.006740_r8, 14.006740_r8, & + 137.112200_r8, 103.135200_r8, 253.348200_r8, 159.114800_r8, 159.114800_r8, & + 123.127600_r8, 61.057800_r8, 75.083600_r8, 109.101800_r8, 75.042400_r8, & + 47.032000_r8, 129.089600_r8, 105.108800_r8, 61.057800_r8, 77.057200_r8, & + 33.006200_r8, 63.031400_r8, 117.119800_r8, 117.119800_r8, 117.119800_r8, & + 233.355800_r8, 119.093400_r8, 115.063800_r8, 101.079200_r8, 117.078600_r8, & + 103.094000_r8, 185.234000_r8, 230.232140_r8, 15.999400_r8, 17.006800_r8, & + 175.114200_r8, 91.083000_r8, 89.068200_r8, 199.218600_r8, 185.234000_r8, & + 173.140600_r8, 173.140600_r8, 149.118600_r8, 187.166400_r8, 187.166400_r8, & + 203.165800_r8, 18.014200_r8 /) + + crb_mass(:202) = (/ 60.055000_r8, 60.055000_r8, 12.011000_r8, 180.165000_r8, 72.066000_r8, & + 72.066000_r8, 72.066000_r8, 60.055000_r8, 48.044000_r8, 60.055000_r8, & + 60.055000_r8, 72.066000_r8, 60.055000_r8, 48.044000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 84.077000_r8, & + 84.077000_r8, 24.022000_r8, 24.022000_r8, 24.022000_r8, 24.022000_r8, & + 24.022000_r8, 36.033000_r8, 36.033000_r8, 36.033000_r8, 72.066000_r8, & + 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, 24.022000_r8, & + 24.022000_r8, 24.022000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 12.011000_r8, 24.022000_r8, 24.022000_r8, 12.011000_r8, 24.022000_r8, & + 36.033000_r8, 36.033000_r8, 24.022000_r8, 24.022000_r8, 12.011000_r8, & + 12.011000_r8, 12.011000_r8, 12.011000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 12.011000_r8, 12.011000_r8, & + 12.011000_r8, 12.011000_r8, 12.011000_r8, 84.077000_r8, 24.022000_r8, & + 12.011000_r8, 24.022000_r8, 0.000000_r8, 24.022000_r8, 24.022000_r8, & + 0.000000_r8, 0.000000_r8, 24.022000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 24.022000_r8, 24.022000_r8, 12.011000_r8, 0.000000_r8, & + 12.011000_r8, 12.011000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 48.044000_r8, 60.055000_r8, 36.033000_r8, & + 60.055000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, & + 60.055000_r8, 60.055000_r8, 60.055000_r8, 156.143000_r8, 48.044000_r8, & + 48.044000_r8, 48.044000_r8, 48.044000_r8, 48.044000_r8, 120.110000_r8, & + 48.044000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 60.055000_r8, & + 60.055000_r8, 0.000000_r8, 0.000000_r8, 12.011000_r8, 12.011000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 36.033000_r8, 120.110000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 12.011000_r8, & + 48.044000_r8, 24.022000_r8, 84.077000_r8, 72.066000_r8, 72.066000_r8, & + 72.066000_r8, 36.033000_r8, 36.033000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 180.165000_r8, 180.165000_r8, & + 180.165000_r8, 180.165000_r8, 180.165000_r8, 12.011000_r8, 264.242000_r8, & + 84.077000_r8, 120.110000_r8, 120.110000_r8, 120.110000_r8, 120.110000_r8, & + 108.099000_r8, 84.077000_r8, 84.077000_r8, 60.055000_r8, 96.088000_r8, & + 96.088000_r8, 96.088000_r8, 96.088000_r8, 0.000000_r8, 0.000000_r8, & + 84.077000_r8, 60.055000_r8, 180.165000_r8, 72.066000_r8, 72.066000_r8, & + 84.077000_r8, 24.022000_r8, 36.033000_r8, 72.066000_r8, 24.022000_r8, & + 12.011000_r8, 60.055000_r8, 48.044000_r8, 24.022000_r8, 24.022000_r8, & + 0.000000_r8, 12.011000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, & + 156.143000_r8, 48.044000_r8, 48.044000_r8, 48.044000_r8, 48.044000_r8, & + 48.044000_r8, 120.110000_r8, 120.110000_r8, 0.000000_r8, 0.000000_r8, & + 72.066000_r8, 36.033000_r8, 36.033000_r8, 120.110000_r8, 120.110000_r8, & + 84.077000_r8, 84.077000_r8, 60.055000_r8, 96.088000_r8, 96.088000_r8, & + 96.088000_r8, 0.000000_r8 /) + + fix_mass(: 3) = (/ 0.00000000_r8, 31.9988000_r8, 28.0134800_r8 /) + + clsmap(: 31,1) = (/ 3, 19, 31, 32, 33, 34, 35, 36, 37, 38, & + 39, 41, 42, 44, 52, 53, 59, 61, 66, 73, & + 77, 78, 79, 108, 114, 115, 123, 135, 144, 159, & + 160 /) + clsmap(:171,4) = (/ 1, 2, 4, 5, 6, 7, 8, 9, 10, 11, & + 12, 13, 14, 15, 16, 17, 18, 20, 21, 22, & + 23, 24, 25, 26, 27, 28, 29, 30, 40, 43, & + 45, 46, 47, 48, 49, 50, 51, 54, 55, 56, & + 57, 58, 60, 62, 63, 64, 65, 67, 68, 69, & + 70, 71, 72, 74, 75, 76, 80, 81, 82, 83, & + 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, & + 94, 95, 96, 97, 98, 99, 100, 101, 102, 103, & + 104, 105, 106, 107, 109, 110, 111, 112, 113, 116, & + 117, 118, 119, 120, 121, 122, 124, 125, 126, 127, & + 128, 129, 130, 131, 132, 133, 134, 136, 137, 138, & + 139, 140, 141, 142, 143, 145, 146, 147, 148, 149, & + 150, 151, 152, 153, 154, 155, 156, 157, 158, 161, & + 162, 163, 164, 165, 166, 167, 168, 169, 170, 171, & + 172, 173, 174, 175, 176, 177, 178, 179, 180, 181, & + 182, 183, 184, 185, 186, 187, 188, 189, 190, 191, & + 192, 193, 194, 195, 196, 197, 198, 199, 200, 201, & + 202 /) + + permute(:171,4) = (/ 101, 100, 124, 26, 70, 27, 71, 76, 51, 97, & + 59, 39, 61, 154, 42, 160, 86, 40, 58, 50, & + 90, 43, 53, 49, 129, 69, 19, 44, 161, 134, & + 16, 127, 146, 88, 84, 113, 67, 169, 25, 17, & + 164, 128, 135, 20, 29, 32, 47, 21, 111, 131, & + 122, 156, 143, 93, 22, 118, 168, 30, 115, 37, & + 155, 62, 112, 116, 136, 38, 137, 52, 23, 119, & + 94, 89, 144, 63, 107, 12, 145, 54, 83, 55, & + 92, 125, 149, 64, 48, 65, 132, 18, 1, 165, & + 167, 170, 121, 66, 162, 166, 56, 60, 41, 77, & + 24, 78, 28, 57, 87, 68, 82, 147, 120, 45, & + 2, 3, 4, 5, 6, 7, 33, 95, 98, 79, & + 130, 133, 96, 31, 34, 35, 103, 36, 72, 85, & + 126, 8, 80, 9, 73, 117, 114, 99, 153, 157, & + 109, 91, 46, 104, 163, 74, 151, 148, 10, 11, & + 150, 105, 152, 123, 102, 13, 140, 158, 159, 75, & + 110, 141, 139, 138, 106, 14, 142, 108, 15, 81, & + 171 /) + + diag_map(:171) = (/ 1, 2, 3, 4, 5, 6, 12, 18, 24, 30, & + 36, 38, 44, 50, 56, 57, 60, 63, 66, 70, & + 73, 76, 79, 82, 85, 88, 94, 98, 103, 107, & + 112, 119, 124, 128, 133, 141, 146, 149, 154, 157, & + 160, 163, 166, 170, 175, 179, 183, 189, 195, 201, & + 207, 210, 213, 218, 223, 228, 233, 239, 244, 249, & + 257, 265, 271, 277, 283, 289, 295, 301, 307, 313, & + 319, 325, 333, 339, 346, 352, 355, 362, 366, 375, & + 383, 390, 396, 401, 408, 414, 422, 430, 434, 442, & + 450, 458, 466, 473, 482, 493, 502, 506, 514, 521, & + 532, 543, 554, 567, 574, 585, 596, 609, 620, 629, & + 639, 648, 656, 661, 671, 676, 686, 694, 706, 723, & + 729, 736, 741, 759, 786, 808, 818, 826, 840, 855, & + 864, 873, 885, 894, 903, 912, 925, 938, 960, 979, & + 995,1011,1024,1044,1060,1072,1083,1113,1135,1157, & + 1183,1202,1233,1247,1260,1273,1320,1344,1499,1524, & + 1548,1579,1686,1713,1804,1865,1907,1931,1966,2024, & + 2050 /) + + extfrc_lst(: 6) = (/ 'CO ','NO ','NO2 ','SO2 ','AOA_NH ', & + 'N ' /) + + frc_from_dataset(: 6) = (/ .true., .true., .true., .true., .false., & + .false. /) + + inv_lst(: 3) = (/ 'M ', 'O2 ', 'N2 ' /) + + slvd_lst(: 41) = (/ 'ACBZO2 ', 'ALKO2 ', 'BCARYO2VBS ', 'BENZO2 ', 'BENZO2VBS ', & + 'BZOO ', 'C2H5O2 ', 'C3H7O2 ', 'C6H5O2 ', 'CH3CO3 ', & + 'CH3O2 ', 'DICARBO2 ', 'ENEO2 ', 'EO ', 'EO2 ', & + 'HO2 ', 'HOCH2OO ', 'ISOPAO2 ', 'ISOPBO2 ', 'ISOPO2VBS ', & + 'IVOCO2VBS ', 'MACRO2 ', 'MALO2 ', 'MCO3 ', 'MDIALO2 ', & + 'MEKO2 ', 'MTERPO2VBS ', 'NTERPO2 ', 'O1D ', 'OH ', & + 'PHENO2 ', 'PO2 ', 'RO2 ', 'TERP2O2 ', 'TERPO2 ', & + 'TOLO2 ', 'TOLUO2VBS ', 'XO2 ', 'XYLENO2 ', 'XYLEO2VBS ', & + 'XYLOLO2 ' /) + + if( allocated( rxt_tag_lst ) ) then + deallocate( rxt_tag_lst ) + end if + allocate( rxt_tag_lst(rxt_tag_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate rxt_tag_lst; error = ',ios + call endrun + end if + if( allocated( rxt_tag_map ) ) then + deallocate( rxt_tag_map ) + end if + allocate( rxt_tag_map(rxt_tag_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate rxt_tag_map; error = ',ios + call endrun + end if + rxt_tag_lst( 1: 200) = (/ 'jh2o_b ', 'jh2o_a ', & + 'jh2o_c ', 'jh2o2 ', & + 'jo2_a ', 'jo2_b ', & + 'jo3_a ', 'jo3_b ', & + 'jhno3 ', 'jho2no2_a ', & + 'jho2no2_b ', 'jn2o ', & + 'jn2o5_a ', 'jn2o5_b ', & + 'jno ', 'jno2 ', & + 'jno3_b ', 'jno3_a ', & + 'jalknit ', 'jalkooh ', & + 'jbenzooh ', 'jbepomuc ', & + 'jbigald ', 'jbigald1 ', & + 'jbigald2 ', 'jbigald3 ', & + 'jbigald4 ', 'jbzooh ', & + 'jc2h5ooh ', 'jc3h7ooh ', & + 'jc6h5ooh ', 'jch2o_a ', & + 'jch2o_b ', 'jch3cho ', & + 'jacet ', 'jmgly ', & + 'jch3co3h ', 'jch3ooh ', & + 'jch4_a ', 'jch4_b ', & + 'jco2 ', 'jeooh ', & + 'jglyald ', 'jglyoxal ', & + 'jhonitr ', 'jhpald ', & + 'jhyac ', 'jisopnooh ', & + 'jisopooh ', 'jmacr_a ', & + 'jmacr_b ', 'jmek ', & + 'jmekooh ', 'jmpan ', & + 'jmvk ', 'jnc4cho ', & + 'jnoa ', 'jnterpooh ', & + 'jonitr ', 'jpan ', & + 'jphenooh ', 'jpooh ', & + 'jrooh ', 'jtepomuc ', & + 'jterp2ooh ', 'jterpnit ', & + 'jterpooh ', 'jterprd1 ', & + 'jterprd2 ', 'jtolooh ', & + 'jxooh ', 'jxylenooh ', & + 'jxylolooh ', 'jbrcl ', & + 'jbro ', 'jbrono2_b ', & + 'jbrono2_a ', 'jccl4 ', & + 'jcf2clbr ', 'jcf3br ', & + 'jcfcl3 ', 'jcfc113 ', & + 'jcfc114 ', 'jcfc115 ', & + 'jcf2cl2 ', 'jch2br2 ', & + 'jch3br ', 'jch3ccl3 ', & + 'jch3cl ', 'jchbr3 ', & + 'jcl2 ', 'jcl2o2 ', & + 'jclo ', 'jclono2_a ', & + 'jclono2_b ', 'jcof2 ', & + 'jcofcl ', 'jh2402 ', & + 'jhbr ', 'jhcfc141b ', & + 'jhcfc142b ', 'jhcfc22 ', & + 'jhcl ', 'jhf ', & + 'jhobr ', 'jhocl ', & + 'joclo ', 'jsf6 ', & + 'jh2so4 ', 'jocs ', & + 'jso ', 'jso2 ', & + 'jso3 ', 'O1D_H2 ', & + 'O1D_H2O ', 'O1D_N2 ', & + 'O1D_O2ab ', 'O1D_O3 ', & + 'O_O3 ', 'usr_O_O ', & + 'usr_O_O2 ', 'H2_O ', & + 'H2O2_O ', 'H_HO2 ', & + 'H_HO2a ', 'H_HO2b ', & + 'H_O2 ', 'HO2_O ', & + 'HO2_O3 ', 'H_O3 ', & + 'OH_H2 ', 'OH_H2O2 ', & + 'OH_HO2 ', 'OH_O ', & + 'OH_O3 ', 'OH_OH ', & + 'OH_OH_M ', 'usr_HO2_HO2 ', & + 'HO2NO2_OH ', 'N_NO ', & + 'N_NO2a ', 'N_NO2b ', & + 'N_NO2c ', 'N_O2 ', & + 'NO2_O ', 'NO2_O3 ', & + 'NO2_O_M ', 'NO3_HO2 ', & + 'NO3_NO ', 'NO3_O ', & + 'NO3_OH ', 'N_OH ', & + 'NO_HO2 ', 'NO_O3 ', & + 'NO_O_M ', 'O1D_N2Oa ', & + 'O1D_N2Ob ', 'tag_NO2_HO2 ', & + 'tag_NO2_NO3 ', 'tag_NO2_OH ', & + 'usr_HNO3_OH ', 'usr_HO2NO2_M ', & + 'usr_N2O5_M ', 'CL_CH2O ', & + 'CL_CH4 ', 'CL_H2 ', & + 'CL_H2O2 ', 'CL_HO2a ', & + 'CL_HO2b ', 'CL_O3 ', & + 'CLO_CH3O2 ', 'CLO_CLOa ', & + 'CLO_CLOb ', 'CLO_CLOc ', & + 'CLO_HO2 ', 'CLO_NO ', & + 'CLONO2_CL ', 'CLO_NO2_M ', & + 'CLONO2_O ', 'CLONO2_OH ', & + 'CLO_O ', 'CLO_OHa ', & + 'CLO_OHb ', 'HCL_O ', & + 'HCL_OH ', 'HOCL_CL ', & + 'HOCL_O ', 'HOCL_OH ', & + 'O1D_CCL4 ', 'O1D_CF2CLBR ', & + 'O1D_CFC11 ', 'O1D_CFC113 ', & + 'O1D_CFC114 ', 'O1D_CFC115 ', & + 'O1D_CFC12 ', 'O1D_HCLa ', & + 'O1D_HCLb ', 'tag_CLO_CLO_M ', & + 'usr_CL2O2_M ', 'BR_CH2O ' /) + rxt_tag_lst( 201: 400) = (/ 'BR_HO2 ', 'BR_O3 ', & + 'BRO_BRO ', 'BRO_CLOa ', & + 'BRO_CLOb ', 'BRO_CLOc ', & + 'BRO_HO2 ', 'BRO_NO ', & + 'BRO_NO2_M ', 'BRONO2_O ', & + 'BRO_O ', 'BRO_OH ', & + 'HBR_O ', 'HBR_OH ', & + 'HOBR_O ', 'O1D_CF3BR ', & + 'O1D_CHBR3 ', 'O1D_H2402 ', & + 'O1D_HBRa ', 'O1D_HBRb ', & + 'F_CH4 ', 'F_H2 ', & + 'F_H2O ', 'F_HNO3 ', & + 'O1D_COF2 ', 'O1D_COFCL ', & + 'CH2BR2_CL ', 'CH2BR2_OH ', & + 'CH3BR_CL ', 'CH3BR_OH ', & + 'CH3CCL3_OH ', 'CH3CL_CL ', & + 'CH3CL_OH ', 'CHBR3_CL ', & + 'CHBR3_OH ', 'HCFC141B_OH ', & + 'HCFC142B_OH ', 'HCFC22_OH ', & + 'O1D_CH2BR2 ', 'O1D_CH3BR ', & + 'O1D_HCFC141B ', 'O1D_HCFC142B ', & + 'O1D_HCFC22 ', 'CH2O_HO2 ', & + 'CH2O_NO3 ', 'CH2O_O ', & + 'CH2O_OH ', 'CH3O2_CH3O2a ', & + 'CH3O2_CH3O2b ', 'CH3O2_HO2 ', & + 'CH3O2_NO ', 'CH3OH_OH ', & + 'CH3OOH_OH ', 'CH4_OH ', & + 'CO_OH_M ', 'HCN_OH ', & + 'HCOOH_OH ', 'HOCH2OO_HO2 ', & + 'HOCH2OO_M ', 'HOCH2OO_NO ', & + 'O1D_CH4a ', 'O1D_CH4b ', & + 'O1D_CH4c ', 'O1D_HCN ', & + 'usr_CO_OH_b ', 'C2H2_CL_M ', & + 'C2H2_OH_M ', 'C2H4_CL_M ', & + 'C2H4_O3 ', 'C2H5O2_C2H5O2 ', & + 'C2H5O2_CH3O2 ', 'C2H5O2_HO2 ', & + 'C2H5O2_NO ', 'C2H5OH_OH ', & + 'C2H5OOH_OH ', 'C2H6_CL ', & + 'C2H6_OH ', 'CH3CHO_NO3 ', & + 'CH3CHO_OH ', 'CH3CN_OH ', & + 'CH3CO3_CH3CO3 ', 'CH3CO3_CH3O2 ', & + 'CH3CO3_HO2 ', 'CH3CO3_NO ', & + 'CH3COOH_OH ', 'CH3COOOH_OH ', & + 'EO2_HO2 ', 'EO2_NO ', & + 'EO_M ', 'EO_O2 ', & + 'GLYALD_OH ', 'GLYOXAL_OH ', & + 'PAN_OH ', 'tag_C2H4_OH ', & + 'tag_CH3CO3_NO2 ', 'usr_PAN_M ', & + 'C3H6_NO3 ', 'C3H6_O3 ', & + 'C3H7O2_CH3O2 ', 'C3H7O2_HO2 ', & + 'C3H7O2_NO ', 'C3H7OOH_OH ', & + 'C3H8_OH ', 'CH3COCHO_NO3 ', & + 'CH3COCHO_OH ', 'HYAC_OH ', & + 'NOA_OH ', 'PO2_HO2 ', & + 'PO2_NO ', 'POOH_OH ', & + 'RO2_CH3O2 ', 'RO2_HO2 ', & + 'RO2_NO ', 'ROOH_OH ', & + 'tag_C3H6_OH ', 'usr_CH3COCH3_OH ', & + 'BIGENE_NO3 ', 'BIGENE_OH ', & + 'ENEO2_NO ', 'ENEO2_NOb ', & + 'HONITR_OH ', 'MACRO2_CH3CO3 ', & + 'MACRO2_CH3O2 ', 'MACRO2_HO2 ', & + 'MACRO2_NO3 ', 'MACRO2_NOa ', & + 'MACRO2_NOb ', 'MACR_O3 ', & + 'MACR_OH ', 'MACROOH_OH ', & + 'MCO3_CH3CO3 ', 'MCO3_CH3O2 ', & + 'MCO3_HO2 ', 'MCO3_MCO3 ', & + 'MCO3_NO ', 'MCO3_NO3 ', & + 'MEKO2_HO2 ', 'MEKO2_NO ', & + 'MEK_OH ', 'MEKOOH_OH ', & + 'MPAN_OH_M ', 'MVK_O3 ', & + 'MVK_OH ', 'usr_MCO3_NO2 ', & + 'usr_MPAN_M ', 'ALKNIT_OH ', & + 'ALKO2_HO2 ', 'ALKO2_NO ', & + 'ALKO2_NOb ', 'ALKOOH_OH ', & + 'BIGALK_OH ', 'HPALD_OH ', & + 'HYDRALD_OH ', 'IEPOX_OH ', & + 'ISOPAO2_CH3CO3 ', 'ISOPAO2_CH3O2 ', & + 'ISOPAO2_HO2 ', 'ISOPAO2_NO ', & + 'ISOPAO2_NO3 ', 'ISOPBO2_CH3CO3 ', & + 'ISOPBO2_CH3O2 ', 'ISOPBO2_HO2 ', & + 'ISOPBO2_M ', 'ISOPBO2_NO ', & + 'ISOPBO2_NO3 ', 'ISOPNITA_OH ', & + 'ISOPNITB_OH ', 'ISOP_NO3 ', & + 'ISOPNO3_CH3CO3 ', 'ISOPNO3_CH3O2 ', & + 'ISOPNO3_HO2 ', 'ISOPNO3_NO ', & + 'ISOPNO3_NO3 ', 'ISOPNOOH_OH ', & + 'ISOP_O3 ', 'ISOP_OH ', & + 'ISOPOOH_OH ', 'NC4CH2OH_OH ', & + 'NC4CHO_OH ', 'XO2_CH3CO3 ', & + 'XO2_CH3O2 ', 'XO2_HO2 ', & + 'XO2_NO ', 'XO2_NO3 ', & + 'XOOH_OH ', 'ACBZO2_HO2 ', & + 'ACBZO2_NO ', 'BENZENE_OH ', & + 'BENZO2_HO2 ', 'BENZO2_NO ', & + 'BENZOOH_OH ', 'BZALD_OH ', & + 'BZOO_HO2 ', 'BZOOH_OH ', & + 'BZOO_NO ', 'C6H5O2_HO2 ', & + 'C6H5O2_NO ', 'C6H5OOH_OH ', & + 'CRESOL_OH ', 'DICARBO2_HO2 ' /) + rxt_tag_lst( 401: 532) = (/ 'DICARBO2_NO ', 'DICARBO2_NO2 ', & + 'MALO2_HO2 ', 'MALO2_NO ', & + 'MALO2_NO2 ', 'MDIALO2_HO2 ', & + 'MDIALO2_NO ', 'MDIALO2_NO2 ', & + 'PHENO2_HO2 ', 'PHENO2_NO ', & + 'PHENOL_OH ', 'PHENO_NO2 ', & + 'PHENO_O3 ', 'PHENOOH_OH ', & + 'tag_ACBZO2_NO2 ', 'TOLO2_HO2 ', & + 'TOLO2_NO ', 'TOLOOH_OH ', & + 'TOLUENE_OH ', 'usr_PBZNIT_M ', & + 'XYLENES_OH ', 'XYLENO2_HO2 ', & + 'XYLENO2_NO ', 'XYLENOOH_OH ', & + 'XYLOLO2_HO2 ', 'XYLOLO2_NO ', & + 'XYLOL_OH ', 'XYLOLOOH_OH ', & + 'BCARY_NO3 ', 'BCARY_O3 ', & + 'BCARY_OH ', 'MTERP_NO3 ', & + 'MTERP_O3 ', 'MTERP_OH ', & + 'NTERPO2_CH3O2 ', 'NTERPO2_HO2 ', & + 'NTERPO2_NO ', 'NTERPO2_NO3 ', & + 'NTERPOOH_OH ', 'TERP2O2_CH3O2 ', & + 'TERP2O2_HO2 ', 'TERP2O2_NO ', & + 'TERP2OOH_OH ', 'TERPNIT_OH ', & + 'TERPO2_CH3O2 ', 'TERPO2_HO2 ', & + 'TERPO2_NO ', 'TERPOOH_OH ', & + 'TERPROD1_NO3 ', 'TERPROD1_OH ', & + 'TERPROD2_OH ', 'DMS_NO3 ', & + 'DMS_OHa ', 'OCS_O ', & + 'OCS_OH ', 'S_O2 ', & + 'S_O3 ', 'SO_BRO ', & + 'SO_CLO ', 'S_OH ', & + 'SO_NO2 ', 'SO_O2 ', & + 'SO_O3 ', 'SO_OCLO ', & + 'SO_OH ', 'usr_DMS_OH ', & + 'usr_SO2_OH ', 'usr_SO3_H2O ', & + 'NH3_OH ', 'usr_GLYOXAL_aer ', & + 'usr_HO2_aer ', 'usr_HONITR_aer ', & + 'usr_ISOPNITA_aer ', 'usr_ISOPNITB_aer ', & + 'usr_N2O5_aer ', 'usr_NC4CH2OH_aer ', & + 'usr_NC4CHO_aer ', 'usr_NH4_strat_tau ', & + 'usr_NO2_aer ', 'usr_NO3_aer ', & + 'usr_NTERPOOH_aer ', 'usr_ONITR_aer ', & + 'usr_TERPNIT_aer ', 'BCARY_NO3_vbs ', & + 'BCARYO2_HO2_vbs ', 'BCARYO2_NO_vbs ', & + 'BCARY_O3_vbs ', 'BCARY_OH_vbs ', & + 'BENZENE_OH_vbs ', 'BENZO2_HO2_vbs ', & + 'BENZO2_NO_vbs ', 'ISOP_NO3_vbs ', & + 'ISOPO2_HO2_vbs ', 'ISOPO2_NO_vbs ', & + 'ISOP_O3_vbs ', 'ISOP_OH_vbs ', & + 'IVOCO2_HO2_vbs ', 'IVOCO2_NO_vbs ', & + 'IVOC_OH_vbs ', 'MTERP_NO3_vbs ', & + 'MTERPO2_HO2_vbs ', 'MTERPO2_NO_vbs ', & + 'MTERP_O3_vbs ', 'MTERP_OH_vbs ', & + 'SVOC_OH ', 'TOLUENE_OH_vbs ', & + 'TOLUO2_HO2_vbs ', 'TOLUO2_NO_vbs ', & + 'XYLENES_OH_vbs ', 'XYLEO2_HO2_vbs ', & + 'XYLEO2_NO_vbs ', 'het1 ', & + 'het10 ', 'het11 ', & + 'het12 ', 'het13 ', & + 'het14 ', 'het15 ', & + 'het16 ', 'het17 ', & + 'het2 ', 'het3 ', & + 'het4 ', 'het5 ', & + 'het6 ', 'het7 ', & + 'het8 ', 'het9 ', & + 'E90_tau ', 'NH_50_tau ', & + 'NH_5_tau ', 'ST80_25_tau ' /) + rxt_tag_map(:rxt_tag_cnt) = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, & + 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, & + 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, & + 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, & + 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, & + 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, & + 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, & + 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, & + 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, & + 91, 92, 93, 94, 95, 96, 97, 98, 99, 100, & + 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, & + 111, 112, 113, 114, 115, 116, 117, 118, 119, 120, & + 121, 122, 123, 124, 125, 126, 127, 128, 129, 130, & + 131, 132, 133, 134, 135, 136, 137, 138, 139, 140, & + 141, 142, 143, 144, 145, 146, 147, 148, 149, 150, & + 151, 152, 153, 154, 155, 156, 157, 158, 159, 160, & + 161, 162, 163, 164, 165, 166, 167, 168, 169, 170, & + 171, 172, 173, 174, 175, 176, 177, 178, 179, 180, & + 181, 182, 183, 184, 185, 186, 187, 188, 189, 190, & + 191, 192, 193, 194, 195, 196, 197, 198, 199, 200, & + 201, 202, 203, 204, 205, 206, 207, 208, 209, 210, & + 211, 212, 213, 214, 215, 216, 217, 218, 219, 220, & + 221, 222, 223, 224, 225, 226, 227, 228, 229, 230, & + 231, 232, 233, 234, 235, 236, 237, 238, 239, 240, & + 241, 242, 243, 244, 245, 246, 247, 248, 249, 250, & + 251, 252, 253, 254, 255, 256, 257, 258, 259, 260, & + 261, 262, 263, 264, 265, 266, 267, 268, 269, 270, & + 271, 272, 273, 274, 275, 276, 277, 278, 279, 280, & + 281, 282, 283, 284, 285, 286, 287, 288, 289, 290, & + 291, 292, 293, 294, 295, 296, 297, 298, 299, 300, & + 301, 302, 303, 304, 305, 306, 307, 308, 309, 310, & + 311, 312, 313, 314, 315, 316, 317, 318, 319, 320, & + 321, 322, 323, 324, 325, 326, 327, 328, 329, 330, & + 331, 332, 333, 334, 335, 336, 337, 338, 339, 340, & + 341, 342, 343, 344, 345, 346, 347, 348, 349, 350, & + 351, 352, 353, 354, 355, 356, 357, 358, 359, 360, & + 361, 362, 363, 364, 365, 366, 367, 368, 369, 370, & + 371, 372, 373, 374, 375, 376, 377, 378, 379, 380, & + 381, 382, 383, 384, 385, 386, 387, 388, 389, 390, & + 391, 392, 393, 394, 395, 396, 397, 398, 399, 400, & + 401, 402, 403, 404, 405, 406, 407, 408, 409, 410, & + 411, 412, 413, 414, 415, 416, 417, 418, 419, 420, & + 421, 422, 423, 424, 425, 426, 427, 428, 429, 430, & + 431, 432, 433, 434, 435, 436, 437, 438, 439, 440, & + 441, 442, 443, 444, 445, 446, 447, 448, 449, 450, & + 451, 452, 453, 454, 455, 456, 457, 458, 459, 460, & + 461, 462, 463, 464, 465, 466, 467, 468, 469, 470, & + 471, 472, 473, 474, 475, 476, 477, 478, 479, 480, & + 481, 482, 483, 484, 485, 486, 487, 488, 489, 490, & + 491, 492, 493, 494, 495, 496, 497, 498, 499, 500, & + 501, 502, 503, 504, 505, 506, 507, 508, 509, 510, & + 511, 512, 513, 514, 515, 516, 517, 518, 519, 520, & + 521, 522, 523, 524, 525, 526, 527, 528, 529, 530, & + 531, 532 /) + if( allocated( pht_alias_lst ) ) then + deallocate( pht_alias_lst ) + end if + allocate( pht_alias_lst(phtcnt,2),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate pht_alias_lst; error = ',ios + call endrun + end if + if( allocated( pht_alias_mult ) ) then + deallocate( pht_alias_mult ) + end if + allocate( pht_alias_mult(phtcnt,2),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate pht_alias_mult; error = ',ios + call endrun + end if + pht_alias_lst(:,1) = (/ ' ', ' ', ' ', ' ', & + 'userdefined ', 'userdefined ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', 'userdefined ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ' /) + pht_alias_lst(:,2) = (/ ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', 'jch3ooh ', 'jch3ooh ', & + 'jch3ooh ', 'jno2 ', 'jno2 ', 'jno2 ', & + 'jno2 ', 'jno2 ', 'jno2 ', 'jch3ooh ', & + 'jch3ooh ', 'jch3ooh ', 'jch3ooh ', ' ', & + ' ', ' ', ' ', ' ', & + 'jh2o2 ', ' ', ' ', ' ', & + ' ', 'jch3ooh ', ' ', 'jmgly ', & + 'jch2o_a ', 'jno2 ', ' ', 'jch3ooh ', & + 'jch3ooh ', ' ', ' ', 'jacet ', & + 'jch3ooh ', 'jpan ', ' ', 'jch2o_a ', & + 'jch2o_a ', 'jch3ooh ', 'jch3cho ', ' ', & + 'jch3ooh ', 'jch3ooh ', 'jch3ooh ', 'jno2 ', & + 'jch3ooh ', 'jch3ooh ', 'jch3ooh ', 'jch3cho ', & + 'jch3cho ', 'jch3ooh ', 'jch3ooh ', 'jch3ooh ', & + 'jch3ooh ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ' /) + pht_alias_mult(:,1) = (/ 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8 /) + pht_alias_mult(:,2) = (/ 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, .10_r8, 0.2_r8, .14_r8, .20_r8, & + .20_r8, .006_r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 0.28_r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + .006_r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, .10_r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8 /) + allocate( cph_enthalpy(enthalpy_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate cph_enthalpy; error = ',ios + call endrun + end if + allocate( cph_rid(enthalpy_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate cph_rid; error = ',ios + call endrun + end if + cph_rid(:) = (/ 116, 119, 120, 121, 124, & + 127, 128, 129, 130, 133, & + 134, 135, 138, 140, 144, & + 145, 153, 154 /) + cph_enthalpy(:) = (/ 189.810000_r8, 392.190000_r8, 493.580000_r8, 101.390000_r8, 232.590000_r8, & + 203.400000_r8, 226.580000_r8, 120.100000_r8, 194.710000_r8, 293.620000_r8, & + 67.670000_r8, 165.300000_r8, 165.510000_r8, 313.750000_r8, 133.750000_r8, & + 193.020000_r8, 34.470000_r8, 199.170000_r8 /) + allocate( num_rnts(rxntot-phtcnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate num_rnts; error = ',ios + call endrun + end if + num_rnts(:) = (/ 2, 2, 2, 2, 2, 2, 3, 3, 2, 2, & + 2, 2, 2, 3, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 3, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 3, 2, 2, 2, 2, 2, 2, & + 2, 3, 2, 2, 3, 3, 3, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 3, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 3, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 3, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 3, 3, 2, 2, 1, 2, 2, 2, 2, & + 2, 2, 3, 3, 3, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 1, 2, 2, 2, 2, & + 3, 3, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 3, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 3, 2, 2, & + 3, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 3, 2, & + 2, 3, 2, 2, 3, 2, 2, 2, 2, 2, & + 2, 3, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, & + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 1, 2, & + 1, 1, 1, 1, 2, 2, 2, 1, 1, 2, & + 2, 2, 1, 1, 2, 1, 1, 1, 1 /) + + end subroutine set_sim_dat + + end module mo_sim_dat diff --git a/src/chemistry/pp_waccm_ma_noaero/chem_mech.doc b/src/chemistry/pp_waccm_ma_noaero/chem_mech.doc new file mode 100644 index 0000000000..45c4c983c8 --- /dev/null +++ b/src/chemistry/pp_waccm_ma_noaero/chem_mech.doc @@ -0,0 +1,775 @@ + + + Solution species + ( 1) BR (Br) + ( 2) BRCL (BrCl) + ( 3) BRO (BrO) + ( 4) BRONO2 (BrONO2) + ( 5) BRY + ( 6) CCL4 (CCl4) + ( 7) CF2CLBR (CF2ClBr) + ( 8) CF3BR (CF3Br) + ( 9) CFC11 (CFCl3) + ( 10) CFC113 (CCl2FCClF2) + ( 11) CFC114 (CClF2CClF2) + ( 12) CFC115 (CClF2CF3) + ( 13) CFC12 (CF2Cl2) + ( 14) CH2BR2 (CH2Br2) + ( 15) CH2O + ( 16) CH3BR (CH3Br) + ( 17) CH3CCL3 (CH3CCl3) + ( 18) CH3CL (CH3Cl) + ( 19) CH3O2 + ( 20) CH3OOH + ( 21) CH4 + ( 22) CHBR3 (CHBr3) + ( 23) CL (Cl) + ( 24) CL2 (Cl2) + ( 25) CL2O2 (Cl2O2) + ( 26) CLO (ClO) + ( 27) CLONO2 (ClONO2) + ( 28) CLY + ( 29) CO + ( 30) CO2 + ( 31) COF2 + ( 32) COFCL (COFCl) + ( 33) DMS (CH3SCH3) + ( 34) F + ( 35) H + ( 36) H2 + ( 37) H2402 (CBrF2CBrF2) + ( 38) H2O2 + ( 39) H2SO4 (H2SO4) + ( 40) HBR (HBr) + ( 41) HCFC141B (CH3CCl2F) + ( 42) HCFC142B (CH3CClF2) + ( 43) HCFC22 (CHF2Cl) + ( 44) HCL (HCl) + ( 45) HF + ( 46) HNO3 + ( 47) HO2NO2 + ( 48) HOBR (HOBr) + ( 49) HOCL (HOCl) + ( 50) N + ( 51) N2O + ( 52) N2O5 + ( 53) NO + ( 54) NO2 + ( 55) NO3 + ( 56) O + ( 57) O2 + ( 58) O3 + ( 59) OCLO (OClO) + ( 60) OCS (OCS) + ( 61) S (S) + ( 62) SF6 + ( 63) SO (SO) + ( 64) SO2 + ( 65) SO3 (SO3) + ( 66) SOAG (C) + ( 67) e (E) + ( 68) HO2 + ( 69) N2D (N) + ( 70) N2p (N2) + ( 71) NOp (NO) + ( 72) Np (N) + ( 73) O1D (O) + ( 74) O2_1D (O2) + ( 75) O2_1S (O2) + ( 76) O2p (O2) + ( 77) OH + ( 78) Op (O) + ( 79) Op2D (O) + ( 80) Op2P (O) + ( 81) H2O + + + Invariant species + ( 1) M + ( 2) N2 + + + Column integrals + ( 1) O3 - 0.000E+00 + ( 2) O2 - 0.000E+00 + +Class List +========== + Explicit + -------- + ( 1) BRY + ( 2) CCL4 + ( 3) CF2CLBR + ( 4) CF3BR + ( 5) CFC11 + ( 6) CFC113 + ( 7) CFC114 + ( 8) CFC115 + ( 9) CFC12 + ( 10) CH2BR2 + ( 11) CH3BR + ( 12) CH3CCL3 + ( 13) CH3CL + ( 14) CH4 + ( 15) CHBR3 + ( 16) CLY + ( 17) CO2 + ( 18) H2402 + ( 19) HCFC141B + ( 20) HCFC142B + ( 21) HCFC22 + ( 22) N2O + ( 23) SF6 + + Implicit + -------- + ( 1) BR + ( 2) BRCL + ( 3) BRO + ( 4) BRONO2 + ( 5) CH2O + ( 6) CH3O2 + ( 7) CH3OOH + ( 8) CL + ( 9) CL2 + ( 10) CL2O2 + ( 11) CLO + ( 12) CLONO2 + ( 13) CO + ( 14) COF2 + ( 15) COFCL + ( 16) DMS + ( 17) F + ( 18) H + ( 19) H2 + ( 20) H2O2 + ( 21) H2SO4 + ( 22) HBR + ( 23) HCL + ( 24) HF + ( 25) HNO3 + ( 26) HO2NO2 + ( 27) HOBR + ( 28) HOCL + ( 29) N + ( 30) N2O5 + ( 31) NO + ( 32) NO2 + ( 33) NO3 + ( 34) O + ( 35) O2 + ( 36) O3 + ( 37) OCLO + ( 38) OCS + ( 39) S + ( 40) SO + ( 41) SO2 + ( 42) SO3 + ( 43) SOAG + ( 44) e + ( 45) HO2 + ( 46) N2D + ( 47) N2p + ( 48) NOp + ( 49) Np + ( 50) O1D + ( 51) O2_1D + ( 52) O2_1S + ( 53) O2p + ( 54) OH + ( 55) Op + ( 56) Op2D + ( 57) Op2P + ( 58) H2O + + Photolysis + jh2o_b ( 1) H2O + hv -> H2 + O1D rate = ** User defined ** ( 1) + jh2o_c ( 2) H2O + hv -> 2*H + O rate = ** User defined ** ( 2) + jh2o_a ( 3) H2O + hv -> OH + H rate = ** User defined ** ( 3) + jh2o2 ( 4) H2O2 + hv -> 2*OH rate = ** User defined ** ( 4) + jo2_b ( 5) O2 + hv -> 2*O rate = ** User defined ** ( 5) + jo2_a ( 6) O2 + hv -> O + O1D rate = ** User defined ** ( 6) + jo3_a ( 7) O3 + hv -> O1D + O2_1D rate = ** User defined ** ( 7) + jo3_b ( 8) O3 + hv -> O + O2 rate = ** User defined ** ( 8) + jhno3 ( 9) HNO3 + hv -> NO2 + OH rate = ** User defined ** ( 9) + jho2no2_a ( 10) HO2NO2 + hv -> OH + NO3 rate = ** User defined ** ( 10) + jho2no2_b ( 11) HO2NO2 + hv -> NO2 + HO2 rate = ** User defined ** ( 11) + jn2o ( 12) N2O + hv -> O1D + N2 rate = ** User defined ** ( 12) + jn2o5_a ( 13) N2O5 + hv -> NO2 + NO3 rate = ** User defined ** ( 13) + jn2o5_b ( 14) N2O5 + hv -> NO + O + NO3 rate = ** User defined ** ( 14) + jno ( 15) NO + hv -> N + O rate = ** User defined ** ( 15) + jno_i ( 16) NO + hv -> NOp + e rate = ** User defined ** ( 16) + jno2 ( 17) NO2 + hv -> NO + O rate = ** User defined ** ( 17) + jno3_a ( 18) NO3 + hv -> NO2 + O rate = ** User defined ** ( 18) + jno3_b ( 19) NO3 + hv -> NO + O2 rate = ** User defined ** ( 19) + jch2o_a ( 20) CH2O + hv -> CO + 2*H rate = ** User defined ** ( 20) + jch2o_b ( 21) CH2O + hv -> CO + H2 rate = ** User defined ** ( 21) + jch3ooh ( 22) CH3OOH + hv -> CH2O + H + OH rate = ** User defined ** ( 22) + jch4_a ( 23) CH4 + hv -> H + CH3O2 rate = ** User defined ** ( 23) + jch4_b ( 24) CH4 + hv -> 1.44*H2 + 0.18*CH2O + 0.18*O + 0.33*OH + 0.33*H rate = ** User defined ** ( 24) + + 0.44*CO2 + 0.38*CO + 0.05*H2O + jco2 ( 25) CO2 + hv -> CO + O rate = ** User defined ** ( 25) + jbrcl ( 26) BRCL + hv -> BR + CL rate = ** User defined ** ( 26) + jbro ( 27) BRO + hv -> BR + O rate = ** User defined ** ( 27) + jbrono2_b ( 28) BRONO2 + hv -> BRO + NO2 rate = ** User defined ** ( 28) + jbrono2_a ( 29) BRONO2 + hv -> BR + NO3 rate = ** User defined ** ( 29) + jccl4 ( 30) CCL4 + hv -> 4*CL rate = ** User defined ** ( 30) + jcf2clbr ( 31) CF2CLBR + hv -> BR + CL + COF2 rate = ** User defined ** ( 31) + jcf3br ( 32) CF3BR + hv -> BR + F + COF2 rate = ** User defined ** ( 32) + jcfcl3 ( 33) CFC11 + hv -> 2*CL + COFCL rate = ** User defined ** ( 33) + jcfc113 ( 34) CFC113 + hv -> 2*CL + COFCL + COF2 rate = ** User defined ** ( 34) + jcfc114 ( 35) CFC114 + hv -> 2*CL + 2*COF2 rate = ** User defined ** ( 35) + jcfc115 ( 36) CFC115 + hv -> CL + F + 2*COF2 rate = ** User defined ** ( 36) + jcf2cl2 ( 37) CFC12 + hv -> 2*CL + COF2 rate = ** User defined ** ( 37) + jch2br2 ( 38) CH2BR2 + hv -> 2*BR rate = ** User defined ** ( 38) + jch3br ( 39) CH3BR + hv -> BR + CH3O2 rate = ** User defined ** ( 39) + jch3ccl3 ( 40) CH3CCL3 + hv -> 3*CL rate = ** User defined ** ( 40) + jch3cl ( 41) CH3CL + hv -> CL + CH3O2 rate = ** User defined ** ( 41) + jchbr3 ( 42) CHBR3 + hv -> 3*BR rate = ** User defined ** ( 42) + jcl2 ( 43) CL2 + hv -> 2*CL rate = ** User defined ** ( 43) + jcl2o2 ( 44) CL2O2 + hv -> 2*CL rate = ** User defined ** ( 44) + jclo ( 45) CLO + hv -> CL + O rate = ** User defined ** ( 45) + jclono2_a ( 46) CLONO2 + hv -> CL + NO3 rate = ** User defined ** ( 46) + jclono2_b ( 47) CLONO2 + hv -> CLO + NO2 rate = ** User defined ** ( 47) + jcof2 ( 48) COF2 + hv -> 2*F rate = ** User defined ** ( 48) + jcofcl ( 49) COFCL + hv -> F + CL rate = ** User defined ** ( 49) + jh2402 ( 50) H2402 + hv -> 2*BR + 2*COF2 rate = ** User defined ** ( 50) + jhbr ( 51) HBR + hv -> BR + H rate = ** User defined ** ( 51) + jhcfc141b ( 52) HCFC141B + hv -> CL + COFCL rate = ** User defined ** ( 52) + jhcfc142b ( 53) HCFC142B + hv -> CL + COF2 rate = ** User defined ** ( 53) + jhcfc22 ( 54) HCFC22 + hv -> CL + COF2 rate = ** User defined ** ( 54) + jhcl ( 55) HCL + hv -> H + CL rate = ** User defined ** ( 55) + jhf ( 56) HF + hv -> H + F rate = ** User defined ** ( 56) + jhobr ( 57) HOBR + hv -> BR + OH rate = ** User defined ** ( 57) + jhocl ( 58) HOCL + hv -> OH + CL rate = ** User defined ** ( 58) + joclo ( 59) OCLO + hv -> O + CLO rate = ** User defined ** ( 59) + jsf6 ( 60) SF6 + hv -> {sink} rate = ** User defined ** ( 60) + jeuv_26 ( 61) CO2 + hv -> CO + O rate = ** User defined ** ( 61) + jeuv_4 ( 62) N + hv -> Np + e rate = ** User defined ** ( 62) + jeuv_6 ( 63) N2 + hv -> N2p + e rate = ** User defined ** ( 63) + jeuv_22 ( 64) N2 + hv -> N + Np + e rate = ** User defined ** ( 64) + jeuv_23 ( 65) N2 + hv -> N2D + Np + e rate = ** User defined ** ( 65) + jeuv_25 ( 66) N2 + hv -> 1.2*N2D + 0.8*N rate = ** User defined ** ( 66) + jeuv_18 ( 67) N2 + hv -> N2p + e rate = ** User defined ** ( 67) + jeuv_13 ( 68) N2 + hv -> 1.2*N2D + 0.8*N rate = ** User defined ** ( 68) + jeuv_11 ( 69) N2 + hv -> N2D + Np + e rate = ** User defined ** ( 69) + jeuv_10 ( 70) N2 + hv -> N + Np + e rate = ** User defined ** ( 70) + jeuv_3 ( 71) O + hv -> Op2P + e rate = ** User defined ** ( 71) + jeuv_16 ( 72) O + hv -> Op2P + e rate = ** User defined ** ( 72) + jeuv_1 ( 73) O + hv -> Op + e rate = ** User defined ** ( 73) + jeuv_14 ( 74) O + hv -> Op + e rate = ** User defined ** ( 74) + jeuv_2 ( 75) O + hv -> Op2D + e rate = ** User defined ** ( 75) + jeuv_15 ( 76) O + hv -> Op2D + e rate = ** User defined ** ( 76) + jeuv_21 ( 77) O2 + hv -> O + Op2P + e rate = ** User defined ** ( 77) + jeuv_17 ( 78) O2 + hv -> O2p + e rate = ** User defined ** ( 78) + jeuv_7 ( 79) O2 + hv -> O + Op + e rate = ** User defined ** ( 79) + jeuv_5 ( 80) O2 + hv -> O2p + e rate = ** User defined ** ( 80) + jeuv_19 ( 81) O2 + hv -> O + Op + e rate = ** User defined ** ( 81) + jeuv_24 ( 82) O2 + hv -> 2*O rate = ** User defined ** ( 82) + jeuv_12 ( 83) O2 + hv -> 2*O rate = ** User defined ** ( 83) + jeuv_9 ( 84) O2 + hv -> O + Op2P + e rate = ** User defined ** ( 84) + jeuv_8 ( 85) O2 + hv -> O + Op2D + e rate = ** User defined ** ( 85) + jeuv_20 ( 86) O2 + hv -> O + Op2D + e rate = ** User defined ** ( 86) + jh2so4 ( 87) H2SO4 + hv -> SO3 + H2O rate = ** User defined ** ( 87) + jocs ( 88) OCS + hv -> S + CO rate = ** User defined ** ( 88) + jso ( 89) SO + hv -> S + O rate = ** User defined ** ( 89) + jso2 ( 90) SO2 + hv -> SO + O rate = ** User defined ** ( 90) + jso3 ( 91) SO3 + hv -> SO2 + O rate = ** User defined ** ( 91) + + Reactions + ag1 ( 1) O2_1D -> O2 rate = 2.58E-04 ( 92) + ag2 ( 2) O2_1S -> O2 rate = 8.50E-02 ( 93) + O1D_H2 ( 3) O1D + H2 -> H + OH rate = 1.20E-10 ( 94) + O1D_H2O ( 4) O1D + H2O -> 2*OH rate = 1.63E-10*exp( 60./t) ( 95) + O1D_N2 ( 5) O1D + N2 -> O + N2 rate = 2.15E-11*exp( 110./t) ( 96) + O1D_O2 ( 6) O1D + O2 -> O + O2_1S rate = 2.64E-11*exp( 55./t) ( 97) + O1D_O2b ( 7) O1D + O2 -> O + O2 rate = 6.60E-12*exp( 55./t) ( 98) + O1D_O3 ( 8) O1D + O3 -> O2 + O2 rate = 1.20E-10 ( 99) + O2_1D_N2 ( 9) O2_1D + N2 -> O2 + N2 rate = 1.00E-20 (100) + O2_1D_O ( 10) O2_1D + O -> O2 + O rate = 1.30E-16 (101) + O2_1D_O2 ( 11) O2_1D + O2 -> 2*O2 rate = 3.60E-18*exp( -220./t) (102) + O2_1S_CO2 ( 12) O2_1S + CO2 -> O2_1D + CO2 rate = 4.20E-13 (103) + O2_1S_N2 ( 13) O2_1S + N2 -> O2_1D + N2 rate = 1.80E-15*exp( 45./t) (104) + O2_1S_O ( 14) O2_1S + O -> O2_1D + O rate = 8.00E-14 (105) + O2_1S_O2 ( 15) O2_1S + O2 -> O2_1D + O2 rate = 3.90E-17 (106) + O2_1S_O3 ( 16) O2_1S + O3 -> O2_1D + O3 rate = 3.50E-11*exp( -135./t) (107) + O_O3 ( 17) O + O3 -> 2*O2 rate = 8.00E-12*exp( -2060./t) (108) + usr_O_O ( 18) O + O + M -> O2 + M rate = ** User defined ** (109) + usr_O_O2 ( 19) O + O2 + M -> O3 + M rate = ** User defined ** (110) + H2_O ( 20) H2 + O -> OH + H rate = 1.60E-11*exp( -4570./t) (111) + H2O2_O ( 21) H2O2 + O -> OH + HO2 rate = 1.40E-12*exp( -2000./t) (112) + H_HO2 ( 22) H + HO2 -> H2 + O2 rate = 6.90E-12 (113) + H_HO2a ( 23) H + HO2 -> 2*OH rate = 7.20E-11 (114) + H_HO2b ( 24) H + HO2 -> H2O + O rate = 1.60E-12 (115) + H_O2 ( 25) H + O2 + M -> HO2 + M troe : ko=4.40E-32*(300/t)**1.30 (116) + ki=7.50E-11*(300/t)**-0.20 + f=0.60 + HO2_O ( 26) HO2 + O -> OH + O2 rate = 3.00E-11*exp( 200./t) (117) + HO2_O3 ( 27) HO2 + O3 -> OH + 2*O2 rate = 1.00E-14*exp( -490./t) (118) + H_O3 ( 28) H + O3 -> OH + O2 rate = 1.40E-10*exp( -470./t) (119) + OH_H2 ( 29) OH + H2 -> H2O + H rate = 2.80E-12*exp( -1800./t) (120) + OH_H2O2 ( 30) OH + H2O2 -> H2O + HO2 rate = 1.80E-12 (121) + OH_HO2 ( 31) OH + HO2 -> H2O + O2 rate = 4.80E-11*exp( 250./t) (122) + OH_O ( 32) OH + O -> H + O2 rate = 1.80E-11*exp( 180./t) (123) + OH_O3 ( 33) OH + O3 -> HO2 + O2 rate = 1.70E-12*exp( -940./t) (124) + OH_OH ( 34) OH + OH -> H2O + O rate = 1.80E-12 (125) + OH_OH_M ( 35) OH + OH + M -> H2O2 + M troe : ko=6.90E-31*(300/t)**1.00 (126) + ki=2.60E-11 + f=0.60 + usr_HO2_HO2 ( 36) HO2 + HO2 -> H2O2 + O2 rate = ** User defined ** (127) + HO2NO2_OH ( 37) HO2NO2 + OH -> H2O + NO2 + O2 rate = 1.30E-12*exp( 380./t) (128) + N2D_O ( 38) N2D + O -> N + O rate = 7.00E-13 (129) + N2D_O2 ( 39) N2D + O2 -> NO + O1D rate = 5.00E-12 (130) + N_NO ( 40) N + NO -> N2 + O rate = 2.10E-11*exp( 100./t) (131) + N_NO2a ( 41) N + NO2 -> N2O + O rate = 2.90E-12*exp( 220./t) (132) + N_NO2b ( 42) N + NO2 -> 2*NO rate = 1.45E-12*exp( 220./t) (133) + N_NO2c ( 43) N + NO2 -> N2 + O2 rate = 1.45E-12*exp( 220./t) (134) + N_O2 ( 44) N + O2 -> NO + O rate = 1.50E-11*exp( -3600./t) (135) + NO2_O ( 45) NO2 + O -> NO + O2 rate = 5.10E-12*exp( 210./t) (136) + NO2_O3 ( 46) NO2 + O3 -> NO3 + O2 rate = 1.20E-13*exp( -2450./t) (137) + NO2_O_M ( 47) NO2 + O + M -> NO3 + M troe : ko=2.50E-31*(300/t)**1.80 (138) + ki=2.20E-11*(300/t)**0.70 + f=0.60 + NO3_HO2 ( 48) NO3 + HO2 -> OH + NO2 + O2 rate = 3.50E-12 (139) + NO3_NO ( 49) NO3 + NO -> 2*NO2 rate = 1.50E-11*exp( 170./t) (140) + NO3_O ( 50) NO3 + O -> NO2 + O2 rate = 1.00E-11 (141) + NO3_OH ( 51) NO3 + OH -> HO2 + NO2 rate = 2.20E-11 (142) + N_OH ( 52) N + OH -> NO + H rate = 5.00E-11 (143) + NO_HO2 ( 53) NO + HO2 -> NO2 + OH rate = 3.30E-12*exp( 270./t) (144) + NO_O3 ( 54) NO + O3 -> NO2 + O2 rate = 3.00E-12*exp( -1500./t) (145) + NO_O_M ( 55) NO + O + M -> NO2 + M troe : ko=9.00E-32*(300/t)**1.50 (146) + ki=3.00E-11 + f=0.60 + O1D_N2Oa ( 56) O1D + N2O -> 2*NO rate = 7.26E-11*exp( 20./t) (147) + O1D_N2Ob ( 57) O1D + N2O -> N2 + O2 rate = 4.64E-11*exp( 20./t) (148) + tag_NO2_HO2 ( 58) NO2 + HO2 + M -> HO2NO2 + M troe : ko=1.90E-31*(300/t)**3.40 (149) + ki=4.00E-12*(300/t)**0.30 + f=0.60 + tag_NO2_NO3 ( 59) NO2 + NO3 + M -> N2O5 + M troe : ko=2.40E-30*(300/t)**3.00 (150) + ki=1.60E-12*(300/t)**-0.10 + f=0.60 + tag_NO2_OH ( 60) NO2 + OH + M -> HNO3 + M troe : ko=1.80E-30*(300/t)**3.00 (151) + ki=2.80E-11 + f=0.60 + usr_HNO3_OH ( 61) HNO3 + OH -> NO3 + H2O rate = ** User defined ** (152) + usr_HO2NO2_M ( 62) HO2NO2 + M -> HO2 + NO2 + M rate = ** User defined ** (153) + usr_N2O5_M ( 63) N2O5 + M -> NO2 + NO3 + M rate = ** User defined ** (154) + CL_CH2O ( 64) CL + CH2O -> HCL + HO2 + CO rate = 8.10E-11*exp( -30./t) (155) + CL_CH4 ( 65) CL + CH4 -> CH3O2 + HCL rate = 7.10E-12*exp( -1270./t) (156) + CL_H2 ( 66) CL + H2 -> HCL + H rate = 3.05E-11*exp( -2270./t) (157) + CL_H2O2 ( 67) CL + H2O2 -> HCL + HO2 rate = 1.10E-11*exp( -980./t) (158) + CL_HO2a ( 68) CL + HO2 -> HCL + O2 rate = 1.40E-11*exp( 270./t) (159) + CL_HO2b ( 69) CL + HO2 -> OH + CLO rate = 3.60E-11*exp( -375./t) (160) + CL_O3 ( 70) CL + O3 -> CLO + O2 rate = 2.30E-11*exp( -200./t) (161) + CLO_CH3O2 ( 71) CLO + CH3O2 -> CL + HO2 + CH2O rate = 3.30E-12*exp( -115./t) (162) + CLO_CLOa ( 72) CLO + CLO -> 2*CL + O2 rate = 3.00E-11*exp( -2450./t) (163) + CLO_CLOb ( 73) CLO + CLO -> CL2 + O2 rate = 1.00E-12*exp( -1590./t) (164) + CLO_CLOc ( 74) CLO + CLO -> CL + OCLO rate = 3.50E-13*exp( -1370./t) (165) + CLO_HO2 ( 75) CLO + HO2 -> O2 + HOCL rate = 2.60E-12*exp( 290./t) (166) + CLO_NO ( 76) CLO + NO -> NO2 + CL rate = 6.40E-12*exp( 290./t) (167) + CLONO2_CL ( 77) CLONO2 + CL -> CL2 + NO3 rate = 6.50E-12*exp( 135./t) (168) + CLO_NO2_M ( 78) CLO + NO2 + M -> CLONO2 + M troe : ko=1.80E-31*(300/t)**3.40 (169) + ki=1.50E-11*(300/t)**1.90 + f=0.60 + CLONO2_O ( 79) CLONO2 + O -> CLO + NO3 rate = 3.60E-12*exp( -840./t) (170) + CLONO2_OH ( 80) CLONO2 + OH -> HOCL + NO3 rate = 1.20E-12*exp( -330./t) (171) + CLO_O ( 81) CLO + O -> CL + O2 rate = 2.80E-11*exp( 85./t) (172) + CLO_OHa ( 82) CLO + OH -> CL + HO2 rate = 7.40E-12*exp( 270./t) (173) + CLO_OHb ( 83) CLO + OH -> HCL + O2 rate = 6.00E-13*exp( 230./t) (174) + HCL_O ( 84) HCL + O -> CL + OH rate = 1.00E-11*exp( -3300./t) (175) + HCL_OH ( 85) HCL + OH -> H2O + CL rate = 1.80E-12*exp( -250./t) (176) + HOCL_CL ( 86) HOCL + CL -> HCL + CLO rate = 3.40E-12*exp( -130./t) (177) + HOCL_O ( 87) HOCL + O -> CLO + OH rate = 1.70E-13 (178) + HOCL_OH ( 88) HOCL + OH -> H2O + CLO rate = 3.00E-12*exp( -500./t) (179) + O1D_CCL4 ( 89) O1D + CCL4 -> 4*CL rate = 2.61E-10 (180) + O1D_CF2CLBR ( 90) O1D + CF2CLBR -> CL + BR + COF2 rate = 9.75E-11 (181) + O1D_CFC11 ( 91) O1D + CFC11 -> 2*CL + COFCL rate = 2.07E-10 (182) + O1D_CFC113 ( 92) O1D + CFC113 -> 2*CL + COFCL + COF2 rate = 2.09E-10 (183) + O1D_CFC114 ( 93) O1D + CFC114 -> 2*CL + 2*COF2 rate = 1.17E-10 (184) + O1D_CFC115 ( 94) O1D + CFC115 -> CL + F + 2*COF2 rate = 4.64E-11 (185) + O1D_CFC12 ( 95) O1D + CFC12 -> 2*CL + COF2 rate = 1.20E-10 (186) + O1D_HCLa ( 96) O1D + HCL -> CL + OH rate = 9.90E-11 (187) + O1D_HCLb ( 97) O1D + HCL -> CLO + H rate = 3.30E-12 (188) + tag_CLO_CLO_M ( 98) CLO + CLO + M -> CL2O2 + M troe : ko=1.90E-32*(300/t)**3.60 (189) + ki=3.70E-12*(300/t)**1.60 + f=0.60 + usr_CL2O2_M ( 99) CL2O2 + M -> CLO + CLO + M rate = ** User defined ** (190) + BR_CH2O (100) BR + CH2O -> HBR + HO2 + CO rate = 1.70E-11*exp( -800./t) (191) + BR_HO2 (101) BR + HO2 -> HBR + O2 rate = 4.80E-12*exp( -310./t) (192) + BR_O3 (102) BR + O3 -> BRO + O2 rate = 1.60E-11*exp( -780./t) (193) + BRO_BRO (103) BRO + BRO -> 2*BR + O2 rate = 1.50E-12*exp( 230./t) (194) + BRO_CLOa (104) BRO + CLO -> BR + OCLO rate = 9.50E-13*exp( 550./t) (195) + BRO_CLOb (105) BRO + CLO -> BR + CL + O2 rate = 2.30E-12*exp( 260./t) (196) + BRO_CLOc (106) BRO + CLO -> BRCL + O2 rate = 4.10E-13*exp( 290./t) (197) + BRO_HO2 (107) BRO + HO2 -> HOBR + O2 rate = 4.50E-12*exp( 460./t) (198) + BRO_NO (108) BRO + NO -> BR + NO2 rate = 8.80E-12*exp( 260./t) (199) + BRO_NO2_M (109) BRO + NO2 + M -> BRONO2 + M troe : ko=5.20E-31*(300/t)**3.20 (200) + ki=6.90E-12*(300/t)**2.90 + f=0.60 + BRONO2_O (110) BRONO2 + O -> BRO + NO3 rate = 1.90E-11*exp( 215./t) (201) + BRO_O (111) BRO + O -> BR + O2 rate = 1.90E-11*exp( 230./t) (202) + BRO_OH (112) BRO + OH -> BR + HO2 rate = 1.70E-11*exp( 250./t) (203) + HBR_O (113) HBR + O -> BR + OH rate = 5.80E-12*exp( -1500./t) (204) + HBR_OH (114) HBR + OH -> BR + H2O rate = 5.50E-12*exp( 200./t) (205) + HOBR_O (115) HOBR + O -> BRO + OH rate = 1.20E-10*exp( -430./t) (206) + O1D_CF3BR (116) O1D + CF3BR -> BR + F + COF2 rate = 4.50E-11 (207) + O1D_CHBR3 (117) O1D + CHBR3 -> 3*BR rate = 4.62E-10 (208) + O1D_H2402 (118) O1D + H2402 -> 2*BR + 2*COF2 rate = 1.20E-10 (209) + O1D_HBRa (119) O1D + HBR -> BR + OH rate = 9.00E-11 (210) + O1D_HBRb (120) O1D + HBR -> BRO + H rate = 3.00E-11 (211) + F_CH4 (121) F + CH4 -> HF + CH3O2 rate = 1.60E-10*exp( -260./t) (212) + F_H2 (122) F + H2 -> HF + H rate = 1.40E-10*exp( -500./t) (213) + F_H2O (123) F + H2O -> HF + OH rate = 1.40E-11 (214) + F_HNO3 (124) F + HNO3 -> HF + NO3 rate = 6.00E-12*exp( 400./t) (215) + O1D_COF2 (125) O1D + COF2 -> 2*F rate = 2.14E-11 (216) + O1D_COFCL (126) O1D + COFCL -> F + CL rate = 1.90E-10 (217) + CH2BR2_CL (127) CH2BR2 + CL -> 2*BR + HCL rate = 6.30E-12*exp( -800./t) (218) + CH2BR2_OH (128) CH2BR2 + OH -> 2*BR + H2O rate = 2.00E-12*exp( -840./t) (219) + CH3BR_CL (129) CH3BR + CL -> HCL + HO2 + BR rate = 1.46E-11*exp( -1040./t) (220) + CH3BR_OH (130) CH3BR + OH -> BR + H2O + HO2 rate = 1.42E-12*exp( -1150./t) (221) + CH3CCL3_OH (131) CH3CCL3 + OH -> H2O + 3*CL rate = 1.64E-12*exp( -1520./t) (222) + CH3CL_CL (132) CH3CL + CL -> HO2 + CO + 2*HCL rate = 2.03E-11*exp( -1100./t) (223) + CH3CL_OH (133) CH3CL + OH -> CL + H2O + HO2 rate = 1.96E-12*exp( -1200./t) (224) + CHBR3_CL (134) CHBR3 + CL -> 3*BR + HCL rate = 4.85E-12*exp( -850./t) (225) + CHBR3_OH (135) CHBR3 + OH -> 3*BR rate = 9.00E-13*exp( -360./t) (226) + HCFC141B_OH (136) HCFC141B + OH -> CL + COFCL rate = 1.25E-12*exp( -1600./t) (227) + HCFC142B_OH (137) HCFC142B + OH -> CL + COF2 rate = 1.30E-12*exp( -1770./t) (228) + HCFC22_OH (138) HCFC22 + OH -> H2O + CL + COF2 rate = 9.20E-13*exp( -1560./t) (229) + O1D_CH2BR2 (139) O1D + CH2BR2 -> 2*BR rate = 2.57E-10 (230) + O1D_CH3BR (140) O1D + CH3BR -> BR rate = 1.80E-10 (231) + O1D_HCFC141B (141) O1D + HCFC141B -> CL + COFCL rate = 1.79E-10 (232) + O1D_HCFC142B (142) O1D + HCFC142B -> CL + COF2 rate = 1.30E-10 (233) + O1D_HCFC22 (143) O1D + HCFC22 -> CL + COF2 rate = 7.65E-11 (234) + CH2O_NO3 (144) CH2O + NO3 -> CO + HO2 + HNO3 rate = 6.00E-13*exp( -2058./t) (235) + CH2O_O (145) CH2O + O -> HO2 + OH + CO rate = 3.40E-11*exp( -1600./t) (236) + CH2O_OH (146) CH2O + OH -> CO + H2O + H rate = 5.50E-12*exp( 125./t) (237) + CH3O2_HO2 (147) CH3O2 + HO2 -> CH3OOH + O2 rate = 4.10E-13*exp( 750./t) (238) + CH3O2_NO (148) CH3O2 + NO -> CH2O + NO2 + HO2 rate = 2.80E-12*exp( 300./t) (239) + CH3OOH_OH (149) CH3OOH + OH -> 0.7*CH3O2 + 0.3*OH + 0.3*CH2O + H2O rate = 3.80E-12*exp( 200./t) (240) + CH4_OH (150) CH4 + OH -> CH3O2 + H2O rate = 2.45E-12*exp( -1775./t) (241) + CO_OH_M (151) CO + OH + M -> CO2 + HO2 + M troe : ko=5.90E-33*(300/t)**1.00 (242) + ki=1.10E-12*(300/t)**-1.30 + f=0.60 + O1D_CH4a (152) O1D + CH4 -> CH3O2 + OH rate = 1.31E-10 (243) + O1D_CH4b (153) O1D + CH4 -> CH2O + H + HO2 rate = 3.50E-11 (244) + O1D_CH4c (154) O1D + CH4 -> CH2O + H2 rate = 9.00E-12 (245) + usr_CO_OH_b (155) CO + OH -> CO2 + H rate = ** User defined ** (246) + DMS_NO3 (156) DMS + NO3 -> SO2 + HNO3 rate = 1.90E-13*exp( 520./t) (247) + DMS_OHa (157) DMS + OH -> SO2 rate = 9.60E-12*exp( -234./t) (248) + OCS_O (158) OCS + O -> SO + CO rate = 2.10E-11*exp( -2200./t) (249) + OCS_OH (159) OCS + OH -> SO2 + CO + H rate = 7.20E-14*exp( -1070./t) (250) + S_O2 (160) S + O2 -> SO + O rate = 2.30E-12 (251) + S_O3 (161) S + O3 -> SO + O2 rate = 1.20E-11 (252) + SO_BRO (162) SO + BRO -> SO2 + BR rate = 5.70E-11 (253) + SO_CLO (163) SO + CLO -> SO2 + CL rate = 2.80E-11 (254) + S_OH (164) S + OH -> SO + H rate = 6.60E-11 (255) + SO_NO2 (165) SO + NO2 -> SO2 + NO rate = 1.40E-11 (256) + SO_O2 (166) SO + O2 -> SO2 + O rate = 1.60E-13*exp( -2280./t) (257) + SO_O3 (167) SO + O3 -> SO2 + O2 rate = 3.40E-12*exp( -1100./t) (258) + SO_OCLO (168) SO + OCLO -> SO2 + CLO rate = 1.90E-12 (259) + SO_OH (169) SO + OH -> SO2 + H rate = 2.70E-11*exp( 335./t) (260) + usr_DMS_OH (170) DMS + OH -> 0.5*SO2 + 0.5*HO2 rate = ** User defined ** (261) + usr_SO2_OH (171) SO2 + OH -> SO3 + HO2 rate = ** User defined ** (262) + usr_SO3_H2O (172) SO3 + H2O -> H2SO4 rate = ** User defined ** (263) + usr_HO2_aer (173) HO2 -> H2O rate = ** User defined ** (264) + usr_N2O5_aer (174) N2O5 -> 2*HNO3 rate = ** User defined ** (265) + usr_NO2_aer (175) NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3 rate = ** User defined ** (266) + usr_NO3_aer (176) NO3 -> HNO3 rate = ** User defined ** (267) + het1 (177) N2O5 -> 2*HNO3 rate = ** User defined ** (268) + het10 (178) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (269) + het11 (179) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (270) + het12 (180) N2O5 -> 2*HNO3 rate = ** User defined ** (271) + het13 (181) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (272) + het14 (182) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (273) + het15 (183) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (274) + het16 (184) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (275) + het17 (185) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (276) + het2 (186) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (277) + het3 (187) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (278) + het4 (188) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (279) + het5 (189) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (280) + het6 (190) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (281) + het7 (191) N2O5 -> 2*HNO3 rate = ** User defined ** (282) + het8 (192) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (283) + het9 (193) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (284) + ag247nm (194) Op2P -> Op rate = 4.70E-02 (285) + ag373nm (195) Op2D -> Op rate = 7.70E-05 (286) + ag732nm (196) Op2P -> Op2D rate = 1.71E-01 (287) + elec1 (197) NOp + e -> 0.2*N + 0.8*N2D + O rate = ** User defined ** (288) + elec2 (198) O2p + e -> 1.15*O + 0.85*O1D rate = ** User defined ** (289) + elec3 (199) N2p + e -> 1.1*N + 0.9*N2D rate = ** User defined ** (290) + ion_N2p_O2 (200) N2p + O2 -> O2p + N2 rate = 6.00E-11 (291) + ion_N2p_Oa (201) N2p + O -> NOp + N2D rate = ** User defined ** (292) + ion_N2p_Ob (202) N2p + O -> Op + N2 rate = ** User defined ** (293) + ion_Np_O (203) Np + O -> Op + N rate = 1.00E-12 (294) + ion_Np_O2a (204) Np + O2 -> O2p + N rate = 4.00E-10 (295) + ion_Np_O2b (205) Np + O2 -> NOp + O rate = 2.00E-10 (296) + ion_O2p_N (206) O2p + N -> NOp + O rate = 1.00E-10 (297) + ion_O2p_N2 (207) O2p + N2 -> NOp + NO rate = 5.00E-16 (298) + ion_O2p_NO (208) O2p + NO -> NOp + O2 rate = 4.40E-10 (299) + ion_Op_CO2 (209) Op + CO2 -> O2p + CO rate = 9.00E-10 (300) + ion_Op_N2 (210) Op + N2 -> NOp + N rate = ** User defined ** (301) + ion_Op_N2D (211) Op + N2D -> Np + O rate = 1.30E-10 (302) + ion_Op_O2 (212) Op + O2 -> O2p + O rate = ** User defined ** (303) + Op2D_e (213) Op2D + e -> Op + e rate = ** User defined ** (304) + Op2D_N2 (214) Op2D + N2 -> N2p + O rate = 8.00E-10 (305) + Op2D_O (215) Op2D + O -> Op + O rate = 5.00E-12 (306) + Op2D_O2 (216) Op2D + O2 -> O2p + O rate = 7.00E-10 (307) + Op2P_ea (217) Op2P + e -> Op2D + e rate = ** User defined ** (308) + Op2P_eb (218) Op2P + e -> Op + e rate = ** User defined ** (309) + Op2P_N2a (219) Op2P + N2 -> N2p + O rate = 4.80E-10 (310) + Op2P_N2b (220) Op2P + N2 -> Np + NO rate = 1.00E-10 (311) + Op2P_O (221) Op2P + O -> Op + O rate = 4.00E-10 (312) + +Extraneous prod/loss species + ( 1) DMS (dataset) + ( 2) CO (dataset) + ( 3) NO (dataset) + ( 4) NO2 (dataset) + ( 5) SO2 (dataset) + ( 6) N + ( 7) N2D + ( 8) N2p + ( 9) Op + (10) e + (11) Np + (12) O2p + (13) OH + + + Equation Report + + d(BR)/dt = j26*BRCL + j27*BRO + j29*BRONO2 + j31*CF2CLBR + j32*CF3BR + 2*j38*CH2BR2 + j39*CH3BR + + 3*j42*CHBR3 + 2*j50*H2402 + j51*HBR + j57*HOBR + r90*O1D*CF2CLBR + 2*r103*BRO*BRO + + r104*BRO*CLO + r105*BRO*CLO + r108*BRO*NO + r111*BRO*O + r112*BRO*OH + r113*HBR*O + + r114*HBR*OH + r116*O1D*CF3BR + 3*r117*O1D*CHBR3 + 2*r118*O1D*H2402 + r119*O1D*HBR + + 2*r127*CH2BR2*CL + 2*r128*CH2BR2*OH + r129*CH3BR*CL + r130*CH3BR*OH + 3*r134*CHBR3*CL + + 3*r135*CHBR3*OH + 2*r139*O1D*CH2BR2 + r140*O1D*CH3BR + r162*SO*BRO + - r100*CH2O*BR - r101*HO2*BR - r102*O3*BR + d(BRCL)/dt = r106*BRO*CLO + r185*HOBR*HCL + r190*HOBR*HCL + - j26*BRCL + d(BRO)/dt = j28*BRONO2 + r102*BR*O3 + r110*BRONO2*O + r115*HOBR*O + r120*O1D*HBR + - j27*BRO - 2*r103*BRO*BRO - r104*CLO*BRO - r105*CLO*BRO - r106*CLO*BRO - r107*HO2*BRO + - r108*NO*BRO - r109*M*NO2*BRO - r111*O*BRO - r112*OH*BRO - r162*SO*BRO + d(BRONO2)/dt = r109*M*BRO*NO2 + - j28*BRONO2 - j29*BRONO2 - r179*BRONO2 - r182*BRONO2 - r187*BRONO2 - r110*O*BRONO2 + d(BRY)/dt = 0 + d(CCL4)/dt = - j30*CCL4 - r89*O1D*CCL4 + d(CF2CLBR)/dt = - j31*CF2CLBR - r90*O1D*CF2CLBR + d(CF3BR)/dt = - j32*CF3BR - r116*O1D*CF3BR + d(CFC11)/dt = - j33*CFC11 - r91*O1D*CFC11 + d(CFC113)/dt = - j34*CFC113 - r92*O1D*CFC113 + d(CFC114)/dt = - j35*CFC114 - r93*O1D*CFC114 + d(CFC115)/dt = - j36*CFC115 - r94*O1D*CFC115 + d(CFC12)/dt = - j37*CFC12 - r95*O1D*CFC12 + d(CH2BR2)/dt = - j38*CH2BR2 - r127*CL*CH2BR2 - r128*OH*CH2BR2 - r139*O1D*CH2BR2 + d(CH2O)/dt = j22*CH3OOH + .18*j24*CH4 + r71*CLO*CH3O2 + r148*CH3O2*NO + .3*r149*CH3OOH*OH + r153*O1D*CH4 + + r154*O1D*CH4 + - j20*CH2O - j21*CH2O - r64*CL*CH2O - r100*BR*CH2O - r144*NO3*CH2O - r145*O*CH2O + - r146*OH*CH2O + d(CH3BR)/dt = - j39*CH3BR - r129*CL*CH3BR - r130*OH*CH3BR - r140*O1D*CH3BR + d(CH3CCL3)/dt = - j40*CH3CCL3 - r131*OH*CH3CCL3 + d(CH3CL)/dt = - j41*CH3CL - r132*CL*CH3CL - r133*OH*CH3CL + d(CH3O2)/dt = j23*CH4 + j39*CH3BR + j41*CH3CL + r65*CL*CH4 + r121*F*CH4 + .7*r149*CH3OOH*OH + r150*CH4*OH + + r152*O1D*CH4 + - r71*CLO*CH3O2 - r147*HO2*CH3O2 - r148*NO*CH3O2 + d(CH3OOH)/dt = r147*CH3O2*HO2 + - j22*CH3OOH - r149*OH*CH3OOH + d(CH4)/dt = - j23*CH4 - j24*CH4 - r65*CL*CH4 - r121*F*CH4 - r150*OH*CH4 - r152*O1D*CH4 - r153*O1D*CH4 + - r154*O1D*CH4 + d(CHBR3)/dt = - j42*CHBR3 - r117*O1D*CHBR3 - r134*CL*CHBR3 - r135*OH*CHBR3 + d(CL)/dt = j26*BRCL + 4*j30*CCL4 + j31*CF2CLBR + 2*j33*CFC11 + 2*j34*CFC113 + 2*j35*CFC114 + j36*CFC115 + + 2*j37*CFC12 + 3*j40*CH3CCL3 + j41*CH3CL + 2*j43*CL2 + 2*j44*CL2O2 + j45*CLO + j46*CLONO2 + + j49*COFCL + j52*HCFC141B + j53*HCFC142B + j54*HCFC22 + j55*HCL + j58*HOCL + r71*CLO*CH3O2 + + 2*r72*CLO*CLO + r74*CLO*CLO + r76*CLO*NO + r81*CLO*O + r82*CLO*OH + r84*HCL*O + r85*HCL*OH + + 4*r89*O1D*CCL4 + r90*O1D*CF2CLBR + 2*r91*O1D*CFC11 + 2*r92*O1D*CFC113 + 2*r93*O1D*CFC114 + + r94*O1D*CFC115 + 2*r95*O1D*CFC12 + r96*O1D*HCL + r105*BRO*CLO + r126*O1D*COFCL + + 3*r131*CH3CCL3*OH + r133*CH3CL*OH + r136*HCFC141B*OH + r137*HCFC142B*OH + r138*HCFC22*OH + + r141*O1D*HCFC141B + r142*O1D*HCFC142B + r143*O1D*HCFC22 + r163*SO*CLO + - r64*CH2O*CL - r65*CH4*CL - r66*H2*CL - r67*H2O2*CL - r68*HO2*CL - r69*HO2*CL - r70*O3*CL + - r77*CLONO2*CL - r86*HOCL*CL - r127*CH2BR2*CL - r129*CH3BR*CL - r132*CH3CL*CL - r134*CHBR3*CL + d(CL2)/dt = r73*CLO*CLO + r77*CLONO2*CL + r178*HOCL*HCL + r183*CLONO2*HCL + r184*HOCL*HCL + r188*CLONO2*HCL + + r189*HOCL*HCL + r193*CLONO2*HCL + - j43*CL2 + d(CL2O2)/dt = r98*M*CLO*CLO + - j44*CL2O2 - r99*M*CL2O2 + d(CLO)/dt = j47*CLONO2 + j59*OCLO + r99*M*CL2O2 + r99*M*CL2O2 + r69*CL*HO2 + r70*CL*O3 + r79*CLONO2*O + + r86*HOCL*CL + r87*HOCL*O + r88*HOCL*OH + r97*O1D*HCL + r168*SO*OCLO + - j45*CLO - r71*CH3O2*CLO - 2*r72*CLO*CLO - 2*r73*CLO*CLO - 2*r74*CLO*CLO - r75*HO2*CLO + - r76*NO*CLO - r78*M*NO2*CLO - r81*O*CLO - r82*OH*CLO - r83*OH*CLO - 2*r98*M*CLO*CLO + - r104*BRO*CLO - r105*BRO*CLO - r106*BRO*CLO - r163*SO*CLO + d(CLONO2)/dt = r78*M*CLO*NO2 + - j46*CLONO2 - j47*CLONO2 - r181*CLONO2 - r186*CLONO2 - r192*CLONO2 - r77*CL*CLONO2 + - r79*O*CLONO2 - r80*OH*CLONO2 - r183*HCL*CLONO2 - r188*HCL*CLONO2 - r193*HCL*CLONO2 + d(CLY)/dt = 0 + d(CO)/dt = j20*CH2O + j21*CH2O + .38*j24*CH4 + j25*CO2 + j61*CO2 + j88*OCS + r64*CL*CH2O + r100*BR*CH2O + + r132*CH3CL*CL + r144*CH2O*NO3 + r145*CH2O*O + r146*CH2O*OH + r158*OCS*O + r159*OCS*OH + + r209*Op*CO2 + - r151*M*OH*CO - r155*OH*CO + d(CO2)/dt = .44*j24*CH4 + r151*M*CO*OH + r155*CO*OH + - j25*CO2 - j61*CO2 - r209*Op*CO2 + d(COF2)/dt = j31*CF2CLBR + j32*CF3BR + j34*CFC113 + 2*j35*CFC114 + 2*j36*CFC115 + j37*CFC12 + 2*j50*H2402 + + j53*HCFC142B + j54*HCFC22 + r90*O1D*CF2CLBR + r92*O1D*CFC113 + 2*r93*O1D*CFC114 + + 2*r94*O1D*CFC115 + r95*O1D*CFC12 + r116*O1D*CF3BR + 2*r118*O1D*H2402 + r137*HCFC142B*OH + + r138*HCFC22*OH + r142*O1D*HCFC142B + r143*O1D*HCFC22 + - j48*COF2 - r125*O1D*COF2 + d(COFCL)/dt = j33*CFC11 + j34*CFC113 + j52*HCFC141B + r91*O1D*CFC11 + r92*O1D*CFC113 + r136*HCFC141B*OH + + r141*O1D*HCFC141B + - j49*COFCL - r126*O1D*COFCL + d(DMS)/dt = - r156*NO3*DMS - r157*OH*DMS - r170*OH*DMS + d(F)/dt = j32*CF3BR + j36*CFC115 + 2*j48*COF2 + j49*COFCL + j56*HF + r94*O1D*CFC115 + r116*O1D*CF3BR + + 2*r125*O1D*COF2 + r126*O1D*COFCL + - r121*CH4*F - r122*H2*F - r123*H2O*F - r124*HNO3*F + d(H)/dt = 2*j2*H2O + j3*H2O + 2*j20*CH2O + j22*CH3OOH + j23*CH4 + .33*j24*CH4 + j51*HBR + j55*HCL + j56*HF + + r3*O1D*H2 + r20*H2*O + r29*OH*H2 + r32*OH*O + r52*N*OH + r66*CL*H2 + r97*O1D*HCL + + r120*O1D*HBR + r122*F*H2 + r146*CH2O*OH + r153*O1D*CH4 + r155*CO*OH + r159*OCS*OH + r164*S*OH + + r169*SO*OH + - r22*HO2*H - r23*HO2*H - r24*HO2*H - r25*M*O2*H - r28*O3*H + d(H2)/dt = j1*H2O + j21*CH2O + 1.4400001*j24*CH4 + r22*H*HO2 + r154*O1D*CH4 + - r3*O1D*H2 - r20*O*H2 - r29*OH*H2 - r66*CL*H2 - r122*F*H2 + d(H2402)/dt = - j50*H2402 - r118*O1D*H2402 + d(H2O2)/dt = r35*M*OH*OH + r36*HO2*HO2 + - j4*H2O2 - r21*O*H2O2 - r30*OH*H2O2 - r67*CL*H2O2 + d(H2SO4)/dt = r172*SO3*H2O + - j87*H2SO4 + d(HBR)/dt = r100*BR*CH2O + r101*BR*HO2 + - j51*HBR - r113*O*HBR - r114*OH*HBR - r119*O1D*HBR - r120*O1D*HBR + d(HCFC141B)/dt = - j52*HCFC141B - r136*OH*HCFC141B - r141*O1D*HCFC141B + d(HCFC142B)/dt = - j53*HCFC142B - r137*OH*HCFC142B - r142*O1D*HCFC142B + d(HCFC22)/dt = - j54*HCFC22 - r138*OH*HCFC22 - r143*O1D*HCFC22 + d(HCL)/dt = r64*CL*CH2O + r65*CL*CH4 + r66*CL*H2 + r67*CL*H2O2 + r68*CL*HO2 + r83*CLO*OH + r86*HOCL*CL + + r127*CH2BR2*CL + r129*CH3BR*CL + 2*r132*CH3CL*CL + r134*CHBR3*CL + - j55*HCL - r84*O*HCL - r85*OH*HCL - r96*O1D*HCL - r97*O1D*HCL - r178*HOCL*HCL + - r183*CLONO2*HCL - r184*HOCL*HCL - r185*HOBR*HCL - r188*CLONO2*HCL - r189*HOCL*HCL + - r190*HOBR*HCL - r193*CLONO2*HCL + d(HF)/dt = r121*F*CH4 + r122*F*H2 + r123*F*H2O + r124*F*HNO3 + - j56*HF + d(HNO3)/dt = 2*r174*N2O5 + .5*r175*NO2 + r176*NO3 + 2*r177*N2O5 + r179*BRONO2 + 2*r180*N2O5 + r181*CLONO2 + + r182*BRONO2 + r186*CLONO2 + r187*BRONO2 + 2*r191*N2O5 + r192*CLONO2 + r60*M*NO2*OH + + r144*CH2O*NO3 + r156*DMS*NO3 + r183*CLONO2*HCL + r188*CLONO2*HCL + r193*CLONO2*HCL + - j9*HNO3 - r61*OH*HNO3 - r124*F*HNO3 + d(HO2NO2)/dt = r58*M*NO2*HO2 + - j10*HO2NO2 - j11*HO2NO2 - r62*M*HO2NO2 - r37*OH*HO2NO2 + d(HOBR)/dt = r179*BRONO2 + r182*BRONO2 + r187*BRONO2 + r107*BRO*HO2 + - j57*HOBR - r115*O*HOBR - r185*HCL*HOBR - r190*HCL*HOBR + d(HOCL)/dt = r181*CLONO2 + r186*CLONO2 + r192*CLONO2 + r75*CLO*HO2 + r80*CLONO2*OH + - j58*HOCL - r86*CL*HOCL - r87*O*HOCL - r88*OH*HOCL - r178*HCL*HOCL - r184*HCL*HOCL + - r189*HCL*HOCL + d(N)/dt = j64*N2 + .8*j66*N2 + .8*j68*N2 + j70*N2 + j15*NO + r210*N2*Op + r38*N2D*O + .2*r197*NOp*e + + 1.1*r199*N2p*e + r203*Np*O + r204*Np*O2 + - j62*N - r40*NO*N - r41*NO2*N - r42*NO2*N - r43*NO2*N - r44*O2*N - r52*OH*N - r206*O2p*N + d(N2O)/dt = r41*N*NO2 + - j12*N2O - r56*O1D*N2O - r57*O1D*N2O + d(N2O5)/dt = r59*M*NO2*NO3 + - j13*N2O5 - j14*N2O5 - r63*M*N2O5 - r174*N2O5 - r177*N2O5 - r180*N2O5 - r191*N2O5 + d(NO)/dt = j14*N2O5 + j17*NO2 + j19*NO3 + .5*r175*NO2 + r207*N2*O2p + r220*N2*Op2P + r39*N2D*O2 + + 2*r42*N*NO2 + r44*N*O2 + r45*NO2*O + r52*N*OH + 2*r56*O1D*N2O + r165*SO*NO2 + - j15*NO - j16*NO - r40*N*NO - r49*NO3*NO - r53*HO2*NO - r54*O3*NO - r55*M*O*NO - r76*CLO*NO + - r108*BRO*NO - r148*CH3O2*NO - r208*O2p*NO + d(NO2)/dt = j9*HNO3 + j11*HO2NO2 + j13*N2O5 + j18*NO3 + j28*BRONO2 + j47*CLONO2 + r62*M*HO2NO2 + r63*M*N2O5 + + r37*HO2NO2*OH + r48*NO3*HO2 + 2*r49*NO3*NO + r50*NO3*O + r51*NO3*OH + r53*NO*HO2 + r54*NO*O3 + + r55*M*NO*O + r76*CLO*NO + r108*BRO*NO + r148*CH3O2*NO + - j17*NO2 - r175*NO2 - r41*N*NO2 - r42*N*NO2 - r43*N*NO2 - r45*O*NO2 - r46*O3*NO2 + - r47*M*O*NO2 - r58*M*HO2*NO2 - r59*M*NO3*NO2 - r60*M*OH*NO2 - r78*M*CLO*NO2 - r109*M*BRO*NO2 + - r165*SO*NO2 + d(NO3)/dt = j10*HO2NO2 + j13*N2O5 + j14*N2O5 + j29*BRONO2 + j46*CLONO2 + r63*M*N2O5 + r46*NO2*O3 + + r47*M*NO2*O + r61*HNO3*OH + r77*CLONO2*CL + r79*CLONO2*O + r80*CLONO2*OH + r110*BRONO2*O + + r124*F*HNO3 + - j18*NO3 - j19*NO3 - r176*NO3 - r48*HO2*NO3 - r49*NO*NO3 - r50*O*NO3 - r51*OH*NO3 + - r59*M*NO2*NO3 - r144*CH2O*NO3 - r156*DMS*NO3 + d(O)/dt = j2*H2O + 2*j5*O2 + j6*O2 + j8*O3 + j14*N2O5 + j15*NO + j17*NO2 + j18*NO3 + .18*j24*CH4 + + j25*CO2 + j27*BRO + j45*CLO + j59*OCLO + j61*CO2 + j77*O2 + j79*O2 + j81*O2 + 2*j82*O2 + + 2*j83*O2 + j84*O2 + j85*O2 + j86*O2 + j89*SO + j90*SO2 + j91*SO3 + r5*N2*O1D + r214*N2*Op2D + + r219*N2*Op2P + r6*O1D*O2 + r7*O1D*O2 + r24*H*HO2 + r34*OH*OH + r40*N*NO + r41*N*NO2 + r44*N*O2 + + r160*S*O2 + r166*SO*O2 + r197*NOp*e + 1.15*r198*O2p*e + r205*Np*O2 + r206*O2p*N + r211*Op*N2D + + r212*Op*O2 + r216*Op2D*O2 + - j71*O - j72*O - j73*O - j74*O - j75*O - j76*O - r17*O3*O - 2*r18*M*O*O - r19*M*O2*O + - r20*H2*O - r21*H2O2*O - r26*HO2*O - r32*OH*O - r45*NO2*O - r47*M*NO2*O - r50*NO3*O + - r55*M*NO*O - r79*CLONO2*O - r81*CLO*O - r84*HCL*O - r87*HOCL*O - r110*BRONO2*O - r111*BRO*O + - r113*HBR*O - r115*HOBR*O - r145*CH2O*O - r158*OCS*O - r201*N2p*O - r202*N2p*O - r203*Np*O + d(O2)/dt = j8*O3 + j19*NO3 + r1*O2_1D + r2*O2_1S + r9*N2*O2_1D + r8*O1D*O3 + r8*O1D*O3 + r10*O2_1D*O + + 2*r11*O2_1D*O2 + 2*r17*O*O3 + r18*M*O*O + r22*H*HO2 + r26*HO2*O + 2*r27*HO2*O3 + r28*H*O3 + + r31*OH*HO2 + r32*OH*O + r33*OH*O3 + r36*HO2*HO2 + r37*HO2NO2*OH + r43*N*NO2 + r45*NO2*O + + r46*NO2*O3 + r48*NO3*HO2 + r50*NO3*O + r54*NO*O3 + r57*O1D*N2O + r68*CL*HO2 + r70*CL*O3 + + r72*CLO*CLO + r73*CLO*CLO + r75*CLO*HO2 + r81*CLO*O + r83*CLO*OH + r101*BR*HO2 + r102*BR*O3 + + r103*BRO*BRO + r105*BRO*CLO + r106*BRO*CLO + r107*BRO*HO2 + r111*BRO*O + r147*CH3O2*HO2 + + r161*S*O3 + r167*SO*O3 + r208*O2p*NO + - j5*O2 - j6*O2 - j77*O2 - j78*O2 - j79*O2 - j80*O2 - j81*O2 - j82*O2 - j83*O2 - j84*O2 + - j85*O2 - j86*O2 - r6*O1D*O2 - r11*O2_1D*O2 - r19*M*O*O2 - r25*M*H*O2 - r39*N2D*O2 - r44*N*O2 + - r160*S*O2 - r166*SO*O2 - r200*N2p*O2 - r204*Np*O2 - r205*Np*O2 - r212*Op*O2 - r216*Op2D*O2 + d(O3)/dt = r19*M*O*O2 + - j7*O3 - j8*O3 - r8*O1D*O3 - r17*O*O3 - r27*HO2*O3 - r28*H*O3 - r33*OH*O3 - r46*NO2*O3 + - r54*NO*O3 - r70*CL*O3 - r102*BR*O3 - r161*S*O3 - r167*SO*O3 + d(OCLO)/dt = r74*CLO*CLO + r104*BRO*CLO + - j59*OCLO - r168*SO*OCLO + d(OCS)/dt = - j88*OCS - r158*O*OCS - r159*OH*OCS + d(S)/dt = j88*OCS + j89*SO + - r160*O2*S - r161*O3*S - r164*OH*S + d(SF6)/dt = - j60*SF6 + d(SO)/dt = j90*SO2 + r158*OCS*O + r160*S*O2 + r161*S*O3 + r164*S*OH + - j89*SO - r162*BRO*SO - r163*CLO*SO - r165*NO2*SO - r166*O2*SO - r167*O3*SO - r168*OCLO*SO + - r169*OH*SO + d(SO2)/dt = j91*SO3 + r156*DMS*NO3 + r157*DMS*OH + r159*OCS*OH + r162*SO*BRO + r163*SO*CLO + r165*SO*NO2 + + r166*SO*O2 + r167*SO*O3 + r168*SO*OCLO + r169*SO*OH + .5*r170*DMS*OH + - j90*SO2 - r171*OH*SO2 + d(SO3)/dt = j87*H2SO4 + r171*SO2*OH + - j91*SO3 - r172*H2O*SO3 + d(SOAG)/dt = 0 + d(e)/dt = j63*N2 + j64*N2 + j65*N2 + j67*N2 + j69*N2 + j70*N2 + j16*NO + j62*N + j71*O + j72*O + j73*O + + j74*O + j75*O + j76*O + j77*O2 + j78*O2 + j79*O2 + j80*O2 + j81*O2 + j84*O2 + j85*O2 + + j86*O2 + - r197*NOp*e - r198*O2p*e - r199*N2p*e + d(HO2)/dt = j11*HO2NO2 + r62*M*HO2NO2 + r21*H2O2*O + r25*M*H*O2 + r30*OH*H2O2 + r33*OH*O3 + r51*NO3*OH + + r64*CL*CH2O + r67*CL*H2O2 + r71*CLO*CH3O2 + r82*CLO*OH + r100*BR*CH2O + r112*BRO*OH + + r129*CH3BR*CL + r130*CH3BR*OH + r132*CH3CL*CL + r133*CH3CL*OH + r144*CH2O*NO3 + r145*CH2O*O + + r148*CH3O2*NO + r151*M*CO*OH + r153*O1D*CH4 + .5*r170*DMS*OH + r171*SO2*OH + - r173*HO2 - r22*H*HO2 - r23*H*HO2 - r24*H*HO2 - r26*O*HO2 - r27*O3*HO2 - r31*OH*HO2 + - 2*r36*HO2*HO2 - r48*NO3*HO2 - r53*NO*HO2 - r58*M*NO2*HO2 - r68*CL*HO2 - r69*CL*HO2 + - r75*CLO*HO2 - r101*BR*HO2 - r107*BRO*HO2 - r147*CH3O2*HO2 + d(N2D)/dt = j65*N2 + 1.2*j66*N2 + 1.2*j68*N2 + j69*N2 + .8*r197*NOp*e + .9*r199*N2p*e + r201*N2p*O + - r38*O*N2D - r39*O2*N2D - r211*Op*N2D + d(N2p)/dt = j63*N2 + j67*N2 + r214*N2*Op2D + r219*N2*Op2P + - r199*e*N2p - r200*O2*N2p - r201*O*N2p - r202*O*N2p + d(NOp)/dt = j16*NO + r207*N2*O2p + r210*N2*Op + r201*N2p*O + r205*Np*O2 + r206*O2p*N + r208*O2p*NO + - r197*e*NOp + d(Np)/dt = j64*N2 + j65*N2 + j69*N2 + j70*N2 + j62*N + r220*N2*Op2P + r211*Op*N2D + - r203*O*Np - r204*O2*Np - r205*O2*Np + d(O1D)/dt = j1*H2O + j6*O2 + j7*O3 + j12*N2O + r39*N2D*O2 + .85*r198*O2p*e + - r5*N2*O1D - r3*H2*O1D - r4*H2O*O1D - r6*O2*O1D - r7*O2*O1D - r8*O3*O1D - r56*N2O*O1D + - r57*N2O*O1D - r89*CCL4*O1D - r90*CF2CLBR*O1D - r91*CFC11*O1D - r92*CFC113*O1D - r93*CFC114*O1D + - r94*CFC115*O1D - r95*CFC12*O1D - r96*HCL*O1D - r97*HCL*O1D - r116*CF3BR*O1D - r117*CHBR3*O1D + - r118*H2402*O1D - r119*HBR*O1D - r120*HBR*O1D - r125*COF2*O1D - r126*COFCL*O1D + - r139*CH2BR2*O1D - r140*CH3BR*O1D - r141*HCFC141B*O1D - r142*HCFC142B*O1D - r143*HCFC22*O1D + - r152*CH4*O1D - r153*CH4*O1D - r154*CH4*O1D + d(O2_1D)/dt = j7*O3 + r13*N2*O2_1S + r12*O2_1S*CO2 + r14*O2_1S*O + r15*O2_1S*O2 + r16*O2_1S*O3 + - r1*O2_1D - r9*N2*O2_1D - r10*O*O2_1D - r11*O2*O2_1D + d(O2_1S)/dt = r6*O1D*O2 + - r2*O2_1S - r13*N2*O2_1S - r12*CO2*O2_1S - r14*O*O2_1S - r15*O2*O2_1S - r16*O3*O2_1S + d(O2p)/dt = j78*O2 + j80*O2 + r200*N2p*O2 + r204*Np*O2 + r209*Op*CO2 + r212*Op*O2 + r216*Op2D*O2 + - r207*N2*O2p - r198*e*O2p - r206*N*O2p - r208*NO*O2p + d(OH)/dt = j3*H2O + 2*j4*H2O2 + j9*HNO3 + j10*HO2NO2 + j22*CH3OOH + .33*j24*CH4 + j57*HOBR + j58*HOCL + + .5*r175*NO2 + r3*O1D*H2 + 2*r4*O1D*H2O + r20*H2*O + r21*H2O2*O + 2*r23*H*HO2 + r26*HO2*O + + r27*HO2*O3 + r28*H*O3 + r48*NO3*HO2 + r53*NO*HO2 + r69*CL*HO2 + r84*HCL*O + r87*HOCL*O + + r96*O1D*HCL + r113*HBR*O + r115*HOBR*O + r119*O1D*HBR + r123*F*H2O + r145*CH2O*O + + .3*r149*CH3OOH*OH + r152*O1D*CH4 + - r29*H2*OH - r30*H2O2*OH - r31*HO2*OH - r32*O*OH - r33*O3*OH - 2*r34*OH*OH - 2*r35*M*OH*OH + - r37*HO2NO2*OH - r51*NO3*OH - r52*N*OH - r60*M*NO2*OH - r61*HNO3*OH - r80*CLONO2*OH + - r82*CLO*OH - r83*CLO*OH - r85*HCL*OH - r88*HOCL*OH - r112*BRO*OH - r114*HBR*OH + - r128*CH2BR2*OH - r130*CH3BR*OH - r131*CH3CCL3*OH - r133*CH3CL*OH - r135*CHBR3*OH + - r136*HCFC141B*OH - r137*HCFC142B*OH - r138*HCFC22*OH - r146*CH2O*OH - r149*CH3OOH*OH + - r150*CH4*OH - r151*M*CO*OH - r155*CO*OH - r157*DMS*OH - r159*OCS*OH - r164*S*OH - r169*SO*OH + - r170*DMS*OH - r171*SO2*OH + d(Op)/dt = j73*O + j74*O + j79*O2 + j81*O2 + r194*Op2P + r195*Op2D + r202*N2p*O + r203*Np*O + r213*Op2D*e + + r215*Op2D*O + r218*Op2P*e + r221*Op2P*O + - r210*N2*Op - r209*CO2*Op - r211*N2D*Op - r212*O2*Op + d(Op2D)/dt = j75*O + j76*O + j85*O2 + j86*O2 + r196*Op2P + r217*Op2P*e + - r195*Op2D - r214*N2*Op2D - r213*e*Op2D - r215*O*Op2D - r216*O2*Op2D + d(Op2P)/dt = j71*O + j72*O + j77*O2 + j84*O2 + - r194*Op2P - r196*Op2P - r219*N2*Op2P - r220*N2*Op2P - r217*e*Op2P - r218*e*Op2P + - r221*O*Op2P + d(H2O)/dt = .05*j24*CH4 + j87*H2SO4 + r173*HO2 + r24*H*HO2 + r29*OH*H2 + r30*OH*H2O2 + r31*OH*HO2 + + r34*OH*OH + r37*HO2NO2*OH + r61*HNO3*OH + r85*HCL*OH + r88*HOCL*OH + r114*HBR*OH + + r128*CH2BR2*OH + r130*CH3BR*OH + r131*CH3CCL3*OH + r133*CH3CL*OH + r138*HCFC22*OH + + r146*CH2O*OH + r149*CH3OOH*OH + r150*CH4*OH + r178*HOCL*HCL + r184*HOCL*HCL + r185*HOBR*HCL + + r189*HOCL*HCL + r190*HOBR*HCL + - j1*H2O - j2*H2O - j3*H2O - r4*O1D*H2O - r123*F*H2O - r172*SO3*H2O diff --git a/src/chemistry/pp_waccm_ma_noaero/chem_mech.in b/src/chemistry/pp_waccm_ma_noaero/chem_mech.in new file mode 100644 index 0000000000..1b1aa8b452 --- /dev/null +++ b/src/chemistry/pp_waccm_ma_noaero/chem_mech.in @@ -0,0 +1,622 @@ +* Comments +* User-given Tag Description: WACCM_MA_MAM4_2 +* Tag database identifier : MZ279_MA_MAM4_20200925 +* Tag created by : lke +* Tag created from branch : MA_MAM4 +* Tag created on : 2020-09-25 11:46:07.598596-06 +* Comments for this tag follow: +* lke : 2020-09-25 : Middle Atmosphere mechanism. +* Corrected removing BR, CL from non-transported. + + SPECIES + + Solution + BR -> Br, + BRCL -> BrCl, + BRO -> BrO, + BRONO2 -> BrONO2, + BRY, + CCL4 -> CCl4, + CF2CLBR -> CF2ClBr, + CF3BR -> CF3Br, + CFC11 -> CFCl3, + CFC113 -> CCl2FCClF2, + CFC114 -> CClF2CClF2, + CFC115 -> CClF2CF3, + CFC12 -> CF2Cl2, + CH2BR2 -> CH2Br2, + CH2O, + CH3BR -> CH3Br, + CH3CCL3 -> CH3CCl3, + CH3CL -> CH3Cl, + CH3O2, + CH3OOH, + CH4, + CHBR3 -> CHBr3, + CL -> Cl, + CL2 -> Cl2, + CL2O2 -> Cl2O2, + CLO -> ClO, + CLONO2 -> ClONO2, + CLY, + CO, + CO2, + COF2, + COFCL -> COFCl, + DMS -> CH3SCH3, + F, + H, + H2, + H2402 -> CBrF2CBrF2, + H2O2, + H2SO4 -> H2SO4, + HBR -> HBr, + HCFC141B -> CH3CCl2F, + HCFC142B -> CH3CClF2, + HCFC22 -> CHF2Cl, + HCL -> HCl, + HF, + HNO3, + HO2NO2, + HOBR -> HOBr, + HOCL -> HOCl, + N, + N2O, + N2O5, + NO, + NO2, + NO3, + O, + O2, + O3, + OCLO -> OClO, + OCS -> OCS, + S -> S, + SF6, + SO -> SO, + SO2, + SO3 -> SO3, + SOAG -> C, + e -> E, + HO2, + N2D -> N, + N2p -> N2, + NOp -> NO, + Np -> N, + O1D -> O, + O2_1D -> O2, + O2_1S -> O2, + O2p -> O2, + OH, + Op -> O, + Op2D -> O, + Op2P -> O, + H2O + + End Solution + + + Fixed + M, N2 + End Fixed + + Col-int + O3 = 0. + O2 = 0. + End Col-int + + Not-Transported + e, + HO2, + N2D, + N2p, + NOp, + Np, + O1D, + O2_1D, + O2_1S, + O2p, + OH, + Op, + Op2D, + Op2P + End Not-Transported + + END Species + + + Solution classes + Explicit + BRY + CCL4 + CF2CLBR + CF3BR + CFC11 + CFC113 + CFC114 + CFC115 + CFC12 + CH2BR2 + CH3BR + CH3CCL3 + CH3CL + CH4 + CHBR3 + CLY + CO2 + H2402 + HCFC141B + HCFC142B + HCFC22 + N2O + SF6 + End Explicit + + Implicit + BR + BRCL + BRO + BRONO2 + CH2O + CH3O2 + CH3OOH + CL + CL2 + CL2O2 + CLO + CLONO2 + CO + COF2 + COFCL + DMS + F + H + H2 + H2O2 + H2SO4 + HBR + HCL + HF + HNO3 + HO2NO2 + HOBR + HOCL + N + N2O5 + NO + NO2 + NO3 + O + O2 + O3 + OCLO + OCS + S + SO + SO2 + SO3 + SOAG + e + HO2 + N2D + N2p + NOp + Np + O1D + O2_1D + O2_1S + O2p + OH + Op + Op2D + Op2P + H2O + End Implicit + + End Solution classes + + + CHEMISTRY + Photolysis +********************************* +*** odd-oxygen +********************************* +[jh2o_b] H2O + hv -> H2 + O1D +[jh2o_c] H2O + hv -> 2*H + O +[jh2o_a] H2O + hv -> OH + H +[jh2o2] H2O2 + hv -> 2*OH +[jo2_b=userdefined,] O2 + hv -> 2*O +[jo2_a=userdefined,] O2 + hv -> O + O1D +[jo3_a] O3 + hv -> O1D + O2_1D +[jo3_b] O3 + hv -> O + O2 +********************************* +*** odd-nitrogen +********************************* +[jhno3] HNO3 + hv -> NO2 + OH +[jho2no2_a] HO2NO2 + hv -> OH + NO3 +[jho2no2_b] HO2NO2 + hv -> NO2 + HO2 +[jn2o] N2O + hv -> O1D + N2 +[jn2o5_a] N2O5 + hv -> NO2 + NO3 +[jn2o5_b] N2O5 + hv -> NO + O + NO3 +[jno=userdefined,] NO + hv -> N + O +[jno_i] NO + hv -> NOp + e +[jno2] NO2 + hv -> NO + O +[jno3_a] NO3 + hv -> NO2 + O +[jno3_b] NO3 + hv -> NO + O2 +********************************* +*** organics +********************************* +[jch2o_a] CH2O + hv -> CO + 2*H +[jch2o_b] CH2O + hv -> CO + H2 +[jch3ooh] CH3OOH + hv -> CH2O + H + OH +[jch4_a] CH4 + hv -> H + CH3O2 +[jch4_b] CH4 + hv -> 1.44*H2 + 0.18*CH2O + 0.18*O + 0.33*OH + 0.33*H + 0.44*CO2 + 0.38*CO + 0.05*H2O +[jco2] CO2 + hv -> CO + O +********************************* +*** halogens +********************************* +[jbrcl] BRCL + hv -> BR + CL +[jbro] BRO + hv -> BR + O +[jbrono2_b] BRONO2 + hv -> BRO + NO2 +[jbrono2_a] BRONO2 + hv -> BR + NO3 +[jccl4] CCL4 + hv -> 4*CL +[jcf2clbr] CF2CLBR + hv -> BR + CL + COF2 +[jcf3br] CF3BR + hv -> BR + F + COF2 +[jcfcl3] CFC11 + hv -> 2*CL + COFCL +[jcfc113] CFC113 + hv -> 2*CL + COFCL + COF2 +[jcfc114] CFC114 + hv -> 2*CL + 2*COF2 +[jcfc115] CFC115 + hv -> CL + F + 2*COF2 +[jcf2cl2] CFC12 + hv -> 2*CL + COF2 +[jch2br2] CH2BR2 + hv -> 2*BR +[jch3br] CH3BR + hv -> BR + CH3O2 +[jch3ccl3] CH3CCL3 + hv -> 3*CL +[jch3cl] CH3CL + hv -> CL + CH3O2 +[jchbr3] CHBR3 + hv -> 3*BR +[jcl2] CL2 + hv -> 2*CL +[jcl2o2] CL2O2 + hv -> 2*CL +[jclo] CLO + hv -> CL + O +[jclono2_a] CLONO2 + hv -> CL + NO3 +[jclono2_b] CLONO2 + hv -> CLO + NO2 +[jcof2] COF2 + hv -> 2*F +[jcofcl] COFCL + hv -> F + CL +[jh2402] H2402 + hv -> 2*BR + 2*COF2 +[jhbr] HBR + hv -> BR + H +[jhcfc141b] HCFC141B + hv -> CL + COFCL +[jhcfc142b] HCFC142B + hv -> CL + COF2 +[jhcfc22] HCFC22 + hv -> CL + COF2 +[jhcl] HCL + hv -> H + CL +[jhf] HF + hv -> H + F +[jhobr] HOBR + hv -> BR + OH +[jhocl] HOCL + hv -> OH + CL +[joclo] OCLO + hv -> O + CLO +[jsf6] SF6 + hv -> sink +********************************* +*** ions +********************************* +[jeuv_26=userdefined,userdefined] CO2 + hv -> CO + O +[jeuv_4=userdefined,userdefined] N + hv -> Np + e +[jeuv_6=userdefined,userdefined] N2 + hv -> N2p + e +[jeuv_22=userdefined,userdefined] N2 + hv -> N + Np + e +[jeuv_23=userdefined,userdefined] N2 + hv -> N2D + Np + e +[jeuv_25=userdefined,userdefined] N2 + hv -> 1.2*N2D + 0.8*N +[jeuv_18=userdefined,userdefined] N2 + hv -> N2p + e +[jeuv_13=userdefined,userdefined] N2 + hv -> 1.2*N2D + 0.8*N +[jeuv_11=userdefined,userdefined] N2 + hv -> N2D + Np + e +[jeuv_10=userdefined,userdefined] N2 + hv -> N + Np + e +[jeuv_3=userdefined,userdefined] O + hv -> Op2P + e +[jeuv_16=userdefined,userdefined] O + hv -> Op2P + e +[jeuv_1=userdefined,userdefined] O + hv -> Op + e +[jeuv_14=userdefined,userdefined] O + hv -> Op + e +[jeuv_2=userdefined,userdefined] O + hv -> Op2D + e +[jeuv_15=userdefined,userdefined] O + hv -> Op2D + e +[jeuv_21=userdefined,userdefined] O2 + hv -> O + Op2P + e +[jeuv_17=userdefined,userdefined] O2 + hv -> O2p + e +[jeuv_7=userdefined,userdefined] O2 + hv -> O + Op + e +[jeuv_5=userdefined,userdefined] O2 + hv -> O2p + e +[jeuv_19=userdefined,userdefined] O2 + hv -> O + Op + e +[jeuv_24=userdefined,userdefined] O2 + hv -> 2*O +[jeuv_12=userdefined,userdefined] O2 + hv -> 2*O +[jeuv_9=userdefined,userdefined] O2 + hv -> O + Op2P + e +[jeuv_8=userdefined,userdefined] O2 + hv -> O + Op2D + e +[jeuv_20=userdefined,userdefined] O2 + hv -> O + Op2D + e +********************************* +*** sulfur +********************************* +[jh2so4] H2SO4 + hv -> SO3 + H2O +[jocs] OCS + hv -> S + CO +[jso] SO + hv -> S + O +[jso2] SO2 + hv -> SO + O +[jso3] SO3 + hv -> SO2 + O + End Photolysis + + Reactions +********************************* +*** odd-oxygen +********************************* +[ag1] O2_1D -> O2 ; 0.000258 +[ag2] O2_1S -> O2 ; 0.085 +[O1D_H2] O1D + H2 -> H + OH ; 1.2e-10 +[O1D_H2O] O1D + H2O -> 2*OH ; 1.63e-10, 60 +[O1D_N2,cph=189.81] O1D + N2 -> O + N2 ; 2.15e-11, 110 +[O1D_O2,cph=32.91] O1D + O2 -> O + O2_1S ; 2.64e-11, 55 +[O1D_O2b,cph=189.81] O1D + O2 -> O + O2 ; 6.6e-12, 55 +[O1D_O3] O1D + O3 -> O2 + O2 ; 1.2e-10 +[O2_1D_N2,cph=94.3] O2_1D + N2 -> O2 + N2 ; 1e-20 +[O2_1D_O,cph=94.3] O2_1D + O -> O2 + O ; 1.3e-16 +[O2_1D_O2,cph=94.3] O2_1D + O2 -> 2*O2 ; 3.6e-18, -220 +[O2_1S_CO2] O2_1S + CO2 -> O2_1D + CO2 ; 4.2e-13 +[O2_1S_N2,cph=62.6] O2_1S + N2 -> O2_1D + N2 ; 1.8e-15, 45 +[O2_1S_O,cph=62.6] O2_1S + O -> O2_1D + O ; 8e-14 +[O2_1S_O2,cph=62.6] O2_1S + O2 -> O2_1D + O2 ; 3.9e-17 +[O2_1S_O3,cph=62.6] O2_1S + O3 -> O2_1D + O3 ; 3.5e-11, -135 +[O_O3,cph=392.19] O + O3 -> 2*O2 ; 8e-12, -2060 +[usr_O_O,cph=493.58] O + O + M -> O2 + M +[usr_O_O2,cph=101.39] O + O2 + M -> O3 + M +********************************* +*** odd-hydrogen +********************************* +[H2_O] H2 + O -> OH + H ; 1.6e-11, -4570 +[H2O2_O] H2O2 + O -> OH + HO2 ; 1.4e-12, -2000 +[H_HO2,cph=232.59] H + HO2 -> H2 + O2 ; 6.9e-12 +[H_HO2a] H + HO2 -> 2*OH ; 7.2e-11 +[H_HO2b] H + HO2 -> H2O + O ; 1.6e-12 +[H_O2,cph=203.4] H + O2 + M -> HO2 + M ; 4.4e-32, 1.3, 7.5e-11, -0.2, 0.6 +[HO2_O,cph=226.58] HO2 + O -> OH + O2 ; 3e-11, 200 +[HO2_O3,cph=120.1] HO2 + O3 -> OH + 2*O2 ; 1e-14, -490 +[H_O3,cph=194.71] H + O3 -> OH + O2 ; 1.4e-10, -470 +[OH_H2] OH + H2 -> H2O + H ; 2.8e-12, -1800 +[OH_H2O2] OH + H2O2 -> H2O + HO2 ; 1.8e-12 +[OH_HO2,cph=293.62] OH + HO2 -> H2O + O2 ; 4.8e-11, 250 +[OH_O,cph=67.67] OH + O -> H + O2 ; 1.8e-11, 180 +[OH_O3,cph=165.3] OH + O3 -> HO2 + O2 ; 1.7e-12, -940 +[OH_OH] OH + OH -> H2O + O ; 1.8e-12 +[OH_OH_M] OH + OH + M -> H2O2 + M ; 6.9e-31, 1, 2.6e-11, 0, 0.6 +[usr_HO2_HO2,cph=165.51] HO2 + HO2 -> H2O2 + O2 +********************************* +*** odd-nitrogen +********************************* +[HO2NO2_OH] HO2NO2 + OH -> H2O + NO2 + O2 ; 1.3e-12, 380 +[N2D_O,cph=229.61] N2D + O -> N + O ; 7e-13 +[N2D_O2,cph=177.51] N2D + O2 -> NO + O1D ; 5e-12 +[N_NO,cph=313.75] N + NO -> N2 + O ; 2.1e-11, 100 +[N_NO2a] N + NO2 -> N2O + O ; 2.9e-12, 220 +[N_NO2b] N + NO2 -> 2*NO ; 1.45e-12, 220 +[N_NO2c] N + NO2 -> N2 + O2 ; 1.45e-12, 220 +[N_O2,cph=133.75] N + O2 -> NO + O ; 1.5e-11, -3600 +[NO2_O,cph=193.02] NO2 + O -> NO + O2 ; 5.1e-12, 210 +[NO2_O3] NO2 + O3 -> NO3 + O2 ; 1.2e-13, -2450 +[NO2_O_M] NO2 + O + M -> NO3 + M ; 2.5e-31, 1.8, 2.2e-11, 0.7, 0.6 +[NO3_HO2] NO3 + HO2 -> OH + NO2 + O2 ; 3.5e-12 +[NO3_NO] NO3 + NO -> 2*NO2 ; 1.5e-11, 170 +[NO3_O] NO3 + O -> NO2 + O2 ; 1e-11 +[NO3_OH] NO3 + OH -> HO2 + NO2 ; 2.2e-11 +[N_OH] N + OH -> NO + H ; 5e-11 +[NO_HO2,cph=34.47] NO + HO2 -> NO2 + OH ; 3.3e-12, 270 +[NO_O3,cph=199.17] NO + O3 -> NO2 + O2 ; 3e-12, -1500 +[NO_O_M] NO + O + M -> NO2 + M ; 9e-32, 1.5, 3e-11, 0, 0.6 +[O1D_N2Oa] O1D + N2O -> 2*NO ; 7.26e-11, 20 +[O1D_N2Ob] O1D + N2O -> N2 + O2 ; 4.64e-11, 20 +[tag_NO2_HO2] NO2 + HO2 + M -> HO2NO2 + M ; 1.9e-31, 3.4, 4e-12, 0.3, 0.6 +[tag_NO2_NO3] NO2 + NO3 + M -> N2O5 + M ; 2.4e-30, 3, 1.6e-12, -0.1, 0.6 +[tag_NO2_OH] NO2 + OH + M -> HNO3 + M ; 1.8e-30, 3, 2.8e-11, 0, 0.6 +[usr_HNO3_OH] HNO3 + OH -> NO3 + H2O +[usr_HO2NO2_M] HO2NO2 + M -> HO2 + NO2 + M +[usr_N2O5_M] N2O5 + M -> NO2 + NO3 + M +********************************* +*** odd-chlorine +********************************* +[CL_CH2O] CL + CH2O -> HCL + HO2 + CO ; 8.1e-11, -30 +[CL_CH4] CL + CH4 -> CH3O2 + HCL ; 7.1e-12, -1270 +[CL_H2] CL + H2 -> HCL + H ; 3.05e-11, -2270 +[CL_H2O2] CL + H2O2 -> HCL + HO2 ; 1.1e-11, -980 +[CL_HO2a] CL + HO2 -> HCL + O2 ; 1.4e-11, 270 +[CL_HO2b] CL + HO2 -> OH + CLO ; 3.6e-11, -375 +[CL_O3] CL + O3 -> CLO + O2 ; 2.3e-11, -200 +[CLO_CH3O2] CLO + CH3O2 -> CL + HO2 + CH2O ; 3.3e-12, -115 +[CLO_CLOa] CLO + CLO -> 2*CL + O2 ; 3e-11, -2450 +[CLO_CLOb] CLO + CLO -> CL2 + O2 ; 1e-12, -1590 +[CLO_CLOc] CLO + CLO -> CL + OCLO ; 3.5e-13, -1370 +[CLO_HO2] CLO + HO2 -> O2 + HOCL ; 2.6e-12, 290 +[CLO_NO] CLO + NO -> NO2 + CL ; 6.4e-12, 290 +[CLONO2_CL] CLONO2 + CL -> CL2 + NO3 ; 6.5e-12, 135 +[CLO_NO2_M] CLO + NO2 + M -> CLONO2 + M ; 1.8e-31, 3.4, 1.5e-11, 1.9, 0.6 +[CLONO2_O] CLONO2 + O -> CLO + NO3 ; 3.6e-12, -840 +[CLONO2_OH] CLONO2 + OH -> HOCL + NO3 ; 1.2e-12, -330 +[CLO_O] CLO + O -> CL + O2 ; 2.8e-11, 85 +[CLO_OHa] CLO + OH -> CL + HO2 ; 7.4e-12, 270 +[CLO_OHb] CLO + OH -> HCL + O2 ; 6e-13, 230 +[HCL_O] HCL + O -> CL + OH ; 1e-11, -3300 +[HCL_OH] HCL + OH -> H2O + CL ; 1.8e-12, -250 +[HOCL_CL] HOCL + CL -> HCL + CLO ; 3.4e-12, -130 +[HOCL_O] HOCL + O -> CLO + OH ; 1.7e-13 +[HOCL_OH] HOCL + OH -> H2O + CLO ; 3e-12, -500 +[O1D_CCL4] O1D + CCL4 -> 4*CL ; 2.607e-10 +[O1D_CF2CLBR] O1D + CF2CLBR -> CL + BR + COF2 ; 9.75e-11 +[O1D_CFC11] O1D + CFC11 -> 2*CL + COFCL ; 2.07e-10 +[O1D_CFC113] O1D + CFC113 -> 2*CL + COFCL + COF2 ; 2.088e-10 +[O1D_CFC114] O1D + CFC114 -> 2*CL + 2*COF2 ; 1.17e-10 +[O1D_CFC115] O1D + CFC115 -> CL + F + 2*COF2 ; 4.644e-11 +[O1D_CFC12] O1D + CFC12 -> 2*CL + COF2 ; 1.204e-10 +[O1D_HCLa] O1D + HCL -> CL + OH ; 9.9e-11 +[O1D_HCLb] O1D + HCL -> CLO + H ; 3.3e-12 +[tag_CLO_CLO_M] CLO + CLO + M -> CL2O2 + M ; 1.9e-32, 3.6, 3.7e-12, 1.6, 0.6 +[usr_CL2O2_M] CL2O2 + M -> CLO + CLO + M +********************************* +*** odd-bromine +********************************* +[BR_CH2O] BR + CH2O -> HBR + HO2 + CO ; 1.7e-11, -800 +[BR_HO2] BR + HO2 -> HBR + O2 ; 4.8e-12, -310 +[BR_O3] BR + O3 -> BRO + O2 ; 1.6e-11, -780 +[BRO_BRO] BRO + BRO -> 2*BR + O2 ; 1.5e-12, 230 +[BRO_CLOa] BRO + CLO -> BR + OCLO ; 9.5e-13, 550 +[BRO_CLOb] BRO + CLO -> BR + CL + O2 ; 2.3e-12, 260 +[BRO_CLOc] BRO + CLO -> BRCL + O2 ; 4.1e-13, 290 +[BRO_HO2] BRO + HO2 -> HOBR + O2 ; 4.5e-12, 460 +[BRO_NO] BRO + NO -> BR + NO2 ; 8.8e-12, 260 +[BRO_NO2_M] BRO + NO2 + M -> BRONO2 + M ; 5.2e-31, 3.2, 6.9e-12, 2.9, 0.6 +[BRONO2_O] BRONO2 + O -> BRO + NO3 ; 1.9e-11, 215 +[BRO_O] BRO + O -> BR + O2 ; 1.9e-11, 230 +[BRO_OH] BRO + OH -> BR + HO2 ; 1.7e-11, 250 +[HBR_O] HBR + O -> BR + OH ; 5.8e-12, -1500 +[HBR_OH] HBR + OH -> BR + H2O ; 5.5e-12, 200 +[HOBR_O] HOBR + O -> BRO + OH ; 1.2e-10, -430 +[O1D_CF3BR] O1D + CF3BR -> BR + F + COF2 ; 4.5e-11 +[O1D_CHBR3] O1D + CHBR3 -> 3*BR ; 4.62e-10 +[O1D_H2402] O1D + H2402 -> 2*BR + 2*COF2 ; 1.2e-10 +[O1D_HBRa] O1D + HBR -> BR + OH ; 9e-11 +[O1D_HBRb] O1D + HBR -> BRO + H ; 3e-11 +********************************* +*** odd-fluorine +********************************* +[F_CH4] F + CH4 -> HF + CH3O2 ; 1.6e-10, -260 +[F_H2] F + H2 -> HF + H ; 1.4e-10, -500 +[F_H2O] F + H2O -> HF + OH ; 1.4e-11, 0 +[F_HNO3] F + HNO3 -> HF + NO3 ; 6e-12, 400 +[O1D_COF2] O1D + COF2 -> 2*F ; 2.14e-11 +[O1D_COFCL] O1D + COFCL -> F + CL ; 1.9e-10 +********************************* +*** organic-halogens +********************************* +[CH2BR2_CL] CH2BR2 + CL -> 2*BR + HCL ; 6.3e-12, -800 +[CH2BR2_OH] CH2BR2 + OH -> 2*BR + H2O ; 2e-12, -840 +[CH3BR_CL] CH3BR + CL -> HCL + HO2 + BR ; 1.46e-11, -1040 +[CH3BR_OH] CH3BR + OH -> BR + H2O + HO2 ; 1.42e-12, -1150 +[CH3CCL3_OH] CH3CCL3 + OH -> H2O + 3*CL ; 1.64e-12, -1520 +[CH3CL_CL] CH3CL + CL -> HO2 + CO + 2*HCL ; 2.03e-11, -1100 +[CH3CL_OH] CH3CL + OH -> CL + H2O + HO2 ; 1.96e-12, -1200 +[CHBR3_CL] CHBR3 + CL -> 3*BR + HCL ; 4.85e-12, -850 +[CHBR3_OH] CHBR3 + OH -> 3*BR ; 9e-13, -360 +[HCFC141B_OH] HCFC141B + OH -> CL + COFCL ; 1.25e-12, -1600 +[HCFC142B_OH] HCFC142B + OH -> CL + COF2 ; 1.3e-12, -1770 +[HCFC22_OH] HCFC22 + OH -> H2O + CL + COF2 ; 9.2e-13, -1560 +[O1D_CH2BR2] O1D + CH2BR2 -> 2*BR ; 2.57e-10 +[O1D_CH3BR] O1D + CH3BR -> BR ; 1.8e-10 +[O1D_HCFC141B] O1D + HCFC141B -> CL + COFCL ; 1.794e-10 +[O1D_HCFC142B] O1D + HCFC142B -> CL + COF2 ; 1.3e-10 +[O1D_HCFC22] O1D + HCFC22 -> CL + COF2 ; 7.65e-11 +********************************* +*** C1 +********************************* +[CH2O_NO3] CH2O + NO3 -> CO + HO2 + HNO3 ; 6e-13, -2058 +[CH2O_O] CH2O + O -> HO2 + OH + CO ; 3.4e-11, -1600 +[CH2O_OH] CH2O + OH -> CO + H2O + H ; 5.5e-12, 125 +[CH3O2_HO2] CH3O2 + HO2 -> CH3OOH + O2 ; 4.1e-13, 750 +[CH3O2_NO] CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.8e-12, 300 +[CH3OOH_OH] CH3OOH + OH -> 0.7*CH3O2 + 0.3*OH + 0.3*CH2O + H2O ; 3.8e-12, 200 +[CH4_OH] CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775 +[CO_OH_M] CO + OH + M -> CO2 + HO2 + M ; 5.9e-33, 1, 1.1e-12, -1.3, 0.6 +[O1D_CH4a] O1D + CH4 -> CH3O2 + OH ; 1.31e-10 +[O1D_CH4b] O1D + CH4 -> CH2O + H + HO2 ; 3.5e-11 +[O1D_CH4c] O1D + CH4 -> CH2O + H2 ; 9e-12 +[usr_CO_OH_b] CO + OH -> CO2 + H +********************************* +*** Sulfur +********************************* +[DMS_NO3] DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520 +[DMS_OHa] DMS + OH -> SO2 ; 9.6e-12, -234 +[OCS_O] OCS + O -> SO + CO ; 2.1e-11, -2200 +[OCS_OH] OCS + OH -> SO2 + CO + H ; 7.2e-14, -1070 +[S_O2] S + O2 -> SO + O ; 2.3e-12 +[S_O3] S + O3 -> SO + O2 ; 1.2e-11 +[SO_BRO] SO + BRO -> SO2 + BR ; 5.7e-11 +[SO_CLO] SO + CLO -> SO2 + CL ; 2.8e-11 +[S_OH] S + OH -> SO + H ; 6.6e-11 +[SO_NO2] SO + NO2 -> SO2 + NO ; 1.4e-11 +[SO_O2] SO + O2 -> SO2 + O ; 1.6e-13, -2280 +[SO_O3] SO + O3 -> SO2 + O2 ; 3.4e-12, -1100 +[SO_OCLO] SO + OCLO -> SO2 + CLO ; 1.9e-12 +[SO_OH] SO + OH -> SO2 + H ; 2.7e-11, 335 +[usr_DMS_OH] DMS + OH -> 0.5*SO2 + 0.5*HO2 +[usr_SO2_OH] SO2 + OH -> SO3 + HO2 +[usr_SO3_H2O] SO3 + H2O -> H2SO4 +********************************* +*** Tropospheric Aerosol +********************************* +[usr_HO2_aer] HO2 -> H2O +[usr_N2O5_aer] N2O5 -> 2*HNO3 +[usr_NO2_aer] NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3 +[usr_NO3_aer] NO3 -> HNO3 +********************************* +*** Stratospheric Aerosol +********************************* +[het1] N2O5 -> 2*HNO3 +[het10] HOCL + HCL -> CL2 + H2O +[het11] BRONO2 -> HOBR + HNO3 +[het12] N2O5 -> 2*HNO3 +[het13] CLONO2 -> HOCL + HNO3 +[het14] BRONO2 -> HOBR + HNO3 +[het15] CLONO2 + HCL -> CL2 + HNO3 +[het16] HOCL + HCL -> CL2 + H2O +[het17] HOBR + HCL -> BRCL + H2O +[het2] CLONO2 -> HOCL + HNO3 +[het3] BRONO2 -> HOBR + HNO3 +[het4] CLONO2 + HCL -> CL2 + HNO3 +[het5] HOCL + HCL -> CL2 + H2O +[het6] HOBR + HCL -> BRCL + H2O +[het7] N2O5 -> 2*HNO3 +[het8] CLONO2 -> HOCL + HNO3 +[het9] CLONO2 + HCL -> CL2 + HNO3 +********************************* +*** Ions +********************************* +[ag247nm,cph=483.39] Op2P -> Op ; 0.047 +[ag373nm,cph=321.3] Op2D -> Op ; 7.7e-05 +[ag732nm,cph=163.06] Op2P -> Op2D ; 0.171 +[elec1,cph=82.389] NOp + e -> 0.2*N + 0.8*N2D + O +[elec2,cph=508.95] O2p + e -> 1.15*O + 0.85*O1D +[elec3,cph=354.83] N2p + e -> 1.1*N + 0.9*N2D +[ion_N2p_O2,cph=339.59] N2p + O2 -> O2p + N2 ; 6e-11 +[ion_N2p_Oa,cph=67.53] N2p + O -> NOp + N2D +[ion_N2p_Ob] N2p + O -> Op + N2 +[ion_Np_O,cph=95.55] Np + O -> Op + N ; 1e-12 +[ion_Np_O2a,cph=239.84] Np + O2 -> O2p + N ; 4e-10 +[ion_Np_O2b,cph=646.28] Np + O2 -> NOp + O ; 2e-10 +[ion_O2p_N,cph=406.16] O2p + N -> NOp + O ; 1e-10 +[ion_O2p_N2] O2p + N2 -> NOp + NO ; 5e-16 +[ion_O2p_NO,cph=271.38] O2p + NO -> NOp + O2 ; 4.4e-10 +[ion_Op_CO2] Op + CO2 -> O2p + CO ; 9e-10 +[ion_Op_N2,cph=105.04] Op + N2 -> NOp + N +[ion_Op_N2D,cph=139.9] Op + N2D -> Np + O ; 1.3e-10 +[ion_Op_O2,cph=150.11] Op + O2 -> O2p + O +[Op2D_e,cph=319.37] Op2D + e -> Op + e +[Op2D_N2,cph=128.32] Op2D + N2 -> N2p + O ; 8e-10 +[Op2D_O,cph=319.36] Op2D + O -> Op + O ; 5e-12 +[Op2D_O2,cph=469.4] Op2D + O2 -> O2p + O ; 7e-10 +[Op2P_ea,cph=163.06] Op2P + e -> Op2D + e +[Op2P_eb,cph=482.43] Op2P + e -> Op + e +[Op2P_N2a,cph=291.38] Op2P + N2 -> N2p + O ; 4.8e-10 +[Op2P_N2b,cph=67.54] Op2P + N2 -> Np + NO ; 1e-10 +[Op2P_O,cph=501.72] Op2P + O -> Op + O ; 4e-10 + End Reactions + + Ext Forcing + DMS <- dataset + CO <- dataset + NO <- dataset + NO2 <- dataset + SO2 <- dataset + N + N2D + N2p + Op + e + Np + O2p + OH + End Ext Forcing + + End Chemistry + + SIMULATION PARAMETERS + + Version Options + machine = nec + model = cam + model_architecture = VECTOR + vector_length = 32 + architecture = hybrid + namemod = on + End Version Options + + + End Simulation Parameters diff --git a/src/chemistry/pp_waccm_ma_noaero/chem_mods.F90 b/src/chemistry/pp_waccm_ma_noaero/chem_mods.F90 new file mode 100644 index 0000000000..822410bf32 --- /dev/null +++ b/src/chemistry/pp_waccm_ma_noaero/chem_mods.F90 @@ -0,0 +1,51 @@ + module chem_mods +!-------------------------------------------------------------- +! ... Basic chemistry parameters and arrays +!-------------------------------------------------------------- + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + save + integer, parameter :: phtcnt = 91, & ! number of photolysis reactions + rxntot = 312, & ! number of total reactions + gascnt = 221, & ! number of gas phase reactions + nabscol = 2, & ! number of absorbing column densities + gas_pcnst = 81, & ! number of "gas phase" species + nfs = 2, & ! number of "fixed" species + relcnt = 0, & ! number of relationship species + grpcnt = 0, & ! number of group members + nzcnt = 745, & ! number of non-zero matrix entries + extcnt = 13, & ! number of species with external forcing + clscnt1 = 23, & ! number of species in explicit class + clscnt2 = 0, & ! number of species in hov class + clscnt3 = 0, & ! number of species in ebi class + clscnt4 = 58, & ! number of species in implicit class + clscnt5 = 0, & ! number of species in rodas class + indexm = 1, & ! index of total atm density in invariant array + indexh2o = 0, & ! index of water vapor density + clsze = 1, & ! loop length for implicit chemistry + rxt_tag_cnt = 312, & + enthalpy_cnt = 54, & + nslvd = 14 + integer :: clscnt(5) = 0 + integer :: cls_rxt_cnt(4,5) = 0 + integer :: clsmap(gas_pcnst,5) = 0 + integer :: permute(gas_pcnst,5) = 0 + integer :: diag_map(clscnt4) = 0 + real(r8) :: adv_mass(gas_pcnst) = 0._r8 + real(r8) :: crb_mass(gas_pcnst) = 0._r8 + real(r8) :: fix_mass(max(1,nfs)) + real(r8), allocatable :: cph_enthalpy(:) + integer, allocatable :: cph_rid(:) + integer, allocatable :: num_rnts(:) + integer, allocatable :: rxt_tag_map(:) + real(r8), allocatable :: pht_alias_mult(:,:) + character(len=32), allocatable :: rxt_tag_lst(:) + character(len=16), allocatable :: pht_alias_lst(:,:) + character(len=16) :: inv_lst(max(1,nfs)) + character(len=16) :: extfrc_lst(max(1,extcnt)) + logical :: frc_from_dataset(max(1,extcnt)) + logical :: is_vector + logical :: is_scalar + character(len=16) :: slvd_lst(max(1,nslvd)) + integer, parameter :: veclen = 32 + end module chem_mods diff --git a/src/chemistry/pp_waccm_ma_noaero/m_rxt_id.F90 b/src/chemistry/pp_waccm_ma_noaero/m_rxt_id.F90 new file mode 100644 index 0000000000..dff4734ed0 --- /dev/null +++ b/src/chemistry/pp_waccm_ma_noaero/m_rxt_id.F90 @@ -0,0 +1,315 @@ + module m_rxt_id + implicit none + integer, parameter :: rid_jh2o_b = 1 + integer, parameter :: rid_jh2o_c = 2 + integer, parameter :: rid_jh2o_a = 3 + integer, parameter :: rid_jh2o2 = 4 + integer, parameter :: rid_jo2_b = 5 + integer, parameter :: rid_jo2_a = 6 + integer, parameter :: rid_jo3_a = 7 + integer, parameter :: rid_jo3_b = 8 + integer, parameter :: rid_jhno3 = 9 + integer, parameter :: rid_jho2no2_a = 10 + integer, parameter :: rid_jho2no2_b = 11 + integer, parameter :: rid_jn2o = 12 + integer, parameter :: rid_jn2o5_a = 13 + integer, parameter :: rid_jn2o5_b = 14 + integer, parameter :: rid_jno = 15 + integer, parameter :: rid_jno_i = 16 + integer, parameter :: rid_jno2 = 17 + integer, parameter :: rid_jno3_a = 18 + integer, parameter :: rid_jno3_b = 19 + integer, parameter :: rid_jch2o_a = 20 + integer, parameter :: rid_jch2o_b = 21 + integer, parameter :: rid_jch3ooh = 22 + integer, parameter :: rid_jch4_a = 23 + integer, parameter :: rid_jch4_b = 24 + integer, parameter :: rid_jco2 = 25 + integer, parameter :: rid_jbrcl = 26 + integer, parameter :: rid_jbro = 27 + integer, parameter :: rid_jbrono2_b = 28 + integer, parameter :: rid_jbrono2_a = 29 + integer, parameter :: rid_jccl4 = 30 + integer, parameter :: rid_jcf2clbr = 31 + integer, parameter :: rid_jcf3br = 32 + integer, parameter :: rid_jcfcl3 = 33 + integer, parameter :: rid_jcfc113 = 34 + integer, parameter :: rid_jcfc114 = 35 + integer, parameter :: rid_jcfc115 = 36 + integer, parameter :: rid_jcf2cl2 = 37 + integer, parameter :: rid_jch2br2 = 38 + integer, parameter :: rid_jch3br = 39 + integer, parameter :: rid_jch3ccl3 = 40 + integer, parameter :: rid_jch3cl = 41 + integer, parameter :: rid_jchbr3 = 42 + integer, parameter :: rid_jcl2 = 43 + integer, parameter :: rid_jcl2o2 = 44 + integer, parameter :: rid_jclo = 45 + integer, parameter :: rid_jclono2_a = 46 + integer, parameter :: rid_jclono2_b = 47 + integer, parameter :: rid_jcof2 = 48 + integer, parameter :: rid_jcofcl = 49 + integer, parameter :: rid_jh2402 = 50 + integer, parameter :: rid_jhbr = 51 + integer, parameter :: rid_jhcfc141b = 52 + integer, parameter :: rid_jhcfc142b = 53 + integer, parameter :: rid_jhcfc22 = 54 + integer, parameter :: rid_jhcl = 55 + integer, parameter :: rid_jhf = 56 + integer, parameter :: rid_jhobr = 57 + integer, parameter :: rid_jhocl = 58 + integer, parameter :: rid_joclo = 59 + integer, parameter :: rid_jsf6 = 60 + integer, parameter :: rid_jeuv_26 = 61 + integer, parameter :: rid_jeuv_4 = 62 + integer, parameter :: rid_jeuv_6 = 63 + integer, parameter :: rid_jeuv_22 = 64 + integer, parameter :: rid_jeuv_23 = 65 + integer, parameter :: rid_jeuv_25 = 66 + integer, parameter :: rid_jeuv_18 = 67 + integer, parameter :: rid_jeuv_13 = 68 + integer, parameter :: rid_jeuv_11 = 69 + integer, parameter :: rid_jeuv_10 = 70 + integer, parameter :: rid_jeuv_3 = 71 + integer, parameter :: rid_jeuv_16 = 72 + integer, parameter :: rid_jeuv_1 = 73 + integer, parameter :: rid_jeuv_14 = 74 + integer, parameter :: rid_jeuv_2 = 75 + integer, parameter :: rid_jeuv_15 = 76 + integer, parameter :: rid_jeuv_21 = 77 + integer, parameter :: rid_jeuv_17 = 78 + integer, parameter :: rid_jeuv_7 = 79 + integer, parameter :: rid_jeuv_5 = 80 + integer, parameter :: rid_jeuv_19 = 81 + integer, parameter :: rid_jeuv_24 = 82 + integer, parameter :: rid_jeuv_12 = 83 + integer, parameter :: rid_jeuv_9 = 84 + integer, parameter :: rid_jeuv_8 = 85 + integer, parameter :: rid_jeuv_20 = 86 + integer, parameter :: rid_jh2so4 = 87 + integer, parameter :: rid_jocs = 88 + integer, parameter :: rid_jso = 89 + integer, parameter :: rid_jso2 = 90 + integer, parameter :: rid_jso3 = 91 + integer, parameter :: rid_ag1 = 92 + integer, parameter :: rid_ag2 = 93 + integer, parameter :: rid_O1D_H2 = 94 + integer, parameter :: rid_O1D_H2O = 95 + integer, parameter :: rid_O1D_N2 = 96 + integer, parameter :: rid_O1D_O2 = 97 + integer, parameter :: rid_O1D_O2b = 98 + integer, parameter :: rid_O1D_O3 = 99 + integer, parameter :: rid_O2_1D_N2 = 100 + integer, parameter :: rid_O2_1D_O = 101 + integer, parameter :: rid_O2_1D_O2 = 102 + integer, parameter :: rid_O2_1S_CO2 = 103 + integer, parameter :: rid_O2_1S_N2 = 104 + integer, parameter :: rid_O2_1S_O = 105 + integer, parameter :: rid_O2_1S_O2 = 106 + integer, parameter :: rid_O2_1S_O3 = 107 + integer, parameter :: rid_O_O3 = 108 + integer, parameter :: rid_usr_O_O = 109 + integer, parameter :: rid_usr_O_O2 = 110 + integer, parameter :: rid_H2_O = 111 + integer, parameter :: rid_H2O2_O = 112 + integer, parameter :: rid_H_HO2 = 113 + integer, parameter :: rid_H_HO2a = 114 + integer, parameter :: rid_H_HO2b = 115 + integer, parameter :: rid_H_O2 = 116 + integer, parameter :: rid_HO2_O = 117 + integer, parameter :: rid_HO2_O3 = 118 + integer, parameter :: rid_H_O3 = 119 + integer, parameter :: rid_OH_H2 = 120 + integer, parameter :: rid_OH_H2O2 = 121 + integer, parameter :: rid_OH_HO2 = 122 + integer, parameter :: rid_OH_O = 123 + integer, parameter :: rid_OH_O3 = 124 + integer, parameter :: rid_OH_OH = 125 + integer, parameter :: rid_OH_OH_M = 126 + integer, parameter :: rid_usr_HO2_HO2 = 127 + integer, parameter :: rid_HO2NO2_OH = 128 + integer, parameter :: rid_N2D_O = 129 + integer, parameter :: rid_N2D_O2 = 130 + integer, parameter :: rid_N_NO = 131 + integer, parameter :: rid_N_NO2a = 132 + integer, parameter :: rid_N_NO2b = 133 + integer, parameter :: rid_N_NO2c = 134 + integer, parameter :: rid_N_O2 = 135 + integer, parameter :: rid_NO2_O = 136 + integer, parameter :: rid_NO2_O3 = 137 + integer, parameter :: rid_NO2_O_M = 138 + integer, parameter :: rid_NO3_HO2 = 139 + integer, parameter :: rid_NO3_NO = 140 + integer, parameter :: rid_NO3_O = 141 + integer, parameter :: rid_NO3_OH = 142 + integer, parameter :: rid_N_OH = 143 + integer, parameter :: rid_NO_HO2 = 144 + integer, parameter :: rid_NO_O3 = 145 + integer, parameter :: rid_NO_O_M = 146 + integer, parameter :: rid_O1D_N2Oa = 147 + integer, parameter :: rid_O1D_N2Ob = 148 + integer, parameter :: rid_tag_NO2_HO2 = 149 + integer, parameter :: rid_tag_NO2_NO3 = 150 + integer, parameter :: rid_tag_NO2_OH = 151 + integer, parameter :: rid_usr_HNO3_OH = 152 + integer, parameter :: rid_usr_HO2NO2_M = 153 + integer, parameter :: rid_usr_N2O5_M = 154 + integer, parameter :: rid_CL_CH2O = 155 + integer, parameter :: rid_CL_CH4 = 156 + integer, parameter :: rid_CL_H2 = 157 + integer, parameter :: rid_CL_H2O2 = 158 + integer, parameter :: rid_CL_HO2a = 159 + integer, parameter :: rid_CL_HO2b = 160 + integer, parameter :: rid_CL_O3 = 161 + integer, parameter :: rid_CLO_CH3O2 = 162 + integer, parameter :: rid_CLO_CLOa = 163 + integer, parameter :: rid_CLO_CLOb = 164 + integer, parameter :: rid_CLO_CLOc = 165 + integer, parameter :: rid_CLO_HO2 = 166 + integer, parameter :: rid_CLO_NO = 167 + integer, parameter :: rid_CLONO2_CL = 168 + integer, parameter :: rid_CLO_NO2_M = 169 + integer, parameter :: rid_CLONO2_O = 170 + integer, parameter :: rid_CLONO2_OH = 171 + integer, parameter :: rid_CLO_O = 172 + integer, parameter :: rid_CLO_OHa = 173 + integer, parameter :: rid_CLO_OHb = 174 + integer, parameter :: rid_HCL_O = 175 + integer, parameter :: rid_HCL_OH = 176 + integer, parameter :: rid_HOCL_CL = 177 + integer, parameter :: rid_HOCL_O = 178 + integer, parameter :: rid_HOCL_OH = 179 + integer, parameter :: rid_O1D_CCL4 = 180 + integer, parameter :: rid_O1D_CF2CLBR = 181 + integer, parameter :: rid_O1D_CFC11 = 182 + integer, parameter :: rid_O1D_CFC113 = 183 + integer, parameter :: rid_O1D_CFC114 = 184 + integer, parameter :: rid_O1D_CFC115 = 185 + integer, parameter :: rid_O1D_CFC12 = 186 + integer, parameter :: rid_O1D_HCLa = 187 + integer, parameter :: rid_O1D_HCLb = 188 + integer, parameter :: rid_tag_CLO_CLO_M = 189 + integer, parameter :: rid_usr_CL2O2_M = 190 + integer, parameter :: rid_BR_CH2O = 191 + integer, parameter :: rid_BR_HO2 = 192 + integer, parameter :: rid_BR_O3 = 193 + integer, parameter :: rid_BRO_BRO = 194 + integer, parameter :: rid_BRO_CLOa = 195 + integer, parameter :: rid_BRO_CLOb = 196 + integer, parameter :: rid_BRO_CLOc = 197 + integer, parameter :: rid_BRO_HO2 = 198 + integer, parameter :: rid_BRO_NO = 199 + integer, parameter :: rid_BRO_NO2_M = 200 + integer, parameter :: rid_BRONO2_O = 201 + integer, parameter :: rid_BRO_O = 202 + integer, parameter :: rid_BRO_OH = 203 + integer, parameter :: rid_HBR_O = 204 + integer, parameter :: rid_HBR_OH = 205 + integer, parameter :: rid_HOBR_O = 206 + integer, parameter :: rid_O1D_CF3BR = 207 + integer, parameter :: rid_O1D_CHBR3 = 208 + integer, parameter :: rid_O1D_H2402 = 209 + integer, parameter :: rid_O1D_HBRa = 210 + integer, parameter :: rid_O1D_HBRb = 211 + integer, parameter :: rid_F_CH4 = 212 + integer, parameter :: rid_F_H2 = 213 + integer, parameter :: rid_F_H2O = 214 + integer, parameter :: rid_F_HNO3 = 215 + integer, parameter :: rid_O1D_COF2 = 216 + integer, parameter :: rid_O1D_COFCL = 217 + integer, parameter :: rid_CH2BR2_CL = 218 + integer, parameter :: rid_CH2BR2_OH = 219 + integer, parameter :: rid_CH3BR_CL = 220 + integer, parameter :: rid_CH3BR_OH = 221 + integer, parameter :: rid_CH3CCL3_OH = 222 + integer, parameter :: rid_CH3CL_CL = 223 + integer, parameter :: rid_CH3CL_OH = 224 + integer, parameter :: rid_CHBR3_CL = 225 + integer, parameter :: rid_CHBR3_OH = 226 + integer, parameter :: rid_HCFC141B_OH = 227 + integer, parameter :: rid_HCFC142B_OH = 228 + integer, parameter :: rid_HCFC22_OH = 229 + integer, parameter :: rid_O1D_CH2BR2 = 230 + integer, parameter :: rid_O1D_CH3BR = 231 + integer, parameter :: rid_O1D_HCFC141B = 232 + integer, parameter :: rid_O1D_HCFC142B = 233 + integer, parameter :: rid_O1D_HCFC22 = 234 + integer, parameter :: rid_CH2O_NO3 = 235 + integer, parameter :: rid_CH2O_O = 236 + integer, parameter :: rid_CH2O_OH = 237 + integer, parameter :: rid_CH3O2_HO2 = 238 + integer, parameter :: rid_CH3O2_NO = 239 + integer, parameter :: rid_CH3OOH_OH = 240 + integer, parameter :: rid_CH4_OH = 241 + integer, parameter :: rid_CO_OH_M = 242 + integer, parameter :: rid_O1D_CH4a = 243 + integer, parameter :: rid_O1D_CH4b = 244 + integer, parameter :: rid_O1D_CH4c = 245 + integer, parameter :: rid_usr_CO_OH_b = 246 + integer, parameter :: rid_DMS_NO3 = 247 + integer, parameter :: rid_DMS_OHa = 248 + integer, parameter :: rid_OCS_O = 249 + integer, parameter :: rid_OCS_OH = 250 + integer, parameter :: rid_S_O2 = 251 + integer, parameter :: rid_S_O3 = 252 + integer, parameter :: rid_SO_BRO = 253 + integer, parameter :: rid_SO_CLO = 254 + integer, parameter :: rid_S_OH = 255 + integer, parameter :: rid_SO_NO2 = 256 + integer, parameter :: rid_SO_O2 = 257 + integer, parameter :: rid_SO_O3 = 258 + integer, parameter :: rid_SO_OCLO = 259 + integer, parameter :: rid_SO_OH = 260 + integer, parameter :: rid_usr_DMS_OH = 261 + integer, parameter :: rid_usr_SO2_OH = 262 + integer, parameter :: rid_usr_SO3_H2O = 263 + integer, parameter :: rid_usr_HO2_aer = 264 + integer, parameter :: rid_usr_N2O5_aer = 265 + integer, parameter :: rid_usr_NO2_aer = 266 + integer, parameter :: rid_usr_NO3_aer = 267 + integer, parameter :: rid_het1 = 268 + integer, parameter :: rid_het10 = 269 + integer, parameter :: rid_het11 = 270 + integer, parameter :: rid_het12 = 271 + integer, parameter :: rid_het13 = 272 + integer, parameter :: rid_het14 = 273 + integer, parameter :: rid_het15 = 274 + integer, parameter :: rid_het16 = 275 + integer, parameter :: rid_het17 = 276 + integer, parameter :: rid_het2 = 277 + integer, parameter :: rid_het3 = 278 + integer, parameter :: rid_het4 = 279 + integer, parameter :: rid_het5 = 280 + integer, parameter :: rid_het6 = 281 + integer, parameter :: rid_het7 = 282 + integer, parameter :: rid_het8 = 283 + integer, parameter :: rid_het9 = 284 + integer, parameter :: rid_ag247nm = 285 + integer, parameter :: rid_ag373nm = 286 + integer, parameter :: rid_ag732nm = 287 + integer, parameter :: rid_elec1 = 288 + integer, parameter :: rid_elec2 = 289 + integer, parameter :: rid_elec3 = 290 + integer, parameter :: rid_ion_N2p_O2 = 291 + integer, parameter :: rid_ion_N2p_Oa = 292 + integer, parameter :: rid_ion_N2p_Ob = 293 + integer, parameter :: rid_ion_Np_O = 294 + integer, parameter :: rid_ion_Np_O2a = 295 + integer, parameter :: rid_ion_Np_O2b = 296 + integer, parameter :: rid_ion_O2p_N = 297 + integer, parameter :: rid_ion_O2p_N2 = 298 + integer, parameter :: rid_ion_O2p_NO = 299 + integer, parameter :: rid_ion_Op_CO2 = 300 + integer, parameter :: rid_ion_Op_N2 = 301 + integer, parameter :: rid_ion_Op_N2D = 302 + integer, parameter :: rid_ion_Op_O2 = 303 + integer, parameter :: rid_Op2D_e = 304 + integer, parameter :: rid_Op2D_N2 = 305 + integer, parameter :: rid_Op2D_O = 306 + integer, parameter :: rid_Op2D_O2 = 307 + integer, parameter :: rid_Op2P_ea = 308 + integer, parameter :: rid_Op2P_eb = 309 + integer, parameter :: rid_Op2P_N2a = 310 + integer, parameter :: rid_Op2P_N2b = 311 + integer, parameter :: rid_Op2P_O = 312 + end module m_rxt_id diff --git a/src/chemistry/pp_waccm_ma_noaero/m_spc_id.F90 b/src/chemistry/pp_waccm_ma_noaero/m_spc_id.F90 new file mode 100644 index 0000000000..477c949cd3 --- /dev/null +++ b/src/chemistry/pp_waccm_ma_noaero/m_spc_id.F90 @@ -0,0 +1,84 @@ + module m_spc_id + implicit none + integer, parameter :: id_BR = 1 + integer, parameter :: id_BRCL = 2 + integer, parameter :: id_BRO = 3 + integer, parameter :: id_BRONO2 = 4 + integer, parameter :: id_BRY = 5 + integer, parameter :: id_CCL4 = 6 + integer, parameter :: id_CF2CLBR = 7 + integer, parameter :: id_CF3BR = 8 + integer, parameter :: id_CFC11 = 9 + integer, parameter :: id_CFC113 = 10 + integer, parameter :: id_CFC114 = 11 + integer, parameter :: id_CFC115 = 12 + integer, parameter :: id_CFC12 = 13 + integer, parameter :: id_CH2BR2 = 14 + integer, parameter :: id_CH2O = 15 + integer, parameter :: id_CH3BR = 16 + integer, parameter :: id_CH3CCL3 = 17 + integer, parameter :: id_CH3CL = 18 + integer, parameter :: id_CH3O2 = 19 + integer, parameter :: id_CH3OOH = 20 + integer, parameter :: id_CH4 = 21 + integer, parameter :: id_CHBR3 = 22 + integer, parameter :: id_CL = 23 + integer, parameter :: id_CL2 = 24 + integer, parameter :: id_CL2O2 = 25 + integer, parameter :: id_CLO = 26 + integer, parameter :: id_CLONO2 = 27 + integer, parameter :: id_CLY = 28 + integer, parameter :: id_CO = 29 + integer, parameter :: id_CO2 = 30 + integer, parameter :: id_COF2 = 31 + integer, parameter :: id_COFCL = 32 + integer, parameter :: id_DMS = 33 + integer, parameter :: id_F = 34 + integer, parameter :: id_H = 35 + integer, parameter :: id_H2 = 36 + integer, parameter :: id_H2402 = 37 + integer, parameter :: id_H2O2 = 38 + integer, parameter :: id_H2SO4 = 39 + integer, parameter :: id_HBR = 40 + integer, parameter :: id_HCFC141B = 41 + integer, parameter :: id_HCFC142B = 42 + integer, parameter :: id_HCFC22 = 43 + integer, parameter :: id_HCL = 44 + integer, parameter :: id_HF = 45 + integer, parameter :: id_HNO3 = 46 + integer, parameter :: id_HO2NO2 = 47 + integer, parameter :: id_HOBR = 48 + integer, parameter :: id_HOCL = 49 + integer, parameter :: id_N = 50 + integer, parameter :: id_N2O = 51 + integer, parameter :: id_N2O5 = 52 + integer, parameter :: id_NO = 53 + integer, parameter :: id_NO2 = 54 + integer, parameter :: id_NO3 = 55 + integer, parameter :: id_O = 56 + integer, parameter :: id_O2 = 57 + integer, parameter :: id_O3 = 58 + integer, parameter :: id_OCLO = 59 + integer, parameter :: id_OCS = 60 + integer, parameter :: id_S = 61 + integer, parameter :: id_SF6 = 62 + integer, parameter :: id_SO = 63 + integer, parameter :: id_SO2 = 64 + integer, parameter :: id_SO3 = 65 + integer, parameter :: id_SOAG = 66 + integer, parameter :: id_e = 67 + integer, parameter :: id_HO2 = 68 + integer, parameter :: id_N2D = 69 + integer, parameter :: id_N2p = 70 + integer, parameter :: id_NOp = 71 + integer, parameter :: id_Np = 72 + integer, parameter :: id_O1D = 73 + integer, parameter :: id_O2_1D = 74 + integer, parameter :: id_O2_1S = 75 + integer, parameter :: id_O2p = 76 + integer, parameter :: id_OH = 77 + integer, parameter :: id_Op = 78 + integer, parameter :: id_Op2D = 79 + integer, parameter :: id_Op2P = 80 + integer, parameter :: id_H2O = 81 + end module m_spc_id diff --git a/src/chemistry/pp_waccm_ma_noaero/mo_adjrxt.F90 b/src/chemistry/pp_waccm_ma_noaero/mo_adjrxt.F90 new file mode 100644 index 0000000000..98a1812d5f --- /dev/null +++ b/src/chemistry/pp_waccm_ma_noaero/mo_adjrxt.F90 @@ -0,0 +1,233 @@ + module mo_adjrxt + private + public :: adjrxt + contains + subroutine adjrxt( rate, inv, m, ncol, nlev ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : nfs, rxntot + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: ncol, nlev + real(r8), intent(in) :: inv(ncol,nlev,nfs) + real(r8), intent(in) :: m(ncol,nlev) + real(r8), intent(inout) :: rate(ncol,nlev,rxntot) + rate(:,:, 96) = rate(:,:, 96) * inv(:,:, 2) + rate(:,:, 100) = rate(:,:, 100) * inv(:,:, 2) + rate(:,:, 104) = rate(:,:, 104) * inv(:,:, 2) + rate(:,:, 109) = rate(:,:, 109) * inv(:,:, 1) + rate(:,:, 110) = rate(:,:, 110) * inv(:,:, 1) + rate(:,:, 116) = rate(:,:, 116) * inv(:,:, 1) + rate(:,:, 126) = rate(:,:, 126) * inv(:,:, 1) + rate(:,:, 138) = rate(:,:, 138) * inv(:,:, 1) + rate(:,:, 146) = rate(:,:, 146) * inv(:,:, 1) + rate(:,:, 149) = rate(:,:, 149) * inv(:,:, 1) + rate(:,:, 150) = rate(:,:, 150) * inv(:,:, 1) + rate(:,:, 151) = rate(:,:, 151) * inv(:,:, 1) + rate(:,:, 153) = rate(:,:, 153) * inv(:,:, 1) + rate(:,:, 154) = rate(:,:, 154) * inv(:,:, 1) + rate(:,:, 169) = rate(:,:, 169) * inv(:,:, 1) + rate(:,:, 189) = rate(:,:, 189) * inv(:,:, 1) + rate(:,:, 190) = rate(:,:, 190) * inv(:,:, 1) + rate(:,:, 200) = rate(:,:, 200) * inv(:,:, 1) + rate(:,:, 242) = rate(:,:, 242) * inv(:,:, 1) + rate(:,:, 298) = rate(:,:, 298) * inv(:,:, 2) + rate(:,:, 301) = rate(:,:, 301) * inv(:,:, 2) + rate(:,:, 305) = rate(:,:, 305) * inv(:,:, 2) + rate(:,:, 310) = rate(:,:, 310) * inv(:,:, 2) + rate(:,:, 311) = rate(:,:, 311) * inv(:,:, 2) + rate(:,:, 94) = rate(:,:, 94) * m(:,:) + rate(:,:, 95) = rate(:,:, 95) * m(:,:) + rate(:,:, 97) = rate(:,:, 97) * m(:,:) + rate(:,:, 98) = rate(:,:, 98) * m(:,:) + rate(:,:, 99) = rate(:,:, 99) * m(:,:) + rate(:,:, 101) = rate(:,:, 101) * m(:,:) + rate(:,:, 102) = rate(:,:, 102) * m(:,:) + rate(:,:, 103) = rate(:,:, 103) * m(:,:) + rate(:,:, 105) = rate(:,:, 105) * m(:,:) + rate(:,:, 106) = rate(:,:, 106) * m(:,:) + rate(:,:, 107) = rate(:,:, 107) * m(:,:) + rate(:,:, 108) = rate(:,:, 108) * m(:,:) + rate(:,:, 109) = rate(:,:, 109) * m(:,:) + rate(:,:, 110) = rate(:,:, 110) * m(:,:) + rate(:,:, 111) = rate(:,:, 111) * m(:,:) + rate(:,:, 112) = rate(:,:, 112) * m(:,:) + rate(:,:, 113) = rate(:,:, 113) * m(:,:) + rate(:,:, 114) = rate(:,:, 114) * m(:,:) + rate(:,:, 115) = rate(:,:, 115) * m(:,:) + rate(:,:, 116) = rate(:,:, 116) * m(:,:) + rate(:,:, 117) = rate(:,:, 117) * m(:,:) + rate(:,:, 118) = rate(:,:, 118) * m(:,:) + rate(:,:, 119) = rate(:,:, 119) * m(:,:) + rate(:,:, 120) = rate(:,:, 120) * m(:,:) + rate(:,:, 121) = rate(:,:, 121) * m(:,:) + rate(:,:, 122) = rate(:,:, 122) * m(:,:) + rate(:,:, 123) = rate(:,:, 123) * m(:,:) + rate(:,:, 124) = rate(:,:, 124) * m(:,:) + rate(:,:, 125) = rate(:,:, 125) * m(:,:) + rate(:,:, 126) = rate(:,:, 126) * m(:,:) + rate(:,:, 127) = rate(:,:, 127) * m(:,:) + rate(:,:, 128) = rate(:,:, 128) * m(:,:) + rate(:,:, 129) = rate(:,:, 129) * m(:,:) + rate(:,:, 130) = rate(:,:, 130) * m(:,:) + rate(:,:, 131) = rate(:,:, 131) * m(:,:) + rate(:,:, 132) = rate(:,:, 132) * m(:,:) + rate(:,:, 133) = rate(:,:, 133) * m(:,:) + rate(:,:, 134) = rate(:,:, 134) * m(:,:) + rate(:,:, 135) = rate(:,:, 135) * m(:,:) + rate(:,:, 136) = rate(:,:, 136) * m(:,:) + rate(:,:, 137) = rate(:,:, 137) * m(:,:) + rate(:,:, 138) = rate(:,:, 138) * m(:,:) + rate(:,:, 139) = rate(:,:, 139) * m(:,:) + rate(:,:, 140) = rate(:,:, 140) * m(:,:) + rate(:,:, 141) = rate(:,:, 141) * m(:,:) + rate(:,:, 142) = rate(:,:, 142) * m(:,:) + rate(:,:, 143) = rate(:,:, 143) * m(:,:) + rate(:,:, 144) = rate(:,:, 144) * m(:,:) + rate(:,:, 145) = rate(:,:, 145) * m(:,:) + rate(:,:, 146) = rate(:,:, 146) * m(:,:) + rate(:,:, 147) = rate(:,:, 147) * m(:,:) + rate(:,:, 148) = rate(:,:, 148) * m(:,:) + rate(:,:, 149) = rate(:,:, 149) * m(:,:) + rate(:,:, 150) = rate(:,:, 150) * m(:,:) + rate(:,:, 151) = rate(:,:, 151) * m(:,:) + rate(:,:, 152) = rate(:,:, 152) * m(:,:) + rate(:,:, 155) = rate(:,:, 155) * m(:,:) + rate(:,:, 156) = rate(:,:, 156) * m(:,:) + rate(:,:, 157) = rate(:,:, 157) * m(:,:) + rate(:,:, 158) = rate(:,:, 158) * m(:,:) + rate(:,:, 159) = rate(:,:, 159) * m(:,:) + rate(:,:, 160) = rate(:,:, 160) * m(:,:) + rate(:,:, 161) = rate(:,:, 161) * m(:,:) + rate(:,:, 162) = rate(:,:, 162) * m(:,:) + rate(:,:, 163) = rate(:,:, 163) * m(:,:) + rate(:,:, 164) = rate(:,:, 164) * m(:,:) + rate(:,:, 165) = rate(:,:, 165) * m(:,:) + rate(:,:, 166) = rate(:,:, 166) * m(:,:) + rate(:,:, 167) = rate(:,:, 167) * m(:,:) + rate(:,:, 168) = rate(:,:, 168) * m(:,:) + rate(:,:, 169) = rate(:,:, 169) * m(:,:) + rate(:,:, 170) = rate(:,:, 170) * m(:,:) + rate(:,:, 171) = rate(:,:, 171) * m(:,:) + rate(:,:, 172) = rate(:,:, 172) * m(:,:) + rate(:,:, 173) = rate(:,:, 173) * m(:,:) + rate(:,:, 174) = rate(:,:, 174) * m(:,:) + rate(:,:, 175) = rate(:,:, 175) * m(:,:) + rate(:,:, 176) = rate(:,:, 176) * m(:,:) + rate(:,:, 177) = rate(:,:, 177) * m(:,:) + rate(:,:, 178) = rate(:,:, 178) * m(:,:) + rate(:,:, 179) = rate(:,:, 179) * m(:,:) + rate(:,:, 180) = rate(:,:, 180) * m(:,:) + rate(:,:, 181) = rate(:,:, 181) * m(:,:) + rate(:,:, 182) = rate(:,:, 182) * m(:,:) + rate(:,:, 183) = rate(:,:, 183) * m(:,:) + rate(:,:, 184) = rate(:,:, 184) * m(:,:) + rate(:,:, 185) = rate(:,:, 185) * m(:,:) + rate(:,:, 186) = rate(:,:, 186) * m(:,:) + rate(:,:, 187) = rate(:,:, 187) * m(:,:) + rate(:,:, 188) = rate(:,:, 188) * m(:,:) + rate(:,:, 189) = rate(:,:, 189) * m(:,:) + rate(:,:, 191) = rate(:,:, 191) * m(:,:) + rate(:,:, 192) = rate(:,:, 192) * m(:,:) + rate(:,:, 193) = rate(:,:, 193) * m(:,:) + rate(:,:, 194) = rate(:,:, 194) * m(:,:) + rate(:,:, 195) = rate(:,:, 195) * m(:,:) + rate(:,:, 196) = rate(:,:, 196) * m(:,:) + rate(:,:, 197) = rate(:,:, 197) * m(:,:) + rate(:,:, 198) = rate(:,:, 198) * m(:,:) + rate(:,:, 199) = rate(:,:, 199) * m(:,:) + rate(:,:, 200) = rate(:,:, 200) * m(:,:) + rate(:,:, 201) = rate(:,:, 201) * m(:,:) + rate(:,:, 202) = rate(:,:, 202) * m(:,:) + rate(:,:, 203) = rate(:,:, 203) * m(:,:) + rate(:,:, 204) = rate(:,:, 204) * m(:,:) + rate(:,:, 205) = rate(:,:, 205) * m(:,:) + rate(:,:, 206) = rate(:,:, 206) * m(:,:) + rate(:,:, 207) = rate(:,:, 207) * m(:,:) + rate(:,:, 208) = rate(:,:, 208) * m(:,:) + rate(:,:, 209) = rate(:,:, 209) * m(:,:) + rate(:,:, 210) = rate(:,:, 210) * m(:,:) + rate(:,:, 211) = rate(:,:, 211) * m(:,:) + rate(:,:, 212) = rate(:,:, 212) * m(:,:) + rate(:,:, 213) = rate(:,:, 213) * m(:,:) + rate(:,:, 214) = rate(:,:, 214) * m(:,:) + rate(:,:, 215) = rate(:,:, 215) * m(:,:) + rate(:,:, 216) = rate(:,:, 216) * m(:,:) + rate(:,:, 217) = rate(:,:, 217) * m(:,:) + rate(:,:, 218) = rate(:,:, 218) * m(:,:) + rate(:,:, 219) = rate(:,:, 219) * m(:,:) + rate(:,:, 220) = rate(:,:, 220) * m(:,:) + rate(:,:, 221) = rate(:,:, 221) * m(:,:) + rate(:,:, 222) = rate(:,:, 222) * m(:,:) + rate(:,:, 223) = rate(:,:, 223) * m(:,:) + rate(:,:, 224) = rate(:,:, 224) * m(:,:) + rate(:,:, 225) = rate(:,:, 225) * m(:,:) + rate(:,:, 226) = rate(:,:, 226) * m(:,:) + rate(:,:, 227) = rate(:,:, 227) * m(:,:) + rate(:,:, 228) = rate(:,:, 228) * m(:,:) + rate(:,:, 229) = rate(:,:, 229) * m(:,:) + rate(:,:, 230) = rate(:,:, 230) * m(:,:) + rate(:,:, 231) = rate(:,:, 231) * m(:,:) + rate(:,:, 232) = rate(:,:, 232) * m(:,:) + rate(:,:, 233) = rate(:,:, 233) * m(:,:) + rate(:,:, 234) = rate(:,:, 234) * m(:,:) + rate(:,:, 235) = rate(:,:, 235) * m(:,:) + rate(:,:, 236) = rate(:,:, 236) * m(:,:) + rate(:,:, 237) = rate(:,:, 237) * m(:,:) + rate(:,:, 238) = rate(:,:, 238) * m(:,:) + rate(:,:, 239) = rate(:,:, 239) * m(:,:) + rate(:,:, 240) = rate(:,:, 240) * m(:,:) + rate(:,:, 241) = rate(:,:, 241) * m(:,:) + rate(:,:, 242) = rate(:,:, 242) * m(:,:) + rate(:,:, 243) = rate(:,:, 243) * m(:,:) + rate(:,:, 244) = rate(:,:, 244) * m(:,:) + rate(:,:, 245) = rate(:,:, 245) * m(:,:) + rate(:,:, 246) = rate(:,:, 246) * m(:,:) + rate(:,:, 247) = rate(:,:, 247) * m(:,:) + rate(:,:, 248) = rate(:,:, 248) * m(:,:) + rate(:,:, 249) = rate(:,:, 249) * m(:,:) + rate(:,:, 250) = rate(:,:, 250) * m(:,:) + rate(:,:, 251) = rate(:,:, 251) * m(:,:) + rate(:,:, 252) = rate(:,:, 252) * m(:,:) + rate(:,:, 253) = rate(:,:, 253) * m(:,:) + rate(:,:, 254) = rate(:,:, 254) * m(:,:) + rate(:,:, 255) = rate(:,:, 255) * m(:,:) + rate(:,:, 256) = rate(:,:, 256) * m(:,:) + rate(:,:, 257) = rate(:,:, 257) * m(:,:) + rate(:,:, 258) = rate(:,:, 258) * m(:,:) + rate(:,:, 259) = rate(:,:, 259) * m(:,:) + rate(:,:, 260) = rate(:,:, 260) * m(:,:) + rate(:,:, 261) = rate(:,:, 261) * m(:,:) + rate(:,:, 262) = rate(:,:, 262) * m(:,:) + rate(:,:, 263) = rate(:,:, 263) * m(:,:) + rate(:,:, 269) = rate(:,:, 269) * m(:,:) + rate(:,:, 274) = rate(:,:, 274) * m(:,:) + rate(:,:, 275) = rate(:,:, 275) * m(:,:) + rate(:,:, 276) = rate(:,:, 276) * m(:,:) + rate(:,:, 279) = rate(:,:, 279) * m(:,:) + rate(:,:, 280) = rate(:,:, 280) * m(:,:) + rate(:,:, 281) = rate(:,:, 281) * m(:,:) + rate(:,:, 284) = rate(:,:, 284) * m(:,:) + rate(:,:, 288) = rate(:,:, 288) * m(:,:) + rate(:,:, 289) = rate(:,:, 289) * m(:,:) + rate(:,:, 290) = rate(:,:, 290) * m(:,:) + rate(:,:, 291) = rate(:,:, 291) * m(:,:) + rate(:,:, 292) = rate(:,:, 292) * m(:,:) + rate(:,:, 293) = rate(:,:, 293) * m(:,:) + rate(:,:, 294) = rate(:,:, 294) * m(:,:) + rate(:,:, 295) = rate(:,:, 295) * m(:,:) + rate(:,:, 296) = rate(:,:, 296) * m(:,:) + rate(:,:, 297) = rate(:,:, 297) * m(:,:) + rate(:,:, 299) = rate(:,:, 299) * m(:,:) + rate(:,:, 300) = rate(:,:, 300) * m(:,:) + rate(:,:, 302) = rate(:,:, 302) * m(:,:) + rate(:,:, 303) = rate(:,:, 303) * m(:,:) + rate(:,:, 304) = rate(:,:, 304) * m(:,:) + rate(:,:, 306) = rate(:,:, 306) * m(:,:) + rate(:,:, 307) = rate(:,:, 307) * m(:,:) + rate(:,:, 308) = rate(:,:, 308) * m(:,:) + rate(:,:, 309) = rate(:,:, 309) * m(:,:) + rate(:,:, 312) = rate(:,:, 312) * m(:,:) + end subroutine adjrxt + end module mo_adjrxt diff --git a/src/chemistry/pp_waccm_ma_noaero/mo_exp_sol.F90 b/src/chemistry/pp_waccm_ma_noaero/mo_exp_sol.F90 new file mode 100644 index 0000000000..c1cde93fa7 --- /dev/null +++ b/src/chemistry/pp_waccm_ma_noaero/mo_exp_sol.F90 @@ -0,0 +1,81 @@ +module mo_exp_sol + private + public :: exp_sol + public :: exp_sol_inti +contains + subroutine exp_sol_inti + use mo_tracname, only : solsym + use chem_mods, only : clscnt1, clsmap + use cam_history, only : addfld + implicit none + integer :: i,j + do i = 1,clscnt1 + j = clsmap(i,1) + call addfld( trim(solsym(j))//'_CHMP', (/ 'lev' /), 'I', '/cm3/s', 'chemical production rate' ) + call addfld( trim(solsym(j))//'_CHML', (/ 'lev' /), 'I', '/cm3/s', 'chemical loss rate' ) + enddo + end subroutine exp_sol_inti + subroutine exp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, xhnm, ncol, lchnk, ltrop ) + !----------------------------------------------------------------------- + ! ... Exp_sol advances the volumetric mixing ratio + ! forward one time step via the fully explicit + ! Euler scheme + !----------------------------------------------------------------------- + use chem_mods, only : clscnt1, extcnt, gas_pcnst, clsmap, rxntot + use ppgrid, only : pcols, pver + use mo_prod_loss, only : exp_prod_loss + use mo_indprd, only : indprd + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_history, only : outfld + use mo_tracname, only : solsym + implicit none + !----------------------------------------------------------------------- + ! ... Dummy arguments + !----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunck + integer, intent(in) :: lchnk ! chunk id + real(r8), intent(in) :: delt ! time step (s) + real(r8), intent(in) :: het_rates(ncol,pver,max(1,gas_pcnst)) ! het rates (1/cm^3/s) + real(r8), intent(in) :: reaction_rates(ncol,pver,rxntot) ! rxt rates (1/cm^3/s) + real(r8), intent(in) :: extfrc(ncol,pver,extcnt) ! "external insitu forcing" (1/cm^3/s) + real(r8), intent(in) :: xhnm(ncol,pver) + integer, intent(in) :: ltrop(pcols) ! chemistry troposphere boundary (index) + real(r8), intent(inout) :: base_sol(ncol,pver,gas_pcnst) ! working mixing ratios (vmr) + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: i, k, l, m + integer :: chnkpnts + real(r8), dimension(ncol,pver,max(1,clscnt1)) :: & + prod, & + loss + real(r8), dimension(ncol,pver,clscnt1) :: ind_prd + real(r8), dimension(ncol,pver) :: wrk + chnkpnts = ncol*pver + !----------------------------------------------------------------------- + ! ... Put "independent" production in the forcing + !----------------------------------------------------------------------- + call indprd( 1, ind_prd, clscnt1, base_sol, extfrc, & + reaction_rates, chnkpnts ) + !----------------------------------------------------------------------- + ! ... Form F(y) + !----------------------------------------------------------------------- + call exp_prod_loss( 1, chnkpnts, prod, loss, base_sol, reaction_rates, & + het_rates, chnkpnts ) + !----------------------------------------------------------------------- + ! ... Solve for the mixing ratio at t(n+1) + !----------------------------------------------------------------------- + do m = 1,clscnt1 + l = clsmap(m,1) + do i = 1,ncol + do k = ltrop(i)+1,pver + base_sol(i,k,l) = base_sol(i,k,l) + delt * (prod(i,k,m) + ind_prd(i,k,m) - loss(i,k,m)) + end do + end do + wrk(:,:) = (prod(:,:,m) + ind_prd(:,:,m))*xhnm + call outfld( trim(solsym(l))//'_CHMP', wrk(:,:), ncol, lchnk ) + wrk(:,:) = (loss(:,:,m))*xhnm + call outfld( trim(solsym(l))//'_CHML', wrk(:,:), ncol, lchnk ) + end do + end subroutine exp_sol +end module mo_exp_sol diff --git a/src/chemistry/pp_waccm_ma_noaero/mo_imp_sol.F90 b/src/chemistry/pp_waccm_ma_noaero/mo_imp_sol.F90 new file mode 100644 index 0000000000..98cadb9050 --- /dev/null +++ b/src/chemistry/pp_waccm_ma_noaero/mo_imp_sol.F90 @@ -0,0 +1,435 @@ +module mo_imp_sol + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, gas_pcnst, clsmap, veclen + use cam_logfile, only : iulog + implicit none + private + public :: imp_slv_inti, imp_sol + save + real(r8), parameter :: rel_err = 1.e-3_r8 + real(r8), parameter :: high_rel_err = 1.e-4_r8 + !----------------------------------------------------------------------- + ! Newton-Raphson iteration limits + !----------------------------------------------------------------------- + integer, parameter :: itermax = 11 + integer, parameter :: cut_limit = 5 + real(r8), parameter :: sol_min = 1.e-20_r8 + real(r8), parameter :: small = 1.e-40_r8 + real(r8) :: epsilon(clscnt4) + logical :: factor(itermax) +contains + subroutine imp_slv_inti + !----------------------------------------------------------------------- + ! ... Initialize the implict solver + !----------------------------------------------------------------------- + use mo_chem_utls, only : get_spc_ndx + implicit none + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: m, ox_ndx, o3a_ndx + real(r8) :: eps(gas_pcnst) + factor(:) = .true. + eps(:) = rel_err + ox_ndx = get_spc_ndx( 'OX' ) + if( ox_ndx < 1 ) then + ox_ndx = get_spc_ndx( 'O3' ) + end if + if( ox_ndx > 0 ) then + eps(ox_ndx) = high_rel_err + end if + m = get_spc_ndx( 'NO' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HO2NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'N2O5' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'OH' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + o3a_ndx = get_spc_ndx( 'O3A' ) + if( o3a_ndx > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XHNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XHO2NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO2NO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO2XNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + do m = 1,clscnt4 + epsilon(m) = eps(clsmap(m,4)) + end do + end subroutine imp_slv_inti + subroutine imp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, & + ncol, nlev, lchnk, prod_out, loss_out ) + !----------------------------------------------------------------------- + ! ... imp_sol advances the volumetric mixing ratio + ! forward one time step via the fully implicit euler scheme. + ! this source is meant for vector architectures such as the + ! nec sx6 and cray x1 + !----------------------------------------------------------------------- + use chem_mods, only : rxntot, extcnt, nzcnt, permute, cls_rxt_cnt + use mo_tracname, only : solsym + use mo_lin_matrix, only : linmat + use mo_nln_matrix, only : nlnmat + use mo_lu_factor, only : lu_fac + use mo_lu_solve, only : lu_slv + use mo_prod_loss, only : imp_prod_loss + use mo_indprd, only : indprd + use time_manager, only : get_nstep + use perf_mod, only : t_startf, t_stopf + implicit none + !----------------------------------------------------------------------- + ! ... dummy args + !----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunck + integer, intent(in) :: nlev + integer, intent(in) :: lchnk ! chunk id + real(r8), intent(in) :: delt ! time step (s) + real(r8), intent(in) :: reaction_rates(ncol*nlev,max(1,rxntot)) ! rxt rates (1/cm^3/s) + real(r8), intent(in) :: extfrc(ncol*nlev,max(1,extcnt)) ! external in-situ forcing (1/cm^3/s) + real(r8), intent(in) :: het_rates(ncol*nlev,max(1,gas_pcnst)) ! washout rates (1/s) + real(r8), intent(inout) :: base_sol(ncol*nlev,gas_pcnst) ! species mixing ratios (vmr) + real(r8), intent(out) :: prod_out(ncol*nlev,max(1,clscnt4)) + real(r8), intent(out) :: loss_out(ncol*nlev,max(1,clscnt4)) + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: nr_iter + integer :: ofl + integer :: ofu + integer :: avec_len + integer :: bndx ! base index + integer :: cndx ! class index + integer :: pndx ! permuted class index + integer :: i,m + integer :: fail_cnt(veclen) + integer :: cut_cnt(veclen) + integer :: stp_con_cnt(veclen) + integer :: nstep + real(r8) :: interval_done(veclen) + real(r8) :: dt(veclen) + real(r8) :: dti(veclen) + real(r8) :: max_delta(max(1,clscnt4)) + real(r8) :: ind_prd(ncol*nlev,max(1,clscnt4)) + logical :: convergence + integer :: chnkpnts ! total spatial points in chunk; ncol*ncol + logical :: diags_out(ncol*nlev,max(1,clscnt4)) + real(r8) :: sys_jac_blk(veclen,max(1,nzcnt)) + real(r8) :: lin_jac_blk(veclen,max(1,nzcnt)) + real(r8) :: solution_blk(veclen,max(1,clscnt4)) + real(r8) :: forcing_blk(veclen,max(1,clscnt4)) + real(r8) :: iter_invariant_blk(veclen,max(1,clscnt4)) + real(r8) :: prod_blk(veclen,max(1,clscnt4)) + real(r8) :: loss_blk(veclen,max(1,clscnt4)) + real(r8) :: ind_prd_blk(veclen,max(1,clscnt4)) + real(r8) :: sbase_sol_blk(veclen,gas_pcnst) + real(r8) :: wrk_blk(veclen) + logical :: spc_conv_blk(veclen,max(1,clscnt4)) + logical :: cls_conv_blk(veclen) + logical :: time_stp_done_blk(veclen) + real(r8) :: reaction_rates_blk(veclen,max(1,rxntot)) + real(r8) :: extfrc_blk(veclen,max(1,extcnt)) + real(r8) :: het_rates_blk(veclen,max(1,gas_pcnst)) + real(r8) :: base_sol_blk(veclen,gas_pcnst) + chnkpnts = ncol*nlev + prod_out = 0._r8 + loss_out = 0._r8 + diags_out = .false. + !----------------------------------------------------------------------- + ! ... class independent forcing + !----------------------------------------------------------------------- + if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then + call indprd( 4, ind_prd, clscnt4, base_sol, extfrc, & + reaction_rates, chnkpnts ) + else + do m = 1,clscnt4 + ind_prd(:,m) = 0._r8 + end do + end if + nstep = get_nstep() + ofl = 1 + chnkpnts_loop : do + ofu = min( chnkpnts,ofl + veclen - 1 ) + avec_len = (ofu - ofl) + 1 + reaction_rates_blk(1:avec_len,:) = reaction_rates(ofl:ofu,:) + extfrc_blk(1:avec_len,:) = extfrc(ofl:ofu,:) + het_rates_blk(1:avec_len,:) = het_rates(ofl:ofu,:) + ind_prd_blk(1:avec_len,:) = ind_prd(ofl:ofu,:) + base_sol_blk(1:avec_len,:) = base_sol(ofl:ofu,:) + cls_conv_blk(1:avec_len) = .false. + dt(1:avec_len) = delt + cut_cnt(1:avec_len) = 0 + fail_cnt(1:avec_len) = 0 + stp_con_cnt(1:avec_len) = 0 + interval_done(1:avec_len) = 0._r8 + time_stp_done_blk(1:avec_len) = .false. + !----------------------------------------------------------------------- + ! ... time step loop + !----------------------------------------------------------------------- + time_step_loop : do + dti(1:avec_len) = 1._r8 / dt(1:avec_len) + !----------------------------------------------------------------------- + ! ... transfer from base to class array + !----------------------------------------------------------------------- + do cndx = 1,clscnt4 + bndx = clsmap(cndx,4) + pndx = permute(cndx,4) + do i = 1, avec_len + solution_blk(i,pndx) = base_sol_blk(i,bndx) + end do + end do + do m = 1,gas_pcnst + sbase_sol_blk(1:avec_len,m) = base_sol_blk(1:avec_len,m) + end do + !----------------------------------------------------------------------- + ! ... set the iteration invariant part of the function f(y) + !----------------------------------------------------------------------- + if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then + do m = 1,clscnt4 + do i = 1, avec_len + iter_invariant_blk(i,m) = dti(i) * solution_blk(i,m) + ind_prd_blk(i,m) + end do + end do + else + do m = 1,clscnt4 + do i = 1, avec_len + iter_invariant_blk(i,m) = dti(i) * solution_blk(i,m) + end do + end do + end if + !----------------------------------------------------------------------- + ! ... the linear component + !----------------------------------------------------------------------- + if( cls_rxt_cnt(2,4) > 0 ) then + call t_startf( 'lin_mat' ) + call linmat( avec_len, lin_jac_blk, base_sol_blk, & + reaction_rates_blk, het_rates_blk ) + call t_stopf( 'lin_mat' ) + end if + !======================================================================= + ! the newton-raphson iteration for f(y) = 0 + !======================================================================= + iter_loop : do nr_iter = 1,itermax + !----------------------------------------------------------------------- + ! ... the non-linear component + !----------------------------------------------------------------------- + if( factor(nr_iter) ) then + call t_startf( 'nln_mat' ) + call nlnmat( avec_len, sys_jac_blk, base_sol_blk, & + reaction_rates_blk, lin_jac_blk, dti ) + call t_stopf( 'nln_mat' ) + !----------------------------------------------------------------------- + ! ... factor the "system" matrix + !----------------------------------------------------------------------- + call t_startf( 'lu_fac' ) + call lu_fac( avec_len, sys_jac_blk ) + call t_stopf( 'lu_fac' ) + end if + !----------------------------------------------------------------------- + ! ... form f(y) + !----------------------------------------------------------------------- + call t_startf( 'prod_loss' ) + call imp_prod_loss( avec_len, prod_blk, loss_blk, & + base_sol_blk, reaction_rates_blk, het_rates_blk ) + call t_stopf( 'prod_loss' ) + do m = 1,clscnt4 + do i = 1, avec_len + forcing_blk(i,m) = solution_blk(i,m)*dti(i) & + - (iter_invariant_blk(i,m) + prod_blk(i,m) - loss_blk(i,m)) + end do + end do + !----------------------------------------------------------------------- + ! ... solve for the mixing ratio at t(n+1) + !----------------------------------------------------------------------- + call t_startf( 'lu_slv' ) + call lu_slv( avec_len, sys_jac_blk, forcing_blk ) + call t_stopf( 'lu_slv' ) + do m = 1,clscnt4 + do i = 1, avec_len + if( .not. cls_conv_blk(i) )then + solution_blk(i,m) = solution_blk(i,m) + forcing_blk(i,m) + else + forcing_blk(i,m) = 0._r8 + endif + end do + end do + !----------------------------------------------------------------------- + ! ... convergence measures and test + !----------------------------------------------------------------------- + conv_chk : if( nr_iter > 1 ) then + !----------------------------------------------------------------------- + ! ... check for convergence + !----------------------------------------------------------------------- + do cndx = 1,clscnt4 + pndx = permute(cndx,4) + bndx = clsmap(cndx,4) + do i = 1, avec_len + if ( abs( solution_blk(i,pndx) ) > sol_min ) then + wrk_blk(i) = abs( forcing_blk(i,pndx)/solution_blk(i,pndx) ) + else + wrk_blk(i) = 0._r8 + endif + enddo + max_delta(cndx) = maxval( wrk_blk(1:avec_len) ) + do i = 1, avec_len + solution_blk(i,pndx) = max( 0._r8,solution_blk(i,pndx) ) + base_sol_blk(i,bndx) = solution_blk(i,pndx) + if ( abs( forcing_blk(i,pndx) ) > small ) then + spc_conv_blk(i,cndx) = abs(forcing_blk(i,pndx)) <= epsilon(cndx)*abs(solution_blk(i,pndx)) + else + spc_conv_blk(i,cndx) = .true. + endif + enddo + where( spc_conv_blk(1:avec_len,cndx) .and. .not.diags_out(ofl:ofu,cndx) ) + ! capture output production and loss diagnostics at converged ponits + prod_out(ofl:ofu,cndx) = prod_blk(1:avec_len,cndx) + ind_prd_blk(1:avec_len,cndx) + loss_out(ofl:ofu,cndx) = loss_blk(1:avec_len,cndx) + diags_out(ofl:ofu,cndx) = .true. + endwhere + end do + do i = 1, avec_len + if( .not. cls_conv_blk(i) ) then + cls_conv_blk(i) = all( spc_conv_blk(i,:) ) + end if + end do + convergence = all( cls_conv_blk(:) ) + if( convergence ) then + exit iter_loop + end if + else conv_chk +!----------------------------------------------------------------------- +! ... limit iterate +!----------------------------------------------------------------------- + do m = 1,clscnt4 + do i = 1, avec_len + solution_blk(i,m) = max( 0._r8,solution_blk(i,m) ) + end do + end do +!----------------------------------------------------------------------- +! ... transfer latest solution back to base array +!----------------------------------------------------------------------- + do cndx = 1,clscnt4 + pndx = permute(cndx,4) + bndx = clsmap(cndx,4) + do i = 1, avec_len + base_sol_blk(i,bndx) = solution_blk(i,pndx) + end do + end do + end if conv_chk + end do iter_loop + !----------------------------------------------------------------------- + ! ... check for newton-raphson convergence + !----------------------------------------------------------------------- + do i = 1,avec_len + if( .not. cls_conv_blk(i) ) then + fail_cnt(i) = fail_cnt(i) + 1 + write(iulog,'('' imp_sol: time step '',1p,g15.7,'' failed to converge @ (lchnk,vctrpos,nstep) = '',3i8)') & + dt(i),lchnk,ofl+i-1,nstep + stp_con_cnt(i) = 0 + if( cut_cnt(i) < cut_limit ) then + cut_cnt(i) = cut_cnt(i) + 1 + if( cut_cnt(i) < cut_limit ) then + dt(i) = .5_r8 * dt(i) + else + dt(i) = .1_r8 * dt(i) + end if + base_sol_blk(i,:) = sbase_sol_blk(i,:) + else + write(iulog,'('' imp_sol: step failed to converge @ (lchnk,vctrpos,nstep,dt,time) = '',3i8,1p,2g15.7)') & + lchnk,ofl+i-1,nstep,dt(i),interval_done+dt(i) + do m = 1,clscnt4 + if( .not. spc_conv_blk(i,m) ) then + write(iulog,'(1x,a16,1x,1pe10.3)') solsym(clsmap(m,4)), max_delta(m) + end if + end do + cls_conv_blk(i) = .true. + if( .not. time_stp_done_blk(i) ) then + interval_done(i) = interval_done(i) + dt(i) + time_stp_done_blk(i) = abs( delt - interval_done(i) ) <= .0001_r8 + endif + end if + elseif( .not. time_stp_done_blk(i) ) then + interval_done(i) = interval_done(i) + dt(i) + time_stp_done_blk(i) = abs( delt - interval_done(i) ) <= .0001_r8 + stp_con_cnt(i) = stp_con_cnt(i) + 1 + if( .not. time_stp_done_blk(i) ) then + if( stp_con_cnt(i) >= 2 ) then + dt(i) = 2._r8*dt(i) + stp_con_cnt(i) = 0 + end if + dt(i) = min( dt(i),delt-interval_done(i) ) + else + base_sol(ofl+i-1,1:gas_pcnst) = base_sol_blk(i,1:gas_pcnst) + endif + endif + end do + convergence = all( cls_conv_blk(:) ) + do i = 1,avec_len + if( cls_conv_blk(i) .and. .not. time_stp_done_blk(i) ) then + cls_conv_blk(i) = .false. + endif + end do + if( .not. convergence ) then + cycle time_step_loop + endif + !----------------------------------------------------------------------- + ! ... check for time step done + !----------------------------------------------------------------------- + if( all( time_stp_done_blk(1:avec_len) ) ) then + exit time_step_loop + end if + end do time_step_loop + ofl = ofu + 1 + if( ofl > chnkpnts ) then + exit chnkpnts_loop + end if + end do chnkpnts_loop + end subroutine imp_sol +end module mo_imp_sol diff --git a/src/chemistry/pp_waccm_ma_noaero/mo_indprd.F90 b/src/chemistry/pp_waccm_ma_noaero/mo_indprd.F90 new file mode 100644 index 0000000000..d7f5c8b5e4 --- /dev/null +++ b/src/chemistry/pp_waccm_ma_noaero/mo_indprd.F90 @@ -0,0 +1,123 @@ + module mo_indprd + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: indprd + contains + subroutine indprd( class, prod, nprod, y, extfrc, rxt, chnkpnts ) + use chem_mods, only : gas_pcnst, extcnt, rxntot + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: class + integer, intent(in) :: chnkpnts + integer, intent(in) :: nprod + real(r8), intent(in) :: y(chnkpnts,gas_pcnst) + real(r8), intent(in) :: rxt(chnkpnts,rxntot) + real(r8), intent(in) :: extfrc(chnkpnts,extcnt) + real(r8), intent(inout) :: prod(chnkpnts,nprod) +!-------------------------------------------------------------------- +! ... "independent" production for Explicit species +!-------------------------------------------------------------------- + if( class == 1 ) then + prod(:,1) = 0._r8 + prod(:,2) = 0._r8 + prod(:,3) = 0._r8 + prod(:,4) = 0._r8 + prod(:,5) = 0._r8 + prod(:,6) = 0._r8 + prod(:,7) = 0._r8 + prod(:,8) = 0._r8 + prod(:,9) = 0._r8 + prod(:,10) = 0._r8 + prod(:,11) = 0._r8 + prod(:,12) = 0._r8 + prod(:,13) = 0._r8 + prod(:,14) = 0._r8 + prod(:,15) = 0._r8 + prod(:,16) = 0._r8 + prod(:,17) = (rxt(:,242)*y(:,77) +rxt(:,246)*y(:,77))*y(:,29) + prod(:,18) = 0._r8 + prod(:,19) = 0._r8 + prod(:,20) = 0._r8 + prod(:,21) = 0._r8 + prod(:,22) =rxt(:,132)*y(:,54)*y(:,50) + prod(:,23) = 0._r8 +!-------------------------------------------------------------------- +! ... "independent" production for Implicit species +!-------------------------------------------------------------------- + else if( class == 4 ) then + prod(:,41) =rxt(:,31)*y(:,7) +rxt(:,32)*y(:,8) +2.000_r8*rxt(:,38)*y(:,14) & + +rxt(:,39)*y(:,16) +3.000_r8*rxt(:,42)*y(:,22) +2.000_r8*rxt(:,50) & + *y(:,37) + prod(:,9) = 0._r8 + prod(:,57) = 0._r8 + prod(:,20) = 0._r8 + prod(:,51) =.180_r8*rxt(:,24)*y(:,21) + prod(:,43) =rxt(:,39)*y(:,16) +rxt(:,41)*y(:,18) +rxt(:,23)*y(:,21) + prod(:,16) = 0._r8 + prod(:,48) =4.000_r8*rxt(:,30)*y(:,6) +rxt(:,31)*y(:,7) +2.000_r8*rxt(:,33) & + *y(:,9) +2.000_r8*rxt(:,34)*y(:,10) +2.000_r8*rxt(:,35)*y(:,11) & + +rxt(:,36)*y(:,12) +2.000_r8*rxt(:,37)*y(:,13) +3.000_r8*rxt(:,40) & + *y(:,17) +rxt(:,41)*y(:,18) +rxt(:,52)*y(:,41) +rxt(:,53)*y(:,42) & + +rxt(:,54)*y(:,43) + prod(:,7) = 0._r8 + prod(:,2) = 0._r8 + prod(:,47) = 0._r8 + prod(:,37) = 0._r8 + prod(:,21) = (rxt(:,25) +rxt(:,61))*y(:,30) +.380_r8*rxt(:,24)*y(:,21) & + + extfrc(:,2) + prod(:,3) =rxt(:,31)*y(:,7) +rxt(:,32)*y(:,8) +rxt(:,34)*y(:,10) & + +2.000_r8*rxt(:,35)*y(:,11) +2.000_r8*rxt(:,36)*y(:,12) +rxt(:,37) & + *y(:,13) +2.000_r8*rxt(:,50)*y(:,37) +rxt(:,53)*y(:,42) +rxt(:,54) & + *y(:,43) + prod(:,8) =rxt(:,33)*y(:,9) +rxt(:,34)*y(:,10) +rxt(:,52)*y(:,41) + prod(:,12) = + extfrc(:,1) + prod(:,26) =rxt(:,32)*y(:,8) +rxt(:,36)*y(:,12) + prod(:,40) = (rxt(:,23) +.330_r8*rxt(:,24))*y(:,21) + prod(:,56) =1.440_r8*rxt(:,24)*y(:,21) + prod(:,22) = 0._r8 + prod(:,4) = 0._r8 + prod(:,29) = 0._r8 + prod(:,42) = 0._r8 + prod(:,10) = 0._r8 + prod(:,38) = 0._r8 + prod(:,17) = 0._r8 + prod(:,27) = 0._r8 + prod(:,28) = 0._r8 + prod(:,35) = (rxt(:,64) +.800_r8*rxt(:,66) +.800_r8*rxt(:,68) +rxt(:,70)) & + + extfrc(:,6) + prod(:,13) = 0._r8 + prod(:,55) = + extfrc(:,3) + prod(:,53) = + extfrc(:,4) + prod(:,44) = 0._r8 + prod(:,46) = (rxt(:,25) +rxt(:,61))*y(:,30) +.180_r8*rxt(:,24)*y(:,21) + prod(:,49) = 0._r8 + prod(:,52) = 0._r8 + prod(:,14) = 0._r8 + prod(:,15) = 0._r8 + prod(:,24) = 0._r8 + prod(:,39) = 0._r8 + prod(:,36) = + extfrc(:,5) + prod(:,11) = 0._r8 + prod(:,1) = 0._r8 + prod(:,33) = (rxt(:,63) +rxt(:,64) +rxt(:,65) +rxt(:,67) +rxt(:,69) + & + rxt(:,70)) + extfrc(:,10) + prod(:,45) = 0._r8 + prod(:,34) = (rxt(:,65) +1.200_r8*rxt(:,66) +1.200_r8*rxt(:,68) +rxt(:,69)) & + + extfrc(:,7) + prod(:,23) = (rxt(:,63) +rxt(:,67)) + extfrc(:,8) + prod(:,25) = 0._r8 + prod(:,30) = (rxt(:,64) +rxt(:,65) +rxt(:,69) +rxt(:,70)) + extfrc(:,11) + prod(:,50) =rxt(:,12)*y(:,51) + prod(:,5) = 0._r8 + prod(:,6) = 0._r8 + prod(:,32) = + extfrc(:,12) + prod(:,54) =.330_r8*rxt(:,24)*y(:,21) + extfrc(:,13) + prod(:,31) = + extfrc(:,9) + prod(:,19) = 0._r8 + prod(:,18) = 0._r8 + prod(:,58) =.050_r8*rxt(:,24)*y(:,21) + end if + end subroutine indprd + end module mo_indprd diff --git a/src/chemistry/pp_waccm_ma_noaero/mo_lin_matrix.F90 b/src/chemistry/pp_waccm_ma_noaero/mo_lin_matrix.F90 new file mode 100644 index 0000000000..ee2b0c068e --- /dev/null +++ b/src/chemistry/pp_waccm_ma_noaero/mo_lin_matrix.F90 @@ -0,0 +1,309 @@ + module mo_lin_matrix + use chem_mods, only: veclen + private + public :: linmat + contains + subroutine linmat01( avec_len, mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(in) :: het_rates(veclen,gas_pcnst) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k + do k = 1,avec_len + mat(k,291) = -( het_rates(k,1) ) + mat(k,23) = rxt(k,26) + mat(k,703) = rxt(k,27) + mat(k,87) = rxt(k,29) + mat(k,152) = rxt(k,51) + mat(k,135) = rxt(k,57) + mat(k,524) = rxt(k,181)*y(k,7) + rxt(k,207)*y(k,8) + 3.000_r8*rxt(k,208)*y(k,22) & + + 2.000_r8*rxt(k,209)*y(k,37) + 2.000_r8*rxt(k,230)*y(k,14) & + + rxt(k,231)*y(k,16) + mat(k,468) = 2.000_r8*rxt(k,218)*y(k,14) + rxt(k,220)*y(k,16) & + + 3.000_r8*rxt(k,225)*y(k,22) + mat(k,633) = 2.000_r8*rxt(k,219)*y(k,14) + rxt(k,221)*y(k,16) & + + 3.000_r8*rxt(k,226)*y(k,22) + mat(k,22) = -( rxt(k,26) + het_rates(k,2) ) + mat(k,719) = -( rxt(k,27) + het_rates(k,3) ) + mat(k,91) = rxt(k,28) + mat(k,84) = -( rxt(k,28) + rxt(k,29) + rxt(k,270) + rxt(k,273) + rxt(k,278) & + + het_rates(k,4) ) + mat(k,556) = -( rxt(k,20) + rxt(k,21) + het_rates(k,15) ) + mat(k,61) = rxt(k,22) + mat(k,534) = rxt(k,244)*y(k,21) + rxt(k,245)*y(k,21) + mat(k,328) = -( het_rates(k,19) ) + mat(k,470) = rxt(k,156)*y(k,21) + mat(k,128) = rxt(k,212)*y(k,21) + mat(k,635) = rxt(k,241)*y(k,21) + mat(k,526) = rxt(k,243)*y(k,21) + mat(k,58) = -( rxt(k,22) + het_rates(k,20) ) + mat(k,475) = -( rxt(k,156)*y(k,21) + rxt(k,218)*y(k,14) + rxt(k,220)*y(k,16) & + + rxt(k,223)*y(k,18) + rxt(k,225)*y(k,22) + het_rates(k,23) ) + mat(k,24) = rxt(k,26) + mat(k,17) = 2.000_r8*rxt(k,43) + mat(k,4) = 2.000_r8*rxt(k,44) + mat(k,450) = rxt(k,45) + mat(k,249) = rxt(k,46) + mat(k,20) = rxt(k,49) + mat(k,316) = rxt(k,55) + mat(k,147) = rxt(k,58) + mat(k,531) = 4.000_r8*rxt(k,180)*y(k,6) + rxt(k,181)*y(k,7) & + + 2.000_r8*rxt(k,182)*y(k,9) + 2.000_r8*rxt(k,183)*y(k,10) & + + 2.000_r8*rxt(k,184)*y(k,11) + rxt(k,185)*y(k,12) & + + 2.000_r8*rxt(k,186)*y(k,13) + rxt(k,232)*y(k,41) & + + rxt(k,233)*y(k,42) + rxt(k,234)*y(k,43) + mat(k,640) = 3.000_r8*rxt(k,222)*y(k,17) + rxt(k,224)*y(k,18) & + + rxt(k,227)*y(k,41) + rxt(k,228)*y(k,42) + rxt(k,229)*y(k,43) + mat(k,16) = -( rxt(k,43) + het_rates(k,24) ) + mat(k,2) = -( rxt(k,44) + rxt(k,190) + het_rates(k,25) ) + mat(k,449) = -( rxt(k,45) + het_rates(k,26) ) + mat(k,248) = rxt(k,47) + mat(k,49) = rxt(k,59) + mat(k,3) = 2.000_r8*rxt(k,190) + mat(k,243) = -( rxt(k,46) + rxt(k,47) + rxt(k,272) + rxt(k,277) + rxt(k,283) & + + het_rates(k,27) ) + mat(k,92) = -( het_rates(k,29) ) + mat(k,542) = rxt(k,20) + rxt(k,21) + mat(k,51) = rxt(k,88) + mat(k,462) = rxt(k,223)*y(k,18) + mat(k,167) = rxt(k,300)*y(k,30) + mat(k,5) = -( rxt(k,48) + het_rates(k,31) ) + mat(k,517) = rxt(k,181)*y(k,7) + rxt(k,183)*y(k,10) + 2.000_r8*rxt(k,184)*y(k,11) & + + 2.000_r8*rxt(k,185)*y(k,12) + rxt(k,186)*y(k,13) & + + rxt(k,207)*y(k,8) + 2.000_r8*rxt(k,209)*y(k,37) & + + rxt(k,233)*y(k,42) + rxt(k,234)*y(k,43) + mat(k,614) = rxt(k,228)*y(k,42) + rxt(k,229)*y(k,43) + mat(k,18) = -( rxt(k,49) + het_rates(k,32) ) + mat(k,519) = rxt(k,182)*y(k,9) + rxt(k,183)*y(k,10) + rxt(k,232)*y(k,41) + mat(k,615) = rxt(k,227)*y(k,41) + mat(k,33) = -( het_rates(k,33) ) + mat(k,125) = -( rxt(k,212)*y(k,21) + het_rates(k,34) ) + mat(k,6) = 2.000_r8*rxt(k,48) + mat(k,19) = rxt(k,49) + mat(k,26) = rxt(k,56) + mat(k,520) = rxt(k,185)*y(k,12) + rxt(k,207)*y(k,8) + mat(k,280) = -( het_rates(k,35) ) + mat(k,728) = 2.000_r8*rxt(k,2) + rxt(k,3) + mat(k,545) = 2.000_r8*rxt(k,20) + mat(k,59) = rxt(k,22) + mat(k,151) = rxt(k,51) + mat(k,308) = rxt(k,55) + mat(k,27) = rxt(k,56) + mat(k,523) = rxt(k,244)*y(k,21) + mat(k,692) = -( het_rates(k,36) ) + mat(k,743) = rxt(k,1) + mat(k,561) = rxt(k,21) + mat(k,539) = rxt(k,245)*y(k,21) + mat(k,96) = -( rxt(k,4) + het_rates(k,38) ) + mat(k,8) = -( rxt(k,87) + het_rates(k,39) ) + mat(k,150) = -( rxt(k,51) + het_rates(k,40) ) + mat(k,310) = -( rxt(k,55) + het_rates(k,44) ) + mat(k,469) = rxt(k,156)*y(k,21) + rxt(k,218)*y(k,14) + rxt(k,220)*y(k,16) & + + 2.000_r8*rxt(k,223)*y(k,18) + rxt(k,225)*y(k,22) + mat(k,25) = -( rxt(k,56) + het_rates(k,45) ) + mat(k,124) = rxt(k,212)*y(k,21) + mat(k,255) = -( rxt(k,9) + het_rates(k,46) ) + mat(k,40) = 2.000_r8*rxt(k,265) + 2.000_r8*rxt(k,268) + 2.000_r8*rxt(k,271) & + + 2.000_r8*rxt(k,282) + mat(k,593) = .500_r8*rxt(k,266) + mat(k,345) = rxt(k,267) + mat(k,86) = rxt(k,270) + rxt(k,273) + rxt(k,278) + mat(k,244) = rxt(k,272) + rxt(k,277) + rxt(k,283) + mat(k,64) = -( rxt(k,10) + rxt(k,11) + rxt(k,153) + het_rates(k,47) ) + mat(k,134) = -( rxt(k,57) + het_rates(k,48) ) + mat(k,85) = rxt(k,270) + rxt(k,273) + rxt(k,278) + mat(k,143) = -( rxt(k,58) + het_rates(k,49) ) + mat(k,242) = rxt(k,272) + rxt(k,277) + rxt(k,283) + mat(k,225) = -( rxt(k,62) + het_rates(k,50) ) + mat(k,655) = rxt(k,15) + mat(k,174) = rxt(k,301) + mat(k,39) = -( rxt(k,13) + rxt(k,14) + rxt(k,154) + rxt(k,265) + rxt(k,268) & + + rxt(k,271) + rxt(k,282) + het_rates(k,52) ) + mat(k,670) = -( rxt(k,15) + rxt(k,16) + het_rates(k,53) ) + mat(k,44) = rxt(k,14) + mat(k,610) = rxt(k,17) + .500_r8*rxt(k,266) + mat(k,361) = rxt(k,19) + mat(k,188) = rxt(k,298) + mat(k,77) = rxt(k,311) + mat(k,538) = 2.000_r8*rxt(k,147)*y(k,51) + mat(k,608) = -( rxt(k,17) + rxt(k,266) + het_rates(k,54) ) + mat(k,259) = rxt(k,9) + mat(k,68) = rxt(k,11) + rxt(k,153) + mat(k,43) = rxt(k,13) + rxt(k,154) + mat(k,359) = rxt(k,18) + mat(k,90) = rxt(k,28) + mat(k,250) = rxt(k,47) + mat(k,350) = -( rxt(k,18) + rxt(k,19) + rxt(k,267) + het_rates(k,55) ) + mat(k,65) = rxt(k,10) + mat(k,41) = rxt(k,13) + rxt(k,14) + rxt(k,154) + mat(k,88) = rxt(k,29) + mat(k,246) = rxt(k,46) + mat(k,420) = -( rxt(k,71) + rxt(k,72) + rxt(k,73) + rxt(k,74) + rxt(k,75) & + + rxt(k,76) + het_rates(k,56) ) + mat(k,733) = rxt(k,2) + mat(k,504) = 2.000_r8*rxt(k,5) + rxt(k,6) + rxt(k,77) + rxt(k,79) + rxt(k,81) & + + 2.000_r8*rxt(k,82) + 2.000_r8*rxt(k,83) + rxt(k,84) + rxt(k,85) & + + rxt(k,86) + mat(k,573) = rxt(k,8) + mat(k,42) = rxt(k,14) + mat(k,661) = rxt(k,15) + mat(k,601) = rxt(k,17) + mat(k,352) = rxt(k,18) + mat(k,708) = rxt(k,27) + mat(k,448) = rxt(k,45) + mat(k,48) = rxt(k,59) + mat(k,270) = rxt(k,89) + mat(k,238) = rxt(k,90) + mat(k,31) = rxt(k,91) + mat(k,529) = rxt(k,96) + mat(k,82) = rxt(k,305) + mat(k,76) = rxt(k,310) + mat(k,507) = -( rxt(k,5) + rxt(k,6) + rxt(k,77) + rxt(k,78) + rxt(k,79) & + + rxt(k,80) + rxt(k,81) + rxt(k,82) + rxt(k,83) + rxt(k,84) & + + rxt(k,85) + rxt(k,86) + het_rates(k,57) ) + mat(k,576) = rxt(k,8) + mat(k,355) = rxt(k,19) + mat(k,12) = rxt(k,92) + rxt(k,100) + mat(k,15) = rxt(k,93) + mat(k,532) = rxt(k,148)*y(k,51) + mat(k,579) = -( rxt(k,7) + rxt(k,8) + het_rates(k,58) ) + mat(k,45) = -( rxt(k,59) + het_rates(k,59) ) + mat(k,50) = -( rxt(k,88) + het_rates(k,60) ) + mat(k,112) = -( het_rates(k,61) ) + mat(k,52) = rxt(k,88) + mat(k,264) = rxt(k,89) + mat(k,266) = -( rxt(k,89) + het_rates(k,63) ) + mat(k,236) = rxt(k,90) + mat(k,235) = -( rxt(k,90) + het_rates(k,64) ) + mat(k,30) = rxt(k,91) + mat(k,29) = -( rxt(k,91) + het_rates(k,65) ) + mat(k,9) = rxt(k,87) + mat(k,1) = -( het_rates(k,66) ) + mat(k,196) = -( het_rates(k,67) ) + mat(k,653) = rxt(k,16) + mat(k,223) = rxt(k,62) + mat(k,407) = rxt(k,71) + rxt(k,72) + rxt(k,73) + rxt(k,74) + rxt(k,75) & + + rxt(k,76) + mat(k,496) = rxt(k,77) + rxt(k,78) + rxt(k,79) + rxt(k,80) + rxt(k,81) & + + rxt(k,84) + rxt(k,85) + rxt(k,86) + mat(k,376) = -( rxt(k,264) + het_rates(k,68) ) + mat(k,66) = rxt(k,11) + rxt(k,153) + mat(k,472) = rxt(k,220)*y(k,16) + rxt(k,223)*y(k,18) + mat(k,637) = rxt(k,221)*y(k,16) + rxt(k,224)*y(k,18) + mat(k,528) = rxt(k,244)*y(k,21) + mat(k,210) = -( het_rates(k,69) ) + mat(k,103) = -( het_rates(k,70) ) + mat(k,79) = rxt(k,305) + mat(k,73) = rxt(k,310) + mat(k,119) = -( het_rates(k,71) ) + mat(k,651) = rxt(k,16) + mat(k,180) = rxt(k,298) + mat(k,168) = rxt(k,301) + mat(k,159) = -( het_rates(k,72) ) + mat(k,220) = rxt(k,62) + mat(k,74) = rxt(k,311) + mat(k,533) = -( rxt(k,96) + rxt(k,147)*y(k,51) + rxt(k,148)*y(k,51) & + + rxt(k,180)*y(k,6) + rxt(k,181)*y(k,7) + rxt(k,182)*y(k,9) & + + rxt(k,183)*y(k,10) + rxt(k,184)*y(k,11) + rxt(k,185)*y(k,12) & + + rxt(k,186)*y(k,13) + rxt(k,207)*y(k,8) + rxt(k,208)*y(k,22) & + + rxt(k,209)*y(k,37) + rxt(k,230)*y(k,14) + rxt(k,231)*y(k,16) & + + rxt(k,232)*y(k,41) + rxt(k,233)*y(k,42) + rxt(k,234)*y(k,43) & + + rxt(k,243)*y(k,21) + rxt(k,244)*y(k,21) + rxt(k,245)*y(k,21) & + + het_rates(k,73) ) + mat(k,737) = rxt(k,1) + mat(k,508) = rxt(k,6) + mat(k,577) = rxt(k,7) + end do + end subroutine linmat01 + subroutine linmat02( avec_len, mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(in) :: het_rates(veclen,gas_pcnst) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k + do k = 1,avec_len + mat(k,11) = -( rxt(k,92) + rxt(k,100) + het_rates(k,74) ) + mat(k,564) = rxt(k,7) + mat(k,13) = rxt(k,104) + rxt(k,103)*y(k,30) + mat(k,14) = -( rxt(k,93) + rxt(k,104) + rxt(k,103)*y(k,30) + het_rates(k,75) ) + mat(k,181) = -( rxt(k,298) + het_rates(k,76) ) + mat(k,495) = rxt(k,78) + rxt(k,80) + mat(k,171) = rxt(k,300)*y(k,30) + mat(k,646) = -( rxt(k,219)*y(k,14) + rxt(k,221)*y(k,16) + rxt(k,222)*y(k,17) & + + rxt(k,224)*y(k,18) + rxt(k,226)*y(k,22) + rxt(k,227)*y(k,41) & + + rxt(k,228)*y(k,42) + rxt(k,229)*y(k,43) + rxt(k,241)*y(k,21) & + + het_rates(k,77) ) + mat(k,741) = rxt(k,3) + mat(k,101) = 2.000_r8*rxt(k,4) + mat(k,260) = rxt(k,9) + mat(k,69) = rxt(k,10) + mat(k,62) = rxt(k,22) + mat(k,139) = rxt(k,57) + mat(k,148) = rxt(k,58) + mat(k,609) = .500_r8*rxt(k,266) + mat(k,537) = rxt(k,243)*y(k,21) + mat(k,170) = -( rxt(k,301) + rxt(k,300)*y(k,30) + het_rates(k,78) ) + mat(k,405) = rxt(k,73) + rxt(k,74) + mat(k,494) = rxt(k,79) + rxt(k,81) + mat(k,75) = rxt(k,285) + mat(k,80) = rxt(k,286) + mat(k,78) = -( rxt(k,286) + rxt(k,305) + het_rates(k,79) ) + mat(k,394) = rxt(k,75) + rxt(k,76) + mat(k,489) = rxt(k,85) + rxt(k,86) + mat(k,72) = rxt(k,287) + mat(k,71) = -( rxt(k,285) + rxt(k,287) + rxt(k,310) + rxt(k,311) & + + het_rates(k,80) ) + mat(k,393) = rxt(k,71) + rxt(k,72) + mat(k,488) = rxt(k,77) + rxt(k,84) + mat(k,745) = -( rxt(k,1) + rxt(k,2) + rxt(k,3) + het_rates(k,81) ) + mat(k,10) = rxt(k,87) + mat(k,389) = rxt(k,264) + mat(k,650) = rxt(k,219)*y(k,14) + rxt(k,221)*y(k,16) + rxt(k,222)*y(k,17) & + + rxt(k,224)*y(k,18) + rxt(k,229)*y(k,43) + rxt(k,241)*y(k,21) + end do + end subroutine linmat02 + subroutine linmat( avec_len, mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(in) :: het_rates(veclen,gas_pcnst) + real(r8), intent(inout) :: mat(veclen,nzcnt) + call linmat01( avec_len, mat, y, rxt, het_rates ) + call linmat02( avec_len, mat, y, rxt, het_rates ) + end subroutine linmat + end module mo_lin_matrix diff --git a/src/chemistry/pp_waccm_ma_noaero/mo_lu_factor.F90 b/src/chemistry/pp_waccm_ma_noaero/mo_lu_factor.F90 new file mode 100644 index 0000000000..0f6b4c76a3 --- /dev/null +++ b/src/chemistry/pp_waccm_ma_noaero/mo_lu_factor.F90 @@ -0,0 +1,3204 @@ + module mo_lu_factor + use chem_mods, only: veclen + private + public :: lu_fac + contains + subroutine lu_fac01( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,1) = 1._r8 / lu(k,1) + lu(k,2) = 1._r8 / lu(k,2) + lu(k,3) = lu(k,3) * lu(k,2) + lu(k,4) = lu(k,4) * lu(k,2) + lu(k,449) = lu(k,449) - lu(k,3) * lu(k,433) + lu(k,450) = lu(k,450) - lu(k,4) * lu(k,433) + lu(k,5) = 1._r8 / lu(k,5) + lu(k,6) = lu(k,6) * lu(k,5) + lu(k,7) = lu(k,7) * lu(k,5) + lu(k,520) = lu(k,520) - lu(k,6) * lu(k,517) + lu(k,533) = lu(k,533) - lu(k,7) * lu(k,517) + lu(k,624) = - lu(k,6) * lu(k,614) + lu(k,642) = - lu(k,7) * lu(k,614) + lu(k,8) = 1._r8 / lu(k,8) + lu(k,9) = lu(k,9) * lu(k,8) + lu(k,10) = lu(k,10) * lu(k,8) + lu(k,29) = lu(k,29) - lu(k,9) * lu(k,28) + lu(k,32) = lu(k,32) - lu(k,10) * lu(k,28) + lu(k,723) = lu(k,723) - lu(k,9) * lu(k,721) + lu(k,745) = lu(k,745) - lu(k,10) * lu(k,721) + lu(k,11) = 1._r8 / lu(k,11) + lu(k,12) = lu(k,12) * lu(k,11) + lu(k,15) = lu(k,15) - lu(k,12) * lu(k,13) + lu(k,423) = lu(k,423) - lu(k,12) * lu(k,390) + lu(k,507) = lu(k,507) - lu(k,12) * lu(k,486) + lu(k,576) = lu(k,576) - lu(k,12) * lu(k,564) + lu(k,14) = 1._r8 / lu(k,14) + lu(k,15) = lu(k,15) * lu(k,14) + lu(k,423) = lu(k,423) - lu(k,15) * lu(k,391) + lu(k,507) = lu(k,507) - lu(k,15) * lu(k,487) + lu(k,532) = lu(k,532) - lu(k,15) * lu(k,518) + lu(k,576) = lu(k,576) - lu(k,15) * lu(k,565) + lu(k,16) = 1._r8 / lu(k,16) + lu(k,17) = lu(k,17) * lu(k,16) + lu(k,147) = lu(k,147) - lu(k,17) * lu(k,142) + lu(k,249) = lu(k,249) - lu(k,17) * lu(k,241) + lu(k,316) = lu(k,316) - lu(k,17) * lu(k,302) + lu(k,450) = lu(k,450) - lu(k,17) * lu(k,434) + lu(k,475) = lu(k,475) - lu(k,17) * lu(k,461) + lu(k,18) = 1._r8 / lu(k,18) + lu(k,19) = lu(k,19) * lu(k,18) + lu(k,20) = lu(k,20) * lu(k,18) + lu(k,21) = lu(k,21) * lu(k,18) + lu(k,520) = lu(k,520) - lu(k,19) * lu(k,519) + lu(k,531) = lu(k,531) - lu(k,20) * lu(k,519) + lu(k,533) = lu(k,533) - lu(k,21) * lu(k,519) + lu(k,624) = lu(k,624) - lu(k,19) * lu(k,615) + lu(k,640) = lu(k,640) - lu(k,20) * lu(k,615) + lu(k,642) = lu(k,642) - lu(k,21) * lu(k,615) + lu(k,22) = 1._r8 / lu(k,22) + lu(k,23) = lu(k,23) * lu(k,22) + lu(k,24) = lu(k,24) * lu(k,22) + lu(k,135) = lu(k,135) - lu(k,23) * lu(k,133) + lu(k,138) = - lu(k,24) * lu(k,133) + lu(k,309) = - lu(k,23) * lu(k,303) + lu(k,316) = lu(k,316) - lu(k,24) * lu(k,303) + lu(k,443) = lu(k,443) - lu(k,23) * lu(k,435) + lu(k,450) = lu(k,450) - lu(k,24) * lu(k,435) + lu(k,703) = lu(k,703) - lu(k,23) * lu(k,695) + lu(k,710) = lu(k,710) - lu(k,24) * lu(k,695) + lu(k,25) = 1._r8 / lu(k,25) + lu(k,26) = lu(k,26) * lu(k,25) + lu(k,27) = lu(k,27) * lu(k,25) + lu(k,125) = lu(k,125) - lu(k,26) * lu(k,124) + lu(k,127) = lu(k,127) - lu(k,27) * lu(k,124) + lu(k,254) = lu(k,254) - lu(k,26) * lu(k,253) + lu(k,256) = - lu(k,27) * lu(k,253) + lu(k,675) = lu(k,675) - lu(k,26) * lu(k,674) + lu(k,677) = lu(k,677) - lu(k,27) * lu(k,674) + lu(k,724) = lu(k,724) - lu(k,26) * lu(k,722) + lu(k,728) = lu(k,728) - lu(k,27) * lu(k,722) + lu(k,29) = 1._r8 / lu(k,29) + lu(k,30) = lu(k,30) * lu(k,29) + lu(k,31) = lu(k,31) * lu(k,29) + lu(k,32) = lu(k,32) * lu(k,29) + lu(k,235) = lu(k,235) - lu(k,30) * lu(k,234) + lu(k,238) = lu(k,238) - lu(k,31) * lu(k,234) + lu(k,240) = - lu(k,32) * lu(k,234) + lu(k,628) = lu(k,628) - lu(k,30) * lu(k,616) + lu(k,638) = lu(k,638) - lu(k,31) * lu(k,616) + lu(k,650) = lu(k,650) - lu(k,32) * lu(k,616) + lu(k,725) = - lu(k,30) * lu(k,723) + lu(k,733) = lu(k,733) - lu(k,31) * lu(k,723) + lu(k,745) = lu(k,745) - lu(k,32) * lu(k,723) + lu(k,33) = 1._r8 / lu(k,33) + lu(k,34) = lu(k,34) * lu(k,33) + lu(k,35) = lu(k,35) * lu(k,33) + lu(k,36) = lu(k,36) * lu(k,33) + lu(k,37) = lu(k,37) * lu(k,33) + lu(k,38) = lu(k,38) * lu(k,33) + lu(k,344) = lu(k,344) - lu(k,34) * lu(k,341) + lu(k,345) = lu(k,345) - lu(k,35) * lu(k,341) + lu(k,350) = lu(k,350) - lu(k,36) * lu(k,341) + lu(k,351) = lu(k,351) - lu(k,37) * lu(k,341) + lu(k,360) = lu(k,360) - lu(k,38) * lu(k,341) + lu(k,628) = lu(k,628) - lu(k,34) * lu(k,617) + lu(k,630) = lu(k,630) - lu(k,35) * lu(k,617) + lu(k,636) = lu(k,636) - lu(k,36) * lu(k,617) + lu(k,637) = lu(k,637) - lu(k,37) * lu(k,617) + lu(k,646) = lu(k,646) - lu(k,38) * lu(k,617) + lu(k,39) = 1._r8 / lu(k,39) + lu(k,40) = lu(k,40) * lu(k,39) + lu(k,41) = lu(k,41) * lu(k,39) + lu(k,42) = lu(k,42) * lu(k,39) + lu(k,43) = lu(k,43) * lu(k,39) + lu(k,44) = lu(k,44) * lu(k,39) + lu(k,345) = lu(k,345) - lu(k,40) * lu(k,342) + lu(k,350) = lu(k,350) - lu(k,41) * lu(k,342) + lu(k,352) = lu(k,352) - lu(k,42) * lu(k,342) + lu(k,359) = lu(k,359) - lu(k,43) * lu(k,342) + lu(k,361) = lu(k,361) - lu(k,44) * lu(k,342) + lu(k,593) = lu(k,593) - lu(k,40) * lu(k,586) + lu(k,599) = lu(k,599) - lu(k,41) * lu(k,586) + lu(k,601) = lu(k,601) - lu(k,42) * lu(k,586) + lu(k,608) = lu(k,608) - lu(k,43) * lu(k,586) + lu(k,610) = lu(k,610) - lu(k,44) * lu(k,586) + lu(k,45) = 1._r8 / lu(k,45) + lu(k,46) = lu(k,46) * lu(k,45) + lu(k,47) = lu(k,47) * lu(k,45) + lu(k,48) = lu(k,48) * lu(k,45) + lu(k,49) = lu(k,49) * lu(k,45) + lu(k,265) = lu(k,265) - lu(k,46) * lu(k,263) + lu(k,266) = lu(k,266) - lu(k,47) * lu(k,263) + lu(k,270) = lu(k,270) - lu(k,48) * lu(k,263) + lu(k,271) = lu(k,271) - lu(k,49) * lu(k,263) + lu(k,438) = lu(k,438) - lu(k,46) * lu(k,436) + lu(k,441) = lu(k,441) - lu(k,47) * lu(k,436) + lu(k,448) = lu(k,448) - lu(k,48) * lu(k,436) + lu(k,449) = lu(k,449) - lu(k,49) * lu(k,436) + lu(k,699) = lu(k,699) - lu(k,46) * lu(k,696) + lu(k,701) = lu(k,701) - lu(k,47) * lu(k,696) + lu(k,708) = lu(k,708) - lu(k,48) * lu(k,696) + lu(k,709) = lu(k,709) - lu(k,49) * lu(k,696) + end do + end subroutine lu_fac01 + subroutine lu_fac02( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,50) = 1._r8 / lu(k,50) + lu(k,51) = lu(k,51) * lu(k,50) + lu(k,52) = lu(k,52) * lu(k,50) + lu(k,53) = lu(k,53) * lu(k,50) + lu(k,54) = lu(k,54) * lu(k,50) + lu(k,55) = lu(k,55) * lu(k,50) + lu(k,56) = lu(k,56) * lu(k,50) + lu(k,57) = lu(k,57) * lu(k,50) + lu(k,396) = lu(k,396) - lu(k,51) * lu(k,392) + lu(k,399) = - lu(k,52) * lu(k,392) + lu(k,410) = - lu(k,53) * lu(k,392) + lu(k,413) = lu(k,413) - lu(k,54) * lu(k,392) + lu(k,414) = lu(k,414) - lu(k,55) * lu(k,392) + lu(k,420) = lu(k,420) - lu(k,56) * lu(k,392) + lu(k,428) = lu(k,428) - lu(k,57) * lu(k,392) + lu(k,621) = lu(k,621) - lu(k,51) * lu(k,618) + lu(k,623) = lu(k,623) - lu(k,52) * lu(k,618) + lu(k,628) = lu(k,628) - lu(k,53) * lu(k,618) + lu(k,631) = lu(k,631) - lu(k,54) * lu(k,618) + lu(k,632) = lu(k,632) - lu(k,55) * lu(k,618) + lu(k,638) = lu(k,638) - lu(k,56) * lu(k,618) + lu(k,646) = lu(k,646) - lu(k,57) * lu(k,618) + lu(k,58) = 1._r8 / lu(k,58) + lu(k,59) = lu(k,59) * lu(k,58) + lu(k,60) = lu(k,60) * lu(k,58) + lu(k,61) = lu(k,61) * lu(k,58) + lu(k,62) = lu(k,62) * lu(k,58) + lu(k,63) = lu(k,63) * lu(k,58) + lu(k,327) = - lu(k,59) * lu(k,326) + lu(k,328) = lu(k,328) - lu(k,60) * lu(k,326) + lu(k,334) = lu(k,334) - lu(k,61) * lu(k,326) + lu(k,337) = - lu(k,62) * lu(k,326) + lu(k,340) = - lu(k,63) * lu(k,326) + lu(k,371) = lu(k,371) - lu(k,59) * lu(k,365) + lu(k,374) = lu(k,374) - lu(k,60) * lu(k,365) + lu(k,382) = - lu(k,61) * lu(k,365) + lu(k,385) = lu(k,385) - lu(k,62) * lu(k,365) + lu(k,389) = lu(k,389) - lu(k,63) * lu(k,365) + lu(k,632) = lu(k,632) - lu(k,59) * lu(k,619) + lu(k,635) = lu(k,635) - lu(k,60) * lu(k,619) + lu(k,643) = lu(k,643) - lu(k,61) * lu(k,619) + lu(k,646) = lu(k,646) - lu(k,62) * lu(k,619) + lu(k,650) = lu(k,650) - lu(k,63) * lu(k,619) + lu(k,64) = 1._r8 / lu(k,64) + lu(k,65) = lu(k,65) * lu(k,64) + lu(k,66) = lu(k,66) * lu(k,64) + lu(k,67) = lu(k,67) * lu(k,64) + lu(k,68) = lu(k,68) * lu(k,64) + lu(k,69) = lu(k,69) * lu(k,64) + lu(k,70) = lu(k,70) * lu(k,64) + lu(k,375) = lu(k,375) - lu(k,65) * lu(k,366) + lu(k,376) = lu(k,376) - lu(k,66) * lu(k,366) + lu(k,380) = lu(k,380) - lu(k,67) * lu(k,366) + lu(k,384) = lu(k,384) - lu(k,68) * lu(k,366) + lu(k,385) = lu(k,385) - lu(k,69) * lu(k,366) + lu(k,389) = lu(k,389) - lu(k,70) * lu(k,366) + lu(k,599) = lu(k,599) - lu(k,65) * lu(k,587) + lu(k,600) = lu(k,600) - lu(k,66) * lu(k,587) + lu(k,604) = lu(k,604) - lu(k,67) * lu(k,587) + lu(k,608) = lu(k,608) - lu(k,68) * lu(k,587) + lu(k,609) = lu(k,609) - lu(k,69) * lu(k,587) + lu(k,613) = - lu(k,70) * lu(k,587) + lu(k,636) = lu(k,636) - lu(k,65) * lu(k,620) + lu(k,637) = lu(k,637) - lu(k,66) * lu(k,620) + lu(k,641) = lu(k,641) - lu(k,67) * lu(k,620) + lu(k,645) = lu(k,645) - lu(k,68) * lu(k,620) + lu(k,646) = lu(k,646) - lu(k,69) * lu(k,620) + lu(k,650) = lu(k,650) - lu(k,70) * lu(k,620) + lu(k,71) = 1._r8 / lu(k,71) + lu(k,72) = lu(k,72) * lu(k,71) + lu(k,73) = lu(k,73) * lu(k,71) + lu(k,74) = lu(k,74) * lu(k,71) + lu(k,75) = lu(k,75) * lu(k,71) + lu(k,76) = lu(k,76) * lu(k,71) + lu(k,77) = lu(k,77) * lu(k,71) + lu(k,190) = lu(k,190) - lu(k,72) * lu(k,189) + lu(k,191) = lu(k,191) - lu(k,73) * lu(k,189) + lu(k,193) = - lu(k,74) * lu(k,189) + lu(k,194) = lu(k,194) - lu(k,75) * lu(k,189) + lu(k,201) = lu(k,201) - lu(k,76) * lu(k,189) + lu(k,205) = - lu(k,77) * lu(k,189) + lu(k,394) = lu(k,394) - lu(k,72) * lu(k,393) + lu(k,398) = lu(k,398) - lu(k,73) * lu(k,393) + lu(k,404) = lu(k,404) - lu(k,74) * lu(k,393) + lu(k,405) = lu(k,405) - lu(k,75) * lu(k,393) + lu(k,420) = lu(k,420) - lu(k,76) * lu(k,393) + lu(k,429) = lu(k,429) - lu(k,77) * lu(k,393) + lu(k,489) = lu(k,489) - lu(k,72) * lu(k,488) + lu(k,490) = lu(k,490) - lu(k,73) * lu(k,488) + lu(k,493) = lu(k,493) - lu(k,74) * lu(k,488) + lu(k,494) = lu(k,494) - lu(k,75) * lu(k,488) + lu(k,504) = lu(k,504) - lu(k,76) * lu(k,488) + lu(k,513) = lu(k,513) - lu(k,77) * lu(k,488) + lu(k,78) = 1._r8 / lu(k,78) + lu(k,79) = lu(k,79) * lu(k,78) + lu(k,80) = lu(k,80) * lu(k,78) + lu(k,81) = lu(k,81) * lu(k,78) + lu(k,82) = lu(k,82) * lu(k,78) + lu(k,83) = lu(k,83) * lu(k,78) + lu(k,191) = lu(k,191) - lu(k,79) * lu(k,190) + lu(k,194) = lu(k,194) - lu(k,80) * lu(k,190) + lu(k,195) = lu(k,195) - lu(k,81) * lu(k,190) + lu(k,201) = lu(k,201) - lu(k,82) * lu(k,190) + lu(k,202) = - lu(k,83) * lu(k,190) + lu(k,398) = lu(k,398) - lu(k,79) * lu(k,394) + lu(k,405) = lu(k,405) - lu(k,80) * lu(k,394) + lu(k,406) = - lu(k,81) * lu(k,394) + lu(k,420) = lu(k,420) - lu(k,82) * lu(k,394) + lu(k,423) = lu(k,423) - lu(k,83) * lu(k,394) + lu(k,490) = lu(k,490) - lu(k,79) * lu(k,489) + lu(k,494) = lu(k,494) - lu(k,80) * lu(k,489) + lu(k,495) = lu(k,495) - lu(k,81) * lu(k,489) + lu(k,504) = lu(k,504) - lu(k,82) * lu(k,489) + lu(k,507) = lu(k,507) - lu(k,83) * lu(k,489) + lu(k,84) = 1._r8 / lu(k,84) + lu(k,85) = lu(k,85) * lu(k,84) + lu(k,86) = lu(k,86) * lu(k,84) + lu(k,87) = lu(k,87) * lu(k,84) + lu(k,88) = lu(k,88) * lu(k,84) + lu(k,89) = lu(k,89) * lu(k,84) + lu(k,90) = lu(k,90) * lu(k,84) + lu(k,91) = lu(k,91) * lu(k,84) + lu(k,401) = lu(k,401) - lu(k,85) * lu(k,395) + lu(k,412) = - lu(k,86) * lu(k,395) + lu(k,415) = lu(k,415) - lu(k,87) * lu(k,395) + lu(k,418) = lu(k,418) - lu(k,88) * lu(k,395) + lu(k,420) = lu(k,420) - lu(k,89) * lu(k,395) + lu(k,427) = lu(k,427) - lu(k,90) * lu(k,395) + lu(k,431) = lu(k,431) - lu(k,91) * lu(k,395) + lu(k,589) = - lu(k,85) * lu(k,588) + lu(k,593) = lu(k,593) - lu(k,86) * lu(k,588) + lu(k,596) = - lu(k,87) * lu(k,588) + lu(k,599) = lu(k,599) - lu(k,88) * lu(k,588) + lu(k,601) = lu(k,601) - lu(k,89) * lu(k,588) + lu(k,608) = lu(k,608) - lu(k,90) * lu(k,588) + lu(k,612) = lu(k,612) - lu(k,91) * lu(k,588) + lu(k,698) = lu(k,698) - lu(k,85) * lu(k,697) + lu(k,700) = - lu(k,86) * lu(k,697) + lu(k,703) = lu(k,703) - lu(k,87) * lu(k,697) + lu(k,706) = - lu(k,88) * lu(k,697) + lu(k,708) = lu(k,708) - lu(k,89) * lu(k,697) + lu(k,715) = lu(k,715) - lu(k,90) * lu(k,697) + lu(k,719) = lu(k,719) - lu(k,91) * lu(k,697) + end do + end subroutine lu_fac02 + subroutine lu_fac03( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,92) = 1._r8 / lu(k,92) + lu(k,93) = lu(k,93) * lu(k,92) + lu(k,94) = lu(k,94) * lu(k,92) + lu(k,95) = lu(k,95) * lu(k,92) + lu(k,175) = - lu(k,93) * lu(k,167) + lu(k,176) = - lu(k,94) * lu(k,167) + lu(k,179) = - lu(k,95) * lu(k,167) + lu(k,290) = - lu(k,93) * lu(k,288) + lu(k,292) = lu(k,292) - lu(k,94) * lu(k,288) + lu(k,298) = - lu(k,95) * lu(k,288) + lu(k,347) = - lu(k,93) * lu(k,343) + lu(k,351) = lu(k,351) - lu(k,94) * lu(k,343) + lu(k,360) = lu(k,360) - lu(k,95) * lu(k,343) + lu(k,414) = lu(k,414) - lu(k,93) * lu(k,396) + lu(k,419) = lu(k,419) - lu(k,94) * lu(k,396) + lu(k,428) = lu(k,428) - lu(k,95) * lu(k,396) + lu(k,467) = lu(k,467) - lu(k,93) * lu(k,462) + lu(k,472) = lu(k,472) - lu(k,94) * lu(k,462) + lu(k,481) = lu(k,481) - lu(k,95) * lu(k,462) + lu(k,545) = lu(k,545) - lu(k,93) * lu(k,542) + lu(k,550) = lu(k,550) - lu(k,94) * lu(k,542) + lu(k,559) = lu(k,559) - lu(k,95) * lu(k,542) + lu(k,632) = lu(k,632) - lu(k,93) * lu(k,621) + lu(k,637) = lu(k,637) - lu(k,94) * lu(k,621) + lu(k,646) = lu(k,646) - lu(k,95) * lu(k,621) + lu(k,96) = 1._r8 / lu(k,96) + lu(k,97) = lu(k,97) * lu(k,96) + lu(k,98) = lu(k,98) * lu(k,96) + lu(k,99) = lu(k,99) * lu(k,96) + lu(k,100) = lu(k,100) * lu(k,96) + lu(k,101) = lu(k,101) * lu(k,96) + lu(k,102) = lu(k,102) * lu(k,96) + lu(k,373) = lu(k,373) - lu(k,97) * lu(k,367) + lu(k,376) = lu(k,376) - lu(k,98) * lu(k,367) + lu(k,377) = lu(k,377) - lu(k,99) * lu(k,367) + lu(k,379) = lu(k,379) - lu(k,100) * lu(k,367) + lu(k,385) = lu(k,385) - lu(k,101) * lu(k,367) + lu(k,389) = lu(k,389) - lu(k,102) * lu(k,367) + lu(k,416) = lu(k,416) - lu(k,97) * lu(k,397) + lu(k,419) = lu(k,419) - lu(k,98) * lu(k,397) + lu(k,420) = lu(k,420) - lu(k,99) * lu(k,397) + lu(k,422) = lu(k,422) - lu(k,100) * lu(k,397) + lu(k,428) = lu(k,428) - lu(k,101) * lu(k,397) + lu(k,432) = - lu(k,102) * lu(k,397) + lu(k,469) = lu(k,469) - lu(k,97) * lu(k,463) + lu(k,472) = lu(k,472) - lu(k,98) * lu(k,463) + lu(k,473) = - lu(k,99) * lu(k,463) + lu(k,475) = lu(k,475) - lu(k,100) * lu(k,463) + lu(k,481) = lu(k,481) - lu(k,101) * lu(k,463) + lu(k,485) = - lu(k,102) * lu(k,463) + lu(k,634) = lu(k,634) - lu(k,97) * lu(k,622) + lu(k,637) = lu(k,637) - lu(k,98) * lu(k,622) + lu(k,638) = lu(k,638) - lu(k,99) * lu(k,622) + lu(k,640) = lu(k,640) - lu(k,100) * lu(k,622) + lu(k,646) = lu(k,646) - lu(k,101) * lu(k,622) + lu(k,650) = lu(k,650) - lu(k,102) * lu(k,622) + lu(k,103) = 1._r8 / lu(k,103) + lu(k,104) = lu(k,104) * lu(k,103) + lu(k,105) = lu(k,105) * lu(k,103) + lu(k,106) = lu(k,106) * lu(k,103) + lu(k,107) = lu(k,107) * lu(k,103) + lu(k,108) = lu(k,108) * lu(k,103) + lu(k,109) = lu(k,109) * lu(k,103) + lu(k,110) = lu(k,110) * lu(k,103) + lu(k,111) = lu(k,111) * lu(k,103) + lu(k,192) = lu(k,192) - lu(k,104) * lu(k,191) + lu(k,194) = lu(k,194) - lu(k,105) * lu(k,191) + lu(k,195) = lu(k,195) - lu(k,106) * lu(k,191) + lu(k,196) = lu(k,196) - lu(k,107) * lu(k,191) + lu(k,197) = lu(k,197) - lu(k,108) * lu(k,191) + lu(k,198) = lu(k,198) - lu(k,109) * lu(k,191) + lu(k,201) = lu(k,201) - lu(k,110) * lu(k,191) + lu(k,202) = lu(k,202) - lu(k,111) * lu(k,191) + lu(k,400) = lu(k,400) - lu(k,104) * lu(k,398) + lu(k,405) = lu(k,405) - lu(k,105) * lu(k,398) + lu(k,406) = lu(k,406) - lu(k,106) * lu(k,398) + lu(k,407) = lu(k,407) - lu(k,107) * lu(k,398) + lu(k,408) = lu(k,408) - lu(k,108) * lu(k,398) + lu(k,409) = lu(k,409) - lu(k,109) * lu(k,398) + lu(k,420) = lu(k,420) - lu(k,110) * lu(k,398) + lu(k,423) = lu(k,423) - lu(k,111) * lu(k,398) + lu(k,492) = lu(k,492) - lu(k,104) * lu(k,490) + lu(k,494) = lu(k,494) - lu(k,105) * lu(k,490) + lu(k,495) = lu(k,495) - lu(k,106) * lu(k,490) + lu(k,496) = lu(k,496) - lu(k,107) * lu(k,490) + lu(k,497) = lu(k,497) - lu(k,108) * lu(k,490) + lu(k,498) = lu(k,498) - lu(k,109) * lu(k,490) + lu(k,504) = lu(k,504) - lu(k,110) * lu(k,490) + lu(k,507) = lu(k,507) - lu(k,111) * lu(k,490) + lu(k,112) = 1._r8 / lu(k,112) + lu(k,113) = lu(k,113) * lu(k,112) + lu(k,114) = lu(k,114) * lu(k,112) + lu(k,115) = lu(k,115) * lu(k,112) + lu(k,116) = lu(k,116) * lu(k,112) + lu(k,117) = lu(k,117) * lu(k,112) + lu(k,118) = lu(k,118) * lu(k,112) + lu(k,266) = lu(k,266) - lu(k,113) * lu(k,264) + lu(k,267) = lu(k,267) - lu(k,114) * lu(k,264) + lu(k,270) = lu(k,270) - lu(k,115) * lu(k,264) + lu(k,273) = lu(k,273) - lu(k,116) * lu(k,264) + lu(k,274) = lu(k,274) - lu(k,117) * lu(k,264) + lu(k,276) = lu(k,276) - lu(k,118) * lu(k,264) + lu(k,413) = lu(k,413) - lu(k,113) * lu(k,399) + lu(k,414) = lu(k,414) - lu(k,114) * lu(k,399) + lu(k,420) = lu(k,420) - lu(k,115) * lu(k,399) + lu(k,423) = lu(k,423) - lu(k,116) * lu(k,399) + lu(k,426) = lu(k,426) - lu(k,117) * lu(k,399) + lu(k,428) = lu(k,428) - lu(k,118) * lu(k,399) + lu(k,500) = lu(k,500) - lu(k,113) * lu(k,491) + lu(k,501) = lu(k,501) - lu(k,114) * lu(k,491) + lu(k,504) = lu(k,504) - lu(k,115) * lu(k,491) + lu(k,507) = lu(k,507) - lu(k,116) * lu(k,491) + lu(k,510) = lu(k,510) - lu(k,117) * lu(k,491) + lu(k,512) = - lu(k,118) * lu(k,491) + lu(k,568) = lu(k,568) - lu(k,113) * lu(k,566) + lu(k,569) = lu(k,569) - lu(k,114) * lu(k,566) + lu(k,573) = lu(k,573) - lu(k,115) * lu(k,566) + lu(k,576) = lu(k,576) - lu(k,116) * lu(k,566) + lu(k,579) = lu(k,579) - lu(k,117) * lu(k,566) + lu(k,581) = lu(k,581) - lu(k,118) * lu(k,566) + lu(k,631) = lu(k,631) - lu(k,113) * lu(k,623) + lu(k,632) = lu(k,632) - lu(k,114) * lu(k,623) + lu(k,638) = lu(k,638) - lu(k,115) * lu(k,623) + lu(k,641) = lu(k,641) - lu(k,116) * lu(k,623) + lu(k,644) = lu(k,644) - lu(k,117) * lu(k,623) + lu(k,646) = lu(k,646) - lu(k,118) * lu(k,623) + lu(k,119) = 1._r8 / lu(k,119) + lu(k,120) = lu(k,120) * lu(k,119) + lu(k,121) = lu(k,121) * lu(k,119) + lu(k,122) = lu(k,122) * lu(k,119) + lu(k,123) = lu(k,123) * lu(k,119) + lu(k,162) = - lu(k,120) * lu(k,158) + lu(k,163) = - lu(k,121) * lu(k,158) + lu(k,164) = lu(k,164) - lu(k,122) * lu(k,158) + lu(k,165) = lu(k,165) - lu(k,123) * lu(k,158) + lu(k,172) = - lu(k,120) * lu(k,168) + lu(k,173) = lu(k,173) - lu(k,121) * lu(k,168) + lu(k,174) = lu(k,174) - lu(k,122) * lu(k,168) + lu(k,177) = lu(k,177) - lu(k,123) * lu(k,168) + lu(k,182) = lu(k,182) - lu(k,120) * lu(k,180) + lu(k,183) = - lu(k,121) * lu(k,180) + lu(k,184) = lu(k,184) - lu(k,122) * lu(k,180) + lu(k,185) = lu(k,185) - lu(k,123) * lu(k,180) + lu(k,196) = lu(k,196) - lu(k,120) * lu(k,192) + lu(k,197) = lu(k,197) - lu(k,121) * lu(k,192) + lu(k,198) = lu(k,198) - lu(k,122) * lu(k,192) + lu(k,201) = lu(k,201) - lu(k,123) * lu(k,192) + lu(k,223) = lu(k,223) - lu(k,120) * lu(k,219) + lu(k,224) = - lu(k,121) * lu(k,219) + lu(k,225) = lu(k,225) - lu(k,122) * lu(k,219) + lu(k,228) = lu(k,228) - lu(k,123) * lu(k,219) + lu(k,407) = lu(k,407) - lu(k,120) * lu(k,400) + lu(k,408) = lu(k,408) - lu(k,121) * lu(k,400) + lu(k,409) = lu(k,409) - lu(k,122) * lu(k,400) + lu(k,420) = lu(k,420) - lu(k,123) * lu(k,400) + lu(k,496) = lu(k,496) - lu(k,120) * lu(k,492) + lu(k,497) = lu(k,497) - lu(k,121) * lu(k,492) + lu(k,498) = lu(k,498) - lu(k,122) * lu(k,492) + lu(k,504) = lu(k,504) - lu(k,123) * lu(k,492) + lu(k,653) = lu(k,653) - lu(k,120) * lu(k,651) + lu(k,654) = - lu(k,121) * lu(k,651) + lu(k,655) = lu(k,655) - lu(k,122) * lu(k,651) + lu(k,661) = lu(k,661) - lu(k,123) * lu(k,651) + lu(k,125) = 1._r8 / lu(k,125) + lu(k,126) = lu(k,126) * lu(k,125) + lu(k,127) = lu(k,127) * lu(k,125) + lu(k,128) = lu(k,128) * lu(k,125) + lu(k,129) = lu(k,129) * lu(k,125) + lu(k,130) = lu(k,130) * lu(k,125) + lu(k,131) = lu(k,131) * lu(k,125) + lu(k,132) = lu(k,132) * lu(k,125) + lu(k,255) = lu(k,255) - lu(k,126) * lu(k,254) + lu(k,256) = lu(k,256) - lu(k,127) * lu(k,254) + lu(k,257) = - lu(k,128) * lu(k,254) + lu(k,258) = lu(k,258) - lu(k,129) * lu(k,254) + lu(k,260) = lu(k,260) - lu(k,130) * lu(k,254) + lu(k,261) = - lu(k,131) * lu(k,254) + lu(k,262) = lu(k,262) - lu(k,132) * lu(k,254) + lu(k,522) = - lu(k,126) * lu(k,520) + lu(k,523) = lu(k,523) - lu(k,127) * lu(k,520) + lu(k,526) = lu(k,526) - lu(k,128) * lu(k,520) + lu(k,527) = - lu(k,129) * lu(k,520) + lu(k,537) = lu(k,537) - lu(k,130) * lu(k,520) + lu(k,539) = lu(k,539) - lu(k,131) * lu(k,520) + lu(k,541) = lu(k,541) - lu(k,132) * lu(k,520) + lu(k,630) = lu(k,630) - lu(k,126) * lu(k,624) + lu(k,632) = lu(k,632) - lu(k,127) * lu(k,624) + lu(k,635) = lu(k,635) - lu(k,128) * lu(k,624) + lu(k,636) = lu(k,636) - lu(k,129) * lu(k,624) + lu(k,646) = lu(k,646) - lu(k,130) * lu(k,624) + lu(k,648) = lu(k,648) - lu(k,131) * lu(k,624) + lu(k,650) = lu(k,650) - lu(k,132) * lu(k,624) + lu(k,676) = - lu(k,126) * lu(k,675) + lu(k,677) = lu(k,677) - lu(k,127) * lu(k,675) + lu(k,679) = - lu(k,128) * lu(k,675) + lu(k,680) = - lu(k,129) * lu(k,675) + lu(k,690) = lu(k,690) - lu(k,130) * lu(k,675) + lu(k,692) = lu(k,692) - lu(k,131) * lu(k,675) + lu(k,694) = lu(k,694) - lu(k,132) * lu(k,675) + lu(k,726) = - lu(k,126) * lu(k,724) + lu(k,728) = lu(k,728) - lu(k,127) * lu(k,724) + lu(k,730) = - lu(k,128) * lu(k,724) + lu(k,731) = - lu(k,129) * lu(k,724) + lu(k,741) = lu(k,741) - lu(k,130) * lu(k,724) + lu(k,743) = lu(k,743) - lu(k,131) * lu(k,724) + lu(k,745) = lu(k,745) - lu(k,132) * lu(k,724) + end do + end subroutine lu_fac03 + subroutine lu_fac04( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,134) = 1._r8 / lu(k,134) + lu(k,135) = lu(k,135) * lu(k,134) + lu(k,136) = lu(k,136) * lu(k,134) + lu(k,137) = lu(k,137) * lu(k,134) + lu(k,138) = lu(k,138) * lu(k,134) + lu(k,139) = lu(k,139) * lu(k,134) + lu(k,140) = lu(k,140) * lu(k,134) + lu(k,141) = lu(k,141) * lu(k,134) + lu(k,309) = lu(k,309) - lu(k,135) * lu(k,304) + lu(k,310) = lu(k,310) - lu(k,136) * lu(k,304) + lu(k,314) = lu(k,314) - lu(k,137) * lu(k,304) + lu(k,316) = lu(k,316) - lu(k,138) * lu(k,304) + lu(k,322) = lu(k,322) - lu(k,139) * lu(k,304) + lu(k,324) = - lu(k,140) * lu(k,304) + lu(k,325) = lu(k,325) - lu(k,141) * lu(k,304) + lu(k,372) = lu(k,372) - lu(k,135) * lu(k,368) + lu(k,373) = lu(k,373) - lu(k,136) * lu(k,368) + lu(k,377) = lu(k,377) - lu(k,137) * lu(k,368) + lu(k,379) = lu(k,379) - lu(k,138) * lu(k,368) + lu(k,385) = lu(k,385) - lu(k,139) * lu(k,368) + lu(k,388) = lu(k,388) - lu(k,140) * lu(k,368) + lu(k,389) = lu(k,389) - lu(k,141) * lu(k,368) + lu(k,415) = lu(k,415) - lu(k,135) * lu(k,401) + lu(k,416) = lu(k,416) - lu(k,136) * lu(k,401) + lu(k,420) = lu(k,420) - lu(k,137) * lu(k,401) + lu(k,422) = lu(k,422) - lu(k,138) * lu(k,401) + lu(k,428) = lu(k,428) - lu(k,139) * lu(k,401) + lu(k,431) = lu(k,431) - lu(k,140) * lu(k,401) + lu(k,432) = lu(k,432) - lu(k,141) * lu(k,401) + lu(k,596) = lu(k,596) - lu(k,135) * lu(k,589) + lu(k,597) = - lu(k,136) * lu(k,589) + lu(k,601) = lu(k,601) - lu(k,137) * lu(k,589) + lu(k,603) = - lu(k,138) * lu(k,589) + lu(k,609) = lu(k,609) - lu(k,139) * lu(k,589) + lu(k,612) = lu(k,612) - lu(k,140) * lu(k,589) + lu(k,613) = lu(k,613) - lu(k,141) * lu(k,589) + lu(k,703) = lu(k,703) - lu(k,135) * lu(k,698) + lu(k,704) = - lu(k,136) * lu(k,698) + lu(k,708) = lu(k,708) - lu(k,137) * lu(k,698) + lu(k,710) = lu(k,710) - lu(k,138) * lu(k,698) + lu(k,716) = lu(k,716) - lu(k,139) * lu(k,698) + lu(k,719) = lu(k,719) - lu(k,140) * lu(k,698) + lu(k,720) = - lu(k,141) * lu(k,698) + lu(k,143) = 1._r8 / lu(k,143) + lu(k,144) = lu(k,144) * lu(k,143) + lu(k,145) = lu(k,145) * lu(k,143) + lu(k,146) = lu(k,146) * lu(k,143) + lu(k,147) = lu(k,147) * lu(k,143) + lu(k,148) = lu(k,148) * lu(k,143) + lu(k,149) = lu(k,149) * lu(k,143) + lu(k,245) = lu(k,245) - lu(k,144) * lu(k,242) + lu(k,247) = lu(k,247) - lu(k,145) * lu(k,242) + lu(k,248) = lu(k,248) - lu(k,146) * lu(k,242) + lu(k,249) = lu(k,249) - lu(k,147) * lu(k,242) + lu(k,251) = lu(k,251) - lu(k,148) * lu(k,242) + lu(k,252) = - lu(k,149) * lu(k,242) + lu(k,310) = lu(k,310) - lu(k,144) * lu(k,305) + lu(k,314) = lu(k,314) - lu(k,145) * lu(k,305) + lu(k,315) = lu(k,315) - lu(k,146) * lu(k,305) + lu(k,316) = lu(k,316) - lu(k,147) * lu(k,305) + lu(k,322) = lu(k,322) - lu(k,148) * lu(k,305) + lu(k,325) = lu(k,325) - lu(k,149) * lu(k,305) + lu(k,373) = lu(k,373) - lu(k,144) * lu(k,369) + lu(k,377) = lu(k,377) - lu(k,145) * lu(k,369) + lu(k,378) = lu(k,378) - lu(k,146) * lu(k,369) + lu(k,379) = lu(k,379) - lu(k,147) * lu(k,369) + lu(k,385) = lu(k,385) - lu(k,148) * lu(k,369) + lu(k,389) = lu(k,389) - lu(k,149) * lu(k,369) + lu(k,416) = lu(k,416) - lu(k,144) * lu(k,402) + lu(k,420) = lu(k,420) - lu(k,145) * lu(k,402) + lu(k,421) = lu(k,421) - lu(k,146) * lu(k,402) + lu(k,422) = lu(k,422) - lu(k,147) * lu(k,402) + lu(k,428) = lu(k,428) - lu(k,148) * lu(k,402) + lu(k,432) = lu(k,432) - lu(k,149) * lu(k,402) + lu(k,444) = lu(k,444) - lu(k,144) * lu(k,437) + lu(k,448) = lu(k,448) - lu(k,145) * lu(k,437) + lu(k,449) = lu(k,449) - lu(k,146) * lu(k,437) + lu(k,450) = lu(k,450) - lu(k,147) * lu(k,437) + lu(k,456) = lu(k,456) - lu(k,148) * lu(k,437) + lu(k,460) = - lu(k,149) * lu(k,437) + lu(k,469) = lu(k,469) - lu(k,144) * lu(k,464) + lu(k,473) = lu(k,473) - lu(k,145) * lu(k,464) + lu(k,474) = lu(k,474) - lu(k,146) * lu(k,464) + lu(k,475) = lu(k,475) - lu(k,147) * lu(k,464) + lu(k,481) = lu(k,481) - lu(k,148) * lu(k,464) + lu(k,485) = lu(k,485) - lu(k,149) * lu(k,464) + lu(k,634) = lu(k,634) - lu(k,144) * lu(k,625) + lu(k,638) = lu(k,638) - lu(k,145) * lu(k,625) + lu(k,639) = lu(k,639) - lu(k,146) * lu(k,625) + lu(k,640) = lu(k,640) - lu(k,147) * lu(k,625) + lu(k,646) = lu(k,646) - lu(k,148) * lu(k,625) + lu(k,650) = lu(k,650) - lu(k,149) * lu(k,625) + lu(k,150) = 1._r8 / lu(k,150) + lu(k,151) = lu(k,151) * lu(k,150) + lu(k,152) = lu(k,152) * lu(k,150) + lu(k,153) = lu(k,153) * lu(k,150) + lu(k,154) = lu(k,154) * lu(k,150) + lu(k,155) = lu(k,155) * lu(k,150) + lu(k,156) = lu(k,156) * lu(k,150) + lu(k,157) = lu(k,157) * lu(k,150) + lu(k,290) = lu(k,290) - lu(k,151) * lu(k,289) + lu(k,291) = lu(k,291) - lu(k,152) * lu(k,289) + lu(k,293) = - lu(k,153) * lu(k,289) + lu(k,295) = - lu(k,154) * lu(k,289) + lu(k,298) = lu(k,298) - lu(k,155) * lu(k,289) + lu(k,300) = lu(k,300) - lu(k,156) * lu(k,289) + lu(k,301) = - lu(k,157) * lu(k,289) + lu(k,371) = lu(k,371) - lu(k,151) * lu(k,370) + lu(k,372) = lu(k,372) - lu(k,152) * lu(k,370) + lu(k,377) = lu(k,377) - lu(k,153) * lu(k,370) + lu(k,381) = - lu(k,154) * lu(k,370) + lu(k,385) = lu(k,385) - lu(k,155) * lu(k,370) + lu(k,388) = lu(k,388) - lu(k,156) * lu(k,370) + lu(k,389) = lu(k,389) - lu(k,157) * lu(k,370) + lu(k,414) = lu(k,414) - lu(k,151) * lu(k,403) + lu(k,415) = lu(k,415) - lu(k,152) * lu(k,403) + lu(k,420) = lu(k,420) - lu(k,153) * lu(k,403) + lu(k,424) = - lu(k,154) * lu(k,403) + lu(k,428) = lu(k,428) - lu(k,155) * lu(k,403) + lu(k,431) = lu(k,431) - lu(k,156) * lu(k,403) + lu(k,432) = lu(k,432) - lu(k,157) * lu(k,403) + lu(k,523) = lu(k,523) - lu(k,151) * lu(k,521) + lu(k,524) = lu(k,524) - lu(k,152) * lu(k,521) + lu(k,529) = lu(k,529) - lu(k,153) * lu(k,521) + lu(k,533) = lu(k,533) - lu(k,154) * lu(k,521) + lu(k,537) = lu(k,537) - lu(k,155) * lu(k,521) + lu(k,540) = lu(k,540) - lu(k,156) * lu(k,521) + lu(k,541) = lu(k,541) - lu(k,157) * lu(k,521) + lu(k,545) = lu(k,545) - lu(k,151) * lu(k,543) + lu(k,546) = lu(k,546) - lu(k,152) * lu(k,543) + lu(k,551) = lu(k,551) - lu(k,153) * lu(k,543) + lu(k,555) = - lu(k,154) * lu(k,543) + lu(k,559) = lu(k,559) - lu(k,155) * lu(k,543) + lu(k,562) = - lu(k,156) * lu(k,543) + lu(k,563) = lu(k,563) - lu(k,157) * lu(k,543) + lu(k,632) = lu(k,632) - lu(k,151) * lu(k,626) + lu(k,633) = lu(k,633) - lu(k,152) * lu(k,626) + lu(k,638) = lu(k,638) - lu(k,153) * lu(k,626) + lu(k,642) = lu(k,642) - lu(k,154) * lu(k,626) + lu(k,646) = lu(k,646) - lu(k,155) * lu(k,626) + lu(k,649) = lu(k,649) - lu(k,156) * lu(k,626) + lu(k,650) = lu(k,650) - lu(k,157) * lu(k,626) + lu(k,159) = 1._r8 / lu(k,159) + lu(k,160) = lu(k,160) * lu(k,159) + lu(k,161) = lu(k,161) * lu(k,159) + lu(k,162) = lu(k,162) * lu(k,159) + lu(k,163) = lu(k,163) * lu(k,159) + lu(k,164) = lu(k,164) * lu(k,159) + lu(k,165) = lu(k,165) * lu(k,159) + lu(k,166) = lu(k,166) * lu(k,159) + lu(k,170) = lu(k,170) - lu(k,160) * lu(k,169) + lu(k,171) = lu(k,171) - lu(k,161) * lu(k,169) + lu(k,172) = lu(k,172) - lu(k,162) * lu(k,169) + lu(k,173) = lu(k,173) - lu(k,163) * lu(k,169) + lu(k,174) = lu(k,174) - lu(k,164) * lu(k,169) + lu(k,177) = lu(k,177) - lu(k,165) * lu(k,169) + lu(k,178) = lu(k,178) - lu(k,166) * lu(k,169) + lu(k,194) = lu(k,194) - lu(k,160) * lu(k,193) + lu(k,195) = lu(k,195) - lu(k,161) * lu(k,193) + lu(k,196) = lu(k,196) - lu(k,162) * lu(k,193) + lu(k,197) = lu(k,197) - lu(k,163) * lu(k,193) + lu(k,198) = lu(k,198) - lu(k,164) * lu(k,193) + lu(k,201) = lu(k,201) - lu(k,165) * lu(k,193) + lu(k,202) = lu(k,202) - lu(k,166) * lu(k,193) + lu(k,207) = lu(k,207) - lu(k,160) * lu(k,206) + lu(k,208) = - lu(k,161) * lu(k,206) + lu(k,209) = - lu(k,162) * lu(k,206) + lu(k,210) = lu(k,210) - lu(k,163) * lu(k,206) + lu(k,211) = lu(k,211) - lu(k,164) * lu(k,206) + lu(k,214) = lu(k,214) - lu(k,165) * lu(k,206) + lu(k,215) = lu(k,215) - lu(k,166) * lu(k,206) + lu(k,221) = - lu(k,160) * lu(k,220) + lu(k,222) = lu(k,222) - lu(k,161) * lu(k,220) + lu(k,223) = lu(k,223) - lu(k,162) * lu(k,220) + lu(k,224) = lu(k,224) - lu(k,163) * lu(k,220) + lu(k,225) = lu(k,225) - lu(k,164) * lu(k,220) + lu(k,228) = lu(k,228) - lu(k,165) * lu(k,220) + lu(k,229) = lu(k,229) - lu(k,166) * lu(k,220) + lu(k,405) = lu(k,405) - lu(k,160) * lu(k,404) + lu(k,406) = lu(k,406) - lu(k,161) * lu(k,404) + lu(k,407) = lu(k,407) - lu(k,162) * lu(k,404) + lu(k,408) = lu(k,408) - lu(k,163) * lu(k,404) + lu(k,409) = lu(k,409) - lu(k,164) * lu(k,404) + lu(k,420) = lu(k,420) - lu(k,165) * lu(k,404) + lu(k,423) = lu(k,423) - lu(k,166) * lu(k,404) + lu(k,494) = lu(k,494) - lu(k,160) * lu(k,493) + lu(k,495) = lu(k,495) - lu(k,161) * lu(k,493) + lu(k,496) = lu(k,496) - lu(k,162) * lu(k,493) + lu(k,497) = lu(k,497) - lu(k,163) * lu(k,493) + lu(k,498) = lu(k,498) - lu(k,164) * lu(k,493) + lu(k,504) = lu(k,504) - lu(k,165) * lu(k,493) + lu(k,507) = lu(k,507) - lu(k,166) * lu(k,493) + lu(k,170) = 1._r8 / lu(k,170) + lu(k,171) = lu(k,171) * lu(k,170) + lu(k,172) = lu(k,172) * lu(k,170) + lu(k,173) = lu(k,173) * lu(k,170) + lu(k,174) = lu(k,174) * lu(k,170) + lu(k,175) = lu(k,175) * lu(k,170) + lu(k,176) = lu(k,176) * lu(k,170) + lu(k,177) = lu(k,177) * lu(k,170) + lu(k,178) = lu(k,178) * lu(k,170) + lu(k,179) = lu(k,179) * lu(k,170) + lu(k,195) = lu(k,195) - lu(k,171) * lu(k,194) + lu(k,196) = lu(k,196) - lu(k,172) * lu(k,194) + lu(k,197) = lu(k,197) - lu(k,173) * lu(k,194) + lu(k,198) = lu(k,198) - lu(k,174) * lu(k,194) + lu(k,199) = - lu(k,175) * lu(k,194) + lu(k,200) = - lu(k,176) * lu(k,194) + lu(k,201) = lu(k,201) - lu(k,177) * lu(k,194) + lu(k,202) = lu(k,202) - lu(k,178) * lu(k,194) + lu(k,204) = - lu(k,179) * lu(k,194) + lu(k,208) = lu(k,208) - lu(k,171) * lu(k,207) + lu(k,209) = lu(k,209) - lu(k,172) * lu(k,207) + lu(k,210) = lu(k,210) - lu(k,173) * lu(k,207) + lu(k,211) = lu(k,211) - lu(k,174) * lu(k,207) + lu(k,212) = - lu(k,175) * lu(k,207) + lu(k,213) = - lu(k,176) * lu(k,207) + lu(k,214) = lu(k,214) - lu(k,177) * lu(k,207) + lu(k,215) = lu(k,215) - lu(k,178) * lu(k,207) + lu(k,217) = - lu(k,179) * lu(k,207) + lu(k,222) = lu(k,222) - lu(k,171) * lu(k,221) + lu(k,223) = lu(k,223) - lu(k,172) * lu(k,221) + lu(k,224) = lu(k,224) - lu(k,173) * lu(k,221) + lu(k,225) = lu(k,225) - lu(k,174) * lu(k,221) + lu(k,226) = lu(k,226) - lu(k,175) * lu(k,221) + lu(k,227) = - lu(k,176) * lu(k,221) + lu(k,228) = lu(k,228) - lu(k,177) * lu(k,221) + lu(k,229) = lu(k,229) - lu(k,178) * lu(k,221) + lu(k,232) = lu(k,232) - lu(k,179) * lu(k,221) + lu(k,406) = lu(k,406) - lu(k,171) * lu(k,405) + lu(k,407) = lu(k,407) - lu(k,172) * lu(k,405) + lu(k,408) = lu(k,408) - lu(k,173) * lu(k,405) + lu(k,409) = lu(k,409) - lu(k,174) * lu(k,405) + lu(k,414) = lu(k,414) - lu(k,175) * lu(k,405) + lu(k,419) = lu(k,419) - lu(k,176) * lu(k,405) + lu(k,420) = lu(k,420) - lu(k,177) * lu(k,405) + lu(k,423) = lu(k,423) - lu(k,178) * lu(k,405) + lu(k,428) = lu(k,428) - lu(k,179) * lu(k,405) + lu(k,495) = lu(k,495) - lu(k,171) * lu(k,494) + lu(k,496) = lu(k,496) - lu(k,172) * lu(k,494) + lu(k,497) = lu(k,497) - lu(k,173) * lu(k,494) + lu(k,498) = lu(k,498) - lu(k,174) * lu(k,494) + lu(k,501) = lu(k,501) - lu(k,175) * lu(k,494) + lu(k,503) = lu(k,503) - lu(k,176) * lu(k,494) + lu(k,504) = lu(k,504) - lu(k,177) * lu(k,494) + lu(k,507) = lu(k,507) - lu(k,178) * lu(k,494) + lu(k,512) = lu(k,512) - lu(k,179) * lu(k,494) + end do + end subroutine lu_fac04 + subroutine lu_fac05( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,181) = 1._r8 / lu(k,181) + lu(k,182) = lu(k,182) * lu(k,181) + lu(k,183) = lu(k,183) * lu(k,181) + lu(k,184) = lu(k,184) * lu(k,181) + lu(k,185) = lu(k,185) * lu(k,181) + lu(k,186) = lu(k,186) * lu(k,181) + lu(k,187) = lu(k,187) * lu(k,181) + lu(k,188) = lu(k,188) * lu(k,181) + lu(k,196) = lu(k,196) - lu(k,182) * lu(k,195) + lu(k,197) = lu(k,197) - lu(k,183) * lu(k,195) + lu(k,198) = lu(k,198) - lu(k,184) * lu(k,195) + lu(k,201) = lu(k,201) - lu(k,185) * lu(k,195) + lu(k,202) = lu(k,202) - lu(k,186) * lu(k,195) + lu(k,203) = lu(k,203) - lu(k,187) * lu(k,195) + lu(k,205) = lu(k,205) - lu(k,188) * lu(k,195) + lu(k,209) = lu(k,209) - lu(k,182) * lu(k,208) + lu(k,210) = lu(k,210) - lu(k,183) * lu(k,208) + lu(k,211) = lu(k,211) - lu(k,184) * lu(k,208) + lu(k,214) = lu(k,214) - lu(k,185) * lu(k,208) + lu(k,215) = lu(k,215) - lu(k,186) * lu(k,208) + lu(k,216) = lu(k,216) - lu(k,187) * lu(k,208) + lu(k,218) = lu(k,218) - lu(k,188) * lu(k,208) + lu(k,223) = lu(k,223) - lu(k,182) * lu(k,222) + lu(k,224) = lu(k,224) - lu(k,183) * lu(k,222) + lu(k,225) = lu(k,225) - lu(k,184) * lu(k,222) + lu(k,228) = lu(k,228) - lu(k,185) * lu(k,222) + lu(k,229) = lu(k,229) - lu(k,186) * lu(k,222) + lu(k,230) = - lu(k,187) * lu(k,222) + lu(k,233) = lu(k,233) - lu(k,188) * lu(k,222) + lu(k,407) = lu(k,407) - lu(k,182) * lu(k,406) + lu(k,408) = lu(k,408) - lu(k,183) * lu(k,406) + lu(k,409) = lu(k,409) - lu(k,184) * lu(k,406) + lu(k,420) = lu(k,420) - lu(k,185) * lu(k,406) + lu(k,423) = lu(k,423) - lu(k,186) * lu(k,406) + lu(k,424) = lu(k,424) - lu(k,187) * lu(k,406) + lu(k,429) = lu(k,429) - lu(k,188) * lu(k,406) + lu(k,496) = lu(k,496) - lu(k,182) * lu(k,495) + lu(k,497) = lu(k,497) - lu(k,183) * lu(k,495) + lu(k,498) = lu(k,498) - lu(k,184) * lu(k,495) + lu(k,504) = lu(k,504) - lu(k,185) * lu(k,495) + lu(k,507) = lu(k,507) - lu(k,186) * lu(k,495) + lu(k,508) = lu(k,508) - lu(k,187) * lu(k,495) + lu(k,513) = lu(k,513) - lu(k,188) * lu(k,495) + lu(k,653) = lu(k,653) - lu(k,182) * lu(k,652) + lu(k,654) = lu(k,654) - lu(k,183) * lu(k,652) + lu(k,655) = lu(k,655) - lu(k,184) * lu(k,652) + lu(k,661) = lu(k,661) - lu(k,185) * lu(k,652) + lu(k,664) = lu(k,664) - lu(k,186) * lu(k,652) + lu(k,665) = - lu(k,187) * lu(k,652) + lu(k,670) = lu(k,670) - lu(k,188) * lu(k,652) + lu(k,196) = 1._r8 / lu(k,196) + lu(k,197) = lu(k,197) * lu(k,196) + lu(k,198) = lu(k,198) * lu(k,196) + lu(k,199) = lu(k,199) * lu(k,196) + lu(k,200) = lu(k,200) * lu(k,196) + lu(k,201) = lu(k,201) * lu(k,196) + lu(k,202) = lu(k,202) * lu(k,196) + lu(k,203) = lu(k,203) * lu(k,196) + lu(k,204) = lu(k,204) * lu(k,196) + lu(k,205) = lu(k,205) * lu(k,196) + lu(k,210) = lu(k,210) - lu(k,197) * lu(k,209) + lu(k,211) = lu(k,211) - lu(k,198) * lu(k,209) + lu(k,212) = lu(k,212) - lu(k,199) * lu(k,209) + lu(k,213) = lu(k,213) - lu(k,200) * lu(k,209) + lu(k,214) = lu(k,214) - lu(k,201) * lu(k,209) + lu(k,215) = lu(k,215) - lu(k,202) * lu(k,209) + lu(k,216) = lu(k,216) - lu(k,203) * lu(k,209) + lu(k,217) = lu(k,217) - lu(k,204) * lu(k,209) + lu(k,218) = lu(k,218) - lu(k,205) * lu(k,209) + lu(k,224) = lu(k,224) - lu(k,197) * lu(k,223) + lu(k,225) = lu(k,225) - lu(k,198) * lu(k,223) + lu(k,226) = lu(k,226) - lu(k,199) * lu(k,223) + lu(k,227) = lu(k,227) - lu(k,200) * lu(k,223) + lu(k,228) = lu(k,228) - lu(k,201) * lu(k,223) + lu(k,229) = lu(k,229) - lu(k,202) * lu(k,223) + lu(k,230) = lu(k,230) - lu(k,203) * lu(k,223) + lu(k,232) = lu(k,232) - lu(k,204) * lu(k,223) + lu(k,233) = lu(k,233) - lu(k,205) * lu(k,223) + lu(k,408) = lu(k,408) - lu(k,197) * lu(k,407) + lu(k,409) = lu(k,409) - lu(k,198) * lu(k,407) + lu(k,414) = lu(k,414) - lu(k,199) * lu(k,407) + lu(k,419) = lu(k,419) - lu(k,200) * lu(k,407) + lu(k,420) = lu(k,420) - lu(k,201) * lu(k,407) + lu(k,423) = lu(k,423) - lu(k,202) * lu(k,407) + lu(k,424) = lu(k,424) - lu(k,203) * lu(k,407) + lu(k,428) = lu(k,428) - lu(k,204) * lu(k,407) + lu(k,429) = lu(k,429) - lu(k,205) * lu(k,407) + lu(k,497) = lu(k,497) - lu(k,197) * lu(k,496) + lu(k,498) = lu(k,498) - lu(k,198) * lu(k,496) + lu(k,501) = lu(k,501) - lu(k,199) * lu(k,496) + lu(k,503) = lu(k,503) - lu(k,200) * lu(k,496) + lu(k,504) = lu(k,504) - lu(k,201) * lu(k,496) + lu(k,507) = lu(k,507) - lu(k,202) * lu(k,496) + lu(k,508) = lu(k,508) - lu(k,203) * lu(k,496) + lu(k,512) = lu(k,512) - lu(k,204) * lu(k,496) + lu(k,513) = lu(k,513) - lu(k,205) * lu(k,496) + lu(k,654) = lu(k,654) - lu(k,197) * lu(k,653) + lu(k,655) = lu(k,655) - lu(k,198) * lu(k,653) + lu(k,656) = - lu(k,199) * lu(k,653) + lu(k,660) = lu(k,660) - lu(k,200) * lu(k,653) + lu(k,661) = lu(k,661) - lu(k,201) * lu(k,653) + lu(k,664) = lu(k,664) - lu(k,202) * lu(k,653) + lu(k,665) = lu(k,665) - lu(k,203) * lu(k,653) + lu(k,669) = lu(k,669) - lu(k,204) * lu(k,653) + lu(k,670) = lu(k,670) - lu(k,205) * lu(k,653) + lu(k,210) = 1._r8 / lu(k,210) + lu(k,211) = lu(k,211) * lu(k,210) + lu(k,212) = lu(k,212) * lu(k,210) + lu(k,213) = lu(k,213) * lu(k,210) + lu(k,214) = lu(k,214) * lu(k,210) + lu(k,215) = lu(k,215) * lu(k,210) + lu(k,216) = lu(k,216) * lu(k,210) + lu(k,217) = lu(k,217) * lu(k,210) + lu(k,218) = lu(k,218) * lu(k,210) + lu(k,225) = lu(k,225) - lu(k,211) * lu(k,224) + lu(k,226) = lu(k,226) - lu(k,212) * lu(k,224) + lu(k,227) = lu(k,227) - lu(k,213) * lu(k,224) + lu(k,228) = lu(k,228) - lu(k,214) * lu(k,224) + lu(k,229) = lu(k,229) - lu(k,215) * lu(k,224) + lu(k,230) = lu(k,230) - lu(k,216) * lu(k,224) + lu(k,232) = lu(k,232) - lu(k,217) * lu(k,224) + lu(k,233) = lu(k,233) - lu(k,218) * lu(k,224) + lu(k,409) = lu(k,409) - lu(k,211) * lu(k,408) + lu(k,414) = lu(k,414) - lu(k,212) * lu(k,408) + lu(k,419) = lu(k,419) - lu(k,213) * lu(k,408) + lu(k,420) = lu(k,420) - lu(k,214) * lu(k,408) + lu(k,423) = lu(k,423) - lu(k,215) * lu(k,408) + lu(k,424) = lu(k,424) - lu(k,216) * lu(k,408) + lu(k,428) = lu(k,428) - lu(k,217) * lu(k,408) + lu(k,429) = lu(k,429) - lu(k,218) * lu(k,408) + lu(k,498) = lu(k,498) - lu(k,211) * lu(k,497) + lu(k,501) = lu(k,501) - lu(k,212) * lu(k,497) + lu(k,503) = lu(k,503) - lu(k,213) * lu(k,497) + lu(k,504) = lu(k,504) - lu(k,214) * lu(k,497) + lu(k,507) = lu(k,507) - lu(k,215) * lu(k,497) + lu(k,508) = lu(k,508) - lu(k,216) * lu(k,497) + lu(k,512) = lu(k,512) - lu(k,217) * lu(k,497) + lu(k,513) = lu(k,513) - lu(k,218) * lu(k,497) + lu(k,655) = lu(k,655) - lu(k,211) * lu(k,654) + lu(k,656) = lu(k,656) - lu(k,212) * lu(k,654) + lu(k,660) = lu(k,660) - lu(k,213) * lu(k,654) + lu(k,661) = lu(k,661) - lu(k,214) * lu(k,654) + lu(k,664) = lu(k,664) - lu(k,215) * lu(k,654) + lu(k,665) = lu(k,665) - lu(k,216) * lu(k,654) + lu(k,669) = lu(k,669) - lu(k,217) * lu(k,654) + lu(k,670) = lu(k,670) - lu(k,218) * lu(k,654) + lu(k,225) = 1._r8 / lu(k,225) + lu(k,226) = lu(k,226) * lu(k,225) + lu(k,227) = lu(k,227) * lu(k,225) + lu(k,228) = lu(k,228) * lu(k,225) + lu(k,229) = lu(k,229) * lu(k,225) + lu(k,230) = lu(k,230) * lu(k,225) + lu(k,231) = lu(k,231) * lu(k,225) + lu(k,232) = lu(k,232) * lu(k,225) + lu(k,233) = lu(k,233) * lu(k,225) + lu(k,414) = lu(k,414) - lu(k,226) * lu(k,409) + lu(k,419) = lu(k,419) - lu(k,227) * lu(k,409) + lu(k,420) = lu(k,420) - lu(k,228) * lu(k,409) + lu(k,423) = lu(k,423) - lu(k,229) * lu(k,409) + lu(k,424) = lu(k,424) - lu(k,230) * lu(k,409) + lu(k,427) = lu(k,427) - lu(k,231) * lu(k,409) + lu(k,428) = lu(k,428) - lu(k,232) * lu(k,409) + lu(k,429) = lu(k,429) - lu(k,233) * lu(k,409) + lu(k,501) = lu(k,501) - lu(k,226) * lu(k,498) + lu(k,503) = lu(k,503) - lu(k,227) * lu(k,498) + lu(k,504) = lu(k,504) - lu(k,228) * lu(k,498) + lu(k,507) = lu(k,507) - lu(k,229) * lu(k,498) + lu(k,508) = lu(k,508) - lu(k,230) * lu(k,498) + lu(k,511) = - lu(k,231) * lu(k,498) + lu(k,512) = lu(k,512) - lu(k,232) * lu(k,498) + lu(k,513) = lu(k,513) - lu(k,233) * lu(k,498) + lu(k,595) = - lu(k,226) * lu(k,590) + lu(k,600) = lu(k,600) - lu(k,227) * lu(k,590) + lu(k,601) = lu(k,601) - lu(k,228) * lu(k,590) + lu(k,604) = lu(k,604) - lu(k,229) * lu(k,590) + lu(k,605) = - lu(k,230) * lu(k,590) + lu(k,608) = lu(k,608) - lu(k,231) * lu(k,590) + lu(k,609) = lu(k,609) - lu(k,232) * lu(k,590) + lu(k,610) = lu(k,610) - lu(k,233) * lu(k,590) + lu(k,632) = lu(k,632) - lu(k,226) * lu(k,627) + lu(k,637) = lu(k,637) - lu(k,227) * lu(k,627) + lu(k,638) = lu(k,638) - lu(k,228) * lu(k,627) + lu(k,641) = lu(k,641) - lu(k,229) * lu(k,627) + lu(k,642) = lu(k,642) - lu(k,230) * lu(k,627) + lu(k,645) = lu(k,645) - lu(k,231) * lu(k,627) + lu(k,646) = lu(k,646) - lu(k,232) * lu(k,627) + lu(k,647) = lu(k,647) - lu(k,233) * lu(k,627) + lu(k,656) = lu(k,656) - lu(k,226) * lu(k,655) + lu(k,660) = lu(k,660) - lu(k,227) * lu(k,655) + lu(k,661) = lu(k,661) - lu(k,228) * lu(k,655) + lu(k,664) = lu(k,664) - lu(k,229) * lu(k,655) + lu(k,665) = lu(k,665) - lu(k,230) * lu(k,655) + lu(k,668) = lu(k,668) - lu(k,231) * lu(k,655) + lu(k,669) = lu(k,669) - lu(k,232) * lu(k,655) + lu(k,670) = lu(k,670) - lu(k,233) * lu(k,655) + lu(k,235) = 1._r8 / lu(k,235) + lu(k,236) = lu(k,236) * lu(k,235) + lu(k,237) = lu(k,237) * lu(k,235) + lu(k,238) = lu(k,238) * lu(k,235) + lu(k,239) = lu(k,239) * lu(k,235) + lu(k,240) = lu(k,240) * lu(k,235) + lu(k,266) = lu(k,266) - lu(k,236) * lu(k,265) + lu(k,269) = - lu(k,237) * lu(k,265) + lu(k,270) = lu(k,270) - lu(k,238) * lu(k,265) + lu(k,276) = lu(k,276) - lu(k,239) * lu(k,265) + lu(k,279) = - lu(k,240) * lu(k,265) + lu(k,346) = - lu(k,236) * lu(k,344) + lu(k,351) = lu(k,351) - lu(k,237) * lu(k,344) + lu(k,352) = lu(k,352) - lu(k,238) * lu(k,344) + lu(k,360) = lu(k,360) - lu(k,239) * lu(k,344) + lu(k,364) = - lu(k,240) * lu(k,344) + lu(k,413) = lu(k,413) - lu(k,236) * lu(k,410) + lu(k,419) = lu(k,419) - lu(k,237) * lu(k,410) + lu(k,420) = lu(k,420) - lu(k,238) * lu(k,410) + lu(k,428) = lu(k,428) - lu(k,239) * lu(k,410) + lu(k,432) = lu(k,432) - lu(k,240) * lu(k,410) + lu(k,441) = lu(k,441) - lu(k,236) * lu(k,438) + lu(k,447) = lu(k,447) - lu(k,237) * lu(k,438) + lu(k,448) = lu(k,448) - lu(k,238) * lu(k,438) + lu(k,456) = lu(k,456) - lu(k,239) * lu(k,438) + lu(k,460) = lu(k,460) - lu(k,240) * lu(k,438) + lu(k,500) = lu(k,500) - lu(k,236) * lu(k,499) + lu(k,503) = lu(k,503) - lu(k,237) * lu(k,499) + lu(k,504) = lu(k,504) - lu(k,238) * lu(k,499) + lu(k,512) = lu(k,512) - lu(k,239) * lu(k,499) + lu(k,516) = - lu(k,240) * lu(k,499) + lu(k,568) = lu(k,568) - lu(k,236) * lu(k,567) + lu(k,572) = lu(k,572) - lu(k,237) * lu(k,567) + lu(k,573) = lu(k,573) - lu(k,238) * lu(k,567) + lu(k,581) = lu(k,581) - lu(k,239) * lu(k,567) + lu(k,585) = - lu(k,240) * lu(k,567) + lu(k,594) = lu(k,594) - lu(k,236) * lu(k,591) + lu(k,600) = lu(k,600) - lu(k,237) * lu(k,591) + lu(k,601) = lu(k,601) - lu(k,238) * lu(k,591) + lu(k,609) = lu(k,609) - lu(k,239) * lu(k,591) + lu(k,613) = lu(k,613) - lu(k,240) * lu(k,591) + lu(k,631) = lu(k,631) - lu(k,236) * lu(k,628) + lu(k,637) = lu(k,637) - lu(k,237) * lu(k,628) + lu(k,638) = lu(k,638) - lu(k,238) * lu(k,628) + lu(k,646) = lu(k,646) - lu(k,239) * lu(k,628) + lu(k,650) = lu(k,650) - lu(k,240) * lu(k,628) + lu(k,701) = lu(k,701) - lu(k,236) * lu(k,699) + lu(k,707) = lu(k,707) - lu(k,237) * lu(k,699) + lu(k,708) = lu(k,708) - lu(k,238) * lu(k,699) + lu(k,716) = lu(k,716) - lu(k,239) * lu(k,699) + lu(k,720) = lu(k,720) - lu(k,240) * lu(k,699) + lu(k,727) = - lu(k,236) * lu(k,725) + lu(k,732) = - lu(k,237) * lu(k,725) + lu(k,733) = lu(k,733) - lu(k,238) * lu(k,725) + lu(k,741) = lu(k,741) - lu(k,239) * lu(k,725) + lu(k,745) = lu(k,745) - lu(k,240) * lu(k,725) + end do + end subroutine lu_fac05 + subroutine lu_fac06( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,243) = 1._r8 / lu(k,243) + lu(k,244) = lu(k,244) * lu(k,243) + lu(k,245) = lu(k,245) * lu(k,243) + lu(k,246) = lu(k,246) * lu(k,243) + lu(k,247) = lu(k,247) * lu(k,243) + lu(k,248) = lu(k,248) * lu(k,243) + lu(k,249) = lu(k,249) * lu(k,243) + lu(k,250) = lu(k,250) * lu(k,243) + lu(k,251) = lu(k,251) * lu(k,243) + lu(k,252) = lu(k,252) * lu(k,243) + lu(k,307) = lu(k,307) - lu(k,244) * lu(k,306) + lu(k,310) = lu(k,310) - lu(k,245) * lu(k,306) + lu(k,312) = - lu(k,246) * lu(k,306) + lu(k,314) = lu(k,314) - lu(k,247) * lu(k,306) + lu(k,315) = lu(k,315) - lu(k,248) * lu(k,306) + lu(k,316) = lu(k,316) - lu(k,249) * lu(k,306) + lu(k,321) = - lu(k,250) * lu(k,306) + lu(k,322) = lu(k,322) - lu(k,251) * lu(k,306) + lu(k,325) = lu(k,325) - lu(k,252) * lu(k,306) + lu(k,412) = lu(k,412) - lu(k,244) * lu(k,411) + lu(k,416) = lu(k,416) - lu(k,245) * lu(k,411) + lu(k,418) = lu(k,418) - lu(k,246) * lu(k,411) + lu(k,420) = lu(k,420) - lu(k,247) * lu(k,411) + lu(k,421) = lu(k,421) - lu(k,248) * lu(k,411) + lu(k,422) = lu(k,422) - lu(k,249) * lu(k,411) + lu(k,427) = lu(k,427) - lu(k,250) * lu(k,411) + lu(k,428) = lu(k,428) - lu(k,251) * lu(k,411) + lu(k,432) = lu(k,432) - lu(k,252) * lu(k,411) + lu(k,440) = - lu(k,244) * lu(k,439) + lu(k,444) = lu(k,444) - lu(k,245) * lu(k,439) + lu(k,446) = - lu(k,246) * lu(k,439) + lu(k,448) = lu(k,448) - lu(k,247) * lu(k,439) + lu(k,449) = lu(k,449) - lu(k,248) * lu(k,439) + lu(k,450) = lu(k,450) - lu(k,249) * lu(k,439) + lu(k,455) = lu(k,455) - lu(k,250) * lu(k,439) + lu(k,456) = lu(k,456) - lu(k,251) * lu(k,439) + lu(k,460) = lu(k,460) - lu(k,252) * lu(k,439) + lu(k,466) = - lu(k,244) * lu(k,465) + lu(k,469) = lu(k,469) - lu(k,245) * lu(k,465) + lu(k,471) = lu(k,471) - lu(k,246) * lu(k,465) + lu(k,473) = lu(k,473) - lu(k,247) * lu(k,465) + lu(k,474) = lu(k,474) - lu(k,248) * lu(k,465) + lu(k,475) = lu(k,475) - lu(k,249) * lu(k,465) + lu(k,480) = - lu(k,250) * lu(k,465) + lu(k,481) = lu(k,481) - lu(k,251) * lu(k,465) + lu(k,485) = lu(k,485) - lu(k,252) * lu(k,465) + lu(k,593) = lu(k,593) - lu(k,244) * lu(k,592) + lu(k,597) = lu(k,597) - lu(k,245) * lu(k,592) + lu(k,599) = lu(k,599) - lu(k,246) * lu(k,592) + lu(k,601) = lu(k,601) - lu(k,247) * lu(k,592) + lu(k,602) = lu(k,602) - lu(k,248) * lu(k,592) + lu(k,603) = lu(k,603) - lu(k,249) * lu(k,592) + lu(k,608) = lu(k,608) - lu(k,250) * lu(k,592) + lu(k,609) = lu(k,609) - lu(k,251) * lu(k,592) + lu(k,613) = lu(k,613) - lu(k,252) * lu(k,592) + lu(k,630) = lu(k,630) - lu(k,244) * lu(k,629) + lu(k,634) = lu(k,634) - lu(k,245) * lu(k,629) + lu(k,636) = lu(k,636) - lu(k,246) * lu(k,629) + lu(k,638) = lu(k,638) - lu(k,247) * lu(k,629) + lu(k,639) = lu(k,639) - lu(k,248) * lu(k,629) + lu(k,640) = lu(k,640) - lu(k,249) * lu(k,629) + lu(k,645) = lu(k,645) - lu(k,250) * lu(k,629) + lu(k,646) = lu(k,646) - lu(k,251) * lu(k,629) + lu(k,650) = lu(k,650) - lu(k,252) * lu(k,629) + lu(k,255) = 1._r8 / lu(k,255) + lu(k,256) = lu(k,256) * lu(k,255) + lu(k,257) = lu(k,257) * lu(k,255) + lu(k,258) = lu(k,258) * lu(k,255) + lu(k,259) = lu(k,259) * lu(k,255) + lu(k,260) = lu(k,260) * lu(k,255) + lu(k,261) = lu(k,261) * lu(k,255) + lu(k,262) = lu(k,262) * lu(k,255) + lu(k,308) = lu(k,308) - lu(k,256) * lu(k,307) + lu(k,311) = - lu(k,257) * lu(k,307) + lu(k,312) = lu(k,312) - lu(k,258) * lu(k,307) + lu(k,321) = lu(k,321) - lu(k,259) * lu(k,307) + lu(k,322) = lu(k,322) - lu(k,260) * lu(k,307) + lu(k,323) = - lu(k,261) * lu(k,307) + lu(k,325) = lu(k,325) - lu(k,262) * lu(k,307) + lu(k,347) = lu(k,347) - lu(k,256) * lu(k,345) + lu(k,349) = - lu(k,257) * lu(k,345) + lu(k,350) = lu(k,350) - lu(k,258) * lu(k,345) + lu(k,359) = lu(k,359) - lu(k,259) * lu(k,345) + lu(k,360) = lu(k,360) - lu(k,260) * lu(k,345) + lu(k,362) = - lu(k,261) * lu(k,345) + lu(k,364) = lu(k,364) - lu(k,262) * lu(k,345) + lu(k,414) = lu(k,414) - lu(k,256) * lu(k,412) + lu(k,417) = - lu(k,257) * lu(k,412) + lu(k,418) = lu(k,418) - lu(k,258) * lu(k,412) + lu(k,427) = lu(k,427) - lu(k,259) * lu(k,412) + lu(k,428) = lu(k,428) - lu(k,260) * lu(k,412) + lu(k,430) = lu(k,430) - lu(k,261) * lu(k,412) + lu(k,432) = lu(k,432) - lu(k,262) * lu(k,412) + lu(k,442) = - lu(k,256) * lu(k,440) + lu(k,445) = lu(k,445) - lu(k,257) * lu(k,440) + lu(k,446) = lu(k,446) - lu(k,258) * lu(k,440) + lu(k,455) = lu(k,455) - lu(k,259) * lu(k,440) + lu(k,456) = lu(k,456) - lu(k,260) * lu(k,440) + lu(k,458) = - lu(k,261) * lu(k,440) + lu(k,460) = lu(k,460) - lu(k,262) * lu(k,440) + lu(k,467) = lu(k,467) - lu(k,256) * lu(k,466) + lu(k,470) = lu(k,470) - lu(k,257) * lu(k,466) + lu(k,471) = lu(k,471) - lu(k,258) * lu(k,466) + lu(k,480) = lu(k,480) - lu(k,259) * lu(k,466) + lu(k,481) = lu(k,481) - lu(k,260) * lu(k,466) + lu(k,483) = lu(k,483) - lu(k,261) * lu(k,466) + lu(k,485) = lu(k,485) - lu(k,262) * lu(k,466) + lu(k,523) = lu(k,523) - lu(k,256) * lu(k,522) + lu(k,526) = lu(k,526) - lu(k,257) * lu(k,522) + lu(k,527) = lu(k,527) - lu(k,258) * lu(k,522) + lu(k,536) = - lu(k,259) * lu(k,522) + lu(k,537) = lu(k,537) - lu(k,260) * lu(k,522) + lu(k,539) = lu(k,539) - lu(k,261) * lu(k,522) + lu(k,541) = lu(k,541) - lu(k,262) * lu(k,522) + lu(k,545) = lu(k,545) - lu(k,256) * lu(k,544) + lu(k,548) = - lu(k,257) * lu(k,544) + lu(k,549) = lu(k,549) - lu(k,258) * lu(k,544) + lu(k,558) = - lu(k,259) * lu(k,544) + lu(k,559) = lu(k,559) - lu(k,260) * lu(k,544) + lu(k,561) = lu(k,561) - lu(k,261) * lu(k,544) + lu(k,563) = lu(k,563) - lu(k,262) * lu(k,544) + lu(k,595) = lu(k,595) - lu(k,256) * lu(k,593) + lu(k,598) = - lu(k,257) * lu(k,593) + lu(k,599) = lu(k,599) - lu(k,258) * lu(k,593) + lu(k,608) = lu(k,608) - lu(k,259) * lu(k,593) + lu(k,609) = lu(k,609) - lu(k,260) * lu(k,593) + lu(k,611) = - lu(k,261) * lu(k,593) + lu(k,613) = lu(k,613) - lu(k,262) * lu(k,593) + lu(k,632) = lu(k,632) - lu(k,256) * lu(k,630) + lu(k,635) = lu(k,635) - lu(k,257) * lu(k,630) + lu(k,636) = lu(k,636) - lu(k,258) * lu(k,630) + lu(k,645) = lu(k,645) - lu(k,259) * lu(k,630) + lu(k,646) = lu(k,646) - lu(k,260) * lu(k,630) + lu(k,648) = lu(k,648) - lu(k,261) * lu(k,630) + lu(k,650) = lu(k,650) - lu(k,262) * lu(k,630) + lu(k,677) = lu(k,677) - lu(k,256) * lu(k,676) + lu(k,679) = lu(k,679) - lu(k,257) * lu(k,676) + lu(k,680) = lu(k,680) - lu(k,258) * lu(k,676) + lu(k,689) = - lu(k,259) * lu(k,676) + lu(k,690) = lu(k,690) - lu(k,260) * lu(k,676) + lu(k,692) = lu(k,692) - lu(k,261) * lu(k,676) + lu(k,694) = lu(k,694) - lu(k,262) * lu(k,676) + lu(k,702) = - lu(k,256) * lu(k,700) + lu(k,705) = - lu(k,257) * lu(k,700) + lu(k,706) = lu(k,706) - lu(k,258) * lu(k,700) + lu(k,715) = lu(k,715) - lu(k,259) * lu(k,700) + lu(k,716) = lu(k,716) - lu(k,260) * lu(k,700) + lu(k,718) = - lu(k,261) * lu(k,700) + lu(k,720) = lu(k,720) - lu(k,262) * lu(k,700) + lu(k,728) = lu(k,728) - lu(k,256) * lu(k,726) + lu(k,730) = lu(k,730) - lu(k,257) * lu(k,726) + lu(k,731) = lu(k,731) - lu(k,258) * lu(k,726) + lu(k,740) = - lu(k,259) * lu(k,726) + lu(k,741) = lu(k,741) - lu(k,260) * lu(k,726) + lu(k,743) = lu(k,743) - lu(k,261) * lu(k,726) + lu(k,745) = lu(k,745) - lu(k,262) * lu(k,726) + lu(k,266) = 1._r8 / lu(k,266) + lu(k,267) = lu(k,267) * lu(k,266) + lu(k,268) = lu(k,268) * lu(k,266) + lu(k,269) = lu(k,269) * lu(k,266) + lu(k,270) = lu(k,270) * lu(k,266) + lu(k,271) = lu(k,271) * lu(k,266) + lu(k,272) = lu(k,272) * lu(k,266) + lu(k,273) = lu(k,273) * lu(k,266) + lu(k,274) = lu(k,274) * lu(k,266) + lu(k,275) = lu(k,275) * lu(k,266) + lu(k,276) = lu(k,276) * lu(k,266) + lu(k,277) = lu(k,277) * lu(k,266) + lu(k,278) = lu(k,278) * lu(k,266) + lu(k,279) = lu(k,279) * lu(k,266) + lu(k,347) = lu(k,347) - lu(k,267) * lu(k,346) + lu(k,348) = - lu(k,268) * lu(k,346) + lu(k,351) = lu(k,351) - lu(k,269) * lu(k,346) + lu(k,352) = lu(k,352) - lu(k,270) * lu(k,346) + lu(k,353) = - lu(k,271) * lu(k,346) + lu(k,354) = - lu(k,272) * lu(k,346) + lu(k,355) = lu(k,355) - lu(k,273) * lu(k,346) + lu(k,358) = - lu(k,274) * lu(k,346) + lu(k,359) = lu(k,359) - lu(k,275) * lu(k,346) + lu(k,360) = lu(k,360) - lu(k,276) * lu(k,346) + lu(k,361) = lu(k,361) - lu(k,277) * lu(k,346) + lu(k,363) = - lu(k,278) * lu(k,346) + lu(k,364) = lu(k,364) - lu(k,279) * lu(k,346) + lu(k,414) = lu(k,414) - lu(k,267) * lu(k,413) + lu(k,415) = lu(k,415) - lu(k,268) * lu(k,413) + lu(k,419) = lu(k,419) - lu(k,269) * lu(k,413) + lu(k,420) = lu(k,420) - lu(k,270) * lu(k,413) + lu(k,421) = lu(k,421) - lu(k,271) * lu(k,413) + lu(k,422) = lu(k,422) - lu(k,272) * lu(k,413) + lu(k,423) = lu(k,423) - lu(k,273) * lu(k,413) + lu(k,426) = lu(k,426) - lu(k,274) * lu(k,413) + lu(k,427) = lu(k,427) - lu(k,275) * lu(k,413) + lu(k,428) = lu(k,428) - lu(k,276) * lu(k,413) + lu(k,429) = lu(k,429) - lu(k,277) * lu(k,413) + lu(k,431) = lu(k,431) - lu(k,278) * lu(k,413) + lu(k,432) = lu(k,432) - lu(k,279) * lu(k,413) + lu(k,442) = lu(k,442) - lu(k,267) * lu(k,441) + lu(k,443) = lu(k,443) - lu(k,268) * lu(k,441) + lu(k,447) = lu(k,447) - lu(k,269) * lu(k,441) + lu(k,448) = lu(k,448) - lu(k,270) * lu(k,441) + lu(k,449) = lu(k,449) - lu(k,271) * lu(k,441) + lu(k,450) = lu(k,450) - lu(k,272) * lu(k,441) + lu(k,451) = lu(k,451) - lu(k,273) * lu(k,441) + lu(k,454) = - lu(k,274) * lu(k,441) + lu(k,455) = lu(k,455) - lu(k,275) * lu(k,441) + lu(k,456) = lu(k,456) - lu(k,276) * lu(k,441) + lu(k,457) = lu(k,457) - lu(k,277) * lu(k,441) + lu(k,459) = lu(k,459) - lu(k,278) * lu(k,441) + lu(k,460) = lu(k,460) - lu(k,279) * lu(k,441) + lu(k,501) = lu(k,501) - lu(k,267) * lu(k,500) + lu(k,502) = - lu(k,268) * lu(k,500) + lu(k,503) = lu(k,503) - lu(k,269) * lu(k,500) + lu(k,504) = lu(k,504) - lu(k,270) * lu(k,500) + lu(k,505) = - lu(k,271) * lu(k,500) + lu(k,506) = - lu(k,272) * lu(k,500) + lu(k,507) = lu(k,507) - lu(k,273) * lu(k,500) + lu(k,510) = lu(k,510) - lu(k,274) * lu(k,500) + lu(k,511) = lu(k,511) - lu(k,275) * lu(k,500) + lu(k,512) = lu(k,512) - lu(k,276) * lu(k,500) + lu(k,513) = lu(k,513) - lu(k,277) * lu(k,500) + lu(k,515) = - lu(k,278) * lu(k,500) + lu(k,516) = lu(k,516) - lu(k,279) * lu(k,500) + lu(k,569) = lu(k,569) - lu(k,267) * lu(k,568) + lu(k,570) = lu(k,570) - lu(k,268) * lu(k,568) + lu(k,572) = lu(k,572) - lu(k,269) * lu(k,568) + lu(k,573) = lu(k,573) - lu(k,270) * lu(k,568) + lu(k,574) = lu(k,574) - lu(k,271) * lu(k,568) + lu(k,575) = lu(k,575) - lu(k,272) * lu(k,568) + lu(k,576) = lu(k,576) - lu(k,273) * lu(k,568) + lu(k,579) = lu(k,579) - lu(k,274) * lu(k,568) + lu(k,580) = lu(k,580) - lu(k,275) * lu(k,568) + lu(k,581) = lu(k,581) - lu(k,276) * lu(k,568) + lu(k,582) = lu(k,582) - lu(k,277) * lu(k,568) + lu(k,584) = lu(k,584) - lu(k,278) * lu(k,568) + lu(k,585) = lu(k,585) - lu(k,279) * lu(k,568) + lu(k,595) = lu(k,595) - lu(k,267) * lu(k,594) + lu(k,596) = lu(k,596) - lu(k,268) * lu(k,594) + lu(k,600) = lu(k,600) - lu(k,269) * lu(k,594) + lu(k,601) = lu(k,601) - lu(k,270) * lu(k,594) + lu(k,602) = lu(k,602) - lu(k,271) * lu(k,594) + lu(k,603) = lu(k,603) - lu(k,272) * lu(k,594) + lu(k,604) = lu(k,604) - lu(k,273) * lu(k,594) + lu(k,607) = lu(k,607) - lu(k,274) * lu(k,594) + lu(k,608) = lu(k,608) - lu(k,275) * lu(k,594) + lu(k,609) = lu(k,609) - lu(k,276) * lu(k,594) + lu(k,610) = lu(k,610) - lu(k,277) * lu(k,594) + lu(k,612) = lu(k,612) - lu(k,278) * lu(k,594) + lu(k,613) = lu(k,613) - lu(k,279) * lu(k,594) + lu(k,632) = lu(k,632) - lu(k,267) * lu(k,631) + lu(k,633) = lu(k,633) - lu(k,268) * lu(k,631) + lu(k,637) = lu(k,637) - lu(k,269) * lu(k,631) + lu(k,638) = lu(k,638) - lu(k,270) * lu(k,631) + lu(k,639) = lu(k,639) - lu(k,271) * lu(k,631) + lu(k,640) = lu(k,640) - lu(k,272) * lu(k,631) + lu(k,641) = lu(k,641) - lu(k,273) * lu(k,631) + lu(k,644) = lu(k,644) - lu(k,274) * lu(k,631) + lu(k,645) = lu(k,645) - lu(k,275) * lu(k,631) + lu(k,646) = lu(k,646) - lu(k,276) * lu(k,631) + lu(k,647) = lu(k,647) - lu(k,277) * lu(k,631) + lu(k,649) = lu(k,649) - lu(k,278) * lu(k,631) + lu(k,650) = lu(k,650) - lu(k,279) * lu(k,631) + lu(k,702) = lu(k,702) - lu(k,267) * lu(k,701) + lu(k,703) = lu(k,703) - lu(k,268) * lu(k,701) + lu(k,707) = lu(k,707) - lu(k,269) * lu(k,701) + lu(k,708) = lu(k,708) - lu(k,270) * lu(k,701) + lu(k,709) = lu(k,709) - lu(k,271) * lu(k,701) + lu(k,710) = lu(k,710) - lu(k,272) * lu(k,701) + lu(k,711) = lu(k,711) - lu(k,273) * lu(k,701) + lu(k,714) = - lu(k,274) * lu(k,701) + lu(k,715) = lu(k,715) - lu(k,275) * lu(k,701) + lu(k,716) = lu(k,716) - lu(k,276) * lu(k,701) + lu(k,717) = lu(k,717) - lu(k,277) * lu(k,701) + lu(k,719) = lu(k,719) - lu(k,278) * lu(k,701) + lu(k,720) = lu(k,720) - lu(k,279) * lu(k,701) + lu(k,728) = lu(k,728) - lu(k,267) * lu(k,727) + lu(k,729) = - lu(k,268) * lu(k,727) + lu(k,732) = lu(k,732) - lu(k,269) * lu(k,727) + lu(k,733) = lu(k,733) - lu(k,270) * lu(k,727) + lu(k,734) = - lu(k,271) * lu(k,727) + lu(k,735) = - lu(k,272) * lu(k,727) + lu(k,736) = - lu(k,273) * lu(k,727) + lu(k,739) = - lu(k,274) * lu(k,727) + lu(k,740) = lu(k,740) - lu(k,275) * lu(k,727) + lu(k,741) = lu(k,741) - lu(k,276) * lu(k,727) + lu(k,742) = - lu(k,277) * lu(k,727) + lu(k,744) = - lu(k,278) * lu(k,727) + lu(k,745) = lu(k,745) - lu(k,279) * lu(k,727) + end do + end subroutine lu_fac06 + subroutine lu_fac07( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,280) = 1._r8 / lu(k,280) + lu(k,281) = lu(k,281) * lu(k,280) + lu(k,282) = lu(k,282) * lu(k,280) + lu(k,283) = lu(k,283) * lu(k,280) + lu(k,284) = lu(k,284) * lu(k,280) + lu(k,285) = lu(k,285) * lu(k,280) + lu(k,286) = lu(k,286) * lu(k,280) + lu(k,287) = lu(k,287) * lu(k,280) + lu(k,292) = lu(k,292) - lu(k,281) * lu(k,290) + lu(k,293) = lu(k,293) - lu(k,282) * lu(k,290) + lu(k,294) = lu(k,294) - lu(k,283) * lu(k,290) + lu(k,297) = lu(k,297) - lu(k,284) * lu(k,290) + lu(k,298) = lu(k,298) - lu(k,285) * lu(k,290) + lu(k,299) = - lu(k,286) * lu(k,290) + lu(k,301) = lu(k,301) - lu(k,287) * lu(k,290) + lu(k,313) = - lu(k,281) * lu(k,308) + lu(k,314) = lu(k,314) - lu(k,282) * lu(k,308) + lu(k,317) = - lu(k,283) * lu(k,308) + lu(k,320) = - lu(k,284) * lu(k,308) + lu(k,322) = lu(k,322) - lu(k,285) * lu(k,308) + lu(k,323) = lu(k,323) - lu(k,286) * lu(k,308) + lu(k,325) = lu(k,325) - lu(k,287) * lu(k,308) + lu(k,329) = lu(k,329) - lu(k,281) * lu(k,327) + lu(k,330) = - lu(k,282) * lu(k,327) + lu(k,333) = lu(k,333) - lu(k,283) * lu(k,327) + lu(k,335) = - lu(k,284) * lu(k,327) + lu(k,337) = lu(k,337) - lu(k,285) * lu(k,327) + lu(k,339) = - lu(k,286) * lu(k,327) + lu(k,340) = lu(k,340) - lu(k,287) * lu(k,327) + lu(k,351) = lu(k,351) - lu(k,281) * lu(k,347) + lu(k,352) = lu(k,352) - lu(k,282) * lu(k,347) + lu(k,355) = lu(k,355) - lu(k,283) * lu(k,347) + lu(k,358) = lu(k,358) - lu(k,284) * lu(k,347) + lu(k,360) = lu(k,360) - lu(k,285) * lu(k,347) + lu(k,362) = lu(k,362) - lu(k,286) * lu(k,347) + lu(k,364) = lu(k,364) - lu(k,287) * lu(k,347) + lu(k,376) = lu(k,376) - lu(k,281) * lu(k,371) + lu(k,377) = lu(k,377) - lu(k,282) * lu(k,371) + lu(k,380) = lu(k,380) - lu(k,283) * lu(k,371) + lu(k,383) = lu(k,383) - lu(k,284) * lu(k,371) + lu(k,385) = lu(k,385) - lu(k,285) * lu(k,371) + lu(k,387) = lu(k,387) - lu(k,286) * lu(k,371) + lu(k,389) = lu(k,389) - lu(k,287) * lu(k,371) + lu(k,419) = lu(k,419) - lu(k,281) * lu(k,414) + lu(k,420) = lu(k,420) - lu(k,282) * lu(k,414) + lu(k,423) = lu(k,423) - lu(k,283) * lu(k,414) + lu(k,426) = lu(k,426) - lu(k,284) * lu(k,414) + lu(k,428) = lu(k,428) - lu(k,285) * lu(k,414) + lu(k,430) = lu(k,430) - lu(k,286) * lu(k,414) + lu(k,432) = lu(k,432) - lu(k,287) * lu(k,414) + lu(k,447) = lu(k,447) - lu(k,281) * lu(k,442) + lu(k,448) = lu(k,448) - lu(k,282) * lu(k,442) + lu(k,451) = lu(k,451) - lu(k,283) * lu(k,442) + lu(k,454) = lu(k,454) - lu(k,284) * lu(k,442) + lu(k,456) = lu(k,456) - lu(k,285) * lu(k,442) + lu(k,458) = lu(k,458) - lu(k,286) * lu(k,442) + lu(k,460) = lu(k,460) - lu(k,287) * lu(k,442) + lu(k,472) = lu(k,472) - lu(k,281) * lu(k,467) + lu(k,473) = lu(k,473) - lu(k,282) * lu(k,467) + lu(k,476) = lu(k,476) - lu(k,283) * lu(k,467) + lu(k,479) = lu(k,479) - lu(k,284) * lu(k,467) + lu(k,481) = lu(k,481) - lu(k,285) * lu(k,467) + lu(k,483) = lu(k,483) - lu(k,286) * lu(k,467) + lu(k,485) = lu(k,485) - lu(k,287) * lu(k,467) + lu(k,503) = lu(k,503) - lu(k,281) * lu(k,501) + lu(k,504) = lu(k,504) - lu(k,282) * lu(k,501) + lu(k,507) = lu(k,507) - lu(k,283) * lu(k,501) + lu(k,510) = lu(k,510) - lu(k,284) * lu(k,501) + lu(k,512) = lu(k,512) - lu(k,285) * lu(k,501) + lu(k,514) = - lu(k,286) * lu(k,501) + lu(k,516) = lu(k,516) - lu(k,287) * lu(k,501) + lu(k,528) = lu(k,528) - lu(k,281) * lu(k,523) + lu(k,529) = lu(k,529) - lu(k,282) * lu(k,523) + lu(k,532) = lu(k,532) - lu(k,283) * lu(k,523) + lu(k,535) = lu(k,535) - lu(k,284) * lu(k,523) + lu(k,537) = lu(k,537) - lu(k,285) * lu(k,523) + lu(k,539) = lu(k,539) - lu(k,286) * lu(k,523) + lu(k,541) = lu(k,541) - lu(k,287) * lu(k,523) + lu(k,550) = lu(k,550) - lu(k,281) * lu(k,545) + lu(k,551) = lu(k,551) - lu(k,282) * lu(k,545) + lu(k,554) = - lu(k,283) * lu(k,545) + lu(k,557) = - lu(k,284) * lu(k,545) + lu(k,559) = lu(k,559) - lu(k,285) * lu(k,545) + lu(k,561) = lu(k,561) - lu(k,286) * lu(k,545) + lu(k,563) = lu(k,563) - lu(k,287) * lu(k,545) + lu(k,572) = lu(k,572) - lu(k,281) * lu(k,569) + lu(k,573) = lu(k,573) - lu(k,282) * lu(k,569) + lu(k,576) = lu(k,576) - lu(k,283) * lu(k,569) + lu(k,579) = lu(k,579) - lu(k,284) * lu(k,569) + lu(k,581) = lu(k,581) - lu(k,285) * lu(k,569) + lu(k,583) = - lu(k,286) * lu(k,569) + lu(k,585) = lu(k,585) - lu(k,287) * lu(k,569) + lu(k,600) = lu(k,600) - lu(k,281) * lu(k,595) + lu(k,601) = lu(k,601) - lu(k,282) * lu(k,595) + lu(k,604) = lu(k,604) - lu(k,283) * lu(k,595) + lu(k,607) = lu(k,607) - lu(k,284) * lu(k,595) + lu(k,609) = lu(k,609) - lu(k,285) * lu(k,595) + lu(k,611) = lu(k,611) - lu(k,286) * lu(k,595) + lu(k,613) = lu(k,613) - lu(k,287) * lu(k,595) + lu(k,637) = lu(k,637) - lu(k,281) * lu(k,632) + lu(k,638) = lu(k,638) - lu(k,282) * lu(k,632) + lu(k,641) = lu(k,641) - lu(k,283) * lu(k,632) + lu(k,644) = lu(k,644) - lu(k,284) * lu(k,632) + lu(k,646) = lu(k,646) - lu(k,285) * lu(k,632) + lu(k,648) = lu(k,648) - lu(k,286) * lu(k,632) + lu(k,650) = lu(k,650) - lu(k,287) * lu(k,632) + lu(k,660) = lu(k,660) - lu(k,281) * lu(k,656) + lu(k,661) = lu(k,661) - lu(k,282) * lu(k,656) + lu(k,664) = lu(k,664) - lu(k,283) * lu(k,656) + lu(k,667) = lu(k,667) - lu(k,284) * lu(k,656) + lu(k,669) = lu(k,669) - lu(k,285) * lu(k,656) + lu(k,671) = - lu(k,286) * lu(k,656) + lu(k,673) = - lu(k,287) * lu(k,656) + lu(k,681) = - lu(k,281) * lu(k,677) + lu(k,682) = lu(k,682) - lu(k,282) * lu(k,677) + lu(k,685) = - lu(k,283) * lu(k,677) + lu(k,688) = - lu(k,284) * lu(k,677) + lu(k,690) = lu(k,690) - lu(k,285) * lu(k,677) + lu(k,692) = lu(k,692) - lu(k,286) * lu(k,677) + lu(k,694) = lu(k,694) - lu(k,287) * lu(k,677) + lu(k,707) = lu(k,707) - lu(k,281) * lu(k,702) + lu(k,708) = lu(k,708) - lu(k,282) * lu(k,702) + lu(k,711) = lu(k,711) - lu(k,283) * lu(k,702) + lu(k,714) = lu(k,714) - lu(k,284) * lu(k,702) + lu(k,716) = lu(k,716) - lu(k,285) * lu(k,702) + lu(k,718) = lu(k,718) - lu(k,286) * lu(k,702) + lu(k,720) = lu(k,720) - lu(k,287) * lu(k,702) + lu(k,732) = lu(k,732) - lu(k,281) * lu(k,728) + lu(k,733) = lu(k,733) - lu(k,282) * lu(k,728) + lu(k,736) = lu(k,736) - lu(k,283) * lu(k,728) + lu(k,739) = lu(k,739) - lu(k,284) * lu(k,728) + lu(k,741) = lu(k,741) - lu(k,285) * lu(k,728) + lu(k,743) = lu(k,743) - lu(k,286) * lu(k,728) + lu(k,745) = lu(k,745) - lu(k,287) * lu(k,728) + lu(k,291) = 1._r8 / lu(k,291) + lu(k,292) = lu(k,292) * lu(k,291) + lu(k,293) = lu(k,293) * lu(k,291) + lu(k,294) = lu(k,294) * lu(k,291) + lu(k,295) = lu(k,295) * lu(k,291) + lu(k,296) = lu(k,296) * lu(k,291) + lu(k,297) = lu(k,297) * lu(k,291) + lu(k,298) = lu(k,298) * lu(k,291) + lu(k,299) = lu(k,299) * lu(k,291) + lu(k,300) = lu(k,300) * lu(k,291) + lu(k,301) = lu(k,301) * lu(k,291) + lu(k,313) = lu(k,313) - lu(k,292) * lu(k,309) + lu(k,314) = lu(k,314) - lu(k,293) * lu(k,309) + lu(k,317) = lu(k,317) - lu(k,294) * lu(k,309) + lu(k,318) = lu(k,318) - lu(k,295) * lu(k,309) + lu(k,319) = - lu(k,296) * lu(k,309) + lu(k,320) = lu(k,320) - lu(k,297) * lu(k,309) + lu(k,322) = lu(k,322) - lu(k,298) * lu(k,309) + lu(k,323) = lu(k,323) - lu(k,299) * lu(k,309) + lu(k,324) = lu(k,324) - lu(k,300) * lu(k,309) + lu(k,325) = lu(k,325) - lu(k,301) * lu(k,309) + lu(k,351) = lu(k,351) - lu(k,292) * lu(k,348) + lu(k,352) = lu(k,352) - lu(k,293) * lu(k,348) + lu(k,355) = lu(k,355) - lu(k,294) * lu(k,348) + lu(k,356) = - lu(k,295) * lu(k,348) + lu(k,357) = lu(k,357) - lu(k,296) * lu(k,348) + lu(k,358) = lu(k,358) - lu(k,297) * lu(k,348) + lu(k,360) = lu(k,360) - lu(k,298) * lu(k,348) + lu(k,362) = lu(k,362) - lu(k,299) * lu(k,348) + lu(k,363) = lu(k,363) - lu(k,300) * lu(k,348) + lu(k,364) = lu(k,364) - lu(k,301) * lu(k,348) + lu(k,376) = lu(k,376) - lu(k,292) * lu(k,372) + lu(k,377) = lu(k,377) - lu(k,293) * lu(k,372) + lu(k,380) = lu(k,380) - lu(k,294) * lu(k,372) + lu(k,381) = lu(k,381) - lu(k,295) * lu(k,372) + lu(k,382) = lu(k,382) - lu(k,296) * lu(k,372) + lu(k,383) = lu(k,383) - lu(k,297) * lu(k,372) + lu(k,385) = lu(k,385) - lu(k,298) * lu(k,372) + lu(k,387) = lu(k,387) - lu(k,299) * lu(k,372) + lu(k,388) = lu(k,388) - lu(k,300) * lu(k,372) + lu(k,389) = lu(k,389) - lu(k,301) * lu(k,372) + lu(k,419) = lu(k,419) - lu(k,292) * lu(k,415) + lu(k,420) = lu(k,420) - lu(k,293) * lu(k,415) + lu(k,423) = lu(k,423) - lu(k,294) * lu(k,415) + lu(k,424) = lu(k,424) - lu(k,295) * lu(k,415) + lu(k,425) = lu(k,425) - lu(k,296) * lu(k,415) + lu(k,426) = lu(k,426) - lu(k,297) * lu(k,415) + lu(k,428) = lu(k,428) - lu(k,298) * lu(k,415) + lu(k,430) = lu(k,430) - lu(k,299) * lu(k,415) + lu(k,431) = lu(k,431) - lu(k,300) * lu(k,415) + lu(k,432) = lu(k,432) - lu(k,301) * lu(k,415) + lu(k,447) = lu(k,447) - lu(k,292) * lu(k,443) + lu(k,448) = lu(k,448) - lu(k,293) * lu(k,443) + lu(k,451) = lu(k,451) - lu(k,294) * lu(k,443) + lu(k,452) = - lu(k,295) * lu(k,443) + lu(k,453) = lu(k,453) - lu(k,296) * lu(k,443) + lu(k,454) = lu(k,454) - lu(k,297) * lu(k,443) + lu(k,456) = lu(k,456) - lu(k,298) * lu(k,443) + lu(k,458) = lu(k,458) - lu(k,299) * lu(k,443) + lu(k,459) = lu(k,459) - lu(k,300) * lu(k,443) + lu(k,460) = lu(k,460) - lu(k,301) * lu(k,443) + lu(k,472) = lu(k,472) - lu(k,292) * lu(k,468) + lu(k,473) = lu(k,473) - lu(k,293) * lu(k,468) + lu(k,476) = lu(k,476) - lu(k,294) * lu(k,468) + lu(k,477) = - lu(k,295) * lu(k,468) + lu(k,478) = lu(k,478) - lu(k,296) * lu(k,468) + lu(k,479) = lu(k,479) - lu(k,297) * lu(k,468) + lu(k,481) = lu(k,481) - lu(k,298) * lu(k,468) + lu(k,483) = lu(k,483) - lu(k,299) * lu(k,468) + lu(k,484) = - lu(k,300) * lu(k,468) + lu(k,485) = lu(k,485) - lu(k,301) * lu(k,468) + lu(k,503) = lu(k,503) - lu(k,292) * lu(k,502) + lu(k,504) = lu(k,504) - lu(k,293) * lu(k,502) + lu(k,507) = lu(k,507) - lu(k,294) * lu(k,502) + lu(k,508) = lu(k,508) - lu(k,295) * lu(k,502) + lu(k,509) = - lu(k,296) * lu(k,502) + lu(k,510) = lu(k,510) - lu(k,297) * lu(k,502) + lu(k,512) = lu(k,512) - lu(k,298) * lu(k,502) + lu(k,514) = lu(k,514) - lu(k,299) * lu(k,502) + lu(k,515) = lu(k,515) - lu(k,300) * lu(k,502) + lu(k,516) = lu(k,516) - lu(k,301) * lu(k,502) + lu(k,528) = lu(k,528) - lu(k,292) * lu(k,524) + lu(k,529) = lu(k,529) - lu(k,293) * lu(k,524) + lu(k,532) = lu(k,532) - lu(k,294) * lu(k,524) + lu(k,533) = lu(k,533) - lu(k,295) * lu(k,524) + lu(k,534) = lu(k,534) - lu(k,296) * lu(k,524) + lu(k,535) = lu(k,535) - lu(k,297) * lu(k,524) + lu(k,537) = lu(k,537) - lu(k,298) * lu(k,524) + lu(k,539) = lu(k,539) - lu(k,299) * lu(k,524) + lu(k,540) = lu(k,540) - lu(k,300) * lu(k,524) + lu(k,541) = lu(k,541) - lu(k,301) * lu(k,524) + lu(k,550) = lu(k,550) - lu(k,292) * lu(k,546) + lu(k,551) = lu(k,551) - lu(k,293) * lu(k,546) + lu(k,554) = lu(k,554) - lu(k,294) * lu(k,546) + lu(k,555) = lu(k,555) - lu(k,295) * lu(k,546) + lu(k,556) = lu(k,556) - lu(k,296) * lu(k,546) + lu(k,557) = lu(k,557) - lu(k,297) * lu(k,546) + lu(k,559) = lu(k,559) - lu(k,298) * lu(k,546) + lu(k,561) = lu(k,561) - lu(k,299) * lu(k,546) + lu(k,562) = lu(k,562) - lu(k,300) * lu(k,546) + lu(k,563) = lu(k,563) - lu(k,301) * lu(k,546) + lu(k,572) = lu(k,572) - lu(k,292) * lu(k,570) + lu(k,573) = lu(k,573) - lu(k,293) * lu(k,570) + lu(k,576) = lu(k,576) - lu(k,294) * lu(k,570) + lu(k,577) = lu(k,577) - lu(k,295) * lu(k,570) + lu(k,578) = - lu(k,296) * lu(k,570) + lu(k,579) = lu(k,579) - lu(k,297) * lu(k,570) + lu(k,581) = lu(k,581) - lu(k,298) * lu(k,570) + lu(k,583) = lu(k,583) - lu(k,299) * lu(k,570) + lu(k,584) = lu(k,584) - lu(k,300) * lu(k,570) + lu(k,585) = lu(k,585) - lu(k,301) * lu(k,570) + lu(k,600) = lu(k,600) - lu(k,292) * lu(k,596) + lu(k,601) = lu(k,601) - lu(k,293) * lu(k,596) + lu(k,604) = lu(k,604) - lu(k,294) * lu(k,596) + lu(k,605) = lu(k,605) - lu(k,295) * lu(k,596) + lu(k,606) = - lu(k,296) * lu(k,596) + lu(k,607) = lu(k,607) - lu(k,297) * lu(k,596) + lu(k,609) = lu(k,609) - lu(k,298) * lu(k,596) + lu(k,611) = lu(k,611) - lu(k,299) * lu(k,596) + lu(k,612) = lu(k,612) - lu(k,300) * lu(k,596) + lu(k,613) = lu(k,613) - lu(k,301) * lu(k,596) + lu(k,637) = lu(k,637) - lu(k,292) * lu(k,633) + lu(k,638) = lu(k,638) - lu(k,293) * lu(k,633) + lu(k,641) = lu(k,641) - lu(k,294) * lu(k,633) + lu(k,642) = lu(k,642) - lu(k,295) * lu(k,633) + lu(k,643) = lu(k,643) - lu(k,296) * lu(k,633) + lu(k,644) = lu(k,644) - lu(k,297) * lu(k,633) + lu(k,646) = lu(k,646) - lu(k,298) * lu(k,633) + lu(k,648) = lu(k,648) - lu(k,299) * lu(k,633) + lu(k,649) = lu(k,649) - lu(k,300) * lu(k,633) + lu(k,650) = lu(k,650) - lu(k,301) * lu(k,633) + lu(k,660) = lu(k,660) - lu(k,292) * lu(k,657) + lu(k,661) = lu(k,661) - lu(k,293) * lu(k,657) + lu(k,664) = lu(k,664) - lu(k,294) * lu(k,657) + lu(k,665) = lu(k,665) - lu(k,295) * lu(k,657) + lu(k,666) = lu(k,666) - lu(k,296) * lu(k,657) + lu(k,667) = lu(k,667) - lu(k,297) * lu(k,657) + lu(k,669) = lu(k,669) - lu(k,298) * lu(k,657) + lu(k,671) = lu(k,671) - lu(k,299) * lu(k,657) + lu(k,672) = lu(k,672) - lu(k,300) * lu(k,657) + lu(k,673) = lu(k,673) - lu(k,301) * lu(k,657) + lu(k,707) = lu(k,707) - lu(k,292) * lu(k,703) + lu(k,708) = lu(k,708) - lu(k,293) * lu(k,703) + lu(k,711) = lu(k,711) - lu(k,294) * lu(k,703) + lu(k,712) = - lu(k,295) * lu(k,703) + lu(k,713) = - lu(k,296) * lu(k,703) + lu(k,714) = lu(k,714) - lu(k,297) * lu(k,703) + lu(k,716) = lu(k,716) - lu(k,298) * lu(k,703) + lu(k,718) = lu(k,718) - lu(k,299) * lu(k,703) + lu(k,719) = lu(k,719) - lu(k,300) * lu(k,703) + lu(k,720) = lu(k,720) - lu(k,301) * lu(k,703) + lu(k,732) = lu(k,732) - lu(k,292) * lu(k,729) + lu(k,733) = lu(k,733) - lu(k,293) * lu(k,729) + lu(k,736) = lu(k,736) - lu(k,294) * lu(k,729) + lu(k,737) = lu(k,737) - lu(k,295) * lu(k,729) + lu(k,738) = - lu(k,296) * lu(k,729) + lu(k,739) = lu(k,739) - lu(k,297) * lu(k,729) + lu(k,741) = lu(k,741) - lu(k,298) * lu(k,729) + lu(k,743) = lu(k,743) - lu(k,299) * lu(k,729) + lu(k,744) = lu(k,744) - lu(k,300) * lu(k,729) + lu(k,745) = lu(k,745) - lu(k,301) * lu(k,729) + lu(k,310) = 1._r8 / lu(k,310) + lu(k,311) = lu(k,311) * lu(k,310) + lu(k,312) = lu(k,312) * lu(k,310) + lu(k,313) = lu(k,313) * lu(k,310) + lu(k,314) = lu(k,314) * lu(k,310) + lu(k,315) = lu(k,315) * lu(k,310) + lu(k,316) = lu(k,316) * lu(k,310) + lu(k,317) = lu(k,317) * lu(k,310) + lu(k,318) = lu(k,318) * lu(k,310) + lu(k,319) = lu(k,319) * lu(k,310) + lu(k,320) = lu(k,320) * lu(k,310) + lu(k,321) = lu(k,321) * lu(k,310) + lu(k,322) = lu(k,322) * lu(k,310) + lu(k,323) = lu(k,323) * lu(k,310) + lu(k,324) = lu(k,324) * lu(k,310) + lu(k,325) = lu(k,325) * lu(k,310) + lu(k,374) = lu(k,374) - lu(k,311) * lu(k,373) + lu(k,375) = lu(k,375) - lu(k,312) * lu(k,373) + lu(k,376) = lu(k,376) - lu(k,313) * lu(k,373) + lu(k,377) = lu(k,377) - lu(k,314) * lu(k,373) + lu(k,378) = lu(k,378) - lu(k,315) * lu(k,373) + lu(k,379) = lu(k,379) - lu(k,316) * lu(k,373) + lu(k,380) = lu(k,380) - lu(k,317) * lu(k,373) + lu(k,381) = lu(k,381) - lu(k,318) * lu(k,373) + lu(k,382) = lu(k,382) - lu(k,319) * lu(k,373) + lu(k,383) = lu(k,383) - lu(k,320) * lu(k,373) + lu(k,384) = lu(k,384) - lu(k,321) * lu(k,373) + lu(k,385) = lu(k,385) - lu(k,322) * lu(k,373) + lu(k,387) = lu(k,387) - lu(k,323) * lu(k,373) + lu(k,388) = lu(k,388) - lu(k,324) * lu(k,373) + lu(k,389) = lu(k,389) - lu(k,325) * lu(k,373) + lu(k,417) = lu(k,417) - lu(k,311) * lu(k,416) + lu(k,418) = lu(k,418) - lu(k,312) * lu(k,416) + lu(k,419) = lu(k,419) - lu(k,313) * lu(k,416) + lu(k,420) = lu(k,420) - lu(k,314) * lu(k,416) + lu(k,421) = lu(k,421) - lu(k,315) * lu(k,416) + lu(k,422) = lu(k,422) - lu(k,316) * lu(k,416) + lu(k,423) = lu(k,423) - lu(k,317) * lu(k,416) + lu(k,424) = lu(k,424) - lu(k,318) * lu(k,416) + lu(k,425) = lu(k,425) - lu(k,319) * lu(k,416) + lu(k,426) = lu(k,426) - lu(k,320) * lu(k,416) + lu(k,427) = lu(k,427) - lu(k,321) * lu(k,416) + lu(k,428) = lu(k,428) - lu(k,322) * lu(k,416) + lu(k,430) = lu(k,430) - lu(k,323) * lu(k,416) + lu(k,431) = lu(k,431) - lu(k,324) * lu(k,416) + lu(k,432) = lu(k,432) - lu(k,325) * lu(k,416) + lu(k,445) = lu(k,445) - lu(k,311) * lu(k,444) + lu(k,446) = lu(k,446) - lu(k,312) * lu(k,444) + lu(k,447) = lu(k,447) - lu(k,313) * lu(k,444) + lu(k,448) = lu(k,448) - lu(k,314) * lu(k,444) + lu(k,449) = lu(k,449) - lu(k,315) * lu(k,444) + lu(k,450) = lu(k,450) - lu(k,316) * lu(k,444) + lu(k,451) = lu(k,451) - lu(k,317) * lu(k,444) + lu(k,452) = lu(k,452) - lu(k,318) * lu(k,444) + lu(k,453) = lu(k,453) - lu(k,319) * lu(k,444) + lu(k,454) = lu(k,454) - lu(k,320) * lu(k,444) + lu(k,455) = lu(k,455) - lu(k,321) * lu(k,444) + lu(k,456) = lu(k,456) - lu(k,322) * lu(k,444) + lu(k,458) = lu(k,458) - lu(k,323) * lu(k,444) + lu(k,459) = lu(k,459) - lu(k,324) * lu(k,444) + lu(k,460) = lu(k,460) - lu(k,325) * lu(k,444) + lu(k,470) = lu(k,470) - lu(k,311) * lu(k,469) + lu(k,471) = lu(k,471) - lu(k,312) * lu(k,469) + lu(k,472) = lu(k,472) - lu(k,313) * lu(k,469) + lu(k,473) = lu(k,473) - lu(k,314) * lu(k,469) + lu(k,474) = lu(k,474) - lu(k,315) * lu(k,469) + lu(k,475) = lu(k,475) - lu(k,316) * lu(k,469) + lu(k,476) = lu(k,476) - lu(k,317) * lu(k,469) + lu(k,477) = lu(k,477) - lu(k,318) * lu(k,469) + lu(k,478) = lu(k,478) - lu(k,319) * lu(k,469) + lu(k,479) = lu(k,479) - lu(k,320) * lu(k,469) + lu(k,480) = lu(k,480) - lu(k,321) * lu(k,469) + lu(k,481) = lu(k,481) - lu(k,322) * lu(k,469) + lu(k,483) = lu(k,483) - lu(k,323) * lu(k,469) + lu(k,484) = lu(k,484) - lu(k,324) * lu(k,469) + lu(k,485) = lu(k,485) - lu(k,325) * lu(k,469) + lu(k,526) = lu(k,526) - lu(k,311) * lu(k,525) + lu(k,527) = lu(k,527) - lu(k,312) * lu(k,525) + lu(k,528) = lu(k,528) - lu(k,313) * lu(k,525) + lu(k,529) = lu(k,529) - lu(k,314) * lu(k,525) + lu(k,530) = lu(k,530) - lu(k,315) * lu(k,525) + lu(k,531) = lu(k,531) - lu(k,316) * lu(k,525) + lu(k,532) = lu(k,532) - lu(k,317) * lu(k,525) + lu(k,533) = lu(k,533) - lu(k,318) * lu(k,525) + lu(k,534) = lu(k,534) - lu(k,319) * lu(k,525) + lu(k,535) = lu(k,535) - lu(k,320) * lu(k,525) + lu(k,536) = lu(k,536) - lu(k,321) * lu(k,525) + lu(k,537) = lu(k,537) - lu(k,322) * lu(k,525) + lu(k,539) = lu(k,539) - lu(k,323) * lu(k,525) + lu(k,540) = lu(k,540) - lu(k,324) * lu(k,525) + lu(k,541) = lu(k,541) - lu(k,325) * lu(k,525) + lu(k,548) = lu(k,548) - lu(k,311) * lu(k,547) + lu(k,549) = lu(k,549) - lu(k,312) * lu(k,547) + lu(k,550) = lu(k,550) - lu(k,313) * lu(k,547) + lu(k,551) = lu(k,551) - lu(k,314) * lu(k,547) + lu(k,552) = - lu(k,315) * lu(k,547) + lu(k,553) = lu(k,553) - lu(k,316) * lu(k,547) + lu(k,554) = lu(k,554) - lu(k,317) * lu(k,547) + lu(k,555) = lu(k,555) - lu(k,318) * lu(k,547) + lu(k,556) = lu(k,556) - lu(k,319) * lu(k,547) + lu(k,557) = lu(k,557) - lu(k,320) * lu(k,547) + lu(k,558) = lu(k,558) - lu(k,321) * lu(k,547) + lu(k,559) = lu(k,559) - lu(k,322) * lu(k,547) + lu(k,561) = lu(k,561) - lu(k,323) * lu(k,547) + lu(k,562) = lu(k,562) - lu(k,324) * lu(k,547) + lu(k,563) = lu(k,563) - lu(k,325) * lu(k,547) + lu(k,598) = lu(k,598) - lu(k,311) * lu(k,597) + lu(k,599) = lu(k,599) - lu(k,312) * lu(k,597) + lu(k,600) = lu(k,600) - lu(k,313) * lu(k,597) + lu(k,601) = lu(k,601) - lu(k,314) * lu(k,597) + lu(k,602) = lu(k,602) - lu(k,315) * lu(k,597) + lu(k,603) = lu(k,603) - lu(k,316) * lu(k,597) + lu(k,604) = lu(k,604) - lu(k,317) * lu(k,597) + lu(k,605) = lu(k,605) - lu(k,318) * lu(k,597) + lu(k,606) = lu(k,606) - lu(k,319) * lu(k,597) + lu(k,607) = lu(k,607) - lu(k,320) * lu(k,597) + lu(k,608) = lu(k,608) - lu(k,321) * lu(k,597) + lu(k,609) = lu(k,609) - lu(k,322) * lu(k,597) + lu(k,611) = lu(k,611) - lu(k,323) * lu(k,597) + lu(k,612) = lu(k,612) - lu(k,324) * lu(k,597) + lu(k,613) = lu(k,613) - lu(k,325) * lu(k,597) + lu(k,635) = lu(k,635) - lu(k,311) * lu(k,634) + lu(k,636) = lu(k,636) - lu(k,312) * lu(k,634) + lu(k,637) = lu(k,637) - lu(k,313) * lu(k,634) + lu(k,638) = lu(k,638) - lu(k,314) * lu(k,634) + lu(k,639) = lu(k,639) - lu(k,315) * lu(k,634) + lu(k,640) = lu(k,640) - lu(k,316) * lu(k,634) + lu(k,641) = lu(k,641) - lu(k,317) * lu(k,634) + lu(k,642) = lu(k,642) - lu(k,318) * lu(k,634) + lu(k,643) = lu(k,643) - lu(k,319) * lu(k,634) + lu(k,644) = lu(k,644) - lu(k,320) * lu(k,634) + lu(k,645) = lu(k,645) - lu(k,321) * lu(k,634) + lu(k,646) = lu(k,646) - lu(k,322) * lu(k,634) + lu(k,648) = lu(k,648) - lu(k,323) * lu(k,634) + lu(k,649) = lu(k,649) - lu(k,324) * lu(k,634) + lu(k,650) = lu(k,650) - lu(k,325) * lu(k,634) + lu(k,679) = lu(k,679) - lu(k,311) * lu(k,678) + lu(k,680) = lu(k,680) - lu(k,312) * lu(k,678) + lu(k,681) = lu(k,681) - lu(k,313) * lu(k,678) + lu(k,682) = lu(k,682) - lu(k,314) * lu(k,678) + lu(k,683) = - lu(k,315) * lu(k,678) + lu(k,684) = lu(k,684) - lu(k,316) * lu(k,678) + lu(k,685) = lu(k,685) - lu(k,317) * lu(k,678) + lu(k,686) = lu(k,686) - lu(k,318) * lu(k,678) + lu(k,687) = - lu(k,319) * lu(k,678) + lu(k,688) = lu(k,688) - lu(k,320) * lu(k,678) + lu(k,689) = lu(k,689) - lu(k,321) * lu(k,678) + lu(k,690) = lu(k,690) - lu(k,322) * lu(k,678) + lu(k,692) = lu(k,692) - lu(k,323) * lu(k,678) + lu(k,693) = - lu(k,324) * lu(k,678) + lu(k,694) = lu(k,694) - lu(k,325) * lu(k,678) + lu(k,705) = lu(k,705) - lu(k,311) * lu(k,704) + lu(k,706) = lu(k,706) - lu(k,312) * lu(k,704) + lu(k,707) = lu(k,707) - lu(k,313) * lu(k,704) + lu(k,708) = lu(k,708) - lu(k,314) * lu(k,704) + lu(k,709) = lu(k,709) - lu(k,315) * lu(k,704) + lu(k,710) = lu(k,710) - lu(k,316) * lu(k,704) + lu(k,711) = lu(k,711) - lu(k,317) * lu(k,704) + lu(k,712) = lu(k,712) - lu(k,318) * lu(k,704) + lu(k,713) = lu(k,713) - lu(k,319) * lu(k,704) + lu(k,714) = lu(k,714) - lu(k,320) * lu(k,704) + lu(k,715) = lu(k,715) - lu(k,321) * lu(k,704) + lu(k,716) = lu(k,716) - lu(k,322) * lu(k,704) + lu(k,718) = lu(k,718) - lu(k,323) * lu(k,704) + lu(k,719) = lu(k,719) - lu(k,324) * lu(k,704) + lu(k,720) = lu(k,720) - lu(k,325) * lu(k,704) + end do + end subroutine lu_fac07 + subroutine lu_fac08( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,328) = 1._r8 / lu(k,328) + lu(k,329) = lu(k,329) * lu(k,328) + lu(k,330) = lu(k,330) * lu(k,328) + lu(k,331) = lu(k,331) * lu(k,328) + lu(k,332) = lu(k,332) * lu(k,328) + lu(k,333) = lu(k,333) * lu(k,328) + lu(k,334) = lu(k,334) * lu(k,328) + lu(k,335) = lu(k,335) * lu(k,328) + lu(k,336) = lu(k,336) * lu(k,328) + lu(k,337) = lu(k,337) * lu(k,328) + lu(k,338) = lu(k,338) * lu(k,328) + lu(k,339) = lu(k,339) * lu(k,328) + lu(k,340) = lu(k,340) * lu(k,328) + lu(k,351) = lu(k,351) - lu(k,329) * lu(k,349) + lu(k,352) = lu(k,352) - lu(k,330) * lu(k,349) + lu(k,353) = lu(k,353) - lu(k,331) * lu(k,349) + lu(k,354) = lu(k,354) - lu(k,332) * lu(k,349) + lu(k,355) = lu(k,355) - lu(k,333) * lu(k,349) + lu(k,357) = lu(k,357) - lu(k,334) * lu(k,349) + lu(k,358) = lu(k,358) - lu(k,335) * lu(k,349) + lu(k,359) = lu(k,359) - lu(k,336) * lu(k,349) + lu(k,360) = lu(k,360) - lu(k,337) * lu(k,349) + lu(k,361) = lu(k,361) - lu(k,338) * lu(k,349) + lu(k,362) = lu(k,362) - lu(k,339) * lu(k,349) + lu(k,364) = lu(k,364) - lu(k,340) * lu(k,349) + lu(k,376) = lu(k,376) - lu(k,329) * lu(k,374) + lu(k,377) = lu(k,377) - lu(k,330) * lu(k,374) + lu(k,378) = lu(k,378) - lu(k,331) * lu(k,374) + lu(k,379) = lu(k,379) - lu(k,332) * lu(k,374) + lu(k,380) = lu(k,380) - lu(k,333) * lu(k,374) + lu(k,382) = lu(k,382) - lu(k,334) * lu(k,374) + lu(k,383) = lu(k,383) - lu(k,335) * lu(k,374) + lu(k,384) = lu(k,384) - lu(k,336) * lu(k,374) + lu(k,385) = lu(k,385) - lu(k,337) * lu(k,374) + lu(k,386) = lu(k,386) - lu(k,338) * lu(k,374) + lu(k,387) = lu(k,387) - lu(k,339) * lu(k,374) + lu(k,389) = lu(k,389) - lu(k,340) * lu(k,374) + lu(k,419) = lu(k,419) - lu(k,329) * lu(k,417) + lu(k,420) = lu(k,420) - lu(k,330) * lu(k,417) + lu(k,421) = lu(k,421) - lu(k,331) * lu(k,417) + lu(k,422) = lu(k,422) - lu(k,332) * lu(k,417) + lu(k,423) = lu(k,423) - lu(k,333) * lu(k,417) + lu(k,425) = lu(k,425) - lu(k,334) * lu(k,417) + lu(k,426) = lu(k,426) - lu(k,335) * lu(k,417) + lu(k,427) = lu(k,427) - lu(k,336) * lu(k,417) + lu(k,428) = lu(k,428) - lu(k,337) * lu(k,417) + lu(k,429) = lu(k,429) - lu(k,338) * lu(k,417) + lu(k,430) = lu(k,430) - lu(k,339) * lu(k,417) + lu(k,432) = lu(k,432) - lu(k,340) * lu(k,417) + lu(k,447) = lu(k,447) - lu(k,329) * lu(k,445) + lu(k,448) = lu(k,448) - lu(k,330) * lu(k,445) + lu(k,449) = lu(k,449) - lu(k,331) * lu(k,445) + lu(k,450) = lu(k,450) - lu(k,332) * lu(k,445) + lu(k,451) = lu(k,451) - lu(k,333) * lu(k,445) + lu(k,453) = lu(k,453) - lu(k,334) * lu(k,445) + lu(k,454) = lu(k,454) - lu(k,335) * lu(k,445) + lu(k,455) = lu(k,455) - lu(k,336) * lu(k,445) + lu(k,456) = lu(k,456) - lu(k,337) * lu(k,445) + lu(k,457) = lu(k,457) - lu(k,338) * lu(k,445) + lu(k,458) = lu(k,458) - lu(k,339) * lu(k,445) + lu(k,460) = lu(k,460) - lu(k,340) * lu(k,445) + lu(k,472) = lu(k,472) - lu(k,329) * lu(k,470) + lu(k,473) = lu(k,473) - lu(k,330) * lu(k,470) + lu(k,474) = lu(k,474) - lu(k,331) * lu(k,470) + lu(k,475) = lu(k,475) - lu(k,332) * lu(k,470) + lu(k,476) = lu(k,476) - lu(k,333) * lu(k,470) + lu(k,478) = lu(k,478) - lu(k,334) * lu(k,470) + lu(k,479) = lu(k,479) - lu(k,335) * lu(k,470) + lu(k,480) = lu(k,480) - lu(k,336) * lu(k,470) + lu(k,481) = lu(k,481) - lu(k,337) * lu(k,470) + lu(k,482) = - lu(k,338) * lu(k,470) + lu(k,483) = lu(k,483) - lu(k,339) * lu(k,470) + lu(k,485) = lu(k,485) - lu(k,340) * lu(k,470) + lu(k,528) = lu(k,528) - lu(k,329) * lu(k,526) + lu(k,529) = lu(k,529) - lu(k,330) * lu(k,526) + lu(k,530) = lu(k,530) - lu(k,331) * lu(k,526) + lu(k,531) = lu(k,531) - lu(k,332) * lu(k,526) + lu(k,532) = lu(k,532) - lu(k,333) * lu(k,526) + lu(k,534) = lu(k,534) - lu(k,334) * lu(k,526) + lu(k,535) = lu(k,535) - lu(k,335) * lu(k,526) + lu(k,536) = lu(k,536) - lu(k,336) * lu(k,526) + lu(k,537) = lu(k,537) - lu(k,337) * lu(k,526) + lu(k,538) = lu(k,538) - lu(k,338) * lu(k,526) + lu(k,539) = lu(k,539) - lu(k,339) * lu(k,526) + lu(k,541) = lu(k,541) - lu(k,340) * lu(k,526) + lu(k,550) = lu(k,550) - lu(k,329) * lu(k,548) + lu(k,551) = lu(k,551) - lu(k,330) * lu(k,548) + lu(k,552) = lu(k,552) - lu(k,331) * lu(k,548) + lu(k,553) = lu(k,553) - lu(k,332) * lu(k,548) + lu(k,554) = lu(k,554) - lu(k,333) * lu(k,548) + lu(k,556) = lu(k,556) - lu(k,334) * lu(k,548) + lu(k,557) = lu(k,557) - lu(k,335) * lu(k,548) + lu(k,558) = lu(k,558) - lu(k,336) * lu(k,548) + lu(k,559) = lu(k,559) - lu(k,337) * lu(k,548) + lu(k,560) = - lu(k,338) * lu(k,548) + lu(k,561) = lu(k,561) - lu(k,339) * lu(k,548) + lu(k,563) = lu(k,563) - lu(k,340) * lu(k,548) + lu(k,600) = lu(k,600) - lu(k,329) * lu(k,598) + lu(k,601) = lu(k,601) - lu(k,330) * lu(k,598) + lu(k,602) = lu(k,602) - lu(k,331) * lu(k,598) + lu(k,603) = lu(k,603) - lu(k,332) * lu(k,598) + lu(k,604) = lu(k,604) - lu(k,333) * lu(k,598) + lu(k,606) = lu(k,606) - lu(k,334) * lu(k,598) + lu(k,607) = lu(k,607) - lu(k,335) * lu(k,598) + lu(k,608) = lu(k,608) - lu(k,336) * lu(k,598) + lu(k,609) = lu(k,609) - lu(k,337) * lu(k,598) + lu(k,610) = lu(k,610) - lu(k,338) * lu(k,598) + lu(k,611) = lu(k,611) - lu(k,339) * lu(k,598) + lu(k,613) = lu(k,613) - lu(k,340) * lu(k,598) + lu(k,637) = lu(k,637) - lu(k,329) * lu(k,635) + lu(k,638) = lu(k,638) - lu(k,330) * lu(k,635) + lu(k,639) = lu(k,639) - lu(k,331) * lu(k,635) + lu(k,640) = lu(k,640) - lu(k,332) * lu(k,635) + lu(k,641) = lu(k,641) - lu(k,333) * lu(k,635) + lu(k,643) = lu(k,643) - lu(k,334) * lu(k,635) + lu(k,644) = lu(k,644) - lu(k,335) * lu(k,635) + lu(k,645) = lu(k,645) - lu(k,336) * lu(k,635) + lu(k,646) = lu(k,646) - lu(k,337) * lu(k,635) + lu(k,647) = lu(k,647) - lu(k,338) * lu(k,635) + lu(k,648) = lu(k,648) - lu(k,339) * lu(k,635) + lu(k,650) = lu(k,650) - lu(k,340) * lu(k,635) + lu(k,660) = lu(k,660) - lu(k,329) * lu(k,658) + lu(k,661) = lu(k,661) - lu(k,330) * lu(k,658) + lu(k,662) = lu(k,662) - lu(k,331) * lu(k,658) + lu(k,663) = lu(k,663) - lu(k,332) * lu(k,658) + lu(k,664) = lu(k,664) - lu(k,333) * lu(k,658) + lu(k,666) = lu(k,666) - lu(k,334) * lu(k,658) + lu(k,667) = lu(k,667) - lu(k,335) * lu(k,658) + lu(k,668) = lu(k,668) - lu(k,336) * lu(k,658) + lu(k,669) = lu(k,669) - lu(k,337) * lu(k,658) + lu(k,670) = lu(k,670) - lu(k,338) * lu(k,658) + lu(k,671) = lu(k,671) - lu(k,339) * lu(k,658) + lu(k,673) = lu(k,673) - lu(k,340) * lu(k,658) + lu(k,681) = lu(k,681) - lu(k,329) * lu(k,679) + lu(k,682) = lu(k,682) - lu(k,330) * lu(k,679) + lu(k,683) = lu(k,683) - lu(k,331) * lu(k,679) + lu(k,684) = lu(k,684) - lu(k,332) * lu(k,679) + lu(k,685) = lu(k,685) - lu(k,333) * lu(k,679) + lu(k,687) = lu(k,687) - lu(k,334) * lu(k,679) + lu(k,688) = lu(k,688) - lu(k,335) * lu(k,679) + lu(k,689) = lu(k,689) - lu(k,336) * lu(k,679) + lu(k,690) = lu(k,690) - lu(k,337) * lu(k,679) + lu(k,691) = - lu(k,338) * lu(k,679) + lu(k,692) = lu(k,692) - lu(k,339) * lu(k,679) + lu(k,694) = lu(k,694) - lu(k,340) * lu(k,679) + lu(k,707) = lu(k,707) - lu(k,329) * lu(k,705) + lu(k,708) = lu(k,708) - lu(k,330) * lu(k,705) + lu(k,709) = lu(k,709) - lu(k,331) * lu(k,705) + lu(k,710) = lu(k,710) - lu(k,332) * lu(k,705) + lu(k,711) = lu(k,711) - lu(k,333) * lu(k,705) + lu(k,713) = lu(k,713) - lu(k,334) * lu(k,705) + lu(k,714) = lu(k,714) - lu(k,335) * lu(k,705) + lu(k,715) = lu(k,715) - lu(k,336) * lu(k,705) + lu(k,716) = lu(k,716) - lu(k,337) * lu(k,705) + lu(k,717) = lu(k,717) - lu(k,338) * lu(k,705) + lu(k,718) = lu(k,718) - lu(k,339) * lu(k,705) + lu(k,720) = lu(k,720) - lu(k,340) * lu(k,705) + lu(k,732) = lu(k,732) - lu(k,329) * lu(k,730) + lu(k,733) = lu(k,733) - lu(k,330) * lu(k,730) + lu(k,734) = lu(k,734) - lu(k,331) * lu(k,730) + lu(k,735) = lu(k,735) - lu(k,332) * lu(k,730) + lu(k,736) = lu(k,736) - lu(k,333) * lu(k,730) + lu(k,738) = lu(k,738) - lu(k,334) * lu(k,730) + lu(k,739) = lu(k,739) - lu(k,335) * lu(k,730) + lu(k,740) = lu(k,740) - lu(k,336) * lu(k,730) + lu(k,741) = lu(k,741) - lu(k,337) * lu(k,730) + lu(k,742) = lu(k,742) - lu(k,338) * lu(k,730) + lu(k,743) = lu(k,743) - lu(k,339) * lu(k,730) + lu(k,745) = lu(k,745) - lu(k,340) * lu(k,730) + lu(k,350) = 1._r8 / lu(k,350) + lu(k,351) = lu(k,351) * lu(k,350) + lu(k,352) = lu(k,352) * lu(k,350) + lu(k,353) = lu(k,353) * lu(k,350) + lu(k,354) = lu(k,354) * lu(k,350) + lu(k,355) = lu(k,355) * lu(k,350) + lu(k,356) = lu(k,356) * lu(k,350) + lu(k,357) = lu(k,357) * lu(k,350) + lu(k,358) = lu(k,358) * lu(k,350) + lu(k,359) = lu(k,359) * lu(k,350) + lu(k,360) = lu(k,360) * lu(k,350) + lu(k,361) = lu(k,361) * lu(k,350) + lu(k,362) = lu(k,362) * lu(k,350) + lu(k,363) = lu(k,363) * lu(k,350) + lu(k,364) = lu(k,364) * lu(k,350) + lu(k,376) = lu(k,376) - lu(k,351) * lu(k,375) + lu(k,377) = lu(k,377) - lu(k,352) * lu(k,375) + lu(k,378) = lu(k,378) - lu(k,353) * lu(k,375) + lu(k,379) = lu(k,379) - lu(k,354) * lu(k,375) + lu(k,380) = lu(k,380) - lu(k,355) * lu(k,375) + lu(k,381) = lu(k,381) - lu(k,356) * lu(k,375) + lu(k,382) = lu(k,382) - lu(k,357) * lu(k,375) + lu(k,383) = lu(k,383) - lu(k,358) * lu(k,375) + lu(k,384) = lu(k,384) - lu(k,359) * lu(k,375) + lu(k,385) = lu(k,385) - lu(k,360) * lu(k,375) + lu(k,386) = lu(k,386) - lu(k,361) * lu(k,375) + lu(k,387) = lu(k,387) - lu(k,362) * lu(k,375) + lu(k,388) = lu(k,388) - lu(k,363) * lu(k,375) + lu(k,389) = lu(k,389) - lu(k,364) * lu(k,375) + lu(k,419) = lu(k,419) - lu(k,351) * lu(k,418) + lu(k,420) = lu(k,420) - lu(k,352) * lu(k,418) + lu(k,421) = lu(k,421) - lu(k,353) * lu(k,418) + lu(k,422) = lu(k,422) - lu(k,354) * lu(k,418) + lu(k,423) = lu(k,423) - lu(k,355) * lu(k,418) + lu(k,424) = lu(k,424) - lu(k,356) * lu(k,418) + lu(k,425) = lu(k,425) - lu(k,357) * lu(k,418) + lu(k,426) = lu(k,426) - lu(k,358) * lu(k,418) + lu(k,427) = lu(k,427) - lu(k,359) * lu(k,418) + lu(k,428) = lu(k,428) - lu(k,360) * lu(k,418) + lu(k,429) = lu(k,429) - lu(k,361) * lu(k,418) + lu(k,430) = lu(k,430) - lu(k,362) * lu(k,418) + lu(k,431) = lu(k,431) - lu(k,363) * lu(k,418) + lu(k,432) = lu(k,432) - lu(k,364) * lu(k,418) + lu(k,447) = lu(k,447) - lu(k,351) * lu(k,446) + lu(k,448) = lu(k,448) - lu(k,352) * lu(k,446) + lu(k,449) = lu(k,449) - lu(k,353) * lu(k,446) + lu(k,450) = lu(k,450) - lu(k,354) * lu(k,446) + lu(k,451) = lu(k,451) - lu(k,355) * lu(k,446) + lu(k,452) = lu(k,452) - lu(k,356) * lu(k,446) + lu(k,453) = lu(k,453) - lu(k,357) * lu(k,446) + lu(k,454) = lu(k,454) - lu(k,358) * lu(k,446) + lu(k,455) = lu(k,455) - lu(k,359) * lu(k,446) + lu(k,456) = lu(k,456) - lu(k,360) * lu(k,446) + lu(k,457) = lu(k,457) - lu(k,361) * lu(k,446) + lu(k,458) = lu(k,458) - lu(k,362) * lu(k,446) + lu(k,459) = lu(k,459) - lu(k,363) * lu(k,446) + lu(k,460) = lu(k,460) - lu(k,364) * lu(k,446) + lu(k,472) = lu(k,472) - lu(k,351) * lu(k,471) + lu(k,473) = lu(k,473) - lu(k,352) * lu(k,471) + lu(k,474) = lu(k,474) - lu(k,353) * lu(k,471) + lu(k,475) = lu(k,475) - lu(k,354) * lu(k,471) + lu(k,476) = lu(k,476) - lu(k,355) * lu(k,471) + lu(k,477) = lu(k,477) - lu(k,356) * lu(k,471) + lu(k,478) = lu(k,478) - lu(k,357) * lu(k,471) + lu(k,479) = lu(k,479) - lu(k,358) * lu(k,471) + lu(k,480) = lu(k,480) - lu(k,359) * lu(k,471) + lu(k,481) = lu(k,481) - lu(k,360) * lu(k,471) + lu(k,482) = lu(k,482) - lu(k,361) * lu(k,471) + lu(k,483) = lu(k,483) - lu(k,362) * lu(k,471) + lu(k,484) = lu(k,484) - lu(k,363) * lu(k,471) + lu(k,485) = lu(k,485) - lu(k,364) * lu(k,471) + lu(k,528) = lu(k,528) - lu(k,351) * lu(k,527) + lu(k,529) = lu(k,529) - lu(k,352) * lu(k,527) + lu(k,530) = lu(k,530) - lu(k,353) * lu(k,527) + lu(k,531) = lu(k,531) - lu(k,354) * lu(k,527) + lu(k,532) = lu(k,532) - lu(k,355) * lu(k,527) + lu(k,533) = lu(k,533) - lu(k,356) * lu(k,527) + lu(k,534) = lu(k,534) - lu(k,357) * lu(k,527) + lu(k,535) = lu(k,535) - lu(k,358) * lu(k,527) + lu(k,536) = lu(k,536) - lu(k,359) * lu(k,527) + lu(k,537) = lu(k,537) - lu(k,360) * lu(k,527) + lu(k,538) = lu(k,538) - lu(k,361) * lu(k,527) + lu(k,539) = lu(k,539) - lu(k,362) * lu(k,527) + lu(k,540) = lu(k,540) - lu(k,363) * lu(k,527) + lu(k,541) = lu(k,541) - lu(k,364) * lu(k,527) + lu(k,550) = lu(k,550) - lu(k,351) * lu(k,549) + lu(k,551) = lu(k,551) - lu(k,352) * lu(k,549) + lu(k,552) = lu(k,552) - lu(k,353) * lu(k,549) + lu(k,553) = lu(k,553) - lu(k,354) * lu(k,549) + lu(k,554) = lu(k,554) - lu(k,355) * lu(k,549) + lu(k,555) = lu(k,555) - lu(k,356) * lu(k,549) + lu(k,556) = lu(k,556) - lu(k,357) * lu(k,549) + lu(k,557) = lu(k,557) - lu(k,358) * lu(k,549) + lu(k,558) = lu(k,558) - lu(k,359) * lu(k,549) + lu(k,559) = lu(k,559) - lu(k,360) * lu(k,549) + lu(k,560) = lu(k,560) - lu(k,361) * lu(k,549) + lu(k,561) = lu(k,561) - lu(k,362) * lu(k,549) + lu(k,562) = lu(k,562) - lu(k,363) * lu(k,549) + lu(k,563) = lu(k,563) - lu(k,364) * lu(k,549) + lu(k,572) = lu(k,572) - lu(k,351) * lu(k,571) + lu(k,573) = lu(k,573) - lu(k,352) * lu(k,571) + lu(k,574) = lu(k,574) - lu(k,353) * lu(k,571) + lu(k,575) = lu(k,575) - lu(k,354) * lu(k,571) + lu(k,576) = lu(k,576) - lu(k,355) * lu(k,571) + lu(k,577) = lu(k,577) - lu(k,356) * lu(k,571) + lu(k,578) = lu(k,578) - lu(k,357) * lu(k,571) + lu(k,579) = lu(k,579) - lu(k,358) * lu(k,571) + lu(k,580) = lu(k,580) - lu(k,359) * lu(k,571) + lu(k,581) = lu(k,581) - lu(k,360) * lu(k,571) + lu(k,582) = lu(k,582) - lu(k,361) * lu(k,571) + lu(k,583) = lu(k,583) - lu(k,362) * lu(k,571) + lu(k,584) = lu(k,584) - lu(k,363) * lu(k,571) + lu(k,585) = lu(k,585) - lu(k,364) * lu(k,571) + lu(k,600) = lu(k,600) - lu(k,351) * lu(k,599) + lu(k,601) = lu(k,601) - lu(k,352) * lu(k,599) + lu(k,602) = lu(k,602) - lu(k,353) * lu(k,599) + lu(k,603) = lu(k,603) - lu(k,354) * lu(k,599) + lu(k,604) = lu(k,604) - lu(k,355) * lu(k,599) + lu(k,605) = lu(k,605) - lu(k,356) * lu(k,599) + lu(k,606) = lu(k,606) - lu(k,357) * lu(k,599) + lu(k,607) = lu(k,607) - lu(k,358) * lu(k,599) + lu(k,608) = lu(k,608) - lu(k,359) * lu(k,599) + lu(k,609) = lu(k,609) - lu(k,360) * lu(k,599) + lu(k,610) = lu(k,610) - lu(k,361) * lu(k,599) + lu(k,611) = lu(k,611) - lu(k,362) * lu(k,599) + lu(k,612) = lu(k,612) - lu(k,363) * lu(k,599) + lu(k,613) = lu(k,613) - lu(k,364) * lu(k,599) + lu(k,637) = lu(k,637) - lu(k,351) * lu(k,636) + lu(k,638) = lu(k,638) - lu(k,352) * lu(k,636) + lu(k,639) = lu(k,639) - lu(k,353) * lu(k,636) + lu(k,640) = lu(k,640) - lu(k,354) * lu(k,636) + lu(k,641) = lu(k,641) - lu(k,355) * lu(k,636) + lu(k,642) = lu(k,642) - lu(k,356) * lu(k,636) + lu(k,643) = lu(k,643) - lu(k,357) * lu(k,636) + lu(k,644) = lu(k,644) - lu(k,358) * lu(k,636) + lu(k,645) = lu(k,645) - lu(k,359) * lu(k,636) + lu(k,646) = lu(k,646) - lu(k,360) * lu(k,636) + lu(k,647) = lu(k,647) - lu(k,361) * lu(k,636) + lu(k,648) = lu(k,648) - lu(k,362) * lu(k,636) + lu(k,649) = lu(k,649) - lu(k,363) * lu(k,636) + lu(k,650) = lu(k,650) - lu(k,364) * lu(k,636) + lu(k,660) = lu(k,660) - lu(k,351) * lu(k,659) + lu(k,661) = lu(k,661) - lu(k,352) * lu(k,659) + lu(k,662) = lu(k,662) - lu(k,353) * lu(k,659) + lu(k,663) = lu(k,663) - lu(k,354) * lu(k,659) + lu(k,664) = lu(k,664) - lu(k,355) * lu(k,659) + lu(k,665) = lu(k,665) - lu(k,356) * lu(k,659) + lu(k,666) = lu(k,666) - lu(k,357) * lu(k,659) + lu(k,667) = lu(k,667) - lu(k,358) * lu(k,659) + lu(k,668) = lu(k,668) - lu(k,359) * lu(k,659) + lu(k,669) = lu(k,669) - lu(k,360) * lu(k,659) + lu(k,670) = lu(k,670) - lu(k,361) * lu(k,659) + lu(k,671) = lu(k,671) - lu(k,362) * lu(k,659) + lu(k,672) = lu(k,672) - lu(k,363) * lu(k,659) + lu(k,673) = lu(k,673) - lu(k,364) * lu(k,659) + lu(k,681) = lu(k,681) - lu(k,351) * lu(k,680) + lu(k,682) = lu(k,682) - lu(k,352) * lu(k,680) + lu(k,683) = lu(k,683) - lu(k,353) * lu(k,680) + lu(k,684) = lu(k,684) - lu(k,354) * lu(k,680) + lu(k,685) = lu(k,685) - lu(k,355) * lu(k,680) + lu(k,686) = lu(k,686) - lu(k,356) * lu(k,680) + lu(k,687) = lu(k,687) - lu(k,357) * lu(k,680) + lu(k,688) = lu(k,688) - lu(k,358) * lu(k,680) + lu(k,689) = lu(k,689) - lu(k,359) * lu(k,680) + lu(k,690) = lu(k,690) - lu(k,360) * lu(k,680) + lu(k,691) = lu(k,691) - lu(k,361) * lu(k,680) + lu(k,692) = lu(k,692) - lu(k,362) * lu(k,680) + lu(k,693) = lu(k,693) - lu(k,363) * lu(k,680) + lu(k,694) = lu(k,694) - lu(k,364) * lu(k,680) + lu(k,707) = lu(k,707) - lu(k,351) * lu(k,706) + lu(k,708) = lu(k,708) - lu(k,352) * lu(k,706) + lu(k,709) = lu(k,709) - lu(k,353) * lu(k,706) + lu(k,710) = lu(k,710) - lu(k,354) * lu(k,706) + lu(k,711) = lu(k,711) - lu(k,355) * lu(k,706) + lu(k,712) = lu(k,712) - lu(k,356) * lu(k,706) + lu(k,713) = lu(k,713) - lu(k,357) * lu(k,706) + lu(k,714) = lu(k,714) - lu(k,358) * lu(k,706) + lu(k,715) = lu(k,715) - lu(k,359) * lu(k,706) + lu(k,716) = lu(k,716) - lu(k,360) * lu(k,706) + lu(k,717) = lu(k,717) - lu(k,361) * lu(k,706) + lu(k,718) = lu(k,718) - lu(k,362) * lu(k,706) + lu(k,719) = lu(k,719) - lu(k,363) * lu(k,706) + lu(k,720) = lu(k,720) - lu(k,364) * lu(k,706) + lu(k,732) = lu(k,732) - lu(k,351) * lu(k,731) + lu(k,733) = lu(k,733) - lu(k,352) * lu(k,731) + lu(k,734) = lu(k,734) - lu(k,353) * lu(k,731) + lu(k,735) = lu(k,735) - lu(k,354) * lu(k,731) + lu(k,736) = lu(k,736) - lu(k,355) * lu(k,731) + lu(k,737) = lu(k,737) - lu(k,356) * lu(k,731) + lu(k,738) = lu(k,738) - lu(k,357) * lu(k,731) + lu(k,739) = lu(k,739) - lu(k,358) * lu(k,731) + lu(k,740) = lu(k,740) - lu(k,359) * lu(k,731) + lu(k,741) = lu(k,741) - lu(k,360) * lu(k,731) + lu(k,742) = lu(k,742) - lu(k,361) * lu(k,731) + lu(k,743) = lu(k,743) - lu(k,362) * lu(k,731) + lu(k,744) = lu(k,744) - lu(k,363) * lu(k,731) + lu(k,745) = lu(k,745) - lu(k,364) * lu(k,731) + lu(k,376) = 1._r8 / lu(k,376) + lu(k,377) = lu(k,377) * lu(k,376) + lu(k,378) = lu(k,378) * lu(k,376) + lu(k,379) = lu(k,379) * lu(k,376) + lu(k,380) = lu(k,380) * lu(k,376) + lu(k,381) = lu(k,381) * lu(k,376) + lu(k,382) = lu(k,382) * lu(k,376) + lu(k,383) = lu(k,383) * lu(k,376) + lu(k,384) = lu(k,384) * lu(k,376) + lu(k,385) = lu(k,385) * lu(k,376) + lu(k,386) = lu(k,386) * lu(k,376) + lu(k,387) = lu(k,387) * lu(k,376) + lu(k,388) = lu(k,388) * lu(k,376) + lu(k,389) = lu(k,389) * lu(k,376) + lu(k,420) = lu(k,420) - lu(k,377) * lu(k,419) + lu(k,421) = lu(k,421) - lu(k,378) * lu(k,419) + lu(k,422) = lu(k,422) - lu(k,379) * lu(k,419) + lu(k,423) = lu(k,423) - lu(k,380) * lu(k,419) + lu(k,424) = lu(k,424) - lu(k,381) * lu(k,419) + lu(k,425) = lu(k,425) - lu(k,382) * lu(k,419) + lu(k,426) = lu(k,426) - lu(k,383) * lu(k,419) + lu(k,427) = lu(k,427) - lu(k,384) * lu(k,419) + lu(k,428) = lu(k,428) - lu(k,385) * lu(k,419) + lu(k,429) = lu(k,429) - lu(k,386) * lu(k,419) + lu(k,430) = lu(k,430) - lu(k,387) * lu(k,419) + lu(k,431) = lu(k,431) - lu(k,388) * lu(k,419) + lu(k,432) = lu(k,432) - lu(k,389) * lu(k,419) + lu(k,448) = lu(k,448) - lu(k,377) * lu(k,447) + lu(k,449) = lu(k,449) - lu(k,378) * lu(k,447) + lu(k,450) = lu(k,450) - lu(k,379) * lu(k,447) + lu(k,451) = lu(k,451) - lu(k,380) * lu(k,447) + lu(k,452) = lu(k,452) - lu(k,381) * lu(k,447) + lu(k,453) = lu(k,453) - lu(k,382) * lu(k,447) + lu(k,454) = lu(k,454) - lu(k,383) * lu(k,447) + lu(k,455) = lu(k,455) - lu(k,384) * lu(k,447) + lu(k,456) = lu(k,456) - lu(k,385) * lu(k,447) + lu(k,457) = lu(k,457) - lu(k,386) * lu(k,447) + lu(k,458) = lu(k,458) - lu(k,387) * lu(k,447) + lu(k,459) = lu(k,459) - lu(k,388) * lu(k,447) + lu(k,460) = lu(k,460) - lu(k,389) * lu(k,447) + lu(k,473) = lu(k,473) - lu(k,377) * lu(k,472) + lu(k,474) = lu(k,474) - lu(k,378) * lu(k,472) + lu(k,475) = lu(k,475) - lu(k,379) * lu(k,472) + lu(k,476) = lu(k,476) - lu(k,380) * lu(k,472) + lu(k,477) = lu(k,477) - lu(k,381) * lu(k,472) + lu(k,478) = lu(k,478) - lu(k,382) * lu(k,472) + lu(k,479) = lu(k,479) - lu(k,383) * lu(k,472) + lu(k,480) = lu(k,480) - lu(k,384) * lu(k,472) + lu(k,481) = lu(k,481) - lu(k,385) * lu(k,472) + lu(k,482) = lu(k,482) - lu(k,386) * lu(k,472) + lu(k,483) = lu(k,483) - lu(k,387) * lu(k,472) + lu(k,484) = lu(k,484) - lu(k,388) * lu(k,472) + lu(k,485) = lu(k,485) - lu(k,389) * lu(k,472) + lu(k,504) = lu(k,504) - lu(k,377) * lu(k,503) + lu(k,505) = lu(k,505) - lu(k,378) * lu(k,503) + lu(k,506) = lu(k,506) - lu(k,379) * lu(k,503) + lu(k,507) = lu(k,507) - lu(k,380) * lu(k,503) + lu(k,508) = lu(k,508) - lu(k,381) * lu(k,503) + lu(k,509) = lu(k,509) - lu(k,382) * lu(k,503) + lu(k,510) = lu(k,510) - lu(k,383) * lu(k,503) + lu(k,511) = lu(k,511) - lu(k,384) * lu(k,503) + lu(k,512) = lu(k,512) - lu(k,385) * lu(k,503) + lu(k,513) = lu(k,513) - lu(k,386) * lu(k,503) + lu(k,514) = lu(k,514) - lu(k,387) * lu(k,503) + lu(k,515) = lu(k,515) - lu(k,388) * lu(k,503) + lu(k,516) = lu(k,516) - lu(k,389) * lu(k,503) + lu(k,529) = lu(k,529) - lu(k,377) * lu(k,528) + lu(k,530) = lu(k,530) - lu(k,378) * lu(k,528) + lu(k,531) = lu(k,531) - lu(k,379) * lu(k,528) + lu(k,532) = lu(k,532) - lu(k,380) * lu(k,528) + lu(k,533) = lu(k,533) - lu(k,381) * lu(k,528) + lu(k,534) = lu(k,534) - lu(k,382) * lu(k,528) + lu(k,535) = lu(k,535) - lu(k,383) * lu(k,528) + lu(k,536) = lu(k,536) - lu(k,384) * lu(k,528) + lu(k,537) = lu(k,537) - lu(k,385) * lu(k,528) + lu(k,538) = lu(k,538) - lu(k,386) * lu(k,528) + lu(k,539) = lu(k,539) - lu(k,387) * lu(k,528) + lu(k,540) = lu(k,540) - lu(k,388) * lu(k,528) + lu(k,541) = lu(k,541) - lu(k,389) * lu(k,528) + lu(k,551) = lu(k,551) - lu(k,377) * lu(k,550) + lu(k,552) = lu(k,552) - lu(k,378) * lu(k,550) + lu(k,553) = lu(k,553) - lu(k,379) * lu(k,550) + lu(k,554) = lu(k,554) - lu(k,380) * lu(k,550) + lu(k,555) = lu(k,555) - lu(k,381) * lu(k,550) + lu(k,556) = lu(k,556) - lu(k,382) * lu(k,550) + lu(k,557) = lu(k,557) - lu(k,383) * lu(k,550) + lu(k,558) = lu(k,558) - lu(k,384) * lu(k,550) + lu(k,559) = lu(k,559) - lu(k,385) * lu(k,550) + lu(k,560) = lu(k,560) - lu(k,386) * lu(k,550) + lu(k,561) = lu(k,561) - lu(k,387) * lu(k,550) + lu(k,562) = lu(k,562) - lu(k,388) * lu(k,550) + lu(k,563) = lu(k,563) - lu(k,389) * lu(k,550) + lu(k,573) = lu(k,573) - lu(k,377) * lu(k,572) + lu(k,574) = lu(k,574) - lu(k,378) * lu(k,572) + lu(k,575) = lu(k,575) - lu(k,379) * lu(k,572) + lu(k,576) = lu(k,576) - lu(k,380) * lu(k,572) + lu(k,577) = lu(k,577) - lu(k,381) * lu(k,572) + lu(k,578) = lu(k,578) - lu(k,382) * lu(k,572) + lu(k,579) = lu(k,579) - lu(k,383) * lu(k,572) + lu(k,580) = lu(k,580) - lu(k,384) * lu(k,572) + lu(k,581) = lu(k,581) - lu(k,385) * lu(k,572) + lu(k,582) = lu(k,582) - lu(k,386) * lu(k,572) + lu(k,583) = lu(k,583) - lu(k,387) * lu(k,572) + lu(k,584) = lu(k,584) - lu(k,388) * lu(k,572) + lu(k,585) = lu(k,585) - lu(k,389) * lu(k,572) + lu(k,601) = lu(k,601) - lu(k,377) * lu(k,600) + lu(k,602) = lu(k,602) - lu(k,378) * lu(k,600) + lu(k,603) = lu(k,603) - lu(k,379) * lu(k,600) + lu(k,604) = lu(k,604) - lu(k,380) * lu(k,600) + lu(k,605) = lu(k,605) - lu(k,381) * lu(k,600) + lu(k,606) = lu(k,606) - lu(k,382) * lu(k,600) + lu(k,607) = lu(k,607) - lu(k,383) * lu(k,600) + lu(k,608) = lu(k,608) - lu(k,384) * lu(k,600) + lu(k,609) = lu(k,609) - lu(k,385) * lu(k,600) + lu(k,610) = lu(k,610) - lu(k,386) * lu(k,600) + lu(k,611) = lu(k,611) - lu(k,387) * lu(k,600) + lu(k,612) = lu(k,612) - lu(k,388) * lu(k,600) + lu(k,613) = lu(k,613) - lu(k,389) * lu(k,600) + lu(k,638) = lu(k,638) - lu(k,377) * lu(k,637) + lu(k,639) = lu(k,639) - lu(k,378) * lu(k,637) + lu(k,640) = lu(k,640) - lu(k,379) * lu(k,637) + lu(k,641) = lu(k,641) - lu(k,380) * lu(k,637) + lu(k,642) = lu(k,642) - lu(k,381) * lu(k,637) + lu(k,643) = lu(k,643) - lu(k,382) * lu(k,637) + lu(k,644) = lu(k,644) - lu(k,383) * lu(k,637) + lu(k,645) = lu(k,645) - lu(k,384) * lu(k,637) + lu(k,646) = lu(k,646) - lu(k,385) * lu(k,637) + lu(k,647) = lu(k,647) - lu(k,386) * lu(k,637) + lu(k,648) = lu(k,648) - lu(k,387) * lu(k,637) + lu(k,649) = lu(k,649) - lu(k,388) * lu(k,637) + lu(k,650) = lu(k,650) - lu(k,389) * lu(k,637) + lu(k,661) = lu(k,661) - lu(k,377) * lu(k,660) + lu(k,662) = lu(k,662) - lu(k,378) * lu(k,660) + lu(k,663) = lu(k,663) - lu(k,379) * lu(k,660) + lu(k,664) = lu(k,664) - lu(k,380) * lu(k,660) + lu(k,665) = lu(k,665) - lu(k,381) * lu(k,660) + lu(k,666) = lu(k,666) - lu(k,382) * lu(k,660) + lu(k,667) = lu(k,667) - lu(k,383) * lu(k,660) + lu(k,668) = lu(k,668) - lu(k,384) * lu(k,660) + lu(k,669) = lu(k,669) - lu(k,385) * lu(k,660) + lu(k,670) = lu(k,670) - lu(k,386) * lu(k,660) + lu(k,671) = lu(k,671) - lu(k,387) * lu(k,660) + lu(k,672) = lu(k,672) - lu(k,388) * lu(k,660) + lu(k,673) = lu(k,673) - lu(k,389) * lu(k,660) + lu(k,682) = lu(k,682) - lu(k,377) * lu(k,681) + lu(k,683) = lu(k,683) - lu(k,378) * lu(k,681) + lu(k,684) = lu(k,684) - lu(k,379) * lu(k,681) + lu(k,685) = lu(k,685) - lu(k,380) * lu(k,681) + lu(k,686) = lu(k,686) - lu(k,381) * lu(k,681) + lu(k,687) = lu(k,687) - lu(k,382) * lu(k,681) + lu(k,688) = lu(k,688) - lu(k,383) * lu(k,681) + lu(k,689) = lu(k,689) - lu(k,384) * lu(k,681) + lu(k,690) = lu(k,690) - lu(k,385) * lu(k,681) + lu(k,691) = lu(k,691) - lu(k,386) * lu(k,681) + lu(k,692) = lu(k,692) - lu(k,387) * lu(k,681) + lu(k,693) = lu(k,693) - lu(k,388) * lu(k,681) + lu(k,694) = lu(k,694) - lu(k,389) * lu(k,681) + lu(k,708) = lu(k,708) - lu(k,377) * lu(k,707) + lu(k,709) = lu(k,709) - lu(k,378) * lu(k,707) + lu(k,710) = lu(k,710) - lu(k,379) * lu(k,707) + lu(k,711) = lu(k,711) - lu(k,380) * lu(k,707) + lu(k,712) = lu(k,712) - lu(k,381) * lu(k,707) + lu(k,713) = lu(k,713) - lu(k,382) * lu(k,707) + lu(k,714) = lu(k,714) - lu(k,383) * lu(k,707) + lu(k,715) = lu(k,715) - lu(k,384) * lu(k,707) + lu(k,716) = lu(k,716) - lu(k,385) * lu(k,707) + lu(k,717) = lu(k,717) - lu(k,386) * lu(k,707) + lu(k,718) = lu(k,718) - lu(k,387) * lu(k,707) + lu(k,719) = lu(k,719) - lu(k,388) * lu(k,707) + lu(k,720) = lu(k,720) - lu(k,389) * lu(k,707) + lu(k,733) = lu(k,733) - lu(k,377) * lu(k,732) + lu(k,734) = lu(k,734) - lu(k,378) * lu(k,732) + lu(k,735) = lu(k,735) - lu(k,379) * lu(k,732) + lu(k,736) = lu(k,736) - lu(k,380) * lu(k,732) + lu(k,737) = lu(k,737) - lu(k,381) * lu(k,732) + lu(k,738) = lu(k,738) - lu(k,382) * lu(k,732) + lu(k,739) = lu(k,739) - lu(k,383) * lu(k,732) + lu(k,740) = lu(k,740) - lu(k,384) * lu(k,732) + lu(k,741) = lu(k,741) - lu(k,385) * lu(k,732) + lu(k,742) = lu(k,742) - lu(k,386) * lu(k,732) + lu(k,743) = lu(k,743) - lu(k,387) * lu(k,732) + lu(k,744) = lu(k,744) - lu(k,388) * lu(k,732) + lu(k,745) = lu(k,745) - lu(k,389) * lu(k,732) + lu(k,420) = 1._r8 / lu(k,420) + lu(k,421) = lu(k,421) * lu(k,420) + lu(k,422) = lu(k,422) * lu(k,420) + lu(k,423) = lu(k,423) * lu(k,420) + lu(k,424) = lu(k,424) * lu(k,420) + lu(k,425) = lu(k,425) * lu(k,420) + lu(k,426) = lu(k,426) * lu(k,420) + lu(k,427) = lu(k,427) * lu(k,420) + lu(k,428) = lu(k,428) * lu(k,420) + lu(k,429) = lu(k,429) * lu(k,420) + lu(k,430) = lu(k,430) * lu(k,420) + lu(k,431) = lu(k,431) * lu(k,420) + lu(k,432) = lu(k,432) * lu(k,420) + lu(k,449) = lu(k,449) - lu(k,421) * lu(k,448) + lu(k,450) = lu(k,450) - lu(k,422) * lu(k,448) + lu(k,451) = lu(k,451) - lu(k,423) * lu(k,448) + lu(k,452) = lu(k,452) - lu(k,424) * lu(k,448) + lu(k,453) = lu(k,453) - lu(k,425) * lu(k,448) + lu(k,454) = lu(k,454) - lu(k,426) * lu(k,448) + lu(k,455) = lu(k,455) - lu(k,427) * lu(k,448) + lu(k,456) = lu(k,456) - lu(k,428) * lu(k,448) + lu(k,457) = lu(k,457) - lu(k,429) * lu(k,448) + lu(k,458) = lu(k,458) - lu(k,430) * lu(k,448) + lu(k,459) = lu(k,459) - lu(k,431) * lu(k,448) + lu(k,460) = lu(k,460) - lu(k,432) * lu(k,448) + lu(k,474) = lu(k,474) - lu(k,421) * lu(k,473) + lu(k,475) = lu(k,475) - lu(k,422) * lu(k,473) + lu(k,476) = lu(k,476) - lu(k,423) * lu(k,473) + lu(k,477) = lu(k,477) - lu(k,424) * lu(k,473) + lu(k,478) = lu(k,478) - lu(k,425) * lu(k,473) + lu(k,479) = lu(k,479) - lu(k,426) * lu(k,473) + lu(k,480) = lu(k,480) - lu(k,427) * lu(k,473) + lu(k,481) = lu(k,481) - lu(k,428) * lu(k,473) + lu(k,482) = lu(k,482) - lu(k,429) * lu(k,473) + lu(k,483) = lu(k,483) - lu(k,430) * lu(k,473) + lu(k,484) = lu(k,484) - lu(k,431) * lu(k,473) + lu(k,485) = lu(k,485) - lu(k,432) * lu(k,473) + lu(k,505) = lu(k,505) - lu(k,421) * lu(k,504) + lu(k,506) = lu(k,506) - lu(k,422) * lu(k,504) + lu(k,507) = lu(k,507) - lu(k,423) * lu(k,504) + lu(k,508) = lu(k,508) - lu(k,424) * lu(k,504) + lu(k,509) = lu(k,509) - lu(k,425) * lu(k,504) + lu(k,510) = lu(k,510) - lu(k,426) * lu(k,504) + lu(k,511) = lu(k,511) - lu(k,427) * lu(k,504) + lu(k,512) = lu(k,512) - lu(k,428) * lu(k,504) + lu(k,513) = lu(k,513) - lu(k,429) * lu(k,504) + lu(k,514) = lu(k,514) - lu(k,430) * lu(k,504) + lu(k,515) = lu(k,515) - lu(k,431) * lu(k,504) + lu(k,516) = lu(k,516) - lu(k,432) * lu(k,504) + lu(k,530) = lu(k,530) - lu(k,421) * lu(k,529) + lu(k,531) = lu(k,531) - lu(k,422) * lu(k,529) + lu(k,532) = lu(k,532) - lu(k,423) * lu(k,529) + lu(k,533) = lu(k,533) - lu(k,424) * lu(k,529) + lu(k,534) = lu(k,534) - lu(k,425) * lu(k,529) + lu(k,535) = lu(k,535) - lu(k,426) * lu(k,529) + lu(k,536) = lu(k,536) - lu(k,427) * lu(k,529) + lu(k,537) = lu(k,537) - lu(k,428) * lu(k,529) + lu(k,538) = lu(k,538) - lu(k,429) * lu(k,529) + lu(k,539) = lu(k,539) - lu(k,430) * lu(k,529) + lu(k,540) = lu(k,540) - lu(k,431) * lu(k,529) + lu(k,541) = lu(k,541) - lu(k,432) * lu(k,529) + lu(k,552) = lu(k,552) - lu(k,421) * lu(k,551) + lu(k,553) = lu(k,553) - lu(k,422) * lu(k,551) + lu(k,554) = lu(k,554) - lu(k,423) * lu(k,551) + lu(k,555) = lu(k,555) - lu(k,424) * lu(k,551) + lu(k,556) = lu(k,556) - lu(k,425) * lu(k,551) + lu(k,557) = lu(k,557) - lu(k,426) * lu(k,551) + lu(k,558) = lu(k,558) - lu(k,427) * lu(k,551) + lu(k,559) = lu(k,559) - lu(k,428) * lu(k,551) + lu(k,560) = lu(k,560) - lu(k,429) * lu(k,551) + lu(k,561) = lu(k,561) - lu(k,430) * lu(k,551) + lu(k,562) = lu(k,562) - lu(k,431) * lu(k,551) + lu(k,563) = lu(k,563) - lu(k,432) * lu(k,551) + lu(k,574) = lu(k,574) - lu(k,421) * lu(k,573) + lu(k,575) = lu(k,575) - lu(k,422) * lu(k,573) + lu(k,576) = lu(k,576) - lu(k,423) * lu(k,573) + lu(k,577) = lu(k,577) - lu(k,424) * lu(k,573) + lu(k,578) = lu(k,578) - lu(k,425) * lu(k,573) + lu(k,579) = lu(k,579) - lu(k,426) * lu(k,573) + lu(k,580) = lu(k,580) - lu(k,427) * lu(k,573) + lu(k,581) = lu(k,581) - lu(k,428) * lu(k,573) + lu(k,582) = lu(k,582) - lu(k,429) * lu(k,573) + lu(k,583) = lu(k,583) - lu(k,430) * lu(k,573) + lu(k,584) = lu(k,584) - lu(k,431) * lu(k,573) + lu(k,585) = lu(k,585) - lu(k,432) * lu(k,573) + lu(k,602) = lu(k,602) - lu(k,421) * lu(k,601) + lu(k,603) = lu(k,603) - lu(k,422) * lu(k,601) + lu(k,604) = lu(k,604) - lu(k,423) * lu(k,601) + lu(k,605) = lu(k,605) - lu(k,424) * lu(k,601) + lu(k,606) = lu(k,606) - lu(k,425) * lu(k,601) + lu(k,607) = lu(k,607) - lu(k,426) * lu(k,601) + lu(k,608) = lu(k,608) - lu(k,427) * lu(k,601) + lu(k,609) = lu(k,609) - lu(k,428) * lu(k,601) + lu(k,610) = lu(k,610) - lu(k,429) * lu(k,601) + lu(k,611) = lu(k,611) - lu(k,430) * lu(k,601) + lu(k,612) = lu(k,612) - lu(k,431) * lu(k,601) + lu(k,613) = lu(k,613) - lu(k,432) * lu(k,601) + lu(k,639) = lu(k,639) - lu(k,421) * lu(k,638) + lu(k,640) = lu(k,640) - lu(k,422) * lu(k,638) + lu(k,641) = lu(k,641) - lu(k,423) * lu(k,638) + lu(k,642) = lu(k,642) - lu(k,424) * lu(k,638) + lu(k,643) = lu(k,643) - lu(k,425) * lu(k,638) + lu(k,644) = lu(k,644) - lu(k,426) * lu(k,638) + lu(k,645) = lu(k,645) - lu(k,427) * lu(k,638) + lu(k,646) = lu(k,646) - lu(k,428) * lu(k,638) + lu(k,647) = lu(k,647) - lu(k,429) * lu(k,638) + lu(k,648) = lu(k,648) - lu(k,430) * lu(k,638) + lu(k,649) = lu(k,649) - lu(k,431) * lu(k,638) + lu(k,650) = lu(k,650) - lu(k,432) * lu(k,638) + lu(k,662) = lu(k,662) - lu(k,421) * lu(k,661) + lu(k,663) = lu(k,663) - lu(k,422) * lu(k,661) + lu(k,664) = lu(k,664) - lu(k,423) * lu(k,661) + lu(k,665) = lu(k,665) - lu(k,424) * lu(k,661) + lu(k,666) = lu(k,666) - lu(k,425) * lu(k,661) + lu(k,667) = lu(k,667) - lu(k,426) * lu(k,661) + lu(k,668) = lu(k,668) - lu(k,427) * lu(k,661) + lu(k,669) = lu(k,669) - lu(k,428) * lu(k,661) + lu(k,670) = lu(k,670) - lu(k,429) * lu(k,661) + lu(k,671) = lu(k,671) - lu(k,430) * lu(k,661) + lu(k,672) = lu(k,672) - lu(k,431) * lu(k,661) + lu(k,673) = lu(k,673) - lu(k,432) * lu(k,661) + lu(k,683) = lu(k,683) - lu(k,421) * lu(k,682) + lu(k,684) = lu(k,684) - lu(k,422) * lu(k,682) + lu(k,685) = lu(k,685) - lu(k,423) * lu(k,682) + lu(k,686) = lu(k,686) - lu(k,424) * lu(k,682) + lu(k,687) = lu(k,687) - lu(k,425) * lu(k,682) + lu(k,688) = lu(k,688) - lu(k,426) * lu(k,682) + lu(k,689) = lu(k,689) - lu(k,427) * lu(k,682) + lu(k,690) = lu(k,690) - lu(k,428) * lu(k,682) + lu(k,691) = lu(k,691) - lu(k,429) * lu(k,682) + lu(k,692) = lu(k,692) - lu(k,430) * lu(k,682) + lu(k,693) = lu(k,693) - lu(k,431) * lu(k,682) + lu(k,694) = lu(k,694) - lu(k,432) * lu(k,682) + lu(k,709) = lu(k,709) - lu(k,421) * lu(k,708) + lu(k,710) = lu(k,710) - lu(k,422) * lu(k,708) + lu(k,711) = lu(k,711) - lu(k,423) * lu(k,708) + lu(k,712) = lu(k,712) - lu(k,424) * lu(k,708) + lu(k,713) = lu(k,713) - lu(k,425) * lu(k,708) + lu(k,714) = lu(k,714) - lu(k,426) * lu(k,708) + lu(k,715) = lu(k,715) - lu(k,427) * lu(k,708) + lu(k,716) = lu(k,716) - lu(k,428) * lu(k,708) + lu(k,717) = lu(k,717) - lu(k,429) * lu(k,708) + lu(k,718) = lu(k,718) - lu(k,430) * lu(k,708) + lu(k,719) = lu(k,719) - lu(k,431) * lu(k,708) + lu(k,720) = lu(k,720) - lu(k,432) * lu(k,708) + lu(k,734) = lu(k,734) - lu(k,421) * lu(k,733) + lu(k,735) = lu(k,735) - lu(k,422) * lu(k,733) + lu(k,736) = lu(k,736) - lu(k,423) * lu(k,733) + lu(k,737) = lu(k,737) - lu(k,424) * lu(k,733) + lu(k,738) = lu(k,738) - lu(k,425) * lu(k,733) + lu(k,739) = lu(k,739) - lu(k,426) * lu(k,733) + lu(k,740) = lu(k,740) - lu(k,427) * lu(k,733) + lu(k,741) = lu(k,741) - lu(k,428) * lu(k,733) + lu(k,742) = lu(k,742) - lu(k,429) * lu(k,733) + lu(k,743) = lu(k,743) - lu(k,430) * lu(k,733) + lu(k,744) = lu(k,744) - lu(k,431) * lu(k,733) + lu(k,745) = lu(k,745) - lu(k,432) * lu(k,733) + end do + end subroutine lu_fac08 + subroutine lu_fac09( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,449) = 1._r8 / lu(k,449) + lu(k,450) = lu(k,450) * lu(k,449) + lu(k,451) = lu(k,451) * lu(k,449) + lu(k,452) = lu(k,452) * lu(k,449) + lu(k,453) = lu(k,453) * lu(k,449) + lu(k,454) = lu(k,454) * lu(k,449) + lu(k,455) = lu(k,455) * lu(k,449) + lu(k,456) = lu(k,456) * lu(k,449) + lu(k,457) = lu(k,457) * lu(k,449) + lu(k,458) = lu(k,458) * lu(k,449) + lu(k,459) = lu(k,459) * lu(k,449) + lu(k,460) = lu(k,460) * lu(k,449) + lu(k,475) = lu(k,475) - lu(k,450) * lu(k,474) + lu(k,476) = lu(k,476) - lu(k,451) * lu(k,474) + lu(k,477) = lu(k,477) - lu(k,452) * lu(k,474) + lu(k,478) = lu(k,478) - lu(k,453) * lu(k,474) + lu(k,479) = lu(k,479) - lu(k,454) * lu(k,474) + lu(k,480) = lu(k,480) - lu(k,455) * lu(k,474) + lu(k,481) = lu(k,481) - lu(k,456) * lu(k,474) + lu(k,482) = lu(k,482) - lu(k,457) * lu(k,474) + lu(k,483) = lu(k,483) - lu(k,458) * lu(k,474) + lu(k,484) = lu(k,484) - lu(k,459) * lu(k,474) + lu(k,485) = lu(k,485) - lu(k,460) * lu(k,474) + lu(k,506) = lu(k,506) - lu(k,450) * lu(k,505) + lu(k,507) = lu(k,507) - lu(k,451) * lu(k,505) + lu(k,508) = lu(k,508) - lu(k,452) * lu(k,505) + lu(k,509) = lu(k,509) - lu(k,453) * lu(k,505) + lu(k,510) = lu(k,510) - lu(k,454) * lu(k,505) + lu(k,511) = lu(k,511) - lu(k,455) * lu(k,505) + lu(k,512) = lu(k,512) - lu(k,456) * lu(k,505) + lu(k,513) = lu(k,513) - lu(k,457) * lu(k,505) + lu(k,514) = lu(k,514) - lu(k,458) * lu(k,505) + lu(k,515) = lu(k,515) - lu(k,459) * lu(k,505) + lu(k,516) = lu(k,516) - lu(k,460) * lu(k,505) + lu(k,531) = lu(k,531) - lu(k,450) * lu(k,530) + lu(k,532) = lu(k,532) - lu(k,451) * lu(k,530) + lu(k,533) = lu(k,533) - lu(k,452) * lu(k,530) + lu(k,534) = lu(k,534) - lu(k,453) * lu(k,530) + lu(k,535) = lu(k,535) - lu(k,454) * lu(k,530) + lu(k,536) = lu(k,536) - lu(k,455) * lu(k,530) + lu(k,537) = lu(k,537) - lu(k,456) * lu(k,530) + lu(k,538) = lu(k,538) - lu(k,457) * lu(k,530) + lu(k,539) = lu(k,539) - lu(k,458) * lu(k,530) + lu(k,540) = lu(k,540) - lu(k,459) * lu(k,530) + lu(k,541) = lu(k,541) - lu(k,460) * lu(k,530) + lu(k,553) = lu(k,553) - lu(k,450) * lu(k,552) + lu(k,554) = lu(k,554) - lu(k,451) * lu(k,552) + lu(k,555) = lu(k,555) - lu(k,452) * lu(k,552) + lu(k,556) = lu(k,556) - lu(k,453) * lu(k,552) + lu(k,557) = lu(k,557) - lu(k,454) * lu(k,552) + lu(k,558) = lu(k,558) - lu(k,455) * lu(k,552) + lu(k,559) = lu(k,559) - lu(k,456) * lu(k,552) + lu(k,560) = lu(k,560) - lu(k,457) * lu(k,552) + lu(k,561) = lu(k,561) - lu(k,458) * lu(k,552) + lu(k,562) = lu(k,562) - lu(k,459) * lu(k,552) + lu(k,563) = lu(k,563) - lu(k,460) * lu(k,552) + lu(k,575) = lu(k,575) - lu(k,450) * lu(k,574) + lu(k,576) = lu(k,576) - lu(k,451) * lu(k,574) + lu(k,577) = lu(k,577) - lu(k,452) * lu(k,574) + lu(k,578) = lu(k,578) - lu(k,453) * lu(k,574) + lu(k,579) = lu(k,579) - lu(k,454) * lu(k,574) + lu(k,580) = lu(k,580) - lu(k,455) * lu(k,574) + lu(k,581) = lu(k,581) - lu(k,456) * lu(k,574) + lu(k,582) = lu(k,582) - lu(k,457) * lu(k,574) + lu(k,583) = lu(k,583) - lu(k,458) * lu(k,574) + lu(k,584) = lu(k,584) - lu(k,459) * lu(k,574) + lu(k,585) = lu(k,585) - lu(k,460) * lu(k,574) + lu(k,603) = lu(k,603) - lu(k,450) * lu(k,602) + lu(k,604) = lu(k,604) - lu(k,451) * lu(k,602) + lu(k,605) = lu(k,605) - lu(k,452) * lu(k,602) + lu(k,606) = lu(k,606) - lu(k,453) * lu(k,602) + lu(k,607) = lu(k,607) - lu(k,454) * lu(k,602) + lu(k,608) = lu(k,608) - lu(k,455) * lu(k,602) + lu(k,609) = lu(k,609) - lu(k,456) * lu(k,602) + lu(k,610) = lu(k,610) - lu(k,457) * lu(k,602) + lu(k,611) = lu(k,611) - lu(k,458) * lu(k,602) + lu(k,612) = lu(k,612) - lu(k,459) * lu(k,602) + lu(k,613) = lu(k,613) - lu(k,460) * lu(k,602) + lu(k,640) = lu(k,640) - lu(k,450) * lu(k,639) + lu(k,641) = lu(k,641) - lu(k,451) * lu(k,639) + lu(k,642) = lu(k,642) - lu(k,452) * lu(k,639) + lu(k,643) = lu(k,643) - lu(k,453) * lu(k,639) + lu(k,644) = lu(k,644) - lu(k,454) * lu(k,639) + lu(k,645) = lu(k,645) - lu(k,455) * lu(k,639) + lu(k,646) = lu(k,646) - lu(k,456) * lu(k,639) + lu(k,647) = lu(k,647) - lu(k,457) * lu(k,639) + lu(k,648) = lu(k,648) - lu(k,458) * lu(k,639) + lu(k,649) = lu(k,649) - lu(k,459) * lu(k,639) + lu(k,650) = lu(k,650) - lu(k,460) * lu(k,639) + lu(k,663) = lu(k,663) - lu(k,450) * lu(k,662) + lu(k,664) = lu(k,664) - lu(k,451) * lu(k,662) + lu(k,665) = lu(k,665) - lu(k,452) * lu(k,662) + lu(k,666) = lu(k,666) - lu(k,453) * lu(k,662) + lu(k,667) = lu(k,667) - lu(k,454) * lu(k,662) + lu(k,668) = lu(k,668) - lu(k,455) * lu(k,662) + lu(k,669) = lu(k,669) - lu(k,456) * lu(k,662) + lu(k,670) = lu(k,670) - lu(k,457) * lu(k,662) + lu(k,671) = lu(k,671) - lu(k,458) * lu(k,662) + lu(k,672) = lu(k,672) - lu(k,459) * lu(k,662) + lu(k,673) = lu(k,673) - lu(k,460) * lu(k,662) + lu(k,684) = lu(k,684) - lu(k,450) * lu(k,683) + lu(k,685) = lu(k,685) - lu(k,451) * lu(k,683) + lu(k,686) = lu(k,686) - lu(k,452) * lu(k,683) + lu(k,687) = lu(k,687) - lu(k,453) * lu(k,683) + lu(k,688) = lu(k,688) - lu(k,454) * lu(k,683) + lu(k,689) = lu(k,689) - lu(k,455) * lu(k,683) + lu(k,690) = lu(k,690) - lu(k,456) * lu(k,683) + lu(k,691) = lu(k,691) - lu(k,457) * lu(k,683) + lu(k,692) = lu(k,692) - lu(k,458) * lu(k,683) + lu(k,693) = lu(k,693) - lu(k,459) * lu(k,683) + lu(k,694) = lu(k,694) - lu(k,460) * lu(k,683) + lu(k,710) = lu(k,710) - lu(k,450) * lu(k,709) + lu(k,711) = lu(k,711) - lu(k,451) * lu(k,709) + lu(k,712) = lu(k,712) - lu(k,452) * lu(k,709) + lu(k,713) = lu(k,713) - lu(k,453) * lu(k,709) + lu(k,714) = lu(k,714) - lu(k,454) * lu(k,709) + lu(k,715) = lu(k,715) - lu(k,455) * lu(k,709) + lu(k,716) = lu(k,716) - lu(k,456) * lu(k,709) + lu(k,717) = lu(k,717) - lu(k,457) * lu(k,709) + lu(k,718) = lu(k,718) - lu(k,458) * lu(k,709) + lu(k,719) = lu(k,719) - lu(k,459) * lu(k,709) + lu(k,720) = lu(k,720) - lu(k,460) * lu(k,709) + lu(k,735) = lu(k,735) - lu(k,450) * lu(k,734) + lu(k,736) = lu(k,736) - lu(k,451) * lu(k,734) + lu(k,737) = lu(k,737) - lu(k,452) * lu(k,734) + lu(k,738) = lu(k,738) - lu(k,453) * lu(k,734) + lu(k,739) = lu(k,739) - lu(k,454) * lu(k,734) + lu(k,740) = lu(k,740) - lu(k,455) * lu(k,734) + lu(k,741) = lu(k,741) - lu(k,456) * lu(k,734) + lu(k,742) = lu(k,742) - lu(k,457) * lu(k,734) + lu(k,743) = lu(k,743) - lu(k,458) * lu(k,734) + lu(k,744) = lu(k,744) - lu(k,459) * lu(k,734) + lu(k,745) = lu(k,745) - lu(k,460) * lu(k,734) + lu(k,475) = 1._r8 / lu(k,475) + lu(k,476) = lu(k,476) * lu(k,475) + lu(k,477) = lu(k,477) * lu(k,475) + lu(k,478) = lu(k,478) * lu(k,475) + lu(k,479) = lu(k,479) * lu(k,475) + lu(k,480) = lu(k,480) * lu(k,475) + lu(k,481) = lu(k,481) * lu(k,475) + lu(k,482) = lu(k,482) * lu(k,475) + lu(k,483) = lu(k,483) * lu(k,475) + lu(k,484) = lu(k,484) * lu(k,475) + lu(k,485) = lu(k,485) * lu(k,475) + lu(k,507) = lu(k,507) - lu(k,476) * lu(k,506) + lu(k,508) = lu(k,508) - lu(k,477) * lu(k,506) + lu(k,509) = lu(k,509) - lu(k,478) * lu(k,506) + lu(k,510) = lu(k,510) - lu(k,479) * lu(k,506) + lu(k,511) = lu(k,511) - lu(k,480) * lu(k,506) + lu(k,512) = lu(k,512) - lu(k,481) * lu(k,506) + lu(k,513) = lu(k,513) - lu(k,482) * lu(k,506) + lu(k,514) = lu(k,514) - lu(k,483) * lu(k,506) + lu(k,515) = lu(k,515) - lu(k,484) * lu(k,506) + lu(k,516) = lu(k,516) - lu(k,485) * lu(k,506) + lu(k,532) = lu(k,532) - lu(k,476) * lu(k,531) + lu(k,533) = lu(k,533) - lu(k,477) * lu(k,531) + lu(k,534) = lu(k,534) - lu(k,478) * lu(k,531) + lu(k,535) = lu(k,535) - lu(k,479) * lu(k,531) + lu(k,536) = lu(k,536) - lu(k,480) * lu(k,531) + lu(k,537) = lu(k,537) - lu(k,481) * lu(k,531) + lu(k,538) = lu(k,538) - lu(k,482) * lu(k,531) + lu(k,539) = lu(k,539) - lu(k,483) * lu(k,531) + lu(k,540) = lu(k,540) - lu(k,484) * lu(k,531) + lu(k,541) = lu(k,541) - lu(k,485) * lu(k,531) + lu(k,554) = lu(k,554) - lu(k,476) * lu(k,553) + lu(k,555) = lu(k,555) - lu(k,477) * lu(k,553) + lu(k,556) = lu(k,556) - lu(k,478) * lu(k,553) + lu(k,557) = lu(k,557) - lu(k,479) * lu(k,553) + lu(k,558) = lu(k,558) - lu(k,480) * lu(k,553) + lu(k,559) = lu(k,559) - lu(k,481) * lu(k,553) + lu(k,560) = lu(k,560) - lu(k,482) * lu(k,553) + lu(k,561) = lu(k,561) - lu(k,483) * lu(k,553) + lu(k,562) = lu(k,562) - lu(k,484) * lu(k,553) + lu(k,563) = lu(k,563) - lu(k,485) * lu(k,553) + lu(k,576) = lu(k,576) - lu(k,476) * lu(k,575) + lu(k,577) = lu(k,577) - lu(k,477) * lu(k,575) + lu(k,578) = lu(k,578) - lu(k,478) * lu(k,575) + lu(k,579) = lu(k,579) - lu(k,479) * lu(k,575) + lu(k,580) = lu(k,580) - lu(k,480) * lu(k,575) + lu(k,581) = lu(k,581) - lu(k,481) * lu(k,575) + lu(k,582) = lu(k,582) - lu(k,482) * lu(k,575) + lu(k,583) = lu(k,583) - lu(k,483) * lu(k,575) + lu(k,584) = lu(k,584) - lu(k,484) * lu(k,575) + lu(k,585) = lu(k,585) - lu(k,485) * lu(k,575) + lu(k,604) = lu(k,604) - lu(k,476) * lu(k,603) + lu(k,605) = lu(k,605) - lu(k,477) * lu(k,603) + lu(k,606) = lu(k,606) - lu(k,478) * lu(k,603) + lu(k,607) = lu(k,607) - lu(k,479) * lu(k,603) + lu(k,608) = lu(k,608) - lu(k,480) * lu(k,603) + lu(k,609) = lu(k,609) - lu(k,481) * lu(k,603) + lu(k,610) = lu(k,610) - lu(k,482) * lu(k,603) + lu(k,611) = lu(k,611) - lu(k,483) * lu(k,603) + lu(k,612) = lu(k,612) - lu(k,484) * lu(k,603) + lu(k,613) = lu(k,613) - lu(k,485) * lu(k,603) + lu(k,641) = lu(k,641) - lu(k,476) * lu(k,640) + lu(k,642) = lu(k,642) - lu(k,477) * lu(k,640) + lu(k,643) = lu(k,643) - lu(k,478) * lu(k,640) + lu(k,644) = lu(k,644) - lu(k,479) * lu(k,640) + lu(k,645) = lu(k,645) - lu(k,480) * lu(k,640) + lu(k,646) = lu(k,646) - lu(k,481) * lu(k,640) + lu(k,647) = lu(k,647) - lu(k,482) * lu(k,640) + lu(k,648) = lu(k,648) - lu(k,483) * lu(k,640) + lu(k,649) = lu(k,649) - lu(k,484) * lu(k,640) + lu(k,650) = lu(k,650) - lu(k,485) * lu(k,640) + lu(k,664) = lu(k,664) - lu(k,476) * lu(k,663) + lu(k,665) = lu(k,665) - lu(k,477) * lu(k,663) + lu(k,666) = lu(k,666) - lu(k,478) * lu(k,663) + lu(k,667) = lu(k,667) - lu(k,479) * lu(k,663) + lu(k,668) = lu(k,668) - lu(k,480) * lu(k,663) + lu(k,669) = lu(k,669) - lu(k,481) * lu(k,663) + lu(k,670) = lu(k,670) - lu(k,482) * lu(k,663) + lu(k,671) = lu(k,671) - lu(k,483) * lu(k,663) + lu(k,672) = lu(k,672) - lu(k,484) * lu(k,663) + lu(k,673) = lu(k,673) - lu(k,485) * lu(k,663) + lu(k,685) = lu(k,685) - lu(k,476) * lu(k,684) + lu(k,686) = lu(k,686) - lu(k,477) * lu(k,684) + lu(k,687) = lu(k,687) - lu(k,478) * lu(k,684) + lu(k,688) = lu(k,688) - lu(k,479) * lu(k,684) + lu(k,689) = lu(k,689) - lu(k,480) * lu(k,684) + lu(k,690) = lu(k,690) - lu(k,481) * lu(k,684) + lu(k,691) = lu(k,691) - lu(k,482) * lu(k,684) + lu(k,692) = lu(k,692) - lu(k,483) * lu(k,684) + lu(k,693) = lu(k,693) - lu(k,484) * lu(k,684) + lu(k,694) = lu(k,694) - lu(k,485) * lu(k,684) + lu(k,711) = lu(k,711) - lu(k,476) * lu(k,710) + lu(k,712) = lu(k,712) - lu(k,477) * lu(k,710) + lu(k,713) = lu(k,713) - lu(k,478) * lu(k,710) + lu(k,714) = lu(k,714) - lu(k,479) * lu(k,710) + lu(k,715) = lu(k,715) - lu(k,480) * lu(k,710) + lu(k,716) = lu(k,716) - lu(k,481) * lu(k,710) + lu(k,717) = lu(k,717) - lu(k,482) * lu(k,710) + lu(k,718) = lu(k,718) - lu(k,483) * lu(k,710) + lu(k,719) = lu(k,719) - lu(k,484) * lu(k,710) + lu(k,720) = lu(k,720) - lu(k,485) * lu(k,710) + lu(k,736) = lu(k,736) - lu(k,476) * lu(k,735) + lu(k,737) = lu(k,737) - lu(k,477) * lu(k,735) + lu(k,738) = lu(k,738) - lu(k,478) * lu(k,735) + lu(k,739) = lu(k,739) - lu(k,479) * lu(k,735) + lu(k,740) = lu(k,740) - lu(k,480) * lu(k,735) + lu(k,741) = lu(k,741) - lu(k,481) * lu(k,735) + lu(k,742) = lu(k,742) - lu(k,482) * lu(k,735) + lu(k,743) = lu(k,743) - lu(k,483) * lu(k,735) + lu(k,744) = lu(k,744) - lu(k,484) * lu(k,735) + lu(k,745) = lu(k,745) - lu(k,485) * lu(k,735) + lu(k,507) = 1._r8 / lu(k,507) + lu(k,508) = lu(k,508) * lu(k,507) + lu(k,509) = lu(k,509) * lu(k,507) + lu(k,510) = lu(k,510) * lu(k,507) + lu(k,511) = lu(k,511) * lu(k,507) + lu(k,512) = lu(k,512) * lu(k,507) + lu(k,513) = lu(k,513) * lu(k,507) + lu(k,514) = lu(k,514) * lu(k,507) + lu(k,515) = lu(k,515) * lu(k,507) + lu(k,516) = lu(k,516) * lu(k,507) + lu(k,533) = lu(k,533) - lu(k,508) * lu(k,532) + lu(k,534) = lu(k,534) - lu(k,509) * lu(k,532) + lu(k,535) = lu(k,535) - lu(k,510) * lu(k,532) + lu(k,536) = lu(k,536) - lu(k,511) * lu(k,532) + lu(k,537) = lu(k,537) - lu(k,512) * lu(k,532) + lu(k,538) = lu(k,538) - lu(k,513) * lu(k,532) + lu(k,539) = lu(k,539) - lu(k,514) * lu(k,532) + lu(k,540) = lu(k,540) - lu(k,515) * lu(k,532) + lu(k,541) = lu(k,541) - lu(k,516) * lu(k,532) + lu(k,555) = lu(k,555) - lu(k,508) * lu(k,554) + lu(k,556) = lu(k,556) - lu(k,509) * lu(k,554) + lu(k,557) = lu(k,557) - lu(k,510) * lu(k,554) + lu(k,558) = lu(k,558) - lu(k,511) * lu(k,554) + lu(k,559) = lu(k,559) - lu(k,512) * lu(k,554) + lu(k,560) = lu(k,560) - lu(k,513) * lu(k,554) + lu(k,561) = lu(k,561) - lu(k,514) * lu(k,554) + lu(k,562) = lu(k,562) - lu(k,515) * lu(k,554) + lu(k,563) = lu(k,563) - lu(k,516) * lu(k,554) + lu(k,577) = lu(k,577) - lu(k,508) * lu(k,576) + lu(k,578) = lu(k,578) - lu(k,509) * lu(k,576) + lu(k,579) = lu(k,579) - lu(k,510) * lu(k,576) + lu(k,580) = lu(k,580) - lu(k,511) * lu(k,576) + lu(k,581) = lu(k,581) - lu(k,512) * lu(k,576) + lu(k,582) = lu(k,582) - lu(k,513) * lu(k,576) + lu(k,583) = lu(k,583) - lu(k,514) * lu(k,576) + lu(k,584) = lu(k,584) - lu(k,515) * lu(k,576) + lu(k,585) = lu(k,585) - lu(k,516) * lu(k,576) + lu(k,605) = lu(k,605) - lu(k,508) * lu(k,604) + lu(k,606) = lu(k,606) - lu(k,509) * lu(k,604) + lu(k,607) = lu(k,607) - lu(k,510) * lu(k,604) + lu(k,608) = lu(k,608) - lu(k,511) * lu(k,604) + lu(k,609) = lu(k,609) - lu(k,512) * lu(k,604) + lu(k,610) = lu(k,610) - lu(k,513) * lu(k,604) + lu(k,611) = lu(k,611) - lu(k,514) * lu(k,604) + lu(k,612) = lu(k,612) - lu(k,515) * lu(k,604) + lu(k,613) = lu(k,613) - lu(k,516) * lu(k,604) + lu(k,642) = lu(k,642) - lu(k,508) * lu(k,641) + lu(k,643) = lu(k,643) - lu(k,509) * lu(k,641) + lu(k,644) = lu(k,644) - lu(k,510) * lu(k,641) + lu(k,645) = lu(k,645) - lu(k,511) * lu(k,641) + lu(k,646) = lu(k,646) - lu(k,512) * lu(k,641) + lu(k,647) = lu(k,647) - lu(k,513) * lu(k,641) + lu(k,648) = lu(k,648) - lu(k,514) * lu(k,641) + lu(k,649) = lu(k,649) - lu(k,515) * lu(k,641) + lu(k,650) = lu(k,650) - lu(k,516) * lu(k,641) + lu(k,665) = lu(k,665) - lu(k,508) * lu(k,664) + lu(k,666) = lu(k,666) - lu(k,509) * lu(k,664) + lu(k,667) = lu(k,667) - lu(k,510) * lu(k,664) + lu(k,668) = lu(k,668) - lu(k,511) * lu(k,664) + lu(k,669) = lu(k,669) - lu(k,512) * lu(k,664) + lu(k,670) = lu(k,670) - lu(k,513) * lu(k,664) + lu(k,671) = lu(k,671) - lu(k,514) * lu(k,664) + lu(k,672) = lu(k,672) - lu(k,515) * lu(k,664) + lu(k,673) = lu(k,673) - lu(k,516) * lu(k,664) + lu(k,686) = lu(k,686) - lu(k,508) * lu(k,685) + lu(k,687) = lu(k,687) - lu(k,509) * lu(k,685) + lu(k,688) = lu(k,688) - lu(k,510) * lu(k,685) + lu(k,689) = lu(k,689) - lu(k,511) * lu(k,685) + lu(k,690) = lu(k,690) - lu(k,512) * lu(k,685) + lu(k,691) = lu(k,691) - lu(k,513) * lu(k,685) + lu(k,692) = lu(k,692) - lu(k,514) * lu(k,685) + lu(k,693) = lu(k,693) - lu(k,515) * lu(k,685) + lu(k,694) = lu(k,694) - lu(k,516) * lu(k,685) + lu(k,712) = lu(k,712) - lu(k,508) * lu(k,711) + lu(k,713) = lu(k,713) - lu(k,509) * lu(k,711) + lu(k,714) = lu(k,714) - lu(k,510) * lu(k,711) + lu(k,715) = lu(k,715) - lu(k,511) * lu(k,711) + lu(k,716) = lu(k,716) - lu(k,512) * lu(k,711) + lu(k,717) = lu(k,717) - lu(k,513) * lu(k,711) + lu(k,718) = lu(k,718) - lu(k,514) * lu(k,711) + lu(k,719) = lu(k,719) - lu(k,515) * lu(k,711) + lu(k,720) = lu(k,720) - lu(k,516) * lu(k,711) + lu(k,737) = lu(k,737) - lu(k,508) * lu(k,736) + lu(k,738) = lu(k,738) - lu(k,509) * lu(k,736) + lu(k,739) = lu(k,739) - lu(k,510) * lu(k,736) + lu(k,740) = lu(k,740) - lu(k,511) * lu(k,736) + lu(k,741) = lu(k,741) - lu(k,512) * lu(k,736) + lu(k,742) = lu(k,742) - lu(k,513) * lu(k,736) + lu(k,743) = lu(k,743) - lu(k,514) * lu(k,736) + lu(k,744) = lu(k,744) - lu(k,515) * lu(k,736) + lu(k,745) = lu(k,745) - lu(k,516) * lu(k,736) + lu(k,533) = 1._r8 / lu(k,533) + lu(k,534) = lu(k,534) * lu(k,533) + lu(k,535) = lu(k,535) * lu(k,533) + lu(k,536) = lu(k,536) * lu(k,533) + lu(k,537) = lu(k,537) * lu(k,533) + lu(k,538) = lu(k,538) * lu(k,533) + lu(k,539) = lu(k,539) * lu(k,533) + lu(k,540) = lu(k,540) * lu(k,533) + lu(k,541) = lu(k,541) * lu(k,533) + lu(k,556) = lu(k,556) - lu(k,534) * lu(k,555) + lu(k,557) = lu(k,557) - lu(k,535) * lu(k,555) + lu(k,558) = lu(k,558) - lu(k,536) * lu(k,555) + lu(k,559) = lu(k,559) - lu(k,537) * lu(k,555) + lu(k,560) = lu(k,560) - lu(k,538) * lu(k,555) + lu(k,561) = lu(k,561) - lu(k,539) * lu(k,555) + lu(k,562) = lu(k,562) - lu(k,540) * lu(k,555) + lu(k,563) = lu(k,563) - lu(k,541) * lu(k,555) + lu(k,578) = lu(k,578) - lu(k,534) * lu(k,577) + lu(k,579) = lu(k,579) - lu(k,535) * lu(k,577) + lu(k,580) = lu(k,580) - lu(k,536) * lu(k,577) + lu(k,581) = lu(k,581) - lu(k,537) * lu(k,577) + lu(k,582) = lu(k,582) - lu(k,538) * lu(k,577) + lu(k,583) = lu(k,583) - lu(k,539) * lu(k,577) + lu(k,584) = lu(k,584) - lu(k,540) * lu(k,577) + lu(k,585) = lu(k,585) - lu(k,541) * lu(k,577) + lu(k,606) = lu(k,606) - lu(k,534) * lu(k,605) + lu(k,607) = lu(k,607) - lu(k,535) * lu(k,605) + lu(k,608) = lu(k,608) - lu(k,536) * lu(k,605) + lu(k,609) = lu(k,609) - lu(k,537) * lu(k,605) + lu(k,610) = lu(k,610) - lu(k,538) * lu(k,605) + lu(k,611) = lu(k,611) - lu(k,539) * lu(k,605) + lu(k,612) = lu(k,612) - lu(k,540) * lu(k,605) + lu(k,613) = lu(k,613) - lu(k,541) * lu(k,605) + lu(k,643) = lu(k,643) - lu(k,534) * lu(k,642) + lu(k,644) = lu(k,644) - lu(k,535) * lu(k,642) + lu(k,645) = lu(k,645) - lu(k,536) * lu(k,642) + lu(k,646) = lu(k,646) - lu(k,537) * lu(k,642) + lu(k,647) = lu(k,647) - lu(k,538) * lu(k,642) + lu(k,648) = lu(k,648) - lu(k,539) * lu(k,642) + lu(k,649) = lu(k,649) - lu(k,540) * lu(k,642) + lu(k,650) = lu(k,650) - lu(k,541) * lu(k,642) + lu(k,666) = lu(k,666) - lu(k,534) * lu(k,665) + lu(k,667) = lu(k,667) - lu(k,535) * lu(k,665) + lu(k,668) = lu(k,668) - lu(k,536) * lu(k,665) + lu(k,669) = lu(k,669) - lu(k,537) * lu(k,665) + lu(k,670) = lu(k,670) - lu(k,538) * lu(k,665) + lu(k,671) = lu(k,671) - lu(k,539) * lu(k,665) + lu(k,672) = lu(k,672) - lu(k,540) * lu(k,665) + lu(k,673) = lu(k,673) - lu(k,541) * lu(k,665) + lu(k,687) = lu(k,687) - lu(k,534) * lu(k,686) + lu(k,688) = lu(k,688) - lu(k,535) * lu(k,686) + lu(k,689) = lu(k,689) - lu(k,536) * lu(k,686) + lu(k,690) = lu(k,690) - lu(k,537) * lu(k,686) + lu(k,691) = lu(k,691) - lu(k,538) * lu(k,686) + lu(k,692) = lu(k,692) - lu(k,539) * lu(k,686) + lu(k,693) = lu(k,693) - lu(k,540) * lu(k,686) + lu(k,694) = lu(k,694) - lu(k,541) * lu(k,686) + lu(k,713) = lu(k,713) - lu(k,534) * lu(k,712) + lu(k,714) = lu(k,714) - lu(k,535) * lu(k,712) + lu(k,715) = lu(k,715) - lu(k,536) * lu(k,712) + lu(k,716) = lu(k,716) - lu(k,537) * lu(k,712) + lu(k,717) = lu(k,717) - lu(k,538) * lu(k,712) + lu(k,718) = lu(k,718) - lu(k,539) * lu(k,712) + lu(k,719) = lu(k,719) - lu(k,540) * lu(k,712) + lu(k,720) = lu(k,720) - lu(k,541) * lu(k,712) + lu(k,738) = lu(k,738) - lu(k,534) * lu(k,737) + lu(k,739) = lu(k,739) - lu(k,535) * lu(k,737) + lu(k,740) = lu(k,740) - lu(k,536) * lu(k,737) + lu(k,741) = lu(k,741) - lu(k,537) * lu(k,737) + lu(k,742) = lu(k,742) - lu(k,538) * lu(k,737) + lu(k,743) = lu(k,743) - lu(k,539) * lu(k,737) + lu(k,744) = lu(k,744) - lu(k,540) * lu(k,737) + lu(k,745) = lu(k,745) - lu(k,541) * lu(k,737) + lu(k,556) = 1._r8 / lu(k,556) + lu(k,557) = lu(k,557) * lu(k,556) + lu(k,558) = lu(k,558) * lu(k,556) + lu(k,559) = lu(k,559) * lu(k,556) + lu(k,560) = lu(k,560) * lu(k,556) + lu(k,561) = lu(k,561) * lu(k,556) + lu(k,562) = lu(k,562) * lu(k,556) + lu(k,563) = lu(k,563) * lu(k,556) + lu(k,579) = lu(k,579) - lu(k,557) * lu(k,578) + lu(k,580) = lu(k,580) - lu(k,558) * lu(k,578) + lu(k,581) = lu(k,581) - lu(k,559) * lu(k,578) + lu(k,582) = lu(k,582) - lu(k,560) * lu(k,578) + lu(k,583) = lu(k,583) - lu(k,561) * lu(k,578) + lu(k,584) = lu(k,584) - lu(k,562) * lu(k,578) + lu(k,585) = lu(k,585) - lu(k,563) * lu(k,578) + lu(k,607) = lu(k,607) - lu(k,557) * lu(k,606) + lu(k,608) = lu(k,608) - lu(k,558) * lu(k,606) + lu(k,609) = lu(k,609) - lu(k,559) * lu(k,606) + lu(k,610) = lu(k,610) - lu(k,560) * lu(k,606) + lu(k,611) = lu(k,611) - lu(k,561) * lu(k,606) + lu(k,612) = lu(k,612) - lu(k,562) * lu(k,606) + lu(k,613) = lu(k,613) - lu(k,563) * lu(k,606) + lu(k,644) = lu(k,644) - lu(k,557) * lu(k,643) + lu(k,645) = lu(k,645) - lu(k,558) * lu(k,643) + lu(k,646) = lu(k,646) - lu(k,559) * lu(k,643) + lu(k,647) = lu(k,647) - lu(k,560) * lu(k,643) + lu(k,648) = lu(k,648) - lu(k,561) * lu(k,643) + lu(k,649) = lu(k,649) - lu(k,562) * lu(k,643) + lu(k,650) = lu(k,650) - lu(k,563) * lu(k,643) + lu(k,667) = lu(k,667) - lu(k,557) * lu(k,666) + lu(k,668) = lu(k,668) - lu(k,558) * lu(k,666) + lu(k,669) = lu(k,669) - lu(k,559) * lu(k,666) + lu(k,670) = lu(k,670) - lu(k,560) * lu(k,666) + lu(k,671) = lu(k,671) - lu(k,561) * lu(k,666) + lu(k,672) = lu(k,672) - lu(k,562) * lu(k,666) + lu(k,673) = lu(k,673) - lu(k,563) * lu(k,666) + lu(k,688) = lu(k,688) - lu(k,557) * lu(k,687) + lu(k,689) = lu(k,689) - lu(k,558) * lu(k,687) + lu(k,690) = lu(k,690) - lu(k,559) * lu(k,687) + lu(k,691) = lu(k,691) - lu(k,560) * lu(k,687) + lu(k,692) = lu(k,692) - lu(k,561) * lu(k,687) + lu(k,693) = lu(k,693) - lu(k,562) * lu(k,687) + lu(k,694) = lu(k,694) - lu(k,563) * lu(k,687) + lu(k,714) = lu(k,714) - lu(k,557) * lu(k,713) + lu(k,715) = lu(k,715) - lu(k,558) * lu(k,713) + lu(k,716) = lu(k,716) - lu(k,559) * lu(k,713) + lu(k,717) = lu(k,717) - lu(k,560) * lu(k,713) + lu(k,718) = lu(k,718) - lu(k,561) * lu(k,713) + lu(k,719) = lu(k,719) - lu(k,562) * lu(k,713) + lu(k,720) = lu(k,720) - lu(k,563) * lu(k,713) + lu(k,739) = lu(k,739) - lu(k,557) * lu(k,738) + lu(k,740) = lu(k,740) - lu(k,558) * lu(k,738) + lu(k,741) = lu(k,741) - lu(k,559) * lu(k,738) + lu(k,742) = lu(k,742) - lu(k,560) * lu(k,738) + lu(k,743) = lu(k,743) - lu(k,561) * lu(k,738) + lu(k,744) = lu(k,744) - lu(k,562) * lu(k,738) + lu(k,745) = lu(k,745) - lu(k,563) * lu(k,738) + lu(k,579) = 1._r8 / lu(k,579) + lu(k,580) = lu(k,580) * lu(k,579) + lu(k,581) = lu(k,581) * lu(k,579) + lu(k,582) = lu(k,582) * lu(k,579) + lu(k,583) = lu(k,583) * lu(k,579) + lu(k,584) = lu(k,584) * lu(k,579) + lu(k,585) = lu(k,585) * lu(k,579) + lu(k,608) = lu(k,608) - lu(k,580) * lu(k,607) + lu(k,609) = lu(k,609) - lu(k,581) * lu(k,607) + lu(k,610) = lu(k,610) - lu(k,582) * lu(k,607) + lu(k,611) = lu(k,611) - lu(k,583) * lu(k,607) + lu(k,612) = lu(k,612) - lu(k,584) * lu(k,607) + lu(k,613) = lu(k,613) - lu(k,585) * lu(k,607) + lu(k,645) = lu(k,645) - lu(k,580) * lu(k,644) + lu(k,646) = lu(k,646) - lu(k,581) * lu(k,644) + lu(k,647) = lu(k,647) - lu(k,582) * lu(k,644) + lu(k,648) = lu(k,648) - lu(k,583) * lu(k,644) + lu(k,649) = lu(k,649) - lu(k,584) * lu(k,644) + lu(k,650) = lu(k,650) - lu(k,585) * lu(k,644) + lu(k,668) = lu(k,668) - lu(k,580) * lu(k,667) + lu(k,669) = lu(k,669) - lu(k,581) * lu(k,667) + lu(k,670) = lu(k,670) - lu(k,582) * lu(k,667) + lu(k,671) = lu(k,671) - lu(k,583) * lu(k,667) + lu(k,672) = lu(k,672) - lu(k,584) * lu(k,667) + lu(k,673) = lu(k,673) - lu(k,585) * lu(k,667) + lu(k,689) = lu(k,689) - lu(k,580) * lu(k,688) + lu(k,690) = lu(k,690) - lu(k,581) * lu(k,688) + lu(k,691) = lu(k,691) - lu(k,582) * lu(k,688) + lu(k,692) = lu(k,692) - lu(k,583) * lu(k,688) + lu(k,693) = lu(k,693) - lu(k,584) * lu(k,688) + lu(k,694) = lu(k,694) - lu(k,585) * lu(k,688) + lu(k,715) = lu(k,715) - lu(k,580) * lu(k,714) + lu(k,716) = lu(k,716) - lu(k,581) * lu(k,714) + lu(k,717) = lu(k,717) - lu(k,582) * lu(k,714) + lu(k,718) = lu(k,718) - lu(k,583) * lu(k,714) + lu(k,719) = lu(k,719) - lu(k,584) * lu(k,714) + lu(k,720) = lu(k,720) - lu(k,585) * lu(k,714) + lu(k,740) = lu(k,740) - lu(k,580) * lu(k,739) + lu(k,741) = lu(k,741) - lu(k,581) * lu(k,739) + lu(k,742) = lu(k,742) - lu(k,582) * lu(k,739) + lu(k,743) = lu(k,743) - lu(k,583) * lu(k,739) + lu(k,744) = lu(k,744) - lu(k,584) * lu(k,739) + lu(k,745) = lu(k,745) - lu(k,585) * lu(k,739) + end do + end subroutine lu_fac09 + subroutine lu_fac10( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,608) = 1._r8 / lu(k,608) + lu(k,609) = lu(k,609) * lu(k,608) + lu(k,610) = lu(k,610) * lu(k,608) + lu(k,611) = lu(k,611) * lu(k,608) + lu(k,612) = lu(k,612) * lu(k,608) + lu(k,613) = lu(k,613) * lu(k,608) + lu(k,646) = lu(k,646) - lu(k,609) * lu(k,645) + lu(k,647) = lu(k,647) - lu(k,610) * lu(k,645) + lu(k,648) = lu(k,648) - lu(k,611) * lu(k,645) + lu(k,649) = lu(k,649) - lu(k,612) * lu(k,645) + lu(k,650) = lu(k,650) - lu(k,613) * lu(k,645) + lu(k,669) = lu(k,669) - lu(k,609) * lu(k,668) + lu(k,670) = lu(k,670) - lu(k,610) * lu(k,668) + lu(k,671) = lu(k,671) - lu(k,611) * lu(k,668) + lu(k,672) = lu(k,672) - lu(k,612) * lu(k,668) + lu(k,673) = lu(k,673) - lu(k,613) * lu(k,668) + lu(k,690) = lu(k,690) - lu(k,609) * lu(k,689) + lu(k,691) = lu(k,691) - lu(k,610) * lu(k,689) + lu(k,692) = lu(k,692) - lu(k,611) * lu(k,689) + lu(k,693) = lu(k,693) - lu(k,612) * lu(k,689) + lu(k,694) = lu(k,694) - lu(k,613) * lu(k,689) + lu(k,716) = lu(k,716) - lu(k,609) * lu(k,715) + lu(k,717) = lu(k,717) - lu(k,610) * lu(k,715) + lu(k,718) = lu(k,718) - lu(k,611) * lu(k,715) + lu(k,719) = lu(k,719) - lu(k,612) * lu(k,715) + lu(k,720) = lu(k,720) - lu(k,613) * lu(k,715) + lu(k,741) = lu(k,741) - lu(k,609) * lu(k,740) + lu(k,742) = lu(k,742) - lu(k,610) * lu(k,740) + lu(k,743) = lu(k,743) - lu(k,611) * lu(k,740) + lu(k,744) = lu(k,744) - lu(k,612) * lu(k,740) + lu(k,745) = lu(k,745) - lu(k,613) * lu(k,740) + lu(k,646) = 1._r8 / lu(k,646) + lu(k,647) = lu(k,647) * lu(k,646) + lu(k,648) = lu(k,648) * lu(k,646) + lu(k,649) = lu(k,649) * lu(k,646) + lu(k,650) = lu(k,650) * lu(k,646) + lu(k,670) = lu(k,670) - lu(k,647) * lu(k,669) + lu(k,671) = lu(k,671) - lu(k,648) * lu(k,669) + lu(k,672) = lu(k,672) - lu(k,649) * lu(k,669) + lu(k,673) = lu(k,673) - lu(k,650) * lu(k,669) + lu(k,691) = lu(k,691) - lu(k,647) * lu(k,690) + lu(k,692) = lu(k,692) - lu(k,648) * lu(k,690) + lu(k,693) = lu(k,693) - lu(k,649) * lu(k,690) + lu(k,694) = lu(k,694) - lu(k,650) * lu(k,690) + lu(k,717) = lu(k,717) - lu(k,647) * lu(k,716) + lu(k,718) = lu(k,718) - lu(k,648) * lu(k,716) + lu(k,719) = lu(k,719) - lu(k,649) * lu(k,716) + lu(k,720) = lu(k,720) - lu(k,650) * lu(k,716) + lu(k,742) = lu(k,742) - lu(k,647) * lu(k,741) + lu(k,743) = lu(k,743) - lu(k,648) * lu(k,741) + lu(k,744) = lu(k,744) - lu(k,649) * lu(k,741) + lu(k,745) = lu(k,745) - lu(k,650) * lu(k,741) + lu(k,670) = 1._r8 / lu(k,670) + lu(k,671) = lu(k,671) * lu(k,670) + lu(k,672) = lu(k,672) * lu(k,670) + lu(k,673) = lu(k,673) * lu(k,670) + lu(k,692) = lu(k,692) - lu(k,671) * lu(k,691) + lu(k,693) = lu(k,693) - lu(k,672) * lu(k,691) + lu(k,694) = lu(k,694) - lu(k,673) * lu(k,691) + lu(k,718) = lu(k,718) - lu(k,671) * lu(k,717) + lu(k,719) = lu(k,719) - lu(k,672) * lu(k,717) + lu(k,720) = lu(k,720) - lu(k,673) * lu(k,717) + lu(k,743) = lu(k,743) - lu(k,671) * lu(k,742) + lu(k,744) = lu(k,744) - lu(k,672) * lu(k,742) + lu(k,745) = lu(k,745) - lu(k,673) * lu(k,742) + lu(k,692) = 1._r8 / lu(k,692) + lu(k,693) = lu(k,693) * lu(k,692) + lu(k,694) = lu(k,694) * lu(k,692) + lu(k,719) = lu(k,719) - lu(k,693) * lu(k,718) + lu(k,720) = lu(k,720) - lu(k,694) * lu(k,718) + lu(k,744) = lu(k,744) - lu(k,693) * lu(k,743) + lu(k,745) = lu(k,745) - lu(k,694) * lu(k,743) + lu(k,719) = 1._r8 / lu(k,719) + lu(k,720) = lu(k,720) * lu(k,719) + lu(k,745) = lu(k,745) - lu(k,720) * lu(k,744) + lu(k,745) = 1._r8 / lu(k,745) + end do + end subroutine lu_fac10 + subroutine lu_fac( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) + call lu_fac01( avec_len, lu ) + call lu_fac02( avec_len, lu ) + call lu_fac03( avec_len, lu ) + call lu_fac04( avec_len, lu ) + call lu_fac05( avec_len, lu ) + call lu_fac06( avec_len, lu ) + call lu_fac07( avec_len, lu ) + call lu_fac08( avec_len, lu ) + call lu_fac09( avec_len, lu ) + call lu_fac10( avec_len, lu ) + end subroutine lu_fac + end module mo_lu_factor diff --git a/src/chemistry/pp_waccm_ma_noaero/mo_lu_solve.F90 b/src/chemistry/pp_waccm_ma_noaero/mo_lu_solve.F90 new file mode 100644 index 0000000000..c5ff23fe6e --- /dev/null +++ b/src/chemistry/pp_waccm_ma_noaero/mo_lu_solve.F90 @@ -0,0 +1,849 @@ + module mo_lu_solve + use chem_mods, only: veclen + private + public :: lu_slv + contains + subroutine lu_slv01( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: k +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + do k = 1,avec_len + b(k,47) = b(k,47) - lu(k,3) * b(k,2) + b(k,48) = b(k,48) - lu(k,4) * b(k,2) + b(k,26) = b(k,26) - lu(k,6) * b(k,3) + b(k,50) = b(k,50) - lu(k,7) * b(k,3) + b(k,11) = b(k,11) - lu(k,9) * b(k,4) + b(k,58) = b(k,58) - lu(k,10) * b(k,4) + b(k,49) = b(k,49) - lu(k,12) * b(k,5) + b(k,49) = b(k,49) - lu(k,15) * b(k,6) + b(k,48) = b(k,48) - lu(k,17) * b(k,7) + b(k,26) = b(k,26) - lu(k,19) * b(k,8) + b(k,48) = b(k,48) - lu(k,20) * b(k,8) + b(k,50) = b(k,50) - lu(k,21) * b(k,8) + b(k,41) = b(k,41) - lu(k,23) * b(k,9) + b(k,48) = b(k,48) - lu(k,24) * b(k,9) + b(k,26) = b(k,26) - lu(k,26) * b(k,10) + b(k,40) = b(k,40) - lu(k,27) * b(k,10) + b(k,36) = b(k,36) - lu(k,30) * b(k,11) + b(k,46) = b(k,46) - lu(k,31) * b(k,11) + b(k,58) = b(k,58) - lu(k,32) * b(k,11) + b(k,36) = b(k,36) - lu(k,34) * b(k,12) + b(k,38) = b(k,38) - lu(k,35) * b(k,12) + b(k,44) = b(k,44) - lu(k,36) * b(k,12) + b(k,45) = b(k,45) - lu(k,37) * b(k,12) + b(k,54) = b(k,54) - lu(k,38) * b(k,12) + b(k,38) = b(k,38) - lu(k,40) * b(k,13) + b(k,44) = b(k,44) - lu(k,41) * b(k,13) + b(k,46) = b(k,46) - lu(k,42) * b(k,13) + b(k,53) = b(k,53) - lu(k,43) * b(k,13) + b(k,55) = b(k,55) - lu(k,44) * b(k,13) + b(k,36) = b(k,36) - lu(k,46) * b(k,14) + b(k,39) = b(k,39) - lu(k,47) * b(k,14) + b(k,46) = b(k,46) - lu(k,48) * b(k,14) + b(k,47) = b(k,47) - lu(k,49) * b(k,14) + b(k,21) = b(k,21) - lu(k,51) * b(k,15) + b(k,24) = b(k,24) - lu(k,52) * b(k,15) + b(k,36) = b(k,36) - lu(k,53) * b(k,15) + b(k,39) = b(k,39) - lu(k,54) * b(k,15) + b(k,40) = b(k,40) - lu(k,55) * b(k,15) + b(k,46) = b(k,46) - lu(k,56) * b(k,15) + b(k,54) = b(k,54) - lu(k,57) * b(k,15) + b(k,40) = b(k,40) - lu(k,59) * b(k,16) + b(k,43) = b(k,43) - lu(k,60) * b(k,16) + b(k,51) = b(k,51) - lu(k,61) * b(k,16) + b(k,54) = b(k,54) - lu(k,62) * b(k,16) + b(k,58) = b(k,58) - lu(k,63) * b(k,16) + b(k,44) = b(k,44) - lu(k,65) * b(k,17) + b(k,45) = b(k,45) - lu(k,66) * b(k,17) + b(k,49) = b(k,49) - lu(k,67) * b(k,17) + b(k,53) = b(k,53) - lu(k,68) * b(k,17) + b(k,54) = b(k,54) - lu(k,69) * b(k,17) + b(k,58) = b(k,58) - lu(k,70) * b(k,17) + b(k,19) = b(k,19) - lu(k,72) * b(k,18) + b(k,23) = b(k,23) - lu(k,73) * b(k,18) + b(k,30) = b(k,30) - lu(k,74) * b(k,18) + b(k,31) = b(k,31) - lu(k,75) * b(k,18) + b(k,46) = b(k,46) - lu(k,76) * b(k,18) + b(k,55) = b(k,55) - lu(k,77) * b(k,18) + b(k,23) = b(k,23) - lu(k,79) * b(k,19) + b(k,31) = b(k,31) - lu(k,80) * b(k,19) + b(k,32) = b(k,32) - lu(k,81) * b(k,19) + b(k,46) = b(k,46) - lu(k,82) * b(k,19) + b(k,49) = b(k,49) - lu(k,83) * b(k,19) + b(k,27) = b(k,27) - lu(k,85) * b(k,20) + b(k,38) = b(k,38) - lu(k,86) * b(k,20) + b(k,41) = b(k,41) - lu(k,87) * b(k,20) + b(k,44) = b(k,44) - lu(k,88) * b(k,20) + b(k,46) = b(k,46) - lu(k,89) * b(k,20) + b(k,53) = b(k,53) - lu(k,90) * b(k,20) + b(k,57) = b(k,57) - lu(k,91) * b(k,20) + b(k,40) = b(k,40) - lu(k,93) * b(k,21) + b(k,45) = b(k,45) - lu(k,94) * b(k,21) + b(k,54) = b(k,54) - lu(k,95) * b(k,21) + b(k,42) = b(k,42) - lu(k,97) * b(k,22) + b(k,45) = b(k,45) - lu(k,98) * b(k,22) + b(k,46) = b(k,46) - lu(k,99) * b(k,22) + b(k,48) = b(k,48) - lu(k,100) * b(k,22) + b(k,54) = b(k,54) - lu(k,101) * b(k,22) + b(k,58) = b(k,58) - lu(k,102) * b(k,22) + b(k,25) = b(k,25) - lu(k,104) * b(k,23) + b(k,31) = b(k,31) - lu(k,105) * b(k,23) + b(k,32) = b(k,32) - lu(k,106) * b(k,23) + b(k,33) = b(k,33) - lu(k,107) * b(k,23) + b(k,34) = b(k,34) - lu(k,108) * b(k,23) + b(k,35) = b(k,35) - lu(k,109) * b(k,23) + b(k,46) = b(k,46) - lu(k,110) * b(k,23) + b(k,49) = b(k,49) - lu(k,111) * b(k,23) + b(k,39) = b(k,39) - lu(k,113) * b(k,24) + b(k,40) = b(k,40) - lu(k,114) * b(k,24) + b(k,46) = b(k,46) - lu(k,115) * b(k,24) + b(k,49) = b(k,49) - lu(k,116) * b(k,24) + b(k,52) = b(k,52) - lu(k,117) * b(k,24) + b(k,54) = b(k,54) - lu(k,118) * b(k,24) + b(k,33) = b(k,33) - lu(k,120) * b(k,25) + b(k,34) = b(k,34) - lu(k,121) * b(k,25) + b(k,35) = b(k,35) - lu(k,122) * b(k,25) + b(k,46) = b(k,46) - lu(k,123) * b(k,25) + b(k,38) = b(k,38) - lu(k,126) * b(k,26) + b(k,40) = b(k,40) - lu(k,127) * b(k,26) + b(k,43) = b(k,43) - lu(k,128) * b(k,26) + b(k,44) = b(k,44) - lu(k,129) * b(k,26) + b(k,54) = b(k,54) - lu(k,130) * b(k,26) + b(k,56) = b(k,56) - lu(k,131) * b(k,26) + b(k,58) = b(k,58) - lu(k,132) * b(k,26) + b(k,41) = b(k,41) - lu(k,135) * b(k,27) + b(k,42) = b(k,42) - lu(k,136) * b(k,27) + b(k,46) = b(k,46) - lu(k,137) * b(k,27) + b(k,48) = b(k,48) - lu(k,138) * b(k,27) + b(k,54) = b(k,54) - lu(k,139) * b(k,27) + b(k,57) = b(k,57) - lu(k,140) * b(k,27) + b(k,58) = b(k,58) - lu(k,141) * b(k,27) + b(k,42) = b(k,42) - lu(k,144) * b(k,28) + b(k,46) = b(k,46) - lu(k,145) * b(k,28) + b(k,47) = b(k,47) - lu(k,146) * b(k,28) + b(k,48) = b(k,48) - lu(k,147) * b(k,28) + b(k,54) = b(k,54) - lu(k,148) * b(k,28) + b(k,58) = b(k,58) - lu(k,149) * b(k,28) + b(k,40) = b(k,40) - lu(k,151) * b(k,29) + b(k,41) = b(k,41) - lu(k,152) * b(k,29) + b(k,46) = b(k,46) - lu(k,153) * b(k,29) + b(k,50) = b(k,50) - lu(k,154) * b(k,29) + b(k,54) = b(k,54) - lu(k,155) * b(k,29) + b(k,57) = b(k,57) - lu(k,156) * b(k,29) + b(k,58) = b(k,58) - lu(k,157) * b(k,29) + b(k,31) = b(k,31) - lu(k,160) * b(k,30) + b(k,32) = b(k,32) - lu(k,161) * b(k,30) + b(k,33) = b(k,33) - lu(k,162) * b(k,30) + b(k,34) = b(k,34) - lu(k,163) * b(k,30) + b(k,35) = b(k,35) - lu(k,164) * b(k,30) + b(k,46) = b(k,46) - lu(k,165) * b(k,30) + b(k,49) = b(k,49) - lu(k,166) * b(k,30) + b(k,32) = b(k,32) - lu(k,171) * b(k,31) + b(k,33) = b(k,33) - lu(k,172) * b(k,31) + b(k,34) = b(k,34) - lu(k,173) * b(k,31) + b(k,35) = b(k,35) - lu(k,174) * b(k,31) + b(k,40) = b(k,40) - lu(k,175) * b(k,31) + b(k,45) = b(k,45) - lu(k,176) * b(k,31) + b(k,46) = b(k,46) - lu(k,177) * b(k,31) + b(k,49) = b(k,49) - lu(k,178) * b(k,31) + b(k,54) = b(k,54) - lu(k,179) * b(k,31) + b(k,33) = b(k,33) - lu(k,182) * b(k,32) + b(k,34) = b(k,34) - lu(k,183) * b(k,32) + b(k,35) = b(k,35) - lu(k,184) * b(k,32) + b(k,46) = b(k,46) - lu(k,185) * b(k,32) + b(k,49) = b(k,49) - lu(k,186) * b(k,32) + b(k,50) = b(k,50) - lu(k,187) * b(k,32) + b(k,55) = b(k,55) - lu(k,188) * b(k,32) + b(k,34) = b(k,34) - lu(k,197) * b(k,33) + b(k,35) = b(k,35) - lu(k,198) * b(k,33) + b(k,40) = b(k,40) - lu(k,199) * b(k,33) + b(k,45) = b(k,45) - lu(k,200) * b(k,33) + b(k,46) = b(k,46) - lu(k,201) * b(k,33) + b(k,49) = b(k,49) - lu(k,202) * b(k,33) + b(k,50) = b(k,50) - lu(k,203) * b(k,33) + b(k,54) = b(k,54) - lu(k,204) * b(k,33) + b(k,55) = b(k,55) - lu(k,205) * b(k,33) + b(k,35) = b(k,35) - lu(k,211) * b(k,34) + b(k,40) = b(k,40) - lu(k,212) * b(k,34) + b(k,45) = b(k,45) - lu(k,213) * b(k,34) + b(k,46) = b(k,46) - lu(k,214) * b(k,34) + b(k,49) = b(k,49) - lu(k,215) * b(k,34) + b(k,50) = b(k,50) - lu(k,216) * b(k,34) + b(k,54) = b(k,54) - lu(k,217) * b(k,34) + b(k,55) = b(k,55) - lu(k,218) * b(k,34) + b(k,40) = b(k,40) - lu(k,226) * b(k,35) + b(k,45) = b(k,45) - lu(k,227) * b(k,35) + b(k,46) = b(k,46) - lu(k,228) * b(k,35) + b(k,49) = b(k,49) - lu(k,229) * b(k,35) + b(k,50) = b(k,50) - lu(k,230) * b(k,35) + b(k,53) = b(k,53) - lu(k,231) * b(k,35) + b(k,54) = b(k,54) - lu(k,232) * b(k,35) + b(k,55) = b(k,55) - lu(k,233) * b(k,35) + b(k,39) = b(k,39) - lu(k,236) * b(k,36) + b(k,45) = b(k,45) - lu(k,237) * b(k,36) + b(k,46) = b(k,46) - lu(k,238) * b(k,36) + b(k,54) = b(k,54) - lu(k,239) * b(k,36) + b(k,58) = b(k,58) - lu(k,240) * b(k,36) + b(k,38) = b(k,38) - lu(k,244) * b(k,37) + b(k,42) = b(k,42) - lu(k,245) * b(k,37) + b(k,44) = b(k,44) - lu(k,246) * b(k,37) + b(k,46) = b(k,46) - lu(k,247) * b(k,37) + b(k,47) = b(k,47) - lu(k,248) * b(k,37) + b(k,48) = b(k,48) - lu(k,249) * b(k,37) + b(k,53) = b(k,53) - lu(k,250) * b(k,37) + b(k,54) = b(k,54) - lu(k,251) * b(k,37) + b(k,58) = b(k,58) - lu(k,252) * b(k,37) + b(k,40) = b(k,40) - lu(k,256) * b(k,38) + b(k,43) = b(k,43) - lu(k,257) * b(k,38) + b(k,44) = b(k,44) - lu(k,258) * b(k,38) + b(k,53) = b(k,53) - lu(k,259) * b(k,38) + b(k,54) = b(k,54) - lu(k,260) * b(k,38) + b(k,56) = b(k,56) - lu(k,261) * b(k,38) + b(k,58) = b(k,58) - lu(k,262) * b(k,38) + b(k,40) = b(k,40) - lu(k,267) * b(k,39) + b(k,41) = b(k,41) - lu(k,268) * b(k,39) + b(k,45) = b(k,45) - lu(k,269) * b(k,39) + b(k,46) = b(k,46) - lu(k,270) * b(k,39) + b(k,47) = b(k,47) - lu(k,271) * b(k,39) + b(k,48) = b(k,48) - lu(k,272) * b(k,39) + b(k,49) = b(k,49) - lu(k,273) * b(k,39) + b(k,52) = b(k,52) - lu(k,274) * b(k,39) + b(k,53) = b(k,53) - lu(k,275) * b(k,39) + b(k,54) = b(k,54) - lu(k,276) * b(k,39) + b(k,55) = b(k,55) - lu(k,277) * b(k,39) + b(k,57) = b(k,57) - lu(k,278) * b(k,39) + b(k,58) = b(k,58) - lu(k,279) * b(k,39) + end do + end subroutine lu_slv01 + subroutine lu_slv02( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: k +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + do k = 1,avec_len + b(k,45) = b(k,45) - lu(k,281) * b(k,40) + b(k,46) = b(k,46) - lu(k,282) * b(k,40) + b(k,49) = b(k,49) - lu(k,283) * b(k,40) + b(k,52) = b(k,52) - lu(k,284) * b(k,40) + b(k,54) = b(k,54) - lu(k,285) * b(k,40) + b(k,56) = b(k,56) - lu(k,286) * b(k,40) + b(k,58) = b(k,58) - lu(k,287) * b(k,40) + b(k,45) = b(k,45) - lu(k,292) * b(k,41) + b(k,46) = b(k,46) - lu(k,293) * b(k,41) + b(k,49) = b(k,49) - lu(k,294) * b(k,41) + b(k,50) = b(k,50) - lu(k,295) * b(k,41) + b(k,51) = b(k,51) - lu(k,296) * b(k,41) + b(k,52) = b(k,52) - lu(k,297) * b(k,41) + b(k,54) = b(k,54) - lu(k,298) * b(k,41) + b(k,56) = b(k,56) - lu(k,299) * b(k,41) + b(k,57) = b(k,57) - lu(k,300) * b(k,41) + b(k,58) = b(k,58) - lu(k,301) * b(k,41) + b(k,43) = b(k,43) - lu(k,311) * b(k,42) + b(k,44) = b(k,44) - lu(k,312) * b(k,42) + b(k,45) = b(k,45) - lu(k,313) * b(k,42) + b(k,46) = b(k,46) - lu(k,314) * b(k,42) + b(k,47) = b(k,47) - lu(k,315) * b(k,42) + b(k,48) = b(k,48) - lu(k,316) * b(k,42) + b(k,49) = b(k,49) - lu(k,317) * b(k,42) + b(k,50) = b(k,50) - lu(k,318) * b(k,42) + b(k,51) = b(k,51) - lu(k,319) * b(k,42) + b(k,52) = b(k,52) - lu(k,320) * b(k,42) + b(k,53) = b(k,53) - lu(k,321) * b(k,42) + b(k,54) = b(k,54) - lu(k,322) * b(k,42) + b(k,56) = b(k,56) - lu(k,323) * b(k,42) + b(k,57) = b(k,57) - lu(k,324) * b(k,42) + b(k,58) = b(k,58) - lu(k,325) * b(k,42) + b(k,45) = b(k,45) - lu(k,329) * b(k,43) + b(k,46) = b(k,46) - lu(k,330) * b(k,43) + b(k,47) = b(k,47) - lu(k,331) * b(k,43) + b(k,48) = b(k,48) - lu(k,332) * b(k,43) + b(k,49) = b(k,49) - lu(k,333) * b(k,43) + b(k,51) = b(k,51) - lu(k,334) * b(k,43) + b(k,52) = b(k,52) - lu(k,335) * b(k,43) + b(k,53) = b(k,53) - lu(k,336) * b(k,43) + b(k,54) = b(k,54) - lu(k,337) * b(k,43) + b(k,55) = b(k,55) - lu(k,338) * b(k,43) + b(k,56) = b(k,56) - lu(k,339) * b(k,43) + b(k,58) = b(k,58) - lu(k,340) * b(k,43) + b(k,45) = b(k,45) - lu(k,351) * b(k,44) + b(k,46) = b(k,46) - lu(k,352) * b(k,44) + b(k,47) = b(k,47) - lu(k,353) * b(k,44) + b(k,48) = b(k,48) - lu(k,354) * b(k,44) + b(k,49) = b(k,49) - lu(k,355) * b(k,44) + b(k,50) = b(k,50) - lu(k,356) * b(k,44) + b(k,51) = b(k,51) - lu(k,357) * b(k,44) + b(k,52) = b(k,52) - lu(k,358) * b(k,44) + b(k,53) = b(k,53) - lu(k,359) * b(k,44) + b(k,54) = b(k,54) - lu(k,360) * b(k,44) + b(k,55) = b(k,55) - lu(k,361) * b(k,44) + b(k,56) = b(k,56) - lu(k,362) * b(k,44) + b(k,57) = b(k,57) - lu(k,363) * b(k,44) + b(k,58) = b(k,58) - lu(k,364) * b(k,44) + b(k,46) = b(k,46) - lu(k,377) * b(k,45) + b(k,47) = b(k,47) - lu(k,378) * b(k,45) + b(k,48) = b(k,48) - lu(k,379) * b(k,45) + b(k,49) = b(k,49) - lu(k,380) * b(k,45) + b(k,50) = b(k,50) - lu(k,381) * b(k,45) + b(k,51) = b(k,51) - lu(k,382) * b(k,45) + b(k,52) = b(k,52) - lu(k,383) * b(k,45) + b(k,53) = b(k,53) - lu(k,384) * b(k,45) + b(k,54) = b(k,54) - lu(k,385) * b(k,45) + b(k,55) = b(k,55) - lu(k,386) * b(k,45) + b(k,56) = b(k,56) - lu(k,387) * b(k,45) + b(k,57) = b(k,57) - lu(k,388) * b(k,45) + b(k,58) = b(k,58) - lu(k,389) * b(k,45) + b(k,47) = b(k,47) - lu(k,421) * b(k,46) + b(k,48) = b(k,48) - lu(k,422) * b(k,46) + b(k,49) = b(k,49) - lu(k,423) * b(k,46) + b(k,50) = b(k,50) - lu(k,424) * b(k,46) + b(k,51) = b(k,51) - lu(k,425) * b(k,46) + b(k,52) = b(k,52) - lu(k,426) * b(k,46) + b(k,53) = b(k,53) - lu(k,427) * b(k,46) + b(k,54) = b(k,54) - lu(k,428) * b(k,46) + b(k,55) = b(k,55) - lu(k,429) * b(k,46) + b(k,56) = b(k,56) - lu(k,430) * b(k,46) + b(k,57) = b(k,57) - lu(k,431) * b(k,46) + b(k,58) = b(k,58) - lu(k,432) * b(k,46) + b(k,48) = b(k,48) - lu(k,450) * b(k,47) + b(k,49) = b(k,49) - lu(k,451) * b(k,47) + b(k,50) = b(k,50) - lu(k,452) * b(k,47) + b(k,51) = b(k,51) - lu(k,453) * b(k,47) + b(k,52) = b(k,52) - lu(k,454) * b(k,47) + b(k,53) = b(k,53) - lu(k,455) * b(k,47) + b(k,54) = b(k,54) - lu(k,456) * b(k,47) + b(k,55) = b(k,55) - lu(k,457) * b(k,47) + b(k,56) = b(k,56) - lu(k,458) * b(k,47) + b(k,57) = b(k,57) - lu(k,459) * b(k,47) + b(k,58) = b(k,58) - lu(k,460) * b(k,47) + b(k,49) = b(k,49) - lu(k,476) * b(k,48) + b(k,50) = b(k,50) - lu(k,477) * b(k,48) + b(k,51) = b(k,51) - lu(k,478) * b(k,48) + b(k,52) = b(k,52) - lu(k,479) * b(k,48) + b(k,53) = b(k,53) - lu(k,480) * b(k,48) + b(k,54) = b(k,54) - lu(k,481) * b(k,48) + b(k,55) = b(k,55) - lu(k,482) * b(k,48) + b(k,56) = b(k,56) - lu(k,483) * b(k,48) + b(k,57) = b(k,57) - lu(k,484) * b(k,48) + b(k,58) = b(k,58) - lu(k,485) * b(k,48) + b(k,50) = b(k,50) - lu(k,508) * b(k,49) + b(k,51) = b(k,51) - lu(k,509) * b(k,49) + b(k,52) = b(k,52) - lu(k,510) * b(k,49) + b(k,53) = b(k,53) - lu(k,511) * b(k,49) + b(k,54) = b(k,54) - lu(k,512) * b(k,49) + b(k,55) = b(k,55) - lu(k,513) * b(k,49) + b(k,56) = b(k,56) - lu(k,514) * b(k,49) + b(k,57) = b(k,57) - lu(k,515) * b(k,49) + b(k,58) = b(k,58) - lu(k,516) * b(k,49) + b(k,51) = b(k,51) - lu(k,534) * b(k,50) + b(k,52) = b(k,52) - lu(k,535) * b(k,50) + b(k,53) = b(k,53) - lu(k,536) * b(k,50) + b(k,54) = b(k,54) - lu(k,537) * b(k,50) + b(k,55) = b(k,55) - lu(k,538) * b(k,50) + b(k,56) = b(k,56) - lu(k,539) * b(k,50) + b(k,57) = b(k,57) - lu(k,540) * b(k,50) + b(k,58) = b(k,58) - lu(k,541) * b(k,50) + b(k,52) = b(k,52) - lu(k,557) * b(k,51) + b(k,53) = b(k,53) - lu(k,558) * b(k,51) + b(k,54) = b(k,54) - lu(k,559) * b(k,51) + b(k,55) = b(k,55) - lu(k,560) * b(k,51) + b(k,56) = b(k,56) - lu(k,561) * b(k,51) + b(k,57) = b(k,57) - lu(k,562) * b(k,51) + b(k,58) = b(k,58) - lu(k,563) * b(k,51) + b(k,53) = b(k,53) - lu(k,580) * b(k,52) + b(k,54) = b(k,54) - lu(k,581) * b(k,52) + b(k,55) = b(k,55) - lu(k,582) * b(k,52) + b(k,56) = b(k,56) - lu(k,583) * b(k,52) + b(k,57) = b(k,57) - lu(k,584) * b(k,52) + b(k,58) = b(k,58) - lu(k,585) * b(k,52) + b(k,54) = b(k,54) - lu(k,609) * b(k,53) + b(k,55) = b(k,55) - lu(k,610) * b(k,53) + b(k,56) = b(k,56) - lu(k,611) * b(k,53) + b(k,57) = b(k,57) - lu(k,612) * b(k,53) + b(k,58) = b(k,58) - lu(k,613) * b(k,53) + b(k,55) = b(k,55) - lu(k,647) * b(k,54) + b(k,56) = b(k,56) - lu(k,648) * b(k,54) + b(k,57) = b(k,57) - lu(k,649) * b(k,54) + b(k,58) = b(k,58) - lu(k,650) * b(k,54) + b(k,56) = b(k,56) - lu(k,671) * b(k,55) + b(k,57) = b(k,57) - lu(k,672) * b(k,55) + b(k,58) = b(k,58) - lu(k,673) * b(k,55) + b(k,57) = b(k,57) - lu(k,693) * b(k,56) + b(k,58) = b(k,58) - lu(k,694) * b(k,56) + b(k,58) = b(k,58) - lu(k,720) * b(k,57) + end do + end subroutine lu_slv02 + subroutine lu_slv03( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: k +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + do k = 1,avec_len +!----------------------------------------------------------------------- +! ... Solve U * x = y +!----------------------------------------------------------------------- + b(k,58) = b(k,58) * lu(k,745) + b(k,57) = b(k,57) - lu(k,744) * b(k,58) + b(k,56) = b(k,56) - lu(k,743) * b(k,58) + b(k,55) = b(k,55) - lu(k,742) * b(k,58) + b(k,54) = b(k,54) - lu(k,741) * b(k,58) + b(k,53) = b(k,53) - lu(k,740) * b(k,58) + b(k,52) = b(k,52) - lu(k,739) * b(k,58) + b(k,51) = b(k,51) - lu(k,738) * b(k,58) + b(k,50) = b(k,50) - lu(k,737) * b(k,58) + b(k,49) = b(k,49) - lu(k,736) * b(k,58) + b(k,48) = b(k,48) - lu(k,735) * b(k,58) + b(k,47) = b(k,47) - lu(k,734) * b(k,58) + b(k,46) = b(k,46) - lu(k,733) * b(k,58) + b(k,45) = b(k,45) - lu(k,732) * b(k,58) + b(k,44) = b(k,44) - lu(k,731) * b(k,58) + b(k,43) = b(k,43) - lu(k,730) * b(k,58) + b(k,41) = b(k,41) - lu(k,729) * b(k,58) + b(k,40) = b(k,40) - lu(k,728) * b(k,58) + b(k,39) = b(k,39) - lu(k,727) * b(k,58) + b(k,38) = b(k,38) - lu(k,726) * b(k,58) + b(k,36) = b(k,36) - lu(k,725) * b(k,58) + b(k,26) = b(k,26) - lu(k,724) * b(k,58) + b(k,11) = b(k,11) - lu(k,723) * b(k,58) + b(k,10) = b(k,10) - lu(k,722) * b(k,58) + b(k,4) = b(k,4) - lu(k,721) * b(k,58) + b(k,57) = b(k,57) * lu(k,719) + b(k,56) = b(k,56) - lu(k,718) * b(k,57) + b(k,55) = b(k,55) - lu(k,717) * b(k,57) + b(k,54) = b(k,54) - lu(k,716) * b(k,57) + b(k,53) = b(k,53) - lu(k,715) * b(k,57) + b(k,52) = b(k,52) - lu(k,714) * b(k,57) + b(k,51) = b(k,51) - lu(k,713) * b(k,57) + b(k,50) = b(k,50) - lu(k,712) * b(k,57) + b(k,49) = b(k,49) - lu(k,711) * b(k,57) + b(k,48) = b(k,48) - lu(k,710) * b(k,57) + b(k,47) = b(k,47) - lu(k,709) * b(k,57) + b(k,46) = b(k,46) - lu(k,708) * b(k,57) + b(k,45) = b(k,45) - lu(k,707) * b(k,57) + b(k,44) = b(k,44) - lu(k,706) * b(k,57) + b(k,43) = b(k,43) - lu(k,705) * b(k,57) + b(k,42) = b(k,42) - lu(k,704) * b(k,57) + b(k,41) = b(k,41) - lu(k,703) * b(k,57) + b(k,40) = b(k,40) - lu(k,702) * b(k,57) + b(k,39) = b(k,39) - lu(k,701) * b(k,57) + b(k,38) = b(k,38) - lu(k,700) * b(k,57) + b(k,36) = b(k,36) - lu(k,699) * b(k,57) + b(k,27) = b(k,27) - lu(k,698) * b(k,57) + b(k,20) = b(k,20) - lu(k,697) * b(k,57) + b(k,14) = b(k,14) - lu(k,696) * b(k,57) + b(k,9) = b(k,9) - lu(k,695) * b(k,57) + b(k,56) = b(k,56) * lu(k,692) + b(k,55) = b(k,55) - lu(k,691) * b(k,56) + b(k,54) = b(k,54) - lu(k,690) * b(k,56) + b(k,53) = b(k,53) - lu(k,689) * b(k,56) + b(k,52) = b(k,52) - lu(k,688) * b(k,56) + b(k,51) = b(k,51) - lu(k,687) * b(k,56) + b(k,50) = b(k,50) - lu(k,686) * b(k,56) + b(k,49) = b(k,49) - lu(k,685) * b(k,56) + b(k,48) = b(k,48) - lu(k,684) * b(k,56) + b(k,47) = b(k,47) - lu(k,683) * b(k,56) + b(k,46) = b(k,46) - lu(k,682) * b(k,56) + b(k,45) = b(k,45) - lu(k,681) * b(k,56) + b(k,44) = b(k,44) - lu(k,680) * b(k,56) + b(k,43) = b(k,43) - lu(k,679) * b(k,56) + b(k,42) = b(k,42) - lu(k,678) * b(k,56) + b(k,40) = b(k,40) - lu(k,677) * b(k,56) + b(k,38) = b(k,38) - lu(k,676) * b(k,56) + b(k,26) = b(k,26) - lu(k,675) * b(k,56) + b(k,10) = b(k,10) - lu(k,674) * b(k,56) + b(k,55) = b(k,55) * lu(k,670) + b(k,54) = b(k,54) - lu(k,669) * b(k,55) + b(k,53) = b(k,53) - lu(k,668) * b(k,55) + b(k,52) = b(k,52) - lu(k,667) * b(k,55) + b(k,51) = b(k,51) - lu(k,666) * b(k,55) + b(k,50) = b(k,50) - lu(k,665) * b(k,55) + b(k,49) = b(k,49) - lu(k,664) * b(k,55) + b(k,48) = b(k,48) - lu(k,663) * b(k,55) + b(k,47) = b(k,47) - lu(k,662) * b(k,55) + b(k,46) = b(k,46) - lu(k,661) * b(k,55) + b(k,45) = b(k,45) - lu(k,660) * b(k,55) + b(k,44) = b(k,44) - lu(k,659) * b(k,55) + b(k,43) = b(k,43) - lu(k,658) * b(k,55) + b(k,41) = b(k,41) - lu(k,657) * b(k,55) + b(k,40) = b(k,40) - lu(k,656) * b(k,55) + b(k,35) = b(k,35) - lu(k,655) * b(k,55) + b(k,34) = b(k,34) - lu(k,654) * b(k,55) + b(k,33) = b(k,33) - lu(k,653) * b(k,55) + b(k,32) = b(k,32) - lu(k,652) * b(k,55) + b(k,25) = b(k,25) - lu(k,651) * b(k,55) + b(k,54) = b(k,54) * lu(k,646) + b(k,53) = b(k,53) - lu(k,645) * b(k,54) + b(k,52) = b(k,52) - lu(k,644) * b(k,54) + b(k,51) = b(k,51) - lu(k,643) * b(k,54) + b(k,50) = b(k,50) - lu(k,642) * b(k,54) + b(k,49) = b(k,49) - lu(k,641) * b(k,54) + b(k,48) = b(k,48) - lu(k,640) * b(k,54) + b(k,47) = b(k,47) - lu(k,639) * b(k,54) + b(k,46) = b(k,46) - lu(k,638) * b(k,54) + b(k,45) = b(k,45) - lu(k,637) * b(k,54) + b(k,44) = b(k,44) - lu(k,636) * b(k,54) + b(k,43) = b(k,43) - lu(k,635) * b(k,54) + b(k,42) = b(k,42) - lu(k,634) * b(k,54) + b(k,41) = b(k,41) - lu(k,633) * b(k,54) + b(k,40) = b(k,40) - lu(k,632) * b(k,54) + b(k,39) = b(k,39) - lu(k,631) * b(k,54) + b(k,38) = b(k,38) - lu(k,630) * b(k,54) + b(k,37) = b(k,37) - lu(k,629) * b(k,54) + b(k,36) = b(k,36) - lu(k,628) * b(k,54) + b(k,35) = b(k,35) - lu(k,627) * b(k,54) + b(k,29) = b(k,29) - lu(k,626) * b(k,54) + b(k,28) = b(k,28) - lu(k,625) * b(k,54) + b(k,26) = b(k,26) - lu(k,624) * b(k,54) + b(k,24) = b(k,24) - lu(k,623) * b(k,54) + b(k,22) = b(k,22) - lu(k,622) * b(k,54) + b(k,21) = b(k,21) - lu(k,621) * b(k,54) + b(k,17) = b(k,17) - lu(k,620) * b(k,54) + b(k,16) = b(k,16) - lu(k,619) * b(k,54) + b(k,15) = b(k,15) - lu(k,618) * b(k,54) + b(k,12) = b(k,12) - lu(k,617) * b(k,54) + b(k,11) = b(k,11) - lu(k,616) * b(k,54) + b(k,8) = b(k,8) - lu(k,615) * b(k,54) + b(k,3) = b(k,3) - lu(k,614) * b(k,54) + b(k,53) = b(k,53) * lu(k,608) + b(k,52) = b(k,52) - lu(k,607) * b(k,53) + b(k,51) = b(k,51) - lu(k,606) * b(k,53) + b(k,50) = b(k,50) - lu(k,605) * b(k,53) + b(k,49) = b(k,49) - lu(k,604) * b(k,53) + b(k,48) = b(k,48) - lu(k,603) * b(k,53) + b(k,47) = b(k,47) - lu(k,602) * b(k,53) + b(k,46) = b(k,46) - lu(k,601) * b(k,53) + b(k,45) = b(k,45) - lu(k,600) * b(k,53) + b(k,44) = b(k,44) - lu(k,599) * b(k,53) + b(k,43) = b(k,43) - lu(k,598) * b(k,53) + b(k,42) = b(k,42) - lu(k,597) * b(k,53) + b(k,41) = b(k,41) - lu(k,596) * b(k,53) + b(k,40) = b(k,40) - lu(k,595) * b(k,53) + b(k,39) = b(k,39) - lu(k,594) * b(k,53) + b(k,38) = b(k,38) - lu(k,593) * b(k,53) + b(k,37) = b(k,37) - lu(k,592) * b(k,53) + b(k,36) = b(k,36) - lu(k,591) * b(k,53) + b(k,35) = b(k,35) - lu(k,590) * b(k,53) + b(k,27) = b(k,27) - lu(k,589) * b(k,53) + b(k,20) = b(k,20) - lu(k,588) * b(k,53) + b(k,17) = b(k,17) - lu(k,587) * b(k,53) + b(k,13) = b(k,13) - lu(k,586) * b(k,53) + b(k,52) = b(k,52) * lu(k,579) + b(k,51) = b(k,51) - lu(k,578) * b(k,52) + b(k,50) = b(k,50) - lu(k,577) * b(k,52) + b(k,49) = b(k,49) - lu(k,576) * b(k,52) + b(k,48) = b(k,48) - lu(k,575) * b(k,52) + b(k,47) = b(k,47) - lu(k,574) * b(k,52) + b(k,46) = b(k,46) - lu(k,573) * b(k,52) + b(k,45) = b(k,45) - lu(k,572) * b(k,52) + b(k,44) = b(k,44) - lu(k,571) * b(k,52) + b(k,41) = b(k,41) - lu(k,570) * b(k,52) + b(k,40) = b(k,40) - lu(k,569) * b(k,52) + b(k,39) = b(k,39) - lu(k,568) * b(k,52) + b(k,36) = b(k,36) - lu(k,567) * b(k,52) + b(k,24) = b(k,24) - lu(k,566) * b(k,52) + b(k,6) = b(k,6) - lu(k,565) * b(k,52) + b(k,5) = b(k,5) - lu(k,564) * b(k,52) + b(k,51) = b(k,51) * lu(k,556) + b(k,50) = b(k,50) - lu(k,555) * b(k,51) + b(k,49) = b(k,49) - lu(k,554) * b(k,51) + b(k,48) = b(k,48) - lu(k,553) * b(k,51) + b(k,47) = b(k,47) - lu(k,552) * b(k,51) + b(k,46) = b(k,46) - lu(k,551) * b(k,51) + b(k,45) = b(k,45) - lu(k,550) * b(k,51) + b(k,44) = b(k,44) - lu(k,549) * b(k,51) + b(k,43) = b(k,43) - lu(k,548) * b(k,51) + b(k,42) = b(k,42) - lu(k,547) * b(k,51) + b(k,41) = b(k,41) - lu(k,546) * b(k,51) + b(k,40) = b(k,40) - lu(k,545) * b(k,51) + b(k,38) = b(k,38) - lu(k,544) * b(k,51) + b(k,29) = b(k,29) - lu(k,543) * b(k,51) + b(k,21) = b(k,21) - lu(k,542) * b(k,51) + b(k,50) = b(k,50) * lu(k,533) + b(k,49) = b(k,49) - lu(k,532) * b(k,50) + b(k,48) = b(k,48) - lu(k,531) * b(k,50) + b(k,47) = b(k,47) - lu(k,530) * b(k,50) + b(k,46) = b(k,46) - lu(k,529) * b(k,50) + b(k,45) = b(k,45) - lu(k,528) * b(k,50) + b(k,44) = b(k,44) - lu(k,527) * b(k,50) + b(k,43) = b(k,43) - lu(k,526) * b(k,50) + b(k,42) = b(k,42) - lu(k,525) * b(k,50) + b(k,41) = b(k,41) - lu(k,524) * b(k,50) + b(k,40) = b(k,40) - lu(k,523) * b(k,50) + b(k,38) = b(k,38) - lu(k,522) * b(k,50) + b(k,29) = b(k,29) - lu(k,521) * b(k,50) + b(k,26) = b(k,26) - lu(k,520) * b(k,50) + b(k,8) = b(k,8) - lu(k,519) * b(k,50) + b(k,6) = b(k,6) - lu(k,518) * b(k,50) + b(k,3) = b(k,3) - lu(k,517) * b(k,50) + b(k,49) = b(k,49) * lu(k,507) + b(k,48) = b(k,48) - lu(k,506) * b(k,49) + b(k,47) = b(k,47) - lu(k,505) * b(k,49) + b(k,46) = b(k,46) - lu(k,504) * b(k,49) + b(k,45) = b(k,45) - lu(k,503) * b(k,49) + b(k,41) = b(k,41) - lu(k,502) * b(k,49) + b(k,40) = b(k,40) - lu(k,501) * b(k,49) + b(k,39) = b(k,39) - lu(k,500) * b(k,49) + b(k,36) = b(k,36) - lu(k,499) * b(k,49) + b(k,35) = b(k,35) - lu(k,498) * b(k,49) + b(k,34) = b(k,34) - lu(k,497) * b(k,49) + b(k,33) = b(k,33) - lu(k,496) * b(k,49) + b(k,32) = b(k,32) - lu(k,495) * b(k,49) + b(k,31) = b(k,31) - lu(k,494) * b(k,49) + b(k,30) = b(k,30) - lu(k,493) * b(k,49) + b(k,25) = b(k,25) - lu(k,492) * b(k,49) + b(k,24) = b(k,24) - lu(k,491) * b(k,49) + b(k,23) = b(k,23) - lu(k,490) * b(k,49) + b(k,19) = b(k,19) - lu(k,489) * b(k,49) + b(k,18) = b(k,18) - lu(k,488) * b(k,49) + b(k,6) = b(k,6) - lu(k,487) * b(k,49) + b(k,5) = b(k,5) - lu(k,486) * b(k,49) + end do + end subroutine lu_slv03 + subroutine lu_slv04( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: k +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + do k = 1,avec_len + b(k,48) = b(k,48) * lu(k,475) + b(k,47) = b(k,47) - lu(k,474) * b(k,48) + b(k,46) = b(k,46) - lu(k,473) * b(k,48) + b(k,45) = b(k,45) - lu(k,472) * b(k,48) + b(k,44) = b(k,44) - lu(k,471) * b(k,48) + b(k,43) = b(k,43) - lu(k,470) * b(k,48) + b(k,42) = b(k,42) - lu(k,469) * b(k,48) + b(k,41) = b(k,41) - lu(k,468) * b(k,48) + b(k,40) = b(k,40) - lu(k,467) * b(k,48) + b(k,38) = b(k,38) - lu(k,466) * b(k,48) + b(k,37) = b(k,37) - lu(k,465) * b(k,48) + b(k,28) = b(k,28) - lu(k,464) * b(k,48) + b(k,22) = b(k,22) - lu(k,463) * b(k,48) + b(k,21) = b(k,21) - lu(k,462) * b(k,48) + b(k,7) = b(k,7) - lu(k,461) * b(k,48) + b(k,47) = b(k,47) * lu(k,449) + b(k,46) = b(k,46) - lu(k,448) * b(k,47) + b(k,45) = b(k,45) - lu(k,447) * b(k,47) + b(k,44) = b(k,44) - lu(k,446) * b(k,47) + b(k,43) = b(k,43) - lu(k,445) * b(k,47) + b(k,42) = b(k,42) - lu(k,444) * b(k,47) + b(k,41) = b(k,41) - lu(k,443) * b(k,47) + b(k,40) = b(k,40) - lu(k,442) * b(k,47) + b(k,39) = b(k,39) - lu(k,441) * b(k,47) + b(k,38) = b(k,38) - lu(k,440) * b(k,47) + b(k,37) = b(k,37) - lu(k,439) * b(k,47) + b(k,36) = b(k,36) - lu(k,438) * b(k,47) + b(k,28) = b(k,28) - lu(k,437) * b(k,47) + b(k,14) = b(k,14) - lu(k,436) * b(k,47) + b(k,9) = b(k,9) - lu(k,435) * b(k,47) + b(k,7) = b(k,7) - lu(k,434) * b(k,47) + b(k,2) = b(k,2) - lu(k,433) * b(k,47) + b(k,46) = b(k,46) * lu(k,420) + b(k,45) = b(k,45) - lu(k,419) * b(k,46) + b(k,44) = b(k,44) - lu(k,418) * b(k,46) + b(k,43) = b(k,43) - lu(k,417) * b(k,46) + b(k,42) = b(k,42) - lu(k,416) * b(k,46) + b(k,41) = b(k,41) - lu(k,415) * b(k,46) + b(k,40) = b(k,40) - lu(k,414) * b(k,46) + b(k,39) = b(k,39) - lu(k,413) * b(k,46) + b(k,38) = b(k,38) - lu(k,412) * b(k,46) + b(k,37) = b(k,37) - lu(k,411) * b(k,46) + b(k,36) = b(k,36) - lu(k,410) * b(k,46) + b(k,35) = b(k,35) - lu(k,409) * b(k,46) + b(k,34) = b(k,34) - lu(k,408) * b(k,46) + b(k,33) = b(k,33) - lu(k,407) * b(k,46) + b(k,32) = b(k,32) - lu(k,406) * b(k,46) + b(k,31) = b(k,31) - lu(k,405) * b(k,46) + b(k,30) = b(k,30) - lu(k,404) * b(k,46) + b(k,29) = b(k,29) - lu(k,403) * b(k,46) + b(k,28) = b(k,28) - lu(k,402) * b(k,46) + b(k,27) = b(k,27) - lu(k,401) * b(k,46) + b(k,25) = b(k,25) - lu(k,400) * b(k,46) + b(k,24) = b(k,24) - lu(k,399) * b(k,46) + b(k,23) = b(k,23) - lu(k,398) * b(k,46) + b(k,22) = b(k,22) - lu(k,397) * b(k,46) + b(k,21) = b(k,21) - lu(k,396) * b(k,46) + b(k,20) = b(k,20) - lu(k,395) * b(k,46) + b(k,19) = b(k,19) - lu(k,394) * b(k,46) + b(k,18) = b(k,18) - lu(k,393) * b(k,46) + b(k,15) = b(k,15) - lu(k,392) * b(k,46) + b(k,6) = b(k,6) - lu(k,391) * b(k,46) + b(k,5) = b(k,5) - lu(k,390) * b(k,46) + b(k,45) = b(k,45) * lu(k,376) + b(k,44) = b(k,44) - lu(k,375) * b(k,45) + b(k,43) = b(k,43) - lu(k,374) * b(k,45) + b(k,42) = b(k,42) - lu(k,373) * b(k,45) + b(k,41) = b(k,41) - lu(k,372) * b(k,45) + b(k,40) = b(k,40) - lu(k,371) * b(k,45) + b(k,29) = b(k,29) - lu(k,370) * b(k,45) + b(k,28) = b(k,28) - lu(k,369) * b(k,45) + b(k,27) = b(k,27) - lu(k,368) * b(k,45) + b(k,22) = b(k,22) - lu(k,367) * b(k,45) + b(k,17) = b(k,17) - lu(k,366) * b(k,45) + b(k,16) = b(k,16) - lu(k,365) * b(k,45) + b(k,44) = b(k,44) * lu(k,350) + b(k,43) = b(k,43) - lu(k,349) * b(k,44) + b(k,41) = b(k,41) - lu(k,348) * b(k,44) + b(k,40) = b(k,40) - lu(k,347) * b(k,44) + b(k,39) = b(k,39) - lu(k,346) * b(k,44) + b(k,38) = b(k,38) - lu(k,345) * b(k,44) + b(k,36) = b(k,36) - lu(k,344) * b(k,44) + b(k,21) = b(k,21) - lu(k,343) * b(k,44) + b(k,13) = b(k,13) - lu(k,342) * b(k,44) + b(k,12) = b(k,12) - lu(k,341) * b(k,44) + b(k,43) = b(k,43) * lu(k,328) + b(k,40) = b(k,40) - lu(k,327) * b(k,43) + b(k,16) = b(k,16) - lu(k,326) * b(k,43) + b(k,42) = b(k,42) * lu(k,310) + b(k,41) = b(k,41) - lu(k,309) * b(k,42) + b(k,40) = b(k,40) - lu(k,308) * b(k,42) + b(k,38) = b(k,38) - lu(k,307) * b(k,42) + b(k,37) = b(k,37) - lu(k,306) * b(k,42) + b(k,28) = b(k,28) - lu(k,305) * b(k,42) + b(k,27) = b(k,27) - lu(k,304) * b(k,42) + b(k,9) = b(k,9) - lu(k,303) * b(k,42) + b(k,7) = b(k,7) - lu(k,302) * b(k,42) + b(k,41) = b(k,41) * lu(k,291) + b(k,40) = b(k,40) - lu(k,290) * b(k,41) + b(k,29) = b(k,29) - lu(k,289) * b(k,41) + b(k,21) = b(k,21) - lu(k,288) * b(k,41) + b(k,40) = b(k,40) * lu(k,280) + b(k,39) = b(k,39) * lu(k,266) + b(k,36) = b(k,36) - lu(k,265) * b(k,39) + b(k,24) = b(k,24) - lu(k,264) * b(k,39) + b(k,14) = b(k,14) - lu(k,263) * b(k,39) + b(k,38) = b(k,38) * lu(k,255) + b(k,26) = b(k,26) - lu(k,254) * b(k,38) + b(k,10) = b(k,10) - lu(k,253) * b(k,38) + b(k,37) = b(k,37) * lu(k,243) + b(k,28) = b(k,28) - lu(k,242) * b(k,37) + b(k,7) = b(k,7) - lu(k,241) * b(k,37) + b(k,36) = b(k,36) * lu(k,235) + b(k,11) = b(k,11) - lu(k,234) * b(k,36) + b(k,35) = b(k,35) * lu(k,225) + b(k,34) = b(k,34) - lu(k,224) * b(k,35) + b(k,33) = b(k,33) - lu(k,223) * b(k,35) + b(k,32) = b(k,32) - lu(k,222) * b(k,35) + b(k,31) = b(k,31) - lu(k,221) * b(k,35) + b(k,30) = b(k,30) - lu(k,220) * b(k,35) + b(k,25) = b(k,25) - lu(k,219) * b(k,35) + b(k,34) = b(k,34) * lu(k,210) + b(k,33) = b(k,33) - lu(k,209) * b(k,34) + b(k,32) = b(k,32) - lu(k,208) * b(k,34) + b(k,31) = b(k,31) - lu(k,207) * b(k,34) + b(k,30) = b(k,30) - lu(k,206) * b(k,34) + b(k,33) = b(k,33) * lu(k,196) + b(k,32) = b(k,32) - lu(k,195) * b(k,33) + b(k,31) = b(k,31) - lu(k,194) * b(k,33) + b(k,30) = b(k,30) - lu(k,193) * b(k,33) + b(k,25) = b(k,25) - lu(k,192) * b(k,33) + b(k,23) = b(k,23) - lu(k,191) * b(k,33) + b(k,19) = b(k,19) - lu(k,190) * b(k,33) + b(k,18) = b(k,18) - lu(k,189) * b(k,33) + b(k,32) = b(k,32) * lu(k,181) + b(k,25) = b(k,25) - lu(k,180) * b(k,32) + b(k,31) = b(k,31) * lu(k,170) + b(k,30) = b(k,30) - lu(k,169) * b(k,31) + b(k,25) = b(k,25) - lu(k,168) * b(k,31) + b(k,21) = b(k,21) - lu(k,167) * b(k,31) + b(k,30) = b(k,30) * lu(k,159) + b(k,25) = b(k,25) - lu(k,158) * b(k,30) + b(k,29) = b(k,29) * lu(k,150) + b(k,28) = b(k,28) * lu(k,143) + b(k,7) = b(k,7) - lu(k,142) * b(k,28) + b(k,27) = b(k,27) * lu(k,134) + b(k,9) = b(k,9) - lu(k,133) * b(k,27) + b(k,26) = b(k,26) * lu(k,125) + b(k,10) = b(k,10) - lu(k,124) * b(k,26) + b(k,25) = b(k,25) * lu(k,119) + b(k,24) = b(k,24) * lu(k,112) + b(k,23) = b(k,23) * lu(k,103) + b(k,22) = b(k,22) * lu(k,96) + b(k,21) = b(k,21) * lu(k,92) + b(k,20) = b(k,20) * lu(k,84) + b(k,19) = b(k,19) * lu(k,78) + b(k,18) = b(k,18) * lu(k,71) + b(k,17) = b(k,17) * lu(k,64) + b(k,16) = b(k,16) * lu(k,58) + b(k,15) = b(k,15) * lu(k,50) + b(k,14) = b(k,14) * lu(k,45) + b(k,13) = b(k,13) * lu(k,39) + b(k,12) = b(k,12) * lu(k,33) + b(k,11) = b(k,11) * lu(k,29) + b(k,4) = b(k,4) - lu(k,28) * b(k,11) + b(k,10) = b(k,10) * lu(k,25) + b(k,9) = b(k,9) * lu(k,22) + b(k,8) = b(k,8) * lu(k,18) + b(k,7) = b(k,7) * lu(k,16) + b(k,6) = b(k,6) * lu(k,14) + b(k,5) = b(k,5) - lu(k,13) * b(k,6) + b(k,5) = b(k,5) * lu(k,11) + b(k,4) = b(k,4) * lu(k,8) + b(k,3) = b(k,3) * lu(k,5) + b(k,2) = b(k,2) * lu(k,2) + b(k,1) = b(k,1) * lu(k,1) + end do + end subroutine lu_slv04 + subroutine lu_slv( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) + call lu_slv01( avec_len, lu, b ) + call lu_slv02( avec_len, lu, b ) + call lu_slv03( avec_len, lu, b ) + call lu_slv04( avec_len, lu, b ) + end subroutine lu_slv + end module mo_lu_solve diff --git a/src/chemistry/pp_waccm_ma_noaero/mo_nln_matrix.F90 b/src/chemistry/pp_waccm_ma_noaero/mo_nln_matrix.F90 new file mode 100644 index 0000000000..69c477accb --- /dev/null +++ b/src/chemistry/pp_waccm_ma_noaero/mo_nln_matrix.F90 @@ -0,0 +1,1251 @@ + module mo_nln_matrix + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only: veclen + private + public :: nlnmat + contains + subroutine nlnmat01( avec_len, mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + do k = 1,avec_len + mat(k,291) = -(rxt(k,191)*y(k,15) + rxt(k,192)*y(k,68) + rxt(k,193)*y(k,58)) + mat(k,546) = -rxt(k,191)*y(k,1) + mat(k,372) = -rxt(k,192)*y(k,1) + mat(k,570) = -rxt(k,193)*y(k,1) + mat(k,703) = 4.000_r8*rxt(k,194)*y(k,3) + (rxt(k,195)+rxt(k,196))*y(k,26) & + + rxt(k,199)*y(k,53) + rxt(k,202)*y(k,56) + rxt(k,253)*y(k,63) & + + rxt(k,203)*y(k,77) + mat(k,443) = (rxt(k,195)+rxt(k,196))*y(k,3) + mat(k,152) = rxt(k,204)*y(k,56) + rxt(k,210)*y(k,73) + rxt(k,205)*y(k,77) + mat(k,657) = rxt(k,199)*y(k,3) + mat(k,415) = rxt(k,202)*y(k,3) + rxt(k,204)*y(k,40) + mat(k,268) = rxt(k,253)*y(k,3) + mat(k,524) = rxt(k,210)*y(k,40) + mat(k,633) = rxt(k,203)*y(k,3) + rxt(k,205)*y(k,40) + mat(k,695) = rxt(k,197)*y(k,26) + mat(k,435) = rxt(k,197)*y(k,3) + mat(k,303) = (rxt(k,276)+rxt(k,281))*y(k,48) + mat(k,133) = (rxt(k,276)+rxt(k,281))*y(k,44) + mat(k,719) = -(4._r8*rxt(k,194)*y(k,3) + (rxt(k,195) + rxt(k,196) + rxt(k,197) & + ) * y(k,26) + rxt(k,198)*y(k,68) + rxt(k,199)*y(k,53) + rxt(k,200) & + *y(k,54) + rxt(k,202)*y(k,56) + rxt(k,203)*y(k,77) + rxt(k,253) & + *y(k,63)) + mat(k,459) = -(rxt(k,195) + rxt(k,196) + rxt(k,197)) * y(k,3) + mat(k,388) = -rxt(k,198)*y(k,3) + mat(k,672) = -rxt(k,199)*y(k,3) + mat(k,612) = -rxt(k,200)*y(k,3) + mat(k,431) = -rxt(k,202)*y(k,3) + mat(k,649) = -rxt(k,203)*y(k,3) + mat(k,278) = -rxt(k,253)*y(k,3) + mat(k,300) = rxt(k,193)*y(k,58) + mat(k,91) = rxt(k,201)*y(k,56) + mat(k,156) = rxt(k,211)*y(k,73) + mat(k,140) = rxt(k,206)*y(k,56) + mat(k,431) = mat(k,431) + rxt(k,201)*y(k,4) + rxt(k,206)*y(k,48) + mat(k,584) = rxt(k,193)*y(k,1) + mat(k,540) = rxt(k,211)*y(k,40) + mat(k,84) = -(rxt(k,201)*y(k,56)) + mat(k,395) = -rxt(k,201)*y(k,4) + mat(k,697) = rxt(k,200)*y(k,54) + mat(k,588) = rxt(k,200)*y(k,3) + mat(k,556) = -(rxt(k,155)*y(k,23) + rxt(k,191)*y(k,1) + rxt(k,235)*y(k,55) & + + rxt(k,236)*y(k,56) + rxt(k,237)*y(k,77)) + mat(k,478) = -rxt(k,155)*y(k,15) + mat(k,296) = -rxt(k,191)*y(k,15) + mat(k,357) = -rxt(k,235)*y(k,15) + mat(k,425) = -rxt(k,236)*y(k,15) + mat(k,643) = -rxt(k,237)*y(k,15) + mat(k,334) = rxt(k,162)*y(k,26) + rxt(k,239)*y(k,53) + mat(k,61) = .300_r8*rxt(k,240)*y(k,77) + mat(k,453) = rxt(k,162)*y(k,19) + mat(k,666) = rxt(k,239)*y(k,19) + mat(k,643) = mat(k,643) + .300_r8*rxt(k,240)*y(k,20) + mat(k,328) = -(rxt(k,162)*y(k,26) + rxt(k,238)*y(k,68) + rxt(k,239)*y(k,53)) + mat(k,445) = -rxt(k,162)*y(k,19) + mat(k,374) = -rxt(k,238)*y(k,19) + mat(k,658) = -rxt(k,239)*y(k,19) + mat(k,60) = .700_r8*rxt(k,240)*y(k,77) + mat(k,635) = .700_r8*rxt(k,240)*y(k,20) + mat(k,58) = -(rxt(k,240)*y(k,77)) + mat(k,619) = -rxt(k,240)*y(k,20) + mat(k,326) = rxt(k,238)*y(k,68) + mat(k,365) = rxt(k,238)*y(k,19) + mat(k,475) = -(rxt(k,155)*y(k,15) + rxt(k,157)*y(k,36) + rxt(k,158)*y(k,38) & + + (rxt(k,159) + rxt(k,160)) * y(k,68) + rxt(k,161)*y(k,58) & + + rxt(k,168)*y(k,27) + rxt(k,177)*y(k,49)) + mat(k,553) = -rxt(k,155)*y(k,23) + mat(k,684) = -rxt(k,157)*y(k,23) + mat(k,100) = -rxt(k,158)*y(k,23) + mat(k,379) = -(rxt(k,159) + rxt(k,160)) * y(k,23) + mat(k,575) = -rxt(k,161)*y(k,23) + mat(k,249) = -rxt(k,168)*y(k,23) + mat(k,147) = -rxt(k,177)*y(k,23) + mat(k,710) = rxt(k,196)*y(k,26) + mat(k,332) = rxt(k,162)*y(k,26) + mat(k,450) = rxt(k,196)*y(k,3) + rxt(k,162)*y(k,19) + (4.000_r8*rxt(k,163) & + +2.000_r8*rxt(k,165))*y(k,26) + rxt(k,167)*y(k,53) + rxt(k,172) & + *y(k,56) + rxt(k,254)*y(k,63) + rxt(k,173)*y(k,77) + mat(k,20) = rxt(k,217)*y(k,73) + mat(k,316) = rxt(k,175)*y(k,56) + rxt(k,187)*y(k,73) + rxt(k,176)*y(k,77) + mat(k,663) = rxt(k,167)*y(k,26) + mat(k,422) = rxt(k,172)*y(k,26) + rxt(k,175)*y(k,44) + mat(k,272) = rxt(k,254)*y(k,26) + mat(k,531) = rxt(k,217)*y(k,32) + rxt(k,187)*y(k,44) + mat(k,640) = rxt(k,173)*y(k,26) + rxt(k,176)*y(k,44) + mat(k,461) = rxt(k,168)*y(k,27) + mat(k,434) = 2.000_r8*rxt(k,164)*y(k,26) + mat(k,241) = rxt(k,168)*y(k,23) + (rxt(k,274)+rxt(k,279)+rxt(k,284))*y(k,44) + mat(k,302) = (rxt(k,274)+rxt(k,279)+rxt(k,284))*y(k,27) + (rxt(k,269) & + +rxt(k,275)+rxt(k,280))*y(k,49) + mat(k,142) = (rxt(k,269)+rxt(k,275)+rxt(k,280))*y(k,44) + mat(k,433) = 2.000_r8*rxt(k,189)*y(k,26) + mat(k,449) = -(rxt(k,162)*y(k,19) + (4._r8*rxt(k,163) + 4._r8*rxt(k,164) & + + 4._r8*rxt(k,165) + 4._r8*rxt(k,189)) * y(k,26) + rxt(k,166) & + *y(k,68) + rxt(k,167)*y(k,53) + rxt(k,169)*y(k,54) + rxt(k,172) & + *y(k,56) + (rxt(k,173) + rxt(k,174)) * y(k,77) + (rxt(k,195) & + + rxt(k,196) + rxt(k,197)) * y(k,3) + rxt(k,254)*y(k,63)) + mat(k,331) = -rxt(k,162)*y(k,26) + mat(k,378) = -rxt(k,166)*y(k,26) + mat(k,662) = -rxt(k,167)*y(k,26) + mat(k,602) = -rxt(k,169)*y(k,26) + mat(k,421) = -rxt(k,172)*y(k,26) + mat(k,639) = -(rxt(k,173) + rxt(k,174)) * y(k,26) + mat(k,709) = -(rxt(k,195) + rxt(k,196) + rxt(k,197)) * y(k,26) + mat(k,271) = -rxt(k,254)*y(k,26) + mat(k,474) = rxt(k,177)*y(k,49) + rxt(k,161)*y(k,58) + rxt(k,160)*y(k,68) + mat(k,248) = rxt(k,170)*y(k,56) + mat(k,315) = rxt(k,188)*y(k,73) + mat(k,146) = rxt(k,177)*y(k,23) + rxt(k,178)*y(k,56) + rxt(k,179)*y(k,77) + mat(k,421) = mat(k,421) + rxt(k,170)*y(k,27) + rxt(k,178)*y(k,49) + mat(k,574) = rxt(k,161)*y(k,23) + mat(k,49) = rxt(k,259)*y(k,63) + mat(k,271) = mat(k,271) + rxt(k,259)*y(k,59) + mat(k,378) = mat(k,378) + rxt(k,160)*y(k,23) + mat(k,530) = rxt(k,188)*y(k,44) + mat(k,639) = mat(k,639) + rxt(k,179)*y(k,49) + mat(k,243) = -(rxt(k,168)*y(k,23) + rxt(k,170)*y(k,56) + rxt(k,171)*y(k,77) & + + (rxt(k,274) + rxt(k,279) + rxt(k,284)) * y(k,44)) + mat(k,465) = -rxt(k,168)*y(k,27) + mat(k,411) = -rxt(k,170)*y(k,27) + mat(k,629) = -rxt(k,171)*y(k,27) + mat(k,306) = -(rxt(k,274) + rxt(k,279) + rxt(k,284)) * y(k,27) + mat(k,439) = rxt(k,169)*y(k,54) + mat(k,592) = rxt(k,169)*y(k,26) + mat(k,92) = -((rxt(k,242) + rxt(k,246)) * y(k,77)) + mat(k,621) = -(rxt(k,242) + rxt(k,246)) * y(k,29) + mat(k,288) = rxt(k,191)*y(k,15) + mat(k,542) = rxt(k,191)*y(k,1) + rxt(k,155)*y(k,23) + rxt(k,235)*y(k,55) & + + rxt(k,236)*y(k,56) + rxt(k,237)*y(k,77) + mat(k,462) = rxt(k,155)*y(k,15) + mat(k,343) = rxt(k,235)*y(k,15) + mat(k,396) = rxt(k,236)*y(k,15) + rxt(k,249)*y(k,60) + mat(k,51) = rxt(k,249)*y(k,56) + rxt(k,250)*y(k,77) + mat(k,621) = mat(k,621) + rxt(k,237)*y(k,15) + rxt(k,250)*y(k,60) + mat(k,5) = -(rxt(k,216)*y(k,73)) + mat(k,517) = -rxt(k,216)*y(k,31) + mat(k,18) = -(rxt(k,217)*y(k,73)) + mat(k,519) = -rxt(k,217)*y(k,32) + mat(k,33) = -(rxt(k,247)*y(k,55) + (rxt(k,248) + rxt(k,261)) * y(k,77)) + mat(k,341) = -rxt(k,247)*y(k,33) + mat(k,617) = -(rxt(k,248) + rxt(k,261)) * y(k,33) + mat(k,125) = -(rxt(k,213)*y(k,36) + rxt(k,214)*y(k,81) + rxt(k,215)*y(k,46)) + mat(k,675) = -rxt(k,213)*y(k,34) + mat(k,724) = -rxt(k,214)*y(k,34) + mat(k,254) = -rxt(k,215)*y(k,34) + mat(k,6) = 2.000_r8*rxt(k,216)*y(k,73) + mat(k,19) = rxt(k,217)*y(k,73) + mat(k,520) = 2.000_r8*rxt(k,216)*y(k,31) + rxt(k,217)*y(k,32) + mat(k,280) = -((rxt(k,113) + rxt(k,114) + rxt(k,115)) * y(k,68) + rxt(k,116) & + *y(k,57) + rxt(k,119)*y(k,58)) + mat(k,371) = -(rxt(k,113) + rxt(k,114) + rxt(k,115)) * y(k,35) + mat(k,501) = -rxt(k,116)*y(k,35) + mat(k,569) = -rxt(k,119)*y(k,35) + mat(k,545) = rxt(k,237)*y(k,77) + mat(k,467) = rxt(k,157)*y(k,36) + mat(k,93) = rxt(k,246)*y(k,77) + mat(k,127) = rxt(k,213)*y(k,36) + mat(k,677) = rxt(k,157)*y(k,23) + rxt(k,213)*y(k,34) + rxt(k,111)*y(k,56) & + + rxt(k,94)*y(k,73) + rxt(k,120)*y(k,77) + mat(k,151) = rxt(k,211)*y(k,73) + mat(k,308) = rxt(k,188)*y(k,73) + mat(k,226) = rxt(k,143)*y(k,77) + mat(k,414) = rxt(k,111)*y(k,36) + rxt(k,123)*y(k,77) + mat(k,55) = rxt(k,250)*y(k,77) + mat(k,114) = rxt(k,255)*y(k,77) + mat(k,267) = rxt(k,260)*y(k,77) + mat(k,523) = rxt(k,94)*y(k,36) + rxt(k,211)*y(k,40) + rxt(k,188)*y(k,44) + mat(k,632) = rxt(k,237)*y(k,15) + rxt(k,246)*y(k,29) + rxt(k,120)*y(k,36) & + + rxt(k,143)*y(k,50) + rxt(k,123)*y(k,56) + rxt(k,250)*y(k,60) & + + rxt(k,255)*y(k,61) + rxt(k,260)*y(k,63) + mat(k,692) = -(rxt(k,94)*y(k,73) + rxt(k,111)*y(k,56) + rxt(k,120)*y(k,77) & + + rxt(k,157)*y(k,23) + rxt(k,213)*y(k,34)) + mat(k,539) = -rxt(k,94)*y(k,36) + mat(k,430) = -rxt(k,111)*y(k,36) + mat(k,648) = -rxt(k,120)*y(k,36) + mat(k,483) = -rxt(k,157)*y(k,36) + mat(k,131) = -rxt(k,213)*y(k,36) + mat(k,286) = rxt(k,113)*y(k,68) + mat(k,387) = rxt(k,113)*y(k,35) + mat(k,96) = -(rxt(k,112)*y(k,56) + rxt(k,121)*y(k,77) + rxt(k,158)*y(k,23)) + mat(k,397) = -rxt(k,112)*y(k,38) + mat(k,622) = -rxt(k,121)*y(k,38) + mat(k,463) = -rxt(k,158)*y(k,38) + mat(k,367) = 2.000_r8*rxt(k,127)*y(k,68) + mat(k,622) = mat(k,622) + 2.000_r8*rxt(k,126)*y(k,77) + mat(k,28) = rxt(k,263)*y(k,81) + mat(k,721) = rxt(k,263)*y(k,65) + mat(k,150) = -(rxt(k,204)*y(k,56) + rxt(k,205)*y(k,77) + (rxt(k,210) & + + rxt(k,211)) * y(k,73)) + mat(k,403) = -rxt(k,204)*y(k,40) + mat(k,626) = -rxt(k,205)*y(k,40) + mat(k,521) = -(rxt(k,210) + rxt(k,211)) * y(k,40) + mat(k,289) = rxt(k,191)*y(k,15) + rxt(k,192)*y(k,68) + mat(k,543) = rxt(k,191)*y(k,1) + mat(k,370) = rxt(k,192)*y(k,1) + mat(k,310) = -(rxt(k,175)*y(k,56) + rxt(k,176)*y(k,77) + (rxt(k,187) & + + rxt(k,188)) * y(k,73) + (rxt(k,269) + rxt(k,275) + rxt(k,280) & + ) * y(k,49) + (rxt(k,274) + rxt(k,279) + rxt(k,284)) * y(k,27) & + + (rxt(k,276) + rxt(k,281)) * y(k,48)) + mat(k,416) = -rxt(k,175)*y(k,44) + mat(k,634) = -rxt(k,176)*y(k,44) + mat(k,525) = -(rxt(k,187) + rxt(k,188)) * y(k,44) + mat(k,144) = -(rxt(k,269) + rxt(k,275) + rxt(k,280)) * y(k,44) + mat(k,245) = -(rxt(k,274) + rxt(k,279) + rxt(k,284)) * y(k,44) + mat(k,136) = -(rxt(k,276) + rxt(k,281)) * y(k,44) + mat(k,547) = rxt(k,155)*y(k,23) + mat(k,469) = rxt(k,155)*y(k,15) + rxt(k,157)*y(k,36) + rxt(k,158)*y(k,38) & + + rxt(k,177)*y(k,49) + rxt(k,159)*y(k,68) + mat(k,444) = rxt(k,174)*y(k,77) + mat(k,678) = rxt(k,157)*y(k,23) + mat(k,97) = rxt(k,158)*y(k,23) + mat(k,144) = mat(k,144) + rxt(k,177)*y(k,23) + mat(k,373) = rxt(k,159)*y(k,23) + mat(k,634) = mat(k,634) + rxt(k,174)*y(k,26) + end do + end subroutine nlnmat01 + subroutine nlnmat02( avec_len, mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + do k = 1,avec_len + mat(k,124) = rxt(k,213)*y(k,36) + rxt(k,215)*y(k,46) + rxt(k,214)*y(k,81) + mat(k,674) = rxt(k,213)*y(k,34) + mat(k,253) = rxt(k,215)*y(k,34) + mat(k,722) = rxt(k,214)*y(k,34) + mat(k,255) = -(rxt(k,152)*y(k,77) + rxt(k,215)*y(k,34)) + mat(k,630) = -rxt(k,152)*y(k,46) + mat(k,126) = -rxt(k,215)*y(k,46) + mat(k,544) = rxt(k,235)*y(k,55) + mat(k,244) = (rxt(k,274)+rxt(k,279)+rxt(k,284))*y(k,44) + mat(k,35) = rxt(k,247)*y(k,55) + mat(k,307) = (rxt(k,274)+rxt(k,279)+rxt(k,284))*y(k,27) + mat(k,593) = rxt(k,151)*y(k,77) + mat(k,345) = rxt(k,235)*y(k,15) + rxt(k,247)*y(k,33) + mat(k,630) = mat(k,630) + rxt(k,151)*y(k,54) + mat(k,64) = -(rxt(k,128)*y(k,77)) + mat(k,620) = -rxt(k,128)*y(k,47) + mat(k,587) = rxt(k,149)*y(k,68) + mat(k,366) = rxt(k,149)*y(k,54) + mat(k,134) = -(rxt(k,206)*y(k,56) + (rxt(k,276) + rxt(k,281)) * y(k,44)) + mat(k,401) = -rxt(k,206)*y(k,48) + mat(k,304) = -(rxt(k,276) + rxt(k,281)) * y(k,48) + mat(k,698) = rxt(k,198)*y(k,68) + mat(k,368) = rxt(k,198)*y(k,3) + mat(k,143) = -(rxt(k,177)*y(k,23) + rxt(k,178)*y(k,56) + rxt(k,179)*y(k,77) & + + (rxt(k,269) + rxt(k,275) + rxt(k,280)) * y(k,44)) + mat(k,464) = -rxt(k,177)*y(k,49) + mat(k,402) = -rxt(k,178)*y(k,49) + mat(k,625) = -rxt(k,179)*y(k,49) + mat(k,305) = -(rxt(k,269) + rxt(k,275) + rxt(k,280)) * y(k,49) + mat(k,437) = rxt(k,166)*y(k,68) + mat(k,242) = rxt(k,171)*y(k,77) + mat(k,369) = rxt(k,166)*y(k,26) + mat(k,625) = mat(k,625) + rxt(k,171)*y(k,27) + mat(k,225) = -(rxt(k,131)*y(k,53) + (rxt(k,132) + rxt(k,133) + rxt(k,134) & + ) * y(k,54) + rxt(k,135)*y(k,57) + rxt(k,143)*y(k,77) + rxt(k,297) & + *y(k,76)) + mat(k,655) = -rxt(k,131)*y(k,50) + mat(k,590) = -(rxt(k,132) + rxt(k,133) + rxt(k,134)) * y(k,50) + mat(k,498) = -rxt(k,135)*y(k,50) + mat(k,627) = -rxt(k,143)*y(k,50) + mat(k,184) = -rxt(k,297)*y(k,50) + mat(k,409) = rxt(k,129)*y(k,69) + rxt(k,294)*y(k,72) + mat(k,498) = mat(k,498) + rxt(k,295)*y(k,72) + mat(k,198) = 1.100_r8*rxt(k,290)*y(k,70) + .200_r8*rxt(k,288)*y(k,71) + mat(k,211) = rxt(k,129)*y(k,56) + mat(k,109) = 1.100_r8*rxt(k,290)*y(k,67) + mat(k,122) = .200_r8*rxt(k,288)*y(k,67) + mat(k,164) = rxt(k,294)*y(k,56) + rxt(k,295)*y(k,57) + mat(k,586) = rxt(k,150)*y(k,55) + mat(k,342) = rxt(k,150)*y(k,54) + mat(k,670) = -(rxt(k,131)*y(k,50) + rxt(k,140)*y(k,55) + rxt(k,144)*y(k,68) & + + rxt(k,145)*y(k,58) + rxt(k,146)*y(k,56) + rxt(k,167)*y(k,26) & + + rxt(k,199)*y(k,3) + rxt(k,239)*y(k,19) + rxt(k,299)*y(k,76)) + mat(k,233) = -rxt(k,131)*y(k,53) + mat(k,361) = -rxt(k,140)*y(k,53) + mat(k,386) = -rxt(k,144)*y(k,53) + mat(k,582) = -rxt(k,145)*y(k,53) + mat(k,429) = -rxt(k,146)*y(k,53) + mat(k,457) = -rxt(k,167)*y(k,53) + mat(k,717) = -rxt(k,199)*y(k,53) + mat(k,338) = -rxt(k,239)*y(k,53) + mat(k,188) = -rxt(k,299)*y(k,53) + mat(k,233) = mat(k,233) + 2.000_r8*rxt(k,133)*y(k,54) + rxt(k,135)*y(k,57) & + + rxt(k,143)*y(k,77) + mat(k,610) = 2.000_r8*rxt(k,133)*y(k,50) + rxt(k,136)*y(k,56) + rxt(k,256) & + *y(k,63) + mat(k,429) = mat(k,429) + rxt(k,136)*y(k,54) + mat(k,513) = rxt(k,135)*y(k,50) + rxt(k,130)*y(k,69) + mat(k,277) = rxt(k,256)*y(k,54) + mat(k,218) = rxt(k,130)*y(k,57) + mat(k,647) = rxt(k,143)*y(k,50) + mat(k,608) = -((rxt(k,132) + rxt(k,133) + rxt(k,134)) * y(k,50) + (rxt(k,136) & + + rxt(k,138)) * y(k,56) + rxt(k,137)*y(k,58) + rxt(k,149) & + *y(k,68) + rxt(k,150)*y(k,55) + rxt(k,151)*y(k,77) + rxt(k,169) & + *y(k,26) + rxt(k,200)*y(k,3) + rxt(k,256)*y(k,63)) + mat(k,231) = -(rxt(k,132) + rxt(k,133) + rxt(k,134)) * y(k,54) + mat(k,427) = -(rxt(k,136) + rxt(k,138)) * y(k,54) + mat(k,580) = -rxt(k,137)*y(k,54) + mat(k,384) = -rxt(k,149)*y(k,54) + mat(k,359) = -rxt(k,150)*y(k,54) + mat(k,645) = -rxt(k,151)*y(k,54) + mat(k,455) = -rxt(k,169)*y(k,54) + mat(k,715) = -rxt(k,200)*y(k,54) + mat(k,275) = -rxt(k,256)*y(k,54) + mat(k,715) = mat(k,715) + rxt(k,199)*y(k,53) + mat(k,336) = rxt(k,239)*y(k,53) + mat(k,455) = mat(k,455) + rxt(k,167)*y(k,53) + mat(k,68) = rxt(k,128)*y(k,77) + mat(k,668) = rxt(k,199)*y(k,3) + rxt(k,239)*y(k,19) + rxt(k,167)*y(k,26) & + + 2.000_r8*rxt(k,140)*y(k,55) + rxt(k,146)*y(k,56) + rxt(k,145) & + *y(k,58) + rxt(k,144)*y(k,68) + mat(k,359) = mat(k,359) + 2.000_r8*rxt(k,140)*y(k,53) + rxt(k,141)*y(k,56) & + + rxt(k,139)*y(k,68) + rxt(k,142)*y(k,77) + mat(k,427) = mat(k,427) + rxt(k,146)*y(k,53) + rxt(k,141)*y(k,55) + mat(k,580) = mat(k,580) + rxt(k,145)*y(k,53) + mat(k,384) = mat(k,384) + rxt(k,144)*y(k,53) + rxt(k,139)*y(k,55) + mat(k,645) = mat(k,645) + rxt(k,128)*y(k,47) + rxt(k,142)*y(k,55) + mat(k,350) = -(rxt(k,139)*y(k,68) + rxt(k,140)*y(k,53) + rxt(k,141)*y(k,56) & + + rxt(k,142)*y(k,77) + rxt(k,150)*y(k,54) + rxt(k,235)*y(k,15) & + + rxt(k,247)*y(k,33)) + mat(k,375) = -rxt(k,139)*y(k,55) + mat(k,659) = -rxt(k,140)*y(k,55) + mat(k,418) = -rxt(k,141)*y(k,55) + mat(k,636) = -rxt(k,142)*y(k,55) + mat(k,599) = -rxt(k,150)*y(k,55) + mat(k,549) = -rxt(k,235)*y(k,55) + mat(k,36) = -rxt(k,247)*y(k,55) + mat(k,88) = rxt(k,201)*y(k,56) + mat(k,471) = rxt(k,168)*y(k,27) + mat(k,246) = rxt(k,168)*y(k,23) + rxt(k,170)*y(k,56) + rxt(k,171)*y(k,77) + mat(k,129) = rxt(k,215)*y(k,46) + mat(k,258) = rxt(k,215)*y(k,34) + rxt(k,152)*y(k,77) + mat(k,599) = mat(k,599) + rxt(k,138)*y(k,56) + rxt(k,137)*y(k,58) + mat(k,418) = mat(k,418) + rxt(k,201)*y(k,4) + rxt(k,170)*y(k,27) + rxt(k,138) & + *y(k,54) + mat(k,571) = rxt(k,137)*y(k,54) + mat(k,636) = mat(k,636) + rxt(k,171)*y(k,27) + rxt(k,152)*y(k,46) + mat(k,420) = -(rxt(k,108)*y(k,58) + 4._r8*rxt(k,109)*y(k,56) + rxt(k,110) & + *y(k,57) + rxt(k,111)*y(k,36) + rxt(k,112)*y(k,38) + rxt(k,117) & + *y(k,68) + rxt(k,123)*y(k,77) + (rxt(k,136) + rxt(k,138) & + ) * y(k,54) + rxt(k,141)*y(k,55) + rxt(k,146)*y(k,53) + rxt(k,170) & + *y(k,27) + rxt(k,172)*y(k,26) + rxt(k,175)*y(k,44) + rxt(k,178) & + *y(k,49) + rxt(k,201)*y(k,4) + rxt(k,202)*y(k,3) + rxt(k,204) & + *y(k,40) + rxt(k,206)*y(k,48) + rxt(k,236)*y(k,15) + rxt(k,249) & + *y(k,60) + (rxt(k,292) + rxt(k,293)) * y(k,70) + rxt(k,294) & + *y(k,72)) + mat(k,573) = -rxt(k,108)*y(k,56) + mat(k,504) = -rxt(k,110)*y(k,56) + mat(k,682) = -rxt(k,111)*y(k,56) + mat(k,99) = -rxt(k,112)*y(k,56) + mat(k,377) = -rxt(k,117)*y(k,56) + mat(k,638) = -rxt(k,123)*y(k,56) + mat(k,601) = -(rxt(k,136) + rxt(k,138)) * y(k,56) + mat(k,352) = -rxt(k,141)*y(k,56) + mat(k,661) = -rxt(k,146)*y(k,56) + mat(k,247) = -rxt(k,170)*y(k,56) + mat(k,448) = -rxt(k,172)*y(k,56) + mat(k,314) = -rxt(k,175)*y(k,56) + mat(k,145) = -rxt(k,178)*y(k,56) + mat(k,89) = -rxt(k,201)*y(k,56) + mat(k,708) = -rxt(k,202)*y(k,56) + mat(k,153) = -rxt(k,204)*y(k,56) + mat(k,137) = -rxt(k,206)*y(k,56) + mat(k,551) = -rxt(k,236)*y(k,56) + mat(k,56) = -rxt(k,249)*y(k,56) + mat(k,110) = -(rxt(k,292) + rxt(k,293)) * y(k,56) + mat(k,165) = -rxt(k,294)*y(k,56) + mat(k,282) = rxt(k,115)*y(k,68) + mat(k,228) = rxt(k,131)*y(k,53) + rxt(k,132)*y(k,54) + rxt(k,135)*y(k,57) & + + rxt(k,297)*y(k,76) + mat(k,661) = mat(k,661) + rxt(k,131)*y(k,50) + mat(k,601) = mat(k,601) + rxt(k,132)*y(k,50) + mat(k,504) = mat(k,504) + rxt(k,135)*y(k,50) + rxt(k,251)*y(k,61) & + + rxt(k,257)*y(k,63) + rxt(k,296)*y(k,72) + (rxt(k,97)+rxt(k,98)) & + *y(k,73) + rxt(k,303)*y(k,78) + rxt(k,307)*y(k,79) + mat(k,115) = rxt(k,251)*y(k,57) + mat(k,270) = rxt(k,257)*y(k,57) + mat(k,201) = rxt(k,288)*y(k,71) + 1.150_r8*rxt(k,289)*y(k,76) + mat(k,377) = mat(k,377) + rxt(k,115)*y(k,35) + mat(k,214) = rxt(k,302)*y(k,78) + mat(k,123) = rxt(k,288)*y(k,67) + mat(k,165) = mat(k,165) + rxt(k,296)*y(k,57) + mat(k,529) = (rxt(k,97)+rxt(k,98))*y(k,57) + mat(k,185) = rxt(k,297)*y(k,50) + 1.150_r8*rxt(k,289)*y(k,67) + mat(k,638) = mat(k,638) + 2.000_r8*rxt(k,125)*y(k,77) + mat(k,177) = rxt(k,303)*y(k,57) + rxt(k,302)*y(k,69) + mat(k,82) = rxt(k,307)*y(k,57) + mat(k,507) = -(rxt(k,97)*y(k,73) + rxt(k,102)*y(k,74) + rxt(k,110)*y(k,56) & + + rxt(k,116)*y(k,35) + rxt(k,130)*y(k,69) + rxt(k,135)*y(k,50) & + + rxt(k,251)*y(k,61) + rxt(k,257)*y(k,63) + rxt(k,291)*y(k,70) & + + (rxt(k,295) + rxt(k,296)) * y(k,72) + rxt(k,303)*y(k,78) & + + rxt(k,307)*y(k,79)) + mat(k,532) = -rxt(k,97)*y(k,57) + mat(k,12) = -rxt(k,102)*y(k,57) + mat(k,423) = -rxt(k,110)*y(k,57) + mat(k,283) = -rxt(k,116)*y(k,57) + mat(k,215) = -rxt(k,130)*y(k,57) + mat(k,229) = -rxt(k,135)*y(k,57) + mat(k,116) = -rxt(k,251)*y(k,57) + mat(k,273) = -rxt(k,257)*y(k,57) + mat(k,111) = -rxt(k,291)*y(k,57) + mat(k,166) = -(rxt(k,295) + rxt(k,296)) * y(k,57) + mat(k,178) = -rxt(k,303)*y(k,57) + mat(k,83) = -rxt(k,307)*y(k,57) + mat(k,294) = rxt(k,193)*y(k,58) + rxt(k,192)*y(k,68) + mat(k,711) = 2.000_r8*rxt(k,194)*y(k,3) + (rxt(k,196)+rxt(k,197))*y(k,26) & + + rxt(k,202)*y(k,56) + rxt(k,198)*y(k,68) + mat(k,333) = rxt(k,238)*y(k,68) + mat(k,476) = rxt(k,161)*y(k,58) + rxt(k,159)*y(k,68) + mat(k,451) = (rxt(k,196)+rxt(k,197))*y(k,3) + (2.000_r8*rxt(k,163) & + +2.000_r8*rxt(k,164))*y(k,26) + rxt(k,172)*y(k,56) + rxt(k,166) & + *y(k,68) + rxt(k,174)*y(k,77) + mat(k,283) = mat(k,283) + rxt(k,119)*y(k,58) + rxt(k,113)*y(k,68) + mat(k,67) = rxt(k,128)*y(k,77) + mat(k,229) = mat(k,229) + rxt(k,134)*y(k,54) + mat(k,664) = rxt(k,145)*y(k,58) + rxt(k,299)*y(k,76) + mat(k,604) = rxt(k,134)*y(k,50) + rxt(k,136)*y(k,56) + rxt(k,137)*y(k,58) + mat(k,355) = rxt(k,141)*y(k,56) + rxt(k,139)*y(k,68) + mat(k,423) = mat(k,423) + rxt(k,202)*y(k,3) + rxt(k,172)*y(k,26) + rxt(k,136) & + *y(k,54) + rxt(k,141)*y(k,55) + 2.000_r8*rxt(k,109)*y(k,56) & + + 2.000_r8*rxt(k,108)*y(k,58) + rxt(k,117)*y(k,68) + rxt(k,101) & + *y(k,74) + rxt(k,123)*y(k,77) + mat(k,507) = mat(k,507) + 2.000_r8*rxt(k,102)*y(k,74) + mat(k,576) = rxt(k,193)*y(k,1) + rxt(k,161)*y(k,23) + rxt(k,119)*y(k,35) & + + rxt(k,145)*y(k,53) + rxt(k,137)*y(k,54) + 2.000_r8*rxt(k,108) & + *y(k,56) + rxt(k,252)*y(k,61) + rxt(k,258)*y(k,63) & + + 2.000_r8*rxt(k,118)*y(k,68) + 2.000_r8*rxt(k,99)*y(k,73) & + + rxt(k,124)*y(k,77) + mat(k,116) = mat(k,116) + rxt(k,252)*y(k,58) + mat(k,273) = mat(k,273) + rxt(k,258)*y(k,58) + mat(k,380) = rxt(k,192)*y(k,1) + rxt(k,198)*y(k,3) + rxt(k,238)*y(k,19) & + + rxt(k,159)*y(k,23) + rxt(k,166)*y(k,26) + rxt(k,113)*y(k,35) & + + rxt(k,139)*y(k,55) + rxt(k,117)*y(k,56) + 2.000_r8*rxt(k,118) & + *y(k,58) + 2.000_r8*rxt(k,127)*y(k,68) + rxt(k,122)*y(k,77) + mat(k,532) = mat(k,532) + 2.000_r8*rxt(k,99)*y(k,58) + mat(k,12) = mat(k,12) + rxt(k,101)*y(k,56) + 2.000_r8*rxt(k,102)*y(k,57) + mat(k,186) = rxt(k,299)*y(k,53) + mat(k,641) = rxt(k,174)*y(k,26) + rxt(k,128)*y(k,47) + rxt(k,123)*y(k,56) & + + rxt(k,124)*y(k,58) + rxt(k,122)*y(k,68) + end do + end subroutine nlnmat02 + subroutine nlnmat03( avec_len, mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + do k = 1,avec_len + mat(k,579) = -(rxt(k,99)*y(k,73) + rxt(k,108)*y(k,56) + rxt(k,118)*y(k,68) & + + rxt(k,119)*y(k,35) + rxt(k,124)*y(k,77) + rxt(k,137)*y(k,54) & + + rxt(k,145)*y(k,53) + rxt(k,161)*y(k,23) + rxt(k,193)*y(k,1) & + + rxt(k,252)*y(k,61) + rxt(k,258)*y(k,63)) + mat(k,535) = -rxt(k,99)*y(k,58) + mat(k,426) = -rxt(k,108)*y(k,58) + mat(k,383) = -rxt(k,118)*y(k,58) + mat(k,284) = -rxt(k,119)*y(k,58) + mat(k,644) = -rxt(k,124)*y(k,58) + mat(k,607) = -rxt(k,137)*y(k,58) + mat(k,667) = -rxt(k,145)*y(k,58) + mat(k,479) = -rxt(k,161)*y(k,58) + mat(k,297) = -rxt(k,193)*y(k,58) + mat(k,117) = -rxt(k,252)*y(k,58) + mat(k,274) = -rxt(k,258)*y(k,58) + mat(k,426) = mat(k,426) + rxt(k,110)*y(k,57) + mat(k,510) = rxt(k,110)*y(k,56) + mat(k,45) = -(rxt(k,259)*y(k,63)) + mat(k,263) = -rxt(k,259)*y(k,59) + mat(k,696) = rxt(k,195)*y(k,26) + mat(k,436) = rxt(k,195)*y(k,3) + 2.000_r8*rxt(k,165)*y(k,26) + mat(k,50) = -(rxt(k,249)*y(k,56) + rxt(k,250)*y(k,77)) + mat(k,392) = -rxt(k,249)*y(k,60) + mat(k,618) = -rxt(k,250)*y(k,60) + mat(k,112) = -(rxt(k,251)*y(k,57) + rxt(k,252)*y(k,58) + rxt(k,255)*y(k,77)) + mat(k,491) = -rxt(k,251)*y(k,61) + mat(k,566) = -rxt(k,252)*y(k,61) + mat(k,623) = -rxt(k,255)*y(k,61) + mat(k,266) = -(rxt(k,253)*y(k,3) + rxt(k,254)*y(k,26) + rxt(k,256)*y(k,54) & + + rxt(k,257)*y(k,57) + rxt(k,258)*y(k,58) + rxt(k,259)*y(k,59) & + + rxt(k,260)*y(k,77)) + mat(k,701) = -rxt(k,253)*y(k,63) + mat(k,441) = -rxt(k,254)*y(k,63) + mat(k,594) = -rxt(k,256)*y(k,63) + mat(k,500) = -rxt(k,257)*y(k,63) + mat(k,568) = -rxt(k,258)*y(k,63) + mat(k,47) = -rxt(k,259)*y(k,63) + mat(k,631) = -rxt(k,260)*y(k,63) + mat(k,413) = rxt(k,249)*y(k,60) + mat(k,500) = mat(k,500) + rxt(k,251)*y(k,61) + mat(k,568) = mat(k,568) + rxt(k,252)*y(k,61) + mat(k,54) = rxt(k,249)*y(k,56) + mat(k,113) = rxt(k,251)*y(k,57) + rxt(k,252)*y(k,58) + rxt(k,255)*y(k,77) + mat(k,631) = mat(k,631) + rxt(k,255)*y(k,61) + mat(k,235) = -(rxt(k,262)*y(k,77)) + mat(k,628) = -rxt(k,262)*y(k,64) + mat(k,699) = rxt(k,253)*y(k,63) + mat(k,438) = rxt(k,254)*y(k,63) + mat(k,34) = rxt(k,247)*y(k,55) + (rxt(k,248)+.500_r8*rxt(k,261))*y(k,77) + mat(k,591) = rxt(k,256)*y(k,63) + mat(k,344) = rxt(k,247)*y(k,33) + mat(k,499) = rxt(k,257)*y(k,63) + mat(k,567) = rxt(k,258)*y(k,63) + mat(k,46) = rxt(k,259)*y(k,63) + mat(k,53) = rxt(k,250)*y(k,77) + mat(k,265) = rxt(k,253)*y(k,3) + rxt(k,254)*y(k,26) + rxt(k,256)*y(k,54) & + + rxt(k,257)*y(k,57) + rxt(k,258)*y(k,58) + rxt(k,259)*y(k,59) & + + rxt(k,260)*y(k,77) + mat(k,628) = mat(k,628) + (rxt(k,248)+.500_r8*rxt(k,261))*y(k,33) & + + rxt(k,250)*y(k,60) + rxt(k,260)*y(k,63) + mat(k,29) = -(rxt(k,263)*y(k,81)) + mat(k,723) = -rxt(k,263)*y(k,65) + mat(k,234) = rxt(k,262)*y(k,77) + mat(k,616) = rxt(k,262)*y(k,64) + mat(k,196) = -(rxt(k,288)*y(k,71) + rxt(k,289)*y(k,76) + rxt(k,290)*y(k,70)) + mat(k,120) = -rxt(k,288)*y(k,67) + mat(k,182) = -rxt(k,289)*y(k,67) + mat(k,107) = -rxt(k,290)*y(k,67) + mat(k,376) = -((rxt(k,113) + rxt(k,114) + rxt(k,115)) * y(k,35) + rxt(k,117) & + *y(k,56) + rxt(k,118)*y(k,58) + rxt(k,122)*y(k,77) & + + 4._r8*rxt(k,127)*y(k,68) + rxt(k,139)*y(k,55) + rxt(k,144) & + *y(k,53) + rxt(k,149)*y(k,54) + (rxt(k,159) + rxt(k,160) & + ) * y(k,23) + rxt(k,166)*y(k,26) + rxt(k,192)*y(k,1) + rxt(k,198) & + *y(k,3) + rxt(k,238)*y(k,19)) + mat(k,281) = -(rxt(k,113) + rxt(k,114) + rxt(k,115)) * y(k,68) + mat(k,419) = -rxt(k,117)*y(k,68) + mat(k,572) = -rxt(k,118)*y(k,68) + mat(k,637) = -rxt(k,122)*y(k,68) + mat(k,351) = -rxt(k,139)*y(k,68) + mat(k,660) = -rxt(k,144)*y(k,68) + mat(k,600) = -rxt(k,149)*y(k,68) + mat(k,472) = -(rxt(k,159) + rxt(k,160)) * y(k,68) + mat(k,447) = -rxt(k,166)*y(k,68) + mat(k,292) = -rxt(k,192)*y(k,68) + mat(k,707) = -rxt(k,198)*y(k,68) + mat(k,329) = -rxt(k,238)*y(k,68) + mat(k,292) = mat(k,292) + rxt(k,191)*y(k,15) + mat(k,707) = mat(k,707) + rxt(k,203)*y(k,77) + mat(k,550) = rxt(k,191)*y(k,1) + rxt(k,155)*y(k,23) + rxt(k,235)*y(k,55) & + + rxt(k,236)*y(k,56) + mat(k,329) = mat(k,329) + rxt(k,162)*y(k,26) + rxt(k,239)*y(k,53) + mat(k,472) = mat(k,472) + rxt(k,155)*y(k,15) + rxt(k,158)*y(k,38) + mat(k,447) = mat(k,447) + rxt(k,162)*y(k,19) + rxt(k,173)*y(k,77) + mat(k,94) = rxt(k,242)*y(k,77) + mat(k,37) = .500_r8*rxt(k,261)*y(k,77) + mat(k,281) = mat(k,281) + rxt(k,116)*y(k,57) + mat(k,98) = rxt(k,158)*y(k,23) + rxt(k,112)*y(k,56) + rxt(k,121)*y(k,77) + mat(k,660) = mat(k,660) + rxt(k,239)*y(k,19) + mat(k,351) = mat(k,351) + rxt(k,235)*y(k,15) + rxt(k,142)*y(k,77) + mat(k,419) = mat(k,419) + rxt(k,236)*y(k,15) + rxt(k,112)*y(k,38) + mat(k,503) = rxt(k,116)*y(k,35) + mat(k,572) = mat(k,572) + rxt(k,124)*y(k,77) + mat(k,237) = rxt(k,262)*y(k,77) + mat(k,637) = mat(k,637) + rxt(k,203)*y(k,3) + rxt(k,173)*y(k,26) + rxt(k,242) & + *y(k,29) + .500_r8*rxt(k,261)*y(k,33) + rxt(k,121)*y(k,38) & + + rxt(k,142)*y(k,55) + rxt(k,124)*y(k,58) + rxt(k,262)*y(k,64) + mat(k,210) = -(rxt(k,129)*y(k,56) + rxt(k,130)*y(k,57) + rxt(k,302)*y(k,78)) + mat(k,408) = -rxt(k,129)*y(k,69) + mat(k,497) = -rxt(k,130)*y(k,69) + mat(k,173) = -rxt(k,302)*y(k,69) + mat(k,408) = mat(k,408) + rxt(k,292)*y(k,70) + mat(k,197) = .900_r8*rxt(k,290)*y(k,70) + .800_r8*rxt(k,288)*y(k,71) + mat(k,108) = rxt(k,292)*y(k,56) + .900_r8*rxt(k,290)*y(k,67) + mat(k,121) = .800_r8*rxt(k,288)*y(k,67) + mat(k,103) = -(rxt(k,290)*y(k,67) + rxt(k,291)*y(k,57) + (rxt(k,292) & + + rxt(k,293)) * y(k,56)) + mat(k,191) = -rxt(k,290)*y(k,70) + mat(k,490) = -rxt(k,291)*y(k,70) + mat(k,398) = -(rxt(k,292) + rxt(k,293)) * y(k,70) + mat(k,119) = -(rxt(k,288)*y(k,67)) + mat(k,192) = -rxt(k,288)*y(k,71) + mat(k,219) = rxt(k,297)*y(k,76) + mat(k,651) = rxt(k,299)*y(k,76) + mat(k,400) = rxt(k,292)*y(k,70) + mat(k,492) = rxt(k,296)*y(k,72) + mat(k,104) = rxt(k,292)*y(k,56) + mat(k,158) = rxt(k,296)*y(k,57) + mat(k,180) = rxt(k,297)*y(k,50) + rxt(k,299)*y(k,53) + mat(k,159) = -(rxt(k,294)*y(k,56) + (rxt(k,295) + rxt(k,296)) * y(k,57)) + mat(k,404) = -rxt(k,294)*y(k,72) + mat(k,493) = -(rxt(k,295) + rxt(k,296)) * y(k,72) + mat(k,206) = rxt(k,302)*y(k,78) + mat(k,169) = rxt(k,302)*y(k,69) + mat(k,533) = -(rxt(k,94)*y(k,36) + rxt(k,95)*y(k,81) + (rxt(k,97) + rxt(k,98) & + ) * y(k,57) + rxt(k,99)*y(k,58) + (rxt(k,187) + rxt(k,188) & + ) * y(k,44) + (rxt(k,210) + rxt(k,211)) * y(k,40) + rxt(k,216) & + *y(k,31) + rxt(k,217)*y(k,32)) + mat(k,686) = -rxt(k,94)*y(k,73) + mat(k,737) = -rxt(k,95)*y(k,73) + mat(k,508) = -(rxt(k,97) + rxt(k,98)) * y(k,73) + mat(k,577) = -rxt(k,99)*y(k,73) + mat(k,318) = -(rxt(k,187) + rxt(k,188)) * y(k,73) + mat(k,154) = -(rxt(k,210) + rxt(k,211)) * y(k,73) + mat(k,7) = -rxt(k,216)*y(k,73) + mat(k,21) = -rxt(k,217)*y(k,73) + mat(k,508) = mat(k,508) + rxt(k,130)*y(k,69) + mat(k,203) = .850_r8*rxt(k,289)*y(k,76) + mat(k,216) = rxt(k,130)*y(k,57) + mat(k,187) = .850_r8*rxt(k,289)*y(k,67) + mat(k,11) = -(rxt(k,101)*y(k,56) + rxt(k,102)*y(k,57)) + mat(k,390) = -rxt(k,101)*y(k,74) + mat(k,486) = -rxt(k,102)*y(k,74) + mat(k,390) = mat(k,390) + rxt(k,105)*y(k,75) + mat(k,486) = mat(k,486) + rxt(k,106)*y(k,75) + mat(k,564) = rxt(k,107)*y(k,75) + mat(k,13) = rxt(k,105)*y(k,56) + rxt(k,106)*y(k,57) + rxt(k,107)*y(k,58) + mat(k,14) = -(rxt(k,105)*y(k,56) + rxt(k,106)*y(k,57) + rxt(k,107)*y(k,58)) + mat(k,391) = -rxt(k,105)*y(k,75) + mat(k,487) = -rxt(k,106)*y(k,75) + mat(k,565) = -rxt(k,107)*y(k,75) + mat(k,487) = mat(k,487) + rxt(k,97)*y(k,73) + mat(k,518) = rxt(k,97)*y(k,57) + mat(k,181) = -(rxt(k,289)*y(k,67) + rxt(k,297)*y(k,50) + rxt(k,299)*y(k,53)) + mat(k,195) = -rxt(k,289)*y(k,76) + mat(k,222) = -rxt(k,297)*y(k,76) + mat(k,652) = -rxt(k,299)*y(k,76) + mat(k,495) = rxt(k,291)*y(k,70) + rxt(k,295)*y(k,72) + rxt(k,303)*y(k,78) & + + rxt(k,307)*y(k,79) + mat(k,106) = rxt(k,291)*y(k,57) + mat(k,161) = rxt(k,295)*y(k,57) + mat(k,171) = rxt(k,303)*y(k,57) + mat(k,81) = rxt(k,307)*y(k,57) + mat(k,646) = -(rxt(k,120)*y(k,36) + rxt(k,121)*y(k,38) + rxt(k,122)*y(k,68) & + + rxt(k,123)*y(k,56) + rxt(k,124)*y(k,58) + (4._r8*rxt(k,125) & + + 4._r8*rxt(k,126)) * y(k,77) + rxt(k,128)*y(k,47) + rxt(k,142) & + *y(k,55) + rxt(k,143)*y(k,50) + rxt(k,151)*y(k,54) + rxt(k,152) & + *y(k,46) + rxt(k,171)*y(k,27) + (rxt(k,173) + rxt(k,174) & + ) * y(k,26) + rxt(k,176)*y(k,44) + rxt(k,179)*y(k,49) + rxt(k,203) & + *y(k,3) + rxt(k,205)*y(k,40) + rxt(k,237)*y(k,15) + rxt(k,240) & + *y(k,20) + (rxt(k,242) + rxt(k,246)) * y(k,29) + (rxt(k,248) & + + rxt(k,261)) * y(k,33) + rxt(k,250)*y(k,60) + rxt(k,255) & + *y(k,61) + rxt(k,260)*y(k,63) + rxt(k,262)*y(k,64)) + mat(k,690) = -rxt(k,120)*y(k,77) + mat(k,101) = -rxt(k,121)*y(k,77) + mat(k,385) = -rxt(k,122)*y(k,77) + mat(k,428) = -rxt(k,123)*y(k,77) + mat(k,581) = -rxt(k,124)*y(k,77) + mat(k,69) = -rxt(k,128)*y(k,77) + mat(k,360) = -rxt(k,142)*y(k,77) + mat(k,232) = -rxt(k,143)*y(k,77) + mat(k,609) = -rxt(k,151)*y(k,77) + mat(k,260) = -rxt(k,152)*y(k,77) + mat(k,251) = -rxt(k,171)*y(k,77) + mat(k,456) = -(rxt(k,173) + rxt(k,174)) * y(k,77) + mat(k,322) = -rxt(k,176)*y(k,77) + mat(k,148) = -rxt(k,179)*y(k,77) + mat(k,716) = -rxt(k,203)*y(k,77) + mat(k,155) = -rxt(k,205)*y(k,77) + mat(k,559) = -rxt(k,237)*y(k,77) + mat(k,62) = -rxt(k,240)*y(k,77) + mat(k,95) = -(rxt(k,242) + rxt(k,246)) * y(k,77) + mat(k,38) = -(rxt(k,248) + rxt(k,261)) * y(k,77) + mat(k,57) = -rxt(k,250)*y(k,77) + mat(k,118) = -rxt(k,255)*y(k,77) + mat(k,276) = -rxt(k,260)*y(k,77) + mat(k,239) = -rxt(k,262)*y(k,77) + mat(k,559) = mat(k,559) + rxt(k,236)*y(k,56) + mat(k,62) = mat(k,62) + .300_r8*rxt(k,240)*y(k,77) + mat(k,481) = rxt(k,160)*y(k,68) + mat(k,130) = rxt(k,214)*y(k,81) + mat(k,285) = rxt(k,119)*y(k,58) + 2.000_r8*rxt(k,114)*y(k,68) + mat(k,690) = mat(k,690) + rxt(k,111)*y(k,56) + rxt(k,94)*y(k,73) + mat(k,101) = mat(k,101) + rxt(k,112)*y(k,56) + mat(k,155) = mat(k,155) + rxt(k,204)*y(k,56) + rxt(k,210)*y(k,73) + mat(k,322) = mat(k,322) + rxt(k,175)*y(k,56) + rxt(k,187)*y(k,73) + mat(k,139) = rxt(k,206)*y(k,56) + mat(k,148) = mat(k,148) + rxt(k,178)*y(k,56) + mat(k,669) = rxt(k,144)*y(k,68) + mat(k,360) = mat(k,360) + rxt(k,139)*y(k,68) + mat(k,428) = mat(k,428) + rxt(k,236)*y(k,15) + rxt(k,111)*y(k,36) & + + rxt(k,112)*y(k,38) + rxt(k,204)*y(k,40) + rxt(k,175)*y(k,44) & + + rxt(k,206)*y(k,48) + rxt(k,178)*y(k,49) + rxt(k,117)*y(k,68) + mat(k,581) = mat(k,581) + rxt(k,119)*y(k,35) + rxt(k,118)*y(k,68) + mat(k,385) = mat(k,385) + rxt(k,160)*y(k,23) + 2.000_r8*rxt(k,114)*y(k,35) & + + rxt(k,144)*y(k,53) + rxt(k,139)*y(k,55) + rxt(k,117)*y(k,56) & + + rxt(k,118)*y(k,58) + mat(k,537) = rxt(k,94)*y(k,36) + rxt(k,210)*y(k,40) + rxt(k,187)*y(k,44) & + + 2.000_r8*rxt(k,95)*y(k,81) + mat(k,646) = mat(k,646) + .300_r8*rxt(k,240)*y(k,20) + mat(k,741) = rxt(k,214)*y(k,34) + 2.000_r8*rxt(k,95)*y(k,73) + end do + end subroutine nlnmat03 + subroutine nlnmat04( avec_len, mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + do k = 1,avec_len + mat(k,170) = -(rxt(k,302)*y(k,69) + rxt(k,303)*y(k,57)) + mat(k,207) = -rxt(k,302)*y(k,78) + mat(k,494) = -rxt(k,303)*y(k,78) + mat(k,405) = rxt(k,293)*y(k,70) + rxt(k,294)*y(k,72) + rxt(k,306)*y(k,79) & + + rxt(k,312)*y(k,80) + mat(k,194) = rxt(k,304)*y(k,79) + rxt(k,309)*y(k,80) + mat(k,105) = rxt(k,293)*y(k,56) + mat(k,160) = rxt(k,294)*y(k,56) + mat(k,80) = rxt(k,306)*y(k,56) + rxt(k,304)*y(k,67) + mat(k,75) = rxt(k,312)*y(k,56) + rxt(k,309)*y(k,67) + mat(k,78) = -(rxt(k,304)*y(k,67) + rxt(k,306)*y(k,56) + rxt(k,307)*y(k,57)) + mat(k,190) = -rxt(k,304)*y(k,79) + mat(k,394) = -rxt(k,306)*y(k,79) + mat(k,489) = -rxt(k,307)*y(k,79) + mat(k,190) = mat(k,190) + rxt(k,308)*y(k,80) + mat(k,72) = rxt(k,308)*y(k,67) + mat(k,71) = -((rxt(k,308) + rxt(k,309)) * y(k,67) + rxt(k,312)*y(k,56)) + mat(k,189) = -(rxt(k,308) + rxt(k,309)) * y(k,80) + mat(k,393) = -rxt(k,312)*y(k,80) + mat(k,745) = -(rxt(k,95)*y(k,73) + rxt(k,214)*y(k,34) + rxt(k,263)*y(k,65)) + mat(k,541) = -rxt(k,95)*y(k,81) + mat(k,132) = -rxt(k,214)*y(k,81) + mat(k,32) = -rxt(k,263)*y(k,81) + mat(k,563) = rxt(k,237)*y(k,77) + mat(k,63) = rxt(k,240)*y(k,77) + mat(k,287) = rxt(k,115)*y(k,68) + mat(k,694) = rxt(k,120)*y(k,77) + mat(k,102) = rxt(k,121)*y(k,77) + mat(k,157) = rxt(k,205)*y(k,77) + mat(k,325) = (rxt(k,276)+rxt(k,281))*y(k,48) + (rxt(k,269)+rxt(k,275) & + +rxt(k,280))*y(k,49) + rxt(k,176)*y(k,77) + mat(k,262) = rxt(k,152)*y(k,77) + mat(k,70) = rxt(k,128)*y(k,77) + mat(k,141) = (rxt(k,276)+rxt(k,281))*y(k,44) + mat(k,149) = (rxt(k,269)+rxt(k,275)+rxt(k,280))*y(k,44) + rxt(k,179)*y(k,77) + mat(k,389) = rxt(k,115)*y(k,35) + rxt(k,122)*y(k,77) + mat(k,650) = rxt(k,237)*y(k,15) + rxt(k,240)*y(k,20) + rxt(k,120)*y(k,36) & + + rxt(k,121)*y(k,38) + rxt(k,205)*y(k,40) + rxt(k,176)*y(k,44) & + + rxt(k,152)*y(k,46) + rxt(k,128)*y(k,47) + rxt(k,179)*y(k,49) & + + rxt(k,122)*y(k,68) + 2.000_r8*rxt(k,125)*y(k,77) + end do + end subroutine nlnmat04 + subroutine nlnmat_finit( avec_len, mat, lmat, dti ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: dti(veclen) + real(r8), intent(in) :: lmat(veclen,nzcnt) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + do k = 1,avec_len + mat(k, 1) = lmat(k, 1) + mat(k, 2) = lmat(k, 2) + mat(k, 3) = lmat(k, 3) + mat(k, 4) = lmat(k, 4) + mat(k, 5) = mat(k, 5) + lmat(k, 5) + mat(k, 6) = mat(k, 6) + lmat(k, 6) + mat(k, 8) = lmat(k, 8) + mat(k, 9) = lmat(k, 9) + mat(k, 10) = lmat(k, 10) + mat(k, 11) = mat(k, 11) + lmat(k, 11) + mat(k, 12) = mat(k, 12) + lmat(k, 12) + mat(k, 13) = mat(k, 13) + lmat(k, 13) + mat(k, 14) = mat(k, 14) + lmat(k, 14) + mat(k, 15) = lmat(k, 15) + mat(k, 16) = lmat(k, 16) + mat(k, 17) = lmat(k, 17) + mat(k, 18) = mat(k, 18) + lmat(k, 18) + mat(k, 19) = mat(k, 19) + lmat(k, 19) + mat(k, 20) = mat(k, 20) + lmat(k, 20) + mat(k, 22) = lmat(k, 22) + mat(k, 23) = lmat(k, 23) + mat(k, 24) = lmat(k, 24) + mat(k, 25) = lmat(k, 25) + mat(k, 26) = lmat(k, 26) + mat(k, 27) = lmat(k, 27) + mat(k, 29) = mat(k, 29) + lmat(k, 29) + mat(k, 30) = lmat(k, 30) + mat(k, 31) = lmat(k, 31) + mat(k, 33) = mat(k, 33) + lmat(k, 33) + mat(k, 39) = lmat(k, 39) + mat(k, 40) = lmat(k, 40) + mat(k, 41) = lmat(k, 41) + mat(k, 42) = lmat(k, 42) + mat(k, 43) = lmat(k, 43) + mat(k, 44) = lmat(k, 44) + mat(k, 45) = mat(k, 45) + lmat(k, 45) + mat(k, 48) = lmat(k, 48) + mat(k, 49) = mat(k, 49) + lmat(k, 49) + mat(k, 50) = mat(k, 50) + lmat(k, 50) + mat(k, 51) = mat(k, 51) + lmat(k, 51) + mat(k, 52) = lmat(k, 52) + mat(k, 58) = mat(k, 58) + lmat(k, 58) + mat(k, 59) = lmat(k, 59) + mat(k, 61) = mat(k, 61) + lmat(k, 61) + mat(k, 62) = mat(k, 62) + lmat(k, 62) + mat(k, 64) = mat(k, 64) + lmat(k, 64) + mat(k, 65) = lmat(k, 65) + mat(k, 66) = lmat(k, 66) + mat(k, 68) = mat(k, 68) + lmat(k, 68) + mat(k, 69) = mat(k, 69) + lmat(k, 69) + mat(k, 71) = mat(k, 71) + lmat(k, 71) + mat(k, 72) = mat(k, 72) + lmat(k, 72) + mat(k, 73) = lmat(k, 73) + mat(k, 74) = lmat(k, 74) + mat(k, 75) = mat(k, 75) + lmat(k, 75) + mat(k, 76) = lmat(k, 76) + mat(k, 77) = lmat(k, 77) + mat(k, 78) = mat(k, 78) + lmat(k, 78) + mat(k, 79) = lmat(k, 79) + mat(k, 80) = mat(k, 80) + lmat(k, 80) + mat(k, 82) = mat(k, 82) + lmat(k, 82) + mat(k, 84) = mat(k, 84) + lmat(k, 84) + mat(k, 85) = lmat(k, 85) + mat(k, 86) = lmat(k, 86) + mat(k, 87) = lmat(k, 87) + mat(k, 88) = mat(k, 88) + lmat(k, 88) + mat(k, 90) = lmat(k, 90) + mat(k, 91) = mat(k, 91) + lmat(k, 91) + mat(k, 92) = mat(k, 92) + lmat(k, 92) + mat(k, 96) = mat(k, 96) + lmat(k, 96) + mat(k, 101) = mat(k, 101) + lmat(k, 101) + mat(k, 103) = mat(k, 103) + lmat(k, 103) + mat(k, 112) = mat(k, 112) + lmat(k, 112) + mat(k, 119) = mat(k, 119) + lmat(k, 119) + mat(k, 124) = mat(k, 124) + lmat(k, 124) + mat(k, 125) = mat(k, 125) + lmat(k, 125) + mat(k, 128) = lmat(k, 128) + mat(k, 134) = mat(k, 134) + lmat(k, 134) + mat(k, 135) = lmat(k, 135) + mat(k, 139) = mat(k, 139) + lmat(k, 139) + mat(k, 143) = mat(k, 143) + lmat(k, 143) + mat(k, 147) = mat(k, 147) + lmat(k, 147) + mat(k, 148) = mat(k, 148) + lmat(k, 148) + mat(k, 150) = mat(k, 150) + lmat(k, 150) + mat(k, 151) = mat(k, 151) + lmat(k, 151) + mat(k, 152) = mat(k, 152) + lmat(k, 152) + mat(k, 159) = mat(k, 159) + lmat(k, 159) + mat(k, 167) = lmat(k, 167) + mat(k, 168) = lmat(k, 168) + mat(k, 170) = mat(k, 170) + lmat(k, 170) + mat(k, 171) = mat(k, 171) + lmat(k, 171) + mat(k, 174) = lmat(k, 174) + mat(k, 180) = mat(k, 180) + lmat(k, 180) + mat(k, 181) = mat(k, 181) + lmat(k, 181) + mat(k, 188) = mat(k, 188) + lmat(k, 188) + mat(k, 196) = mat(k, 196) + lmat(k, 196) + mat(k, 210) = mat(k, 210) + lmat(k, 210) + mat(k, 220) = lmat(k, 220) + mat(k, 223) = lmat(k, 223) + mat(k, 225) = mat(k, 225) + lmat(k, 225) + mat(k, 235) = mat(k, 235) + lmat(k, 235) + mat(k, 236) = lmat(k, 236) + mat(k, 238) = lmat(k, 238) + mat(k, 242) = mat(k, 242) + lmat(k, 242) + mat(k, 243) = mat(k, 243) + lmat(k, 243) + mat(k, 244) = mat(k, 244) + lmat(k, 244) + mat(k, 246) = mat(k, 246) + lmat(k, 246) + mat(k, 248) = mat(k, 248) + lmat(k, 248) + mat(k, 249) = mat(k, 249) + lmat(k, 249) + mat(k, 250) = lmat(k, 250) + mat(k, 255) = mat(k, 255) + lmat(k, 255) + mat(k, 259) = lmat(k, 259) + mat(k, 260) = mat(k, 260) + lmat(k, 260) + mat(k, 264) = lmat(k, 264) + mat(k, 266) = mat(k, 266) + lmat(k, 266) + mat(k, 270) = mat(k, 270) + lmat(k, 270) + mat(k, 280) = mat(k, 280) + lmat(k, 280) + mat(k, 291) = mat(k, 291) + lmat(k, 291) + mat(k, 308) = mat(k, 308) + lmat(k, 308) + mat(k, 310) = mat(k, 310) + lmat(k, 310) + mat(k, 316) = mat(k, 316) + lmat(k, 316) + mat(k, 328) = mat(k, 328) + lmat(k, 328) + mat(k, 345) = mat(k, 345) + lmat(k, 345) + mat(k, 350) = mat(k, 350) + lmat(k, 350) + mat(k, 352) = mat(k, 352) + lmat(k, 352) + mat(k, 355) = mat(k, 355) + lmat(k, 355) + mat(k, 359) = mat(k, 359) + lmat(k, 359) + mat(k, 361) = mat(k, 361) + lmat(k, 361) + mat(k, 376) = mat(k, 376) + lmat(k, 376) + mat(k, 389) = mat(k, 389) + lmat(k, 389) + mat(k, 393) = mat(k, 393) + lmat(k, 393) + mat(k, 394) = mat(k, 394) + lmat(k, 394) + mat(k, 405) = mat(k, 405) + lmat(k, 405) + mat(k, 407) = lmat(k, 407) + mat(k, 420) = mat(k, 420) + lmat(k, 420) + mat(k, 448) = mat(k, 448) + lmat(k, 448) + mat(k, 449) = mat(k, 449) + lmat(k, 449) + mat(k, 450) = mat(k, 450) + lmat(k, 450) + mat(k, 462) = mat(k, 462) + lmat(k, 462) + mat(k, 468) = lmat(k, 468) + mat(k, 469) = mat(k, 469) + lmat(k, 469) + mat(k, 470) = lmat(k, 470) + mat(k, 472) = mat(k, 472) + lmat(k, 472) + mat(k, 475) = mat(k, 475) + lmat(k, 475) + mat(k, 488) = lmat(k, 488) + mat(k, 489) = mat(k, 489) + lmat(k, 489) + mat(k, 494) = mat(k, 494) + lmat(k, 494) + mat(k, 495) = mat(k, 495) + lmat(k, 495) + mat(k, 496) = lmat(k, 496) + mat(k, 504) = mat(k, 504) + lmat(k, 504) + mat(k, 507) = mat(k, 507) + lmat(k, 507) + mat(k, 508) = mat(k, 508) + lmat(k, 508) + mat(k, 517) = mat(k, 517) + lmat(k, 517) + mat(k, 519) = mat(k, 519) + lmat(k, 519) + mat(k, 520) = mat(k, 520) + lmat(k, 520) + mat(k, 523) = mat(k, 523) + lmat(k, 523) + mat(k, 524) = mat(k, 524) + lmat(k, 524) + mat(k, 526) = lmat(k, 526) + mat(k, 528) = lmat(k, 528) + mat(k, 529) = mat(k, 529) + lmat(k, 529) + mat(k, 531) = mat(k, 531) + lmat(k, 531) + mat(k, 532) = mat(k, 532) + lmat(k, 532) + mat(k, 533) = mat(k, 533) + lmat(k, 533) + mat(k, 534) = lmat(k, 534) + mat(k, 537) = mat(k, 537) + lmat(k, 537) + mat(k, 538) = lmat(k, 538) + mat(k, 539) = mat(k, 539) + lmat(k, 539) + mat(k, 542) = mat(k, 542) + lmat(k, 542) + mat(k, 545) = mat(k, 545) + lmat(k, 545) + mat(k, 556) = mat(k, 556) + lmat(k, 556) + mat(k, 561) = lmat(k, 561) + mat(k, 564) = mat(k, 564) + lmat(k, 564) + mat(k, 573) = mat(k, 573) + lmat(k, 573) + mat(k, 576) = mat(k, 576) + lmat(k, 576) + mat(k, 577) = mat(k, 577) + lmat(k, 577) + mat(k, 579) = mat(k, 579) + lmat(k, 579) + mat(k, 593) = mat(k, 593) + lmat(k, 593) + mat(k, 601) = mat(k, 601) + lmat(k, 601) + mat(k, 608) = mat(k, 608) + lmat(k, 608) + mat(k, 609) = mat(k, 609) + lmat(k, 609) + mat(k, 610) = mat(k, 610) + lmat(k, 610) + mat(k, 614) = lmat(k, 614) + mat(k, 615) = lmat(k, 615) + mat(k, 633) = mat(k, 633) + lmat(k, 633) + mat(k, 635) = mat(k, 635) + lmat(k, 635) + mat(k, 637) = mat(k, 637) + lmat(k, 637) + mat(k, 640) = mat(k, 640) + lmat(k, 640) + mat(k, 646) = mat(k, 646) + lmat(k, 646) + mat(k, 650) = mat(k, 650) + lmat(k, 650) + mat(k, 651) = mat(k, 651) + lmat(k, 651) + mat(k, 653) = lmat(k, 653) + mat(k, 655) = mat(k, 655) + lmat(k, 655) + mat(k, 661) = mat(k, 661) + lmat(k, 661) + mat(k, 670) = mat(k, 670) + lmat(k, 670) + mat(k, 692) = mat(k, 692) + lmat(k, 692) + mat(k, 703) = mat(k, 703) + lmat(k, 703) + mat(k, 708) = mat(k, 708) + lmat(k, 708) + mat(k, 719) = mat(k, 719) + lmat(k, 719) + mat(k, 728) = lmat(k, 728) + mat(k, 733) = lmat(k, 733) + mat(k, 737) = mat(k, 737) + lmat(k, 737) + mat(k, 741) = mat(k, 741) + lmat(k, 741) + mat(k, 743) = lmat(k, 743) + mat(k, 745) = mat(k, 745) + lmat(k, 745) + mat(k, 138) = 0._r8 + mat(k, 162) = 0._r8 + mat(k, 163) = 0._r8 + mat(k, 172) = 0._r8 + mat(k, 175) = 0._r8 + mat(k, 176) = 0._r8 + mat(k, 179) = 0._r8 + mat(k, 183) = 0._r8 + mat(k, 193) = 0._r8 + mat(k, 199) = 0._r8 + mat(k, 200) = 0._r8 + mat(k, 202) = 0._r8 + mat(k, 204) = 0._r8 + mat(k, 205) = 0._r8 + mat(k, 208) = 0._r8 + mat(k, 209) = 0._r8 + mat(k, 212) = 0._r8 + mat(k, 213) = 0._r8 + mat(k, 217) = 0._r8 + mat(k, 221) = 0._r8 + mat(k, 224) = 0._r8 + mat(k, 227) = 0._r8 + mat(k, 230) = 0._r8 + mat(k, 240) = 0._r8 + mat(k, 252) = 0._r8 + mat(k, 256) = 0._r8 + mat(k, 257) = 0._r8 + mat(k, 261) = 0._r8 + mat(k, 269) = 0._r8 + mat(k, 279) = 0._r8 + mat(k, 290) = 0._r8 + mat(k, 293) = 0._r8 + mat(k, 295) = 0._r8 + mat(k, 298) = 0._r8 + mat(k, 299) = 0._r8 + mat(k, 301) = 0._r8 + mat(k, 309) = 0._r8 + mat(k, 311) = 0._r8 + mat(k, 312) = 0._r8 + mat(k, 313) = 0._r8 + mat(k, 317) = 0._r8 + mat(k, 319) = 0._r8 + mat(k, 320) = 0._r8 + mat(k, 321) = 0._r8 + mat(k, 323) = 0._r8 + mat(k, 324) = 0._r8 + mat(k, 327) = 0._r8 + mat(k, 330) = 0._r8 + mat(k, 335) = 0._r8 + mat(k, 337) = 0._r8 + mat(k, 339) = 0._r8 + mat(k, 340) = 0._r8 + mat(k, 346) = 0._r8 + mat(k, 347) = 0._r8 + mat(k, 348) = 0._r8 + mat(k, 349) = 0._r8 + mat(k, 353) = 0._r8 + mat(k, 354) = 0._r8 + mat(k, 356) = 0._r8 + mat(k, 358) = 0._r8 + mat(k, 362) = 0._r8 + mat(k, 363) = 0._r8 + mat(k, 364) = 0._r8 + mat(k, 381) = 0._r8 + mat(k, 382) = 0._r8 + mat(k, 399) = 0._r8 + mat(k, 406) = 0._r8 + mat(k, 410) = 0._r8 + mat(k, 412) = 0._r8 + mat(k, 417) = 0._r8 + mat(k, 424) = 0._r8 + mat(k, 432) = 0._r8 + mat(k, 440) = 0._r8 + mat(k, 442) = 0._r8 + mat(k, 446) = 0._r8 + mat(k, 452) = 0._r8 + mat(k, 454) = 0._r8 + mat(k, 458) = 0._r8 + mat(k, 460) = 0._r8 + mat(k, 466) = 0._r8 + mat(k, 473) = 0._r8 + mat(k, 477) = 0._r8 + mat(k, 480) = 0._r8 + mat(k, 482) = 0._r8 + mat(k, 484) = 0._r8 + mat(k, 485) = 0._r8 + mat(k, 502) = 0._r8 + mat(k, 505) = 0._r8 + mat(k, 506) = 0._r8 + mat(k, 509) = 0._r8 + mat(k, 511) = 0._r8 + mat(k, 512) = 0._r8 + mat(k, 514) = 0._r8 + mat(k, 515) = 0._r8 + mat(k, 516) = 0._r8 + mat(k, 522) = 0._r8 + mat(k, 527) = 0._r8 + mat(k, 536) = 0._r8 + mat(k, 548) = 0._r8 + mat(k, 552) = 0._r8 + mat(k, 554) = 0._r8 + mat(k, 555) = 0._r8 + mat(k, 557) = 0._r8 + mat(k, 558) = 0._r8 + mat(k, 560) = 0._r8 + mat(k, 562) = 0._r8 + mat(k, 578) = 0._r8 + mat(k, 583) = 0._r8 + mat(k, 585) = 0._r8 + mat(k, 589) = 0._r8 + mat(k, 595) = 0._r8 + mat(k, 596) = 0._r8 + mat(k, 597) = 0._r8 + mat(k, 598) = 0._r8 + mat(k, 603) = 0._r8 + mat(k, 605) = 0._r8 + mat(k, 606) = 0._r8 + mat(k, 611) = 0._r8 + mat(k, 613) = 0._r8 + mat(k, 624) = 0._r8 + mat(k, 642) = 0._r8 + mat(k, 654) = 0._r8 + mat(k, 656) = 0._r8 + mat(k, 665) = 0._r8 + mat(k, 671) = 0._r8 + mat(k, 673) = 0._r8 + mat(k, 676) = 0._r8 + mat(k, 679) = 0._r8 + mat(k, 680) = 0._r8 + mat(k, 681) = 0._r8 + mat(k, 683) = 0._r8 + mat(k, 685) = 0._r8 + mat(k, 687) = 0._r8 + mat(k, 688) = 0._r8 + mat(k, 689) = 0._r8 + mat(k, 691) = 0._r8 + mat(k, 693) = 0._r8 + mat(k, 700) = 0._r8 + mat(k, 702) = 0._r8 + mat(k, 704) = 0._r8 + mat(k, 705) = 0._r8 + mat(k, 706) = 0._r8 + mat(k, 712) = 0._r8 + mat(k, 713) = 0._r8 + mat(k, 714) = 0._r8 + mat(k, 718) = 0._r8 + mat(k, 720) = 0._r8 + mat(k, 725) = 0._r8 + mat(k, 726) = 0._r8 + mat(k, 727) = 0._r8 + mat(k, 729) = 0._r8 + mat(k, 730) = 0._r8 + mat(k, 731) = 0._r8 + mat(k, 732) = 0._r8 + mat(k, 734) = 0._r8 + mat(k, 735) = 0._r8 + mat(k, 736) = 0._r8 + mat(k, 738) = 0._r8 + mat(k, 739) = 0._r8 + mat(k, 740) = 0._r8 + mat(k, 742) = 0._r8 + mat(k, 744) = 0._r8 + mat(k, 1) = mat(k, 1) - dti(k) + mat(k, 2) = mat(k, 2) - dti(k) + mat(k, 5) = mat(k, 5) - dti(k) + mat(k, 8) = mat(k, 8) - dti(k) + mat(k, 11) = mat(k, 11) - dti(k) + mat(k, 14) = mat(k, 14) - dti(k) + mat(k, 16) = mat(k, 16) - dti(k) + mat(k, 18) = mat(k, 18) - dti(k) + mat(k, 22) = mat(k, 22) - dti(k) + mat(k, 25) = mat(k, 25) - dti(k) + mat(k, 29) = mat(k, 29) - dti(k) + mat(k, 33) = mat(k, 33) - dti(k) + mat(k, 39) = mat(k, 39) - dti(k) + mat(k, 45) = mat(k, 45) - dti(k) + mat(k, 50) = mat(k, 50) - dti(k) + mat(k, 58) = mat(k, 58) - dti(k) + mat(k, 64) = mat(k, 64) - dti(k) + mat(k, 71) = mat(k, 71) - dti(k) + mat(k, 78) = mat(k, 78) - dti(k) + mat(k, 84) = mat(k, 84) - dti(k) + mat(k, 92) = mat(k, 92) - dti(k) + mat(k, 96) = mat(k, 96) - dti(k) + mat(k, 103) = mat(k, 103) - dti(k) + mat(k, 112) = mat(k, 112) - dti(k) + mat(k, 119) = mat(k, 119) - dti(k) + mat(k, 125) = mat(k, 125) - dti(k) + mat(k, 134) = mat(k, 134) - dti(k) + mat(k, 143) = mat(k, 143) - dti(k) + mat(k, 150) = mat(k, 150) - dti(k) + mat(k, 159) = mat(k, 159) - dti(k) + mat(k, 170) = mat(k, 170) - dti(k) + mat(k, 181) = mat(k, 181) - dti(k) + mat(k, 196) = mat(k, 196) - dti(k) + mat(k, 210) = mat(k, 210) - dti(k) + mat(k, 225) = mat(k, 225) - dti(k) + mat(k, 235) = mat(k, 235) - dti(k) + mat(k, 243) = mat(k, 243) - dti(k) + mat(k, 255) = mat(k, 255) - dti(k) + mat(k, 266) = mat(k, 266) - dti(k) + mat(k, 280) = mat(k, 280) - dti(k) + mat(k, 291) = mat(k, 291) - dti(k) + mat(k, 310) = mat(k, 310) - dti(k) + mat(k, 328) = mat(k, 328) - dti(k) + mat(k, 350) = mat(k, 350) - dti(k) + mat(k, 376) = mat(k, 376) - dti(k) + mat(k, 420) = mat(k, 420) - dti(k) + mat(k, 449) = mat(k, 449) - dti(k) + mat(k, 475) = mat(k, 475) - dti(k) + mat(k, 507) = mat(k, 507) - dti(k) + mat(k, 533) = mat(k, 533) - dti(k) + mat(k, 556) = mat(k, 556) - dti(k) + mat(k, 579) = mat(k, 579) - dti(k) + mat(k, 608) = mat(k, 608) - dti(k) + mat(k, 646) = mat(k, 646) - dti(k) + mat(k, 670) = mat(k, 670) - dti(k) + mat(k, 692) = mat(k, 692) - dti(k) + mat(k, 719) = mat(k, 719) - dti(k) + mat(k, 745) = mat(k, 745) - dti(k) + end do + end subroutine nlnmat_finit + subroutine nlnmat( avec_len, mat, y, rxt, lmat, dti ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: dti(veclen) + real(r8), intent(in) :: lmat(veclen,nzcnt) + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(inout) :: mat(veclen,nzcnt) + call nlnmat01( avec_len, mat, y, rxt ) + call nlnmat02( avec_len, mat, y, rxt ) + call nlnmat03( avec_len, mat, y, rxt ) + call nlnmat04( avec_len, mat, y, rxt ) + call nlnmat_finit( avec_len, mat, lmat, dti ) + end subroutine nlnmat + end module mo_nln_matrix diff --git a/src/chemistry/pp_waccm_ma_noaero/mo_phtadj.F90 b/src/chemistry/pp_waccm_ma_noaero/mo_phtadj.F90 new file mode 100644 index 0000000000..f75938e173 --- /dev/null +++ b/src/chemistry/pp_waccm_ma_noaero/mo_phtadj.F90 @@ -0,0 +1,33 @@ + module mo_phtadj + private + public :: phtadj + contains + subroutine phtadj( p_rate, inv, m, ncol, nlev ) + use chem_mods, only : nfs, phtcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: ncol, nlev + real(r8), intent(in) :: inv(ncol,nlev,max(1,nfs)) + real(r8), intent(in) :: m(ncol,nlev) + real(r8), intent(inout) :: p_rate(ncol,nlev,max(1,phtcnt)) +!-------------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------------- + integer :: k + real(r8) :: im(ncol,nlev) + do k = 1,nlev + im(:ncol,k) = 1._r8 / m(:ncol,k) + p_rate(:,k, 63) = p_rate(:,k, 63) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 64) = p_rate(:,k, 64) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 65) = p_rate(:,k, 65) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 66) = p_rate(:,k, 66) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 67) = p_rate(:,k, 67) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 68) = p_rate(:,k, 68) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 69) = p_rate(:,k, 69) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 70) = p_rate(:,k, 70) * inv(:,k, 2) * im(:,k) + end do + end subroutine phtadj + end module mo_phtadj diff --git a/src/chemistry/pp_waccm_ma_noaero/mo_prod_loss.F90 b/src/chemistry/pp_waccm_ma_noaero/mo_prod_loss.F90 new file mode 100644 index 0000000000..3e3e4d988f --- /dev/null +++ b/src/chemistry/pp_waccm_ma_noaero/mo_prod_loss.F90 @@ -0,0 +1,493 @@ + module mo_prod_loss + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : veclen + private + public :: exp_prod_loss + public :: imp_prod_loss + contains + subroutine exp_prod_loss( ofl, ofu, prod, loss, y, & + rxt, het_rates, chnkpnts ) + use chem_mods, only : gas_pcnst,rxntot,clscnt1 + implicit none +!-------------------------------------------------------------------- +! ... dummy args +!-------------------------------------------------------------------- + integer, intent(in) :: ofl, ofu, chnkpnts + real(r8), dimension(chnkpnts,max(1,clscnt1)), intent(out) :: & + prod, & + loss + real(r8), intent(in) :: y(chnkpnts,gas_pcnst) + real(r8), intent(in) :: rxt(chnkpnts,rxntot) + real(r8), intent(in) :: het_rates(chnkpnts,gas_pcnst) +!-------------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------------- + integer :: k +!-------------------------------------------------------------------- +! ... loss and production for Explicit method +!-------------------------------------------------------------------- + do k = ofl,ofu + loss(k,1) = ( + het_rates(k,5))* y(k,5) + prod(k,1) = 0._r8 + loss(k,2) = (rxt(k,180)* y(k,73) + rxt(k,30) + het_rates(k,6))* y(k,6) + prod(k,2) = 0._r8 + loss(k,3) = (rxt(k,181)* y(k,73) + rxt(k,31) + het_rates(k,7))* y(k,7) + prod(k,3) = 0._r8 + loss(k,4) = (rxt(k,207)* y(k,73) + rxt(k,32) + het_rates(k,8))* y(k,8) + prod(k,4) = 0._r8 + loss(k,5) = (rxt(k,182)* y(k,73) + rxt(k,33) + het_rates(k,9))* y(k,9) + prod(k,5) = 0._r8 + loss(k,6) = (rxt(k,183)* y(k,73) + rxt(k,34) + het_rates(k,10))* y(k,10) + prod(k,6) = 0._r8 + loss(k,7) = (rxt(k,184)* y(k,73) + rxt(k,35) + het_rates(k,11))* y(k,11) + prod(k,7) = 0._r8 + loss(k,8) = (rxt(k,185)* y(k,73) + rxt(k,36) + het_rates(k,12))* y(k,12) + prod(k,8) = 0._r8 + loss(k,9) = (rxt(k,186)* y(k,73) + rxt(k,37) + het_rates(k,13))* y(k,13) + prod(k,9) = 0._r8 + loss(k,10) = (rxt(k,218)* y(k,23) +rxt(k,230)* y(k,73) +rxt(k,219)* y(k,77) & + + rxt(k,38) + het_rates(k,14))* y(k,14) + prod(k,10) = 0._r8 + loss(k,11) = (rxt(k,220)* y(k,23) +rxt(k,231)* y(k,73) +rxt(k,221)* y(k,77) & + + rxt(k,39) + het_rates(k,16))* y(k,16) + prod(k,11) = 0._r8 + loss(k,12) = (rxt(k,222)* y(k,77) + rxt(k,40) + het_rates(k,17))* y(k,17) + prod(k,12) = 0._r8 + loss(k,13) = (rxt(k,223)* y(k,23) +rxt(k,224)* y(k,77) + rxt(k,41) & + + het_rates(k,18))* y(k,18) + prod(k,13) = 0._r8 + loss(k,14) = (rxt(k,156)* y(k,23) +rxt(k,212)* y(k,34) + (rxt(k,243) + & + rxt(k,244) +rxt(k,245))* y(k,73) +rxt(k,241)* y(k,77) + rxt(k,23) & + + rxt(k,24) + het_rates(k,21))* y(k,21) + prod(k,14) = 0._r8 + loss(k,15) = (rxt(k,225)* y(k,23) +rxt(k,208)* y(k,73) +rxt(k,226)* y(k,77) & + + rxt(k,42) + het_rates(k,22))* y(k,22) + prod(k,15) = 0._r8 + loss(k,16) = ( + het_rates(k,28))* y(k,28) + prod(k,16) = 0._r8 + loss(k,17) = (rxt(k,300)* y(k,78) + rxt(k,25) + rxt(k,61) + het_rates(k,30)) & + * y(k,30) + prod(k,17) =.440_r8*rxt(k,24)*y(k,21) + loss(k,18) = (rxt(k,209)* y(k,73) + rxt(k,50) + het_rates(k,37))* y(k,37) + prod(k,18) = 0._r8 + loss(k,19) = (rxt(k,232)* y(k,73) +rxt(k,227)* y(k,77) + rxt(k,52) & + + het_rates(k,41))* y(k,41) + prod(k,19) = 0._r8 + loss(k,20) = (rxt(k,233)* y(k,73) +rxt(k,228)* y(k,77) + rxt(k,53) & + + het_rates(k,42))* y(k,42) + prod(k,20) = 0._r8 + loss(k,21) = (rxt(k,234)* y(k,73) +rxt(k,229)* y(k,77) + rxt(k,54) & + + het_rates(k,43))* y(k,43) + prod(k,21) = 0._r8 + loss(k,22) = ((rxt(k,147) +rxt(k,148))* y(k,73) + rxt(k,12) & + + het_rates(k,51))* y(k,51) + prod(k,22) = 0._r8 + loss(k,23) = ( + rxt(k,60) + het_rates(k,62))* y(k,62) + prod(k,23) = 0._r8 + end do + end subroutine exp_prod_loss + subroutine imp_prod_loss( avec_len, prod, loss, y, & + rxt, het_rates ) + use chem_mods, only : gas_pcnst,rxntot,clscnt4 + implicit none +!-------------------------------------------------------------------- +! ... dummy args +!-------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), dimension(veclen,clscnt4), intent(out) :: & + prod, & + loss + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(in) :: het_rates(veclen,gas_pcnst) +!-------------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------------- + integer :: k +!-------------------------------------------------------------------- +! ... loss and production for Implicit method +!-------------------------------------------------------------------- + do k = 1,avec_len + loss(k,41) = (rxt(k,191)* y(k,15) +rxt(k,193)* y(k,58) +rxt(k,192)* y(k,68) & + + het_rates(k,1))* y(k,1) + prod(k,41) = (rxt(k,27) +2.000_r8*rxt(k,194)*y(k,3) +rxt(k,195)*y(k,26) + & + rxt(k,196)*y(k,26) +rxt(k,199)*y(k,53) +rxt(k,202)*y(k,56) + & + rxt(k,203)*y(k,77) +rxt(k,253)*y(k,63))*y(k,3) + (rxt(k,181)*y(k,7) + & + rxt(k,207)*y(k,8) +3.000_r8*rxt(k,208)*y(k,22) + & + 2.000_r8*rxt(k,209)*y(k,37) +2.000_r8*rxt(k,230)*y(k,14) + & + rxt(k,231)*y(k,16) +rxt(k,210)*y(k,40))*y(k,73) & + + (2.000_r8*rxt(k,219)*y(k,14) +rxt(k,221)*y(k,16) + & + 3.000_r8*rxt(k,226)*y(k,22) +rxt(k,205)*y(k,40))*y(k,77) & + + (2.000_r8*rxt(k,218)*y(k,14) +rxt(k,220)*y(k,16) + & + 3.000_r8*rxt(k,225)*y(k,22))*y(k,23) + (rxt(k,51) + & + rxt(k,204)*y(k,56))*y(k,40) +rxt(k,26)*y(k,2) +rxt(k,29)*y(k,4) & + +rxt(k,57)*y(k,48) + loss(k,9) = ( + rxt(k,26) + het_rates(k,2))* y(k,2) + prod(k,9) = (rxt(k,276)*y(k,48) +rxt(k,281)*y(k,48))*y(k,44) & + +rxt(k,197)*y(k,26)*y(k,3) + loss(k,57) = (2._r8*rxt(k,194)* y(k,3) + (rxt(k,195) +rxt(k,196) +rxt(k,197)) & + * y(k,26) +rxt(k,199)* y(k,53) +rxt(k,200)* y(k,54) +rxt(k,202) & + * y(k,56) +rxt(k,253)* y(k,63) +rxt(k,198)* y(k,68) +rxt(k,203) & + * y(k,77) + rxt(k,27) + het_rates(k,3))* y(k,3) + prod(k,57) = (rxt(k,28) +rxt(k,201)*y(k,56))*y(k,4) +rxt(k,193)*y(k,58) & + *y(k,1) +rxt(k,211)*y(k,73)*y(k,40) +rxt(k,206)*y(k,56)*y(k,48) + loss(k,20) = (rxt(k,201)* y(k,56) + rxt(k,28) + rxt(k,29) + rxt(k,270) & + + rxt(k,273) + rxt(k,278) + het_rates(k,4))* y(k,4) + prod(k,20) =rxt(k,200)*y(k,54)*y(k,3) + loss(k,51) = (rxt(k,191)* y(k,1) +rxt(k,155)* y(k,23) +rxt(k,235)* y(k,55) & + +rxt(k,236)* y(k,56) +rxt(k,237)* y(k,77) + rxt(k,20) + rxt(k,21) & + + het_rates(k,15))* y(k,15) + prod(k,51) = (rxt(k,162)*y(k,26) +rxt(k,239)*y(k,53))*y(k,19) + (rxt(k,22) + & + .300_r8*rxt(k,240)*y(k,77))*y(k,20) + (rxt(k,244)*y(k,73) + & + rxt(k,245)*y(k,73))*y(k,21) + loss(k,43) = (rxt(k,162)* y(k,26) +rxt(k,239)* y(k,53) +rxt(k,238)* y(k,68) & + + het_rates(k,19))* y(k,19) + prod(k,43) = (rxt(k,156)*y(k,23) +rxt(k,212)*y(k,34) +rxt(k,241)*y(k,77) + & + rxt(k,243)*y(k,73))*y(k,21) +.700_r8*rxt(k,240)*y(k,77)*y(k,20) + loss(k,16) = (rxt(k,240)* y(k,77) + rxt(k,22) + het_rates(k,20))* y(k,20) + prod(k,16) =rxt(k,238)*y(k,68)*y(k,19) + loss(k,48) = (rxt(k,218)* y(k,14) +rxt(k,155)* y(k,15) +rxt(k,220)* y(k,16) & + +rxt(k,223)* y(k,18) +rxt(k,156)* y(k,21) +rxt(k,225)* y(k,22) & + +rxt(k,168)* y(k,27) +rxt(k,157)* y(k,36) +rxt(k,158)* y(k,38) & + +rxt(k,177)* y(k,49) +rxt(k,161)* y(k,58) + (rxt(k,159) +rxt(k,160)) & + * y(k,68) + het_rates(k,23))* y(k,23) + prod(k,48) = (4.000_r8*rxt(k,180)*y(k,6) +rxt(k,181)*y(k,7) + & + 2.000_r8*rxt(k,182)*y(k,9) +2.000_r8*rxt(k,183)*y(k,10) + & + 2.000_r8*rxt(k,184)*y(k,11) +rxt(k,185)*y(k,12) + & + 2.000_r8*rxt(k,186)*y(k,13) +rxt(k,232)*y(k,41) +rxt(k,233)*y(k,42) + & + rxt(k,234)*y(k,43) +rxt(k,187)*y(k,44) +rxt(k,217)*y(k,32))*y(k,73) & + + (rxt(k,45) +rxt(k,162)*y(k,19) +2.000_r8*rxt(k,163)*y(k,26) + & + rxt(k,165)*y(k,26) +rxt(k,167)*y(k,53) +rxt(k,172)*y(k,56) + & + rxt(k,173)*y(k,77) +rxt(k,196)*y(k,3) +rxt(k,254)*y(k,63))*y(k,26) & + + (3.000_r8*rxt(k,222)*y(k,17) +rxt(k,224)*y(k,18) + & + rxt(k,227)*y(k,41) +rxt(k,228)*y(k,42) +rxt(k,229)*y(k,43) + & + rxt(k,176)*y(k,44))*y(k,77) + (rxt(k,55) +rxt(k,175)*y(k,56))*y(k,44) & + +rxt(k,26)*y(k,2) +2.000_r8*rxt(k,43)*y(k,24) +2.000_r8*rxt(k,44) & + *y(k,25) +rxt(k,46)*y(k,27) +rxt(k,49)*y(k,32) +rxt(k,58)*y(k,49) + loss(k,7) = ( + rxt(k,43) + het_rates(k,24))* y(k,24) + prod(k,7) = (rxt(k,269)*y(k,49) +rxt(k,274)*y(k,27) +rxt(k,275)*y(k,49) + & + rxt(k,279)*y(k,27) +rxt(k,280)*y(k,49) +rxt(k,284)*y(k,27))*y(k,44) & + +rxt(k,168)*y(k,27)*y(k,23) +rxt(k,164)*y(k,26)*y(k,26) + loss(k,2) = ( + rxt(k,44) + rxt(k,190) + het_rates(k,25))* y(k,25) + prod(k,2) =rxt(k,189)*y(k,26)*y(k,26) + loss(k,47) = ((rxt(k,195) +rxt(k,196) +rxt(k,197))* y(k,3) +rxt(k,162) & + * y(k,19) + 2._r8*(rxt(k,163) +rxt(k,164) +rxt(k,165) +rxt(k,189)) & + * y(k,26) +rxt(k,167)* y(k,53) +rxt(k,169)* y(k,54) +rxt(k,172) & + * y(k,56) +rxt(k,254)* y(k,63) +rxt(k,166)* y(k,68) + (rxt(k,173) + & + rxt(k,174))* y(k,77) + rxt(k,45) + het_rates(k,26))* y(k,26) + prod(k,47) = (rxt(k,160)*y(k,68) +rxt(k,161)*y(k,58) +rxt(k,177)*y(k,49)) & + *y(k,23) + (rxt(k,47) +rxt(k,170)*y(k,56))*y(k,27) & + + (rxt(k,178)*y(k,56) +rxt(k,179)*y(k,77))*y(k,49) + (rxt(k,59) + & + rxt(k,259)*y(k,63))*y(k,59) +2.000_r8*rxt(k,190)*y(k,25) & + +rxt(k,188)*y(k,73)*y(k,44) + loss(k,37) = (rxt(k,168)* y(k,23) + (rxt(k,274) +rxt(k,279) +rxt(k,284)) & + * y(k,44) +rxt(k,170)* y(k,56) +rxt(k,171)* y(k,77) + rxt(k,46) & + + rxt(k,47) + rxt(k,272) + rxt(k,277) + rxt(k,283) & + + het_rates(k,27))* y(k,27) + prod(k,37) =rxt(k,169)*y(k,54)*y(k,26) + loss(k,21) = ((rxt(k,242) +rxt(k,246))* y(k,77) + het_rates(k,29))* y(k,29) + prod(k,21) = (rxt(k,20) +rxt(k,21) +rxt(k,155)*y(k,23) +rxt(k,191)*y(k,1) + & + rxt(k,235)*y(k,55) +rxt(k,236)*y(k,56) +rxt(k,237)*y(k,77))*y(k,15) & + + (rxt(k,88) +rxt(k,249)*y(k,56) +rxt(k,250)*y(k,77))*y(k,60) & + +rxt(k,223)*y(k,23)*y(k,18) +rxt(k,300)*y(k,78)*y(k,30) + loss(k,3) = (rxt(k,216)* y(k,73) + rxt(k,48) + het_rates(k,31))* y(k,31) + prod(k,3) = (rxt(k,181)*y(k,7) +rxt(k,183)*y(k,10) + & + 2.000_r8*rxt(k,184)*y(k,11) +2.000_r8*rxt(k,185)*y(k,12) + & + rxt(k,186)*y(k,13) +rxt(k,207)*y(k,8) +2.000_r8*rxt(k,209)*y(k,37) + & + rxt(k,233)*y(k,42) +rxt(k,234)*y(k,43))*y(k,73) & + + (rxt(k,228)*y(k,42) +rxt(k,229)*y(k,43))*y(k,77) + loss(k,8) = (rxt(k,217)* y(k,73) + rxt(k,49) + het_rates(k,32))* y(k,32) + prod(k,8) = (rxt(k,182)*y(k,9) +rxt(k,183)*y(k,10) +rxt(k,232)*y(k,41)) & + *y(k,73) +rxt(k,227)*y(k,77)*y(k,41) + loss(k,12) = (rxt(k,247)* y(k,55) + (rxt(k,248) +rxt(k,261))* y(k,77) & + + het_rates(k,33))* y(k,33) + prod(k,12) = 0._r8 + loss(k,26) = (rxt(k,212)* y(k,21) +rxt(k,213)* y(k,36) +rxt(k,215)* y(k,46) & + +rxt(k,214)* y(k,81) + het_rates(k,34))* y(k,34) + prod(k,26) = (rxt(k,185)*y(k,12) +rxt(k,207)*y(k,8) + & + 2.000_r8*rxt(k,216)*y(k,31) +rxt(k,217)*y(k,32))*y(k,73) & + +2.000_r8*rxt(k,48)*y(k,31) +rxt(k,49)*y(k,32) +rxt(k,56)*y(k,45) + loss(k,40) = (rxt(k,116)* y(k,57) +rxt(k,119)* y(k,58) + (rxt(k,113) + & + rxt(k,114) +rxt(k,115))* y(k,68) + het_rates(k,35))* y(k,35) + prod(k,40) = (rxt(k,120)*y(k,36) +rxt(k,123)*y(k,56) +rxt(k,143)*y(k,50) + & + rxt(k,237)*y(k,15) +rxt(k,246)*y(k,29) +rxt(k,250)*y(k,60) + & + rxt(k,255)*y(k,61) +rxt(k,260)*y(k,63))*y(k,77) & + + (rxt(k,94)*y(k,73) +rxt(k,111)*y(k,56) +rxt(k,157)*y(k,23) + & + rxt(k,213)*y(k,34))*y(k,36) + (rxt(k,244)*y(k,21) + & + rxt(k,188)*y(k,44) +rxt(k,211)*y(k,40))*y(k,73) & + + (2.000_r8*rxt(k,2) +rxt(k,3))*y(k,81) +2.000_r8*rxt(k,20)*y(k,15) & + +rxt(k,22)*y(k,20) +rxt(k,51)*y(k,40) +rxt(k,55)*y(k,44) +rxt(k,56) & + *y(k,45) + loss(k,56) = (rxt(k,157)* y(k,23) +rxt(k,213)* y(k,34) +rxt(k,111)* y(k,56) & + +rxt(k,94)* y(k,73) +rxt(k,120)* y(k,77) + het_rates(k,36))* y(k,36) + prod(k,56) =rxt(k,21)*y(k,15) +rxt(k,245)*y(k,73)*y(k,21) +rxt(k,113)*y(k,68) & + *y(k,35) +rxt(k,1)*y(k,81) + loss(k,22) = (rxt(k,158)* y(k,23) +rxt(k,112)* y(k,56) +rxt(k,121)* y(k,77) & + + rxt(k,4) + het_rates(k,38))* y(k,38) + prod(k,22) =rxt(k,127)*y(k,68)*y(k,68) +rxt(k,126)*y(k,77)*y(k,77) + loss(k,4) = ( + rxt(k,87) + het_rates(k,39))* y(k,39) + prod(k,4) =rxt(k,263)*y(k,81)*y(k,65) + loss(k,29) = (rxt(k,204)* y(k,56) + (rxt(k,210) +rxt(k,211))* y(k,73) & + +rxt(k,205)* y(k,77) + rxt(k,51) + het_rates(k,40))* y(k,40) + prod(k,29) = (rxt(k,191)*y(k,15) +rxt(k,192)*y(k,68))*y(k,1) + loss(k,42) = ((rxt(k,274) +rxt(k,279) +rxt(k,284))* y(k,27) + (rxt(k,276) + & + rxt(k,281))* y(k,48) + (rxt(k,269) +rxt(k,275) +rxt(k,280))* y(k,49) & + +rxt(k,175)* y(k,56) + (rxt(k,187) +rxt(k,188))* y(k,73) +rxt(k,176) & + * y(k,77) + rxt(k,55) + het_rates(k,44))* y(k,44) + prod(k,42) = (rxt(k,156)*y(k,21) +rxt(k,218)*y(k,14) +rxt(k,220)*y(k,16) + & + 2.000_r8*rxt(k,223)*y(k,18) +rxt(k,225)*y(k,22) +rxt(k,155)*y(k,15) + & + rxt(k,157)*y(k,36) +rxt(k,158)*y(k,38) +rxt(k,159)*y(k,68) + & + rxt(k,177)*y(k,49))*y(k,23) +rxt(k,174)*y(k,77)*y(k,26) + loss(k,10) = ( + rxt(k,56) + het_rates(k,45))* y(k,45) + prod(k,10) = (rxt(k,212)*y(k,21) +rxt(k,213)*y(k,36) +rxt(k,214)*y(k,81) + & + rxt(k,215)*y(k,46))*y(k,34) + loss(k,38) = (rxt(k,215)* y(k,34) +rxt(k,152)* y(k,77) + rxt(k,9) & + + het_rates(k,46))* y(k,46) + prod(k,38) = (rxt(k,272) +rxt(k,277) +rxt(k,283) +rxt(k,274)*y(k,44) + & + rxt(k,279)*y(k,44) +rxt(k,284)*y(k,44))*y(k,27) & + + (2.000_r8*rxt(k,265) +2.000_r8*rxt(k,268) +2.000_r8*rxt(k,271) + & + 2.000_r8*rxt(k,282))*y(k,52) + (rxt(k,270) +rxt(k,273) +rxt(k,278)) & + *y(k,4) + (rxt(k,267) +rxt(k,235)*y(k,15) +rxt(k,247)*y(k,33)) & + *y(k,55) + (.500_r8*rxt(k,266) +rxt(k,151)*y(k,77))*y(k,54) + loss(k,17) = (rxt(k,128)* y(k,77) + rxt(k,10) + rxt(k,11) + rxt(k,153) & + + het_rates(k,47))* y(k,47) + prod(k,17) =rxt(k,149)*y(k,68)*y(k,54) + loss(k,27) = ((rxt(k,276) +rxt(k,281))* y(k,44) +rxt(k,206)* y(k,56) & + + rxt(k,57) + het_rates(k,48))* y(k,48) + prod(k,27) = (rxt(k,270) +rxt(k,273) +rxt(k,278))*y(k,4) +rxt(k,198)*y(k,68) & + *y(k,3) + loss(k,28) = (rxt(k,177)* y(k,23) + (rxt(k,269) +rxt(k,275) +rxt(k,280)) & + * y(k,44) +rxt(k,178)* y(k,56) +rxt(k,179)* y(k,77) + rxt(k,58) & + + het_rates(k,49))* y(k,49) + prod(k,28) = (rxt(k,272) +rxt(k,277) +rxt(k,283) +rxt(k,171)*y(k,77))*y(k,27) & + +rxt(k,166)*y(k,68)*y(k,26) + loss(k,35) = (rxt(k,131)* y(k,53) + (rxt(k,132) +rxt(k,133) +rxt(k,134)) & + * y(k,54) +rxt(k,135)* y(k,57) +rxt(k,297)* y(k,76) +rxt(k,143) & + * y(k,77) + rxt(k,62) + het_rates(k,50))* y(k,50) + prod(k,35) = (rxt(k,129)*y(k,69) +rxt(k,294)*y(k,72))*y(k,56) & + + (.200_r8*rxt(k,288)*y(k,71) +1.100_r8*rxt(k,290)*y(k,70))*y(k,67) & + +rxt(k,15)*y(k,53) +rxt(k,295)*y(k,72)*y(k,57) +rxt(k,301)*y(k,78) + loss(k,13) = ( + rxt(k,13) + rxt(k,14) + rxt(k,154) + rxt(k,265) + rxt(k,268) & + + rxt(k,271) + rxt(k,282) + het_rates(k,52))* y(k,52) + prod(k,13) =rxt(k,150)*y(k,55)*y(k,54) + loss(k,55) = (rxt(k,199)* y(k,3) +rxt(k,239)* y(k,19) +rxt(k,167)* y(k,26) & + +rxt(k,131)* y(k,50) +rxt(k,140)* y(k,55) +rxt(k,146)* y(k,56) & + +rxt(k,145)* y(k,58) +rxt(k,144)* y(k,68) +rxt(k,299)* y(k,76) & + + rxt(k,15) + rxt(k,16) + het_rates(k,53))* y(k,53) + prod(k,55) = (rxt(k,17) +.500_r8*rxt(k,266) +2.000_r8*rxt(k,133)*y(k,50) + & + rxt(k,136)*y(k,56) +rxt(k,256)*y(k,63))*y(k,54) & + + (rxt(k,135)*y(k,57) +rxt(k,143)*y(k,77))*y(k,50) & + +2.000_r8*rxt(k,147)*y(k,73)*y(k,51) +rxt(k,14)*y(k,52) +rxt(k,19) & + *y(k,55) +rxt(k,130)*y(k,69)*y(k,57) +rxt(k,298)*y(k,76) +rxt(k,311) & + *y(k,80) + loss(k,53) = (rxt(k,200)* y(k,3) +rxt(k,169)* y(k,26) + (rxt(k,132) + & + rxt(k,133) +rxt(k,134))* y(k,50) +rxt(k,150)* y(k,55) + (rxt(k,136) + & + rxt(k,138))* y(k,56) +rxt(k,137)* y(k,58) +rxt(k,256)* y(k,63) & + +rxt(k,149)* y(k,68) +rxt(k,151)* y(k,77) + rxt(k,17) + rxt(k,266) & + + het_rates(k,54))* y(k,54) + prod(k,53) = (2.000_r8*rxt(k,140)*y(k,55) +rxt(k,144)*y(k,68) + & + rxt(k,145)*y(k,58) +rxt(k,146)*y(k,56) +rxt(k,167)*y(k,26) + & + rxt(k,199)*y(k,3) +rxt(k,239)*y(k,19))*y(k,53) + (rxt(k,18) + & + rxt(k,139)*y(k,68) +rxt(k,141)*y(k,56) +rxt(k,142)*y(k,77))*y(k,55) & + + (rxt(k,11) +rxt(k,153) +rxt(k,128)*y(k,77))*y(k,47) + (rxt(k,13) + & + rxt(k,154))*y(k,52) +rxt(k,28)*y(k,4) +rxt(k,47)*y(k,27) +rxt(k,9) & + *y(k,46) + loss(k,44) = (rxt(k,235)* y(k,15) +rxt(k,247)* y(k,33) +rxt(k,140)* y(k,53) & + +rxt(k,150)* y(k,54) +rxt(k,141)* y(k,56) +rxt(k,139)* y(k,68) & + +rxt(k,142)* y(k,77) + rxt(k,18) + rxt(k,19) + rxt(k,267) & + + het_rates(k,55))* y(k,55) + prod(k,44) = (rxt(k,46) +rxt(k,168)*y(k,23) +rxt(k,170)*y(k,56) + & + rxt(k,171)*y(k,77))*y(k,27) + (rxt(k,13) +rxt(k,14) +rxt(k,154)) & + *y(k,52) + (rxt(k,29) +rxt(k,201)*y(k,56))*y(k,4) & + + (rxt(k,152)*y(k,77) +rxt(k,215)*y(k,34))*y(k,46) & + + (rxt(k,137)*y(k,58) +rxt(k,138)*y(k,56))*y(k,54) +rxt(k,10) & + *y(k,47) + loss(k,46) = (rxt(k,202)* y(k,3) +rxt(k,201)* y(k,4) +rxt(k,236)* y(k,15) & + +rxt(k,172)* y(k,26) +rxt(k,170)* y(k,27) +rxt(k,111)* y(k,36) & + +rxt(k,112)* y(k,38) +rxt(k,204)* y(k,40) +rxt(k,175)* y(k,44) & + +rxt(k,206)* y(k,48) +rxt(k,178)* y(k,49) +rxt(k,146)* y(k,53) & + + (rxt(k,136) +rxt(k,138))* y(k,54) +rxt(k,141)* y(k,55) & + + 2._r8*rxt(k,109)* y(k,56) +rxt(k,110)* y(k,57) +rxt(k,108) & + * y(k,58) +rxt(k,249)* y(k,60) +rxt(k,117)* y(k,68) + (rxt(k,292) + & + rxt(k,293))* y(k,70) +rxt(k,294)* y(k,72) +rxt(k,123)* y(k,77) & + + rxt(k,71) + rxt(k,72) + rxt(k,73) + rxt(k,74) + rxt(k,75) & + + rxt(k,76) + het_rates(k,56))* y(k,56) + prod(k,46) = (2.000_r8*rxt(k,5) +rxt(k,6) +rxt(k,77) +rxt(k,79) +rxt(k,81) + & + 2.000_r8*rxt(k,82) +2.000_r8*rxt(k,83) +rxt(k,84) +rxt(k,85) + & + rxt(k,86) +rxt(k,97)*y(k,73) +rxt(k,98)*y(k,73) +rxt(k,135)*y(k,50) + & + rxt(k,251)*y(k,61) +rxt(k,257)*y(k,63) +rxt(k,296)*y(k,72) + & + rxt(k,303)*y(k,78) +rxt(k,307)*y(k,79))*y(k,57) & + + (rxt(k,131)*y(k,53) +rxt(k,132)*y(k,54) +rxt(k,297)*y(k,76)) & + *y(k,50) + (rxt(k,288)*y(k,71) +1.150_r8*rxt(k,289)*y(k,76))*y(k,67) & + +rxt(k,27)*y(k,3) +rxt(k,45)*y(k,26) +rxt(k,115)*y(k,68)*y(k,35) & + +rxt(k,14)*y(k,52) +rxt(k,15)*y(k,53) +rxt(k,17)*y(k,54) +rxt(k,18) & + *y(k,55) +rxt(k,8)*y(k,58) +rxt(k,59)*y(k,59) +rxt(k,89)*y(k,63) & + +rxt(k,90)*y(k,64) +rxt(k,91)*y(k,65) +rxt(k,302)*y(k,78)*y(k,69) & + +rxt(k,96)*y(k,73) +rxt(k,125)*y(k,77)*y(k,77) +rxt(k,305)*y(k,79) & + +rxt(k,310)*y(k,80) +rxt(k,2)*y(k,81) + loss(k,49) = (rxt(k,116)* y(k,35) +rxt(k,135)* y(k,50) +rxt(k,110)* y(k,56) & + +rxt(k,251)* y(k,61) +rxt(k,257)* y(k,63) +rxt(k,130)* y(k,69) & + +rxt(k,291)* y(k,70) + (rxt(k,295) +rxt(k,296))* y(k,72) +rxt(k,97) & + * y(k,73) +rxt(k,102)* y(k,74) +rxt(k,303)* y(k,78) +rxt(k,307) & + * y(k,79) + rxt(k,5) + rxt(k,6) + rxt(k,77) + rxt(k,78) + rxt(k,79) & + + rxt(k,80) + rxt(k,81) + rxt(k,82) + rxt(k,83) + rxt(k,84) & + + rxt(k,85) + rxt(k,86) + het_rates(k,57))* y(k,57) + prod(k,49) = (rxt(k,8) +2.000_r8*rxt(k,99)*y(k,73) + & + 2.000_r8*rxt(k,108)*y(k,56) +2.000_r8*rxt(k,118)*y(k,68) + & + rxt(k,119)*y(k,35) +rxt(k,124)*y(k,77) +rxt(k,137)*y(k,54) + & + rxt(k,145)*y(k,53) +rxt(k,161)*y(k,23) +rxt(k,193)*y(k,1) + & + rxt(k,252)*y(k,61) +rxt(k,258)*y(k,63))*y(k,58) & + + (rxt(k,113)*y(k,35) +rxt(k,117)*y(k,56) +rxt(k,122)*y(k,77) + & + rxt(k,127)*y(k,68) +rxt(k,139)*y(k,55) +rxt(k,159)*y(k,23) + & + rxt(k,166)*y(k,26) +rxt(k,192)*y(k,1) +rxt(k,198)*y(k,3) + & + rxt(k,238)*y(k,19))*y(k,68) + (rxt(k,101)*y(k,74) + & + rxt(k,109)*y(k,56) +rxt(k,123)*y(k,77) +rxt(k,136)*y(k,54) + & + rxt(k,141)*y(k,55) +rxt(k,172)*y(k,26) +rxt(k,202)*y(k,3))*y(k,56) & + + (rxt(k,163)*y(k,26) +rxt(k,164)*y(k,26) +rxt(k,174)*y(k,77) + & + rxt(k,196)*y(k,3) +rxt(k,197)*y(k,3))*y(k,26) + (rxt(k,92) + & + rxt(k,100) +2.000_r8*rxt(k,102)*y(k,57))*y(k,74) +rxt(k,194)*y(k,3) & + *y(k,3) +rxt(k,128)*y(k,77)*y(k,47) +rxt(k,134)*y(k,54)*y(k,50) & + +rxt(k,148)*y(k,73)*y(k,51) +rxt(k,299)*y(k,76)*y(k,53) +rxt(k,19) & + *y(k,55) +rxt(k,93)*y(k,75) + loss(k,52) = (rxt(k,193)* y(k,1) +rxt(k,161)* y(k,23) +rxt(k,119)* y(k,35) & + +rxt(k,145)* y(k,53) +rxt(k,137)* y(k,54) +rxt(k,108)* y(k,56) & + +rxt(k,252)* y(k,61) +rxt(k,258)* y(k,63) +rxt(k,118)* y(k,68) & + +rxt(k,99)* y(k,73) +rxt(k,124)* y(k,77) + rxt(k,7) + rxt(k,8) & + + het_rates(k,58))* y(k,58) + prod(k,52) =rxt(k,110)*y(k,57)*y(k,56) + loss(k,14) = (rxt(k,259)* y(k,63) + rxt(k,59) + het_rates(k,59))* y(k,59) + prod(k,14) = (rxt(k,165)*y(k,26) +rxt(k,195)*y(k,3))*y(k,26) + loss(k,15) = (rxt(k,249)* y(k,56) +rxt(k,250)* y(k,77) + rxt(k,88) & + + het_rates(k,60))* y(k,60) + prod(k,15) = 0._r8 + loss(k,24) = (rxt(k,251)* y(k,57) +rxt(k,252)* y(k,58) +rxt(k,255)* y(k,77) & + + het_rates(k,61))* y(k,61) + prod(k,24) =rxt(k,88)*y(k,60) +rxt(k,89)*y(k,63) + loss(k,39) = (rxt(k,253)* y(k,3) +rxt(k,254)* y(k,26) +rxt(k,256)* y(k,54) & + +rxt(k,257)* y(k,57) +rxt(k,258)* y(k,58) +rxt(k,259)* y(k,59) & + +rxt(k,260)* y(k,77) + rxt(k,89) + het_rates(k,63))* y(k,63) + prod(k,39) = (rxt(k,251)*y(k,57) +rxt(k,252)*y(k,58) +rxt(k,255)*y(k,77)) & + *y(k,61) +rxt(k,249)*y(k,60)*y(k,56) +rxt(k,90)*y(k,64) + loss(k,36) = (rxt(k,262)* y(k,77) + rxt(k,90) + het_rates(k,64))* y(k,64) + prod(k,36) = (rxt(k,253)*y(k,3) +rxt(k,254)*y(k,26) +rxt(k,256)*y(k,54) + & + rxt(k,257)*y(k,57) +rxt(k,258)*y(k,58) +rxt(k,259)*y(k,59) + & + rxt(k,260)*y(k,77))*y(k,63) + (rxt(k,247)*y(k,55) + & + rxt(k,248)*y(k,77) +.500_r8*rxt(k,261)*y(k,77))*y(k,33) & + +rxt(k,250)*y(k,77)*y(k,60) +rxt(k,91)*y(k,65) + loss(k,11) = (rxt(k,263)* y(k,81) + rxt(k,91) + het_rates(k,65))* y(k,65) + prod(k,11) =rxt(k,87)*y(k,39) +rxt(k,262)*y(k,77)*y(k,64) + loss(k,1) = ( + het_rates(k,66))* y(k,66) + prod(k,1) = 0._r8 + loss(k,33) = (rxt(k,290)* y(k,70) +rxt(k,288)* y(k,71) +rxt(k,289)* y(k,76) & + + het_rates(k,67))* y(k,67) + prod(k,33) = (rxt(k,77) +rxt(k,78) +rxt(k,79) +rxt(k,80) +rxt(k,81) + & + rxt(k,84) +rxt(k,85) +rxt(k,86))*y(k,57) + (rxt(k,71) +rxt(k,72) + & + rxt(k,73) +rxt(k,74) +rxt(k,75) +rxt(k,76))*y(k,56) +rxt(k,62) & + *y(k,50) +rxt(k,16)*y(k,53) + loss(k,45) = (rxt(k,192)* y(k,1) +rxt(k,198)* y(k,3) +rxt(k,238)* y(k,19) & + + (rxt(k,159) +rxt(k,160))* y(k,23) +rxt(k,166)* y(k,26) & + + (rxt(k,113) +rxt(k,114) +rxt(k,115))* y(k,35) +rxt(k,144)* y(k,53) & + +rxt(k,149)* y(k,54) +rxt(k,139)* y(k,55) +rxt(k,117)* y(k,56) & + +rxt(k,118)* y(k,58) + 2._r8*rxt(k,127)* y(k,68) +rxt(k,122) & + * y(k,77) + rxt(k,264) + het_rates(k,68))* y(k,68) + prod(k,45) = (rxt(k,221)*y(k,16) +rxt(k,224)*y(k,18) +rxt(k,121)*y(k,38) + & + rxt(k,124)*y(k,58) +rxt(k,142)*y(k,55) +rxt(k,173)*y(k,26) + & + rxt(k,203)*y(k,3) +rxt(k,242)*y(k,29) +.500_r8*rxt(k,261)*y(k,33) + & + rxt(k,262)*y(k,64))*y(k,77) + (rxt(k,155)*y(k,23) + & + rxt(k,191)*y(k,1) +rxt(k,235)*y(k,55) +rxt(k,236)*y(k,56))*y(k,15) & + + (rxt(k,220)*y(k,16) +rxt(k,223)*y(k,18) +rxt(k,158)*y(k,38)) & + *y(k,23) + (rxt(k,162)*y(k,26) +rxt(k,239)*y(k,53))*y(k,19) & + + (rxt(k,11) +rxt(k,153))*y(k,47) +rxt(k,244)*y(k,73)*y(k,21) & + +rxt(k,116)*y(k,57)*y(k,35) +rxt(k,112)*y(k,56)*y(k,38) + loss(k,34) = (rxt(k,129)* y(k,56) +rxt(k,130)* y(k,57) +rxt(k,302)* y(k,78) & + + het_rates(k,69))* y(k,69) + prod(k,34) = (.800_r8*rxt(k,288)*y(k,71) +.900_r8*rxt(k,290)*y(k,70))*y(k,67) & + +rxt(k,292)*y(k,70)*y(k,56) + loss(k,23) = ((rxt(k,292) +rxt(k,293))* y(k,56) +rxt(k,291)* y(k,57) & + +rxt(k,290)* y(k,67) + het_rates(k,70))* y(k,70) + prod(k,23) =rxt(k,305)*y(k,79) +rxt(k,310)*y(k,80) + loss(k,25) = (rxt(k,288)* y(k,67) + het_rates(k,71))* y(k,71) + prod(k,25) = (rxt(k,298) +rxt(k,297)*y(k,50) +rxt(k,299)*y(k,53))*y(k,76) & + +rxt(k,16)*y(k,53) +rxt(k,292)*y(k,70)*y(k,56) +rxt(k,296)*y(k,72) & + *y(k,57) +rxt(k,301)*y(k,78) + loss(k,30) = (rxt(k,294)* y(k,56) + (rxt(k,295) +rxt(k,296))* y(k,57) & + + het_rates(k,72))* y(k,72) + prod(k,30) =rxt(k,62)*y(k,50) +rxt(k,302)*y(k,78)*y(k,69) +rxt(k,311)*y(k,80) + loss(k,50) = (rxt(k,180)* y(k,6) +rxt(k,181)* y(k,7) +rxt(k,207)* y(k,8) & + +rxt(k,182)* y(k,9) +rxt(k,183)* y(k,10) +rxt(k,184)* y(k,11) & + +rxt(k,185)* y(k,12) +rxt(k,186)* y(k,13) +rxt(k,230)* y(k,14) & + +rxt(k,231)* y(k,16) + (rxt(k,243) +rxt(k,244) +rxt(k,245))* y(k,21) & + +rxt(k,208)* y(k,22) +rxt(k,216)* y(k,31) +rxt(k,217)* y(k,32) & + +rxt(k,94)* y(k,36) +rxt(k,209)* y(k,37) + (rxt(k,210) +rxt(k,211)) & + * y(k,40) +rxt(k,232)* y(k,41) +rxt(k,233)* y(k,42) +rxt(k,234) & + * y(k,43) + (rxt(k,187) +rxt(k,188))* y(k,44) + (rxt(k,147) + & + rxt(k,148))* y(k,51) + (rxt(k,97) +rxt(k,98))* y(k,57) +rxt(k,99) & + * y(k,58) +rxt(k,95)* y(k,81) + rxt(k,96) + het_rates(k,73))* y(k,73) + prod(k,50) = (rxt(k,6) +rxt(k,130)*y(k,69))*y(k,57) +rxt(k,7)*y(k,58) & + +.850_r8*rxt(k,289)*y(k,76)*y(k,67) +rxt(k,1)*y(k,81) + loss(k,5) = (rxt(k,101)* y(k,56) +rxt(k,102)* y(k,57) + rxt(k,92) & + + rxt(k,100) + het_rates(k,74))* y(k,74) + prod(k,5) = (rxt(k,104) +rxt(k,103)*y(k,30) +rxt(k,105)*y(k,56) + & + rxt(k,106)*y(k,57) +rxt(k,107)*y(k,58))*y(k,75) +rxt(k,7)*y(k,58) + loss(k,6) = (rxt(k,103)* y(k,30) +rxt(k,105)* y(k,56) +rxt(k,106)* y(k,57) & + +rxt(k,107)* y(k,58) + rxt(k,93) + rxt(k,104) + het_rates(k,75)) & + * y(k,75) + prod(k,6) =rxt(k,97)*y(k,73)*y(k,57) + loss(k,32) = (rxt(k,297)* y(k,50) +rxt(k,299)* y(k,53) +rxt(k,289)* y(k,67) & + + rxt(k,298) + het_rates(k,76))* y(k,76) + prod(k,32) = (rxt(k,78) +rxt(k,80) +rxt(k,291)*y(k,70) +rxt(k,295)*y(k,72) + & + rxt(k,303)*y(k,78) +rxt(k,307)*y(k,79))*y(k,57) +rxt(k,300)*y(k,78) & + *y(k,30) + loss(k,54) = (rxt(k,203)* y(k,3) +rxt(k,219)* y(k,14) +rxt(k,237)* y(k,15) & + +rxt(k,221)* y(k,16) +rxt(k,222)* y(k,17) +rxt(k,224)* y(k,18) & + +rxt(k,240)* y(k,20) +rxt(k,241)* y(k,21) +rxt(k,226)* y(k,22) & + + (rxt(k,173) +rxt(k,174))* y(k,26) +rxt(k,171)* y(k,27) & + + (rxt(k,242) +rxt(k,246))* y(k,29) + (rxt(k,248) +rxt(k,261)) & + * y(k,33) +rxt(k,120)* y(k,36) +rxt(k,121)* y(k,38) +rxt(k,205) & + * y(k,40) +rxt(k,227)* y(k,41) +rxt(k,228)* y(k,42) +rxt(k,229) & + * y(k,43) +rxt(k,176)* y(k,44) +rxt(k,152)* y(k,46) +rxt(k,128) & + * y(k,47) +rxt(k,179)* y(k,49) +rxt(k,143)* y(k,50) +rxt(k,151) & + * y(k,54) +rxt(k,142)* y(k,55) +rxt(k,123)* y(k,56) +rxt(k,124) & + * y(k,58) +rxt(k,250)* y(k,60) +rxt(k,255)* y(k,61) +rxt(k,260) & + * y(k,63) +rxt(k,262)* y(k,64) +rxt(k,122)* y(k,68) & + + 2._r8*(rxt(k,125) +rxt(k,126))* y(k,77) + het_rates(k,77)) & + * y(k,77) + prod(k,54) = (rxt(k,111)*y(k,36) +rxt(k,112)*y(k,38) +rxt(k,117)*y(k,68) + & + rxt(k,175)*y(k,44) +rxt(k,178)*y(k,49) +rxt(k,204)*y(k,40) + & + rxt(k,206)*y(k,48) +rxt(k,236)*y(k,15))*y(k,56) & + + (2.000_r8*rxt(k,114)*y(k,35) +rxt(k,118)*y(k,58) + & + rxt(k,139)*y(k,55) +rxt(k,144)*y(k,53) +rxt(k,160)*y(k,23))*y(k,68) & + + (rxt(k,243)*y(k,21) +rxt(k,94)*y(k,36) + & + 2.000_r8*rxt(k,95)*y(k,81) +rxt(k,187)*y(k,44) +rxt(k,210)*y(k,40)) & + *y(k,73) + (rxt(k,22) +.300_r8*rxt(k,240)*y(k,77))*y(k,20) & + + (rxt(k,3) +rxt(k,214)*y(k,34))*y(k,81) +rxt(k,119)*y(k,58)*y(k,35) & + +2.000_r8*rxt(k,4)*y(k,38) +rxt(k,9)*y(k,46) +rxt(k,10)*y(k,47) & + +rxt(k,57)*y(k,48) +rxt(k,58)*y(k,49) +.500_r8*rxt(k,266)*y(k,54) + loss(k,31) = (rxt(k,300)* y(k,30) +rxt(k,303)* y(k,57) +rxt(k,302)* y(k,69) & + + rxt(k,301) + het_rates(k,78))* y(k,78) + prod(k,31) = (rxt(k,73) +rxt(k,74) +rxt(k,293)*y(k,70) +rxt(k,294)*y(k,72) + & + rxt(k,306)*y(k,79) +rxt(k,312)*y(k,80))*y(k,56) + (rxt(k,79) + & + rxt(k,81))*y(k,57) + (rxt(k,304)*y(k,79) +rxt(k,309)*y(k,80))*y(k,67) & + +rxt(k,286)*y(k,79) +rxt(k,285)*y(k,80) + loss(k,19) = (rxt(k,306)* y(k,56) +rxt(k,307)* y(k,57) +rxt(k,304)* y(k,67) & + + rxt(k,286) + rxt(k,305) + het_rates(k,79))* y(k,79) + prod(k,19) = (rxt(k,75) +rxt(k,76))*y(k,56) + (rxt(k,85) +rxt(k,86))*y(k,57) & + + (rxt(k,287) +rxt(k,308)*y(k,67))*y(k,80) + loss(k,18) = (rxt(k,312)* y(k,56) + (rxt(k,308) +rxt(k,309))* y(k,67) & + + rxt(k,285) + rxt(k,287) + rxt(k,310) + rxt(k,311) & + + het_rates(k,80))* y(k,80) + prod(k,18) = (rxt(k,71) +rxt(k,72))*y(k,56) + (rxt(k,77) +rxt(k,84))*y(k,57) + loss(k,58) = (rxt(k,214)* y(k,34) +rxt(k,263)* y(k,65) +rxt(k,95)* y(k,73) & + + rxt(k,1) + rxt(k,2) + rxt(k,3) + het_rates(k,81))* y(k,81) + prod(k,58) = (rxt(k,219)*y(k,14) +rxt(k,221)*y(k,16) +rxt(k,222)*y(k,17) + & + rxt(k,224)*y(k,18) +rxt(k,229)*y(k,43) +rxt(k,241)*y(k,21) + & + rxt(k,120)*y(k,36) +rxt(k,121)*y(k,38) +rxt(k,122)*y(k,68) + & + rxt(k,125)*y(k,77) +rxt(k,128)*y(k,47) +rxt(k,152)*y(k,46) + & + rxt(k,176)*y(k,44) +rxt(k,179)*y(k,49) +rxt(k,205)*y(k,40) + & + rxt(k,237)*y(k,15) +rxt(k,240)*y(k,20))*y(k,77) & + + (rxt(k,269)*y(k,49) +rxt(k,275)*y(k,49) +rxt(k,276)*y(k,48) + & + rxt(k,280)*y(k,49) +rxt(k,281)*y(k,48))*y(k,44) + (rxt(k,264) + & + rxt(k,115)*y(k,35))*y(k,68) +rxt(k,87)*y(k,39) + end do + end subroutine imp_prod_loss + end module mo_prod_loss diff --git a/src/chemistry/pp_waccm_ma_noaero/mo_rxt_rates_conv.F90 b/src/chemistry/pp_waccm_ma_noaero/mo_rxt_rates_conv.F90 new file mode 100644 index 0000000000..4d09fda0a2 --- /dev/null +++ b/src/chemistry/pp_waccm_ma_noaero/mo_rxt_rates_conv.F90 @@ -0,0 +1,324 @@ +module mo_rxt_rates_conv + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + private + public :: set_rates +contains + subroutine set_rates( rxt_rates, sol, ncol ) + real(r8), intent(inout) :: rxt_rates(:,:,:) + real(r8), intent(in) :: sol(:,:,:) + integer, intent(in) :: ncol + rxt_rates(:ncol,:, 1) = rxt_rates(:ncol,:, 1)*sol(:ncol,:, 81) ! rate_const*H2O + rxt_rates(:ncol,:, 2) = rxt_rates(:ncol,:, 2)*sol(:ncol,:, 81) ! rate_const*H2O + rxt_rates(:ncol,:, 3) = rxt_rates(:ncol,:, 3)*sol(:ncol,:, 81) ! rate_const*H2O + rxt_rates(:ncol,:, 4) = rxt_rates(:ncol,:, 4)*sol(:ncol,:, 38) ! rate_const*H2O2 + rxt_rates(:ncol,:, 5) = rxt_rates(:ncol,:, 5)*sol(:ncol,:, 57) ! rate_const*O2 + rxt_rates(:ncol,:, 6) = rxt_rates(:ncol,:, 6)*sol(:ncol,:, 57) ! rate_const*O2 + rxt_rates(:ncol,:, 7) = rxt_rates(:ncol,:, 7)*sol(:ncol,:, 58) ! rate_const*O3 + rxt_rates(:ncol,:, 8) = rxt_rates(:ncol,:, 8)*sol(:ncol,:, 58) ! rate_const*O3 + rxt_rates(:ncol,:, 9) = rxt_rates(:ncol,:, 9)*sol(:ncol,:, 46) ! rate_const*HNO3 + rxt_rates(:ncol,:, 10) = rxt_rates(:ncol,:, 10)*sol(:ncol,:, 47) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 11) = rxt_rates(:ncol,:, 11)*sol(:ncol,:, 47) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 12) = rxt_rates(:ncol,:, 12)*sol(:ncol,:, 51) ! rate_const*N2O + rxt_rates(:ncol,:, 13) = rxt_rates(:ncol,:, 13)*sol(:ncol,:, 52) ! rate_const*N2O5 + rxt_rates(:ncol,:, 14) = rxt_rates(:ncol,:, 14)*sol(:ncol,:, 52) ! rate_const*N2O5 + rxt_rates(:ncol,:, 15) = rxt_rates(:ncol,:, 15)*sol(:ncol,:, 53) ! rate_const*NO + rxt_rates(:ncol,:, 16) = rxt_rates(:ncol,:, 16)*sol(:ncol,:, 53) ! rate_const*NO + rxt_rates(:ncol,:, 17) = rxt_rates(:ncol,:, 17)*sol(:ncol,:, 54) ! rate_const*NO2 + rxt_rates(:ncol,:, 18) = rxt_rates(:ncol,:, 18)*sol(:ncol,:, 55) ! rate_const*NO3 + rxt_rates(:ncol,:, 19) = rxt_rates(:ncol,:, 19)*sol(:ncol,:, 55) ! rate_const*NO3 + rxt_rates(:ncol,:, 20) = rxt_rates(:ncol,:, 20)*sol(:ncol,:, 15) ! rate_const*CH2O + rxt_rates(:ncol,:, 21) = rxt_rates(:ncol,:, 21)*sol(:ncol,:, 15) ! rate_const*CH2O + rxt_rates(:ncol,:, 22) = rxt_rates(:ncol,:, 22)*sol(:ncol,:, 20) ! rate_const*CH3OOH + rxt_rates(:ncol,:, 23) = rxt_rates(:ncol,:, 23)*sol(:ncol,:, 21) ! rate_const*CH4 + rxt_rates(:ncol,:, 24) = rxt_rates(:ncol,:, 24)*sol(:ncol,:, 21) ! rate_const*CH4 + rxt_rates(:ncol,:, 25) = rxt_rates(:ncol,:, 25)*sol(:ncol,:, 30) ! rate_const*CO2 + rxt_rates(:ncol,:, 26) = rxt_rates(:ncol,:, 26)*sol(:ncol,:, 2) ! rate_const*BRCL + rxt_rates(:ncol,:, 27) = rxt_rates(:ncol,:, 27)*sol(:ncol,:, 3) ! rate_const*BRO + rxt_rates(:ncol,:, 28) = rxt_rates(:ncol,:, 28)*sol(:ncol,:, 4) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 29) = rxt_rates(:ncol,:, 29)*sol(:ncol,:, 4) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 30) = rxt_rates(:ncol,:, 30)*sol(:ncol,:, 6) ! rate_const*CCL4 + rxt_rates(:ncol,:, 31) = rxt_rates(:ncol,:, 31)*sol(:ncol,:, 7) ! rate_const*CF2CLBR + rxt_rates(:ncol,:, 32) = rxt_rates(:ncol,:, 32)*sol(:ncol,:, 8) ! rate_const*CF3BR + rxt_rates(:ncol,:, 33) = rxt_rates(:ncol,:, 33)*sol(:ncol,:, 9) ! rate_const*CFC11 + rxt_rates(:ncol,:, 34) = rxt_rates(:ncol,:, 34)*sol(:ncol,:, 10) ! rate_const*CFC113 + rxt_rates(:ncol,:, 35) = rxt_rates(:ncol,:, 35)*sol(:ncol,:, 11) ! rate_const*CFC114 + rxt_rates(:ncol,:, 36) = rxt_rates(:ncol,:, 36)*sol(:ncol,:, 12) ! rate_const*CFC115 + rxt_rates(:ncol,:, 37) = rxt_rates(:ncol,:, 37)*sol(:ncol,:, 13) ! rate_const*CFC12 + rxt_rates(:ncol,:, 38) = rxt_rates(:ncol,:, 38)*sol(:ncol,:, 14) ! rate_const*CH2BR2 + rxt_rates(:ncol,:, 39) = rxt_rates(:ncol,:, 39)*sol(:ncol,:, 16) ! rate_const*CH3BR + rxt_rates(:ncol,:, 40) = rxt_rates(:ncol,:, 40)*sol(:ncol,:, 17) ! rate_const*CH3CCL3 + rxt_rates(:ncol,:, 41) = rxt_rates(:ncol,:, 41)*sol(:ncol,:, 18) ! rate_const*CH3CL + rxt_rates(:ncol,:, 42) = rxt_rates(:ncol,:, 42)*sol(:ncol,:, 22) ! rate_const*CHBR3 + rxt_rates(:ncol,:, 43) = rxt_rates(:ncol,:, 43)*sol(:ncol,:, 24) ! rate_const*CL2 + rxt_rates(:ncol,:, 44) = rxt_rates(:ncol,:, 44)*sol(:ncol,:, 25) ! rate_const*CL2O2 + rxt_rates(:ncol,:, 45) = rxt_rates(:ncol,:, 45)*sol(:ncol,:, 26) ! rate_const*CLO + rxt_rates(:ncol,:, 46) = rxt_rates(:ncol,:, 46)*sol(:ncol,:, 27) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 47) = rxt_rates(:ncol,:, 47)*sol(:ncol,:, 27) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 48) = rxt_rates(:ncol,:, 48)*sol(:ncol,:, 31) ! rate_const*COF2 + rxt_rates(:ncol,:, 49) = rxt_rates(:ncol,:, 49)*sol(:ncol,:, 32) ! rate_const*COFCL + rxt_rates(:ncol,:, 50) = rxt_rates(:ncol,:, 50)*sol(:ncol,:, 37) ! rate_const*H2402 + rxt_rates(:ncol,:, 51) = rxt_rates(:ncol,:, 51)*sol(:ncol,:, 40) ! rate_const*HBR + rxt_rates(:ncol,:, 52) = rxt_rates(:ncol,:, 52)*sol(:ncol,:, 41) ! rate_const*HCFC141B + rxt_rates(:ncol,:, 53) = rxt_rates(:ncol,:, 53)*sol(:ncol,:, 42) ! rate_const*HCFC142B + rxt_rates(:ncol,:, 54) = rxt_rates(:ncol,:, 54)*sol(:ncol,:, 43) ! rate_const*HCFC22 + rxt_rates(:ncol,:, 55) = rxt_rates(:ncol,:, 55)*sol(:ncol,:, 44) ! rate_const*HCL + rxt_rates(:ncol,:, 56) = rxt_rates(:ncol,:, 56)*sol(:ncol,:, 45) ! rate_const*HF + rxt_rates(:ncol,:, 57) = rxt_rates(:ncol,:, 57)*sol(:ncol,:, 48) ! rate_const*HOBR + rxt_rates(:ncol,:, 58) = rxt_rates(:ncol,:, 58)*sol(:ncol,:, 49) ! rate_const*HOCL + rxt_rates(:ncol,:, 59) = rxt_rates(:ncol,:, 59)*sol(:ncol,:, 59) ! rate_const*OCLO + rxt_rates(:ncol,:, 60) = rxt_rates(:ncol,:, 60)*sol(:ncol,:, 62) ! rate_const*SF6 + rxt_rates(:ncol,:, 61) = rxt_rates(:ncol,:, 61)*sol(:ncol,:, 30) ! rate_const*CO2 + rxt_rates(:ncol,:, 62) = rxt_rates(:ncol,:, 62)*sol(:ncol,:, 50) ! rate_const*N + ! rate_const*N2 + ! rate_const*N2 + ! rate_const*N2 + ! rate_const*N2 + ! rate_const*N2 + ! rate_const*N2 + ! rate_const*N2 + ! rate_const*N2 + rxt_rates(:ncol,:, 71) = rxt_rates(:ncol,:, 71)*sol(:ncol,:, 56) ! rate_const*O + rxt_rates(:ncol,:, 72) = rxt_rates(:ncol,:, 72)*sol(:ncol,:, 56) ! rate_const*O + rxt_rates(:ncol,:, 73) = rxt_rates(:ncol,:, 73)*sol(:ncol,:, 56) ! rate_const*O + rxt_rates(:ncol,:, 74) = rxt_rates(:ncol,:, 74)*sol(:ncol,:, 56) ! rate_const*O + rxt_rates(:ncol,:, 75) = rxt_rates(:ncol,:, 75)*sol(:ncol,:, 56) ! rate_const*O + rxt_rates(:ncol,:, 76) = rxt_rates(:ncol,:, 76)*sol(:ncol,:, 56) ! rate_const*O + rxt_rates(:ncol,:, 77) = rxt_rates(:ncol,:, 77)*sol(:ncol,:, 57) ! rate_const*O2 + rxt_rates(:ncol,:, 78) = rxt_rates(:ncol,:, 78)*sol(:ncol,:, 57) ! rate_const*O2 + rxt_rates(:ncol,:, 79) = rxt_rates(:ncol,:, 79)*sol(:ncol,:, 57) ! rate_const*O2 + rxt_rates(:ncol,:, 80) = rxt_rates(:ncol,:, 80)*sol(:ncol,:, 57) ! rate_const*O2 + rxt_rates(:ncol,:, 81) = rxt_rates(:ncol,:, 81)*sol(:ncol,:, 57) ! rate_const*O2 + rxt_rates(:ncol,:, 82) = rxt_rates(:ncol,:, 82)*sol(:ncol,:, 57) ! rate_const*O2 + rxt_rates(:ncol,:, 83) = rxt_rates(:ncol,:, 83)*sol(:ncol,:, 57) ! rate_const*O2 + rxt_rates(:ncol,:, 84) = rxt_rates(:ncol,:, 84)*sol(:ncol,:, 57) ! rate_const*O2 + rxt_rates(:ncol,:, 85) = rxt_rates(:ncol,:, 85)*sol(:ncol,:, 57) ! rate_const*O2 + rxt_rates(:ncol,:, 86) = rxt_rates(:ncol,:, 86)*sol(:ncol,:, 57) ! rate_const*O2 + rxt_rates(:ncol,:, 87) = rxt_rates(:ncol,:, 87)*sol(:ncol,:, 39) ! rate_const*H2SO4 + rxt_rates(:ncol,:, 88) = rxt_rates(:ncol,:, 88)*sol(:ncol,:, 60) ! rate_const*OCS + rxt_rates(:ncol,:, 89) = rxt_rates(:ncol,:, 89)*sol(:ncol,:, 63) ! rate_const*SO + rxt_rates(:ncol,:, 90) = rxt_rates(:ncol,:, 90)*sol(:ncol,:, 64) ! rate_const*SO2 + rxt_rates(:ncol,:, 91) = rxt_rates(:ncol,:, 91)*sol(:ncol,:, 65) ! rate_const*SO3 + rxt_rates(:ncol,:, 92) = rxt_rates(:ncol,:, 92)*sol(:ncol,:, 74) ! rate_const*O2_1D + rxt_rates(:ncol,:, 93) = rxt_rates(:ncol,:, 93)*sol(:ncol,:, 75) ! rate_const*O2_1S + rxt_rates(:ncol,:, 94) = rxt_rates(:ncol,:, 94)*sol(:ncol,:, 73)*sol(:ncol,:, 36) ! rate_const*O1D*H2 + rxt_rates(:ncol,:, 95) = rxt_rates(:ncol,:, 95)*sol(:ncol,:, 73)*sol(:ncol,:, 81) ! rate_const*O1D*H2O + rxt_rates(:ncol,:, 96) = rxt_rates(:ncol,:, 96)*sol(:ncol,:, 73) ! rate_const*N2*O1D + rxt_rates(:ncol,:, 97) = rxt_rates(:ncol,:, 97)*sol(:ncol,:, 73)*sol(:ncol,:, 57) ! rate_const*O1D*O2 + rxt_rates(:ncol,:, 98) = rxt_rates(:ncol,:, 98)*sol(:ncol,:, 73)*sol(:ncol,:, 57) ! rate_const*O1D*O2 + rxt_rates(:ncol,:, 99) = rxt_rates(:ncol,:, 99)*sol(:ncol,:, 73)*sol(:ncol,:, 58) ! rate_const*O1D*O3 + rxt_rates(:ncol,:, 100) = rxt_rates(:ncol,:, 100)*sol(:ncol,:, 74) ! rate_const*N2*O2_1D + rxt_rates(:ncol,:, 101) = rxt_rates(:ncol,:, 101)*sol(:ncol,:, 74)*sol(:ncol,:, 56) ! rate_const*O2_1D*O + rxt_rates(:ncol,:, 102) = rxt_rates(:ncol,:, 102)*sol(:ncol,:, 74)*sol(:ncol,:, 57) ! rate_const*O2_1D*O2 + rxt_rates(:ncol,:, 103) = rxt_rates(:ncol,:, 103)*sol(:ncol,:, 75)*sol(:ncol,:, 30) ! rate_const*O2_1S*CO2 + rxt_rates(:ncol,:, 104) = rxt_rates(:ncol,:, 104)*sol(:ncol,:, 75) ! rate_const*N2*O2_1S + rxt_rates(:ncol,:, 105) = rxt_rates(:ncol,:, 105)*sol(:ncol,:, 75)*sol(:ncol,:, 56) ! rate_const*O2_1S*O + rxt_rates(:ncol,:, 106) = rxt_rates(:ncol,:, 106)*sol(:ncol,:, 75)*sol(:ncol,:, 57) ! rate_const*O2_1S*O2 + rxt_rates(:ncol,:, 107) = rxt_rates(:ncol,:, 107)*sol(:ncol,:, 75)*sol(:ncol,:, 58) ! rate_const*O2_1S*O3 + rxt_rates(:ncol,:, 108) = rxt_rates(:ncol,:, 108)*sol(:ncol,:, 56)*sol(:ncol,:, 58) ! rate_const*O*O3 + rxt_rates(:ncol,:, 109) = rxt_rates(:ncol,:, 109)*sol(:ncol,:, 56)*sol(:ncol,:, 56) ! rate_const*M*O*O + rxt_rates(:ncol,:, 110) = rxt_rates(:ncol,:, 110)*sol(:ncol,:, 56)*sol(:ncol,:, 57) ! rate_const*M*O*O2 + rxt_rates(:ncol,:, 111) = rxt_rates(:ncol,:, 111)*sol(:ncol,:, 36)*sol(:ncol,:, 56) ! rate_const*H2*O + rxt_rates(:ncol,:, 112) = rxt_rates(:ncol,:, 112)*sol(:ncol,:, 38)*sol(:ncol,:, 56) ! rate_const*H2O2*O + rxt_rates(:ncol,:, 113) = rxt_rates(:ncol,:, 113)*sol(:ncol,:, 35)*sol(:ncol,:, 68) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 114) = rxt_rates(:ncol,:, 114)*sol(:ncol,:, 35)*sol(:ncol,:, 68) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 115) = rxt_rates(:ncol,:, 115)*sol(:ncol,:, 35)*sol(:ncol,:, 68) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 116) = rxt_rates(:ncol,:, 116)*sol(:ncol,:, 35)*sol(:ncol,:, 57) ! rate_const*M*H*O2 + rxt_rates(:ncol,:, 117) = rxt_rates(:ncol,:, 117)*sol(:ncol,:, 68)*sol(:ncol,:, 56) ! rate_const*HO2*O + rxt_rates(:ncol,:, 118) = rxt_rates(:ncol,:, 118)*sol(:ncol,:, 68)*sol(:ncol,:, 58) ! rate_const*HO2*O3 + rxt_rates(:ncol,:, 119) = rxt_rates(:ncol,:, 119)*sol(:ncol,:, 35)*sol(:ncol,:, 58) ! rate_const*H*O3 + rxt_rates(:ncol,:, 120) = rxt_rates(:ncol,:, 120)*sol(:ncol,:, 77)*sol(:ncol,:, 36) ! rate_const*OH*H2 + rxt_rates(:ncol,:, 121) = rxt_rates(:ncol,:, 121)*sol(:ncol,:, 77)*sol(:ncol,:, 38) ! rate_const*OH*H2O2 + rxt_rates(:ncol,:, 122) = rxt_rates(:ncol,:, 122)*sol(:ncol,:, 77)*sol(:ncol,:, 68) ! rate_const*OH*HO2 + rxt_rates(:ncol,:, 123) = rxt_rates(:ncol,:, 123)*sol(:ncol,:, 77)*sol(:ncol,:, 56) ! rate_const*OH*O + rxt_rates(:ncol,:, 124) = rxt_rates(:ncol,:, 124)*sol(:ncol,:, 77)*sol(:ncol,:, 58) ! rate_const*OH*O3 + rxt_rates(:ncol,:, 125) = rxt_rates(:ncol,:, 125)*sol(:ncol,:, 77)*sol(:ncol,:, 77) ! rate_const*OH*OH + rxt_rates(:ncol,:, 126) = rxt_rates(:ncol,:, 126)*sol(:ncol,:, 77)*sol(:ncol,:, 77) ! rate_const*M*OH*OH + rxt_rates(:ncol,:, 127) = rxt_rates(:ncol,:, 127)*sol(:ncol,:, 68)*sol(:ncol,:, 68) ! rate_const*HO2*HO2 + rxt_rates(:ncol,:, 128) = rxt_rates(:ncol,:, 128)*sol(:ncol,:, 47)*sol(:ncol,:, 77) ! rate_const*HO2NO2*OH + rxt_rates(:ncol,:, 129) = rxt_rates(:ncol,:, 129)*sol(:ncol,:, 69)*sol(:ncol,:, 56) ! rate_const*N2D*O + rxt_rates(:ncol,:, 130) = rxt_rates(:ncol,:, 130)*sol(:ncol,:, 69)*sol(:ncol,:, 57) ! rate_const*N2D*O2 + rxt_rates(:ncol,:, 131) = rxt_rates(:ncol,:, 131)*sol(:ncol,:, 50)*sol(:ncol,:, 53) ! rate_const*N*NO + rxt_rates(:ncol,:, 132) = rxt_rates(:ncol,:, 132)*sol(:ncol,:, 50)*sol(:ncol,:, 54) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 133) = rxt_rates(:ncol,:, 133)*sol(:ncol,:, 50)*sol(:ncol,:, 54) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 134) = rxt_rates(:ncol,:, 134)*sol(:ncol,:, 50)*sol(:ncol,:, 54) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 135) = rxt_rates(:ncol,:, 135)*sol(:ncol,:, 50)*sol(:ncol,:, 57) ! rate_const*N*O2 + rxt_rates(:ncol,:, 136) = rxt_rates(:ncol,:, 136)*sol(:ncol,:, 54)*sol(:ncol,:, 56) ! rate_const*NO2*O + rxt_rates(:ncol,:, 137) = rxt_rates(:ncol,:, 137)*sol(:ncol,:, 54)*sol(:ncol,:, 58) ! rate_const*NO2*O3 + rxt_rates(:ncol,:, 138) = rxt_rates(:ncol,:, 138)*sol(:ncol,:, 54)*sol(:ncol,:, 56) ! rate_const*M*NO2*O + rxt_rates(:ncol,:, 139) = rxt_rates(:ncol,:, 139)*sol(:ncol,:, 55)*sol(:ncol,:, 68) ! rate_const*NO3*HO2 + rxt_rates(:ncol,:, 140) = rxt_rates(:ncol,:, 140)*sol(:ncol,:, 55)*sol(:ncol,:, 53) ! rate_const*NO3*NO + rxt_rates(:ncol,:, 141) = rxt_rates(:ncol,:, 141)*sol(:ncol,:, 55)*sol(:ncol,:, 56) ! rate_const*NO3*O + rxt_rates(:ncol,:, 142) = rxt_rates(:ncol,:, 142)*sol(:ncol,:, 55)*sol(:ncol,:, 77) ! rate_const*NO3*OH + rxt_rates(:ncol,:, 143) = rxt_rates(:ncol,:, 143)*sol(:ncol,:, 50)*sol(:ncol,:, 77) ! rate_const*N*OH + rxt_rates(:ncol,:, 144) = rxt_rates(:ncol,:, 144)*sol(:ncol,:, 53)*sol(:ncol,:, 68) ! rate_const*NO*HO2 + rxt_rates(:ncol,:, 145) = rxt_rates(:ncol,:, 145)*sol(:ncol,:, 53)*sol(:ncol,:, 58) ! rate_const*NO*O3 + rxt_rates(:ncol,:, 146) = rxt_rates(:ncol,:, 146)*sol(:ncol,:, 53)*sol(:ncol,:, 56) ! rate_const*M*NO*O + rxt_rates(:ncol,:, 147) = rxt_rates(:ncol,:, 147)*sol(:ncol,:, 73)*sol(:ncol,:, 51) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 148) = rxt_rates(:ncol,:, 148)*sol(:ncol,:, 73)*sol(:ncol,:, 51) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 149) = rxt_rates(:ncol,:, 149)*sol(:ncol,:, 54)*sol(:ncol,:, 68) ! rate_const*M*NO2*HO2 + rxt_rates(:ncol,:, 150) = rxt_rates(:ncol,:, 150)*sol(:ncol,:, 54)*sol(:ncol,:, 55) ! rate_const*M*NO2*NO3 + rxt_rates(:ncol,:, 151) = rxt_rates(:ncol,:, 151)*sol(:ncol,:, 54)*sol(:ncol,:, 77) ! rate_const*M*NO2*OH + rxt_rates(:ncol,:, 152) = rxt_rates(:ncol,:, 152)*sol(:ncol,:, 46)*sol(:ncol,:, 77) ! rate_const*HNO3*OH + rxt_rates(:ncol,:, 153) = rxt_rates(:ncol,:, 153)*sol(:ncol,:, 47) ! rate_const*M*HO2NO2 + rxt_rates(:ncol,:, 154) = rxt_rates(:ncol,:, 154)*sol(:ncol,:, 52) ! rate_const*M*N2O5 + rxt_rates(:ncol,:, 155) = rxt_rates(:ncol,:, 155)*sol(:ncol,:, 23)*sol(:ncol,:, 15) ! rate_const*CL*CH2O + rxt_rates(:ncol,:, 156) = rxt_rates(:ncol,:, 156)*sol(:ncol,:, 23)*sol(:ncol,:, 21) ! rate_const*CL*CH4 + rxt_rates(:ncol,:, 157) = rxt_rates(:ncol,:, 157)*sol(:ncol,:, 23)*sol(:ncol,:, 36) ! rate_const*CL*H2 + rxt_rates(:ncol,:, 158) = rxt_rates(:ncol,:, 158)*sol(:ncol,:, 23)*sol(:ncol,:, 38) ! rate_const*CL*H2O2 + rxt_rates(:ncol,:, 159) = rxt_rates(:ncol,:, 159)*sol(:ncol,:, 23)*sol(:ncol,:, 68) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 160) = rxt_rates(:ncol,:, 160)*sol(:ncol,:, 23)*sol(:ncol,:, 68) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 161) = rxt_rates(:ncol,:, 161)*sol(:ncol,:, 23)*sol(:ncol,:, 58) ! rate_const*CL*O3 + rxt_rates(:ncol,:, 162) = rxt_rates(:ncol,:, 162)*sol(:ncol,:, 26)*sol(:ncol,:, 19) ! rate_const*CLO*CH3O2 + rxt_rates(:ncol,:, 163) = rxt_rates(:ncol,:, 163)*sol(:ncol,:, 26)*sol(:ncol,:, 26) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 164) = rxt_rates(:ncol,:, 164)*sol(:ncol,:, 26)*sol(:ncol,:, 26) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 165) = rxt_rates(:ncol,:, 165)*sol(:ncol,:, 26)*sol(:ncol,:, 26) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 166) = rxt_rates(:ncol,:, 166)*sol(:ncol,:, 26)*sol(:ncol,:, 68) ! rate_const*CLO*HO2 + rxt_rates(:ncol,:, 167) = rxt_rates(:ncol,:, 167)*sol(:ncol,:, 26)*sol(:ncol,:, 53) ! rate_const*CLO*NO + rxt_rates(:ncol,:, 168) = rxt_rates(:ncol,:, 168)*sol(:ncol,:, 27)*sol(:ncol,:, 23) ! rate_const*CLONO2*CL + rxt_rates(:ncol,:, 169) = rxt_rates(:ncol,:, 169)*sol(:ncol,:, 26)*sol(:ncol,:, 54) ! rate_const*M*CLO*NO2 + rxt_rates(:ncol,:, 170) = rxt_rates(:ncol,:, 170)*sol(:ncol,:, 27)*sol(:ncol,:, 56) ! rate_const*CLONO2*O + rxt_rates(:ncol,:, 171) = rxt_rates(:ncol,:, 171)*sol(:ncol,:, 27)*sol(:ncol,:, 77) ! rate_const*CLONO2*OH + rxt_rates(:ncol,:, 172) = rxt_rates(:ncol,:, 172)*sol(:ncol,:, 26)*sol(:ncol,:, 56) ! rate_const*CLO*O + rxt_rates(:ncol,:, 173) = rxt_rates(:ncol,:, 173)*sol(:ncol,:, 26)*sol(:ncol,:, 77) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 174) = rxt_rates(:ncol,:, 174)*sol(:ncol,:, 26)*sol(:ncol,:, 77) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 175) = rxt_rates(:ncol,:, 175)*sol(:ncol,:, 44)*sol(:ncol,:, 56) ! rate_const*HCL*O + rxt_rates(:ncol,:, 176) = rxt_rates(:ncol,:, 176)*sol(:ncol,:, 44)*sol(:ncol,:, 77) ! rate_const*HCL*OH + rxt_rates(:ncol,:, 177) = rxt_rates(:ncol,:, 177)*sol(:ncol,:, 49)*sol(:ncol,:, 23) ! rate_const*HOCL*CL + rxt_rates(:ncol,:, 178) = rxt_rates(:ncol,:, 178)*sol(:ncol,:, 49)*sol(:ncol,:, 56) ! rate_const*HOCL*O + rxt_rates(:ncol,:, 179) = rxt_rates(:ncol,:, 179)*sol(:ncol,:, 49)*sol(:ncol,:, 77) ! rate_const*HOCL*OH + rxt_rates(:ncol,:, 180) = rxt_rates(:ncol,:, 180)*sol(:ncol,:, 73)*sol(:ncol,:, 6) ! rate_const*O1D*CCL4 + rxt_rates(:ncol,:, 181) = rxt_rates(:ncol,:, 181)*sol(:ncol,:, 73)*sol(:ncol,:, 7) ! rate_const*O1D*CF2CLBR + rxt_rates(:ncol,:, 182) = rxt_rates(:ncol,:, 182)*sol(:ncol,:, 73)*sol(:ncol,:, 9) ! rate_const*O1D*CFC11 + rxt_rates(:ncol,:, 183) = rxt_rates(:ncol,:, 183)*sol(:ncol,:, 73)*sol(:ncol,:, 10) ! rate_const*O1D*CFC113 + rxt_rates(:ncol,:, 184) = rxt_rates(:ncol,:, 184)*sol(:ncol,:, 73)*sol(:ncol,:, 11) ! rate_const*O1D*CFC114 + rxt_rates(:ncol,:, 185) = rxt_rates(:ncol,:, 185)*sol(:ncol,:, 73)*sol(:ncol,:, 12) ! rate_const*O1D*CFC115 + rxt_rates(:ncol,:, 186) = rxt_rates(:ncol,:, 186)*sol(:ncol,:, 73)*sol(:ncol,:, 13) ! rate_const*O1D*CFC12 + rxt_rates(:ncol,:, 187) = rxt_rates(:ncol,:, 187)*sol(:ncol,:, 73)*sol(:ncol,:, 44) ! rate_const*O1D*HCL + rxt_rates(:ncol,:, 188) = rxt_rates(:ncol,:, 188)*sol(:ncol,:, 73)*sol(:ncol,:, 44) ! rate_const*O1D*HCL + rxt_rates(:ncol,:, 189) = rxt_rates(:ncol,:, 189)*sol(:ncol,:, 26)*sol(:ncol,:, 26) ! rate_const*M*CLO*CLO + rxt_rates(:ncol,:, 190) = rxt_rates(:ncol,:, 190)*sol(:ncol,:, 25) ! rate_const*M*CL2O2 + rxt_rates(:ncol,:, 191) = rxt_rates(:ncol,:, 191)*sol(:ncol,:, 1)*sol(:ncol,:, 15) ! rate_const*BR*CH2O + rxt_rates(:ncol,:, 192) = rxt_rates(:ncol,:, 192)*sol(:ncol,:, 1)*sol(:ncol,:, 68) ! rate_const*BR*HO2 + rxt_rates(:ncol,:, 193) = rxt_rates(:ncol,:, 193)*sol(:ncol,:, 1)*sol(:ncol,:, 58) ! rate_const*BR*O3 + rxt_rates(:ncol,:, 194) = rxt_rates(:ncol,:, 194)*sol(:ncol,:, 3)*sol(:ncol,:, 3) ! rate_const*BRO*BRO + rxt_rates(:ncol,:, 195) = rxt_rates(:ncol,:, 195)*sol(:ncol,:, 3)*sol(:ncol,:, 26) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 196) = rxt_rates(:ncol,:, 196)*sol(:ncol,:, 3)*sol(:ncol,:, 26) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 197) = rxt_rates(:ncol,:, 197)*sol(:ncol,:, 3)*sol(:ncol,:, 26) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 198) = rxt_rates(:ncol,:, 198)*sol(:ncol,:, 3)*sol(:ncol,:, 68) ! rate_const*BRO*HO2 + rxt_rates(:ncol,:, 199) = rxt_rates(:ncol,:, 199)*sol(:ncol,:, 3)*sol(:ncol,:, 53) ! rate_const*BRO*NO + rxt_rates(:ncol,:, 200) = rxt_rates(:ncol,:, 200)*sol(:ncol,:, 3)*sol(:ncol,:, 54) ! rate_const*M*BRO*NO2 + rxt_rates(:ncol,:, 201) = rxt_rates(:ncol,:, 201)*sol(:ncol,:, 4)*sol(:ncol,:, 56) ! rate_const*BRONO2*O + rxt_rates(:ncol,:, 202) = rxt_rates(:ncol,:, 202)*sol(:ncol,:, 3)*sol(:ncol,:, 56) ! rate_const*BRO*O + rxt_rates(:ncol,:, 203) = rxt_rates(:ncol,:, 203)*sol(:ncol,:, 3)*sol(:ncol,:, 77) ! rate_const*BRO*OH + rxt_rates(:ncol,:, 204) = rxt_rates(:ncol,:, 204)*sol(:ncol,:, 40)*sol(:ncol,:, 56) ! rate_const*HBR*O + rxt_rates(:ncol,:, 205) = rxt_rates(:ncol,:, 205)*sol(:ncol,:, 40)*sol(:ncol,:, 77) ! rate_const*HBR*OH + rxt_rates(:ncol,:, 206) = rxt_rates(:ncol,:, 206)*sol(:ncol,:, 48)*sol(:ncol,:, 56) ! rate_const*HOBR*O + rxt_rates(:ncol,:, 207) = rxt_rates(:ncol,:, 207)*sol(:ncol,:, 73)*sol(:ncol,:, 8) ! rate_const*O1D*CF3BR + rxt_rates(:ncol,:, 208) = rxt_rates(:ncol,:, 208)*sol(:ncol,:, 73)*sol(:ncol,:, 22) ! rate_const*O1D*CHBR3 + rxt_rates(:ncol,:, 209) = rxt_rates(:ncol,:, 209)*sol(:ncol,:, 73)*sol(:ncol,:, 37) ! rate_const*O1D*H2402 + rxt_rates(:ncol,:, 210) = rxt_rates(:ncol,:, 210)*sol(:ncol,:, 73)*sol(:ncol,:, 40) ! rate_const*O1D*HBR + rxt_rates(:ncol,:, 211) = rxt_rates(:ncol,:, 211)*sol(:ncol,:, 73)*sol(:ncol,:, 40) ! rate_const*O1D*HBR + rxt_rates(:ncol,:, 212) = rxt_rates(:ncol,:, 212)*sol(:ncol,:, 34)*sol(:ncol,:, 21) ! rate_const*F*CH4 + rxt_rates(:ncol,:, 213) = rxt_rates(:ncol,:, 213)*sol(:ncol,:, 34)*sol(:ncol,:, 36) ! rate_const*F*H2 + rxt_rates(:ncol,:, 214) = rxt_rates(:ncol,:, 214)*sol(:ncol,:, 34)*sol(:ncol,:, 81) ! rate_const*F*H2O + rxt_rates(:ncol,:, 215) = rxt_rates(:ncol,:, 215)*sol(:ncol,:, 34)*sol(:ncol,:, 46) ! rate_const*F*HNO3 + rxt_rates(:ncol,:, 216) = rxt_rates(:ncol,:, 216)*sol(:ncol,:, 73)*sol(:ncol,:, 31) ! rate_const*O1D*COF2 + rxt_rates(:ncol,:, 217) = rxt_rates(:ncol,:, 217)*sol(:ncol,:, 73)*sol(:ncol,:, 32) ! rate_const*O1D*COFCL + rxt_rates(:ncol,:, 218) = rxt_rates(:ncol,:, 218)*sol(:ncol,:, 14)*sol(:ncol,:, 23) ! rate_const*CH2BR2*CL + rxt_rates(:ncol,:, 219) = rxt_rates(:ncol,:, 219)*sol(:ncol,:, 14)*sol(:ncol,:, 77) ! rate_const*CH2BR2*OH + rxt_rates(:ncol,:, 220) = rxt_rates(:ncol,:, 220)*sol(:ncol,:, 16)*sol(:ncol,:, 23) ! rate_const*CH3BR*CL + rxt_rates(:ncol,:, 221) = rxt_rates(:ncol,:, 221)*sol(:ncol,:, 16)*sol(:ncol,:, 77) ! rate_const*CH3BR*OH + rxt_rates(:ncol,:, 222) = rxt_rates(:ncol,:, 222)*sol(:ncol,:, 17)*sol(:ncol,:, 77) ! rate_const*CH3CCL3*OH + rxt_rates(:ncol,:, 223) = rxt_rates(:ncol,:, 223)*sol(:ncol,:, 18)*sol(:ncol,:, 23) ! rate_const*CH3CL*CL + rxt_rates(:ncol,:, 224) = rxt_rates(:ncol,:, 224)*sol(:ncol,:, 18)*sol(:ncol,:, 77) ! rate_const*CH3CL*OH + rxt_rates(:ncol,:, 225) = rxt_rates(:ncol,:, 225)*sol(:ncol,:, 22)*sol(:ncol,:, 23) ! rate_const*CHBR3*CL + rxt_rates(:ncol,:, 226) = rxt_rates(:ncol,:, 226)*sol(:ncol,:, 22)*sol(:ncol,:, 77) ! rate_const*CHBR3*OH + rxt_rates(:ncol,:, 227) = rxt_rates(:ncol,:, 227)*sol(:ncol,:, 41)*sol(:ncol,:, 77) ! rate_const*HCFC141B*OH + rxt_rates(:ncol,:, 228) = rxt_rates(:ncol,:, 228)*sol(:ncol,:, 42)*sol(:ncol,:, 77) ! rate_const*HCFC142B*OH + rxt_rates(:ncol,:, 229) = rxt_rates(:ncol,:, 229)*sol(:ncol,:, 43)*sol(:ncol,:, 77) ! rate_const*HCFC22*OH + rxt_rates(:ncol,:, 230) = rxt_rates(:ncol,:, 230)*sol(:ncol,:, 73)*sol(:ncol,:, 14) ! rate_const*O1D*CH2BR2 + rxt_rates(:ncol,:, 231) = rxt_rates(:ncol,:, 231)*sol(:ncol,:, 73)*sol(:ncol,:, 16) ! rate_const*O1D*CH3BR + rxt_rates(:ncol,:, 232) = rxt_rates(:ncol,:, 232)*sol(:ncol,:, 73)*sol(:ncol,:, 41) ! rate_const*O1D*HCFC141B + rxt_rates(:ncol,:, 233) = rxt_rates(:ncol,:, 233)*sol(:ncol,:, 73)*sol(:ncol,:, 42) ! rate_const*O1D*HCFC142B + rxt_rates(:ncol,:, 234) = rxt_rates(:ncol,:, 234)*sol(:ncol,:, 73)*sol(:ncol,:, 43) ! rate_const*O1D*HCFC22 + rxt_rates(:ncol,:, 235) = rxt_rates(:ncol,:, 235)*sol(:ncol,:, 15)*sol(:ncol,:, 55) ! rate_const*CH2O*NO3 + rxt_rates(:ncol,:, 236) = rxt_rates(:ncol,:, 236)*sol(:ncol,:, 15)*sol(:ncol,:, 56) ! rate_const*CH2O*O + rxt_rates(:ncol,:, 237) = rxt_rates(:ncol,:, 237)*sol(:ncol,:, 15)*sol(:ncol,:, 77) ! rate_const*CH2O*OH + rxt_rates(:ncol,:, 238) = rxt_rates(:ncol,:, 238)*sol(:ncol,:, 19)*sol(:ncol,:, 68) ! rate_const*CH3O2*HO2 + rxt_rates(:ncol,:, 239) = rxt_rates(:ncol,:, 239)*sol(:ncol,:, 19)*sol(:ncol,:, 53) ! rate_const*CH3O2*NO + rxt_rates(:ncol,:, 240) = rxt_rates(:ncol,:, 240)*sol(:ncol,:, 20)*sol(:ncol,:, 77) ! rate_const*CH3OOH*OH + rxt_rates(:ncol,:, 241) = rxt_rates(:ncol,:, 241)*sol(:ncol,:, 21)*sol(:ncol,:, 77) ! rate_const*CH4*OH + rxt_rates(:ncol,:, 242) = rxt_rates(:ncol,:, 242)*sol(:ncol,:, 29)*sol(:ncol,:, 77) ! rate_const*M*CO*OH + rxt_rates(:ncol,:, 243) = rxt_rates(:ncol,:, 243)*sol(:ncol,:, 73)*sol(:ncol,:, 21) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 244) = rxt_rates(:ncol,:, 244)*sol(:ncol,:, 73)*sol(:ncol,:, 21) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 245) = rxt_rates(:ncol,:, 245)*sol(:ncol,:, 73)*sol(:ncol,:, 21) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 246) = rxt_rates(:ncol,:, 246)*sol(:ncol,:, 29)*sol(:ncol,:, 77) ! rate_const*CO*OH + rxt_rates(:ncol,:, 247) = rxt_rates(:ncol,:, 247)*sol(:ncol,:, 33)*sol(:ncol,:, 55) ! rate_const*DMS*NO3 + rxt_rates(:ncol,:, 248) = rxt_rates(:ncol,:, 248)*sol(:ncol,:, 33)*sol(:ncol,:, 77) ! rate_const*DMS*OH + rxt_rates(:ncol,:, 249) = rxt_rates(:ncol,:, 249)*sol(:ncol,:, 60)*sol(:ncol,:, 56) ! rate_const*OCS*O + rxt_rates(:ncol,:, 250) = rxt_rates(:ncol,:, 250)*sol(:ncol,:, 60)*sol(:ncol,:, 77) ! rate_const*OCS*OH + rxt_rates(:ncol,:, 251) = rxt_rates(:ncol,:, 251)*sol(:ncol,:, 61)*sol(:ncol,:, 57) ! rate_const*S*O2 + rxt_rates(:ncol,:, 252) = rxt_rates(:ncol,:, 252)*sol(:ncol,:, 61)*sol(:ncol,:, 58) ! rate_const*S*O3 + rxt_rates(:ncol,:, 253) = rxt_rates(:ncol,:, 253)*sol(:ncol,:, 63)*sol(:ncol,:, 3) ! rate_const*SO*BRO + rxt_rates(:ncol,:, 254) = rxt_rates(:ncol,:, 254)*sol(:ncol,:, 63)*sol(:ncol,:, 26) ! rate_const*SO*CLO + rxt_rates(:ncol,:, 255) = rxt_rates(:ncol,:, 255)*sol(:ncol,:, 61)*sol(:ncol,:, 77) ! rate_const*S*OH + rxt_rates(:ncol,:, 256) = rxt_rates(:ncol,:, 256)*sol(:ncol,:, 63)*sol(:ncol,:, 54) ! rate_const*SO*NO2 + rxt_rates(:ncol,:, 257) = rxt_rates(:ncol,:, 257)*sol(:ncol,:, 63)*sol(:ncol,:, 57) ! rate_const*SO*O2 + rxt_rates(:ncol,:, 258) = rxt_rates(:ncol,:, 258)*sol(:ncol,:, 63)*sol(:ncol,:, 58) ! rate_const*SO*O3 + rxt_rates(:ncol,:, 259) = rxt_rates(:ncol,:, 259)*sol(:ncol,:, 63)*sol(:ncol,:, 59) ! rate_const*SO*OCLO + rxt_rates(:ncol,:, 260) = rxt_rates(:ncol,:, 260)*sol(:ncol,:, 63)*sol(:ncol,:, 77) ! rate_const*SO*OH + rxt_rates(:ncol,:, 261) = rxt_rates(:ncol,:, 261)*sol(:ncol,:, 33)*sol(:ncol,:, 77) ! rate_const*DMS*OH + rxt_rates(:ncol,:, 262) = rxt_rates(:ncol,:, 262)*sol(:ncol,:, 64)*sol(:ncol,:, 77) ! rate_const*SO2*OH + rxt_rates(:ncol,:, 263) = rxt_rates(:ncol,:, 263)*sol(:ncol,:, 65)*sol(:ncol,:, 81) ! rate_const*SO3*H2O + rxt_rates(:ncol,:, 264) = rxt_rates(:ncol,:, 264)*sol(:ncol,:, 68) ! rate_const*HO2 + rxt_rates(:ncol,:, 265) = rxt_rates(:ncol,:, 265)*sol(:ncol,:, 52) ! rate_const*N2O5 + rxt_rates(:ncol,:, 266) = rxt_rates(:ncol,:, 266)*sol(:ncol,:, 54) ! rate_const*NO2 + rxt_rates(:ncol,:, 267) = rxt_rates(:ncol,:, 267)*sol(:ncol,:, 55) ! rate_const*NO3 + rxt_rates(:ncol,:, 268) = rxt_rates(:ncol,:, 268)*sol(:ncol,:, 52) ! rate_const*N2O5 + rxt_rates(:ncol,:, 269) = rxt_rates(:ncol,:, 269)*sol(:ncol,:, 49)*sol(:ncol,:, 44) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 270) = rxt_rates(:ncol,:, 270)*sol(:ncol,:, 4) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 271) = rxt_rates(:ncol,:, 271)*sol(:ncol,:, 52) ! rate_const*N2O5 + rxt_rates(:ncol,:, 272) = rxt_rates(:ncol,:, 272)*sol(:ncol,:, 27) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 273) = rxt_rates(:ncol,:, 273)*sol(:ncol,:, 4) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 274) = rxt_rates(:ncol,:, 274)*sol(:ncol,:, 27)*sol(:ncol,:, 44) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 275) = rxt_rates(:ncol,:, 275)*sol(:ncol,:, 49)*sol(:ncol,:, 44) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 276) = rxt_rates(:ncol,:, 276)*sol(:ncol,:, 48)*sol(:ncol,:, 44) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 277) = rxt_rates(:ncol,:, 277)*sol(:ncol,:, 27) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 278) = rxt_rates(:ncol,:, 278)*sol(:ncol,:, 4) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 279) = rxt_rates(:ncol,:, 279)*sol(:ncol,:, 27)*sol(:ncol,:, 44) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 280) = rxt_rates(:ncol,:, 280)*sol(:ncol,:, 49)*sol(:ncol,:, 44) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 281) = rxt_rates(:ncol,:, 281)*sol(:ncol,:, 48)*sol(:ncol,:, 44) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 282) = rxt_rates(:ncol,:, 282)*sol(:ncol,:, 52) ! rate_const*N2O5 + rxt_rates(:ncol,:, 283) = rxt_rates(:ncol,:, 283)*sol(:ncol,:, 27) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 284) = rxt_rates(:ncol,:, 284)*sol(:ncol,:, 27)*sol(:ncol,:, 44) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 285) = rxt_rates(:ncol,:, 285)*sol(:ncol,:, 80) ! rate_const*Op2P + rxt_rates(:ncol,:, 286) = rxt_rates(:ncol,:, 286)*sol(:ncol,:, 79) ! rate_const*Op2D + rxt_rates(:ncol,:, 287) = rxt_rates(:ncol,:, 287)*sol(:ncol,:, 80) ! rate_const*Op2P + rxt_rates(:ncol,:, 288) = rxt_rates(:ncol,:, 288)*sol(:ncol,:, 71)*sol(:ncol,:, 67) ! rate_const*NOp*e + rxt_rates(:ncol,:, 289) = rxt_rates(:ncol,:, 289)*sol(:ncol,:, 76)*sol(:ncol,:, 67) ! rate_const*O2p*e + rxt_rates(:ncol,:, 290) = rxt_rates(:ncol,:, 290)*sol(:ncol,:, 70)*sol(:ncol,:, 67) ! rate_const*N2p*e + rxt_rates(:ncol,:, 291) = rxt_rates(:ncol,:, 291)*sol(:ncol,:, 70)*sol(:ncol,:, 57) ! rate_const*N2p*O2 + rxt_rates(:ncol,:, 292) = rxt_rates(:ncol,:, 292)*sol(:ncol,:, 70)*sol(:ncol,:, 56) ! rate_const*N2p*O + rxt_rates(:ncol,:, 293) = rxt_rates(:ncol,:, 293)*sol(:ncol,:, 70)*sol(:ncol,:, 56) ! rate_const*N2p*O + rxt_rates(:ncol,:, 294) = rxt_rates(:ncol,:, 294)*sol(:ncol,:, 72)*sol(:ncol,:, 56) ! rate_const*Np*O + rxt_rates(:ncol,:, 295) = rxt_rates(:ncol,:, 295)*sol(:ncol,:, 72)*sol(:ncol,:, 57) ! rate_const*Np*O2 + rxt_rates(:ncol,:, 296) = rxt_rates(:ncol,:, 296)*sol(:ncol,:, 72)*sol(:ncol,:, 57) ! rate_const*Np*O2 + rxt_rates(:ncol,:, 297) = rxt_rates(:ncol,:, 297)*sol(:ncol,:, 76)*sol(:ncol,:, 50) ! rate_const*O2p*N + rxt_rates(:ncol,:, 298) = rxt_rates(:ncol,:, 298)*sol(:ncol,:, 76) ! rate_const*N2*O2p + rxt_rates(:ncol,:, 299) = rxt_rates(:ncol,:, 299)*sol(:ncol,:, 76)*sol(:ncol,:, 53) ! rate_const*O2p*NO + rxt_rates(:ncol,:, 300) = rxt_rates(:ncol,:, 300)*sol(:ncol,:, 78)*sol(:ncol,:, 30) ! rate_const*Op*CO2 + rxt_rates(:ncol,:, 301) = rxt_rates(:ncol,:, 301)*sol(:ncol,:, 78) ! rate_const*N2*Op + rxt_rates(:ncol,:, 302) = rxt_rates(:ncol,:, 302)*sol(:ncol,:, 78)*sol(:ncol,:, 69) ! rate_const*Op*N2D + rxt_rates(:ncol,:, 303) = rxt_rates(:ncol,:, 303)*sol(:ncol,:, 78)*sol(:ncol,:, 57) ! rate_const*Op*O2 + rxt_rates(:ncol,:, 304) = rxt_rates(:ncol,:, 304)*sol(:ncol,:, 79)*sol(:ncol,:, 67) ! rate_const*Op2D*e + rxt_rates(:ncol,:, 305) = rxt_rates(:ncol,:, 305)*sol(:ncol,:, 79) ! rate_const*N2*Op2D + rxt_rates(:ncol,:, 306) = rxt_rates(:ncol,:, 306)*sol(:ncol,:, 79)*sol(:ncol,:, 56) ! rate_const*Op2D*O + rxt_rates(:ncol,:, 307) = rxt_rates(:ncol,:, 307)*sol(:ncol,:, 79)*sol(:ncol,:, 57) ! rate_const*Op2D*O2 + rxt_rates(:ncol,:, 308) = rxt_rates(:ncol,:, 308)*sol(:ncol,:, 80)*sol(:ncol,:, 67) ! rate_const*Op2P*e + rxt_rates(:ncol,:, 309) = rxt_rates(:ncol,:, 309)*sol(:ncol,:, 80)*sol(:ncol,:, 67) ! rate_const*Op2P*e + rxt_rates(:ncol,:, 310) = rxt_rates(:ncol,:, 310)*sol(:ncol,:, 80) ! rate_const*N2*Op2P + rxt_rates(:ncol,:, 311) = rxt_rates(:ncol,:, 311)*sol(:ncol,:, 80) ! rate_const*N2*Op2P + rxt_rates(:ncol,:, 312) = rxt_rates(:ncol,:, 312)*sol(:ncol,:, 80)*sol(:ncol,:, 56) ! rate_const*Op2P*O + end subroutine set_rates +end module mo_rxt_rates_conv diff --git a/src/chemistry/pp_waccm_ma_noaero/mo_setrxt.F90 b/src/chemistry/pp_waccm_ma_noaero/mo_setrxt.F90 new file mode 100644 index 0000000000..87de9d4b32 --- /dev/null +++ b/src/chemistry/pp_waccm_ma_noaero/mo_setrxt.F90 @@ -0,0 +1,419 @@ + + module mo_setrxt + + use shr_kind_mod, only : r8 => shr_kind_r8 + + private + public :: setrxt + public :: setrxt_hrates + + contains + + subroutine setrxt( rate, temp, m, ncol ) + + use ppgrid, only : pcols, pver + + + use chem_mods, only : rxntot + use mo_jpl, only : jpl + + implicit none + +!------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------- + integer, intent(in) :: ncol + real(r8), intent(in) :: temp(pcols,pver) + real(r8), intent(in) :: m(ncol*pver) + real(r8), intent(inout) :: rate(ncol*pver,max(1,rxntot)) + +!------------------------------------------------------- +! ... local variables +!------------------------------------------------------- + integer :: n + integer :: offset + real(r8) :: itemp(ncol*pver) + real(r8) :: exp_fac(ncol*pver) + real(r8) :: ko(ncol*pver) + real(r8) :: kinf(ncol*pver) + + rate(:,92) = 0.000258_r8 + rate(:,93) = 0.085_r8 + rate(:,94) = 1.2e-10_r8 + rate(:,99) = 1.2e-10_r8 + rate(:,100) = 1e-20_r8 + rate(:,101) = 1.3e-16_r8 + rate(:,103) = 4.2e-13_r8 + rate(:,105) = 8e-14_r8 + rate(:,106) = 3.9e-17_r8 + rate(:,113) = 6.9e-12_r8 + rate(:,114) = 7.2e-11_r8 + rate(:,115) = 1.6e-12_r8 + rate(:,121) = 1.8e-12_r8 + rate(:,125) = 1.8e-12_r8 + rate(:,129) = 7e-13_r8 + rate(:,130) = 5e-12_r8 + rate(:,139) = 3.5e-12_r8 + rate(:,141) = 1e-11_r8 + rate(:,142) = 2.2e-11_r8 + rate(:,143) = 5e-11_r8 + rate(:,178) = 1.7e-13_r8 + rate(:,180) = 2.607e-10_r8 + rate(:,181) = 9.75e-11_r8 + rate(:,182) = 2.07e-10_r8 + rate(:,183) = 2.088e-10_r8 + rate(:,184) = 1.17e-10_r8 + rate(:,185) = 4.644e-11_r8 + rate(:,186) = 1.204e-10_r8 + rate(:,187) = 9.9e-11_r8 + rate(:,188) = 3.3e-12_r8 + rate(:,207) = 4.5e-11_r8 + rate(:,208) = 4.62e-10_r8 + rate(:,209) = 1.2e-10_r8 + rate(:,210) = 9e-11_r8 + rate(:,211) = 3e-11_r8 + rate(:,216) = 2.14e-11_r8 + rate(:,217) = 1.9e-10_r8 + rate(:,230) = 2.57e-10_r8 + rate(:,231) = 1.8e-10_r8 + rate(:,232) = 1.794e-10_r8 + rate(:,233) = 1.3e-10_r8 + rate(:,234) = 7.65e-11_r8 + rate(:,243) = 1.31e-10_r8 + rate(:,244) = 3.5e-11_r8 + rate(:,245) = 9e-12_r8 + rate(:,251) = 2.3e-12_r8 + rate(:,252) = 1.2e-11_r8 + rate(:,253) = 5.7e-11_r8 + rate(:,254) = 2.8e-11_r8 + rate(:,255) = 6.6e-11_r8 + rate(:,256) = 1.4e-11_r8 + rate(:,259) = 1.9e-12_r8 + rate(:,285) = 0.047_r8 + rate(:,286) = 7.7e-05_r8 + rate(:,287) = 0.171_r8 + rate(:,291) = 6e-11_r8 + rate(:,294) = 1e-12_r8 + rate(:,295) = 4e-10_r8 + rate(:,296) = 2e-10_r8 + rate(:,297) = 1e-10_r8 + rate(:,298) = 5e-16_r8 + rate(:,299) = 4.4e-10_r8 + rate(:,300) = 9e-10_r8 + rate(:,302) = 1.3e-10_r8 + rate(:,305) = 8e-10_r8 + rate(:,306) = 5e-12_r8 + rate(:,307) = 7e-10_r8 + rate(:,310) = 4.8e-10_r8 + rate(:,311) = 1e-10_r8 + rate(:,312) = 4e-10_r8 + + do n = 1,pver + offset = (n-1)*ncol + itemp(offset+1:offset+ncol) = 1._r8 / temp(:ncol,n) + end do + + rate(:,95) = 1.63e-10_r8 * exp( 60._r8 * itemp(:) ) + rate(:,96) = 2.15e-11_r8 * exp( 110._r8 * itemp(:) ) + exp_fac(:) = exp( 55._r8 * itemp(:) ) + rate(:,97) = 2.64e-11_r8 * exp_fac(:) + rate(:,98) = 6.6e-12_r8 * exp_fac(:) + rate(:,102) = 3.6e-18_r8 * exp( -220._r8 * itemp(:) ) + rate(:,104) = 1.8e-15_r8 * exp( 45._r8 * itemp(:) ) + rate(:,107) = 3.5e-11_r8 * exp( -135._r8 * itemp(:) ) + rate(:,108) = 8e-12_r8 * exp( -2060._r8 * itemp(:) ) + rate(:,111) = 1.6e-11_r8 * exp( -4570._r8 * itemp(:) ) + rate(:,112) = 1.4e-12_r8 * exp( -2000._r8 * itemp(:) ) + exp_fac(:) = exp( 200._r8 * itemp(:) ) + rate(:,117) = 3e-11_r8 * exp_fac(:) + rate(:,205) = 5.5e-12_r8 * exp_fac(:) + rate(:,240) = 3.8e-12_r8 * exp_fac(:) + rate(:,118) = 1e-14_r8 * exp( -490._r8 * itemp(:) ) + rate(:,119) = 1.4e-10_r8 * exp( -470._r8 * itemp(:) ) + rate(:,120) = 2.8e-12_r8 * exp( -1800._r8 * itemp(:) ) + exp_fac(:) = exp( 250._r8 * itemp(:) ) + rate(:,122) = 4.8e-11_r8 * exp_fac(:) + rate(:,203) = 1.7e-11_r8 * exp_fac(:) + rate(:,123) = 1.8e-11_r8 * exp( 180._r8 * itemp(:) ) + rate(:,124) = 1.7e-12_r8 * exp( -940._r8 * itemp(:) ) + rate(:,128) = 1.3e-12_r8 * exp( 380._r8 * itemp(:) ) + rate(:,131) = 2.1e-11_r8 * exp( 100._r8 * itemp(:) ) + exp_fac(:) = exp( 220._r8 * itemp(:) ) + rate(:,132) = 2.9e-12_r8 * exp_fac(:) + rate(:,133) = 1.45e-12_r8 * exp_fac(:) + rate(:,134) = 1.45e-12_r8 * exp_fac(:) + rate(:,135) = 1.5e-11_r8 * exp( -3600._r8 * itemp(:) ) + rate(:,136) = 5.1e-12_r8 * exp( 210._r8 * itemp(:) ) + exp_fac(:) = exp( -2450._r8 * itemp(:) ) + rate(:,137) = 1.2e-13_r8 * exp_fac(:) + rate(:,163) = 3e-11_r8 * exp_fac(:) + rate(:,140) = 1.5e-11_r8 * exp( 170._r8 * itemp(:) ) + exp_fac(:) = exp( 270._r8 * itemp(:) ) + rate(:,144) = 3.3e-12_r8 * exp_fac(:) + rate(:,159) = 1.4e-11_r8 * exp_fac(:) + rate(:,173) = 7.4e-12_r8 * exp_fac(:) + exp_fac(:) = exp( -1500._r8 * itemp(:) ) + rate(:,145) = 3e-12_r8 * exp_fac(:) + rate(:,204) = 5.8e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 20._r8 * itemp(:) ) + rate(:,147) = 7.26e-11_r8 * exp_fac(:) + rate(:,148) = 4.64e-11_r8 * exp_fac(:) + rate(:,155) = 8.1e-11_r8 * exp( -30._r8 * itemp(:) ) + rate(:,156) = 7.1e-12_r8 * exp( -1270._r8 * itemp(:) ) + rate(:,157) = 3.05e-11_r8 * exp( -2270._r8 * itemp(:) ) + rate(:,158) = 1.1e-11_r8 * exp( -980._r8 * itemp(:) ) + rate(:,160) = 3.6e-11_r8 * exp( -375._r8 * itemp(:) ) + rate(:,161) = 2.3e-11_r8 * exp( -200._r8 * itemp(:) ) + rate(:,162) = 3.3e-12_r8 * exp( -115._r8 * itemp(:) ) + rate(:,164) = 1e-12_r8 * exp( -1590._r8 * itemp(:) ) + rate(:,165) = 3.5e-13_r8 * exp( -1370._r8 * itemp(:) ) + exp_fac(:) = exp( 290._r8 * itemp(:) ) + rate(:,166) = 2.6e-12_r8 * exp_fac(:) + rate(:,167) = 6.4e-12_r8 * exp_fac(:) + rate(:,197) = 4.1e-13_r8 * exp_fac(:) + rate(:,168) = 6.5e-12_r8 * exp( 135._r8 * itemp(:) ) + exp_fac(:) = exp( -840._r8 * itemp(:) ) + rate(:,170) = 3.6e-12_r8 * exp_fac(:) + rate(:,219) = 2e-12_r8 * exp_fac(:) + rate(:,171) = 1.2e-12_r8 * exp( -330._r8 * itemp(:) ) + rate(:,172) = 2.8e-11_r8 * exp( 85._r8 * itemp(:) ) + exp_fac(:) = exp( 230._r8 * itemp(:) ) + rate(:,174) = 6e-13_r8 * exp_fac(:) + rate(:,194) = 1.5e-12_r8 * exp_fac(:) + rate(:,202) = 1.9e-11_r8 * exp_fac(:) + rate(:,175) = 1e-11_r8 * exp( -3300._r8 * itemp(:) ) + rate(:,176) = 1.8e-12_r8 * exp( -250._r8 * itemp(:) ) + rate(:,177) = 3.4e-12_r8 * exp( -130._r8 * itemp(:) ) + exp_fac(:) = exp( -500._r8 * itemp(:) ) + rate(:,179) = 3e-12_r8 * exp_fac(:) + rate(:,213) = 1.4e-10_r8 * exp_fac(:) + exp_fac(:) = exp( -800._r8 * itemp(:) ) + rate(:,191) = 1.7e-11_r8 * exp_fac(:) + rate(:,218) = 6.3e-12_r8 * exp_fac(:) + rate(:,192) = 4.8e-12_r8 * exp( -310._r8 * itemp(:) ) + rate(:,193) = 1.6e-11_r8 * exp( -780._r8 * itemp(:) ) + rate(:,195) = 9.5e-13_r8 * exp( 550._r8 * itemp(:) ) + exp_fac(:) = exp( 260._r8 * itemp(:) ) + rate(:,196) = 2.3e-12_r8 * exp_fac(:) + rate(:,199) = 8.8e-12_r8 * exp_fac(:) + rate(:,198) = 4.5e-12_r8 * exp( 460._r8 * itemp(:) ) + rate(:,201) = 1.9e-11_r8 * exp( 215._r8 * itemp(:) ) + rate(:,206) = 1.2e-10_r8 * exp( -430._r8 * itemp(:) ) + rate(:,212) = 1.6e-10_r8 * exp( -260._r8 * itemp(:) ) + exp_fac(:) = exp( 0._r8 * itemp(:) ) + rate(:,214) = 1.4e-11_r8 * exp_fac(:) + rate(:,216) = 2.14e-11_r8 * exp_fac(:) + rate(:,217) = 1.9e-10_r8 * exp_fac(:) + rate(:,230) = 2.57e-10_r8 * exp_fac(:) + rate(:,231) = 1.8e-10_r8 * exp_fac(:) + rate(:,232) = 1.794e-10_r8 * exp_fac(:) + rate(:,233) = 1.3e-10_r8 * exp_fac(:) + rate(:,234) = 7.65e-11_r8 * exp_fac(:) + rate(:,243) = 1.31e-10_r8 * exp_fac(:) + rate(:,244) = 3.5e-11_r8 * exp_fac(:) + rate(:,245) = 9e-12_r8 * exp_fac(:) + rate(:,251) = 2.3e-12_r8 * exp_fac(:) + rate(:,252) = 1.2e-11_r8 * exp_fac(:) + rate(:,253) = 5.7e-11_r8 * exp_fac(:) + rate(:,254) = 2.8e-11_r8 * exp_fac(:) + rate(:,255) = 6.6e-11_r8 * exp_fac(:) + rate(:,256) = 1.4e-11_r8 * exp_fac(:) + rate(:,259) = 1.9e-12_r8 * exp_fac(:) + rate(:,285) = 0.047_r8 * exp_fac(:) + rate(:,286) = 7.7e-05_r8 * exp_fac(:) + rate(:,287) = 0.171_r8 * exp_fac(:) + rate(:,291) = 6e-11_r8 * exp_fac(:) + rate(:,294) = 1e-12_r8 * exp_fac(:) + rate(:,295) = 4e-10_r8 * exp_fac(:) + rate(:,296) = 2e-10_r8 * exp_fac(:) + rate(:,297) = 1e-10_r8 * exp_fac(:) + rate(:,298) = 5e-16_r8 * exp_fac(:) + rate(:,299) = 4.4e-10_r8 * exp_fac(:) + rate(:,300) = 9e-10_r8 * exp_fac(:) + rate(:,302) = 1.3e-10_r8 * exp_fac(:) + rate(:,305) = 8e-10_r8 * exp_fac(:) + rate(:,306) = 5e-12_r8 * exp_fac(:) + rate(:,307) = 7e-10_r8 * exp_fac(:) + rate(:,310) = 4.8e-10_r8 * exp_fac(:) + rate(:,311) = 1e-10_r8 * exp_fac(:) + rate(:,312) = 4e-10_r8 * exp_fac(:) + rate(:,215) = 6e-12_r8 * exp( 400._r8 * itemp(:) ) + rate(:,220) = 1.46e-11_r8 * exp( -1040._r8 * itemp(:) ) + rate(:,221) = 1.42e-12_r8 * exp( -1150._r8 * itemp(:) ) + rate(:,222) = 1.64e-12_r8 * exp( -1520._r8 * itemp(:) ) + exp_fac(:) = exp( -1100._r8 * itemp(:) ) + rate(:,223) = 2.03e-11_r8 * exp_fac(:) + rate(:,258) = 3.4e-12_r8 * exp_fac(:) + rate(:,224) = 1.96e-12_r8 * exp( -1200._r8 * itemp(:) ) + rate(:,225) = 4.85e-12_r8 * exp( -850._r8 * itemp(:) ) + rate(:,226) = 9e-13_r8 * exp( -360._r8 * itemp(:) ) + exp_fac(:) = exp( -1600._r8 * itemp(:) ) + rate(:,227) = 1.25e-12_r8 * exp_fac(:) + rate(:,236) = 3.4e-11_r8 * exp_fac(:) + rate(:,228) = 1.3e-12_r8 * exp( -1770._r8 * itemp(:) ) + rate(:,229) = 9.2e-13_r8 * exp( -1560._r8 * itemp(:) ) + rate(:,235) = 6e-13_r8 * exp( -2058._r8 * itemp(:) ) + rate(:,237) = 5.5e-12_r8 * exp( 125._r8 * itemp(:) ) + rate(:,238) = 4.1e-13_r8 * exp( 750._r8 * itemp(:) ) + rate(:,239) = 2.8e-12_r8 * exp( 300._r8 * itemp(:) ) + rate(:,241) = 2.45e-12_r8 * exp( -1775._r8 * itemp(:) ) + rate(:,247) = 1.9e-13_r8 * exp( 520._r8 * itemp(:) ) + rate(:,248) = 9.6e-12_r8 * exp( -234._r8 * itemp(:) ) + rate(:,249) = 2.1e-11_r8 * exp( -2200._r8 * itemp(:) ) + rate(:,250) = 7.2e-14_r8 * exp( -1070._r8 * itemp(:) ) + rate(:,257) = 1.6e-13_r8 * exp( -2280._r8 * itemp(:) ) + rate(:,260) = 2.7e-11_r8 * exp( 335._r8 * itemp(:) ) + + itemp(:) = 300._r8 * itemp(:) + + n = ncol*pver + + ko(:) = 4.4e-32_r8 * itemp(:)**1.3_r8 + kinf(:) = 7.5e-11_r8 * itemp(:)**(-0.2_r8) + call jpl( rate(:,116), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 6.9e-31_r8 * itemp(:)**1._r8 + kinf(:) = 2.6e-11_r8 + call jpl( rate(:,126), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 2.5e-31_r8 * itemp(:)**1.8_r8 + kinf(:) = 2.2e-11_r8 * itemp(:)**0.7_r8 + call jpl( rate(:,138), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 9e-32_r8 * itemp(:)**1.5_r8 + kinf(:) = 3e-11_r8 + call jpl( rate(:,146), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 1.9e-31_r8 * itemp(:)**3.4_r8 + kinf(:) = 4e-12_r8 * itemp(:)**0.3_r8 + call jpl( rate(:,149), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 2.4e-30_r8 * itemp(:)**3._r8 + kinf(:) = 1.6e-12_r8 * itemp(:)**(-0.1_r8) + call jpl( rate(:,150), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 1.8e-30_r8 * itemp(:)**3._r8 + kinf(:) = 2.8e-11_r8 + call jpl( rate(:,151), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 1.8e-31_r8 * itemp(:)**3.4_r8 + kinf(:) = 1.5e-11_r8 * itemp(:)**1.9_r8 + call jpl( rate(:,169), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 1.9e-32_r8 * itemp(:)**3.6_r8 + kinf(:) = 3.7e-12_r8 * itemp(:)**1.6_r8 + call jpl( rate(:,189), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 5.2e-31_r8 * itemp(:)**3.2_r8 + kinf(:) = 6.9e-12_r8 * itemp(:)**2.9_r8 + call jpl( rate(:,200), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 5.9e-33_r8 * itemp(:)**1._r8 + kinf(:) = 1.1e-12_r8 * itemp(:)**(-1.3_r8) + call jpl( rate(:,242), m, 0.6_r8, ko, kinf, n ) + + end subroutine setrxt + + + subroutine setrxt_hrates( rate, temp, m, ncol, kbot ) + + use ppgrid, only : pcols, pver + + + use chem_mods, only : rxntot + use mo_jpl, only : jpl + + implicit none + +!------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------- + integer, intent(in) :: ncol + integer, intent(in) :: kbot + real(r8), intent(in) :: temp(pcols,pver) + real(r8), intent(in) :: m(ncol*pver) + real(r8), intent(inout) :: rate(ncol*pver,max(1,rxntot)) + +!------------------------------------------------------- +! ... local variables +!------------------------------------------------------- + integer :: n + integer :: offset + integer :: k + real(r8) :: itemp(ncol*kbot) + real(r8) :: exp_fac(ncol*kbot) + real(r8) :: ko(ncol*kbot) + real(r8) :: kinf(ncol*kbot) + real(r8) :: wrk(ncol*kbot) + + n = ncol*kbot + + rate(:n,100) = 1e-20_r8 + rate(:n,101) = 1.3e-16_r8 + rate(:n,105) = 8e-14_r8 + rate(:n,106) = 3.9e-17_r8 + rate(:n,113) = 6.9e-12_r8 + rate(:n,129) = 7e-13_r8 + rate(:n,130) = 5e-12_r8 + rate(:n,285) = 0.047_r8 + rate(:n,286) = 7.7e-05_r8 + rate(:n,287) = 0.171_r8 + rate(:n,291) = 6e-11_r8 + rate(:n,294) = 1e-12_r8 + rate(:n,295) = 4e-10_r8 + rate(:n,296) = 2e-10_r8 + rate(:n,297) = 1e-10_r8 + rate(:n,299) = 4.4e-10_r8 + rate(:n,302) = 1.3e-10_r8 + rate(:n,305) = 8e-10_r8 + rate(:n,306) = 5e-12_r8 + rate(:n,307) = 7e-10_r8 + rate(:n,310) = 4.8e-10_r8 + rate(:n,311) = 1e-10_r8 + rate(:n,312) = 4e-10_r8 + + do k = 1,kbot + offset = (k-1)*ncol + itemp(offset+1:offset+ncol) = 1._r8 / temp(:ncol,k) + end do + + rate(:n,96) = 2.15e-11_r8 * exp( 110._r8 * itemp(:) ) + exp_fac(:) = exp( 55._r8 * itemp(:) ) + rate(:n,97) = 2.64e-11_r8 * exp_fac(:) + rate(:n,98) = 6.6e-12_r8 * exp_fac(:) + rate(:n,102) = 3.6e-18_r8 * exp( -220._r8 * itemp(:) ) + rate(:n,104) = 1.8e-15_r8 * exp( 45._r8 * itemp(:) ) + rate(:n,107) = 3.5e-11_r8 * exp( -135._r8 * itemp(:) ) + rate(:n,108) = 8e-12_r8 * exp( -2060._r8 * itemp(:) ) + rate(:n,117) = 3e-11_r8 * exp( 200._r8 * itemp(:) ) + rate(:n,118) = 1e-14_r8 * exp( -490._r8 * itemp(:) ) + rate(:n,119) = 1.4e-10_r8 * exp( -470._r8 * itemp(:) ) + rate(:n,122) = 4.8e-11_r8 * exp( 250._r8 * itemp(:) ) + rate(:n,123) = 1.8e-11_r8 * exp( 180._r8 * itemp(:) ) + rate(:n,124) = 1.7e-12_r8 * exp( -940._r8 * itemp(:) ) + rate(:n,131) = 2.1e-11_r8 * exp( 100._r8 * itemp(:) ) + rate(:n,135) = 1.5e-11_r8 * exp( -3600._r8 * itemp(:) ) + rate(:n,136) = 5.1e-12_r8 * exp( 210._r8 * itemp(:) ) + rate(:n,144) = 3.3e-12_r8 * exp( 270._r8 * itemp(:) ) + rate(:n,145) = 3e-12_r8 * exp( -1500._r8 * itemp(:) ) + + itemp(:) = 300._r8 * itemp(:) + + ko(:) = 4.4e-32_r8 * itemp(:)**1.3_r8 + kinf(:) = 7.5e-11_r8 * itemp(:)**(-0.2_r8) + call jpl( wrk, m, 0.6_r8, ko, kinf, n ) + rate(:n,116) = wrk(:) + + + + + + + + + + + + end subroutine setrxt_hrates + + end module mo_setrxt diff --git a/src/chemistry/pp_waccm_ma_noaero/mo_sim_dat.F90 b/src/chemistry/pp_waccm_ma_noaero/mo_sim_dat.F90 new file mode 100644 index 0000000000..ed2f3718f4 --- /dev/null +++ b/src/chemistry/pp_waccm_ma_noaero/mo_sim_dat.F90 @@ -0,0 +1,500 @@ + + module mo_sim_dat + + private + public :: set_sim_dat + + contains + + subroutine set_sim_dat + + use chem_mods, only : clscnt, cls_rxt_cnt, clsmap, permute, adv_mass, fix_mass, crb_mass + use chem_mods, only : diag_map + use chem_mods, only : phtcnt, rxt_tag_cnt, rxt_tag_lst, rxt_tag_map + use chem_mods, only : pht_alias_lst, pht_alias_mult + use chem_mods, only : extfrc_lst, inv_lst, slvd_lst + use chem_mods, only : enthalpy_cnt, cph_enthalpy, cph_rid, num_rnts, rxntot + use cam_abortutils,only : endrun + use mo_tracname, only : solsym + use chem_mods, only : frc_from_dataset + use chem_mods, only : is_scalar, is_vector + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_logfile, only : iulog + + implicit none + +!-------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------- + integer :: ios + + is_scalar = .false. + is_vector = .true. + + clscnt(:) = (/ 23, 0, 0, 58, 0 /) + + cls_rxt_cnt(:,1) = (/ 3, 59, 0, 23 /) + cls_rxt_cnt(:,4) = (/ 30, 126, 155, 58 /) + + solsym(: 81) = (/ 'BR ','BRCL ','BRO ','BRONO2 ','BRY ', & + 'CCL4 ','CF2CLBR ','CF3BR ','CFC11 ','CFC113 ', & + 'CFC114 ','CFC115 ','CFC12 ','CH2BR2 ','CH2O ', & + 'CH3BR ','CH3CCL3 ','CH3CL ','CH3O2 ','CH3OOH ', & + 'CH4 ','CHBR3 ','CL ','CL2 ','CL2O2 ', & + 'CLO ','CLONO2 ','CLY ','CO ','CO2 ', & + 'COF2 ','COFCL ','DMS ','F ','H ', & + 'H2 ','H2402 ','H2O2 ','H2SO4 ','HBR ', & + 'HCFC141B ','HCFC142B ','HCFC22 ','HCL ','HF ', & + 'HNO3 ','HO2NO2 ','HOBR ','HOCL ','N ', & + 'N2O ','N2O5 ','NO ','NO2 ','NO3 ', & + 'O ','O2 ','O3 ','OCLO ','OCS ', & + 'S ','SF6 ','SO ','SO2 ','SO3 ', & + 'SOAG ','e ','HO2 ','N2D ','N2p ', & + 'NOp ','Np ','O1D ','O2_1D ','O2_1S ', & + 'O2p ','OH ','Op ','Op2D ','Op2P ', & + 'H2O ' /) + + adv_mass(: 81) = (/ 79.904000_r8, 115.356700_r8, 95.903400_r8, 141.908940_r8, 99.716850_r8, & + 153.821800_r8, 165.364506_r8, 148.910210_r8, 137.367503_r8, 187.375310_r8, & + 170.921013_r8, 154.466716_r8, 120.913206_r8, 173.833800_r8, 30.025200_r8, & + 94.937200_r8, 133.402300_r8, 50.485900_r8, 47.032000_r8, 48.039400_r8, & + 16.040600_r8, 252.730400_r8, 35.452700_r8, 70.905400_r8, 102.904200_r8, & + 51.452100_r8, 97.457640_r8, 100.916850_r8, 28.010400_r8, 44.009800_r8, & + 66.007206_r8, 82.461503_r8, 62.132400_r8, 18.998403_r8, 1.007400_r8, & + 2.014800_r8, 259.823613_r8, 34.013600_r8, 98.078400_r8, 80.911400_r8, & + 116.948003_r8, 100.493706_r8, 86.467906_r8, 36.460100_r8, 20.005803_r8, & + 63.012340_r8, 79.011740_r8, 96.910800_r8, 52.459500_r8, 14.006740_r8, & + 44.012880_r8, 108.010480_r8, 30.006140_r8, 46.005540_r8, 62.004940_r8, & + 15.999400_r8, 31.998800_r8, 47.998200_r8, 67.451500_r8, 60.076400_r8, & + 32.066000_r8, 146.056419_r8, 48.065400_r8, 64.064800_r8, 80.064200_r8, & + 12.011000_r8, 0.548567E-03_r8, 33.006200_r8, 14.006740_r8, 28.013480_r8, & + 30.006140_r8, 14.006740_r8, 15.999400_r8, 31.998800_r8, 31.998800_r8, & + 31.998800_r8, 17.006800_r8, 15.999400_r8, 15.999400_r8, 15.999400_r8, & + 18.014200_r8 /) + + crb_mass(: 81) = (/ 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, 24.022000_r8, & + 24.022000_r8, 24.022000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 12.011000_r8, 24.022000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 12.011000_r8, 12.011000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 12.011000_r8, 12.011000_r8, 24.022000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 24.022000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 24.022000_r8, 24.022000_r8, 12.011000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 12.011000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 12.011000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8 /) + + fix_mass(: 2) = (/ 0.00000000_r8, 28.0134800_r8 /) + + clsmap(: 23,1) = (/ 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, & + 16, 17, 18, 21, 22, 28, 30, 37, 41, 42, & + 43, 51, 62 /) + clsmap(: 58,4) = (/ 1, 2, 3, 4, 15, 19, 20, 23, 24, 25, & + 26, 27, 29, 31, 32, 33, 34, 35, 36, 38, & + 39, 40, 44, 45, 46, 47, 48, 49, 50, 52, & + 53, 54, 55, 56, 57, 58, 59, 60, 61, 63, & + 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, & + 74, 75, 76, 77, 78, 79, 80, 81 /) + + permute(: 58,4) = (/ 41, 9, 57, 20, 51, 43, 16, 48, 7, 2, & + 47, 37, 21, 3, 8, 12, 26, 40, 56, 22, & + 4, 29, 42, 10, 38, 17, 27, 28, 35, 13, & + 55, 53, 44, 46, 49, 52, 14, 15, 24, 39, & + 36, 11, 1, 33, 45, 34, 23, 25, 30, 50, & + 5, 6, 32, 54, 31, 19, 18, 58 /) + + diag_map(: 58) = (/ 1, 2, 5, 8, 11, 14, 16, 18, 22, 25, & + 29, 33, 39, 45, 50, 58, 64, 71, 78, 84, & + 92, 96, 103, 112, 119, 125, 134, 143, 150, 159, & + 170, 181, 196, 210, 225, 235, 243, 255, 266, 280, & + 291, 310, 328, 350, 376, 420, 449, 475, 507, 533, & + 556, 579, 608, 646, 670, 692, 719, 745 /) + + extfrc_lst(: 13) = (/ 'DMS ','CO ','NO ','NO2 ','SO2 ', & + 'N ','N2D ','N2p ','Op ','e ', & + 'Np ','O2p ','OH ' /) + + frc_from_dataset(: 13) = (/ .true., .true., .true., .true., .true., & + .false., .false., .false., .false., .false., & + .false., .false., .false. /) + + inv_lst(: 2) = (/ 'M ', 'N2 ' /) + + slvd_lst(: 14) = (/ 'e ', 'HO2 ', 'N2D ', 'N2p ', 'NOp ', & + 'Np ', 'O1D ', 'O2_1D ', 'O2_1S ', 'O2p ', & + 'OH ', 'Op ', 'Op2D ', 'Op2P ' /) + + if( allocated( rxt_tag_lst ) ) then + deallocate( rxt_tag_lst ) + end if + allocate( rxt_tag_lst(rxt_tag_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate rxt_tag_lst; error = ',ios + call endrun + end if + if( allocated( rxt_tag_map ) ) then + deallocate( rxt_tag_map ) + end if + allocate( rxt_tag_map(rxt_tag_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate rxt_tag_map; error = ',ios + call endrun + end if + rxt_tag_lst( 1: 200) = (/ 'jh2o_b ', 'jh2o_c ', & + 'jh2o_a ', 'jh2o2 ', & + 'jo2_b ', 'jo2_a ', & + 'jo3_a ', 'jo3_b ', & + 'jhno3 ', 'jho2no2_a ', & + 'jho2no2_b ', 'jn2o ', & + 'jn2o5_a ', 'jn2o5_b ', & + 'jno ', 'jno_i ', & + 'jno2 ', 'jno3_a ', & + 'jno3_b ', 'jch2o_a ', & + 'jch2o_b ', 'jch3ooh ', & + 'jch4_a ', 'jch4_b ', & + 'jco2 ', 'jbrcl ', & + 'jbro ', 'jbrono2_b ', & + 'jbrono2_a ', 'jccl4 ', & + 'jcf2clbr ', 'jcf3br ', & + 'jcfcl3 ', 'jcfc113 ', & + 'jcfc114 ', 'jcfc115 ', & + 'jcf2cl2 ', 'jch2br2 ', & + 'jch3br ', 'jch3ccl3 ', & + 'jch3cl ', 'jchbr3 ', & + 'jcl2 ', 'jcl2o2 ', & + 'jclo ', 'jclono2_a ', & + 'jclono2_b ', 'jcof2 ', & + 'jcofcl ', 'jh2402 ', & + 'jhbr ', 'jhcfc141b ', & + 'jhcfc142b ', 'jhcfc22 ', & + 'jhcl ', 'jhf ', & + 'jhobr ', 'jhocl ', & + 'joclo ', 'jsf6 ', & + 'jeuv_26 ', 'jeuv_4 ', & + 'jeuv_6 ', 'jeuv_22 ', & + 'jeuv_23 ', 'jeuv_25 ', & + 'jeuv_18 ', 'jeuv_13 ', & + 'jeuv_11 ', 'jeuv_10 ', & + 'jeuv_3 ', 'jeuv_16 ', & + 'jeuv_1 ', 'jeuv_14 ', & + 'jeuv_2 ', 'jeuv_15 ', & + 'jeuv_21 ', 'jeuv_17 ', & + 'jeuv_7 ', 'jeuv_5 ', & + 'jeuv_19 ', 'jeuv_24 ', & + 'jeuv_12 ', 'jeuv_9 ', & + 'jeuv_8 ', 'jeuv_20 ', & + 'jh2so4 ', 'jocs ', & + 'jso ', 'jso2 ', & + 'jso3 ', 'ag1 ', & + 'ag2 ', 'O1D_H2 ', & + 'O1D_H2O ', 'O1D_N2 ', & + 'O1D_O2 ', 'O1D_O2b ', & + 'O1D_O3 ', 'O2_1D_N2 ', & + 'O2_1D_O ', 'O2_1D_O2 ', & + 'O2_1S_CO2 ', 'O2_1S_N2 ', & + 'O2_1S_O ', 'O2_1S_O2 ', & + 'O2_1S_O3 ', 'O_O3 ', & + 'usr_O_O ', 'usr_O_O2 ', & + 'H2_O ', 'H2O2_O ', & + 'H_HO2 ', 'H_HO2a ', & + 'H_HO2b ', 'H_O2 ', & + 'HO2_O ', 'HO2_O3 ', & + 'H_O3 ', 'OH_H2 ', & + 'OH_H2O2 ', 'OH_HO2 ', & + 'OH_O ', 'OH_O3 ', & + 'OH_OH ', 'OH_OH_M ', & + 'usr_HO2_HO2 ', 'HO2NO2_OH ', & + 'N2D_O ', 'N2D_O2 ', & + 'N_NO ', 'N_NO2a ', & + 'N_NO2b ', 'N_NO2c ', & + 'N_O2 ', 'NO2_O ', & + 'NO2_O3 ', 'NO2_O_M ', & + 'NO3_HO2 ', 'NO3_NO ', & + 'NO3_O ', 'NO3_OH ', & + 'N_OH ', 'NO_HO2 ', & + 'NO_O3 ', 'NO_O_M ', & + 'O1D_N2Oa ', 'O1D_N2Ob ', & + 'tag_NO2_HO2 ', 'tag_NO2_NO3 ', & + 'tag_NO2_OH ', 'usr_HNO3_OH ', & + 'usr_HO2NO2_M ', 'usr_N2O5_M ', & + 'CL_CH2O ', 'CL_CH4 ', & + 'CL_H2 ', 'CL_H2O2 ', & + 'CL_HO2a ', 'CL_HO2b ', & + 'CL_O3 ', 'CLO_CH3O2 ', & + 'CLO_CLOa ', 'CLO_CLOb ', & + 'CLO_CLOc ', 'CLO_HO2 ', & + 'CLO_NO ', 'CLONO2_CL ', & + 'CLO_NO2_M ', 'CLONO2_O ', & + 'CLONO2_OH ', 'CLO_O ', & + 'CLO_OHa ', 'CLO_OHb ', & + 'HCL_O ', 'HCL_OH ', & + 'HOCL_CL ', 'HOCL_O ', & + 'HOCL_OH ', 'O1D_CCL4 ', & + 'O1D_CF2CLBR ', 'O1D_CFC11 ', & + 'O1D_CFC113 ', 'O1D_CFC114 ', & + 'O1D_CFC115 ', 'O1D_CFC12 ', & + 'O1D_HCLa ', 'O1D_HCLb ', & + 'tag_CLO_CLO_M ', 'usr_CL2O2_M ', & + 'BR_CH2O ', 'BR_HO2 ', & + 'BR_O3 ', 'BRO_BRO ', & + 'BRO_CLOa ', 'BRO_CLOb ', & + 'BRO_CLOc ', 'BRO_HO2 ', & + 'BRO_NO ', 'BRO_NO2_M ' /) + rxt_tag_lst( 201: 312) = (/ 'BRONO2_O ', 'BRO_O ', & + 'BRO_OH ', 'HBR_O ', & + 'HBR_OH ', 'HOBR_O ', & + 'O1D_CF3BR ', 'O1D_CHBR3 ', & + 'O1D_H2402 ', 'O1D_HBRa ', & + 'O1D_HBRb ', 'F_CH4 ', & + 'F_H2 ', 'F_H2O ', & + 'F_HNO3 ', 'O1D_COF2 ', & + 'O1D_COFCL ', 'CH2BR2_CL ', & + 'CH2BR2_OH ', 'CH3BR_CL ', & + 'CH3BR_OH ', 'CH3CCL3_OH ', & + 'CH3CL_CL ', 'CH3CL_OH ', & + 'CHBR3_CL ', 'CHBR3_OH ', & + 'HCFC141B_OH ', 'HCFC142B_OH ', & + 'HCFC22_OH ', 'O1D_CH2BR2 ', & + 'O1D_CH3BR ', 'O1D_HCFC141B ', & + 'O1D_HCFC142B ', 'O1D_HCFC22 ', & + 'CH2O_NO3 ', 'CH2O_O ', & + 'CH2O_OH ', 'CH3O2_HO2 ', & + 'CH3O2_NO ', 'CH3OOH_OH ', & + 'CH4_OH ', 'CO_OH_M ', & + 'O1D_CH4a ', 'O1D_CH4b ', & + 'O1D_CH4c ', 'usr_CO_OH_b ', & + 'DMS_NO3 ', 'DMS_OHa ', & + 'OCS_O ', 'OCS_OH ', & + 'S_O2 ', 'S_O3 ', & + 'SO_BRO ', 'SO_CLO ', & + 'S_OH ', 'SO_NO2 ', & + 'SO_O2 ', 'SO_O3 ', & + 'SO_OCLO ', 'SO_OH ', & + 'usr_DMS_OH ', 'usr_SO2_OH ', & + 'usr_SO3_H2O ', 'usr_HO2_aer ', & + 'usr_N2O5_aer ', 'usr_NO2_aer ', & + 'usr_NO3_aer ', 'het1 ', & + 'het10 ', 'het11 ', & + 'het12 ', 'het13 ', & + 'het14 ', 'het15 ', & + 'het16 ', 'het17 ', & + 'het2 ', 'het3 ', & + 'het4 ', 'het5 ', & + 'het6 ', 'het7 ', & + 'het8 ', 'het9 ', & + 'ag247nm ', 'ag373nm ', & + 'ag732nm ', 'elec1 ', & + 'elec2 ', 'elec3 ', & + 'ion_N2p_O2 ', 'ion_N2p_Oa ', & + 'ion_N2p_Ob ', 'ion_Np_O ', & + 'ion_Np_O2a ', 'ion_Np_O2b ', & + 'ion_O2p_N ', 'ion_O2p_N2 ', & + 'ion_O2p_NO ', 'ion_Op_CO2 ', & + 'ion_Op_N2 ', 'ion_Op_N2D ', & + 'ion_Op_O2 ', 'Op2D_e ', & + 'Op2D_N2 ', 'Op2D_O ', & + 'Op2D_O2 ', 'Op2P_ea ', & + 'Op2P_eb ', 'Op2P_N2a ', & + 'Op2P_N2b ', 'Op2P_O ' /) + rxt_tag_map(:rxt_tag_cnt) = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, & + 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, & + 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, & + 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, & + 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, & + 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, & + 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, & + 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, & + 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, & + 91, 92, 93, 94, 95, 96, 97, 98, 99, 100, & + 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, & + 111, 112, 113, 114, 115, 116, 117, 118, 119, 120, & + 121, 122, 123, 124, 125, 126, 127, 128, 129, 130, & + 131, 132, 133, 134, 135, 136, 137, 138, 139, 140, & + 141, 142, 143, 144, 145, 146, 147, 148, 149, 150, & + 151, 152, 153, 154, 155, 156, 157, 158, 159, 160, & + 161, 162, 163, 164, 165, 166, 167, 168, 169, 170, & + 171, 172, 173, 174, 175, 176, 177, 178, 179, 180, & + 181, 182, 183, 184, 185, 186, 187, 188, 189, 190, & + 191, 192, 193, 194, 195, 196, 197, 198, 199, 200, & + 201, 202, 203, 204, 205, 206, 207, 208, 209, 210, & + 211, 212, 213, 214, 215, 216, 217, 218, 219, 220, & + 221, 222, 223, 224, 225, 226, 227, 228, 229, 230, & + 231, 232, 233, 234, 235, 236, 237, 238, 239, 240, & + 241, 242, 243, 244, 245, 246, 247, 248, 249, 250, & + 251, 252, 253, 254, 255, 256, 257, 258, 259, 260, & + 261, 262, 263, 264, 265, 266, 267, 268, 269, 270, & + 271, 272, 273, 274, 275, 276, 277, 278, 279, 280, & + 281, 282, 283, 284, 285, 286, 287, 288, 289, 290, & + 291, 292, 293, 294, 295, 296, 297, 298, 299, 300, & + 301, 302, 303, 304, 305, 306, 307, 308, 309, 310, & + 311, 312 /) + if( allocated( pht_alias_lst ) ) then + deallocate( pht_alias_lst ) + end if + allocate( pht_alias_lst(phtcnt,2),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate pht_alias_lst; error = ',ios + call endrun + end if + if( allocated( pht_alias_mult ) ) then + deallocate( pht_alias_mult ) + end if + allocate( pht_alias_mult(phtcnt,2),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate pht_alias_mult; error = ',ios + call endrun + end if + pht_alias_lst(:,1) = (/ ' ', ' ', ' ', ' ', & + 'userdefined ', 'userdefined ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', 'userdefined ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', ' ', ' ', & + ' ', ' ', ' ' /) + pht_alias_lst(:,2) = (/ ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', ' ', ' ', & + ' ', ' ', ' ' /) + pht_alias_mult(:,1) = (/ 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8 /) + pht_alias_mult(:,2) = (/ 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8 /) + allocate( cph_enthalpy(enthalpy_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate cph_enthalpy; error = ',ios + call endrun + end if + allocate( cph_rid(enthalpy_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate cph_rid; error = ',ios + call endrun + end if + cph_rid(:) = (/ 96, 97, 98, 100, 101, & + 102, 104, 105, 106, 107, & + 108, 109, 110, 113, 116, & + 117, 118, 119, 122, 123, & + 124, 127, 129, 130, 131, & + 135, 136, 144, 145, 285, & + 286, 287, 288, 289, 290, & + 291, 292, 294, 295, 296, & + 297, 299, 301, 302, 303, & + 304, 305, 306, 307, 308, & + 309, 310, 311, 312 /) + cph_enthalpy(:) = (/ 189.810000_r8, 32.910000_r8, 189.810000_r8, 94.300000_r8, 94.300000_r8, & + 94.300000_r8, 62.600000_r8, 62.600000_r8, 62.600000_r8, 62.600000_r8, & + 392.190000_r8, 493.580000_r8, 101.390000_r8, 232.590000_r8, 203.400000_r8, & + 226.580000_r8, 120.100000_r8, 194.710000_r8, 293.620000_r8, 67.670000_r8, & + 165.300000_r8, 165.510000_r8, 229.610000_r8, 177.510000_r8, 313.750000_r8, & + 133.750000_r8, 193.020000_r8, 34.470000_r8, 199.170000_r8, 483.390000_r8, & + 321.300000_r8, 163.060000_r8, 82.389000_r8, 508.950000_r8, 354.830000_r8, & + 339.590000_r8, 67.530000_r8, 95.550000_r8, 239.840000_r8, 646.280000_r8, & + 406.160000_r8, 271.380000_r8, 105.040000_r8, 139.900000_r8, 150.110000_r8, & + 319.370000_r8, 128.320000_r8, 319.360000_r8, 469.400000_r8, 163.060000_r8, & + 482.430000_r8, 291.380000_r8, 67.540000_r8, 501.720000_r8 /) + allocate( num_rnts(rxntot-phtcnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate num_rnts; error = ',ios + call endrun + end if + num_rnts(:) = (/ 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 3, 3, 2, & + 2, 2, 2, 2, 3, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 3, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 3, 2, 2, 2, & + 2, 2, 2, 2, 3, 2, 2, 3, 3, 3, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 3, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 3, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 3, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 3, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 1, 1, 1, 1, 1, 2, 1, 1, & + 1, 1, 2, 2, 2, 1, 1, 2, 2, 2, & + 1, 1, 2, 1, 1, 1, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2 /) + + end subroutine set_sim_dat + + end module mo_sim_dat diff --git a/src/chemistry/utils/elevated_emissions_mod.F90 b/src/chemistry/utils/elevated_emissions_mod.F90 new file mode 100644 index 0000000000..22442c98b7 --- /dev/null +++ b/src/chemistry/utils/elevated_emissions_mod.F90 @@ -0,0 +1,439 @@ +module elevated_emissions_mod + !--------------------------------------------------------------- + ! ... elevalted emissions module + !--------------------------------------------------------------- + + use shr_kind_mod, only : r8 => shr_kind_r8, shr_kind_cl + use spmd_utils, only : masterproc + use cam_abortutils,only : endrun + use ioFileMod, only : getfil + use cam_logfile, only : iulog + use tracer_data, only : trfld,trfile + use infnan, only : nan, assignment(=) + use cam_history, only : addfld, outfld, add_default, fieldname_len + + implicit none + + type :: emission + integer :: bufndx + real(r8) :: scalefactor + character(len=256):: filename + character(len=16) :: species + character(len=32) :: units + integer :: nsectors + character(len=32),pointer :: sectors(:) + type(trfld), pointer :: fields(:) + type(trfile) :: file + end type emission + + private + + public :: elevated_emissions_readnl + public :: elevated_emissions_reg + public :: elevated_emissions_init + public :: elevated_emissions_adv + public :: elevated_emissions_set + + integer, parameter :: NMAX=50 + + type(emission), allocatable :: elev_emis(:) + integer :: n_emis_files = 0 + integer :: n_pbuf_flds = 0 + + character(len=shr_kind_cl) :: elev_emis_specifier(NMAX) = ' ' + character(len=24) :: elev_emis_type + integer :: elev_emis_cycle_yr + integer :: elev_emis_fixed_ymd + integer :: elev_emis_fixed_tod + + character(len=fieldname_len) :: names(NMAX) = ' ' + character(len=32) :: units(NMAX) = ' ' + integer :: indexes(NMAX) = -1 + integer :: n_diags = 0 + +contains + + !----------------------------------------------------------------------- + !----------------------------------------------------------------------- + subroutine elevated_emissions_readnl(nlfile) + + use namelist_utils, only : find_group_name + use spmd_utils, only : mpicom, masterprocid, mpi_integer, mpi_character + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr, i + logical :: logmsg + character(len=*), parameter :: subname = 'elevated_emissions_readnl' + + namelist /elevated_emissions_opts/ elev_emis_specifier, elev_emis_type, elev_emis_cycle_yr, & + elev_emis_fixed_ymd, elev_emis_fixed_tod + + ! Read namelist + if (masterproc) then + open( newunit=unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'elevated_emissions_opts', status=ierr) + if (ierr == 0) then + read(unitn, elevated_emissions_opts, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + + end if + + ! Broadcast namelist variables + call mpi_bcast(elev_emis_specifier,len(elev_emis_specifier(1))*NMAX, mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast(elev_emis_type, len(elev_emis_type), mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast(elev_emis_cycle_yr, 1, mpi_integer, masterprocid, mpicom, ierr) + call mpi_bcast(elev_emis_fixed_ymd, 1, mpi_integer, masterprocid, mpicom, ierr) + call mpi_bcast(elev_emis_fixed_tod, 1, mpi_integer, masterprocid, mpicom, ierr) + + logmsg = .false. + if (masterproc) then + do i = 1,NMAX + if (len_trim(elev_emis_specifier(i))>0) then + logmsg = .true. + write(iulog,'(2a)') subname,': elev_emis_specifier: ',trim(elev_emis_specifier(i)) + endif + enddo + if (logmsg) then + write(iulog,*) subname,': elev_emis_type: ',elev_emis_type + write(iulog,*) subname,': elev_emis_cycle_yr: ',elev_emis_cycle_yr + write(iulog,*) subname,': elev_emis_fixed_ymd: ',elev_emis_fixed_ymd + write(iulog,*) subname,': elev_emis_fixed_tod: ',elev_emis_fixed_tod + endif + endif + + end subroutine elevated_emissions_readnl + + !----------------------------------------------------------------------- + !----------------------------------------------------------------------- + subroutine elevated_emissions_reg( ) + use m_MergeSorts, only : IndexSort + use physics_buffer, only : pbuf_add_field, dtype_r8, pbuf_get_index + use ppgrid, only : pcols, pver + + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: astat + integer :: j, l, m, n, i, nn, kk ! Indices + character(len=16) :: spc_name + character(len=256) :: filename + + character(len=16) :: emis_species(NMAX) + character(len=256) :: emis_filenam(NMAX) + integer :: emis_indexes(NMAX) + integer :: indx(NMAX) + real(r8) :: emis_scalefactor(NMAX) + + character(len=256) :: tmp_string = ' ' + character(len=32) :: xchr = ' ' + real(r8) :: xdbl + + + integer :: err + character(len=32) :: bname + + character(len=*), parameter :: prefix = 'elevated_emissions_reg: ' + kk = 0 + nn = 0 + indx(:) = 0 + emis_species = ' ' + emis_indexes = -1 + emis_filenam = 'NONE' + + count_emis: do n=1,size(elev_emis_specifier) + if ( len_trim(elev_emis_specifier(n) ) == 0 ) then + exit count_emis + endif + + i = scan(elev_emis_specifier(n),'->') + spc_name = trim(adjustl(elev_emis_specifier(n)(:i-1))) + + ! need to parse out scalefactor ... + tmp_string = adjustl(elev_emis_specifier(n)(i+2:)) + j = scan( tmp_string, '*' ) + if (j>0) then + xchr = tmp_string(1:j-1) ! get the multipler (left of the '*') + read( xchr, * ) xdbl ! convert the string to a real + tmp_string = adjustl(tmp_string(j+1:)) ! get the filepath name (right of the '*') + else + xdbl = 1._r8 + endif + filename = trim(tmp_string) + + bname = trim(spc_name)//'_elevemis' + + m = pbuf_get_index(bname,errcode=err) + if (m<1) then + call pbuf_add_field(bname, 'physpkg', dtype_r8, (/pcols,pver/), m) + kk = kk+1 + names(kk) = bname + indexes(kk) = m + endif + + nn = nn+1 + emis_species(nn) = spc_name + emis_filenam(nn) = filename + emis_indexes(nn) = m + emis_scalefactor(nn) = xdbl + + indx(n)=n + enddo count_emis + + n_diags = kk + n_emis_files = nn + + if (masterproc) write(iulog,*) prefix,' n_emis_files = ',n_emis_files + + allocate( elev_emis(n_emis_files), stat=astat ) + if( astat/= 0 ) then + write(iulog,*) 'elev_emis_inti: failed to allocate emissions array; error = ',astat + call endrun('elev_emis_inti: failed to allocate emissions array') + end if + + !----------------------------------------------------------------------- + ! Sort the input files so that the emissions sources are summed in the + ! same order regardless of the order of the input files in the namelist + !----------------------------------------------------------------------- + if (n_emis_files > 0) then + call IndexSort(n_emis_files, indx, emis_filenam) + end if + + !----------------------------------------------------------------------- + ! ... setup the emission type array + !----------------------------------------------------------------------- + do m=1,n_emis_files + elev_emis(m)%bufndx = emis_indexes(indx(m)) + elev_emis(m)%species = emis_species(indx(m)) + elev_emis(m)%filename = emis_filenam(indx(m)) + elev_emis(m)%scalefactor = emis_scalefactor(indx(m)) + enddo + end subroutine elevated_emissions_reg + + !----------------------------------------------------------------------- + !----------------------------------------------------------------------- + subroutine elevated_emissions_init(pbuf2d) + use tracer_data, only : trcdata_init + use cam_pio_utils, only : cam_pio_openfile + use pio, only : pio_inquire, pio_nowrite, pio_closefile, pio_inq_varndims + use pio, only : pio_inq_varname, pio_inq_vardimid, pio_inq_dimid + use pio, only : file_desc_t, pio_get_att, PIO_NOERR, PIO_GLOBAL + use pio, only : pio_seterrorhandling, PIO_BCAST_ERROR,PIO_INTERNAL_ERROR + use string_utils, only : GLC + use physics_buffer,only : physics_buffer_desc, pbuf_set_field + + !-------------------------------------------------------- + ! ... Dummy arguments + !-------------------------------------------------------- + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: ierr, astat, l, m, n + logical :: unstructured + integer :: vid, nvars, isec, num_dims_emis + integer :: vndims + logical, allocatable :: is_sector(:) + type(file_desc_t) :: ncid + character(len=32) :: varname + character(len=256) :: locfn + character(len=80) :: file_interp_type = ' ' + integer, allocatable :: dimids(:) + integer :: time_dimid, ncol_dimid + + character(len=32) :: emis_type = ' ' + character(len=1), parameter :: filelist = '' + character(len=1), parameter :: datapath = '' + logical , parameter :: rmv_file = .false. + real(r8) :: xnan + + xnan = nan + !----------------------------------------------------------------------- + ! read emis files to determine number of sectors + !----------------------------------------------------------------------- + files_loop: do m = 1, n_emis_files + + elev_emis(m)%nsectors = 0 + call getfil (elev_emis(m)%filename, locfn, 0) + call cam_pio_openfile ( ncid, trim(locfn), PIO_NOWRITE) + ierr = pio_inquire (ncid, nVariables=nvars) + + call pio_seterrorhandling(ncid, PIO_BCAST_ERROR) + ierr = pio_inq_dimid( ncid, 'ncol', ncol_dimid ) + unstructured = ierr==PIO_NOERR + call pio_seterrorhandling(ncid, PIO_INTERNAL_ERROR) + + allocate(is_sector(nvars)) + is_sector(:) = .false. + + if (unstructured) then + ierr = pio_inq_dimid( ncid, 'time', time_dimid ) + end if + + do vid = 1,nvars + + ierr = pio_inq_varndims (ncid, vid, vndims) + + if (unstructured) then + num_dims_emis = 3 + else + num_dims_emis = 4 + endif + + if( vndims < num_dims_emis ) then + cycle + elseif( vndims > num_dims_emis ) then + ierr = pio_inq_varname (ncid, vid, varname) + write(iulog,*) 'elev_emis_inti: Skipping variable ', trim(varname),', ndims = ',vndims, & + ' , species=',trim(elev_emis(m)%species) + cycle + end if + + if (unstructured) then + allocate( dimids(vndims) ) + ierr = pio_inq_vardimid( ncid, vid, dimids ) + if ( any(dimids(:)==ncol_dimid) .and. any(dimids(:)==time_dimid) ) then + elev_emis(m)%nsectors = elev_emis(m)%nsectors+1 + is_sector(vid)=.true. + endif + deallocate(dimids) + else + elev_emis(m)%nsectors = elev_emis(m)%nsectors+1 + is_sector(vid)=.true. + end if + + enddo + + allocate( elev_emis(m)%sectors(elev_emis(m)%nsectors), stat=astat ) + if( astat/= 0 ) then + write(iulog,*) 'elev_emis_inti: failed to allocate elev_emis(m)%sectors array; error = ',astat + call endrun + end if + + isec = 1 + + do vid = 1,nvars + if( is_sector(vid) ) then + ierr = pio_inq_varname(ncid, vid, elev_emis(m)%sectors(isec)) + isec = isec+1 + endif + enddo + deallocate(is_sector) + + ! Global attribute 'input_method' overrides the srf_emis_type namelist setting on + ! a file-by-file basis. If the emis file does not contain the 'input_method' + ! attribute then the srf_emis_type namelist setting is used. + call pio_seterrorhandling(ncid, PIO_BCAST_ERROR) + ierr = pio_get_att(ncid, PIO_GLOBAL, 'input_method', file_interp_type) + call pio_seterrorhandling(ncid, PIO_INTERNAL_ERROR) + if ( ierr == PIO_NOERR) then + l = GLC(file_interp_type) + emis_type(1:l) = file_interp_type(1:l) + emis_type(l+1:) = ' ' + else + emis_type = trim(elev_emis_type) + endif + + call pio_closefile (ncid) + + allocate(elev_emis(m)%file%in_pbuf(size(elev_emis(m)%sectors))) + elev_emis(m)%file%in_pbuf(:) = .false. + + call trcdata_init( elev_emis(m)%sectors, & + elev_emis(m)%filename, filelist, datapath, & + elev_emis(m)%fields, & + elev_emis(m)%file, & + rmv_file, elev_emis_cycle_yr, & + elev_emis_fixed_ymd, elev_emis_fixed_tod, trim(emis_type) ) + + elev_emis(m)%units = elev_emis(m)%fields(1)%units + + call pbuf_set_field(pbuf2d, elev_emis(m)%bufndx, xnan) + + set_units: do n = 1,n_diags + if (trim(elev_emis(m)%species)//'_elevemis'==names(n)) then + units(n) = elev_emis(m)%fields(1)%units + exit set_units + end if + end do set_units + + enddo files_loop + + do n = 1, n_diags + call addfld(names(n), (/ 'lev' /), 'A', units(n), 'pbuf elev emis '//trim(names(n))) + end do + + end subroutine elevated_emissions_init + + !----------------------------------------------------------------------- + !----------------------------------------------------------------------- + subroutine elevated_emissions_adv( pbuf2d, state ) + !----------------------------------------------------------------------- + ! ... check serial case for time span + !----------------------------------------------------------------------- + + use physics_types,only : physics_state + use ppgrid, only : begchunk, endchunk + use tracer_data, only : advance_trcdata + use physics_buffer, only : physics_buffer_desc, pbuf_set_field + + !-------------------------------------------------------- + ! ... Dummy arguments + !-------------------------------------------------------- + type(physics_state), intent(in):: state(begchunk:endchunk) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: m + + do m = 1,n_emis_files + call advance_trcdata( elev_emis(m)%fields, elev_emis(m)%file, state, pbuf2d ) + call pbuf_set_field(pbuf2d, elev_emis(m)%bufndx, 0._r8) + end do + + end subroutine elevated_emissions_adv + + !----------------------------------------------------------------------- + !----------------------------------------------------------------------- + subroutine elevated_emissions_set( lchnk, ncol, pbuf ) + use physics_buffer, only : physics_buffer_desc, pbuf_get_field + + !-------------------------------------------------------- + ! ... Dummy arguments + !-------------------------------------------------------- + integer, intent(in) :: ncol + integer, intent(in) :: lchnk + type(physics_buffer_desc), pointer :: pbuf(:) + + !-------------------------------------------------------- + ! ... local variables + !-------------------------------------------------------- + integer :: isec, m, n + real(r8), pointer :: flux(:,:) + + !-------------------------------------------------------- + ! ... set non-zero emissions + !-------------------------------------------------------- + do m = 1,n_emis_files + call pbuf_get_field(pbuf, elev_emis(m)%bufndx, flux) + do isec = 1,elev_emis(m)%nsectors + flux(:ncol,:) = flux(:ncol,:) + elev_emis(m)%scalefactor*elev_emis(m)%fields(isec)%data(:ncol,:,lchnk) + enddo + end do + + do n = 1, n_diags + call pbuf_get_field(pbuf, indexes(n), flux) + call outfld(names(n), flux(:ncol,:), ncol, lchnk) + end do + + end subroutine elevated_emissions_set + +end module elevated_emissions_mod diff --git a/src/chemistry/utils/surface_emissions_mod.F90 b/src/chemistry/utils/surface_emissions_mod.F90 new file mode 100644 index 0000000000..23e9973986 --- /dev/null +++ b/src/chemistry/utils/surface_emissions_mod.F90 @@ -0,0 +1,420 @@ +module surface_emissions_mod + !--------------------------------------------------------------- + ! ... surface emissions module + !--------------------------------------------------------------- + + use shr_kind_mod, only : r8 => shr_kind_r8, shr_kind_cl + use spmd_utils, only : masterproc + use cam_abortutils,only : endrun + use ioFileMod, only : getfil + use cam_logfile, only : iulog + use tracer_data, only : trfld,trfile + use infnan, only : nan, assignment(=) + use cam_history, only : addfld, outfld, add_default, horiz_only, fieldname_len + + implicit none + + type :: emission + integer :: bufndx + real(r8) :: scalefactor + character(len=256):: filename + character(len=16) :: species + character(len=8) :: units + integer :: nsectors + character(len=32),pointer :: sectors(:) + type(trfld), pointer :: fields(:) + type(trfile) :: file + end type emission + + private + + public :: surface_emissions_readnl + public :: surface_emissions_reg + public :: surface_emissions_init + public :: surface_emissions_adv + public :: surface_emissions_set + + integer, parameter :: NMAX=50 + + type(emission), allocatable :: emissions(:) + integer :: n_emis_files = 0 + integer :: n_pbuf_flds = 0 + + character(len=shr_kind_cl) :: emissions_specifier(NMAX) = ' ' + character(len=24) :: emissions_type + integer :: emissions_cycle_yr + integer :: emissions_fixed_ymd + integer :: emissions_fixed_tod + + character(len=fieldname_len) :: names(NMAX) = ' ' + character(len=32) :: units(NMAX) = ' ' + integer :: indexes(NMAX) = -1 + integer :: n_diags = 0 + +contains + + !----------------------------------------------------------------------- + !----------------------------------------------------------------------- + subroutine surface_emissions_readnl(nlfile) + + use namelist_utils, only : find_group_name + use spmd_utils, only : mpicom, masterprocid, mpi_integer, mpi_character + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'surface_emissions_readnl' + + namelist /surface_emissions_opts/ emissions_specifier, emissions_type, emissions_cycle_yr, & + emissions_fixed_ymd, emissions_fixed_tod + + ! Read namelist + if (masterproc) then + open( newunit=unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'surface_emissions_opts', status=ierr) + if (ierr == 0) then + read(unitn, surface_emissions_opts, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + end if + + ! Broadcast namelist variables + call mpi_bcast(emissions_specifier,len(emissions_specifier(1))*NMAX, mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast(emissions_type, len(emissions_type), mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast(emissions_cycle_yr, 1, mpi_integer, masterprocid, mpicom, ierr) + call mpi_bcast(emissions_fixed_ymd, 1, mpi_integer, masterprocid, mpicom, ierr) + call mpi_bcast(emissions_fixed_tod, 1, mpi_integer, masterprocid, mpicom, ierr) + + end subroutine surface_emissions_readnl + + !----------------------------------------------------------------------- + !----------------------------------------------------------------------- + subroutine surface_emissions_reg( ) + use m_MergeSorts, only : IndexSort + use physics_buffer, only : pbuf_add_field, dtype_r8, pbuf_get_index + use ppgrid, only : pcols + + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: astat + integer :: j, l, m, n, i, nn, kk ! Indices + character(len=16) :: spc_name + character(len=256) :: filename + + character(len=16) :: emis_species(NMAX) + character(len=256) :: emis_filenam(NMAX) + integer :: emis_indexes(NMAX) + integer :: indx(NMAX) + real(r8) :: emis_scalefactor(NMAX) + + character(len=256) :: tmp_string = ' ' + character(len=32) :: xchr = ' ' + real(r8) :: xdbl + + + integer :: err + character(len=32) :: bname + + kk = 0 + nn = 0 + indx(:) = 0 + emis_species = ' ' + emis_indexes = -1 + emis_filenam = 'NONE' + + count_emis: do n=1,size(emissions_specifier) + if ( len_trim(emissions_specifier(n) ) == 0 ) then + exit count_emis + endif + + i = scan(emissions_specifier(n),'->') + spc_name = trim(adjustl(emissions_specifier(n)(:i-1))) + + ! need to parse out scalefactor ... + tmp_string = adjustl(emissions_specifier(n)(i+2:)) + j = scan( tmp_string, '*' ) + if (j>0) then + xchr = tmp_string(1:j-1) ! get the multipler (left of the '*') + read( xchr, * ) xdbl ! convert the string to a real + tmp_string = adjustl(tmp_string(j+1:)) ! get the filepath name (right of the '*') + else + xdbl = 1._r8 + endif + filename = trim(tmp_string) + + bname = trim(spc_name)//'_srfemis' + + m = pbuf_get_index(bname,errcode=err) + if (m<1) then + call pbuf_add_field(bname, 'physpkg', dtype_r8, (/pcols/), m) + kk = kk+1 + names(kk) = bname + indexes(kk) = m + endif + + nn = nn+1 + emis_species(nn) = spc_name + emis_filenam(nn) = filename + emis_indexes(nn) = m + emis_scalefactor(nn) = xdbl + + indx(n)=n + enddo count_emis + + n_diags = kk + n_emis_files = nn + + if (masterproc) write(iulog,*) 'srf_emis_inti: n_emis_files = ',n_emis_files + + allocate( emissions(n_emis_files), stat=astat ) + if( astat/= 0 ) then + write(iulog,*) 'srf_emis_inti: failed to allocate emissions array; error = ',astat + call endrun('srf_emis_inti: failed to allocate emissions array') + end if + + !----------------------------------------------------------------------- + ! Sort the input files so that the emissions sources are summed in the + ! same order regardless of the order of the input files in the namelist + !----------------------------------------------------------------------- + if (n_emis_files > 0) then + call IndexSort(n_emis_files, indx, emis_filenam) + end if + + !----------------------------------------------------------------------- + ! ... setup the emission type array + !----------------------------------------------------------------------- + do m=1,n_emis_files + emissions(m)%bufndx = emis_indexes(indx(m)) + emissions(m)%species = emis_species(indx(m)) + emissions(m)%filename = emis_filenam(indx(m)) + emissions(m)%scalefactor = emis_scalefactor(indx(m)) + enddo + end subroutine surface_emissions_reg + + !----------------------------------------------------------------------- + !----------------------------------------------------------------------- + subroutine surface_emissions_init(pbuf2d) + use tracer_data, only : trcdata_init + use cam_pio_utils, only : cam_pio_openfile + use pio, only : pio_inquire, pio_nowrite, pio_closefile, pio_inq_varndims + use pio, only : pio_inq_varname, pio_inq_vardimid, pio_inq_dimid + use pio, only : file_desc_t, pio_get_att, PIO_NOERR, PIO_GLOBAL + use pio, only : pio_seterrorhandling, PIO_BCAST_ERROR,PIO_INTERNAL_ERROR + use string_utils, only : GLC + use physics_buffer,only : physics_buffer_desc, pbuf_set_field + + !-------------------------------------------------------- + ! ... Dummy arguments + !-------------------------------------------------------- + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: ierr, astat, l, m, n + logical :: unstructured + integer :: vid, nvars, isec, num_dims_emis + integer :: vndims + logical, allocatable :: is_sector(:) + type(file_desc_t) :: ncid + character(len=32) :: varname + character(len=256) :: locfn + character(len=80) :: file_interp_type = ' ' + integer, allocatable :: dimids(:) + integer :: time_dimid, ncol_dimid + + character(len=32) :: emis_type = ' ' + character(len=1), parameter :: filelist = '' + character(len=1), parameter :: datapath = '' + logical , parameter :: rmv_file = .false. + real(r8) :: xnan + + xnan = nan + !----------------------------------------------------------------------- + ! read emis files to determine number of sectors + !----------------------------------------------------------------------- + files_loop: do m = 1, n_emis_files + + emissions(m)%nsectors = 0 + call getfil (emissions(m)%filename, locfn, 0) + call cam_pio_openfile ( ncid, trim(locfn), PIO_NOWRITE) + ierr = pio_inquire (ncid, nVariables=nvars) + + call pio_seterrorhandling(ncid, PIO_BCAST_ERROR) + ierr = pio_inq_dimid( ncid, 'ncol', ncol_dimid ) + unstructured = ierr==PIO_NOERR + call pio_seterrorhandling(ncid, PIO_INTERNAL_ERROR) + + allocate(is_sector(nvars)) + is_sector(:) = .false. + + if (unstructured) then + ierr = pio_inq_dimid( ncid, 'time', time_dimid ) + end if + + do vid = 1,nvars + + ierr = pio_inq_varndims (ncid, vid, vndims) + + if (unstructured) then + num_dims_emis = 2 + else + num_dims_emis = 3 + endif + + if( vndims < num_dims_emis ) then + cycle + elseif( vndims > num_dims_emis ) then + ierr = pio_inq_varname (ncid, vid, varname) + write(iulog,*) 'srf_emis_inti: Skipping variable ', trim(varname),', ndims = ',vndims, & + ' , species=',trim(emissions(m)%species) + cycle + end if + + if (unstructured) then + allocate( dimids(vndims) ) + ierr = pio_inq_vardimid( ncid, vid, dimids ) + if ( any(dimids(:)==ncol_dimid) .and. any(dimids(:)==time_dimid) ) then + emissions(m)%nsectors = emissions(m)%nsectors+1 + is_sector(vid)=.true. + endif + deallocate(dimids) + else + emissions(m)%nsectors = emissions(m)%nsectors+1 + is_sector(vid)=.true. + end if + + enddo + + allocate( emissions(m)%sectors(emissions(m)%nsectors), stat=astat ) + if( astat/= 0 ) then + write(iulog,*) 'srf_emis_inti: failed to allocate emissions(m)%sectors array; error = ',astat + call endrun + end if + + isec = 1 + + do vid = 1,nvars + if( is_sector(vid) ) then + ierr = pio_inq_varname(ncid, vid, emissions(m)%sectors(isec)) + isec = isec+1 + endif + enddo + deallocate(is_sector) + + ! Global attribute 'input_method' overrides the srf_emis_type namelist setting on + ! a file-by-file basis. If the emis file does not contain the 'input_method' + ! attribute then the srf_emis_type namelist setting is used. + call pio_seterrorhandling(ncid, PIO_BCAST_ERROR) + ierr = pio_get_att(ncid, PIO_GLOBAL, 'input_method', file_interp_type) + call pio_seterrorhandling(ncid, PIO_INTERNAL_ERROR) + if ( ierr == PIO_NOERR) then + l = GLC(file_interp_type) + emis_type(1:l) = file_interp_type(1:l) + emis_type(l+1:) = ' ' + else + emis_type = trim(emissions_type) + endif + + call pio_closefile (ncid) + + allocate(emissions(m)%file%in_pbuf(size(emissions(m)%sectors))) + emissions(m)%file%in_pbuf(:) = .false. + + call trcdata_init( emissions(m)%sectors, & + emissions(m)%filename, filelist, datapath, & + emissions(m)%fields, & + emissions(m)%file, & + rmv_file, emissions_cycle_yr, & + emissions_fixed_ymd, emissions_fixed_tod, trim(emis_type) ) + + emissions(m)%units = emissions(m)%fields(1)%units + + call pbuf_set_field(pbuf2d, emissions(m)%bufndx, xnan) + + set_units: do n = 1,n_diags + if (trim(emissions(m)%species)//'_srfemis'==names(n)) then + units(n) = emissions(m)%fields(1)%units + exit set_units + end if + end do set_units + + enddo files_loop + + do n = 1, n_diags + call addfld(names(n), horiz_only, 'A', units(n), 'pbuf surf emis '//trim(names(n))) + end do + + end subroutine surface_emissions_init + + !----------------------------------------------------------------------- + !----------------------------------------------------------------------- + subroutine surface_emissions_adv( pbuf2d, state ) + !----------------------------------------------------------------------- + ! ... check serial case for time span + !----------------------------------------------------------------------- + + use physics_types,only : physics_state + use ppgrid, only : begchunk, endchunk + use tracer_data, only : advance_trcdata + use physics_buffer, only : physics_buffer_desc, pbuf_set_field + + !-------------------------------------------------------- + ! ... Dummy arguments + !-------------------------------------------------------- + type(physics_state), intent(in):: state(begchunk:endchunk) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: m + + do m = 1,n_emis_files + call advance_trcdata( emissions(m)%fields, emissions(m)%file, state, pbuf2d ) + call pbuf_set_field(pbuf2d, emissions(m)%bufndx, 0._r8) + end do + + end subroutine surface_emissions_adv + + !----------------------------------------------------------------------- + !----------------------------------------------------------------------- + subroutine surface_emissions_set( lchnk, ncol, pbuf ) + use physics_buffer, only : physics_buffer_desc, pbuf_get_field + + !-------------------------------------------------------- + ! ... Dummy arguments + !-------------------------------------------------------- + integer, intent(in) :: ncol + integer, intent(in) :: lchnk + type(physics_buffer_desc), pointer :: pbuf(:) + + !-------------------------------------------------------- + ! ... local variables + !-------------------------------------------------------- + integer :: isec, m, n + real(r8), pointer :: flux(:) + + !-------------------------------------------------------- + ! ... set non-zero emissions + !-------------------------------------------------------- + do m = 1,n_emis_files + call pbuf_get_field(pbuf, emissions(m)%bufndx, flux) + do isec = 1,emissions(m)%nsectors + flux(:ncol) = flux(:ncol) + emissions(m)%scalefactor*emissions(m)%fields(isec)%data(:ncol,1,lchnk) + enddo + end do + + do n = 1, n_diags + call pbuf_get_field(pbuf, indexes(n), flux) + call outfld(names(n), flux(:ncol), ncol, lchnk) + end do + + end subroutine surface_emissions_set + +end module surface_emissions_mod diff --git a/src/control/cam_history.F90 b/src/control/cam_history.F90 index 39222fc536..6d3555a2cc 100644 --- a/src/control/cam_history.F90 +++ b/src/control/cam_history.F90 @@ -236,7 +236,7 @@ module cam_history ! User definable constants for hash and overflow tables. ! Define size of primary hash table (specified as 2**size). ! - integer, parameter :: tbl_hash_pri_sz_lg2 = 16 + integer, parameter :: tbl_hash_pri_sz_lg2 = 20 ! ! Define size of overflow hash table % of primary hash table. ! diff --git a/src/control/runtime_opts.F90 b/src/control/runtime_opts.F90 index 915664cdb9..bd9c83f2d1 100644 --- a/src/control/runtime_opts.F90 +++ b/src/control/runtime_opts.F90 @@ -102,6 +102,8 @@ subroutine read_namelist(nlfilename, single_column, scmlat, scmlon) use cam_budget, only: cam_budget_readnl use phys_grid_ctem, only: phys_grid_ctem_readnl use mo_lightning, only: lightning_readnl + use surface_emissions_mod, only: surface_emissions_readnl + use elevated_emissions_mod, only: elevated_emissions_readnl !---------------------------Arguments----------------------------------- @@ -205,6 +207,8 @@ subroutine read_namelist(nlfilename, single_column, scmlat, scmlon) call hemco_readnl(nlfilename) call cam_budget_readnl(nlfilename) call phys_grid_ctem_readnl(nlfilename) + call surface_emissions_readnl(nlfilename) + call elevated_emissions_readnl(nlfilename) end subroutine read_namelist diff --git a/src/physics/cam/aer_rad_props.F90 b/src/physics/cam/aer_rad_props.F90 index d83ca10f50..33ecc9056f 100644 --- a/src/physics/cam/aer_rad_props.F90 +++ b/src/physics/cam/aer_rad_props.F90 @@ -54,7 +54,8 @@ subroutine aer_rad_props_init() logical :: history_aero_optics ! Output aerosol optics diagnostics logical :: history_dust ! Output dust diagnostics logical :: prog_modal_aero ! Prognostic modal aerosols present - integer :: nmodes ! number of aerosol modes + integer :: nmodes ! number of aerosol modes + integer :: nbins ! number of aerosol bins !---------------------------------------------------------------------------- @@ -79,7 +80,7 @@ subroutine aer_rad_props_init() ! get names of bulk aerosols allocate(aernames(numaerosols)) - call rad_cnst_get_info(0, aernames=aernames, nmodes=nmodes) + call rad_cnst_get_info(0, aernames=aernames, nmodes=nmodes, nbins=nbins) ! diagnostic output for bulk aerosols ! create outfld names for visible OD @@ -103,8 +104,8 @@ subroutine aer_rad_props_init() end do endif - if (nmodes > 0) then - call aerosol_optics_cam_init() + if (nmodes>0 .or. nbins>0) then + call aerosol_optics_cam_init() end if deallocate(aernames) @@ -178,6 +179,7 @@ subroutine aer_rad_props_sw(list_idx, state, pbuf, nnite, idxnite, & integer :: numaerosols ! number of bulk aerosols in climate/diagnostic list integer :: nmodes ! number of aerosol modes in climate/diagnostic list + integer :: nbins ! number of aerosol bins in climate/diagnostic list integer :: iaerosol ! index into bulk aerosol list character(len=ot_length) :: opticstype ! hygro or nonhygro @@ -216,10 +218,10 @@ subroutine aer_rad_props_sw(list_idx, state, pbuf, nnite, idxnite, & wrh(1:ncol,1:pver) = rhtrunc(1:ncol,1:pver) * nrh - krh(1:ncol,1:pver) ! (-) weighting on left side values ! get number of bulk aerosols and number of modes in current list - call rad_cnst_get_info(list_idx, naero=numaerosols, nmodes=nmodes) + call rad_cnst_get_info(list_idx, naero=numaerosols, nmodes=nmodes, nbins=nbins) - ! Contributions from modal aerosols. - if (nmodes > 0) then + ! Contributions from modal and bin aerosols. + if (nmodes>0 .or. nbins>0) then call aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, & tau, tau_w, tau_w_g, tau_w_f) else @@ -336,6 +338,7 @@ subroutine aer_rad_props_lw(list_idx, state, pbuf, odap_aer) integer :: ncol ! number of columns integer :: numaerosols ! number of bulk aerosols in climate/diagnostic list integer :: nmodes ! number of aerosol modes in climate/diagnostic list + integer :: nbins ! number of aerosol bins in climate/diagnostic list integer :: iaerosol ! index into bulk aerosol list character(len=ot_length) :: opticstype ! hygro or nonhygro @@ -372,10 +375,10 @@ subroutine aer_rad_props_lw(list_idx, state, pbuf, odap_aer) ncol = state%ncol ! get number of bulk aerosols and number of modes in current list - call rad_cnst_get_info(list_idx, naero=numaerosols, nmodes=nmodes) + call rad_cnst_get_info(list_idx, naero=numaerosols, nmodes=nmodes, nbins=nbins) - ! Contributions from modal aerosols. - if (nmodes > 0) then + ! Contributions from modal and sectional aerosols. + if (nmodes>0 .or. nbins>0) then call aerosol_optics_cam_lw(list_idx, state, pbuf, odap_aer) else odap_aer = 0._r8 diff --git a/src/physics/cam/aerosol_optics_cam.F90 b/src/physics/cam/aerosol_optics_cam.F90 index 3fb18c7a9c..9ea02e5d9f 100644 --- a/src/physics/cam/aerosol_optics_cam.F90 +++ b/src/physics/cam/aerosol_optics_cam.F90 @@ -16,15 +16,20 @@ module aerosol_optics_cam use cam_history_support, only: fillvalue use tropopause, only : tropopause_findChemTrop + use wv_saturation, only: qsat use aerosol_properties_mod, only: aerosol_properties use modal_aerosol_properties_mod, only: modal_aerosol_properties + use carma_aerosol_properties_mod, only: carma_aerosol_properties use aerosol_state_mod, only: aerosol_state use modal_aerosol_state_mod,only: modal_aerosol_state + use carma_aerosol_state_mod,only: carma_aerosol_state use aerosol_optics_mod, only: aerosol_optics use refractive_aerosol_optics_mod, only: refractive_aerosol_optics + use hygrocoreshell_aerosol_optics_mod, only: hygrocoreshell_aerosol_optics + use hygrowghtpct_aerosol_optics_mod, only: hygrowghtpct_aerosol_optics implicit none @@ -52,6 +57,7 @@ module aerosol_optics_cam complex(r8) :: crefwlw(nlwbands) = -huge(1._r8) ! complex refractive index for water infrared character(len=cl) :: water_refindex_file = 'NONE' ! full pathname for water refractive index dataset + logical :: carma_active = .false. logical :: modal_active = .false. integer :: num_aero_models = 0 integer :: lw10um_indx = -1 ! wavelength index corresponding to 10 microns @@ -125,7 +131,7 @@ subroutine aerosol_optics_cam_init use ioFileMod, only: getfil character(len=*), parameter :: prefix = 'aerosol_optics_cam_init: ' - integer :: nmodes=0, iaermod, istat, ilist, i + integer :: nmodes=0, nbins=0, iaermod, istat, ilist, i logical :: call_list(0:n_diag) real(r8) :: lwavlen_lo(nlwbands), lwavlen_hi(nlwbands) @@ -145,11 +151,16 @@ subroutine aerosol_optics_cam_init num_aero_models = 0 - call rad_cnst_get_info(0, nmodes=nmodes) + call rad_cnst_get_info(0, nmodes=nmodes, nbins=nbins) modal_active = nmodes>0 + carma_active = nbins>0 + ! count aerosol models if (modal_active) then - num_aero_models = num_aero_models+1 ! count aerosol models + num_aero_models = num_aero_models+1 + end if + if (carma_active) then + num_aero_models = num_aero_models+1 end if if (num_aero_models>0) then @@ -165,6 +176,10 @@ subroutine aerosol_optics_cam_init iaermod = iaermod+1 aero_props(iaermod)%obj => modal_aerosol_properties() end if + if (carma_active) then + iaermod = iaermod+1 + aero_props(iaermod)%obj => carma_aerosol_properties() + end if if (water_refindex_file=='NONE') then call endrun(prefix//'water_refindex_file must be specified') @@ -500,6 +515,8 @@ subroutine aerosol_optics_cam_init call add_default ('EXTxASYMdn' , 1, ' ') end if + call addfld( 'SULFWTPCT', (/ 'lev' /), 'I', '1', 'Sulfate Weight Percent' ) + end subroutine aerosol_optics_cam_init !=============================================================================== @@ -559,6 +576,11 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, real(r8), allocatable :: palb(:) ! parameterized single scattering albedo real(r8), allocatable :: pasm(:) ! parameterized asymmetry factor + real(r8) :: relh(pcols,pver) + real(r8) :: sate(pcols,pver) ! saturation vapor pressure + real(r8) :: satq(pcols,pver) ! saturation specific humidity + real(r8) :: sulfwtpct(pcols,pver) ! sulf weight percent + character(len=ot_length) :: opticstype integer :: iaermod @@ -637,6 +659,8 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, real(r8) :: ssavis(pcols) integer :: troplev(pcols) + integer :: i, k + nullify(aero_optics) lchnk = state%lchnk @@ -694,6 +718,10 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, iaermod = iaermod+1 aero_state(iaermod)%obj => modal_aerosol_state( state, pbuf ) end if + if (carma_active) then + iaermod = iaermod+1 + aero_state(iaermod)%obj => carma_aerosol_state( state, pbuf ) + end if allocate(pext(ncol), stat=istat) if (istat/=0) then @@ -719,6 +747,9 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, nbins=aeroprops%nbins(list_idx) + sulfwtpct(:ncol,:pver) = aerostate%wgtpct(ncol,pver) + call outfld('SULFWTPCT', sulfwtpct(1:ncol,:), ncol, lchnk) + binloop: do ibin = 1, nbins dustaodbin(:) = 0._r8 @@ -731,6 +762,16 @@ subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, case('modal') ! refractive method aero_optics=>refractive_aerosol_optics(aeroprops, aerostate, list_idx, ibin, & ncol, pver, nswbands, nlwbands, crefwsw, crefwlw) + case('hygroscopic_coreshell') + ! calculate relative humidity for table lookup into rh grid + call qsat(state%t(:ncol,:), state%pmid(:ncol,:), sate(:ncol,:), satq(:ncol,:), ncol, pver) + relh(:ncol,:) = state%q(1:ncol,:,1) / satq(:ncol,:) + relh(:ncol,:) = max(1.e-20_r8,relh(:ncol,:)) + aero_optics=>hygrocoreshell_aerosol_optics(aeroprops, aerostate, list_idx, & + ibin, ncol, pver, relh(:ncol,:)) + case('hygroscopic_wtp') + aero_optics=>hygrowghtpct_aerosol_optics(aeroprops, aerostate, list_idx, & + ibin, ncol, pver, sulfwtpct(:ncol,:)) case default call endrun(prefix//'optics method not recognized') end select @@ -1141,6 +1182,11 @@ subroutine aerosol_optics_cam_lw(list_idx, state, pbuf, tauxar) real(r8), allocatable :: pabs(:) + real(r8) :: relh(pcols,pver) + real(r8) :: sate(pcols,pver) ! saturation vapor pressure + real(r8) :: satq(pcols,pver) ! saturation specific humidity + real(r8) :: sulfwtpct(pcols,pver) ! sulf weight percent + character(len=32) :: opticstype integer :: iaermod @@ -1160,6 +1206,10 @@ subroutine aerosol_optics_cam_lw(list_idx, state, pbuf, tauxar) iaermod = iaermod+1 aero_state(iaermod)%obj => modal_aerosol_state( state, pbuf ) end if + if (carma_active) then + iaermod = iaermod+1 + aero_state(iaermod)%obj => carma_aerosol_state( state, pbuf ) + end if ncol = state%ncol @@ -1177,6 +1227,8 @@ subroutine aerosol_optics_cam_lw(list_idx, state, pbuf, tauxar) nbins=aero_props(iaermod)%obj%nbins(list_idx) + sulfwtpct(:ncol,:pver) = aerostate%wgtpct(ncol,pver) + binloop: do ibin = 1, nbins call aeroprops%optics_params(list_idx, ibin, opticstype=opticstype) @@ -1185,6 +1237,16 @@ subroutine aerosol_optics_cam_lw(list_idx, state, pbuf, tauxar) case('modal') ! refractive method aero_optics=>refractive_aerosol_optics(aeroprops, aerostate, list_idx, ibin, & ncol, pver, nswbands, nlwbands, crefwsw, crefwlw) + case('hygroscopic_coreshell') + ! calculate relative humidity for table lookup into rh grid + call qsat(state%t(:ncol,:), state%pmid(:ncol,:), sate(:ncol,:), satq(:ncol,:), ncol, pver) + relh(:ncol,:) = state%q(1:ncol,:,1) / satq(:ncol,:) + relh(:ncol,:) = max(1.e-20_r8,relh(:ncol,:)) + aero_optics=>hygrocoreshell_aerosol_optics(aeroprops, aerostate, list_idx, & + ibin, ncol, pver, relh(:ncol,:)) + case('hygroscopic_wtp') + aero_optics=>hygrowghtpct_aerosol_optics(aeroprops, aerostate, list_idx, & + ibin, ncol, pver, sulfwtpct(:ncol,:)) case default call endrun(prefix//'optics method not recognized') end select diff --git a/src/physics/cam/carma_flags_mod.F90 b/src/physics/cam/carma_flags_mod.F90 index 59fee48bf3..1ffa27b046 100644 --- a/src/physics/cam/carma_flags_mod.F90 +++ b/src/physics/cam/carma_flags_mod.F90 @@ -11,8 +11,13 @@ module carma_flags_mod use spmd_utils, only: masterproc ! Flags for integration with CAM Microphysics - public carma_readnl ! read the carma namelist - + + implicit none + public + + integer, parameter :: carma_maxdiags = 100 + integer, protected :: carma_ndiagpkgs ! Number of diags_packages listed + integer, protected :: carma_ndebugpkgs ! Number of diags_packages listed ! Namelist flags ! @@ -20,45 +25,53 @@ module carma_flags_mod ! calculations, but it will still initialize itself. This allows the same build and ! namelist to be used, but the CARMA processing diabled. Use the configure option ! -carma none to totally disable CARMA and prevent even the register from happening. - logical, public :: carma_flag = .false. ! If .true. then turn on CARMA microphysics in CAM - logical, public :: carma_do_aerosol = .true. ! If .true. then CARMA is processed after surface coupling - logical, public :: carma_do_cldice = .false. ! If .true. then do cloud ice - logical, public :: carma_do_cldliq = .false. ! If .true. then do cloud liquid - logical, public :: carma_do_clearsky = .false. ! If .true. then do clear sky particle calculations - logical, public :: carma_do_coag = .false. ! If .true. then do coagulation - logical, public :: carma_do_detrain = .false. ! If .true. then do detrain - logical, public :: carma_do_drydep = .false. ! If .true. then do dry deposition - logical, public :: carma_do_emission = .false. ! If .true. then do emission - logical, public :: carma_do_fixedinit= .false. ! If .true. then do fixed initialization to a reference state - logical, public :: carma_hetchem_feedback= .false.! If .true. then CARMA sulfate surface area density used in heterogeneous chemistry - logical, public :: carma_rad_feedback= .false. ! If .true. then CARMA sulfate mass mixing ratio & effective radius used in radiation - logical, public :: carma_do_explised = .false. ! If .true. then do sedimentation with substepping - logical, public :: carma_do_incloud = .false. ! If .true. then do incloud particle calculations - logical, public :: carma_do_grow = .false. ! If .true. then do growth - logical, public :: carma_do_optics = .false. ! If .true. then do optical properties file - logical, public :: carma_do_partialinit= .false. ! If .true. then do initialization of coagulation to a reference state (requires fixedinit) - logical, public :: carma_do_pheat = .false. ! If .true. then do particle heating - logical, public :: carma_do_pheatatm = .false. ! If .true. then do particle heating of atmosphere - logical, public :: carma_do_substep = .false. ! If .true. then do substeping - logical, public :: carma_do_thermo = .false. ! If .true. then do solve thermodynamics equation - logical, public :: carma_do_wetdep = .false. ! If .true. then do wet deposition - logical, public :: carma_do_vdiff = .false. ! If .true. then do vertical brownian diffusion - logical, public :: carma_do_vtran = .false. ! If .true. then do vertical transport - integer, public :: carma_maxsubsteps = 1 ! Maximum number of time substeps allowed - integer, public :: carma_minsubsteps = 1 ! Minimum number of time substeps allowed - integer, public :: carma_maxretries = 8 ! Maximum number of time substeps allowed - real(r8), public :: carma_conmax = 0.1_r8 ! Minumum relative concentration to consider in substep - real(r8), public :: carma_dgc_threshold = 0.0_r8 ! When non-zero, the largest percentage change in gas concentration allowed per substep. - real(r8), public :: carma_ds_threshold = 0.0_r8 ! When non-zero, the largest percentage change in gas saturation allowed per substep. - real(r8), public :: carma_dt_threshold = 0.0_r8 ! When non-zero, the largest change in temperature (K) allowed per substep. - real(r8), public :: carma_tstick = 1.0_r8 ! Thermal accommodation coefficient - real(r8), public :: carma_gsticki = 0.93_r8 ! Growth accommodation coefficient for ice - real(r8), public :: carma_gstickl = 1.0_r8 ! Growth accommodation coefficient for liquid - real(r8), public :: carma_cstick = 1.0_r8 ! Coagulation accommodation coefficient - real(r8), public :: carma_rhcrit = 1.0_r8 ! Critical relative humidity for liquid clouds - real(r8), public :: carma_vf_const = 0.0_r8 ! If specified and non-zero, constant fall velocity for all particles [cm/s] - character(len=256), public :: carma_reftfile = 'carma_reft.nc' ! path to the file containing the reference temperature profile - character(len=32), public :: carma_model = "none" ! String (no spaces) that identifies the model + logical, protected :: carma_flag = .false. ! If .true. then turn on CARMA microphysics in CAM + logical, protected :: carma_do_aerosol = .true. ! If .true. then CARMA is processed after surface coupling + logical, protected :: carma_do_coremasscheck = .false. ! If .true. then do coremasscheck and abort model after certain subroutines + logical, protected :: carma_do_cldice = .false. ! If .true. then do cloud ice + logical, protected :: carma_do_cldliq = .false. ! If .true. then do cloud liquid + logical, protected :: carma_do_clearsky = .false. ! If .true. then do clear sky particle calculations + logical, protected :: carma_do_cloudborne = .false. ! If .true. then do then the carma groups can be cloudborne + logical, protected :: carma_do_coag = .false. ! If .true. then do coagulation + logical, protected :: carma_do_detrain = .false. ! If .true. then do detrain + logical, protected :: carma_do_drydep = .false. ! If .true. then do dry deposition + logical, protected :: carma_do_emission = .false. ! If .true. then do emission + logical, protected :: carma_do_fixedinit= .false. ! If .true. then do fixed initialization to a reference state + logical, protected :: carma_hetchem_feedback=.false.! If .true. then CARMA sulfate surface area density used in heterogeneous chemistry + logical, protected :: carma_rad_feedback= .false. ! If .true. then CARMA sulfate mass mixing ratio & effective radius used in radiation + logical, protected :: carma_do_explised = .false. ! If .true. then do sedimentation with substepping + logical, protected :: carma_do_incloud = .false. ! If .true. then do incloud particle calculations + logical, protected :: carma_do_budget_diags = .false. ! If .true. then do budget diagnostics + logical, protected :: carma_do_package_diags = .false. ! If .true. then do package diagnostics + logical, protected :: carma_do_grow = .false. ! If .true. then do growth + logical, protected :: carma_do_optics = .false. ! If .true. then do optical properties file + logical, protected :: carma_do_partialinit= .false. ! If .true. then do initialization of coagulation to a reference state (requires fixedinit) + logical, protected :: carma_do_pheat = .false. ! If .true. then do particle heating + logical, protected :: carma_do_pheatatm = .false. ! If .true. then do particle heating of atmosphere + logical, protected :: carma_do_substep = .false. ! If .true. then do substeping + logical, protected :: carma_do_thermo = .false. ! If .true. then do solve thermodynamics equation + logical, protected :: carma_do_wetdep = .false. ! If .true. then do wet deposition + logical, protected :: carma_do_vdiff = .false. ! If .true. then do vertical brownian diffusion + logical, protected :: carma_do_vtran = .false. ! If .true. then do vertical transport + integer, protected :: carma_diags_file = 0 ! Default file for diagnostic output + integer, protected :: carma_maxsubsteps = 1 ! Maximum number of time substeps allowed + integer, protected :: carma_minsubsteps = 1 ! Minimum number of time substeps allowed + integer, protected :: carma_maxretries = 8 ! Maximum number of time substeps allowed + real(r8), protected :: carma_conmax = 0.1_r8 ! Minumum relative concentration to consider in substep + real(r8), protected :: carma_dgc_threshold = 0.0_r8 ! When non-zero, the largest percentage change in gas concentration allowed per substep. + real(r8), protected :: carma_ds_threshold = 0.0_r8 ! When non-zero, the largest percentage change in gas saturation allowed per substep. + real(r8), protected :: carma_dt_threshold = 0.0_r8 ! When non-zero, the largest change in temperature (K) allowed per substep. + real(r8), protected :: carma_tstick = 1.0_r8 ! Thermal accommodation coefficient + real(r8), protected :: carma_gsticki = 0.93_r8 ! Growth accommodation coefficient for ice + real(r8), protected :: carma_gstickl = 1.0_r8 ! Growth accommodation coefficient for liquid + real(r8), protected :: carma_cstick = 1.0_r8 ! Coagulation accommodation coefficient + real(r8), protected :: carma_rhcrit = 1.0_r8 ! Critical relative humidity for liquid clouds + real(r8), protected :: carma_vf_const = 0.0_r8 ! If specified and non-zero, constant fall velocity for all particles [cm/s] + character(len=32), protected :: carma_model = "none" ! String (no spaces) that identifies the model + character(len=10), protected :: carma_sulfnuc_method = "none" ! Sulfate Nucleation method + character(len=32), protected :: carma_diags_packages(carma_maxdiags) = " " ! Names of physics packages for which diagnostic output is desired + character(len=12), protected :: carma_debug_packages(carma_maxdiags) = " " ! Names of physics packages for which debug output is desired + contains @@ -68,30 +81,31 @@ module carma_flags_mod !! @author Chuck Bardeen !! @version Aug-2010 subroutine carma_readnl(nlfile) - + ! Read carma namelist group. - + use cam_abortutils, only: endrun use namelist_utils, only: find_group_name - use units, only: getunit, freeunit - use mpishorthand + use spmd_utils, only: mpicom, masterprocid, mpi_real8, mpi_integer, mpi_logical, mpi_character use carma_model_flags_mod, only: carma_model_readnl - + ! args - + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input - + ! local vars - - integer :: unitn, ierr - + + integer :: unitn, ierr, i + ! read namelist for CARMA namelist /carma_nl/ & carma_flag, & carma_do_aerosol, & + carma_do_coremasscheck, & carma_do_cldliq, & carma_do_cldice, & carma_do_clearsky, & + carma_do_cloudborne, & carma_do_coag, & carma_do_detrain, & carma_do_drydep, & @@ -101,6 +115,8 @@ subroutine carma_readnl(nlfile) carma_rad_feedback, & carma_do_explised, & carma_do_incloud, & + carma_do_budget_diags, & + carma_do_package_diags, & carma_do_grow, & carma_do_optics, & carma_do_partialinit, & @@ -115,7 +131,6 @@ subroutine carma_readnl(nlfile) carma_minsubsteps, & carma_maxretries, & carma_model, & - carma_reftfile, & carma_conmax, & carma_dgc_threshold, & carma_ds_threshold, & @@ -125,11 +140,16 @@ subroutine carma_readnl(nlfile) carma_gstickl, & carma_cstick, & carma_rhcrit, & - carma_vf_const - + carma_vf_const, & + carma_sulfnuc_method, & + carma_do_budget_diags, & + carma_do_package_diags, & + carma_diags_packages, & + carma_debug_packages, & + carma_diags_file + if (masterproc) then - unitn = getunit() - open( unitn, file=trim(nlfile), status='old' ) + open( newunit=unitn, file=trim(nlfile), status='old' ) call find_group_name(unitn, 'carma_nl', status=ierr) if (ierr == 0) then read(unitn, carma_nl, iostat=ierr) @@ -138,54 +158,72 @@ subroutine carma_readnl(nlfile) end if end if close(unitn) - call freeunit(unitn) end if - -#ifdef SPMD - call mpibcast (carma_flag, 1 ,mpilog, 0,mpicom) - call mpibcast (carma_do_aerosol, 1 ,mpilog, 0,mpicom) - call mpibcast (carma_do_cldliq, 1 ,mpilog, 0,mpicom) - call mpibcast (carma_do_cldice, 1 ,mpilog, 0,mpicom) - call mpibcast (carma_do_clearsky, 1 ,mpilog, 0,mpicom) - call mpibcast (carma_do_coag, 1 ,mpilog, 0,mpicom) - call mpibcast (carma_do_detrain, 1 ,mpilog, 0,mpicom) - call mpibcast (carma_do_drydep, 1 ,mpilog, 0,mpicom) - call mpibcast (carma_do_emission, 1 ,mpilog, 0,mpicom) - call mpibcast (carma_do_fixedinit, 1 ,mpilog, 0,mpicom) - call mpibcast (carma_hetchem_feedback,1 ,mpilog, 0,mpicom) - call mpibcast (carma_rad_feedback, 1 ,mpilog, 0,mpicom) - call mpibcast (carma_do_explised, 1 ,mpilog, 0,mpicom) - call mpibcast (carma_do_incloud, 1 ,mpilog, 0,mpicom) - call mpibcast (carma_do_grow, 1 ,mpilog, 0,mpicom) - call mpibcast (carma_do_optics, 1 ,mpilog, 0,mpicom) - call mpibcast (carma_do_partialinit, 1 ,mpilog, 0,mpicom) - call mpibcast (carma_do_pheat, 1 ,mpilog, 0,mpicom) - call mpibcast (carma_do_pheatatm, 1 ,mpilog, 0,mpicom) - call mpibcast (carma_do_substep, 1 ,mpilog, 0,mpicom) - call mpibcast (carma_do_thermo, 1 ,mpilog, 0,mpicom) - call mpibcast (carma_do_wetdep, 1 ,mpilog, 0,mpicom) - call mpibcast (carma_do_vdiff, 1 ,mpilog, 0,mpicom) - call mpibcast (carma_do_vtran, 1 ,mpilog, 0,mpicom) - call mpibcast (carma_maxsubsteps, 1 ,mpiint, 0,mpicom) - call mpibcast (carma_minsubsteps, 1 ,mpiint, 0,mpicom) - call mpibcast (carma_maxretries, 1 ,mpiint, 0,mpicom) - call mpibcast (carma_conmax, 1 ,mpir8, 0,mpicom) - call mpibcast (carma_dgc_threshold, 1 ,mpir8, 0,mpicom) - call mpibcast (carma_ds_threshold, 1 ,mpir8, 0,mpicom) - call mpibcast (carma_dt_threshold, 1 ,mpir8, 0,mpicom) - call mpibcast (carma_tstick, 1 ,mpir8, 0,mpicom) - call mpibcast (carma_gsticki, 1 ,mpir8, 0,mpicom) - call mpibcast (carma_gstickl, 1 ,mpir8, 0,mpicom) - call mpibcast (carma_cstick, 1 ,mpir8, 0,mpicom) - call mpibcast (carma_rhcrit, 1 ,mpir8, 0,mpicom) - call mpibcast (carma_vf_const, 1 ,mpir8, 0,mpicom) - call mpibcast (carma_model, len(carma_model), mpichar, 0, mpicom) - call mpibcast (carma_reftfile, len(carma_reftfile), mpichar, 0, mpicom) -#endif + + call mpi_bcast (carma_flag, 1 ,mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast (carma_do_aerosol, 1 ,mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast (carma_do_coremasscheck,1 ,mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast (carma_do_cldliq, 1 ,mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast (carma_do_cldice, 1 ,mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast (carma_do_clearsky, 1 ,mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast (carma_do_cloudborne, 1 ,mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast (carma_do_coag, 1 ,mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast (carma_do_detrain, 1 ,mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast (carma_do_drydep, 1 ,mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast (carma_do_emission, 1 ,mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast (carma_do_fixedinit, 1 ,mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast (carma_hetchem_feedback,1 ,mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast (carma_rad_feedback, 1 ,mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast (carma_do_explised, 1 ,mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast (carma_do_budget_diags, 1 ,mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast (carma_do_package_diags,1 ,mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast (carma_do_incloud, 1 ,mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast (carma_do_grow, 1 ,mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast (carma_do_optics, 1 ,mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast (carma_do_partialinit, 1 ,mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast (carma_do_pheat, 1 ,mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast (carma_do_pheatatm, 1 ,mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast (carma_do_substep, 1 ,mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast (carma_do_thermo, 1 ,mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast (carma_do_wetdep, 1 ,mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast (carma_do_vdiff, 1 ,mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast (carma_do_vtran, 1 ,mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast (carma_diags_file, 1 ,mpi_integer, masterprocid, mpicom, ierr) + call mpi_bcast (carma_maxsubsteps, 1 ,mpi_integer, masterprocid, mpicom, ierr) + call mpi_bcast (carma_minsubsteps, 1 ,mpi_integer, masterprocid, mpicom, ierr) + call mpi_bcast (carma_maxretries, 1 ,mpi_integer, masterprocid, mpicom, ierr) + call mpi_bcast (carma_conmax, 1 ,mpi_real8, masterprocid, mpicom, ierr) + call mpi_bcast (carma_dgc_threshold, 1 ,mpi_real8, masterprocid, mpicom, ierr) + call mpi_bcast (carma_ds_threshold, 1 ,mpi_real8, masterprocid, mpicom, ierr) + call mpi_bcast (carma_dt_threshold, 1 ,mpi_real8, masterprocid, mpicom, ierr) + call mpi_bcast (carma_tstick, 1 ,mpi_real8, masterprocid, mpicom, ierr) + call mpi_bcast (carma_gsticki, 1 ,mpi_real8, masterprocid, mpicom, ierr) + call mpi_bcast (carma_gstickl, 1 ,mpi_real8, masterprocid, mpicom, ierr) + call mpi_bcast (carma_cstick, 1 ,mpi_real8, masterprocid, mpicom, ierr) + call mpi_bcast (carma_rhcrit, 1 ,mpi_real8, masterprocid, mpicom, ierr) + call mpi_bcast (carma_vf_const, 1 ,mpi_real8, masterprocid, mpicom, ierr) + call mpi_bcast (carma_model, len(carma_model), mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast (carma_sulfnuc_method, len(carma_sulfnuc_method), mpi_character, masterprocid, mpicom, ierr) + call mpibcast (carma_diags_packages, len(carma_diags_packages(1))*carma_maxdiags, mpi_character, 0, mpicom) + call mpibcast (carma_debug_packages, len(carma_debug_packages(1))*carma_maxdiags, mpi_character, 0, mpicom) + + carma_ndiagpkgs = 0 + do i = 1, carma_maxdiags + if (len_trim(carma_diags_packages(i)) > 0) then + carma_ndiagpkgs = carma_ndiagpkgs + 1 + endif + enddo + + carma_ndebugpkgs = 0 + do i = 1, carma_maxdiags + if (len_trim(carma_debug_packages(i)) > 0) then + carma_ndebugpkgs = carma_ndebugpkgs + 1 + endif + enddo ! Also cause the CARMA model flags to be read in. call carma_model_readnl(nlfile) - + end subroutine carma_readnl end module carma_flags_mod diff --git a/src/physics/cam/carma_intr.F90 b/src/physics/cam/carma_intr.F90 index fc09de5246..b2f8872336 100644 --- a/src/physics/cam/carma_intr.F90 +++ b/src/physics/cam/carma_intr.F90 @@ -22,12 +22,12 @@ module carma_intr implicit none - + private save ! Public interfaces - + ! CAM Physics Interface public carma_register ! register consituents public carma_is_active ! retrns true if this package is active (microphysics = .true.) @@ -38,11 +38,39 @@ module carma_intr public carma_timestep_init ! initialize timestep dependent variables public carma_timestep_tend ! interface to tendency computation public carma_accumulate_stats ! collect stats from all MPI tasks - + ! Other Microphysics public carma_emission_tend ! calculate tendency from emission source function + public carma_calculate_cloudborne_diagnostics ! calculate model specific budget diagnostics for cloudborne aerosols + public carma_output_cloudborne_diagnostics ! output model specific budget diagnostics for cloudborne aerosols + public carma_output_budget_diagnostics ! calculate and output model specific aerosol budget terms public carma_wetdep_tend ! calculate tendency from wet deposition - + public :: carma_restart_init + public :: carma_restart_write + public :: carma_restart_read + + + public carma_get_bin + public carma_get_bin_cld + public carma_get_dry_radius + public carma_get_elem_for_group + public carma_get_group_by_name + public carma_get_kappa + public carma_get_number + public carma_get_number_cld + public carma_get_total_mmr + public carma_get_total_mmr_cld + public carma_get_wet_radius + public carma_get_bin_rmass + public carma_set_bin + public carma_get_sad + public :: carma_get_wght_pct + public :: carma_effecitive_radius + + public :: carma_get_bin_radius + + integer, parameter, public :: MAXCLDAERDIAG = 16 + contains @@ -55,40 +83,41 @@ end subroutine carma_register function carma_is_active() implicit none - + logical :: carma_is_active - + carma_is_active = .false. - + return end function carma_is_active function carma_implements_cnst(name) implicit none - + character(len=*), intent(in) :: name !! constituent name logical :: carma_implements_cnst ! return value carma_implements_cnst = .false. - + return end function carma_implements_cnst - - subroutine carma_init + + subroutine carma_init(pbuf2d) implicit none - + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + return end subroutine carma_init subroutine carma_final implicit none - + return end subroutine carma_final - + subroutine carma_timestep_init implicit none @@ -103,7 +132,7 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli use time_manager, only: get_nstep, get_step_size, is_first_step use camsrfexch, only: cam_in_t, cam_out_t use scamMod, only: single_column - + implicit none type(physics_state), intent(inout) :: state !! physics state variables @@ -114,13 +143,13 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer real(r8), intent(in), optional :: dlf(pcols,pver) !! Detraining cld H20 from convection (kg/kg/s) real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(out), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(out), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(out), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) real(r8), intent(out), optional :: prec_sed(pcols) !! total precip from cloud sedimentation (m/s) real(r8), intent(out), optional :: snow_sed(pcols) !! snow from cloud ice sedimentation (m/s) real(r8), intent(in), optional :: ustar(pcols) !! friction velocity (m/s) real(r8), intent(in), optional :: obklen(pcols) !! Obukhov length [ m ] - + call physics_ptend_init(ptend,state%psetcols,'none') !Initialize an empty ptend for use with physics_update if (present(prec_str)) prec_str(:) = 0._r8 @@ -140,27 +169,70 @@ subroutine carma_init_cnst(name, latvals, lonvals, mask, q) real(r8), intent(in) :: lonvals(:) !! lon in degrees (ncol) logical, intent(in) :: mask(:) !! Only initialize where .true. real(r8), intent(out) :: q(:,:) !! mass mixing ratio - + if (name == "carma") then q = 0._r8 - end if - + end if + return end subroutine carma_init_cnst - subroutine carma_emission_tend(state, ptend, cam_in, dt) + subroutine carma_calculate_cloudborne_diagnostics(state, pbuf, aerclddiag) + + implicit none + + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + real(r8), intent(out) :: aerclddiag(pcols, MAXCLDAERDIAG) !! previous cloudborne diagnostics + + return + end subroutine carma_calculate_cloudborne_diagnostics + + + subroutine carma_output_cloudborne_diagnostics(state, pbuf, pname, dt, oldaerclddiag) + + implicit none + + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + character(*), intent(in) :: pname !! short name of the physics package + real(r8), intent(in) :: dt !! timestep (s) + real(r8), intent(in) :: oldaerclddiag(pcols, MAXCLDAERDIAG) !! previous cloudborne diagnostics + + return + end subroutine carma_output_cloudborne_diagnostics + + + subroutine carma_output_budget_diagnostics(state, ptend, old_cflux, cflux, dt, pname) + + implicit none + + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + real(r8) :: old_cflux(pcols,pcnst) !! cam_in%clfux from before the timestep_tend + real(r8) :: cflux(pcols,pcnst) !! cam_in%clfux from after the timestep_tend + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + + + return + end subroutine carma_output_budget_diagnostics + + + subroutine carma_emission_tend(state, ptend, cam_in, dt, pbuf) use camsrfexch, only: cam_in_t implicit none - + type(physics_state), intent(in ) :: state !! physics state type(physics_ptend), intent(inout) :: ptend !! physics state tendencies type(cam_in_t), intent(inout) :: cam_in !! surface inputs real(r8), intent(in) :: dt !! time step (s) + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer return - end subroutine carma_emission_tend + end subroutine carma_emission_tend subroutine carma_wetdep_tend(state, ptend, dt, pbuf, dlf, cam_out) @@ -183,4 +255,198 @@ subroutine carma_accumulate_stats() implicit none end subroutine carma_accumulate_stats + + !--------------------------------------------------------------------------- + ! define fields for reference profiles in cam restart file + !--------------------------------------------------------------------------- + subroutine CARMA_restart_init( File ) + use pio, only: file_desc_t + + ! arguments + type(file_desc_t),intent(inout) :: File ! pio File pointer + + end subroutine CARMA_restart_init + + !--------------------------------------------------------------------------- + ! write reference profiles to restart file + !--------------------------------------------------------------------------- + subroutine CARMA_restart_write(File) + use pio, only: file_desc_t + + ! arguments + type(file_desc_t), intent(inout) :: File + + end subroutine CARMA_restart_write + + !--------------------------------------------------------------------------- + ! read reference profiles from restart file + !--------------------------------------------------------------------------- + subroutine CARMA_restart_read(File) + use pio, only: file_desc_t + + ! arguments + type(file_desc_t),intent(inout) :: File ! pio File pointer + + end subroutine CARMA_restart_read + + + !! Get the mixing ratio for the specified element and bin. + subroutine carma_get_bin(state, ielem, ibin, mmr, rc) + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + real(r8), intent(out) :: mmr(pcols,pver) !! mass mixing ratio (kg/kg) + integer, intent(out) :: rc !! return code + + end subroutine carma_get_bin + !! Get the mixing ratio for the specified element and bin. + subroutine carma_get_bin_cld(pbuf, ielem, ibin, ncol, nlev, mmr, rc) + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + integer, intent(in) :: ncol,nlev !! dimensions + real(r8), intent(out) :: mmr(:,:) !! mass mixing ratio (kg/kg) + integer, intent(out) :: rc !! return code + + end subroutine carma_get_bin_cld + !! Determine the dry radius and dry density for the particular bin. + subroutine carma_get_dry_radius(state, igroup, ibin, rdry, rhopdry, rc) + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(in) :: igroup !! group index + integer, intent(in) :: ibin !! bin index + real(r8), intent(out) :: rdry(:,:) !! dry radius (m) + real(r8), intent(out) :: rhopdry(:,:) !! dry density (kg/m3) + integer, intent(out) :: rc !! return code + + end subroutine carma_get_dry_radius + !! Get the number of elements and list of element ids for a group. This includes + subroutine carma_get_elem_for_group(igroup, nelems, ielems, rc) + integer, intent(in) :: igroup !! group index + integer, intent(out) :: nelems !! number of elements in group + integer, intent(out) :: ielems(:) !! indexes of elements in group + integer, intent(out) :: rc !! return code + end subroutine carma_get_elem_for_group + !! Get the CARMA group id a group name. + subroutine carma_get_group_by_name(shortname, igroup, rc) + character(len=*), intent(in) :: shortname !! the group short name + integer, intent(out) :: igroup !! group index + integer, intent(out) :: rc !! return code + + end subroutine carma_get_group_by_name + !! Get the CARMA group id and bin id from a compound name xxxxxxnn, where xxxxxx is the + subroutine carma_get_group_and_bin_by_name(shortname, igroup, ibin, rc) + character(len=*), intent(out) :: shortname !! the group short name + integer, intent(out) :: igroup !! group index + integer, intent(out) :: ibin !! bin index + integer, intent(out) :: rc !! return code + + end subroutine carma_get_group_and_bin_by_name + !! Determine a mass weighted kappa for the entire particle. + subroutine carma_get_kappa(state, igroup, ibin, kappa, rc) + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(in) :: igroup !! group index + integer, intent(in) :: ibin !! bin index + real(r8), intent(out) :: kappa(:,:) !! kappa value for the entire particle + integer, intent(out) :: rc !! return code + end subroutine carma_get_kappa + !! Get the number mixing ratio for the group. This is the number of particles per + subroutine carma_get_number(state, igroup, ibin, nmr, rc) + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(in) :: igroup !! group index + integer, intent(in) :: ibin !! bin index + real(r8), intent(out) :: nmr(pcols,pver) !! number mixing ratio (#/kg) + integer, intent(out) :: rc !! return code + end subroutine carma_get_number + + subroutine carma_get_number_cld(pbuf, igroup, ibin, ncol, nlev, nmr, rc) + type(physics_buffer_desc),pointer :: pbuf(:) !! physics buffer + integer, intent(in) :: igroup !! group index + integer, intent(in) :: ibin !! bin index + integer, intent(in) :: ncol,nlev !! dimensions + real(r8), intent(out) :: nmr(pcols,pver) !! number mixing ratio (#/kg) + integer, intent(out) :: rc !! return code + end subroutine carma_get_number_cld + !! Get the mixing ratio for the group. This is the total of all the elements that + subroutine carma_get_total_mmr(state, igroup, ibin, totmmr, rc) + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(in) :: igroup !! group index + integer, intent(in) :: ibin !! bin index + real(r8), intent(out) :: totmmr(pcols,pver) !! total mmr (kg/kg) + integer, intent(out) :: rc !! return code + end subroutine carma_get_total_mmr + + subroutine carma_get_total_mmr_cld(pbuf, igroup, ibin, ncol, nlev, totmmr, rc) + type(physics_buffer_desc),pointer :: pbuf(:) !! physics buffer + integer, intent(in) :: igroup !! group index + integer, intent(in) :: ibin !! bin index + integer, intent(in) :: ncol,nlev !! dimensions + real(r8), intent(out) :: totmmr(pcols,pver) !! total mmr (kg/kg) + integer, intent(out) :: rc !! return code + + end subroutine carma_get_total_mmr_cld + + subroutine carma_get_sad(state, igroup, ibin, sad, rc) + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(in) :: igroup !! group index + integer, intent(in) :: ibin !! bin index + real(r8), intent(out) :: sad(pcols,pver) !! surface area dens (cm2/cm3) + integer, intent(out) :: rc !! return code + end subroutine carma_get_sad + + !! Find the wet radius and wet density for the group and bin specified. + subroutine carma_get_wet_radius(state, igroup, ibin, rwet, rhopwet, rc) + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(in) :: igroup !! group index + integer, intent(in) :: ibin !! bin index + real(r8), intent(out) :: rwet(pcols,pver) !! wet radius (m) + real(r8), intent(out) :: rhopwet(pcols,pver) !! wet density (kg/m3) + integer, intent(inout) :: rc !! return code + + end subroutine carma_get_wet_radius + !! Provides the tendency (in kg/kg/s) required to change the element and bin from + !! the current state to the desired mmr. + subroutine carma_set_bin(state, ielem, ibin, mmr, dt, ptend, rc) + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + real(r8), intent(in) :: mmr(pcols,pver) !! mass mixing ratio (kg/kg) + integer :: dt !! timestep size (sec) + type(physics_ptend), intent(inout) :: ptend !! constituent tendencies + integer, intent(out) :: rc !! return code + end subroutine carma_set_bin + + subroutine carma_get_bin_rmass(igroup, ibin, mass, rc) + + integer, intent(in) :: igroup !! group index + integer, intent(in) :: ibin !! bin index + real(r8),intent(out) :: mass ! grams ??? + integer, intent(out) :: rc !! return code + + end subroutine carma_get_bin_rmass + + function carma_get_wght_pct(icol,ilev,state) result(wtpct) + + integer, intent(in) :: icol,ilev + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + + real(r8) :: wtpct + + end function carma_get_wght_pct + + + function carma_effecitive_radius(state) result(rad) + + type(physics_state), intent(in) :: state !! physics state variables + real(r8) :: rad(pcols,pver) ! effective radius (cm) + end function carma_effecitive_radius + + !----------------------------------------------------------------------------- + !----------------------------------------------------------------------------- + subroutine carma_get_bin_radius(igroup, ibin, radius, rc) + integer, intent(in) :: igroup !! group index + integer, intent(in) :: ibin !! bin index + real(r8),intent(out) :: radius ! cm ??? + integer, intent(out) :: rc !! return code + end subroutine carma_get_bin_radius + end module carma_intr diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index 9bbf211fba..2fdbe9d827 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -13,7 +13,7 @@ module clubb_intr ! ! !---------------------------Code history-------------------------------------------------------------- ! ! Authors: P. Bogenschutz, C. Craig, A. Gettelman ! - ! Modified by: K Thayer-Calder ! + ! Modified by: K Thayer-Calder ! ! ! !----------------------------------------------------------------------------------------------------- ! @@ -25,13 +25,13 @@ module clubb_intr use cam_history_support, only: max_fieldname_len use spmd_utils, only: masterproc - use constituents, only: pcnst, cnst_add + use constituents, only: pcnst, cnst_add, cnst_ndropmixed use pbl_utils, only: calc_ustar, calc_obklen use ref_pres, only: top_lev => trop_cloud_top_lev #ifdef CLUBB_SGS use clubb_api_module, only: pdf_parameter, implicit_coefs_terms - use clubb_api_module, only: clubb_config_flags_type, grid, stats, & + use clubb_api_module, only: clubb_config_flags_type, grid, stats, & nu_vertical_res_dep, stats_metadata_type, & hm_metadata_type, sclr_idx_type @@ -52,7 +52,7 @@ module clubb_intr stats_sfc(pcols) ! stats_sfc type (hm_metadata_type) :: & hm_metadata - + type (stats_metadata_type) :: & stats_metadata @@ -95,7 +95,7 @@ module clubb_intr ! These are zero by default, but will be set by SILHS before they are used by subcolumns integer :: & - hydromet_dim = 0, & + hydromet_dim = 0, & pdf_dim = 0 @@ -117,7 +117,7 @@ module clubb_intr hm_metadata #endif #endif - + ! ------------ ! ! Private data ! ! ------------ ! @@ -340,7 +340,7 @@ module clubb_intr clubb_l_mono_flux_lim_um, & ! Flag to turn on monotonic flux limiter for um clubb_l_mono_flux_lim_vm, & ! Flag to turn on monotonic flux limiter for vm clubb_l_mono_flux_lim_spikefix, & ! Flag to implement monotonic flux limiter code that - ! eliminates spurious drying tendencies at model top + ! eliminates spurious drying tendencies at model top clubb_l_host_applies_sfc_fluxes ! Whether the host model applies the surface fluxes logical :: & @@ -349,12 +349,11 @@ module clubb_intr ! Constant parameters logical, parameter, private :: & l_implemented = .true. ! Implemented in a host model (always true) - + logical, parameter, private :: & apply_to_heat = .false. ! Apply WACCM energy fixer to heat or not (.true. = yes (duh)) logical :: lq(pcnst) - logical :: prog_modal_aero logical :: do_rainturb logical :: clubb_do_adv logical :: clubb_do_liqsupersat = .false. @@ -1525,8 +1524,7 @@ subroutine clubb_ini_cam(pbuf2d) ! off of pcnst (the total consituents) ! ----------------------------------------------------------------- ! - call phys_getopts(prog_modal_aero_out=prog_modal_aero, & - history_amwg_out=history_amwg, & + call phys_getopts(history_amwg_out=history_amwg, & history_clubb_out=history_clubb, & do_hb_above_clubb_out=do_hb_above_clubb) @@ -1542,29 +1540,15 @@ subroutine clubb_ini_cam(pbuf2d) call cnst_get_ind('CLDLIQ',ixcldliq) call cnst_get_ind('CLDICE',ixcldice) - if (prog_modal_aero) then - ! Turn off modal aerosols and decrement edsclr_dim accordingly - call rad_cnst_get_info(0, nmodes=nmodes) - - do m = 1, nmodes - call rad_cnst_get_mode_num_idx(m, lptr) - lq(lptr)=.false. + do m = 1, pcnst + if (cnst_ndropmixed(m)) then + lq(m)=.false. + ! Droplet number is transported in dropmixnuc, therefore we + ! do NOT want CLUBB to apply transport tendencies to avoid double + ! counting. Else, we apply tendencies. edsclr_dim = edsclr_dim-1 - - call rad_cnst_get_info(0, m, nspec=nspec) - do l = 1, nspec - call rad_cnst_get_mam_mmr_idx(m, l, lptr) - lq(lptr)=.false. - edsclr_dim = edsclr_dim-1 - end do - end do - - ! In addition, if running with MAM, droplet number is transported - ! in dropmixnuc, therefore we do NOT want CLUBB to apply transport - ! tendencies to avoid double counted. Else, we apply tendencies. - lq(ixnumliq) = .false. - edsclr_dim = edsclr_dim-1 - endif + endif + enddo ! ----------------------------------------------------------------- ! ! Set the debug level. Level 2 has additional computational expense since @@ -1733,7 +1717,7 @@ subroutine clubb_ini_cam(pbuf2d) clubb_params_single_col(iwpxp_Ri_exp) = clubb_wpxp_Ri_exp clubb_params_single_col(iz_displace) = clubb_z_displace - ! Override clubb default + ! Override clubb default if ( trim(subcol_scheme) == 'SILHS' ) then clubb_config_flags%saturation_formula = saturation_flatau else @@ -1742,7 +1726,7 @@ subroutine clubb_ini_cam(pbuf2d) ! Define model constant parameters call setup_parameters_model_api( theta0, ts_nudge, clubb_params_single_col(iSkw_max_mag) ) - + ! Set up CLUBB core. Note that some of these inputs are overwritten ! when clubb_tend_cam is called. The reason is that heights can change ! at each time step, which is why dummy arrays are read in here for heights @@ -1885,7 +1869,7 @@ subroutine clubb_ini_cam(pbuf2d) dum3 = 300._r8 if (stats_metadata%l_stats) then - + call stats_init_clubb( .true., dum1, dum2, & nlev+1, nlev+1, nlev+1, dum3, & stats_zt(:), stats_zm(:), stats_sfc(:), & @@ -2591,7 +2575,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & real(r8), dimension(state%ncol,nparams) :: & clubb_params ! Adjustable CLUBB parameters (C1, C2 ...) - + #endif det_s(:) = 0.0_r8 det_ice(:) = 0.0_r8 @@ -4833,7 +4817,7 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & ! Set stats_variables variables with inputs from calling subroutine stats_metadata%l_stats = l_stats_in - + stats_metadata%stats_tsamp = stats_tsamp_in stats_metadata%stats_tout = stats_tout_in diff --git a/src/physics/cam/constituents.F90 b/src/physics/cam/constituents.F90 index b93cf060b3..41e06669d0 100644 --- a/src/physics/cam/constituents.F90 +++ b/src/physics/cam/constituents.F90 @@ -54,6 +54,7 @@ module constituents real(r8), public :: cnst_mw (pcnst) ! molecular weight (kg/kmole) character*3, public, protected :: cnst_type(pcnst)! wet or dry mixing ratio character*5, public :: cnst_molec(pcnst) ! major or minor species molecular diffusion +logical, public, protected :: cnst_ndropmixed(pcnst) = .false. ! vertically mixed by ndrop activation process real(r8), public :: cnst_rgas(pcnst) ! gas constant () real(r8), public :: qmin (pcnst) ! minimum permitted constituent concentration (kg/kg) real(r8), public :: qmincg (pcnst) ! for backward compatibility only @@ -131,7 +132,7 @@ end subroutine cnst_readnl subroutine cnst_add (name, mwc, cpc, qminc, & - ind, longname, readiv, mixtype, molectype, cam_outfld, & + ind, longname, readiv, mixtype, molectype, ndropmixed, cam_outfld, & fixed_ubc, fixed_ubflx, is_convtran1, is_convtran2, cnst_spec_class) ! Register a constituent. @@ -151,7 +152,9 @@ subroutine cnst_add (name, mwc, cpc, qminc, & character(len=*), intent(in), optional :: & mixtype ! mixing ratio type (dry, wet) character(len=*), intent(in), optional :: & - molectype ! molecular diffusion type (minor, major) + molectype ! molecular diffusion type (minor, major) + logical, intent(in), optional :: & + ndropmixed ! vertically mixed by ndrop activation process logical, intent(in), optional :: & cam_outfld ! true => default CAM output of constituent in kg/kg logical, intent(in), optional :: & @@ -206,6 +209,13 @@ subroutine cnst_add (name, mwc, cpc, qminc, & cnst_molec(ind) = 'minor' end if + ! vertically mixed by ndrop activation process + if (present(ndropmixed)) then + cnst_ndropmixed(ind) = ndropmixed + else + cnst_ndropmixed(ind) = .false. + end if + ! set outfld type ! (false: the module declaring the constituent is responsible for outfld calls) if (present(cam_outfld)) then diff --git a/src/physics/cam/micro_pumas_cam.F90 b/src/physics/cam/micro_pumas_cam.F90 index a0c66eb7f1..406be8f667 100644 --- a/src/physics/cam/micro_pumas_cam.F90 +++ b/src/physics/cam/micro_pumas_cam.F90 @@ -16,7 +16,7 @@ module micro_pumas_cam use time_manager, only: get_curr_date, get_curr_calday use phys_grid, only: get_rlat_all_p, get_rlon_all_p use orbit, only: zenith - + use physics_types, only: physics_state, physics_ptend, & physics_ptend_init, physics_state_copy, & physics_update, physics_state_dealloc, & @@ -541,12 +541,14 @@ end subroutine micro_pumas_cam_readnl !================================================================================================ subroutine micro_pumas_cam_register + use carma_flags_mod, only: carma_model ! Register microphysics constituents and fields in the physics buffer. !----------------------------------------------------------------------- logical :: prog_modal_aero logical :: use_subcol_microp ! If true, then are using subcolumns in microphysics + logical :: ndropmixed ! If true, then vertically mixed by ndrop routine call phys_getopts(use_subcol_microp_out = use_subcol_microp, & prog_modal_aero_out = prog_modal_aero) @@ -558,7 +560,12 @@ subroutine micro_pumas_cam_register call cnst_add(cnst_names(2), mwh2o, cpair, 0._r8, ixcldice, & longname='Grid box averaged cloud ice amount', is_convtran1=.true.) - call cnst_add(cnst_names(3), mwh2o, cpair, 0._r8, ixnumliq, & + ! Droplet number is transported in dropmixnuc, therefore we + ! do NOT want CLUBB to apply transport tendencies to avoid double + ! counting. + ndropmixed = prog_modal_aero.or.(carma_model(:10)=='trop_strat') + + call cnst_add(cnst_names(3), mwh2o, cpair, 0._r8, ixnumliq, ndropmixed=ndropmixed, & longname='Grid box averaged cloud liquid number', is_convtran1=.true.) call cnst_add(cnst_names(4), mwh2o, cpair, 0._r8, ixnumice, & longname='Grid box averaged cloud ice number', is_convtran1=.true.) @@ -1027,7 +1034,7 @@ subroutine micro_pumas_cam_init(pbuf2d) call addfld ('RBFRAC', horiz_only, 'A', 'Fraction', 'Fraction of sky covered by a potential rainbow' ) call addfld ('RBFREQ', horiz_only, 'A', 'Frequency', 'Potential rainbow frequency' ) call addfld( 'rbSZA', horiz_only, 'I', 'degrees', 'solar zenith angle' ) - + ! History variables for CAM5 microphysics call addfld ('MPDT', (/ 'lev' /), 'A', 'W/kg', 'Heating tendency - Morrison microphysics' ) call addfld ('MPDQ', (/ 'lev' /), 'A', 'kg/kg/s', 'Q tendency - Morrison microphysics' ) @@ -1615,7 +1622,7 @@ subroutine micro_pumas_cam_tend(state, ptend, dtime, pbuf) real(r8), pointer :: cld(:,:) ! Total cloud fraction real(r8), pointer :: concld(:,:) ! Convective cloud fraction real(r8), pointer :: prec_dp(:) ! Deep Convective precip - real(r8), pointer :: prec_sh(:) ! Shallow Convective precip + real(r8), pointer :: prec_sh(:) ! Shallow Convective precip real(r8), pointer :: iciwpst(:,:) ! Stratiform in-cloud ice water path for radiation real(r8), pointer :: iclwpst(:,:) ! Stratiform in-cloud liquid water path for radiation @@ -1875,7 +1882,7 @@ subroutine micro_pumas_cam_tend(state, ptend, dtime, pbuf) real(r8) :: cldtot real(r8) :: rmax logical :: rval - + !------------------------------------------------------------------------------- lchnk = state%lchnk @@ -1935,7 +1942,7 @@ subroutine micro_pumas_cam_tend(state, ptend, dtime, pbuf) else precc(:ncol) = 0._r8 end if - + if (.not. do_cldice) then ! If we are NOT prognosing ice and snow tendencies, then get them from the Pbuf call pbuf_get_field(pbuf, tnd_qsnow_idx, tnd_qsnow, col_type=col_type, copy_if_needed=use_subcol_microp) @@ -2108,10 +2115,10 @@ subroutine micro_pumas_cam_tend(state, ptend, dtime, pbuf) call pbuf_get_field(pbuf, evpsnow_st_idx, evpsnow_st_grid) call pbuf_get_field(pbuf, am_evp_st_idx, am_evp_st_grid) - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- ! ... Calculate cosine of zenith angle ! then cast back to angle (radians) - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- zen_angle(:) = 0.0_r8 rlats(:) = 0.0_r8 rlons(:) = 0.0_r8 @@ -2127,7 +2134,7 @@ subroutine micro_pumas_cam_tend(state, ptend, dtime, pbuf) sza(:) = zen_angle(:) * rad2deg call outfld( 'rbSZA', sza, ncol, lchnk ) - + !------------------------------------------------------------------------------------- ! Microphysics assumes 'liquid stratus frac = ice stratus frac ! = max( liquid stratus frac, ice stratus frac )'. @@ -2226,7 +2233,7 @@ subroutine micro_pumas_cam_tend(state, ptend, dtime, pbuf) ! Zero out diagnostic rainbow arrays rbfreq = 0._r8 - rbfrac = 0._r8 + rbfrac = 0._r8 ! Zero out values above top_lev before passing into _tend for some pbuf variables that are inputs naai(:ncol,:top_lev-1) = 0._r8 @@ -3229,14 +3236,14 @@ subroutine micro_pumas_cam_tend(state, ptend, dtime, pbuf) frlow = 0._r8 cldmx = 0._r8 cldtot = maxval(ast(i,top_lev:)) - + ! Find levels in surface layer do k = top_lev, pver - if (state%pmid(i,k) > rb_pmin) then + if (state%pmid(i,k) > rb_pmin) then top_idx = min(k,top_idx) - end if - end do - + end if + end do + !For all fractional precip calculated below, use maximum in surface layer. !For convective precip, base on convective cloud area convmx = maxval(concld(i,top_idx:)) @@ -3252,27 +3259,27 @@ subroutine micro_pumas_cam_tend(state, ptend, dtime, pbuf) ! (rval = true if any sig precip) rval = ((precc(i) > rb_rcmin) .or. (rmax > rb_rmin)) - + !Now can find conditions for a rainbow: ! Maximum cloud cover (CLDTOT) < 0.5 ! 48 < SZA < 90 ! freqr (below rb_pmin) > 0.25 -! Some rain (liquid > 1.e-6 kg/kg, convective precip > 1.e-7 m/s +! Some rain (liquid > 1.e-6 kg/kg, convective precip > 1.e-7 m/s - if ((cldtot < 0.5_r8) .and. (sza(i) > 48._r8) .and. (sza(i) < 90._r8) .and. rval) then + if ((cldtot < 0.5_r8) .and. (sza(i) > 48._r8) .and. (sza(i) < 90._r8) .and. rval) then -!Rainbow 'probability' (area) derived from solid angle theory +!Rainbow 'probability' (area) derived from solid angle theory !as the fraction of the hemisphere for a spherical cap with angle phi=sza-48. ! This is only valid between 48 < sza < 90 (controlled for above). rbfrac(i) = max(0._r8,(1._r8-COS((sza(i)-48._r8)*deg2rad))/2._r8) * frlow - rbfreq(i) = 1.0_r8 - end if + rbfreq(i) = 1.0_r8 + end if end do ! end column loop for rainbows call outfld('RBFRAC', rbfrac, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - call outfld('RBFREQ', rbfreq, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('RBFREQ', rbfreq, psetcols, lchnk, avg_subcol_field=use_subcol_microp) ! --------------------- ! ! History Output Fields ! diff --git a/src/physics/cam/microp_aero.F90 b/src/physics/cam/microp_aero.F90 index 4961a139a8..deef6c390d 100644 --- a/src/physics/cam/microp_aero.F90 +++ b/src/physics/cam/microp_aero.F90 @@ -50,9 +50,11 @@ module microp_aero use aerosol_properties_mod, only: aerosol_properties use modal_aerosol_properties_mod, only: modal_aerosol_properties +use carma_aerosol_properties_mod, only: carma_aerosol_properties use aerosol_state_mod, only: aerosol_state use modal_aerosol_state_mod, only: modal_aerosol_state +use carma_aerosol_state_mod, only: carma_aerosol_state implicit none private @@ -111,6 +113,9 @@ module microp_aero integer :: idxdst3 = -1 ! index in aerosol list for dust3 integer :: idxdst4 = -1 ! index in aerosol list for dust4 +! carma aerosols +logical :: clim_carma_aero + ! modal aerosols logical :: clim_modal_aero @@ -179,6 +184,7 @@ subroutine microp_aero_init(phys_state,pbuf2d) ! local variables integer :: iaer, ierr integer :: m, n, nmodes, nspec + integer :: nbins character(len=32) :: str32 character(len=*), parameter :: routine = 'microp_aero_init' @@ -212,22 +218,25 @@ subroutine microp_aero_init(phys_state,pbuf2d) ! clim_modal_aero determines whether modal aerosols are used in the climate calculation. ! The modal aerosols can be either prognostic or prescribed. - call rad_cnst_get_info(0, nmodes=nmodes) + call rad_cnst_get_info(0, nmodes=nmodes, nbins=nbins) clim_modal_aero = (nmodes > 0) + clim_carma_aero = (nbins> 0) ast_idx = pbuf_get_index('AST') - if (clim_modal_aero) then - + if (clim_modal_aero .or. clim_carma_aero) then cldo_idx = pbuf_get_index('CLDO') - dgnumwet_idx = pbuf_get_index('DGNUMWET') - - aero_props_obj => modal_aerosol_properties() - if (.not.associated(aero_props_obj)) then - call endrun('ma_convproc_init: construction of modal_aerosol_properties object failed') + if (clim_modal_aero) then + aero_props_obj => modal_aerosol_properties() + else if (clim_carma_aero) then + aero_props_obj => carma_aerosol_properties() end if call ndrop_init(aero_props_obj) - call nucleate_ice_cam_init(mincld, bulk_scale, pbuf2d, aero_props=aero_props_obj) + end if + + if (clim_modal_aero) then + + dgnumwet_idx = pbuf_get_index('DGNUMWET') allocate(aero_state(begchunk:endchunk)) do c = begchunk,endchunk @@ -330,7 +339,6 @@ subroutine microp_aero_init(phys_state,pbuf2d) end do call ndrop_bam_init() - call nucleate_ice_cam_init(mincld, bulk_scale, pbuf2d) end if @@ -343,6 +351,11 @@ subroutine microp_aero_init(phys_state,pbuf2d) call add_default ('WSUB ', 1, ' ') end if + if (associated(aero_props_obj)) then + call nucleate_ice_cam_init(mincld, bulk_scale, pbuf2d, aero_props=aero_props_obj) + else + call nucleate_ice_cam_init(mincld, bulk_scale, pbuf2d) + end if if (use_hetfrz_classnuc) then if (associated(aero_props_obj)) then call hetfrz_classnuc_cam_init(mincld, aero_props_obj) @@ -564,17 +577,28 @@ subroutine microp_aero_run ( & call physics_ptend_init(ptend_all, state%psetcols, 'microp_aero') + ! create the aerosol state object if (clim_modal_aero) then - ! create an aerosol state object specifically for cam state1 aero_state1_obj => modal_aerosol_state( state1, pbuf ) if (.not.associated(aero_state1_obj)) then call endrun('microp_aero_run: construction of aero_state1_obj modal_aerosol_state object failed') end if + else if (clim_carma_aero) then + aero_state1_obj => carma_aerosol_state( state1, pbuf ) + if (.not.associated(aero_state1_obj)) then + call endrun('microp_aero_run: construction of aero_state1_obj carma_aerosol_state object failed') + end if + end if + + if (clim_modal_aero.or.clim_carma_aero) then itim_old = pbuf_old_tim_idx() call pbuf_get_field(pbuf, ast_idx, cldn, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) call pbuf_get_field(pbuf, cldo_idx, cldo, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + end if + + if (clim_modal_aero) then call pbuf_get_field(pbuf, dgnumwet_idx, dgnumwet) end if @@ -703,9 +727,9 @@ subroutine microp_aero_run ( & !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc ! Droplet Activation - if (clim_modal_aero) then + if (clim_modal_aero .or. clim_carma_aero) then - ! for modal aerosol + ! for modal or carma aerosol ! partition cloud fraction into liquid water part lcldn = 0._r8 @@ -859,7 +883,7 @@ subroutine microp_aero_run ( & end if - if (clim_modal_aero) then + if (clim_modal_aero.or.clim_carma_aero) then deallocate(factnum) end if diff --git a/src/physics/cam/ndrop.F90 b/src/physics/cam/ndrop.F90 index 9eea87d218..7b9e4e8d19 100644 --- a/src/physics/cam/ndrop.F90 +++ b/src/physics/cam/ndrop.F90 @@ -105,7 +105,7 @@ subroutine ndrop_init(aero_props) do m = 1, aero_props%nbins() - do l = 0, aero_props%nmasses(m) + do l = 0, aero_props%nspecies(m) mm = aero_props%indexer(m,l) diff --git a/src/physics/cam/ndrop_bam.F90 b/src/physics/cam/ndrop_bam.F90 index 6cd8231356..988b15a8f0 100644 --- a/src/physics/cam/ndrop_bam.F90 +++ b/src/physics/cam/ndrop_bam.F90 @@ -73,10 +73,10 @@ subroutine ndrop_bam_init use phys_control, only: phys_getopts - !----------------------------------------------------------------------- - ! + !----------------------------------------------------------------------- + ! ! Initialize constants for droplet activation by bulk aerosols - ! + ! !----------------------------------------------------------------------- integer :: l, m, iaer @@ -91,6 +91,8 @@ subroutine ndrop_bam_init ! by using routines from the rad_constituents module. call rad_cnst_get_info(0, naero=naer_all) + if (.not. naer_all>0) return + allocate( & aername(naer_all), & dryrad_aer(naer_all), & @@ -172,7 +174,7 @@ subroutine ndrop_bam_init ! Skip aerosols that don't have a dispersion defined. if (dispersion_aer(m) == 0._r8) cycle - + alogsig(m) = log(dispersion_aer(m)) exp45logsig(m) = exp(4.5_r8*alogsig(m)*alogsig(m)) argfactor(m) = 2._r8/(3._r8*sqrt(2._r8)*alogsig(m)) @@ -266,7 +268,11 @@ subroutine ndrop_bam_run( & integer :: m !------------------------------------------------------------------------------- + nact = 0._r8 + + if (.not. naer_all>0) return maxmodes = naer_all + allocate( & volc(maxmodes), & eta(maxmodes), & @@ -280,8 +286,6 @@ subroutine ndrop_bam_run( & call endrun('ndrop_bam_run') endif - nact = 0._r8 - if (nmode .eq. 1 .and. na(1) .lt. 1.e-20_r8) return if (wbar .le. 0._r8) return @@ -316,7 +320,7 @@ subroutine ndrop_bam_run( & smc(m) = smcrit(m) ! only for prescribed size dist if (hygro_aer(m) > 1.e-10_r8) then ! loop only if variable size dist - smc(m) = 2._r8*aten*sqrt(aten/(27._r8*hygro_aer(m)*amcubeloc(m))) + smc(m) = 2._r8*aten*sqrt(aten/(27._r8*hygro_aer(m)*amcubeloc(m))) else smc(m) = 100._r8 endif @@ -388,6 +392,8 @@ subroutine ndrop_bam_ccn(lchnk, ncol, maerosol, naer2) real(r8) :: ccn(pcols,pver,psat) ! number conc of aerosols activated at supersat !------------------------------------------------------------------------------- + if (.not. naer_all>0) return + ccn(:ncol,:,:) = 0._r8 do k = top_lev, pver @@ -397,7 +403,7 @@ subroutine ndrop_bam_ccn(lchnk, ncol, maerosol, naer2) if (m == idxsul) then ! Lohmann treatment for sulfate has variable size distribution do i = 1, ncol - if (naer2(i,k,m) > 0._r8) then + if (naer2(i,k,m) > 0._r8) then amcubesulfate(i) = amcubefactor(m)*maerosol(i,k,m)/(naer2(i,k,m)) smcritsulfate(i) = smcritfactor(m)/sqrt(amcubesulfate(i)) else @@ -489,9 +495,9 @@ subroutine maxsat(zeta, eta, nmode, smc, smax) sum=1.e20_r8 endif enddo - + smax=1._r8/sqrt(sum) - + end subroutine maxsat !=============================================================================== diff --git a/src/physics/cam/nucleate_ice.F90 b/src/physics/cam/nucleate_ice.F90 index ac7268c068..42db39a083 100644 --- a/src/physics/cam/nucleate_ice.F90 +++ b/src/physics/cam/nucleate_ice.F90 @@ -226,9 +226,11 @@ subroutine nucleati( & if ( ((tc.le.0.0_r8).and.(tc.ge.-37.0_r8).and.(qc.lt.1.e-12_r8)).or.(tc.le.-37.0_r8)) then - A = -1.4938_r8 * log(soot_num+dst_num) + 12.884_r8 - B = -10.41_r8 * log(soot_num+dst_num) - 67.69_r8 - regm = A * log(wbar1) + B + if ( (soot_num+dst_num) > 0._r8) then + A = -1.4938_r8 * log(soot_num+dst_num) + 12.884_r8 + B = -10.41_r8 * log(soot_num+dst_num) - 67.69_r8 + regm = A * log(wbar1) + B + end if ! heterogeneous nucleation only if (tc .gt. regm .or. so4_num < 1.0e-10_r8) then @@ -260,8 +262,11 @@ subroutine nucleati( & nihf = 0._r8 n1 = niimm + nidep - osoot_num = soot_num * (niimm + nidep) / (soot_num + dst_num) - odst_num = dst_num * (niimm + nidep) / (soot_num + dst_num) + if ( (soot_num+dst_num) > 0._r8) then + osoot_num = soot_num * (niimm + nidep) / (soot_num + dst_num) + odst_num = dst_num * (niimm + nidep) / (soot_num + dst_num) + end if + endif ! homogeneous nucleation only @@ -322,8 +327,10 @@ subroutine nucleati( & oso4_num = nihf endif - osoot_num = soot_num * (niimm + nidep) / (soot_num + dst_num) - odst_num = dst_num * (niimm + nidep) / (soot_num + dst_num) + if ( (soot_num+dst_num) > 0._r8) then + osoot_num = soot_num * (niimm + nidep) / (soot_num + dst_num) + odst_num = dst_num * (niimm + nidep) / (soot_num + dst_num) + end if nihf = nihf * fhom * ((regm - tc) / 5._r8)**2 oso4_num = oso4_num * fhom * ((regm - tc) / 5._r8)**2 @@ -582,4 +589,3 @@ subroutine frachom(Tmean,RHimean,detaT,fhom) end subroutine frachom end module nucleate_ice - diff --git a/src/physics/cam/nucleate_ice_cam.F90 b/src/physics/cam/nucleate_ice_cam.F90 index 7dff84f529..7d26ca83a5 100644 --- a/src/physics/cam/nucleate_ice_cam.F90 +++ b/src/physics/cam/nucleate_ice_cam.F90 @@ -86,8 +86,8 @@ module nucleate_ice_cam integer :: idxdst4 = -1 ! index in aerosol list for dust4 integer :: idxbcphi = -1 ! index in aerosol list for Soot (BCPHIL) -! modal aerosols -logical :: clim_modal_aero = .false. +! MODAL or CARMA aerosols +logical :: clim_modal_carma = .false. logical :: prog_modal_aero = .false. logical :: lq(pcnst) = .false. ! set flags true for constituents with non-zero tendencies @@ -169,7 +169,7 @@ subroutine nucleate_ice_cam_init(mincld_in, bulk_scale_in, pbuf2d, aero_props) integer :: ierr integer :: ispc, ibin integer :: idxtmp - integer :: nmodes + integer :: nmodes, nbins character(len=*), parameter :: routine = 'nucleate_ice_cam_init' logical :: history_cesm_forcing @@ -179,12 +179,18 @@ subroutine nucleate_ice_cam_init(mincld_in, bulk_scale_in, pbuf2d, aero_props) !-------------------------------------------------------------------------------------------- call phys_getopts(prog_modal_aero_out = prog_modal_aero, history_cesm_forcing_out = history_cesm_forcing) + ! clim_modal_aero determines whether modal or carma aerosols are used in the climate calculation. + ! The modal aerosols can be either prognostic or prescribed. + call rad_cnst_get_info(0, nmodes=nmodes, nbins=nbins) + + clim_modal_carma = (nmodes > 0) .or. (nbins > 0) + mincld = mincld_in bulk_scale = bulk_scale_in lq(:) = .false. - if (prog_modal_aero.and.use_preexisting_ice) then + if (clim_modal_carma.and.use_preexisting_ice) then if (.not. present(aero_props)) then call endrun(routine//' : aero_props must be present') @@ -326,13 +332,7 @@ subroutine nucleate_ice_cam_init(mincld_in, bulk_scale_in, pbuf2d, aero_props) end if end if - ! clim_modal_aero determines whether modal aerosols are used in the climate calculation. - ! The modal aerosols can be either prognostic or prescribed. - call rad_cnst_get_info(0, nmodes=nmodes) - - clim_modal_aero = (nmodes > 0) - - if (.not. clim_modal_aero) then + if (.not. clim_modal_carma) then ! Props needed for BAM number concentration calcs. @@ -471,6 +471,10 @@ subroutine nucleate_ice_cam_calc( & real(r8), parameter :: per_cm3 = 1.e-6_r8 ! factor for m-3 to cm-3 conversions + integer :: nbins, nmaxspc + real(r8), allocatable :: amb_num_bins(:,:,:) + real(r8), allocatable :: size_wght(:,:,:,:) + !------------------------------------------------------------------------------- lchnk = state%lchnk @@ -481,10 +485,19 @@ subroutine nucleate_ice_cam_calc( & qi => state%q(:,:,cldice_idx) ni => state%q(:,:,numice_idx) pmid => state%pmid + nbins = aero_props%nbins() + nmaxspc = maxval(aero_props%nspecies()) + + allocate(size_wght(ncol,pver,nbins,nmaxspc)) + allocate(amb_num_bins(ncol,pver,nbins)) - rho(:ncol,:) = pmid(:ncol,:)/(rair*t(:ncol,:)) + do k = 1, pver + do i = 1, ncol + rho(i,k) = pmid(i,k)/(rair*t(i,k)) + end do + end do - if (clim_modal_aero) then + if (clim_modal_carma) then call physics_ptend_init(ptend, state%psetcols, 'nucleatei', lq=lq) @@ -595,7 +608,7 @@ subroutine nucleate_ice_cam_calc( & sulf_num_tot_col = 0._r8 soot_num_col = 0._r8 - if (clim_modal_aero) then + if (clim_modal_carma) then if (.not.(present(aero_props).and.present(aero_state))) then call endrun('nucleate_ice_cam_calc: aero_props and aero_state must be present') @@ -615,6 +628,21 @@ subroutine nucleate_ice_cam_calc( & soot_num_col(:ncol,:) = naer2(:ncol,:,idxbcphi)/25._r8 * per_cm3 endif + do m = 1, aero_props%nbins() + call aero_state%get_ambient_num(m, amb_num) + amb_num_bins(:ncol,:,m) = amb_num(:ncol,:) + end do + + do m = 1, aero_props%nbins() + do l = 1, aero_props%nspecies(m) + call aero_props%species_type(m, l, spectype) + call aero_state%icenuc_size_wght( m, ncol, pver, spectype, use_preexisting_ice, size_wght(:,:,m,l)) + + !size_wght(:ncol,:,m,l) = wght(:ncol,:) + end do + end do + + kloop: do k = top_lev, pver iloop: do i = 1, ncol @@ -658,7 +686,7 @@ subroutine nucleate_ice_cam_calc( & ! in the next timestep and will supress homogeneous freezing. - if (prog_modal_aero .and. use_preexisting_ice) then + if (clim_modal_carma .and. use_preexisting_ice) then ! compute tendencies for transported aerosol constituents ! and update not-transported constituents @@ -669,10 +697,7 @@ subroutine nucleate_ice_cam_calc( & ! constituents of this bin will need to be updated - call aero_state%get_ambient_num(m, amb_num) - call aero_state%get_cldbrne_num(m, cld_num) - - if (amb_num(i,k)>0._r8) then + if (amb_num_bins(i,k,m)>0._r8) then delmmr_sum = 0._r8 delnum_sum = 0._r8 @@ -681,7 +706,8 @@ subroutine nucleate_ice_cam_calc( & if (aero_props%icenuc_updates_mmr(m,l)) then call aero_props%species_type(m, l, spectype) - call aero_state%icenuc_size_wght( m, i,k, spectype, use_preexisting_ice, wght) + + wght = size_wght(i,k,m,l) if (wght>0._r8) then @@ -752,7 +778,7 @@ subroutine nucleate_ice_cam_calc( & ! particles. It may not represent the proper saturation threshold for ! nucleation, and wsubi from CLUBB is probably not representative of ! wave driven varaibility in the polar stratosphere. - if (nucleate_ice_use_troplev .and. clim_modal_aero) then + if (nucleate_ice_use_troplev .and. clim_modal_carma) then if ((k < troplev(i)) .and. (nucleate_ice_strat > 0._r8) .and. (oso4_num > 0._r8)) then dso4_num = max(0._r8, (nucleate_ice_strat*so4_num_st_cr_tot - oso4_num) * 1e6_r8 / rho(i,k)) naai(i,k) = naai(i,k) + dso4_num @@ -854,7 +880,7 @@ subroutine nucleate_ice_cam_calc( & end do iloop end do kloop - if (.not. clim_modal_aero) then + if (.not. clim_modal_carma) then deallocate( & naer2, & maerosol) @@ -900,6 +926,9 @@ subroutine nucleate_ice_cam_calc( & call outfld('INFreIN ',INFreIN, pcols,lchnk) end if + deallocate(size_wght) + deallocate(amb_num_bins) + end subroutine nucleate_ice_cam_calc !================================================================================================ diff --git a/src/physics/cam/phys_control.F90 b/src/physics/cam/phys_control.F90 index 7105f2d6cd..d911caa1e0 100644 --- a/src/physics/cam/phys_control.F90 +++ b/src/physics/cam/phys_control.F90 @@ -65,6 +65,7 @@ module phys_control logical :: history_waccmx = .false. ! output variables of interest for WACCM-X runs logical :: history_chemistry = .true. ! output default chemistry-related variables logical :: history_carma = .false. ! output default CARMA-related variables +logical :: history_carma_srf_flx= .false. ! output default CARMA-related variables logical :: history_clubb = .true. ! output default CLUBB-related variables logical :: history_cesm_forcing = .false. logical :: history_dust = .false. @@ -134,7 +135,8 @@ subroutine phys_ctl_readnl(nlfile) eddy_scheme, microp_scheme, macrop_scheme, radiation_scheme, srf_flux_avg, & use_subcol_microp, atm_dep_flux, history_amwg, history_vdiag, history_aerosol, history_aero_optics, & history_eddy, history_budget, history_budget_histfile_num, history_waccm, & - history_waccmx, history_chemistry, history_carma, history_clubb, history_dust, & + history_waccmx, history_chemistry, history_carma, history_carma_srf_flx, & + history_clubb, history_dust, & history_cesm_forcing, history_scwaccm_forcing, history_chemspecies_srf, & do_clubb_sgs, state_debug_checks, use_hetfrz_classnuc, use_gw_oro, use_gw_front, & use_gw_front_igw, use_gw_convect_dp, use_gw_convect_sh, use_gw_movmtn_pbl, cld_macmic_num_steps, & @@ -181,6 +183,7 @@ subroutine phys_ctl_readnl(nlfile) call mpi_bcast(history_waccmx, 1, mpi_logical, masterprocid, mpicom, ierr) call mpi_bcast(history_chemistry, 1, mpi_logical, masterprocid, mpicom, ierr) call mpi_bcast(history_carma, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(history_carma_srf_flx, 1, mpi_logical, masterprocid, mpicom, ierr) call mpi_bcast(history_clubb, 1, mpi_logical, masterprocid, mpicom, ierr) call mpi_bcast(history_cesm_forcing, 1, mpi_logical, masterprocid, mpicom, ierr) call mpi_bcast(history_chemspecies_srf, 1, mpi_logical, masterprocid, mpicom, ierr) @@ -321,7 +324,7 @@ subroutine phys_getopts(deep_scheme_out, shallow_scheme_out, eddy_scheme_out, mi history_amwg_out, history_vdiag_out, history_aerosol_out, history_aero_optics_out, history_eddy_out, & history_budget_out, history_budget_histfile_num_out, & history_waccm_out, history_waccmx_out, history_chemistry_out, & - history_carma_out, history_clubb_out, history_dust_out, & + history_carma_out, history_carma_srf_flx_out, history_clubb_out, history_dust_out, & history_cesm_forcing_out, history_scwaccm_forcing_out, history_chemspecies_srf_out, & cam_chempkg_out, prog_modal_aero_out, macrop_scheme_out, & do_clubb_sgs_out, use_spcam_out, state_debug_checks_out, cld_macmic_num_steps_out, & @@ -357,6 +360,7 @@ subroutine phys_getopts(deep_scheme_out, shallow_scheme_out, eddy_scheme_out, mi logical, intent(out), optional :: history_waccmx_out logical, intent(out), optional :: history_chemistry_out logical, intent(out), optional :: history_carma_out + logical, intent(out), optional :: history_carma_srf_flx_out logical, intent(out), optional :: history_clubb_out logical, intent(out), optional :: history_cesm_forcing_out logical, intent(out), optional :: history_chemspecies_srf_out @@ -400,6 +404,7 @@ subroutine phys_getopts(deep_scheme_out, shallow_scheme_out, eddy_scheme_out, mi if ( present(history_chemspecies_srf_out) ) history_chemspecies_srf_out = history_chemspecies_srf if ( present(history_scwaccm_forcing_out) ) history_scwaccm_forcing_out = history_scwaccm_forcing if ( present(history_carma_out ) ) history_carma_out = history_carma + if ( present(history_carma_srf_flx_out) ) history_carma_srf_flx_out= history_carma_srf_flx if ( present(history_clubb_out ) ) history_clubb_out = history_clubb if ( present(history_dust_out ) ) history_dust_out = history_dust if ( present(do_clubb_sgs_out ) ) do_clubb_sgs_out = do_clubb_sgs diff --git a/src/physics/cam/phys_prop.F90 b/src/physics/cam/phys_prop.F90 index 6c504e8c78..defe78b32b 100644 --- a/src/physics/cam/phys_prop.F90 +++ b/src/physics/cam/phys_prop.F90 @@ -6,7 +6,7 @@ module phys_prop ! This module is a utility used by the rad_constituents module. The properties stored ! here are meant to be accessed via that module. This module knows nothing about how ! this data is associated with the constituents that are radiatively active or those that -! are being used for diagnostic calculations. That is the responsibility of the +! are being used for diagnostic calculations. That is the responsibility of the ! rad_constituents module. use shr_kind_mod, only: r8 => shr_kind_r8 @@ -74,6 +74,33 @@ module phys_prop real(r8), pointer :: refrtablw(:,:) ! table of real refractive indices for aerosols infrared real(r8), pointer :: refitablw(:,:) ! table of imag refractive indices for aerosols infrared + ! for core/shell optics + real(r8), pointer :: extpsw2(:,:) ! specific extinction + real(r8), pointer :: abspsw2(:,:) ! specific absorption + real(r8), pointer :: asmpsw2(:,:) ! asymmetry factor + real(r8), pointer :: absplw2(:,:) ! specific absorption + real(r8), pointer :: corefrac(:) ! table of real refractive indices for aerosols visible + integer :: nfraC ! number of Chebyshev coefficients + + ! for hygroscopic species of pure sulfate + real(r8), pointer :: sw_hygro_ext_wtp(:,:) + real(r8), pointer :: sw_hygro_ssa_wtp(:,:) + real(r8), pointer :: sw_hygro_asm_wtp(:,:) + real(r8), pointer :: lw_hygro_abs_wtp(:,:) + real(r8), pointer :: wgtpct (:) ! weight percent! + integer :: nwtp ! number weight percent + ! for hygroscopic species of externally mixed aerosols + real(r8), pointer :: sw_hygro_coreshell_ext(:,:,:,:,:) + real(r8), pointer :: sw_hygro_coreshell_ssa(:,:,:,:,:) + real(r8), pointer :: sw_hygro_coreshell_asm(:,:,:,:,:) + real(r8), pointer :: lw_hygro_coreshell_abs(:,:,:,:,:) + real(r8), pointer :: bcdust(:) ! table of bc-dust mass ratio + real(r8), pointer :: kap(:) ! table of kappa + real(r8), pointer :: relh(:) ! table of relative humidity + integer :: nbcdust + integer :: nkap + integer :: nrelh + ! microphysics parameters. character(len=32) :: aername ! for output of number concentration real(r8) :: density_aer ! density of aerosol (kg/m3) @@ -105,7 +132,7 @@ module phys_prop ! the properties. Searching the uniquefilenames array provides the index into the physprop ! array. character(len=256), allocatable :: uniquefilenames(:) - + ! Number of evenly spaced intervals in rh used in this module and in the aer_rad_props module ! for calculations of aerosol hygroscopic growth. integer, parameter, public :: nrh = 1000 @@ -135,7 +162,7 @@ subroutine physprop_accum_unique_files(radname, type) do i = 1, ncnst ! check if radname is either a bulk aerosol or a mode - if (type(i) == 'A' .or. type(i) == 'M') then + if (type(i) == 'A' .or. type(i) == 'M' .or. type(i) == 'B') then ! check if this filename has been used by another aerosol. If not ! then add it to the list of unique names. @@ -194,7 +221,7 @@ subroutine physprop_init() character(len=256) :: locfn ! path to actual file used character(len=32) :: aername_str ! string read from netCDF file -- may contain trailing ! nulls which aren't dealt with by trim() - + integer :: ierr ! error codes from mpi !------------------------------------------------------------------------------------ @@ -207,6 +234,20 @@ subroutine physprop_init() nullify(physprop(fileindex)%sw_hygro_asm) nullify(physprop(fileindex)%lw_hygro_abs) + nullify(physprop(fileindex)%sw_hygro_ext_wtp) + nullify(physprop(fileindex)%sw_hygro_ssa_wtp) + nullify(physprop(fileindex)%sw_hygro_asm_wtp) + nullify(physprop(fileindex)%lw_hygro_abs_wtp) + nullify(physprop(fileindex)%wgtpct) + + nullify(physprop(fileindex)%sw_hygro_coreshell_ext) + nullify(physprop(fileindex)%sw_hygro_coreshell_ssa) + nullify(physprop(fileindex)%sw_hygro_coreshell_asm) + nullify(physprop(fileindex)%lw_hygro_coreshell_abs) + nullify(physprop(fileindex)%bcdust) + nullify(physprop(fileindex)%kap) + nullify(physprop(fileindex)%relh) + nullify(physprop(fileindex)%sw_nonhygro_ext) nullify(physprop(fileindex)%sw_nonhygro_ssa) nullify(physprop(fileindex)%sw_nonhygro_asm) @@ -232,6 +273,12 @@ subroutine physprop_init() nullify(physprop(fileindex)%refrtablw) nullify(physprop(fileindex)%refitablw) + nullify(physprop(fileindex)%extpsw2) + nullify(physprop(fileindex)%abspsw2) + nullify(physprop(fileindex)%asmpsw2) + nullify(physprop(fileindex)%absplw2) + nullify(physprop(fileindex)%corefrac) + call getfil(uniquefilenames(fileindex), locfn, 0) physprop(fileindex)%sourcefile = locfn @@ -270,6 +317,7 @@ end function physprop_get_id subroutine physprop_get(id, sourcefile, opticstype, & sw_hygro_ext, sw_hygro_ssa, sw_hygro_asm, lw_hygro_abs, & + sw_hygro_ext_wtp, sw_hygro_ssa_wtp, sw_hygro_asm_wtp, lw_hygro_abs_wtp, & sw_nonhygro_ext, sw_nonhygro_ssa, sw_nonhygro_asm, & sw_nonhygro_scat, sw_nonhygro_ascat, lw_abs, & refindex_aer_sw, refindex_aer_lw, & @@ -278,7 +326,12 @@ subroutine physprop_get(id, sourcefile, opticstype, & refitabsw, refrtablw, refitablw, & aername, density_aer, hygro_aer, dryrad_aer, dispersion_aer, & num_to_mass_aer, ncoef, prefr, prefi, sigmag, & - dgnum, dgnumlo, dgnumhi, rhcrystal, rhdeliques) + dgnum, dgnumlo, dgnumhi, rhcrystal, rhdeliques, & + extpsw2, abspsw2, asmpsw2, absplw2, corefrac, nfrac, & + wgtpct, bcdust, kap, relh, & + nkap, nwtp, nbcdust, nrelh, & + sw_hygro_coreshell_ext, sw_hygro_coreshell_ssa, & + sw_hygro_coreshell_asm, lw_hygro_coreshell_abs ) ! Return requested properties for specified ID. @@ -287,15 +340,33 @@ subroutine physprop_get(id, sourcefile, opticstype, & character(len=256), optional, intent(out) :: sourcefile ! Absolute pathname of data file. character(len=ot_length), optional, intent(out) :: opticstype real(r8), optional, pointer :: sw_hygro_ext(:,:) - real(r8), optional, pointer :: sw_hygro_ssa(:,:) - real(r8), optional, pointer :: sw_hygro_asm(:,:) - real(r8), optional, pointer :: lw_hygro_abs(:,:) + real(r8), optional, pointer :: sw_hygro_ssa(:,:) + real(r8), optional, pointer :: sw_hygro_asm(:,:) + real(r8), optional, pointer :: lw_hygro_abs(:,:) + real(r8), optional, pointer :: sw_hygro_ext_wtp(:,:) + real(r8), optional, pointer :: sw_hygro_ssa_wtp(:,:) + real(r8), optional, pointer :: sw_hygro_asm_wtp(:,:) + real(r8), optional, pointer :: lw_hygro_abs_wtp(:,:) + real(r8), optional, pointer :: wgtpct(:) + integer, optional, intent(out) :: nwtp + + real(r8), optional, pointer :: sw_hygro_coreshell_ext(:,:,:,:,:) + real(r8), optional, pointer :: sw_hygro_coreshell_ssa(:,:,:,:,:) + real(r8), optional, pointer :: sw_hygro_coreshell_asm(:,:,:,:,:) + real(r8), optional, pointer :: lw_hygro_coreshell_abs(:,:,:,:,:) + real(r8), optional, pointer :: kap(:) + integer, optional, intent(out) :: nkap + real(r8), optional, pointer :: bcdust(:) + integer, optional, intent(out) :: nbcdust + real(r8), optional, pointer :: relh(:) + integer, optional, intent(out) :: nrelh + real(r8), optional, pointer :: sw_nonhygro_ext(:) real(r8), optional, pointer :: sw_nonhygro_ssa(:) real(r8), optional, pointer :: sw_nonhygro_asm(:) real(r8), optional, pointer :: sw_nonhygro_scat(:) real(r8), optional, pointer :: sw_nonhygro_ascat(:) - real(r8), optional, pointer :: lw_abs(:) + real(r8), optional, pointer :: lw_abs(:) complex(r8), optional, pointer :: refindex_aer_sw(:) complex(r8), optional, pointer :: refindex_aer_lw(:) real(r8), optional, pointer :: r_sw_ext(:,:) @@ -311,10 +382,10 @@ subroutine physprop_get(id, sourcefile, opticstype, & real(r8), optional, pointer :: refitabsw(:,:) real(r8), optional, pointer :: refrtablw(:,:) real(r8), optional, pointer :: refitablw(:,:) - character(len=20), optional, intent(out) :: aername - real(r8), optional, intent(out) :: density_aer - real(r8), optional, intent(out) :: hygro_aer - real(r8), optional, intent(out) :: dryrad_aer + character(len=20), optional, intent(out) :: aername + real(r8), optional, intent(out) :: density_aer + real(r8), optional, intent(out) :: hygro_aer + real(r8), optional, intent(out) :: dryrad_aer real(r8), optional, intent(out) :: dispersion_aer real(r8), optional, intent(out) :: num_to_mass_aer integer, optional, intent(out) :: ncoef @@ -326,6 +397,13 @@ subroutine physprop_get(id, sourcefile, opticstype, & real(r8), optional, intent(out) :: dgnumhi real(r8), optional, intent(out) :: rhcrystal real(r8), optional, intent(out) :: rhdeliques +! for core/shell + real(r8), optional, pointer :: extpsw2(:,:) + real(r8), optional, pointer :: abspsw2(:,:) + real(r8), optional, pointer :: asmpsw2(:,:) + real(r8), optional, pointer :: absplw2(:,:) + real(r8), optional, pointer :: corefrac(:) + integer, optional, intent(out) :: nfrac ! Local variables character(len=*), parameter :: subname = 'physprop_get' @@ -342,6 +420,22 @@ subroutine physprop_get(id, sourcefile, opticstype, & if (present(sw_hygro_ssa)) sw_hygro_ssa => physprop(id)%sw_hygro_ssa if (present(sw_hygro_asm)) sw_hygro_asm => physprop(id)%sw_hygro_asm if (present(lw_hygro_abs)) lw_hygro_abs => physprop(id)%lw_hygro_abs + if (present(sw_hygro_ext_wtp)) sw_hygro_ext_wtp => physprop(id)%sw_hygro_ext_wtp + if (present(sw_hygro_ssa_wtp)) sw_hygro_ssa_wtp => physprop(id)%sw_hygro_ssa_wtp + if (present(sw_hygro_asm_wtp)) sw_hygro_asm_wtp => physprop(id)%sw_hygro_asm_wtp + if (present(lw_hygro_abs_wtp)) lw_hygro_abs_wtp => physprop(id)%lw_hygro_abs_wtp + if (present(wgtpct)) wgtpct => physprop(id)%wgtpct + if (present(nwtp)) nwtp = physprop(id)%nwtp + if (present(sw_hygro_coreshell_ext)) sw_hygro_coreshell_ext => physprop(id)%sw_hygro_coreshell_ext + if (present(sw_hygro_coreshell_ssa)) sw_hygro_coreshell_ssa => physprop(id)%sw_hygro_coreshell_ssa + if (present(sw_hygro_coreshell_asm)) sw_hygro_coreshell_asm => physprop(id)%sw_hygro_coreshell_asm + if (present(lw_hygro_coreshell_abs)) lw_hygro_coreshell_abs => physprop(id)%lw_hygro_coreshell_abs + if (present(kap)) kap => physprop(id)%kap + if (present(nkap)) nkap = physprop(id)%nkap + if (present(bcdust)) bcdust => physprop(id)%bcdust + if (present(nbcdust)) nbcdust = physprop(id)%nbcdust + if (present(relh)) relh => physprop(id)%relh + if (present(nrelh)) nrelh = physprop(id)%nrelh if (present(sw_nonhygro_ext)) sw_nonhygro_ext => physprop(id)%sw_nonhygro_ext if (present(sw_nonhygro_ssa)) sw_nonhygro_ssa => physprop(id)%sw_nonhygro_ssa if (present(sw_nonhygro_asm)) sw_nonhygro_asm => physprop(id)%sw_nonhygro_asm @@ -384,6 +478,14 @@ subroutine physprop_get(id, sourcefile, opticstype, & if (present(rhcrystal)) rhcrystal = physprop(id)%rhcrystal if (present(rhdeliques)) rhdeliques = physprop(id)%rhdeliques +! For core/shell bins + if (present(extpsw2)) extpsw2 => physprop(id)%extpsw2 + if (present(abspsw2)) abspsw2 => physprop(id)%abspsw2 + if (present(asmpsw2)) asmpsw2 => physprop(id)%asmpsw2 + if (present(absplw2)) absplw2 => physprop(id)%absplw2 + if (present(corefrac)) corefrac => physprop(id)%corefrac + if (present(nfrac)) nfrac = physprop(id)%nfrac + end subroutine physprop_get !================================================================================================ @@ -392,7 +494,7 @@ end subroutine physprop_get subroutine aerosol_optics_init(phys_prop, nc_id) - ! Determine the opticstype, then call the + ! Determine the opticstype, then call the ! appropriate routine to read the data. type(physprop_type), intent(inout) :: phys_prop ! data after interp onto cam rh mesh @@ -423,21 +525,33 @@ subroutine aerosol_optics_init(phys_prop, nc_id) case ('hygroscopic') call hygroscopic_optics_init(phys_prop, nc_id) + case ('hygroscopic_wtp') + call hygroscopic_wtp_optics_init(phys_prop, nc_id) + + case ('hygroscopic_coreshell') + call hygroscopic_coreshell_optics_init(phys_prop, nc_id) + case ('nonhygro') call nonhygro_optics_init(phys_prop, nc_id) - + case ('insoluble') call insoluble_optics_init(phys_prop, nc_id) - + case ('volcanic_radius','volcanic_radius1','volcanic_radius2','volcanic_radius3') call volcanic_radius_optics_init(phys_prop, nc_id) case ('volcanic') call volcanic_optics_init(phys_prop, nc_id) - + case ('modal') call modal_optics_init(phys_prop, nc_id) - + + case ('sectional') + call bin_optics_init(phys_prop, nc_id) + + case ('sectional_props') + call bindef_optics_init(phys_prop, nc_id) + ! other types of optics can be added here case default @@ -1099,6 +1213,108 @@ end subroutine modal_optics_init !================================================================================================ +subroutine bin_optics_init(props, ncid) + +! Read optics data for modal aerosols + + type (physprop_type), intent(inout) :: props ! storage for file data + type (file_desc_T), intent(inout) :: ncid ! indentifier for netcdf file + + ! Local variables + integer :: ierr + integer :: did + integer :: ival + type(var_desc_t) :: vid + + character(len=*), parameter :: subname = 'bin_optics_init' + !------------------------------------------------------------------------------------ + + ! Check dimensions for number of lw and sw bands + + ierr = pio_inq_dimid(ncid, 'lw_band', did) + ierr = pio_inq_dimlen(ncid, did, ival) + if (ival .ne. nlwbands) call endrun(subname//':'//props%sourcefile// & + ' has the wrong number of lw bands') + + ierr = pio_inq_dimid(ncid, 'sw_band', did) + ierr = pio_inq_dimlen(ncid, did, ival) + if (ival .ne. nswbands) call endrun(subname//':'//props%sourcefile// & + ' has the wrong number of sw bands') + + ! Get other dimensions + ierr = pio_inq_dimid(ncid, 'corefrac', did) + ierr = pio_inq_dimlen(ncid, did, props%nfrac) + + + ! Allocate arrays + allocate( & + props%extpsw2(props%nfrac,nswbands), & + props%abspsw2(props%nfrac,nswbands), & + props%asmpsw2(props%nfrac,nswbands), & + props%absplw2(props%nfrac,nlwbands), & + props%corefrac(props%nfrac) ) + + ierr = pio_inq_varid(ncid, 'extpsw2', vid) + ierr = pio_get_var(ncid, vid, props%extpsw2) + + ierr = pio_inq_varid(ncid, 'abspsw2', vid) + ierr = pio_get_var(ncid, vid, props%abspsw2) + + ierr = pio_inq_varid(ncid, 'asmpsw2', vid) + ierr = pio_get_var(ncid, vid, props%asmpsw2) + + ierr = pio_inq_varid(ncid, 'absplw2', vid) + ierr = pio_get_var(ncid, vid, props%absplw2) + + ierr = pio_inq_varid(ncid, 'corefrac', vid) + ierr = pio_get_var(ncid, vid, props%corefrac) + +end subroutine bin_optics_init + + +!================================================================================================ + +subroutine bindef_optics_init(props, ncid) + +! Read optics data for modal aerosols + + type (physprop_type), intent(inout) :: props ! storage for file data + type (file_desc_T), intent(inout) :: ncid ! indentifier for netcdf file + + ! Local variables + integer :: ierr + integer :: did + integer :: ival + type(var_desc_t) :: vid + + character(len=*), parameter :: subname = 'bin_optics_init' + !------------------------------------------------------------------------------------ + + ! Check dimensions for number of lw and sw bands + + ierr = pio_inq_dimid(ncid, 'lw_band', did) + ierr = pio_inq_dimlen(ncid, did, ival) + if (ival .ne. nlwbands) call endrun(subname//':'//props%sourcefile// & + ' has the wrong number of lw bands') + + ierr = pio_inq_dimid(ncid, 'sw_band', did) + ierr = pio_inq_dimlen(ncid, did, ival) + if (ival .ne. nswbands) call endrun(subname//':'//props%sourcefile// & + ' has the wrong number of sw bands') + + ierr = pio_inq_varid(ncid, 'density', vid) + ierr = pio_get_var(ncid, vid, props%density_aer) + + ierr = pio_inq_varid(ncid, 'hygroscopicity', vid) + ierr = pio_get_var(ncid, vid, props%hygro_aer) + + ! read refractive index data if available + call refindex_aer_init(props, ncid) + +end subroutine bindef_optics_init + +!================================================================================================ + subroutine bulk_props_init(physprop, nc_id) ! Read props for bulk aerosols @@ -1131,13 +1347,13 @@ subroutine bulk_props_init(physprop, nc_id) ierr = pio_inq_varid(nc_id, 'dryrad', vid) ierr = pio_get_var(nc_id, vid, physprop%dryrad_aer) - + ierr = pio_inq_varid(nc_id, 'hygroscopicity', vid) ierr = pio_get_var(nc_id, vid, physprop%hygro_aer) ierr = pio_inq_varid(nc_id, 'num_to_mass_ratio', vid) ierr = pio_get_var(nc_id, vid, physprop%num_to_mass_aer) - + ! Output select data to log file if (debug .and. masterproc .and. idx_sw_diag > 0) then if (trim(physprop%aername) == 'SULFATE') then @@ -1316,4 +1532,154 @@ end subroutine aer_optics_log_rh !================================================================================================ +subroutine hygroscopic_coreshell_optics_init(phys_prop, nc_id) + + ! Read optics data of type 'hygroscopic_coreshell' and interpolate it to CAM's rh mesh. + + type (physprop_type), intent(inout) :: phys_prop ! data after interp onto cam rh mesh + type (file_desc_T), intent(inout) :: nc_id ! indentifier for netcdf file + + ! Local variables + integer :: ierr ! error flag + + integer :: rh_id, lw_band_id, sw_band_id, coreshell_id, dstbc_id, kap_id + integer :: sw_ext_id, sw_ssa_id, sw_asm_id, lw_abs_id + integer :: nbnd, swbands, did + + ! temp data from hygroscopic file before interpolation onto cam-rh-mesh + integer :: nrh ! number of rh values in file + integer :: nfrac ! number of core/shell ratio values in file + integer :: nbcdust,nkap + + real(r8) :: rh ! real rh value on cam rh mesh (indexvalue) + character(len=*), parameter :: sub = 'hygroscopic_coreshell_optics_init' + !------------------------------------------------------------------------------------ + + if (masterproc) then + write(iulog,*) 'hygroscopic_coreshell_optics_init: Read file '//trim(phys_prop%sourcefile) + endif + + ierr = pio_inq_dimid(nc_id, 'lw_band', lw_band_id) + ierr = pio_inq_dimlen(nc_id, lw_band_id, nbnd) + if (nbnd .ne. nlwbands) call endrun(trim(phys_prop%sourcefile)// & + ' has the wrong number of lwbands') + + ierr = pio_inq_dimid(nc_id, 'sw_band', sw_band_id) + ierr = pio_inq_dimlen(nc_id, sw_band_id, swbands) + if(swbands .ne. nswbands) call endrun(trim(phys_prop%sourcefile)// & + ' has the wrong number of sw bands') + + + ierr = pio_inq_dimid(nc_id, 'coreshellratio', did) + ierr = pio_inq_dimlen(nc_id, did, phys_prop%nfrac) + + ierr = pio_inq_dimid(nc_id, 'dstbcratio', did) + ierr = pio_inq_dimlen(nc_id, did, phys_prop%nbcdust) + + ierr = pio_inq_dimid(nc_id, 'kap', did) + ierr = pio_inq_dimlen(nc_id, did, phys_prop%nkap) + + ierr = pio_inq_dimid(nc_id, 'rh_idx', rh_id) + ierr = pio_inq_dimlen(nc_id, rh_id, phys_prop%nrelh) + + allocate(phys_prop%sw_hygro_coreshell_ext(phys_prop%nrelh,nswbands, & + phys_prop%nfrac,phys_prop%nbcdust,phys_prop%nkap)) + allocate(phys_prop%sw_hygro_coreshell_ssa(phys_prop%nrelh,nswbands, & + phys_prop%nfrac,phys_prop%nbcdust,phys_prop%nkap)) + allocate(phys_prop%sw_hygro_coreshell_asm(phys_prop%nrelh,nswbands, & + phys_prop%nfrac,phys_prop%nbcdust,phys_prop%nkap)) + allocate(phys_prop%lw_hygro_coreshell_abs(phys_prop%nrelh,nlwbands, & + phys_prop%nfrac,phys_prop%nbcdust,phys_prop%nkap)) + allocate(phys_prop%corefrac(phys_prop%nfrac)) + allocate(phys_prop%bcdust(phys_prop%nbcdust)) + allocate(phys_prop%kap(phys_prop%nkap)) + allocate(phys_prop%relh(phys_prop%nrelh)) + + ierr = pio_inq_varid(nc_id, 'rh', rh_id) + ierr = pio_inq_varid(nc_id, 'coreshellratio', coreshell_id) ! modified by Pengfei for coreshell + ierr = pio_inq_varid(nc_id, 'dstbcratio', dstbc_id) ! modified by Pengfei for coreshell + ierr = pio_inq_varid(nc_id, 'kap', kap_id) + + ierr = pio_inq_varid(nc_id, 'ext_sw_coreshell', sw_ext_id) + ierr = pio_inq_varid(nc_id, 'ssa_sw_coreshell', sw_ssa_id) + ierr = pio_inq_varid(nc_id, 'asm_sw_coreshell', sw_asm_id) + ierr = pio_inq_varid(nc_id, 'abs_lw_coreshell', lw_abs_id) + + ierr = pio_get_var(nc_id, sw_ext_id, phys_prop%sw_hygro_coreshell_ext) + ierr = pio_get_var(nc_id, sw_ssa_id, phys_prop%sw_hygro_coreshell_ssa) + ierr = pio_get_var(nc_id, sw_asm_id, phys_prop%sw_hygro_coreshell_asm) + ierr = pio_get_var(nc_id, lw_abs_id, phys_prop%lw_hygro_coreshell_abs) + ierr = pio_get_var(nc_id, kap_id, phys_prop%kap) + ierr = pio_get_var(nc_id, rh_id, phys_prop%relh) + ierr = pio_get_var(nc_id, dstbc_id, phys_prop%bcdust) + ierr = pio_get_var(nc_id, coreshell_id, phys_prop%corefrac) + + ! read refractive index data if available + call refindex_aer_init(phys_prop, nc_id) + +end subroutine hygroscopic_coreshell_optics_init + +!================================================================================================ + +subroutine hygroscopic_wtp_optics_init(phys_prop, nc_id) + + ! Read optics data of type 'hygroscopic' and interpolate it to CAM's rh mesh. + + type (physprop_type), intent(inout) :: phys_prop ! data after interp onto cam rh mesh + type (file_desc_T), intent(inout) :: nc_id ! indentifier for netcdf file + + ! Local variables + integer :: ierr ! error flag + + integer :: lw_band_id, sw_band_id, did + integer :: sw_ext_wtp_id, sw_ssa_wtp_id, sw_asm_wtp_id, lw_ext_wtp_id, wtp_id + integer :: nbnd, swbands + + real(r8) :: rh ! real rh value on cam rh mesh (indexvalue) + character(len=*), parameter :: sub = 'hygroscopic_wtp_optics_init' + !------------------------------------------------------------------------------------ + +!st + ! Get other dimensions + ierr = pio_inq_dimid(nc_id, 'wgtpct', did) + ierr = pio_inq_dimlen(nc_id, did, phys_prop%nwtp) + + + allocate(phys_prop%sw_hygro_ext_wtp(phys_prop%nwtp,nswbands)) + allocate(phys_prop%sw_hygro_ssa_wtp(phys_prop%nwtp,nswbands)) + allocate(phys_prop%sw_hygro_asm_wtp(phys_prop%nwtp,nswbands)) + allocate(phys_prop%lw_hygro_abs_wtp(phys_prop%nwtp,nlwbands)) + allocate(phys_prop%wgtpct(phys_prop%nwtp)) + + ierr = pio_inq_dimid(nc_id, 'lw_band', lw_band_id) + ierr = pio_inq_dimlen(nc_id, lw_band_id, nbnd) + if (nbnd .ne. nlwbands) call endrun(phys_prop%sourcefile// & + ' has the wrong number of lwbands') + + ierr = pio_inq_dimid(nc_id, 'sw_band', sw_band_id) + ierr = pio_inq_dimlen(nc_id, sw_band_id, swbands) + if(swbands .ne. nswbands) call endrun(phys_prop%sourcefile// & + ' has the wrong number of sw bands') + + ierr = pio_inq_varid(nc_id, 'ext_sw_wtp', sw_ext_wtp_id) + ierr = pio_inq_varid(nc_id, 'ssa_sw_wtp', sw_ssa_wtp_id) + ierr = pio_inq_varid(nc_id, 'asm_sw_wtp', sw_asm_wtp_id) + ierr = pio_inq_varid(nc_id, 'abs_lw_wtp', lw_ext_wtp_id) + ierr = pio_inq_varid(nc_id, 'wgtpct', wtp_id) + + ierr = pio_get_var(nc_id, sw_ext_wtp_id, phys_prop%sw_hygro_ext_wtp) + ierr = pio_get_var(nc_id, sw_ssa_wtp_id, phys_prop%sw_hygro_ssa_wtp) + ierr = pio_get_var(nc_id, sw_asm_wtp_id, phys_prop%sw_hygro_asm_wtp) + ierr = pio_get_var(nc_id, lw_ext_wtp_id, phys_prop%lw_hygro_abs_wtp) + ierr = pio_get_var(nc_id, wtp_id, phys_prop%wgtpct) + + ! read refractive index data if available + call refindex_aer_init(phys_prop, nc_id) + + ! read bulk aero props + call bulk_props_init(phys_prop, nc_id) + +end subroutine hygroscopic_wtp_optics_init + + end module phys_prop diff --git a/src/physics/cam/physics_types.F90 b/src/physics/cam/physics_types.F90 index 3228c27105..534f87c95f 100644 --- a/src/physics/cam/physics_types.F90 +++ b/src/physics/cam/physics_types.F90 @@ -223,7 +223,7 @@ subroutine physics_update(state, ptend, dt, tend) real(r8), intent(in) :: dt ! time step type(physics_tend ), intent(inout), optional :: tend ! Physics tendencies over timestep - ! tend is usually only needed by calls from physpkg. + ! tend is usually only needed by calls from physpkg. ! !---------------------------Local storage------------------------------- integer :: k,m ! column,level,constituent indices @@ -1267,10 +1267,10 @@ subroutine physics_dme_adjust(state, tend, qini, liqini, iceini, dt) ! if (.not.(dycore_is('MPAS') .or. dycore_is('SE'))) then do k = 1, pver - + ! adjusment factor is just change in water vapor fdq(:ncol) = 1._r8 + state%q(:ncol,k,1) - qini(:ncol,k) - + ! adjust constituents to conserve mass in each layer do m = 1, pcnst state%q(:ncol,k,m) = state%q(:ncol,k,m) / fdq(:ncol) diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90 index ba36670ce8..2782dff2b6 100644 --- a/src/physics/cam/physpkg.F90 +++ b/src/physics/cam/physpkg.F90 @@ -159,6 +159,8 @@ subroutine phys_register use offline_driver, only: offline_driver_reg use hemco_interface, only: HCOI_Chunk_Init use upper_bc, only: ubc_fixed_conc + use surface_emissions_mod, only: surface_emissions_reg + use elevated_emissions_mod, only: elevated_emissions_reg !---------------------------Local variables----------------------------- ! @@ -269,6 +271,9 @@ subroutine phys_register call modal_aero_wateruptake_reg() endif + call surface_emissions_reg() + call elevated_emissions_reg() + ! register chemical constituents including aerosols ... call chem_register() @@ -774,6 +779,8 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) use phys_control, only: phys_getopts use phys_grid_ctem, only: phys_grid_ctem_init use cam_budget, only: cam_budget_init + use surface_emissions_mod, only: surface_emissions_init + use elevated_emissions_mod, only: elevated_emissions_init use ccpp_constituent_prop_mod, only: ccpp_const_props_init @@ -855,7 +862,9 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) call aer_rad_props_init() ! initialize carma - call carma_init() + call carma_init(pbuf2d) + call surface_emissions_init(pbuf2d) + call elevated_emissions_init(pbuf2d) ! Prognostic chemistry. call chem_init(phys_state,pbuf2d) @@ -1075,6 +1084,7 @@ subroutine phys_run1(phys_state, ztodt, phys_tend, pbuf2d, cam_in, cam_out) #if ( defined OFFLINE_DYN ) use metdata, only: get_met_srf1 #endif + ! ! Input arguments ! @@ -1132,7 +1142,6 @@ subroutine phys_run1(phys_state, ztodt, phys_tend, pbuf2d, cam_in, cam_out) call gmean_mass ('before tphysbc DRY', phys_state) #endif - !----------------------------------------------------------------------- ! Tendency physics before flux coupler invocation !----------------------------------------------------------------------- @@ -1381,14 +1390,16 @@ subroutine tphysac (ztodt, cam_in, & use constituents, only: cnst_get_ind use physics_types, only: physics_state, physics_tend, physics_ptend, physics_update, & physics_dme_adjust, set_dry_to_wet, physics_state_check, & - dyn_te_idx + dyn_te_idx, physics_ptend_init use waccmx_phys_intr, only: waccmx_phys_mspd_tend ! WACCM-X major diffusion use waccmx_phys_intr, only: waccmx_phys_ion_elec_temp_tend ! WACCM-X use aoa_tracers, only: aoa_tracers_timestep_tend use physconst, only: rhoh2o, latvap,latice use dyn_tests_utils, only: vc_dycore use aero_model, only: aero_model_drydep - use carma_intr, only: carma_emission_tend, carma_timestep_tend + use carma_intr, only: carma_emission_tend, carma_timestep_tend, carma_output_budget_diagnostics, & + carma_output_cloudborne_diagnostics, carma_calculate_cloudborne_diagnostics, & + MAXCLDAERDIAG use carma_flags_mod, only: carma_do_aerosol, carma_do_emission use check_energy, only: check_energy_chng, tot_energy_phys use check_energy, only: check_tracers_data, check_tracers_init, check_tracers_chng @@ -1469,6 +1480,13 @@ subroutine tphysac (ztodt, cam_in, & real(r8), pointer, dimension(:,:) :: dvcore real(r8), pointer, dimension(:,:) :: ast ! relative humidity cloud fraction + ! CARMA diagnostics + real(r8) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the cloudborne aerosol diags snapshot + real(r8) :: old_cflux(pcols,pcnst) !! cam_in%clfux from before the timestep_tend + logical :: lq_none(pcnst) !! Used to initialize null ptend for chem_emissions + + + !----------------------------------------------------------------------- lchnk = state%lchnk ncol = state%ncol @@ -1516,13 +1534,28 @@ subroutine tphysac (ztodt, cam_in, & + (cam_out%precsc(i) + cam_out%precsl(i))*latice*rhoh2o end do + ! Add a diagnostic term for the aerosol emissions coupled from the surface. + lq_none(:) = .false. + call physics_ptend_init(ptend,state%psetcols, 'surf_emissions', lq=lq_none) + + ! emissions of aerosols and gas-phase chemistry constituents at surface if (trim(cam_take_snapshot_before) == "chem_emissions") then call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,& fh2o, surfric, obklen, flx_heat) end if + + old_cflux = cam_in%cflx + call carma_calculate_cloudborne_diagnostics(state, pbuf, aerclddiag) + call chem_emissions( state, cam_in, pbuf ) + + lq_none(:) = .false. + call physics_ptend_init(ptend,state%psetcols, 'chem_emissions', lq=lq_none) + call carma_output_budget_diagnostics(state, ptend, old_cflux, cam_in%cflx, ztodt, "CHEMEMIS") + call carma_output_cloudborne_diagnostics(state, pbuf, "CHEMEMIS", ztodt, aerclddiag) + if (trim(cam_take_snapshot_after) == "chem_emissions") then call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf,& fh2o, surfric, obklen, flx_heat) @@ -1530,7 +1563,11 @@ subroutine tphysac (ztodt, cam_in, & if (carma_do_emission) then ! carma emissions - call carma_emission_tend (state, ptend, cam_in, ztodt) + old_cflux = cam_in%cflx + call carma_calculate_cloudborne_diagnostics(state, pbuf, aerclddiag) + call carma_emission_tend(state, ptend, cam_in, ztodt, pbuf) + call carma_output_budget_diagnostics(state, ptend, old_cflux, cam_in%cflx, ztodt, "CREMIS") + call carma_output_cloudborne_diagnostics(state, pbuf, "CREMIS", ztodt, aerclddiag) call physics_update(state, ptend, ztodt, tend) end if @@ -1601,6 +1638,9 @@ subroutine tphysac (ztodt, cam_in, & fh2o, surfric, obklen, flx_heat) end if + old_cflux = cam_in%cflx + call carma_calculate_cloudborne_diagnostics(state, pbuf, aerclddiag) + call chem_timestep_tend(state, ptend, cam_in, cam_out, ztodt, & pbuf, fh2o=fh2o) @@ -1609,6 +1649,8 @@ subroutine tphysac (ztodt, cam_in, & (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then call cam_snapshot_ptend_outfld(ptend, lchnk) end if + call carma_output_budget_diagnostics(state, ptend, old_cflux, cam_in%cflx, ztodt, "CHEM") + call carma_output_cloudborne_diagnostics(state, pbuf, "CHEM", ztodt, aerclddiag) call physics_update(state, ptend, ztodt, tend) if (trim(cam_take_snapshot_after) == "chem_timestep_tend") then @@ -1633,6 +1675,9 @@ subroutine tphysac (ztodt, cam_in, & fh2o, surfric, obklen, flx_heat) end if + old_cflux = cam_in%cflx + call carma_calculate_cloudborne_diagnostics(state, pbuf, aerclddiag) + call vertical_diffusion_tend (ztodt ,state , cam_in, & surfric ,obklen ,ptend ,ast ,pbuf ) @@ -1653,6 +1698,8 @@ subroutine tphysac (ztodt, cam_in, & if ( ptend%lv ) then call outfld( 'VTEND_VDIFF', ptend%v, pcols, lchnk) end if + call carma_output_budget_diagnostics(state, ptend, old_cflux, cam_in%cflx, ztodt, "VDIF") + call carma_output_cloudborne_diagnostics(state, pbuf, "VDIF", ztodt, aerclddiag) call physics_update(state, ptend, ztodt, tend) if (trim(cam_take_snapshot_after) == "vertical_diffusion_section") then @@ -1693,11 +1740,16 @@ subroutine tphysac (ztodt, cam_in, & fh2o, surfric, obklen, flx_heat) end if + old_cflux = cam_in%cflx + call carma_calculate_cloudborne_diagnostics(state, pbuf, aerclddiag) + call aero_model_drydep( state, pbuf, obklen, surfric, cam_in, ztodt, cam_out, ptend ) if ( (trim(cam_take_snapshot_after) == "aero_model_drydep") .and. & (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then call cam_snapshot_ptend_outfld(ptend, lchnk) end if + call carma_output_budget_diagnostics(state, ptend, old_cflux, cam_in%cflx, ztodt, "DRYDEPA") + call carma_output_cloudborne_diagnostics(state, pbuf, "DRYDEPA", ztodt, aerclddiag) call physics_update(state, ptend, ztodt, tend) if (trim(cam_take_snapshot_after) == "aero_model_drydep") then @@ -1716,7 +1768,11 @@ subroutine tphysac (ztodt, cam_in, & ! can be added to for CARMA aerosols. if (carma_do_aerosol) then call t_startf('carma_timestep_tend') + old_cflux = cam_in%cflx + call carma_calculate_cloudborne_diagnostics(state, pbuf, aerclddiag) call carma_timestep_tend(state, cam_in, cam_out, ptend, ztodt, pbuf, obklen=obklen, ustar=surfric) + call carma_output_budget_diagnostics(state, ptend, old_cflux, cam_in%cflx, ztodt, "CRTEND") + call carma_output_cloudborne_diagnostics(state, pbuf, "CRTEND", ztodt, aerclddiag) call physics_update(state, ptend, ztodt, tend) call check_energy_chng(state, tend, "carma_tend", nstep, ztodt, zero, zero, zero, zero) @@ -1858,6 +1914,7 @@ subroutine tphysac (ztodt, cam_in, & ! Update Nudging values, if needed !---------------------------------- if((Nudge_Model).and.(Nudge_ON)) then + call nudging_timestep_tend(state,ptend) if ( ptend%lu ) then call outfld( 'UTEND_NDG', ptend%u, pcols, lchnk) @@ -1865,6 +1922,7 @@ subroutine tphysac (ztodt, cam_in, & if ( ptend%lv ) then call outfld( 'VTEND_NDG', ptend%v, pcols, lchnk) end if + call physics_update(state,ptend,ztodt,tend) call check_energy_chng(state, tend, "nudging", nstep, ztodt, zero, zero, zero, zero) endif @@ -2050,7 +2108,9 @@ subroutine tphysbc (ztodt, state, & use dycore, only: dycore_is use aero_model, only: aero_model_wetdep use aero_wetdep_cam, only: wetdep_lq - use carma_intr, only: carma_wetdep_tend, carma_timestep_tend + use carma_intr, only: carma_wetdep_tend, carma_timestep_tend, carma_output_budget_diagnostics, & + carma_output_cloudborne_diagnostics, carma_calculate_cloudborne_diagnostics, & + MAXCLDAERDIAG use carma_flags_mod, only: carma_do_detrain, carma_do_cldice, carma_do_cldliq, carma_do_wetdep use radiation, only: radiation_tend use cloud_diagnostics, only: cloud_diagnostics_calc @@ -2072,6 +2132,8 @@ subroutine tphysbc (ztodt, state, & use cam_snapshot_common, only: cam_snapshot_ptend_outfld use ssatcontrail, only: ssatcontrail_d0 use dyn_tests_utils, only: vc_dycore + use surface_emissions_mod,only: surface_emissions_set + use elevated_emissions_mod,only: elevated_emissions_set ! Arguments @@ -2179,6 +2241,11 @@ subroutine tphysbc (ztodt, state, & type(check_tracers_data):: tracerint ! energy integrals and cummulative boundary fluxes real(r8) :: zero_tracers(pcols,pcnst) + ! For aerosol budget diagnostics + character(len=16) :: pname !! package name + real(r8) :: aerclddiag(pcols, MAXCLDAERDIAG) !! the cloudborne aerosol diags snapshot + real(r8) :: old_cflux(pcols,pcnst) !! cam_in%clfux from before the timestep_tend + !----------------------------------------------------------------------- call t_startf('bc_init') @@ -2254,7 +2321,9 @@ subroutine tphysbc (ztodt, state, & call tot_energy_phys(state, 'phBF') call tot_energy_phys(state, 'dyBF',vc=vc_dycore) if (.not.dycore_is('EUL')) then + call check_energy_fix(state, ptend, nstep, flx_heat) + call physics_update(state, ptend, ztodt, tend) call check_energy_chng(state, tend, "chkengyfix", nstep, ztodt, zero, zero, zero, flx_heat) call outfld( 'EFIX', flx_heat , pcols, lchnk ) @@ -2300,6 +2369,12 @@ subroutine tphysbc (ztodt, state, & end if call t_stopf('energy_fixer') + + + call surface_emissions_set( lchnk, ncol, pbuf ) + + call elevated_emissions_set( lchnk, ncol, pbuf ) + ! !=================================================== ! Dry adjustment @@ -2409,6 +2484,8 @@ subroutine tphysbc (ztodt, state, & state , ptend , pbuf, cam_in) call t_stopf ('convect_shallow_tend') + call physics_update(state, ptend, ztodt, tend) + if ( (trim(cam_take_snapshot_after) == "convect_shallow_tend") .and. & (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then call cam_snapshot_ptend_outfld(ptend, lchnk) @@ -2452,8 +2529,12 @@ subroutine tphysbc (ztodt, state, & call t_startf('carma_timestep_tend') if (carma_do_cldice .or. carma_do_cldliq) then + old_cflux = cam_in%cflx + call carma_calculate_cloudborne_diagnostics(state, pbuf, aerclddiag) call carma_timestep_tend(state, cam_in, cam_out, ptend, ztodt, pbuf, dlf=dlf, rliq=rliq, & prec_str=prec_str, snow_str=snow_str, prec_sed=prec_sed_carma, snow_sed=snow_sed_carma) + call carma_output_budget_diagnostics(state, ptend, old_cflux, cam_in%cflx, ztodt, "CRTEND") + call carma_output_cloudborne_diagnostics(state, pbuf, "CRTEND", ztodt, aerclddiag) call physics_update(state, ptend, ztodt, tend) ! Before the detrainment, the reserved condensate is all liquid, but if CARMA is doing @@ -2580,6 +2661,10 @@ subroutine tphysbc (ztodt, state, & flx_cnd(:ncol) = -1._r8*rliq(:ncol) flx_heat(:ncol) = cam_in%shf(:ncol) + det_s(:ncol) + ! These need to be reported before the scaling as they are based + ! on the substep size not ztodt. + write(pname, '(A, I2.2)') "CLUBB", macmic_it + ! Unfortunately, physics_update does not know what time period ! "tend" is supposed to cover, and therefore can't update it ! with substeps correctly. For now, work around this by scaling @@ -2638,6 +2723,9 @@ subroutine tphysbc (ztodt, state, & flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) end if + old_cflux = cam_in%cflx + call carma_calculate_cloudborne_diagnostics(state, pbuf, aerclddiag) + call t_startf('microp_aero_run') call microp_aero_run(state, ptend_aero, cld_macmic_ztodt, pbuf) call t_stopf('microp_aero_run') @@ -2718,6 +2806,12 @@ subroutine tphysbc (ztodt, state, & call physics_ptend_sum(ptend_aero, ptend, ncol) call physics_ptend_dealloc(ptend_aero) + ! These need to be reported before the scaling as they are based + ! on the substep size not ztodt. + write(pname, '(A, I2.2)') "MICROP", macmic_it + call carma_output_budget_diagnostics(state, ptend, old_cflux, cam_in%cflx, ztodt/cld_macmic_num_steps, pname) + call carma_output_cloudborne_diagnostics(state, pbuf, pname, ztodt/cld_macmic_num_steps, aerclddiag) + ! Have to scale and apply for full timestep to get tend right ! (see above note for macrophysics). call physics_ptend_scale(ptend, 1._r8/cld_macmic_num_steps, ncol) @@ -2802,11 +2896,16 @@ subroutine tphysbc (ztodt, state, & flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) end if + old_cflux = cam_in%cflx + call carma_calculate_cloudborne_diagnostics(state, pbuf, aerclddiag) + call aero_model_wetdep( state, ztodt, dlf, cam_out, ptend, pbuf) if ( (trim(cam_take_snapshot_after) == "aero_model_wetdep") .and. & (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then call cam_snapshot_ptend_outfld(ptend, lchnk) end if + call carma_output_budget_diagnostics(state, ptend, old_cflux, cam_in%cflx, ztodt, "WETDEPA") + call carma_output_cloudborne_diagnostics(state, pbuf, "WETDEPA", ztodt, aerclddiag) call physics_update(state, ptend, ztodt, tend) if (trim(cam_take_snapshot_after) == "aero_model_wetdep") then @@ -2821,7 +2920,11 @@ subroutine tphysbc (ztodt, state, & ! fields have already been set for CAM aerosols and cam_out can be added ! to for CARMA aerosols. call t_startf ('carma_wetdep_tend') + old_cflux = cam_in%cflx + call carma_calculate_cloudborne_diagnostics(state, pbuf, aerclddiag) call carma_wetdep_tend(state, ptend, ztodt, pbuf, dlf, cam_out) + call carma_output_budget_diagnostics(state, ptend, old_cflux, cam_in%cflx, ztodt, "WETDEPC") + call carma_output_cloudborne_diagnostics(state, pbuf, "WETDEPC", ztodt, aerclddiag) call physics_update(state, ptend, ztodt, tend) call t_stopf ('carma_wetdep_tend') end if @@ -2944,6 +3047,8 @@ subroutine phys_timestep_init(phys_state, cam_in, cam_out, pbuf2d) use nudging, only: Nudge_Model, nudging_timestep_init use waccmx_phys_intr, only: waccmx_phys_ion_elec_temp_timestep_init use phys_grid_ctem, only: phys_grid_ctem_diags + use surface_emissions_mod,only: surface_emissions_adv + use elevated_emissions_mod,only: elevated_emissions_adv implicit none @@ -2964,6 +3069,8 @@ subroutine phys_timestep_init(phys_state, cam_in, cam_out, pbuf2d) ! Chemistry surface values call chem_surfvals_set() + call surface_emissions_adv(pbuf2d, phys_state) + call elevated_emissions_adv(pbuf2d, phys_state) ! Solar irradiance call solar_data_advance() diff --git a/src/physics/cam/rad_constituents.F90 b/src/physics/cam/rad_constituents.F90 index 777af8728e..824da411ab 100644 --- a/src/physics/cam/rad_constituents.F90 +++ b/src/physics/cam/rad_constituents.F90 @@ -47,7 +47,16 @@ module rad_constituents rad_cnst_get_mode_num, &! return mode number mixing ratio rad_cnst_get_mode_num_idx, &! get constituent index of mode number m.r. (climate list only) rad_cnst_out, &! output constituent diagnostics (mass per layer and column burden) - rad_cnst_get_call_list ! return list of active climate/diagnostic calls to radiation + rad_cnst_get_call_list, &! return list of active climate/diagnostic calls to radiation + rad_cnst_get_bin_props_by_idx, & + rad_cnst_get_bin_mmr_by_idx, & + rad_cnst_get_info_by_bin, & + rad_cnst_get_info_by_bin_spec, & + rad_cnst_get_bin_props, & + rad_cnst_get_bin_num, & + rad_cnst_get_bin_num_idx, & + rad_cnst_get_carma_mmr_idx, & + rad_cnst_get_bin_mmr public :: rad_cnst_num_name @@ -62,11 +71,15 @@ module rad_constituents ! max number of strings in mode definitions integer, parameter :: n_mode_str = 120 +! max number of strings in bin definitions +integer, parameter :: n_bin_str = 640 + ! max number of externally mixed entities in the climate/diag lists integer, parameter :: n_rad_cnst = N_RAD_CNST ! Namelist variables character(len=cs1), dimension(n_mode_str) :: mode_defs = ' ' +character(len=cs1), dimension(n_bin_str) :: bin_defs = ' ' character(len=cs1) :: rad_climate(n_rad_cnst) = ' ' character(len=cs1) :: rad_diag_1(n_rad_cnst) = ' ' character(len=cs1) :: rad_diag_2(n_rad_cnst) = ' ' @@ -112,6 +125,49 @@ module rad_constituents type(modes_t), target :: modes ! mode definitions +! type to provide access to the components of a bin +type :: bin_component_t + integer :: nspec + ! For "source" variables below, value is: + ! 'N' if in pbuf (non-advected) + ! 'A' if in state (advected) + character(len= 1) :: source_num_a ! source of interstitial number conc field + character(len= 32) :: camname_num_a ! name registered in pbuf or constituents for number mixing ratio of interstitial species + character(len= 1) :: source_num_c ! source of cloud borne number conc field + character(len= 32) :: camname_num_c ! name registered in pbuf or constituents for number mixing ratio of cloud borne species + + character(len= 1) :: source_mass_a ! source of interstitial number conc field + character(len= 32) :: camname_mass_a ! name registered in pbuf or constituents for number mixing ratio of interstitial species + character(len= 1) :: source_mass_c ! source of cloud borne number conc field + character(len= 32) :: camname_mass_c ! name registered in pbuf or constituents for number mixing ratio of cloud borne species + + character(len= 1), pointer :: source_mmr_a(:) ! source of interstitial mmr field + character(len= 32), pointer :: camname_mmr_a(:) ! name registered in pbuf or constituents for mmr species + character(len= 1), pointer :: source_mmr_c(:) ! source of cloud borne specie mmr fields + character(len= 32), pointer :: camname_mmr_c(:) ! name registered in pbuf or constituents for mmr of cloud borne components + character(len= 32), pointer :: type(:) ! species type + character(len= 32), pointer :: morph(:) ! species morphology + character(len=cs1), pointer :: props(:) ! file containing specie properties + + integer :: idx_num_a ! index in pbuf or constituents for number mixing ratio of interstitial species + integer :: idx_num_c ! index in pbuf for number mixing ratio of cloud-borne species + integer :: idx_mass_a ! index in pbuf or constituents for mass mixing ratio of interstitial species + integer :: idx_mass_c ! index in pbuf for mass mixing ratio of cloud-borne species + + integer, pointer :: idx_mmr_a(:) ! index in pbuf or constituents for mmr of interstitial species + integer, pointer :: idx_mmr_c(:) ! index in pbuf or constituents for mmr of cloud-borne species + integer, pointer :: idx_props(:) ! ID used to access physical properties of mode species from phys_prop module +end type bin_component_t + +! type to provide access to all bins +type :: bins_t + integer :: nbins + character(len= 32), pointer :: names(:) ! names used to identify a mode in the climate/diag lists + type(bin_component_t), pointer :: comps(:) ! components which define the mode +end type bins_t + +type(bins_t), target :: bins ! mode definitions + ! type to provide access to the data parsed from the rad_climate and rad_diag_* strings type :: rad_cnst_namelist_t integer :: ncnst @@ -182,6 +238,18 @@ module rad_constituents type(modelist_t), target :: ma_list(0:N_DIAG) ! list of aerosol modes used in climate/diagnostic calcs +! storage for modal aerosol components in the climate/diagnostic lists + +type :: binlist_t + integer :: nbins ! number of bins + character(len=2) :: list_id ! set to " " for climate list, or two character integer + ! (include leading zero) to identify diagnostic list + integer, pointer :: idx(:) ! index of the bin in the bin definition object + character(len=cs1), pointer :: physprop_files(:) ! physprop filename + integer, pointer :: idx_props(:) ! index of the bin properties in the physprop object +end type binlist_t + +type(binlist_t), target :: sa_list(0:N_DIAG) ! list of aerosol bins used in climate/diagnostic calcs ! values for constituents with requested value of zero real(r8), allocatable, target :: zero_cols(:,:) @@ -217,6 +285,9 @@ module rad_constituents 'sulfate ', 'ammonium ', 'nitrate ', 'p-organic', & 's-organic', 'black-c ', 'seasalt ', 'dust '/) +integer, parameter :: num_bin_morphs = 2 +character(len=8), parameter :: bin_morph_names(num_bin_morphs) = & + (/ 'shell ', 'core ' /) !============================================================================== contains @@ -239,6 +310,7 @@ subroutine rad_cnst_readnl(nlfile) character(len=*), parameter :: subname = 'rad_cnst_readnl' namelist /rad_cnst_nl/ mode_defs, & + bin_defs, & rad_climate, & rad_diag_1, & rad_diag_2, & @@ -277,6 +349,7 @@ subroutine rad_cnst_readnl(nlfile) #ifdef SPMD ! Broadcast namelist variables call mpibcast (mode_defs, len(mode_defs(1))*n_mode_str, mpichar, 0, mpicom) + call mpibcast (bin_defs, len(bin_defs(1))*n_bin_str, mpichar, 0, mpicom) call mpibcast (rad_climate, len(rad_climate(1))*n_rad_cnst, mpichar, 0, mpicom) call mpibcast (rad_diag_1, len(rad_diag_1(1))*n_rad_cnst, mpichar, 0, mpicom) call mpibcast (rad_diag_2, len(rad_diag_2(1))*n_rad_cnst, mpichar, 0, mpicom) @@ -300,6 +373,9 @@ subroutine rad_cnst_readnl(nlfile) ! Mode definition stings call parse_mode_defs(mode_defs, modes) + ! Bin definition stings + call parse_bin_defs(bin_defs, bins) + ! Lists of externally mixed entities for climate and diagnostic calculations do i = 0,N_DIAG select case (i) @@ -347,6 +423,7 @@ subroutine rad_cnst_readnl(nlfile) aerosollist(i)%list_id = suffix gaslist(i)%list_id = suffix ma_list(i)%list_id = suffix + sa_list(i)%list_id = suffix end if end do @@ -369,22 +446,31 @@ subroutine rad_cnst_readnl(nlfile) deallocate(ctype) end do + ! Add physprop files for the species from the bin definitions. + do i = 1, bins%nbins + allocate(ctype(bins%comps(i)%nspec)) + ctype = 'A' + call physprop_accum_unique_files(bins%comps(i)%props, ctype) + deallocate(ctype) + end do + ! Initialize the gas, bulk aerosol, and modal aerosol lists. This step splits the ! input climate/diagnostic lists into the corresponding gas, bulk and modal aerosol ! lists. if (masterproc) write(iulog,*) nl//subname//': Radiation constituent lists:' do i = 0, N_DIAG if (active_calls(i)) then - call list_init1(namelist(i), gaslist(i), aerosollist(i), ma_list(i)) + call list_init1(namelist(i), gaslist(i), aerosollist(i), ma_list(i), sa_list(i)) if (masterproc .and. verbose) then - call print_lists(gaslist(i), aerosollist(i), ma_list(i)) + call print_lists(gaslist(i), aerosollist(i), ma_list(i), sa_list(i)) end if end if end do if (masterproc .and. verbose) call print_modes(modes) + if (masterproc .and. verbose) call print_bins(bins) end subroutine rad_cnst_readnl @@ -418,10 +504,13 @@ subroutine rad_cnst_init() ! Finish initializing the mode definitions. call init_mode_comps(modes) + ! Finish initializing the bin definitions. + call init_bin_comps(bins) + ! Finish initializing the gas, bulk aerosol, and mode lists. do i = 0, N_DIAG if (active_calls(i)) then - call list_init2(gaslist(i), aerosollist(i), ma_list(i)) + call list_init2(gaslist(i), aerosollist(i), ma_list(i), sa_list(i)) end if end do @@ -546,7 +635,7 @@ function rad_cnst_num_name(list_idx, spc_name_in, num_name_out, mode_out, spec_o !================================================================================================ subroutine rad_cnst_get_info(list_idx, gasnames, aernames, & - use_data_o3, ngas, naero, nmodes) + use_data_o3, ngas, naero, nmodes, nbins) ! Return info about gas and aerosol lists @@ -558,11 +647,13 @@ subroutine rad_cnst_get_info(list_idx, gasnames, aernames, & integer, optional, intent(out) :: naero integer, optional, intent(out) :: ngas integer, optional, intent(out) :: nmodes + integer, optional, intent(out) :: nbins ! Local variables type(gaslist_t), pointer :: g_list ! local pointer to gas list of interest type(aerlist_t), pointer :: a_list ! local pointer to aerosol list of interest type(modelist_t), pointer :: m_list ! local pointer to mode list of interest + type(binlist_t), pointer :: s_list ! local pointer to bin list of interest integer :: i integer :: arrlen ! length of assumed shape array @@ -576,6 +667,7 @@ subroutine rad_cnst_get_info(list_idx, gasnames, aernames, & g_list => gaslist(list_idx) a_list => aerosollist(list_idx) m_list => ma_list(list_idx) + s_list => sa_list(list_idx) ! number of bulk aerosols in list if (present(naero)) then @@ -587,6 +679,11 @@ subroutine rad_cnst_get_info(list_idx, gasnames, aernames, & nmodes = m_list%nmodes endif + ! number of aerosol bins in list + if (present(nbins)) then + nbins = s_list%nbins + endif + ! number of gases in list if (present(ngas)) then ngas = g_list%ngas @@ -699,6 +796,132 @@ end subroutine rad_cnst_get_info_by_mode !================================================================================================ +subroutine rad_cnst_get_info_by_bin(list_idx, m_idx, & + bin_name, num_name, num_name_cw, mmr_name, mmr_name_cw, nspec) + + ! Return info about CARMA aerosol lists + + ! Arguments + integer, intent(in) :: list_idx ! index of the climate or a diagnostic list + integer, intent(in) :: m_idx ! index of bin in the specified list + character(len=*), optional, intent(out) :: bin_name + character(len=32), optional, intent(out) :: num_name ! name of interstitial number mixing ratio + character(len=32), optional, intent(out) :: num_name_cw ! name of cloud borne number mixing ratio + character(len=32), optional, intent(out) :: mmr_name ! name of interstitial mass mixing ratio + character(len=32), optional, intent(out) :: mmr_name_cw ! name of cloud borne mass mixing ratio + integer, optional, intent(out) :: nspec ! number of species in the mode + + ! Local variables + type(binlist_t), pointer :: s_list ! local pointer to mode list of interest + + integer :: nbins + integer :: mm + + character(len=*), parameter :: subname = 'rad_cnst_get_info_by_bin' + !----------------------------------------------------------------------------- + + s_list => sa_list(list_idx) + + ! check for valid mode index + nbins = s_list%nbins + if (m_idx < 1 .or. m_idx > nbins) then + write(iulog,*) subname//': ERROR - invalid bin index: ', m_idx + call endrun(subname//': ERROR - invalid bin index') + end if + + ! get index into the mode definition object + mm = s_list%idx(m_idx) + + ! number of species in the mode + if (present(nspec)) then + nspec = bins%comps(mm)%nspec + endif + + ! bin name + if (present(bin_name)) then + bin_name = bins%names(m_idx) + end if + + ! name of interstitial number mixing ratio + if (present(num_name)) then + num_name = bins%comps(mm)%camname_num_a + endif + + ! name of cloud borne number mixing ratio + if (present(num_name_cw)) then + num_name_cw = bins%comps(mm)%camname_num_c + endif + + ! name of interstitial mass mixing ratio + if (present(mmr_name)) then + mmr_name = bins%comps(mm)%camname_mass_a + endif + + ! name of cloud borne mass mixing ratio + if (present(mmr_name_cw)) then + mmr_name_cw = bins%comps(mm)%camname_mass_c + endif + +end subroutine rad_cnst_get_info_by_bin + +!================================================================================================ +subroutine rad_cnst_get_info_by_bin_spec(list_idx, m_idx, s_idx, & + spec_type, spec_morph, spec_name, spec_name_cw) + + ! Return info about CARMA aerosol lists + + ! Arguments + integer, intent(in) :: list_idx ! index of the climate or a diagnostic list + integer, intent(in) :: m_idx ! index of bin in the specified list + integer, intent(in) :: s_idx ! index of species in the specified mode + character(len=32), optional, intent(out) :: spec_type ! type of species + character(len=32), optional, intent(out) :: spec_morph ! type of species + character(len=32), optional, intent(out) :: spec_name ! name of interstitial species + character(len=32), optional, intent(out) :: spec_name_cw ! name of cloud borne species + + ! Local variables + type(binlist_t), pointer :: s_list ! local pointer to mode list of interest + integer :: nbins, nspec + integer :: mm + + character(len=*), parameter :: subname = 'rad_cnst_get_info_by_bin_spec' + !----------------------------------------------------------------------------- + + s_list => sa_list(list_idx) + + ! check for valid mode index + nbins = s_list%nbins + if (m_idx < 1 .or. m_idx > nbins) then + write(iulog,*) subname//': ERROR - invalid bin index: ', m_idx + call endrun(subname//': ERROR - invalid bin index') + end if + + ! get index into the mode definition object + mm = s_list%idx(m_idx) + + ! check for valid species index + nspec = bins%comps(mm)%nspec + if (s_idx < 1 .or. s_idx > nspec) then + write(iulog,*) subname//': ERROR - invalid specie index: ', s_idx + call endrun(subname//': ERROR - invalid specie index') + end if + + if (present(spec_type)) then + spec_type = bins%comps(mm)%type(s_idx) + endif + if (present(spec_morph)) then + spec_morph = bins%comps(mm)%morph(s_idx) + endif + if (present(spec_name)) then + spec_name = bins%comps(mm)%camname_mmr_a(s_idx) + endif + if (present(spec_name_cw)) then + spec_name_cw = bins%comps(mm)%camname_mmr_c(s_idx) + endif + +end subroutine rad_cnst_get_info_by_bin_spec + +!================================================================================================ subroutine rad_cnst_get_info_by_mode_spec(list_idx, m_idx, s_idx, & spec_type, spec_name, spec_name_cw) @@ -1029,7 +1252,7 @@ subroutine init_mode_comps(modes) ! Local variables integer :: m, ispec, nspec - character(len=*), parameter :: routine = 'init_modes' + character(len=*), parameter :: routine = 'init_mode_comps' !----------------------------------------------------------------------------- do m = 1, modes%nmodes @@ -1067,6 +1290,61 @@ end subroutine init_mode_comps !================================================================================================ +subroutine init_bin_comps(bins) + + ! Initialize the mode definitions by looking up the relevent indices in the + ! constituent and pbuf arrays, and getting the physprop IDs + + ! Arguments + type(bins_t), intent(inout) :: bins + + ! Local variables + integer :: m, ispec, nspec + + character(len=*), parameter :: routine = 'init_bin_comps' + !----------------------------------------------------------------------------- + + do m = 1, bins%nbins + + ! indices for number mixing ratio components + bins%comps(m)%idx_num_a = get_cam_idx(bins%comps(m)%source_num_a, bins%comps(m)%camname_num_a, routine) + bins%comps(m)%idx_num_c = get_cam_idx(bins%comps(m)%source_num_c, bins%comps(m)%camname_num_c, routine) + if ( bins%comps(m)%source_mass_a /= 'NOTSET' .and. bins%comps(m)%camname_mass_a /= 'NOTSET' ) then + bins%comps(m)%idx_mass_a = get_cam_idx(bins%comps(m)%source_mass_a, bins%comps(m)%camname_mass_a, routine) + endif + if ( bins%comps(m)%source_mass_c /= 'NOTSET' .and. bins%comps(m)%camname_mass_c /= 'NOTSET' ) then + bins%comps(m)%idx_mass_c = get_cam_idx(bins%comps(m)%source_mass_c, bins%comps(m)%camname_mass_c, routine) + endif + + ! allocate memory for species + nspec = bins%comps(m)%nspec + allocate( & + bins%comps(m)%idx_mmr_a(nspec), & + bins%comps(m)%idx_mmr_c(nspec), & + bins%comps(m)%idx_props(nspec) ) + + do ispec = 1, nspec + + ! indices for species mixing ratio components + bins%comps(m)%idx_mmr_a(ispec) = get_cam_idx(bins%comps(m)%source_mmr_a(ispec), & + bins%comps(m)%camname_mmr_a(ispec), routine) + bins%comps(m)%idx_mmr_c(ispec) = get_cam_idx(bins%comps(m)%source_mmr_c(ispec), & + bins%comps(m)%camname_mmr_c(ispec), routine) + + ! get physprop ID + bins%comps(m)%idx_props(ispec) = physprop_get_id(bins%comps(m)%props(ispec)) + if (bins%comps(m)%idx_props(ispec) == -1) then + call endrun(routine//' : ERROR idx not found for '//trim(bins%comps(m)%props(ispec))) + end if + + end do + + end do + +end subroutine init_bin_comps + +!================================================================================================ + integer function get_cam_idx(source, name, routine) ! get index of name in internal CAM array; either the constituent array @@ -1110,7 +1388,7 @@ end function get_cam_idx !================================================================================================ -subroutine list_init1(namelist, gaslist, aerlist, ma_list) +subroutine list_init1(namelist, gaslist, aerlist, ma_list, sa_list) ! Initialize the gas and bulk and modal aerosol lists with the ! entities specified in the climate or diagnostic lists. @@ -1123,11 +1401,11 @@ subroutine list_init1(namelist, gaslist, aerlist, ma_list) type(gaslist_t), intent(inout) :: gaslist type(aerlist_t), intent(inout) :: aerlist type(modelist_t), intent(inout) :: ma_list - + type(binlist_t), intent(inout) :: sa_list ! Local variables - integer :: ii, m, naero, nmodes - integer :: igas, ba_idx, ma_idx + integer :: ii, m, naero, nmodes, nbins + integer :: igas, ba_idx, ma_idx, sa_idx integer :: istat character(len=*), parameter :: routine = 'list_init1' !----------------------------------------------------------------------------- @@ -1138,12 +1416,15 @@ subroutine list_init1(namelist, gaslist, aerlist, ma_list) ! Determine the number of bulk aerosols and aerosol modes in the list naero = 0 nmodes = 0 + nbins = 0 do ii = 1, namelist%ncnst if (trim(namelist%type(ii)) == 'A') naero = naero + 1 if (trim(namelist%type(ii)) == 'M') nmodes = nmodes + 1 + if (trim(namelist%type(ii)) == 'B') nbins = nbins + 1 end do aerlist%numaerosols = naero ma_list%nmodes = nmodes + sa_list%nbins = nbins ! allocate storage for the aerosol, gas, and mode lists allocate( & @@ -1152,6 +1433,9 @@ subroutine list_init1(namelist, gaslist, aerlist, ma_list) ma_list%idx(ma_list%nmodes), & ma_list%physprop_files(ma_list%nmodes), & ma_list%idx_props(ma_list%nmodes), & + sa_list%idx(sa_list%nbins), & + sa_list%physprop_files(sa_list%nbins), & + sa_list%idx_props(sa_list%nbins), & stat=istat) if (istat /= 0) call endrun(routine//': allocate ERROR; aero and gas list components') @@ -1166,6 +1450,7 @@ subroutine list_init1(namelist, gaslist, aerlist, ma_list) ! Loop over the radiatively active components specified in the namelist ba_idx = 0 ma_idx = 0 + sa_idx = 0 do ii = 1, namelist%ncnst if (masterproc .and. verbose) & @@ -1174,8 +1459,9 @@ subroutine list_init1(namelist, gaslist, aerlist, ma_list) ! Check that the source specifier is legal. if (namelist%source(ii) /= 'A' .and. namelist%source(ii) /= 'M' .and. & - namelist%source(ii) /= 'N' .and. namelist%source(ii) /= 'Z' ) then - call endrun(routine//": source must either be A, M, N or Z:"//& + namelist%source(ii) /= 'N' .and. namelist%source(ii) /= 'Z' .and. & + namelist%source(ii) /= 'B' ) then + call endrun(routine//": source must either be A, B, M, N or Z:"//& " illegal specifier in namelist input: "//namelist%source(ii)) end if @@ -1209,6 +1495,26 @@ subroutine list_init1(namelist, gaslist, aerlist, ma_list) ! Also save the name of the physprop file ma_list%physprop_files(ma_idx) = namelist%radname(ii) + else if (namelist%type(ii) == 'B') then + + ! Add to modal aerosol list + sa_idx = sa_idx + 1 + + ! Look through the bin definitions for the name of the specified bin. The + ! index into the modes object all the information relevent to the mode definition. + sa_list%idx(sa_idx) = -1 + do m = 1, bins%nbins + if (trim(namelist%camname(ii)) == trim(bins%names(m))) then + sa_list%idx(sa_idx) = m + exit + end if + end do + if (sa_list%idx(sa_idx) == -1) & + call endrun(routine//' ERROR cannot find bin name '//trim(namelist%camname(ii))) + + ! Also save the name of the physprop file + sa_list%physprop_files(sa_idx) = namelist%radname(ii) + else ! Add to gas list @@ -1235,7 +1541,7 @@ end subroutine list_init1 !================================================================================================ -subroutine list_init2(gaslist, aerlist, ma_list) +subroutine list_init2(gaslist, aerlist, ma_list, sa_list) ! Final initialization phase gets the component indices in the constituent array ! and the physics buffer, and indices into physprop module. @@ -1243,6 +1549,7 @@ subroutine list_init2(gaslist, aerlist, ma_list) type(gaslist_t), intent(inout) :: gaslist type(aerlist_t), intent(inout) :: aerlist type(modelist_t), intent(inout) :: ma_list + type(binlist_t), intent(inout) :: sa_list ! Local variables integer :: i @@ -1276,6 +1583,14 @@ subroutine list_init2(gaslist, aerlist, ma_list) end do + ! Loop over bins + do i = 1, sa_list%nbins + + ! get the physprop_id from the phys_prop module + sa_list%idx_props(i) = physprop_get_id(sa_list%physprop_files(i)) + + end do + end subroutine list_init2 !================================================================================================ @@ -1490,7 +1805,6 @@ subroutine parse_mode_defs(nl_in, modes) call endrun(routine//': ERROR allocating storage for modes') end if - mcur = 1 ! index of current string being processed ! loop over modes @@ -1727,60 +2041,428 @@ end subroutine parse_mode_defs !================================================================================================ -subroutine parse_rad_specifier(specifier, namelist_data) +subroutine parse_bin_defs(nl_in, bins) -!----------------------------------------------------------------------------- -! Private method for parsing the radiation namelist specifiers. The specifiers -! are of the form 'source_camname:radname' where: -! source -- either 'N' for pbuf (non-advected) or 'A' for state (advected) -! camname -- the name of a constituent that must be found in the constituent -! component of the state when source=A or in the physics buffer -! when source=N -! radname -- For gases this is a name that identifies the constituent to the -! radiative transfer codes. These names are contained in the -! radconstants module. For aerosols this is a filename, which is -! identified by a ".nc" suffix. The file contains optical and -! other physical properties of the aerosol. -! -! This code also identifies whether the constituent is a gas or an aerosol -! and adds that info to a structure that stores the parsed data. -!----------------------------------------------------------------------------- + ! Parse the bin definition specifiers. The specifiers are of the form: + ! + ! 'bin_name:=', + ! 'source_num_a:camname_num_a:source_num_c:camname_num_c:num_mr:+', + ! 'source_mmr_a:camname_mmr_a:source_mmr_c:camname_mmr_c:spec_type:prop_file[:+]'[,] + ! ['source_mmr_a:camname_mmr_a:source_mmr_c:camname_mmr_c:spec_type:prop_file][:+]['] + ! + ! where the ':' separated fields are: + ! bin_name -- name of the bin. + ! = -- this line terminator identifies the initial string in a + ! mode definition + ! + -- this line terminator indicates that the mode definition is + ! continued in the next string + ! source_num_a -- Source of interstitial number mixing ratio, 'A', 'N', or 'Z' + ! camname_num_a -- the name of the interstitial number component. This name must be + ! registered in the constituent arrays when source=A or in the + ! physics buffer when source=N + ! source_num_c -- Source of cloud borne number mixing ratio, 'A', 'N', or 'Z' + ! camname_num_c -- the name of the cloud borne number component. This name must be + ! registered in the constituent arrays when source=A or in the + ! physics buffer when source=N + ! source_mmr_a -- Source of interstitial specie mass mixing ratio, 'A', 'N' or 'Z' + ! camname_mmr_a -- the name of the interstitial specie. This name must be + ! registered in the constituent arrays when source=A or in the + ! physics buffer when source=N + ! source_mmr_c -- Source of cloud borne specie mass mixing ratio, 'A', 'N' or 'Z' + ! camname_mmr_c -- the name of the cloud borne specie. This name must be + ! registered in the constituent arrays when source=A or in the + ! physics buffer when source=N + ! spec_type -- species type. Valid values are particle, shell, and core. + ! prop_file -- For aerosol species this is a filename, which is + ! identified by a ".nc" suffix. The file contains optical and + ! other physical properties of the aerosol. + ! + ! A bin definition must contain at least 1 string for the species and can contain + ! a maximum of 1 particle type. - character(len=*), dimension(:), intent(in) :: specifier - type(rad_cnst_namelist_t), intent(inout) :: namelist_data - ! Local variables - integer :: number, i, j - integer :: ipos, strlen - integer :: astat - character(len=cs1) :: tmpstr - character(len=1) :: source(n_rad_cnst) - character(len=64) :: camname(n_rad_cnst) - character(len=cs1) :: radname(n_rad_cnst) - character(len=1) :: type(n_rad_cnst) - !------------------------------------------------------------------------- + character(len=*), intent(inout) :: nl_in(:) ! namelist input (blanks are removed on output) + type(bins_t), intent(inout) :: bins ! structure containing parsed input - number = 0 + ! Local variables + logical :: num_mr_found, mass_mr_found + logical :: particle_mr_found + integer :: m + integer :: istat + integer :: nbins, nstr, istr + integer :: mbeg, mcur + integer :: nspec, ispec + integer :: strlen, ibeg, iend, ipos + logical :: part_mr_found + character(len=*), parameter :: routine = 'parse_bin_defs' + character(len=len(nl_in(1))) :: tmpstr + character(len=1) :: tmp_src_a + character(len=32) :: tmp_name_a + character(len=1) :: tmp_src_c + character(len=32) :: tmp_name_c + character(len=32) :: tmp_type + character(len=32) :: tmp_morph + !------------------------------------------------------------------------- - parse_loop: do i = 1, n_rad_cnst - if ( len_trim(specifier(i)) == 0 ) then - exit parse_loop - endif + ! Determine number of bins defined by counting number of strings that are + ! terminated by ':=' + ! (algorithm stops counting at first blank element). + nbins = 0 + nstr = 0 + do m = 1, n_bin_str + + if (len_trim(nl_in(m)) == 0) exit + nstr = nstr + 1 ! There are no fields in the input strings in which a blank character is allowed. ! To simplify the parsing go through the input strings and remove blanks. - tmpstr = adjustl(specifier(i)) + tmpstr = adjustl(nl_in(m)) + nl_in(m) = tmpstr do - strlen = len_trim(tmpstr) - ipos = index(tmpstr, ' ') + strlen = len_trim(nl_in(m)) + ipos = index(nl_in(m), ' ') if (ipos == 0 .or. ipos > strlen) exit - tmpstr = tmpstr(:ipos-1) // tmpstr(ipos+1:strlen) + tmpstr = nl_in(m)(:ipos-1) // nl_in(m)(ipos+1:strlen) + nl_in(m) = tmpstr end do + ! count strings with ':=' terminator + if (nl_in(m)(strlen-1:strlen) == ':=') nbins = nbins + 1 - ! Locate the ':' separating source from camname. - j = index(tmpstr, ':') - source(i) = tmpstr(:j-1) - tmpstr = tmpstr(j+1:) + end do + bins%nbins = nbins + + ! return if no bins defined + if (nbins == 0) return + + ! allocate components that depend on nmodes + allocate( & + bins%names(nbins), & + bins%comps(nbins), & + stat=istat ) + if (istat > 0) then + write(iulog,*) routine//': ERROR: cannot allocate storage for bins. nbins=', nbins + call endrun(routine//': ERROR allocating storage for bins') + end if + + mcur = 1 ! index of current string being processed + + ! loop over bins + bins_loop: do m = 1, nbins + + mbeg = mcur ! remember the first string of a bin + + ! check that first string in bin definition is ':=' terminated + iend = len_trim(nl_in(mcur)) + if (nl_in(mcur)(iend-1:iend) /= ':=') call parse_error('= not found', nl_in(mcur)) + + ! count species in bin definition. definition will contain 1 string with + ! with a ':+' terminator for each specie + nspec = 0 + mcur = mcur + 1 + do + iend = len_trim(nl_in(mcur)) + if (nl_in(mcur)(iend-1:iend) /= ':+') exit + if (nl_in(mcur)(iend-4:iend) /= 'mmr:+') nspec = nspec + 1 + mcur = mcur + 1 + end do + + ! a bin must have at least one specie + if (nspec == 0) call parse_error('bin must have at least one specie', nl_in(mbeg)) + + ! allocate components that depend on number of species + allocate( & + bins%comps(m)%source_mmr_a(nspec), & + bins%comps(m)%camname_mmr_a(nspec), & + bins%comps(m)%source_mmr_c(nspec), & + bins%comps(m)%camname_mmr_c(nspec), & + bins%comps(m)%type(nspec), & + bins%comps(m)%morph(nspec), & + bins%comps(m)%props(nspec), & + stat=istat) + + if (istat > 0) then + write(iulog,*) routine//': ERROR: cannot allocate storage for species. nspec=', nspec + call endrun(routine//': ERROR allocating storage for species') + end if + + ! initialize components + bins%comps(m)%nspec = nspec + bins%comps(m)%source_num_a = ' ' + bins%comps(m)%camname_num_a = ' ' + bins%comps(m)%source_num_c = ' ' + bins%comps(m)%camname_num_c = ' ' + bins%comps(m)%source_mass_a = 'NOTSET' + bins%comps(m)%camname_mass_a = 'NOTSET' + bins%comps(m)%source_mass_c = 'NOTSET' + bins%comps(m)%camname_mass_c = 'NOTSET' + do ispec = 1, nspec + bins%comps(m)%source_mmr_a(ispec) = ' ' + bins%comps(m)%camname_mmr_a(ispec) = ' ' + bins%comps(m)%source_mmr_c(ispec) = ' ' + bins%comps(m)%camname_mmr_c(ispec) = ' ' + bins%comps(m)%type(ispec) = ' ' + bins%comps(m)%props(ispec) = ' ' + end do + + ! return to first string in mode definition + mcur = mbeg + tmpstr = nl_in(mcur) + + ! bin name + ipos = index(tmpstr, ':') + if (ipos < 2) call parse_error('bin name not found', tmpstr) + bins%names(m) = tmpstr(:ipos-1) + tmpstr = tmpstr(ipos+1:) + + ! bin name must be followed by '=' + if (tmpstr(1:1) /= '=') call parse_error('= not found', tmpstr) + + ! move to next string + mcur = mcur + 1 + tmpstr = nl_in(mcur) + + ! process bin component strings + particle_mr_found = .false. ! keep track of whether particle mixing ratio component is found + num_mr_found = .false. ! keep track of whether number mixing ratio component is found + mass_mr_found = .false. ! keep track of whether number mixing ratio component is found + ispec = 0 ! keep track of the number of species found + comps_loop: do + + ! source of interstitial component + ipos = index(tmpstr, ':') + if (ipos < 2) call parse_error('expect to find source field first', tmpstr) + ! check for valid source + if (tmpstr(:ipos-1) /= 'A' .and. tmpstr(:ipos-1) /= 'N' .and. tmpstr(:ipos-1) /= 'Z') & + call parse_error('source must be A, N or Z', tmpstr) + tmp_src_a = tmpstr(:ipos-1) + tmpstr = tmpstr(ipos+1:) + + ! name of interstitial component + ipos = index(tmpstr, ':') + if (ipos == 0) call parse_error('next separator not found', tmpstr) + tmp_name_a = tmpstr(:ipos-1) + tmpstr = tmpstr(ipos+1:) + + ! source of cloud borne component + ipos = index(tmpstr, ':') + if (ipos < 2) call parse_error('expect to find a source field', tmpstr) + ! check for valid source + if (tmpstr(:ipos-1) /= 'A' .and. tmpstr(:ipos-1) /= 'N' .and. tmpstr(:ipos-1) /= 'Z') & + call parse_error('source must be A, N or Z', tmpstr) + tmp_src_c = tmpstr(:ipos-1) + tmpstr = tmpstr(ipos+1:) + + ! name of cloud borne component + ipos = index(tmpstr, ':') + if (ipos == 0) call parse_error('next separator not found', tmpstr) + tmp_name_c = tmpstr(:ipos-1) + tmpstr = tmpstr(ipos+1:) + + ! component type + ipos = scan(tmpstr, ': ') + if (ipos == 0) call parse_error('next separator not found', tmpstr) + + if (tmpstr(:ipos-1) == 'num') then + + ! there can only be one number mixing ratio component + if (num_mr_found) call parse_error('more than 1 number component', nl_in(mcur)) + + num_mr_found = .true. + bins%comps(m)%source_num_a = tmp_src_a + bins%comps(m)%camname_num_a = tmp_name_a + bins%comps(m)%source_num_c = tmp_src_c + bins%comps(m)%camname_num_c = tmp_name_c + tmpstr = tmpstr(ipos+1:) + + else if (tmpstr(:ipos-1) == 'mmr') then + + ! there can only be one number mixing ratio component + if (mass_mr_found) call parse_error('more than 1 mass mixing ratio component', nl_in(mcur)) + + mass_mr_found = .true. + bins%comps(m)%source_mass_a = tmp_src_a + bins%comps(m)%camname_mass_a = tmp_name_a + bins%comps(m)%source_mass_c = tmp_src_c + bins%comps(m)%camname_mass_c = tmp_name_c + tmpstr = tmpstr(ipos+1:) + + else + + ! check for valid species type + call check_bin_type(tmpstr, 1, ipos-1) + tmp_type = tmpstr(:ipos-1) + tmpstr = tmpstr(ipos+1:) + + ipos = index(tmpstr, ':') + if (ipos == 0) call parse_error('next separator not found', tmpstr) + + ! check for valid species type + call check_bin_morph(tmpstr, 1, ipos-1) + tmp_morph = tmpstr(:ipos-1) + tmpstr = tmpstr(ipos+1:) + + ! get the properties file + ipos = scan(tmpstr, ': ') + if (ipos == 0) call parse_error('next separator not found', tmpstr) + + ! check for valid filename -- must have .nc extension + if (tmpstr(ipos-3:ipos-1) /= '.nc') & + call parse_error('filename not valid', tmpstr) + + ispec = ispec + 1 + + bins%comps(m)%source_mmr_a(ispec) = tmp_src_a + bins%comps(m)%camname_mmr_a(ispec) = tmp_name_a + bins%comps(m)%source_mmr_c(ispec) = tmp_src_c + bins%comps(m)%camname_mmr_c(ispec) = tmp_name_c + bins%comps(m)%type(ispec) = tmp_type + bins%comps(m)%morph(ispec) = tmp_morph + + bins%comps(m)%props(ispec) = tmpstr(:ipos-1) + tmpstr = tmpstr(ipos+1:) + + endif + + ! check if there are more components. either the current character is + ! a ' ' which means this string is the final mode component, or the character + ! is a '+' which means there are more components + if (tmpstr(1:1) == ' ') then + exit comps_loop + endif + + if (tmpstr(1:1) /= '+') & + call parse_error('+ field not found', tmpstr) + + ! continue to next component... + mcur = mcur + 1 + tmpstr = nl_in(mcur) + end do comps_loop + + + ! check that a number component was found + if (.not. num_mr_found) call parse_error('number component not found', nl_in(mbeg)) + + ! check that the right number of species were found + if (ispec /= nspec) then + write(*,*) 'ispec, nspec = ',ispec, nspec + call parse_error('component parsing got wrong number of species', nl_in(mbeg)) + endif + + ! continue to next bin... + mcur = mcur + 1 + tmpstr = nl_in(mcur) + end do bins_loop + + !------------------------------------------------------------------------------------------------ + contains + !------------------------------------------------------------------------------------------------ + + ! internal subroutines used for error checking and reporting + + subroutine parse_error(msg, str) + + character(len=*), intent(in) :: msg + character(len=*), intent(in) :: str + + write(iulog,*) routine//': ERROR: '//msg + write(iulog,*) ' input string: '//trim(str) + call endrun(routine//': ERROR: '//msg) + + end subroutine parse_error + + !------------------------------------------------------------------------------------------------ + + subroutine check_bin_morph(str, ib, ie) + + character(len=*), intent(in) :: str + integer, intent(in) :: ib, ie + + integer :: i + + do i = 1, num_bin_morphs + if (str(ib:ie) == trim(bin_morph_names(i))) return + end do + + call parse_error('bin morph not valid', str(ib:ie)) + + end subroutine check_bin_morph + + !------------------------------------------------------------------------------------------------ + subroutine check_bin_type(str, ib, ie) + + character(len=*), intent(in) :: str + integer, intent(in) :: ib, ie ! begin, end character of mode type substring + + integer :: i + + do i = 1, num_spec_types + if (str(ib:ie) == trim(spec_type_names(i))) return + end do + + call parse_error('bin species type not valid', str(ib:ie)) + + end subroutine check_bin_type + + !------------------------------------------------------------------------------------------------ + +end subroutine parse_bin_defs + +!================================================================================================ + +subroutine parse_rad_specifier(specifier, namelist_data) + +!----------------------------------------------------------------------------- +! Private method for parsing the radiation namelist specifiers. The specifiers +! are of the form 'source_camname:radname' where: +! source -- either 'N' for pbuf (non-advected) or 'A' for state (advected) +! camname -- the name of a constituent that must be found in the constituent +! component of the state when source=A or in the physics buffer +! when source=N +! radname -- For gases this is a name that identifies the constituent to the +! radiative transfer codes. These names are contained in the +! radconstants module. For aerosols this is a filename, which is +! identified by a ".nc" suffix. The file contains optical and +! other physical properties of the aerosol. +! +! This code also identifies whether the constituent is a gas or an aerosol +! and adds that info to a structure that stores the parsed data. +!----------------------------------------------------------------------------- + + character(len=*), dimension(:), intent(in) :: specifier + type(rad_cnst_namelist_t), intent(inout) :: namelist_data + + ! Local variables + integer :: number, i, j + integer :: ipos, strlen + integer :: astat + character(len=cs1) :: tmpstr + character(len=1) :: source(n_rad_cnst) + character(len=64) :: camname(n_rad_cnst) + character(len=cs1) :: radname(n_rad_cnst) + character(len=1) :: type(n_rad_cnst) + !------------------------------------------------------------------------- + + number = 0 + + parse_loop: do i = 1, n_rad_cnst + if ( len_trim(specifier(i)) == 0 ) then + exit parse_loop + endif + + ! There are no fields in the input strings in which a blank character is allowed. + ! To simplify the parsing go through the input strings and remove blanks. + tmpstr = adjustl(specifier(i)) + do + strlen = len_trim(tmpstr) + ipos = index(tmpstr, ' ') + if (ipos == 0 .or. ipos > strlen) exit + tmpstr = tmpstr(:ipos-1) // tmpstr(ipos+1:strlen) + end do + + ! Locate the ':' separating source from camname. + j = index(tmpstr, ':') + source(i) = tmpstr(:j-1) + tmpstr = tmpstr(j+1:) ! locate the ':' separating camname from radname j = scan(tmpstr, ':') @@ -1791,6 +2473,8 @@ subroutine parse_rad_specifier(specifier, namelist_data) ! determine the type of constituent if (source(i) == 'M') then type(i) = 'M' + else if (source(i) == 'B') then + type(i) = 'B' else if(index(radname(i),".nc") .gt. 0) then type(i) = 'A' else @@ -1945,29 +2629,263 @@ end subroutine rad_cnst_get_mam_mmr_by_idx !================================================================================================ -subroutine rad_cnst_get_mam_mmr_idx(mode_idx, spec_idx, idx) - - ! Return constituent index of mam specie mass mixing ratio for aerosol modes in - ! the climate list. +subroutine rad_cnst_get_bin_mmr_by_idx(list_idx, bin_idx, spec_idx, phase, state, pbuf, mmr) + + ! Return pointer to mass mixing ratio for the modal aerosol specie from the specified + ! climate or diagnostic list. + + ! Arguments + integer, intent(in) :: list_idx ! index of the climate or a diagnostic list + integer, intent(in) :: bin_idx ! mode index + integer, intent(in) :: spec_idx ! index of specie in the mode + character(len=1), intent(in) :: phase ! 'a' for interstitial, 'c' for cloud borne + type(physics_state), target, intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + real(r8), pointer :: mmr(:,:) + + ! Local variables + integer :: s_idx + integer :: idx + integer :: lchnk + character(len=1) :: source + type(binlist_t), pointer :: slist + character(len=*), parameter :: subname = 'rad_cnst_get_bin_mmr_by_idx' + !----------------------------------------------------------------------------- + + if (list_idx >= 0 .and. list_idx <= N_DIAG) then + slist => sa_list(list_idx) + else + write(iulog,*) subname//': list_idx =', list_idx + call endrun(subname//': list_idx out of bounds') + endif + + ! Check for valid mode index + if (bin_idx < 1 .or. bin_idx > slist%nbins) then + write(iulog,*) subname//': bin_idx= ', bin_idx, ' nbins= ', slist%nbins + call endrun(subname//': bin list index out of range') + end if + + ! Get the index for the corresponding mode in the mode definition object + s_idx = slist%idx(bin_idx) + + ! Check for valid specie index + if (spec_idx < 1 .or. spec_idx > bins%comps(s_idx)%nspec) then + write(iulog,*) subname//': spec_idx= ', spec_idx, ' nspec= ', bins%comps(s_idx)%nspec + call endrun(subname//': specie list index out of range') + end if + + ! Get data source + if (phase == 'a') then + source = bins%comps(s_idx)%source_mmr_a(spec_idx) + idx = bins%comps(s_idx)%idx_mmr_a(spec_idx) + else if (phase == 'c') then + source = bins%comps(s_idx)%source_mmr_c(spec_idx) + idx = bins%comps(s_idx)%idx_mmr_c(spec_idx) + else + write(iulog,*) subname//': phase= ', phase + call endrun(subname//': unrecognized phase; must be "a" or "c"') + end if + + lchnk = state%lchnk + + select case( source ) + case ('A') + mmr => state%q(:,:,idx) + case ('N') + call pbuf_get_field(pbuf, idx, mmr) + case ('Z') + mmr => zero_cols + end select + +end subroutine rad_cnst_get_bin_mmr_by_idx + +!================================================================================================ + +subroutine rad_cnst_get_mam_mmr_idx(mode_idx, spec_idx, idx) + + ! Return constituent index of mam specie mass mixing ratio for aerosol modes in + ! the climate list. + + ! This is a special routine to allow direct access to information in the + ! constituent array inside physics parameterizations that have been passed, + ! and are operating over the entire constituent array. The interstitial phase + ! is assumed since that's what is contained in the constituent array. + + ! Arguments + integer, intent(in) :: mode_idx ! mode index + integer, intent(in) :: spec_idx ! index of specie in the mode + integer, intent(out) :: idx ! index of specie in the constituent array + + ! Local variables + integer :: m_idx + type(modelist_t), pointer :: mlist + character(len=*), parameter :: subname = 'rad_cnst_get_mam_mmr_idx' + !----------------------------------------------------------------------------- + + ! assume climate list (i.e., species are in the constituent array) + mlist => ma_list(0) + + ! Check for valid mode index + if (mode_idx < 1 .or. mode_idx > mlist%nmodes) then + write(iulog,*) subname//': mode_idx= ', mode_idx, ' nmodes= ', mlist%nmodes + call endrun(subname//': mode list index out of range') + end if + + ! Get the index for the corresponding mode in the mode definition object + m_idx = mlist%idx(mode_idx) + + ! Check for valid specie index + if (spec_idx < 1 .or. spec_idx > modes%comps(m_idx)%nspec) then + write(iulog,*) subname//': spec_idx= ', spec_idx, ' nspec= ', modes%comps(m_idx)%nspec + call endrun(subname//': specie list index out of range') + end if + + ! Assume data source is interstitial since that's what's in the constituent array + idx = modes%comps(m_idx)%idx_mmr_a(spec_idx) + +end subroutine rad_cnst_get_mam_mmr_idx + +!================================================================================================ + +subroutine rad_cnst_get_carma_mmr_idx(bin_idx, spec_idx, idx) + + ! Return constituent index of camra species mass mixing ratio for aerosol bins in + ! the climate list. + + ! This is a special routine to allow direct access to information in the + ! constituent array inside physics parameterizations that have been passed, + ! and are operating over the entire constituent array. The interstitial phase + ! is assumed since that's what is contained in the constituent array. + + ! Arguments + integer, intent(in) :: bin_idx ! bin index + integer, intent(in) :: spec_idx ! index of specie in the bin + integer, intent(out) :: idx ! index of specie in the constituent array + + ! Local variables + integer :: b_idx + type(binlist_t), pointer :: slist + character(len=*), parameter :: subname = 'rad_cnst_get_carma_mmr_idx' + !----------------------------------------------------------------------------- + + ! assume climate list (i.e., species are in the constituent array) + slist => sa_list(0) + + ! Check for valid bin index + if (bin_idx < 1 .or. bin_idx > slist%nbins) then + write(iulog,*) subname//': bin_idx= ', bin_idx, ' nbins= ', slist%nbins + call endrun(subname//': bin list index out of range') + end if + + ! Get the index for the corresponding bin in the bin definition object + b_idx = slist%idx(bin_idx) + + ! Check for valid specie index + if (spec_idx < 1 .or. spec_idx > bins%comps(b_idx)%nspec) then + write(iulog,*) subname//': spec_idx= ', spec_idx, ' nspec= ', bins%comps(b_idx)%nspec + call endrun(subname//': specie list index out of range') + end if + + ! Assume data source is interstitial since that's what's in the constituent array + idx = bins%comps(b_idx)%idx_mmr_a(spec_idx) + +end subroutine rad_cnst_get_carma_mmr_idx + +!================================================================================================ + +subroutine rad_cnst_get_bin_mmr(list_idx, bin_idx, phase, state, pbuf, mmr) + + ! Return pointer to mass mixing ratio for the aerosol bin from the specified + ! climate or diagnostic list. + + ! Arguments + integer, intent(in) :: list_idx ! index of the climate or a diagnostic list + integer, intent(in) :: bin_idx ! bin index + character(len=1), intent(in) :: phase ! 'a' for interstitial, 'c' for cloud borne + type(physics_state), target, intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + real(r8), pointer :: mmr(:,:) + + ! Local variables + integer :: m_idx + integer :: idx + integer :: lchnk + character(len=1) :: source + type(binlist_t), pointer :: slist + character(len=*), parameter :: subname = 'rad_cnst_get_bin_mmr' + !----------------------------------------------------------------------------- + + if (list_idx >= 0 .and. list_idx <= N_DIAG) then + slist => sa_list(list_idx) + else + write(iulog,*) subname//': list_idx =', list_idx + call endrun(subname//': list_idx out of bounds') + endif + + ! Check for valid bin index + if (bin_idx < 1 .or. bin_idx > slist%nbins) then + write(iulog,*) subname//': bin_idx= ', bin_idx, ' nbins= ', slist%nbins + call endrun(subname//': bin list index out of range') + end if + + ! Get the index for the corresponding bin in the bin definition object + m_idx = slist%idx(bin_idx) + + ! Get data source + if (phase == 'a') then + source = bins%comps(m_idx)%source_mass_a + idx = bins%comps(m_idx)%idx_mass_a + else if (phase == 'c') then + source = bins%comps(m_idx)%source_mass_c + idx = bins%comps(m_idx)%idx_mass_c + else + write(iulog,*) subname//': phase= ', phase + call endrun(subname//': unrecognized phase; must be "a" or "c"') + end if + + lchnk = state%lchnk + + select case( source ) + case ('A') + mmr => state%q(:,:,idx) + case ('N') + call pbuf_get_field(pbuf, idx, mmr) + case ('Z') + mmr => zero_cols + end select + +end subroutine rad_cnst_get_bin_mmr + +!================================================================================================ + +subroutine rad_cnst_get_mode_num(list_idx, mode_idx, phase, state, pbuf, num) - ! This is a special routine to allow direct access to information in the - ! constituent array inside physics parameterizations that have been passed, - ! and are operating over the entire constituent array. The interstitial phase - ! is assumed since that's what is contained in the constituent array. + ! Return pointer to number mixing ratio for the aerosol mode from the specified + ! climate or diagnostic list. ! Arguments - integer, intent(in) :: mode_idx ! mode index - integer, intent(in) :: spec_idx ! index of specie in the mode - integer, intent(out) :: idx ! index of specie in the constituent array + integer, intent(in) :: list_idx ! index of the climate or a diagnostic list + integer, intent(in) :: mode_idx ! mode index + character(len=1), intent(in) :: phase ! 'a' for interstitial, 'c' for cloud borne + type(physics_state), target, intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + real(r8), pointer :: num(:,:) ! Local variables integer :: m_idx + integer :: idx + integer :: lchnk + character(len=1) :: source type(modelist_t), pointer :: mlist - character(len=*), parameter :: subname = 'rad_cnst_get_mam_mmr_idx' + character(len=*), parameter :: subname = 'rad_cnst_get_mode_num' !----------------------------------------------------------------------------- - ! assume climate list (i.e., species are in the constituent array) - mlist => ma_list(0) + if (list_idx >= 0 .and. list_idx <= N_DIAG) then + mlist => ma_list(list_idx) + else + write(iulog,*) subname//': list_idx =', list_idx + call endrun(subname//': list_idx out of bounds') + endif ! Check for valid mode index if (mode_idx < 1 .or. mode_idx > mlist%nmodes) then @@ -1978,27 +2896,41 @@ subroutine rad_cnst_get_mam_mmr_idx(mode_idx, spec_idx, idx) ! Get the index for the corresponding mode in the mode definition object m_idx = mlist%idx(mode_idx) - ! Check for valid specie index - if (spec_idx < 1 .or. spec_idx > modes%comps(m_idx)%nspec) then - write(iulog,*) subname//': spec_idx= ', spec_idx, ' nspec= ', modes%comps(m_idx)%nspec - call endrun(subname//': specie list index out of range') + ! Get data source + if (phase == 'a') then + source = modes%comps(m_idx)%source_num_a + idx = modes%comps(m_idx)%idx_num_a + else if (phase == 'c') then + source = modes%comps(m_idx)%source_num_c + idx = modes%comps(m_idx)%idx_num_c + else + write(iulog,*) subname//': phase= ', phase + call endrun(subname//': unrecognized phase; must be "a" or "c"') end if - ! Assume data source is interstitial since that's what's in the constituent array - idx = modes%comps(m_idx)%idx_mmr_a(spec_idx) + lchnk = state%lchnk -end subroutine rad_cnst_get_mam_mmr_idx + select case( source ) + case ('A') + num => state%q(:,:,idx) + case ('N') + call pbuf_get_field(pbuf, idx, num) + case ('Z') + num => zero_cols + end select + +end subroutine rad_cnst_get_mode_num !================================================================================================ -subroutine rad_cnst_get_mode_num(list_idx, mode_idx, phase, state, pbuf, num) +subroutine rad_cnst_get_bin_num(list_idx, bin_idx, phase, state, pbuf, num) - ! Return pointer to number mixing ratio for the aerosol mode from the specified + ! Return pointer to number mixing ratio for the aerosol bin from the specified ! climate or diagnostic list. ! Arguments integer, intent(in) :: list_idx ! index of the climate or a diagnostic list - integer, intent(in) :: mode_idx ! mode index + integer, intent(in) :: bin_idx ! bin index character(len=1), intent(in) :: phase ! 'a' for interstitial, 'c' for cloud borne type(physics_state), target, intent(in) :: state type(physics_buffer_desc), pointer :: pbuf(:) @@ -2009,33 +2941,33 @@ subroutine rad_cnst_get_mode_num(list_idx, mode_idx, phase, state, pbuf, num) integer :: idx integer :: lchnk character(len=1) :: source - type(modelist_t), pointer :: mlist - character(len=*), parameter :: subname = 'rad_cnst_get_mode_num' + type(binlist_t), pointer :: slist + character(len=*), parameter :: subname = 'rad_cnst_get_bin_num' !----------------------------------------------------------------------------- if (list_idx >= 0 .and. list_idx <= N_DIAG) then - mlist => ma_list(list_idx) + slist => sa_list(list_idx) else write(iulog,*) subname//': list_idx =', list_idx call endrun(subname//': list_idx out of bounds') endif - ! Check for valid mode index - if (mode_idx < 1 .or. mode_idx > mlist%nmodes) then - write(iulog,*) subname//': mode_idx= ', mode_idx, ' nmodes= ', mlist%nmodes - call endrun(subname//': mode list index out of range') + ! Check for valid bin index + if (bin_idx < 1 .or. bin_idx > slist%nbins) then + write(iulog,*) subname//': bin_idx= ', bin_idx, ' nbins= ', slist%nbins + call endrun(subname//': bin list index out of range') end if - ! Get the index for the corresponding mode in the mode definition object - m_idx = mlist%idx(mode_idx) + ! Get the index for the corresponding bin in the bin definition object + m_idx = slist%idx(bin_idx) ! Get data source if (phase == 'a') then - source = modes%comps(m_idx)%source_num_a - idx = modes%comps(m_idx)%idx_num_a + source = bins%comps(m_idx)%source_num_a + idx = bins%comps(m_idx)%idx_num_a else if (phase == 'c') then - source = modes%comps(m_idx)%source_num_c - idx = modes%comps(m_idx)%idx_num_c + source = bins%comps(m_idx)%source_num_c + idx = bins%comps(m_idx)%idx_num_c else write(iulog,*) subname//': phase= ', phase call endrun(subname//': unrecognized phase; must be "a" or "c"') @@ -2052,7 +2984,7 @@ subroutine rad_cnst_get_mode_num(list_idx, mode_idx, phase, state, pbuf, num) num => zero_cols end select -end subroutine rad_cnst_get_mode_num +end subroutine rad_cnst_get_bin_num !================================================================================================ @@ -2103,6 +3035,53 @@ end subroutine rad_cnst_get_mode_num_idx !================================================================================================ +subroutine rad_cnst_get_bin_num_idx(bin_idx, cnst_idx) + + ! Return constituent index of bin number mixing ratio for the aerosol bin in + ! the climate list. + + ! This is a special routine to allow direct access to information in the + ! constituent array inside physics parameterizations that have been passed, + ! and are operating over the entire constituent array. The interstitial phase + ! is assumed since that's what is contained in the constituent array. + + ! Arguments + integer, intent(in) :: bin_idx ! bin index + integer, intent(out) :: cnst_idx ! constituent index + + ! Local variables + integer :: b_idx + character(len=1) :: source + type(binlist_t), pointer :: slist + character(len=*), parameter :: subname = 'rad_cnst_get_bin_num_idx' + !----------------------------------------------------------------------------- + + ! assume climate list + slist => sa_list(0) + + ! Check for valid bin index + if (bin_idx < 1 .or. bin_idx > slist%nbins) then + write(iulog,*) subname//': bin_idx= ', bin_idx, ' nbins= ', slist%nbins + call endrun(subname//': bin list index out of range') + end if + + ! Get the index for the corresponding bin in the bin definition object + b_idx = slist%idx(bin_idx) + + ! Check that source is 'A' which means the index is for the constituent array + source = bins%comps(b_idx)%source_num_a + if (source /= 'A') then + write(iulog,*) subname//': source= ', source + call endrun(subname//': requested bin number index not in constituent array') + end if + + ! Return index in constituent array + cnst_idx = bins%comps(b_idx)%idx_num_a + +end subroutine rad_cnst_get_bin_num_idx + +!================================================================================================ + integer function rad_cnst_get_aer_idx(list_idx, aer_name) ! Return the index of aerosol aer_name in the list specified by list_idx. @@ -2352,6 +3331,121 @@ end subroutine rad_cnst_get_mam_props_by_idx !================================================================================================ +subroutine rad_cnst_get_bin_props_by_idx(list_idx, & + bin_idx, spec_idx, opticstype, & + sw_hygro_ext, sw_hygro_ssa, sw_hygro_asm, lw_hygro_ext, & + sw_nonhygro_ext, sw_nonhygro_ssa, sw_nonhygro_asm, & + sw_nonhygro_scat, sw_nonhygro_ascat, lw_ext, & + refindex_aer_sw, refindex_aer_lw, & + r_sw_ext, r_sw_scat, r_sw_ascat, r_lw_abs, mu, & + aername, density_aer, hygro_aer, dryrad_aer, dispersion_aer, & + num_to_mass_aer, spectype, specmorph) + + ! Return requested properties for the aerosol from the specified + ! climate or diagnostic list. + + use phys_prop, only: physprop_get + + ! Arguments + integer, intent(in) :: list_idx ! index of the climate or a diagnostic list + integer, intent(in) :: bin_idx ! mode index + integer, intent(in) :: spec_idx ! index of specie in the mode + character(len=ot_length), optional, intent(out) :: opticstype + real(r8), optional, pointer :: sw_hygro_ext(:,:) + real(r8), optional, pointer :: sw_hygro_ssa(:,:) + real(r8), optional, pointer :: sw_hygro_asm(:,:) + real(r8), optional, pointer :: lw_hygro_ext(:,:) + real(r8), optional, pointer :: sw_nonhygro_ext(:) + real(r8), optional, pointer :: sw_nonhygro_ssa(:) + real(r8), optional, pointer :: sw_nonhygro_asm(:) + real(r8), optional, pointer :: sw_nonhygro_scat(:) + real(r8), optional, pointer :: sw_nonhygro_ascat(:) + real(r8), optional, pointer :: lw_ext(:) + complex(r8), optional, pointer :: refindex_aer_sw(:) + complex(r8), optional, pointer :: refindex_aer_lw(:) + + real(r8), optional, pointer :: r_sw_ext(:,:) + real(r8), optional, pointer :: r_sw_scat(:,:) + real(r8), optional, pointer :: r_sw_ascat(:,:) + real(r8), optional, pointer :: r_lw_abs(:,:) + real(r8), optional, pointer :: mu(:) + + character(len=20), optional, intent(out) :: aername + real(r8), optional, intent(out) :: density_aer + real(r8), optional, intent(out) :: hygro_aer + real(r8), optional, intent(out) :: dryrad_aer + real(r8), optional, intent(out) :: dispersion_aer + real(r8), optional, intent(out) :: num_to_mass_aer + character(len=32), optional, intent(out) :: spectype + character(len=32), optional, intent(out) :: specmorph + + ! Local variables + integer :: m_idx, id + type(binlist_t), pointer :: slist + character(len=*), parameter :: subname = 'rad_cnst_get_bin_props_by_idx' + !------------------------------------------------------------------------------------ + + if (list_idx >= 0 .and. list_idx <= N_DIAG) then + slist => sa_list(list_idx) + else + write(iulog,*) subname//': list_idx = ', list_idx + call endrun(subname//': list_idx out of range') + endif + + ! Check for valid mode index + if (bin_idx < 1 .or. bin_idx > slist%nbins) then + write(iulog,*) subname//': bin_idx= ', bin_idx, ' nbins= ', slist%nbins + call endrun(subname//': bin list index out of range') + end if + + ! Get the index for the corresponding mode in the mode definition object + m_idx = slist%idx(bin_idx) + + ! Check for valid specie index + if (spec_idx < 1 .or. spec_idx > bins%comps(m_idx)%nspec) then + write(iulog,*) subname//': spec_idx= ', spec_idx, ' nspec= ', bins%comps(m_idx)%nspec + call endrun(subname//': specie list index out of range') + end if + + id = bins%comps(m_idx)%idx_props(spec_idx) + + if (present(opticstype)) call physprop_get(id, opticstype=opticstype) + + if (present(sw_hygro_ext)) call physprop_get(id, sw_hygro_ext=sw_hygro_ext) + if (present(sw_hygro_ssa)) call physprop_get(id, sw_hygro_ssa=sw_hygro_ssa) + if (present(sw_hygro_asm)) call physprop_get(id, sw_hygro_asm=sw_hygro_asm) + if (present(lw_hygro_ext)) call physprop_get(id, lw_hygro_abs=lw_hygro_ext) + + if (present(sw_nonhygro_ext)) call physprop_get(id, sw_nonhygro_ext=sw_nonhygro_ext) + if (present(sw_nonhygro_ssa)) call physprop_get(id, sw_nonhygro_ssa=sw_nonhygro_ssa) + if (present(sw_nonhygro_asm)) call physprop_get(id, sw_nonhygro_asm=sw_nonhygro_asm) + if (present(sw_nonhygro_scat)) call physprop_get(id, sw_nonhygro_scat=sw_nonhygro_scat) + if (present(sw_nonhygro_ascat)) call physprop_get(id, sw_nonhygro_ascat=sw_nonhygro_ascat) + if (present(lw_ext)) call physprop_get(id, lw_abs=lw_ext) + + if (present(refindex_aer_sw)) call physprop_get(id, refindex_aer_sw=refindex_aer_sw) + if (present(refindex_aer_lw)) call physprop_get(id, refindex_aer_lw=refindex_aer_lw) + + if (present(r_lw_abs)) call physprop_get(id, r_lw_abs=r_lw_abs) + if (present(r_sw_ext)) call physprop_get(id, r_sw_ext=r_sw_ext) + if (present(r_sw_scat)) call physprop_get(id, r_sw_scat=r_sw_scat) + if (present(r_sw_ascat)) call physprop_get(id, r_sw_ascat=r_sw_ascat) + if (present(mu)) call physprop_get(id, mu=mu) + + if (present(aername)) call physprop_get(id, aername=aername) + if (present(density_aer)) call physprop_get(id, density_aer=density_aer) + if (present(hygro_aer)) call physprop_get(id, hygro_aer=hygro_aer) + if (present(dryrad_aer)) call physprop_get(id, dryrad_aer=dryrad_aer) + if (present(dispersion_aer)) call physprop_get(id, dispersion_aer=dispersion_aer) + if (present(num_to_mass_aer)) call physprop_get(id, num_to_mass_aer=num_to_mass_aer) + + if (present(spectype)) spectype = bins%comps(m_idx)%type(spec_idx) + if (present(specmorph)) specmorph = bins%comps(m_idx)%morph(spec_idx) + +end subroutine rad_cnst_get_bin_props_by_idx + +!================================================================================================ + subroutine rad_cnst_get_mode_props(list_idx, mode_idx, opticstype, & extpsw, abspsw, asmpsw, absplw, refrtabsw, & refitabsw, refrtablw, refitablw, ncoef, prefr, & @@ -2366,6 +3460,7 @@ subroutine rad_cnst_get_mode_props(list_idx, mode_idx, opticstype, & ! Arguments integer, intent(in) :: list_idx ! index of the climate or a diagnostic list integer, intent(in) :: mode_idx ! mode index + character(len=ot_length), optional, intent(out) :: opticstype real(r8), optional, pointer :: extpsw(:,:,:,:) real(r8), optional, pointer :: abspsw(:,:,:,:) @@ -2432,6 +3527,100 @@ end subroutine rad_cnst_get_mode_props !================================================================================================ +subroutine rad_cnst_get_bin_props(list_idx, bin_idx, opticstype, & + extpsw, abspsw, asmpsw, absplw, corefrac, nfrac, & + wgtpct, nwtp, bcdust, nbcdust, kap, nkap, relh, nrelh, & + sw_hygro_ext_wtp, sw_hygro_ssa_wtp, sw_hygro_asm_wtp, lw_hygro_ext_wtp, & + sw_hygro_coreshell_ext, sw_hygro_coreshell_ssa, sw_hygro_coreshell_asm, lw_hygro_coreshell_ext, dryrad ) + + ! Return requested properties for the bin from the specified + ! climate or diagnostic list. + + use phys_prop, only: physprop_get + + ! Arguments + integer, intent(in) :: list_idx ! index of the climate or a diagnostic list + integer, intent(in) :: bin_idx ! mode index + + character(len=ot_length), optional, intent(out) :: opticstype + + real(r8), optional, pointer :: extpsw(:,:) + real(r8), optional, pointer :: abspsw(:,:) + real(r8), optional, pointer :: asmpsw(:,:) + real(r8), optional, pointer :: absplw(:,:) + real(r8), optional, pointer :: corefrac(:) + integer, optional, intent(out) :: nfrac + + real(r8), optional, pointer :: sw_hygro_ext_wtp(:,:) + real(r8), optional, pointer :: sw_hygro_ssa_wtp(:,:) + real(r8), optional, pointer :: sw_hygro_asm_wtp(:,:) + real(r8), optional, pointer :: lw_hygro_ext_wtp(:,:) + real(r8), optional, pointer :: sw_hygro_coreshell_ext(:,:,:,:,:) ! Pengfei Yu Mar.30 + real(r8), optional, pointer :: sw_hygro_coreshell_ssa(:,:,:,:,:) + real(r8), optional, pointer :: sw_hygro_coreshell_asm(:,:,:,:,:) + real(r8), optional, pointer :: lw_hygro_coreshell_ext(:,:,:,:,:) + real(r8), optional, pointer :: wgtpct(:) + real(r8), optional, pointer :: bcdust(:) + real(r8), optional, pointer :: kap(:) + real(r8), optional, pointer :: relh(:) + integer, optional, intent(out) :: nwtp + integer, optional, intent(out) :: nbcdust + integer, optional, intent(out) :: nkap + integer, optional, intent(out) :: nrelh + real(r8), optional, intent(out) :: dryrad + + ! Local variables + integer :: id + type(binlist_t), pointer :: slist + character(len=*), parameter :: subname = 'rad_cnst_get_bin_props' + !------------------------------------------------------------------------------------ + + if (list_idx >= 0 .and. list_idx <= N_DIAG) then + slist => sa_list(list_idx) + else + write(iulog,*) subname//': list_idx = ', list_idx + call endrun(subname//': list_idx out of range') + endif + + ! Check for valid mode index + if (bin_idx < 1 .or. bin_idx > slist%nbins) then + write(iulog,*) subname//': bin_idx= ', bin_idx, ' nbins= ', slist%nbins + call endrun(subname//': bin list index out of range') + end if + + ! Get the physprop index for the requested bin + id = slist%idx_props(bin_idx) + + if (present(opticstype)) call physprop_get(id, opticstype=opticstype) + if (present(extpsw)) call physprop_get(id, extpsw2=extpsw) + if (present(abspsw)) call physprop_get(id, abspsw2=abspsw) + if (present(asmpsw)) call physprop_get(id, asmpsw2=asmpsw) + if (present(absplw)) call physprop_get(id, absplw2=absplw) + if (present(corefrac)) call physprop_get(id, corefrac=corefrac) + if (present(nfrac)) call physprop_get(id, nfrac=nfrac) + + if (present(sw_hygro_ext_wtp)) call physprop_get(id, sw_hygro_ext_wtp=sw_hygro_ext_wtp) + if (present(sw_hygro_ssa_wtp)) call physprop_get(id, sw_hygro_ssa_wtp=sw_hygro_ssa_wtp) + if (present(sw_hygro_asm_wtp)) call physprop_get(id, sw_hygro_asm_wtp=sw_hygro_asm_wtp) + if (present(lw_hygro_ext_wtp)) call physprop_get(id, lw_hygro_abs_wtp=lw_hygro_ext_wtp) + if (present(sw_hygro_coreshell_ext)) call physprop_get(id, sw_hygro_coreshell_ext=sw_hygro_coreshell_ext) + if (present(sw_hygro_coreshell_ssa)) call physprop_get(id, sw_hygro_coreshell_ssa=sw_hygro_coreshell_ssa) + if (present(sw_hygro_coreshell_asm)) call physprop_get(id, sw_hygro_coreshell_asm=sw_hygro_coreshell_asm) + if (present(lw_hygro_coreshell_ext)) call physprop_get(id, lw_hygro_coreshell_abs=lw_hygro_coreshell_ext) + if (present(wgtpct)) call physprop_get(id, wgtpct=wgtpct) + if (present(bcdust)) call physprop_get(id, bcdust=bcdust) + if (present(kap)) call physprop_get(id, kap=kap) + if (present(relh)) call physprop_get(id, relh=relh) + if (present(nwtp)) call physprop_get(id, nwtp=nwtp) + if (present(nbcdust)) call physprop_get(id, nbcdust=nbcdust) + if (present(nkap)) call physprop_get(id, nkap=nkap) + if (present(nrelh)) call physprop_get(id, nrelh=nrelh) + if (present(dryrad)) call physprop_get(id, dryrad_aer=dryrad) + +end subroutine rad_cnst_get_bin_props + +!================================================================================================ + subroutine print_modes(modes) type(modes_t), intent(inout) :: modes @@ -2461,7 +3650,33 @@ end subroutine print_modes !================================================================================================ -subroutine print_lists(gas_list, aer_list, ma_list) +subroutine print_bins(bins) + + type(bins_t), intent(inout) :: bins + + integer :: i, m + !--------------------------------------------------------------------------------------------- + + write(iulog,*)' Bin Definitions' + + do m = 1, bins%nbins + + write(iulog,*) nl//' name=',trim(bins%names(m)) + + do i = 1, bins%comps(m)%nspec + + write(iulog,*) ' src_a=',trim(bins%comps(m)%source_mmr_a(i)), ' mmr_a=',trim(bins%comps(m)%camname_mmr_a(i)), & + ' type=',trim(bins%comps(m)%type(i)) + write(iulog,*) ' prop file=', trim(bins%comps(m)%props(i)) + end do + + end do + +end subroutine print_bins + +!================================================================================================ + +subroutine print_lists(gas_list, aer_list, ma_list, sa_list) ! Print summary of gas, bulk and modal aerosol lists. This is just the information ! read from the namelist. @@ -2471,6 +3686,7 @@ subroutine print_lists(gas_list, aer_list, ma_list) type(aerlist_t), intent(in) :: aer_list type(gaslist_t), intent(in) :: gas_list type(modelist_t), intent(in) :: ma_list + type(binlist_t), intent(in) :: sa_list integer :: i, id @@ -2512,6 +3728,17 @@ subroutine print_lists(gas_list, aer_list, ma_list) write(iulog,*) ' '//trim(modes%names(id)) enddo + if (len_trim(sa_list%list_id) == 0) then + write(iulog,*) nl//' bin aerosol list for climate calculations' + else + write(iulog,*) nl//' bin aerosol list for diag'//sa_list%list_id//' calculations' + end if + + do i = 1, sa_list%nbins + id = sa_list%idx(i) + write(iulog,*) ' '//trim(bins%names(id)) + enddo + end subroutine print_lists !================================================================================================ diff --git a/src/physics/cam/restart_physics.F90 b/src/physics/cam/restart_physics.F90 index 2793e26b6e..f43e73279e 100644 --- a/src/physics/cam/restart_physics.F90 +++ b/src/physics/cam/restart_physics.F90 @@ -61,6 +61,7 @@ subroutine init_restart_physics ( File, pbuf2d) use cam_pio_utils, only: cam_pio_def_dim use subcol_utils, only: is_subcol_on use subcol, only: subcol_init_restart + use carma_intr, only: carma_restart_init type(file_desc_t), intent(inout) :: file type(physics_buffer_desc), pointer :: pbuf2d(:,:) @@ -134,6 +135,8 @@ subroutine init_restart_physics ( File, pbuf2d) call subcol_init_restart(file, hdimids) end if + call carma_restart_init(file) + end subroutine init_restart_physics subroutine write_restart_physics (File, cam_in, cam_out, pbuf2d) @@ -157,6 +160,7 @@ subroutine write_restart_physics (File, cam_in, cam_out, pbuf2d) use pio, only: pio_write_darray use subcol_utils, only: is_subcol_on use subcol, only: subcol_write_restart + use carma_intr, only: carma_restart_write ! ! Input arguments ! @@ -329,6 +333,7 @@ subroutine write_restart_physics (File, cam_in, cam_out, pbuf2d) call pio_write_darray(File, shf_desc, iodesc, tmpfield, ierr) call radiation_write_restart(file) + call carma_restart_write(file) end subroutine write_restart_physics @@ -352,6 +357,7 @@ subroutine read_restart_physics(File, cam_in, cam_out, pbuf2d) use subcol_utils, only: is_subcol_on use subcol, only: subcol_read_restart use pio, only: pio_read_darray + use carma_intr, only: carma_restart_read ! ! Arguments ! @@ -589,6 +595,7 @@ subroutine read_restart_physics(File, cam_in, cam_out, pbuf2d) deallocate(tmpfield2) call radiation_read_restart(file) + call carma_restart_read(file) end subroutine read_restart_physics diff --git a/src/physics/cam/vertical_diffusion.F90 b/src/physics/cam/vertical_diffusion.F90 index 472b2a5501..aa04a7572e 100644 --- a/src/physics/cam/vertical_diffusion.F90 +++ b/src/physics/cam/vertical_diffusion.F90 @@ -132,10 +132,6 @@ module vertical_diffusion logical :: diff_cnsrv_mass_check ! do mass conservation check logical :: do_iss ! switch for implicit turbulent surface stress -logical :: prog_modal_aero = .false. ! set true if prognostic modal aerosols are present -integer :: pmam_ncnst = 0 ! number of prognostic modal aerosol constituents -integer, allocatable :: pmam_cnst_idx(:) ! constituent indices of prognostic modal aerosols - logical :: do_pbl_diags = .false. logical :: waccmx_mode = .false. logical :: do_hb_above_clubb = .false. @@ -269,12 +265,10 @@ subroutine vertical_diffusion_init(pbuf2d) use hb_diff, only : init_hb_diff use molec_diff, only : init_molec_diff use diffusion_solver, only : init_vdiff, new_fieldlist_vdiff, vdiff_select - use constituents, only : cnst_get_ind, cnst_get_type_byind, cnst_name, cnst_get_molec_byind + use constituents, only : cnst_get_ind, cnst_get_type_byind, cnst_name, cnst_get_molec_byind, cnst_ndropmixed use spmd_utils, only : masterproc use ref_pres, only : press_lim_idx, pref_mid use physics_buffer, only : pbuf_set_field, pbuf_get_index, physics_buffer_desc - use rad_constituents, only : rad_cnst_get_info, rad_cnst_get_mode_num_idx, & - rad_cnst_get_mam_mmr_idx use trb_mtn_stress_cam,only : trb_mtn_stress_init use beljaars_drag_cam, only : beljaars_drag_init use upper_bc, only : ubc_init @@ -357,39 +351,6 @@ subroutine vertical_diffusion_init(pbuf2d) call cnst_get_ind( 'NUMLIQ', ixnumliq, abort=.false. ) call cnst_get_ind( 'NUMICE', ixnumice, abort=.false. ) - ! prog_modal_aero determines whether prognostic modal aerosols are present in the run. - call phys_getopts(prog_modal_aero_out=prog_modal_aero) - if (prog_modal_aero) then - - ! Get the constituent indices of the number and mass mixing ratios of the modal - ! aerosols. - ! - ! N.B. - This implementation assumes that the prognostic modal aerosols are - ! impacting the climate calculation (i.e., can get info from list 0). - ! - - ! First need total number of mam constituents - call rad_cnst_get_info(0, nmodes=nmodes) - do m = 1, nmodes - call rad_cnst_get_info(0, m, nspec=nspec) - pmam_ncnst = pmam_ncnst + 1 + nspec - end do - - allocate(pmam_cnst_idx(pmam_ncnst)) - - ! Get the constituent indicies - im = 1 - do m = 1, nmodes - call rad_cnst_get_mode_num_idx(m, pmam_cnst_idx(im)) - im = im + 1 - call rad_cnst_get_info(0, m, nspec=nspec) - do l = 1, nspec - call rad_cnst_get_mam_mmr_idx(m, l, pmam_cnst_idx(im)) - im = im + 1 - end do - end do - end if - ! Initialize upper boundary condition module call ubc_init() @@ -490,14 +451,8 @@ subroutine vertical_diffusion_init(pbuf2d) constit_loop: do k = 1, pcnst - if (prog_modal_aero) then - ! Do not diffuse droplet number - treated in dropmixnuc - if (k == ixnumliq) cycle constit_loop - ! Don't diffuse modal aerosol - treated in dropmixnuc - do m = 1, pmam_ncnst - if (k == pmam_cnst_idx(m)) cycle constit_loop - enddo - end if + ! Do not diffuse tracer -- treated in dropmixnuc + if (cnst_ndropmixed(k)) cycle constit_loop ! Convert all constituents to wet before doing diffusion. if( vdiff_select( fieldlist_wet, 'q', k ) .ne. '' ) call endrun( vdiff_select( fieldlist_wet, 'q', k ) ) @@ -723,7 +678,7 @@ subroutine vertical_diffusion_tend( & use air_composition, only : cpairv, rairv !Needed for calculation of upward H flux use time_manager, only : get_nstep use constituents, only : cnst_get_type_byind, cnst_name, & - cnst_mw, cnst_fixed_ubc, cnst_fixed_ubflx + cnst_mw, cnst_fixed_ubc, cnst_fixed_ubflx, cnst_ndropmixed use physconst, only : pi use pbl_utils, only : virtem, calc_obklen, calc_ustar use upper_bc, only : ubc_get_vals, ubc_fixed_temp @@ -1259,17 +1214,14 @@ subroutine vertical_diffusion_tend( & end if - if (prog_modal_aero) then - - ! Modal aerosol species not diffused, so just add the explicit surface fluxes to the - ! lowest layer. **NOTE** This code assumes wet mmr. - - tmp1(:ncol) = ztodt * gravit * state%rpdel(:ncol,pver) - do m = 1, pmam_ncnst - l = pmam_cnst_idx(m) + ! For species not diffused, so just add the explicit surface fluxes to the + ! lowest layer. **NOTE** This code assumes wet mmr. + tmp1(:ncol) = ztodt * gravit * state%rpdel(:ncol,pver) + do l = 1, pcnst + if (cnst_ndropmixed(l)) then q_tmp(:ncol,pver,l) = q_tmp(:ncol,pver,l) + tmp1(:ncol) * cflux(:ncol,l) - enddo - end if + end if + end do ! -------------------------------------------------------- ! ! Diagnostics and output writing after applying PBL scheme ! diff --git a/src/physics/cam7/micro_pumas_cam.F90 b/src/physics/cam7/micro_pumas_cam.F90 index 0d9f448e2f..150962ba83 100644 --- a/src/physics/cam7/micro_pumas_cam.F90 +++ b/src/physics/cam7/micro_pumas_cam.F90 @@ -569,6 +569,7 @@ end subroutine micro_pumas_cam_readnl subroutine micro_pumas_cam_register use cam_history_support, only: add_vert_coord, hist_dimension_values use cam_abortutils, only: handle_allocate_error + use carma_flags_mod, only: carma_model ! Register microphysics constituents and fields in the physics buffer. !----------------------------------------------------------------------- @@ -594,6 +595,7 @@ subroutine micro_pumas_cam_register longname='Grid box averaged cloud ice amount', is_convtran1=.true.) call cnst_add(cnst_names(3), mwh2o, cpair, 0._r8, ixnumliq, & + ndropmixed=prog_modal_aero.or.carma_model(:10)=='trop_strat', & longname='Grid box averaged cloud liquid number', is_convtran1=.true.) call cnst_add(cnst_names(4), mwh2o, cpair, 0._r8, ixnumice, & longname='Grid box averaged cloud ice number', is_convtran1=.true.) diff --git a/src/physics/cam7/physpkg.F90 b/src/physics/cam7/physpkg.F90 index 83d03c46d1..66e545755c 100644 --- a/src/physics/cam7/physpkg.F90 +++ b/src/physics/cam7/physpkg.F90 @@ -154,6 +154,8 @@ subroutine phys_register use dyn_comp, only: dyn_register use offline_driver, only: offline_driver_reg use hemco_interface, only: HCOI_Chunk_Init + use surface_emissions_mod, only: surface_emissions_reg + use elevated_emissions_mod, only: elevated_emissions_reg !---------------------------Local variables----------------------------- ! @@ -261,6 +263,9 @@ subroutine phys_register call modal_aero_wateruptake_reg() endif + call surface_emissions_reg() + call elevated_emissions_reg() + ! register chemical constituents including aerosols ... call chem_register() @@ -771,6 +776,8 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) use cam_history, only: addfld, register_vector_field, add_default use cam_budget, only: cam_budget_init use phys_grid_ctem, only: phys_grid_ctem_init + use surface_emissions_mod, only: surface_emissions_init + use elevated_emissions_mod, only: elevated_emissions_init use ccpp_constituent_prop_mod, only: ccpp_const_props_init @@ -853,7 +860,9 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) call aer_rad_props_init() ! initialize carma - call carma_init() + call carma_init(pbuf2d) + call surface_emissions_init(pbuf2d) + call elevated_emissions_init(pbuf2d) ! Prognostic chemistry. call chem_init(phys_state,pbuf2d) @@ -1615,7 +1624,7 @@ subroutine tphysac (ztodt, cam_in, & if (carma_do_emission) then ! carma emissions - call carma_emission_tend (state, ptend, cam_in, ztodt) + call carma_emission_tend (state, ptend, cam_in, ztodt, pbuf) call physics_update(state, ptend, ztodt, tend) end if @@ -2531,6 +2540,8 @@ subroutine tphysbc (ztodt, state, & use cam_snapshot, only: cam_snapshot_all_outfld_tphysbc use cam_snapshot_common, only: cam_snapshot_ptend_outfld use dyn_tests_utils, only: vc_dycore + use surface_emissions_mod,only: surface_emissions_set + use elevated_emissions_mod,only: elevated_emissions_set ! Arguments @@ -2746,6 +2757,10 @@ subroutine tphysbc (ztodt, state, & end if call t_stopf('energy_fixer') + + call surface_emissions_set( lchnk, ncol, pbuf ) + call elevated_emissions_set( lchnk, ncol, pbuf ) + ! !=================================================== ! Dry adjustment @@ -2944,6 +2959,8 @@ subroutine phys_timestep_init(phys_state, cam_in, cam_out, pbuf2d) use nudging, only: Nudge_Model, nudging_timestep_init use waccmx_phys_intr, only: waccmx_phys_ion_elec_temp_timestep_init use phys_grid_ctem, only: phys_grid_ctem_diags + use surface_emissions_mod,only: surface_emissions_adv + use elevated_emissions_mod,only: elevated_emissions_adv implicit none @@ -2964,6 +2981,8 @@ subroutine phys_timestep_init(phys_state, cam_in, cam_out, pbuf2d) ! Chemistry surface values call chem_surfvals_set() + call surface_emissions_adv(pbuf2d, phys_state) + call elevated_emissions_adv(pbuf2d, phys_state) ! Solar irradiance call solar_data_advance() diff --git a/src/physics/carma/base b/src/physics/carma/base index bf165cd84e..67418505b4 160000 --- a/src/physics/carma/base +++ b/src/physics/carma/base @@ -1 +1 @@ -Subproject commit bf165cd84ef94087d9a5669a5ad47838ab24c0ef +Subproject commit 67418505b48787bd305a50ffb581f98f0b466cba diff --git a/src/physics/carma/cam/carma_constants_mod.F90 b/src/physics/carma/cam/carma_constants_mod.F90 index e7392cc6a5..c29820d382 100644 --- a/src/physics/carma/cam/carma_constants_mod.F90 +++ b/src/physics/carma/cam/carma_constants_mod.F90 @@ -119,9 +119,9 @@ module carma_constants_mod !! NWAVE should be the total number of bands CAM supports. integer, public, parameter :: NWAVE = nlwbands+nswbands ! Number of wavelength bands - - - + !! The maximum number of diagnostic values that can be returned by + !! CARMA_CalculateCloudborneDiagnostics + integer, public, parameter :: MAXCLDAERDIAG = 16 !! These are constants per CARMA's definition, but are set dynamically in CAM and thus !! can not be set as constants. They must be initialized as variables in carma_init. @@ -147,5 +147,4 @@ module carma_constants_mod !! Define ratio of gas constant for dry air and specific heat real(kind=f) :: RKAPPA - -end module +end module carma_constants_mod diff --git a/src/physics/carma/cam/carma_intr.F90 b/src/physics/carma/cam/carma_intr.F90 index e726c296c9..47af8ff6fc 100644 --- a/src/physics/carma/cam/carma_intr.F90 +++ b/src/physics/carma/cam/carma_intr.F90 @@ -11,7 +11,8 @@ module carma_intr use carma_precision_mod use carma_enums_mod - use carma_constants_mod + use carma_constants_mod, only : GRAV, REARTH, WTMOL_AIR, WTMOL_H2O, R_AIR, CP, RKAPPA, & + MAXCLDAERDIAG use carma_types_mod use carma_flags_mod use carma_model_mod @@ -23,25 +24,21 @@ module carma_intr use carma_mod use shr_kind_mod, only: r8 => shr_kind_r8 - use spmd_utils, only: masterproc - use pmgrid, only: plat, plev, plevp, plon - use ppgrid, only: pcols, pver, pverp + use spmd_utils, only: masterproc, mpicom + use shr_reprosum_mod, only : shr_reprosum_calc + use ppgrid, only: pcols, pver, pverp, begchunk,endchunk use ref_pres, only: pref_mid, pref_edge, pref_mid_norm, psurf_ref use physics_types, only: physics_state, physics_ptend, physics_ptend_init, & set_dry_to_wet, physics_state_copy - use phys_grid, only: get_lat_all_p - use physconst, only: avogad, cpair + use physconst, only: cpair use constituents, only: pcnst, cnst_add, cnst_get_ind, & - cnst_name, cnst_longname, cnst_type - use chem_surfvals, only: chem_surfvals_get + cnst_name, cnst_longname use cam_abortutils, only: endrun use physics_buffer, only: physics_buffer_desc, pbuf_add_field, pbuf_old_tim_idx, & - pbuf_get_index, pbuf_get_field, dtype_r8 + pbuf_get_index, pbuf_get_field, dtype_r8, pbuf_set_field + use pio, only: var_desc_t - -#if ( defined SPMD ) - use mpishorthand -#endif + use wv_sat_methods, only: wv_sat_qsat_water implicit none @@ -61,17 +58,52 @@ module carma_intr public carma_timestep_tend ! interface to tendency computation public carma_accumulate_stats ! collect stats from all MPI tasks + ! Other Microphysics public carma_emission_tend ! calculate tendency from emission source function + public carma_calculate_cloudborne_diagnostics ! calculate model specific budget diagnostics for cloudborne aerosols + public carma_output_cloudborne_diagnostics ! output model specific budget diagnostics for cloudborne aerosols + public carma_output_budget_diagnostics ! calculate and output model specific aerosol budget terms public carma_wetdep_tend ! calculate tendency from wet deposition - + public :: carma_restart_init + public :: carma_restart_write + public :: carma_restart_read + + + ! Microphysics info from CAM state + ! + ! NOTE: These calls can be used in CAM when the CAM state is available, but the CARMASTATE + ! is not available. These will return the instantaneous values instead of relying on + ! pbuf fields that might be from the previous timestep. + public carma_get_bin + public carma_get_bin_cld + public carma_get_dry_radius + public carma_get_elem_for_group + public carma_get_group_by_name + public carma_get_kappa + public carma_get_number + public carma_get_number_cld + public carma_get_total_mmr + public carma_get_total_mmr_cld + public carma_get_wet_radius + public carma_get_bin_rmass + public carma_set_bin + public carma_get_sad + public :: carma_get_wght_pct + public :: carma_effecitive_radius + + ! NOTE: This is required by physpkg.F90, since the carma_intr.F90 stub in physics/cam + ! does not have access to carma_constant.F90, but needs to also provide a defintion + ! for MAXCLDAERDIAG. Thus the definition of this variable needs to come from + ! carma_intr.F90. + public :: MAXCLDAERDIAG ! Private data ! Particle Group Statistics ! Gridbox average - integer, parameter :: NGPDIAGS = 12 ! Number of particle diagnostics ... + integer, parameter :: NGPDIAGS = 13 ! Number of particle diagnostics ... integer, parameter :: GPDIAGS_ND = 1 ! Number density integer, parameter :: GPDIAGS_AD = 2 ! Surface area density integer, parameter :: GPDIAGS_MD = 3 ! Mass density @@ -84,10 +116,15 @@ module carma_intr integer, parameter :: GPDIAGS_VM = 10 ! Mass Weighted Fall Velocity integer, parameter :: GPDIAGS_PA = 11 ! Projected Area integer, parameter :: GPDIAGS_AR = 12 ! Area Ratio + integer, parameter :: GPDIAGS_VR = 13 ! Volatile Mixing Ratio ! Particle Bin (Element) Statistics - integer, parameter :: NBNDIAGS = 1 ! Number of bin surface diagnostics ... + integer, parameter :: NBNDIAGS = 5 ! Number of bin surface diagnostics ... integer, parameter :: BNDIAGS_TP = 1 ! Delta Particle Temperature [K] + integer, parameter :: BNDIAGS_WETR = 2 ! wet radius + integer, parameter :: BNDIAGS_ND = 3 ! Number density + integer, parameter :: BNDIAGS_RO = 4 ! particle density + integer, parameter :: BNDIAGS_VR = 5 ! Volatile Mixing Ratio ! Surface integer, parameter :: NSBDIAGS = 2 ! Number of bin surface diagnostics ... @@ -110,7 +147,7 @@ module carma_intr ! Defaults not in the namelist character(len=10), parameter :: carma_mixtype = 'wet' ! mixing ratio type for CARMA constituents - integer :: LUNOPRT = -1 ! lun for output + integer :: LUNOPRT = 6 ! lun for output ! Constituent Mappings integer :: icnst4elem(NELEM, NBIN) ! constituent index for a carma element @@ -134,16 +171,19 @@ module carma_intr ! Physics Buffer Indicies - integer :: ipbuf4gas(NGAS) ! physics buffer index for a carma gas - integer :: ipbuf4t ! physics buffer index for a carma temperature - integer :: ipbuf4sati(NGAS) ! physics buffer index for a carma saturation over ice - integer :: ipbuf4satl(NGAS) ! physics buffer index for a carma saturation over liquid + integer :: ipbuf4gas(NGAS)=-1 ! physics buffer index for a carma gas + integer :: ipbuf4t=-1 ! physics buffer index for a carma temperature + integer :: ipbuf4sati(NGAS)=-1 ! physics buffer index for a carma saturation over ice + integer :: ipbuf4satl(NGAS)=-1 ! physics buffer index for a carma saturation over liquid ! Globals used for a reference atmosphere. - real(kind=f) :: carma_t_ref(pver) ! midpoint temperature (Pa) - real(kind=f) :: carma_h2o_ref(pver) ! h2o mmmr (kg/kg) - real(kind=f) :: carma_h2so4_ref(pver) ! h2so4 mmr (kg/kg) + real(kind=f) :: carma_t_ref(pver) = -huge(1._f) ! midpoint temperature (Pa) + real(kind=f) :: carma_h2o_ref(pver) = -huge(1._f) ! h2o mmmr (kg/kg) + real(kind=f) :: carma_h2so4_ref(pver) = -huge(1._f) ! h2so4 mmr (kg/kg) + type(var_desc_t) :: t_ref_desc + type(var_desc_t) :: h2o_ref_desc + type(var_desc_t) :: h2so4_ref_desc ! Globals used for total statistics real(kind=f) :: glob_max_nsubstep = 0._f @@ -158,7 +198,6 @@ module carma_intr real(kind=f) :: step_nsubstep = 0._f real(kind=f) :: step_nretry = 0._f - contains @@ -177,8 +216,7 @@ module carma_intr !! @author Chuck Bardeen !! @version May-2009 subroutine carma_register - use radconstants, only : nswbands, nlwbands, & - get_sw_spectral_boundaries, get_lw_spectral_boundaries + use radconstants, only : nlwbands, get_sw_spectral_boundaries, get_lw_spectral_boundaries use cam_logfile, only : iulog use cam_control_mod, only : initial_run use physconst, only: gravit, p_rearth=>rearth, mwdry, mwh2o @@ -204,6 +242,7 @@ subroutine carma_register real(r8) :: wtmol ! gas molecular weight integer :: cnsttype ! constituent type integer :: maxbin ! last prognostic bin + logical :: ndropmixed ! tracer is vertically mixed in ndrop character(len=16) :: radiation_scheme ! CAM's radiation package. @@ -251,19 +290,19 @@ subroutine carma_register ! Create the CARMA object that will contain all the information about the ! how CARMA is configured. - call CARMA_Create(carma, NBIN, NELEM, NGROUP, NSOLUTE, NGAS, NWAVE, rc, & - LUNOPRT=LUNOPRT, wave=wave, dwave=dwave, do_wave_emit=do_wave_emit) + LUNOPRT=LUNOPRT, wave=wave, dwave=dwave, do_wave_emit=do_wave_emit, NREFIDX=NREFIDX) if (rc < 0) call endrun('carma_register::CARMA_Create failed.') ! Define the microphysical model. - call CARMA_DefineModel(carma, rc) + call CARMAMODEL_DefineModel(carma, rc) if (rc < 0) call endrun('carma_register::CARMA_DefineModel failed.') if (masterproc) then write(LUNOPRT,*) '' write(LUNOPRT,*) 'CARMA general settings for ', trim(carma_model), ' model : ' write(LUNOPRT,*) ' carma_do_aerosol = ', carma_do_aerosol + write(LUNOPRT,*) ' carma_do_coremasscheck = ',carma_do_coremasscheck write(LUNOPRT,*) ' carma_do_cldice = ', carma_do_cldice write(LUNOPRT,*) ' carma_do_cldliq = ', carma_do_cldliq write(LUNOPRT,*) ' carma_do_clearsky = ', carma_do_clearsky @@ -297,8 +336,8 @@ subroutine carma_register write(LUNOPRT,*) ' carma_maxretries = ', carma_maxretries write(LUNOPRT,*) ' carma_vf_const = ', carma_vf_const write(LUNOPRT,*) ' cldfrc_incloud = ', CLDFRC_INCLOUD - write(LUNOPRT,*) ' carma_reftfile = ', trim(carma_reftfile) write(LUNOPRT,*) ' carma_rad_feedback = ', carma_rad_feedback + write(LUNOPRT,*) ' carma_sulfnuc_method = ', carma_sulfnuc_method write(LUNOPRT,*) '' endif @@ -309,6 +348,8 @@ subroutine carma_register ! assumptions made in the CAM energy checking and microphysics code. call CARMA_Initialize(carma, & rc, & + sulfnucl_method = carma_sulfnuc_method, & + do_coremasscheck = carma_do_coremasscheck, & do_clearsky = carma_do_clearsky, & do_cnst_rlh = .true., & do_coag = carma_do_coag, & @@ -338,6 +379,7 @@ subroutine carma_register tstick = carma_tstick) if (rc < 0) call endrun('carma_register::CARMA_Initialize failed.') + ndropmixed = carma_model(:10)=='trop_strat' ! The elements and gases from CARMA need to be added as constituents in ! CAM (if they don't already exist). For the elements, each radius bin @@ -362,16 +404,14 @@ subroutine carma_register ! For prognostic groups, all of the bins need to be represented as actual CAM ! constituents. Diagnostic groups are determined from state information that ! is already present in CAM, and thus their bins only exist in CARMA. - if (cnsttype == I_CNSTTYPE_PROGNOSTIC) then - - do ibin = 1, NBIN + do ibin = 1, NBIN + write(btndname(igroup, ibin), '(A, I2.2)') trim(grp_short), ibin + if (cnsttype == I_CNSTTYPE_PROGNOSTIC) then ! Bins past maxbin are treated as diagnostic even if the group ! is prognostic and thus are not advected in the paerent model. if (ibin <= maxbin) then - write(btndname(igroup, ibin), '(A, I2.2)') trim(grp_short), ibin - write(c_name, '(A, I2.2)') trim(shortname), ibin write(c_longname, '(A, e11.4, A)') trim(name) // ', ', r(ibin)*1.e4_r8, ' um' @@ -379,10 +419,11 @@ subroutine carma_register ! doesn't make sense for particles. The CAM solvers are unstable if the ! mass provided is large. call cnst_add(c_name, WTMOL_AIR, cpair, 0._r8, icnst4elem(ielem, ibin), & - longname=c_longname, mixtype=carma_mixtype, is_convtran1=is_convtran1(igroup)) + longname=c_longname, mixtype=carma_mixtype, is_convtran1=is_convtran1(igroup), & + ndropmixed=ndropmixed ) end if - end do - end if + end if + end do end do ! Find the constituent for the gas or add it if not found. @@ -508,16 +549,14 @@ end function carma_implements_cnst !! !! @author Chuck Bardeen !! @version May 2009 - subroutine carma_init + subroutine carma_init(pbuf2d) use cam_history, only: addfld, add_default, horiz_only - use ioFileMod, only : getfil use wrap_nf use time_manager, only: is_first_step use phys_control, only: phys_getopts - implicit none + type(physics_buffer_desc), pointer :: pbuf2d(:,:) - integer :: iz ! vertical index integer :: ielem ! element index integer :: ibin ! bin index integer :: igas ! gas index @@ -529,15 +568,11 @@ subroutine carma_init integer :: maxbin ! last prognostic bin logical :: is_cloud ! is the group a cloud? logical :: do_drydep ! is dry deposition enabled? + integer :: ncore ! number of core elements in the group - integer :: ier - integer :: ncid, dimid_lev, vid_T - logical :: lexist - character(len=256) :: locfn - integer :: nlev - integer :: LUNOPRT ! logical unit number for output - logical :: do_print ! do print output? logical :: history_carma + logical :: history_carma_srf_flx + integer :: astat 1 format(a6,4x,a11,4x,a11,4x,a11) 2 format(i6,4x,3(1pe11.3,4x)) @@ -545,7 +580,7 @@ subroutine carma_init ! Initialize the return code. rc = 0 - call phys_getopts(history_carma_out=history_carma) + call phys_getopts(history_carma_out=history_carma, history_carma_srf_flx_out=history_carma_srf_flx) ! Set names of constituent sources and declare them as history variables; howver, ! only prognostic variables have. @@ -589,9 +624,18 @@ subroutine carma_init call addfld(trim(etndname(ielem, ibin))//'SW', horiz_only, 'A', 'kg/m2/s', & trim(cnst_name(icnst)) // ' wet deposition flux at surface') + if (history_carma_srf_flx) then + call add_default(trim(etndname(ielem, ibin))//'EM', 1, ' ') + call add_default(trim(etndname(ielem, ibin))//'SF', 1, ' ') + call add_default(trim(etndname(ielem, ibin))//'SW', 1, ' ') + end if + if (do_drydep) then - call addfld(trim(etndname(ielem, ibin))//'DD', horiz_only, 'A', 'kg/m2/s ', & - trim(cnst_name(icnst)) // ' dry deposition') + call addfld(trim(etndname(ielem, ibin))//'DD', horiz_only, 'A', 'kg/m2/s ', & + trim(cnst_name(icnst)) // ' dry deposition') + if (history_carma_srf_flx) then + call add_default(trim(etndname(ielem, ibin))//'DD', 1, ' ') + end if end if if (carma_do_pheat) then @@ -604,7 +648,7 @@ subroutine carma_init end do do igroup = 1, NGROUP - call CARMAGROUP_Get(carma, igroup, rc, shortname=sname, is_cloud=is_cloud, do_drydep=do_drydep) + call CARMAGROUP_Get(carma, igroup, rc, shortname=sname, is_cloud=is_cloud, do_drydep=do_drydep, ncore=ncore) if (rc < 0) call endrun('carma_init::CARMAGROUP_GetGroup failed.') ! Gridbox average @@ -623,6 +667,7 @@ subroutine carma_init call addfld(trim(sname)//'PA', (/ 'lev' /), 'A', 'cm2', trim(sname) // ' projected area') call addfld(trim(sname)//'AR', (/ 'lev' /), 'A', ' ', trim(sname) // ' area ratio') call addfld(trim(sname)//'VM', (/ 'lev' /), 'A', 'm/s', trim(sname) // ' fall velocity') + call addfld(trim(sname)//'VR', (/ 'lev' /), 'A', 'kg/kg', trim(sname) // ' volatile mass mixing ratio') if (history_carma) then call add_default(trim(sname)//'ND', 1, ' ') @@ -636,6 +681,7 @@ subroutine carma_init call add_default(trim(sname)//'PA', 1, ' ') call add_default(trim(sname)//'AR', 1, ' ') call add_default(trim(sname)//'VM', 1, ' ') + call add_default(trim(sname)//'VR', 1, ' ') if (carma_do_grow) then call add_default(trim(sname)//'JN', 1, ' ') @@ -644,12 +690,39 @@ subroutine carma_init ! Per bin stats .. if (do_drydep) then - do ibin = 1, NBIN - call addfld(trim(btndname(igroup, ibin))//'VD', horiz_only, 'A', 'm/s', & - trim(btndname(igroup, ibin))//' dry deposition velocity') - end do + do ibin = 1, NBIN + call addfld(trim(btndname(igroup, ibin))//'VD', horiz_only, 'A', 'm/s', & + trim(btndname(igroup, ibin)) // ' dry deposition velocity') + end do end if + do ibin = 1, NBIN + call addfld(trim(btndname(igroup, ibin))//'ND', (/ 'lev' /), 'A', '#/cm3', & + trim(btndname(igroup, ibin)) // ' number density') + call addfld(trim(btndname(igroup, ibin))//'WR', (/ 'lev' /), 'A', 'um', & + trim(btndname(igroup, ibin)) // ' wet radius') + call addfld(trim(btndname(igroup, ibin))//'RO', (/ 'lev' /), 'A', 'g/cm3', & + trim(btndname(igroup, ibin)) // ' wet particle density') + call addfld(trim(btndname(igroup, ibin))//'VR', (/ 'lev' /), 'A', 'um', & + trim(btndname(igroup, ibin)) // ' volatile mixing ratio') + + + if ((carma_ndebugpkgs > 0) .and. (ncore > 0)) then + call addfld(trim(btndname(igroup, ibin))//'LCFM', horiz_only, 'A', 'kg/m2', trim(btndname(igroup, ibin)) // ' CARMA local mass fixer fail mass ') + call addfld(trim(btndname(igroup, ibin))//'LCFP', horiz_only, 'A', 'probability', trim(btndname(igroup, ibin)) // ' CARMA mass local fail PDF') + call addfld(trim(btndname(igroup, ibin))//'LCR', (/ 'lev' /), 'A', 'kg/kg', trim(btndname(igroup, ibin)) // ' CARMA local mass fix MMR') + call addfld(trim(btndname(igroup, ibin))//'LCP', (/ 'lev' /), 'A', 'probability', trim(btndname(igroup, ibin)) // ' CARMA local fix PDF') + + if (carma_diags_file > 0) then + call add_default(trim(btndname(igroup, ibin))//'LCFM', carma_diags_file, ' ') + call add_default(trim(btndname(igroup, ibin))//'LCFP', carma_diags_file, ' ') + call add_default(trim(btndname(igroup, ibin))//'LCR', carma_diags_file, ' ') + call add_default(trim(btndname(igroup, ibin))//'LCP', carma_diags_file, ' ') + end if + end if + + end do + end do do igas = 1, NGAS @@ -708,105 +781,20 @@ subroutine carma_init if (carma%f_igash2o /= 0) call carma_getH2O(carma_h2o_ref) if (carma%f_igash2So4 /= 0) call carma_getH2SO4(carma_h2so4_ref) end if - - if (masterproc) then - call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) - if (rc < 0) call endrun('carma_init::CARMA_Get failed.') - - if (do_print) write(LUNOPRT,*) "" - if (do_print) write(LUNOPRT,*) "CARMA initializing to fixed reference state." - if (do_print) write(LUNOPRT,*) "" - - ! For temperature, get the average temperature from reference temperature file - ! if it exists or from the initial condition file if the reference temperature file - ! doesn't exist. - ! - ! NOTE: The reference temperature file will only be created for an inital run. It - ! must already exist for a restart run. - - ! Does reference temperature file already exist? - call getfil(carma_reftfile, locfn, iflag=1) - - inquire(file=locfn, exist=lexist) - - ! Read the reference temperature from the file. - if (lexist) then - - ! Open the netcdf file. - call wrap_open(trim(locfn), NF90_NOWRITE, ncid) - - ! Inquire about dimensions - call wrap_inq_dimid(ncid, 'lev', dimid_lev) - call wrap_inq_dimlen(ncid, dimid_lev, nlev) - - ! Does the number of levels match? - if (nlev /= pver) then - call endrun("carma_init::ERROR - Incompatible number of levels & - &in the CARMA reference temperature file ... " // trim(locfn)) - end if - - ! Get variable ID for reference temperature - call wrap_inq_varid(ncid, 'T', vid_T) - - ! Read in the temperature data. - call wrap_get_var_realx(ncid, vid_T, carma_T_ref) - - if (carma%f_igash2o /= 0) then - ! Get variable ID for reference temperature - call wrap_inq_varid(ncid, 'Q', vid_T) - - ! Read in the temperature data. - call wrap_get_var_realx(ncid, vid_T, carma_h2o_ref) - end if - - if (carma%f_igash2so4 /= 0) then - ! Get variable ID for reference temperature - call wrap_inq_varid(ncid, 'H2SO4', vid_T) - - ! Read in the temperature data. - call wrap_get_var_realx(ncid, vid_T, carma_h2so4_ref) - end if - - ! Close the file - call wrap_close(ncid) - - ! Is this an initial or restart run? - else if (is_first_step()) then - - if (do_print) write(LUNOPRT,*) "" - if (do_print) write(LUNOPRT,*) 'Creating CARMA reference temperature file ... ', trim(locfn) - - ! Save the average into a file to be used for restarts. - call CARMA_CreateRefTFile(carma, locfn, pref_mid(:) / 100._r8, & - carma_t_ref(:), rc, refh2o=carma_h2o_ref(:), refh2so4=carma_h2so4_ref(:)) - else - - ! The file must already exist for a restart run. - call endrun("carma_init::ERROR - Can't find the CARMA reference temperature file ... " // trim(carma_reftfile)) - - end if - - ! Write out the values that are being used. - if (do_print) write(LUNOPRT,*) "" - if (do_print) write(LUNOPRT,1) "Level","Int P (Pa)","Mid P (Pa)","Mid T (K)" - - do iz = 1, pver - if (do_print) write(LUNOPRT,2) iz, pref_edge(iz), pref_mid(iz), carma_t_ref(iz) - end do - if (do_print) write(LUNOPRT,2) iz, pref_edge(iz), 0.0_r8, 0.0_r8 - if (do_print) write(LUNOPRT,*) "" - end if - -#ifdef SPMD - - ! Communicate the settings to the other MPI tasks. - call mpi_bcast(carma_t_ref, pver, MPI_REAL8, 0, mpicom, ier) -#endif end if + if (is_first_step()) then + ! initialize physics buffer fields + do igas = 1, NGAS + call pbuf_set_field(pbuf2d, ipbuf4gas(igas), 0.0_r8) + call pbuf_set_field(pbuf2d, ipbuf4sati(igas), 0.0_r8) + call pbuf_set_field(pbuf2d, ipbuf4satl(igas), 0.0_r8) + end do + call pbuf_set_field(pbuf2d, ipbuf4t, 0.0_r8) + endif ! Do a model specific initialization. - call CARMA_InitializeModel(carma, lq_carma, rc) + call CARMAMODEL_InitializeModel(carma, lq_carma, pbuf2d, rc) if (rc < 0) call endrun('carma_init::CARMA_InitializeModel failed.') return @@ -846,9 +834,9 @@ subroutine carma_final glob_nretry / glob_nstep else if (do_print) write(LUNOPRT,2) glob_max_nsubstep, & - 0., & + 0._r8, & glob_max_nretry, & - 0. + 0._r8 end if end if end if @@ -902,7 +890,7 @@ end subroutine carma_timestep_init !! @version May-2009 subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rliq, prec_str, snow_str, & prec_sed, snow_sed, ustar, obklen) - use time_manager, only: get_nstep, get_step_size, is_first_step + use time_manager, only: get_nstep, is_first_step use camsrfexch, only: cam_in_t, cam_out_t use planck, only: planckIntensity @@ -968,9 +956,12 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli real(r8) :: ar(pver) ! Area Ratio real(r8) :: vm(pver) ! Massweighted fall velocity (cm2) real(r8) :: jn(pver) ! nucleation (cm-3) + real(r8) :: totalmmr(pver) ! total particle mmr (kg/kg) real(r8) :: numberDensity(pver) ! number density (cm-3) real(r8) :: nucleationRate(pver) ! nucleation rate (cm-3 s-1) real(r8) :: extinctionCoefficient(pver) ! extinction coefficient (cm2) + real(r8) :: r_wet(pver) ! wet radius (um) + real(r8) :: rhop_wet(pver) ! wet particle density (g/cm3) real(r8) :: dd ! dry deposition (kg/m2) real(r8) :: vd ! dry deposition velocity (cm/s) real(r8) :: vf(pverp) ! fall velocity (cm/s) @@ -986,7 +977,6 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli real(r8), pointer, dimension(:,:) :: tnd_qsnow ! external tendency on snow mass (kg/kg/s) real(r8), pointer, dimension(:,:) :: tnd_nsnow ! external tendency on snow number(#/kg/s) real(r8), pointer, dimension(:,:) :: re_ice ! ice effective radius (m) - integer :: lchnk ! chunk identifier integer :: iz real(r8) :: cldfrc(pver) ! cloud fraction [fraction] real(r8) :: rhcrit(pver) ! relative humidity for onset of liquid clouds [fraction] @@ -1010,7 +1000,6 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli logical :: is_ice ! is the group ice? logical :: grp_do_drydep ! is dry depostion enabled for group? logical :: do_drydep ! is dry depostion enabled? - logical :: do_fixedinit ! do initialization from reference atm? logical :: do_detrain ! do convective detrainment? integer :: iwvl real(r8), parameter :: zzocen = 0.0001_r8 ! Ocean aerodynamic roughness length [m] @@ -1048,8 +1037,6 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli call cnst_get_ind('Q', icnst_q) ! Get pointers into pbuf ... - lchnk = state_loc%lchnk - call pbuf_get_field(pbuf, ipbuf4t, t_ptr) ! If doing particle heating, then get pointers to the spectral flux data provided @@ -1080,11 +1067,10 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli ! If initializing CARMASTATE from a reference state, do it before entering the main ! loop. ! - call CARMA_Get(carma, rc, do_fixedinit=do_fixedinit, do_drydep=do_drydep) + call CARMA_Get(carma, rc, do_drydep=do_drydep) if (rc < 0) call endrun('carma_timestep_tend::CARMA_Get failed.') - if (do_fixedinit) then - + if (carma_do_fixedinit) then call CARMASTATE_CreateFromReference(cstate, & carma_ptr, & time, & @@ -1101,7 +1087,7 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli rc, & qh2o=carma_h2o_ref, & qh2so4=carma_h2so4_ref) - if (rc < 0) call endrun('carma_timestep_tend::CARMASTATE_CreateFromReference failed.') + if (rc < 0) call endrun('carma_timestep_tend::CARMASTATE_CreateFromReference failed.') end if @@ -1227,7 +1213,7 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli end do - call CARMA_DiagnoseBins(carma, cstate, state_loc, pbuf, icol, dt, rc, rliq=rliq, prec_str=prec_str, snow_str=snow_str) + call CARMAMODEL_DiagnoseBins(carma, cstate, state_loc, pbuf, icol, dt, rc, rliq=rliq, prec_str=prec_str, snow_str=snow_str) if (rc < 0) call endrun('carma_timestep_tend::CARMA_DiagnoseBins failed.') @@ -1237,7 +1223,7 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli if (rc < 0) call endrun('CARMA_Detrain::CARMA_Get failed.') if (do_detrain) then - call CARMA_Detrain(carma, cstate, cam_in, dlf, state_loc, icol, dt, rc, rliq=rliq, prec_str=prec_str, & + call CARMAMODEL_Detrain(carma, cstate, cam_in, dlf, state_loc, icol, dt, rc, rliq=rliq, prec_str=prec_str, & snow_str=snow_str, tnd_qsnow=tnd_qsnow, tnd_nsnow=tnd_nsnow) if (rc < 0) call endrun('carma_timestep_tend::CARMA_Detrain failed.') end if @@ -1312,11 +1298,11 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli ! NOTE: To work around an XL Fortran compiler bug, the optional arguments can only ! be passed when defined. if (present(rliq)) then - call CARMA_DiagnoseBulk(carma, cstate, cam_out, state_loc, pbuf, ptend, icol, dt, rc, & + call CARMAMODEL_DiagnoseBulk(carma, cstate, cam_out, state_loc, pbuf, ptend, icol, dt, rc, & rliq=rliq, prec_str=prec_str, snow_str=snow_str, prec_sed=prec_sed, & snow_sed=snow_sed, tnd_qsnow=tnd_qsnow, tnd_nsnow=tnd_nsnow, re_ice=re_ice) else - call CARMA_DiagnoseBulk(carma, cstate, cam_out, state_loc, pbuf, ptend, icol, dt, rc) + call CARMAMODEL_DiagnoseBulk(carma, cstate, cam_out, state_loc, pbuf, ptend, icol, dt, rc) end if if (rc < 0) call endrun('carma_timestep_tend::CARMASTATE_DiagnoseBulk failed.') @@ -1351,7 +1337,8 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli do ibin = 1, NBIN call CARMASTATE_GetBin(cstate, ielem, ibin, newstate(:), rc, & - numberDensity=numberDensity, nucleationRate=nucleationRate, surface=dd, vd=vd, vf=vf, dtpart=dtpart) + numberDensity=numberDensity, nucleationRate=nucleationRate, r_wet=r_wet, & + rhop_wet=rhop_wet, sedimentationflux=dd, vd=vd, vf=vf, dtpart=dtpart, totalmmr=totalmmr) if (rc < 0) call endrun('carma_timestep_tend::CARMASTATE_GetBin failed.') ! For prognostic groups, set the tendency from the corresponding constituents. @@ -1367,7 +1354,7 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli ptend%q(icol, :, icnst) = (newstate(:) - state_loc%q(icol, :, icnst)) / dt if (grp_do_drydep) then - sbdiags(icol, ibin, ielem, SBDIAGS_DD) = dd / dt + sbdiags(icol, ibin, ielem, SBDIAGS_DD) = dd sbdiags(icol, ibin, ielem, SBDIAGS_VD) = - vd / 100._r8 end if end if @@ -1382,7 +1369,7 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli re3(:) = re3(:) + numberDensity(:) * ((r(ibin)*rrat(ibin))**3) ad(:) = ad(:) + numberDensity(:) * 4.0_r8 * PI * (r(ibin)**2) * 1.0e8_r8 md(:) = md(:) + numberDensity(:) * rmass(ibin) - mr(:) = mr(:) + newstate(:) + mr(:) = mr(:) + totalmmr(:) pa(:) = pa(:) + numberDensity(:) * PI * ((r(ibin) * rrat(ibin))**2) * arat(ibin) vm(:) = vm(:) + numberDensity(:) * rmass(ibin) * vf(2:) / 100._f @@ -1397,6 +1384,9 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli od(:) = od(:) + numberDensity(:) * extinctionCoefficient(:) * dz(:) * 100._r8 end if + bndiags(icol,:,ibin,ielem,BNDIAGS_VR) = bndiags(icol,:,ibin,ielem,BNDIAGS_VR) + totalmmr(:) + gpdiags(icol, :, igroup, GPDIAGS_VR) = gpdiags(icol, :, igroup, GPDIAGS_VR) + totalmmr(:) + ! Particle temperatures from particle heating. if (carma_do_pheat) then bndiags(icol, :, ibin, ielem, BNDIAGS_TP) = dtpart(:) @@ -1405,6 +1395,12 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli if (nucleationRate(1) /= CAM_FILL) then jn(:) = jn(:) + nucleationRate(:) end if + + ! Output nd and wet radius for each bin. + r_wet = r_wet * 1e4_r8 ! cm to um + bndiags(icol,:,ibin,ielem,BNDIAGS_WETR) = r_wet(:) + bndiags(icol,:,ibin,ielem,BNDIAGS_ND) = numberDensity(:) + bndiags(icol,:,ibin,ielem,BNDIAGS_RO) = rhop_wet(:) end do ! If this is the number element for the group, then write out the @@ -1454,7 +1450,7 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli call pbuf_get_field(pbuf, ipbuf4satl(igas), satl_ptr) call CARMASTATE_GetGas(cstate, igas, newstate(:), rc, satice=satice, satliq=satliq, & - eqice=eqice, eqliq=eqliq, wtpct=wtpct) + eqice=eqice, eqliq=eqliq, wtpct=wtpct) if (rc < 0) call endrun('carma_timestep_tend::CARMASTATE_GetGas failed.') icnst = icnst4gas(igas) @@ -1492,7 +1488,9 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli if (rc < 0) call endrun('carma_timestep_tend::CARMASTATE_Get failed.') spdiags(icol, :, SPDIAGS_NSTEP) = zsubsteps(:) - spdiags(icol, :, SPDIAGS_LNSTEP) = log(zsubsteps(:)) + where (zsubsteps/=0.0_r8) + spdiags(icol, :, SPDIAGS_LNSTEP) = log(zsubsteps(:)) + end where end if end do @@ -1517,14 +1515,35 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli call CARMASTATE_Destroy(cstate, rc) if (rc < 0) call endrun('carma_timestep_tend::CARMASTATE_Destroy failed.') - ! Output diagnostic fields. - call carma_output_diagnostics(state_loc, ptend, gpdiags, sbdiags, gsdiags, spdiags, bndiags) + call carma_output_diagnostics(state_loc, ptend, pbuf, cam_in, gpdiags, sbdiags, gsdiags, spdiags, bndiags) end subroutine carma_timestep_tend + !! Get the index for the constituents array for the specified bin + !! of the specified element. + !! + !! @author Yunqian Zhu, Francis Vitt + !! @version September-2022 + subroutine carma_getcnstforbin(ielem, ibin, icnst) + implicit none + + integer, intent(in) :: ielem, ibin + integer, intent(out) :: icnst + + icnst = icnst4elem(ielem,ibin) + return + end subroutine carma_getcnstforbin + + !! Collect CARMA substep statistics from all MPI tasks. + !! + !! @author Chuck Bardeen + !! @version May-2009 subroutine carma_accumulate_stats() +#if ( defined SPMD ) + use mpishorthand +#endif implicit none integer :: istat @@ -1600,9 +1619,9 @@ subroutine carma_accumulate_stats() step_nretry / step_nstep else if (do_print) write(LUNOPRT,1) step_max_nsubstep, & - 0., & + 0._r8, & step_max_nretry, & - 0. + 0._r8 end if end if end if @@ -1665,7 +1684,7 @@ subroutine carma_init_cnst(name, latvals, lonvals, mask, q) end where end do - call CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) + call CARMAMODEL_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) if (rc < 0) call endrun('carma_init_cnst::CARMA_InitializeParticle failed.') end if end if @@ -1679,19 +1698,122 @@ subroutine carma_init_cnst(name, latvals, lonvals, mask, q) return end subroutine carma_init_cnst + !! Calculate amounts of cloudborne aerosols for use in budget diagnostics. This should + !! be called before the timestep, and the results passed to CARMA_output_cloudborne_diagnostics() + !! after the timestep to calculate the tendencies and write them out the the history files. + !! + !! NOTE: The exact fields that are calculated are determined by the particular CARMA model. + !! + !! @author Chuck Bardeen + !! @version January-2023 + subroutine carma_calculate_cloudborne_diagnostics(state, pbuf, aerclddiag) + + implicit none + + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + real(r8), intent(out) :: aerclddiag(pcols, MAXCLDAERDIAG) !! previous cloudborne diagnostics + + integer :: rc + + call CARMAMODEL_CalculateCloudborneDiagnostics(carma, state, pbuf, aerclddiag, rc) + + return + end subroutine carma_calculate_cloudborne_diagnostics + + + !! Output cloudborne aerosol budget tendencies to the history files for physics packages + !! other than CARMA that may be affecting the CARMA aerosols. Since cloudborne aerosols + !! are not in the physics_state, you must call CARMA_calculate_cloudborne_diagnostics() + !! before the timestep tend to capture the prior state. This call will calculate the + !! final state and output the difference as a tendency. This may be useful for + !! debugging and for calculating aerosol budgets. + !! + !! @author Chuck Bardeen + !! @version January-2023 + subroutine carma_output_cloudborne_diagnostics(state, pbuf, pname, dt, oldaerclddiag) + + implicit none + + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + character(*), intent(in) :: pname !! short name of the physics package + real(r8), intent(in) :: dt !! timestep (s) + real(r8), intent(in) :: oldaerclddiag(pcols, MAXCLDAERDIAG) !! previous cloudborne diagnostics + + integer :: rc + integer :: i + + ! Check to make sure the the package is in the packages list. + do i = 1, carma_ndiagpkgs + if (trim(carma_diags_packages(i)) .eq. trim(pname)) then + + ! Allow models to output their own diagnostics related to aerosol + ! budgets related to physics packages other than CARMA + call CARMAMODEL_OutputCloudborneDiagnostics(carma, state, pbuf, dt, pname, oldaerclddiag, rc) + exit + end if + end do + + return + end subroutine carma_output_cloudborne_diagnostics + + + + !! Output budget tendencies to the history files for physics packages + !! other than CARMA that may be affecting the CARMA aerosols. This can be + !! called for any physics package that is using ptend to modify the CARMA + !! aerosol, and may be useful for debugging and for calculating aerosol budgets. + !! + !! All the columns in the chunk should be output at the same time. + !! + !! @author Chuck Bardeen + !! @version January-2023 + subroutine carma_output_budget_diagnostics(state, ptend, old_cflux, cflux, dt, pname) + + implicit none + + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + real(r8) :: old_cflux(pcols,pcnst) !! cam_in%clfux from before the timestep_tend + real(r8) :: cflux(pcols,pcnst) !! cam_in%clfux from after the timestep_tend + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + + integer :: rc + + integer :: i + + ! Check to make sure the the package is in the packages list. + do i = 1, carma_ndiagpkgs + if (trim(carma_diags_packages(i)) .eq. trim(pname)) then + + ! Allow models to output their own diagnostics related to aerosol + ! budgets related to physics packages other than CARMA + call CARMAMODEL_OutputBudgetDiagnostics(carma, icnst4elem, icnst4gas, state, ptend, old_cflux, cflux, dt, pname, rc) + exit + end if + end do + + return + end subroutine carma_output_budget_diagnostics + !! Outputs tracer tendencies and diagnositc fields to the history files. !! All the columns in the chunk should be output at the same time. !! !! @author Chuck Bardeen !! @version May-2009 - subroutine carma_output_diagnostics(state, ptend, gpdiags, sbdiags, gsdiags, spdiags, bndiags) + subroutine carma_output_diagnostics(state, ptend, pbuf, cam_in, gpdiags, sbdiags, gsdiags, spdiags, bndiags) use cam_history, only: outfld + use camsrfexch, only: cam_in_t implicit none type(physics_state), intent(in) :: state !! Physics state variables - before CARMA type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + type(cam_in_t), intent(in) :: cam_in !! surface inputs real(r8), intent(in), dimension(pcols, pver, NGROUP, NGPDIAGS) :: gpdiags !! CARMA group diagnostic output real(r8), intent(in), dimension(pcols, NBIN, NELEM, NSBDIAGS) :: sbdiags !! CARMA surface bin diagnostic output real(r8), intent(in), dimension(pcols, pver, NGAS, NGSDIAGS) :: gsdiags !! CARMA gas diagnostic output @@ -1706,7 +1828,6 @@ subroutine carma_output_diagnostics(state, ptend, gpdiags, sbdiags, gsdiags, spd integer :: ienconc ! element index for group's concentration element integer :: icnst ! constituent index integer :: lchnk ! chunk identifier - integer :: ncol ! number of columns integer :: rc ! CARMA return code character(len=8) :: sname ! short (CAM) name integer :: cnsttype ! constituent type @@ -1714,12 +1835,13 @@ subroutine carma_output_diagnostics(state, ptend, gpdiags, sbdiags, gsdiags, spd logical :: is_cloud ! is the group a cloud? logical :: do_drydep ! is dry deposition enabled? + character(len=*), parameter :: subname = 'carma_output_diagnostics' + ! Initialize the return code. rc = 0 ! Check each column int the chunk. lchnk = state%lchnk - ncol = state%ncol ! Output step diagnostics. if (carma_do_substep) then @@ -1732,10 +1854,10 @@ subroutine carma_output_diagnostics(state, ptend, gpdiags, sbdiags, gsdiags, spd do ibin = 1, NBIN call CARMAELEMENT_Get(carma, ielem, rc, igroup=igroup) - if (rc < 0) call endrun('carma_timestep_tend::CARMAELEMENT_Get failed.') + if (rc < 0) call endrun(subname//'::CARMAELEMENT_Get failed.') call CARMAGROUP_Get(carma, igroup, rc, cnsttype=cnsttype, maxbin=maxbin, do_drydep=do_drydep) - if (rc < 0) call endrun('carma_timestep_tend::CARMAGROUP_Get failed.') + if (rc < 0) call endrun(subname//'::CARMAGROUP_Get failed.') if (cnsttype == I_CNSTTYPE_PROGNOSTIC) then @@ -1766,7 +1888,7 @@ subroutine carma_output_diagnostics(state, ptend, gpdiags, sbdiags, gsdiags, spd ! Output the particle diagnostics. do igroup = 1, NGROUP call CARMAGROUP_Get(carma, igroup, rc, shortname=sname, is_cloud=is_cloud, do_drydep=do_drydep, ienconc=ienconc) - if (rc < 0) call endrun('carma_output_diagnostics::CARMAGROUP_Get failed.') + if (rc < 0) call endrun(subname//'::CARMAGROUP_Get failed.') ! Gridbox average call outfld(trim(sname)//'ND', gpdiags(:, :, igroup, GPDIAGS_ND), pcols, lchnk) @@ -1781,12 +1903,20 @@ subroutine carma_output_diagnostics(state, ptend, gpdiags, sbdiags, gsdiags, spd call outfld(trim(sname)//'PA', gpdiags(:, :, igroup, GPDIAGS_PA), pcols, lchnk) call outfld(trim(sname)//'AR', gpdiags(:, :, igroup, GPDIAGS_AR), pcols, lchnk) call outfld(trim(sname)//'VM', gpdiags(:, :, igroup, GPDIAGS_VM), pcols, lchnk) + call outfld(trim(sname)//'VR', gpdiags(:, :, igroup, GPDIAGS_VR), pcols, lchnk) if (do_drydep) then do ibin = 1, NBIN call outfld(trim(btndname(igroup, ibin))//'VD', sbdiags(:, ibin, ienconc, SBDIAGS_VD), pcols, lchnk) end do end if + + do ibin = 1,NBIN + call outfld(trim(btndname(igroup, ibin))//'ND',bndiags(:, :, ibin, ienconc, BNDIAGS_ND), pcols, lchnk) + call outfld(trim(btndname(igroup, ibin))//'WR',bndiags(:, :, ibin, ienconc, BNDIAGS_WETR), pcols, lchnk) + call outfld(trim(btndname(igroup, ibin))//'RO',bndiags(:, :, ibin, ienconc, BNDIAGS_RO), pcols, lchnk) + call outfld(trim(btndname(igroup, ibin))//'VR',bndiags(:, :, ibin, ienconc, BNDIAGS_VR), pcols, lchnk) + end do end do ! Output the gas tendencies. @@ -1808,19 +1938,21 @@ subroutine carma_output_diagnostics(state, ptend, gpdiags, sbdiags, gsdiags, spd call outfld('CRTT', ptend%s(:, :) / cpair, pcols, lchnk) end if + ! Allow models to output their own diagnostics + call CARMAMODEL_OutputDiagnostics(carma, icnst4elem, state, ptend, pbuf, cam_in, rc) + return end subroutine carma_output_diagnostics - !! Calculate the emissions for CARMA aerosols. This is taken from !! the routine aerosol_emis_intr in aerosol_intr.F90 and dust_emis_intr in !! dust_intr.F90 by Phil Rasch. !! !! @author Chuck Bardeen !! @version May-2009 - subroutine carma_emission_tend (state, ptend, cam_in, dt) - use cam_history, only: outfld - use camsrfexch, only: cam_in_t + subroutine carma_emission_tend (state, ptend, cam_in, dt, pbuf) + use cam_history, only: outfld + use camsrfexch, only: cam_in_t implicit none @@ -1828,6 +1960,7 @@ subroutine carma_emission_tend (state, ptend, cam_in, dt) type(physics_ptend), intent(inout) :: ptend !! physics state tendencies type(cam_in_t), intent(inout) :: cam_in !! surface inputs real(r8), intent(in) :: dt !! time step (s) + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer integer :: lchnk ! chunk identifier integer :: ncol ! number of columns in chunk @@ -1873,7 +2006,7 @@ subroutine carma_emission_tend (state, ptend, cam_in, dt) icnst = icnst4elem(ielem, ibin) - call CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, rc) + call CARMAMODEL_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, pbuf, rc) if (rc < 0) call endrun('carma_emission_tend::CARMA_EmitParticle failed.') ! Add any surface flux here. @@ -1908,7 +2041,6 @@ end subroutine carma_emission_tend subroutine carma_wetdep_tend(state, ptend, dt, pbuf, dlf, cam_out) use cam_history, only: outfld use phys_control, only: cam_physpkg_is - use phys_grid, only: get_lat_all_p, get_lon_all_p, get_rlat_all_p use wetdep, only: clddiag, wetdepa_v1, wetdepa_v2 use camsrfexch, only: cam_out_t use physconst, only: gravit @@ -1942,7 +2074,7 @@ subroutine carma_wetdep_tend(state, ptend, dt, pbuf, dlf, cam_out) integer :: ixcldice real(r8) :: totcond(pcols, pver) ! total condensate real(r8) :: solfac(pcols, pver) ! solubility factor - real(r8) :: solfactor + real(r8) :: solfac_in ! solubility factor real(r8) :: scavcoef ! scavenging Coefficient logical :: do_wetdep integer :: ncol ! number of columns @@ -2030,11 +2162,11 @@ subroutine carma_wetdep_tend(state, ptend, dt, pbuf, dlf, cam_out) if (rc < 0) call endrun('carma_wetdep_tend::CARMAELEMENT_Get failed.') call CARMAGROUP_Get(carma, igroup, rc, cnsttype=cnsttype, do_wetdep=do_wetdep, & - solfac=solfactor, scavcoef=scavcoef, maxbin=maxbin) - solfac(:ncol,:) = solfactor - + solfac=solfac_in, scavcoef=scavcoef, maxbin=maxbin) if (rc < 0) call endrun('carma_wetdep_tend::CARMAGROUP_Get failed.') + solfac(:,:) = solfac_in + if ((do_wetdep) .and. (cnsttype == I_CNSTTYPE_PROGNOSTIC)) then do ibin = 1, NBIN @@ -2099,7 +2231,7 @@ subroutine carma_wetdep_tend(state, ptend, dt, pbuf, dlf, cam_out) iscavt, & cldv, & fracis(:, :, icnst), & - solfactor, & + solfac_in, & ncol, & z_scavcoef) else @@ -2122,7 +2254,7 @@ subroutine carma_wetdep_tend(state, ptend, dt, pbuf, dlf, cam_out) call outfld(trim(cnst_name(icnst))//'SW', sflx, pcols, lchnk) ! Add this to the surface amount of the constituent - call CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) + call CARMAMODEL_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) end if end do @@ -2138,10 +2270,114 @@ end subroutine carma_wetdep_tend !! code to include the impact of CARMA particles in the radiative transfer !! calculation. !! + !! The opticsType that is specified for the group determines how the optical + !! properties will be generated for that group. Each group can use a different + !! optics method if needed. Refractive indices need for these calculation are + !! are specified in the group's elements rather than at the group level. This + !! allows various mixing approaches to be used to determine the refractive index + !! for the particle as a whole. + !! + !! The I_OPTICS_MIXED_YU2105 and I_OPTICS_SULFATE_YU2015 optics methods are + !! designed to trop_strat models as define in the Yu et al. (2015) paper. The + !! other optics types can be applied more generically to a number of different + !! aerosol/cloud models. + !! !! NOTE: The format of this file is determined by the needs of the radiative tranfer !! code, so ideally a routine would exist in that module that could create a file !! with the proper format. Since that doesn't exist, we do it all here. subroutine CARMA_CreateOpticsFile(carma, rc) + + implicit none + + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Local variables + integer :: igroup + logical :: do_mie + integer :: cnsttype ! constituent type + integer :: opticsType + + ! Assume success. + rc = 0 + + ! Process each group that is defined in the model. + do igroup = 1, NGROUP + + ! Get the necessary group properties. + call CARMAGROUP_Get(carma, igroup, rc, do_mie=do_mie, cnsttype=cnsttype, iopticstype=opticsType) + if (rc < 0) call endrun('carma_CreateOpticsFile::CARMAGROUP_Get failed.') + + ! Are we supposed to do the mie calculation for this group? + if ((do_mie) .and. (cnsttype == I_CNSTTYPE_PROGNOSTIC)) then + + ! What type of calculation is needed for this group? + ! + ! NOTE: Some of these calculations generate optical properties as single mass + ! coefficients, while others are lookup tables designed around multiple + ! dimensions. + select case (opticsType) + + ! This is for fixed composition, but the particle may swell in response + ! to changes in RH. Only one refractive index specified at the group level. + ! + ! NOTE: This is what was used by the first CARMA models that were radiatively + ! active. + case (I_OPTICS_FIXED) + call CARMA_CreateOpticsFile_Fixed(carma, igroup, rc) + if (rc < 0) call endrun('carma_CreateOpticsFile::CreateOpticsFile_Fixed failed.') + + ! This is similar to Yu (2015) in that handles mixed particles treated as + ! core shell particles; however the dimensions of the lookup table are the + ! the radii and the refractive indicies, so it can be used with various + ! aerosol configurations (not just as in the Yu(2015)). + case(I_OPTICS_MIXED_CORESHELL) + call endrun('carma_CreateOpticsFile mixed_coreshell has not been implemented.') + + ! This is similar to MAM4, in that a volume mixing approach is used to + ! mixed both the core and the shell together and thus only one radius and + ! one refractive index are needed in the lookup table. + case(I_OPTICS_MIXED_VOLUME) + call endrun('carma_CreateOpticsFile mixed_volume has not been implemented.') + + ! This is similar to "mixed_volume", except that Maxwell-Garnett mixing + ! is used instead of volume mixing. + case(I_OPTICS_MIXED_MAXWELL) + call endrun('carma_CreateOpticsFile mixed_maxwell has not been implemented.') + + ! This is for a pure sulfate group where the table is based upon weight + ! percent; however, unlike sulfate_Yu, the refractive index of the sulfate + ! changes with the weight percent of H2SO4. + case(I_OPTICS_SULFATE) + call CARMA_CreateOpticsFile_Sulfate(carma, igroup, rc) + if (rc < 0) call endrun('carma_CreateOpticsFile::CreateOpticsFile_Sulfate failed.') + + ! Other types are not generically useful are are particular to the + ! specific model, so thos are handled by model specific code. These + ! include: + ! I_OPTICS_MIXED_YU2015 + ! I_OPTICS_MIXED_YU_H2O + ! I_OPTICS_SULFATE_YU2015 + case default + call CARMAMODEL_CreateOpticsFile(carma, igroup, opticsType, rc) + + end select + end if + end do + + return + end subroutine CARMA_CreateOpticsFile + + + !! This routine creates files containing optical properties for each radiatively + !! active particle type. These optical properties are used by the RRTMG radiation + !! code to include the impact of CARMA particles in the radiative transfer + !! calculation. + !! + !! NOTE: The format of this file is determined by the needs of the radiative tranfer + !! code, so ideally a routine would exist in that module that could create a file + !! with the proper format. Since that doesn't exist, we do it all here. + subroutine CARMA_CreateOpticsFile_Fixed(carma, igroup, rc) use radconstants, only : nswbands, nlwbands use wrap_nf use wetr, only : getwetr @@ -2149,16 +2385,17 @@ subroutine CARMA_CreateOpticsFile(carma, rc) implicit none type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(in) :: igroup !! group index integer, intent(out) :: rc !! return code, negative indicates failure ! Local variables - integer :: igroup, ibin, iwave, irh + integer :: ibin, iwave, irh integer :: irhswell integer :: ienconc real(kind=f) :: rho(NBIN), rhopwet real(kind=f) :: r(NBIN), rmass(NBIN), rlow(NBIN), rup(NBIN) real(kind=f) :: wave(NWAVE) - complex(kind=f) :: refidx(NWAVE) + complex(kind=f) :: refidx(NWAVE, NREFIDX) character(len=CARMA_NAME_LEN) :: name character(len=CARMA_SHORT_NAME_LEN) :: shortname logical :: do_mie @@ -2199,381 +2436,661 @@ subroutine CARMA_CreateOpticsFile(carma, rc) call CARMA_GET(carma, rc, wave=wave, do_print=do_print, LUNOPRT=LUNOPRT) if (rc < 0) call endrun('carma_CreateOpticsFile::CARMA_Get failed.') - ! Process each group that is defined in the model. - do igroup = 1, NGROUP + ! Get the necessary group properties. + call CARMAGROUP_Get(carma, igroup, rc, do_mie=do_mie, name=name, shortname=shortname, r=r, & + rlow=rlow, rup=rup, rmass=rmass, irhswell=irhswell, & + ienconc=ienconc, cnsttype=cnsttype, maxbin=maxbin) + if (rc < 0) call endrun('carma_CreateOpticsFile::CARMAGROUP_Get failed.') - ! Get the necessary group properties. - call CARMAGROUP_Get(carma, igroup, rc, do_mie=do_mie, name=name, shortname=shortname, r=r, & - rlow=rlow, rup=rup, rmass=rmass, refidx=refidx, irhswell=irhswell, & - ienconc=ienconc, cnsttype=cnsttype, maxbin=maxbin) - if (rc < 0) call endrun('carma_CreateOpticsFile::CARMAGROUP_Get failed.') + call CARMAELEMENT_Get(carma, ienconc, rc, rho=rho, refidx=refidx) + if (rc < 0) call endrun('carma_CreateOpticsFile::CARMAELEMENT_Get failed.') - ! Are we supposed to do the mie calculation for this group? - if ((do_mie) .and. (cnsttype == I_CNSTTYPE_PROGNOSTIC)) then + ! A file needs to be created for each bin. + do ibin = 1, NBIN - call CARMAELEMENT_Get(carma, ienconc, rc, rho=rho) - if (rc < 0) call endrun('carma_CreateOpticsFile::CARMAELEMENT_Get failed.') + ! Bins past maxbin are treated as diagnostic even if the group + ! is prognostic and thus are not advected in the paerent model. + if (ibin <= maxbin) then - ! A file needs to be created for each bin. - do ibin = 1, NBIN + write(c_name, '(A, I2.2)') trim(shortname), ibin - ! Bins past maxbin are treated as diagnostic even if the group - ! is prognostic and thus are not advected in the paerent model. - if (ibin <= maxbin) then + ! Construct the path to the file. Each model will have its own subdirectory + ! where the optical property files are stored. + filepath = trim(carma_model) // '_' // trim(c_name) // '_rrtmg.nc' - write(c_name, '(A, I2.2)') trim(shortname), ibin + if (do_print) write(LUNOPRT,*) 'Creating CARMA optics file ... ', trim(filepath) - ! Construct the path to the file. Each model will have its own subdirectory - ! where the optical property files are stored. - filepath = trim(carma_model) // '_' // trim(c_name) // '_rrtmg.nc' + ! Create the file. + call wrap_create(filepath, NF90_CLOBBER, fid) - if (do_print) write(LUNOPRT,*) 'Creating CARMA optics file ... ', trim(filepath) + ! For non-hygroscopic, only use 1 RH value. + if (irhswell /= 0) then + nrh = NMIE_RH + else + nrh = min(NMIE_RH, 1) + end if - ! Create the file. - call wrap_create(filepath, NF90_CLOBBER, fid) + ! Define the dimensions: rh, lwbands, swbands + call wrap_def_dim(fid, 'rh_idx', nrh, rhdim) + call wrap_def_dim(fid, 'lw_band', nlwbands, lwdim) + call wrap_def_dim(fid, 'sw_band', nswbands, swdim) - ! For non-hygroscopic, only use 1 RH value. - if (irhswell /= 0) then - nrh = NMIE_RH - else - nrh = min(NMIE_RH, 1) - end if + write(LUNOPRT,*) "Defined rh_idx, lw_band, and sw_band dims." - ! Define the dimensions: rh, lwbands, swbands - call wrap_def_dim(fid, 'rh_idx', nrh, rhdim) - call wrap_def_dim(fid, 'lw_band', nlwbands, lwdim) - call wrap_def_dim(fid, 'sw_band', nswbands, swdim) + dimids(1) = rhdim + call wrap_def_var(fid, 'rh', NF90_DOUBLE, 1, dimids(1:1), rhvar) - write(LUNOPRT,*) "Defined rh_idx, lw_band, and sw_band dims." + dimids(1) = lwdim + call wrap_def_var(fid, 'lw_band', NF90_DOUBLE, 1, dimids(1:1), lwvar) - dimids(1) = rhdim - call wrap_def_var(fid, 'rh', NF90_DOUBLE, 1, dimids(1:1), rhvar) + dimids(1) = swdim + call wrap_def_var(fid, 'sw_band', NF90_DOUBLE, 1, dimids(1:1), swvar) - dimids(1) = lwdim - call wrap_def_var(fid, 'lw_band', NF90_DOUBLE, 1, dimids(1:1), lwvar) + write(LUNOPRT,*) "Defined rh_idx, lw_band, and sw_band vars." - dimids(1) = swdim - call wrap_def_var(fid, 'sw_band', NF90_DOUBLE, 1, dimids(1:1), swvar) + call wrap_put_att_text(fid, rhvar, 'units', 'fraction') + call wrap_put_att_text(fid, lwvar, 'units', 'm') + call wrap_put_att_text(fid, swvar, 'units', 'm') - write(LUNOPRT,*) "Defined rh_idx, lw_band, and sw_band vars." + call wrap_put_att_text(fid, rhvar, 'long_name', 'relative humidity') + call wrap_put_att_text(fid, lwvar, 'long_name', 'longwave bands') + call wrap_put_att_text(fid, swvar, 'long_name', 'shortwave bands') - call wrap_put_att_text(fid, rhvar, 'units', 'fraction') - call wrap_put_att_text(fid, lwvar, 'units', 'm') - call wrap_put_att_text(fid, swvar, 'units', 'm') + ! Define the variables: abs_lw, ext_sw, ssa_sw, asm_sw + dimids(1) = rhdim + dimids(2) = lwdim + call wrap_def_var(fid, 'abs_lw', NF90_DOUBLE, 2, dimids, abs_lw_var) - call wrap_put_att_text(fid, rhvar, 'long_name', 'relative humidity') - call wrap_put_att_text(fid, lwvar, 'long_name', 'longwave bands') - call wrap_put_att_text(fid, swvar, 'long_name', 'shortwave bands') + write(LUNOPRT,*) "Defined abs_lw." - ! Define the variables: abs_lw, ext_sw, ssa_sw, asm_sw - dimids(1) = rhdim - dimids(2) = lwdim - call wrap_def_var(fid, 'abs_lw', NF90_DOUBLE, 2, dimids, abs_lw_var) + call wrap_put_att_text(fid, abs_lw_var, 'units', 'meter^2 kilogram^-1') - write(LUNOPRT,*) "Defined abs_lw." + dimids(1) = rhdim + dimids(2) = swdim + call wrap_def_var(fid, 'ext_sw', NF90_DOUBLE, 2, dimids, ext_sw_var) + call wrap_def_var(fid, 'ssa_sw', NF90_DOUBLE, 2, dimids, ssa_sw_var) + call wrap_def_var(fid, 'asm_sw', NF90_DOUBLE, 2, dimids, asm_sw_var) - call wrap_put_att_text(fid, abs_lw_var, 'units', 'meter^2 kilogram^-1') + write(LUNOPRT,*) "Defined ext_sw, ssa_sw, and asm_sw." - dimids(1) = rhdim - dimids(2) = swdim - call wrap_def_var(fid, 'ext_sw', NF90_DOUBLE, 2, dimids, ext_sw_var) - call wrap_def_var(fid, 'ssa_sw', NF90_DOUBLE, 2, dimids, ssa_sw_var) - call wrap_def_var(fid, 'asm_sw', NF90_DOUBLE, 2, dimids, asm_sw_var) + call wrap_put_att_text(fid, ssa_sw_var, 'units', 'fraction') + call wrap_put_att_text(fid, ext_sw_var, 'units', 'meter^2 kilogram^-1') + call wrap_put_att_text(fid, asm_sw_var, 'units', '-') - write(LUNOPRT,*) "Defined ext_sw, ssa_sw, and asm_sw." + ! Define the variables for the refractive indicies. + dimids(1) = swdim + call wrap_def_var(fid, 'refindex_real_aer_sw', NF90_DOUBLE, 1, dimids(1:1), sw_r_refidx_var) + call wrap_def_var(fid, 'refindex_im_aer_sw', NF90_DOUBLE, 1, dimids(1:1), sw_i_refidx_var) - call wrap_put_att_text(fid, ssa_sw_var, 'units', 'fraction') - call wrap_put_att_text(fid, ext_sw_var, 'units', 'meter^2 kilogram^-1') - call wrap_put_att_text(fid, asm_sw_var, 'units', '-') + write(LUNOPRT,*) "Defined lw refindex." - ! Define the variables for the refractive indicies. - dimids(1) = swdim - call wrap_def_var(fid, 'refindex_real_aer_sw', NF90_DOUBLE, 1, dimids(1:1), sw_r_refidx_var) - call wrap_def_var(fid, 'refindex_im_aer_sw', NF90_DOUBLE, 1, dimids(1:1), sw_i_refidx_var) + dimids(1) = lwdim + call wrap_def_var(fid, 'refindex_real_aer_lw', NF90_DOUBLE, 1, dimids(1:1), lw_r_refidx_var) + call wrap_def_var(fid, 'refindex_im_aer_lw', NF90_DOUBLE, 1, dimids(1:1), lw_i_refidx_var) - write(LUNOPRT,*) "Defined lw refindex." + write(LUNOPRT,*) "Defined sw refindex." - dimids(1) = lwdim - call wrap_def_var(fid, 'refindex_real_aer_lw', NF90_DOUBLE, 1, dimids(1:1), lw_r_refidx_var) - call wrap_def_var(fid, 'refindex_im_aer_lw', NF90_DOUBLE, 1, dimids(1:1), lw_i_refidx_var) + call wrap_put_att_text(fid, sw_r_refidx_var, 'units', '-') + call wrap_put_att_text(fid, sw_i_refidx_var, 'units', '-') + call wrap_put_att_text(fid, lw_r_refidx_var, 'units', '-') + call wrap_put_att_text(fid, lw_i_refidx_var, 'units', '-') - write(LUNOPRT,*) "Defined sw refindex." + call wrap_put_att_text(fid, sw_r_refidx_var, 'long_name', 'real refractive index of aerosol - shortwave') + call wrap_put_att_text(fid, sw_i_refidx_var, 'long_name', 'imaginary refractive index of aerosol - shortwave') + call wrap_put_att_text(fid, lw_r_refidx_var, 'long_name', 'real refractive index of aerosol - longwave') + call wrap_put_att_text(fid, lw_i_refidx_var, 'long_name', 'imaginary refractive index of aerosol - longwave') - call wrap_put_att_text(fid, sw_r_refidx_var, 'units', '-') - call wrap_put_att_text(fid, sw_i_refidx_var, 'units', '-') - call wrap_put_att_text(fid, lw_r_refidx_var, 'units', '-') - call wrap_put_att_text(fid, lw_i_refidx_var, 'units', '-') - call wrap_put_att_text(fid, sw_r_refidx_var, 'long_name', 'real refractive index of aerosol - shortwave') - call wrap_put_att_text(fid, sw_i_refidx_var, 'long_name', 'imaginary refractive index of aerosol - shortwave') - call wrap_put_att_text(fid, lw_r_refidx_var, 'long_name', 'real refractive index of aerosol - longwave') - call wrap_put_att_text(fid, lw_i_refidx_var, 'long_name', 'imaginary refractive index of aerosol - longwave') + ! Define fields that define the aerosol properties. + call wrap_def_dim(fid, 'opticsmethod_len', 32, omdim) + dimids(1) = omdim + call wrap_def_var(fid, 'opticsmethod', NF90_CHAR, 1, dimids(1:1), omvar) + write(LUNOPRT,*) "Defined omdim." - ! Define fields that define the aerosol properties. - call wrap_def_dim(fid, 'opticsmethod_len', 32, omdim) - dimids(1) = omdim - call wrap_def_var(fid, 'opticsmethod', NF90_CHAR, 1, dimids(1:1), omvar) + call wrap_def_dim(fid, 'namelength', 20, andim) + dimids(1) = andim + call wrap_def_var(fid, 'aername', NF90_CHAR, 1, dimids(1:1), anvar) - write(LUNOPRT,*) "Defined omdim." + write(LUNOPRT,*) "Defined aername." - call wrap_def_dim(fid, 'namelength', 20, andim) - dimids(1) = andim - call wrap_def_var(fid, 'aername', NF90_CHAR, 1, dimids(1:1), anvar) + call wrap_def_dim(fid, 'name_len', 32, namedim) + dimids(1) = namedim + call wrap_def_var(fid, 'name', NF90_CHAR, 1, dimids(1:1), namevar) - write(LUNOPRT,*) "Defined aername." + write(LUNOPRT,*) "Defined name." - call wrap_def_dim(fid, 'name_len', 32, namedim) - dimids(1) = namedim - call wrap_def_var(fid, 'name', NF90_CHAR, 1, dimids(1:1), namevar) + call wrap_def_var(fid, 'density', NF90_DOUBLE, 0, dimids(1:0), denvar) + call wrap_def_var(fid, 'sigma_logr', NF90_DOUBLE, 0, dimids(1:0), slogvar) + call wrap_def_var(fid, 'dryrad', NF90_DOUBLE, 0, dimids(1:0), dryrvar) + call wrap_def_var(fid, 'radmin_aer', NF90_DOUBLE, 0, dimids(1:0), rminvar) + call wrap_def_var(fid, 'radmax_aer', NF90_DOUBLE, 0, dimids(1:0), rmaxvar) + call wrap_def_var(fid, 'hygroscopicity', NF90_DOUBLE, 0, dimids(1:0), hygrovar) + call wrap_def_var(fid, 'num_to_mass_ratio', NF90_DOUBLE, 0, dimids(1:0), ntmvar) - write(LUNOPRT,*) "Defined name." + call wrap_put_att_text(fid, denvar, 'units', 'kg m^-3') + call wrap_put_att_text(fid, slogvar, 'units', '-') + call wrap_put_att_text(fid, dryrvar, 'units', 'm') + call wrap_put_att_text(fid, rminvar, 'units', 'm') + call wrap_put_att_text(fid, rmaxvar, 'units', 'm') + call wrap_put_att_text(fid, hygrovar, 'units', '-') + call wrap_put_att_text(fid, ntmvar, 'units', 'kg^-1') - call wrap_def_var(fid, 'density', NF90_DOUBLE, 0, dimids(1:0), denvar) - call wrap_def_var(fid, 'sigma_logr', NF90_DOUBLE, 0, dimids(1:0), slogvar) - call wrap_def_var(fid, 'dryrad', NF90_DOUBLE, 0, dimids(1:0), dryrvar) - call wrap_def_var(fid, 'radmin_aer', NF90_DOUBLE, 0, dimids(1:0), rminvar) - call wrap_def_var(fid, 'radmax_aer', NF90_DOUBLE, 0, dimids(1:0), rmaxvar) - call wrap_def_var(fid, 'hygroscopicity', NF90_DOUBLE, 0, dimids(1:0), hygrovar) - call wrap_def_var(fid, 'num_to_mass_ratio', NF90_DOUBLE, 0, dimids(1:0), ntmvar) + call wrap_put_att_text(fid, denvar, 'long_name', 'aerosol material density') + call wrap_put_att_text(fid, slogvar, 'long_name', 'geometric standard deviation of aerosol') + call wrap_put_att_text(fid, dryrvar, 'long_name', 'dry number mode radius of aerosol') + call wrap_put_att_text(fid, rminvar, 'long_name', 'minimum dry radius of aerosol for bin') + call wrap_put_att_text(fid, rmaxvar, 'long_name', 'maximum dry radius of aerosol for bin') + call wrap_put_att_text(fid, hygrovar, 'long_name', 'hygroscopicity of aerosol') + call wrap_put_att_text(fid, ntmvar, 'long_name', 'ratio of number to mass of aerosol') - call wrap_put_att_text(fid, denvar, 'units', 'kg m^-3') - call wrap_put_att_text(fid, slogvar, 'units', '-') - call wrap_put_att_text(fid, dryrvar, 'units', 'm') - call wrap_put_att_text(fid, rminvar, 'units', 'm') - call wrap_put_att_text(fid, rmaxvar, 'units', 'm') - call wrap_put_att_text(fid, hygrovar, 'units', '-') - call wrap_put_att_text(fid, ntmvar, 'units', 'kg^-1') - call wrap_put_att_text(fid, denvar, 'long_name', 'aerosol material density') - call wrap_put_att_text(fid, slogvar, 'long_name', 'geometric standard deviation of aerosol') - call wrap_put_att_text(fid, dryrvar, 'long_name', 'dry number mode radius of aerosol') - call wrap_put_att_text(fid, rminvar, 'long_name', 'minimum dry radius of aerosol for bin') - call wrap_put_att_text(fid, rmaxvar, 'long_name', 'maximum dry radius of aerosol for bin') - call wrap_put_att_text(fid, hygrovar, 'long_name', 'hygroscopicity of aerosol') - call wrap_put_att_text(fid, ntmvar, 'long_name', 'ratio of number to mass of aerosol') + write(LUNOPRT,*) "Defined all variables." + ! End the defintion phase of the netcdf file. + call wrap_enddef(fid) - write(LUNOPRT,*) "Defined all variables." + ! Write out the dimensions. + call wrap_put_var_realx(fid, rhvar, mie_rh(:nrh)) + call wrap_put_var_realx(fid, lwvar, wave(:nlwbands) * 1e-2_f) + call wrap_put_var_realx(fid, swvar, wave(nlwbands+1:) * 1e-2_f) - ! End the defintion phase of the netcdf file. - call wrap_enddef(fid) + ! Write out the refractive indicies. + call wrap_put_var_realx(fid, sw_r_refidx_var, real(refidx(nlwbands+1:, 1))) + call wrap_put_var_realx(fid, sw_i_refidx_var, aimag(refidx(nlwbands+1:, 1))) + call wrap_put_var_realx(fid, lw_r_refidx_var, real(refidx(:nlwbands, 1))) + call wrap_put_var_realx(fid, lw_i_refidx_var, aimag(refidx(:nlwbands, 1))) - ! Write out the dimensions. - call wrap_put_var_realx(fid, rhvar, mie_rh(:nrh)) - call wrap_put_var_realx(fid, lwvar, wave(:nlwbands) * 1e-2_f) - call wrap_put_var_realx(fid, swvar, wave(nlwbands+1:) * 1e-2_f) + ! Pad the names out with spaces. + aer_name = ' ' + aer_name(1:len(trim(c_name))) = c_name + + start_text(1) = 1 + count_text(1) = 32 + call wrap_put_vara_text(fid, namevar, start_text, count_text, (/ aer_name /)) + count_text(1) = 20 + call wrap_put_vara_text(fid, anvar, start_text, count_text, (/ aer_name /)) - ! Write out the refractive indicies. - call wrap_put_var_realx(fid, sw_r_refidx_var, real(refidx(nlwbands+1:))) - call wrap_put_var_realx(fid, sw_i_refidx_var, aimag(refidx(nlwbands+1:))) - call wrap_put_var_realx(fid, lw_r_refidx_var, real(refidx(:nlwbands))) - call wrap_put_var_realx(fid, lw_i_refidx_var, aimag(refidx(:nlwbands))) + ! These fields control whether the particle is treated as a CCN. For now, + ! set these so that CARMA particles are not considered as CCN by the + ! CAM microphysics. + if (irhswell /= 0) then + count_text(1) = len('hygroscopic ') + call wrap_put_vara_text(fid, omvar, start_text, count_text, (/ 'hygroscopic ' /)) + else + count_text(1) = len('insoluble ') + call wrap_put_vara_text(fid, omvar, start_text, count_text, (/ 'insoluble ' /)) + end if + call wrap_put_var_realx(fid, denvar, (/ rho(ibin) * 1e-3_f / 1e-6_f /)) + call wrap_put_var_realx(fid, slogvar, (/ 0._f /)) + call wrap_put_var_realx(fid, dryrvar, (/ r(ibin) * 1e-2_f /)) + call wrap_put_var_realx(fid, rminvar, (/ rlow(ibin) * 1e-2_f /)) + call wrap_put_var_realx(fid, rmaxvar, (/ rup(ibin) * 1e-2_f /)) + call wrap_put_var_realx(fid, hygrovar, (/ 0._f /)) + call wrap_put_var_realx(fid, ntmvar, (/ 1._f / rmass(ibin) / 1e-3_f /)) - ! Pad the names out with spaces. - aer_name = ' ' - aer_name(1:len(trim(c_name))) = c_name + ! Iterate over a range of relative humidities, since the particle may swell + ! with relative humidity which will change its optical properties. + do irh = 1, nrh - start_text(1) = 1 - count_text(1) = 32 - call wrap_put_vara_text(fid, namevar, start_text, count_text, (/ aer_name /)) - count_text(1) = 20 - call wrap_put_vara_text(fid, anvar, start_text, count_text, (/ aer_name /)) + ! Determine the wet radius. + call getwetr(carma, igroup, mie_rh(irh), r(ibin), rwet, rho(ibin), rhopwet, rc) + if (rc < 0) call endrun('carma_CreateOpticsFile::wetr failed.') - ! These fields control whether the particle is treated as a CCN. For now, - ! set these so that CARMA particles are not considered as CCN by the - ! CAM microphysics. - if (irhswell /= 0) then - count_text(1) = len('hygroscopic ') - call wrap_put_vara_text(fid, omvar, start_text, count_text, (/ 'hygroscopic ' /)) - else - count_text(1) = len('insoluble ') - call wrap_put_vara_text(fid, omvar, start_text, count_text, (/ 'insoluble ' /)) - end if + ! Calculate at each wavelength. + do iwave = 1, NWAVE - call wrap_put_var_realx(fid, denvar, (/ rho(ibin) * 1e-3_f / 1e-6_f /)) - call wrap_put_var_realx(fid, slogvar, (/ 0._f /)) - call wrap_put_var_realx(fid, dryrvar, (/ r(ibin) * 1e-2_f /)) - call wrap_put_var_realx(fid, rminvar, (/ rlow(ibin) * 1e-2_f /)) - call wrap_put_var_realx(fid, rmaxvar, (/ rup(ibin) * 1e-2_f /)) - call wrap_put_var_realx(fid, hygrovar, (/ 0._f /)) - call wrap_put_var_realx(fid, ntmvar, (/ 1._f / rmass(ibin) / 1e-3_f /)) - - ! Iterate over a range of relative humidities, since the particle may swell - ! with relative humidity which will change its optical properties. - do irh = 1, nrh - - ! Determine the wet radius. - call getwetr(carma, igroup, mie_rh(irh), r(ibin), rwet, rho(ibin), rhopwet, rc) - if (rc < 0) call endrun('carma_CreateOpticsFile::wetr failed.') - - ! Calculate at each wavelength. - do iwave = 1, NWAVE -write(carma%f_LUNOPRT,*) "CARMA mie calc: start ", igroup, ibin, iwave, carma%f_wave(iwave), carma%f_group(igroup)%f_nmon(ibin) - - - ! Using Mie code, calculate the optical properties: extinction coefficient, - ! single scattering albedo and asymmetry factor. - ! Assume the particle is homogeneous (no core). - ! - ! NOTE: nmon, df, rmon and falpha are only used for fractal particles. - call mie(carma, & - carma%f_group(igroup)%f_imiertn, & - rwet, & - carma%f_wave(iwave), & - carma%f_group(igroup)%f_nmon(ibin), & - carma%f_group(igroup)%f_df(ibin), & - carma%f_group(igroup)%f_rmon, & - carma%f_group(igroup)%f_falpha, & - carma%f_group(igroup)%f_refidx(iwave), & - Qext, & - Qsca, & - asym, & - rc) - if (rc < 0) call endrun('carma_CreateOpticsFile::mie failed.') -write(carma%f_LUNOPRT,*) "CARMA mie calc: done ", Qext, Qsca, asym - - - ! Calculate the shortwave and longwave properties? - ! - ! NOTE: miess is in cgs units, but the optics file needs to be in mks - ! units, so perform the necessary conversions. - if (iwave <= nlwbands) then - - ! Longwave just needs absorption: abs_lw. - abs_lw(irh, iwave) = (Qext - Qsca) * PI * (rwet * 1e-2_f)**2 / (rmass(ibin) * 1e-3_f) - else - - ! Shortwave needs extinction, single scattering albedo and asymmetry factor: - ! ext_sw, ssa_sw and asm_sw. - ext_sw(irh, iwave - nlwbands) = Qext * PI * (rwet * 1e-2_f)**2 / (rmass(ibin) * 1e-3_f) - ssa_sw(irh, iwave - nlwbands) = Qsca / Qext - asm_sw(irh, iwave - nlwbands) = asym - end if - end do - end do + ! Using Mie code, calculate the optical properties: extinction coefficient, + ! single scattering albedo and asymmetry factor. + ! Assume the particle is homogeneous (no core). + ! + ! NOTE: nmon, df, rmon and falpha are only used for fractal particles. + call mie(carma, & + carma%f_group(igroup)%f_imiertn, & + rwet, & + carma%f_wave(iwave), & + real(carma%f_group(igroup)%f_nmon(ibin),kind=f), & + carma%f_group(igroup)%f_df(ibin), & + carma%f_group(igroup)%f_rmon, & + carma%f_group(igroup)%f_falpha, & + refidx(iwave, 1), & + 0.0_f, & + refidx(iwave, 1), & + Qext, & + Qsca, & + asym, & + rc) + if (rc < 0) call endrun('carma_CreateOpticsFile::mie failed.') + + ! Calculate the shortwave and longwave properties? + ! + ! NOTE: miess is in cgs units, but the optics file needs to be in mks + ! units, so perform the necessary conversions. + if (iwave <= nlwbands) then - ! Write out the longwave fields. - ret = nf90_put_var (fid, abs_lw_var, abs_lw(:nrh, :)) - if (ret/=NF90_NOERR) then - write(iulog,*)'CARMA_CreateOpticsFile: error writing varid =', abs_lw_var - call handle_error (ret) - end if + ! Longwave just needs absorption: abs_lw. + abs_lw(irh, iwave) = (Qext - Qsca) * PI * (rwet * 1e-2_f)**2 / (rmass(ibin) * 1e-3_f) + else - ! Write out the shortwave fields. - ret = nf90_put_var (fid, ext_sw_var, ext_sw(:nrh, :)) - if (ret/=NF90_NOERR) then - write(iulog,*)'CARMA_CreateOpticsFile: error writing varid =', ext_sw_var - call handle_error (ret) - end if - ret = nf90_put_var (fid, ssa_sw_var, ssa_sw(:nrh, :)) - if (ret/=NF90_NOERR) then - write(iulog,*)'CARMA_CreateOpticsFile: error writing varid =', ssa_sw_var - call handle_error (ret) + ! Shortwave needs extinction, single scattering albedo and asymmetry factor: + ! ext_sw, ssa_sw and asm_sw. + ext_sw(irh, iwave - nlwbands) = Qext * PI * (rwet * 1e-2_f)**2 / (rmass(ibin) * 1e-3_f) + ssa_sw(irh, iwave - nlwbands) = Qsca / Qext + asm_sw(irh, iwave - nlwbands) = asym end if - ret = nf90_put_var (fid, asm_sw_var, asm_sw(:nrh, :)) - if (ret/=NF90_NOERR) then - write(iulog,*)'CARMA_CreateOpticsFile: error writing varid =', asm_sw_var - call handle_error (ret) - end if - - ! Close the file. - call wrap_close(fid) - end if + end do end do + + ! Write out the longwave fields. + ret = nf90_put_var (fid, abs_lw_var, abs_lw(:nrh, :)) + if (ret/=NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile: error writing varid =', abs_lw_var + call handle_error (ret) + end if + + ! Write out the shortwave fields. + ret = nf90_put_var (fid, ext_sw_var, ext_sw(:nrh, :)) + if (ret/=NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile: error writing varid =', ext_sw_var + call handle_error (ret) + end if + ret = nf90_put_var (fid, ssa_sw_var, ssa_sw(:nrh, :)) + if (ret/=NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile: error writing varid =', ssa_sw_var + call handle_error (ret) + end if + ret = nf90_put_var (fid, asm_sw_var, asm_sw(:nrh, :)) + if (ret/=NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile: error writing varid =', asm_sw_var + call handle_error (ret) + end if + + ! Close the file. + call wrap_close(fid) end if end do return - end subroutine CARMA_CreateOpticsFile + end subroutine CARMA_CreateOpticsFile_Fixed - !! This routine creates a file containing a reference temperature profile - !! for use with fixed initialization. - subroutine CARMA_CreateRefTFile(carma, filepath, lev, reft, rc, refh2o, refh2so4) + + !! This routine creates files containing optical properties for the pure sulfate group + !! following Yu et al. (2015). These optical properties are used by the RRTMG radiation + !! code to include the impact of CARMA particles in the radiative transfer + !! calculation. + subroutine CARMA_CreateOpticsFile_Sulfate(carma, igroup, rc) + use radconstants, only : nswbands, nlwbands use wrap_nf + use wetr, only : getwetr implicit none - type(carma_type), intent(inout) :: carma !! the carma object - character(len=*), intent(in) :: filepath !! the file path - real(kind=f), intent(in) :: lev(pver) !! pressure levels - real(kind=f), intent(in) :: reft(pver) !! reference temperature - integer, intent(out) :: rc !! return code, negative indicates failure - real(kind=f), optional, intent(in) :: refh2o(pver) !! reference water vapor - real(kind=f), optional, intent(in) :: refh2so4(pver) !! reference sulfuric acid + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(in) :: igroup !! group index + integer, intent(out) :: rc !! return code, negative indicates failure ! Local variables + integer :: ibin, iwave, iwtp + integer :: irhswell + integer :: imiertn + integer :: ienconc + real(kind=f) :: rho(NBIN), rhopwet + real(kind=f) :: r(NBIN), rmass(NBIN), rlow(NBIN), rup(NBIN) + real(kind=f) :: wave(NWAVE) + complex(kind=f) :: refidx(NWAVE) + complex(kind=f) :: refidxS(NWAVE, NREFIDX) + complex(kind=f) :: refidxW(NWAVE) + character(len=CARMA_NAME_LEN) :: name + character(len=CARMA_SHORT_NAME_LEN) :: shortname integer :: fid - integer :: levdim - integer :: levvar, tvar, h2ovar, h2so4var + integer :: rhdim, lwdim, swdim, wtpdim + integer :: rhvar, lwvar, swvar, wtp_var + integer :: rwetvar + integer :: abs_lw_wtp_var, qabs_lw_wtp_var + integer :: ext_sw_wtp_var, ssa_sw_wtp_var, asm_sw_wtp_var, qext_sw_wtp_var + integer :: omdim, andim, namedim + integer :: omvar, anvar, namevar integer :: dimids(2) + integer :: denvar, slogvar, dryrvar, rminvar, rmaxvar, hygrovar, ntmvar + real(kind=f) :: abs_lw_wtp(NMIE_WTP, nlwbands) + real(kind=f) :: qabs_lw_wtp(NMIE_WTP, nlwbands) + real(kind=f) :: ext_sw_wtp(NMIE_WTP, nswbands) + real(kind=f) :: qext_sw_wtp(NMIE_WTP, nswbands) + real(kind=f) :: ssa_sw_wtp(NMIE_WTP, nswbands) + real(kind=f) :: asm_sw_wtp(NMIE_WTP, nswbands) + character(len=8) :: c_name ! constituent name + character(len=32) :: aer_name ! long enough for both aername and name + character(len=255) :: filepath + real(kind=f) :: rwet + real(kind=f) :: Qext + real(kind=f) :: Qsca + real(kind=f) :: asym + integer :: start_text(2), count_text(2) + integer :: sw_r_refidx_var, sw_i_refidx_var, lw_r_refidx_var, lw_i_refidx_var + integer :: cnsttype ! constituent type + integer :: maxbin ! last prognostic bin + integer :: LUNOPRT ! logical unit number for output + logical :: do_print ! do print output? + integer :: ret + real(kind=f) :: volwater + real(kind=f) :: volsulfate + real(kind=f) :: volshell + integer :: igash2o ! Assume success. rc = 0 - ! Create the file. - call wrap_create(filepath, NF90_CLOBBER, fid) + ! Get the wavelength structure. + call CARMA_GET(carma, rc, wave=wave, do_print=do_print, LUNOPRT=LUNOPRT, igash2o=igash2o) + if (rc < 0) call endrun('carma_CreateOpticsFile::CARMA_Get failed.') + ! Get the necessary group properties. + call CARMAGROUP_Get(carma, igroup, rc, name=name, shortname=shortname, r=r, & + rlow=rlow, rup=rup, rmass=rmass, irhswell=irhswell, & + ienconc=ienconc, cnsttype=cnsttype, maxbin=maxbin, imiertn=imiertn) + if (rc < 0) call endrun('carma_CreateOpticsFile::CARMAGROUP_Get failed.') - ! Define the dimensions: lev - call wrap_def_dim(fid, 'lev', pver, levdim) + ! Get the necessary element properties. + call CARMAELEMENT_Get(carma, ienconc, rc, rho=rho, refidx=refidxS) + if (rc < 0) call endrun('carma_CreateOpticsFile::CARMAELEMENT_Get failed.') - dimids(1) = levdim - call wrap_def_var(fid, 'lev', NF90_DOUBLE, 1, dimids(1:1), levvar) + ! Get the refractive index for water. + call CARMAGAS_Get(carma, igash2o, rc, refidx=refidxW) + if (rc < 0) call endrun('carma_CreateOpticsFile::CARMAGAS_Get failed.') - call wrap_put_att_text(fid, levvar, 'units', 'level') - call wrap_put_att_text(fid, levvar, 'long_name', 'hybrid level at midpoints (1000*(A+B))') - call wrap_put_att_text(fid, levvar, 'positive', 'down') - call wrap_put_att_text(fid, levvar, 'standard_name', 'atmosphere_hybrid_sigma_pressure_coordinate') - call wrap_put_att_text(fid, levvar, 'formula_terms', 'a: hyam b: hybm p0: P0 ps: PS') + ! A file needs to be created for each bin. + do ibin = 1, NBIN - ! Define the variables: T - call wrap_def_var(fid, 'T', NF90_DOUBLE, 1, dimids(1:1), tvar) + ! Bins past maxbin are treated as diagnostic even if the group + ! is prognostic and thus are not advected in the paerent model. + if (ibin <= maxbin) then - call wrap_put_att_text(fid, tvar, 'units', 'K') - call wrap_put_att_text(fid, tvar, 'long_name', 'Temperature') + write(c_name, '(A, I2.2)') trim(shortname), ibin - if ((carma%f_igash2o /= 0) .and. present(refh2o)) then - call wrap_def_var(fid, 'Q', NF90_DOUBLE, 1, dimids(1:1), h2ovar) + ! Construct the path to the file. Each model will have its own subdirectory + ! where the optical property files are stored. + filepath = trim(carma_model) // '_' // trim(c_name) // '_rrtmg.nc' + + if (do_print) write(LUNOPRT,*) 'Creating CARMA optics file ... ', trim(filepath) - call wrap_put_att_text(fid, h2ovar, 'units', 'kg/kg') - call wrap_put_att_text(fid, h2ovar, 'long_name', 'Specific Humidity') - end if + ! Create the file. + call wrap_create(filepath, NF90_CLOBBER, fid) + + ! Define the dimensions: rh, lwbands, swbands + call wrap_def_dim(fid, 'rh_idx', NMIE_RH, rhdim) + call wrap_def_dim(fid, 'lw_band', nlwbands, lwdim) + call wrap_def_dim(fid, 'sw_band', nswbands, swdim) + + call wrap_def_dim(fid, 'wgtpct', NMIE_WTP, wtpdim) + + dimids(1) = rhdim + call wrap_def_var(fid, 'rh', NF90_DOUBLE, 1, dimids(1), rhvar) + call wrap_def_var(fid, 'rwet',NF90_DOUBLE, 1, dimids(1), rwetvar) + + dimids(1) = lwdim + call wrap_def_var(fid, 'lw_band', NF90_DOUBLE, 1, dimids(1), lwvar) + + dimids(1) = swdim + call wrap_def_var(fid, 'sw_band', NF90_DOUBLE, 1, dimids(1), swvar) + + dimids(1) = wtpdim + call wrap_def_var(fid, 'wgtpct', NF90_DOUBLE, 1, dimids(1), wtp_var) + + call wrap_put_att_text(fid, rhvar, 'units', 'fraction') + call wrap_put_att_text(fid, rwetvar, 'units', 'cm') + call wrap_put_att_text(fid, lwvar, 'units', 'm') + call wrap_put_att_text(fid, swvar, 'units', 'm') + + call wrap_put_att_text(fid, wtp_var,'units', 'unitless') + call wrap_put_att_text(fid, wtp_var,'long_name', 'weight percent') + + call wrap_put_att_text(fid, rhvar, 'long_name', 'relative humidity') + call wrap_put_att_text(fid, rwetvar, 'long_name', 'wet radius') + call wrap_put_att_text(fid, lwvar, 'long_name', 'longwave bands') + call wrap_put_att_text(fid, swvar, 'long_name', 'shortwave bands') + + ! Define the variables: abs_lw, ext_sw, ssa_sw, asm_sw + ! Define 2-dimension (:nrh,:nswbands) LW optics properties: abs_lw, qabs_lw + dimids(1) = wtpdim + dimids(2) = lwdim + call wrap_def_var(fid, 'abs_lw_wtp', NF90_DOUBLE, 2, dimids(1:2), abs_lw_wtp_var) + call wrap_def_var(fid, 'qabs_lw_wtp',NF90_DOUBLE, 2, dimids(1:2), qabs_lw_wtp_var) + + call wrap_put_att_text(fid, abs_lw_wtp_var, 'units', 'meter^2 kilogram^-1') + call wrap_put_att_text(fid, qabs_lw_wtp_var,'units', '-') + + ! Define 2-dimension (:nrh,:nswbands) optics properties: ext_sw, qext_sw, ssa_sw, asm_sw + dimids(1) = wtpdim + dimids(2) = swdim + call wrap_def_var(fid, 'ext_sw_wtp', NF90_DOUBLE, 2, dimids(1:2), ext_sw_wtp_var) + call wrap_def_var(fid, 'qext_sw_wtp',NF90_DOUBLE, 2, dimids(1:2), qext_sw_wtp_var) + call wrap_def_var(fid, 'ssa_sw_wtp', NF90_DOUBLE, 2, dimids(1:2), ssa_sw_wtp_var) + call wrap_def_var(fid, 'asm_sw_wtp', NF90_DOUBLE, 2, dimids(1:2), asm_sw_wtp_var) + + call wrap_put_att_text(fid, ssa_sw_wtp_var, 'units', 'fraction') + call wrap_put_att_text(fid, qext_sw_wtp_var,'units', '-') + call wrap_put_att_text(fid, ext_sw_wtp_var, 'units', 'meter^2 kilogram^-1') + call wrap_put_att_text(fid, asm_sw_wtp_var, 'units', '-') + + ! Define the variables for the refractive indicies. + dimids(1) = swdim + call wrap_def_var(fid, 'refindex_real_aer_sw', NF90_DOUBLE, 1, dimids(1), sw_r_refidx_var) + call wrap_def_var(fid, 'refindex_im_aer_sw', NF90_DOUBLE, 1, dimids(1), sw_i_refidx_var) + + dimids(1) = lwdim + call wrap_def_var(fid, 'refindex_real_aer_lw', NF90_DOUBLE, 1, dimids(1), lw_r_refidx_var) + call wrap_def_var(fid, 'refindex_im_aer_lw', NF90_DOUBLE, 1, dimids(1), lw_i_refidx_var) + + call wrap_put_att_text(fid, sw_r_refidx_var, 'units', '-') + call wrap_put_att_text(fid, sw_i_refidx_var, 'units', '-') + call wrap_put_att_text(fid, lw_r_refidx_var, 'units', '-') + call wrap_put_att_text(fid, lw_i_refidx_var, 'units', '-') + + call wrap_put_att_text(fid, sw_r_refidx_var, 'long_name', 'real refractive index of aerosol - shortwave') + call wrap_put_att_text(fid, sw_i_refidx_var, 'long_name', 'imaginary refractive index of aerosol - shortwave') + call wrap_put_att_text(fid, lw_r_refidx_var, 'long_name', 'real refractive index of aerosol - longwave') + call wrap_put_att_text(fid, lw_i_refidx_var, 'long_name', 'imaginary refractive index of aerosol - longwave') + + + ! Define fields that define the aerosol properties. + call wrap_def_dim(fid, 'opticsmethod_len', 32, omdim) + dimids(1) = omdim + call wrap_def_var(fid, 'opticsmethod', NF90_CHAR, 1, dimids(1), omvar) + + call wrap_def_dim(fid, 'namelength', 20, andim) + dimids(1) = andim + call wrap_def_var(fid, 'aername', NF90_CHAR, 1, dimids(1), anvar) + + call wrap_def_dim(fid, 'name_len', 32, namedim) + dimids(1) = namedim + call wrap_def_var(fid, 'name', NF90_CHAR, 1, dimids, namevar) + + call wrap_def_var(fid, 'density', NF90_DOUBLE, 0, dimids(1), denvar) + call wrap_def_var(fid, 'sigma_logr', NF90_DOUBLE, 0, dimids(1), slogvar) + call wrap_def_var(fid, 'dryrad', NF90_DOUBLE, 0, dimids(1), dryrvar) + call wrap_def_var(fid, 'radmin_aer', NF90_DOUBLE, 0, dimids(1), rminvar) + call wrap_def_var(fid, 'radmax_aer', NF90_DOUBLE, 0, dimids(1), rmaxvar) + call wrap_def_var(fid, 'hygroscopicity', NF90_DOUBLE, 0, dimids(1), hygrovar) + call wrap_def_var(fid, 'num_to_mass_ratio', NF90_DOUBLE, 0, dimids(1), ntmvar) + + call wrap_put_att_text(fid, denvar, 'units', 'kg m^-3') + call wrap_put_att_text(fid, slogvar, 'units', '-') + call wrap_put_att_text(fid, dryrvar, 'units', 'm') + call wrap_put_att_text(fid, rminvar, 'units', 'm') + call wrap_put_att_text(fid, rmaxvar, 'units', 'm') + call wrap_put_att_text(fid, hygrovar, 'units', '-') + call wrap_put_att_text(fid, ntmvar, 'units', 'kg^-1') + + call wrap_put_att_text(fid, denvar, 'long_name', 'aerosol material density') + call wrap_put_att_text(fid, slogvar, 'long_name', 'geometric standard deviation of aerosol') + call wrap_put_att_text(fid, dryrvar, 'long_name', 'dry number mode radius of aerosol') + call wrap_put_att_text(fid, rminvar, 'long_name', 'minimum dry radius of aerosol for bin') + call wrap_put_att_text(fid, rmaxvar, 'long_name', 'maximum dry radius of aerosol for bin') + call wrap_put_att_text(fid, hygrovar, 'long_name', 'hygroscopicity of aerosol') + call wrap_put_att_text(fid, ntmvar, 'long_name', 'ratio of number to mass of aerosol') + + ! End the defintion phase of the netcdf file. + call wrap_enddef(fid) + + ! Write out the dimensions. + call wrap_put_var_realx(fid, rhvar, mie_rh(:)) + call wrap_put_var_realx(fid, lwvar, wave(:nlwbands) * 1e-2_f) + call wrap_put_var_realx(fid, swvar, wave(nlwbands+1:) * 1e-2_f) + + call wrap_put_var_realx(fid, wtp_var, mie_wtp(:)*100._f) + + ! Write out the refractive indicies. + call wrap_put_var_realx(fid, sw_r_refidx_var, real(refidxS(nlwbands+1:, 1))) + call wrap_put_var_realx(fid, sw_i_refidx_var, aimag(refidxS(nlwbands+1:, 1))) + call wrap_put_var_realx(fid, lw_r_refidx_var, real(refidxS(:nlwbands, 1))) + call wrap_put_var_realx(fid, lw_i_refidx_var, aimag(refidxS(:nlwbands, 1))) + + ! Pad the names out with spaces. + aer_name = ' ' + aer_name(1:len(trim(c_name))) = c_name + + start_text(1) = 1 + count_text(1) = 32 + call wrap_put_vara_text(fid, namevar, start_text, count_text, (/ aer_name /)) + count_text(1) = 20 + call wrap_put_vara_text(fid, anvar, start_text, count_text, (/ aer_name /)) + + count_text(1) = len('hygroscopic_wtp ') + call wrap_put_vara_text(fid, omvar, start_text, count_text, (/ 'hygroscopic_wtp ' /)) + + call wrap_put_var_realx(fid, denvar, (/ rho(ibin) * 1e-3_f / 1e-6_f /)) + call wrap_put_var_realx(fid, slogvar, (/ 0._f /)) + call wrap_put_var_realx(fid, dryrvar, (/ r(ibin) * 1e-2_f /)) + call wrap_put_var_realx(fid, rminvar, (/ rlow(ibin) * 1e-2_f /)) + call wrap_put_var_realx(fid, rmaxvar, (/ rup(ibin) * 1e-2_f /)) + call wrap_put_var_realx(fid, hygrovar, (/ 0.6_f /)) + call wrap_put_var_realx(fid, ntmvar, (/ 1._f / rmass(ibin) / 1e-3_f /)) + + ! For now, ext_sw(:nrh, :nswbands) and ext_sw_coreshell(:nrh, :nswbands, :ncoreshellratio) both are calculated + ! Since other aerosols in CAM may use ext_sw rather than ext_sw_coreshell + ! Modified by Pengfei Yu + ! April.1, 2012 + + ! calculate qext and ext for pure sulfate dependent on weight percent + ! ideally qext is based on (wgt,temp,wave), however Beyer et al. (1996) Figure 5 + ! shows sulfate density is roughly 0.006 g/cm3/k, I negelet temp dimension, assuming temp = 270 K + ! In code, sulfate density is precisely calculated to determine wet raidus + do iwtp = 1, NMIE_WTP + + ! NOTE: Weight percent is normal a result of the getwetr calculation. To build the + ! table based upon weight percent, we need to pass in the desired value and a + ! reference temperature. In that case, the RH is ignored. + call getwetr(carma, igroup, mie_rh(1), r(ibin), rwet, rho(ibin), rhopwet, rc, wgtpct=mie_wtp(iwtp)*100._f, temp=270._f) + if (rc < 0) call endrun('carma_CreateOpticsFile::wetr failed.') + + ! This is not in Yu (2015), but rather than using the refractive + ! index of H2SO4 for the shell, do a volume mix of water and H2SO4 + ! for the refractive index of the shell. + volwater = rwet**3._f - r(ibin)**3._f + volsulfate = r(ibin)**3._f + volshell = volwater + volsulfate + if (volshell > 0._f) then + refidx(:) = (volwater / volshell) * refidxW(:) + (volsulfate / volshell) * refidxS(:, 1) + else + refidx(:) = refidxS(:, 1) + end if - if ((carma%f_igash2so4 /= 0) .and. present(refh2so4)) then - call wrap_def_var(fid, 'H2SO4', NF90_DOUBLE, 1, dimids(1:1), h2so4var) + ! Calculate at each wavelength. + do iwave = 1, NWAVE - call wrap_put_att_text(fid, h2so4var, 'units', 'kg/kg') - call wrap_put_att_text(fid, h2so4var, 'long_name', 'H2SO4') - end if + ! Using Mie code, calculate the optical properties: extinction coefficient, + ! single scattering albedo and asymmetry factor. + ! Assume the particle is homogeneous (no core). + ! + ! NOTE: The refractive index for sulfate changes with RH/weight percent, which + ! is not reflected in this code. + call mie(carma, & + imiertn, & + rwet, & + wave(iwave), & + 0._f, & + 3.0_f, & + 0.0_f, & + 1.0_f, & + refidx(iwave), & + 0.0_f, & + refidx(iwave), & + Qext, & + Qsca, & + asym, & + rc) + if (rc < 0) call endrun('carma_CreateOpticsFile::mie failed.') + + ! Calculate the shortwave and longwave properties? + ! + ! NOTE: miess is in cgs units, but the optics file needs to be in mks + ! units, so perform the necessary conversions. + if (iwave <= nlwbands) then - ! End the defintion phase of the netcdf file. - call wrap_enddef(fid) + ! Longwave just needs absorption: abs_lw. + qabs_lw_wtp(iwtp, iwave) = (Qext - Qsca) ! absorption per particle + abs_lw_wtp (iwtp, iwave) = (Qext - Qsca) * PI * (rwet * 1e-2_f)**2 / (rmass(ibin) * 1e-3_f) + else + ! Shortwave needs extinction, single scattering albedo and asymmetry factor: + ! ext_sw, ssa_sw and asm_sw. + qext_sw_wtp(iwtp, iwave - nlwbands) = Qext ! extinction per particle + ext_sw_wtp (iwtp, iwave - nlwbands) = Qext * PI * (rwet * 1e-2_f)**2 / (rmass(ibin) * 1e-3_f) + ssa_sw_wtp (iwtp, iwave - nlwbands) = Qsca / Qext + asm_sw_wtp (iwtp, iwave - nlwbands) = asym + end if + end do ! iwave + end do ! iwtp + + ! Write out the longwave fields. + ret = nf90_put_var(fid, abs_lw_wtp_var, abs_lw_wtp (:, :)) + if (ret /= NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile_SulfateYu: error writing varid =', fid, abs_lw_wtp_var + call handle_error(ret) + end if - ! Write out the dimensions. - call wrap_put_var_realx(fid, levvar, lev) + ret = nf90_put_var(fid, qabs_lw_wtp_var, qabs_lw_wtp(:, :)) + if (ret /= NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile_SulfateYu: error writing varid =', qabs_lw_wtp_var + call handle_error(ret) + end if - ! Write out the variables. - call wrap_put_var_realx(fid, tvar, reft) + ! Write out the shortwave fields. + ret = nf90_put_var(fid, ext_sw_wtp_var, ext_sw_wtp (:, :)) + if (ret /= NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile_SulfateYu: error writing varid =', ext_sw_wtp_var + call handle_error(ret) + end if - if ((carma%f_igash2o /= 0) .and. present(refh2o)) then - call wrap_put_var_realx(fid, h2ovar, refh2o(:)) - end if + ret = nf90_put_var(fid, qext_sw_wtp_var,qext_sw_wtp(:, :)) + if (ret /= NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile_SulfateYu: error writing varid =', qext_sw_wtp_var + call handle_error(ret) + end if - if ((carma%f_igash2so4 /= 0) .and. present(refh2so4)) then - call wrap_put_var_realx(fid, h2so4var, refh2so4(:)) - end if + ret = nf90_put_var(fid, ssa_sw_wtp_var, ssa_sw_wtp (:, :)) + if (ret /= NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile_SulfateYu: error writing varid =', ssa_sw_wtp_var + call handle_error(ret) + end if + + ret = nf90_put_var(fid, asm_sw_wtp_var, asm_sw_wtp (:, :)) + if (ret /= NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile_SulfateYu: error writing varid =', asm_sw_wtp_var + call handle_error(ret) + end if - ! Close the file. - call wrap_close(fid) + ! Close the file. + call wrap_close(fid) + end if + end do return - end subroutine CARMA_CreateRefTFile + end subroutine CARMA_CreateOpticsFile_Sulfate !! Calculate the aerodynamic resistance for dry deposition. @@ -2645,4 +3162,947 @@ subroutine CARMA_calcram(ustar, z0, pdel, pmid, tmid, obklen, ram) return end subroutine CARMA_calcram + + !--------------------------------------------------------------------------- + ! define fields for reference profiles in cam restart file + !--------------------------------------------------------------------------- + subroutine CARMA_restart_init( File ) + use cam_pio_utils, only: cam_pio_def_dim + use pio, only: file_desc_t, pio_def_var, pio_double + + ! arguments + type(file_desc_t),intent(inout) :: File ! pio File pointer + + ! local variables + integer :: levid, ierr + + if (carma_do_fixedinit) then + call cam_pio_def_dim(File, 'lev', pver, levid, existOK=.true.) + ierr = pio_def_var(File, 'CARMA_REF_T', pio_double, (/ levid /), t_ref_desc) + ierr = pio_def_var(File, 'CARMA_REF_H2O', pio_double, (/ levid /), h2o_ref_desc) + ierr = pio_def_var(File, 'CARMA_REF_H2SO4', pio_double, (/ levid /), h2so4_ref_desc) + endif + + end subroutine CARMA_restart_init + + !--------------------------------------------------------------------------- + ! write reference profiles to restart file + !--------------------------------------------------------------------------- + subroutine CARMA_restart_write(File) + use pio, only: file_desc_t, pio_put_var + + ! arguments + type(file_desc_t), intent(inout) :: File + + ! local variables + integer ::ierr + + if (carma_do_fixedinit) then + ierr = pio_put_var(File, t_ref_desc, carma_t_ref) + if (carma%f_igash2o /= 0) then + ierr = pio_put_var(File, h2o_ref_desc, carma_h2o_ref) + endif + if (carma%f_igash2So4 /= 0) then + ierr = pio_put_var(File, h2so4_ref_desc, carma_h2so4_ref) + endif + endif + + end subroutine CARMA_restart_write + + !--------------------------------------------------------------------------- + ! read reference profiles from restart file + !--------------------------------------------------------------------------- + subroutine CARMA_restart_read(File) + use pio, only: file_desc_t, pio_inq_varid, pio_get_var + + ! arguments + type(file_desc_t),intent(inout) :: File ! pio File pointer + + ! local variables + integer :: ierr, varid + character(len=*), parameter :: subname = 'CARMA_restart_read: ' + + if (carma_do_fixedinit) then + ierr = pio_inq_varid(File, 'CARMA_REF_T', varid) + if (varid>0) then + ierr = pio_get_var(File, varid, carma_t_ref) + else + call endrun(subname//'restart file must include CARMA_REF_T') + endif + ierr = pio_inq_varid(File, 'CARMA_REF_H2O', varid) + if (varid>0) then + ierr = pio_get_var(File, varid, carma_h2o_ref) + else if (carma%f_igash2o /= 0) then + call endrun(subname//'restart file must include CARMA_REF_H2O') + endif + ierr = pio_inq_varid(File, 'CARMA_REF_H2SO4', varid) + if (varid>0) then + ierr = pio_get_var(File, varid, carma_h2so4_ref) + else if (carma%f_igash2So4 /= 0) then + call endrun(subname//'restart file must include CARMA_REF_H2SO4') + endif + endif + + end subroutine CARMA_restart_read + + + + !! Get the mixing ratio for the specified element and bin. + !! + !! @author Chuck Bardeen + !! @version Aug 2023 + subroutine carma_get_bin(state, ielem, ibin, mmr, rc) + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + real(r8), intent(out) :: mmr(pcols,pver) !! mass mixing ratio (kg/kg) + integer, intent(out) :: rc !! return code + + integer :: ncol + + ! default return code + rc = RC_OK + + ncol = state%ncol + + ! Check the group and bin ranges + if ((ielem < 1) .or. (ielem .gt. NELEM)) then + write(LUNOPRT, *) 'carma_get_bin:: ERROR - Invalid element id, ', ielem + rc = RC_ERROR + return + end if + + if ((ibin < 1) .or. (ibin .gt. NBIN)) then + write(LUNOPRT, *) 'carma_get_bin:: ERROR - Invalid bin id, ', ibin + rc = RC_ERROR + return + end if + + ! Get the element from the physics state + mmr(:ncol, :) = state%q(:ncol, :, icnst4elem(ielem, ibin)) + + return + end subroutine + + !! Get the mixing ratio for the specified element and bin. + subroutine carma_get_bin_cld(pbuf, ielem, ibin, ncol, nlev, mmr, rc) + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + integer, intent(in) :: ncol,nlev !! dimensions + real(r8), intent(out) :: mmr(:,:) !! mass mixing ratio (kg/kg) + integer, intent(out) :: rc !! return code + + real(r8), pointer :: mmr_ptr(:,:) + character(len=8) :: shortname ! short (CAM) name + character(len=16) :: c_name + integer :: idx + + ! default return code + rc = RC_OK + + call CARMAELEMENT_Get(carma, ielem, rc, shortname=shortname) + + write(c_name, '(A, I2.2)') trim(shortname), ibin + + idx = pbuf_get_index('CLD'//trim(c_name)) + call pbuf_get_field(pbuf, idx, mmr_ptr) + + mmr(:ncol,:nlev) = mmr_ptr(:ncol,:nlev) + + end subroutine carma_get_bin_cld + + !! Determine the dry radius and dry density for the particular bin. + !! + !! @author Chuck Bardeen + !! @version Aug 2023 + subroutine carma_get_dry_radius(state, igroup, ibin, rdry, rhopdry, rc) + + implicit none + + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(in) :: igroup !! group index + integer, intent(in) :: ibin !! bin index + real(r8), intent(out) :: rdry(:,:) !! dry radius (m) + real(r8), intent(out) :: rhopdry(:,:) !! dry density (kg/m3) + integer, intent(out) :: rc !! return code + + real(r8) :: rhoelem(NBIN) ! element density (g/cm3) + real(r8) :: totvol(pcols,pver) ! total volume (m3/kg) + real(r8) :: totmmr(pcols,pver) ! total mmr (kg/kg) + real(r8) :: mmr(pcols, pver) ! mass mixing ratio (kg/kg) + real(r8) :: nmr(pcols, pver) ! number mixing ratio (#/kg) + integer :: nelems ! number of elements in group + integer :: ielems(NELEM) ! element indexes for group + integer :: ncol + integer :: i + integer :: ielem + + ! default return code + rc = RC_OK + + ncol = state%ncol + + ! Check the group and bin ranges + if ((igroup < 1) .or. (igroup .gt. NGROUP)) then + write(LUNOPRT, *) 'carma_get_dry_radius:: ERROR - Invalid group id, ', igroup + rc = RC_ERROR + return + end if + + if ((ibin < 1) .or. (ibin .gt. NBIN)) then + write(LUNOPRT, *) 'carma_get_dry_radius:: ERROR - Invalid bin id, ', ibin + rc = RC_ERROR + return + end if + + ! Iterate over all of the composition and determine the dry volume and dry radius. + call carma_get_elem_for_group(igroup, nelems, ielems, rc) + if (rc < 0) return + + totvol(:ncol, :) = 0._r8 + totmmr(:ncol, :) = 0._r8 + rhopdry(:ncol, :)= 0._r8 + rdry(:ncol, :) = 0._r8 + + do i = 1, nelems + ielem = ielems(i) + + call CARMAELEMENT_Get(carma, ielem, rc, rho=rhoelem) + if (rc < 0) return + + call carma_get_bin(state, ielem, ibin, mmr, rc) + if (rc < 0) return + + totmmr(:ncol, :) = totmmr(:ncol, :) + mmr(:ncol, :) + totvol(:ncol, :) = totvol(:ncol, :) + mmr(:ncol, :) / (rhoelem(ibin) / 1.e3_r8 * 1.e6_r8) + end do + + ! Add checks for totvol = 0 and nmr = 0 + where(totvol(:ncol, :)>0._r8) + rhopdry(:ncol, :) = totmmr(:ncol, :) / totvol(:ncol, :) + end where + + call carma_get_number(state, igroup, ibin, nmr, rc) + if (rc < 0) return + + where(nmr(:ncol, :)>0._r8) + rdry(:ncol, :) = ((3._r8 * totvol(:ncol, :) / nmr(:ncol, :)) / (4._r8 * PI)) ** (1._r8 / 3._r8) + !rdry(:ncol, :) = ((three_o_fourpi* totvol(:ncol, :) / nmr(:ncol, :))) ** onethird + end where + + return + end subroutine carma_get_dry_radius + + + !! Get the number of elements and list of element ids for a group. This includes + !! the concentration elements and the core masses. + !! + !! @author Chuck Bardeen + !! @version Aug 2023 + subroutine carma_get_elem_for_group(igroup, nelems, ielems, rc) + integer, intent(in) :: igroup !! group index + integer, intent(out) :: nelems !! number of elements in group + integer, intent(out) :: ielems(NELEM) !! indexes of elements in group + integer, intent(out) :: rc !! return code + + integer :: ienconc + integer :: ncore + integer :: icorelem(NELEM) + + ! default return code + rc = RC_OK + + ! Check the group range. + if ((igroup < 1) .or. (igroup .gt. NGROUP)) then + write(LUNOPRT, *) 'carma_get_elem_for_group:: ERROR - Invalid group id, ', igroup + rc = RC_ERROR + return + end if + + call CARMAGROUP_Get(carma, igroup, rc, ienconc=ienconc, ncore=ncore, icorelem=icorelem) + + nelems = ncore + 1 + ielems(1) = ienconc + + if (ncore .gt. 0) then + ielems(2:ncore+1) = icorelem(1:ncore) + end if + + return + end subroutine + + + !! Get the CARMA group id a group name. + !! + !! @author Chuck Bardeen + !! @version Aug 2023 + subroutine carma_get_group_by_name(shortname, igroup, rc) + character(len=*), intent(in) :: shortname !! the group short name + integer, intent(out) :: igroup !! group index + integer, intent(out) :: rc !! return code + + integer :: i + character(len=32) :: name + + ! default return code + rc = RC_OK + + igroup = -1 + + ! Check the short names of each group for one that matches + do i = 1, NGROUP + call CARMAGROUP_Get(carma, i, rc, shortname=name) + + if (trim(shortname) .eq. trim(name)) then + igroup = i + exit + end if + end do + + if (igroup .eq. -1) then + write(LUNOPRT, *) 'carma_get_group_by_name:: ERROR - group not found, ', shortname + rc = RC_ERROR + return + end if + + return + end subroutine + + + !! Get the CARMA group id and bin id from a compound name xxxxxxnn, where xxxxxx is the + !! name of the group and nn is the two digit bin number. + !! + !! @author Chuck Bardeen + !! @version Aug 2023 + subroutine carma_get_group_and_bin_by_name(shortname, igroup, ibin, rc) + character(len=*), intent(out) :: shortname !! the group short name + integer, intent(out) :: igroup !! group index + integer, intent(out) :: ibin !! bin index + integer, intent(out) :: rc !! return code + + integer :: i + character(len=32) :: name + character(len=32) :: groupname + character(len=32) :: binname + + ! default return code + rc = RC_OK + + igroup = -1 + ibin = -1 + + if (len(shortname) <= 2) then + write(LUNOPRT, *) 'carma_get_group_and_bin_by_name:: ERROR - Illegal shortname, ' // shortname + rc = RC_ERROR + return + end if + + ! Check the short names of each group for one that matches + groupname = shortname(:len(shortname)-2) + binname = shortname(len(shortname)-2:) + + call carma_get_group_by_name(groupname, igroup, rc) + if (rc < 0) return + + read(binname, *) ibin + + return + end subroutine + + + !! Determine a mass weighted kappa for the entire particle. + !! + !! @author Chuck Bardeen + !! @version Aug 2023 + subroutine carma_get_kappa(state, igroup, ibin, kappa, rc) + + implicit none + + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(in) :: igroup !! group index + integer, intent(in) :: ibin !! bin index + real(r8), intent(out) :: kappa(:,:) !! kappa value for the entire particle + integer, intent(out) :: rc !! return code + + real(r8) :: totmmr(pcols,pver) ! total mmr (kg/kg) + real(r8) :: mmr(pcols,pver) ! element mmr (kg/kg) + real(r8) :: kappaelem ! element kappa + integer :: ncol + integer :: nelems + integer :: ielems(NELEM) + integer :: i + integer :: ielem + + ! default return code + rc = RC_OK + + ncol = state%ncol + + ! Check the group and bin ranges + if ((igroup < 1) .or. (igroup .gt. NGROUP)) then + write(LUNOPRT, *) 'carma_get_kappa:: ERROR - Invalid group id, ', igroup + rc = RC_ERROR + return + end if + + if ((ibin < 1) .or. (igroup .gt. NBIN)) then + write(LUNOPRT, *) 'carma_get_kappa:: ERROR - Invalid bin id, ', ibin + rc = RC_ERROR + return + end if + + ! Iterate over all of the composition and determine the total mass. + call carma_get_elem_for_group(igroup, nelems, ielems, rc) + if (rc < 0) return + + totmmr(:ncol, :) = 0._r8 + kappa(:ncol, :) = 0._r8 + + do i = 1, nelems + ielem = ielems(i) + + call carma_get_bin(state, ielem, ibin, mmr, rc) + if (rc < 0) return + + call CARMAELEMENT_Get(carma, ielem, rc, kappa=kappaelem) + + kappa(:ncol, :) = kappa(:ncol, :) + mmr(:ncol, :) * kappaelem + totmmr(:ncol, :) = totmmr(:ncol, :) + mmr(:ncol, :) + end do + + ! Figure out the average kappa.q + where (totmmr(:ncol,:) .gt. 0._r8) + kappa(:ncol,:) = kappa(:ncol,:) / totmmr(:ncol,:) + end where + + return + end subroutine + + + !! Get the number mixing ratio for the group. This is the number of particles per + !! density of air. + !! + !! @author Chuck Bardeen + !! @version Aug 2023 + subroutine carma_get_number(state, igroup, ibin, nmr, rc) + + implicit none + + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(in) :: igroup !! group index + integer, intent(in) :: ibin !! bin index + real(r8), intent(out) :: nmr(pcols,pver) !! number mixing ratio (#/kg) + integer, intent(out) :: rc !! return code + + real(r8) :: rmass(carma%f_NBIN) ! the bin mass (g) + real(r8) :: totmmr(pcols,pver) ! total mmr (kg/kg) + integer :: ncol + + ! default return code + rc = RC_OK + + ncol = state%ncol + + ! Check the group and bin ranges + if ((igroup < 1) .or. (igroup .gt. NGROUP)) then + write(LUNOPRT, *) 'carma_get_number:: ERROR - Invalid group id, ', igroup + rc = RC_ERROR + return + end if + + if ((ibin < 1) .or. (igroup .gt. NBIN)) then + write(LUNOPRT, *) 'carma_get_number:: ERROR - Invalid bin id, ', ibin + rc = RC_ERROR + return + end if + + ! Get the mass in each bin + call CARMAGROUP_Get(carma, igroup, rc, rmass=rmass) + if (rc < 0) return + + ! Get the total mmr in the bin + call carma_get_total_mmr(state, igroup, ibin, totmmr, rc) + if (rc < 0) return + + ! Get the mmr is the total mass divided by rmass, but need to convert rmass + ! to kg. + nmr(:ncol, :) = totmmr(:ncol, :) / (rmass(ibin) / 1.e3_r8) + + return + end subroutine carma_get_number + + subroutine carma_get_number_cld(pbuf, igroup, ibin, ncol, nlev, nmr, rc) + + implicit none + + type(physics_buffer_desc),pointer :: pbuf(:) !! physics buffer + integer, intent(in) :: igroup !! group index + integer, intent(in) :: ibin !! bin index + integer, intent(in) :: ncol,nlev !! dimensions + real(r8), intent(out) :: nmr(pcols,pver) !! number mixing ratio (#/kg) + integer, intent(out) :: rc !! return code + + real(r8) :: rmass(carma%f_NBIN) ! the bin mass (g) + real(r8) :: totmmr(pcols,pver) ! total mmr (kg/kg) + + ! default return code + rc = RC_OK + + ! Check the group and bin ranges + if ((igroup < 1) .or. (igroup .gt. NGROUP)) then + write(LUNOPRT, *) 'carma_get_number:: ERROR - Invalid group id, ', igroup + rc = RC_ERROR + return + end if + + if ((ibin < 1) .or. (igroup .gt. NBIN)) then + write(LUNOPRT, *) 'carma_get_number:: ERROR - Invalid bin id, ', ibin + rc = RC_ERROR + return + end if + + ! Get the mass in each bin + call CARMAGROUP_Get(carma, igroup, rc, rmass=rmass) + if (rc < 0) return + + ! Get the total mmr in the bin + call carma_get_total_mmr_cld(pbuf, igroup, ibin, ncol, nlev, totmmr, rc) + if (rc < 0) return + + ! Get the mmr is the total mass divided by rmass, but need to convert rmass + ! to kg. + nmr(:ncol, :) = totmmr(:ncol, :) / (rmass(ibin) / 1.e3_r8) + + return + end subroutine carma_get_number_cld + + + !! Get the mixing ratio for the group. This is the total of all the elements that + !! make up the group. + !! + !! @author Chuck Bardeen + !! @version Aug 2023 + subroutine carma_get_total_mmr(state, igroup, ibin, totmmr, rc) + + implicit none + + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(in) :: igroup !! group index + integer, intent(in) :: ibin !! bin index + real(r8), intent(out) :: totmmr(pcols,pver) !! total mmr (kg/kg) + integer, intent(out) :: rc !! return code + + real(r8) :: mmr(pcols, pver) ! mmr (kg/kg) + integer :: i + integer :: nelems + integer :: ielems(NELEM) + integer :: ielem + integer :: ncol + + ! default return code + rc = RC_OK + + ncol = state%ncol + + ! Check the group and bin ranges + if ((igroup < 1) .or. (igroup .gt. NGROUP)) then + write(LUNOPRT, *) 'carma_get_total_mmr:: ERROR - Invalid group id, ', igroup + rc = RC_ERROR + return + end if + + if ((ibin < 1) .or. (ibin .gt. NBIN)) then + write(LUNOPRT, *) 'carma_get_total_mmr:: ERROR - Invalid bin id, ', ibin + rc = RC_ERROR + return + end if + + ! Iterate over all of the composition and determine the total mass. + call carma_get_elem_for_group(igroup, nelems, ielems, rc) + if (rc < 0) return + + totmmr(:ncol, :) = 0._r8 + + do i = 1, nelems + ielem = ielems(i) + + call carma_get_bin(state, ielem, ibin, mmr, rc) + if (rc < 0) return + + totmmr(:ncol, :) = totmmr(:ncol, :) + mmr(:ncol, :) + end do + + return + end subroutine carma_get_total_mmr + + subroutine carma_get_total_mmr_cld(pbuf, igroup, ibin, ncol, nlev, totmmr, rc) + + type(physics_buffer_desc),pointer :: pbuf(:) !! physics buffer + integer, intent(in) :: igroup !! group index + integer, intent(in) :: ibin !! bin index + integer, intent(in) :: ncol,nlev !! dimensions + real(r8), intent(out) :: totmmr(pcols,pver) !! total mmr (kg/kg) + integer, intent(out) :: rc !! return code + + real(r8) :: mmr(pcols, pver) ! mmr (kg/kg) + integer :: i + integer :: nelems + integer :: ielems(NELEM) + integer :: ielem + + ! default return code + rc = RC_OK + + + ! Check the group and bin ranges + if ((igroup < 1) .or. (igroup .gt. NGROUP)) then + write(LUNOPRT, *) 'carma_get_total_mmr:: ERROR - Invalid group id, ', igroup + rc = RC_ERROR + return + end if + + if ((ibin < 1) .or. (ibin .gt. NBIN)) then + write(LUNOPRT, *) 'carma_get_total_mmr:: ERROR - Invalid bin id, ', ibin + rc = RC_ERROR + return + end if + + ! Iterate over all of the composition and determine the total mass. + call carma_get_elem_for_group(igroup, nelems, ielems, rc) + if (rc < 0) return + + totmmr(:ncol, :) = 0._r8 + + do i = 1, nelems + ielem = ielems(i) + + call carma_get_bin_cld(pbuf, ielem, ibin, ncol, nlev, mmr, rc) + if (rc < 0) return + + totmmr(:ncol, :) = totmmr(:ncol, :) + mmr(:ncol, :) + end do + + end subroutine carma_get_total_mmr_cld + + subroutine carma_get_sad(state, igroup, ibin, sad, rc) + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(in) :: igroup !! group index + integer, intent(in) :: ibin !! bin index + real(r8), intent(out) :: sad(pcols,pver) !! surface area dens (cm2/cm3) + integer, intent(out) :: rc !! return code + + real(r8) :: nmr(pcols,pver) !! number mixing ratio (#/kg) + real(r8) :: rwet(pcols,pver) !! wet radius (m) + real(r8) :: rhopwet(pcols,pver) !! wet density (kg/m3) + real(r8) :: rhoa(pcols,pver) !! air density (kg/m3) + real(r8) :: ndens(pcols,pver) !! number density (#/m3) + + integer :: ncol + + rc = RC_OK + + call carma_get_wet_radius(state, igroup, ibin, rwet, rhopwet, rc) + call carma_get_number(state, igroup, ibin, nmr, rc) + + ncol = state%ncol + + rhoa(:ncol,:) = (state%pmid(:ncol,:) * 10._r8) / (R_AIR * state%t(:ncol,:)) / 1.e3_r8 * 1.e6_r8 ! air density (kg/m3) + + ndens(:ncol,:) = nmr(:ncol,:) * rhoa(:ncol,:) ! #/m3 + + sad(:ncol,:) = 4.0_r8 * PI * ndens(:ncol,:) * (rwet(:ncol,:)**2) * 1.e-2_r8 ! cm2/cm3 + + end subroutine carma_get_sad + + + !! Find the wet radius and wet density for the group and bin specified. + !! + !! NOTE: Groups can be configured with different methods to determine the wet + !! radius, so multiple methods need to be supported and code from rhopart and + !! wetr need to be included in this routine. + !! + !! @author Chuck Bardeen + !! @version Aug 2023 + subroutine carma_get_wet_radius(state, igroup, ibin, rwet, rhopwet, rc) + use wetr, only: getwetr + + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(in) :: igroup !! group index + integer, intent(in) :: ibin !! bin index + real(r8), intent(out) :: rwet(pcols,pver) !! wet radius (m) + real(r8), intent(out) :: rhopwet(pcols,pver) !! wet density (kg/m3) + integer, intent(inout) :: rc !! return code + + real(r8) :: rdry(pcols,pver) !! dry radius (m) + real(r8) :: rhopdry(pcols,pver) !! dry density (kg/m3) + real(r8) :: rhoa(pcols,pver) !! air density (kg/m3) + real(r8) :: kappa(pcols,pver) !! dry radius (m) + real(r8) :: es !! saturation vapor pressure + real(r8) :: qs !! saturation specific humidity + real(r8) :: relhum !! relative humidity + real(r8) :: wvpres !! water eq. vaper pressure (dynes/cm2) + real(r8) :: watcon !! water concentration (g/cm3) + real(r8) :: dryden !! dry density (g/cm3) + real(r8) :: dryrad !! dry radius (cm) + integer :: icol + integer :: iz + integer :: ncol + integer :: iq + integer :: irhswell + + ! default return code + rc = RC_OK + + ncol = state%ncol + + ! Check the group and bin ranges + if ((igroup < 1) .or. (igroup .gt. NGROUP)) then + write(LUNOPRT, *) 'carma_get_total_mmr:: ERROR - Invalid group id, ', igroup + rc = RC_ERROR + !return + end if + if (rc/=RC_OK) then + call endrun('carma_get_wet_radius ERROR1: rc = ',rc) + end if + + if ((ibin < 1) .or. (ibin .gt. NBIN)) then + write(LUNOPRT, *) 'carma_get_total_mmr:: ERROR - Invalid bin id, ', ibin + rc = RC_ERROR + !return + end if + if (rc/=RC_OK) then + call endrun('carma_get_wet_radius ERROR2: rc = ',rc) + end if + + ! Get the constiuent index for water vapor (Q) + call cnst_get_ind("Q", iq) + + ! The wet radius can be configured differently for each group, so we + ! need to use getwetr to handle those differences. This requires repeating + ! some code that is in rhopart to use getwetr properly. There may be a + ! better way to do this, but for now we will duplicate the code. + call carma_get_dry_radius(state, igroup, ibin, rdry, rhopdry, rc) + !if (rc < 0) return + if (rc/=RC_OK) then + call endrun('carma_get_wet_radius ERROR3: rc = ',rc) + end if + + ! Calculate the dry air density at each level, using the ideal gas law. + rhoa(:ncol, :) = (state%pmid(:ncol, :) * 10._r8) / (R_AIR * state%t(:ncol, :)) / 1.e3_r8 * 1.e6_r8 + + call CARMAGROUP_Get(carma, igroup, rc, irhswell=irhswell) + !if (rc < 0) return + if (rc/=RC_OK) then + call endrun('carma_get_wet_radius ERROR4: rc = ',rc) + end if + + do icol = 1, ncol + do iz = 1, pver + if (rdry(icol, iz)>0._r8) then + ! Get relative humidity and vapor pressure + call wv_sat_qsat_water(state%t(icol,iz), state%pmid(icol,iz), es, qs) + + ! NOTE: getwetr is in cgs units, so some conversions are needed from the + ! mks values + wvpres = es * 10._r8 ! dynes/cm2 + relhum = state%q(icol,iz,iq) / qs + watcon = state%q(icol,iz,iq) * rhoa(icol, iz) * 1.e-3_r8 ! g/cm3 + dryden = rhopdry(icol,iz) * 1.e-3_r8 ! g/cm3 + dryrad = rdry(icol,iz) * 1.e2_r8 ! cm + + ! If humidity affects the particle, then determine the equilbirium + ! radius and density based upon the relative humidity. + ! + if (irhswell == I_WTPCT_H2SO4) then + + call getwetr(carma, igroup, relhum, dryrad, rwet(icol, iz), dryden, rhopwet(icol,iz), rc, & + h2o_mass=watcon, h2o_vp=wvpres, temp=state%t(icol,iz)) + if (rc/=RC_OK) then + call endrun('carma_get_wet_radius ERROR5: rc = ',rc) ! <====== + end if + + else if (irhswell == I_PETTERS) then + + call carma_get_kappa(state, igroup, ibin, kappa, rc) + if (rc/=RC_OK) then + call endrun('carma_get_wet_radius carma_get_kappa ERROR: rc = ',rc) + end if + + call getwetr(carma, igroup, relhum, dryrad, rwet(icol, iz), dryden, rhopwet(icol,iz), rc, & + h2o_mass=watcon, h2o_vp=wvpres, temp=state%t(icol,iz), kappa=kappa(icol,iz)) + if (rc/=RC_OK) then + call endrun('carma_get_wet_radius ERROR6: rc = ',rc) + end if + + else ! I_GERBER and I_FITZGERALD + + call getwetr(carma, igroup, relhum, dryrad, rwet(icol, iz), dryden, rhopwet(icol,iz), rc ) + if (rc/=RC_OK) then + call endrun('carma_get_wet_radius ERROR7: rc = ',rc) + end if + + end if + else + rhopwet(icol,iz) = 0._r8 + rwet(icol, iz) = 0._r8 + end if + end do + end do + + ! Convert rwet and rhopwet to mks units + rwet(:ncol,:) = rwet(:ncol,:) * 1.e-2 ! cm --> m + rhopwet(:ncol,:) = rhopwet(:ncol,:) * 1.e3 ! g/cm3 --> kg/m3 + + if (rc/=RC_OK) then + call endrun('carma_get_wet_radius ERROR8: rc = ',rc) + end if + + return + end subroutine + + + !! Provides the tendency (in kg/kg/s) required to change the element and bin from + !! the current state to the desired mmr. + !! + !! NOTE: The caller needs to make sure that the lq flags are set in ptend for the + !! particular tracer. Perhaps we need a routine that will set lq to true for all + !! the fields that could be set by CARMA to be used by the caller of this routine. + !! + !! @author Chuck Bardeen + !! @version Aug 2023 + subroutine carma_set_bin(state, ielem, ibin, mmr, dt, ptend, rc) + + implicit none + + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + real(r8), intent(in) :: mmr(pcols,pver) !! mass mixing ratio (kg/kg) + integer :: dt !! timestep size (sec) + type(physics_ptend), intent(inout) :: ptend !! constituent tendencies + integer, intent(out) :: rc !! return code + + integer :: ncol + integer :: icnst + + ! default return code + rc = RC_OK + + ncol = state%ncol + + ! Check the element and bin ranges + if ((ielem < 1) .or. (ielem .gt. NELEM)) then + write(LUNOPRT, *) 'carma_set_bin:: ERROR - Invalid element id, ', ielem + rc = RC_ERROR + return + end if + + if ((ibin < 1) .or. (ibin .gt. NBIN)) then + write(LUNOPRT, *) 'carma_set_binr:: ERROR - Invalid bin id, ', ibin + rc = RC_ERROR + return + end if + + ! Determine the tendency needed to make state into mmr for this tracer. + icnst = icnst4elem(ielem, ibin) + ptend%q(:ncol, :, icnst) = (mmr(:ncol, :) - state%q(:ncol, :, icnst)) / dt + + return + end subroutine + + subroutine carma_get_bin_rmass(igroup, ibin, mass, rc) + + integer, intent(in) :: igroup !! group index + integer, intent(in) :: ibin !! bin index + real(r8),intent(out) :: mass ! grams ??? + integer, intent(out) :: rc !! return code + + real(r8) :: rmass(carma%f_NBIN) ! the bin mass (g) + + ! default return code + rc = RC_OK + rmass = rmass + + call CARMAGROUP_Get(carma, igroup, rc, rmass=rmass) ! rmass in g + if (rc /= RC_OK) return + + mass = rmass(ibin)*1.e-03_r8 ! convert to kg + + end subroutine carma_get_bin_rmass + + function carma_get_wght_pct(ncol,nlev,state) result(wtpct) + use sulfate_utils, only: wtpct_tabaz + + integer, intent(in) :: ncol,nlev + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + + real(r8) :: wtpct(ncol,nlev) + + integer :: rc !! return code + real(r8) :: pvapl, es, qs, gc_cgs, rhoa + integer :: icol, ilev + + rc = RC_OK + + do ilev = 1,nlev + do icol = 1,ncol + ! Get relative humidity and vapor pressure + + call wv_sat_qsat_water(state%t(icol,ilev), state%pmid(icol,ilev), es, qs) ! es = Saturation vapor pressure in Pa + + pvapl = es * 10._r8 ! Pa -> dynes/cm2 + + rhoa = (state%pmid(icol,ilev) * 10._r8) / (R_AIR * state%t(icol,ilev)) ! grams/cm3 + + gc_cgs = state%q(icol,ilev,icnst4gas(carma%f_igash2o)) * rhoa ! h2o grams/cm3 + + wtpct(icol,ilev) = wtpct_tabaz(carma, state%t(icol,ilev), gc_cgs, pvapl, rc) + + if (rc/=RC_OK) then + call endrun('carma_get_wght_pct: rc = ',rc) + end if + end do + end do + + end function carma_get_wght_pct + + function carma_effecitive_radius(state) result(rad) + + type(physics_state), intent(in) :: state !! physics state variables + real(r8) :: rad(pcols,pver) ! effective radius (cm) + + integer :: igroup, ibin, rc, ncol + real(r8) :: rwet(pcols,pver) !! wet radius (m) + real(r8) :: rho(pcols,pver) !! density (kg/m3) + real(r8) :: nmr(pcols,pver) !! num/kg + real(r8) :: rtmp3(pcols,pver) + real(r8) :: rtmp2(pcols,pver) + + rc = RC_OK + + rtmp2(:,:) = 0.0_r8 + rtmp3(:,:) = 0.0_r8 + + ncol = state%ncol + + do igroup = 1, NGROUP + do ibin = 1, NBIN + + call carma_get_number(state, igroup, ibin, nmr, rc) + call carma_get_wet_radius(state, igroup, ibin, rwet, rho, rc) + if (rc/=RC_OK) then + call endrun('carma_effecitive_radius -- carma_get_wet_radius ERROR: rc = ',rc) + end if + + rtmp3(:ncol,:) = rtmp3(:ncol,:) + nmr(:ncol,:)*(rwet(:ncol,:)**3) + rtmp2(:ncol,:) = rtmp2(:ncol,:) + nmr(:ncol,:)*(rwet(:ncol,:)**2) + + end do + end do + + rad(:ncol,:) = (rtmp3(:ncol,:)/rtmp2(:ncol,:))*100._r8 ! cm + + end function carma_effecitive_radius + end module carma_intr diff --git a/src/physics/carma/models/dust/carma_model_mod.F90 b/src/physics/carma/models/dust/carma_model_mod.F90 index 22ba9b69d2..ae1b11bd3c 100644 --- a/src/physics/carma/models/dust/carma_model_mod.F90 +++ b/src/physics/carma/models/dust/carma_model_mod.F90 @@ -46,14 +46,19 @@ module carma_model_mod private ! Declare the public methods. - public CARMA_DefineModel - public CARMA_Detrain - public CARMA_DiagnoseBins - public CARMA_DiagnoseBulk - public CARMA_EmitParticle - public CARMA_InitializeModel - public CARMA_InitializeParticle - public CARMA_WetDeposition + public CARMAMODEL_CalculateCloudborneDiagnostics + public CARMAMODEL_CreateOpticsFile + public CARMAMODEL_DefineModel + public CARMAMODEL_Detrain + public CARMAMODEL_DiagnoseBins + public CARMAMODEL_DiagnoseBulk + public CARMAMODEL_EmitParticle + public CARMAMODEL_InitializeModel + public CARMAMODEL_InitializeParticle + public CARMAMODEL_OutputBudgetDiagnostics + public CARMAMODEL_OutputCloudborneDiagnostics + public CARMAMODEL_OutputDiagnostics + public CARMAMODEL_WetDeposition ! Declare public constants integer, public, parameter :: NGROUP = 1 !! Number of particle groups @@ -66,6 +71,10 @@ module carma_model_mod integer, public, parameter :: NMIE_RH = 8 !! Number of relative humidities for mie calculations real(kind=f), public :: mie_rh(NMIE_RH) + integer, public, parameter :: NMIE_WTP = 0 !! Number of weight percents for mie calculations + real(kind=f), public :: mie_wtp(NMIE_WTP) + integer, public, parameter :: NREFIDX = 1 !! Number of refractive indices per element + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. ! Water vapor and cloud particles are convected in phase 1, while all other constituents ! are done in phase 2. @@ -90,7 +99,7 @@ module carma_model_mod !! !! @version May-2009 !! @author Chuck Bardeen - subroutine CARMA_DefineModel(carma, rc) + subroutine CARMAMODEL_DefineModel(carma, rc) type(carma_type), intent(inout) :: carma !! the carma object integer, intent(out) :: rc !! return code, negative indicates failure @@ -107,7 +116,7 @@ subroutine CARMA_DefineModel(carma, rc) ! Report model specific namelist configuration parameters. if (masterproc) then call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) - if (rc < 0) call endrun("CARMA_DefineModel: CARMA_Get failed.") + if (rc < 0) call endrun("CARMAMODEL_DefineModel: CARMA_Get failed.") if (do_print) write(LUNOPRT,*) '' if (do_print) write(LUNOPRT,*) 'CARMA ', trim(carma_model), ' specific settings :' @@ -122,7 +131,7 @@ subroutine CARMA_DefineModel(carma, rc) call CARMAGROUP_Create(carma, 1, "dust", rmin, vmrat, I_SPHERE, 1._f, .false., & rc, do_wetdep=.true., do_drydep=.true., solfac=0.3_f, & scavcoef=0.1_f, shortname="CRDUST") - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddGroup failed.') ! Define the Elements @@ -130,7 +139,7 @@ subroutine CARMA_DefineModel(carma, rc) ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names ! should be 6 characters or less and without spaces. call CARMAELEMENT_Create(carma, 1, 1, "dust", RHO_DUST, I_INVOLATILE, I_DUST, rc, shortname="CRDUST") - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddElement failed.') ! Define the Solutes @@ -143,7 +152,7 @@ subroutine CARMA_DefineModel(carma, rc) return - end subroutine CARMA_DefineModel + end subroutine CARMAMODEL_DefineModel !! Defines all the CARMA components (groups, elements, solutes and gases) and process @@ -153,7 +162,7 @@ end subroutine CARMA_DefineModel !! @author Chuck Bardeen !! !! @see CARMASTATE_SetDetrain - subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & + subroutine CARMAMODEL_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & tnd_qsnow, tnd_nsnow) use camsrfexch, only: cam_in_t use physconst, only: latice, latvap, cpair @@ -178,14 +187,14 @@ subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, rc = RC_OK return - end subroutine CARMA_Detrain + end subroutine CARMAMODEL_Detrain !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. !! !! @version July-2009 !! @author Chuck Bardeen - subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) + subroutine CARMAMODEL_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) use time_manager, only: is_first_step implicit none @@ -211,14 +220,14 @@ subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, pr ! code to determine the mass in each bin from the CAM state. return - end subroutine CARMA_DiagnoseBins + end subroutine CARMAMODEL_DiagnoseBins !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. !! !! @version July-2009 !! @author Chuck Bardeen - subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & + subroutine CARMAMODEL_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) use camsrfexch, only: cam_out_t @@ -249,7 +258,7 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, ! code to determine the bulk mass from the CARMA state. return - end subroutine CARMA_DiagnoseBulk + end subroutine CARMAMODEL_DiagnoseBulk !! Calculates the emissions for CARMA aerosol particles. By default, there is no @@ -258,7 +267,7 @@ end subroutine CARMA_DiagnoseBulk !! !! @author Lin Su, Pengfei Yu, Chuck Bardeen !! @version Dec-2010 - subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, rc) + subroutine CARMAMODEL_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, pbuf, rc) use shr_kind_mod, only: r8 => shr_kind_r8 use ppgrid, only: pcols, pver use physics_types, only: physics_state @@ -276,10 +285,9 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend type(cam_in_t), intent(in) :: cam_in !! surface inputs real(r8), intent(out) :: tendency(pcols, pver) !! constituent tendency (kg/kg/s) real(r8), intent(out) :: surfaceFlux(pcols) !! constituent surface flux (kg/m^2/s) + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer integer, intent(out) :: rc !! return code, negative indicates failure - integer :: ilat(pcols) ! latitude index - integer :: ilon(pcols) ! longitude index integer :: lchnk ! chunk identifier integer :: ncol ! number of columns in chunk integer :: icol ! column index @@ -341,7 +349,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend ! Process each column. do icol = 1,ncol - call CARMA_SurfaceWind(carma, state, icol, ielem, igroup, idustbin, cam_in, uv10, wwd, uth, rc) + call CARMAMODEL_SurfaceWind(carma, state, icol, ielem, igroup, idustbin, cam_in, uv10, wwd, uth, rc) ! Is the wind above the threshold for dust production? if (uv10 > uth) then @@ -351,16 +359,15 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend ! Scale the clay bins based upon the smallest silt bin. surfaceFlux(icol) = clay_mf(ibin) * surfaceFlux(icol) - end do ! For debug purposes, output the soil erosion factor. call outfld('CRSLERFC', soil_factor(:ncol, lchnk), ncol, lchnk) - end if + end if return - end subroutine CARMA_EmitParticle + end subroutine CARMAMODEL_EmitParticle !! Allows the model to perform its own initialization in addition to what is done @@ -368,16 +375,17 @@ end subroutine CARMA_EmitParticle !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_InitializeModel(carma, lq_carma, rc) + subroutine CARMAMODEL_InitializeModel(carma, lq_carma, pbuf2d, rc) use cam_history, only: addfld, add_default, horiz_only use constituents, only: pcnst implicit none - type(carma_type), intent(in) :: carma !! the carma object - logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent + type(carma_type), intent(in) :: carma !! the carma object + logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent !! could have a CARMA tendency - integer, intent(out) :: rc !! return code, negative indicates failure + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + integer, intent(out) :: rc !! return code, negative indicates failure ! -------- local variables ---------- integer :: ibin ! CARMA bin index @@ -421,7 +429,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) end do ! Read in the soil factors. - call CARMA_ReadSoilErosionFactor(carma, rc) + call CARMAMODEL_ReadSoilErosionFactor(carma, rc) if (RC < RC_ERROR) return ! To determine Clay Mass Fraction @@ -431,7 +439,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) if (RC < RC_ERROR) return if (shortname .eq. "CRDUST") then - call CARMA_ClayMassFraction(carma, igroup, rc) + call CARMAMODEL_ClayMassFraction(carma, igroup, rc) end if end do @@ -452,7 +460,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) call addfld('CRSLERFC', horiz_only, 'A', 'fraction', 'CARMA soil erosion factor') return - end subroutine CARMA_InitializeModel + end subroutine CARMAMODEL_InitializeModel !! Sets the initial condition for CARMA aerosol particles. By default, there are no @@ -464,7 +472,7 @@ end subroutine CARMA_InitializeModel !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) + subroutine CARMAMODEL_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) use shr_kind_mod, only: r8 => shr_kind_r8 use pmgrid, only: plev @@ -487,15 +495,55 @@ subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, ! NOTE: Initialized to 0. by the caller, so nothing needs to be done. return - end subroutine CARMA_InitializeParticle + end subroutine CARMAMODEL_InitializeParticle + + !! This routine is an extension of CARMA_CreateOpticsFile() that allows for + !! model specific tables to be created in addition to the model independent + !! methods that are in carma_intr.F90. + !! + !! The opticsType that is specified for the group determines how the optical + !! properties will be generated for that group. Each group can use a different + !! optics method if needed. Refractive indices need for these calculation are + !! are specified in the group's elements rather than at the group level. This + !! allows various mixing approaches to be used to determine the refractive index + !! for the particle as a whole. If the refractive index for water is needed, + !! it is specific the the CARMAGAS object for H2O. + subroutine CARMAMODEL_CreateOpticsFile(carma, igroup, opticsType, rc) + + implicit none + + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(in) :: igroup !! group identifier + integer, intent(in) :: opticsType !! optics type (see I_OPTICS_... in carma_enums.F90) + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Local variables + logical :: do_mie + integer :: cnsttype ! constituent type + + ! Assume success. + rc = 0 + ! What type of calculation is needed for this group? + ! + ! NOTE: Some of these calculations generate optical properties as single mass + ! coefficients, while others are lookup tables designed around multiple + ! dimensions. + select case (opticsType) + + case default + call endrun('carma_CreateOpticsFile:: Unknown optics type.') + end select + + return + end subroutine CARMAMODEL_CreateOpticsFile !! Called after wet deposition has been performed. Allows the specific model to add !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. !! !! @version July-2011 !! @author Chuck Bardeen - subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) + subroutine CARMAMODEL_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) use camsrfexch, only: cam_out_t implicit none @@ -514,7 +562,7 @@ subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) rc = RC_OK return - end subroutine CARMA_WetDeposition + end subroutine CARMAMODEL_WetDeposition !! Determines the mass fraction for the clay (submicron) bins based upon @@ -529,7 +577,7 @@ end subroutine CARMA_WetDeposition !! !! @version July-2012 !! @author Lin Su, Pengfei Yu, Chuck Bardeen - subroutine CARMA_ClayMassFraction(carma, igroup, rc) + subroutine CARMAMODEL_ClayMassFraction(carma, igroup, rc) implicit none type(carma_type), intent(in) :: carma !! the carma object @@ -610,7 +658,7 @@ subroutine CARMA_ClayMassFraction(carma, igroup, rc) clay_mf(ind_low(IABOVE):) = 1._r8 return - end subroutine CARMA_ClayMassFraction + end subroutine CARMAMODEL_ClayMassFraction !! Calculate the sea surface wind with a Weibull distribution. @@ -621,7 +669,7 @@ end subroutine CARMA_ClayMassFraction !! !! @author Lin Su, Pengfei Yu, Chuck Bardeen !! @version July-2012 - subroutine CARMA_SurfaceWind(carma, state, icol, ielem, igroup, ibin, cam_in, uv10, wwd, uth, rc) + subroutine CARMAMODEL_SurfaceWind(carma, state, icol, ielem, igroup, ibin, cam_in, uv10, wwd, uth, rc) use ppgrid, only: pcols, pver use physics_types, only: physics_state use camsrfexch, only: cam_in_t @@ -681,7 +729,7 @@ subroutine CARMA_SurfaceWind(carma, state, icol, ielem, igroup, ibin, cam_in, uv call WeibullWind(uv10, uth, 2._r8, wwd) return - end subroutine CARMA_SurfaceWind + end subroutine CARMAMODEL_SurfaceWind !! Read in the dust source (soil) erodibility factor from a NETCDF file. In this @@ -693,7 +741,7 @@ end subroutine CARMA_SurfaceWind !! !! @author Pengfei Yu !! @version July-2012 - subroutine CARMA_ReadSoilErosionFactor(carma, rc) + subroutine CARMAMODEL_ReadSoilErosionFactor(carma, rc) use ppgrid, only: begchunk, endchunk, pcols use ioFileMod, only: getfil use wrap_nf @@ -742,7 +790,7 @@ subroutine CARMA_ReadSoilErosionFactor(carma, rc) call wrap_inq_varid(fid, 'new_source', idvar) i = nf90_get_var (fid, idvar, ero_factor) if (i/=NF90_NOERR) then - write(iulog,*)'CARMA_ReadSoilErosionFactor: error reading varid =', idvar + write(iulog,*)'CARMAMODEL_ReadSoilErosionFactor: error reading varid =', idvar call handle_error (i) end if call wrap_inq_varid(fid, 'plat', idlat) @@ -775,7 +823,8 @@ subroutine CARMA_ReadSoilErosionFactor(carma, rc) deallocate(ero_lon) deallocate(ero_factor) - end subroutine CARMA_ReadSoilErosionFactor + return + end subroutine CARMAMODEL_ReadSoilErosionFactor !! Calculate the nth mean of u using Weibull wind distribution @@ -819,4 +868,92 @@ subroutine WeibullWind(u, uth, n, uwb, wbk) end subroutine WeibullWind + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_CalculateCloudborneDiagnostics(carma, state, pbuf, aerclddiag, rc) + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(out) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the total cloudborne aerosols, supports up to MAXCLDAERDIAG different values + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_CalculateCloudborneDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputBudgetDiagnostics(carma, icnst4elem, icnst4gas, state, ptend, old_cflux, cflux, dt, pname, rc) + use cam_history, only: outfld + use constituents, only: pcnst, cnst_get_ind + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + integer, intent(in) :: icnst4gas(NGAS) !! constituent index for a carma gas + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + real(r8) :: old_cflux(pcols,pcnst) !! cam_in%clfux from before the timestep_tend + real(r8) :: cflux(pcols,pcnst) !! cam_in%clfux from after the timestep_tend + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputBudgetDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputCloudborneDiagnostics(carma, state, pbuf, dt, pname, oldaerclddiag, rc) + use cam_history, only: outfld + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + real(r8), intent(in ) :: oldaerclddiag(pcols,MAXCLDAERDIAG) !! the before timestep cloudborne aerosol diags + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputCloudborneDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputDiagnostics(carma, icnst4elem, state, ptend, pbuf, cam_in, rc) + use cam_history, only: outfld + use constituents, only: cnst_get_ind + use camsrfexch, only: cam_in_t + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + type(cam_in_t), intent(in) :: cam_in !! surface inputs + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputDiagnostics + end module diff --git a/src/physics/carma/models/meteor_impact/carma_model_mod.F90 b/src/physics/carma/models/meteor_impact/carma_model_mod.F90 index f8ebec713d..59bee3ca7e 100755 --- a/src/physics/carma/models/meteor_impact/carma_model_mod.F90 +++ b/src/physics/carma/models/meteor_impact/carma_model_mod.F90 @@ -42,14 +42,19 @@ module carma_model_mod private ! Declare the public methods. - public CARMA_DefineModel - public CARMA_Detrain - public CARMA_DiagnoseBins - public CARMA_DiagnoseBulk - public CARMA_EmitParticle - public CARMA_InitializeModel - public CARMA_InitializeParticle - public CARMA_WetDeposition + public CARMAMODEL_CalculateCloudborneDiagnostics + public CARMAMODEL_CreateOpticsFile + public CARMAMODEL_DefineModel + public CARMAMODEL_Detrain + public CARMAMODEL_DiagnoseBins + public CARMAMODEL_DiagnoseBulk + public CARMAMODEL_EmitParticle + public CARMAMODEL_InitializeModel + public CARMAMODEL_InitializeParticle + public CARMAMODEL_OutputBudgetDiagnostics + public CARMAMODEL_OutputCloudborneDiagnostics + public CARMAMODEL_OutputDiagnostics + public CARMAMODEL_WetDeposition ! Declare public constants integer, public, parameter :: NGROUP = 2 !! Number of particle groups @@ -65,6 +70,10 @@ module carma_model_mod integer, public, parameter :: NMIE_RH = 8 !! Number of relative humidities for mie calculations real(kind=f), public :: mie_rh(NMIE_RH) = (/ 0._f, 0.5_f, 0.7_f, 0.8_f, 0.9_f, 0.95_f, 0.98_f, 0.99_f /) + integer, public, parameter :: NMIE_WTP = 0 !! Number of weight percents for mie calculations + real(kind=f), public :: mie_wtp(NMIE_WTP) + integer, public, parameter :: NREFIDX = 1 !! Number of refractive indices per element + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. ! Water vapor and cloud particles are convected in phase 1, while all other constituents ! are done in phase 2. @@ -96,7 +105,7 @@ module carma_model_mod !! !! @version May-2009 !! @author Chuck Bardeen - subroutine CARMA_DefineModel(carma, rc) + subroutine CARMAMODEL_DefineModel(carma, rc) type(carma_type), intent(inout) :: carma !! the carma object integer, intent(out) :: rc !! return code, negative indicates failure @@ -107,7 +116,7 @@ subroutine CARMA_DefineModel(carma, rc) real(kind=f), parameter :: dust_vmrat = 2.49_f ! dust volume ratio real(kind=f), parameter :: soot_rmin = 20.e-7_f ! dust minimum radius (cm) real(kind=f), parameter :: soot_vmrat = 2.49_f ! dust volume ratio - complex(kind=f) :: refidx(NWAVE) ! refractice indices + complex(kind=f) :: refidx(NWAVE,NREFIDX) ! refractice indices integer :: LUNOPRT ! logical unit number for output logical :: do_print ! do print output? @@ -123,13 +132,13 @@ subroutine CARMA_DefineModel(carma, rc) if (carma_emis_maxlon < 0._f) carma_emis_maxlon = 360._f + carma_emis_maxlon if (carma_emis_minlat > carma_emis_maxlat) then - if (do_print) write(LUNOPRT,*) 'CARMA_DefineModel::ERROR - carma_emis_minlat greater than carma_emis_maxlat' + if (do_print) write(LUNOPRT,*) 'CARMAMODEL_DefineModel::ERROR - carma_emis_minlat greater than carma_emis_maxlat' end if ! Report model specific namelist configuration parameters. if (masterproc) then call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) - if (rc < 0) call endrun("CARMA_InitializeModel: CARMA_Get failed.") + if (rc < 0) call endrun("CARMAMODEL_DefineModel: CARMA_Get failed.") if (do_print) write(LUNOPRT,*) '' if (do_print) write(LUNOPRT,*) 'CARMA ', trim(carma_model), ' specific settings :' @@ -154,19 +163,10 @@ subroutine CARMA_DefineModel(carma, rc) ! defined. If wetdep is defined, then the optional solubility factor ! should also be defined. - ! Use the same refractive index at all wavelengths. This value is typical of soot and - ! is recommended by Toon et al. 2012. TBD Wagner et al. 2011 shows variability in the - ! real part (0.003 (IR) to 0.05 (UV)). - refidx(:) = (1.53_f, 0.008_f) - call CARMAGROUP_Create(carma, I_GRP_DUST, "Dust", dust_rmin, dust_vmrat, I_SPHERE, 1._f, .false., & rc, do_wetdep=.true., do_drydep=.true., solfac=0.3_f, & - scavcoef=0.1_f, shortname="CRDUST", refidx=refidx, do_mie=.true.) - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') - - ! Use the same refractive index at all wavelengths. This value is typical of soot and - ! is recommended by Toon et al. 2012. - refidx(:) = (1.8_f, 0.67_f) + scavcoef=0.1_f, shortname="CRDUST", do_mie=.true.) + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddGroup failed.') if (carma_fractal_soot) then RHO_SOOT = 1.8_f @@ -178,27 +178,37 @@ subroutine CARMA_DefineModel(carma, rc) call CARMAGROUP_Create(carma, I_GRP_SOOT, "Soot", soot_rmin, soot_vmrat, I_SPHERE, 1._f, .false., & rc, do_wetdep=.true., do_drydep=.true., solfac=0.1_f, & - scavcoef=0.1_f, shortname="CRSOOT", refidx=refidx, do_mie=.true., & + scavcoef=0.1_f, shortname="CRSOOT", do_mie=.true., & is_fractal=.true., rmon=soot_rmon, df=soot_df, falpha=soot_falpha, & imiertn=I_MIERTN_BOTET1997) else RHO_SOOT = 1.0_f call CARMAGROUP_Create(carma, I_GRP_SOOT, "Soot", soot_rmin, soot_vmrat, I_SPHERE, 1._f, .false., & rc, do_wetdep=.true., do_drydep=.true., solfac=0.1_f, & - scavcoef=0.1_f, shortname="CRSOOT", refidx=refidx, do_mie=.true.) + scavcoef=0.1_f, shortname="CRSOOT", do_mie=.true.) end if - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddGroup failed.') ! Define the Elements ! ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names ! should be 6 characters or less and without spaces. - call CARMAELEMENT_Create(carma, I_ELEM_DUST, I_GRP_DUST, "Dust", RHO_DUST, I_INVOLATILE, I_DUST, rc, shortname="CRDUST") - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') - call CARMAELEMENT_Create(carma, I_ELEM_SOOT, I_GRP_SOOT, "Soot", RHO_SOOT, I_INVOLATILE, I_SOOT, rc, shortname="CRSOOT") - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + ! Use the same refractive index at all wavelengths. This value is typical of dust and + ! is recommended by Toon et al. 2012. TBD Wagner et al. 2011 shows variability in the + ! real part (0.003 (IR) to 0.05 (UV)). + refidx(:,1) = CMPLX(1.53_f, 0.008_f, kind=f) + + call CARMAELEMENT_Create(carma, I_ELEM_DUST, I_GRP_DUST, "Dust", RHO_DUST, I_INVOLATILE, I_DUST, rc, shortname="CRDUST", refidx=refidx) + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddElement failed.') + + ! Use the same refractive index at all wavelengths. This value is typical of soot and + ! is recommended by Toon et al. 2012. + refidx(:,1) = CMPLX(1.8_f, 0.67_f, kind=f) + + call CARMAELEMENT_Create(carma, I_ELEM_SOOT, I_GRP_SOOT, "Soot", RHO_SOOT, I_INVOLATILE, I_SOOT, rc, shortname="CRSOOT", refidx=refidx) + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddElement failed.') ! Define the Solutes @@ -209,13 +219,13 @@ subroutine CARMA_DefineModel(carma, rc) ! Define the Processes call CARMA_AddCoagulation(carma, I_GRP_DUST, I_GRP_DUST, I_GRP_DUST, I_COLLEC_DATA, rc) - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddCoagulation failed.') call CARMA_AddCoagulation(carma, I_GRP_SOOT, I_GRP_SOOT, I_GRP_SOOT, I_COLLEC_DATA, rc) - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddCoagulation failed.') return - end subroutine CARMA_DefineModel + end subroutine CARMAMODEL_DefineModel !! Defines all the CARMA components (groups, elements, solutes and gases) and process @@ -225,7 +235,7 @@ end subroutine CARMA_DefineModel !! @author Chuck Bardeen !! !! @see CARMASTATE_SetDetrain - subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & + subroutine CARMAMODEL_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & tnd_qsnow, tnd_nsnow) use camsrfexch, only: cam_in_t use physconst, only: latice, latvap, cpair @@ -250,14 +260,14 @@ subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, rc = RC_OK return - end subroutine CARMA_Detrain + end subroutine CARMAMODEL_Detrain !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. !! !! @version July-2009 !! @author Chuck Bardeen - subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) + subroutine CARMAMODEL_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) use time_manager, only: is_first_step implicit none @@ -283,14 +293,14 @@ subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, pr ! code to determine the mass in each bin from the CAM state. return - end subroutine CARMA_DiagnoseBins + end subroutine CARMAMODEL_DiagnoseBins !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. !! !! @version July-2009 !! @author Chuck Bardeen - subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & + subroutine CARMAMODEL_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) use camsrfexch, only: cam_out_t @@ -329,7 +339,7 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, do ibin = 1, NBIN call CARMASTATE_GetBin(cstate, ielem, ibin, mmr, rc, sedimentationFlux=sflx) - if (rc < 0) call endrun('CARMA_DiagnoseBulk::CARMA_GetBin failed.') + if (rc < 0) call endrun('CARMAMODEL_DiagnoseBulk::CARMA_GetBin failed.') cam_out%bcphidry(icol) = cam_out%bcphidry(icol) + max(sflx, 0._r8) end do @@ -338,7 +348,7 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, do ibin = 1, NBIN call CARMASTATE_GetBin(cstate, ielem, ibin, mmr, rc, sedimentationFlux=sflx) - if (rc < 0) call endrun('CARMA_DiagnoseBulk::CARMA_GetBin failed.') + if (rc < 0) call endrun('CARMAMODEL_DiagnoseBulk::CARMA_GetBin failed.') if (carma_dustmap(ibin) == 1) then cam_out%dstdry1(icol) = cam_out%dstdry1(icol) + max(sflx, 0._r8) @@ -352,7 +362,7 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, end do return - end subroutine CARMA_DiagnoseBulk + end subroutine CARMAMODEL_DiagnoseBulk !! Calculates the emissions for CARMA aerosol particles. By default, there is no @@ -361,7 +371,7 @@ end subroutine CARMA_DiagnoseBulk !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, rc) + subroutine CARMAMODEL_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, pbuf, rc) use shr_kind_mod, only: r8 => shr_kind_r8 use ppgrid, only: pcols, pver use physics_types, only: physics_state @@ -382,6 +392,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend type(cam_in_t), intent(in) :: cam_in !! surface inputs real(r8), intent(out) :: tendency(pcols, pver) !! constituent tendency (kg/kg/s) real(r8), intent(out) :: surfaceFlux(pcols) !! constituent surface flux (kg/m^2/s) + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer integer, intent(out) :: rc !! return code, negative indicates failure real(r8), parameter :: mu_dust_gnd = 1._r8 ! width parameter, dust, ground (km) @@ -563,7 +574,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend end if return - end subroutine CARMA_EmitParticle + end subroutine CARMAMODEL_EmitParticle !! Allows the model to perform its own initialization in addition to what is done @@ -574,7 +585,7 @@ end subroutine CARMA_EmitParticle !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_InitializeModel(carma, lq_carma, rc) + subroutine CARMAMODEL_InitializeModel(carma, lq_carma, pbuf2d, rc) use constituents, only: pcnst use phys_grid, only: get_rlat_all_p, get_rlon_all_p, get_area_all_p, get_ncols_p use shr_reprosum_mod, only: shr_reprosum_calc @@ -586,6 +597,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) type(carma_type), intent(in) :: carma !! the carma object logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent !! could have a CARMA tendency + type(physics_buffer_desc), pointer :: pbuf2d(:,:) integer, intent(out) :: rc !! return code, negative indicates failure ! NOTE: The dust distribution has not been specified yet, but it should be different @@ -735,7 +747,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) end if return - end subroutine CARMA_InitializeModel + end subroutine CARMAMODEL_InitializeModel !! Sets the initial condition for CARMA aerosol particles. By default, there are no @@ -747,7 +759,7 @@ end subroutine CARMA_InitializeModel !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) + subroutine CARMAMODEL_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) use shr_kind_mod, only: r8 => shr_kind_r8 implicit none @@ -767,15 +779,55 @@ subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, ! Add initial condition here. return - end subroutine CARMA_InitializeParticle + end subroutine CARMAMODEL_InitializeParticle + !! This routine is an extension of CARMA_CreateOpticsFile() that allows for + !! model specific tables to be created in addition to the model independent + !! methods that are in carma_intr.F90. + !! + !! The opticsType that is specified for the group determines how the optical + !! properties will be generated for that group. Each group can use a different + !! optics method if needed. Refractive indices need for these calculation are + !! are specified in the group's elements rather than at the group level. This + !! allows various mixing approaches to be used to determine the refractive index + !! for the particle as a whole. If the refractive index for water is needed, + !! it is specific the the CARMAGAS object for H2O. + subroutine CARMAMODEL_CreateOpticsFile(carma, igroup, opticsType, rc) + + implicit none + + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(in) :: igroup !! group identifier + integer, intent(in) :: opticsType !! optics type (see I_OPTICS_... in carma_enums.F90) + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Local variables + logical :: do_mie + integer :: cnsttype ! constituent type + + ! Assume success. + rc = 0 + + ! What type of calculation is needed for this group? + ! + ! NOTE: Some of these calculations generate optical properties as single mass + ! coefficients, while others are lookup tables designed around multiple + ! dimensions. + select case (opticsType) + + case default + call endrun('carma_CreateOpticsFile:: Unknown optics type.') + end select + + return + end subroutine CARMAMODEL_CreateOpticsFile !! Called after wet deposition has been performed. Allows the specific model to add !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. !! !! @version July-2011 !! @author Chuck Bardeen - subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) + subroutine CARMAMODEL_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) use camsrfexch, only: cam_out_t implicit none @@ -817,6 +869,121 @@ subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) end if return - end subroutine CARMA_WetDeposition + end subroutine CARMAMODEL_WetDeposition + + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_CalculateCloudborneDiagnostics(carma, state, pbuf, aerclddiag, rc) + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(out) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the total cloudborne aerosols, supports up to MAXCLDAERDIAG different values + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_CalculateCloudborneDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputBudgetDiagnostics(carma, icnst4elem, icnst4gas, state, ptend, old_cflux, cflux, dt, pname, rc) + use cam_history, only: outfld + use constituents, only: pcnst, cnst_get_ind + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + integer, intent(in) :: icnst4gas(NGAS) !! constituent index for a carma gas + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + real(r8) :: old_cflux(pcols,pcnst) !! cam_in%clfux from before the timestep_tend + real(r8) :: cflux(pcols,pcnst) !! cam_in%clfux from after the timestep_tend + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputBudgetDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputCloudborneDiagnostics(carma, state, pbuf, dt, pname, oldaerclddiag, rc) + use cam_history, only: outfld + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + real(r8), intent(in ) :: oldaerclddiag(pcols,MAXCLDAERDIAG) !! the before timestep cloudborne aerosol diags + integer, intent(out) :: rc !! return code, negative indicates failure + + real(r8) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the after timestep cloudborne aerosol diags + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputCloudborneDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputDiagnostics(carma, icnst4elem, state, ptend, pbuf, cam_in, rc) + use cam_history, only: outfld + use constituents, only: cnst_get_ind + use camsrfexch, only: cam_in_t + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + type(cam_in_t), intent(in) :: cam_in !! surface inputs + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: icol !! column index + integer :: ibin !! bin index + real(r8), pointer, dimension(:,:) :: soacm !! aerosol tendency due to gas-aerosol exchange kg/kg/s + real(r8), pointer, dimension(:,:) :: soapt !! aerosol tendency due to no2 photolysis kg/kg/s + character(len=16) :: binname !! names bins + real(r8) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the before timestep cloudborne aerosol diags + integer :: i + integer :: icnst !! constituent index + integer :: ienconc !! concentration element index + integer :: ncore !! number of cores + integer :: icorelem(NELEM) !! core element index + real(r8) :: mair(pver) !! Mass of air column (kg/m2) + real(r8) :: pureso4(pcols) !! pure sulfate (kg/m2) + real(r8) :: mixso4(pcols) !! mix sulfate (kg/m2) + real(r8) :: cprflux(pcols) !! Surface Flux pure sulfate (kg/m2/s) + real(r8) :: cmxflux(pcols) !! Surface Flux mix sulfate (kg/m2/s) + real(r8) :: h2so4(pcols) !! H2SO4 gas (kg/m2) + real(r8) :: so2(pcols) !! SO2 gas (kg/m2) + real(r8) :: bdbc(pcols) !! Burden BC sulfate (kg/m2) + real(r8) :: bddust(pcols) !! Burden dust (kg/m2) + real(r8) :: bdoc(pcols) !! Burden OC sulfate (kg/m2) + real(r8) :: bdsalt(pcols) !! Burden SALT sulfate (kg/m2) + real(r8) :: bdsoa(pcols) !! Burden SOA sulfate (kg/m2) + character(len=16) :: shortname + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputDiagnostics end module diff --git a/src/physics/carma/models/meteor_smoke/carma_model_mod.F90 b/src/physics/carma/models/meteor_smoke/carma_model_mod.F90 index 0b6d83aba1..97d0a65a44 100644 --- a/src/physics/carma/models/meteor_smoke/carma_model_mod.F90 +++ b/src/physics/carma/models/meteor_smoke/carma_model_mod.F90 @@ -42,14 +42,19 @@ module carma_model_mod private ! Declare the public methods. - public CARMA_DefineModel - public CARMA_Detrain - public CARMA_DiagnoseBins - public CARMA_DiagnoseBulk - public CARMA_EmitParticle - public CARMA_InitializeModel - public CARMA_InitializeParticle - public CARMA_WetDeposition + public CARMAMODEL_CalculateCloudborneDiagnostics + public CARMAMODEL_CreateOpticsFile + public CARMAMODEL_DefineModel + public CARMAMODEL_Detrain + public CARMAMODEL_DiagnoseBins + public CARMAMODEL_DiagnoseBulk + public CARMAMODEL_EmitParticle + public CARMAMODEL_InitializeModel + public CARMAMODEL_InitializeParticle + public CARMAMODEL_OutputBudgetDiagnostics + public CARMAMODEL_OutputCloudborneDiagnostics + public CARMAMODEL_OutputDiagnostics + public CARMAMODEL_WetDeposition ! Declare public constants integer, public, parameter :: NGROUP = 1 !! Number of particle groups @@ -62,6 +67,10 @@ module carma_model_mod integer, public, parameter :: NMIE_RH = 8 !! Number of relative humidities for mie calculations real(kind=f), public :: mie_rh(NMIE_RH) + integer, public, parameter :: NMIE_WTP = 0 !! Number of weight percents for mie calculations + real(kind=f), public :: mie_wtp(NMIE_WTP) + integer, public, parameter :: NREFIDX = 1 !! Number of refractive indices per element + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. ! Water vapor and cloud particles are convected in phase 1, while all other constituents ! are done in phase 2. @@ -102,7 +111,7 @@ module carma_model_mod !! !! @version May-2009 !! @author Chuck Bardeen - subroutine CARMA_DefineModel(carma, rc) + subroutine CARMAMODEL_DefineModel(carma, rc) type(carma_type), intent(inout) :: carma !! the carma object integer, intent(out) :: rc !! return code, negative indicates failure @@ -120,7 +129,7 @@ subroutine CARMA_DefineModel(carma, rc) ! Report model specific namelist configuration parameters. if (masterproc) then call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) - if (rc < 0) call endrun("CARMA_InitializeModel: CARMA_Get failed.") + if (rc < 0) call endrun("CARMAMODEL_DefineModel: CARMA_Get failed.") if (do_print) write(LUNOPRT,*) '' if (do_print) write(LUNOPRT,*) 'CARMA ', trim(carma_model), ' specific settings :' @@ -139,7 +148,7 @@ subroutine CARMA_DefineModel(carma, rc) call CARMAGROUP_Create(carma, I_GRP_DUST, "meteor smoke", rmin, vmrat, I_SPHERE, 1._f, .false., & rc, do_wetdep=.true., do_drydep=.true., solfac=0.3_f, & scavcoef=0.1_f, shortname="DUST") - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddGroup failed.') ! Define the Elements @@ -148,7 +157,7 @@ subroutine CARMA_DefineModel(carma, rc) ! should be 6 characters or less and without spaces. call CARMAELEMENT_Create(carma, I_ELEM_DUST, I_GRP_DUST, "meteor smoke", RHO_METEOR_SMOKE, & I_INVOLATILE, I_METEOR_SMOKE, rc, shortname="DUST") - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddElement failed.') ! Define the Solutes @@ -159,10 +168,10 @@ subroutine CARMA_DefineModel(carma, rc) ! Define the Processes call CARMA_AddCoagulation(carma, I_GRP_DUST, I_GRP_DUST, I_GRP_DUST, I_COLLEC_DATA, rc) - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddCoagulation failed.') return - end subroutine CARMA_DefineModel + end subroutine CARMAMODEL_DefineModel !! Defines all the CARMA components (groups, elements, solutes and gases) and process @@ -172,7 +181,7 @@ end subroutine CARMA_DefineModel !! @author Chuck Bardeen !! !! @see CARMASTATE_SetDetrain - subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & + subroutine CARMAMODEL_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & tnd_qsnow, tnd_nsnow) use camsrfexch, only: cam_in_t use physconst, only: latice, latvap, cpair @@ -197,14 +206,14 @@ subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, rc = RC_OK return - end subroutine CARMA_Detrain + end subroutine CARMAMODEL_Detrain !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. !! !! @version July-2009 !! @author Chuck Bardeen - subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) + subroutine CARMAMODEL_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) use time_manager, only: is_first_step implicit none @@ -230,14 +239,14 @@ subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, pr ! code to determine the mass in each bin from the CAM state. return - end subroutine CARMA_DiagnoseBins + end subroutine CARMAMODEL_DiagnoseBins !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. !! !! @version July-2009 !! @author Chuck Bardeen - subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & + subroutine CARMAMODEL_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) use camsrfexch, only: cam_out_t @@ -268,7 +277,7 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, ! code to determine the bulk mass from the CARMA state. return - end subroutine CARMA_DiagnoseBulk + end subroutine CARMAMODEL_DiagnoseBulk !! Calculates the emissions for CARMA aerosol particles. By default, there is no @@ -277,7 +286,7 @@ end subroutine CARMA_DiagnoseBulk !! !! @author Chuck Bardeen !! @version Jan-2011 - subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, rc) + subroutine CARMAMODEL_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, pbuf, rc) use shr_kind_mod, only: r8 => shr_kind_r8 use ppgrid, only: pcols, pver use physics_types, only: physics_state @@ -296,6 +305,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend type(cam_in_t), intent(in) :: cam_in !! surface inputs real(r8), intent(out) :: tendency(pcols, pver) !! constituent tendency (kg/kg/s) real(r8), intent(out) :: surfaceFlux(pcols) !! constituent surface flux (kg/m^2/s) + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer integer, intent(out) :: rc !! return code, negative indicates failure integer :: ilat ! latitude index @@ -481,7 +491,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend end if return - end subroutine CARMA_EmitParticle + end subroutine CARMAMODEL_EmitParticle !! Allows the model to perform its own initialization in addition to what is done @@ -489,7 +499,7 @@ end subroutine CARMA_EmitParticle !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_InitializeModel(carma, lq_carma, rc) + subroutine CARMAMODEL_InitializeModel(carma, lq_carma, pbuf2d, rc) use ioFileMod, only: getfil use constituents, only: pcnst use wrap_nf @@ -499,6 +509,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) type(carma_type), intent(in) :: carma !! the carma object logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent !! could have a CARMA tendency + type(physics_buffer_desc), pointer :: pbuf2d(:,:) integer, intent(out) :: rc !! return code, negative indicates failure integer :: ilev ! level index @@ -524,7 +535,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) ! Add initialization here. call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) - if (rc < 0) call endrun("CARMA_InitializeModel: CARMA_Get failed.") + if (rc < 0) call endrun("CARMAMODEL_InitializeModel: CARMA_Get failed.") ! Initialize the emissions rate table. if (carma_do_emission) then @@ -642,7 +653,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) ! There should be one time for each day of the year, so ! quit if it isn't correct. if (carma_escale_nTimes .ne. 365) then - call endrun("CARMA_InitializeModel: Emission scaling file should have entries for 365 days, but doesn't.") + call endrun("CARMAMODEL_InitializeModel: Emission scaling file should have entries for 365 days, but doesn't.") endif call wrap_inq_dimid(fid, "ltime", ltime_did) @@ -665,7 +676,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) call wrap_inq_varid(fid, 'SGRF', grf_vid) tmp = nf90_get_var (fid, grf_vid, carma_escale_grf) if (tmp/=NF90_NOERR) then - write(iulog,*) 'CARMA_InitializeModel: error reading varid =', grf_vid + write(iulog,*) 'CARMAMODEL_InitializeModel: error reading varid =', grf_vid call handle_error (tmp) end if @@ -701,7 +712,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) endif return - end subroutine CARMA_InitializeModel + end subroutine CARMAMODEL_InitializeModel !! Sets the initial condition for CARMA aerosol particles. By default, there are no @@ -713,8 +724,9 @@ end subroutine CARMA_InitializeModel !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) + subroutine CARMAMODEL_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plat, plev, plon implicit none @@ -735,15 +747,55 @@ subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, ! NOTE: Initialized to 0. by the caller, so nothing needs to be done. return - end subroutine CARMA_InitializeParticle + end subroutine CARMAMODEL_InitializeParticle + + !! This routine is an extension of CARMA_CreateOpticsFile() that allows for + !! model specific tables to be created in addition to the model independent + !! methods that are in carma_intr.F90. + !! + !! The opticsType that is specified for the group determines how the optical + !! properties will be generated for that group. Each group can use a different + !! optics method if needed. Refractive indices need for these calculation are + !! are specified in the group's elements rather than at the group level. This + !! allows various mixing approaches to be used to determine the refractive index + !! for the particle as a whole. If the refractive index for water is needed, + !! it is specific the the CARMAGAS object for H2O. + subroutine CARMAMODEL_CreateOpticsFile(carma, igroup, opticsType, rc) + + implicit none + + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(in) :: igroup !! group identifier + integer, intent(in) :: opticsType !! optics type (see I_OPTICS_... in carma_enums.F90) + integer, intent(out) :: rc !! return code, negative indicates failure + ! Local variables + logical :: do_mie + integer :: cnsttype ! constituent type + + ! Assume success. + rc = 0 + + ! What type of calculation is needed for this group? + ! + ! NOTE: Some of these calculations generate optical properties as single mass + ! coefficients, while others are lookup tables designed around multiple + ! dimensions. + select case (opticsType) + + case default + call endrun('carma_CreateOpticsFile:: Unknown optics type.') + end select + + return + end subroutine CARMAMODEL_CreateOpticsFile !! Called after wet deposition has been performed. Allows the specific model to add !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. !! !! @version July-2011 !! @author Chuck Bardeen - subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) + subroutine CARMAMODEL_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) use camsrfexch, only: cam_out_t implicit none @@ -762,6 +814,121 @@ subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) rc = RC_OK return - end subroutine CARMA_WetDeposition + end subroutine CARMAMODEL_WetDeposition + + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_CalculateCloudborneDiagnostics(carma, state, pbuf, aerclddiag, rc) + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(out) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the total cloudborne aerosols, supports up to MAXCLDAERDIAG different values + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_CalculateCloudborneDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputBudgetDiagnostics(carma, icnst4elem, icnst4gas, state, ptend, old_cflux, cflux, dt, pname, rc) + use cam_history, only: outfld + use constituents, only: pcnst, cnst_get_ind + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + integer, intent(in) :: icnst4gas(NGAS) !! constituent index for a carma gas + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + real(r8) :: old_cflux(pcols,pcnst) !! cam_in%clfux from before the timestep_tend + real(r8) :: cflux(pcols,pcnst) !! cam_in%clfux from after the timestep_tend + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputBudgetDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputCloudborneDiagnostics(carma, state, pbuf, dt, pname, oldaerclddiag, rc) + use cam_history, only: outfld + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + real(r8), intent(in ) :: oldaerclddiag(pcols,MAXCLDAERDIAG) !! the before timestep cloudborne aerosol diags + integer, intent(out) :: rc !! return code, negative indicates failure + + real(r8) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the after timestep cloudborne aerosol diags + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputCloudborneDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputDiagnostics(carma, icnst4elem, state, ptend, pbuf, cam_in, rc) + use cam_history, only: outfld + use constituents, only: cnst_get_ind + use camsrfexch, only: cam_in_t + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + type(cam_in_t), intent(in) :: cam_in !! surface inputs + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: icol !! column index + integer :: ibin !! bin index + real(r8), pointer, dimension(:,:) :: soacm !! aerosol tendency due to gas-aerosol exchange kg/kg/s + real(r8), pointer, dimension(:,:) :: soapt !! aerosol tendency due to no2 photolysis kg/kg/s + character(len=16) :: binname !! names bins + real(r8) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the before timestep cloudborne aerosol diags + integer :: i + integer :: icnst !! constituent index + integer :: ienconc !! concentration element index + integer :: ncore !! number of cores + integer :: icorelem(NELEM) !! core element index + real(r8) :: mair(pver) !! Mass of air column (kg/m2) + real(r8) :: pureso4(pcols) !! pure sulfate (kg/m2) + real(r8) :: mixso4(pcols) !! mix sulfate (kg/m2) + real(r8) :: cprflux(pcols) !! Surface Flux pure sulfate (kg/m2/s) + real(r8) :: cmxflux(pcols) !! Surface Flux mix sulfate (kg/m2/s) + real(r8) :: h2so4(pcols) !! H2SO4 gas (kg/m2) + real(r8) :: so2(pcols) !! SO2 gas (kg/m2) + real(r8) :: bdbc(pcols) !! Burden BC sulfate (kg/m2) + real(r8) :: bddust(pcols) !! Burden dust (kg/m2) + real(r8) :: bdoc(pcols) !! Burden OC sulfate (kg/m2) + real(r8) :: bdsalt(pcols) !! Burden SALT sulfate (kg/m2) + real(r8) :: bdsoa(pcols) !! Burden SOA sulfate (kg/m2) + character(len=16) :: shortname + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputDiagnostics end module diff --git a/src/physics/carma/models/mixed_sulfate/carma_model_mod.F90 b/src/physics/carma/models/mixed_sulfate/carma_model_mod.F90 index 36ee1be358..edec758519 100644 --- a/src/physics/carma/models/mixed_sulfate/carma_model_mod.F90 +++ b/src/physics/carma/models/mixed_sulfate/carma_model_mod.F90 @@ -50,14 +50,19 @@ module carma_model_mod private ! Declare the public methods. - public CARMA_DefineModel - public CARMA_Detrain - public CARMA_DiagnoseBins - public CARMA_DiagnoseBulk - public CARMA_EmitParticle - public CARMA_InitializeModel - public CARMA_InitializeParticle - public CARMA_WetDeposition + public CARMAMODEL_CalculateCloudborneDiagnostics + public CARMAMODEL_CreateOpticsFile + public CARMAMODEL_DefineModel + public CARMAMODEL_Detrain + public CARMAMODEL_DiagnoseBins + public CARMAMODEL_DiagnoseBulk + public CARMAMODEL_EmitParticle + public CARMAMODEL_InitializeModel + public CARMAMODEL_InitializeParticle + public CARMAMODEL_OutputBudgetDiagnostics + public CARMAMODEL_OutputCloudborneDiagnostics + public CARMAMODEL_OutputDiagnostics + public CARMAMODEL_WetDeposition ! Declare public constants integer, public, parameter :: NGROUP = 2 !! Number of particle groups @@ -70,6 +75,10 @@ module carma_model_mod integer, public, parameter :: NMIE_RH = 8 !! Number of relative humidities for mie calculations real(kind=f), public :: mie_rh(NMIE_RH) + integer, public, parameter :: NMIE_WTP = 0 !! Number of weight percents for mie calculations + real(kind=f), public :: mie_wtp(NMIE_WTP) + integer, public, parameter :: NREFIDX = 1 !! Number of refractive indices per element + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. ! Water vapor and cloud particles are convected in phase 1, while all other constituents ! are done in phase 2. @@ -121,7 +130,7 @@ module carma_model_mod !! !! @version May-2009 !! @author Chuck Bardeen - subroutine CARMA_DefineModel(carma, rc) + subroutine CARMAMODEL_DefineModel(carma, rc) use ioFileMod, only: getfil use wrap_nf @@ -144,7 +153,7 @@ subroutine CARMA_DefineModel(carma, rc) rc = RC_OK call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_Get failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMA_Get failed.') ! Report model specific configuration parameters. if (masterproc) then @@ -167,7 +176,7 @@ subroutine CARMA_DefineModel(carma, rc) call CARMAGROUP_Create(carma, I_GRP_DUST, "meteor smoke", rmin, 2.0_f, I_SPHERE, 1._f, .false., & rc, do_wetdep=.true., do_drydep=.true., solfac=0.3_f, & scavcoef=0.1_f, shortname="DUST") - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddGroup failed.') ! NOTE: For CAM, the optional do_wetdep and do_drydep flags should be @@ -180,7 +189,7 @@ subroutine CARMA_DefineModel(carma, rc) call CARMAGROUP_Create(carma, I_GRP_SULFATE, "sulfate", rmin_sulfate, vmrat_sulfate, I_SPHERE, 1._f, .false., & rc, irhswell=I_WTPCT_H2SO4, do_wetdep=.true., do_drydep=.true., solfac=1.0_f, & scavcoef=0.1_f, is_sulfate=.true., shortname="SULF") - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddGroup failed.') ! Define the Elements @@ -189,15 +198,15 @@ subroutine CARMA_DefineModel(carma, rc) ! should be 6 characters or less and without spaces. call CARMAELEMENT_Create(carma, I_ELEM_DUST, I_GRP_DUST, "meteor smoke", RHO_METEOR_SMOKE, & I_INVOLATILE, I_METEOR_SMOKE, rc, shortname="DUST") - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddElement failed.') call CARMAELEMENT_Create(carma, I_ELEM_SULFATE, I_GRP_SULFATE, "sulfate", RHO_SULFATE, & I_VOLATILE, I_H2SO4, rc, shortname="SULF") - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddElement failed.') call CARMAELEMENT_Create(carma, I_ELEM_SULCORE, I_GRP_SULFATE, "sulfate core", RHO_METEOR_SMOKE, & I_COREMASS, I_METEOR_SMOKE, rc, shortname="SFCORE") - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddElement failed.') ! Define the Solutes ! @@ -208,40 +217,40 @@ subroutine CARMA_DefineModel(carma, rc) call CARMAGAS_Create(carma, I_GAS_H2O, "Water Vapor", WTMOL_H2O, & I_VAPRTN_H2O_MURPHY2005, I_GCOMP_H2O, rc, shortname="Q", & ds_threshold=0.2_f) - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGAS_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAGAS_Create failed.') call CARMAGAS_Create(carma, I_GAS_H2SO4, "Sulfuric Acid", WTMOL_H2SO4, & I_VAPRTN_H2SO4_AYERS1980, I_GCOMP_H2SO4, rc, shortname = "H2SO4", & ds_threshold=-0.2_f) - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGAS_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAGAS_Create failed.') ! Define the Processes call CARMA_AddCoagulation(carma, I_GRP_DUST, I_GRP_DUST, I_GRP_DUST, I_COLLEC_DATA, rc) - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddCoagulation failed.') ! Set H2SO4 to be the condensing gas, water vapor is assumed to be in equilibrium ! and will be used to define the wet particle radius. call CARMA_AddGrowth(carma, I_ELEM_SULFATE, I_GAS_H2SO4, rc) - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddGrowth failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMA_AddGrowth failed.') call CARMA_AddNucleation(carma, I_ELEM_SULFATE, I_ELEM_SULFATE, I_HOMNUC, 0._f, rc, igas=I_GAS_H2SO4) - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddNucleation failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMA_AddNucleation failed.') ! Also need nucleation with meteor smoke. call CARMA_AddNucleation(carma, I_ELEM_DUST, I_ELEM_SULCORE, I_HETNUCSULF, 0._f, rc, igas=I_GAS_H2SO4, ievp2elem=I_ELEM_DUST) - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddNucleation failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMA_AddNucleation failed.') call CARMA_AddCoagulation(carma, I_GRP_SULFATE, I_GRP_SULFATE, I_GRP_SULFATE, I_COLLEC_FUCHS, rc) - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMA_AddCoagulation failed.') ! Dust-Sulfate Coagulation? call CARMA_AddCoagulation(carma, I_GRP_DUST, I_GRP_SULFATE, I_GRP_SULFATE, I_COLLEC_FUCHS, rc) - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMA_AddCoagulation failed.') return - end subroutine CARMA_DefineModel + end subroutine CARMAMODEL_DefineModel !! Defines all the CARMA components (groups, elements, solutes and gases) and process @@ -251,7 +260,7 @@ end subroutine CARMA_DefineModel !! @author Chuck Bardeen !! !! @see CARMASTATE_SetDetrain - subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & + subroutine CARMAMODEL_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & tnd_qsnow, tnd_nsnow) use camsrfexch, only: cam_in_t use physconst, only: latice, latvap, cpair @@ -276,14 +285,14 @@ subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, rc = RC_OK return - end subroutine CARMA_Detrain + end subroutine CARMAMODEL_Detrain !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. !! !! @version July-2009 !! @author Chuck Bardeen - subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) + subroutine CARMAMODEL_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) use time_manager, only: is_first_step implicit none @@ -309,14 +318,14 @@ subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, pr ! code to determine the mass in each bin from the CAM state. return - end subroutine CARMA_DiagnoseBins + end subroutine CARMAMODEL_DiagnoseBins !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. !! !! @version July-2009 !! @author Chuck Bardeen - subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & + subroutine CARMAMODEL_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) use camsrfexch, only: cam_out_t @@ -347,10 +356,10 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, ! code to determine the bulk mass from the CARMA state. return - end subroutine CARMA_DiagnoseBulk + end subroutine CARMAMODEL_DiagnoseBulk - subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, rc) + subroutine CARMAMODEL_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, pbuf, rc) use shr_kind_mod, only: r8 => shr_kind_r8 use ppgrid, only: pcols, pver use physics_types, only: physics_state @@ -369,6 +378,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend type(cam_in_t), intent(in) :: cam_in !! surface inputs real(r8), intent(out) :: tendency(pcols, pver) !! constituent tendency (kg/kg/s) real(r8), intent(out) :: surfaceFlux(pcols) !! constituent surface flux (kg/m^2/s) + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer integer, intent(out) :: rc !! return code, negative indicates failure integer :: ilat ! latitude index @@ -560,7 +570,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend end if return - end subroutine CARMA_EmitParticle + end subroutine CARMAMODEL_EmitParticle !! Allows the model to perform its own initialization in addition to what is done @@ -568,7 +578,7 @@ end subroutine CARMA_EmitParticle !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_InitializeModel(carma, lq_carma, rc) + subroutine CARMAMODEL_InitializeModel(carma, lq_carma, pbuf2d, rc) use constituents, only: pcnst use ioFileMod, only: getfil use wrap_nf @@ -578,6 +588,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) type(carma_type), intent(in) :: carma !! the carma object logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent !! could have a CARMA tendency + type(physics_buffer_desc), pointer :: pbuf2d(:,:) integer, intent(out) :: rc !! return code, negative indicates failure integer :: ilev ! level index @@ -603,7 +614,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) ! Add initialization here. call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) - if (rc < 0) call endrun("CARMA_InitializeModel: CARMA_Get failed.") + if (rc < 0) call endrun("CARMAMODEL_InitializeModel: CARMA_Get failed.") ! Initialize the emissions rate table. if (carma_do_emission) then @@ -721,7 +732,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) ! There should be one time for each day of the year, so ! quit if it isn't correct. if (carma_escale_nTimes .ne. 365) then - call endrun("CARMA_InitializeModel: Emission scaling file should have entries for 365 days, but doesn't.") + call endrun("CARMAMODEL_InitializeModel: Emission scaling file should have entries for 365 days, but doesn't.") endif call wrap_inq_dimid(fid, "ltime", ltime_did) @@ -744,7 +755,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) call wrap_inq_varid(fid, 'SGRF', grf_vid) tmp = nf90_get_var (fid, grf_vid, carma_escale_grf) if (tmp/=NF90_NOERR) then - write(iulog,*) 'CARMA_InitializeModel: error reading varid =', grf_vid + write(iulog,*) 'CARMAMODEL_InitializeModel: error reading varid =', grf_vid call handle_error (tmp) end if @@ -780,7 +791,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) endif return - end subroutine CARMA_InitializeModel + end subroutine CARMAMODEL_InitializeModel !! Sets the initial condition for CARMA aerosol particles. By default, there are no @@ -792,8 +803,9 @@ end subroutine CARMA_InitializeModel !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) + subroutine CARMAMODEL_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plat, plev, plon implicit none @@ -814,15 +826,55 @@ subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, ! NOTE: Initialized to 0. by the caller, so nothing needs to be done. return - end subroutine CARMA_InitializeParticle + end subroutine CARMAMODEL_InitializeParticle + + !! This routine is an extension of CARMA_CreateOpticsFile() that allows for + !! model specific tables to be created in addition to the model independent + !! methods that are in carma_intr.F90. + !! + !! The opticsType that is specified for the group determines how the optical + !! properties will be generated for that group. Each group can use a different + !! optics method if needed. Refractive indices need for these calculation are + !! are specified in the group's elements rather than at the group level. This + !! allows various mixing approaches to be used to determine the refractive index + !! for the particle as a whole. If the refractive index for water is needed, + !! it is specific the the CARMAGAS object for H2O. + subroutine CARMAMODEL_CreateOpticsFile(carma, igroup, opticsType, rc) + + implicit none + + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(in) :: igroup !! group identifier + integer, intent(in) :: opticsType !! optics type (see I_OPTICS_... in carma_enums.F90) + integer, intent(out) :: rc !! return code, negative indicates failure + ! Local variables + logical :: do_mie + integer :: cnsttype ! constituent type + + ! Assume success. + rc = 0 + + ! What type of calculation is needed for this group? + ! + ! NOTE: Some of these calculations generate optical properties as single mass + ! coefficients, while others are lookup tables designed around multiple + ! dimensions. + select case (opticsType) + + case default + call endrun('carma_CreateOpticsFile:: Unknown optics type.') + end select + + return + end subroutine CARMAMODEL_CreateOpticsFile !! Called after wet deposition has been performed. Allows the specific model to add !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. !! !! @version July-2011 !! @author Chuck Bardeen - subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) + subroutine CARMAMODEL_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) use camsrfexch, only: cam_out_t implicit none @@ -841,6 +893,121 @@ subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) rc = RC_OK return - end subroutine CARMA_WetDeposition + end subroutine CARMAMODEL_WetDeposition + + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_CalculateCloudborneDiagnostics(carma, state, pbuf, aerclddiag, rc) + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(out) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the total cloudborne aerosols, supports up to MAXCLDAERDIAG different values + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_CalculateCloudborneDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputBudgetDiagnostics(carma, icnst4elem, icnst4gas, state, ptend, old_cflux, cflux, dt, pname, rc) + use cam_history, only: outfld + use constituents, only: pcnst, cnst_get_ind + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + integer, intent(in) :: icnst4gas(NGAS) !! constituent index for a carma gas + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + real(r8) :: old_cflux(pcols,pcnst) !! cam_in%clfux from before the timestep_tend + real(r8) :: cflux(pcols,pcnst) !! cam_in%clfux from after the timestep_tend + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputBudgetDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputCloudborneDiagnostics(carma, state, pbuf, dt, pname, oldaerclddiag, rc) + use cam_history, only: outfld + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + real(r8), intent(in ) :: oldaerclddiag(pcols,MAXCLDAERDIAG) !! the before timestep cloudborne aerosol diags + integer, intent(out) :: rc !! return code, negative indicates failure + + real(r8) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the after timestep cloudborne aerosol diags + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputCloudborneDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputDiagnostics(carma, icnst4elem, state, ptend, pbuf, cam_in, rc) + use cam_history, only: outfld + use constituents, only: cnst_get_ind + use camsrfexch, only: cam_in_t + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + type(cam_in_t), intent(in) :: cam_in !! surface inputs + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: icol !! column index + integer :: ibin !! bin index + real(r8), pointer, dimension(:,:) :: soacm !! aerosol tendency due to gas-aerosol exchange kg/kg/s + real(r8), pointer, dimension(:,:) :: soapt !! aerosol tendency due to no2 photolysis kg/kg/s + character(len=16) :: binname !! names bins + real(r8) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the before timestep cloudborne aerosol diags + integer :: i + integer :: icnst !! constituent index + integer :: ienconc !! concentration element index + integer :: ncore !! number of cores + integer :: icorelem(NELEM) !! core element index + real(r8) :: mair(pver) !! Mass of air column (kg/m2) + real(r8) :: pureso4(pcols) !! pure sulfate (kg/m2) + real(r8) :: mixso4(pcols) !! mix sulfate (kg/m2) + real(r8) :: cprflux(pcols) !! Surface Flux pure sulfate (kg/m2/s) + real(r8) :: cmxflux(pcols) !! Surface Flux mix sulfate (kg/m2/s) + real(r8) :: h2so4(pcols) !! H2SO4 gas (kg/m2) + real(r8) :: so2(pcols) !! SO2 gas (kg/m2) + real(r8) :: bdbc(pcols) !! Burden BC sulfate (kg/m2) + real(r8) :: bddust(pcols) !! Burden dust (kg/m2) + real(r8) :: bdoc(pcols) !! Burden OC sulfate (kg/m2) + real(r8) :: bdsalt(pcols) !! Burden SALT sulfate (kg/m2) + real(r8) :: bdsoa(pcols) !! Burden SOA sulfate (kg/m2) + character(len=16) :: shortname + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputDiagnostics end module diff --git a/src/physics/carma/models/pmc/carma_model_mod.F90 b/src/physics/carma/models/pmc/carma_model_mod.F90 index eb8c6e6667..77fd4efccf 100644 --- a/src/physics/carma/models/pmc/carma_model_mod.F90 +++ b/src/physics/carma/models/pmc/carma_model_mod.F90 @@ -45,14 +45,19 @@ module carma_model_mod private ! Declare the public methods. - public CARMA_DefineModel - public CARMA_Detrain - public CARMA_DiagnoseBins - public CARMA_DiagnoseBulk - public CARMA_EmitParticle - public CARMA_InitializeModel - public CARMA_InitializeParticle - public CARMA_WetDeposition + public CARMAMODEL_CalculateCloudborneDiagnostics + public CARMAMODEL_CreateOpticsFile + public CARMAMODEL_DefineModel + public CARMAMODEL_Detrain + public CARMAMODEL_DiagnoseBins + public CARMAMODEL_DiagnoseBulk + public CARMAMODEL_EmitParticle + public CARMAMODEL_InitializeModel + public CARMAMODEL_InitializeParticle + public CARMAMODEL_OutputBudgetDiagnostics + public CARMAMODEL_OutputCloudborneDiagnostics + public CARMAMODEL_OutputDiagnostics + public CARMAMODEL_WetDeposition ! Declare public constants integer, public, parameter :: NGROUP = 2 !! Number of particle groups @@ -65,6 +70,10 @@ module carma_model_mod integer, public, parameter :: NMIE_RH = 8 !! Number of relative humidities for mie calculations real(kind=f), public :: mie_rh(NMIE_RH) + integer, public, parameter :: NMIE_WTP = 0 !! Number of weight percents for mie calculations + real(kind=f), public :: mie_wtp(NMIE_WTP) + integer, public, parameter :: NREFIDX = 1 !! Number of refractive indices per element + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. ! Water vapor and cloud particles are convected in phase 1, while all other constituents ! are done in phase 2. @@ -117,7 +126,7 @@ module carma_model_mod !! !! @version May-2009 !! @author Chuck Bardeen - subroutine CARMA_DefineModel(carma, rc) + subroutine CARMAMODEL_DefineModel(carma, rc) use ioFileMod, only: getfil use wrap_nf @@ -137,7 +146,7 @@ subroutine CARMA_DefineModel(carma, rc) integer :: imag_vid character(len=256) :: efile ! refractive index file name real(kind=f) :: interp - complex(kind=f) :: refidx_ice(NWAVE) ! the refractive index at each CAM wavelength + complex(kind=f) :: refidx_ice(NWAVE,NREFIDX) ! the refractive index at each CAM wavelength integer :: LUNOPRT logical :: do_print @@ -145,7 +154,7 @@ subroutine CARMA_DefineModel(carma, rc) rc = RC_OK call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT, wave=wave) - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_Get failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMA_Get failed.') ! Report model specific configuration parameters. if (masterproc) then @@ -227,10 +236,10 @@ subroutine CARMA_DefineModel(carma, rc) if (wave(i) > warren_wave(j)) then if (j > 1) then interp = (wave(i) - warren_wave(j-1)) / (warren_wave(j) - warren_wave(j-1)) - refidx_ice(i) = cmplx(warren_real(j-1) + interp*(warren_real(j) - warren_real(j-1)), & - warren_imag(j-1) + interp*(warren_imag(j) - warren_imag(j-1))) + refidx_ice(i,1) = cmplx(warren_real(j-1) + interp*(warren_real(j) - warren_real(j-1)), & + warren_imag(j-1) + interp*(warren_imag(j) - warren_imag(j-1)), kind=f) else - refidx_ice(i) = cmplx(warren_real(j), warren_imag(j)) + refidx_ice(i,1) = cmplx(warren_real(j), warren_imag(j), kind=f) endif exit @@ -240,8 +249,8 @@ subroutine CARMA_DefineModel(carma, rc) end if call CARMAGROUP_Create(carma, I_GRP_CRICE, "ice crystal", rmin, 2.2_f, I_SPHERE, 1._f, .true., & - rc, do_mie=carma_do_pheat, refidx=refidx_ice, shortname="CRICE") - if (rc < 0) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + rc, do_mie=carma_do_pheat, shortname="CRICE") + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMAGROUP_Create failed.') ! Define the Elements @@ -250,15 +259,15 @@ subroutine CARMA_DefineModel(carma, rc) ! should be 6 characters or less and without spaces. call CARMAELEMENT_Create(carma, I_ELEM_DUST, I_GRP_DUST, "meteor smoke", RHO_METEOR_SMOKE, & I_INVOLATILE, I_METEOR_SMOKE, rc, shortname="DUST") - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddElement failed.') call CARMAELEMENT_Create(carma, I_ELEM_CRICE, I_GRP_CRICE, "ice crystal", RHO_I, & - I_VOLATILE, I_ICE, rc, shortname="CRICE") - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + I_VOLATILE, I_ICE, rc, shortname="CRICE", refidx=refidx_ice) + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddElement failed.') call CARMAELEMENT_Create(carma, I_ELEM_CRCORE, I_GRP_CRICE, "ice core", RHO_METEOR_SMOKE, & I_COREMASS, I_METEOR_SMOKE, rc, shortname="CRCORE") - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddElement failed.') ! Define the Solutes @@ -267,25 +276,25 @@ subroutine CARMA_DefineModel(carma, rc) ! Define the Gases call CARMAGAS_Create(carma, I_GAS_H2O, "Water Vapor", WTMOL_H2O, & I_VAPRTN_H2O_MURPHY2005, I_GCOMP_H2O, rc, shortname="Q", ds_threshold=0.2_f) - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGAS_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAGAS_Create failed.') ! Define the Processes call CARMA_AddCoagulation(carma, I_GRP_DUST, I_GRP_DUST, I_GRP_DUST, I_COLLEC_DATA, rc) - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddCoagulation failed.') call CARMA_AddNucleation(carma, I_ELEM_DUST, I_ELEM_CRCORE, I_HETNUC, 0._f, rc, & igas=I_GAS_H2O, ievp2elem=I_ELEM_DUST) - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddNucleation failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMA_AddNucleation failed.') call CARMA_AddGrowth(carma, I_ELEM_CRICE, I_GAS_H2O, rc) - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddGrowth failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMA_AddGrowth failed.') call CARMA_AddCoagulation(carma, I_GRP_DUST, I_GRP_CRICE, I_GRP_CRICE, I_COLLEC_DATA, rc) - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddCoagulation failed.') return - end subroutine CARMA_DefineModel + end subroutine CARMAMODEL_DefineModel !! Defines all the CARMA components (groups, elements, solutes and gases) and process @@ -295,7 +304,7 @@ end subroutine CARMA_DefineModel !! @author Chuck Bardeen !! !! @see CARMASTATE_SetDetrain - subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & + subroutine CARMAMODEL_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & tnd_qsnow, tnd_nsnow) use camsrfexch, only: cam_in_t use physconst, only: latice, latvap, cpair @@ -320,14 +329,14 @@ subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, rc = RC_OK return - end subroutine CARMA_Detrain + end subroutine CARMAMODEL_Detrain !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. !! !! @version July-2009 !! @author Chuck Bardeen - subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) + subroutine CARMAMODEL_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) use time_manager, only: is_first_step implicit none @@ -353,14 +362,14 @@ subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, pr ! code to determine the mass in each bin from the CAM state. return - end subroutine CARMA_DiagnoseBins + end subroutine CARMAMODEL_DiagnoseBins !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. !! !! @version July-2009 !! @author Chuck Bardeen - subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & + subroutine CARMAMODEL_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) use camsrfexch, only: cam_out_t @@ -391,10 +400,10 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, ! code to determine the bulk mass from the CARMA state. return - end subroutine CARMA_DiagnoseBulk + end subroutine CARMAMODEL_DiagnoseBulk - subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, rc) + subroutine CARMAMODEL_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, pbuf, rc) use shr_kind_mod, only: r8 => shr_kind_r8 use ppgrid, only: pcols, pver use physics_types, only: physics_state @@ -413,6 +422,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend type(cam_in_t), intent(in) :: cam_in !! surface inputs real(r8), intent(out) :: tendency(pcols, pver) !! constituent tendency (kg/kg/s) real(r8), intent(out) :: surfaceFlux(pcols) !! constituent surface flux (kg/m^2/s) + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer integer, intent(out) :: rc !! return code, negative indicates failure integer :: ilat ! latitude index @@ -598,7 +608,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend end if return - end subroutine CARMA_EmitParticle + end subroutine CARMAMODEL_EmitParticle !! Allows the model to perform its own initialization in addition to what is done @@ -606,7 +616,7 @@ end subroutine CARMA_EmitParticle !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_InitializeModel(carma, lq_carma, rc) + subroutine CARMAMODEL_InitializeModel(carma, lq_carma, pbuf2d, rc) use ioFileMod, only: getfil use constituents, only: pcnst use wrap_nf @@ -616,6 +626,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) type(carma_type), intent(in) :: carma !! the carma object logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent !! could have a CARMA tendency + type(physics_buffer_desc), pointer :: pbuf2d(:,:) integer, intent(out) :: rc !! return code, negative indicates failure integer :: ilev ! level index @@ -641,7 +652,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) ! Add initialization here. call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) - if (rc < 0) call endrun("CARMA_InitializeModel: CARMA_Get failed.") + if (rc < 0) call endrun("CARMAMODEL_InitializeModel: CARMA_Get failed.") ! Initialize the emissions rate table. if (carma_do_emission) then @@ -759,7 +770,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) ! There should be one time for each day of the year, so ! quit if it isn't correct. if (carma_escale_nTimes .ne. 365) then - call endrun("CARMA_InitializeModel: Emission scaling file should have entries for 365 days, but doesn't.") + call endrun("CARMAMODEL_InitializeModel: Emission scaling file should have entries for 365 days, but doesn't.") endif call wrap_inq_dimid(fid, "ltime", ltime_did) @@ -782,7 +793,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) call wrap_inq_varid(fid, 'SGRF', grf_vid) tmp = nf90_get_var (fid, grf_vid, carma_escale_grf) if (tmp/=NF90_NOERR) then - write(iulog,*) 'CARMA_InitializeModel: error reading varid =', grf_vid + write(iulog,*) 'CARMAMODEL_InitializeModel: error reading varid =', grf_vid call handle_error (tmp) end if @@ -818,7 +829,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) endif return - end subroutine CARMA_InitializeModel + end subroutine CARMAMODEL_InitializeModel !! Sets the initial condition for CARMA aerosol particles. By default, there are no @@ -830,8 +841,9 @@ end subroutine CARMA_InitializeModel !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) + subroutine CARMAMODEL_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plat, plev, plon implicit none @@ -852,15 +864,55 @@ subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, ! NOTE: Initialized to 0. by the caller, so nothing needs to be done. return - end subroutine CARMA_InitializeParticle + end subroutine CARMAMODEL_InitializeParticle + + !! This routine is an extension of CARMA_CreateOpticsFile() that allows for + !! model specific tables to be created in addition to the model independent + !! methods that are in carma_intr.F90. + !! + !! The opticsType that is specified for the group determines how the optical + !! properties will be generated for that group. Each group can use a different + !! optics method if needed. Refractive indices need for these calculation are + !! are specified in the group's elements rather than at the group level. This + !! allows various mixing approaches to be used to determine the refractive index + !! for the particle as a whole. If the refractive index for water is needed, + !! it is specific the the CARMAGAS object for H2O. + subroutine CARMAMODEL_CreateOpticsFile(carma, igroup, opticsType, rc) + + implicit none + + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(in) :: igroup !! group identifier + integer, intent(in) :: opticsType !! optics type (see I_OPTICS_... in carma_enums.F90) + integer, intent(out) :: rc !! return code, negative indicates failure + ! Local variables + logical :: do_mie + integer :: cnsttype ! constituent type + + ! Assume success. + rc = 0 + + ! What type of calculation is needed for this group? + ! + ! NOTE: Some of these calculations generate optical properties as single mass + ! coefficients, while others are lookup tables designed around multiple + ! dimensions. + select case (opticsType) + + case default + call endrun('carma_CreateOpticsFile:: Unknown optics type.') + end select + + return + end subroutine CARMAMODEL_CreateOpticsFile !! Called after wet deposition has been performed. Allows the specific model to add !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. !! !! @version July-2011 !! @author Chuck Bardeen - subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) + subroutine CARMAMODEL_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) use camsrfexch, only: cam_out_t implicit none @@ -879,6 +931,121 @@ subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) rc = RC_OK return - end subroutine CARMA_WetDeposition + end subroutine CARMAMODEL_WetDeposition + + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_CalculateCloudborneDiagnostics(carma, state, pbuf, aerclddiag, rc) + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(out) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the total cloudborne aerosols, supports up to MAXCLDAERDIAG different values + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_CalculateCloudborneDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputBudgetDiagnostics(carma, icnst4elem, icnst4gas, state, ptend, old_cflux, cflux, dt, pname, rc) + use cam_history, only: outfld + use constituents, only: pcnst, cnst_get_ind + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + integer, intent(in) :: icnst4gas(NGAS) !! constituent index for a carma gas + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + real(r8) :: old_cflux(pcols,pcnst) !! cam_in%clfux from before the timestep_tend + real(r8) :: cflux(pcols,pcnst) !! cam_in%clfux from after the timestep_tend + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputBudgetDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputCloudborneDiagnostics(carma, state, pbuf, dt, pname, oldaerclddiag, rc) + use cam_history, only: outfld + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + real(r8), intent(in ) :: oldaerclddiag(pcols,MAXCLDAERDIAG) !! the before timestep cloudborne aerosol diags + integer, intent(out) :: rc !! return code, negative indicates failure + + real(r8) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the after timestep cloudborne aerosol diags + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputCloudborneDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputDiagnostics(carma, icnst4elem, state, ptend, pbuf, cam_in, rc) + use cam_history, only: outfld + use constituents, only: cnst_get_ind + use camsrfexch, only: cam_in_t + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + type(cam_in_t), intent(in) :: cam_in !! surface inputs + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: icol !! column index + integer :: ibin !! bin index + real(r8), pointer, dimension(:,:) :: soacm !! aerosol tendency due to gas-aerosol exchange kg/kg/s + real(r8), pointer, dimension(:,:) :: soapt !! aerosol tendency due to no2 photolysis kg/kg/s + character(len=16) :: binname !! names bins + real(r8) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the before timestep cloudborne aerosol diags + integer :: i + integer :: icnst !! constituent index + integer :: ienconc !! concentration element index + integer :: ncore !! number of cores + integer :: icorelem(NELEM) !! core element index + real(r8) :: mair(pver) !! Mass of air column (kg/m2) + real(r8) :: pureso4(pcols) !! pure sulfate (kg/m2) + real(r8) :: mixso4(pcols) !! mix sulfate (kg/m2) + real(r8) :: cprflux(pcols) !! Surface Flux pure sulfate (kg/m2/s) + real(r8) :: cmxflux(pcols) !! Surface Flux mix sulfate (kg/m2/s) + real(r8) :: h2so4(pcols) !! H2SO4 gas (kg/m2) + real(r8) :: so2(pcols) !! SO2 gas (kg/m2) + real(r8) :: bdbc(pcols) !! Burden BC sulfate (kg/m2) + real(r8) :: bddust(pcols) !! Burden dust (kg/m2) + real(r8) :: bdoc(pcols) !! Burden OC sulfate (kg/m2) + real(r8) :: bdsalt(pcols) !! Burden SALT sulfate (kg/m2) + real(r8) :: bdsoa(pcols) !! Burden SOA sulfate (kg/m2) + character(len=16) :: shortname + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputDiagnostics end module diff --git a/src/physics/carma/models/sea_salt/carma_model_mod.F90 b/src/physics/carma/models/sea_salt/carma_model_mod.F90 index db01fb4b00..784192c29f 100644 --- a/src/physics/carma/models/sea_salt/carma_model_mod.F90 +++ b/src/physics/carma/models/sea_salt/carma_model_mod.F90 @@ -44,14 +44,19 @@ module carma_model_mod private ! Declare the public methods. - public CARMA_DefineModel - public CARMA_Detrain - public CARMA_DiagnoseBins - public CARMA_DiagnoseBulk - public CARMA_EmitParticle - public CARMA_InitializeModel - public CARMA_InitializeParticle - public CARMA_WetDeposition + public CARMAMODEL_CalculateCloudborneDiagnostics + public CARMAMODEL_CreateOpticsFile + public CARMAMODEL_DefineModel + public CARMAMODEL_Detrain + public CARMAMODEL_DiagnoseBins + public CARMAMODEL_DiagnoseBulk + public CARMAMODEL_EmitParticle + public CARMAMODEL_InitializeModel + public CARMAMODEL_InitializeParticle + public CARMAMODEL_OutputBudgetDiagnostics + public CARMAMODEL_OutputCloudborneDiagnostics + public CARMAMODEL_OutputDiagnostics + public CARMAMODEL_WetDeposition ! Declare public constants integer, public, parameter :: NGROUP = 1 !! Number of particle groups @@ -64,6 +69,10 @@ module carma_model_mod integer, public, parameter :: NMIE_RH = 8 !! Number of relative humidities for mie calculations real(kind=f), public :: mie_rh(NMIE_RH) + integer, public, parameter :: NMIE_WTP = 0 !! Number of weight percents for mie calculations + real(kind=f), public :: mie_wtp(NMIE_WTP) + integer, public, parameter :: NREFIDX = 1 !! Number of refractive indices per element + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. ! Water vapor and cloud particles are convected in phase 1, while all other constituents ! are done in phase 2. @@ -83,7 +92,7 @@ module carma_model_mod !! !! @version May-2009 !! @author Chuck Bardeen - subroutine CARMA_DefineModel(carma, rc) + subroutine CARMAMODEL_DefineModel(carma, rc) type(carma_type), intent(inout) :: carma !! the carma object integer, intent(out) :: rc !! return code, negative indicates failure @@ -100,7 +109,7 @@ subroutine CARMA_DefineModel(carma, rc) ! Report model specific configuration parameters. if (masterproc) then call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_Get failed.') + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_Get failed.') if (do_print) write(LUNOPRT,*) '' if (do_print) write(LUNOPRT,*) 'CARMA ', trim(carma_model), ' specific settings :' @@ -117,7 +126,7 @@ subroutine CARMA_DefineModel(carma, rc) rc, do_wetdep=.true., do_drydep=.true., solfac=0.3_f, & scavcoef=0.1_f, shortname="SALT", irhswell=I_GERBER, & irhswcomp=I_SWG_SEA_SALT) - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddGroup failed.') ! Define the Elements @@ -125,7 +134,7 @@ subroutine CARMA_DefineModel(carma, rc) ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names ! should be 6 characters or less and without spaces. call CARMAELEMENT_Create(carma, 1, 1, "sea salt", RHO_SALT, I_INVOLATILE, I_SEA_SALT, rc, shortname="SALT") - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddElement failed.') ! Define the Solutes @@ -137,7 +146,7 @@ subroutine CARMA_DefineModel(carma, rc) ! Define the Processes return - end subroutine CARMA_DefineModel + end subroutine CARMAMODEL_DefineModel !! Defines all the CARMA components (groups, elements, solutes and gases) and process @@ -147,7 +156,7 @@ end subroutine CARMA_DefineModel !! @author Chuck Bardeen !! !! @see CARMASTATE_SetDetrain - subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & + subroutine CARMAMODEL_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & tnd_qsnow, tnd_nsnow) use camsrfexch, only: cam_in_t use physconst, only: latice, latvap, cpair @@ -172,14 +181,14 @@ subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, rc = RC_OK return - end subroutine CARMA_Detrain + end subroutine CARMAMODEL_Detrain !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. !! !! @version July-2009 !! @author Chuck Bardeen - subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) + subroutine CARMAMODEL_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) use time_manager, only: is_first_step implicit none @@ -205,14 +214,14 @@ subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, pr ! code to determine the mass in each bin from the CAM state. return - end subroutine CARMA_DiagnoseBins + end subroutine CARMAMODEL_DiagnoseBins !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. !! !! @version July-2009 !! @author Chuck Bardeen - subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & + subroutine CARMAMODEL_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) use camsrfexch, only: cam_out_t @@ -243,7 +252,7 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, ! code to determine the bulk mass from the CARMA state. return - end subroutine CARMA_DiagnoseBulk + end subroutine CARMAMODEL_DiagnoseBulk !! Calculates the emissions for CARMA aerosol particles. By default, there is no @@ -252,7 +261,7 @@ end subroutine CARMA_DiagnoseBulk !! !! @author Tianyi Fan, Chuck Bardeen !! @version Dec-2010 - subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, rc) + subroutine CARMAMODEL_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, pbuf, rc) use shr_kind_mod, only: r8 => shr_kind_r8 use ppgrid, only: pcols, pver use physics_types, only: physics_state @@ -270,6 +279,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend type(cam_in_t), intent(in) :: cam_in !! surface inputs real(r8), intent(out) :: tendency(pcols, pver) !! constituent tendency (kg/kg/s) real(r8), intent(out) :: surfaceFlux(pcols) !! constituent surface flux (kg/m^2/s) + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer integer, intent(out) :: rc !! return code, negative indicates failure integer :: lchnk ! chunk identifier @@ -452,7 +462,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend !********************************** ! WIND for seasalt production !********************************** - call CARMA_SurfaceWind(carma, state, icol, cam_in, u10in, rc) + call CARMAMODEL_SurfaceWind(carma, state, icol, cam_in, u10in, rc) ! Add any surface flux here. ncflx = 0.0_r8 @@ -641,7 +651,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend end if return - end subroutine CARMA_EmitParticle + end subroutine CARMAMODEL_EmitParticle !! Allows the model to perform its own initialization in addition to what is done @@ -649,13 +659,14 @@ end subroutine CARMA_EmitParticle !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_InitializeModel(carma, lq_carma, rc) + subroutine CARMAMODEL_InitializeModel(carma, lq_carma, pbuf2d, rc) use constituents, only: pcnst implicit none type(carma_type), intent(in) :: carma !! the carma object logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent !! could have a CARMA tendency + type(physics_buffer_desc), pointer :: pbuf2d(:,:) integer, intent(out) :: rc !! return code, negative indicates failure ! Default return code. @@ -664,7 +675,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) ! Add initialization here. return - end subroutine CARMA_InitializeModel + end subroutine CARMAMODEL_InitializeModel !! Sets the initial condition for CARMA aerosol particles. By default, there are no @@ -676,8 +687,9 @@ end subroutine CARMA_InitializeModel !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) + subroutine CARMAMODEL_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) use shr_kind_mod, only: r8 => shr_kind_r8 + use pmgrid, only: plat, plev, plon implicit none @@ -698,15 +710,55 @@ subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, ! NOTE: Initialized to 0. by the caller, so nothing needs to be done. return - end subroutine CARMA_InitializeParticle + end subroutine CARMAMODEL_InitializeParticle + + !! This routine is an extension of CARMA_CreateOpticsFile() that allows for + !! model specific tables to be created in addition to the model independent + !! methods that are in carma_intr.F90. + !! + !! The opticsType that is specified for the group determines how the optical + !! properties will be generated for that group. Each group can use a different + !! optics method if needed. Refractive indices need for these calculation are + !! are specified in the group's elements rather than at the group level. This + !! allows various mixing approaches to be used to determine the refractive index + !! for the particle as a whole. If the refractive index for water is needed, + !! it is specific the the CARMAGAS object for H2O. + subroutine CARMAMODEL_CreateOpticsFile(carma, igroup, opticsType, rc) + + implicit none + + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(in) :: igroup !! group identifier + integer, intent(in) :: opticsType !! optics type (see I_OPTICS_... in carma_enums.F90) + integer, intent(out) :: rc !! return code, negative indicates failure + ! Local variables + logical :: do_mie + integer :: cnsttype ! constituent type + + ! Assume success. + rc = 0 + + ! What type of calculation is needed for this group? + ! + ! NOTE: Some of these calculations generate optical properties as single mass + ! coefficients, while others are lookup tables designed around multiple + ! dimensions. + select case (opticsType) + + case default + call endrun('carma_CreateOpticsFile:: Unknown optics type.') + end select + + return + end subroutine CARMAMODEL_CreateOpticsFile !! Called after wet deposition has been performed. Allows the specific model to add !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. !! !! @version July-2011 !! @author Chuck Bardeen - subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) + subroutine CARMAMODEL_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) use camsrfexch, only: cam_out_t implicit none @@ -725,14 +777,14 @@ subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) rc = RC_OK return - end subroutine CARMA_WetDeposition + end subroutine CARMAMODEL_WetDeposition !! Calculate the sea surface wind with a Weibull distribution. !! !! @author Tianyi Fan !! @version August-2010 - subroutine CARMA_SurfaceWind(carma, state, icol, cam_in, u10in, rc) + subroutine CARMAMODEL_SurfaceWind(carma, state, icol, cam_in, u10in, rc) use ppgrid, only: pcols, pver use physics_types, only: physics_state use camsrfexch, only: cam_in_t @@ -765,7 +817,7 @@ subroutine CARMA_SurfaceWind(carma, state, icol, cam_in, u10in, rc) u10in = uWB341 ** (1._r8 / 3.41_r8) return - end subroutine CARMA_SurfaceWind + end subroutine CARMAMODEL_SurfaceWind !! Calculate the nth mean of u using Weibull wind distribution @@ -809,4 +861,119 @@ subroutine WeibullWind(u, uth, n, uwb, wbk) end subroutine WeibullWind + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_CalculateCloudborneDiagnostics(carma, state, pbuf, aerclddiag, rc) + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(out) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the total cloudborne aerosols, supports up to MAXCLDAERDIAG different values + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_CalculateCloudborneDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputBudgetDiagnostics(carma, icnst4elem, icnst4gas, state, ptend, old_cflux, cflux, dt, pname, rc) + use cam_history, only: outfld + use constituents, only: pcnst, cnst_get_ind + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + integer, intent(in) :: icnst4gas(NGAS) !! constituent index for a carma gas + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + real(r8) :: old_cflux(pcols,pcnst) !! cam_in%clfux from before the timestep_tend + real(r8) :: cflux(pcols,pcnst) !! cam_in%clfux from after the timestep_tend + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputBudgetDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputCloudborneDiagnostics(carma, state, pbuf, dt, pname, oldaerclddiag, rc) + use cam_history, only: outfld + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + real(r8), intent(in ) :: oldaerclddiag(pcols,MAXCLDAERDIAG) !! the before timestep cloudborne aerosol diags + integer, intent(out) :: rc !! return code, negative indicates failure + + real(r8) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the after timestep cloudborne aerosol diags + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputCloudborneDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputDiagnostics(carma, icnst4elem, state, ptend, pbuf, cam_in, rc) + use cam_history, only: outfld + use constituents, only: cnst_get_ind + use camsrfexch, only: cam_in_t + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + type(cam_in_t), intent(in) :: cam_in !! surface inputs + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: icol !! column index + integer :: ibin !! bin index + real(r8), pointer, dimension(:,:) :: soacm !! aerosol tendency due to gas-aerosol exchange kg/kg/s + real(r8), pointer, dimension(:,:) :: soapt !! aerosol tendency due to no2 photolysis kg/kg/s + character(len=16) :: binname !! names bins + real(r8) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the before timestep cloudborne aerosol diags + integer :: i + integer :: icnst !! constituent index + integer :: ienconc !! concentration element index + integer :: ncore !! number of cores + integer :: icorelem(NELEM) !! core element index + real(r8) :: mair(pver) !! Mass of air column (kg/m2) + real(r8) :: pureso4(pcols) !! pure sulfate (kg/m2) + real(r8) :: mixso4(pcols) !! mix sulfate (kg/m2) + real(r8) :: cprflux(pcols) !! Surface Flux pure sulfate (kg/m2/s) + real(r8) :: cmxflux(pcols) !! Surface Flux mix sulfate (kg/m2/s) + real(r8) :: h2so4(pcols) !! H2SO4 gas (kg/m2) + real(r8) :: so2(pcols) !! SO2 gas (kg/m2) + real(r8) :: bdbc(pcols) !! Burden BC sulfate (kg/m2) + real(r8) :: bddust(pcols) !! Burden dust (kg/m2) + real(r8) :: bdoc(pcols) !! Burden OC sulfate (kg/m2) + real(r8) :: bdsalt(pcols) !! Burden SALT sulfate (kg/m2) + real(r8) :: bdsoa(pcols) !! Burden SOA sulfate (kg/m2) + character(len=16) :: shortname + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputDiagnostics + end module diff --git a/src/physics/carma/models/sulfate/carma_model_mod.F90 b/src/physics/carma/models/sulfate/carma_model_mod.F90 index abf98d1820..c0b38871ee 100644 --- a/src/physics/carma/models/sulfate/carma_model_mod.F90 +++ b/src/physics/carma/models/sulfate/carma_model_mod.F90 @@ -38,15 +38,19 @@ module carma_model_mod private ! Declare the public methods. - public CARMA_DefineModel - public CARMA_Detrain - public CARMA_DiagnoseBins - public CARMA_DiagnoseBulk - public CARMA_EmitParticle - public CARMA_InitializeModel - public CARMA_InitializeParticle - public CARMA_WetDeposition - + public CARMAMODEL_CalculateCloudborneDiagnostics + public CARMAMODEL_CreateOpticsFile + public CARMAMODEL_DefineModel + public CARMAMODEL_Detrain + public CARMAMODEL_DiagnoseBins + public CARMAMODEL_DiagnoseBulk + public CARMAMODEL_EmitParticle + public CARMAMODEL_InitializeModel + public CARMAMODEL_InitializeParticle + public CARMAMODEL_OutputBudgetDiagnostics + public CARMAMODEL_OutputCloudborneDiagnostics + public CARMAMODEL_OutputDiagnostics + public CARMAMODEL_WetDeposition ! Declare public constants integer, public, parameter :: NGROUP = 1 !! Number of particle groups @@ -59,6 +63,10 @@ module carma_model_mod integer, public, parameter :: NMIE_RH = 8 !! Number of relative humidities for mie calculations real(kind=f), public :: mie_rh(NMIE_RH) + integer, public, parameter :: NMIE_WTP = 0 !! Number of weight percents for mie calculations + real(kind=f), public :: mie_wtp(NMIE_WTP) + integer, public, parameter :: NREFIDX = 1 !! Number of refractive indices per element + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. ! Water vapor and cloud particles are convected in phase 1, while all other constituents ! are done in phase 2. @@ -90,7 +98,7 @@ module carma_model_mod !! !! @version May-2009 !! @author Chuck Bardeen - subroutine CARMA_DefineModel(carma, rc) + subroutine CARMAMODEL_DefineModel(carma, rc) use physics_buffer, only: pbuf_add_field, dtype_r8 type(carma_type), intent(inout) :: carma !! the carma object @@ -172,7 +180,7 @@ subroutine CARMA_DefineModel(carma, rc) call pbuf_add_field('VOLC_MMR', 'global', dtype_r8, (/pcols, pver/), ipbuf4so4mmr) endif - end subroutine CARMA_DefineModel + end subroutine CARMAMODEL_DefineModel !! Defines all the CARMA components (groups, elements, solutes and gases) and process @@ -182,7 +190,7 @@ end subroutine CARMA_DefineModel !! @author Chuck Bardeen !! !! @see CARMASTATE_SetDetrain - subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & + subroutine CARMAMODEL_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & tnd_qsnow, tnd_nsnow) use camsrfexch, only: cam_in_t use physconst, only: latice, latvap, cpair @@ -207,14 +215,14 @@ subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, rc = RC_OK return - end subroutine CARMA_Detrain + end subroutine CARMAMODEL_Detrain !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. !! !! @version July-2009 !! @author Chuck Bardeen - subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) + subroutine CARMAMODEL_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) use time_manager, only: is_first_step implicit none @@ -240,14 +248,14 @@ subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, pr ! code to determine the mass in each bin from the CAM state. return - end subroutine CARMA_DiagnoseBins + end subroutine CARMAMODEL_DiagnoseBins !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. !! !! @version July-2009 !! @author Chuck Bardeen - subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & + subroutine CARMAMODEL_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) use camsrfexch, only: cam_out_t use physics_buffer, only: pbuf_get_field @@ -325,7 +333,7 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, end if - end subroutine CARMA_DiagnoseBulk + end subroutine CARMAMODEL_DiagnoseBulk !! Calculates the emissions for CARMA aerosol particles. By default, there is no @@ -334,7 +342,7 @@ end subroutine CARMA_DiagnoseBulk !! !! @author Tianyi Fan, Chuck Bardeen !! @version Dec-2010 - subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, rc) + subroutine CARMAMODEL_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, pbuf, rc) use shr_kind_mod, only: r8 => shr_kind_r8 use ppgrid, only: pcols, pver use physics_types, only: physics_state @@ -353,6 +361,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend type(cam_in_t), intent(in) :: cam_in !! surface inputs real(r8), intent(out) :: tendency(pcols, pver) !! constituent tendency (kg/kg/s) real(r8), intent(out) :: surfaceFlux(pcols) !! constituent surface flux (kg/m^2/s) + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer integer, intent(out) :: rc !! return code, negative indicates failure ! Default return code. @@ -365,7 +374,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend tendency = 0._r8 return - end subroutine CARMA_EmitParticle + end subroutine CARMAMODEL_EmitParticle !! Allows the model to perform its own initialization in addition to what is done @@ -373,20 +382,21 @@ end subroutine CARMA_EmitParticle !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_InitializeModel(carma, lq_carma, rc) + subroutine CARMAMODEL_InitializeModel(carma, lq_carma, pbuf2d, rc) use constituents, only : pcnst implicit none type(carma_type), intent(in) :: carma !! the carma object logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent !! could have a CARMA tendency + type(physics_buffer_desc), pointer :: pbuf2d(:,:) integer, intent(out) :: rc !! return code, negative indicates failure ! Default return code. rc = RC_OK return - end subroutine CARMA_InitializeModel + end subroutine CARMAMODEL_InitializeModel !! Sets the initial condition for CARMA aerosol particles. By default, there are no @@ -398,7 +408,7 @@ end subroutine CARMA_InitializeModel !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) + subroutine CARMAMODEL_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) use shr_kind_mod, only: r8 => shr_kind_r8 implicit none @@ -420,7 +430,49 @@ subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, ! NOTE: Initialized to 0. by the caller, so nothing needs to be done. return - end subroutine CARMA_InitializeParticle + end subroutine CARMAMODEL_InitializeParticle + + + !! This routine is an extension of CARMA_CreateOpticsFile() that allows for + !! model specific tables to be created in addition to the model independent + !! methods that are in carma_intr.F90. + !! + !! The opticsType that is specified for the group determines how the optical + !! properties will be generated for that group. Each group can use a different + !! optics method if needed. Refractive indices need for these calculation are + !! are specified in the group's elements rather than at the group level. This + !! allows various mixing approaches to be used to determine the refractive index + !! for the particle as a whole. If the refractive index for water is needed, + !! it is specific the the CARMAGAS object for H2O. + subroutine CARMAMODEL_CreateOpticsFile(carma, igroup, opticsType, rc) + + implicit none + + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(in) :: igroup !! group identifier + integer, intent(in) :: opticsType !! optics type (see I_OPTICS_... in carma_enums.F90) + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Local variables + logical :: do_mie + integer :: cnsttype ! constituent type + + ! Assume success. + rc = 0 + + ! What type of calculation is needed for this group? + ! + ! NOTE: Some of these calculations generate optical properties as single mass + ! coefficients, while others are lookup tables designed around multiple + ! dimensions. + select case (opticsType) + + case default + call endrun('carma_CreateOpticsFile:: Unknown optics type.') + end select + + return + end subroutine CARMAMODEL_CreateOpticsFile !! Called after wet deposition has been performed. Allows the specific model to add @@ -428,7 +480,7 @@ end subroutine CARMA_InitializeParticle !! !! @version July-2011 !! @author Chuck Bardeen - subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) + subroutine CARMAMODEL_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) use camsrfexch, only: cam_out_t implicit none @@ -447,6 +499,94 @@ subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) rc = RC_OK return - end subroutine CARMA_WetDeposition + end subroutine CARMAMODEL_WetDeposition + + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_CalculateCloudborneDiagnostics(carma, state, pbuf, aerclddiag, rc) + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(out) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the total cloudborne aerosols, supports up to MAXCLDAERDIAG different values + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_CalculateCloudborneDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputBudgetDiagnostics(carma, icnst4elem, icnst4gas, state, ptend, old_cflux, cflux, dt, pname, rc) + use cam_history, only: outfld + use constituents, only: pcnst, cnst_get_ind + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + integer, intent(in) :: icnst4gas(NGAS) !! constituent index for a carma gas + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + real(r8) :: old_cflux(pcols,pcnst) !! cam_in%clfux from before the timestep_tend + real(r8) :: cflux(pcols,pcnst) !! cam_in%clfux from after the timestep_tend + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputBudgetDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputCloudborneDiagnostics(carma, state, pbuf, dt, pname, oldaerclddiag, rc) + use cam_history, only: outfld + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + real(r8), intent(in ) :: oldaerclddiag(pcols,MAXCLDAERDIAG) !! the before timestep cloudborne aerosol diags + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputCloudborneDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputDiagnostics(carma, icnst4elem, state, ptend, pbuf, cam_in, rc) + use cam_history, only: outfld + use constituents, only: cnst_get_ind + use camsrfexch, only: cam_in_t + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + type(cam_in_t), intent(in) :: cam_in !! surface inputs + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputDiagnostics end module diff --git a/src/physics/carma/models/test_growth/carma_model_mod.F90 b/src/physics/carma/models/test_growth/carma_model_mod.F90 index ad57aed469..1713fa1312 100644 --- a/src/physics/carma/models/test_growth/carma_model_mod.F90 +++ b/src/physics/carma/models/test_growth/carma_model_mod.F90 @@ -10,10 +10,10 @@ !! the initial conditions of the particles. Each realization of CARMA !! microphysics has its own version of this file. !! -!! This file is a simple test case involving one group of dust particles and -!! 8 size bins. Optical properties are calculated, assuming a constant refractive -!! index of (1.55, 4e-3). The particles are not subject to particle swelling, but -!! do coagulate. +!! This file is a simple test case involving two groups: sulfate condensation nuclei +!! and ice particles. The sulfates are prescribed and the ice is prognostics. This +!! test exercises the nucleation and growth code. THe particles are sedimented, but +!! do not coagulate. !! !! @version May-2009 !! @author Chuck Bardeen @@ -43,14 +43,19 @@ module carma_model_mod private ! Declare the public methods. - public CARMA_DefineModel - public CARMA_Detrain - public CARMA_DiagnoseBins - public CARMA_DiagnoseBulk - public CARMA_EmitParticle - public CARMA_InitializeModel - public CARMA_InitializeParticle - public CARMA_WetDeposition + public CARMAMODEL_CalculateCloudborneDiagnostics + public CARMAMODEL_CreateOpticsFile + public CARMAMODEL_DefineModel + public CARMAMODEL_Detrain + public CARMAMODEL_DiagnoseBins + public CARMAMODEL_DiagnoseBulk + public CARMAMODEL_EmitParticle + public CARMAMODEL_InitializeModel + public CARMAMODEL_InitializeParticle + public CARMAMODEL_OutputBudgetDiagnostics + public CARMAMODEL_OutputCloudborneDiagnostics + public CARMAMODEL_OutputDiagnostics + public CARMAMODEL_WetDeposition ! Declare public constants integer, public, parameter :: NGROUP = 2 !! Number of particle groups @@ -63,6 +68,10 @@ module carma_model_mod integer, public, parameter :: NMIE_RH = 8 !! Number of relative humidities for mie calculations real(kind=f), public :: mie_rh(NMIE_RH) + integer, public, parameter :: NMIE_WTP = 0 !! Number of weight percents for mie calculations + real(kind=f), public :: mie_wtp(NMIE_WTP) + integer, public, parameter :: NREFIDX = 1 !! Number of refractive indices per element + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. ! Water vapor and cloud particles are convected in phase 1, while all other constituents ! are done in phase 2. @@ -93,7 +102,7 @@ module carma_model_mod !! !! @version May-2009 !! @author Chuck Bardeen - subroutine CARMA_DefineModel(carma, rc) + subroutine CARMAMODEL_DefineModel(carma, rc) type(carma_type), intent(inout) :: carma !! the carma object integer, intent(out) :: rc !! return code, negative indicates failure @@ -118,11 +127,11 @@ subroutine CARMA_DefineModel(carma, rc) call CARMAGROUP_Create(carma, I_GRP_CRCN, "Sulfate CN", rmin_cn, 4.0_f, I_SPHERE, 1._f, .false., & rc, shortname="CRCN", cnsttype=I_CNSTTYPE_DIAGNOSTIC, & do_vtran=.false.) - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAGROUP_Create failed.') call CARMAGROUP_Create(carma, I_GRP_CRICE, "Ice", rmin_ice, 2.8_f, I_HEXAGON, 1._f / 6._f, .true., & rc, shortname="CRICE", ifallrtn=I_FALLRTN_STD_SHAPE) - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAGROUP_Create failed.') @@ -132,30 +141,30 @@ subroutine CARMA_DefineModel(carma, rc) ! should be 6 characters or less and without spaces. call CARMAELEMENT_Create(carma, I_ELEM_CRCN, I_GRP_CRCN, "Sulfate CN", RHO_CN, & I_INVOLATILE, I_H2SO4, rc, shortname="CRCN", isolute=I_SOL_CRH2SO4) - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAElement_Create failed.') call CARMAELEMENT_Create(carma, I_ELEM_CRICE, I_GRP_CRICE, "Ice", RHO_I, & I_VOLATILE, I_ICE, rc, shortname="CRICE") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAElement_Create failed.') call CARMAELEMENT_Create(carma, I_ELEM_CRCORE, I_GRP_CRICE, "Core Mass", RHO_CN, & I_COREMASS, I_H2SO4, rc, shortname="CRCORE", isolute=1) - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAElement_Create failed.') ! Define the Solutes call CARMASOLUTE_Create(carma, I_SOL_CRH2SO4, "Sulfuric Acid", 2, 98._f, 1.38_f, rc, shortname="CRH2SO4") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMASOLUTE_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMASOLUTE_Create failed.') ! Define the Gases call CARMAGAS_Create(carma, I_GAS_H2O, "Water Vapor", WTMOL_H2O, I_VAPRTN_H2O_MURPHY2005, I_GCOMP_H2O, rc, shortname="Q") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGAS_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAGAS_Create failed.') ! Define the Processes call CARMA_AddGrowth(carma, I_ELEM_CRICE, I_GAS_H2O, rc) - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddGrowth failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMA_AddGrowth failed.') ! NOTE: For now, assume the latent heat for nucleation is the latent of of fusion of ! water, using the CAM constant (scaled from J/kg to erg/g). @@ -165,10 +174,10 @@ subroutine CARMA_DefineModel(carma, rc) ! the gas associated with nucleation is accounted for. call CARMA_AddNucleation(carma, I_ELEM_CRCN, I_ELEM_CRCORE, & I_AERFREEZE + I_AF_KOOP_2000, 0._f, rc, igas=I_GAS_H2O, ievp2elem=I_ELEM_CRCN) - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddNucleation failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMA_AddNucleation failed.') return - end subroutine CARMA_DefineModel + end subroutine CARMAMODEL_DefineModel !! Defines all the CARMA components (groups, elements, solutes and gases) and process @@ -178,7 +187,7 @@ end subroutine CARMA_DefineModel !! @author Chuck Bardeen !! !! @see CARMASTATE_SetDetrain - subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & + subroutine CARMAMODEL_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & tnd_qsnow, tnd_nsnow) use camsrfexch, only: cam_in_t use physconst, only: latice, latvap, cpair @@ -203,14 +212,14 @@ subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, rc = RC_OK return - end subroutine CARMA_Detrain + end subroutine CARMAMODEL_Detrain !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. !! !! @version July-2009 !! @author Chuck Bardeen - subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) + subroutine CARMAMODEL_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) use time_manager, only: is_first_step implicit none @@ -249,7 +258,7 @@ subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, pr ! Get the air density. call CARMASTATE_GetState(cstate, rc, rhoa_wet=rhoa_wet) - if (rc < RC_OK) call endrun('CARMA_DiagnoseBins::CARMASTATE_GetState failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DiagnoseBins::CARMASTATE_GetState failed.') ! Use a fixed sulfate size distribution. By doing this as a diagnostic group, ! the constituents for the sulfate bins do not need to be advected, which @@ -258,7 +267,7 @@ subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, pr ielem = 1 call CARMAGROUP_Get(carma, igroup, rc, r=r, dr=dr, rmass=rmass) - if (rc < RC_OK) call endrun('CARMA_DiagnoseBins::CARMAGROUP_Get failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DiagnoseBins::CARMAGROUP_Get failed.') arg1(:) = n * dr(:) / (sqrt(2._f*PI) * r(:) * log(rsig)) arg2(:) = -((log(r(:)) - log(r0))**2) / (2._f*(log(rsig))**2) @@ -268,18 +277,18 @@ subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, pr do ibin = 1, NBIN mmr(ibin, :) = rhop(ibin) / rhoa_wet(:) call CARMASTATE_SetBin(cstate, ielem, ibin, mmr(ibin, :), rc) - if (rc < RC_OK) call endrun('CARMA_DiagnoseBins::CARMAGROUP_SetBin failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DiagnoseBins::CARMAGROUP_SetBin failed.') end do return - end subroutine CARMA_DiagnoseBins + end subroutine CARMAMODEL_DiagnoseBins !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. !! !! @version July-2009 !! @author Chuck Bardeen - subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & + subroutine CARMAMODEL_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) use camsrfexch, only: cam_out_t @@ -310,7 +319,7 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, ! code to determine the bulk mass from the CARMA state. return - end subroutine CARMA_DiagnoseBulk + end subroutine CARMAMODEL_DiagnoseBulk !! Calculates the emissions for CARMA aerosol particles. By default, there is no @@ -319,7 +328,7 @@ end subroutine CARMA_DiagnoseBulk !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, rc) + subroutine CARMAMODEL_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, pbuf, rc) use shr_kind_mod, only: r8 => shr_kind_r8 use ppgrid, only: pcols, pver use physics_types, only: physics_state @@ -338,6 +347,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend type(cam_in_t), intent(in) :: cam_in !! surface inputs real(r8), intent(out) :: tendency(pcols, pver) !! constituent tendency (kg/kg/s) real(r8), intent(out) :: surfaceFlux(pcols) !! constituent surface flux (kg/m^2/s) + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer integer, intent(out) :: rc !! return code, negative indicates failure integer :: ncol ! number of columns in chunk @@ -370,7 +380,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend tendency(:ncol, :pver) = 0.0_r8 return - end subroutine CARMA_EmitParticle + end subroutine CARMAMODEL_EmitParticle !! Allows the model to perform its own initialization in addition to what is done @@ -381,13 +391,14 @@ end subroutine CARMA_EmitParticle !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_InitializeModel(carma, lq_carma, rc) + subroutine CARMAMODEL_InitializeModel(carma, lq_carma, pbuf2d, rc) use constituents, only : pcnst implicit none type(carma_type), intent(in) :: carma !! the carma object logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent !! could have a CARMA tendency + type(physics_buffer_desc), pointer :: pbuf2d(:,:) integer, intent(out) :: rc !! return code, negative indicates failure ! Default return code. @@ -396,7 +407,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) ! Add initialization here. return - end subroutine CARMA_InitializeModel + end subroutine CARMAMODEL_InitializeModel !! Sets the initial condition for CARMA aerosol particles. By default, there are no @@ -408,7 +419,7 @@ end subroutine CARMA_InitializeModel !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) + subroutine CARMAMODEL_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) use shr_kind_mod, only: r8 => shr_kind_r8 use pmgrid, only: plev @@ -431,31 +442,65 @@ subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, ! Put a horizontally uniform layer of the smallest bin size ! in the model. if (ibin == 1) then - if (ielem == I_ELEM_CRICE) then - where(mask) - q(:, plev/4) = 100e-7_r8 ! 1/4 - end where - end if - if (ielem == I_ELEM_CRCORE) then - where(mask) - q(:, plev/4) = 100e-9_r8 ! 1/4 - end where - end if + where(mask) +! q(:, 1) = 100e-9_r8 ! top + q(:, plev/4) = 100e-9_r8 ! 1/4 ! q(:, plev/2) = 100e-9_r8 ! middle ! q(:, 3*plev/4) = 100e-9_r8 ! 3/4 ! q(:, plev-1) = 100e-9_r8 ! bottom + end where end if return - end subroutine CARMA_InitializeParticle + end subroutine CARMAMODEL_InitializeParticle + + !! This routine is an extension of CARMA_CreateOpticsFile() that allows for + !! model specific tables to be created in addition to the model independent + !! methods that are in carma_intr.F90. + !! + !! The opticsType that is specified for the group determines how the optical + !! properties will be generated for that group. Each group can use a different + !! optics method if needed. Refractive indices need for these calculation are + !! are specified in the group's elements rather than at the group level. This + !! allows various mixing approaches to be used to determine the refractive index + !! for the particle as a whole. If the refractive index for water is needed, + !! it is specific the the CARMAGAS object for H2O. + subroutine CARMAMODEL_CreateOpticsFile(carma, igroup, opticsType, rc) + + implicit none + + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(in) :: igroup !! group identifier + integer, intent(in) :: opticsType !! optics type (see I_OPTICS_... in carma_enums.F90) + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Local variables + logical :: do_mie + integer :: cnsttype ! constituent type + + ! Assume success. + rc = 0 + + ! What type of calculation is needed for this group? + ! + ! NOTE: Some of these calculations generate optical properties as single mass + ! coefficients, while others are lookup tables designed around multiple + ! dimensions. + select case (opticsType) + case default + call endrun('carma_CreateOpticsFile:: Unknown optics type.') + end select + + return + end subroutine CARMAMODEL_CreateOpticsFile !! Called after wet deposition has been performed. Allows the specific model to add !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. !! !! @version July-2011 !! @author Chuck Bardeen - subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) + subroutine CARMAMODEL_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) use camsrfexch, only: cam_out_t implicit none @@ -474,6 +519,94 @@ subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) rc = RC_OK return - end subroutine CARMA_WetDeposition + end subroutine CARMAMODEL_WetDeposition + + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_CalculateCloudborneDiagnostics(carma, state, pbuf, aerclddiag, rc) + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(out) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the total cloudborne aerosols, supports up to MAXCLDAERDIAG different values + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_CalculateCloudborneDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputBudgetDiagnostics(carma, icnst4elem, icnst4gas, state, ptend, old_cflux, cflux, dt, pname, rc) + use cam_history, only: outfld + use constituents, only: pcnst, cnst_get_ind + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + integer, intent(in) :: icnst4gas(NGAS) !! constituent index for a carma gas + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + real(r8) :: old_cflux(pcols,pcnst) !! cam_in%clfux from before the timestep_tend + real(r8) :: cflux(pcols,pcnst) !! cam_in%clfux from after the timestep_tend + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputBudgetDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputCloudborneDiagnostics(carma, state, pbuf, dt, pname, oldaerclddiag, rc) + use cam_history, only: outfld + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + real(r8), intent(in ) :: oldaerclddiag(pcols,MAXCLDAERDIAG) !! the before timestep cloudborne aerosol diags + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputCloudborneDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputDiagnostics(carma, icnst4elem, state, ptend, pbuf, cam_in, rc) + use cam_history, only: outfld + use constituents, only: cnst_get_ind + use camsrfexch, only: cam_in_t + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + type(cam_in_t), intent(in) :: cam_in !! surface inputs + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputDiagnostics end module diff --git a/src/physics/carma/models/test_passive/carma_model_mod.F90 b/src/physics/carma/models/test_passive/carma_model_mod.F90 index 12f4a6168e..95fa8d38ce 100644 --- a/src/physics/carma/models/test_passive/carma_model_mod.F90 +++ b/src/physics/carma/models/test_passive/carma_model_mod.F90 @@ -42,14 +42,19 @@ module carma_model_mod private ! Declare the public methods. - public CARMA_DefineModel - public CARMA_Detrain - public CARMA_DiagnoseBins - public CARMA_DiagnoseBulk - public CARMA_EmitParticle - public CARMA_InitializeModel - public CARMA_InitializeParticle - public CARMA_WetDeposition + public CARMAMODEL_CalculateCloudborneDiagnostics + public CARMAMODEL_CreateOpticsFile + public CARMAMODEL_DefineModel + public CARMAMODEL_Detrain + public CARMAMODEL_DiagnoseBins + public CARMAMODEL_DiagnoseBulk + public CARMAMODEL_EmitParticle + public CARMAMODEL_InitializeModel + public CARMAMODEL_InitializeParticle + public CARMAMODEL_OutputBudgetDiagnostics + public CARMAMODEL_OutputCloudborneDiagnostics + public CARMAMODEL_OutputDiagnostics + public CARMAMODEL_WetDeposition ! Declare public constants integer, public, parameter :: NGROUP = 1 !! Number of particle groups @@ -62,6 +67,10 @@ module carma_model_mod integer, public, parameter :: NMIE_RH = 8 !! Number of relative humidities for mie calculations real(kind=f), public :: mie_rh(NMIE_RH) + integer, public, parameter :: NMIE_WTP = 0 !! Number of weight percents for mie calculations + real(kind=f), public :: mie_wtp(NMIE_WTP) + integer, public, parameter :: NREFIDX = 1 !! Number of refractive indices per element + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. ! Water vapor and cloud particles are convected in phase 1, while all other constituents ! are done in phase 2. @@ -79,7 +88,7 @@ module carma_model_mod !! !! @version May-2009 !! @author Chuck Bardeen - subroutine CARMA_DefineModel(carma, rc) + subroutine CARMAMODEL_DefineModel(carma, rc) type(carma_type), intent(inout) :: carma !! the carma object integer, intent(out) :: rc !! return code, negative indicates failure @@ -101,7 +110,7 @@ subroutine CARMA_DefineModel(carma, rc) call CARMAGROUP_Create(carma, 1, "Dust", rmin, vmrat, I_SPHERE, 1._f, .false., & rc, do_wetdep=.true., do_drydep=.true., solfac=0.15_f, & scavcoef=0.1_f, shortname="DUST") - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddGroup failed.') ! Define the Elements @@ -109,7 +118,7 @@ subroutine CARMA_DefineModel(carma, rc) ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names ! should be 6 characters or less and without spaces. call CARMAELEMENT_Create(carma, 1, 1, "Dust", RHO_DUST, I_INVOLATILE, I_DUST, rc, shortname="DUST") - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddElement failed.') ! Define the Solutes @@ -120,10 +129,10 @@ subroutine CARMA_DefineModel(carma, rc) ! Define the Processes call CARMA_AddCoagulation(carma, 1, 1, 1, I_COLLEC_DATA, rc) - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddCoagulation failed.') return - end subroutine CARMA_DefineModel + end subroutine CARMAMODEL_DefineModel !! Defines all the CARMA components (groups, elements, solutes and gases) and process @@ -133,7 +142,7 @@ end subroutine CARMA_DefineModel !! @author Chuck Bardeen !! !! @see CARMASTATE_SetDetrain - subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & + subroutine CARMAMODEL_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & tnd_qsnow, tnd_nsnow) use camsrfexch, only: cam_in_t use physconst, only: latice, latvap, cpair @@ -158,14 +167,14 @@ subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, rc = RC_OK return - end subroutine CARMA_Detrain + end subroutine CARMAMODEL_Detrain !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. !! !! @version July-2009 !! @author Chuck Bardeen - subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) + subroutine CARMAMODEL_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) use time_manager, only: is_first_step implicit none @@ -191,14 +200,14 @@ subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, pr ! code to determine the mass in each bin from the CAM state. return - end subroutine CARMA_DiagnoseBins + end subroutine CARMAMODEL_DiagnoseBins !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. !! !! @version July-2009 !! @author Chuck Bardeen - subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & + subroutine CARMAMODEL_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) use camsrfexch, only: cam_out_t @@ -229,7 +238,7 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, ! code to determine the bulk mass from the CARMA state. return - end subroutine CARMA_DiagnoseBulk + end subroutine CARMAMODEL_DiagnoseBulk !! Calculates the emissions for CARMA aerosol particles. By default, there is no @@ -238,7 +247,7 @@ end subroutine CARMA_DiagnoseBulk !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, rc) + subroutine CARMAMODEL_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, pbuf, rc) use shr_kind_mod, only: r8 => shr_kind_r8 use ppgrid, only: pcols, pver use physics_types, only: physics_state @@ -257,6 +266,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend type(cam_in_t), intent(in) :: cam_in !! surface inputs real(r8), intent(out) :: tendency(pcols, pver) !! constituent tendency (kg/kg/s) real(r8), intent(out) :: surfaceFlux(pcols) !! constituent surface flux (kg/m^2/s) + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer integer, intent(out) :: rc !! return code, negative indicates failure integer :: ncol ! number of columns in chunk @@ -289,7 +299,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend tendency(:ncol, :pver) = 0.0_r8 return - end subroutine CARMA_EmitParticle + end subroutine CARMAMODEL_EmitParticle !! Allows the model to perform its own initialization in addition to what is done @@ -300,13 +310,14 @@ end subroutine CARMA_EmitParticle !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_InitializeModel(carma, lq_carma, rc) + subroutine CARMAMODEL_InitializeModel(carma, lq_carma, pbuf2d, rc) use constituents, only : pcnst implicit none type(carma_type), intent(in) :: carma !! the carma object logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent !! could have a CARMA tendency + type(physics_buffer_desc), pointer :: pbuf2d(:,:) integer, intent(out) :: rc !! return code, negative indicates failure ! Default return code. @@ -315,7 +326,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) ! Add initialization here. return - end subroutine CARMA_InitializeModel + end subroutine CARMAMODEL_InitializeModel !! Sets the initial condition for CARMA aerosol particles. By default, there are no @@ -327,7 +338,7 @@ end subroutine CARMA_InitializeModel !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) + subroutine CARMAMODEL_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) use shr_kind_mod, only: r8 => shr_kind_r8 use pmgrid, only: plev @@ -360,15 +371,55 @@ subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, end if return - end subroutine CARMA_InitializeParticle + end subroutine CARMAMODEL_InitializeParticle + + !! This routine is an extension of CARMA_CreateOpticsFile() that allows for + !! model specific tables to be created in addition to the model independent + !! methods that are in carma_intr.F90. + !! + !! The opticsType that is specified for the group determines how the optical + !! properties will be generated for that group. Each group can use a different + !! optics method if needed. Refractive indices need for these calculation are + !! are specified in the group's elements rather than at the group level. This + !! allows various mixing approaches to be used to determine the refractive index + !! for the particle as a whole. If the refractive index for water is needed, + !! it is specific the the CARMAGAS object for H2O. + subroutine CARMAMODEL_CreateOpticsFile(carma, igroup, opticsType, rc) + + implicit none + + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(in) :: igroup !! group identifier + integer, intent(in) :: opticsType !! optics type (see I_OPTICS_... in carma_enums.F90) + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Local variables + logical :: do_mie + integer :: cnsttype ! constituent type + + ! Assume success. + rc = 0 + + ! What type of calculation is needed for this group? + ! + ! NOTE: Some of these calculations generate optical properties as single mass + ! coefficients, while others are lookup tables designed around multiple + ! dimensions. + select case (opticsType) + case default + call endrun('carma_CreateOpticsFile:: Unknown optics type.') + end select + + return + end subroutine CARMAMODEL_CreateOpticsFile !! Called after wet deposition has been performed. Allows the specific model to add !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. !! !! @version July-2011 !! @author Chuck Bardeen - subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) + subroutine CARMAMODEL_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) use camsrfexch, only: cam_out_t implicit none @@ -387,6 +438,95 @@ subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) rc = RC_OK return - end subroutine CARMA_WetDeposition + end subroutine CARMAMODEL_WetDeposition + + + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_CalculateCloudborneDiagnostics(carma, state, pbuf, aerclddiag, rc) + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(out) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the total cloudborne aerosols, supports up to MAXCLDAERDIAG different values + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_CalculateCloudborneDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputBudgetDiagnostics(carma, icnst4elem, icnst4gas, state, ptend, old_cflux, cflux, dt, pname, rc) + use cam_history, only: outfld + use constituents, only: pcnst, cnst_get_ind + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + integer, intent(in) :: icnst4gas(NGAS) !! constituent index for a carma gas + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + real(r8) :: old_cflux(pcols,pcnst) !! cam_in%clfux from before the timestep_tend + real(r8) :: cflux(pcols,pcnst) !! cam_in%clfux from after the timestep_tend + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputBudgetDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputCloudborneDiagnostics(carma, state, pbuf, dt, pname, oldaerclddiag, rc) + use cam_history, only: outfld + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + real(r8), intent(in ) :: oldaerclddiag(pcols,MAXCLDAERDIAG) !! the before timestep cloudborne aerosol diags + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputCloudborneDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputDiagnostics(carma, icnst4elem, state, ptend, pbuf, cam_in, rc) + use cam_history, only: outfld + use constituents, only: cnst_get_ind + use camsrfexch, only: cam_in_t + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + type(cam_in_t), intent(in) :: cam_in !! surface inputs + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputDiagnostics end module diff --git a/src/physics/carma/models/test_radiative/carma_model_mod.F90 b/src/physics/carma/models/test_radiative/carma_model_mod.F90 index 8acff28edb..2822327d56 100644 --- a/src/physics/carma/models/test_radiative/carma_model_mod.F90 +++ b/src/physics/carma/models/test_radiative/carma_model_mod.F90 @@ -42,14 +42,19 @@ module carma_model_mod private ! Declare the public methods. - public CARMA_DefineModel - public CARMA_Detrain - public CARMA_DiagnoseBins - public CARMA_DiagnoseBulk - public CARMA_EmitParticle - public CARMA_InitializeModel - public CARMA_InitializeParticle - public CARMA_WetDeposition + public CARMAMODEL_CalculateCloudborneDiagnostics + public CARMAMODEL_CreateOpticsFile + public CARMAMODEL_DefineModel + public CARMAMODEL_Detrain + public CARMAMODEL_DiagnoseBins + public CARMAMODEL_DiagnoseBulk + public CARMAMODEL_EmitParticle + public CARMAMODEL_InitializeModel + public CARMAMODEL_InitializeParticle + public CARMAMODEL_OutputBudgetDiagnostics + public CARMAMODEL_OutputCloudborneDiagnostics + public CARMAMODEL_OutputDiagnostics + public CARMAMODEL_WetDeposition ! Declare public constants integer, public, parameter :: NGROUP = 1 !! Number of particle groups @@ -65,6 +70,10 @@ module carma_model_mod integer, public, parameter :: NMIE_RH = 8 !! Number of relative humidities for mie calculations real(kind=f), public :: mie_rh(NMIE_RH) = (/ 0._f, 0.5_f, 0.7_f, 0.8_f, 0.9_f, 0.95_f, 0.98_f, 0.99_f /) + integer, public, parameter :: NMIE_WTP = 0 !! Number of weight percents for mie calculations + real(kind=f), public :: mie_wtp(NMIE_WTP) + integer, public, parameter :: NREFIDX = 1 !! Number of refractive indices per element + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. ! Water vapor and cloud particles are convected in phase 1, while all other constituents ! are done in phase 2. @@ -82,7 +91,7 @@ module carma_model_mod !! !! @version May-2009 !! @author Chuck Bardeen - subroutine CARMA_DefineModel(carma, rc) + subroutine CARMAMODEL_DefineModel(carma, rc) type(carma_type), intent(inout) :: carma !! the carma object integer, intent(out) :: rc !! return code, negative indicates failure @@ -90,14 +99,14 @@ subroutine CARMA_DefineModel(carma, rc) real(kind=f), parameter :: RHO_DUST = 2.0_f ! density of dust particles (g/cm) real(kind=f), parameter :: rmin = 1e-5_f ! minimum radius (cm) real(kind=f), parameter :: vmrat = 2.0_f ! volume ratio - complex(kind=f) :: refidx(NWAVE) ! refractice indices + complex(kind=f) :: refidx(NWAVE, NREFIDX) ! refractice indices ! Default return code. rc = RC_OK ! Use the same refractive index at all wavelengths. This value is typical of dust in ! the visible. - refidx(:) = (1.55_f, 4e-3_f) + refidx(:,1) = (1.55_f, 4e-3_f) ! Define the Groups ! @@ -108,16 +117,16 @@ subroutine CARMA_DefineModel(carma, rc) ! should also be defined. call CARMAGROUP_Create(carma, 1, "Dust", rmin, vmrat, I_SPHERE, 1._f, .false., & rc, do_wetdep=.true., do_drydep=.true., solfac=0.15_f, & - scavcoef=0.1_f, shortname="DUST", refidx=refidx, do_mie=.true.) - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') + scavcoef=0.1_f, shortname="DUST", do_mie=.true.) + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddGroup failed.') ! Define the Elements ! ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names ! should be 6 characters or less and without spaces. - call CARMAELEMENT_Create(carma, 1, 1, "Dust", RHO_DUST, I_INVOLATILE, I_DUST, rc, shortname="DUST") - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + call CARMAELEMENT_Create(carma, 1, 1, "Dust", RHO_DUST, I_INVOLATILE, I_DUST, rc, shortname="DUST", refidx=refidx) + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddElement failed.') ! Define the Solutes @@ -128,10 +137,10 @@ subroutine CARMA_DefineModel(carma, rc) ! Define the Processes call CARMA_AddCoagulation(carma, 1, 1, 1, I_COLLEC_DATA, rc) - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddCoagulation failed.') return - end subroutine CARMA_DefineModel + end subroutine CARMAMODEL_DefineModel !! Defines all the CARMA components (groups, elements, solutes and gases) and process @@ -141,7 +150,7 @@ end subroutine CARMA_DefineModel !! @author Chuck Bardeen !! !! @see CARMASTATE_SetDetrain - subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & + subroutine CARMAMODEL_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & tnd_qsnow, tnd_nsnow) use camsrfexch, only: cam_in_t use physconst, only: latice, latvap, cpair @@ -166,14 +175,14 @@ subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, rc = RC_OK return - end subroutine CARMA_Detrain + end subroutine CARMAMODEL_Detrain !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. !! !! @version July-2009 !! @author Chuck Bardeen - subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) + subroutine CARMAMODEL_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) use time_manager, only: is_first_step implicit none @@ -199,14 +208,14 @@ subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, pr ! code to determine the mass in each bin from the CAM state. return - end subroutine CARMA_DiagnoseBins + end subroutine CARMAMODEL_DiagnoseBins !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. !! !! @version July-2009 !! @author Chuck Bardeen - subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & + subroutine CARMAMODEL_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) use camsrfexch, only: cam_out_t @@ -237,7 +246,7 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, ! code to determine the bulk mass from the CARMA state. return - end subroutine CARMA_DiagnoseBulk + end subroutine CARMAMODEL_DiagnoseBulk !! Calculates the emissions for CARMA aerosol particles. By default, there is no @@ -246,7 +255,7 @@ end subroutine CARMA_DiagnoseBulk !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, rc) + subroutine CARMAMODEL_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, pbuf, rc) use shr_kind_mod, only: r8 => shr_kind_r8 use ppgrid, only: pcols, pver use physics_types, only: physics_state @@ -265,6 +274,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend type(cam_in_t), intent(in) :: cam_in !! surface inputs real(r8), intent(out) :: tendency(pcols, pver) !! constituent tendency (kg/kg/s) real(r8), intent(out) :: surfaceFlux(pcols) !! constituent surface flux (kg/m^2/s) + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer integer, intent(out) :: rc !! return code, negative indicates failure integer :: ncol ! number of columns in chunk @@ -297,7 +307,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend tendency(:ncol, :pver) = 0.0_r8 return - end subroutine CARMA_EmitParticle + end subroutine CARMAMODEL_EmitParticle !! Allows the model to perform its own initialization in addition to what is done @@ -308,13 +318,14 @@ end subroutine CARMA_EmitParticle !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_InitializeModel(carma, lq_carma, rc) + subroutine CARMAMODEL_InitializeModel(carma, lq_carma, pbuf2d, rc) use constituents, only : pcnst implicit none type(carma_type), intent(in) :: carma !! the carma object logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent !! could have a CARMA tendency + type(physics_buffer_desc), pointer :: pbuf2d(:,:) integer, intent(out) :: rc !! return code, negative indicates failure ! Default return code. @@ -323,7 +334,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) ! Add initialization here. return - end subroutine CARMA_InitializeModel + end subroutine CARMAMODEL_InitializeModel !! Sets the initial condition for CARMA aerosol particles. By default, there are no @@ -335,7 +346,7 @@ end subroutine CARMA_InitializeModel !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) + subroutine CARMAMODEL_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) use shr_kind_mod, only: r8 => shr_kind_r8 use pmgrid, only: plev @@ -368,15 +379,55 @@ subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, end if return - end subroutine CARMA_InitializeParticle + end subroutine CARMAMODEL_InitializeParticle + + !! This routine is an extension of CARMA_CreateOpticsFile() that allows for + !! model specific tables to be created in addition to the model independent + !! methods that are in carma_intr.F90. + !! + !! The opticsType that is specified for the group determines how the optical + !! properties will be generated for that group. Each group can use a different + !! optics method if needed. Refractive indices need for these calculation are + !! are specified in the group's elements rather than at the group level. This + !! allows various mixing approaches to be used to determine the refractive index + !! for the particle as a whole. If the refractive index for water is needed, + !! it is specific the the CARMAGAS object for H2O. + subroutine CARMAMODEL_CreateOpticsFile(carma, igroup, opticsType, rc) + + implicit none + + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(in) :: igroup !! group identifier + integer, intent(in) :: opticsType !! optics type (see I_OPTICS_... in carma_enums.F90) + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Local variables + logical :: do_mie + integer :: cnsttype ! constituent type + + ! Assume success. + rc = 0 + + ! What type of calculation is needed for this group? + ! + ! NOTE: Some of these calculations generate optical properties as single mass + ! coefficients, while others are lookup tables designed around multiple + ! dimensions. + select case (opticsType) + case default + call endrun('carma_CreateOpticsFile:: Unknown optics type.') + end select + + return + end subroutine CARMAMODEL_CreateOpticsFile !! Called after wet deposition has been performed. Allows the specific model to add !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. !! !! @version July-2011 !! @author Chuck Bardeen - subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) + subroutine CARMAMODEL_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) use camsrfexch, only: cam_out_t implicit none @@ -395,6 +446,94 @@ subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) rc = RC_OK return - end subroutine CARMA_WetDeposition + end subroutine CARMAMODEL_WetDeposition + + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_CalculateCloudborneDiagnostics(carma, state, pbuf, aerclddiag, rc) + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(out) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the total cloudborne aerosols, supports up to MAXCLDAERDIAG different values + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_CalculateCloudborneDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputBudgetDiagnostics(carma, icnst4elem, icnst4gas, state, ptend, old_cflux, cflux, dt, pname, rc) + use cam_history, only: outfld + use constituents, only: pcnst, cnst_get_ind + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + integer, intent(in) :: icnst4gas(NGAS) !! constituent index for a carma gas + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + real(r8) :: old_cflux(pcols,pcnst) !! cam_in%clfux from before the timestep_tend + real(r8) :: cflux(pcols,pcnst) !! cam_in%clfux from after the timestep_tend + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputBudgetDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputCloudborneDiagnostics(carma, state, pbuf, dt, pname, oldaerclddiag, rc) + use cam_history, only: outfld + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + real(r8), intent(in ) :: oldaerclddiag(pcols,MAXCLDAERDIAG) !! the before timestep cloudborne aerosol diags + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputCloudborneDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputDiagnostics(carma, icnst4elem, state, ptend, pbuf, cam_in, rc) + use cam_history, only: outfld + use constituents, only: cnst_get_ind + use camsrfexch, only: cam_in_t + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + type(cam_in_t), intent(in) :: cam_in !! surface inputs + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputDiagnostics end module diff --git a/src/physics/carma/models/test_swelling/carma_model_mod.F90 b/src/physics/carma/models/test_swelling/carma_model_mod.F90 index ce55401475..0918106af0 100644 --- a/src/physics/carma/models/test_swelling/carma_model_mod.F90 +++ b/src/physics/carma/models/test_swelling/carma_model_mod.F90 @@ -43,14 +43,19 @@ module carma_model_mod private ! Declare the public methods. - public CARMA_DefineModel - public CARMA_Detrain - public CARMA_DiagnoseBins - public CARMA_DiagnoseBulk - public CARMA_EmitParticle - public CARMA_InitializeModel - public CARMA_InitializeParticle - public CARMA_WetDeposition + public CARMAMODEL_CalculateCloudborneDiagnostics + public CARMAMODEL_CreateOpticsFile + public CARMAMODEL_DefineModel + public CARMAMODEL_Detrain + public CARMAMODEL_DiagnoseBins + public CARMAMODEL_DiagnoseBulk + public CARMAMODEL_EmitParticle + public CARMAMODEL_InitializeModel + public CARMAMODEL_InitializeParticle + public CARMAMODEL_OutputBudgetDiagnostics + public CARMAMODEL_OutputCloudborneDiagnostics + public CARMAMODEL_OutputDiagnostics + public CARMAMODEL_WetDeposition ! Declare public constants integer, public, parameter :: NGROUP = 3 !! Number of particle groups @@ -63,6 +68,10 @@ module carma_model_mod integer, public, parameter :: NMIE_RH = 8 !! Number of relative humidities for mie calculations real(kind=f), public :: mie_rh(NMIE_RH) + integer, public, parameter :: NMIE_WTP = 0 !! Number of weight percents for mie calculations + real(kind=f), public :: mie_wtp(NMIE_WTP) + integer, public, parameter :: NREFIDX = 1 !! Number of refractive indices per element + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. ! Water vapor and cloud particles are convected in phase 1, while all other constituents ! are done in phase 2. @@ -80,7 +89,7 @@ module carma_model_mod !! !! @version May-2009 !! @author Chuck Bardeen - subroutine CARMA_DefineModel(carma, rc) + subroutine CARMAMODEL_DefineModel(carma, rc) type(carma_type), intent(inout) :: carma !! the carma object integer, intent(out) :: rc !! return code, negative indicates failure @@ -100,19 +109,19 @@ subroutine CARMA_DefineModel(carma, rc) call CARMAGROUP_Create(carma, 1, "None", rmin, vmrat, I_SPHERE, 1._f, .false., & rc, do_wetdep=.true., do_drydep=.true., solfac=0.3_f, & scavcoef=0.1_f, shortname="SALT") - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddGroup failed.') call CARMAGROUP_Create(carma, 2, "Fitzgerald", rmin, vmrat, I_SPHERE, 1._f, & .false., rc, do_wetdep=.true., do_drydep=.true., solfac=0.3_f, & scavcoef=0.1_f, shortname="SALTFZ", irhswell=I_FITZGERALD, & irhswcomp=I_SWF_NACL) - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddGroup failed.') call CARMAGROUP_Create(carma, 3, "Gerber", rmin, vmrat, I_SPHERE, 1._f, & .false., rc, do_wetdep=.true., do_drydep=.true., solfac=0.3_f, & scavcoef=0.1_f, shortname="SALTGB", irhswell=I_GERBER, & irhswcomp=I_SWG_SEA_SALT) - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddGroup failed.') ! Define the Elements @@ -120,13 +129,13 @@ subroutine CARMA_DefineModel(carma, rc) ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names ! should be 6 characters or less and without spaces. call CARMAELEMENT_Create(carma, 1, 1, "None", RHO_SALT, I_INVOLATILE, I_SEA_SALT, rc, shortname="SALT") - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddElement failed.') call CARMAELEMENT_Create(carma, 2, 2, "Fitz", RHO_SALT, I_INVOLATILE, I_SEA_SALT, rc, shortname="SALTFZ") - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddElement failed.') call CARMAELEMENT_Create(carma, 3, 3, "Gerb", RHO_SALT, I_INVOLATILE, I_SEA_SALT, rc, shortname="SALTGB") - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddElement failed.') ! Define the Solutes @@ -138,7 +147,7 @@ subroutine CARMA_DefineModel(carma, rc) ! Define the Processes return - end subroutine CARMA_DefineModel + end subroutine CARMAMODEL_DefineModel !! Defines all the CARMA components (groups, elements, solutes and gases) and process @@ -148,7 +157,7 @@ end subroutine CARMA_DefineModel !! @author Chuck Bardeen !! !! @see CARMASTATE_SetDetrain - subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & + subroutine CARMAMODEL_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & tnd_qsnow, tnd_nsnow) use camsrfexch, only: cam_in_t use physconst, only: latice, latvap, cpair @@ -173,14 +182,14 @@ subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, rc = RC_OK return - end subroutine CARMA_Detrain + end subroutine CARMAMODEL_Detrain !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. !! !! @version July-2009 !! @author Chuck Bardeen - subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) + subroutine CARMAMODEL_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) use time_manager, only: is_first_step implicit none @@ -206,14 +215,14 @@ subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, pr ! code to determine the mass in each bin from the CAM state. return - end subroutine CARMA_DiagnoseBins + end subroutine CARMAMODEL_DiagnoseBins !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. !! !! @version July-2009 !! @author Chuck Bardeen - subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & + subroutine CARMAMODEL_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) use camsrfexch, only: cam_out_t @@ -244,7 +253,7 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, ! code to determine the bulk mass from the CARMA state. return - end subroutine CARMA_DiagnoseBulk + end subroutine CARMAMODEL_DiagnoseBulk !! Calculates the emissions for CARMA aerosol particles. By default, there is no @@ -253,7 +262,7 @@ end subroutine CARMA_DiagnoseBulk !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, rc) + subroutine CARMAMODEL_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, pbuf, rc) use shr_kind_mod, only: r8 => shr_kind_r8 use ppgrid, only: pcols, pver use physics_types, only: physics_state @@ -272,6 +281,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend type(cam_in_t), intent(in) :: cam_in !! surface inputs real(r8), intent(out) :: tendency(pcols, pver) !! constituent tendency (kg/kg/s) real(r8), intent(out) :: surfaceFlux(pcols) !! constituent surface flux (kg/m^2/s) + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer integer, intent(out) :: rc !! return code, negative indicates failure integer :: ncol ! number of columns in chunk @@ -304,7 +314,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend tendency(:ncol, :pver) = 0.0_r8 return - end subroutine CARMA_EmitParticle + end subroutine CARMAMODEL_EmitParticle !! Allows the model to perform its own initialization in addition to what is done @@ -312,13 +322,14 @@ end subroutine CARMA_EmitParticle !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_InitializeModel(carma, lq_carma, rc) + subroutine CARMAMODEL_InitializeModel(carma, lq_carma, pbuf2d, rc) use constituents, only : pcnst implicit none type(carma_type), intent(in) :: carma !! the carma object logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent !! could have a CARMA tendency + type(physics_buffer_desc), pointer :: pbuf2d(:,:) integer, intent(out) :: rc !! return code, negative indicates failure ! Default return code. @@ -327,7 +338,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) ! Add initialization here. return - end subroutine CARMA_InitializeModel + end subroutine CARMAMODEL_InitializeModel !! Sets the initial condition for CARMA aerosol particles. By default, there are no @@ -339,7 +350,7 @@ end subroutine CARMA_InitializeModel !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) + subroutine CARMAMODEL_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) use shr_kind_mod, only: r8 => shr_kind_r8 use pmgrid, only: plev @@ -369,15 +380,55 @@ subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, end where return - end subroutine CARMA_InitializeParticle + end subroutine CARMAMODEL_InitializeParticle + + !! This routine is an extension of CARMA_CreateOpticsFile() that allows for + !! model specific tables to be created in addition to the model independent + !! methods that are in carma_intr.F90. + !! + !! The opticsType that is specified for the group determines how the optical + !! properties will be generated for that group. Each group can use a different + !! optics method if needed. Refractive indices need for these calculation are + !! are specified in the group's elements rather than at the group level. This + !! allows various mixing approaches to be used to determine the refractive index + !! for the particle as a whole. If the refractive index for water is needed, + !! it is specific the the CARMAGAS object for H2O. + subroutine CARMAMODEL_CreateOpticsFile(carma, igroup, opticsType, rc) + + implicit none + + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(in) :: igroup !! group identifier + integer, intent(in) :: opticsType !! optics type (see I_OPTICS_... in carma_enums.F90) + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Local variables + logical :: do_mie + integer :: cnsttype ! constituent type + + ! Assume success. + rc = 0 + + ! What type of calculation is needed for this group? + ! + ! NOTE: Some of these calculations generate optical properties as single mass + ! coefficients, while others are lookup tables designed around multiple + ! dimensions. + select case (opticsType) + case default + call endrun('carma_CreateOpticsFile:: Unknown optics type.') + end select + + return + end subroutine CARMAMODEL_CreateOpticsFile !! Called after wet deposition has been performed. Allows the specific model to add !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. !! !! @version July-2011 !! @author Chuck Bardeen - subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) + subroutine CARMAMODEL_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) use camsrfexch, only: cam_out_t implicit none @@ -396,6 +447,95 @@ subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) rc = RC_OK return - end subroutine CARMA_WetDeposition + end subroutine CARMAMODEL_WetDeposition + + + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_CalculateCloudborneDiagnostics(carma, state, pbuf, aerclddiag, rc) + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(out) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the total cloudborne aerosols, supports up to MAXCLDAERDIAG different values + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_CalculateCloudborneDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputBudgetDiagnostics(carma, icnst4elem, icnst4gas, state, ptend, old_cflux, cflux, dt, pname, rc) + use cam_history, only: outfld + use constituents, only: pcnst, cnst_get_ind + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + integer, intent(in) :: icnst4gas(NGAS) !! constituent index for a carma gas + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + real(r8) :: old_cflux(pcols,pcnst) !! cam_in%clfux from before the timestep_tend + real(r8) :: cflux(pcols,pcnst) !! cam_in%clfux from after the timestep_tend + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputBudgetDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputCloudborneDiagnostics(carma, state, pbuf, dt, pname, oldaerclddiag, rc) + use cam_history, only: outfld + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + real(r8), intent(in ) :: oldaerclddiag(pcols,MAXCLDAERDIAG) !! the before timestep cloudborne aerosol diags + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputCloudborneDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputDiagnostics(carma, icnst4elem, state, ptend, pbuf, cam_in, rc) + use cam_history, only: outfld + use constituents, only: cnst_get_ind + use camsrfexch, only: cam_in_t + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + type(cam_in_t), intent(in) :: cam_in !! surface inputs + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputDiagnostics end module diff --git a/src/physics/carma/models/test_tracers/carma_model_mod.F90 b/src/physics/carma/models/test_tracers/carma_model_mod.F90 index 9ed84a9471..f585b22921 100644 --- a/src/physics/carma/models/test_tracers/carma_model_mod.F90 +++ b/src/physics/carma/models/test_tracers/carma_model_mod.F90 @@ -49,14 +49,19 @@ module carma_model_mod private ! Declare the public methods. - public CARMA_DefineModel - public CARMA_Detrain - public CARMA_DiagnoseBins - public CARMA_DiagnoseBulk - public CARMA_EmitParticle - public CARMA_InitializeModel - public CARMA_InitializeParticle - public CARMA_WetDeposition + public CARMAMODEL_CalculateCloudborneDiagnostics + public CARMAMODEL_CreateOpticsFile + public CARMAMODEL_DefineModel + public CARMAMODEL_Detrain + public CARMAMODEL_DiagnoseBins + public CARMAMODEL_DiagnoseBulk + public CARMAMODEL_EmitParticle + public CARMAMODEL_InitializeModel + public CARMAMODEL_InitializeParticle + public CARMAMODEL_OutputBudgetDiagnostics + public CARMAMODEL_OutputCloudborneDiagnostics + public CARMAMODEL_OutputDiagnostics + public CARMAMODEL_WetDeposition ! Declare public constants integer, public, parameter :: NGROUP = 6 !! Number of particle groups @@ -69,6 +74,10 @@ module carma_model_mod integer, public, parameter :: NMIE_RH = 8 !! Number of relative humidities for mie calculations real(kind=f), public :: mie_rh(NMIE_RH) + integer, public, parameter :: NMIE_WTP = 0 !! Number of weight percents for mie calculations + real(kind=f), public :: mie_wtp(NMIE_WTP) + integer, public, parameter :: NREFIDX = 1 !! Number of refractive indices per element + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. ! Water vapor and cloud particles are convected in phase 1, while all other constituents ! are done in phase 2. @@ -98,7 +107,7 @@ module carma_model_mod !! !! @version May-2009 !! @author Chuck Bardeen - subroutine CARMA_DefineModel(carma, rc) + subroutine CARMAMODEL_DefineModel(carma, rc) type(carma_type), intent(inout) :: carma !! the carma object integer, intent(out) :: rc !! return code, negative indicates failure @@ -112,7 +121,7 @@ subroutine CARMA_DefineModel(carma, rc) rc = RC_OK call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_Get failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMA_Get failed.') ! Report model specific configuration parameters. if (masterproc) then @@ -132,22 +141,22 @@ subroutine CARMA_DefineModel(carma, rc) ! defined. If wetdep is defined, then the optional solubility factor ! should also be defined. call CARMAGROUP_Create(carma, 1, "Region 1", rmin, vmrat, I_SPHERE, 1._f, .True., rc, shortname="CRRG1") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAGROUP_Create failed.') call CARMAGROUP_Create(carma, 2, "Region 2", rmin, vmrat, I_SPHERE, 1._f, .True., rc, shortname="CRRG2") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAGROUP_Create failed.') call CARMAGROUP_Create(carma, 3, "Region 3", rmin, vmrat, I_SPHERE, 1._f, .True., rc, shortname="CRRG3") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAGROUP_Create failed.') call CARMAGROUP_Create(carma, 4, "Region 4", rmin, vmrat, I_SPHERE, 1._f, .True., rc, shortname="CRRG4") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAGROUP_Create failed.') call CARMAGROUP_Create(carma, 5, "Region 5", rmin, vmrat, I_SPHERE, 1._f, .True., rc, shortname="CRRG5") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAGROUP_Create failed.') call CARMAGROUP_Create(carma, 6, "Rest of World", rmin, vmrat, I_SPHERE, 1._f, .True., rc, shortname="CRRG6") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAGROUP_Create failed.') ! Define the Elements @@ -155,22 +164,22 @@ subroutine CARMA_DefineModel(carma, rc) ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names ! should be 6 characters or less and without spaces. call CARMAELEMENT_Create(carma, 1, 1, "Region 1", WTMOL_AIR, I_INVOLATILE, I_INERT, rc, shortname="CRRG1") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAElement_Create failed.') call CARMAELEMENT_Create(carma, 2, 2, "Region 2", WTMOL_AIR, I_INVOLATILE, I_INERT, rc, shortname="CRRG2") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAElement_Create failed.') call CARMAELEMENT_Create(carma, 3, 3, "Region 3", WTMOL_AIR, I_INVOLATILE, I_INERT, rc, shortname="CRRG3") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAElement_Create failed.') call CARMAELEMENT_Create(carma, 4, 4, "Region 4", WTMOL_AIR, I_INVOLATILE, I_INERT, rc, shortname="CRRG4") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAElement_Create failed.') call CARMAELEMENT_Create(carma, 5, 5, "Region 5", WTMOL_AIR, I_INVOLATILE, I_INERT, rc, shortname="CRRG5") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAElement_Create failed.') call CARMAELEMENT_Create(carma, 6, 6, "Rest of World", WTMOL_AIR, I_INVOLATILE, I_INERT, rc, shortname="CRRG6") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAElement_Create failed.') ! Define the Solutes @@ -183,7 +192,7 @@ subroutine CARMA_DefineModel(carma, rc) return - end subroutine CARMA_DefineModel + end subroutine CARMAMODEL_DefineModel !! Defines all the CARMA components (groups, elements, solutes and gases) and process @@ -193,7 +202,7 @@ end subroutine CARMA_DefineModel !! @author Chuck Bardeen !! !! @see CARMASTATE_SetDetrain - subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & + subroutine CARMAMODEL_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & tnd_qsnow, tnd_nsnow) use camsrfexch, only: cam_in_t use physconst, only: latice, latvap, cpair, cappa @@ -219,14 +228,14 @@ subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, rc = RC_OK return - end subroutine CARMA_Detrain + end subroutine CARMAMODEL_Detrain !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. !! !! @version July-2009 !! @author Chuck Bardeen - subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) + subroutine CARMAMODEL_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) use time_manager, only: is_first_step implicit none @@ -252,7 +261,7 @@ subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, pr ! code to determine the mass in each bin from the CAM state. return - end subroutine CARMA_DiagnoseBins + end subroutine CARMAMODEL_DiagnoseBins !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. @@ -262,7 +271,7 @@ end subroutine CARMA_DiagnoseBins !! !! @version July-2009 !! @author Chuck Bardeen - subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & + subroutine CARMAMODEL_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) use shr_kind_mod, only: r8 => shr_kind_r8 use ppgrid, only: pcols, pver @@ -325,7 +334,7 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, end if return - end subroutine CARMA_DiagnoseBulk + end subroutine CARMAMODEL_DiagnoseBulk !! Calculates the emissions for CARMA aerosol particles. @@ -352,7 +361,7 @@ end subroutine CARMA_DiagnoseBulk !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, rc) + subroutine CARMAMODEL_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, pbuf, rc) use shr_kind_mod, only: r8 => shr_kind_r8 use ppgrid, only: pcols, pver use physics_types, only: physics_state @@ -372,6 +381,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend type(cam_in_t), intent(in) :: cam_in !! surface inputs real(r8), intent(out) :: tendency(pcols, pver) !! constituent tendency (kg/kg/s) real(r8), intent(out) :: surfaceFlux(pcols) !! constituent surface flux (kg/m^2/s) + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer integer, intent(out) :: rc !! return code, negative indicates failure real(r8) :: lat(state%ncol) ! latitude (degrees) @@ -489,7 +499,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend end if return - end subroutine CARMA_EmitParticle + end subroutine CARMAMODEL_EmitParticle !! Allows the model to perform its own initialization in addition to what is done @@ -500,20 +510,22 @@ end subroutine CARMA_EmitParticle !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_InitializeModel(carma, lq_carma, rc) + subroutine CARMAMODEL_InitializeModel(carma, lq_carma, pbuf2d, rc) use constituents, only : pcnst + implicit none type(carma_type), intent(inout) :: carma !! the carma object logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent !! could have a CARMA tendency + type(physics_buffer_desc), pointer :: pbuf2d(:,:) integer, intent(out) :: rc !! return code, negative indicates failure ! Default return code. rc = RC_OK return - end subroutine CARMA_InitializeModel + end subroutine CARMAMODEL_InitializeModel !! Sets the initial condition for CARMA aerosol particles. By default, there are no @@ -525,7 +537,7 @@ end subroutine CARMA_InitializeModel !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) + subroutine CARMAMODEL_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) use shr_kind_mod, only: r8 => shr_kind_r8 implicit none @@ -552,15 +564,55 @@ subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, end do return - end subroutine CARMA_InitializeParticle + end subroutine CARMAMODEL_InitializeParticle + + !! This routine is an extension of CARMA_CreateOpticsFile() that allows for + !! model specific tables to be created in addition to the model independent + !! methods that are in carma_intr.F90. + !! + !! The opticsType that is specified for the group determines how the optical + !! properties will be generated for that group. Each group can use a different + !! optics method if needed. Refractive indices need for these calculation are + !! are specified in the group's elements rather than at the group level. This + !! allows various mixing approaches to be used to determine the refractive index + !! for the particle as a whole. If the refractive index for water is needed, + !! it is specific the the CARMAGAS object for H2O. + subroutine CARMAMODEL_CreateOpticsFile(carma, igroup, opticsType, rc) + + implicit none + + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(in) :: igroup !! group identifier + integer, intent(in) :: opticsType !! optics type (see I_OPTICS_... in carma_enums.F90) + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Local variables + logical :: do_mie + integer :: cnsttype ! constituent type + + ! Assume success. + rc = 0 + + ! What type of calculation is needed for this group? + ! + ! NOTE: Some of these calculations generate optical properties as single mass + ! coefficients, while others are lookup tables designed around multiple + ! dimensions. + select case (opticsType) + case default + call endrun('carma_CreateOpticsFile:: Unknown optics type.') + end select + + return + end subroutine CARMAMODEL_CreateOpticsFile !! Called after wet deposition has been performed. Allows the specific model to add !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. !! !! @version July-2011 !! @author Chuck Bardeen - subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) + subroutine CARMAMODEL_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) use camsrfexch, only: cam_out_t implicit none @@ -579,6 +631,93 @@ subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) rc = RC_OK return - end subroutine CARMA_WetDeposition + end subroutine CARMAMODEL_WetDeposition + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_CalculateCloudborneDiagnostics(carma, state, pbuf, aerclddiag, rc) + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(out) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the total cloudborne aerosols, supports up to MAXCLDAERDIAG different values + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_CalculateCloudborneDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputBudgetDiagnostics(carma, icnst4elem, icnst4gas, state, ptend, old_cflux, cflux, dt, pname, rc) + use cam_history, only: outfld + use constituents, only: pcnst, cnst_get_ind + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + integer, intent(in) :: icnst4gas(NGAS) !! constituent index for a carma gas + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + real(r8) :: old_cflux(pcols,pcnst) !! cam_in%clfux from before the timestep_tend + real(r8) :: cflux(pcols,pcnst) !! cam_in%clfux from after the timestep_tend + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputBudgetDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputCloudborneDiagnostics(carma, state, pbuf, dt, pname, oldaerclddiag, rc) + use cam_history, only: outfld + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + real(r8), intent(in ) :: oldaerclddiag(pcols,MAXCLDAERDIAG) !! the before timestep cloudborne aerosol diags + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputCloudborneDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputDiagnostics(carma, icnst4elem, state, ptend, pbuf, cam_in, rc) + use cam_history, only: outfld + use constituents, only: cnst_get_ind + use camsrfexch, only: cam_in_t + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + type(cam_in_t), intent(in) :: cam_in !! surface inputs + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputDiagnostics end module diff --git a/src/physics/carma/models/test_tracers2/carma_model_mod.F90 b/src/physics/carma/models/test_tracers2/carma_model_mod.F90 index ecb3324ed8..9eaf4d6cb7 100644 --- a/src/physics/carma/models/test_tracers2/carma_model_mod.F90 +++ b/src/physics/carma/models/test_tracers2/carma_model_mod.F90 @@ -49,14 +49,19 @@ module carma_model_mod private ! Declare the public methods. - public CARMA_DefineModel - public CARMA_Detrain - public CARMA_DiagnoseBins - public CARMA_DiagnoseBulk - public CARMA_EmitParticle - public CARMA_InitializeModel - public CARMA_InitializeParticle - public CARMA_WetDeposition + public CARMAMODEL_CalculateCloudborneDiagnostics + public CARMAMODEL_CreateOpticsFile + public CARMAMODEL_DefineModel + public CARMAMODEL_Detrain + public CARMAMODEL_DiagnoseBins + public CARMAMODEL_DiagnoseBulk + public CARMAMODEL_EmitParticle + public CARMAMODEL_InitializeModel + public CARMAMODEL_InitializeParticle + public CARMAMODEL_OutputBudgetDiagnostics + public CARMAMODEL_OutputCloudborneDiagnostics + public CARMAMODEL_OutputDiagnostics + public CARMAMODEL_WetDeposition ! Declare public constants integer, public, parameter :: NGROUP = 7 !! Number of particle groups @@ -69,6 +74,10 @@ module carma_model_mod integer, public, parameter :: NMIE_RH = 8 !! Number of relative humidities for mie calculations real(kind=f), public :: mie_rh(NMIE_RH) + integer, public, parameter :: NMIE_WTP = 0 !! Number of weight percents for mie calculations + real(kind=f), public :: mie_wtp(NMIE_WTP) + integer, public, parameter :: NREFIDX = 1 !! Number of refractive indices per element + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. ! Water vapor and cloud particles are convected in phase 1, while all other constituents ! are done in phase 2. @@ -99,7 +108,7 @@ module carma_model_mod !! !! @version May-2009 !! @author Chuck Bardeen - subroutine CARMA_DefineModel(carma, rc) + subroutine CARMAMODEL_DefineModel(carma, rc) type(carma_type), intent(inout) :: carma !! the carma object integer, intent(out) :: rc !! return code, negative indicates failure @@ -113,7 +122,7 @@ subroutine CARMA_DefineModel(carma, rc) rc = RC_OK call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_Get failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMA_Get failed.') ! Report model specific configuration parameters. if (masterproc) then @@ -133,25 +142,25 @@ subroutine CARMA_DefineModel(carma, rc) ! defined. If wetdep is defined, then the optional solubility factor ! should also be defined. call CARMAGROUP_Create(carma, 1, "Region 1", rmin, vmrat, I_SPHERE, 1._f, .True., rc, shortname="CRRG1") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAGROUP_Create failed.') call CARMAGROUP_Create(carma, 2, "Region 2", rmin, vmrat, I_SPHERE, 1._f, .True., rc, shortname="CRRG2") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAGROUP_Create failed.') call CARMAGROUP_Create(carma, 3, "Region 3", rmin, vmrat, I_SPHERE, 1._f, .True., rc, shortname="CRRG3") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAGROUP_Create failed.') call CARMAGROUP_Create(carma, 4, "Region 4", rmin, vmrat, I_SPHERE, 1._f, .True., rc, shortname="CRRG4") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAGROUP_Create failed.') call CARMAGROUP_Create(carma, 5, "Region 5", rmin, vmrat, I_SPHERE, 1._f, .True., rc, shortname="CRRG5") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAGROUP_Create failed.') call CARMAGROUP_Create(carma, 6, "Region 6", rmin, vmrat, I_SPHERE, 1._f, .True., rc, shortname="CRRG6") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAGROUP_Create failed.') call CARMAGROUP_Create(carma, 7, "Rest of World", rmin, vmrat, I_SPHERE, 1._f, .True., rc, shortname="CRRG7") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAGROUP_Create failed.') ! Define the Elements @@ -159,25 +168,25 @@ subroutine CARMA_DefineModel(carma, rc) ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names ! should be 6 characters or less and without spaces. call CARMAELEMENT_Create(carma, 1, 1, "Region 1", WTMOL_AIR, I_INVOLATILE, I_INERT, rc, shortname="CRRG1") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAElement_Create failed.') call CARMAELEMENT_Create(carma, 2, 2, "Region 2", WTMOL_AIR, I_INVOLATILE, I_INERT, rc, shortname="CRRG2") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAElement_Create failed.') call CARMAELEMENT_Create(carma, 3, 3, "Region 3", WTMOL_AIR, I_INVOLATILE, I_INERT, rc, shortname="CRRG3") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAElement_Create failed.') call CARMAELEMENT_Create(carma, 4, 4, "Region 4", WTMOL_AIR, I_INVOLATILE, I_INERT, rc, shortname="CRRG4") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAElement_Create failed.') call CARMAELEMENT_Create(carma, 5, 5, "Region 5", WTMOL_AIR, I_INVOLATILE, I_INERT, rc, shortname="CRRG5") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAElement_Create failed.') call CARMAELEMENT_Create(carma, 6, 6, "Region 6", WTMOL_AIR, I_INVOLATILE, I_INERT, rc, shortname="CRRG6") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAElement_Create failed.') call CARMAELEMENT_Create(carma, 7, 7, "Rest of World", WTMOL_AIR, I_INVOLATILE, I_INERT, rc, shortname="CRRG7") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAElement_Create failed.') ! Define the Solutes @@ -190,7 +199,7 @@ subroutine CARMA_DefineModel(carma, rc) return - end subroutine CARMA_DefineModel + end subroutine CARMAMODEL_DefineModel !! Defines all the CARMA components (groups, elements, solutes and gases) and process @@ -200,7 +209,7 @@ end subroutine CARMA_DefineModel !! @author Chuck Bardeen !! !! @see CARMASTATE_SetDetrain - subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & + subroutine CARMAMODEL_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & tnd_qsnow, tnd_nsnow) use camsrfexch, only: cam_in_t use physconst, only: latice, latvap, cpair, cappa @@ -226,14 +235,14 @@ subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, rc = RC_OK return - end subroutine CARMA_Detrain + end subroutine CARMAMODEL_Detrain !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. !! !! @version July-2009 !! @author Chuck Bardeen - subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) + subroutine CARMAMODEL_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) use time_manager, only: is_first_step implicit none @@ -259,7 +268,7 @@ subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, pr ! code to determine the mass in each bin from the CAM state. return - end subroutine CARMA_DiagnoseBins + end subroutine CARMAMODEL_DiagnoseBins !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. @@ -269,7 +278,7 @@ end subroutine CARMA_DiagnoseBins !! !! @version July-2009 !! @author Chuck Bardeen - subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & + subroutine CARMAMODEL_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) use shr_kind_mod, only: r8 => shr_kind_r8 use ppgrid, only: pcols, pver @@ -332,7 +341,7 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, end if return - end subroutine CARMA_DiagnoseBulk + end subroutine CARMAMODEL_DiagnoseBulk !! Calculates the emissions for CARMA aerosol particles. @@ -359,7 +368,7 @@ end subroutine CARMA_DiagnoseBulk !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, rc) + subroutine CARMAMODEL_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, pbuf, rc) use shr_kind_mod, only: r8 => shr_kind_r8 use ppgrid, only: pcols, pver use physics_types, only: physics_state @@ -379,6 +388,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend type(cam_in_t), intent(in) :: cam_in !! surface inputs real(r8), intent(out) :: tendency(pcols, pver) !! constituent tendency (kg/kg/s) real(r8), intent(out) :: surfaceFlux(pcols) !! constituent surface flux (kg/m^2/s) + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer integer, intent(out) :: rc !! return code, negative indicates failure real(r8) :: lat(state%ncol) ! latitude (degrees) @@ -497,7 +507,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend end if return - end subroutine CARMA_EmitParticle + end subroutine CARMAMODEL_EmitParticle !! Allows the model to perform its own initialization in addition to what is done @@ -508,20 +518,21 @@ end subroutine CARMA_EmitParticle !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_InitializeModel(carma, lq_carma, rc) + subroutine CARMAMODEL_InitializeModel(carma, lq_carma, pbuf2d, rc) use constituents, only : pcnst implicit none type(carma_type), intent(inout) :: carma !! the carma object logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent !! could have a CARMA tendency + type(physics_buffer_desc), pointer :: pbuf2d(:,:) integer, intent(out) :: rc !! return code, negative indicates failure ! Default return code. rc = RC_OK return - end subroutine CARMA_InitializeModel + end subroutine CARMAMODEL_InitializeModel !! Sets the initial condition for CARMA aerosol particles. By default, there are no @@ -533,7 +544,7 @@ end subroutine CARMA_InitializeModel !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) + subroutine CARMAMODEL_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) use shr_kind_mod, only: r8 => shr_kind_r8 implicit none @@ -560,15 +571,55 @@ subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, end do return - end subroutine CARMA_InitializeParticle + end subroutine CARMAMODEL_InitializeParticle + + !! This routine is an extension of CARMA_CreateOpticsFile() that allows for + !! model specific tables to be created in addition to the model independent + !! methods that are in carma_intr.F90. + !! + !! The opticsType that is specified for the group determines how the optical + !! properties will be generated for that group. Each group can use a different + !! optics method if needed. Refractive indices need for these calculation are + !! are specified in the group's elements rather than at the group level. This + !! allows various mixing approaches to be used to determine the refractive index + !! for the particle as a whole. If the refractive index for water is needed, + !! it is specific the the CARMAGAS object for H2O. + subroutine CARMAMODEL_CreateOpticsFile(carma, igroup, opticsType, rc) + + implicit none + + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(in) :: igroup !! group identifier + integer, intent(in) :: opticsType !! optics type (see I_OPTICS_... in carma_enums.F90) + integer, intent(out) :: rc !! return code, negative indicates failure + ! Local variables + logical :: do_mie + integer :: cnsttype ! constituent type + + ! Assume success. + rc = 0 + + ! What type of calculation is needed for this group? + ! + ! NOTE: Some of these calculations generate optical properties as single mass + ! coefficients, while others are lookup tables designed around multiple + ! dimensions. + select case (opticsType) + + case default + call endrun('carma_CreateOpticsFile:: Unknown optics type.') + end select + + return + end subroutine CARMAMODEL_CreateOpticsFile !! Called after wet deposition has been performed. Allows the specific model to add !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. !! !! @version July-2011 !! @author Chuck Bardeen - subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) + subroutine CARMAMODEL_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) use camsrfexch, only: cam_out_t implicit none @@ -587,6 +638,94 @@ subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) rc = RC_OK return - end subroutine CARMA_WetDeposition + end subroutine CARMAMODEL_WetDeposition + + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_CalculateCloudborneDiagnostics(carma, state, pbuf, aerclddiag, rc) + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(out) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the total cloudborne aerosols, supports up to MAXCLDAERDIAG different values + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_CalculateCloudborneDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputBudgetDiagnostics(carma, icnst4elem, icnst4gas, state, ptend, old_cflux, cflux, dt, pname, rc) + use cam_history, only: outfld + use constituents, only: pcnst, cnst_get_ind + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + integer, intent(in) :: icnst4gas(NGAS) !! constituent index for a carma gas + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + real(r8) :: old_cflux(pcols,pcnst) !! cam_in%clfux from before the timestep_tend + real(r8) :: cflux(pcols,pcnst) !! cam_in%clfux from after the timestep_tend + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputBudgetDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputCloudborneDiagnostics(carma, state, pbuf, dt, pname, oldaerclddiag, rc) + use cam_history, only: outfld + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + real(r8), intent(in ) :: oldaerclddiag(pcols,MAXCLDAERDIAG) !! the before timestep cloudborne aerosol diags + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputCloudborneDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputDiagnostics(carma, icnst4elem, state, ptend, pbuf, cam_in, rc) + use cam_history, only: outfld + use constituents, only: cnst_get_ind + use camsrfexch, only: cam_in_t + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + type(cam_in_t), intent(in) :: cam_in !! surface inputs + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputDiagnostics end module diff --git a/src/physics/carma/models/trop_strat_soa1/carma_model_flags_mod.F90 b/src/physics/carma/models/trop_strat_soa1/carma_model_flags_mod.F90 new file mode 100644 index 0000000000..be4ca3c490 --- /dev/null +++ b/src/physics/carma/models/trop_strat_soa1/carma_model_flags_mod.F90 @@ -0,0 +1,113 @@ +!! This module handles reading the namelist and provides access to some other flags +!! that control a specific CARMA model's behavior. +!! +!! By default the specific CARMA model does not have any unique namelist values. If +!! a CARMA model wishes to have its own namelist, then this file needs to be copied +!! from physics/cam to physics/model/<model_name> and the code needed to read in the +!! namelist values added there. This file will take the place of the one in +!! physics/cam. +!! +!! It needs to be in its own file to resolve some circular dependencies. +!! +!! @author Chuck Bardeen +!! @version Mar-2011 +module carma_model_flags_mod + + use shr_kind_mod, only: r8 => shr_kind_r8 + use spmd_utils, only: masterproc + + ! Flags for integration with CAM Microphysics + public carma_model_readnl ! read the carma model namelist + + + ! Namelist flags + ! + ! Create a public definition of any new namelist variables that you wish to have, + ! and default them to an inital value. + + ! name of the dust erosion factor file + logical, public, protected :: carma_do_WeibullK = .false. ! if .true. then use calculated Weibull K, [Monahan, 2006] + character(len=32), public, protected :: carma_seasalt_emis = 'Gong' ! the source function scheme, either "Gong", "Martensson", + ! "Clarke", "Caffrey", "CMS", "CONST", or "NONE" + character(len=32), public, protected :: carma_BCOCemissions = 'Yu2015' + character(len=32), public, protected :: carma_SO4elevemis = 'NONE' + character(len=256), public, protected :: carma_soilerosion_file = 'NONE' + character(len=256), public, protected :: BC_GAINS_filename = 'NONE' + character(len=256), public, protected :: OC_GAINS_filename = 'NONE' + character(len=256), public, protected :: BC_ship_filename = 'NONE' + character(len=256), public, protected :: OC_ship_filename = 'NONE' + character(len=256), public, protected :: BC_GFEDv3_filename = 'NONE' + character(len=256), public, protected :: OC_GFEDv3_filename = 'NONE' + real(r8), public, protected :: carma_dustemisfactor = 0.5e-9_r8 + +contains + + + !! Read the CARMA model runtime options from the namelist + !! + !! @author Chuck Bardeen + !! @version Mar-2011 + subroutine carma_model_readnl(nlfile) + + ! Read carma namelist group. + + use cam_abortutils, only: endrun + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + + ! args + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! local vars + + integer :: unitn, ierr + + ! read namelist for CARMA + namelist /carma_model_nl/ & + carma_do_WeibullK, & + carma_seasalt_emis, & + carma_BCOCemissions, & + carma_SO4elevemis, & + carma_soilerosion_file, & + BC_GAINS_filename, & + OC_GAINS_filename, & + BC_ship_filename, & + OC_ship_filename, & + BC_GFEDv3_filename, & + OC_GFEDv3_filename, & + carma_dustemisfactor + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'carma_model_nl', status=ierr) + if (ierr == 0) then + read(unitn, carma_model_nl, iostat=ierr) + if (ierr /= 0) then + call endrun('carma_model_readnl: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + call mpibcast(carma_soilerosion_file, len(carma_soilerosion_file), mpichar, 0, mpicom) + call mpibcast(carma_do_WeibullK, 1, mpilog, 0, mpicom) + call mpibcast(carma_seasalt_emis, len(carma_seasalt_emis), mpichar, 0, mpicom) + call mpibcast(carma_BCOCemissions,len(carma_BCOCemissions), mpichar, 0, mpicom) + call mpibcast(carma_SO4elevemis, len(carma_SO4elevemis), mpichar, 0, mpicom) + call mpibcast(BC_GAINS_filename, len(BC_GAINS_filename), mpichar, 0, mpicom) + call mpibcast(OC_GAINS_filename, len(OC_GAINS_filename), mpichar, 0, mpicom) + call mpibcast(BC_ship_filename, len(BC_ship_filename), mpichar, 0, mpicom) + call mpibcast(OC_ship_filename, len(OC_ship_filename), mpichar, 0, mpicom) + call mpibcast(BC_GFEDv3_filename, len(BC_GFEDv3_filename), mpichar, 0, mpicom) + call mpibcast(OC_GFEDv3_filename, len(OC_GFEDv3_filename), mpichar, 0, mpicom) + call mpibcast(carma_dustemisfactor,1, mpir8, 0,mpicom) +#endif + + end subroutine carma_model_readnl + +end module carma_model_flags_mod diff --git a/src/physics/carma/models/trop_strat_soa1/carma_model_mod.F90 b/src/physics/carma/models/trop_strat_soa1/carma_model_mod.F90 new file mode 100644 index 0000000000..ad8967f688 --- /dev/null +++ b/src/physics/carma/models/trop_strat_soa1/carma_model_mod.F90 @@ -0,0 +1,4501 @@ +!! This CARMA model is for dust aerosols and is based upon Su & Toon, JGR, 2009; +!! Su & Toon, ACP 2011. +!! +!! These dust are not currently radiatively active and do not replace the dust +!! in CAM; however, this is something that could be done in the future. +!! +!! This module defines several constants needed by CARMA, extends a couple of CARMA +!! interface methods: +!! +!! - CARMA_DefineModel() +!! - CARMA_EmitParticle() +!! +!! and adds some local functions used to do sea salt emission: +!! +!! - CARMA_SurfaceWind() +!! - WeibullWind() +!! +!! @version April-2020 +!! @author Simone Tilmes, Lin Su, Pengfei Yu, Chuck Bardeen +!! changes to pervious version: rename PURSULF to PRSULF to be easier read in in CAM +!! Simone Tilmes Aug5 2023: add Ilaria's diagnostic changes + +module carma_model_mod + + use carma_precision_mod + use carma_enums_mod + use carma_constants_mod + use carma_types_mod + use carmaelement_mod + use carmagas_mod + use carmagroup_mod + use carmasolute_mod + use carmastate_mod + use carma_mod + use carma_flags_mod + use carma_model_flags_mod + + use spmd_utils, only: masterproc + use shr_kind_mod, only: r8 => shr_kind_r8 + use cam_abortutils, only: endrun + use physics_types, only: physics_state, physics_ptend + use ppgrid, only: pcols, pver + use physics_buffer, only: physics_buffer_desc, pbuf_set_field, pbuf_get_field, pbuf_get_index + use time_manager, only: is_first_step + use cam_logfile, only: iulog + + implicit none + + private + + ! Declare the public methods. + public CARMAMODEL_CalculateCloudborneDiagnostics + public CARMAMODEL_CreateOpticsFile + public CARMAMODEL_DefineModel + public CARMAMODEL_Detrain + public CARMAMODEL_DiagnoseBins + public CARMAMODEL_DiagnoseBulk + public CARMAMODEL_EmitParticle + public CARMAMODEL_InitializeModel + public CARMAMODEL_InitializeParticle + public CARMAMODEL_OutputBudgetDiagnostics + public CARMAMODEL_OutputCloudborneDiagnostics + public CARMAMODEL_OutputDiagnostics + public CARMAMODEL_WetDeposition + + ! Declare public constants + integer, public, parameter :: NGROUP = 2 !! Number of particle groups + integer, public, parameter :: NELEM = 7 !! Number of particle elements + integer, public, parameter :: NBIN = 20 !! Number of particle bins + integer, public, parameter :: NSOLUTE = 0 !! Number of particle solutes + integer, public, parameter :: NGAS = 2 !! Number of gases + + ! NOTE: This is for now, when Pengfei has only defined sulfates at one weight percent. In the future, + ! we may want to expand this to match NMIE_WTP and/or NMIE_RH + integer, public, parameter :: NREFIDX = 1 !! Number of refractive indices per element + + ! These need to be defined, but are only used when the particles are radiatively active. + integer, public, parameter :: NMIE_RH = 10 !! Number of relative humidities for mie calculations + real(kind=f), public, parameter :: mie_rh(NMIE_RH) = (/ 0.1_f, 0.3_f, 0.5_f, 0.7_f, 0.8_f, 0.85_f, & + 0.9_f, 0.92_f, 0.93_f, 0.95_f /) + integer, public, parameter :: NMIE_WTP = 13 !! Number of weight percents for mie calculations + real(kind=f), public , parameter :: mie_wtp(NMIE_WTP) = (/ 0.1_f, 0.3_f, 0.5_f, 0.7_f, 0.8_f, 0.83_f, & + 0.86_f, 0.9_f, 0.92_f, 0.94_f, 0.96_f, 0.98_f, 1._f/) + + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. + ! Water vapor and cloud particles are convected in phase 1, while all other constituents + ! are done in phase 2. + logical, public :: is_convtran1(NGROUP) = .false. !! Should the group be transported in the first phase? + + ! Define any particle compositions that are used. Each composition type + ! should have a unique number. + integer, public, parameter :: I_H2SO4 = 1 !! H2SO4 coposition + integer, public, parameter :: I_OC = 2 !! OC composition + integer, public, parameter :: I_SOA = 3 !! SOA composition + integer, public, parameter :: I_BC = 4 !! BC composition + integer, public, parameter :: I_DUST = 5 !! dust composition + integer, public, parameter :: I_SALT = 6 !! sea salt composition + + integer, public, parameter :: I_GRP_PRSUL = 1 !! sulfate aerosol + integer, public, parameter :: I_GRP_MXAER = 2 !! mixed aerosol + + integer, public, parameter :: I_ELEM_PRSUL = 1 !! sulfate aerosol; nameing needs to only have 2 charaters before the element name to work with + !! partsof the code reading different elements + integer, public, parameter :: I_ELEM_MXAER = 2 !! aerosol + integer, public, parameter :: I_ELEM_MXOC = 3 !! organics aerosol + integer, public, parameter :: I_ELEM_MXSOA = 4 !! secondary organic aerosol + integer, public, parameter :: I_ELEM_MXBC = 5 !! black carbon + integer, public, parameter :: I_ELEM_MXDUST = 6 !! dust aerosol + integer, public, parameter :: I_ELEM_MXSALT = 7 !! sea salt aerosol + + integer, public, parameter :: I_GAS_H2O = 1 !! water vapor + integer, public, parameter :: I_GAS_H2SO4 = 2 !! sulphuric acid + + real(kind=f), public, parameter :: Kappa_OC = 0.5_f !! hygroscopicity of OC + real(kind=f), public, parameter :: Kappa_SOA = 0.5_f !! hygroscopicity of SOA + real(kind=f), public, parameter :: Kappa_BC = 0.1_f + real(kind=f), public, parameter :: Kappa_DUST = 0.2_f + real(kind=f), public, parameter :: Kappa_SALT = 1.0_f + real(kind=f), public, parameter :: Kappa_SULF = 0.5_f + + real(kind=f), public, parameter :: RHO_obc = 1.35_f !! dry density of smoke aerosol + real(kind=f), public, parameter :: RHO_DUST = 2.65_f !! dry density of dust particles (g/cm^3) -Lin Su + real(kind=f), public, parameter :: RHO_SALT = 2.65_f !! dry density of sea salt particles (g/cm) + real(kind=f), public, parameter :: RHO_SULFATE = 1.923_f !! dry density of sulfate particles (g/cm3) + + ! see CARMA_SmokeEmissionRead +! real(kind=f), allocatable, dimension(:,:) :: Chla ! Chlorophy11 data (mg/m3) + real(r8), allocatable, dimension(:,:,:) :: BCnew ! #/cm2/s + real(r8), allocatable, dimension(:,:,:) :: OCnew + + + ! for sea salt flux calculation + real(r8), parameter :: uth_salt = 4._r8 !! threshold wind velocity + + + ! for dust calculation + real(kind=f), parameter :: rClay = 1e-4_f !! silt/clay particle radius boundary (cm) + + integer :: nClay !! Number of clay bins (r < 1 um) + integer :: nSilt !! Number of silt bins + real(kind=f) :: clay_mf(NBIN)=-huge(1._f) !! clay mass fraction (fraction) + real(kind=f), allocatable, dimension(:,:) :: soil_factor !! Soil Erosion Factor (fraction) + real(kind=f), public, parameter :: WTMOL_H2SO4 = 98.078479_f !! molecular weight of sulphuric acid + +! NOTE: The WeibullK distribution is not currently supported, since the coefficients are not +! generated. This can be added later. +! real(r8), allocatable, dimension(:,:) :: Weibull_k ! Weibull K(nlat,nlon + real(kind=f), public, parameter :: rmin_PRSUL = 3.43e-8_f ! minimum radius (cm) + real(kind=f), public, parameter :: vmrat_PRSUL = 3.67_f ! volume ratio + real(kind=f), public, parameter :: rmin_MXAER = 5e-6_f ! minimum radius (cm) + real(kind=f), public, parameter :: vmrat_MXAER = 2.2588_f !2.4610_f ! volume ratio + +! Physics buffer index for sulfate surface area density + integer :: ipbuf4soa(NBIN) = -1 + integer :: ipbuf4soacm(NBIN) = -1 + integer :: ipbuf4soapt(NBIN) = -1 + integer :: ipbuf4jno2 = -1 + real(kind=f) :: aeronet_fraction(NBIN) !! fraction of BC dV/dlnr in each bin (100%) + real(kind=f) :: so4inj_dist(NBIN) !! SO4 injection distribution across bins using a log normal distr. using r=0.95 and sigma =1.5 + real(kind=f) :: so4inj_dist1(NBIN) !! SO4 injection distribution across bins using a log normal distr. using r=0.95 and sigma =1.5 + + integer :: bc_srfemis_ndx=-1, oc_srfemis_ndx=-1 + integer :: so4_elevemis_ndx=-1 + integer :: carma_dustmap(NBIN) !! mapping of the CARMA dust bins to the surface dust bins. + + ! define refractive indices dependon composition and wavelength + ! + ! NOTE: It would be better to read this out of files, but this is how Pengfei set it up, so we + ! will use this for now. + ! + ! NOTE: Rather than using the values from Pengfei for the sulfate, use the values from MAM. They + ! have more precision and differ in the imaginary part below 2 um where Pengfei's are truncated at 0. + ! The MAM values are consistent with OPAC and truncate at 1e-8. + !real(kind=f), public :: shellreal(NWAVE) = (/1.890_f,1.913_f,1.932_f,1.568_f,1.678_f,1.758_f,1.855_f,1.597_f,1.147_f,1.261_f,& + ! 1.424_f,1.352_f,1.379_f,1.385_f,1.385_f,1.367_f,& + ! 1.367_f,1.315_f,1.358_f,1.380_f,1.393_f,1.405_f,1.412_f,1.422_f,1.428_f,1.430_f,& + ! 1.422_f,1.468_f,1.484_f,1.164_f/) + ! + !real(kind=f), public :: shellimag(NWAVE) = (/0.220_f,0.152_f,0.085_f,0.223_f,0.195_f,0.441_f,0.696_f,0.695_f,0.459_f,0.161_f,& + ! 0.172_f,0.144_f,0.120_f,0.122_f,0.126_f,0.158_f,& + ! 0.158_f,0.057_f,0.003_f,0.001_f,0.001_f,0.000_f,0.000_f,0.000_f,0.000_f,0.000_f,& + ! 0.000_f,0.000_f,0.000_f,0.551_f/) + + real(kind=f), public, parameter :: shellreal(NWAVE) = (/ 1.89_f, 1.912857_f, 1.932063_f, 1.586032_f, & + 1.677979_f, 1.757825_f, 1.855336_f, 1.596767_f, 1.146559_f, 1.261314_f, 1.424219_f, & + 1.351645_f, 1.378697_f, 1.385_f, 1.385_f, 1.366909_f, 1.366909_f, 1.314577_f, & + 1.357978_f, 1.380309_f, 1.392645_f, 1.404506_f, 1.412181_f, 1.421632_f, & + 1.427968_f, 1.430335_f, 1.441641_f, 1.467642_f, 1.484_f, 1.164128_f /) + + real(kind=f), public, parameter :: shellimag(NWAVE) = (/ 0.22_f, 0.15185711_f, 0.08457167_f, 0.22250789_f, 0.19499999_f, & + 0.44068847_f, 0.69594361_f, 0.69466153_f, 0.45876573_f, 0.16060575_f, & + 0.1715766_f , 0.14352135_f, 0.12025213_f, 0.12222873_f, 0.12581848_f, 0.15793008_f, & + 1.57930076e-01_f, 5.66869128e-02_f, 2.88634387e-03_f, 1.49071286e-03_f, & + 5.30385233e-04_f, 1.02977119e-04_f, 1.61967358e-05_f, 1.75122678e-06_f, & + 2.21435655e-08_f, 9.99999994e-09_f, 9.99999994e-09_f, 9.99999994e-09_f, & + 9.99999994e-09_f, 5.51133746e-01_f /) + + real(kind=f), public, parameter :: corerealdst(NWAVE) = & + (/2.340_f,2.904_f,1.748_f,1.508_f,1.911_f,1.822_f,2.917_f,1.557_f,1.242_f,1.447_f,& + 1.432_f,1.473_f,1.495_f,1.500_f,1.500_f,1.510_f,& + 1.510_f,1.520_f,1.523_f,1.529_f,1.530_f,1.530_f,1.530_f,1.530_f,1.530_f,1.530_f,& + 1.530_f,1.530_f,1.530_f,1.180_f/) + + real(kind=f), public, parameter :: corerealbc (NWAVE) = & + (/2.690_f,2.501_f,2.398_f,2.332_f,2.287_f,2.234_f,2.198_f,2.166_f,2.114_f,2.054_f,& + 2.028_f,1.977_f,1.948_f,1.933_f,1.921_f,1.877_f,& + 1.877_f,1.832_f,1.813_f,1.802_f,1.791_f,1.768_f,1.761_f,1.760_f,1.750_f,1.750_f,& + 1.750_f,1.741_f,1.620_f,2.124_f/) + + real(kind=f), public, parameter :: coreimagdst(NWAVE) = & + (/0.700_f,0.857_f,0.462_f,0.263_f,0.319_f,0.260_f,0.650_f,0.373_f,0.093_f,0.105_f,& + 0.061_f,0.025_f,0.011_f,0.008_f,0.007_f,0.018_f,& + 0.018_f,0.028_f,0.012_f,0.008_f,0.007_f,0.006_f,0.005_f,0.004_f,0.004_f,0.006_f,& + 0.014_f,0.024_f,0.030_f,0.101_f/) + + real(kind=f), public, parameter :: coreimagbc(NWAVE) = & + (/1.000_f,0.884_f,0.825_f,0.791_f,0.764_f,0.734_f,0.714_f,0.696_f,0.668_f,0.644_f,& + 0.624_f,0.604_f,0.593_f,0.586_f,0.580_f,0.556_f,& + 0.556_f,0.527_f,0.503_f,0.492_f,0.481_f,0.458_f,0.451_f,0.440_f,0.430_f,0.443_f,& + 0.461_f,0.470_f,0.450_f,0.674_f/) + + real(kind=f), public, parameter :: waterreal(NWAVE) = & + (/ 1.532_f, 1.523857_f, 1.420063_f, 1.274308_f, & + 1.161387_f, 1.142222_f, 1.232189_f, 1.266436_f, 1.295687_f, 1.320659_f, 1.341516_f, & + 1.315192_f, 1.330235_f, 1.339058_f, 1.350425_f, 1.408042_f, 1.408042_f, 1.324462_f, & + 1.276726_f, 1.301847_f, 1.312051_f, 1.321301_f, 1.322836_f, 1.326836_f, 1.330968_f, & + 1.33367_f, 1.339547_f, 1.348521_f, 1.362_f, 1.290783_f /) + + real(kind=f), public, parameter :: waterimag(NWAVE) = & + (/ 0.336_f, 0.36000001_f, 0.42623809_f, 0.40341724_f, & + 0.32062717_f, 0.11484398_f, 0.04710282_f, 0.03901278_f, 0.03373134_f, 0.03437707_f, & + 0.09216518_f, 0.0121094_f, 0.01314786_f, 0.01013119_f, 0.00486624_f, 0.0142042_f, & + 1.42042044e-02_f, 1.57659209e-01_f, 1.51634401e-03_f, 1.15906247e-03_f, & + 2.35527521e-04_f, 1.71196912e-04_f, 2.43626002e-05_f, 3.12758360e-06_f, & + 3.74323598e-08_f, 1.63841034e-09_f, 2.49434956e-09_f, 1.52413800e-08_f, & + 3.35000010e-08_f, 3.43825518e-02_f /) + + + +contains + + !! Defines all the CARMA components (groups, elements, solutes and gases) and process + !! (coagulation, growth, nucleation) that will be part of the microphysical model. + !! + !! @version May-2009 + !! @author Chuck Bardeen + subroutine CARMAMODEL_DefineModel(carma, rc) + + use physics_buffer, only: pbuf_add_field, dtype_r8 + + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(out) :: rc !! return code, negative indicates failure + + + ! Local variables + integer :: LUNOPRT ! logical unit number for output + character(len=2) :: outputname,outputbin + logical :: do_print ! do print output? + complex(kind=f) :: refidx(NWAVE, NREFIDX) ! refractice indices + + integer :: igroup,ibin + character(len=8) :: sname ! short (CAM) name + + ! Default return code. + rc = RC_OK + + ! Report model specific namelist configuration parameters. + if (masterproc) then + call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) + if (rc < 0) call endrun("CARMA_DefineModel: CARMA_Get failed.") + + if (do_print) write(LUNOPRT,*) '' + if (do_print) write(LUNOPRT,*) 'CARMA ', trim(carma_model), ' specific settings :' + if (do_print) write(LUNOPRT,*) ' carma_soilerosion_file = ', carma_soilerosion_file + if (do_print) write(LUNOPRT,*) ' carma_seasalt_emis = ', trim(carma_seasalt_emis) + if (do_print) write(LUNOPRT,*) ' carma_dustemisfactor = ', carma_dustemisfactor + end if + + ! Define the Groups + ! + ! NOTE: For CAM, the optional do_wetdep and do_drydep flags should be + ! defined. If wetdep is defined, then the optional solubility factor + ! should also be defined. + + !call CARMAGROUP_Create(carma, I_GRP_PURSUL, "sulfate", rmin_PRSUL, vmrat_PRSUL, I_SPHERE, 1._f, .false., & + ! rc, irhswell=I_WTPCT_H2SO4, do_wetdep=.true., do_drydep=.true., solfac=0.3_f, & + ! scavcoef=0.1_f, is_sulfate=.true., shortname="PRSULF", icoreshell=0, & + ! refidx = refidx, refidxS = refidx, refidxC = refidx, do_mie=.true.,imiertn=I_MIERTN_TOON1981) + !if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') + + call CARMAGROUP_Create(carma, I_GRP_PRSUL, "sulfate", rmin_PRSUL, vmrat_PRSUL, I_SPHERE, 1._f, .false., & + rc, irhswell=I_WTPCT_H2SO4, do_wetdep=.false., do_drydep=.true., solfac=0.3_f, & + scavcoef=0.1_f, is_sulfate=.true., shortname="PRSUL", do_mie=.true., & + imiertn=I_MIERTN_TOON1981, iopticstype = I_OPTICS_SULFATE) + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') + + + !call CARMAGROUP_Create(carma, I_GRP_MIXAER, "mixed aerosol", rmin_MIXAER, vmrat_MIXAER, I_SPHERE, 1._f, .false., & + ! rc, do_wetdep=.true., do_drydep=.true., solfac=0.2_f, & + ! scavcoef=0.1_f, shortname="CRMIX", refidx=refidx, & + ! refidxS=refidxS, refidxC=refidxC, do_mie=.true., & + ! irhswell=I_MIX, irhswcomp=I_SWG_URBAN, icoreshell=1,imiertn=I_MIERTN_TOON1981) + !if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') + + call CARMAGROUP_Create(carma, I_GRP_MXAER, "mixed aerosol", rmin_MXAER, vmrat_MXAER, I_SPHERE, 1._f, .false., & + rc, do_wetdep=.false., do_drydep=.true., solfac=0.2_f, & + scavcoef=0.1_f, shortname="MXAER", irhswell=I_PETTERS, do_mie=.true., imiertn=I_MIERTN_TOON1981, & + iopticstype = I_OPTICS_MIXED_YU_H2O, & + neutral_volfrc=-1._f) + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') + + + ! Define the Elements + ! + ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names + ! should be 6 characters or less and without spaces. + refidx(:,1) = CMPLX(shellreal(:), shellimag(:), kind=f) + call CARMAELEMENT_Create(carma, I_ELEM_PRSUL, I_GRP_PRSUL, "Sulfate", & + RHO_SULFATE, I_VOLATILE, I_H2SO4, rc, shortname="PRSULF", refidx=refidx) + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + + call CARMAELEMENT_Create(carma, I_ELEM_MXAER, I_GRP_MXAER, "Sulfate in mixed sulfate", & + RHO_SULFATE, I_VOLATILE, I_H2SO4, rc, kappa=Kappa_SULF, shortname="MXSULF", refidx=refidx) + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + + call CARMAELEMENT_Create(carma, I_ELEM_MXOC, I_GRP_MXAER, "organic carbon", & + RHO_obc, I_COREMASS, I_OC, rc, kappa=Kappa_OC, shortname="MXOC") + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + + call CARMAELEMENT_Create(carma, I_ELEM_MXSOA, I_GRP_MXAER, "secondary organic aerosol", & + RHO_obc, I_COREMASS, I_SOA, rc, kappa=Kappa_SOA, shortname="MXSOA") + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + + refidx(:,1) = CMPLX(corerealbc(:), coreimagbc(:), kind=f) + call CARMAELEMENT_Create(carma, I_ELEM_MXBC, I_GRP_MXAER, "black carbon", & + RHO_obc, I_COREMASS, I_BC, rc, kappa=Kappa_BC, shortname="MXBC", refidx=refidx) + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + + refidx(:,1) = CMPLX(corerealdst(:), coreimagdst(:), kind=f) + call CARMAELEMENT_Create(carma, I_ELEM_MXDUST, I_GRP_MXAER, "dust", & + RHO_DUST, I_COREMASS, I_DUST, rc, kappa=Kappa_DUST, shortname="MXDUST", refidx=refidx) + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + + call CARMAELEMENT_Create(carma, I_ELEM_MXSALT, I_GRP_MXAER, "SALT in mixed sulfate", & + RHO_SALT, I_COREMASS, I_SALT, rc, kappa=Kappa_SALT, shortname="MXSALT") + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + + + ! Define the Solutes + + + + ! Define the Gases + refidx(:,1) = CMPLX(waterreal(:), waterimag(:), kind=f) + call CARMAGAS_Create(carma, I_GAS_H2O, "Water Vapor", WTMOL_H2O, I_VAPRTN_H2O_MURPHY2005, I_GCOMP_H2O, & + rc, shortname = "Q", ds_threshold=-0.2_f, refidx=refidx) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGAS_Create failed.') + + call CARMAGAS_Create(carma, I_GAS_H2SO4, "Sulfuric Acid", WTMOL_H2SO4, I_VAPRTN_H2SO4_AYERS1980, & + I_GCOMP_H2SO4, rc, shortname = "H2SO4") + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGAS_Create failed.') + + + ! Define the Processes + + call CARMA_AddGrowth(carma, I_ELEM_PRSUL, I_GAS_H2SO4, rc) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddGrowth failed.') + + call CARMA_AddGrowth(carma, I_ELEM_MXAER, I_GAS_H2SO4, rc) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddGrowth failed.') + + call CARMA_AddNucleation(carma, I_ELEM_PRSUL, I_ELEM_PRSUL, I_HOMNUC, 0._f, rc, igas=I_GAS_H2SO4) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddNucleation failed.') + + call CARMA_AddCoagulation(carma, I_GRP_PRSUL, I_GRP_PRSUL, I_GRP_PRSUL, I_COLLEC_FUCHS, rc) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') + + call CARMA_AddCoagulation(carma, I_GRP_PRSUL, I_GRP_MXAER, I_GRP_MXAER, I_COLLEC_DATA, rc) + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') + + call CARMA_AddCoagulation(carma, I_GRP_MXAER, I_GRP_MXAER, I_GRP_MXAER, I_COLLEC_DATA, rc) + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') + + !----------------- add pbuf ------------------ + do igroup = 1, NGROUP + + call CARMAGROUP_Get(carma, igroup, rc, shortname=sname) + if (rc < 0) call endrun('carma_register::CARMAGROUP_Get failed.') + !write(*,*) "igroup",igroup,"sname",sname + + ! sulfate mass and number density for each bin + ! e.g. CRSULF01 first element mass mixing ratio; NBMXAER01 #/kg + do ibin=1,NBIN + write (outputbin, "(I2.2)") ibin + if (igroup==I_GRP_MXAER) then + call pbuf_add_field("DQDT_MXSOA"//outputbin,'global',dtype_r8,(/pcols,pver/), ipbuf4soa(ibin)) + call pbuf_add_field("MXSOA"//outputbin//"CM",'physpkg',dtype_r8,(/pcols,pver/), ipbuf4soacm(ibin)) + call pbuf_add_field("MXSOA"//outputbin//"PT",'physpkg',dtype_r8,(/pcols,pver/), ipbuf4soapt(ibin)) + end if + end do + end do + + ! no2 photolysis rate constant (/sec) + call pbuf_add_field('JNO2', 'global', dtype_r8, (/pcols,pver/), ipbuf4jno2) + + !--------------------------------------------- + + return + end subroutine CARMAMODEL_DefineModel + + + !! Defines all the CARMA components (groups, elements, solutes and gases) and process + !! (coagulation, growth, nucleation) that will be part of the microphysical model. + !! + !! @version May-2009 + !! @author Chuck Bardeen + !! + !! @see CARMASTATE_SetDetrain + subroutine CARMAMODEL_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & + tnd_qsnow, tnd_nsnow) + use camsrfexch, only: cam_in_t + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(cam_in_t), intent(in) :: cam_in !! surface input + real(r8), intent(in) :: dlf(pcols, pver) !! Detraining cld H20 from convection (kg/kg/s) + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step (s) + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + real(r8), intent(out), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) + real(r8), intent(out), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_Detrain + + + !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. + !! + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMAMODEL_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(physics_state), intent(in) :: state !! physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(in), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + + ! local variables + real(r8), pointer, dimension(:,:) :: dqdt_soa !! soa tendency due to gas-aerosol exchange kg/kg/s + real(r8), pointer, dimension(:,:) :: jno2_rate !! jno2 tendency due to gas-aerosol exchange kg/kg/s + real(r8), pointer, dimension(:,:) :: soacm !! aerosol tendency due to gas-aerosol exchange kg/kg/s + real(r8), pointer, dimension(:,:) :: soapt !! aerosol tendency due to no2 photolysis kg/kg/s + real(r8) :: mmr_core(cstate%f_NZ)!! mass mixing ratio of the core (kg/kg) + real(r8) :: mmr_soa(cstate%f_NZ) !! mass mixing ratio of soa element (kg/kg) + real(r8) :: mmr(cstate%f_NZ) !! mass mixing ratio per bin (kg/kg) + real(r8) :: delta_soa(cstate%f_NZ) !! mass mixing ratio differences from soa gas-aerosol-exchange + integer :: icorelem(NELEM), ncore,ienconc,icore, ielem, ielem_soa, igroup, ibin, icomposition, n, err + + ! Default return code. + rc = RC_OK + + ! get no2 photolysis rates if they exist + call pbuf_get_field(pbuf, ipbuf4jno2, jno2_rate) ! surface area density + + ! get SOA tendency pbuf field for the mixed group and every bin + + igroup = I_GRP_MXAER + call CARMAGROUP_Get(carma, igroup, rc, ienconc=ienconc, ncore=ncore, icorelem=icorelem) + if (rc /= RC_OK) call endrun('CARMA_DiagnoseBins::CARMAGROUP_Get failed.') + + do ibin = 1, NBIN + + ! Iterate over the core elements, looking for the SOA element. Once found, + ! determine the new SOA taking into account both the addition of condensed + ! SOA and the loss of photolyzed SOA. + do ielem = 1, ncore + + call CARMASTATE_GetBin(cstate, icorelem(ielem), ibin, mmr(:), rc) + if (rc /= RC_OK) call endrun('CARMA_DiagnoseBins::CARMASTATE_GetBin failed.') + + call CARMAELEMENT_GET(carma, icorelem(ielem), rc, icomposition=icomposition) + if (rc /= RC_OK) call endrun('CARMA_DiagnoseBins::CARMAELEMENT_Get failed.') + + ! Only need to make adjustments for the SOA. + if (icomposition == I_SOA) then + call pbuf_get_field(pbuf, ipbuf4soa(ibin), dqdt_soa) ! surface area density + + ! Add that soa tendency from chemistry to the aerosol. + ! + ! NOTE: dqdt is in kg/kg/s + mmr_soa(:) = mmr(:) + dqdt_soa(icol,:) * dt + + ! Save the chemistry tendency so it can by output in the diagnostics. + call pbuf_get_field(pbuf, ipbuf4soacm(ibin), soacm) + soacm(icol,:) = dqdt_soa(icol,:) + + ! Save the NO2 photolysis tendency so it can by output in the diagnostics. + ! + ! NOTE: Simone, what is the 0.0004_r8?? + call pbuf_get_field(pbuf, ipbuf4soapt(ibin), soapt) + soapt(icol,:) = - 0.0004_r8 * jno2_rate(icol,:) * mmr_soa(:) + + ! Now adjust the SOA for the loss by the photolysis rate provided by the + ! chemistry. + mmr_soa(:) = max(0.0_r8, mmr_soa(:) + soapt(icol,:) * dt) + + ! Save out these new values for SOA. + call CARMASTATE_SetBin(cstate, icorelem(ielem), ibin, mmr_soa, rc) + if (rc /= RC_OK) call endrun('CARMA_DiagnoseBins::CARMAGROUP_SetBin failed.') + + exit + end if !mxsoa + end do !ielem + end do !nbin + + end subroutine CARMAMODEL_DiagnoseBins + + + !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. + !! + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMAMODEL_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & + prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) + use camsrfexch, only: cam_out_t + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models + type(physics_state), intent(in) :: state !! physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + type(physics_ptend), intent(inout) :: ptend !! constituent tendencies + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + real(r8), intent(inout), optional :: prec_sed(pcols) !! total precip from cloud sedimentation (m/s) + real(r8), intent(inout), optional :: snow_sed(pcols) !! snow from cloud ice sedimentation (m/s) + real(r8), intent(inout), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) + real(r8), intent(inout), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) + real(r8), intent(out), optional :: re_ice(pcols,pver) !! ice effective radius (m) + + ! Local variables + real(r8) :: numberDensity(cstate%f_NZ) + real(r8) :: totad(cstate%f_NZ) + real(r8) :: ad(cstate%f_NZ) !! aerosol wet surface area density (cm2/cm3) + real(r8) :: totreff(cstate%f_NZ) !! total volume density, used to calculate total effective radius (cm) for history output + real(r8) :: reff(cstate%f_NZ) !! wet effective radius (m) + real(r8) :: mmr(cstate%f_NZ) !! mass mixing ratio per bin (kg/kg) + real(r8) :: coremmr(cstate%f_NZ) !! mmr of all the core + real(r8) :: mmr_gas(cstate%f_NZ) !! gas mass mixing ratio (kg/kg) + real(r8) :: numnkg(cstate%f_NZ) !! total number density (#/kg) + real(r8) :: r_wet(cstate%f_NZ) !! Sulfate aerosol bin wet radius (cm) + real(r8) :: elem1mr(cstate%f_NZ) !! First element mass mixing ratio (kg/kg) + real(r8) :: binnkg(cstate%f_NZ) !! number density per bin (#/kg) + real(r8) :: kappa(cstate%f_NZ) !! hygroscopicity parameter (Petters & Kreidenweis, ACP, 2007) + real(r8) :: rhoa_wet(cstate%f_NZ) !! wet air density (kg/m3) + real(r8) :: wtpct(cstate%f_NZ) !! sulfate weight percent + real(r8) :: rmass(NBIN) !! dry mass + real(r8) :: rhop_dry(cstate%f_NZ) !! dry particle density [g/cm3] + + integer :: ibin, igroup, igas, icomposition + integer :: icorelem(NELEM), ncore,ienconc,icore + character(len=8) :: sname !! short (CAM) name + + real(r8), pointer, dimension(:,:) :: sadsulf_ptr !! Total surface area density pointer (cm2/cm3) + real(r8), pointer, dimension(:,:) :: reffaer_ptr !! Total effective radius pointer (cm) for history output + real(r8), pointer, dimension(:,:) :: wtp_ptr !! weight percent pointer + real(r8), pointer, dimension(:,:) :: sad_ptr !! Surface area density pointer + real(r8), pointer, dimension(:,:) :: reff_ptr !! Effective radius pointer + real(r8), pointer, dimension(:,:) :: numnkg_ptr !! Each group number density pointer + real(r8), pointer, dimension(:,:) :: binnkg_ptr !! Each bin number density pointer + real(r8), pointer, dimension(:,:) :: elem1mr_ptr !! First element mmr pointer + real(r8), pointer, dimension(:,:) :: kappa_ptr !! kappa pointer + real(r8), pointer, dimension(:,:) :: wetr_ptr !! wet radius pointer + real(r8), pointer, dimension(:,:) :: dryr_ptr !! dry radius + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_DiagnoseBulk + + + !! Calculates the emissions for CARMA aerosol particles. By default, there is no + !! emission, but this routine can be overridden for models that wish to have + !! an aerosol emission. + !! + !! @author Lin Su, Pengfei Yu, Chuck Bardeen + !! @version Dec-2010 + subroutine CARMAMODEL_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, pbuf, rc) + use ppgrid, only: pcols, pver + use physics_types, only: physics_state + use phys_grid, only: get_lon_all_p, get_lat_all_p + use time_manager, only: get_curr_date, get_perp_date, is_perpetual + use camsrfexch, only: cam_in_t + use cam_history, only: outfld + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + integer, intent(in) :: icnst !! consituent index + real(r8), intent(in) :: dt !! time step (s) + type(physics_state), intent(in) :: state !! physics state + type(cam_in_t), intent(in) :: cam_in !! surface inputs + real(r8), intent(out) :: tendency(pcols, pver) !! constituent tendency (kg/kg/s) + real(r8), intent(out) :: surfaceFlux(pcols) !! constituent surface flux (kg/m^2/s) + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: ilat(pcols) ! latitude index + integer :: ilon(pcols) ! longitude index + real(r8) :: clat(pcols) ! latitude + integer :: lchnk ! chunk identifier + integer :: ncol ! number of columns in chunk + integer :: icol ! column index + integer :: p ! plev index + integer :: yr ! year + integer :: mon ! month + integer :: day ! day of month + integer :: ncsec ! time of day (seconds) + real(r8) :: smoke(pcols) ! smoke emission flux (molecues/cm2/s) + real(r8) :: rhoa(pcols,pver) ! density of air g/cm3 + real(r8) :: so4_inj(pcols,pver) ! so4 emission flux (molecues/cm3/s) + real(r8) :: so4_tendency_factor(pcols,pver) ! Convertion factor from molec/cm3/s to kg/kg/s + integer :: igroup ! the index of the carma aerosol group + character(len=32) :: shortname ! the shortname of the group + + + + ! -------- local variables added for dust and sea-salt model ------------ + real(r8) :: ch ! dimensional factor & tuning number, + real(r8) :: rmass(NBIN) ! bin mass (g) + real(r8) :: r ! bin center (cm) + real(r8) :: rdust ! dust bin center (cm) + real(r8) :: dustFlux ! dust flux (kg/m2/s) + real(r8) :: rsalt ! salt bin center (cm) + real(r8) :: drsalt ! salt bin width (cm) + real(r8) :: rhop(NBIN) ! element density (g/cm3) + real(r8) :: vrfact + real(r8) :: uth ! threshold wind velocity (m/s) + real(r8) :: uv10 ! 10 m wind speed (m/s) + real(r8) :: cd10 ! 10-m drag coefficient () + real(r8) :: wwd ! raw wind speed (m/s) + real(r8) :: sp ! mass fraction for soil factor + integer :: idustbin ! ibin to use for dust production, smallest silt bin for clay + +! ------------ local variables added for organics model ---------------------- + real(r8) :: dr + real(r8) :: aeronet(NBIN) ! AERONET DATA, Sep.20, 2002, Jaru Reserve, Brazil (refer to MATICHUK et al., 2008) + real(r8) :: saltFlux(pcols) ! sea salt flux to calculate marine POA + integer :: LUNOPRT ! logical unit number for output + logical :: do_print ! do print output? + + real(r8),parameter :: OMtoOCratio = 1.8_r8 ! Need better names and doc + real(r8),parameter :: SmoketoSufaceFlux = 1.9934e-22_r8 ! SmoketoSufaceFlux = BC molecular weight + ! (12 g/mol)/avocadro constant (6e-23 #/mol) *10 + real(r8), pointer :: BCemis_ptr(:), OCemis_ptr(:) + real(r8), pointer :: SO4elevemis_ptr(:,:) + + ! Default return code. + rc = RC_OK + smoke(:) = -huge(1._r8) + so4_inj(:,:) = -huge(1._r8) + ch = carma_dustemisfactor + + ! Determine the day of year. + if ( is_perpetual() ) then + call get_perp_date(yr, mon, day, ncsec) + else + call get_curr_date(yr, mon, day, ncsec) + end if + + ! Determine the latitude and longitude of each column. + lchnk = state%lchnk + ncol = state%ncol + + ! Add any surface flux here. + surfaceFlux(:ncol) = 0.0_r8 + + ! For emissions into the atmosphere, put the emission here. + ! + ! NOTE: Do not set tendency to be the surface flux. Surface source is put in to + ! the bottom layer by vertical diffusion. See vertical_solver module, line 355. + tendency(:ncol, :pver) = 0.0_r8 + + ! Add Emission (surfaceFlux) here. + + !!******************************************************************************************************* + + !! add an element, first element is total number with emission from both OC and BC; + !! second element is BC mass + !! by Pengfei Yu + !! Feb.22 2012 + !!******************************************************************************************************* + + + call CARMAELEMENT_GET(carma, ielem, rc, igroup=igroup, shortname=shortname) + if (RC < RC_ERROR) return + + call CARMAGROUP_GET(carma, igroup, rc, shortname=shortname, rmass=rmass) + if (RC < RC_ERROR) return + + !!******************************************************************************************************* + + !if (masterproc) then + ! call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) + ! + ! if (do_print) then + ! write(carma%f_LUNOPRT,*) 'AERONET', aeronet + ! write(carma%f_LUNOPRT,*) 'dr', dr + ! write(carma%f_LUNOPRT,*) 'r', r + ! end if + !end if + + !!******************************************************************************************************* + + if(carma_BCOCemissions == 'Specified')then + call pbuf_get_field(pbuf, bc_srfemis_ndx, BCemis_ptr) + call pbuf_get_field(pbuf, oc_srfemis_ndx, OCemis_ptr) + end if + if(carma_SO4elevemis== 'Specified')then + call pbuf_get_field(pbuf, so4_elevemis_ndx, SO4elevemis_ptr) + end if + + ! Organic carbon emssions + if (ielem == I_ELEM_MXOC) then + if (carma_BCOCemissions == 'Yu2015') then + call get_lat_all_p(lchnk, ncol, ilat) + call get_lon_all_p(lchnk, ncol, ilon) + do icol = 1,ncol + smoke(icol) = OCnew(ilat(icol), ilon(icol), mon)*OMtoOCratio + end do + elseif(carma_BCOCemissions == 'Specified')then + smoke(:ncol) = OCemis_ptr(:ncol) + end if + +! st scip Fsub PBAFlux etcfor now + surfaceFlux(:ncol) = surfaceFlux(:ncol) + smoke(:ncol)*aeronet_fraction(ibin)*SmoketoSufaceFlux + end if + + ! Black carbon emissions + if (ielem == I_ELEM_MXBC) then + if (carma_BCOCemissions == 'Yu2015') then + do icol = 1,ncol + smoke(icol) = BCnew(ilat(icol), ilon(icol), mon) + end do + elseif(carma_BCOCemissions == 'Specified') then + smoke(:ncol) = BCemis_ptr(:ncol) + end if + + surfaceFlux(:ncol) = surfaceFlux(:ncol) + smoke(:ncol)*aeronet_fraction(ibin)*SmoketoSufaceFlux + end if + + if(carma_SO4elevemis == 'Specified') then + ! Sulfate emissions + if (ielem == I_ELEM_PRSUL) then + ! convert from #/kg to kg/kg = 1.e-3 * mw/avog (6e-23) !kg/kg + ! convert from #/cm3/s to kg/kg/s = 1.e3 * density of air * mw / avog + !AVG: molec/mol R_AIR: units? + !rhoa + !number Density + !rhoa(:ncol,:) = 10._r8 * state%pmid(:ncol,:) / (R_AIR * state%t(:ncol,:)) + !pmid is in Pa (Pa->dynes (factor of 10.), T (K), -> g/cm3 + + !so4_tendency_factor(:ncol,:) = rhoa(:ncol,:) * WTMOL_H2SO4 / AVG !molec/cm3/s to kg/kg + + so4_inj(:ncol,:) = SO4elevemis_ptr(:ncol,:) + + + ! set so4_inj larger 0. because of potential negative missing values + do icol = 1,ncol + do p = 1,pver + rhoa(icol,p) = 10._r8 * state%pmid(icol,p) / (R_AIR * state%t(icol,p)) + !pmid is in Pa (Pa->dynes (factor of 10.), T (K), -> g/cm3 + !emis = molec/cm3/s + !rhoa = g/cm3 + !mw = g/mol + !avg = molec/mol + !so4_tendency_factor(icol,p) = rhoa(icol,p) * WTMOL_H2SO4 / AVG !molec/cm3/s to kg/kg + so4_tendency_factor(icol,p) = WTMOL_H2SO4 / AVG / rhoa(icol,p) !molec/cm3/s to kg/kg + so4_inj(icol,p) = max(0._r8,so4_inj(icol,p)) + if (so4_inj(icol,p).gt.0._r8) then + tendency(icol,p) = so4_inj(icol,p)*so4inj_dist(ibin)*so4_tendency_factor(icol,p) + end if + end do + end do + end if + end if + + ! Dust emissions + if (ielem == I_ELEM_MXDUST) then + + ! The radius should be determined by the dust density not the group + ! density + call CARMAELEMENT_Get(carma, I_ELEM_MXDUST, rc, rho=rhop) + if (RC < RC_ERROR) return + + ! Calculate the radius assuming that all the mass will be emitted as this + ! element. + rdust = (3._r8 * rmass(ibin) / 4._r8 / PI / rhop(ibin)) ** (1._r8 / 3._r8) + + ! Is this clay or silt? + ! + ! NOTE: It is assumed that 90% of the mass will be silt and 10% will + ! be clay. + ! + ! NOTE: For clay bins, use the smallest silt bin to calculate the + ! mass and then scale that into each clay bin based upon interpolation of + ! Tegen and Lacis [1996]. + if (rdust >= rClay) then + sp = 0.9_r8 / nSilt + idustbin = ibin + else + sp = 0.1_r8 / nClay + idustbin = nClay + 1 + end if + + ! Process each column. + do icol = 1,ncol + + call CARMAMODEL_SurfaceWind(carma, icol, I_ELEM_MXDUST, igroup, idustbin, cam_in, uv10, wwd, uth, rc) + + ! Is the wind above the threshold for dust production? + if (sqrt(wwd) > uth) then + dustFlux = ch * soil_factor(icol, lchnk) * sp * & + wwd * (sqrt(wwd) - uth) + else + dustFlux = 0._r8 + endif + + ! Scale the clay bins based upon the smallest silt bin. + dustFlux = clay_mf(ibin) * dustFlux + + ! Add the dust flux to the accumulated emissions (important for I_ELEM_MXAER) + surfaceFlux(icol) = surfaceFlux(icol) + dustFlux + end do + + ! For debug purposes, output the soil erosion factor. + call outfld('CRSLERFC', soil_factor(:ncol, lchnk), ncol, lchnk) + end if + + + ! Sea salt emissions + if (ielem == I_ELEM_MXSALT) then + + ! The radius should be determined by the dust density not the group + ! density + call CARMAELEMENT_Get(carma, I_ELEM_MXSALT, rc, rho=rhop) + if (RC < RC_ERROR) return + + ! Calculate the radius assuming that all the mass will be emitted as sea + ! salt. + vrfact = ((3._r8/2._r8 / PI / (vmrat_MXAER + 1._r8))**(1._r8 / 3._r8)) * ((vmrat_MXAER**(1._r8 / 3._r8)) - 1._r8) + rsalt = (3._r8 * rmass(ibin) / 4._r8 / PI / rhop(ibin))**(1._r8 / 3._r8) + drsalt = vrfact * ((rmass(ibin)/rhop(ibin))**(1._r8 / 3._r8)) + + ! get sea spray aerosol flux first (for ibin; SaltFlux(:ncol) unit:kg/m2/s) + call CARMAMODEL_SaltFlux(carma, ibin, state, rsalt, drsalt, rmass(ibin), cam_in, saltFlux, rc) + +!st not used currently but done by Pengfei + !! introduce marine POA emission, use ChlorophyII-dependent mass contribution of OC + !! see Gantt et al., 2009 + !! for sub-micron, I use sea salt flux instead of sub-micron marine particles + !! needed to verify later + !! Added by Pengfei Yu + !! Oct.6.2012 + ! get [Chl-a] data + !! do icol = 1, ncol + !! if (Chla(ilat(icol), ilon(icol)) .lt. 0._r8) then + !! Fsub(icol) = 0._r8 + !! else + !! Fsub(icol) = Chla(ilat(icol), ilon(icol)) * 0.63_r8 + 0.1_r8 + !! endif + !! Fsub(icol) = min(Fsub(icol), 1._r8) + !! enddo + !! surfaceFlux(:ncol) = SaltFlux(:ncol) + !! ! sea salt (NaCl) flux should exclude marine organics and marine sulfate + !! if (carma%f_group(igroup)%f_r(ibin) .le. 0.5e-4_r8) then + !! !surfaceFlux(:ncol) = SaltFlux(:ncol)*(1._r8-0.0983_r8) - SaltFlux(:ncol) * Fsub(:ncol) + !! surfaceFlux(:ncol) = (SaltFlux(:ncol) - SaltFlux(:ncol)*Fsub(:ncol))/1.0983_r8 + !! else + !! !surfaceFlux(:ncol) = SaltFlux(:ncol)*(1._r8-0.0983_r8) - SaltFlux(:ncol) * (Fsub(:ncol)*0.03_r8) + !! surfaceFlux(:ncol) = (SaltFlux(:ncol) - SaltFlux(:ncol)*Fsub(:ncol)*0.03_r8)/1.0983_r8 + !! endif + surfaceFlux(:ncol) = surfaceFlux(:ncol) + saltFlux(:ncol) + end if + + return + end subroutine CARMAMODEL_EmitParticle + + + !! Allows the model to perform its own initialization in addition to what is done + !! by default in CARMA_init. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMAMODEL_InitializeModel(carma, lq_carma, pbuf2d, rc) + use cam_history, only: addfld, horiz_only, add_default + use constituents, only: pcnst + + type(carma_type), intent(in) :: carma !! the carma object + logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent + !! could have a CARMA tendency + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + integer, intent(out) :: rc !! return code, negative indicates failure + + ! -------- local variables ---------- + integer :: ibin ! CARMA bin index + real(r8) :: r(NBIN), dr(NBIN), rdust(NBIN),robc(NBIN),drobc(NBIN),rm(NBIN),rhop(NBIN) ! bin center (cm) + integer :: count_Silt ! count number for Silt + integer :: igroup ! the index of the carma aerosol group + integer :: ielem ! the index of the carma aerosol element + character(len=32) :: shortname ! the shortname of the element + integer :: LUNOPRT ! logical unit number for output + logical :: do_print ! do print output? + + integer :: i, idata,isizebin,ibin_local + integer,parameter :: aeronet_dim1 = 22 + integer,parameter :: aeronet_dim2 = 4 + real(r8),dimension(aeronet_dim1,aeronet_dim2) :: sizedist_aeronet + real(r8),dimension(aeronet_dim1) :: sizedist_avg + real(r8),dimension(NBIN) :: sizedist_carmabin + real(r8) :: rmass(NBIN) !! dry mass + real(r8) :: vrfact + real(r8) :: rgeo + real(r8) :: siglog, siglogsq, sq2pi + character(len=16) :: binname !! names bins + + real(r8),parameter :: size_aeronet(aeronet_dim1) = (/0.050000_r8,0.065604_r8,0.086077_r8,0.112939_r8,0.148184_r8, & + 0.194429_r8,0.255105_r8,0.334716_r8,0.439173_r8,0.576227_r8,0.756052_r8,0.991996_r8,1.301571_r8,1.707757_r8, & + 2.240702_r8,2.939966_r8,3.857452_r8,5.061260_r8,6.640745_r8,8.713145_r8,11.432287_r8,15.000000_r8/)*1.e-4_r8 !um to cm + + ! Default return code. + rc = RC_OK + + ! Determine how many clay and how many silt bins there are, based + ! upon the bin definitions and rClay. + ! + ! TBD: This should use the radii rather than being hard coded. + ! nClay = 8 + ! nSilt = NBIN - nClay + do ielem = 1, NELEM + + ! To get particle radius, need to derive from rmass and density of dust. + call CARMAELEMENT_GET(carma, ielem, rc, igroup=igroup, shortname=shortname, rho=rhop) + if (RC < RC_ERROR) return + + call CARMAGROUP_GET(carma, igroup, rc, rmass=rmass) + if (RC < RC_ERROR) return + + if (shortname .eq. "MXDUST") then + + count_Silt = 0 + do ibin = 1, NBIN + + ! Calculate the radius assuming that all the mass will be emitted as this + ! element. + rdust(ibin) = (3._r8 * rmass(ibin) / 4._r8 / PI / rhop(ibin))**(1._r8 / 3._r8) + + if (rdust(ibin) >= rclay) then + count_Silt = count_Silt + 1 + else + end if + end do + nSilt = count_Silt + nClay = NBIN - nSilt + end if + end do + + ! Read in the soil factors. + call CARMAMODEL_ReadSoilErosionFactor(rc) + if (RC < RC_ERROR) return + + ! To determine Clay Mass Fraction + do ielem = 1, NELEM + ! To get particle radius + call CARMAELEMENT_GET(carma, ielem, rc, igroup=igroup, shortname=shortname) + if (RC < RC_ERROR) return + + if (shortname .eq. "MXDUST") then + call CARMAMODEL_ClayMassFraction(carma, igroup, rdust, rc) + end if + end do + + if (masterproc) then + call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) + if (rc < 0) call endrun("CARMA_InitializeModel: CARMA_Get failed.") + + if (do_print) then + write(carma%f_LUNOPRT,*) 'Initializing CARMA dust model ...' + write(carma%f_LUNOPRT,*) 'nClay = ', nClay, ' nSilt = ', nSilt + write(carma%f_LUNOPRT,*) 'clay_mf = ', clay_mf + write(carma%f_LUNOPRT,*) 'soil_factor = ', soil_factor + + write(carma%f_LUNOPRT,*) 'CARMA dust initialization complete' + end if + end if + + call addfld('CRSLERFC', horiz_only, 'A', 'fraction', 'CARMA soil erosion factor') + + if (carma_BCOCemissions == 'Yu2015')then + ! Added by Pengfei Yu to read smoke emission data + call CARMAMODEL_BCOCread(rc) + end if + if(carma_BCOCemissions == 'Specified')then + bc_srfemis_ndx = pbuf_get_index("BC_srfemis") + oc_srfemis_ndx = pbuf_get_index("OC_srfemis") + end if + + ! prescribed sulfate emissions for stratospheric aerosol injections + if(carma_SO4elevemis == 'Specified')then + so4_elevemis_ndx = pbuf_get_index("SO4_elevemis") + end if + + if (is_first_step()) then + + ! Initialize physics buffer fields + do igroup = 1, NGROUP + do ibin = 1, NBIN + if (igroup==I_GRP_MXAER) then + call pbuf_set_field(pbuf2d, ipbuf4soa(ibin), 0.0_r8 ) + end if + end do + end do + + call pbuf_set_field(pbuf2d, ipbuf4jno2, 0.0_r8 ) + endif + + sizedist_aeronet(:aeronet_dim1,1) = (/0.000585_r8,0.006080_r8,0.025113_r8,0.052255_r8,0.079131_r8,0.081938_r8, & + 0.035791_r8,0.010982_r8,0.005904_r8,0.007106_r8,0.011088_r8,0.012340_r8,0.010812_r8,0.010423_r8, & + 0.011892_r8,0.016529_r8,0.023967_r8,0.026854_r8,0.017901_r8,0.007226_r8,0.002161_r8,0.000544_r8/) + sizedist_aeronet(:aeronet_dim1,2) = (/0.000541_r8,0.006524_r8,0.026103_r8,0.050825_r8,0.077730_r8,0.080545_r8, & + 0.035400_r8,0.011143_r8,0.005753_r8,0.006095_r8,0.008730_r8,0.010794_r8,0.011517_r8,0.012051_r8, & + 0.012362_r8,0.014710_r8,0.019738_r8,0.022156_r8,0.014892_r8,0.005976_r8,0.001891_r8,0.000573_r8/) + sizedist_aeronet(:aeronet_dim1,3) = (/0.000747_r8,0.009291_r8,0.043556_r8,0.099216_r8,0.142377_r8,0.108606_r8, & + 0.043723_r8,0.016385_r8,0.008318_r8,0.005597_r8,0.004431_r8,0.004131_r8,0.004980_r8,0.007484_r8, & + 0.011795_r8,0.017235_r8,0.022404_r8,0.025216_r8,0.022521_r8,0.013752_r8,0.005051_r8,0.001057_r8/) + sizedist_aeronet(:aeronet_dim1,4) = (/0.000979_r8,0.007724_r8,0.034451_r8,0.090410_r8,0.135893_r8,0.103115_r8, & + 0.046047_r8,0.018989_r8,0.009149_r8,0.005034_r8,0.003199_r8,0.002680_r8,0.003249_r8,0.005105_r8, & + 0.008370_r8,0.012542_r8,0.016973_r8,0.021107_r8,0.022077_r8,0.015639_r8,0.006001_r8,0.001115_r8/) + + sizedist_avg(:) = 0._r8 + do idata = 1,aeronet_dim2 + sizedist_avg(:) = sizedist_avg(:) + sizedist_aeronet(:,idata) + end do + sizedist_avg(:) = sizedist_avg(:)*0.25_r8 + + do igroup = 1,NGROUP + call CARMAGROUP_GET(carma, igroup, rc, shortname=shortname, rmass=rmass) + + + if (shortname .eq. "MXAER") then + + !interpolate into carma bin + sizedist_carmabin = 0._r8 + + do ibin_local = 1, NBIN + ! Calculate the radius assuming that all the mass will be emitted as this + ! element. + vrfact = ((3._r8/2._r8 / PI / (vmrat_MXAER + 1._r8))**(1._r8 / 3._r8)) * ((vmrat_MXAER**(1._r8 / 3._r8)) - 1._r8) + robc(ibin_local) = (3._r8 * rmass(ibin_local) / 4._r8 / PI / rho_obc)**(1._r8 / 3._r8) + drobc(ibin_local) = vrfact * ((rmass(ibin_local)/rho_obc) **(1._r8 / 3._r8)) + + if(robc(ibin_local) .lt. size_aeronet(1)) then + sizedist_carmabin(ibin_local) = sizedist_avg(1) + end if + if(robc(ibin_local) .ge. size_aeronet(aeronet_dim1)) then + sizedist_carmabin(ibin_local) = sizedist_avg(aeronet_dim1) + end if + do isizebin= 1,aeronet_dim1-1 + if( robc(ibin_local) .ge. size_aeronet(isizebin) .and. robc(ibin_local) .lt. size_aeronet(isizebin+1))then + sizedist_carmabin(ibin_local) = sizedist_avg(isizebin)*(size_aeronet(isizebin+1)-robc(ibin_local))/& + (size_aeronet(isizebin+1)-size_aeronet(isizebin))& + +sizedist_avg(isizebin+1)*(robc(ibin_local)-size_aeronet(isizebin))& + /(size_aeronet(isizebin+1)-size_aeronet(isizebin)) + end if + end do + end do + + rm(:) = 0._r8 + do ibin_local = 1, NBIN + rm(ibin_local) = sizedist_carmabin(ibin_local)*drobc(ibin_local)/robc(ibin_local)*RHO_obc*1.e-15_r8 ! kg + enddo + + do ibin_local = 1, NBIN + aeronet_fraction(ibin_local) = rm(ibin_local)/sum(rm(:)) + end do + + end if + end do + + ! Produce lognormal size distribtuion for sulfate emissions (SO4 geoengienering experiments) + + ! Define specific for SO4 injection, e.g.,mean dry radius: 0.095, sigma = 1.5 + so4inj_dist(:) = 0.0_r8 + so4inj_dist1(:) = 0.0_r8 + rgeo=0.095e-4_f ! mean radius for aerosol injections in cm + siglog=log(1.5_r8) ! assumed log normal distribtuion around mean radius for aerosol injections + siglogsq=siglog**2_f + sq2pi = sqrt(2._r8*pi) + !aer_Vrat = vmrat_PRSUL + + call CARMAGROUP_GET(carma, I_GRP_PRSUL, rc, r=r, dr=dr, shortname=shortname, rmass=rmass) + + !interpolate into carma bin + + do ibin_local = 1, NBIN + ! Size Distribution-Parameter: log-normal distribution applied using Seinfeld and Pandis (2016) + so4inj_dist1(ibin_local)=dr(ibin_local)/(r(ibin_local)*sq2pi*siglog)*exp(-(((log(r(ibin_local)/rgeo))**2._r8)/(2._r8*siglogsq))) + so4inj_dist(ibin_local)=dr(ibin_local)/(r(ibin_local)*sq2pi*siglog)*exp(-(((log(r(ibin_local)/rgeo))**2._r8)/(2._r8*siglogsq))) + so4inj_dist1(ibin_local) = so4inj_dist1(ibin_local) *rmass(ibin_local) + end do + so4inj_dist(:) = so4inj_dist(:) / sum(so4inj_dist) + so4inj_dist1(:) = so4inj_dist1(:) / sum(so4inj_dist1) + + ! Provide diagnostics on the SOA tendencies that affect MXAER. + do ibin = 1, NBIN + write(binname, '(A, I2.2)') "MXSOA", ibin + + call addfld(trim(binname)//"CM", (/ 'lev' /), 'A', 'kg/kg/s', 'MXAER SOA gas condensation tendency') + call addfld(trim(binname)//"PT", (/ 'lev' /), 'A', 'kg/kg/s', 'MXAER SOA photolysis tendency') + end do + + ! Provide diagnostics for SO4 tendencies from other physics packages + ! + ! NOTE: This can be useful for determining an SO4 budget and for debugging + ! SO4 conservation. + if (carma_do_budget_diags) then + + call addfld("SO4PRBD", horiz_only, 'A', 'kg/m2', 'CARMA, Interstitial SO4 pure burden') + if (carma_diags_file > 0) call add_default("SO4PRBD", carma_diags_file, ' ') + call addfld("SO4MXBD", horiz_only, 'A', 'kg/m2', 'CARMA, Interstitial SO4 mix burden') + if (carma_diags_file > 0) call add_default("SO4MXBD", carma_diags_file, ' ') + call addfld("SO4PRCLDBD", horiz_only, 'A', 'kg/m2', 'CARMA, Cloudborne SO4 pure burden') + if (carma_diags_file > 0) call add_default("SO4PRCLDBD", carma_diags_file, ' ') + call addfld("SO4MXCLDBD", horiz_only, 'A', 'kg/m2', 'CARMA, Cloudborne SO4 mix burden') + + if (carma_diags_file > 0) call add_default("SO4MXCLDBD", carma_diags_file, ' ') + call addfld("SO4PRSF", horiz_only, 'A', 'kg/m2', 'CARMA, Interstitial SO4 pure surface flux') + if (carma_diags_file > 0) call add_default("SO4PRSF", carma_diags_file, ' ') + call addfld("SO4MXSF", horiz_only, 'A', 'kg/m2', 'CARMA, Interstitial SO4 mix surface flux') + if (carma_diags_file > 0) call add_default("SO4MXSF", carma_diags_file, ' ') + + call addfld("H2SO4BD", horiz_only, 'A', 'kg/m2', 'CARMA, H2SO4 burden') + if (carma_diags_file > 0) call add_default("H2SO4BD", carma_diags_file, ' ') + call addfld("SO2BD", horiz_only, 'A', 'kg/m2', 'CARMA, SO2 burden') + if (carma_diags_file > 0) call add_default("SO2BD", carma_diags_file, ' ') + + call addfld("MXBCBD", horiz_only, 'A', 'kg/m2', 'CARMA, Interstitial BC mix burden') + if (carma_diags_file > 0) call add_default("MXBCBD", carma_diags_file, ' ') + call addfld("MXDUSTBD", horiz_only, 'A', 'kg/m2', 'CARMA, Interstitial Dust mix burden') + if (carma_diags_file > 0) call add_default("MXDUSTBD", carma_diags_file, ' ') + call addfld("MXOCBD", horiz_only, 'A', 'kg/m2', 'CARMA, Interstitial OC mix burden') + if (carma_diags_file > 0) call add_default("MXOCBD", carma_diags_file, ' ') + call addfld("MXSALTBD", horiz_only, 'A', 'kg/m2', 'CARMA, Interstitial Sea Salt mix burden') + if (carma_diags_file > 0) call add_default("MXSALTBD", carma_diags_file, ' ') + call addfld("MXSOABD", horiz_only, 'A', 'kg/m2', 'CARMA, Interstitial SOA mix burden') + if (carma_diags_file > 0) call add_default("MXSOABD", carma_diags_file, ' ') + + call addfld("MXBCCLDBD", horiz_only, 'A', 'kg/m2', 'CARMA, Cloudborne BC mix burden') + if (carma_diags_file > 0) call add_default("MXBCCLDBD", carma_diags_file, ' ') + call addfld("MXDUSTCLDBD", horiz_only, 'A', 'kg/m2', 'CARMA, Cloudborne Dust mix burden') + if (carma_diags_file > 0) call add_default("MXDUSTCLDBD", carma_diags_file, ' ') + call addfld("MXOCCLDBD", horiz_only, 'A', 'kg/m2', 'CARMA, Cloudborne OC mix burden') + if (carma_diags_file > 0) call add_default("MXOCCLDBD", carma_diags_file, ' ') + call addfld("MXSALTCLDBD", horiz_only, 'A', 'kg/m2', 'CARMA, Cloudborne Sea Salt mix burden') + if (carma_diags_file > 0) call add_default("MXSALTCLDBD", carma_diags_file, ' ') + call addfld("MXSOACLDBD", horiz_only, 'A', 'kg/m2', 'CARMA, Cloudborne SOA mix burden') + if (carma_diags_file > 0) call add_default("MXSOACLDBD", carma_diags_file, ' ') + end if + + if (carma_do_package_diags) then + + ! Iterate of the packages that have be instrumented. These should match the calls + ! in physpkg.f90. + do i = 1, carma_ndiagpkgs + call addfld("SO4PRBD_"//trim(carma_diags_packages(i)), horiz_only, 'A', 'kg/m2', trim(carma_diags_packages(i))//', SO4 pure burden') + if (carma_diags_file > 0) call add_default("SO4PRBD_"//trim(carma_diags_packages(i)), carma_diags_file, ' ') + call addfld("SO4MXBD_"//trim(carma_diags_packages(i)), horiz_only, 'A', 'kg/m2', trim(carma_diags_packages(i))//', SO4 mixed burden') + if (carma_diags_file > 0) call add_default("SO4MXBD_"//trim(carma_diags_packages(i)), carma_diags_file, ' ') + + call addfld("SO4PRSF_"//trim(carma_diags_packages(i)), horiz_only, 'A', 'kg/m2/s', trim(carma_diags_packages(i))//', Surface Flux, SO4 pure tendency') + if (carma_diags_file > 0) call add_default("SO4PRSF_"//trim(carma_diags_packages(i)), carma_diags_file, ' ') + call addfld("SO4MXSF_"//trim(carma_diags_packages(i)), horiz_only, 'A', 'kg/m2/s', trim(carma_diags_packages(i))//', Surface Flux, SO4 mix tendency') + if (carma_diags_file > 0) call add_default("SO4MXSF_"//trim(carma_diags_packages(i)), carma_diags_file, ' ') + + call addfld("SO4PRTC_"//trim(carma_diags_packages(i)), horiz_only, 'A', 'kg/m2/s', trim(carma_diags_packages(i))//', SO4 pure tendency') + if (carma_diags_file > 0) call add_default("SO4PRTC_"//trim(carma_diags_packages(i)), carma_diags_file, ' ') + call addfld("SO4MXTC_"//trim(carma_diags_packages(i)), horiz_only, 'A', 'kg/m2/s', trim(carma_diags_packages(i))//', SO4 mixed tendency') + if (carma_diags_file > 0) call add_default("SO4MXTC_"//trim(carma_diags_packages(i)), carma_diags_file, ' ') + + call addfld("SO4PRCLDBD_"//trim(carma_diags_packages(i)), horiz_only, 'A', 'kg/m2', trim(carma_diags_packages(i))//', Cloudborne SO4 pure burden') + if (carma_diags_file > 0) call add_default("SO4PRCLDBD_"//trim(carma_diags_packages(i)), carma_diags_file, ' ') + call addfld("SO4MXCLDBD_"//trim(carma_diags_packages(i)), horiz_only, 'A', 'kg/m2', trim(carma_diags_packages(i))//', Cloudborne SO4 mixed burden') + if (carma_diags_file > 0) call add_default("SO4MXCLDBD_"//trim(carma_diags_packages(i)), carma_diags_file, ' ') + + call addfld("SO4PRCLDTC_"//trim(carma_diags_packages(i)), horiz_only, 'A', 'kg/m2/s', trim(carma_diags_packages(i))//', Cloudborne SO4 pure tendency') + if (carma_diags_file > 0) call add_default("SO4PRCLDTC_"//trim(carma_diags_packages(i)), carma_diags_file, ' ') + call addfld("SO4MXCLDTC_"//trim(carma_diags_packages(i)), horiz_only, 'A', 'kg/m2/s', trim(carma_diags_packages(i))//', Cloudborne SO4 mixed tendency') + if (carma_diags_file > 0) call add_default("SO4MXCLDTC_"//trim(carma_diags_packages(i)), carma_diags_file, ' ') + + call addfld("H2SO4TC_"//trim(carma_diags_packages(i)), horiz_only, 'A', 'kg/m2/s', trim(carma_diags_packages(i))//', H2SO4 total tendency') + if (carma_diags_file > 0) call add_default("H2SO4TC_"//trim(carma_diags_packages(i)), carma_diags_file, ' ') + call addfld("SO2TC_"//trim(carma_diags_packages(i)), horiz_only, 'A', 'kg/m2/s', trim(carma_diags_packages(i))//', SO2 total tendency') + if (carma_diags_file > 0) call add_default("SO2TC_"//trim(carma_diags_packages(i)), carma_diags_file, ' ') + end do + end if + + ! Provide diagnostics for Mass mixing ration summed over the bins + call addfld("SO4PRMR", (/ 'lev' /), 'A', 'kg/kg', 'SO4 pure mass mixing ratio') + call addfld("MXSO4MR", (/ 'lev' /), 'A', 'kg/kg', 'SO4 mixed mass mixing ratio') + call addfld("MXBCMR", (/ 'lev' /), 'A', 'kg/kg', 'BC mixed mass mixing ratio') + call addfld("MXDUSTMR", (/ 'lev' /), 'A', 'kg/kg', 'DUST mixed mass mixing ratio') + call addfld("MXOCMR", (/ 'lev' /), 'A', 'kg/kg', 'OC mixed mass mixing ratio') + call addfld("MXSALTMR", (/ 'lev' /), 'A', 'kg/kg', 'SALT mixed mass mixing ratio') + call addfld("MXSOAMR", (/ 'lev' /), 'A', 'kg/kg', 'SOA mixed mass mixing ratio') + + return + end subroutine CARMAMODEL_InitializeModel + + + !! Sets the initial condition for CARMA aerosol particles. By default, there are no + !! particles, but this routine can be overridden for models that wish to have an + !! initial value. + !! + !! NOTE: If CARMA constituents appear in the initial condition file, then those + !! values will override anything set here. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMAMODEL_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + real(r8), intent(in) :: latvals(:) !! lat in degrees (ncol) + real(r8), intent(in) :: lonvals(:) !! lon in degrees (ncol) + logical, intent(in) :: mask(:) !! Only initialize where .true. + real(r8), intent(inout) :: q(:,:) !! mass mixing ratio (gcol, lev) + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + ! Add initial condition here. + ! + ! NOTE: Initialized to 0. by the caller, so nothing needs to be done. + + return + end subroutine CARMAMODEL_InitializeParticle + + + !! This routine is an extension of CARMA_CreateOpticsFile() that allows for + !! model specific tables to be created in addition to the model independent + !! methods that are in carma_intr.F90. + !! + !! The opticsType that is specified for the group determines how the optical + !! properties will be generated for that group. Each group can use a different + !! optics method if needed. Refractive indices need for these calculation are + !! are specified in the group's elements rather than at the group level. This + !! allows various mixing approaches to be used to determine the refractive index + !! for the particle as a whole. If the refractive index for water is needed, + !! it is specific the the CARMAGAS object for H2O. + !! + !! The I_OPTICS_MIXED_YU2105 and I_OPTICS_SULFATE_YU2015 optics methods are + !! designed to trop_strat models as define in the Yu et al. (2015) paper. The + !! I_OPTICS_MIXED_YU_H2O includes volume mixing of the water into the shell. + subroutine CARMAMODEL_CreateOpticsFile(carma, igroup, opticsType, rc) + + implicit none + + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(in) :: igroup !! group identifier + integer, intent(in) :: opticsType !! optics type (see I_OPTICS_... in carma_enums.F90) + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Local variables + logical :: do_mie + integer :: cnsttype ! constituent type + + ! Assume success. + rc = 0 + + ! What type of calculation is needed for this group? + ! + ! NOTE: Some of these calculations generate optical properties as single mass + ! coefficients, while others are lookup tables designed around multiple + ! dimensions. + select case (opticsType) + + ! This is for the mixed aerosol group as implemented by Yu et al. (2015), + ! and is specific to the aerosol defintion in that model. There are multiple + ! elements, some grouped in the core and others in the shell. The refractive + ! index for the shell is assumed to be only sulfates, and the refractive + ! index of the core is a mix of dust and black carbon. Core/shell optics + ! are used to determine the optical properties. + case(I_OPTICS_MIXED_YU2015) + call CARMAMODEL_CreateOpticsFile_MixedYu(carma, igroup, rc) + if (rc < 0) call endrun('carma_CreateOpticsFile::CreateOpticsFile_MixedYu failed.') + + ! This is for the pure sulfate group as implemented by Yu et al. (2015). + ! The particle may swell, but the refractive index is fixed regardless + ! of the weight percent of H21SO4 in the particle. + case(I_OPTICS_SULFATE_YU2015) + call CARMAMODEL_CreateOpticsFile_SulfateYu(carma, igroup, rc) + if (rc < 0) call endrun('carma_CreateOpticsFile::CreateOpticsFile_SulfateYu failed.') + + ! This is similar to I_OPTICS_MIXED_YU2015, except that the shell is a volume + ! mixture of water and H2SO4 rather than just being H2SO4. + case(I_OPTICS_MIXED_YU_H2O) + call CARMAMODEL_CreateOpticsFile_MixedYuH2o(carma, igroup, rc) + if (rc < 0) call endrun('carma_CreateOpticsFile::CreateOpticsFile_MixedYuH2o failed.') + + case default + call endrun('carma_CreateOpticsFile:: Unknown optics type.') + end select + + return + end subroutine CARMAMODEL_CreateOpticsFile + + + !! This routine creates files containing optical properties for the mixed group + !! following Yu et al. (2015). These optical properties are used by the RRTMG radiation + !! code to include the impact of CARMA particles in the radiative transfer + !! calculation. + subroutine CARMAMODEL_CreateOpticsFile_MixedYu(carma, igroup, rc) + use radconstants, only : nswbands, nlwbands + use wrap_nf + use wetr, only : getwetr + + implicit none + + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(in) :: igroup !! group index + integer, intent(out) :: rc !! return code, negative indicates failure + + !! Core-shell mixing method for mie and radiation calculations for the Yu et al. (2015) + !! style table. The CAM optics code will interpolate based upon the current core/shell + !! mass ratio from a table built using the specified core/shell. + integer, parameter :: ncoreshellratio = 9 !! Number of core/shell ratio for mie calculations + integer, parameter :: ndstbcratio = 8 + integer, parameter :: nkap = 9 + + real(kind=f), parameter :: coreshellratio(ncoreshellratio) = (/ 0.001_f, 0.00237_f, 0.00562_f, 0.01333_f, & + 0.03162_f, 0.07499_f, 0.17782_f, 0.42169_f, 1.0_f /) + real(kind=f), parameter :: dstbcratio(ndstbcratio) = (/ 0.01_f, 0.025_f, 0.063_f, 0.1_f, 0.3_f, 0.5_f, 0.7_f, 0.9_f/) + real(kind=f), parameter :: kap(nkap) = (/ 0.1_f, 0.2_f, 0.3_f, 0.4_f, 0.5_f, 0.7_f, 0.9_f, 1.1_f, 1.2_f/) + + ! Local variables + integer :: ibin, iwave, irh, icsr, idb, ikap, icore, ncore + integer :: icorelem(NELEM) + integer :: irhswell + integer :: imiertn + integer :: ienconc + real(kind=f) :: rho(NBIN), rhopwet + real(kind=f) :: r(NBIN), rmass(NBIN), rlow(NBIN), rup(NBIN) + real(kind=f) :: wave(NWAVE) + complex(kind=f) :: refidx(NWAVE, NREFIDX) + complex(kind=f) :: refidxS(NWAVE, NREFIDX) + complex(kind=f) :: refidxB(NWAVE, NREFIDX) + complex(kind=f) :: refidxD(NWAVE, NREFIDX) + complex(kind=f) :: refidxC + !real(kind=f) :: coreimagidx + character(len=CARMA_NAME_LEN) :: name + character(len=CARMA_SHORT_NAME_LEN) :: shortname + logical :: do_mie + integer :: fid + integer :: rhdim, lwdim, swdim, csrdim, dstbcrdim, kapdim + integer :: rhvar, lwvar, swvar, csr_var, dstbcr_var, kap_var + integer :: abs_lw_coreshell_var, qabs_lw_coreshell_var + integer :: ext_sw_coreshell_var, ssa_sw_coreshell_var + integer :: asm_sw_coreshell_var, qext_sw_coreshell_var + integer :: rwetvar + integer :: omdim, andim, namedim + integer :: omvar, anvar, namevar + integer :: dimids(5) + integer :: denvar, slogvar, dryrvar, rminvar, rmaxvar, hygrovar, ntmvar + real(kind=f) :: abs_lw_coreshell(NMIE_RH, nlwbands, ncoreshellratio, ndstbcratio, nkap) + real(kind=f) :: qabs_lw_coreshell(NMIE_RH, nlwbands, ncoreshellratio, ndstbcratio, nkap) + real(kind=f) :: ext_sw_coreshell(NMIE_RH, nswbands, ncoreshellratio, ndstbcratio, nkap) + real(kind=f) :: qext_sw_coreshell(NMIE_RH, nswbands, ncoreshellratio, ndstbcratio, nkap) + real(kind=f) :: ssa_sw_coreshell(NMIE_RH, nswbands, ncoreshellratio, ndstbcratio, nkap) + real(kind=f) :: asm_sw_coreshell(NMIE_RH, nswbands, ncoreshellratio, ndstbcratio, nkap) + real(kind=f) :: rwetbin(NMIE_RH) + character(len=8) :: c_name ! constituent name + character(len=32) :: aer_name ! long enough for both aername and name + character(len=255) :: filepath + real(kind=f) :: rwet + real(kind=f) :: rcore ! CORE radius used in MIE calculation + real(kind=f) :: Qext + real(kind=f) :: Qsca + real(kind=f) :: asym + integer :: start_text(2), count_text(2) + integer :: sw_r_refidx_var, sw_i_refidx_var, lw_r_refidx_var, lw_i_refidx_var + integer :: ncsr, ndbr + integer :: cnsttype ! constituent type + integer :: maxbin ! last prognostic bin + integer :: LUNOPRT ! logical unit number for output + logical :: do_print ! do print output? + integer :: ret + + character(len=32) :: elementname + + ! Assume success. + rc = 0 + + ! Get the wavelength structure. + call CARMA_GET(carma, rc, wave=wave, do_print=do_print, LUNOPRT=LUNOPRT) + if (rc < 0) call endrun('carma_CreateOpticsFile::CARMA_Get failed.') + + ! Get the necessary group properties. + call CARMAGROUP_Get(carma, igroup, rc, do_mie=do_mie, name=name, shortname=shortname, r=r, & + rlow=rlow, rup=rup, rmass=rmass, irhswell=irhswell, imiertn=imiertn, & + ienconc=ienconc, ncore=ncore, icorelem=icorelem, cnsttype=cnsttype, maxbin=maxbin) + if (rc < 0) call endrun('carma_CreateOpticsFile::CARMAGROUP_Get failed.') + + ! The concentration element has the sulfate refractive index. + call CARMAELEMENT_Get(carma, ienconc, rc, rho=rho, refidx=refidxS) + if (rc < 0) call endrun('carma_CreateOpticsFile::CARMAELEMENT_Get failed.') + + ! Need to find the dust and black carbon refractive indicies for the core. + do icore = 1, ncore + call CARMAELEMENT_Get(carma, icorelem(icore), rc, shortname=elementname, refidx=refidx) + if (rc < 0) call endrun('carma_CreateOpticsFile::CARMAELEMENT_Get failed.') + + if (trim(elementname) == 'MXBC') then + refidxB = refidx + else if (trim(elementname) == 'MXDUST') then + refidxD = refidx + end if + end do + + + ! A file needs to be created for each bin. + do ibin = 1, NBIN + + ! Bins past maxbin are treated as diagnostic even if the group + ! is prognostic and thus are not advected in the paerent model. + if (ibin <= maxbin) then + + write(c_name, '(A, I2.2)') trim(shortname), ibin + + ! Construct the path to the file. Each model will have its own subdirectory + ! where the optical property files are stored. + filepath = trim(carma_model) // '_' // trim(c_name) // '_rrtmg.nc' + + if (do_print) write(LUNOPRT,*) 'Creating CARMA optics file ... ', trim(filepath) + + ! Create the file. + call wrap_create(filepath, NF90_CLOBBER, fid) + + ncsr = ncoreshellratio + ndbr = ndstbcratio + + ! Define the dimensions: rh, lwbands, swbands + call wrap_def_dim(fid, 'rh_idx', NMIE_RH, rhdim) + call wrap_def_dim(fid, 'lw_band', nlwbands, lwdim) + call wrap_def_dim(fid, 'sw_band', nswbands, swdim) + + call wrap_def_dim(fid, 'coreshellratio', ncsr, csrdim) + call wrap_def_dim(fid, 'dstbcratio', ndbr, dstbcrdim) + call wrap_def_dim(fid, 'kap', nkap, kapdim) + + dimids(1) = rhdim + call wrap_def_var(fid, 'rh', NF90_DOUBLE, 1, dimids(1), rhvar) + call wrap_def_var(fid, 'rwet',NF90_DOUBLE, 1, dimids(1), rwetvar) + + dimids(1) = lwdim + call wrap_def_var(fid, 'lw_band', NF90_DOUBLE, 1, dimids(1), lwvar) + + dimids(1) = swdim + call wrap_def_var(fid, 'sw_band', NF90_DOUBLE, 1, dimids(1), swvar) + + dimids(1) = csrdim + call wrap_def_var(fid, 'coreshellratio', NF90_DOUBLE, 1, dimids(1), csr_var) + dimids(1) = dstbcrdim + call wrap_def_var(fid, 'dstbcratio', NF90_DOUBLE, 1, dimids(1), dstbcr_var) + dimids(1) = kapdim + call wrap_def_var(fid, 'kap', NF90_DOUBLE, 1, dimids(1), kap_var) + + + call wrap_put_att_text(fid, rhvar, 'units', 'fraction') + call wrap_put_att_text(fid, rwetvar, 'units', 'cm') + call wrap_put_att_text(fid, lwvar, 'units', 'm') + call wrap_put_att_text(fid, swvar, 'units', 'm') + + call wrap_put_att_text(fid, csr_var,'units', 'fraction') + call wrap_put_att_text(fid, dstbcr_var,'units', 'fraction') + call wrap_put_att_text(fid, kap_var,'units', 'unitless') + call wrap_put_att_text(fid, csr_var,'long_name', 'coreshell ratio') + call wrap_put_att_text(fid, dstbcr_var,'long_name', 'dust-bc ratio') + call wrap_put_att_text(fid, kap_var,'long_name', 'kappa value') + + call wrap_put_att_text(fid, rhvar, 'long_name', 'relative humidity') + call wrap_put_att_text(fid, rwetvar, 'long_name', 'wet radius') + call wrap_put_att_text(fid, lwvar, 'long_name', 'longwave bands') + call wrap_put_att_text(fid, swvar, 'long_name', 'shortwave bands') + + ! Define 3-dimension (:nrh,:nswbands,:ncoreshellratio) LW optics properties: abs_lw_coreshell, qabs_lw_coreshell + dimids(1) = rhdim + dimids(2) = lwdim + dimids(3) = csrdim + dimids(4) = dstbcrdim + dimids(5) = kapdim + call wrap_def_var(fid, 'abs_lw_coreshell', NF90_DOUBLE, 5, dimids(1:5), abs_lw_coreshell_var) + call wrap_def_var(fid, 'qabs_lw_coreshell',NF90_DOUBLE, 5, dimids(1:5), qabs_lw_coreshell_var) + + call wrap_put_att_text(fid, abs_lw_coreshell_var, 'units', 'meter^2 kilogram^-1') + call wrap_put_att_text(fid, qabs_lw_coreshell_var,'units', '-') + + ! Define 3-dimension (:nrh,:nswbands,:ncoreshellratio) SW optics properties: + ! ext_sw_coreshell, qext_sw_coreshell, ssa_sw_coreshell, asm_sw_coreshell + dimids(1) = rhdim + dimids(2) = swdim + dimids(3) = csrdim + dimids(4) = dstbcrdim + dimids(5) = kapdim + call wrap_def_var(fid, 'ext_sw_coreshell', NF90_DOUBLE, 5, dimids(1:5), ext_sw_coreshell_var) + call wrap_def_var(fid, 'qext_sw_coreshell',NF90_DOUBLE, 5, dimids(1:5), qext_sw_coreshell_var) + call wrap_def_var(fid, 'ssa_sw_coreshell', NF90_DOUBLE, 5, dimids(1:5), ssa_sw_coreshell_var) + call wrap_def_var(fid, 'asm_sw_coreshell', NF90_DOUBLE, 5, dimids(1:5), asm_sw_coreshell_var) + + call wrap_put_att_text(fid, ssa_sw_coreshell_var, 'units', 'fraction') + call wrap_put_att_text(fid, ext_sw_coreshell_var, 'units', 'meter^2 kilogram^-1') + call wrap_put_att_text(fid, qext_sw_coreshell_var,'units', '-') + call wrap_put_att_text(fid, asm_sw_coreshell_var, 'units', '-') + + ! Define the variables for the refractive indicies. + dimids(1) = swdim + call wrap_def_var(fid, 'refindex_real_aer_sw', NF90_DOUBLE, 1, dimids(1), sw_r_refidx_var) + call wrap_def_var(fid, 'refindex_im_aer_sw', NF90_DOUBLE, 1, dimids(1), sw_i_refidx_var) + + dimids(1) = lwdim + call wrap_def_var(fid, 'refindex_real_aer_lw', NF90_DOUBLE, 1, dimids(1), lw_r_refidx_var) + call wrap_def_var(fid, 'refindex_im_aer_lw', NF90_DOUBLE, 1, dimids(1), lw_i_refidx_var) + + call wrap_put_att_text(fid, sw_r_refidx_var, 'units', '-') + call wrap_put_att_text(fid, sw_i_refidx_var, 'units', '-') + call wrap_put_att_text(fid, lw_r_refidx_var, 'units', '-') + call wrap_put_att_text(fid, lw_i_refidx_var, 'units', '-') + + call wrap_put_att_text(fid, sw_r_refidx_var, 'long_name', 'real refractive index of aerosol - shortwave') + call wrap_put_att_text(fid, sw_i_refidx_var, 'long_name', 'imaginary refractive index of aerosol - shortwave') + call wrap_put_att_text(fid, lw_r_refidx_var, 'long_name', 'real refractive index of aerosol - longwave') + call wrap_put_att_text(fid, lw_i_refidx_var, 'long_name', 'imaginary refractive index of aerosol - longwave') + + ! Define fields that define the aerosol properties. + call wrap_def_dim(fid, 'opticsmethod_len', 32, omdim) + dimids(1) = omdim + call wrap_def_var(fid, 'opticsmethod', NF90_CHAR, 1, dimids(1), omvar) + + call wrap_def_dim(fid, 'namelength', 20, andim) + dimids(1) = andim + call wrap_def_var(fid, 'aername', NF90_CHAR, 1, dimids(1), anvar) + + call wrap_def_dim(fid, 'name_len', 32, namedim) + dimids(1) = namedim + call wrap_def_var(fid, 'name', NF90_CHAR, 1, dimids, namevar) + + call wrap_def_var(fid, 'density', NF90_DOUBLE, 0, dimids(1), denvar) + call wrap_def_var(fid, 'sigma_logr', NF90_DOUBLE, 0, dimids(1), slogvar) + call wrap_def_var(fid, 'dryrad', NF90_DOUBLE, 0, dimids(1), dryrvar) + call wrap_def_var(fid, 'radmin_aer', NF90_DOUBLE, 0, dimids(1), rminvar) + call wrap_def_var(fid, 'radmax_aer', NF90_DOUBLE, 0, dimids(1), rmaxvar) + call wrap_def_var(fid, 'hygroscopicity', NF90_DOUBLE, 0, dimids(1), hygrovar) + call wrap_def_var(fid, 'num_to_mass_ratio', NF90_DOUBLE, 0, dimids(1), ntmvar) + + call wrap_put_att_text(fid, denvar, 'units', 'kg m^-3') + call wrap_put_att_text(fid, slogvar, 'units', '-') + call wrap_put_att_text(fid, dryrvar, 'units', 'm') + call wrap_put_att_text(fid, rminvar, 'units', 'm') + call wrap_put_att_text(fid, rmaxvar, 'units', 'm') + call wrap_put_att_text(fid, hygrovar, 'units', '-') + call wrap_put_att_text(fid, ntmvar, 'units', 'kg^-1') + + call wrap_put_att_text(fid, denvar, 'long_name', 'aerosol material density') + call wrap_put_att_text(fid, slogvar, 'long_name', 'geometric standard deviation of aerosol') + call wrap_put_att_text(fid, dryrvar, 'long_name', 'dry number mode radius of aerosol') + call wrap_put_att_text(fid, rminvar, 'long_name', 'minimum dry radius of aerosol for bin') + call wrap_put_att_text(fid, rmaxvar, 'long_name', 'maximum dry radius of aerosol for bin') + call wrap_put_att_text(fid, hygrovar, 'long_name', 'hygroscopicity of aerosol') + call wrap_put_att_text(fid, ntmvar, 'long_name', 'ratio of number to mass of aerosol') + + ! End the defintion phase of the netcdf file. + call wrap_enddef(fid) + + ! Write out the dimensions. + call wrap_put_var_realx(fid, rhvar, mie_rh(:NMIE_RH)) + call wrap_put_var_realx(fid, lwvar, wave(:nlwbands) * 1e-2_f) + call wrap_put_var_realx(fid, swvar, wave(nlwbands+1:) * 1e-2_f) + + call wrap_put_var_realx(fid, csr_var,coreshellratio(:ncsr)) + call wrap_put_var_realx(fid, dstbcr_var,dstbcratio(:ndstbcratio)) + call wrap_put_var_realx(fid, kap_var,kap(:nkap)) + + ! Write out the refractive indicies. + call wrap_put_var_realx(fid, sw_r_refidx_var, real(refidxS(nlwbands+1:, 1))) + call wrap_put_var_realx(fid, sw_i_refidx_var, aimag(refidxS(nlwbands+1:, 1))) + call wrap_put_var_realx(fid, lw_r_refidx_var, real(refidxS(:nlwbands, 1))) + call wrap_put_var_realx(fid, lw_i_refidx_var, aimag(refidxS(:nlwbands, 1))) + + ! Pad the names out with spaces. + aer_name = ' ' + aer_name(1:len(trim(c_name))) = c_name + + start_text(1) = 1 + count_text(1) = 32 + call wrap_put_vara_text(fid, namevar, start_text, count_text, (/ aer_name /)) + count_text(1) = 20 + call wrap_put_vara_text(fid, anvar, start_text, count_text, (/ aer_name /)) + + count_text(1) = len('hygroscopic_coreshell ') + call wrap_put_vara_text(fid, omvar, start_text, count_text, (/ 'hygroscopic_coreshell ' /)) + + call wrap_put_var_realx(fid, denvar, (/ rho(ibin) * 1e-3_f / 1e-6_f /)) + call wrap_put_var_realx(fid, slogvar, (/ 0._f /)) + call wrap_put_var_realx(fid, dryrvar, (/ r(ibin) * 1e-2_f /)) + call wrap_put_var_realx(fid, rminvar, (/ rlow(ibin) * 1e-2_f /)) + call wrap_put_var_realx(fid, rmaxvar, (/ rup(ibin) * 1e-2_f /)) + call wrap_put_var_realx(fid, hygrovar, (/ 0.6_f /)) + call wrap_put_var_realx(fid, ntmvar, (/ 1._f / rmass(ibin) / 1e-3_f /)) + + ! For now, ext_sw(:nrh, :nswbands) and ext_sw_coreshell(:nrh, :nswbands, :ncoreshellratio) both are calculated + ! Since other aerosols in CAM may use ext_sw rather than ext_sw_coreshell + ! Modified by Pengfei Yu + ! April.1, 2012 + + !--------------------------- for 5-D core-shell optical properties ---------------------------- + + ! Iterate over a range of relative humidities, since the particle may swell + ! with relative humidity which will change its optical properties. + do irh = 1, NMIE_RH + + do ikap = 1, nkap + + ! Determine the wet radius. + call getwetr(carma, igroup, mie_rh(irh), r(ibin), rwet, rho(ibin), rhopwet, rc, kappa=kap(ikap), temp=270._f) + rwetbin(irh) = rwet + + ! Calculate at each wavelength. + do iwave = 1, NWAVE + + ! For now just assume BC/OC constant 15% + ! rcore = r(ibin)*(0.15**(1./3)) + ! Using Mie code, consider core/shell ratio + do icsr = 1, ncsr + if (ncsr > 1) then + rcore = r(ibin)*(coreshellratio(icsr)**(1./3)) + else + rcore = 0.0_f + endif + + ! Using Mie code, assume the particle is CORE-SHELL + ! By: Pengfei Yu + ! Mar.22, 2012 + + !write(*,*) 'before call mie-3D, icsr = ', icsr, ' ;iwave = ', iwave, ' ;irh = ', irh + !write(*,*) 'ibin = ', ibin, ' ;rcore = ', rcore, ' ;csratio = ', coreshellratio(icsr) + + do idb = 1, ndbr + + ! NOTE: This is not the best way to combine the dust and BC refractive indices + ! for the core. Volume mixing should be used for both the real and imaginary + ! parts, not just the imaginary. +! coreimagidx = dstbcratio(idb) * aimag(refidxB(iwave,1)) + (1._f - dstbcratio(idb)) * aimag(refidxD(iwave,1)) +! refidxC = cmplx((real(refidxD(iwave,1)) + real(refidxB(iwave,1))) / 2._f, coreimagidx) + refidxC = dstbcratio(idb) * refidxB(iwave,1) + (1._f - dstbcratio(idb)) * refidxD(iwave,1) + + call mie(carma, & + imiertn, & + rwet, & + wave(iwave), & + 0._f, & + 3.0_f, & + 0.0_f, & + 1.0_f, & + refidxS(iwave, 1), & + rcore, & + refidxC, & + Qext, & + Qsca, & + asym, & + rc) + if (rc < 0) call endrun('carma_CreateOpticsFile::mie failed.') + + ! Calculate the shortwave and longwave properties? + ! + ! NOTE: miess is in cgs units, but the optics file needs to be in mks + ! units, so perform the necessary conversions. + if (iwave <= nlwbands) then + + ! Longwave just needs absorption: abs_lw. + qabs_lw_coreshell(irh, iwave, icsr, idb, ikap) = (Qext - Qsca) ! absorption per particle + abs_lw_coreshell (irh, iwave, icsr, idb, ikap) = (Qext - Qsca) * PI * (rwet * 1e-2_f)**2 & + / (rmass(ibin) * 1e-3_f) + else + + ! Shortwave needs extinction, single scattering albedo and asymmetry factor: + ! ext_sw, qext_sw, ssa_sw and asm_sw. + qext_sw_coreshell(irh, iwave - nlwbands, icsr, idb, ikap) = Qext ! extinction per particle + ext_sw_coreshell (irh, iwave - nlwbands, icsr, idb, ikap) = Qext * PI * (rwet * 1e-2_f)**2 & + / (rmass(ibin) * 1e-3_f) + ssa_sw_coreshell (irh, iwave - nlwbands, icsr, idb, ikap) = Qsca / Qext + asm_sw_coreshell (irh, iwave - nlwbands, icsr, idb, ikap) = asym + end if + end do ! idb + end do ! icsr + end do ! iwave + end do ! ikap + end do ! irh + + call wrap_put_var_realx(fid, rwetvar, rwetbin(:)) + + ! Write out the longwave fields. + ret = nf90_put_var(fid, abs_lw_coreshell_var, abs_lw_coreshell (:, :, :, :, :)) + if (ret /= NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile_MixedYu: error writing varid =', abs_lw_coreshell_var + call handle_error(ret) + end if + + ret = nf90_put_var(fid, qabs_lw_coreshell_var, qabs_lw_coreshell(:, :, :, :, :)) + if (ret /= NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile_MixedYu: error writing varid =', qabs_lw_coreshell_var + call handle_error(ret) + end if + + ! Write out the shortwave fields. + ret = nf90_put_var(fid, ext_sw_coreshell_var, ext_sw_coreshell (:, :, :, :, :)) + if (ret /= NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile_MixedYu: error writing varid =', ext_sw_coreshell_var + call handle_error(ret) + end if + + ret = nf90_put_var(fid, qext_sw_coreshell_var, qext_sw_coreshell(:, :, :, :, :)) + if (ret /= NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile_MixedYu: error writing varid =', qext_sw_coreshell_var + call handle_error(ret) + end if + + ret = nf90_put_var(fid, ssa_sw_coreshell_var, ssa_sw_coreshell (:, :, :, :, :)) + if (ret /= NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile_MixedYu: error writing varid =', ssa_sw_coreshell_var + call handle_error(ret) + end if + + ret = nf90_put_var(fid, asm_sw_coreshell_var, asm_sw_coreshell (:, :, :, :, :)) + if (ret /= NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile_MixedYu: error writing varid =', asm_sw_coreshell_var + call handle_error(ret) + end if + + ! Close the file. + call wrap_close(fid) + end if + end do + + return + end subroutine CARMAMODEL_CreateOpticsFile_MixedYu + + !! This routine creates files containing optical properties for the mixed group + !! following Yu et al. (2015), except that it includes water vapor in the shell. + !! The difference between the wet and dry radius is assumed to be water valor and + !! the shell is a volume mix of the H2SO4 and the water. These optical properties + !! are used by the RRTMG radiation code to include the impact of CARMA particles + !! in the radiative transfer calculation. + !! + !! NOTE: The table structure is the same as for MixedYu, so no changes need to be + !! made on the CAM side to use these optics. + subroutine CARMAMODEL_CreateOpticsFile_MixedYuH2o(carma, igroup, rc) + use radconstants, only : nswbands, nlwbands + use wrap_nf + use wetr, only : getwetr + + implicit none + + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(in) :: igroup !! group index + integer, intent(out) :: rc !! return code, negative indicates failure + + !! Core-shell mixing method for mie and radiation calculations for the Yu et al. (2015) + !! style table. The CAM optics code will interpolate based upon the current core/shell + !! mass ratio from a table built using the specified core/shell. + integer, parameter :: ncoreshellratio = 9 !! Number of core/shell ratio for mie calculations + integer, parameter :: ndstbcratio = 8 + integer, parameter :: nkap = 9 + + real(kind=f) :: coreshellratio(ncoreshellratio) = (/ 0.001_f, 0.00237_f, 0.00562_f, 0.01333_f, 0.03162_f, 0.07499_f, 0.17782_f, 0.42169_f, 1.0_f /) + real(kind=f) :: dstbcratio(ndstbcratio) = (/ 0.01_f, 0.025_f, 0.063_f, 0.1_f, 0.3_f, 0.5_f, 0.7_f, 0.9_f/) + real(kind=f) :: kap(nkap) = (/ 0.1_f, 0.2_f, 0.3_f, 0.4_f, 0.5_f, 0.7_f, 0.9_f, 1.1_f, 1.2_f/) + + ! Local variables + integer :: ibin, iwave, irh, icsr, idb, ikap, icore, ncore + integer :: icorelem(NELEM) + integer :: irhswell + integer :: imiertn + integer :: ienconc + real(kind=f) :: rho(NBIN), rhopwet + real(kind=f) :: r(NBIN), rmass(NBIN), rlow(NBIN), rup(NBIN) + real(kind=f) :: wave(NWAVE) + complex(kind=f) :: refidx(NWAVE, NREFIDX) + complex(kind=f) :: refidxS(NWAVE, NREFIDX) + complex(kind=f) :: refidxB(NWAVE, NREFIDX) + complex(kind=f) :: refidxD(NWAVE, NREFIDX) + complex(kind=f) :: refidxW(NWAVE) + complex(kind=f) :: refidxC + complex(kind=f) :: refidxSH + !real(kind=f) :: coreimagidx + character(len=CARMA_NAME_LEN) :: name + character(len=CARMA_SHORT_NAME_LEN) :: shortname + logical :: do_mie + integer :: fid + integer :: rhdim, lwdim, swdim, csrdim, dstbcrdim, kapdim + integer :: rhvar, lwvar, swvar, csr_var, dstbcr_var, kap_var + integer :: abs_lw_coreshell_var, qabs_lw_coreshell_var + integer :: ext_sw_coreshell_var, ssa_sw_coreshell_var, asm_sw_coreshell_var, qext_sw_coreshell_var + integer :: rwetvar + integer :: omdim, andim, namedim + integer :: omvar, anvar, namevar + integer :: dimids(5) + integer :: denvar, slogvar, dryrvar, rminvar, rmaxvar, hygrovar, ntmvar + real(kind=f) :: abs_lw_coreshell(NMIE_RH, nlwbands, ncoreshellratio, ndstbcratio, nkap) + real(kind=f) :: qabs_lw_coreshell(NMIE_RH, nlwbands, ncoreshellratio, ndstbcratio, nkap) + real(kind=f) :: ext_sw_coreshell(NMIE_RH, nswbands, ncoreshellratio, ndstbcratio, nkap) + real(kind=f) :: qext_sw_coreshell(NMIE_RH, nswbands, ncoreshellratio, ndstbcratio, nkap) + real(kind=f) :: ssa_sw_coreshell(NMIE_RH, nswbands, ncoreshellratio, ndstbcratio, nkap) + real(kind=f) :: asm_sw_coreshell(NMIE_RH, nswbands, ncoreshellratio, ndstbcratio, nkap) + real(kind=f) :: rwetbin(NMIE_RH) + character(len=8) :: c_name ! constituent name + character(len=32) :: aer_name ! long enough for both aername and name + character(len=255) :: filepath + real(kind=f) :: rwet + real(kind=f) :: rcore ! CORE radius used in MIE calculation + real(kind=f) :: Qext + real(kind=f) :: Qsca + real(kind=f) :: asym + integer :: start_text(2), count_text(2) + integer :: sw_r_refidx_var, sw_i_refidx_var, lw_r_refidx_var, lw_i_refidx_var + integer :: ncsr, ndbr + integer :: cnsttype ! constituent type + integer :: maxbin ! last prognostic bin + integer :: LUNOPRT ! logical unit number for output + logical :: do_print ! do print output? + integer :: ret + real(kind=f) :: volwater + real(kind=f) :: volsulfate + real(kind=f) :: volshell + integer :: igash2o + + character(len=32) :: elementname + + ! Assume success. + rc = 0 + + ! Get the wavelength structure. + call CARMA_GET(carma, rc, wave=wave, do_print=do_print, LUNOPRT=LUNOPRT, igash2o=igash2o) + if (rc < 0) call endrun('carma_CreateOpticsFile::CARMA_Get failed.') + + ! Get the necessary group properties. + call CARMAGROUP_Get(carma, igroup, rc, do_mie=do_mie, name=name, shortname=shortname, r=r, & + rlow=rlow, rup=rup, rmass=rmass, irhswell=irhswell, imiertn=imiertn, & + ienconc=ienconc, ncore=ncore, icorelem=icorelem, cnsttype=cnsttype, maxbin=maxbin) + if (rc < 0) call endrun('carma_CreateOpticsFile::CARMAGROUP_Get failed.') + + ! The concentration element has the sulfate refractive index. + call CARMAELEMENT_Get(carma, ienconc, rc, rho=rho, refidx=refidxS) + if (rc < 0) call endrun('carma_CreateOpticsFile::CARMAELEMENT_Get failed.') + + ! Need to find the dust and black carbon refractive indicies for the core. + do icore = 1, ncore + call CARMAELEMENT_Get(carma, icorelem(icore), rc, shortname=elementname, refidx=refidx) + if (rc < 0) call endrun('carma_CreateOpticsFile::CARMAELEMENT_Get failed.') + + if (trim(elementname) == 'MXBC') then + refidxB = refidx + else if (trim(elementname) == 'MXDUST') then + refidxD = refidx + end if + end do + + ! Get the refractive index for water. + call CARMAGAS_Get(carma, igash2o, rc, refidx=refidxW) + if (rc < 0) call endrun('carma_CreateOpticsFile::CARMAGAS_Get failed.') + + refidxW(:) = CMPLX(waterreal(:), waterimag(:), kind=f) + + ! A file needs to be created for each bin. + do ibin = 1, NBIN + + ! Bins past maxbin are treated as diagnostic even if the group + ! is prognostic and thus are not advected in the paerent model. + if (ibin <= maxbin) then + + write(c_name, '(A, I2.2)') trim(shortname), ibin + + ! Construct the path to the file. Each model will have its own subdirectory + ! where the optical property files are stored. + filepath = trim(carma_model) // '_' // trim(c_name) // '_rrtmg.nc' + + if (do_print) write(LUNOPRT,*) 'Creating CARMA optics file ... ', trim(filepath) + + ! Create the file. + call wrap_create(filepath, NF90_CLOBBER, fid) + + ncsr = ncoreshellratio + ndbr = ndstbcratio + + ! Define the dimensions: rh, lwbands, swbands + call wrap_def_dim(fid, 'rh_idx', NMIE_RH, rhdim) + call wrap_def_dim(fid, 'lw_band', nlwbands, lwdim) + call wrap_def_dim(fid, 'sw_band', nswbands, swdim) + + call wrap_def_dim(fid, 'coreshellratio', ncsr, csrdim) + call wrap_def_dim(fid, 'dstbcratio', ndbr, dstbcrdim) + call wrap_def_dim(fid, 'kap', nkap, kapdim) + + dimids(1) = rhdim + call wrap_def_var(fid, 'rh', NF90_DOUBLE, 1, dimids(1), rhvar) + call wrap_def_var(fid, 'rwet',NF90_DOUBLE, 1, dimids(1), rwetvar) + + dimids(1) = lwdim + call wrap_def_var(fid, 'lw_band', NF90_DOUBLE, 1, dimids(1), lwvar) + + dimids(1) = swdim + call wrap_def_var(fid, 'sw_band', NF90_DOUBLE, 1, dimids(1), swvar) + + dimids(1) = csrdim + call wrap_def_var(fid, 'coreshellratio', NF90_DOUBLE, 1, dimids(1), csr_var) + dimids(1) = dstbcrdim + call wrap_def_var(fid, 'dstbcratio', NF90_DOUBLE, 1, dimids(1), dstbcr_var) + dimids(1) = kapdim + call wrap_def_var(fid, 'kap', NF90_DOUBLE, 1, dimids(1), kap_var) + + + call wrap_put_att_text(fid, rhvar, 'units', 'fraction') + call wrap_put_att_text(fid, rwetvar, 'units', 'cm') + call wrap_put_att_text(fid, lwvar, 'units', 'm') + call wrap_put_att_text(fid, swvar, 'units', 'm') + + call wrap_put_att_text(fid, csr_var,'units', 'fraction') + call wrap_put_att_text(fid, dstbcr_var,'units', 'fraction') + call wrap_put_att_text(fid, kap_var,'units', 'unitless') + call wrap_put_att_text(fid, csr_var,'long_name', 'coreshell ratio') + call wrap_put_att_text(fid, dstbcr_var,'long_name', 'dust-bc ratio') + call wrap_put_att_text(fid, kap_var,'long_name', 'kappa value') + + call wrap_put_att_text(fid, rhvar, 'long_name', 'relative humidity') + call wrap_put_att_text(fid, rwetvar, 'long_name', 'wet radius') + call wrap_put_att_text(fid, lwvar, 'long_name', 'longwave bands') + call wrap_put_att_text(fid, swvar, 'long_name', 'shortwave bands') + + ! Define 3-dimension (:nrh,:nswbands,:ncoreshellratio) LW optics properties: abs_lw_coreshell, qabs_lw_coreshell + dimids(1) = rhdim + dimids(2) = lwdim + dimids(3) = csrdim + dimids(4) = dstbcrdim + dimids(5) = kapdim + call wrap_def_var(fid, 'abs_lw_coreshell', NF90_DOUBLE, 5, dimids(1:5), abs_lw_coreshell_var) + call wrap_def_var(fid, 'qabs_lw_coreshell',NF90_DOUBLE, 5, dimids(1:5), qabs_lw_coreshell_var) + + call wrap_put_att_text(fid, abs_lw_coreshell_var, 'units', 'meter^2 kilogram^-1') + call wrap_put_att_text(fid, qabs_lw_coreshell_var,'units', '-') + + ! Define 3-dimension (:nrh,:nswbands,:ncoreshellratio) SW optics properties: + ! ext_sw_coreshell, qext_sw_coreshell, ssa_sw_coreshell, asm_sw_coreshell + dimids(1) = rhdim + dimids(2) = swdim + dimids(3) = csrdim + dimids(4) = dstbcrdim + dimids(5) = kapdim + call wrap_def_var(fid, 'ext_sw_coreshell', NF90_DOUBLE, 5, dimids(1:5), ext_sw_coreshell_var) + call wrap_def_var(fid, 'qext_sw_coreshell',NF90_DOUBLE, 5, dimids(1:5), qext_sw_coreshell_var) + call wrap_def_var(fid, 'ssa_sw_coreshell', NF90_DOUBLE, 5, dimids(1:5), ssa_sw_coreshell_var) + call wrap_def_var(fid, 'asm_sw_coreshell', NF90_DOUBLE, 5, dimids(1:5), asm_sw_coreshell_var) + + call wrap_put_att_text(fid, ssa_sw_coreshell_var, 'units', 'fraction') + call wrap_put_att_text(fid, ext_sw_coreshell_var, 'units', 'meter^2 kilogram^-1') + call wrap_put_att_text(fid, qext_sw_coreshell_var,'units', '-') + call wrap_put_att_text(fid, asm_sw_coreshell_var, 'units', '-') + + ! Define the variables for the refractive indicies. + dimids(1) = swdim + call wrap_def_var(fid, 'refindex_real_aer_sw', NF90_DOUBLE, 1, dimids(1), sw_r_refidx_var) + call wrap_def_var(fid, 'refindex_im_aer_sw', NF90_DOUBLE, 1, dimids(1), sw_i_refidx_var) + + dimids(1) = lwdim + call wrap_def_var(fid, 'refindex_real_aer_lw', NF90_DOUBLE, 1, dimids(1), lw_r_refidx_var) + call wrap_def_var(fid, 'refindex_im_aer_lw', NF90_DOUBLE, 1, dimids(1), lw_i_refidx_var) + + call wrap_put_att_text(fid, sw_r_refidx_var, 'units', '-') + call wrap_put_att_text(fid, sw_i_refidx_var, 'units', '-') + call wrap_put_att_text(fid, lw_r_refidx_var, 'units', '-') + call wrap_put_att_text(fid, lw_i_refidx_var, 'units', '-') + + call wrap_put_att_text(fid, sw_r_refidx_var, 'long_name', 'real refractive index of aerosol - shortwave') + call wrap_put_att_text(fid, sw_i_refidx_var, 'long_name', 'imaginary refractive index of aerosol - shortwave') + call wrap_put_att_text(fid, lw_r_refidx_var, 'long_name', 'real refractive index of aerosol - longwave') + call wrap_put_att_text(fid, lw_i_refidx_var, 'long_name', 'imaginary refractive index of aerosol - longwave') + + ! Define fields that define the aerosol properties. + call wrap_def_dim(fid, 'opticsmethod_len', 32, omdim) + dimids(1) = omdim + call wrap_def_var(fid, 'opticsmethod', NF90_CHAR, 1, dimids(1), omvar) + + call wrap_def_dim(fid, 'namelength', 20, andim) + dimids(1) = andim + call wrap_def_var(fid, 'aername', NF90_CHAR, 1, dimids(1), anvar) + + call wrap_def_dim(fid, 'name_len', 32, namedim) + dimids(1) = namedim + call wrap_def_var(fid, 'name', NF90_CHAR, 1, dimids, namevar) + + call wrap_def_var(fid, 'density', NF90_DOUBLE, 0, dimids(1), denvar) + call wrap_def_var(fid, 'sigma_logr', NF90_DOUBLE, 0, dimids(1), slogvar) + call wrap_def_var(fid, 'dryrad', NF90_DOUBLE, 0, dimids(1), dryrvar) + call wrap_def_var(fid, 'radmin_aer', NF90_DOUBLE, 0, dimids(1), rminvar) + call wrap_def_var(fid, 'radmax_aer', NF90_DOUBLE, 0, dimids(1), rmaxvar) + call wrap_def_var(fid, 'hygroscopicity', NF90_DOUBLE, 0, dimids(1), hygrovar) + call wrap_def_var(fid, 'num_to_mass_ratio', NF90_DOUBLE, 0, dimids(1), ntmvar) + + call wrap_put_att_text(fid, denvar, 'units', 'kg m^-3') + call wrap_put_att_text(fid, slogvar, 'units', '-') + call wrap_put_att_text(fid, dryrvar, 'units', 'm') + call wrap_put_att_text(fid, rminvar, 'units', 'm') + call wrap_put_att_text(fid, rmaxvar, 'units', 'm') + call wrap_put_att_text(fid, hygrovar, 'units', '-') + call wrap_put_att_text(fid, ntmvar, 'units', 'kg^-1') + + call wrap_put_att_text(fid, denvar, 'long_name', 'aerosol material density') + call wrap_put_att_text(fid, slogvar, 'long_name', 'geometric standard deviation of aerosol') + call wrap_put_att_text(fid, dryrvar, 'long_name', 'dry number mode radius of aerosol') + call wrap_put_att_text(fid, rminvar, 'long_name', 'minimum dry radius of aerosol for bin') + call wrap_put_att_text(fid, rmaxvar, 'long_name', 'maximum dry radius of aerosol for bin') + call wrap_put_att_text(fid, hygrovar, 'long_name', 'hygroscopicity of aerosol') + call wrap_put_att_text(fid, ntmvar, 'long_name', 'ratio of number to mass of aerosol') + + ! End the defintion phase of the netcdf file. + call wrap_enddef(fid) + + ! Write out the dimensions. + call wrap_put_var_realx(fid, rhvar, mie_rh(:NMIE_RH)) + call wrap_put_var_realx(fid, lwvar, wave(:nlwbands) * 1e-2_f) + call wrap_put_var_realx(fid, swvar, wave(nlwbands+1:) * 1e-2_f) + + call wrap_put_var_realx(fid, csr_var,coreshellratio(:ncsr)) + call wrap_put_var_realx(fid, dstbcr_var,dstbcratio(:ndstbcratio)) + call wrap_put_var_realx(fid, kap_var,kap(:nkap)) + + ! Write out the refractive indicies. + call wrap_put_var_realx(fid, sw_r_refidx_var, real(refidxS(nlwbands+1:, 1))) + call wrap_put_var_realx(fid, sw_i_refidx_var, aimag(refidxS(nlwbands+1:, 1))) + call wrap_put_var_realx(fid, lw_r_refidx_var, real(refidxS(:nlwbands, 1))) + call wrap_put_var_realx(fid, lw_i_refidx_var, aimag(refidxS(:nlwbands, 1))) + + ! Pad the names out with spaces. + aer_name = ' ' + aer_name(1:len(trim(c_name))) = c_name + + start_text(1) = 1 + count_text(1) = 32 + call wrap_put_vara_text(fid, namevar, start_text, count_text, (/ aer_name /)) + count_text(1) = 20 + call wrap_put_vara_text(fid, anvar, start_text, count_text, (/ aer_name /)) + + count_text(1) = len('hygroscopic_coreshell ') + call wrap_put_vara_text(fid, omvar, start_text, count_text, (/ 'hygroscopic_coreshell ' /)) + + call wrap_put_var_realx(fid, denvar, (/ rho(ibin) * 1e-3_f / 1e-6_f /)) + call wrap_put_var_realx(fid, slogvar, (/ 0._f /)) + call wrap_put_var_realx(fid, dryrvar, (/ r(ibin) * 1e-2_f /)) + call wrap_put_var_realx(fid, rminvar, (/ rlow(ibin) * 1e-2_f /)) + call wrap_put_var_realx(fid, rmaxvar, (/ rup(ibin) * 1e-2_f /)) + call wrap_put_var_realx(fid, hygrovar, (/ 0.6_f /)) + call wrap_put_var_realx(fid, ntmvar, (/ 1._f / rmass(ibin) / 1e-3_f /)) + + ! For now, ext_sw(:nrh, :nswbands) and ext_sw_coreshell(:nrh, :nswbands, :ncoreshellratio) both are calculated + ! Since other aerosols in CAM may use ext_sw rather than ext_sw_coreshell + ! Modified by Pengfei Yu + ! April.1, 2012 + + !--------------------------- for 5-D core-shell optical properties ---------------------------- + + ! Iterate over a range of relative humidities, since the particle may swell + ! with relative humidity which will change its optical properties. + do irh = 1, NMIE_RH + + do ikap = 1, nkap + + ! Determine the wet radius. + call getwetr(carma, igroup, mie_rh(irh), r(ibin), rwet, rho(ibin), rhopwet, rc, kappa=kap(ikap), temp=270._f) + rwetbin(irh) = rwet + + ! Calculate at each wavelength. + do iwave = 1, NWAVE + + ! For now just assume BC/OC constant 15% + ! rcore = r(ibin)*(0.15**(1./3)) + ! Using Mie code, consider core/shell ratio + do icsr = 1, ncsr + if (ncsr > 1) then + rcore = r(ibin)*(coreshellratio(icsr)**(1./3)) + else + rcore = 0.0_f + endif + + ! This is not in Yu (2015), but rather than using the refractive + ! index of H2SO4 for the shell, do a volume mix of water and H2SO4 + ! for the refractive index of the shell. + volwater = rwet**3._f - r(ibin)**3._f + volsulfate = r(ibin)**3._f * (1._f - coreshellratio(icsr)) + volshell = volwater + volsulfate + if (volshell > 0._f) then + refidxSH = (volwater / volshell) * refidxW(iwave) + (volsulfate / volshell) * refidxS(iwave, 1) + else + refidxSH = refidxS(iwave, 1) + end if + + ! Using Mie code, assume the particle is CORE-SHELL + ! By: Pengfei Yu + ! Mar.22, 2012 + + !write(*,*) 'before call mie-3D, icsr = ', icsr, ' ;iwave = ', iwave, ' ;irh = ', irh + !write(*,*) 'ibin = ', ibin, ' ;rcore = ', rcore, ' ;csratio = ', coreshellratio(icsr) + + do idb = 1, ndbr + + ! NOTE: This is not the best way to combine the dust and BC refractive indices + ! for the core. Volume mixing should be used for both the real and imaginary + ! parts, not just the imaginary. +! coreimagidx = dstbcratio(idb) * aimag(refidxB(iwave,1)) + (1._f - dstbcratio(idb)) * aimag(refidxD(iwave,1)) +! refidxC = cmplx((real(refidxD(iwave,1)) + real(refidxB(iwave,1))) / 2._f, coreimagidx) + refidxC = dstbcratio(idb) * refidxB(iwave,1) + (1._f - dstbcratio(idb)) * refidxD(iwave,1) + + call mie(carma, & + imiertn, & + rwet, & + wave(iwave), & + 0._f, & + 3.0_f, & + 0.0_f, & + 1.0_f, & + refidxSH, & + rcore, & + refidxC, & + Qext, & + Qsca, & + asym, & + rc) + if (rc < 0) call endrun('carma_CreateOpticsFile::mie failed.') + + ! Calculate the shortwave and longwave properties? + ! + ! NOTE: miess is in cgs units, but the optics file needs to be in mks + ! units, so perform the necessary conversions. + if (iwave <= nlwbands) then + + ! Longwave just needs absorption: abs_lw. + qabs_lw_coreshell(irh, iwave, icsr, idb, ikap) = (Qext - Qsca) ! absorption per particle + abs_lw_coreshell (irh, iwave, icsr, idb, ikap) = (Qext - Qsca) * PI * (rwet * 1e-2_f)**2 / (rmass(ibin) * 1e-3_f) + else + + ! Shortwave needs extinction, single scattering albedo and asymmetry factor: + ! ext_sw, qext_sw, ssa_sw and asm_sw. + qext_sw_coreshell(irh, iwave - nlwbands, icsr, idb, ikap) = Qext ! extinction per particle + ext_sw_coreshell (irh, iwave - nlwbands, icsr, idb, ikap) = Qext * PI * (rwet * 1e-2_f)**2 / (rmass(ibin) * 1e-3_f) + ssa_sw_coreshell (irh, iwave - nlwbands, icsr, idb, ikap) = Qsca / Qext + asm_sw_coreshell (irh, iwave - nlwbands, icsr, idb, ikap) = asym + end if + end do ! idb + end do ! icsr + end do ! iwave + end do ! ikap + end do ! irh + + call wrap_put_var_realx(fid, rwetvar, rwetbin(:)) + + ! Write out the longwave fields. + ret = nf90_put_var(fid, abs_lw_coreshell_var, abs_lw_coreshell (:, :, :, :, :)) + if (ret /= NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile_MixedYu: error writing varid =', abs_lw_coreshell_var + call handle_error(ret) + end if + + ret = nf90_put_var(fid, qabs_lw_coreshell_var, qabs_lw_coreshell(:, :, :, :, :)) + if (ret /= NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile_MixedYu: error writing varid =', qabs_lw_coreshell_var + call handle_error(ret) + end if + + ! Write out the shortwave fields. + ret = nf90_put_var(fid, ext_sw_coreshell_var, ext_sw_coreshell (:, :, :, :, :)) + if (ret /= NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile_MixedYu: error writing varid =', ext_sw_coreshell_var + call handle_error(ret) + end if + + ret = nf90_put_var(fid, qext_sw_coreshell_var, qext_sw_coreshell(:, :, :, :, :)) + if (ret /= NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile_MixedYu: error writing varid =', qext_sw_coreshell_var + call handle_error(ret) + end if + + ret = nf90_put_var(fid, ssa_sw_coreshell_var, ssa_sw_coreshell (:, :, :, :, :)) + if (ret /= NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile_MixedYu: error writing varid =', ssa_sw_coreshell_var + call handle_error(ret) + end if + + ret = nf90_put_var(fid, asm_sw_coreshell_var, asm_sw_coreshell (:, :, :, :, :)) + if (ret /= NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile_MixedYu: error writing varid =', asm_sw_coreshell_var + call handle_error(ret) + end if + + ! Close the file. + call wrap_close(fid) + end if + end do + + return + end subroutine CARMAMODEL_CreateOpticsFile_MixedYuH2o + + + !! This routine creates files containing optical properties for the pure sulfate group + !! following Yu et al. (2015). These optical properties are used by the RRTMG radiation + !! code to include the impact of CARMA particles in the radiative transfer + !! calculation. + subroutine CARMAMODEL_CreateOpticsFile_SulfateYu(carma, igroup, rc) + use radconstants, only : nswbands, nlwbands + use wrap_nf + use wetr, only : getwetr + + implicit none + + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(in) :: igroup !! group index + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Local variables + integer :: ibin, iwave, iwtp + integer :: irhswell + integer :: imiertn + integer :: ienconc + real(kind=f) :: rho(NBIN), rhopwet + real(kind=f) :: r(NBIN), rmass(NBIN), rlow(NBIN), rup(NBIN) + real(kind=f) :: wave(NWAVE) + complex(kind=f) :: refidx(NWAVE, NREFIDX) + character(len=CARMA_NAME_LEN) :: name + character(len=CARMA_SHORT_NAME_LEN) :: shortname + integer :: fid + integer :: rhdim, lwdim, swdim, wtpdim + integer :: rhvar, lwvar, swvar, wtp_var + integer :: rwetvar + integer :: abs_lw_wtp_var, qabs_lw_wtp_var + integer :: ext_sw_wtp_var, ssa_sw_wtp_var, asm_sw_wtp_var, qext_sw_wtp_var + integer :: omdim, andim, namedim + integer :: omvar, anvar, namevar + integer :: dimids(2) + integer :: denvar, slogvar, dryrvar, rminvar, rmaxvar, hygrovar, ntmvar + real(kind=f) :: abs_lw_wtp(NMIE_WTP, nlwbands) + real(kind=f) :: qabs_lw_wtp(NMIE_WTP, nlwbands) + real(kind=f) :: ext_sw_wtp(NMIE_WTP, nswbands) + real(kind=f) :: qext_sw_wtp(NMIE_WTP, nswbands) + real(kind=f) :: ssa_sw_wtp(NMIE_WTP, nswbands) + real(kind=f) :: asm_sw_wtp(NMIE_WTP, nswbands) + character(len=8) :: c_name ! constituent name + character(len=32) :: aer_name ! long enough for both aername and name + character(len=255) :: filepath + real(kind=f) :: rwet + real(kind=f) :: Qext + real(kind=f) :: Qsca + real(kind=f) :: asym + integer :: start_text(2), count_text(2) + integer :: sw_r_refidx_var, sw_i_refidx_var, lw_r_refidx_var, lw_i_refidx_var + integer :: cnsttype ! constituent type + integer :: maxbin ! last prognostic bin + integer :: LUNOPRT ! logical unit number for output + logical :: do_print ! do print output? + integer :: ret + + + ! Assume success. + rc = 0 + + ! Get the wavelength structure. + call CARMA_GET(carma, rc, wave=wave, do_print=do_print, LUNOPRT=LUNOPRT) + if (rc < 0) call endrun('carma_CreateOpticsFile::CARMA_Get failed.') + + ! Get the necessary group properties. + call CARMAGROUP_Get(carma, igroup, rc, name=name, shortname=shortname, r=r, & + rlow=rlow, rup=rup, rmass=rmass, irhswell=irhswell, & + ienconc=ienconc, cnsttype=cnsttype, maxbin=maxbin, imiertn=imiertn) + if (rc < 0) call endrun('carma_CreateOpticsFile::CARMAGROUP_Get failed.') + + ! Get the necessary element properties. + call CARMAELEMENT_Get(carma, ienconc, rc, rho=rho, refidx=refidx) + if (rc < 0) call endrun('carma_CreateOpticsFile::CARMAELEMENT_Get failed.') + + ! A file needs to be created for each bin. + do ibin = 1, NBIN + + ! Bins past maxbin are treated as diagnostic even if the group + ! is prognostic and thus are not advected in the paerent model. + if (ibin <= maxbin) then + + write(c_name, '(A, I2.2)') trim(shortname), ibin + + ! Construct the path to the file. Each model will have its own subdirectory + ! where the optical property files are stored. + filepath = trim(carma_model) // '_' // trim(c_name) // '_rrtmg.nc' + + if (do_print) write(LUNOPRT,*) 'Creating CARMA optics file ... ', trim(filepath) + + ! Create the file. + call wrap_create(filepath, NF90_CLOBBER, fid) + + ! Define the dimensions: rh, lwbands, swbands + call wrap_def_dim(fid, 'rh_idx', NMIE_RH, rhdim) + call wrap_def_dim(fid, 'lw_band', nlwbands, lwdim) + call wrap_def_dim(fid, 'sw_band', nswbands, swdim) + + call wrap_def_dim(fid, 'wgtpct', NMIE_WTP, wtpdim) + + dimids(1) = rhdim + call wrap_def_var(fid, 'rh', NF90_DOUBLE, 1, dimids(1), rhvar) + call wrap_def_var(fid, 'rwet',NF90_DOUBLE, 1, dimids(1), rwetvar) + + dimids(1) = lwdim + call wrap_def_var(fid, 'lw_band', NF90_DOUBLE, 1, dimids(1), lwvar) + + dimids(1) = swdim + call wrap_def_var(fid, 'sw_band', NF90_DOUBLE, 1, dimids(1), swvar) + + dimids(1) = wtpdim + call wrap_def_var(fid, 'wgtpct', NF90_DOUBLE, 1, dimids(1), wtp_var) + + call wrap_put_att_text(fid, rhvar, 'units', 'fraction') + call wrap_put_att_text(fid, rwetvar, 'units', 'cm') + call wrap_put_att_text(fid, lwvar, 'units', 'm') + call wrap_put_att_text(fid, swvar, 'units', 'm') + + call wrap_put_att_text(fid, wtp_var,'units', 'unitless') + call wrap_put_att_text(fid, wtp_var,'long_name', 'weight percent') + + call wrap_put_att_text(fid, rhvar, 'long_name', 'relative humidity') + call wrap_put_att_text(fid, rwetvar, 'long_name', 'wet radius') + call wrap_put_att_text(fid, lwvar, 'long_name', 'longwave bands') + call wrap_put_att_text(fid, swvar, 'long_name', 'shortwave bands') + + ! Define the variables: abs_lw, ext_sw, ssa_sw, asm_sw + ! Define 2-dimension (:nrh,:nswbands) LW optics properties: abs_lw, qabs_lw + dimids(1) = wtpdim + dimids(2) = lwdim + call wrap_def_var(fid, 'abs_lw_wtp', NF90_DOUBLE, 2, dimids(1:2), abs_lw_wtp_var) + call wrap_def_var(fid, 'qabs_lw_wtp',NF90_DOUBLE, 2, dimids(1:2), qabs_lw_wtp_var) + + call wrap_put_att_text(fid, abs_lw_wtp_var, 'units', 'meter^2 kilogram^-1') + call wrap_put_att_text(fid, qabs_lw_wtp_var,'units', '-') + + ! Define 2-dimension (:nrh,:nswbands) optics properties: ext_sw, qext_sw, ssa_sw, asm_sw + dimids(1) = wtpdim + dimids(2) = swdim + call wrap_def_var(fid, 'ext_sw_wtp', NF90_DOUBLE, 2, dimids(1:2), ext_sw_wtp_var) + call wrap_def_var(fid, 'qext_sw_wtp',NF90_DOUBLE, 2, dimids(1:2), qext_sw_wtp_var) + call wrap_def_var(fid, 'ssa_sw_wtp', NF90_DOUBLE, 2, dimids(1:2), ssa_sw_wtp_var) + call wrap_def_var(fid, 'asm_sw_wtp', NF90_DOUBLE, 2, dimids(1:2), asm_sw_wtp_var) + + call wrap_put_att_text(fid, ssa_sw_wtp_var, 'units', 'fraction') + call wrap_put_att_text(fid, qext_sw_wtp_var,'units', '-') + call wrap_put_att_text(fid, ext_sw_wtp_var, 'units', 'meter^2 kilogram^-1') + call wrap_put_att_text(fid, asm_sw_wtp_var, 'units', '-') + + ! Define the variables for the refractive indicies. + dimids(1) = swdim + call wrap_def_var(fid, 'refindex_real_aer_sw', NF90_DOUBLE, 1, dimids(1), sw_r_refidx_var) + call wrap_def_var(fid, 'refindex_im_aer_sw', NF90_DOUBLE, 1, dimids(1), sw_i_refidx_var) + + dimids(1) = lwdim + call wrap_def_var(fid, 'refindex_real_aer_lw', NF90_DOUBLE, 1, dimids(1), lw_r_refidx_var) + call wrap_def_var(fid, 'refindex_im_aer_lw', NF90_DOUBLE, 1, dimids(1), lw_i_refidx_var) + + call wrap_put_att_text(fid, sw_r_refidx_var, 'units', '-') + call wrap_put_att_text(fid, sw_i_refidx_var, 'units', '-') + call wrap_put_att_text(fid, lw_r_refidx_var, 'units', '-') + call wrap_put_att_text(fid, lw_i_refidx_var, 'units', '-') + + call wrap_put_att_text(fid, sw_r_refidx_var, 'long_name', 'real refractive index of aerosol - shortwave') + call wrap_put_att_text(fid, sw_i_refidx_var, 'long_name', 'imaginary refractive index of aerosol - shortwave') + call wrap_put_att_text(fid, lw_r_refidx_var, 'long_name', 'real refractive index of aerosol - longwave') + call wrap_put_att_text(fid, lw_i_refidx_var, 'long_name', 'imaginary refractive index of aerosol - longwave') + + + ! Define fields that define the aerosol properties. + call wrap_def_dim(fid, 'opticsmethod_len', 32, omdim) + dimids(1) = omdim + call wrap_def_var(fid, 'opticsmethod', NF90_CHAR, 1, dimids(1), omvar) + + call wrap_def_dim(fid, 'namelength', 20, andim) + dimids(1) = andim + call wrap_def_var(fid, 'aername', NF90_CHAR, 1, dimids(1), anvar) + + call wrap_def_dim(fid, 'name_len', 32, namedim) + dimids(1) = namedim + call wrap_def_var(fid, 'name', NF90_CHAR, 1, dimids, namevar) + + call wrap_def_var(fid, 'density', NF90_DOUBLE, 0, dimids(1), denvar) + call wrap_def_var(fid, 'sigma_logr', NF90_DOUBLE, 0, dimids(1), slogvar) + call wrap_def_var(fid, 'dryrad', NF90_DOUBLE, 0, dimids(1), dryrvar) + call wrap_def_var(fid, 'radmin_aer', NF90_DOUBLE, 0, dimids(1), rminvar) + call wrap_def_var(fid, 'radmax_aer', NF90_DOUBLE, 0, dimids(1), rmaxvar) + call wrap_def_var(fid, 'hygroscopicity', NF90_DOUBLE, 0, dimids(1), hygrovar) + call wrap_def_var(fid, 'num_to_mass_ratio', NF90_DOUBLE, 0, dimids(1), ntmvar) + + call wrap_put_att_text(fid, denvar, 'units', 'kg m^-3') + call wrap_put_att_text(fid, slogvar, 'units', '-') + call wrap_put_att_text(fid, dryrvar, 'units', 'm') + call wrap_put_att_text(fid, rminvar, 'units', 'm') + call wrap_put_att_text(fid, rmaxvar, 'units', 'm') + call wrap_put_att_text(fid, hygrovar, 'units', '-') + call wrap_put_att_text(fid, ntmvar, 'units', 'kg^-1') + + call wrap_put_att_text(fid, denvar, 'long_name', 'aerosol material density') + call wrap_put_att_text(fid, slogvar, 'long_name', 'geometric standard deviation of aerosol') + call wrap_put_att_text(fid, dryrvar, 'long_name', 'dry number mode radius of aerosol') + call wrap_put_att_text(fid, rminvar, 'long_name', 'minimum dry radius of aerosol for bin') + call wrap_put_att_text(fid, rmaxvar, 'long_name', 'maximum dry radius of aerosol for bin') + call wrap_put_att_text(fid, hygrovar, 'long_name', 'hygroscopicity of aerosol') + call wrap_put_att_text(fid, ntmvar, 'long_name', 'ratio of number to mass of aerosol') + + ! End the defintion phase of the netcdf file. + call wrap_enddef(fid) + + ! Write out the dimensions. + call wrap_put_var_realx(fid, rhvar, mie_rh(:)) + call wrap_put_var_realx(fid, lwvar, wave(:nlwbands) * 1e-2_f) + call wrap_put_var_realx(fid, swvar, wave(nlwbands+1:) * 1e-2_f) + + call wrap_put_var_realx(fid, wtp_var, mie_wtp(:)*100._f) + + ! Write out the refractive indicies. + call wrap_put_var_realx(fid, sw_r_refidx_var, real(refidx(nlwbands+1:, 1))) + call wrap_put_var_realx(fid, sw_i_refidx_var, aimag(refidx(nlwbands+1:, 1))) + call wrap_put_var_realx(fid, lw_r_refidx_var, real(refidx(:nlwbands, 1))) + call wrap_put_var_realx(fid, lw_i_refidx_var, aimag(refidx(:nlwbands, 1))) + + ! Pad the names out with spaces. + aer_name = ' ' + aer_name(1:len(trim(c_name))) = c_name + + start_text(1) = 1 + count_text(1) = 32 + call wrap_put_vara_text(fid, namevar, start_text, count_text, (/ aer_name /)) + count_text(1) = 20 + call wrap_put_vara_text(fid, anvar, start_text, count_text, (/ aer_name /)) + + count_text(1) = len('hygroscopic_wtp ') + call wrap_put_vara_text(fid, omvar, start_text, count_text, (/ 'hygroscopic_wtp ' /)) + + call wrap_put_var_realx(fid, denvar, (/ rho(ibin) * 1e-3_f / 1e-6_f /)) + call wrap_put_var_realx(fid, slogvar, (/ 0._f /)) + call wrap_put_var_realx(fid, dryrvar, (/ r(ibin) * 1e-2_f /)) + call wrap_put_var_realx(fid, rminvar, (/ rlow(ibin) * 1e-2_f /)) + call wrap_put_var_realx(fid, rmaxvar, (/ rup(ibin) * 1e-2_f /)) + call wrap_put_var_realx(fid, hygrovar, (/ 0.6_f /)) + call wrap_put_var_realx(fid, ntmvar, (/ 1._f / rmass(ibin) / 1e-3_f /)) + + ! For now, ext_sw(:nrh, :nswbands) and ext_sw_coreshell(:nrh, :nswbands, :ncoreshellratio) both are calculated + ! Since other aerosols in CAM may use ext_sw rather than ext_sw_coreshell + ! Modified by Pengfei Yu + ! April.1, 2012 + + ! calculate qext and ext for pure sulfate dependent on weight percent + ! ideally qext is based on (wgt,temp,wave), however Beyer et al. (1996) Figure 5 + ! shows sulfate density is roughly 0.006 g/cm3/k, I negelet temp dimension, assuming temp = 270 K + ! In code, sulfate density is precisely calculated to determine wet raidus + do iwtp = 1, NMIE_WTP + + ! NOTE: Weight percent is normal a result of the getwetr calculation. To build the + ! table based upon weight percent, we need to pass in the desired value and a + ! reference temperature. In that case, the RH is ignored. + call getwetr(carma, igroup, mie_rh(1), r(ibin), rwet, rho(ibin), rhopwet, rc, wgtpct=mie_wtp(iwtp)*100._f, temp=270._f) + if (rc < 0) call endrun('carma_CreateOpticsFile::wetr failed.') + + ! Calculate at each wavelength. + do iwave = 1, NWAVE + + ! Using Mie code, calculate the optical properties: extinction coefficient, + ! single scattering albedo and asymmetry factor. + ! Assume the particle is homogeneous (no core). + ! + ! NOTE: The refractive index for sulfate changes with RH/weight percent, which + ! is not reflected in this code. + call mie(carma, & + imiertn, & + rwet, & + wave(iwave), & + 0._f, & + 3.0_f, & + 0.0_f, & + 1.0_f, & + refidx(iwave, 1), & + 0.0_f, & + refidx(iwave, 1), & + Qext, & + Qsca, & + asym, & + rc) + if (rc < 0) call endrun('carma_CreateOpticsFile::mie failed.') + + ! Calculate the shortwave and longwave properties? + ! + ! NOTE: miess is in cgs units, but the optics file needs to be in mks + ! units, so perform the necessary conversions. + if (iwave <= nlwbands) then + + ! Longwave just needs absorption: abs_lw. + qabs_lw_wtp(iwtp, iwave) = (Qext - Qsca) ! absorption per particle + abs_lw_wtp (iwtp, iwave) = (Qext - Qsca) * PI * (rwet * 1e-2_f)**2 / (rmass(ibin) * 1e-3_f) + else + + ! Shortwave needs extinction, single scattering albedo and asymmetry factor: + ! ext_sw, ssa_sw and asm_sw. + qext_sw_wtp(iwtp, iwave - nlwbands) = Qext ! extinction per particle + ext_sw_wtp (iwtp, iwave - nlwbands) = Qext * PI * (rwet * 1e-2_f)**2 / (rmass(ibin) * 1e-3_f) + ssa_sw_wtp (iwtp, iwave - nlwbands) = Qsca / Qext + asm_sw_wtp (iwtp, iwave - nlwbands) = asym + end if + end do ! iwave + end do ! iwtp + + ! Write out the longwave fields. + ret = nf90_put_var(fid, abs_lw_wtp_var, abs_lw_wtp (:, :)) + if (ret /= NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile_SulfateYu: error writing varid =', fid, abs_lw_wtp_var + call handle_error(ret) + end if + + ret = nf90_put_var(fid, qabs_lw_wtp_var, qabs_lw_wtp(:, :)) + if (ret /= NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile_SulfateYu: error writing varid =', qabs_lw_wtp_var + call handle_error(ret) + end if + + ! Write out the shortwave fields. + ret = nf90_put_var(fid, ext_sw_wtp_var, ext_sw_wtp (:, :)) + if (ret /= NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile_SulfateYu: error writing varid =', ext_sw_wtp_var + call handle_error(ret) + end if + + ret = nf90_put_var(fid, qext_sw_wtp_var,qext_sw_wtp(:, :)) + if (ret /= NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile_SulfateYu: error writing varid =', qext_sw_wtp_var + call handle_error(ret) + end if + + ret = nf90_put_var(fid, ssa_sw_wtp_var, ssa_sw_wtp (:, :)) + if (ret /= NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile_SulfateYu: error writing varid =', ssa_sw_wtp_var + call handle_error(ret) + end if + + ret = nf90_put_var(fid, asm_sw_wtp_var, asm_sw_wtp (:, :)) + if (ret /= NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile_SulfateYu: error writing varid =', asm_sw_wtp_var + call handle_error(ret) + end if + + ! Close the file. + call wrap_close(fid) + end if + end do + + return + end subroutine CARMAMODEL_CreateOpticsFile_SulfateYu + + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! NOTE: This is just keeping track of the changes in the interstitial aerosol, + !! and does not keep track of the aerosol that flows out the top or bottom of the + !! model or that moves into cloudborne aerosol. + !! + !! NOTE: Output occurs a chunk at a time. + !! + !! @version January-2023 + !! @author Chuck Bardeen + subroutine CARMAMODEL_CalculateCloudborneDiagnostics(carma, state, pbuf, aerclddiag, rc) + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(out) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the total cloudborne aerosols, supports up to MAXCLDAERDIAG different values + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: ncols !! number of columns in the chunk + integer :: icol !! column index + integer :: ibin !! bin index + integer :: ienconc !! concentration element index + integer :: ncore !! number of cores + integer :: icorelem(NELEM) !! core element index + real(r8) :: mair(pcols,pver) !! Mass of air column (kg/m2) + real(r8) :: pureso4(pcols,pver) !! Burden pure sulfate (kg/m2) + real(r8) :: mixso4(pcols,pver) !! Burden mix sulfate (kg/m2) + real(r8) :: bdbc(pcols,pver) !! Burden BC sulfate (kg/m2) + real(r8) :: bddust(pcols,pver) !! Burden Dust sulfate (kg/m2) + real(r8) :: bdoc(pcols,pver) !! Burden OC sulfate (kg/m2) + real(r8) :: bdsalt(pcols,pver) !! Burden Salt sulfate (kg/m2) + real(r8) :: bdsoa(pcols,pver) !! Burden SOA sulfate (kg/m2) + real(r8), pointer, dimension(:,:) :: mmr !! cloudbourne aerosol mmr (kg/kg) + character(len=16) :: shortname + character(len=16) :: binname + character(len=16) :: concname + integer :: mmr_ndx + integer :: i + + ! Default return code. + rc = RC_OK + + pureso4(:,:) = 0._r8 + mixso4(:,:) = 0._r8 + aerclddiag(:, :) = 0._r8 + bdbc(:, :) = 0._r8 + bddust(:, :) = 0._r8 + bdoc(:, :) = 0._r8 + bdsalt(:, :) = 0._r8 + bdsoa(:, :) = 0._r8 + + ! Get the air mass in the column + ! + ! NOTE convert GRAV from cm/s2 to m/s2. + ncols = state%ncol + mair(:ncols,:) = state%pdel(:ncols,:) / (GRAV / 100._r8) + + ! For PRSUL, is just the tendency for the concentration element. + call CARMAGROUP_Get(carma, I_GRP_PRSUL, rc, ienconc=ienconc) + call CARMAELEMENT_Get(carma, ienconc, rc, shortname=shortname) + + do ibin = 1, nbin + + write(binname, '(A, I2.2)') "CLD"//trim(shortname), ibin + mmr_ndx = pbuf_get_index(binname) + call pbuf_get_field(pbuf, mmr_ndx, mmr) + + pureso4(:ncols,:) = pureso4(:ncols,:) + mmr(:ncols,:) * mair(:ncols,:) + end do + + ! For MXAER, it is the difference in mass between the concentration element + ! and the sum of the core masses. + call CARMAGROUP_Get(carma, I_GRP_MXAER, rc, ienconc=ienconc, ncore=ncore, icorelem=icorelem) + call CARMAELEMENT_Get(carma, ienconc, rc, shortname=concname) + + do ibin = 1, nbin + + write(binname, '(A, I2.2)') "CLD"//trim(concname), ibin + mmr_ndx = pbuf_get_index(binname) + call pbuf_get_field(pbuf, mmr_ndx, mmr) + + mixso4(:ncols,:) = mixso4(:ncols,:) + mmr(:ncols,:) * mair(:ncols,:) + + do i = 1, ncore + call CARMAELEMENT_Get(carma, icorelem(i), rc, shortname=shortname) + + write(binname, '(A, I2.2)') "CLD"//trim(shortname), ibin + mmr_ndx = pbuf_get_index(binname) + call pbuf_get_field(pbuf, mmr_ndx, mmr) + + if (shortname .eq. "MXBC") then + bdbc(:ncols, :) = bdbc(:ncols, :) + mmr(:ncols,:) * mair(:ncols,:) + else if (shortname .eq. "MXDUST") then + bddust(:ncols, :) = bddust(:ncols, :) + mmr(:ncols,:) * mair(:ncols,:) + else if (shortname .eq. "MXOC") then + bdoc(:ncols, :) = bdoc(:ncols, :) + mmr(:ncols,:) * mair(:ncols,:) + else if (shortname .eq. "MXSALT") then + bdsalt(:ncols, :) = bdsalt(:ncols, :) + mmr(:ncols,:) * mair(:ncols,:) + else if (shortname .eq. "MXSOA") then + bdsoa(:ncols, :) = bdsoa(:ncols, :) + mmr(:ncols,:) * mair(:ncols,:) + end if + end do + end do + + do icol = 1, ncols + aerclddiag(icol, 1) = sum(pureso4(icol,:)) + aerclddiag(icol, 2) = sum(mixso4(icol,:)) + aerclddiag(icol, 3) = sum(bdbc(icol,:)) + aerclddiag(icol, 4) = sum(bddust(icol,:)) + aerclddiag(icol, 5) = sum(bdoc(icol,:)) + aerclddiag(icol, 6) = sum(bdsalt(icol,:)) + aerclddiag(icol, 7) = sum(bdsoa(icol,:)) + end do + + return + end subroutine CARMAMODEL_CalculateCloudborneDiagnostics + + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! NOTE: This is just keeping track of the changes in the interstitial aerosol, + !! and does not keep track of the aerosol that flows out the top or bottom of the + !! model or that moves into cloudborne aerosol. + !! + !! NOTE: Output occurs a chunk at a time. + !! + !! @version January-2023 + !! @author Chuck Bardeen + subroutine CARMAMODEL_OutputBudgetDiagnostics(carma, icnst4elem, icnst4gas, state, ptend, old_cflux, cflux, dt, pname, rc) + use cam_history, only: outfld + use constituents, only: pcnst, cnst_get_ind + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + integer, intent(in) :: icnst4gas(NGAS) !! constituent index for a carma gas + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + real(r8) :: old_cflux(pcols,pcnst) !! cam_in%clfux from before the timestep_tend + real(r8) :: cflux(pcols,pcnst) !! cam_in%clfux from after the timestep_tend + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: icol !! column index + integer :: ibin !! bin index + integer :: i + integer :: icnst !! constituent index + integer :: ienconc !! concentration element index + integer :: ncore !! number of cores + integer :: icorelem(NELEM) !! core element index + real(r8) :: mair(pver) !! Mass of air column (kg/m2) + real(r8) :: puretend(pcols) !! Tendency pure sulfate (kg/m2/s) + real(r8) :: mixtend(pcols) !! Tendency mix sulfate (kg/m2/s) + real(r8) :: bdprso4(pcols) !! Burden pure sulfate (kg/m2) + real(r8) :: bdmxso4(pcols) !! Burden mixed sulfate (kg/m2) + real(r8) :: cprflux(pcols) !! Surface Flux tendency, pure sulfate (kg/m2/s) + real(r8) :: cmxflux(pcols) !! Surface Flux tendency, mix sulfate (kg/m2/s) + real(r8) :: gastend(pcols) !! Tendency H2SO4 gas (kg/m2/s) + real(r8) :: so2tend(pcols) !! Tendency SO2 gas (kg/m2/s) + real(r8) :: tottend(pver) !! Total Tendency mix sulfate (kg/m2/s) + + ! Default return code. + rc = RC_OK + + puretend(:) = 0._r8 + mixtend(:) = 0._r8 + gastend(:) = 0._r8 + so2tend(:) = 0._r8 + cprflux(:) = 0._r8 + cmxflux(:) = 0._r8 + + bdmxso4(:) = 0._r8 + bdprso4(:) = 0._r8 + + ! Add up the sulfate tendencies. + do icol = 1, state%ncol + + ! Get the air mass in the column + ! + ! NOTE convert GRAV from cm/s2 to m/s2. + mair(:) = state%pdel(icol,:) / (GRAV / 100._r8) + + do ibin = 1, nbin + + ! For PRSUL, is just the tendency for the concentration element. + call CARMAGROUP_Get(carma, I_GRP_PRSUL, rc, ienconc=ienconc) + icnst = icnst4elem(ienconc, ibin) + + if (ptend%lq(icnst)) then + puretend(icol) = puretend(icol) + sum(ptend%q(icol,:,icnst) * mair(:)) + end if + bdprso4(icol) = bdprso4(icol) + sum(state%q(icol,:,icnst) * mair(:)) + + cprflux = cprflux(icol) + (cflux(icol,icnst) - old_cflux(icol,icnst)) + + ! For MXAER, it is the difference in mass between the concentration element + ! and the sum of the core masses. + call CARMAGROUP_Get(carma, I_GRP_MXAER, rc, ienconc=ienconc, ncore=ncore, icorelem=icorelem) + icnst = icnst4elem(ienconc, ibin) + + tottend(:) = 0._r8 + if (ptend%lq(icnst)) then + tottend(:) = ptend%q(icol, :, icnst) * mair(:) + end if + bdmxso4(icol) = bdmxso4(icol) + sum(state%q(icol,:,icnst) * mair(:)) + + cmxflux(icol) = cmxflux(icol) + (cflux(icol,icnst) - old_cflux(icol,icnst)) + + do i = 1, ncore + icnst = icnst4elem(icorelem(i), ibin) + if (ptend%lq(icnst)) then + tottend(:) = tottend(:) - ptend%q(icol,:,icnst) * mair(:) + end if + end do + + mixtend(icol) = mixtend(icol) + sum(tottend(:)) + end do + + ! Calculate the H2SO4 change. + icnst = icnst4gas(I_GAS_H2SO4) + if (ptend%lq(icnst)) then + gastend(icol) = sum(ptend%q(icol,:,icnst) * mair(:)) + end if + + ! Also do SO2 + call cnst_get_ind("SO2", icnst) + if (ptend%lq(icnst)) then + so2tend(icol) = sum(ptend%q(icol,:,icnst) * mair(:)) + end if + + end do + + if (carma_do_package_diags) then + ! Output the total sulfate and H2SO4 tendencies for this physics package. + call outfld("SO4PRTC_"//trim(pname), puretend(:), pcols, state%lchnk) + call outfld("SO4MXTC_"//trim(pname), mixtend(:), pcols, state%lchnk) + call outfld("H2SO4TC_"//trim(pname), gastend(:), pcols, state%lchnk) + call outfld("SO2TC_"//trim(pname), so2tend(:), pcols, state%lchnk) + call outfld("SO4PRSF_"//trim(pname), cprflux(:), pcols, state%lchnk) + call outfld("SO4MXSF_"//trim(pname), cmxflux(:), pcols, state%lchnk) + call outfld("SO4PRBD_"//trim(pname), bdprso4(:), pcols, state%lchnk) + call outfld("SO4MXBD_"//trim(pname), bdmxso4(:), pcols, state%lchnk) + endif + + return + end subroutine CARMAMODEL_OutputBudgetDiagnostics + + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! NOTE: This is just keeping track of the changes in the interstitial aerosol, + !! and does not keep track of the aerosol that flows out the top or bottom of the + !! model or that moves into cloudborne aerosol. + !! + !! NOTE: Output occurs a chunk at a time. + !! + !! @version January-2023 + !! @author Chuck Bardeen + subroutine CARMAMODEL_OutputCloudborneDiagnostics(carma, state, pbuf, dt, pname, oldaerclddiag, rc) + use cam_history, only: outfld + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + real(r8), intent(in ) :: oldaerclddiag(pcols,MAXCLDAERDIAG) !! the before timestep cloudborne aerosol diags + integer, intent(out) :: rc !! return code, negative indicates failure + + real(r8) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the after timestep cloudborne aerosol diags + + ! Default return code. + rc = RC_OK + + ! Get the current diagnostics for the cloudborne aerosols. + call CARMAMODEL_CalculateCloudborneDiagnostics(carma, state, pbuf, aerclddiag, rc) + + ! Output the total sulfate and H2SO4 tendencies for this physics package. + call outfld("SO4PRCLDTC_"//trim(pname), (aerclddiag(:,1) - oldaerclddiag(:,1)) / dt, pcols, state%lchnk) + call outfld("SO4MXCLDTC_"//trim(pname), (aerclddiag(:,2) - oldaerclddiag(:,2)) / dt, pcols, state%lchnk) + + ! To be similar to interstitial, where the burden is calculated from the + ! state before the tendencies are applied, report the old burden not the + ! current burden. + ! call outfld("SO4PRCLDBD_"//trim(pname), aerclddiag(:,1), pcols, state%lchnk) + ! call outfld("SO4MXCLDBD_"//trim(pname), aerclddiag(:,2), pcols, state%lchnk) + call outfld("SO4PRCLDBD_"//trim(pname), oldaerclddiag(:,1), pcols, state%lchnk) + call outfld("SO4MXCLDBD_"//trim(pname), oldaerclddiag(:,2), pcols, state%lchnk) + + return + end subroutine CARMAMODEL_OutputCloudborneDiagnostics + + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! NOTE: Output occurs a chunk at a time. + !! + !! @version January-2023 + !! @author Chuck Bardeen + subroutine CARMAMODEL_OutputDiagnostics(carma, icnst4elem, state, ptend, pbuf, cam_in, rc) + use cam_history, only: outfld + use constituents, only: cnst_get_ind + use camsrfexch, only: cam_in_t + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + type(cam_in_t), intent(in) :: cam_in !! surface inputs + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: icol !! column index + integer :: ibin !! bin index + real(r8), pointer, dimension(:,:) :: soacm !! aerosol tendency due to gas-aerosol exchange kg/kg/s + real(r8), pointer, dimension(:,:) :: soapt !! aerosol tendency due to no2 photolysis kg/kg/s + character(len=16) :: binname !! names bins + real(r8) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the before timestep cloudborne aerosol diags + integer :: i + integer :: icnst !! constituent index + integer :: ienconc !! concentration element index + integer :: ncore !! number of cores + integer :: icorelem(NELEM) !! core element index + real(r8) :: mair(pver) !! Mass of air column (kg/m2) + real(r8) :: pureso4(pcols) !! pure sulfate (kg/m2) + real(r8) :: mixso4(pcols) !! mix sulfate (kg/m2) + real(r8) :: cprflux(pcols) !! Surface Flux pure sulfate (kg/m2/s) + real(r8) :: cmxflux(pcols) !! Surface Flux mix sulfate (kg/m2/s) + real(r8) :: h2so4(pcols) !! H2SO4 gas (kg/m2) + real(r8) :: so2(pcols) !! SO2 gas (kg/m2) + real(r8) :: bdbc(pcols) !! Burden BC sulfate (kg/m2) + real(r8) :: bddust(pcols) !! Burden dust (kg/m2) + real(r8) :: bdoc(pcols) !! Burden OC sulfate (kg/m2) + real(r8) :: bdsalt(pcols) !! Burden SALT sulfate (kg/m2) + real(r8) :: bdsoa(pcols) !! Burden SOA sulfate (kg/m2) + real(r8) :: pureso4mr(pcols,pver) !! Mixing ratio pure sulfate (kg/kg) + real(r8) :: mixso4mr(pcols,pver) !! Mixing ratio mix sulfate (kg/kg) + real(r8) :: bcmr(pcols,pver) !! Mixing ratio BC sulfate (kg/kg) + real(r8) :: dustmr(pcols,pver) !! Mixing ratio dust (kg/kg) + real(r8) :: ocmr(pcols,pver) !! Mixing ratio OC sulfate (kg/kg) + real(r8) :: saltmr(pcols,pver) !! Mixing ratio SALT sulfate (kg/kg) + real(r8) :: soamr(pcols,pver) !! Mixing ratio SOA sulfate (kg/kg) + character(len=16) :: shortname + + ! Default return code. + rc = RC_OK + + ! Provide diagnostics on the SOA tendencies that affect MXSOA. + do ibin = 1, NBIN + write(binname, '(A, I2.2)') "MXSOA", ibin + + call pbuf_get_field(pbuf, ipbuf4soacm(ibin), soacm) + call outfld(trim(binname)//'CM', soacm(:, :), pcols, state%lchnk) + + call pbuf_get_field(pbuf, ipbuf4soapt(ibin), soapt) + call outfld(trim(binname)//'PT', soapt(:, :), pcols, state%lchnk) + end do + + if (carma_do_budget_diags) then + ! Output the cloudborne SO4 burdens. + call CARMAMODEL_CalculateCloudborneDiagnostics(carma, state, pbuf, aerclddiag, rc) + call outfld("SO4PRCLDBD", aerclddiag(:,1), pcols, state%lchnk) + call outfld("SO4MXCLDBD", aerclddiag(:,2), pcols, state%lchnk) + call outfld("MXBCCLDBD", aerclddiag(:,3), pcols, state%lchnk) + call outfld("MXDUSTCLDBD", aerclddiag(:,4), pcols, state%lchnk) + call outfld("MXOCCLDBD", aerclddiag(:,5), pcols, state%lchnk) + call outfld("MXSALTCLDBD", aerclddiag(:,6), pcols, state%lchnk) + call outfld("MXSOACLDBD", aerclddiag(:,7), pcols, state%lchnk) + endif + + ! Output the interstitial SO4 burdens. + pureso4(:) = 0._r8 + mixso4(:) = 0._r8 + cprflux(:) = 0._r8 + cmxflux(:) = 0._r8 + h2so4(:) = 0._r8 + so2(:) = 0._r8 + bdbc(:) = 0._r8 + bddust(:) = 0._r8 + bdoc(:) = 0._r8 + bdsalt(:) = 0._r8 + bdsoa(:) = 0._r8 + + ! Output the mixing ratio + pureso4mr(:,:) = 0._r8 + mixso4mr(:,:) = 0._r8 + bcmr(:,:) = 0._r8 + dustmr(:,:) = 0._r8 + ocmr(:,:) = 0._r8 + saltmr(:,:) = 0._r8 + soamr(:,:) = 0._r8 + + ! Add up the sulfate tendencies. + do icol = 1, state%ncol + + ! Get the air mass in the column + ! + ! NOTE convert GRAV from cm/s2 to m/s2. + mair(:) = state%pdel(icol,:) / (GRAV / 100._r8) + + do ibin = 1, nbin + + ! For PRSUL, is just the tendency for the concentration element. + call CARMAGROUP_Get(carma, I_GRP_PRSUL, rc, ienconc=ienconc) + icnst = icnst4elem(ienconc, ibin) + + pureso4mr(icol,:) = pureso4mr(icol,:) + state%q(icol,:,icnst) + pureso4(icol) = pureso4(icol) + sum(state%q(icol,:,icnst) * mair(:)) + + cprflux = cprflux + cam_in%cflx(icol,icnst) + + ! For MXAER, it is the difference in mass between the concentration element + ! and the sum of the core masses. + call CARMAGROUP_Get(carma, I_GRP_MXAER, rc, ienconc=ienconc, ncore=ncore, icorelem=icorelem) + icnst = icnst4elem(ienconc, ibin) + + mixso4mr(icol,:) = mixso4mr(icol,:) + state%q(icol, :, icnst) + mixso4(icol) = mixso4(icol) + sum(state%q(icol, :, icnst) * mair(:)) + + cmxflux(icol) = cmxflux(icol) + cam_in%cflx(icol,icnst) + + do i = 1, ncore + icnst = icnst4elem(icorelem(i), ibin) + + call CARMAELEMENT_Get(carma, icorelem(i), rc, shortname=shortname) + if (shortname .eq. "MXBC") then + bcmr(icol,:) = bcmr(icol,:) + state%q(icol,:,icnst) + bdbc(icol) = bdbc(icol) + sum(state%q(icol,:,icnst) * mair(:)) + else if (shortname .eq. "MXDUST") then + dustmr(icol,:) = dustmr(icol,:) + state%q(icol,:,icnst) + bddust(icol) = bddust(icol) + sum(state%q(icol,:,icnst) * mair(:)) + else if (shortname .eq. "MXOC") then + ocmr(icol,:) = ocmr(icol,:) + state%q(icol,:,icnst) + bdoc(icol) = bdoc(icol) + sum(state%q(icol,:,icnst) * mair(:)) + else if (shortname .eq. "MXSALT") then + saltmr(icol,:) = saltmr(icol,:) + state%q(icol,:,icnst) + bdsalt(icol) = bdsalt(icol) + sum(state%q(icol,:,icnst) * mair(:)) + else if (shortname .eq. "MXSOA") then + soamr(icol,:) = soamr(icol,:) + state%q(icol,:,icnst) + bdsoa(icol) = bdsoa(icol) + sum(state%q(icol,:,icnst) * mair(:)) + end if + + end do + end do + + ! Calculate the H2SO4 burden. + call cnst_get_ind("H2SO4", icnst) + h2so4(icol) = sum(state%q(icol,:,icnst) * mair(:)) + + ! Calculate the SO2 burden. + call cnst_get_ind("SO2", icnst) + so2(icol) = sum(state%q(icol,:,icnst) * mair(:)) + end do + + if (carma_do_budget_diags) then + ! Output the total aerosol and gas burdens and the aerosol fluxes. + call outfld("SO4PRBD", pureso4(:), pcols, state%lchnk) + call outfld("SO4MXBD", mixso4(:), pcols, state%lchnk) + call outfld("SO4PRSF", cprflux(:), pcols, state%lchnk) + call outfld("SO4MXSF", cmxflux(:), pcols, state%lchnk) + call outfld("H2SO4BD", h2so4(:), pcols, state%lchnk) + call outfld("SO2BD", so2(:), pcols, state%lchnk) + call outfld("MXBCBD", bdbc(:), pcols, state%lchnk) + call outfld("MXDUSTBD", bddust(:), pcols, state%lchnk) + call outfld("MXOCBD", bdoc(:), pcols, state%lchnk) + call outfld("MXSALTBD", bdsalt(:), pcols, state%lchnk) + call outfld("MXSOABD", bdsoa(:), pcols, state%lchnk) + endif + + ! Output the total aerosol mixing ratio + call outfld("SO4PRMR", pureso4mr(:,:), pcols, state%lchnk) + call outfld("MXSO4MR", mixso4mr(:,:), pcols, state%lchnk) + call outfld("MXBCMR", bcmr(:,:), pcols, state%lchnk) + call outfld("MXDUSTMR", dustmr(:,:), pcols, state%lchnk) + call outfld("MXOCMR", ocmr(:,:), pcols, state%lchnk) + call outfld("MXSALTMR", saltmr(:,:), pcols, state%lchnk) + call outfld("MXSOAMR", soamr(:,:), pcols, state%lchnk) + + return + end subroutine CARMAMODEL_OutputDiagnostics + + + + !! Called after wet deposition has been performed. Allows the specific model to add + !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. + !! + !! @version July-2011 + !! @author Chuck Bardeen + subroutine CARMAMODEL_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) + use camsrfexch, only: cam_out_t + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + real(r8), intent(in) :: sflx(pcols) !! surface flux (kg/m2/s) + type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: icol + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_WetDeposition + + + !! Calculates the emissions for CARMA sea salt aerosol particles. + !! + !! @author Tianyi Fan, Chuck Bardeen, Pengfei Yu + !! @version Dec-2010 + !! originally calculate sea salt flux in EmitParticle, Pengfei Yu make + !! it a separate subroutine since multiple aerosol types need salt flux + !! e.g. sea salt, sea salt sulfate, marine organics + subroutine CARMAMODEL_SaltFlux(carma, ibin, state, r, dr, rmass, cam_in, SaltFlux, rc) + use ppgrid, only: pcols + use physics_types, only: physics_state + use camsrfexch, only: cam_in_t + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ibin !! bin index + type(physics_state), intent(in) :: state !! physics state + real(r8), intent(in) :: r !! bin center (cm) + real(r8), intent(in) :: dr !! bin width (cm) + real(r8), intent(in) :: rmass !! bin mass (g) + type(cam_in_t), intent(in) :: cam_in !! surface inputs + real(r8), intent(out) :: SaltFlux(pcols) !! constituent surface flux (kg/m^2/s) + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: ncol ! number of columns in chunk + integer :: icol ! column index + + + ! -------- local variables added for sea salt model ------------ + real(r8) :: rdrycm, rdry ! dry radius [cm], [um] + real(r8) :: r80cm, r80 ! wet radius at relatige humidity of 80% [cm] + real(r8) :: ncflx ! dF/dr [#/m2/s/um] + real(r8) :: Monahan, Clarke, Smith ! dF/dr [#/m2/s/um] + real(r8) :: A_para, B_para, sita_para ! A, B, and sita parameters in Gong + real(r8) :: B_mona ! the parameter used in Monahan + real(r8) :: W_Caff ! Correction factor in Caffrey + real(r8) :: u14, ustar_smith, cd_smith ! 14m wind velocity, friction velocity, and drag coefficient as desired by Andreas source function + real(r8) :: wcap ! whitecap coverage + real(r8) :: fref ! correction factor suggested by Hoppe2005 + real(r8), parameter :: xkar = 0.4_r8 ! Von Karman constant + real(r8) :: u10in ! 10 meter wind speed use in the emission rate + + ! ------------------------------------------------------------------------------------------------ + ! -- Martensson source function. Coefficients for the parameterization of Ak(c4-c0) and Bk(d4-d0) + ! ------------------------------------------------------------------------------------------------- + real(r8), parameter :: c41 = -2.576e35_r8 + real(r8), parameter :: c42 = -2.452e33_r8 + real(r8), parameter :: c43 = 1.085e29_r8 + real(r8), parameter :: c31 = 5.932e28_r8 + real(r8), parameter :: c32 = 2.404e27_r8 + real(r8), parameter :: c33 = -9.841e23_r8 + real(r8), parameter :: c21 = -2.867e21_r8 + real(r8), parameter :: c22 = -8.148e20_r8 + real(r8), parameter :: c23 = 3.132e18_r8 + real(r8), parameter :: c11 = -3.003e13_r8 + real(r8), parameter :: c12 = 1.183e14_r8 + real(r8), parameter :: c13 = -4.165e12_r8 + real(r8), parameter :: c01 = -2.881e6_r8 + real(r8), parameter :: c02 = -6.743e6_r8 + real(r8), parameter :: c03 = 2.181e6_r8 + real(r8), parameter :: d41 = 7.188e37_r8 + real(r8), parameter :: d42 = 7.368e35_r8 + real(r8), parameter :: d43 = -2.859e31_r8 + real(r8), parameter :: d31 =-1.616e31_r8 + real(r8), parameter :: d32 =-7.310e29_r8 + real(r8), parameter :: d33 = 2.601e26_r8 + real(r8), parameter :: d21 = 6.791e23_r8 + real(r8), parameter :: d22 = 2.528e23_r8 + real(r8), parameter :: d23 =-8.297e20_r8 + real(r8), parameter :: d11 = 1.829e16_r8 + real(r8), parameter :: d12 =-3.787e16_r8 + real(r8), parameter :: d13 = 1.105e15_r8 + real(r8), parameter :: d01 = 7.609e8_r8 + real(r8), parameter :: d02 = 2.279e9_r8 + real(r8), parameter :: d03 =-5.800e8_r8 + + ! ------------------------------------------------------------ + ! ---- Clarke Source Function. Coefficients for Ai ------- + ! ------------------------------------------------------------ + real(r8), parameter :: beta01 =-5.001e3_r8 + real(r8), parameter :: beta11 = 0.808e6_r8 + real(r8), parameter :: beta21 =-1.980e7_r8 + real(r8), parameter :: beta31 = 2.188e8_r8 + real(r8), parameter :: beta41 =-1.144e9_r8 + real(r8), parameter :: beta51 = 2.290e9_r8 + real(r8), parameter :: beta02 = 3.854e3_r8 + real(r8), parameter :: beta12 = 1.168e4_r8 + real(r8), parameter :: beta22 =-6.572e4_r8 + real(r8), parameter :: beta32 = 1.003e5_r8 + real(r8), parameter :: beta42 =-6.407e4_r8 + real(r8), parameter :: beta52 = 1.493e4_r8 + real(r8), parameter :: beta03 = 4.498e2_r8 + real(r8), parameter :: beta13 = 0.839e3_r8 + real(r8), parameter :: beta23 =-5.394e2_r8 + real(r8), parameter :: beta33 = 1.218e2_r8 + real(r8), parameter :: beta43 =-1.213e1_r8 + real(r8), parameter :: beta53 = 4.514e-1_r8 + + ! --------------------------------------------- + ! coefficient A1, A2 in Andreas's Source funcion + ! --------------------------------------------- + real(r8) ::A1A92 + real(r8) ::A2A92 + + ! --------------------------------------------- + ! coefficient in Smith's Source funcion + ! --------------------------------------------- + real(r8), parameter :: f1 = 3.1_r8 + real(r8), parameter :: f2 = 3.3_r8 + real(r8), parameter :: r1 = 2.1_r8 + real(r8), parameter :: r2 = 9.2_r8 + real(r8), parameter :: delta = 10._r8 + + ! -------------------------------------------------------------------- + ! ---- constants in calculating the particle wet radius [Gerber, 1985] + ! -------------------------------------------------------------------- + real(r8), parameter :: c1 = 0.7674_r8 ! . + real(r8), parameter :: c2 = 3.079_r8 ! . + real(r8), parameter :: c3 = 2.573e-11_r8 ! . + real(r8), parameter :: c4 = -1.424_r8 ! constants in calculating the particle wet radius + + ! Default return code. + rc = RC_OK + + ncol = state%ncol + + ! Add any surface flux here. + SaltFlux(:ncol) = 0.0_r8 + + ! Are we configured for one of the known emission schemes? + if( carma_seasalt_emis .ne. "Gong" .and. & + carma_seasalt_emis .ne. "Martensson" .and. & + carma_seasalt_emis .ne. "Clarke" .and. & + carma_seasalt_emis .ne. "Andreas" .and. & + carma_seasalt_emis .ne. "Caffrey" .and. & + carma_seasalt_emis .ne. "CMS" .and. & + carma_seasalt_emis .ne. "NONE" .and. & + carma_seasalt_emis .ne. "CONST" ) then + + call endrun('carma_EmitParticle:: Invalid sea salt emission scheme.') + end if + + !********************************** + ! wet sea salt radius at RH = 80% + !********************************** + r80cm = (c1 * (r) ** c2 / (c3 * r ** c4 - log10(0.8_r8)) + (r)**3) ** (1._r8/3._r8) ! [cm] + rdrycm = r ! [cm] + r80 = r80cm *1.e4_r8 ! [um] + rdry = rdrycm*1.e4_r8 ! [um] + + do icol = 1,ncol + + ! Only generate sea salt over the ocean. + if (cam_in%ocnfrac(icol) > 0._r8) then + + !********************************** + ! WIND for seasalt production + !********************************** + call CARMAMODEL_SurfaceWind_salt(icol, cam_in, u10in, rc) + + ! Add any surface flux here. + ncflx = 0.0_r8 + Monahan = 0.0_r8 + Clarke = 0.0_r8 + Smith = 0.0_r8 + + !********************************** + ! Whitecap Coverage + !********************************** + wcap = 3.84e-6_r8 * u10in ** 3.41_r8 ! in percent, ie., 75%, wcap = 0.75 + + !**************************************** + ! Hoppel correction factor + ! Smith drag coefficients and etc + !**************************************** + if (u10in .le. 10._r8) then + cd_smith = 1.14e-3_r8 + else + cd_smith = (0.49_r8 + 0.065_r8 * u10in) * 1.e-3_r8 + end if + + ! ustar_smith = cd_smith **0.5_r8 * u10in + ! + ! We don't have vg yet, since that is calculated by CARMA. That will require + ! a different interface for the emissions, storing vg in the physics buffer, + ! and/or doing some duplicate calculations for vg assuming 80% RH. + ! fref = (delta/state%zm(icol, pver))**(vg(icol, ibin, igelem(i))/(xkar*ustar_smith)) + fref = 1.0_r8 + + !********************************** + ! Source Functions + !********************************** + if (carma_seasalt_emis .eq. 'NONE') then + ncflx = 0._r8 + end if + + if (carma_seasalt_emis .eq. 'CONST') then + ncflx = 1.e-5_r8 + end if + + !-------Gong source function------ + if (carma_seasalt_emis == "Gong") then + sita_para = 30 + A_para = - 4.7_r8 * (1+ sita_para * r80) ** (- 0.017_r8 * r80** (-1.44_r8)) + B_para = (0.433_r8 - log10(r80)) / 0.433_r8 + ncflx = 1.373_r8* u10in ** 3.41_r8 * r80 ** A_para * (1._r8 + 0.057_r8 * r80**3.45_r8) * 10._r8 ** (1.607_r8 * exp(- B_para **2)) + ! if (do_print) write(LUNOPRT, *) "Gong: ncflx = ", ncflx, ", u10n = ", u10in + end if + + !------Martensson source function----- + if (carma_seasalt_emis == "Martensson") then + if (rdry .le. 0.0725_r8) then + ncflx = (Ak1(rdry*1.0e-6_r8)* (25._r8+273._r8) + Bk1(rdry*1.0e-6_r8)) * wcap ! dF/dlogr [#/s/m2] + ncflx = ncflx / (2.30258509_r8 * rdry) ! dF/dr [#/s/m2/um] + elseif (rdry .gt. 0.0725_r8 .and. rdry .le. 0.2095_r8) then + ncflx = (Ak2(rdry*1.0e-6_r8)* (25._r8+273._r8) + Bk2(rdry*1.0e-6_r8)) * wcap ! dF/dlogr [#/s/m2] + ncflx = ncflx / (2.30258509_r8 * rdry) ! dF/dr [#/s/m2/um] + elseif (rdry .gt. 0.2095_r8 .and. rdry .le. 1.4_r8) then + ncflx = (Ak3(rdry*1.0e-6_r8)* (25._r8+273._r8) + Bk3(rdry*1.0e-6_r8)) * wcap ! dF/dlogr [#/s/m2] + ncflx = ncflx / (2.30258509_r8 * rdry) ! dF/dr [#/s/m2/um] + else + ncflx = 0._r8 + end if + end if + + !-------Clarke source function------- + if (carma_seasalt_emis == "Clarke")then + if (rdry .lt. 0.066_r8) then + ncflx = A1(rdry) * 1.e4_r8 * wcap ! dF/dlogr [#/s/m2] + ncflx = ncflx / (2.30258509_r8 * rdry) ! dF/dr [#/s/m2/um] + elseif (rdry .ge. 0.066_r8 .and. rdry .lt. 0.6_r8) then + ncflx = A2(rdry) * 1.e4_r8 * wcap ! dF/dlogr [#/s/m2] + ncflx = ncflx / (2.30258509_r8 * rdry) ! dF/dr [#/s/m2/um] + elseif (rdry .ge. 0.6_r8 .and. rdry .lt. 4.0_r8) then + ncflx = A3(rdry) * 1.e4_r8 * wcap ! dF/dlogr [#/s/m2] + ncflx= ncflx / (2.30258509_r8 * rdry) ! dF/dr [#/s/m2/um] + else + ncflx = 0._r8 + end if + end if + + !-----------Caffrey source function------------ + if (carma_seasalt_emis == "Caffrey") then + + !Monahan + B_mona = (0.38_r8 - log10(r80)) / 0.65_r8 + Monahan = 1.373_r8 * (u10in**3.41_r8) * r80**(-3._r8) * (1._r8 + 0.057_r8 *r80**1.05_r8) * 10._r8 ** (1.19_r8 * exp(-1._r8 * B_mona**2)) ! dF/dr + + !Smith + u14 = u10in * (1._r8 + cd_smith**0.5_r8 / xkar * log(14._r8 / 10._r8)) ! 14 meter wind + A1A92 = 10._r8 ** (0.0676_r8 * u14 + 2.430_r8) + A2A92 = 10._r8 ** (0.9590_r8 * u14**0.5_r8 - 1.476_r8) + Smith = A1A92*exp(-f1 *(log(r80/r1))**2) + A2A92*exp(-f2 * (log(r80/r2))**2) ! dF/dr [#/m2/s/um] + + !Caffrey based on Monahan and Smith + W_Caff = 1.136_r8 **(-1._r8 * rdry ** (-0.855_r8))*(1._r8 + 0.2_r8/rdry) + if (rdry .lt. 0.15_r8) then + ncflx = Monahan + else + if (u10in .le. 9._r8) then + ncflx = Monahan + else + if(Monahan .ge. Smith) then + ncflx = Monahan + else + ncflx = Smith + end if + end if + end if + + ncflx = ncflx * W_Caff + + !%%%%%%%%%%%%%%%%%%%%%%%%% + ! Apply Hoppel correction + !%%%%%%%%%%%%%%%%%%%%%%%%% + ncflx = ncflx * fref + end if + + !--------CMS (Clarke, Monahan, and Smith source function)------- + if (carma_seasalt_emis == "CMS") then + + !Clarke + if (rdry .lt. 0.066_r8) then + Clarke = A1(rdry) * 1.e4_r8 * wcap ! dF/dlogr [#/s/m2] + Clarke = Clarke / (2.30258509_r8 * rdry) ! dF/dr [#/s/m2/um] + elseif ((rdry .ge. 0.066_r8) .and. (rdry .lt. 0.6_r8)) then + Clarke = A2(rdry) * 1.e4_r8 * wcap ! dF/dlogr [#/s/m2] + Clarke = Clarke / (2.30258509_r8 * rdry) ! dF/dr [#/s/m2/um] + elseif ((rdry .ge. 0.6_r8) .and. (rdry .lt. 4.0_r8)) then + Clarke = A3(rdry) * 1.e4_r8 * wcap ! dF/dlogr [#/s/m2] + Clarke= Clarke / (2.30258509_r8 * rdry) ! dF/dr [#/s/m2/um] + end if + + !Monahan + B_Mona = (0.38_r8 - log10(r80)) / 0.65_r8 + Monahan = 1.373_r8 * u10in ** 3.41_r8 * r80 ** (-3._r8) * (1._r8 + 0.057_r8 * r80**1.05_r8) * 10._r8 ** (1.19_r8 * exp(- B_Mona **2)) + + !Smith + u14 = u10in * (1._r8 + cd_smith**0.5_r8 / xkar*log(14._r8 / 10._r8)) ! 14 meter wind + A1A92 = 10._r8 ** (0.0676_r8 * u14 + 2.430_r8) + A2A92 = 10._r8 ** (0.9590_r8 * u14**0.5_r8 - 1.476_r8) + Smith = A1A92*exp(-f1 *(log(r80 / r1))**2) + A2A92*exp(-f2 * (log(r80 / r2))**2) ! dF/dr [#/m2/s/um] + + !%%%%%%%%%%%%%%%%%%%%%%%%% + ! CMS1 or CMS2 + !%%%%%%%%%%%%%%%%%%%%%%%%% + ! if (rdry .lt. 0.1_r8) then ! originally cut at 0.1 um + ! ***CMS1***** + if (rdry .lt. 1._r8) then ! cut at 1.0 um + ! ***CMS2***** + ! if (rdry .lt. 2._r8) then ! cut at 2.0 um + ncflx = Clarke + else + if (u10in .lt. 9._r8) then + ncflx = Monahan + else + if (Monahan .gt. Smith) then + ncflx = Monahan + else + ncflx = Smith + end if + end if + end if + + !%%%%%%%%%%%%%%%%%%%%%%%%% + ! Apply Hoppel correction + !%%%%%%%%%%%%%%%%%%%%%%%%% + ncflx = ncflx * fref + end if + + ! convert ncflx [#/m^2/s/um] to surfaceFlx [kg/m^2/s] + SaltFlux(icol) = ncflx * dr * rmass * 10._r8 ! *1e4[um/cm] * 1.e-3[kg/g] + + ! if (do_print) write(LUNOPRT, *) "ibin = ", ibin, ", igroup = ", igroup + ! if (do_print) write(LUNOPRT, *) "dr = ", dr, ", rmass = ", rmass + ! if (do_print) write(LUNOPRT, *) "ncflx = " , ncflx, ", SaltFlux = ", SaltFlux(icol) + + ! weighted by the ocean fraction + SaltFlux(icol) = SaltFlux(icol) * cam_in%ocnfrac(icol) + end if + end do + + contains + + ! Coefficient Ak in Martensson's source functions + pure real(r8) function Ak1(rpdry) + real(r8),intent(in) :: rpdry + Ak1 = c41*(2._r8*rpdry)**4 + c31*(2._r8*rpdry) ** 3 + c21*(2._r8*rpdry)**2 + c11*(2._r8*rpdry)+ c01 + end function Ak1 + + pure real(r8) function Ak2(rpdry) + real(r8),intent(in) :: rpdry + Ak2 = c42*(2._r8*rpdry)**4 + c32*(2._r8*rpdry) ** 3 + c22*(2._r8*rpdry)**2 + c12*(2._r8*rpdry)+ c02 + end function Ak2 + + pure real(r8) function Ak3(rpdry) + real(r8),intent(in) :: rpdry + Ak3 = c43*(2._r8*rpdry)**4 + c33*(2._r8*rpdry) ** 3 + c23*(2._r8*rpdry)**2 + c13*(2._r8*rpdry)+ c03 + end function Ak3 + + ! Coefficient Bk in Martensson's source functions + pure real(r8) function Bk1(rpdry) + real(r8),intent(in) :: rpdry + Bk1= d41*(2._r8*rpdry)**4 + d31*(2._r8*rpdry) ** 3 + d21*(2._r8*rpdry)**2 + d11*(2._r8*rpdry)+ d01 + end function Bk1 + + pure real(r8) function Bk2(rpdry) + real(r8),intent(in) :: rpdry + Bk2 = d42*(2._r8*rpdry)**4 + d32*(2._r8*rpdry) ** 3 + d22*(2._r8*rpdry)**2 + d12*(2._r8*rpdry)+ d02 + end function Bk2 + + pure real(r8) function Bk3(rpdry) + real(r8),intent(in) :: rpdry + Bk3 = d43*(2._r8*rpdry)**4 + d33*(2._r8*rpdry) ** 3 + d23*(2._r8*rpdry)**2 + d13*(2._r8*rpdry)+ d03 + end function Bk3 + + ! Coefficient Ak in Clarkes's source function + pure real(r8) function A1(rpdry) + real(r8),intent(in) :: rpdry + A1 = beta01 + beta11*(2._r8*rpdry) + beta21*(2._r8*rpdry)**2 + beta31*(2._r8*rpdry)**3 & + + beta41*(2._r8*rpdry)**4 + beta51*(2._r8*rpdry)**5 + end function A1 + + pure real(r8) function A2(rpdry) + real(r8),intent(in) :: rpdry + A2 = beta02 + beta12*(2._r8*rpdry) + beta22*(2._r8*rpdry)**2 + beta32*(2._r8*rpdry)**3 & + + beta42*(2._r8*rpdry)**4 + beta52*(2._r8*rpdry)**5 + end function A2 + + pure real(r8) function A3(rpdry) + real(r8),intent(in) :: rpdry + A3 = beta03 + beta13*(2._r8*rpdry) + beta23*(2._r8*rpdry)**2 + beta33*(2._r8*rpdry)**3 & + + beta43*(2._r8*rpdry)**4 + beta53*(2._r8*rpdry)**5 + end function A3 + + end subroutine CARMAMODEL_SaltFlux + + + !! Calculate the sea surface wind with a Weibull distribution. + !! + !! @author Tianyi Fan + !! @version August-2010 + subroutine CARMAMODEL_SurfaceWind_salt(icol, cam_in, u10in, rc) + use camsrfexch, only: cam_in_t + + ! in and out field + integer, intent(in) :: icol !! column index + type(cam_in_t), intent(in) :: cam_in !! surface inputs + real(r8), intent(out) :: u10in !! the 10m wind speed put into the source function + integer, intent(out) :: rc !! return code, negative indicates failure + + ! local variables + real(r8) :: uWB341 ! the nth mean wind with integration using Weibull Distribution(integrate from threshold wind velocity) + + rc = RC_OK + + uWB341 = 0._r8 + + ! calc. the Weibull wind distribution + u10in = cam_in%u10(icol) + + call CARMAMODEL_WeibullWind(u10in, uth_salt, 3.41_r8, uWB341) + + u10in = uWB341 ** (1._r8 / 3.41_r8) + +! if (do_print) write(LUNOPRT, *) 'CARMA_SurfaceWind: icol ',icol, ', u10 =', cam_in%u10(icol), ', u10in =', u10in + + return + end subroutine CARMAMODEL_SurfaceWind_salt + + + + !! Determines the mass fraction for the clay (submicron) bins based upon + !! Tegen and Lacis [1996]. The total fraction for all clay bins should + !! add up to 1. + !! + !! NOTE: WOuld it be better to interpolate this into the bins rather than + !! assigning all CARMA bins within a Tegen & Lacis bin the same value? + !! + !! NOTE: Should any mass go to bins smaller than the smallest one used by + !! Tegen and Lacis? + !! + !! @version July-2012 + !! @author Lin Su, Pengfei Yu, Chuck Bardeen + subroutine CARMAMODEL_ClayMassFraction(carma, igroup, rdust, rc) + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: igroup !! the carma group index + real(r8), intent(in) :: rdust(NBIN) !! radius assuming entire particle is dust + integer, intent(inout) :: rc !! return code, negative indicates failure + + ! Bins and mass fraction from Tegen and Lacis. + integer, parameter :: NBIN_TEGEN = 4 + real(r8) :: tl_rmin(NBIN_TEGEN) = (/ 1.e-5_r8, 1.8e-5_r8, 3.e-5_r8, 6.e-5_r8 /) + real(r8) :: tl_rmax(NBIN_TEGEN) = (/ 1.8e-5_r8, 3.e-5_r8, 6.e-5_r8, 1.e-4_r8 /) + real(r8) :: tl_mf(NBIN_TEGEN) = (/ 0.009_r8, 0.081_r8, 0.234_r8, 0.676_r8 /) + + ! Local Variables + integer, parameter :: IBELOW = 1 + integer, parameter :: IABOVE = 6 + integer :: tl_count(NBIN_TEGEN+2) ! count number in Tegen and Lacis ranges + integer :: ind_up(NBIN_TEGEN+2) + integer :: ind_low(NBIN_TEGEN+2) + integer :: j ! local index number + integer :: ibin ! carma bin index + + ! Default return code. + rc = RC_OK + + ! Figure out how many of the CARMA bins are in each of the Tegen and Lacis + ! ranges. + tl_count(:) = 0 + + do ibin = 1, NBIN + + ! Smaller than the range. + if (rdust(ibin) < tl_rmin(1)) then + tl_count(IBELOW) = tl_count(IBELOW) + 1 + end if + + ! In the range + do j = 1, NBIN_TEGEN + if (rdust(ibin) < tl_rmax(j) .and. rdust(ibin) >= tl_rmin(j)) then + tl_count(j+1) = tl_count(j+1) + 1 + end if + end do + + ! Bigger than the range. + if (rdust(ibin) >= tl_rmax(NBIN_TEGEN)) then + tl_count(IABOVE) = tl_count(IABOVE) + 1 + end if + end do + + ! Determine where the boundaries are between the TEGEN bins and + ! the CARMA bin structure. + ind_up(:) = 0 + ind_low(:) = 0 + ind_up (IBELOW) = tl_count(IBELOW) + ind_low(IBELOW) = min(1, tl_count(IBELOW)) + + do j = 1, 5 + ind_up (j+1) = ind_up(j) + tl_count(j+1) + ind_low(j+1) = ind_up(j) + min(tl_count(j+1), 1) + end do + + ! No mass to bins smaller than the smallest size. + clay_mf(:) = 0._r8 + + ! NOTE: This won't work right if the dust bins are coarser than + ! the Tegen and Lacis bins. In this case mass fraction would need + ! to be combined from the Tegen & Lacis bins into a CARMA bin. + do j = 1, NBIN_TEGEN + if (tl_count(j+1) > 0) then + clay_mf(ind_low(j+1):ind_up(j+1)) = tl_mf(j) / tl_count(j+1) + end if + end do + + clay_mf(ind_low(IABOVE):) = 1._r8 + + return + end subroutine CARMAMODEL_ClayMassFraction + + + !! Calculate the sea surface wind with a Weibull distribution. + !! + !! NOTE: This should be combined with a similar routine in the sea salt + !! model, and any differences should be control by parameters into this + !! routine (and perhaps namelist variables). + !! + !! @author Lin Su, Pengfei Yu, Chuck Bardeen + !! @version July-2012 + subroutine CARMAMODEL_SurfaceWind(carma, icol, ielem, igroup, ibin, cam_in, uv10, wwd, uth, rc) + use camsrfexch, only: cam_in_t + + ! in and out field + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icol !! column index + integer, intent(in) :: ielem !! element index + integer, intent(in) :: igroup !! group index + integer, intent(in) :: ibin !! bin index + type(cam_in_t), intent(in) :: cam_in !! surface inputs + real(r8), intent(out) :: uv10 !! the 10m wind speed (m/s) + real(r8), intent(out) :: wwd !! the 10m wind speed with Weibull applied (m/s) + real(r8), intent(out) :: uth !! the 10m wind threshold (m/s) + integer, intent(inout) :: rc !! return code, negative indicates failure + + real(r8), parameter :: vk = 0.4_r8 ! von Karman constant + real(r8) :: rmass(NBIN) ! CARMA bin mass (g) + real(r8) :: r ! CARMA bin center (cm) + real(r8) :: rhop(NBIN) ! CARMA partile element density (g/cm3) + real(r8) :: uthfact ! + real(r8), parameter :: rhoa = 1.25e-3_r8 ! Air density at surface + + rc = RC_OK + + ! Get the 10 meter wind speed + uv10 = cam_in%u10(icol) + + ! Calculate the threshold wind speed of each bin [Marticorena and Bergametti,1995] + ! note that in cgs units --> m/s + call CARMAGROUP_GET(carma, igroup, rc, rmass=rmass) + if (RC < RC_ERROR) return + + ! Define particle # concentration element index for current group + call CARMAELEMENT_Get(carma, ielem, rc, rho=rhop) + if (RC < RC_ERROR) return + + ! Calculate the radius assuming that all the mass will be emitted as this + ! element. + r = (3._r8 * rmass(ibin) / 4._r8 / PI / rhop(ibin))**(1._r8 / 3._r8) + + if (cam_in%soilw(icol) >= 0._r8 .AND. cam_in%soilw(icol) < 0.5_r8) then + + ! Prevent small values of soilw from driving uthfact negative, but allow + ! for dust emissions even when soilw is 0. + uthfact = 1.2_r8 + 0.2_r8*log10(max(0.001_r8, cam_in%soilw(icol))) + + if (r > 2.825e-5_r8) then ! r(4) = 2.825e-5 cm + uth = uthfact * 1.e-2_r8 * 0.13_r8 * sqrt(rhop(ibin)*GRAV*r*2._r8/rhoa) & + * sqrt(1._r8 + .006_r8/rhop(ibin)/GRAV/(r*2._r8)**2.5_r8) & + / sqrt(1.928_r8*(1331._r8*(r*2._r8)**1.56_r8 + .38_r8)**.092_r8 - 1._r8) + else + uth = uthfact*1.e-2_r8* 0.13_r8 * sqrt(rhop(ibin)*GRAV*(.75e-4_r8)*2._r8/rhoa) & + * sqrt(1._r8 + .006_r8/rhop(ibin)/GRAV/((.75e-4_r8)*2._r8)**2.5_r8) & + / sqrt(1.928_r8*(1331._r8*((.75e-4_r8)*2._r8)**1.56_r8 + .38_r8)**.092_r8 - 1._r8) + endif + else + uth = uv10 + endif + + ! Use Weibull with Lansing's estimate for shape. + call CARMAMODEL_WeibullWind(uv10, uth, 2._r8, wwd) + + ! Set the threshold to the weibull wind value if sol moisture >= 0.5, + ! to turn off emissions. + if (cam_in%soilw(icol) >= 0.5_r8) then + uth = sqrt(wwd) + end if + + return + end subroutine CARMAMODEL_SurfaceWind + + + !! Read in the dust source (soil) erodibility factor from a NETCDF file. In this + !! processes, the data is regridded from the source size to the size needed by the + !! model. + !! + !! NOTE: This is currently doing 2-D interpolation, but it really should be doing + !! regridding. + !! + !! @author Pengfei Yu + !! @version July-2012 + +!! st +!! could use /components/cam/src/chemistry/aerosol/soil_erod_mod.F90 here insted of this routine? + subroutine CARMAMODEL_ReadSoilErosionFactor(rc) + use ppgrid, only: begchunk, endchunk, pcols + use ioFileMod, only: getfil + use interpolate_data, only: lininterp_init, lininterp, interp_type, lininterp_finish + use phys_grid, only: get_rlon_all_p, get_rlat_all_p, get_ncols_p + use wrap_nf + + integer, intent(out) :: rc !! return code, negative indicates failure + + ! local variables + integer :: idvar, f_nlon, f_nlat, idlat, idlon + integer :: fid, fid_lon, fid_lat + real(r8), allocatable, dimension(:,:) :: ero_factor + character(len=256) :: ero_file + real(r8), allocatable, dimension(:) :: ero_lat ! latitude dimension + real(r8), allocatable, dimension(:) :: ero_lon ! latitude dimension + type (interp_type) :: lat_wght, lon_wght + real(r8) :: lat(pcols) ! latitude index + real(r8) :: lon(pcols) ! longitude index + integer :: i + integer :: lchnk ! chunk identifier + integer :: ncol ! number of columns in chunk + + real(r8), parameter :: zero=0_r8, twopi=2_r8*pi, degs2rads = pi/180._r8 + + rc = RC_OK + + ! Open the netcdf file (read only) + call getfil(carma_soilerosion_file, ero_file, 0) + call wrap_open(ero_file, 0, fid) + + ! Get file dimensions + call wrap_inq_dimid(fid, 'plon', fid_lon) + call wrap_inq_dimid(fid, 'plat', fid_lat) + call wrap_inq_dimlen(fid, fid_lon, f_nlon) + call wrap_inq_dimlen(fid, fid_lat, f_nlat) + + allocate(ero_lat(f_nlat)) + allocate(ero_lon(f_nlon)) + allocate(ero_factor (f_nlon, f_nlat)) + allocate(soil_factor(pcols, begchunk:endchunk)) + + ! Read in the tables. + call wrap_inq_varid(fid, 'new_source', idvar) + i = nf90_get_var (fid, idvar, ero_factor) + if (i/=NF90_NOERR) then + write(iulog,*)'CARMA_ReadSoilErosionFactor: error reading varid =', idvar + call handle_error (i) + end if + call wrap_inq_varid(fid, 'plat', idlat) + call wrap_get_var_realx(fid, idlat, ero_lat) + call wrap_inq_varid(fid, 'plon', idlon) + call wrap_get_var_realx(fid, idlon, ero_lon) + + ero_lat(:) = ero_lat(:)*degs2rads + ero_lon(:) = ero_lon(:)*degs2rads + + ! Close the file. + call wrap_close(fid) + + do lchnk=begchunk, endchunk + ncol = get_ncols_p(lchnk) + + call get_rlat_all_p(lchnk, pcols, lat) + call get_rlon_all_p(lchnk, pcols, lon) + + call lininterp_init(ero_lon, f_nlon, lon, ncol, 2, lon_wght, zero, twopi) + call lininterp_init(ero_lat, f_nlat, lat, ncol, 1, lat_wght) + + call lininterp(ero_factor, f_nlon, f_nlat, soil_factor(1:ncol,lchnk), ncol, lon_wght, lat_wght) + + call lininterp_finish(lon_wght) + call lininterp_finish(lat_wght) + end do + + deallocate(ero_lat) + deallocate(ero_lon) + deallocate(ero_factor) + + end subroutine CARMAMODEL_ReadSoilErosionFactor + + !! Calculate the nth mean of u using Weibull wind distribution + !! considering the threshold wind velocity. This algorithm + !! integrates from uth to infinite (u^n P(u)du ) + !! + !! @author Tianyi Fan + !! @version August-2010 + subroutine CARMAMODEL_WeibullWind(u, uth, n, uwb, wbk) + use shr_spfn_mod, only: gamma => shr_spfn_gamma, igamma => shr_spfn_igamma + + real(r8), intent(in) :: u ! mean wind speed + real(r8), intent(in) :: uth ! threshold velocity + real(r8), intent(in) :: n ! the rank of u in the integration + real(r8), intent(out) :: uwb ! the Weibull distribution + real(r8), intent(in), optional :: wbk ! the shape parameter + + ! local variable + real(r8) :: k ! the shape parameter in Weibull distribution + real(r8) :: c ! the scale parameter in Weibull distribution + + if (present(wbk)) then + k = wbk + else + k = 0.94_r8*u**0.5_r8 ! follow Grini and Zender, 2004JGR + ! k = 2.5_r8 ! Lansing's estimate + end if + + ! If u is 0, then k can be 0, which makes a lot of this undefined. + ! Just return 0. in this case. + if (u < 0.35_r8) then + uwb = 0._r8 + else + c = u * (gamma(1._r8 + 1._r8 / k))**(-1._r8) + uwb = c**n * igamma(n / k + 1._r8, (uth / c)**k) + end if + + end subroutine CARMAMODEL_WeibullWind + + !! Read BC data from three components: + !! 1. GAINS anthropogenic; 2. Ship Emission; 3. GFEDv3; 4. Aircraft + !! GAINS unit: kt/year; 2D; lon:-180-180 + !! Ship Emission unit: kg/m2/s; 3D (month,lat,lon); lon:0-360 + !! GFEDv3 unit: g/m2/month; 3D (month,lat,lon); lon:-180-180 + !! + !! @author Pengfei Yu + !! @version May-2013 + subroutine CARMAMODEL_BCOCRead(rc) + use pmgrid, only: plat, plon + use ioFileMod, only: getfil + use cam_pio_utils, only: cam_pio_openfile + use interpolate_data, only : lininterp_init, lininterp, interp_type, lininterp_finish + use pio, only : file_desc_t, var_desc_t, & + pio_inq_dimid, pio_inq_varid, & + pio_get_var, pio_nowrite, pio_inq_dimlen, & + pio_inq_dimlen, pio_closefile + use dycore, only: dycore_is + + integer, intent(out) :: rc !! return code, negative indicates failure + + ! local variables + integer :: f_nlon, f_nlat, f_ntime + integer :: fid_lon, fid_lat, fid_time + real(r8), allocatable, dimension(:,:) :: BC_f2d, BC2d, OC_f2d, OC2d + real(r8), allocatable, dimension(:,:,:) :: BC_f3d, BC3d, OC_f3d, OC3d +! + character(len=256) :: BC_GAINS_file + character(len=256) :: OC_GAINS_file + character(len=256) :: BC_GFEDv3_file + character(len=256) :: OC_GFEDv3_file + character(len=256) :: BC_ship_file + character(len=256) :: OC_ship_file +! + real(r8), allocatable, dimension(:,:,:) :: BC_anthro_GAINS + real(r8), allocatable, dimension(:,:,:) :: OC_anthro_GAINS + real(r8), allocatable, dimension(:,:,:) :: BC_GFEDv3 + real(r8), allocatable, dimension(:,:,:) :: OC_GFEDv3 + real(r8), allocatable, dimension(:,:,:) :: BC_ship_GAINS + real(r8), allocatable, dimension(:,:,:) :: OC_ship_GAINS +! + real(r8), allocatable, dimension(:) :: BC_lat, OC_lat ! latitude dimension + real(r8), allocatable, dimension(:) :: BC_lon, OC_lon ! latitude dimension + type (interp_type) :: wgt1, wgt2 + real(r8) :: lat(plat), lon(plon) + integer :: i, itime + real(r8) :: rearth, gridarea + integer :: nmonth + real(r8) :: tempor(plon,plat) + real(r8), allocatable, dimension(:,:,:) :: tempor3d + real(r8), allocatable, dimension(:,:) :: tempor2d + real(r8), allocatable, dimension(:) :: tempor1d + integer :: mid_idx + real(r8), allocatable, dimension(:,:) :: BC_dom_f2d, OC_dom_f2d + real(r8), allocatable, dimension(:,:,:) :: BC_dom_f3d, OC_dom_f3d + real(r8), allocatable, dimension(:,:,:) :: BC_awb_f3d, OC_awb_f3d + real(r8), allocatable, dimension(:,:) :: BC2d_dom, OC2d_dom + real(r8), allocatable, dimension(:) :: facH, facL + integer :: ind_15N, ind_45N, ierr + type(file_desc_t) :: fid + type(var_desc_t) :: idvar, idlat, idlon, idvar_dom, idvar_awb + + real(r8) :: nlats + + rc = RC_OK + + if(dycore_is('UNSTRUCTURED') ) then + call endrun('CARMAMODEL_BCOCRead: Yu2015 emissions not implemented for unstructured grids' ) + end if + + ! get model lat and lon + nlats = plat-1 ! gnu compiler workaround + do i = 1, plat + lat(i) = 180._r8/(nlats)*(i-1)-90._r8 + end do + do i = 1, plon + lon(i) = 360._r8/plon*(i-1) + end do + +! + nmonth = 12 + + if(carma_BCOCemissions == 'Yu2015')then + ! allocate BCnew and OCnew, unit is #/cm2/s + allocate(BCnew(plat, plon, nmonth)) + allocate(OCnew(plat, plon, nmonth)) + BCnew = -huge(1._r8) + OCnew = -huge(1._r8) + endif + +! monthly fraction of domestic emission + allocate(facH(nmonth)) + allocate(facL(nmonth)) + facH = (/0.18_r8,0.14_r8,0.13_r8,0.08_r8,0.04_r8,0.02_r8,0.01_r8,& + 0.02_r8,0.03_r8,0.07_r8,0.11_r8,0.17_r8/) + facL = (/0.17_r8,0.14_r8,0.11_r8,0.06_r8,0.04_r8,0.04_r8,0.04_r8,& + 0.04_r8,0.04_r8,0.06_r8,0.10_r8,0.15_r8/) + +! find index for 15N and 45N + do i = 1, plat + if (lat(i) .gt. 15._r8) then + ind_15N = i + exit + endif + end do +! + do i = 1, plat + if (lat(i) .gt. 45._r8) then + ind_45N = i + exit + endif + end do + + ! Part 1a: BC anthropogenic from GAINS + ! ------------------------------------------------- + ! Open the netcdf file (read only) + call getfil(BC_GAINS_filename, BC_GAINS_file, 0) + call cam_pio_openfile( fid, BC_GAINS_file, PIO_NOWRITE) + + ! Get file dimensions + ierr = pio_inq_dimid(fid, 'time', fid_time) + ierr = pio_inq_dimid(fid, 'lon', fid_lon) + ierr = pio_inq_dimid(fid, 'lat', fid_lat) + ierr = pio_inq_dimlen(fid, fid_time,f_ntime) + ierr = pio_inq_dimlen(fid, fid_lon, f_nlon) + ierr = pio_inq_dimlen(fid, fid_lat, f_nlat) + + allocate(BC_lat(f_nlat)) + allocate(BC_lon(f_nlon)) + allocate(BC_f3d(f_nlon, f_nlat, f_ntime)) + allocate(BC_f2d(f_nlon, f_nlat)) + allocate(BC_dom_f2d(f_nlon, f_nlat)) + allocate(BC_dom_f3d(f_nlon, f_nlat, f_ntime)) + allocate(BC_awb_f3d(f_nlon, f_nlat, f_ntime)) + allocate(BC2d (plon, plat)) + allocate(BC2d_dom (plon, plat)) + allocate(BC_anthro_GAINS(nmonth, plat, plon)) + + ! Read in the tables. + ierr = pio_inq_varid(fid, 'emis_all', idvar) + ierr = pio_get_var(fid, idvar, BC_f3d ) + ierr = pio_inq_varid(fid, 'emis_dom', idvar_dom) + ierr = pio_get_var(fid, idvar, BC_dom_f3d ) + ierr = pio_inq_varid(fid, 'emis_awb', idvar_awb) + ierr = pio_get_var(fid, idvar, BC_awb_f3d ) + ierr = pio_inq_varid(fid, 'lat', idlat) + ierr = pio_get_var(fid, idlat, BC_lat ) + ierr = pio_inq_varid(fid, 'lon ', idlon) + ierr = pio_get_var(fid, idlon, BC_lon ) + + ! Close the file. + call pio_closefile(fid) + ! get emission excluding domestic and agriculture waste buring + BC_f2d = BC_f3d(:,:,1) - BC_dom_f3d(:,:,1) - BC_awb_f3d(:,:,1) + BC_dom_f2d = BC_dom_f3d(:,:,1) + + ! make sure file longitude range from 0-360 + if (BC_lon(1) < -160._r8) then + allocate(tempor2d(f_nlon, f_nlat)) + allocate(tempor1d(f_nlon)) + mid_idx = floor(f_nlon/2._r8) + ! emission excluding dom + tempor2d(1:mid_idx,:f_nlat) = BC_f2d(mid_idx+1:f_nlon,:f_nlat) + tempor1d(1:mid_idx) = BC_lon(mid_idx+1:f_nlon) + tempor2d(mid_idx+1:f_nlon,:f_nlat) = BC_f2d(1:mid_idx,:f_nlat) + tempor1d(mid_idx+1:f_nlon) = BC_lon(1:mid_idx)+360._r8 + BC_f2d = tempor2d + ! dom emission + tempor2d(1:mid_idx,:f_nlat) = BC_dom_f2d(mid_idx+1:f_nlon,:f_nlat) + tempor2d(mid_idx+1:f_nlon,:f_nlat) = BC_dom_f2d(1:mid_idx,:f_nlat) + BC_dom_f2d = tempor2d + ! + BC_lon = tempor1d + deallocate(tempor2d) + deallocate(tempor1d) + else + BC_lon = BC_lon + endif + + ! Convert kt/year ----> #/cm2/s + rearth = 6.371e6_r8 ! m + do i = 1, f_nlat + gridarea = 2.0_r8*3.14159_r8*rearth/f_nlat * & + 2.0_r8*3.14159_r8*rearth/f_nlon*cos(BC_lat(i)/180._r8*3.14159_r8) + ! + BC_f2d(:f_nlon,i) = BC_f2d(:f_nlon,i)/365._r8/86400._r8*1.e9_r8/ & ! g/s + 12._r8*6.02e23_r8/gridarea*1.e-4_r8 ! #/cm2/s + ! + BC_dom_f2d(:f_nlon,i) = BC_dom_f2d(:f_nlon,i)/365._r8/86400._r8*1.e9_r8/ & ! g/s + 12._r8*6.02e23_r8/gridarea*1.e-4_r8 ! #/cm2/s + end do + + call lininterp_init(BC_lat, f_nlat, lat, plat, 1, wgt1) + call lininterp_init(BC_lon, f_nlon, lon, plon, 1, wgt2) + call lininterp(BC_f2d, f_nlon, f_nlat, BC2d, plon, plat, wgt2, wgt1) + call lininterp_finish(wgt1) + call lininterp_finish(wgt2) + + call lininterp_init(BC_lat, f_nlat, lat, plat, 1, wgt1) + call lininterp_init(BC_lon, f_nlon, lon, plon, 1, wgt2) + call lininterp(BC_dom_f2d, f_nlon, f_nlat, BC2d_dom, plon, plat, wgt2, wgt1) + call lininterp_finish(wgt1) + call lininterp_finish(wgt2) + + ! To implement Monthly data for dom emssion + ! methods from Stohl et al., 2013 + ! facH works for high latitudes: 45-90N + ! facL works for low latitudes: 15-45N + ! below 15N, no seasonal variation + ! + do itime = 1, nmonth + ! 45N-90N + BC2d(:plon, ind_45N:plat) = BC2d(:plon, ind_45N:plat) + & + BC2d_dom(:plon, ind_45N:plat)*facH(itime)*12._r8 + ! 15N-45N + BC2d(:plon, ind_15N:ind_45N-1) = BC2d(:plon, ind_15N:ind_45N-1) + & + BC2d_dom(:plon, ind_15N:ind_45N-1)*facL(itime)*12._r8 + ! 90S-15N + BC2d(:plon, 1:ind_15N-1) = BC2d(:plon, 1:ind_15N-1) + & + BC2d_dom(:plon, 1:ind_15N-1) + + BC_anthro_GAINS(itime, :plat, :plon) = transpose(BC2d(:plon, :plat)) + end do + + deallocate(BC_lat) + deallocate(BC_lon) + deallocate(BC_f2d) + deallocate(BC_f3d) + deallocate(BC_dom_f2d) + deallocate(BC_dom_f3d) + deallocate(BC_awb_f3d) + deallocate(BC2d) + deallocate(BC2d_dom) + + ! Part 1b: OC anthropogenic from GAINS + ! ------------------------------------------------- + ! Open the netcdf file (read only) + call getfil(OC_GAINS_filename, OC_GAINS_file, 0) + call cam_pio_openfile(fid, trim(OC_GAINS_file), PIO_NOWRITE) + + ! Get file dimensions + ierr = pio_inq_dimid(fid, 'time', fid_time) + ierr = pio_inq_dimid(fid, 'lon', fid_lon) + ierr = pio_inq_dimid(fid, 'lat', fid_lat) + ierr = pio_inq_dimlen(fid, fid_time,f_ntime) + ierr = pio_inq_dimlen(fid, fid_lon, f_nlon) + ierr = pio_inq_dimlen(fid, fid_lat, f_nlat) + + allocate(OC_lat(f_nlat)) + allocate(OC_lon(f_nlon)) + allocate(OC_f2d(f_nlon, f_nlat)) + allocate(OC_f3d(f_nlon, f_nlat, f_ntime)) + allocate(OC_dom_f2d(f_nlon, f_nlat)) + allocate(OC_dom_f3d(f_nlon, f_nlat, f_ntime)) + allocate(OC_awb_f3d(f_nlon, f_nlat, f_ntime)) + allocate(OC2d (plon, plat)) + allocate(OC2d_dom (plon, plat)) + allocate(OC_anthro_GAINS(nmonth, plat, plon)) + + ! Read in the tables. + ierr = pio_inq_varid(fid, 'emis_all', idvar) + ierr = pio_get_var(fid, idvar, OC_f3d ) + ierr = pio_inq_varid(fid, 'emis_dom', idvar_dom) + ierr = pio_get_var(fid, idvar, OC_dom_f3d ) + ierr = pio_inq_varid(fid, 'emis_awb', idvar_awb) + ierr = pio_get_var(fid, idvar, OC_awb_f3d ) + ierr = pio_inq_varid(fid, 'lat', idlat) + ierr = pio_get_var(fid, idlat, OC_lat ) + ierr = pio_inq_varid(fid, 'lon ', idlon) + ierr = pio_get_var(fid, idlon, OC_lon ) + + ! Close the file. + call pio_closefile(fid) + + ! get emission excluding domestic and agriculture waste burning + OC_f2d(:,:) = OC_f3d(:,:,1) - OC_dom_f3d(:,:,1) - OC_awb_f3d(:,:,1) + OC_dom_f2d = OC_dom_f3d(:,:,1) + + ! make sure file longitude range from -180-180 to 0-360 + if (OC_lon(1) < -160._r8) then + allocate(tempor2d(f_nlon, f_nlat)) + allocate(tempor1d(f_nlon)) + mid_idx = floor(f_nlon/2._r8) + ! emission excluding dom + tempor2d(1:mid_idx,:f_nlat) = OC_f2d(mid_idx+1:f_nlon,:f_nlat) + tempor1d(1:mid_idx) = OC_lon(mid_idx+1:f_nlon) + tempor2d(mid_idx+1:f_nlon,:f_nlat) = OC_f2d(1:mid_idx,:f_nlat) + tempor1d(mid_idx+1:f_nlon) = OC_lon(1:mid_idx)+360._r8 + OC_f2d = tempor2d + ! dom emission + tempor2d(1:mid_idx,:f_nlat) = OC_dom_f2d(mid_idx+1:f_nlon,:f_nlat) + tempor2d(mid_idx+1:f_nlon,:f_nlat) = OC_dom_f2d(1:mid_idx,:f_nlat) + OC_dom_f2d = tempor2d + ! + OC_lon = tempor1d + deallocate(tempor2d) + deallocate(tempor1d) + else + OC_lon = OC_lon + endif + + ! Convert kt/year ----> #/cm2/s + rearth = 6.371e6_r8 ! m + do i = 1, f_nlat + gridarea = 2.0_r8*3.14159_r8*rearth/f_nlat * & + 2.0_r8*3.14159_r8*rearth/f_nlon*cos(OC_lat(i)/180._r8*3.14159_r8) + ! + OC_f2d(:f_nlon,i) = OC_f2d(:f_nlon,i)/365._r8/86400._r8*1.e9_r8/ & ! g/s + 12._r8*6.02e23_r8/gridarea*1.e-4_r8 ! #/cm2/s + ! + OC_dom_f2d(:f_nlon,i) = OC_dom_f2d(:f_nlon,i)/365._r8/86400._r8*1.e9_r8/ & ! g/s + 12._r8*6.02e23_r8/gridarea*1.e-4_r8 ! #/cm2/s + end do + + call lininterp_init(OC_lat, f_nlat, lat, plat, 1, wgt1) + call lininterp_init(OC_lon, f_nlon, lon, plon, 1, wgt2) + call lininterp(OC_f2d, f_nlon, f_nlat, OC2d, plon, plat, wgt2, wgt1) + call lininterp_finish(wgt1) + call lininterp_finish(wgt2) + + call lininterp_init(OC_lat, f_nlat, lat, plat, 1, wgt1) + call lininterp_init(OC_lon, f_nlon, lon, plon, 1, wgt2) + call lininterp(OC_dom_f2d, f_nlon, f_nlat, OC2d_dom, plon, plat, wgt2, wgt1) + call lininterp_finish(wgt1) + call lininterp_finish(wgt2) + + ! To implement Monthly data for dom emssion + ! methods from Stohl et al., 2013 + ! facH works for high latitudes: 45-90N + ! facL works for low latitudes: 15-45N + ! below 15N, no seasonal variation + ! + do itime = 1, nmonth + ! 45N-90N + OC2d(:plon, ind_45N:plat) = OC2d(:plon, ind_45N:plat) + & + OC2d_dom(:plon, ind_45N:plat)*facH(itime)*12._r8 + ! 15N-45N + OC2d(:plon, ind_15N:ind_45N-1) = OC2d(:plon, ind_15N:ind_45N-1) + & + OC2d_dom(:plon, ind_15N:ind_45N-1)*facL(itime)*12._r8 + ! 90S-15N + OC2d(:plon, 1:ind_15N-1) = OC2d(:plon, 1:ind_15N-1) + & + OC2d_dom(:plon, 1:ind_15N-1) + + OC_anthro_GAINS(itime, :plat, :plon) = transpose(OC2d(:plon, :plat)) + end do + + deallocate(OC_lat) + deallocate(OC_lon) + deallocate(OC_f2d) + deallocate(OC_f3d) + deallocate(OC_dom_f2d) + deallocate(OC_dom_f3d) + deallocate(OC_awb_f3d) + deallocate(OC2d) + deallocate(OC2d_dom) + + ! Part 2a: BC ship + ! ------------------------------------------------- + ! Open the netcdf file (read only) + call getfil(BC_ship_filename, BC_ship_file, 0) + call cam_pio_openfile(fid, trim(BC_ship_file), PIO_NOWRITE) + !call wrap_open(BC_ship_file, 0, fid) + + ! Get file dimensions + ierr = pio_inq_dimid(fid, 'lon', fid_lon) + ierr = pio_inq_dimid(fid, 'lat', fid_lat) + ierr = pio_inq_dimlen(fid, fid_lon, f_nlon) + ierr = pio_inq_dimlen(fid, fid_lat, f_nlat) + + allocate(BC_lat(f_nlat)) + allocate(BC_lon(f_nlon)) + allocate(BC_f3d(f_nlon, f_nlat, nmonth)) + allocate(BC3d (plon, plat, nmonth)) + allocate(BC_ship_GAINS(nmonth, plat, plon)) + + ! Read in the tables. + ierr = pio_inq_varid(fid, 'emiss_shp', idvar) + ierr = pio_get_var(fid, idvar, BC_f3d ) + ierr = pio_inq_varid(fid, 'lat', idlat) + ierr = pio_get_var(fid, idlat, BC_lat ) + ierr = pio_inq_varid(fid, 'lon ', idlon) + ierr = pio_get_var(fid, idlon, BC_lon ) + + ! Close the file. + call pio_closefile(fid) + + ! make sure file longitude range from -180-180 to 0-360 + if (BC_lon(1) < -160._r8) then + allocate(tempor3d(f_nlon, f_nlat, nmonth)) + allocate(tempor1d(f_nlon)) + mid_idx = floor(f_nlon/2._r8) + tempor3d(1:mid_idx,:f_nlat,:nmonth) = BC_f3d(mid_idx+1:f_nlon,:f_nlat,:nmonth) + tempor1d(1:mid_idx) = BC_lon(mid_idx+1:f_nlon) + tempor3d(mid_idx+1:f_nlon,:f_nlat,:nmonth) = BC_f3d(1:mid_idx,:f_nlat,:nmonth) + tempor1d(mid_idx+1:f_nlon) = BC_lon(1:mid_idx)+360._r8 + BC_f3d = tempor3d + BC_lon = tempor1d + deallocate(tempor3d) + deallocate(tempor1d) + else + BC_lon = BC_lon + endif + + ! convert unit from kg/m2/s to #/cm2/s + BC_f3d = BC_f3d*1.e3_r8/1.e4_r8/12._r8*6.02e23_r8 + + call lininterp_init(BC_lat, f_nlat, lat, plat, 1, wgt1) + call lininterp_init(BC_lon, f_nlon, lon, plon, 1, wgt2) + do itime = 1, nmonth + call lininterp(BC_f3d(:,:,itime), f_nlon, f_nlat, tempor(:,:), plon, plat, wgt2, wgt1) + BC3d(:,:,itime) = tempor(:,:) + end do + call lininterp_finish(wgt1) + call lininterp_finish(wgt2) + + do itime = 1, nmonth + BC_ship_GAINS(itime, :plat, :plon) = transpose(BC3d(:plon, :plat, itime)) + end do + + deallocate(BC_lat) + deallocate(BC_lon) + deallocate(BC_f3d) + deallocate(BC3d) + + ! Part 2b: OC Ship + ! ------------------------------------------------- + ! Open the netcdf file (read only) + call getfil(OC_ship_filename, OC_ship_file, 0) + call cam_pio_openfile(fid, trim(OC_ship_file), PIO_NOWRITE) + + ! Get file dimensions + ierr = pio_inq_dimid(fid, 'lon', fid_lon) + ierr = pio_inq_dimid(fid, 'lat', fid_lat) + ierr = pio_inq_dimlen(fid, fid_lon, f_nlon) + ierr = pio_inq_dimlen(fid, fid_lat, f_nlat) + + allocate(OC_lat(f_nlat)) + allocate(OC_lon(f_nlon)) + allocate(OC_f3d(f_nlon, f_nlat, nmonth)) + allocate(OC3d (plon, plat, nmonth)) + allocate(OC_ship_GAINS(nmonth, plat, plon)) + + ! Read in the tables. + ierr = pio_inq_varid(fid, 'emiss_shp', idvar) + ierr = pio_get_var(fid, idvar, OC_f3d ) + ierr = pio_inq_varid(fid, 'lat', idlat) + ierr = pio_get_var(fid, idlat, OC_lat ) + ierr = pio_inq_varid(fid, 'lon ', idlon) + ierr = pio_get_var(fid, idlon, OC_lon ) + + ! Close the file. + call pio_closefile(fid) + + ! make sure file longitude range from -180-180 to 0-360 + if (OC_lon(1) < -160._r8) then + allocate(tempor3d(f_nlon, f_nlat, nmonth)) + allocate(tempor1d(f_nlon)) + mid_idx = floor(f_nlon/2._r8) + tempor3d(1:mid_idx,:f_nlat,:nmonth) = OC_f3d(mid_idx+1:f_nlon,:f_nlat,:nmonth) + tempor1d(1:mid_idx) = OC_lon(mid_idx+1:f_nlon) + tempor3d(mid_idx+1:f_nlon,:f_nlat,:nmonth) = OC_f3d(1:mid_idx,:f_nlat,:nmonth) + tempor1d(mid_idx+1:f_nlon) = OC_lon(1:mid_idx)+360._r8 + OC_f3d = tempor3d + OC_lon = tempor1d + deallocate(tempor3d) + deallocate(tempor1d) + else + OC_lon = OC_lon + endif + + ! convert unit from kg/m2/s to #/cm2/s + OC_f3d = OC_f3d*1.e3_r8/1.e4_r8/12._r8*6.02e23_r8 + + call lininterp_init(OC_lat, f_nlat, lat, plat, 1, wgt1) + call lininterp_init(OC_lon, f_nlon, lon, plon, 1, wgt2) + do itime = 1, nmonth + call lininterp(OC_f3d(:,:,itime), f_nlon, f_nlat, tempor(:,:), plon, plat, wgt2, wgt1) + OC3d(:,:,itime) = tempor(:,:) + end do + call lininterp_finish(wgt1) + call lininterp_finish(wgt2) + + do itime = 1, nmonth + OC_ship_GAINS(itime, :plat, :plon) = transpose(OC3d(:plon, :plat, itime)) + end do + + deallocate(OC_lat) + deallocate(OC_lon) + deallocate(OC_f3d) + deallocate(OC3d) + + ! Part 3a: BC GFEDv3 + ! ------------------------------------------------- + ! Open the netcdf file (read only) + call getfil(BC_GFEDv3_filename, BC_GFEDv3_file, 0) + call cam_pio_openfile(fid, trim(BC_GFEDv3_file), PIO_NOWRITE) + + ! Get file dimensions + ierr = pio_inq_dimid(fid, 'lon', fid_lon) + ierr = pio_inq_dimid(fid, 'lat', fid_lat) + ierr = pio_inq_dimlen(fid, fid_lon, f_nlon) + ierr = pio_inq_dimlen(fid, fid_lat, f_nlat) + + allocate(BC_lat(f_nlat)) + allocate(BC_lon(f_nlon)) + allocate(BC_f3d(f_nlon, f_nlat, nmonth)) + allocate(tempor3d(f_nlon, f_nlat, nmonth)) + allocate(BC3d (plon, plat, nmonth)) + allocate(BC_GFEDv3(nmonth, plat, plon)) + + ! Read in the tables. + BC_f3d = 0._r8 + ierr = pio_inq_varid(fid, 'emis', idvar) + ierr = pio_get_var(fid, idvar, tempor3d ) + !call wrap_inq_varid(fid, 'emis', idvar) + !call wrap_get_var_realx(fid, idvar, tempor3d) + BC_f3d = BC_f3d + tempor3d + ! excluding non-real values + where (BC_f3d(:,:,:) .ge. 1.e10_r8) + BC_f3d(:,:,:) = 1.e-30_r8 + end where + + ierr = pio_inq_varid(fid, 'lat', idlat) + ierr = pio_get_var(fid, idlat, BC_lat ) + ierr = pio_inq_varid(fid, 'lon ', idlon) + ierr = pio_get_var(fid, idlon, BC_lon ) + + ! Close the file. + call pio_closefile(fid) + + ! make sure file longitude range from -180-180 to 0-360 + if (BC_lon(1) < -160._r8) then + allocate(tempor1d(f_nlon)) + mid_idx = floor(f_nlon/2._r8) + tempor3d(1:mid_idx,:f_nlat,:nmonth) = BC_f3d(mid_idx+1:f_nlon,:f_nlat,:nmonth) + tempor1d(1:mid_idx) = BC_lon(mid_idx+1:f_nlon) + tempor3d(mid_idx+1:f_nlon,:f_nlat,:nmonth) = BC_f3d(1:mid_idx,:f_nlat,:nmonth) + tempor1d(mid_idx+1:f_nlon) = BC_lon(1:mid_idx)+360._r8 + BC_f3d = tempor3d + BC_lon = tempor1d + deallocate(tempor1d) + else + BC_lon = BC_lon + endif + + ! convert unit from g/m2/month to #/cm2/s + BC_f3d = BC_f3d/1.e4_r8/30._r8/86400._r8/12._r8*6.02e23_r8 + + call lininterp_init(BC_lat, f_nlat, lat, plat, 1, wgt1) + call lininterp_init(BC_lon, f_nlon, lon, plon, 1, wgt2) + do itime = 1, nmonth + call lininterp(BC_f3d(:,:,itime), f_nlon, f_nlat, tempor(:,:), plon, plat, wgt2, wgt1) + BC3d(:,:,itime) = tempor(:,:) + end do + call lininterp_finish(wgt1) + call lininterp_finish(wgt2) + + do itime = 1, nmonth + BC_GFEDv3(itime, :plat, :plon) = transpose(BC3d(:plon, :plat, itime)) + end do + + deallocate(BC_lat) + deallocate(BC_lon) + deallocate(BC_f3d) + deallocate(BC3d) + deallocate(tempor3d) + + ! Part 3b: OC GFEDv3 + ! ------------------------------------------------- + ! Open the netcdf file (read only) + call getfil(OC_GFEDv3_filename, OC_GFEDv3_file, 0) + call cam_pio_openfile(fid, trim(OC_GFEDv3_file), PIO_NOWRITE) + + ! Get file dimensions + ierr = pio_inq_dimid(fid, 'lon', fid_lon) + ierr = pio_inq_dimid(fid, 'lat', fid_lat) + ierr = pio_inq_dimlen(fid, fid_lon, f_nlon) + ierr = pio_inq_dimlen(fid, fid_lat, f_nlat) + + ! write(carma%f_LUNOPRT,*) '' + ! write(carma%f_LUNOPRT,*) 'f_lon = ', f_nlon + ! write(carma%f_LUNOPRT,*) 'f_lat = ', f_nlat + ! write(carma%f_LUNOPRT,*) '' + + allocate(OC_lat(f_nlat)) + allocate(OC_lon(f_nlon)) + allocate(OC_f3d(f_nlon, f_nlat, nmonth)) + allocate(tempor3d(f_nlon, f_nlat, nmonth)) + allocate(OC3d (plon, plat, nmonth)) + allocate(OC_GFEDv3(nmonth, plat, plon)) + + ! Read in the tables. + OC_f3d = 0._r8 + ierr = pio_inq_varid(fid, 'emis', idvar) + ierr = pio_get_var(fid, idvar, tempor3d ) + !call wrap_inq_varid(fid, 'emis', idvar) + !call wrap_get_var_realx(fid, idvar, tempor3d) + OC_f3d = OC_f3d + tempor3d + ! excluding non-real values + where (OC_f3d(:,:,:) .ge. 1.e10_r8) + OC_f3d(:,:,:) = 1.e-30_r8 + end where + + ierr = pio_inq_varid(fid, 'lat', idlat) + ierr = pio_get_var(fid, idlat, OC_lat ) + ierr = pio_inq_varid(fid, 'lon ', idlon) + ierr = pio_get_var(fid, idlon, OC_lon ) + + ! Close the file. + call pio_closefile(fid) + + ! make sure file longitude range from -180-180 to 0-360 + if (OC_lon(1) < -160._r8) then + allocate(tempor1d(f_nlon)) + mid_idx = floor(f_nlon/2._r8) + tempor3d(1:mid_idx,:f_nlat,:nmonth) = OC_f3d(mid_idx+1:f_nlon,:f_nlat,:nmonth) + tempor1d(1:mid_idx) = OC_lon(mid_idx+1:f_nlon) + tempor3d(mid_idx+1:f_nlon,:f_nlat,:nmonth) = OC_f3d(1:mid_idx,:f_nlat,:nmonth) + tempor1d(mid_idx+1:f_nlon) = OC_lon(1:mid_idx)+360._r8 + OC_f3d = tempor3d + OC_lon = tempor1d + deallocate(tempor1d) + else + OC_lon = OC_lon + endif + call lininterp_init(OC_lat, f_nlat, lat, plat, 1, wgt1) + call lininterp_init(OC_lon, f_nlon, lon, plon, 1, wgt2) + do itime = 1, nmonth + call lininterp(OC_f3d(:,:,itime), f_nlon, f_nlat, tempor(:,:), plon, plat, wgt2, wgt1) + OC3d(:,:,itime) = tempor(:,:) + end do + call lininterp_finish(wgt1) + call lininterp_finish(wgt2) + + do itime = 1, nmonth + OC_GFEDv3(itime, :plat, :plon) = transpose(OC3d(:plon, :plat, itime)) + end do + + deallocate(OC_lat) + deallocate(OC_lon) + deallocate(OC_f3d) + deallocate(OC3d) + deallocate(tempor3d) + +! Sum + do itime = 1, nmonth + BCnew(:plat, :plon, itime) = BC_anthro_GAINS(itime, :plat, :plon) + & + BC_ship_GAINS(itime, :plat, :plon) + BC_GFEDv3(itime, :plat, :plon) +! + OCnew(:plat, :plon, itime) = OC_anthro_GAINS(itime, :plat, :plon) + & + OC_ship_GAINS(itime, :plat, :plon) + OC_GFEDv3(itime, :plat, :plon) + end do +! + deallocate(BC_anthro_GAINS) + deallocate(OC_anthro_GAINS) + deallocate(BC_ship_GAINS) + deallocate(OC_ship_GAINS) + deallocate(BC_GFEDv3) + deallocate(OC_GFEDv3) + deallocate(facH) + deallocate(facL) +! + return + end subroutine CARMAMODEL_BCOCRead + +end module carma_model_mod diff --git a/src/physics/carma/models/trop_strat_soa5/carma_model_flags_mod.F90 b/src/physics/carma/models/trop_strat_soa5/carma_model_flags_mod.F90 new file mode 100644 index 0000000000..be4ca3c490 --- /dev/null +++ b/src/physics/carma/models/trop_strat_soa5/carma_model_flags_mod.F90 @@ -0,0 +1,113 @@ +!! This module handles reading the namelist and provides access to some other flags +!! that control a specific CARMA model's behavior. +!! +!! By default the specific CARMA model does not have any unique namelist values. If +!! a CARMA model wishes to have its own namelist, then this file needs to be copied +!! from physics/cam to physics/model/<model_name> and the code needed to read in the +!! namelist values added there. This file will take the place of the one in +!! physics/cam. +!! +!! It needs to be in its own file to resolve some circular dependencies. +!! +!! @author Chuck Bardeen +!! @version Mar-2011 +module carma_model_flags_mod + + use shr_kind_mod, only: r8 => shr_kind_r8 + use spmd_utils, only: masterproc + + ! Flags for integration with CAM Microphysics + public carma_model_readnl ! read the carma model namelist + + + ! Namelist flags + ! + ! Create a public definition of any new namelist variables that you wish to have, + ! and default them to an inital value. + + ! name of the dust erosion factor file + logical, public, protected :: carma_do_WeibullK = .false. ! if .true. then use calculated Weibull K, [Monahan, 2006] + character(len=32), public, protected :: carma_seasalt_emis = 'Gong' ! the source function scheme, either "Gong", "Martensson", + ! "Clarke", "Caffrey", "CMS", "CONST", or "NONE" + character(len=32), public, protected :: carma_BCOCemissions = 'Yu2015' + character(len=32), public, protected :: carma_SO4elevemis = 'NONE' + character(len=256), public, protected :: carma_soilerosion_file = 'NONE' + character(len=256), public, protected :: BC_GAINS_filename = 'NONE' + character(len=256), public, protected :: OC_GAINS_filename = 'NONE' + character(len=256), public, protected :: BC_ship_filename = 'NONE' + character(len=256), public, protected :: OC_ship_filename = 'NONE' + character(len=256), public, protected :: BC_GFEDv3_filename = 'NONE' + character(len=256), public, protected :: OC_GFEDv3_filename = 'NONE' + real(r8), public, protected :: carma_dustemisfactor = 0.5e-9_r8 + +contains + + + !! Read the CARMA model runtime options from the namelist + !! + !! @author Chuck Bardeen + !! @version Mar-2011 + subroutine carma_model_readnl(nlfile) + + ! Read carma namelist group. + + use cam_abortutils, only: endrun + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + + ! args + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! local vars + + integer :: unitn, ierr + + ! read namelist for CARMA + namelist /carma_model_nl/ & + carma_do_WeibullK, & + carma_seasalt_emis, & + carma_BCOCemissions, & + carma_SO4elevemis, & + carma_soilerosion_file, & + BC_GAINS_filename, & + OC_GAINS_filename, & + BC_ship_filename, & + OC_ship_filename, & + BC_GFEDv3_filename, & + OC_GFEDv3_filename, & + carma_dustemisfactor + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'carma_model_nl', status=ierr) + if (ierr == 0) then + read(unitn, carma_model_nl, iostat=ierr) + if (ierr /= 0) then + call endrun('carma_model_readnl: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + call mpibcast(carma_soilerosion_file, len(carma_soilerosion_file), mpichar, 0, mpicom) + call mpibcast(carma_do_WeibullK, 1, mpilog, 0, mpicom) + call mpibcast(carma_seasalt_emis, len(carma_seasalt_emis), mpichar, 0, mpicom) + call mpibcast(carma_BCOCemissions,len(carma_BCOCemissions), mpichar, 0, mpicom) + call mpibcast(carma_SO4elevemis, len(carma_SO4elevemis), mpichar, 0, mpicom) + call mpibcast(BC_GAINS_filename, len(BC_GAINS_filename), mpichar, 0, mpicom) + call mpibcast(OC_GAINS_filename, len(OC_GAINS_filename), mpichar, 0, mpicom) + call mpibcast(BC_ship_filename, len(BC_ship_filename), mpichar, 0, mpicom) + call mpibcast(OC_ship_filename, len(OC_ship_filename), mpichar, 0, mpicom) + call mpibcast(BC_GFEDv3_filename, len(BC_GFEDv3_filename), mpichar, 0, mpicom) + call mpibcast(OC_GFEDv3_filename, len(OC_GFEDv3_filename), mpichar, 0, mpicom) + call mpibcast(carma_dustemisfactor,1, mpir8, 0,mpicom) +#endif + + end subroutine carma_model_readnl + +end module carma_model_flags_mod diff --git a/src/physics/carma/models/trop_strat_soa5/carma_model_mod.F90 b/src/physics/carma/models/trop_strat_soa5/carma_model_mod.F90 new file mode 100644 index 0000000000..ec657f70a5 --- /dev/null +++ b/src/physics/carma/models/trop_strat_soa5/carma_model_mod.F90 @@ -0,0 +1,4790 @@ +!! This CARMA model is for dust aerosols and is based upon Su & Toon, JGR, 2009; +!! Su & Toon, ACP 2011. +!! +!! These dust are not currently radiatively active and do not replace the dust +!! in CAM; however, this is something that could be done in the future. +!! +!! This module defines several constants needed by CARMA, extends a couple of CARMA +!! interface methods: +!! +!! - CARMA_DefineModel() +!! - CARMA_EmitParticle() +!! +!! and adds some local functions used to do sea salt emission: +!! +!! - CARMA_SurfaceWind() +!! - WeibullWind() +!! +!! @version April-2020 +!! @author Simone Tilmes, Lin Su, Pengfei Yu, Chuck Bardeen +!! changes to pervious version: rename PURSULF to PRSULF to be easier read in in CAM +!! Simone Tilmes Aug5 2023: add Ilaria's diagnostic changes + +module carma_model_mod + + use carma_precision_mod + use carma_enums_mod + use carma_constants_mod + use carma_types_mod + use carmaelement_mod + use carmagas_mod + use carmagroup_mod + use carmasolute_mod + use carmastate_mod + use carma_mod + use carma_flags_mod + use carma_model_flags_mod + + use spmd_utils, only: masterproc + use shr_kind_mod, only: r8 => shr_kind_r8 + use cam_abortutils, only: endrun + use physics_types, only: physics_state, physics_ptend + use ppgrid, only: pcols, pver + use physics_buffer, only: physics_buffer_desc, pbuf_set_field, pbuf_get_field, pbuf_get_index + use time_manager, only: is_first_step + use cam_logfile, only: iulog + + implicit none + + private + + ! Declare the public methods. + public CARMAMODEL_CalculateCloudborneDiagnostics + public CARMAMODEL_CreateOpticsFile + public CARMAMODEL_DefineModel + public CARMAMODEL_Detrain + public CARMAMODEL_DiagnoseBins + public CARMAMODEL_DiagnoseBulk + public CARMAMODEL_EmitParticle + public CARMAMODEL_InitializeModel + public CARMAMODEL_InitializeParticle + public CARMAMODEL_OutputBudgetDiagnostics + public CARMAMODEL_OutputCloudborneDiagnostics + public CARMAMODEL_OutputDiagnostics + public CARMAMODEL_WetDeposition + + ! Declare public constants + integer, public, parameter :: NGROUP = 2 !! Number of particle groups + integer, public, parameter :: NELEM = 11 !! Number of particle elements + integer, public, parameter :: NBIN = 20 !! Number of particle bins + integer, public, parameter :: NSOLUTE = 0 !! Number of particle solutes + integer, public, parameter :: NGAS = 2 !! Number of gases + + ! NOTE: This is for now, when Pengfei has only defined sulfates at one weight percent. In the future, + ! we may want to expand this to match NMIE_WTP and/or NMIE_RH + integer, public, parameter :: NREFIDX = 1 !! Number of refractive indices per element + + ! These need to be defined, but are only used when the particles are radiatively active. + integer, public, parameter :: NMIE_RH = 10 !! Number of relative humidities for mie calculations + real(kind=f), public, parameter :: mie_rh(NMIE_RH) = (/ 0.1_f, 0.3_f, 0.5_f, 0.7_f, 0.8_f, 0.85_f, & + 0.9_f, 0.92_f, 0.93_f, 0.95_f /) + integer, public, parameter :: NMIE_WTP = 13 !! Number of weight percents for mie calculations + real(kind=f), public , parameter :: mie_wtp(NMIE_WTP) = (/ 0.1_f, 0.3_f, 0.5_f, 0.7_f, 0.8_f, 0.83_f, & + 0.86_f, 0.9_f, 0.92_f, 0.94_f, 0.96_f, 0.98_f, 1._f/) + + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. + ! Water vapor and cloud particles are convected in phase 1, while all other constituents + ! are done in phase 2. + logical, public :: is_convtran1(NGROUP) = .false. !! Should the group be transported in the first phase? + + ! Define any particle compositions that are used. Each composition type + ! should have a unique number. + integer, public, parameter :: I_H2SO4 = 1 !! H2SO4 coposition + integer, public, parameter :: I_OC = 2 !! OC composition + integer, public, parameter :: I_SOA1 = 3 !! SOA composition + integer, public, parameter :: I_SOA2 = 4 !! SOA composition + integer, public, parameter :: I_SOA3 = 5 !! SOA composition + integer, public, parameter :: I_SOA4 = 6 !! SOA composition + integer, public, parameter :: I_SOA5 = 7 !! SOA composition + integer, public, parameter :: I_BC = 8 !! BC composition + integer, public, parameter :: I_DUST = 9 !! dust composition + integer, public, parameter :: I_SALT = 10 !! sea salt composition + + integer, public, parameter :: I_GRP_PRSUL = 1 !! sulfate aerosol + integer, public, parameter :: I_GRP_MXAER = 2 !! mixed aerosol + + integer, public, parameter :: I_ELEM_PRSUL = 1 !! sulfate aerosol; nameing needs to only have 2 charaters before the element name to work with + !! partsof the code reading different elements + integer, public, parameter :: I_ELEM_MXAER = 2 !! aerosol + integer, public, parameter :: I_ELEM_MXOC = 3 !! organics aerosol + integer, public, parameter :: I_ELEM_MXSOA1 = 4 !! secondary organic aerosol + integer, public, parameter :: I_ELEM_MXSOA2 = 5 !! secondary organic aerosol + integer, public, parameter :: I_ELEM_MXSOA3 = 6 !! secondary organic aerosol + integer, public, parameter :: I_ELEM_MXSOA4 = 7 !! secondary organic aerosol + integer, public, parameter :: I_ELEM_MXSOA5 = 8 !! secondary organic aerosol + integer, public, parameter :: I_ELEM_MXBC = 9 !! black carbon + integer, public, parameter :: I_ELEM_MXDUST = 10 !! dust aerosol + integer, public, parameter :: I_ELEM_MXSALT = 11 !! sea salt aerosol + + integer, public, parameter :: I_GAS_H2O = 1 !! water vapor + integer, public, parameter :: I_GAS_H2SO4 = 2 !! sulphuric acid + + real(kind=f), public, parameter :: Kappa_OC = 0.5_f !! hygroscopicity of OC + real(kind=f), public, parameter :: Kappa_SOA = 0.5_f !! hygroscopicity of SOA + real(kind=f), public, parameter :: Kappa_BC = 0.1_f + real(kind=f), public, parameter :: Kappa_DUST = 0.2_f + real(kind=f), public, parameter :: Kappa_SALT = 1.0_f + real(kind=f), public, parameter :: Kappa_SULF = 0.5_f + + real(kind=f), public, parameter :: RHO_obc = 1.35_f !! dry density of smoke aerosol + real(kind=f), public, parameter :: RHO_DUST = 2.65_f !! dry density of dust particles (g/cm^3) -Lin Su + real(kind=f), public, parameter :: RHO_SALT = 2.65_f !! dry density of sea salt particles (g/cm) + real(kind=f), public, parameter :: RHO_SULFATE = 1.923_f !! dry density of sulfate particles (g/cm3) + + ! see CARMA_SmokeEmissionRead +! real(kind=f), allocatable, dimension(:,:) :: Chla ! Chlorophy11 data (mg/m3) + real(r8), allocatable, dimension(:,:,:) :: BCnew ! #/cm2/s + real(r8), allocatable, dimension(:,:,:) :: OCnew + + + ! for sea salt flux calculation + real(r8), parameter :: uth_salt = 4._r8 !! threshold wind velocity + + + ! for dust calculation + real(kind=f), parameter :: rClay = 1e-4_f !! silt/clay particle radius boundary (cm) + + integer :: nClay !! Number of clay bins (r < 1 um) + integer :: nSilt !! Number of silt bins + real(kind=f) :: clay_mf(NBIN)=-huge(1._f) !! clay mass fraction (fraction) + real(kind=f), allocatable, dimension(:,:) :: soil_factor !! Soil Erosion Factor (fraction) + real(kind=f), public, parameter :: WTMOL_H2SO4 = 98.078479_f !! molecular weight of sulphuric acid + +! NOTE: The WeibullK distribution is not currently supported, since the coefficients are not +! generated. This can be added later. +! real(r8), allocatable, dimension(:,:) :: Weibull_k ! Weibull K(nlat,nlon + real(kind=f), public, parameter :: rmin_PRSUL = 3.43e-8_f ! minimum radius (cm) + real(kind=f), public, parameter :: vmrat_PRSUL = 3.67_f ! volume ratio + real(kind=f), public, parameter :: rmin_MXAER = 5e-6_f ! minimum radius (cm) + real(kind=f), public, parameter :: vmrat_MXAER = 2.2588_f !2.4610_f ! volume ratio + +! Physics buffer index for sulfate surface area density + integer :: ipbuf4soa1(NBIN) = -1 + integer :: ipbuf4soa2(NBIN) = -1 + integer :: ipbuf4soa3(NBIN) = -1 + integer :: ipbuf4soa4(NBIN) = -1 + integer :: ipbuf4soa5(NBIN) = -1 + integer :: ipbuf4soacm1(NBIN) = -1 + integer :: ipbuf4soacm2(NBIN) = -1 + integer :: ipbuf4soacm3(NBIN) = -1 + integer :: ipbuf4soacm4(NBIN) = -1 + integer :: ipbuf4soacm5(NBIN) = -1 + integer :: ipbuf4soapt1(NBIN) = -1 + integer :: ipbuf4soapt2(NBIN) = -1 + integer :: ipbuf4soapt3(NBIN) = -1 + integer :: ipbuf4soapt4(NBIN) = -1 + integer :: ipbuf4soapt5(NBIN) = -1 + integer :: ipbuf4jno2 = -1 + real(kind=f) :: aeronet_fraction(NBIN) !! fraction of BC dV/dlnr in each bin (100%) + real(kind=f) :: so4inj_dist(NBIN) !! SO4 injection distribution across bins using a log normal distr. using r=0.95 and sigma =1.5 + real(kind=f) :: so4inj_dist1(NBIN) !! SO4 injection distribution across bins using a log normal distr. using r=0.95 and sigma =1.5 + + integer :: bc_srfemis_ndx=-1, oc_srfemis_ndx=-1 + integer :: so4_elevemis_ndx=-1 + integer :: carma_dustmap(NBIN) !! mapping of the CARMA dust bins to the surface dust bins. + + ! define refractive indices dependon composition and wavelength + ! + ! NOTE: It would be better to read this out of files, but this is how Pengfei set it up, so we + ! will use this for now. + ! + ! NOTE: Rather than using the values from Pengfei for the sulfate, use the values from MAM. They + ! have more precision and differ in the imaginary part below 2 um where Pengfei's are truncated at 0. + ! The MAM values are consistent with OPAC and truncate at 1e-8. + !real(kind=f), public :: shellreal(NWAVE) = (/1.890_f,1.913_f,1.932_f,1.568_f,1.678_f,1.758_f,1.855_f,1.597_f,1.147_f,1.261_f,& + ! 1.424_f,1.352_f,1.379_f,1.385_f,1.385_f,1.367_f,& + ! 1.367_f,1.315_f,1.358_f,1.380_f,1.393_f,1.405_f,1.412_f,1.422_f,1.428_f,1.430_f,& + ! 1.422_f,1.468_f,1.484_f,1.164_f/) + ! + !real(kind=f), public :: shellimag(NWAVE) = (/0.220_f,0.152_f,0.085_f,0.223_f,0.195_f,0.441_f,0.696_f,0.695_f,0.459_f,0.161_f,& + ! 0.172_f,0.144_f,0.120_f,0.122_f,0.126_f,0.158_f,& + ! 0.158_f,0.057_f,0.003_f,0.001_f,0.001_f,0.000_f,0.000_f,0.000_f,0.000_f,0.000_f,& + ! 0.000_f,0.000_f,0.000_f,0.551_f/) + + real(kind=f), public, parameter :: shellreal(NWAVE) = (/ 1.89_f, 1.912857_f, 1.932063_f, 1.586032_f, & + 1.677979_f, 1.757825_f, 1.855336_f, 1.596767_f, 1.146559_f, 1.261314_f, 1.424219_f, & + 1.351645_f, 1.378697_f, 1.385_f, 1.385_f, 1.366909_f, 1.366909_f, 1.314577_f, & + 1.357978_f, 1.380309_f, 1.392645_f, 1.404506_f, 1.412181_f, 1.421632_f, & + 1.427968_f, 1.430335_f, 1.441641_f, 1.467642_f, 1.484_f, 1.164128_f /) + + real(kind=f), public, parameter :: shellimag(NWAVE) = (/ 0.22_f, 0.15185711_f, 0.08457167_f, 0.22250789_f, 0.19499999_f, & + 0.44068847_f, 0.69594361_f, 0.69466153_f, 0.45876573_f, 0.16060575_f, & + 0.1715766_f , 0.14352135_f, 0.12025213_f, 0.12222873_f, 0.12581848_f, 0.15793008_f, & + 1.57930076e-01_f, 5.66869128e-02_f, 2.88634387e-03_f, 1.49071286e-03_f, & + 5.30385233e-04_f, 1.02977119e-04_f, 1.61967358e-05_f, 1.75122678e-06_f, & + 2.21435655e-08_f, 9.99999994e-09_f, 9.99999994e-09_f, 9.99999994e-09_f, & + 9.99999994e-09_f, 5.51133746e-01_f /) + + real(kind=f), public, parameter :: corerealdst(NWAVE) = & + (/2.340_f,2.904_f,1.748_f,1.508_f,1.911_f,1.822_f,2.917_f,1.557_f,1.242_f,1.447_f,& + 1.432_f,1.473_f,1.495_f,1.500_f,1.500_f,1.510_f,& + 1.510_f,1.520_f,1.523_f,1.529_f,1.530_f,1.530_f,1.530_f,1.530_f,1.530_f,1.530_f,& + 1.530_f,1.530_f,1.530_f,1.180_f/) + + real(kind=f), public, parameter :: corerealbc (NWAVE) = & + (/2.690_f,2.501_f,2.398_f,2.332_f,2.287_f,2.234_f,2.198_f,2.166_f,2.114_f,2.054_f,& + 2.028_f,1.977_f,1.948_f,1.933_f,1.921_f,1.877_f,& + 1.877_f,1.832_f,1.813_f,1.802_f,1.791_f,1.768_f,1.761_f,1.760_f,1.750_f,1.750_f,& + 1.750_f,1.741_f,1.620_f,2.124_f/) + + real(kind=f), public, parameter :: coreimagdst(NWAVE) = & + (/0.700_f,0.857_f,0.462_f,0.263_f,0.319_f,0.260_f,0.650_f,0.373_f,0.093_f,0.105_f,& + 0.061_f,0.025_f,0.011_f,0.008_f,0.007_f,0.018_f,& + 0.018_f,0.028_f,0.012_f,0.008_f,0.007_f,0.006_f,0.005_f,0.004_f,0.004_f,0.006_f,& + 0.014_f,0.024_f,0.030_f,0.101_f/) + + real(kind=f), public, parameter :: coreimagbc(NWAVE) = & + (/1.000_f,0.884_f,0.825_f,0.791_f,0.764_f,0.734_f,0.714_f,0.696_f,0.668_f,0.644_f,& + 0.624_f,0.604_f,0.593_f,0.586_f,0.580_f,0.556_f,& + 0.556_f,0.527_f,0.503_f,0.492_f,0.481_f,0.458_f,0.451_f,0.440_f,0.430_f,0.443_f,& + 0.461_f,0.470_f,0.450_f,0.674_f/) + + real(kind=f), public, parameter :: waterreal(NWAVE) = & + (/ 1.532_f, 1.523857_f, 1.420063_f, 1.274308_f, & + 1.161387_f, 1.142222_f, 1.232189_f, 1.266436_f, 1.295687_f, 1.320659_f, 1.341516_f, & + 1.315192_f, 1.330235_f, 1.339058_f, 1.350425_f, 1.408042_f, 1.408042_f, 1.324462_f, & + 1.276726_f, 1.301847_f, 1.312051_f, 1.321301_f, 1.322836_f, 1.326836_f, 1.330968_f, & + 1.33367_f, 1.339547_f, 1.348521_f, 1.362_f, 1.290783_f /) + + real(kind=f), public, parameter :: waterimag(NWAVE) = & + (/ 0.336_f, 0.36000001_f, 0.42623809_f, 0.40341724_f, & + 0.32062717_f, 0.11484398_f, 0.04710282_f, 0.03901278_f, 0.03373134_f, 0.03437707_f, & + 0.09216518_f, 0.0121094_f, 0.01314786_f, 0.01013119_f, 0.00486624_f, 0.0142042_f, & + 1.42042044e-02_f, 1.57659209e-01_f, 1.51634401e-03_f, 1.15906247e-03_f, & + 2.35527521e-04_f, 1.71196912e-04_f, 2.43626002e-05_f, 3.12758360e-06_f, & + 3.74323598e-08_f, 1.63841034e-09_f, 2.49434956e-09_f, 1.52413800e-08_f, & + 3.35000010e-08_f, 3.43825518e-02_f /) + + + +contains + + !! Defines all the CARMA components (groups, elements, solutes and gases) and process + !! (coagulation, growth, nucleation) that will be part of the microphysical model. + !! + !! @version May-2009 + !! @author Chuck Bardeen + subroutine CARMAMODEL_DefineModel(carma, rc) + + use physics_buffer, only: pbuf_add_field, dtype_r8 + + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(out) :: rc !! return code, negative indicates failure + + + ! Local variables + integer :: LUNOPRT ! logical unit number for output + character(len=2) :: outputname,outputbin + logical :: do_print ! do print output? + complex(kind=f) :: refidx(NWAVE, NREFIDX) ! refractice indices + + integer :: igroup,ibin + character(len=8) :: sname ! short (CAM) name + + ! Default return code. + rc = RC_OK + + ! Report model specific namelist configuration parameters. + if (masterproc) then + call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) + if (rc < 0) call endrun("CARMA_DefineModel: CARMA_Get failed.") + + if (do_print) write(LUNOPRT,*) '' + if (do_print) write(LUNOPRT,*) 'CARMA ', trim(carma_model), ' specific settings :' + if (do_print) write(LUNOPRT,*) ' carma_soilerosion_file = ', carma_soilerosion_file + if (do_print) write(LUNOPRT,*) ' carma_seasalt_emis = ', trim(carma_seasalt_emis) + if (do_print) write(LUNOPRT,*) ' carma_dustemisfactor = ', carma_dustemisfactor + end if + + ! Define the Groups + ! + ! NOTE: For CAM, the optional do_wetdep and do_drydep flags should be + ! defined. If wetdep is defined, then the optional solubility factor + ! should also be defined. + + !call CARMAGROUP_Create(carma, I_GRP_PURSUL, "sulfate", rmin_PRSUL, vmrat_PRSUL, I_SPHERE, 1._f, .false., & + ! rc, irhswell=I_WTPCT_H2SO4, do_wetdep=.true., do_drydep=.true., solfac=0.3_f, & + ! scavcoef=0.1_f, is_sulfate=.true., shortname="PRSULF", icoreshell=0, & + ! refidx = refidx, refidxS = refidx, refidxC = refidx, do_mie=.true.,imiertn=I_MIERTN_TOON1981) + !if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') + + call CARMAGROUP_Create(carma, I_GRP_PRSUL, "sulfate", rmin_PRSUL, vmrat_PRSUL, I_SPHERE, 1._f, .false., & + rc, irhswell=I_WTPCT_H2SO4, do_wetdep=.false., do_drydep=.true., solfac=0.3_f, & + scavcoef=0.1_f, is_sulfate=.true., shortname="PRSUL", do_mie=.true., & + imiertn=I_MIERTN_TOON1981, iopticstype = I_OPTICS_SULFATE) + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') + + + !call CARMAGROUP_Create(carma, I_GRP_MIXAER, "mixed aerosol", rmin_MIXAER, vmrat_MIXAER, I_SPHERE, 1._f, .false., & + ! rc, do_wetdep=.true., do_drydep=.true., solfac=0.2_f, & + ! scavcoef=0.1_f, shortname="CRMIX", refidx=refidx, & + ! refidxS=refidxS, refidxC=refidxC, do_mie=.true., & + ! irhswell=I_MIX, irhswcomp=I_SWG_URBAN, icoreshell=1,imiertn=I_MIERTN_TOON1981) + !if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') + + call CARMAGROUP_Create(carma, I_GRP_MXAER, "mixed aerosol", rmin_MXAER, vmrat_MXAER, I_SPHERE, 1._f, .false., & + rc, do_wetdep=.false., do_drydep=.true., solfac=0.2_f, & + scavcoef=0.1_f, shortname="MXAER", irhswell=I_PETTERS, do_mie=.true., imiertn=I_MIERTN_TOON1981, & + iopticstype = I_OPTICS_MIXED_YU_H2O, & + neutral_volfrc=-1._f) + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') + + + ! Define the Elements + ! + ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names + ! should be 6 characters or less and without spaces. + refidx(:,1) = CMPLX(shellreal(:), shellimag(:), kind=f) + call CARMAELEMENT_Create(carma, I_ELEM_PRSUL, I_GRP_PRSUL, "Sulfate", & + RHO_SULFATE, I_VOLATILE, I_H2SO4, rc, shortname="PRSULF", refidx=refidx) + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + + call CARMAELEMENT_Create(carma, I_ELEM_MXAER, I_GRP_MXAER, "Sulfate in mixed sulfate", & + RHO_SULFATE, I_VOLATILE, I_H2SO4, rc, kappa=Kappa_SULF, shortname="MXSULF", refidx=refidx) + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + + call CARMAELEMENT_Create(carma, I_ELEM_MXOC, I_GRP_MXAER, "organic carbon", & + RHO_obc, I_COREMASS, I_OC, rc, kappa=Kappa_OC, shortname="MXOC") + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + + call CARMAELEMENT_Create(carma, I_ELEM_MXSOA1, I_GRP_MXAER, "secondary organic aerosol1", & + RHO_obc, I_COREMASS, I_SOA1, rc, kappa=Kappa_SOA, shortname="MXSOA1") + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + + call CARMAELEMENT_Create(carma, I_ELEM_MXSOA2, I_GRP_MXAER, "secondary organic aerosol2", & + RHO_obc, I_COREMASS, I_SOA2, rc, kappa=Kappa_SOA, shortname="MXSOA2") + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + + call CARMAELEMENT_Create(carma, I_ELEM_MXSOA3, I_GRP_MXAER, "secondary organic aerosol3", & + RHO_obc, I_COREMASS, I_SOA3, rc, kappa=Kappa_SOA, shortname="MXSOA3") + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + + call CARMAELEMENT_Create(carma, I_ELEM_MXSOA4, I_GRP_MXAER, "secondary organic aerosol4", & + RHO_obc, I_COREMASS, I_SOA4, rc, kappa=Kappa_SOA, shortname="MXSOA4") + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + + call CARMAELEMENT_Create(carma, I_ELEM_MXSOA5, I_GRP_MXAER, "secondary organic aerosol5", & + RHO_obc, I_COREMASS, I_SOA5, rc, kappa=Kappa_SOA, shortname="MXSOA5") + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + + refidx(:,1) = CMPLX(corerealbc(:), coreimagbc(:), kind=f) + call CARMAELEMENT_Create(carma, I_ELEM_MXBC, I_GRP_MXAER, "black carbon", & + RHO_obc, I_COREMASS, I_BC, rc, kappa=Kappa_BC, shortname="MXBC", refidx=refidx) + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + + refidx(:,1) = CMPLX(corerealdst(:), coreimagdst(:), kind=f) + call CARMAELEMENT_Create(carma, I_ELEM_MXDUST, I_GRP_MXAER, "dust", & + RHO_DUST, I_COREMASS, I_DUST, rc, kappa=Kappa_DUST, shortname="MXDUST", refidx=refidx) + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + + call CARMAELEMENT_Create(carma, I_ELEM_MXSALT, I_GRP_MXAER, "SALT in mixed sulfate", & + RHO_SALT, I_COREMASS, I_SALT, rc, kappa=Kappa_SALT, shortname="MXSALT") + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + + + ! Define the Solutes + + + + ! Define the Gases + refidx(:,1) = CMPLX(waterreal(:), waterimag(:), kind=f) + call CARMAGAS_Create(carma, I_GAS_H2O, "Water Vapor", WTMOL_H2O, I_VAPRTN_H2O_MURPHY2005, I_GCOMP_H2O, & + rc, shortname = "Q", ds_threshold=-0.2_f, refidx=refidx) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGAS_Create failed.') + + call CARMAGAS_Create(carma, I_GAS_H2SO4, "Sulfuric Acid", WTMOL_H2SO4, I_VAPRTN_H2SO4_AYERS1980, & + I_GCOMP_H2SO4, rc, shortname = "H2SO4") + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGAS_Create failed.') + + + ! Define the Processes + + call CARMA_AddGrowth(carma, I_ELEM_PRSUL, I_GAS_H2SO4, rc) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddGrowth failed.') + + call CARMA_AddGrowth(carma, I_ELEM_MXAER, I_GAS_H2SO4, rc) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddGrowth failed.') + + call CARMA_AddNucleation(carma, I_ELEM_PRSUL, I_ELEM_PRSUL, I_HOMNUC, 0._f, rc, igas=I_GAS_H2SO4) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddNucleation failed.') + + call CARMA_AddCoagulation(carma, I_GRP_PRSUL, I_GRP_PRSUL, I_GRP_PRSUL, I_COLLEC_FUCHS, rc) + if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') + + call CARMA_AddCoagulation(carma, I_GRP_PRSUL, I_GRP_MXAER, I_GRP_MXAER, I_COLLEC_DATA, rc) + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') + + call CARMA_AddCoagulation(carma, I_GRP_MXAER, I_GRP_MXAER, I_GRP_MXAER, I_COLLEC_DATA, rc) + if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') + + !----------------- add pbuf ------------------ + do igroup = 1, NGROUP + + call CARMAGROUP_Get(carma, igroup, rc, shortname=sname) + if (rc < 0) call endrun('carma_register::CARMAGROUP_Get failed.') + !write(*,*) "igroup",igroup,"sname",sname + + ! sulfate mass and number density for each bin + ! e.g. CRSULF01 first element mass mixing ratio; NBMXAER01 #/kg + do ibin=1,NBIN + write (outputbin, "(I2.2)") ibin + if (igroup==I_GRP_MXAER) then + call pbuf_add_field("DQDT_MXSOA1"//outputbin,'global',dtype_r8,(/pcols,pver/), ipbuf4soa1(ibin)) + call pbuf_add_field("DQDT_MXSOA2"//outputbin,'global',dtype_r8,(/pcols,pver/), ipbuf4soa2(ibin)) + call pbuf_add_field("DQDT_MXSOA3"//outputbin,'global',dtype_r8,(/pcols,pver/), ipbuf4soa3(ibin)) + call pbuf_add_field("DQDT_MXSOA4"//outputbin,'global',dtype_r8,(/pcols,pver/), ipbuf4soa4(ibin)) + call pbuf_add_field("DQDT_MXSOA5"//outputbin,'global',dtype_r8,(/pcols,pver/), ipbuf4soa5(ibin)) + call pbuf_add_field("MXSOA1"//outputbin//"CM",'physpkg',dtype_r8,(/pcols,pver/), ipbuf4soacm1(ibin)) + call pbuf_add_field("MXSOA2"//outputbin//"CM",'physpkg',dtype_r8,(/pcols,pver/), ipbuf4soacm2(ibin)) + call pbuf_add_field("MXSOA3"//outputbin//"CM",'physpkg',dtype_r8,(/pcols,pver/), ipbuf4soacm3(ibin)) + call pbuf_add_field("MXSOA4"//outputbin//"CM",'physpkg',dtype_r8,(/pcols,pver/), ipbuf4soacm4(ibin)) + call pbuf_add_field("MXSOA5"//outputbin//"CM",'physpkg',dtype_r8,(/pcols,pver/), ipbuf4soacm5(ibin)) + call pbuf_add_field("MXSOA1"//outputbin//"PT",'physpkg',dtype_r8,(/pcols,pver/), ipbuf4soapt1(ibin)) + call pbuf_add_field("MXSOA2"//outputbin//"PT",'physpkg',dtype_r8,(/pcols,pver/), ipbuf4soapt2(ibin)) + call pbuf_add_field("MXSOA3"//outputbin//"PT",'physpkg',dtype_r8,(/pcols,pver/), ipbuf4soapt3(ibin)) + call pbuf_add_field("MXSOA4"//outputbin//"PT",'physpkg',dtype_r8,(/pcols,pver/), ipbuf4soapt4(ibin)) + call pbuf_add_field("MXSOA5"//outputbin//"PT",'physpkg',dtype_r8,(/pcols,pver/), ipbuf4soapt5(ibin)) + end if + end do + end do + + ! no2 photolysis rate constant (/sec) + call pbuf_add_field('JNO2', 'global', dtype_r8, (/pcols,pver/), ipbuf4jno2) + + !--------------------------------------------- + + return + end subroutine CARMAMODEL_DefineModel + + + !! Defines all the CARMA components (groups, elements, solutes and gases) and process + !! (coagulation, growth, nucleation) that will be part of the microphysical model. + !! + !! @version May-2009 + !! @author Chuck Bardeen + !! + !! @see CARMASTATE_SetDetrain + subroutine CARMAMODEL_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & + tnd_qsnow, tnd_nsnow) + use camsrfexch, only: cam_in_t + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(cam_in_t), intent(in) :: cam_in !! surface input + real(r8), intent(in) :: dlf(pcols, pver) !! Detraining cld H20 from convection (kg/kg/s) + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step (s) + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + real(r8), intent(out), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) + real(r8), intent(out), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_Detrain + + + !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. + !! + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMAMODEL_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(physics_state), intent(in) :: state !! physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(in), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + + ! local variables + real(r8), pointer, dimension(:,:) :: dqdt_soa !! soa tendency due to gas-aerosol exchange kg/kg/s + real(r8), pointer, dimension(:,:) :: jno2_rate !! jno2 tendency due to gas-aerosol exchange kg/kg/s + real(r8), pointer, dimension(:,:) :: soacm1 !! aerosol tendency due to gas-aerosol exchange kg/kg/s + real(r8), pointer, dimension(:,:) :: soacm2 !! aerosol tendency due to gas-aerosol exchange kg/kg/s + real(r8), pointer, dimension(:,:) :: soacm3 !! aerosol tendency due to gas-aerosol exchange kg/kg/s + real(r8), pointer, dimension(:,:) :: soacm4 !! aerosol tendency due to gas-aerosol exchange kg/kg/s + real(r8), pointer, dimension(:,:) :: soacm5 !! aerosol tendency due to gas-aerosol exchange kg/kg/s + real(r8), pointer, dimension(:,:) :: soapt1 !! aerosol tendency due to no2 photolysis kg/kg/s + real(r8), pointer, dimension(:,:) :: soapt2 !! aerosol tendency due to no2 photolysis kg/kg/s + real(r8), pointer, dimension(:,:) :: soapt3 !! aerosol tendency due to no2 photolysis kg/kg/s + real(r8), pointer, dimension(:,:) :: soapt4 !! aerosol tendency due to no2 photolysis kg/kg/s + real(r8), pointer, dimension(:,:) :: soapt5 !! aerosol tendency due to no2 photolysis kg/kg/s + real(r8) :: mmr_core(cstate%f_NZ)!! mass mixing ratio of the core (kg/kg) + real(r8) :: mmr_soa(cstate%f_NZ) !! mass mixing ratio of soa element (kg/kg) + real(r8) :: mmr(cstate%f_NZ) !! mass mixing ratio per bin (kg/kg) + real(r8) :: delta_soa(cstate%f_NZ) !! mass mixing ratio differences from soa gas-aerosol-exchange + integer :: icorelem(NELEM), ncore,ienconc,icore, ielem, ielem_soa, igroup, ibin, icomposition, n, err + + ! Default return code. + rc = RC_OK + + ! get no2 photolysis rates if they exist + call pbuf_get_field(pbuf, ipbuf4jno2, jno2_rate) ! surface area density + + ! get SOA tendency pbuf field for the mixed group and every bin + + igroup = I_GRP_MXAER + call CARMAGROUP_Get(carma, igroup, rc, ienconc=ienconc, ncore=ncore, icorelem=icorelem) + if (rc /= RC_OK) call endrun('CARMA_DiagnoseBins::CARMAGROUP_Get failed.') + + do ibin = 1, NBIN + + ! Iterate over the core elements, looking for the SOA elements. Once found, + ! determine the new SOA taking into account both the addition of condensed + ! SOA and the loss of photolyzed SOA. + do ielem = 1, ncore + + call CARMASTATE_GetBin(cstate, icorelem(ielem), ibin, mmr(:), rc) + if (rc /= RC_OK) call endrun('CARMA_DiagnoseBins::CARMASTATE_GetBin failed.') + + call CARMAELEMENT_GET(carma, icorelem(ielem), rc, icomposition=icomposition) + if (rc /= RC_OK) call endrun('CARMA_DiagnoseBins::CARMAELEMENT_Get failed.') + + ! Only need to make adjustments for the SOA. + if (icomposition == I_SOA1) then + call pbuf_get_field(pbuf, ipbuf4soa1(ibin), dqdt_soa) ! surface area density + + ! Add that soa tendency from chemistry to the aerosol. + ! + ! NOTE: dqdt is in kg/kg/s + mmr_soa(:) = mmr(:) + dqdt_soa(icol,:) * dt + + ! Save the chemistry tendency so it can by output in the diagnostics. + call pbuf_get_field(pbuf, ipbuf4soacm1(ibin), soacm1) + soacm1(icol,:) = dqdt_soa(icol,:) + + ! Save the NO2 photolysis tendency so it can by output in the diagnostics. + ! + ! NOTE: Simone, what is the 0.0004_r8?? + call pbuf_get_field(pbuf, ipbuf4soapt1(ibin), soapt1) + soapt1(icol,:) = - 0.0004_r8 * jno2_rate(icol,:) * mmr_soa(:) + + ! Now adjust the SOA for the loss by the photolysis rate provided by the + ! chemistry. + mmr_soa(:) = max(0.0_r8, mmr_soa(:) + soapt1(icol,:) * dt) + + ! Save out these new value for SOA. + call CARMASTATE_SetBin(cstate, icorelem(ielem), ibin, mmr_soa, rc) + if (rc /= RC_OK) call endrun('CARMA_DiagnoseBins::CARMAGROUP_SetBin failed.') + + end if !mxsoa1 + + if (icomposition == I_SOA2) then + call pbuf_get_field(pbuf, ipbuf4soa2(ibin), dqdt_soa) ! surface area density + + ! Add that soa tendency from chemistry to the aerosol. + ! + ! NOTE: dqdt is in kg/kg/s + mmr_soa(:) = mmr(:) + dqdt_soa(icol,:) * dt + + ! Save the chemistry tendency so it can by output in the diagnostics. + call pbuf_get_field(pbuf, ipbuf4soacm2(ibin), soacm2) + soacm2(icol,:) = dqdt_soa(icol,:) + + ! Save the NO2 photolysis tendency so it can by output in the diagnostics. + ! + ! NOTE: Simone, what is the 0.0004_r8?? + call pbuf_get_field(pbuf, ipbuf4soapt2(ibin), soapt2) + soapt2(icol,:) = - 0.0004_r8 * jno2_rate(icol,:) * mmr_soa(:) + + ! Now adjust the SOA for the loss by the photolysis rate provided by the + ! chemistry. + mmr_soa(:) = max(0.0_r8, mmr_soa(:) + soapt2(icol,:) * dt) + + ! Save out these new value for SOA. + call CARMASTATE_SetBin(cstate, icorelem(ielem), ibin, mmr_soa, rc) + if (rc /= RC_OK) call endrun('CARMA_DiagnoseBins::CARMAGROUP_SetBin failed.') + + end if !mxsoa2 + + if (icomposition == I_SOA3) then + call pbuf_get_field(pbuf, ipbuf4soa3(ibin), dqdt_soa) ! surface area density + + ! Add that soa tendency from chemistry to the aerosol. + ! + ! NOTE: dqdt is in kg/kg/s + mmr_soa(:) = mmr(:) + dqdt_soa(icol,:) * dt + + ! Save the chemistry tendency so it can by output in the diagnostics. + call pbuf_get_field(pbuf, ipbuf4soacm3(ibin), soacm3) + soacm3(icol,:) = dqdt_soa(icol,:) + + ! Save the NO2 photolysis tendency so it can by output in the diagnostics. + ! + ! NOTE: Simone, what is the 0.0004_r8?? + call pbuf_get_field(pbuf, ipbuf4soapt3(ibin), soapt3) + soapt3(icol,:) = - 0.0004_r8 * jno2_rate(icol,:) * mmr_soa(:) + + ! Now adjust the SOA for the loss by the photolysis rate provided by the + ! chemistry. + mmr_soa(:) = max(0.0_r8, mmr_soa(:) + soapt3(icol,:) * dt) + + ! Save out these new value for SOA. + call CARMASTATE_SetBin(cstate, icorelem(ielem), ibin, mmr_soa, rc) + if (rc /= RC_OK) call endrun('CARMA_DiagnoseBins::CARMAGROUP_SetBin failed.') + + end if !mxsoa3 + + if (icomposition == I_SOA4) then + call pbuf_get_field(pbuf, ipbuf4soa4(ibin), dqdt_soa) ! surface area density + + ! Add that soa tendency from chemistry to the aerosol. + ! + ! NOTE: dqdt is in kg/kg/s + mmr_soa(:) = mmr(:) + dqdt_soa(icol,:) * dt + + ! Save the chemistry tendency so it can by output in the diagnostics. + call pbuf_get_field(pbuf, ipbuf4soacm4(ibin), soacm4) + soacm4(icol,:) = dqdt_soa(icol,:) + + ! Save the NO2 photolysis tendency so it can by output in the diagnostics. + ! + ! NOTE: Simone, what is the 0.0004_r8?? + call pbuf_get_field(pbuf, ipbuf4soapt4(ibin), soapt4) + soapt4(icol,:) = - 0.0004_r8 * jno2_rate(icol,:) * mmr_soa(:) + + ! Now adjust the SOA for the loss by the photolysis rate provided by the + ! chemistry. + mmr_soa(:) = max(0.0_r8, mmr_soa(:) + soapt4(icol,:) * dt) + + ! Save out these new value for SOA. + call CARMASTATE_SetBin(cstate, icorelem(ielem), ibin, mmr_soa, rc) + if (rc /= RC_OK) call endrun('CARMA_DiagnoseBins::CARMAGROUP_SetBin failed.') + + end if !mxsoa4 + + if (icomposition == I_SOA5) then + call pbuf_get_field(pbuf, ipbuf4soa5(ibin), dqdt_soa) ! surface area density + + ! Add that soa tendency from chemistry to the aerosol. + ! + ! NOTE: dqdt is in kg/kg/s + mmr_soa(:) = mmr(:) + dqdt_soa(icol,:) * dt + + ! Save the chemistry tendency so it can by output in the diagnostics. + call pbuf_get_field(pbuf, ipbuf4soacm5(ibin), soacm5) + soacm5(icol,:) = dqdt_soa(icol,:) + + ! Save the NO2 photolysis tendency so it can by output in the diagnostics. + ! + ! NOTE: Simone, what is the 0.0004_r8?? + call pbuf_get_field(pbuf, ipbuf4soapt5(ibin), soapt5) + soapt5(icol,:) = - 0.0004_r8 * jno2_rate(icol,:) * mmr_soa(:) + + ! Now adjust the SOA for the loss by the photolysis rate provided by the + ! chemistry. + mmr_soa(:) = max(0.0_r8, mmr_soa(:) + soapt5(icol,:) * dt) + + ! Save out these new value for SOA. + call CARMASTATE_SetBin(cstate, icorelem(ielem), ibin, mmr_soa, rc) + if (rc /= RC_OK) call endrun('CARMA_DiagnoseBins::CARMAGROUP_SetBin failed.') + + end if !mxsoa5 + end do !ielem + end do !ibin + + end subroutine CARMAMODEL_DiagnoseBins + + + !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. + !! + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMAMODEL_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & + prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) + use camsrfexch, only: cam_out_t + + type(carma_type), intent(in) :: carma !! the carma object + type(carmastate_type), intent(inout) :: cstate !! the carma state object + type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models + type(physics_state), intent(in) :: state !! physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + type(physics_ptend), intent(inout) :: ptend !! constituent tendencies + integer, intent(in) :: icol !! column index + real(r8), intent(in) :: dt !! time step + integer, intent(out) :: rc !! return code, negative indicates failure + real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) + real(r8), intent(inout), optional :: prec_sed(pcols) !! total precip from cloud sedimentation (m/s) + real(r8), intent(inout), optional :: snow_sed(pcols) !! snow from cloud ice sedimentation (m/s) + real(r8), intent(inout), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) + real(r8), intent(inout), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) + real(r8), intent(out), optional :: re_ice(pcols,pver) !! ice effective radius (m) + + ! Local variables + real(r8) :: numberDensity(cstate%f_NZ) + real(r8) :: totad(cstate%f_NZ) + real(r8) :: ad(cstate%f_NZ) !! aerosol wet surface area density (cm2/cm3) + real(r8) :: totreff(cstate%f_NZ) !! total volume density, used to calculate total effective radius (cm) for history output + real(r8) :: reff(cstate%f_NZ) !! wet effective radius (m) + real(r8) :: mmr(cstate%f_NZ) !! mass mixing ratio per bin (kg/kg) + real(r8) :: coremmr(cstate%f_NZ) !! mmr of all the core + real(r8) :: mmr_gas(cstate%f_NZ) !! gas mass mixing ratio (kg/kg) + real(r8) :: numnkg(cstate%f_NZ) !! total number density (#/kg) + real(r8) :: r_wet(cstate%f_NZ) !! Sulfate aerosol bin wet radius (cm) + real(r8) :: elem1mr(cstate%f_NZ) !! First element mass mixing ratio (kg/kg) + real(r8) :: binnkg(cstate%f_NZ) !! number density per bin (#/kg) + real(r8) :: kappa(cstate%f_NZ) !! hygroscopicity parameter (Petters & Kreidenweis, ACP, 2007) + real(r8) :: rhoa_wet(cstate%f_NZ) !! wet air density (kg/m3) + real(r8) :: wtpct(cstate%f_NZ) !! sulfate weight percent + real(r8) :: rmass(NBIN) !! dry mass + real(r8) :: rhop_dry(cstate%f_NZ) !! dry particle density [g/cm3] + + integer :: ibin, igroup, igas, icomposition + integer :: icorelem(NELEM), ncore,ienconc,icore + character(len=8) :: sname !! short (CAM) name + + real(r8), pointer, dimension(:,:) :: sadsulf_ptr !! Total surface area density pointer (cm2/cm3) + real(r8), pointer, dimension(:,:) :: reffaer_ptr !! Total effective radius pointer (cm) for history output + real(r8), pointer, dimension(:,:) :: wtp_ptr !! weight percent pointer + real(r8), pointer, dimension(:,:) :: sad_ptr !! Surface area density pointer + real(r8), pointer, dimension(:,:) :: reff_ptr !! Effective radius pointer + real(r8), pointer, dimension(:,:) :: numnkg_ptr !! Each group number density pointer + real(r8), pointer, dimension(:,:) :: binnkg_ptr !! Each bin number density pointer + real(r8), pointer, dimension(:,:) :: elem1mr_ptr !! First element mmr pointer + real(r8), pointer, dimension(:,:) :: kappa_ptr !! kappa pointer + real(r8), pointer, dimension(:,:) :: wetr_ptr !! wet radius pointer + real(r8), pointer, dimension(:,:) :: dryr_ptr !! dry radius + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_DiagnoseBulk + + + !! Calculates the emissions for CARMA aerosol particles. By default, there is no + !! emission, but this routine can be overridden for models that wish to have + !! an aerosol emission. + !! + !! @author Lin Su, Pengfei Yu, Chuck Bardeen + !! @version Dec-2010 + subroutine CARMAMODEL_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, pbuf, rc) + use ppgrid, only: pcols, pver + use physics_types, only: physics_state + use phys_grid, only: get_lon_all_p, get_lat_all_p + use time_manager, only: get_curr_date, get_perp_date, is_perpetual + use camsrfexch, only: cam_in_t + use cam_history, only: outfld + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + integer, intent(in) :: icnst !! consituent index + real(r8), intent(in) :: dt !! time step (s) + type(physics_state), intent(in) :: state !! physics state + type(cam_in_t), intent(in) :: cam_in !! surface inputs + real(r8), intent(out) :: tendency(pcols, pver) !! constituent tendency (kg/kg/s) + real(r8), intent(out) :: surfaceFlux(pcols) !! constituent surface flux (kg/m^2/s) + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: ilat(pcols) ! latitude index + integer :: ilon(pcols) ! longitude index + real(r8) :: clat(pcols) ! latitude + integer :: lchnk ! chunk identifier + integer :: ncol ! number of columns in chunk + integer :: icol ! column index + integer :: p ! plev index + integer :: yr ! year + integer :: mon ! month + integer :: day ! day of month + integer :: ncsec ! time of day (seconds) + real(r8) :: smoke(pcols) ! smoke emission flux (molecues/cm2/s) + real(r8) :: rhoa(pcols,pver) ! density of air g/cm3 + real(r8) :: so4_inj(pcols,pver) ! so4 emission flux (molecues/cm3/s) + real(r8) :: so4_tendency_factor(pcols,pver) ! Convertion factor from molec/cm3/s to kg/kg/s + integer :: igroup ! the index of the carma aerosol group + character(len=32) :: shortname ! the shortname of the group + + + + ! -------- local variables added for dust and sea-salt model ------------ + real(r8) :: ch ! dimensional factor & tuning number, + real(r8) :: rmass(NBIN) ! bin mass (g) + real(r8) :: r ! bin center (cm) + real(r8) :: rdust ! dust bin center (cm) + real(r8) :: dustFlux ! dust flux (kg/m2/s) + real(r8) :: rsalt ! salt bin center (cm) + real(r8) :: drsalt ! salt bin width (cm) + real(r8) :: rhop(NBIN) ! element density (g/cm3) + real(r8) :: vrfact + real(r8) :: uth ! threshold wind velocity (m/s) + real(r8) :: uv10 ! 10 m wind speed (m/s) + real(r8) :: cd10 ! 10-m drag coefficient () + real(r8) :: wwd ! raw wind speed (m/s) + real(r8) :: sp ! mass fraction for soil factor + integer :: idustbin ! ibin to use for dust production, smallest silt bin for clay + +! ------------ local variables added for organics model ---------------------- + real(r8) :: dr + real(r8) :: aeronet(NBIN) ! AERONET DATA, Sep.20, 2002, Jaru Reserve, Brazil (refer to MATICHUK et al., 2008) + real(r8) :: saltFlux(pcols) ! sea salt flux to calculate marine POA + integer :: LUNOPRT ! logical unit number for output + logical :: do_print ! do print output? + + real(r8),parameter :: OMtoOCratio = 1.8_r8 ! Need better names and doc + real(r8),parameter :: SmoketoSufaceFlux = 1.9934e-22_r8 ! SmoketoSufaceFlux = BC molecular weight + ! (12 g/mol)/avocadro constant (6e-23 #/mol) *10 + real(r8), pointer :: BCemis_ptr(:), OCemis_ptr(:) + real(r8), pointer :: SO4elevemis_ptr(:,:) + + ! Default return code. + rc = RC_OK + smoke(:) = -huge(1._r8) + so4_inj(:,:) = -huge(1._r8) + ch = carma_dustemisfactor + + ! Determine the day of year. + if ( is_perpetual() ) then + call get_perp_date(yr, mon, day, ncsec) + else + call get_curr_date(yr, mon, day, ncsec) + end if + + ! Determine the latitude and longitude of each column. + lchnk = state%lchnk + ncol = state%ncol + + ! Add any surface flux here. + surfaceFlux(:ncol) = 0.0_r8 + + ! For emissions into the atmosphere, put the emission here. + ! + ! NOTE: Do not set tendency to be the surface flux. Surface source is put in to + ! the bottom layer by vertical diffusion. See vertical_solver module, line 355. + tendency(:ncol, :pver) = 0.0_r8 + + ! Add Emission (surfaceFlux) here. + + !!******************************************************************************************************* + + !! add an element, first element is total number with emission from both OC and BC; + !! second element is BC mass + !! by Pengfei Yu + !! Feb.22 2012 + !!******************************************************************************************************* + + + call CARMAELEMENT_GET(carma, ielem, rc, igroup=igroup, shortname=shortname) + if (RC < RC_ERROR) return + + call CARMAGROUP_GET(carma, igroup, rc, shortname=shortname, rmass=rmass) + if (RC < RC_ERROR) return + + !!******************************************************************************************************* + + !if (masterproc) then + ! call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) + ! + ! if (do_print) then + ! write(carma%f_LUNOPRT,*) 'AERONET', aeronet + ! write(carma%f_LUNOPRT,*) 'dr', dr + ! write(carma%f_LUNOPRT,*) 'r', r + ! end if + !end if + + !!******************************************************************************************************* + + if(carma_BCOCemissions == 'Specified')then + call pbuf_get_field(pbuf, bc_srfemis_ndx, BCemis_ptr) + call pbuf_get_field(pbuf, oc_srfemis_ndx, OCemis_ptr) + end if + if(carma_SO4elevemis== 'Specified')then + call pbuf_get_field(pbuf, so4_elevemis_ndx, SO4elevemis_ptr) + end if + + ! Organic carbon emssions + if (ielem == I_ELEM_MXOC) then + if (carma_BCOCemissions == 'Yu2015') then + call get_lat_all_p(lchnk, ncol, ilat) + call get_lon_all_p(lchnk, ncol, ilon) + do icol = 1,ncol + smoke(icol) = OCnew(ilat(icol), ilon(icol), mon)*OMtoOCratio + end do + elseif(carma_BCOCemissions == 'Specified')then + smoke(:ncol) = OCemis_ptr(:ncol) + end if + +! st scip Fsub PBAFlux etcfor now + surfaceFlux(:ncol) = surfaceFlux(:ncol) + smoke(:ncol)*aeronet_fraction(ibin)*SmoketoSufaceFlux + end if + + ! Black carbon emissions + if (ielem == I_ELEM_MXBC) then + if (carma_BCOCemissions == 'Yu2015') then + do icol = 1,ncol + smoke(icol) = BCnew(ilat(icol), ilon(icol), mon) + end do + elseif(carma_BCOCemissions == 'Specified') then + smoke(:ncol) = BCemis_ptr(:ncol) + end if + + surfaceFlux(:ncol) = surfaceFlux(:ncol) + smoke(:ncol)*aeronet_fraction(ibin)*SmoketoSufaceFlux + end if + + if(carma_SO4elevemis == 'Specified') then + ! Sulfate emissions + if (ielem == I_ELEM_PRSUL) then + ! convert from #/kg to kg/kg = 1.e-3 * mw/avog (6e-23) !kg/kg + ! convert from #/cm3/s to kg/kg/s = 1.e3 * density of air * mw / avog + !AVG: molec/mol R_AIR: units? + !rhoa + !number Density + !rhoa(:ncol,:) = 10._r8 * state%pmid(:ncol,:) / (R_AIR * state%t(:ncol,:)) + !pmid is in Pa (Pa->dynes (factor of 10.), T (K), -> g/cm3 + + !so4_tendency_factor(:ncol,:) = rhoa(:ncol,:) * WTMOL_H2SO4 / AVG !molec/cm3/s to kg/kg + + so4_inj(:ncol,:) = SO4elevemis_ptr(:ncol,:) + + + ! set so4_inj larger 0. because of potential negative missing values + do icol = 1,ncol + do p = 1,pver + rhoa(icol,p) = 10._r8 * state%pmid(icol,p) / (R_AIR * state%t(icol,p)) + !pmid is in Pa (Pa->dynes (factor of 10.), T (K), -> g/cm3 + !emis = molec/cm3/s + !rhoa = g/cm3 + !mw = g/mol + !avg = molec/mol + !so4_tendency_factor(icol,p) = rhoa(icol,p) * WTMOL_H2SO4 / AVG !molec/cm3/s to kg/kg + so4_tendency_factor(icol,p) = WTMOL_H2SO4 / AVG / rhoa(icol,p) !molec/cm3/s to kg/kg + so4_inj(icol,p) = max(0._r8,so4_inj(icol,p)) + if (so4_inj(icol,p).gt.0._r8) then + tendency(icol,p) = so4_inj(icol,p)*so4inj_dist(ibin)*so4_tendency_factor(icol,p) + end if + end do + end do + end if + end if + + ! Dust emissions + if (ielem == I_ELEM_MXDUST) then + + ! The radius should be determined by the dust density not the group + ! density + call CARMAELEMENT_Get(carma, I_ELEM_MXDUST, rc, rho=rhop) + if (RC < RC_ERROR) return + + ! Calculate the radius assuming that all the mass will be emitted as this + ! element. + rdust = (3._r8 * rmass(ibin) / 4._r8 / PI / rhop(ibin)) ** (1._r8 / 3._r8) + + ! Is this clay or silt? + ! + ! NOTE: It is assumed that 90% of the mass will be silt and 10% will + ! be clay. + ! + ! NOTE: For clay bins, use the smallest silt bin to calculate the + ! mass and then scale that into each clay bin based upon interpolation of + ! Tegen and Lacis [1996]. + if (rdust >= rClay) then + sp = 0.9_r8 / nSilt + idustbin = ibin + else + sp = 0.1_r8 / nClay + idustbin = nClay + 1 + end if + + ! Process each column. + do icol = 1,ncol + + call CARMAMODEL_SurfaceWind(carma, icol, I_ELEM_MXDUST, igroup, idustbin, cam_in, uv10, wwd, uth, rc) + + ! Is the wind above the threshold for dust production? + if (sqrt(wwd) > uth) then + dustFlux = ch * soil_factor(icol, lchnk) * sp * & + wwd * (sqrt(wwd) - uth) + else + dustFlux = 0._r8 + endif + + ! Scale the clay bins based upon the smallest silt bin. + dustFlux = clay_mf(ibin) * dustFlux + + ! Add the dust flux to the accumulated emissions (important for I_ELEM_MXAER) + surfaceFlux(icol) = surfaceFlux(icol) + dustFlux + end do + + ! For debug purposes, output the soil erosion factor. + call outfld('CRSLERFC', soil_factor(:ncol, lchnk), ncol, lchnk) + end if + + + ! Sea salt emissions + if (ielem == I_ELEM_MXSALT) then + + ! The radius should be determined by the dust density not the group + ! density + call CARMAELEMENT_Get(carma, I_ELEM_MXSALT, rc, rho=rhop) + if (RC < RC_ERROR) return + + ! Calculate the radius assuming that all the mass will be emitted as sea + ! salt. + vrfact = ((3._r8/2._r8 / PI / (vmrat_MXAER + 1._r8))**(1._r8 / 3._r8)) * ((vmrat_MXAER**(1._r8 / 3._r8)) - 1._r8) + rsalt = (3._r8 * rmass(ibin) / 4._r8 / PI / rhop(ibin))**(1._r8 / 3._r8) + drsalt = vrfact * ((rmass(ibin)/rhop(ibin))**(1._r8 / 3._r8)) + + ! get sea spray aerosol flux first (for ibin; SaltFlux(:ncol) unit:kg/m2/s) + call CARMAMODEL_SaltFlux(carma, ibin, state, rsalt, drsalt, rmass(ibin), cam_in, saltFlux, rc) + +!st not used currently but done by Pengfei + !! introduce marine POA emission, use ChlorophyII-dependent mass contribution of OC + !! see Gantt et al., 2009 + !! for sub-micron, I use sea salt flux instead of sub-micron marine particles + !! needed to verify later + !! Added by Pengfei Yu + !! Oct.6.2012 + ! get [Chl-a] data + !! do icol = 1, ncol + !! if (Chla(ilat(icol), ilon(icol)) .lt. 0._r8) then + !! Fsub(icol) = 0._r8 + !! else + !! Fsub(icol) = Chla(ilat(icol), ilon(icol)) * 0.63_r8 + 0.1_r8 + !! endif + !! Fsub(icol) = min(Fsub(icol), 1._r8) + !! enddo + !! surfaceFlux(:ncol) = SaltFlux(:ncol) + !! ! sea salt (NaCl) flux should exclude marine organics and marine sulfate + !! if (carma%f_group(igroup)%f_r(ibin) .le. 0.5e-4_r8) then + !! !surfaceFlux(:ncol) = SaltFlux(:ncol)*(1._r8-0.0983_r8) - SaltFlux(:ncol) * Fsub(:ncol) + !! surfaceFlux(:ncol) = (SaltFlux(:ncol) - SaltFlux(:ncol)*Fsub(:ncol))/1.0983_r8 + !! else + !! !surfaceFlux(:ncol) = SaltFlux(:ncol)*(1._r8-0.0983_r8) - SaltFlux(:ncol) * (Fsub(:ncol)*0.03_r8) + !! surfaceFlux(:ncol) = (SaltFlux(:ncol) - SaltFlux(:ncol)*Fsub(:ncol)*0.03_r8)/1.0983_r8 + !! endif + surfaceFlux(:ncol) = surfaceFlux(:ncol) + saltFlux(:ncol) + end if + + return + end subroutine CARMAMODEL_EmitParticle + + + !! Allows the model to perform its own initialization in addition to what is done + !! by default in CARMA_init. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMAMODEL_InitializeModel(carma, lq_carma, pbuf2d, rc) + use cam_history, only: addfld, horiz_only, add_default + use constituents, only: pcnst + + type(carma_type), intent(in) :: carma !! the carma object + logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent + !! could have a CARMA tendency + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + integer, intent(out) :: rc !! return code, negative indicates failure + + ! -------- local variables ---------- + integer :: ibin ! CARMA bin index + real(r8) :: r(NBIN), dr(NBIN), rdust(NBIN),robc(NBIN),drobc(NBIN),rm(NBIN),rhop(NBIN) ! bin center (cm) + integer :: count_Silt ! count number for Silt + integer :: igroup ! the index of the carma aerosol group + integer :: ielem ! the index of the carma aerosol element + character(len=32) :: shortname ! the shortname of the element + integer :: LUNOPRT ! logical unit number for output + logical :: do_print ! do print output? + + integer :: i, idata,isizebin,ibin_local + integer,parameter :: aeronet_dim1 = 22 + integer,parameter :: aeronet_dim2 = 4 + real(r8),dimension(aeronet_dim1,aeronet_dim2) :: sizedist_aeronet + real(r8),dimension(aeronet_dim1) :: sizedist_avg + real(r8),dimension(NBIN) :: sizedist_carmabin + real(r8) :: rmass(NBIN) !! dry mass + real(r8) :: vrfact + real(r8) :: rgeo + real(r8) :: siglog, siglogsq, sq2pi + character(len=16) :: binname !! names bins + + real(r8),parameter :: size_aeronet(aeronet_dim1) = (/0.050000_r8,0.065604_r8,0.086077_r8,0.112939_r8,0.148184_r8, & + 0.194429_r8,0.255105_r8,0.334716_r8,0.439173_r8,0.576227_r8,0.756052_r8,0.991996_r8,1.301571_r8,1.707757_r8, & + 2.240702_r8,2.939966_r8,3.857452_r8,5.061260_r8,6.640745_r8,8.713145_r8,11.432287_r8,15.000000_r8/)*1.e-4_r8 !um to cm + + ! Default return code. + rc = RC_OK + + ! Determine how many clay and how many silt bins there are, based + ! upon the bin definitions and rClay. + ! + ! TBD: This should use the radii rather than being hard coded. + ! nClay = 8 + ! nSilt = NBIN - nClay + do ielem = 1, NELEM + + ! To get particle radius, need to derive from rmass and density of dust. + call CARMAELEMENT_GET(carma, ielem, rc, igroup=igroup, shortname=shortname, rho=rhop) + if (RC < RC_ERROR) return + + call CARMAGROUP_GET(carma, igroup, rc, rmass=rmass) + if (RC < RC_ERROR) return + + if (shortname .eq. "MXDUST") then + + count_Silt = 0 + do ibin = 1, NBIN + + ! Calculate the radius assuming that all the mass will be emitted as this + ! element. + rdust(ibin) = (3._r8 * rmass(ibin) / 4._r8 / PI / rhop(ibin))**(1._r8 / 3._r8) + + if (rdust(ibin) >= rclay) then + count_Silt = count_Silt + 1 + else + end if + end do + nSilt = count_Silt + nClay = NBIN - nSilt + end if + end do + + ! Read in the soil factors. + call CARMAMODEL_ReadSoilErosionFactor(rc) + if (RC < RC_ERROR) return + + ! To determine Clay Mass Fraction + do ielem = 1, NELEM + ! To get particle radius + call CARMAELEMENT_GET(carma, ielem, rc, igroup=igroup, shortname=shortname) + if (RC < RC_ERROR) return + + if (shortname .eq. "MXDUST") then + call CARMAMODEL_ClayMassFraction(carma, igroup, rdust, rc) + end if + end do + + if (masterproc) then + call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) + if (rc < 0) call endrun("CARMA_InitializeModel: CARMA_Get failed.") + + if (do_print) then + write(carma%f_LUNOPRT,*) 'Initializing CARMA dust model ...' + write(carma%f_LUNOPRT,*) 'nClay = ', nClay, ' nSilt = ', nSilt + write(carma%f_LUNOPRT,*) 'clay_mf = ', clay_mf + write(carma%f_LUNOPRT,*) 'soil_factor = ', soil_factor + + write(carma%f_LUNOPRT,*) 'CARMA dust initialization complete' + end if + end if + + call addfld('CRSLERFC', horiz_only, 'A', 'fraction', 'CARMA soil erosion factor') + + if (carma_BCOCemissions == 'Yu2015')then + ! Added by Pengfei Yu to read smoke emission data + call CARMAMODEL_BCOCread(rc) + end if + if(carma_BCOCemissions == 'Specified')then + bc_srfemis_ndx = pbuf_get_index("BC_srfemis") + oc_srfemis_ndx = pbuf_get_index("OC_srfemis") + end if + + ! prescribed sulfate emissions for stratospheric aerosol injections + if(carma_SO4elevemis == 'Specified')then + so4_elevemis_ndx = pbuf_get_index("SO4_elevemis") + end if + + if (is_first_step()) then + + ! Initialize physics buffer fields + do igroup = 1, NGROUP + do ibin = 1, NBIN + if (igroup==I_GRP_MXAER) then + call pbuf_set_field(pbuf2d, ipbuf4soa1(ibin), 0.0_r8 ) + call pbuf_set_field(pbuf2d, ipbuf4soa2(ibin), 0.0_r8 ) + call pbuf_set_field(pbuf2d, ipbuf4soa3(ibin), 0.0_r8 ) + call pbuf_set_field(pbuf2d, ipbuf4soa4(ibin), 0.0_r8 ) + call pbuf_set_field(pbuf2d, ipbuf4soa5(ibin), 0.0_r8 ) + end if + end do + end do + + call pbuf_set_field(pbuf2d, ipbuf4jno2, 0.0_r8 ) + endif + + sizedist_aeronet(:aeronet_dim1,1) = (/0.000585_r8,0.006080_r8,0.025113_r8,0.052255_r8,0.079131_r8,0.081938_r8, & + 0.035791_r8,0.010982_r8,0.005904_r8,0.007106_r8,0.011088_r8,0.012340_r8,0.010812_r8,0.010423_r8, & + 0.011892_r8,0.016529_r8,0.023967_r8,0.026854_r8,0.017901_r8,0.007226_r8,0.002161_r8,0.000544_r8/) + sizedist_aeronet(:aeronet_dim1,2) = (/0.000541_r8,0.006524_r8,0.026103_r8,0.050825_r8,0.077730_r8,0.080545_r8, & + 0.035400_r8,0.011143_r8,0.005753_r8,0.006095_r8,0.008730_r8,0.010794_r8,0.011517_r8,0.012051_r8, & + 0.012362_r8,0.014710_r8,0.019738_r8,0.022156_r8,0.014892_r8,0.005976_r8,0.001891_r8,0.000573_r8/) + sizedist_aeronet(:aeronet_dim1,3) = (/0.000747_r8,0.009291_r8,0.043556_r8,0.099216_r8,0.142377_r8,0.108606_r8, & + 0.043723_r8,0.016385_r8,0.008318_r8,0.005597_r8,0.004431_r8,0.004131_r8,0.004980_r8,0.007484_r8, & + 0.011795_r8,0.017235_r8,0.022404_r8,0.025216_r8,0.022521_r8,0.013752_r8,0.005051_r8,0.001057_r8/) + sizedist_aeronet(:aeronet_dim1,4) = (/0.000979_r8,0.007724_r8,0.034451_r8,0.090410_r8,0.135893_r8,0.103115_r8, & + 0.046047_r8,0.018989_r8,0.009149_r8,0.005034_r8,0.003199_r8,0.002680_r8,0.003249_r8,0.005105_r8, & + 0.008370_r8,0.012542_r8,0.016973_r8,0.021107_r8,0.022077_r8,0.015639_r8,0.006001_r8,0.001115_r8/) + + sizedist_avg(:) = 0._r8 + do idata = 1,aeronet_dim2 + sizedist_avg(:) = sizedist_avg(:) + sizedist_aeronet(:,idata) + end do + sizedist_avg(:) = sizedist_avg(:)*0.25_r8 + + do igroup = 1,NGROUP + call CARMAGROUP_GET(carma, igroup, rc, shortname=shortname, rmass=rmass) + + + if (shortname .eq. "MXAER") then + + !interpolate into carma bin + sizedist_carmabin = 0._r8 + + do ibin_local = 1, NBIN + ! Calculate the radius assuming that all the mass will be emitted as this + ! element. + vrfact = ((3._r8/2._r8 / PI / (vmrat_MXAER + 1._r8))**(1._r8 / 3._r8)) * ((vmrat_MXAER**(1._r8 / 3._r8)) - 1._r8) + robc(ibin_local) = (3._r8 * rmass(ibin_local) / 4._r8 / PI / rho_obc)**(1._r8 / 3._r8) + drobc(ibin_local) = vrfact * ((rmass(ibin_local)/rho_obc) **(1._r8 / 3._r8)) + + if(robc(ibin_local) .lt. size_aeronet(1)) then + sizedist_carmabin(ibin_local) = sizedist_avg(1) + end if + if(robc(ibin_local) .ge. size_aeronet(aeronet_dim1)) then + sizedist_carmabin(ibin_local) = sizedist_avg(aeronet_dim1) + end if + do isizebin= 1,aeronet_dim1-1 + if( robc(ibin_local) .ge. size_aeronet(isizebin) .and. robc(ibin_local) .lt. size_aeronet(isizebin+1))then + sizedist_carmabin(ibin_local) = sizedist_avg(isizebin)*(size_aeronet(isizebin+1)-robc(ibin_local))/& + (size_aeronet(isizebin+1)-size_aeronet(isizebin))& + +sizedist_avg(isizebin+1)*(robc(ibin_local)-size_aeronet(isizebin))& + /(size_aeronet(isizebin+1)-size_aeronet(isizebin)) + end if + end do + end do + + rm(:) = 0._r8 + do ibin_local = 1, NBIN + rm(ibin_local) = sizedist_carmabin(ibin_local)*drobc(ibin_local)/robc(ibin_local)*RHO_obc*1.e-15_r8 ! kg + enddo + + do ibin_local = 1, NBIN + aeronet_fraction(ibin_local) = rm(ibin_local)/sum(rm(:)) + end do + + end if + end do + + ! Produce lognormal size distribtuion for sulfate emissions (SO4 geoengienering experiments) + + ! Define specific for SO4 injection, e.g.,mean dry radius: 0.095, sigma = 1.5 + so4inj_dist(:) = 0.0_r8 + so4inj_dist1(:) = 0.0_r8 + rgeo=0.095e-4_f ! mean radius for aerosol injections in cm + siglog=log(1.5_r8) ! assumed log normal distribtuion around mean radius for aerosol injections + siglogsq=siglog**2_f + sq2pi = sqrt(2._r8*pi) + !aer_Vrat = vmrat_PRSUL + + call CARMAGROUP_GET(carma, I_GRP_PRSUL, rc, r=r, dr=dr, shortname=shortname, rmass=rmass) + + !interpolate into carma bin + + do ibin_local = 1, NBIN + ! Size Distribution-Parameter: log-normal distribution applied using Seinfeld and Pandis (2016) + so4inj_dist1(ibin_local)=dr(ibin_local)/(r(ibin_local)*sq2pi*siglog)*exp(-(((log(r(ibin_local)/rgeo))**2._r8)/(2._r8*siglogsq))) + so4inj_dist(ibin_local)=dr(ibin_local)/(r(ibin_local)*sq2pi*siglog)*exp(-(((log(r(ibin_local)/rgeo))**2._r8)/(2._r8*siglogsq))) + so4inj_dist1(ibin_local) = so4inj_dist1(ibin_local) *rmass(ibin_local) + end do + so4inj_dist(:) = so4inj_dist(:) / sum(so4inj_dist) + so4inj_dist1(:) = so4inj_dist1(:) / sum(so4inj_dist1) + + ! Provide diagnostics on the SOA tendencies that affect MXAER. + do ibin = 1, NBIN + write(binname, '(A, I2.2)') "MXSOA1", ibin + call addfld(trim(binname)//"CM", (/ 'lev' /), 'A', 'kg/kg/s', 'MXAER SOA1 gas condensation tendency') + call addfld(trim(binname)//"PT", (/ 'lev' /), 'A', 'kg/kg/s', 'MXAER SOA1 photolysis tendency') + write(binname, '(A, I2.2)') "MXSOA2", ibin + call addfld(trim(binname)//"CM", (/ 'lev' /), 'A', 'kg/kg/s', 'MXAER SOA2 gas condensation tendency') + call addfld(trim(binname)//"PT", (/ 'lev' /), 'A', 'kg/kg/s', 'MXAER SOA2 photolysis tendency') + write(binname, '(A, I2.2)') "MXSOA3", ibin + call addfld(trim(binname)//"CM", (/ 'lev' /), 'A', 'kg/kg/s', 'MXAER SOA3 gas condensation tendency') + call addfld(trim(binname)//"PT", (/ 'lev' /), 'A', 'kg/kg/s', 'MXAER SOA3 photolysis tendency') + write(binname, '(A, I2.2)') "MXSOA4", ibin + call addfld(trim(binname)//"CM", (/ 'lev' /), 'A', 'kg/kg/s', 'MXAER SOA4 gas condensation tendency') + call addfld(trim(binname)//"PT", (/ 'lev' /), 'A', 'kg/kg/s', 'MXAER SOA4 photolysis tendency') + write(binname, '(A, I2.2)') "MXSOA5", ibin + call addfld(trim(binname)//"CM", (/ 'lev' /), 'A', 'kg/kg/s', 'MXAER SOA5 gas condensation tendency') + call addfld(trim(binname)//"PT", (/ 'lev' /), 'A', 'kg/kg/s', 'MXAER SOA5 photolysis tendency') + end do + + ! Provide diagnostics for SO4 tendencies from other physics packages + ! + ! NOTE: This can be useful for determining an SO4 budget and for debugging + ! SO4 conservation. + if (carma_do_budget_diags) then + + call addfld("SO4PRBD", horiz_only, 'A', 'kg/m2', 'CARMA, Interstitial SO4 pure burden') + if (carma_diags_file > 0) call add_default("SO4PRBD", carma_diags_file, ' ') + call addfld("SO4MXBD", horiz_only, 'A', 'kg/m2', 'CARMA, Interstitial SO4 mix burden') + if (carma_diags_file > 0) call add_default("SO4MXBD", carma_diags_file, ' ') + call addfld("SO4PRCLDBD", horiz_only, 'A', 'kg/m2', 'CARMA, Cloudborne SO4 pure burden') + if (carma_diags_file > 0) call add_default("SO4PRCLDBD", carma_diags_file, ' ') + call addfld("SO4MXCLDBD", horiz_only, 'A', 'kg/m2', 'CARMA, Cloudborne SO4 mix burden') + + if (carma_diags_file > 0) call add_default("SO4MXCLDBD", carma_diags_file, ' ') + call addfld("SO4PRSF", horiz_only, 'A', 'kg/m2', 'CARMA, Interstitial SO4 pure surface flux') + if (carma_diags_file > 0) call add_default("SO4PRSF", carma_diags_file, ' ') + call addfld("SO4MXSF", horiz_only, 'A', 'kg/m2', 'CARMA, Interstitial SO4 mix surface flux') + if (carma_diags_file > 0) call add_default("SO4MXSF", carma_diags_file, ' ') + + call addfld("H2SO4BD", horiz_only, 'A', 'kg/m2', 'CARMA, H2SO4 burden') + if (carma_diags_file > 0) call add_default("H2SO4BD", carma_diags_file, ' ') + call addfld("SO2BD", horiz_only, 'A', 'kg/m2', 'CARMA, SO2 burden') + if (carma_diags_file > 0) call add_default("SO2BD", carma_diags_file, ' ') + + call addfld("MXBCBD", horiz_only, 'A', 'kg/m2', 'CARMA, Interstitial BC mix burden') + if (carma_diags_file > 0) call add_default("MXBCBD", carma_diags_file, ' ') + call addfld("MXDUSTBD", horiz_only, 'A', 'kg/m2', 'CARMA, Interstitial Dust mix burden') + if (carma_diags_file > 0) call add_default("MXDUSTBD", carma_diags_file, ' ') + call addfld("MXOCBD", horiz_only, 'A', 'kg/m2', 'CARMA, Interstitial OC mix burden') + if (carma_diags_file > 0) call add_default("MXOCBD", carma_diags_file, ' ') + call addfld("MXSALTBD", horiz_only, 'A', 'kg/m2', 'CARMA, Interstitial Sea Salt mix burden') + if (carma_diags_file > 0) call add_default("MXSALTBD", carma_diags_file, ' ') + call addfld("MXSOA1BD", horiz_only, 'A', 'kg/m2', 'CARMA, Interstitial SOA1 mix burden') + if (carma_diags_file > 0) call add_default("MXSOA1BD", carma_diags_file, ' ') + call addfld("MXSOA2BD", horiz_only, 'A', 'kg/m2', 'CARMA, Interstitial SOA2 mix burden') + if (carma_diags_file > 0) call add_default("MXSOA2BD", carma_diags_file, ' ') + call addfld("MXSOA3BD", horiz_only, 'A', 'kg/m2', 'CARMA, Interstitial SOA3 mix burden') + if (carma_diags_file > 0) call add_default("MXSOA3BD", carma_diags_file, ' ') + call addfld("MXSOA4BD", horiz_only, 'A', 'kg/m2', 'CARMA, Interstitial SOA4 mix burden') + if (carma_diags_file > 0) call add_default("MXSOA4BD", carma_diags_file, ' ') + call addfld("MXSOA5BD", horiz_only, 'A', 'kg/m2', 'CARMA, Interstitial SOA5 mix burden') + if (carma_diags_file > 0) call add_default("MXSOA5BD", carma_diags_file, ' ') + + call addfld("MXBCCLDBD", horiz_only, 'A', 'kg/m2', 'CARMA, Cloudborne BC mix burden') + if (carma_diags_file > 0) call add_default("MXBCCLDBD", carma_diags_file, ' ') + call addfld("MXDUSTCLDBD", horiz_only, 'A', 'kg/m2', 'CARMA, Cloudborne Dust mix burden') + if (carma_diags_file > 0) call add_default("MXDUSTCLDBD", carma_diags_file, ' ') + call addfld("MXOCCLDBD", horiz_only, 'A', 'kg/m2', 'CARMA, Cloudborne OC mix burden') + if (carma_diags_file > 0) call add_default("MXOCCLDBD", carma_diags_file, ' ') + call addfld("MXSALTCLDBD", horiz_only, 'A', 'kg/m2', 'CARMA, Cloudborne Sea Salt mix burden') + if (carma_diags_file > 0) call add_default("MXSALTCLDBD", carma_diags_file, ' ') + call addfld("MXSOA1CLDBD", horiz_only, 'A', 'kg/m2', 'CARMA, Cloudborne SOA1 mix burden') + if (carma_diags_file > 0) call add_default("MXSOA1CLDBD", carma_diags_file, ' ') + call addfld("MXSOA2CLDBD", horiz_only, 'A', 'kg/m2', 'CARMA, Cloudborne SOA2 mix burden') + if (carma_diags_file > 0) call add_default("MXSOA2CLDBD", carma_diags_file, ' ') + call addfld("MXSOA3CLDBD", horiz_only, 'A', 'kg/m2', 'CARMA, Cloudborne SOA3 mix burden') + if (carma_diags_file > 0) call add_default("MXSOA3CLDBD", carma_diags_file, ' ') + call addfld("MXSOA4CLDBD", horiz_only, 'A', 'kg/m2', 'CARMA, Cloudborne SOA4 mix burden') + if (carma_diags_file > 0) call add_default("MXSOA4CLDBD", carma_diags_file, ' ') + call addfld("MXSOA5CLDBD", horiz_only, 'A', 'kg/m2', 'CARMA, Cloudborne SOA5 mix burden') + if (carma_diags_file > 0) call add_default("MXSOA5CLDBD", carma_diags_file, ' ') + end if + + if (carma_do_package_diags) then + + ! Iterate of the packages that have be instrumented. These should match the calls + ! in physpkg.f90. + do i = 1, carma_ndiagpkgs + call addfld("SO4PRBD_"//trim(carma_diags_packages(i)), horiz_only, 'A', 'kg/m2', trim(carma_diags_packages(i))//', SO4 pure burden') + if (carma_diags_file > 0) call add_default("SO4PRBD_"//trim(carma_diags_packages(i)), carma_diags_file, ' ') + call addfld("SO4MXBD_"//trim(carma_diags_packages(i)), horiz_only, 'A', 'kg/m2', trim(carma_diags_packages(i))//', SO4 mixed burden') + if (carma_diags_file > 0) call add_default("SO4MXBD_"//trim(carma_diags_packages(i)), carma_diags_file, ' ') + + call addfld("SO4PRSF_"//trim(carma_diags_packages(i)), horiz_only, 'A', 'kg/m2/s', trim(carma_diags_packages(i))//', Surface Flux, SO4 pure tendency') + if (carma_diags_file > 0) call add_default("SO4PRSF_"//trim(carma_diags_packages(i)), carma_diags_file, ' ') + call addfld("SO4MXSF_"//trim(carma_diags_packages(i)), horiz_only, 'A', 'kg/m2/s', trim(carma_diags_packages(i))//', Surface Flux, SO4 mix tendency') + if (carma_diags_file > 0) call add_default("SO4MXSF_"//trim(carma_diags_packages(i)), carma_diags_file, ' ') + + call addfld("SO4PRTC_"//trim(carma_diags_packages(i)), horiz_only, 'A', 'kg/m2/s', trim(carma_diags_packages(i))//', SO4 pure tendency') + if (carma_diags_file > 0) call add_default("SO4PRTC_"//trim(carma_diags_packages(i)), carma_diags_file, ' ') + call addfld("SO4MXTC_"//trim(carma_diags_packages(i)), horiz_only, 'A', 'kg/m2/s', trim(carma_diags_packages(i))//', SO4 mixed tendency') + if (carma_diags_file > 0) call add_default("SO4MXTC_"//trim(carma_diags_packages(i)), carma_diags_file, ' ') + + call addfld("SO4PRCLDBD_"//trim(carma_diags_packages(i)), horiz_only, 'A', 'kg/m2', trim(carma_diags_packages(i))//', Cloudborne SO4 pure burden') + if (carma_diags_file > 0) call add_default("SO4PRCLDBD_"//trim(carma_diags_packages(i)), carma_diags_file, ' ') + call addfld("SO4MXCLDBD_"//trim(carma_diags_packages(i)), horiz_only, 'A', 'kg/m2', trim(carma_diags_packages(i))//', Cloudborne SO4 mixed burden') + if (carma_diags_file > 0) call add_default("SO4MXCLDBD_"//trim(carma_diags_packages(i)), carma_diags_file, ' ') + + call addfld("SO4PRCLDTC_"//trim(carma_diags_packages(i)), horiz_only, 'A', 'kg/m2/s', trim(carma_diags_packages(i))//', Cloudborne SO4 pure tendency') + if (carma_diags_file > 0) call add_default("SO4PRCLDTC_"//trim(carma_diags_packages(i)), carma_diags_file, ' ') + call addfld("SO4MXCLDTC_"//trim(carma_diags_packages(i)), horiz_only, 'A', 'kg/m2/s', trim(carma_diags_packages(i))//', Cloudborne SO4 mixed tendency') + if (carma_diags_file > 0) call add_default("SO4MXCLDTC_"//trim(carma_diags_packages(i)), carma_diags_file, ' ') + + call addfld("H2SO4TC_"//trim(carma_diags_packages(i)), horiz_only, 'A', 'kg/m2/s', trim(carma_diags_packages(i))//', H2SO4 total tendency') + if (carma_diags_file > 0) call add_default("H2SO4TC_"//trim(carma_diags_packages(i)), carma_diags_file, ' ') + call addfld("H2SO4BD_"//trim(carma_diags_packages(i)), horiz_only, 'A', 'kg/m2', trim(carma_diags_packages(i))//', H2SO4 burden') + if (carma_diags_file > 0) call add_default("H2SO4BD_"//trim(carma_diags_packages(i)), carma_diags_file, ' ') + call addfld("SO2TC_"//trim(carma_diags_packages(i)), horiz_only, 'A', 'kg/m2/s', trim(carma_diags_packages(i))//', SO2 total tendency') + if (carma_diags_file > 0) call add_default("SO2TC_"//trim(carma_diags_packages(i)), carma_diags_file, ' ') + call addfld("SO2BD_"//trim(carma_diags_packages(i)), horiz_only, 'A', 'kg/m2', trim(carma_diags_packages(i))//', SO2 burden') + if (carma_diags_file > 0) call add_default("SO2BD_"//trim(carma_diags_packages(i)), carma_diags_file, ' ') + end do + end if + + ! Provide diagnostics for Mass mixing ration summed over the bins + call addfld("SO4PRMR", (/ 'lev' /), 'A', 'kg/kg', 'SO4 pure mass mixing ratio') + call addfld("MXSO4MR", (/ 'lev' /), 'A', 'kg/kg', 'SO4 mixed mass mixing ratio') + call addfld("MXBCMR", (/ 'lev' /), 'A', 'kg/kg', 'BC mixed mass mixing ratio') + call addfld("MXDUSTMR", (/ 'lev' /), 'A', 'kg/kg', 'DUST mixed mass mixing ratio') + call addfld("MXOCMR", (/ 'lev' /), 'A', 'kg/kg', 'OC mixed mass mixing ratio') + call addfld("MXSALTMR", (/ 'lev' /), 'A', 'kg/kg', 'SALT mixed mass mixing ratio') + call addfld("MXSOAMR", (/ 'lev' /), 'A', 'kg/kg', 'SOA mixed mass mixing ratio') + + return + end subroutine CARMAMODEL_InitializeModel + + + !! Sets the initial condition for CARMA aerosol particles. By default, there are no + !! particles, but this routine can be overridden for models that wish to have an + !! initial value. + !! + !! NOTE: If CARMA constituents appear in the initial condition file, then those + !! values will override anything set here. + !! + !! @author Chuck Bardeen + !! @version May-2009 + subroutine CARMAMODEL_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + real(r8), intent(in) :: latvals(:) !! lat in degrees (ncol) + real(r8), intent(in) :: lonvals(:) !! lon in degrees (ncol) + logical, intent(in) :: mask(:) !! Only initialize where .true. + real(r8), intent(inout) :: q(:,:) !! mass mixing ratio (gcol, lev) + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + ! Add initial condition here. + ! + ! NOTE: Initialized to 0. by the caller, so nothing needs to be done. + + return + end subroutine CARMAMODEL_InitializeParticle + + + !! This routine is an extension of CARMA_CreateOpticsFile() that allows for + !! model specific tables to be created in addition to the model independent + !! methods that are in carma_intr.F90. + !! + !! The opticsType that is specified for the group determines how the optical + !! properties will be generated for that group. Each group can use a different + !! optics method if needed. Refractive indices need for these calculation are + !! are specified in the group's elements rather than at the group level. This + !! allows various mixing approaches to be used to determine the refractive index + !! for the particle as a whole. If the refractive index for water is needed, + !! it is specific the the CARMAGAS object for H2O. + !! + !! The I_OPTICS_MIXED_YU2105 and I_OPTICS_SULFATE_YU2015 optics methods are + !! designed to trop_strat models as define in the Yu et al. (2015) paper. The + !! I_OPTICS_MIXED_YU_H2O includes volume mixing of the water into the shell. + subroutine CARMAMODEL_CreateOpticsFile(carma, igroup, opticsType, rc) + + implicit none + + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(in) :: igroup !! group identifier + integer, intent(in) :: opticsType !! optics type (see I_OPTICS_... in carma_enums.F90) + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Local variables + logical :: do_mie + integer :: cnsttype ! constituent type + + ! Assume success. + rc = 0 + + ! What type of calculation is needed for this group? + ! + ! NOTE: Some of these calculations generate optical properties as single mass + ! coefficients, while others are lookup tables designed around multiple + ! dimensions. + select case (opticsType) + + ! This is for the mixed aerosol group as implemented by Yu et al. (2015), + ! and is specific to the aerosol defintion in that model. There are multiple + ! elements, some grouped in the core and others in the shell. The refractive + ! index for the shell is assumed to be only sulfates, and the refractive + ! index of the core is a mix of dust and black carbon. Core/shell optics + ! are used to determine the optical properties. + case(I_OPTICS_MIXED_YU2015) + call CARMAMODEL_CreateOpticsFile_MixedYu(carma, igroup, rc) + if (rc < 0) call endrun('carma_CreateOpticsFile::CreateOpticsFile_MixedYu failed.') + + ! This is for the pure sulfate group as implemented by Yu et al. (2015). + ! The particle may swell, but the refractive index is fixed regardless + ! of the weight percent of H21SO4 in the particle. + case(I_OPTICS_SULFATE_YU2015) + call CARMAMODEL_CreateOpticsFile_SulfateYu(carma, igroup, rc) + if (rc < 0) call endrun('carma_CreateOpticsFile::CreateOpticsFile_SulfateYu failed.') + + ! This is similar to I_OPTICS_MIXED_YU2015, except that the shell is a volume + ! mixture of water and H2SO4 rather than just being H2SO4. + case(I_OPTICS_MIXED_YU_H2O) + call CARMAMODEL_CreateOpticsFile_MixedYuH2o(carma, igroup, rc) + if (rc < 0) call endrun('carma_CreateOpticsFile::CreateOpticsFile_MixedYuH2o failed.') + + case default + call endrun('carma_CreateOpticsFile:: Unknown optics type.') + end select + + return + end subroutine CARMAMODEL_CreateOpticsFile + + + !! This routine creates files containing optical properties for the mixed group + !! following Yu et al. (2015). These optical properties are used by the RRTMG radiation + !! code to include the impact of CARMA particles in the radiative transfer + !! calculation. + subroutine CARMAMODEL_CreateOpticsFile_MixedYu(carma, igroup, rc) + use radconstants, only : nswbands, nlwbands + use wrap_nf + use wetr, only : getwetr + + implicit none + + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(in) :: igroup !! group index + integer, intent(out) :: rc !! return code, negative indicates failure + + !! Core-shell mixing method for mie and radiation calculations for the Yu et al. (2015) + !! style table. The CAM optics code will interpolate based upon the current core/shell + !! mass ratio from a table built using the specified core/shell. + integer, parameter :: ncoreshellratio = 9 !! Number of core/shell ratio for mie calculations + integer, parameter :: ndstbcratio = 8 + integer, parameter :: nkap = 9 + + real(kind=f), parameter :: coreshellratio(ncoreshellratio) = (/ 0.001_f, 0.00237_f, 0.00562_f, 0.01333_f, & + 0.03162_f, 0.07499_f, 0.17782_f, 0.42169_f, 1.0_f /) + real(kind=f), parameter :: dstbcratio(ndstbcratio) = (/ 0.01_f, 0.025_f, 0.063_f, 0.1_f, 0.3_f, 0.5_f, 0.7_f, 0.9_f/) + real(kind=f), parameter :: kap(nkap) = (/ 0.1_f, 0.2_f, 0.3_f, 0.4_f, 0.5_f, 0.7_f, 0.9_f, 1.1_f, 1.2_f/) + + ! Local variables + integer :: ibin, iwave, irh, icsr, idb, ikap, icore, ncore + integer :: icorelem(NELEM) + integer :: irhswell + integer :: imiertn + integer :: ienconc + real(kind=f) :: rho(NBIN), rhopwet + real(kind=f) :: r(NBIN), rmass(NBIN), rlow(NBIN), rup(NBIN) + real(kind=f) :: wave(NWAVE) + complex(kind=f) :: refidx(NWAVE, NREFIDX) + complex(kind=f) :: refidxS(NWAVE, NREFIDX) + complex(kind=f) :: refidxB(NWAVE, NREFIDX) + complex(kind=f) :: refidxD(NWAVE, NREFIDX) + complex(kind=f) :: refidxC + !real(kind=f) :: coreimagidx + character(len=CARMA_NAME_LEN) :: name + character(len=CARMA_SHORT_NAME_LEN) :: shortname + logical :: do_mie + integer :: fid + integer :: rhdim, lwdim, swdim, csrdim, dstbcrdim, kapdim + integer :: rhvar, lwvar, swvar, csr_var, dstbcr_var, kap_var + integer :: abs_lw_coreshell_var, qabs_lw_coreshell_var + integer :: ext_sw_coreshell_var, ssa_sw_coreshell_var + integer :: asm_sw_coreshell_var, qext_sw_coreshell_var + integer :: rwetvar + integer :: omdim, andim, namedim + integer :: omvar, anvar, namevar + integer :: dimids(5) + integer :: denvar, slogvar, dryrvar, rminvar, rmaxvar, hygrovar, ntmvar + real(kind=f) :: abs_lw_coreshell(NMIE_RH, nlwbands, ncoreshellratio, ndstbcratio, nkap) + real(kind=f) :: qabs_lw_coreshell(NMIE_RH, nlwbands, ncoreshellratio, ndstbcratio, nkap) + real(kind=f) :: ext_sw_coreshell(NMIE_RH, nswbands, ncoreshellratio, ndstbcratio, nkap) + real(kind=f) :: qext_sw_coreshell(NMIE_RH, nswbands, ncoreshellratio, ndstbcratio, nkap) + real(kind=f) :: ssa_sw_coreshell(NMIE_RH, nswbands, ncoreshellratio, ndstbcratio, nkap) + real(kind=f) :: asm_sw_coreshell(NMIE_RH, nswbands, ncoreshellratio, ndstbcratio, nkap) + real(kind=f) :: rwetbin(NMIE_RH) + character(len=8) :: c_name ! constituent name + character(len=32) :: aer_name ! long enough for both aername and name + character(len=255) :: filepath + real(kind=f) :: rwet + real(kind=f) :: rcore ! CORE radius used in MIE calculation + real(kind=f) :: Qext + real(kind=f) :: Qsca + real(kind=f) :: asym + integer :: start_text(2), count_text(2) + integer :: sw_r_refidx_var, sw_i_refidx_var, lw_r_refidx_var, lw_i_refidx_var + integer :: ncsr, ndbr + integer :: cnsttype ! constituent type + integer :: maxbin ! last prognostic bin + integer :: LUNOPRT ! logical unit number for output + logical :: do_print ! do print output? + integer :: ret + + character(len=32) :: elementname + + ! Assume success. + rc = 0 + + ! Get the wavelength structure. + call CARMA_GET(carma, rc, wave=wave, do_print=do_print, LUNOPRT=LUNOPRT) + if (rc < 0) call endrun('carma_CreateOpticsFile::CARMA_Get failed.') + + ! Get the necessary group properties. + call CARMAGROUP_Get(carma, igroup, rc, do_mie=do_mie, name=name, shortname=shortname, r=r, & + rlow=rlow, rup=rup, rmass=rmass, irhswell=irhswell, imiertn=imiertn, & + ienconc=ienconc, ncore=ncore, icorelem=icorelem, cnsttype=cnsttype, maxbin=maxbin) + if (rc < 0) call endrun('carma_CreateOpticsFile::CARMAGROUP_Get failed.') + + ! The concentration element has the sulfate refractive index. + call CARMAELEMENT_Get(carma, ienconc, rc, rho=rho, refidx=refidxS) + if (rc < 0) call endrun('carma_CreateOpticsFile::CARMAELEMENT_Get failed.') + + ! Need to find the dust and black carbon refractive indicies for the core. + do icore = 1, ncore + call CARMAELEMENT_Get(carma, icorelem(icore), rc, shortname=elementname, refidx=refidx) + if (rc < 0) call endrun('carma_CreateOpticsFile::CARMAELEMENT_Get failed.') + + if (trim(elementname) == 'MXBC') then + refidxB = refidx + else if (trim(elementname) == 'MXDUST') then + refidxD = refidx + end if + end do + + + ! A file needs to be created for each bin. + do ibin = 1, NBIN + + ! Bins past maxbin are treated as diagnostic even if the group + ! is prognostic and thus are not advected in the paerent model. + if (ibin <= maxbin) then + + write(c_name, '(A, I2.2)') trim(shortname), ibin + + ! Construct the path to the file. Each model will have its own subdirectory + ! where the optical property files are stored. + filepath = trim(carma_model) // '_' // trim(c_name) // '_rrtmg.nc' + + if (do_print) write(LUNOPRT,*) 'Creating CARMA optics file ... ', trim(filepath) + + ! Create the file. + call wrap_create(filepath, NF90_CLOBBER, fid) + + ncsr = ncoreshellratio + ndbr = ndstbcratio + + ! Define the dimensions: rh, lwbands, swbands + call wrap_def_dim(fid, 'rh_idx', NMIE_RH, rhdim) + call wrap_def_dim(fid, 'lw_band', nlwbands, lwdim) + call wrap_def_dim(fid, 'sw_band', nswbands, swdim) + + call wrap_def_dim(fid, 'coreshellratio', ncsr, csrdim) + call wrap_def_dim(fid, 'dstbcratio', ndbr, dstbcrdim) + call wrap_def_dim(fid, 'kap', nkap, kapdim) + + dimids(1) = rhdim + call wrap_def_var(fid, 'rh', NF90_DOUBLE, 1, dimids(1), rhvar) + call wrap_def_var(fid, 'rwet',NF90_DOUBLE, 1, dimids(1), rwetvar) + + dimids(1) = lwdim + call wrap_def_var(fid, 'lw_band', NF90_DOUBLE, 1, dimids(1), lwvar) + + dimids(1) = swdim + call wrap_def_var(fid, 'sw_band', NF90_DOUBLE, 1, dimids(1), swvar) + + dimids(1) = csrdim + call wrap_def_var(fid, 'coreshellratio', NF90_DOUBLE, 1, dimids(1), csr_var) + dimids(1) = dstbcrdim + call wrap_def_var(fid, 'dstbcratio', NF90_DOUBLE, 1, dimids(1), dstbcr_var) + dimids(1) = kapdim + call wrap_def_var(fid, 'kap', NF90_DOUBLE, 1, dimids(1), kap_var) + + + call wrap_put_att_text(fid, rhvar, 'units', 'fraction') + call wrap_put_att_text(fid, rwetvar, 'units', 'cm') + call wrap_put_att_text(fid, lwvar, 'units', 'm') + call wrap_put_att_text(fid, swvar, 'units', 'm') + + call wrap_put_att_text(fid, csr_var,'units', 'fraction') + call wrap_put_att_text(fid, dstbcr_var,'units', 'fraction') + call wrap_put_att_text(fid, kap_var,'units', 'unitless') + call wrap_put_att_text(fid, csr_var,'long_name', 'coreshell ratio') + call wrap_put_att_text(fid, dstbcr_var,'long_name', 'dust-bc ratio') + call wrap_put_att_text(fid, kap_var,'long_name', 'kappa value') + + call wrap_put_att_text(fid, rhvar, 'long_name', 'relative humidity') + call wrap_put_att_text(fid, rwetvar, 'long_name', 'wet radius') + call wrap_put_att_text(fid, lwvar, 'long_name', 'longwave bands') + call wrap_put_att_text(fid, swvar, 'long_name', 'shortwave bands') + + ! Define 3-dimension (:nrh,:nswbands,:ncoreshellratio) LW optics properties: abs_lw_coreshell, qabs_lw_coreshell + dimids(1) = rhdim + dimids(2) = lwdim + dimids(3) = csrdim + dimids(4) = dstbcrdim + dimids(5) = kapdim + call wrap_def_var(fid, 'abs_lw_coreshell', NF90_DOUBLE, 5, dimids(1:5), abs_lw_coreshell_var) + call wrap_def_var(fid, 'qabs_lw_coreshell',NF90_DOUBLE, 5, dimids(1:5), qabs_lw_coreshell_var) + + call wrap_put_att_text(fid, abs_lw_coreshell_var, 'units', 'meter^2 kilogram^-1') + call wrap_put_att_text(fid, qabs_lw_coreshell_var,'units', '-') + + ! Define 3-dimension (:nrh,:nswbands,:ncoreshellratio) SW optics properties: + ! ext_sw_coreshell, qext_sw_coreshell, ssa_sw_coreshell, asm_sw_coreshell + dimids(1) = rhdim + dimids(2) = swdim + dimids(3) = csrdim + dimids(4) = dstbcrdim + dimids(5) = kapdim + call wrap_def_var(fid, 'ext_sw_coreshell', NF90_DOUBLE, 5, dimids(1:5), ext_sw_coreshell_var) + call wrap_def_var(fid, 'qext_sw_coreshell',NF90_DOUBLE, 5, dimids(1:5), qext_sw_coreshell_var) + call wrap_def_var(fid, 'ssa_sw_coreshell', NF90_DOUBLE, 5, dimids(1:5), ssa_sw_coreshell_var) + call wrap_def_var(fid, 'asm_sw_coreshell', NF90_DOUBLE, 5, dimids(1:5), asm_sw_coreshell_var) + + call wrap_put_att_text(fid, ssa_sw_coreshell_var, 'units', 'fraction') + call wrap_put_att_text(fid, ext_sw_coreshell_var, 'units', 'meter^2 kilogram^-1') + call wrap_put_att_text(fid, qext_sw_coreshell_var,'units', '-') + call wrap_put_att_text(fid, asm_sw_coreshell_var, 'units', '-') + + ! Define the variables for the refractive indicies. + dimids(1) = swdim + call wrap_def_var(fid, 'refindex_real_aer_sw', NF90_DOUBLE, 1, dimids(1), sw_r_refidx_var) + call wrap_def_var(fid, 'refindex_im_aer_sw', NF90_DOUBLE, 1, dimids(1), sw_i_refidx_var) + + dimids(1) = lwdim + call wrap_def_var(fid, 'refindex_real_aer_lw', NF90_DOUBLE, 1, dimids(1), lw_r_refidx_var) + call wrap_def_var(fid, 'refindex_im_aer_lw', NF90_DOUBLE, 1, dimids(1), lw_i_refidx_var) + + call wrap_put_att_text(fid, sw_r_refidx_var, 'units', '-') + call wrap_put_att_text(fid, sw_i_refidx_var, 'units', '-') + call wrap_put_att_text(fid, lw_r_refidx_var, 'units', '-') + call wrap_put_att_text(fid, lw_i_refidx_var, 'units', '-') + + call wrap_put_att_text(fid, sw_r_refidx_var, 'long_name', 'real refractive index of aerosol - shortwave') + call wrap_put_att_text(fid, sw_i_refidx_var, 'long_name', 'imaginary refractive index of aerosol - shortwave') + call wrap_put_att_text(fid, lw_r_refidx_var, 'long_name', 'real refractive index of aerosol - longwave') + call wrap_put_att_text(fid, lw_i_refidx_var, 'long_name', 'imaginary refractive index of aerosol - longwave') + + ! Define fields that define the aerosol properties. + call wrap_def_dim(fid, 'opticsmethod_len', 32, omdim) + dimids(1) = omdim + call wrap_def_var(fid, 'opticsmethod', NF90_CHAR, 1, dimids(1), omvar) + + call wrap_def_dim(fid, 'namelength', 20, andim) + dimids(1) = andim + call wrap_def_var(fid, 'aername', NF90_CHAR, 1, dimids(1), anvar) + + call wrap_def_dim(fid, 'name_len', 32, namedim) + dimids(1) = namedim + call wrap_def_var(fid, 'name', NF90_CHAR, 1, dimids, namevar) + + call wrap_def_var(fid, 'density', NF90_DOUBLE, 0, dimids(1), denvar) + call wrap_def_var(fid, 'sigma_logr', NF90_DOUBLE, 0, dimids(1), slogvar) + call wrap_def_var(fid, 'dryrad', NF90_DOUBLE, 0, dimids(1), dryrvar) + call wrap_def_var(fid, 'radmin_aer', NF90_DOUBLE, 0, dimids(1), rminvar) + call wrap_def_var(fid, 'radmax_aer', NF90_DOUBLE, 0, dimids(1), rmaxvar) + call wrap_def_var(fid, 'hygroscopicity', NF90_DOUBLE, 0, dimids(1), hygrovar) + call wrap_def_var(fid, 'num_to_mass_ratio', NF90_DOUBLE, 0, dimids(1), ntmvar) + + call wrap_put_att_text(fid, denvar, 'units', 'kg m^-3') + call wrap_put_att_text(fid, slogvar, 'units', '-') + call wrap_put_att_text(fid, dryrvar, 'units', 'm') + call wrap_put_att_text(fid, rminvar, 'units', 'm') + call wrap_put_att_text(fid, rmaxvar, 'units', 'm') + call wrap_put_att_text(fid, hygrovar, 'units', '-') + call wrap_put_att_text(fid, ntmvar, 'units', 'kg^-1') + + call wrap_put_att_text(fid, denvar, 'long_name', 'aerosol material density') + call wrap_put_att_text(fid, slogvar, 'long_name', 'geometric standard deviation of aerosol') + call wrap_put_att_text(fid, dryrvar, 'long_name', 'dry number mode radius of aerosol') + call wrap_put_att_text(fid, rminvar, 'long_name', 'minimum dry radius of aerosol for bin') + call wrap_put_att_text(fid, rmaxvar, 'long_name', 'maximum dry radius of aerosol for bin') + call wrap_put_att_text(fid, hygrovar, 'long_name', 'hygroscopicity of aerosol') + call wrap_put_att_text(fid, ntmvar, 'long_name', 'ratio of number to mass of aerosol') + + ! End the defintion phase of the netcdf file. + call wrap_enddef(fid) + + ! Write out the dimensions. + call wrap_put_var_realx(fid, rhvar, mie_rh(:NMIE_RH)) + call wrap_put_var_realx(fid, lwvar, wave(:nlwbands) * 1e-2_f) + call wrap_put_var_realx(fid, swvar, wave(nlwbands+1:) * 1e-2_f) + + call wrap_put_var_realx(fid, csr_var,coreshellratio(:ncsr)) + call wrap_put_var_realx(fid, dstbcr_var,dstbcratio(:ndstbcratio)) + call wrap_put_var_realx(fid, kap_var,kap(:nkap)) + + ! Write out the refractive indicies. + call wrap_put_var_realx(fid, sw_r_refidx_var, real(refidxS(nlwbands+1:, 1))) + call wrap_put_var_realx(fid, sw_i_refidx_var, aimag(refidxS(nlwbands+1:, 1))) + call wrap_put_var_realx(fid, lw_r_refidx_var, real(refidxS(:nlwbands, 1))) + call wrap_put_var_realx(fid, lw_i_refidx_var, aimag(refidxS(:nlwbands, 1))) + + ! Pad the names out with spaces. + aer_name = ' ' + aer_name(1:len(trim(c_name))) = c_name + + start_text(1) = 1 + count_text(1) = 32 + call wrap_put_vara_text(fid, namevar, start_text, count_text, (/ aer_name /)) + count_text(1) = 20 + call wrap_put_vara_text(fid, anvar, start_text, count_text, (/ aer_name /)) + + count_text(1) = len('hygroscopic_coreshell ') + call wrap_put_vara_text(fid, omvar, start_text, count_text, (/ 'hygroscopic_coreshell ' /)) + + call wrap_put_var_realx(fid, denvar, (/ rho(ibin) * 1e-3_f / 1e-6_f /)) + call wrap_put_var_realx(fid, slogvar, (/ 0._f /)) + call wrap_put_var_realx(fid, dryrvar, (/ r(ibin) * 1e-2_f /)) + call wrap_put_var_realx(fid, rminvar, (/ rlow(ibin) * 1e-2_f /)) + call wrap_put_var_realx(fid, rmaxvar, (/ rup(ibin) * 1e-2_f /)) + call wrap_put_var_realx(fid, hygrovar, (/ 0.6_f /)) + call wrap_put_var_realx(fid, ntmvar, (/ 1._f / rmass(ibin) / 1e-3_f /)) + + ! For now, ext_sw(:nrh, :nswbands) and ext_sw_coreshell(:nrh, :nswbands, :ncoreshellratio) both are calculated + ! Since other aerosols in CAM may use ext_sw rather than ext_sw_coreshell + ! Modified by Pengfei Yu + ! April.1, 2012 + + !--------------------------- for 5-D core-shell optical properties ---------------------------- + + ! Iterate over a range of relative humidities, since the particle may swell + ! with relative humidity which will change its optical properties. + do irh = 1, NMIE_RH + + do ikap = 1, nkap + + ! Determine the wet radius. + call getwetr(carma, igroup, mie_rh(irh), r(ibin), rwet, rho(ibin), rhopwet, rc, kappa=kap(ikap), temp=270._f) + rwetbin(irh) = rwet + + ! Calculate at each wavelength. + do iwave = 1, NWAVE + + ! For now just assume BC/OC constant 15% + ! rcore = r(ibin)*(0.15**(1./3)) + ! Using Mie code, consider core/shell ratio + do icsr = 1, ncsr + if (ncsr > 1) then + rcore = r(ibin)*(coreshellratio(icsr)**(1./3)) + else + rcore = 0.0_f + endif + + ! Using Mie code, assume the particle is CORE-SHELL + ! By: Pengfei Yu + ! Mar.22, 2012 + + !write(*,*) 'before call mie-3D, icsr = ', icsr, ' ;iwave = ', iwave, ' ;irh = ', irh + !write(*,*) 'ibin = ', ibin, ' ;rcore = ', rcore, ' ;csratio = ', coreshellratio(icsr) + + do idb = 1, ndbr + + ! NOTE: This is not the best way to combine the dust and BC refractive indices + ! for the core. Volume mixing should be used for both the real and imaginary + ! parts, not just the imaginary. +! coreimagidx = dstbcratio(idb) * aimag(refidxB(iwave,1)) + (1._f - dstbcratio(idb)) * aimag(refidxD(iwave,1)) +! refidxC = cmplx((real(refidxD(iwave,1)) + real(refidxB(iwave,1))) / 2._f, coreimagidx) + refidxC = dstbcratio(idb) * refidxB(iwave,1) + (1._f - dstbcratio(idb)) * refidxD(iwave,1) + + call mie(carma, & + imiertn, & + rwet, & + wave(iwave), & + 0._f, & + 3.0_f, & + 0.0_f, & + 1.0_f, & + refidxS(iwave, 1), & + rcore, & + refidxC, & + Qext, & + Qsca, & + asym, & + rc) + if (rc < 0) call endrun('carma_CreateOpticsFile::mie failed.') + + ! Calculate the shortwave and longwave properties? + ! + ! NOTE: miess is in cgs units, but the optics file needs to be in mks + ! units, so perform the necessary conversions. + if (iwave <= nlwbands) then + + ! Longwave just needs absorption: abs_lw. + qabs_lw_coreshell(irh, iwave, icsr, idb, ikap) = (Qext - Qsca) ! absorption per particle + abs_lw_coreshell (irh, iwave, icsr, idb, ikap) = (Qext - Qsca) * PI * (rwet * 1e-2_f)**2 & + / (rmass(ibin) * 1e-3_f) + else + + ! Shortwave needs extinction, single scattering albedo and asymmetry factor: + ! ext_sw, qext_sw, ssa_sw and asm_sw. + qext_sw_coreshell(irh, iwave - nlwbands, icsr, idb, ikap) = Qext ! extinction per particle + ext_sw_coreshell (irh, iwave - nlwbands, icsr, idb, ikap) = Qext * PI * (rwet * 1e-2_f)**2 & + / (rmass(ibin) * 1e-3_f) + ssa_sw_coreshell (irh, iwave - nlwbands, icsr, idb, ikap) = Qsca / Qext + asm_sw_coreshell (irh, iwave - nlwbands, icsr, idb, ikap) = asym + end if + end do ! idb + end do ! icsr + end do ! iwave + end do ! ikap + end do ! irh + + call wrap_put_var_realx(fid, rwetvar, rwetbin(:)) + + ! Write out the longwave fields. + ret = nf90_put_var(fid, abs_lw_coreshell_var, abs_lw_coreshell (:, :, :, :, :)) + if (ret /= NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile_MixedYu: error writing varid =', abs_lw_coreshell_var + call handle_error(ret) + end if + + ret = nf90_put_var(fid, qabs_lw_coreshell_var, qabs_lw_coreshell(:, :, :, :, :)) + if (ret /= NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile_MixedYu: error writing varid =', qabs_lw_coreshell_var + call handle_error(ret) + end if + + ! Write out the shortwave fields. + ret = nf90_put_var(fid, ext_sw_coreshell_var, ext_sw_coreshell (:, :, :, :, :)) + if (ret /= NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile_MixedYu: error writing varid =', ext_sw_coreshell_var + call handle_error(ret) + end if + + ret = nf90_put_var(fid, qext_sw_coreshell_var, qext_sw_coreshell(:, :, :, :, :)) + if (ret /= NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile_MixedYu: error writing varid =', qext_sw_coreshell_var + call handle_error(ret) + end if + + ret = nf90_put_var(fid, ssa_sw_coreshell_var, ssa_sw_coreshell (:, :, :, :, :)) + if (ret /= NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile_MixedYu: error writing varid =', ssa_sw_coreshell_var + call handle_error(ret) + end if + + ret = nf90_put_var(fid, asm_sw_coreshell_var, asm_sw_coreshell (:, :, :, :, :)) + if (ret /= NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile_MixedYu: error writing varid =', asm_sw_coreshell_var + call handle_error(ret) + end if + + ! Close the file. + call wrap_close(fid) + end if + end do + + return + end subroutine CARMAMODEL_CreateOpticsFile_MixedYu + + !! This routine creates files containing optical properties for the mixed group + !! following Yu et al. (2015), except that it includes water vapor in the shell. + !! The difference between the wet and dry radius is assumed to be water valor and + !! the shell is a volume mix of the H2SO4 and the water. These optical properties + !! are used by the RRTMG radiation code to include the impact of CARMA particles + !! in the radiative transfer calculation. + !! + !! NOTE: The table structure is the same as for MixedYu, so no changes need to be + !! made on the CAM side to use these optics. + subroutine CARMAMODEL_CreateOpticsFile_MixedYuH2o(carma, igroup, rc) + use radconstants, only : nswbands, nlwbands + use wrap_nf + use wetr, only : getwetr + + implicit none + + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(in) :: igroup !! group index + integer, intent(out) :: rc !! return code, negative indicates failure + + !! Core-shell mixing method for mie and radiation calculations for the Yu et al. (2015) + !! style table. The CAM optics code will interpolate based upon the current core/shell + !! mass ratio from a table built using the specified core/shell. + integer, parameter :: ncoreshellratio = 9 !! Number of core/shell ratio for mie calculations + integer, parameter :: ndstbcratio = 8 + integer, parameter :: nkap = 9 + + real(kind=f) :: coreshellratio(ncoreshellratio) = (/ 0.001_f, 0.00237_f, 0.00562_f, 0.01333_f, 0.03162_f, 0.07499_f, 0.17782_f, 0.42169_f, 1.0_f /) + real(kind=f) :: dstbcratio(ndstbcratio) = (/ 0.01_f, 0.025_f, 0.063_f, 0.1_f, 0.3_f, 0.5_f, 0.7_f, 0.9_f/) + real(kind=f) :: kap(nkap) = (/ 0.1_f, 0.2_f, 0.3_f, 0.4_f, 0.5_f, 0.7_f, 0.9_f, 1.1_f, 1.2_f/) + + ! Local variables + integer :: ibin, iwave, irh, icsr, idb, ikap, icore, ncore + integer :: icorelem(NELEM) + integer :: irhswell + integer :: imiertn + integer :: ienconc + real(kind=f) :: rho(NBIN), rhopwet + real(kind=f) :: r(NBIN), rmass(NBIN), rlow(NBIN), rup(NBIN) + real(kind=f) :: wave(NWAVE) + complex(kind=f) :: refidx(NWAVE, NREFIDX) + complex(kind=f) :: refidxS(NWAVE, NREFIDX) + complex(kind=f) :: refidxB(NWAVE, NREFIDX) + complex(kind=f) :: refidxD(NWAVE, NREFIDX) + complex(kind=f) :: refidxW(NWAVE) + complex(kind=f) :: refidxC + complex(kind=f) :: refidxSH + !real(kind=f) :: coreimagidx + character(len=CARMA_NAME_LEN) :: name + character(len=CARMA_SHORT_NAME_LEN) :: shortname + logical :: do_mie + integer :: fid + integer :: rhdim, lwdim, swdim, csrdim, dstbcrdim, kapdim + integer :: rhvar, lwvar, swvar, csr_var, dstbcr_var, kap_var + integer :: abs_lw_coreshell_var, qabs_lw_coreshell_var + integer :: ext_sw_coreshell_var, ssa_sw_coreshell_var, asm_sw_coreshell_var, qext_sw_coreshell_var + integer :: rwetvar + integer :: omdim, andim, namedim + integer :: omvar, anvar, namevar + integer :: dimids(5) + integer :: denvar, slogvar, dryrvar, rminvar, rmaxvar, hygrovar, ntmvar + real(kind=f) :: abs_lw_coreshell(NMIE_RH, nlwbands, ncoreshellratio, ndstbcratio, nkap) + real(kind=f) :: qabs_lw_coreshell(NMIE_RH, nlwbands, ncoreshellratio, ndstbcratio, nkap) + real(kind=f) :: ext_sw_coreshell(NMIE_RH, nswbands, ncoreshellratio, ndstbcratio, nkap) + real(kind=f) :: qext_sw_coreshell(NMIE_RH, nswbands, ncoreshellratio, ndstbcratio, nkap) + real(kind=f) :: ssa_sw_coreshell(NMIE_RH, nswbands, ncoreshellratio, ndstbcratio, nkap) + real(kind=f) :: asm_sw_coreshell(NMIE_RH, nswbands, ncoreshellratio, ndstbcratio, nkap) + real(kind=f) :: rwetbin(NMIE_RH) + character(len=8) :: c_name ! constituent name + character(len=32) :: aer_name ! long enough for both aername and name + character(len=255) :: filepath + real(kind=f) :: rwet + real(kind=f) :: rcore ! CORE radius used in MIE calculation + real(kind=f) :: Qext + real(kind=f) :: Qsca + real(kind=f) :: asym + integer :: start_text(2), count_text(2) + integer :: sw_r_refidx_var, sw_i_refidx_var, lw_r_refidx_var, lw_i_refidx_var + integer :: ncsr, ndbr + integer :: cnsttype ! constituent type + integer :: maxbin ! last prognostic bin + integer :: LUNOPRT ! logical unit number for output + logical :: do_print ! do print output? + integer :: ret + real(kind=f) :: volwater + real(kind=f) :: volsulfate + real(kind=f) :: volshell + integer :: igash2o + + character(len=32) :: elementname + + ! Assume success. + rc = 0 + + ! Get the wavelength structure. + call CARMA_GET(carma, rc, wave=wave, do_print=do_print, LUNOPRT=LUNOPRT, igash2o=igash2o) + if (rc < 0) call endrun('carma_CreateOpticsFile::CARMA_Get failed.') + + ! Get the necessary group properties. + call CARMAGROUP_Get(carma, igroup, rc, do_mie=do_mie, name=name, shortname=shortname, r=r, & + rlow=rlow, rup=rup, rmass=rmass, irhswell=irhswell, imiertn=imiertn, & + ienconc=ienconc, ncore=ncore, icorelem=icorelem, cnsttype=cnsttype, maxbin=maxbin) + if (rc < 0) call endrun('carma_CreateOpticsFile::CARMAGROUP_Get failed.') + + ! The concentration element has the sulfate refractive index. + call CARMAELEMENT_Get(carma, ienconc, rc, rho=rho, refidx=refidxS) + if (rc < 0) call endrun('carma_CreateOpticsFile::CARMAELEMENT_Get failed.') + + ! Need to find the dust and black carbon refractive indicies for the core. + do icore = 1, ncore + call CARMAELEMENT_Get(carma, icorelem(icore), rc, shortname=elementname, refidx=refidx) + if (rc < 0) call endrun('carma_CreateOpticsFile::CARMAELEMENT_Get failed.') + + if (trim(elementname) == 'MXBC') then + refidxB = refidx + else if (trim(elementname) == 'MXDUST') then + refidxD = refidx + end if + end do + + ! Get the refractive index for water. + call CARMAGAS_Get(carma, igash2o, rc, refidx=refidxW) + if (rc < 0) call endrun('carma_CreateOpticsFile::CARMAGAS_Get failed.') + + refidxW(:) = CMPLX(waterreal(:), waterimag(:), kind=f) + + ! A file needs to be created for each bin. + do ibin = 1, NBIN + + ! Bins past maxbin are treated as diagnostic even if the group + ! is prognostic and thus are not advected in the paerent model. + if (ibin <= maxbin) then + + write(c_name, '(A, I2.2)') trim(shortname), ibin + + ! Construct the path to the file. Each model will have its own subdirectory + ! where the optical property files are stored. + filepath = trim(carma_model) // '_' // trim(c_name) // '_rrtmg.nc' + + if (do_print) write(LUNOPRT,*) 'Creating CARMA optics file ... ', trim(filepath) + + ! Create the file. + call wrap_create(filepath, NF90_CLOBBER, fid) + + ncsr = ncoreshellratio + ndbr = ndstbcratio + + ! Define the dimensions: rh, lwbands, swbands + call wrap_def_dim(fid, 'rh_idx', NMIE_RH, rhdim) + call wrap_def_dim(fid, 'lw_band', nlwbands, lwdim) + call wrap_def_dim(fid, 'sw_band', nswbands, swdim) + + call wrap_def_dim(fid, 'coreshellratio', ncsr, csrdim) + call wrap_def_dim(fid, 'dstbcratio', ndbr, dstbcrdim) + call wrap_def_dim(fid, 'kap', nkap, kapdim) + + dimids(1) = rhdim + call wrap_def_var(fid, 'rh', NF90_DOUBLE, 1, dimids(1), rhvar) + call wrap_def_var(fid, 'rwet',NF90_DOUBLE, 1, dimids(1), rwetvar) + + dimids(1) = lwdim + call wrap_def_var(fid, 'lw_band', NF90_DOUBLE, 1, dimids(1), lwvar) + + dimids(1) = swdim + call wrap_def_var(fid, 'sw_band', NF90_DOUBLE, 1, dimids(1), swvar) + + dimids(1) = csrdim + call wrap_def_var(fid, 'coreshellratio', NF90_DOUBLE, 1, dimids(1), csr_var) + dimids(1) = dstbcrdim + call wrap_def_var(fid, 'dstbcratio', NF90_DOUBLE, 1, dimids(1), dstbcr_var) + dimids(1) = kapdim + call wrap_def_var(fid, 'kap', NF90_DOUBLE, 1, dimids(1), kap_var) + + + call wrap_put_att_text(fid, rhvar, 'units', 'fraction') + call wrap_put_att_text(fid, rwetvar, 'units', 'cm') + call wrap_put_att_text(fid, lwvar, 'units', 'm') + call wrap_put_att_text(fid, swvar, 'units', 'm') + + call wrap_put_att_text(fid, csr_var,'units', 'fraction') + call wrap_put_att_text(fid, dstbcr_var,'units', 'fraction') + call wrap_put_att_text(fid, kap_var,'units', 'unitless') + call wrap_put_att_text(fid, csr_var,'long_name', 'coreshell ratio') + call wrap_put_att_text(fid, dstbcr_var,'long_name', 'dust-bc ratio') + call wrap_put_att_text(fid, kap_var,'long_name', 'kappa value') + + call wrap_put_att_text(fid, rhvar, 'long_name', 'relative humidity') + call wrap_put_att_text(fid, rwetvar, 'long_name', 'wet radius') + call wrap_put_att_text(fid, lwvar, 'long_name', 'longwave bands') + call wrap_put_att_text(fid, swvar, 'long_name', 'shortwave bands') + + ! Define 3-dimension (:nrh,:nswbands,:ncoreshellratio) LW optics properties: abs_lw_coreshell, qabs_lw_coreshell + dimids(1) = rhdim + dimids(2) = lwdim + dimids(3) = csrdim + dimids(4) = dstbcrdim + dimids(5) = kapdim + call wrap_def_var(fid, 'abs_lw_coreshell', NF90_DOUBLE, 5, dimids(1:5), abs_lw_coreshell_var) + call wrap_def_var(fid, 'qabs_lw_coreshell',NF90_DOUBLE, 5, dimids(1:5), qabs_lw_coreshell_var) + + call wrap_put_att_text(fid, abs_lw_coreshell_var, 'units', 'meter^2 kilogram^-1') + call wrap_put_att_text(fid, qabs_lw_coreshell_var,'units', '-') + + ! Define 3-dimension (:nrh,:nswbands,:ncoreshellratio) SW optics properties: + ! ext_sw_coreshell, qext_sw_coreshell, ssa_sw_coreshell, asm_sw_coreshell + dimids(1) = rhdim + dimids(2) = swdim + dimids(3) = csrdim + dimids(4) = dstbcrdim + dimids(5) = kapdim + call wrap_def_var(fid, 'ext_sw_coreshell', NF90_DOUBLE, 5, dimids(1:5), ext_sw_coreshell_var) + call wrap_def_var(fid, 'qext_sw_coreshell',NF90_DOUBLE, 5, dimids(1:5), qext_sw_coreshell_var) + call wrap_def_var(fid, 'ssa_sw_coreshell', NF90_DOUBLE, 5, dimids(1:5), ssa_sw_coreshell_var) + call wrap_def_var(fid, 'asm_sw_coreshell', NF90_DOUBLE, 5, dimids(1:5), asm_sw_coreshell_var) + + call wrap_put_att_text(fid, ssa_sw_coreshell_var, 'units', 'fraction') + call wrap_put_att_text(fid, ext_sw_coreshell_var, 'units', 'meter^2 kilogram^-1') + call wrap_put_att_text(fid, qext_sw_coreshell_var,'units', '-') + call wrap_put_att_text(fid, asm_sw_coreshell_var, 'units', '-') + + ! Define the variables for the refractive indicies. + dimids(1) = swdim + call wrap_def_var(fid, 'refindex_real_aer_sw', NF90_DOUBLE, 1, dimids(1), sw_r_refidx_var) + call wrap_def_var(fid, 'refindex_im_aer_sw', NF90_DOUBLE, 1, dimids(1), sw_i_refidx_var) + + dimids(1) = lwdim + call wrap_def_var(fid, 'refindex_real_aer_lw', NF90_DOUBLE, 1, dimids(1), lw_r_refidx_var) + call wrap_def_var(fid, 'refindex_im_aer_lw', NF90_DOUBLE, 1, dimids(1), lw_i_refidx_var) + + call wrap_put_att_text(fid, sw_r_refidx_var, 'units', '-') + call wrap_put_att_text(fid, sw_i_refidx_var, 'units', '-') + call wrap_put_att_text(fid, lw_r_refidx_var, 'units', '-') + call wrap_put_att_text(fid, lw_i_refidx_var, 'units', '-') + + call wrap_put_att_text(fid, sw_r_refidx_var, 'long_name', 'real refractive index of aerosol - shortwave') + call wrap_put_att_text(fid, sw_i_refidx_var, 'long_name', 'imaginary refractive index of aerosol - shortwave') + call wrap_put_att_text(fid, lw_r_refidx_var, 'long_name', 'real refractive index of aerosol - longwave') + call wrap_put_att_text(fid, lw_i_refidx_var, 'long_name', 'imaginary refractive index of aerosol - longwave') + + ! Define fields that define the aerosol properties. + call wrap_def_dim(fid, 'opticsmethod_len', 32, omdim) + dimids(1) = omdim + call wrap_def_var(fid, 'opticsmethod', NF90_CHAR, 1, dimids(1), omvar) + + call wrap_def_dim(fid, 'namelength', 20, andim) + dimids(1) = andim + call wrap_def_var(fid, 'aername', NF90_CHAR, 1, dimids(1), anvar) + + call wrap_def_dim(fid, 'name_len', 32, namedim) + dimids(1) = namedim + call wrap_def_var(fid, 'name', NF90_CHAR, 1, dimids, namevar) + + call wrap_def_var(fid, 'density', NF90_DOUBLE, 0, dimids(1), denvar) + call wrap_def_var(fid, 'sigma_logr', NF90_DOUBLE, 0, dimids(1), slogvar) + call wrap_def_var(fid, 'dryrad', NF90_DOUBLE, 0, dimids(1), dryrvar) + call wrap_def_var(fid, 'radmin_aer', NF90_DOUBLE, 0, dimids(1), rminvar) + call wrap_def_var(fid, 'radmax_aer', NF90_DOUBLE, 0, dimids(1), rmaxvar) + call wrap_def_var(fid, 'hygroscopicity', NF90_DOUBLE, 0, dimids(1), hygrovar) + call wrap_def_var(fid, 'num_to_mass_ratio', NF90_DOUBLE, 0, dimids(1), ntmvar) + + call wrap_put_att_text(fid, denvar, 'units', 'kg m^-3') + call wrap_put_att_text(fid, slogvar, 'units', '-') + call wrap_put_att_text(fid, dryrvar, 'units', 'm') + call wrap_put_att_text(fid, rminvar, 'units', 'm') + call wrap_put_att_text(fid, rmaxvar, 'units', 'm') + call wrap_put_att_text(fid, hygrovar, 'units', '-') + call wrap_put_att_text(fid, ntmvar, 'units', 'kg^-1') + + call wrap_put_att_text(fid, denvar, 'long_name', 'aerosol material density') + call wrap_put_att_text(fid, slogvar, 'long_name', 'geometric standard deviation of aerosol') + call wrap_put_att_text(fid, dryrvar, 'long_name', 'dry number mode radius of aerosol') + call wrap_put_att_text(fid, rminvar, 'long_name', 'minimum dry radius of aerosol for bin') + call wrap_put_att_text(fid, rmaxvar, 'long_name', 'maximum dry radius of aerosol for bin') + call wrap_put_att_text(fid, hygrovar, 'long_name', 'hygroscopicity of aerosol') + call wrap_put_att_text(fid, ntmvar, 'long_name', 'ratio of number to mass of aerosol') + + ! End the defintion phase of the netcdf file. + call wrap_enddef(fid) + + ! Write out the dimensions. + call wrap_put_var_realx(fid, rhvar, mie_rh(:NMIE_RH)) + call wrap_put_var_realx(fid, lwvar, wave(:nlwbands) * 1e-2_f) + call wrap_put_var_realx(fid, swvar, wave(nlwbands+1:) * 1e-2_f) + + call wrap_put_var_realx(fid, csr_var,coreshellratio(:ncsr)) + call wrap_put_var_realx(fid, dstbcr_var,dstbcratio(:ndstbcratio)) + call wrap_put_var_realx(fid, kap_var,kap(:nkap)) + + ! Write out the refractive indicies. + call wrap_put_var_realx(fid, sw_r_refidx_var, real(refidxS(nlwbands+1:, 1))) + call wrap_put_var_realx(fid, sw_i_refidx_var, aimag(refidxS(nlwbands+1:, 1))) + call wrap_put_var_realx(fid, lw_r_refidx_var, real(refidxS(:nlwbands, 1))) + call wrap_put_var_realx(fid, lw_i_refidx_var, aimag(refidxS(:nlwbands, 1))) + + ! Pad the names out with spaces. + aer_name = ' ' + aer_name(1:len(trim(c_name))) = c_name + + start_text(1) = 1 + count_text(1) = 32 + call wrap_put_vara_text(fid, namevar, start_text, count_text, (/ aer_name /)) + count_text(1) = 20 + call wrap_put_vara_text(fid, anvar, start_text, count_text, (/ aer_name /)) + + count_text(1) = len('hygroscopic_coreshell ') + call wrap_put_vara_text(fid, omvar, start_text, count_text, (/ 'hygroscopic_coreshell ' /)) + + call wrap_put_var_realx(fid, denvar, (/ rho(ibin) * 1e-3_f / 1e-6_f /)) + call wrap_put_var_realx(fid, slogvar, (/ 0._f /)) + call wrap_put_var_realx(fid, dryrvar, (/ r(ibin) * 1e-2_f /)) + call wrap_put_var_realx(fid, rminvar, (/ rlow(ibin) * 1e-2_f /)) + call wrap_put_var_realx(fid, rmaxvar, (/ rup(ibin) * 1e-2_f /)) + call wrap_put_var_realx(fid, hygrovar, (/ 0.6_f /)) + call wrap_put_var_realx(fid, ntmvar, (/ 1._f / rmass(ibin) / 1e-3_f /)) + + ! For now, ext_sw(:nrh, :nswbands) and ext_sw_coreshell(:nrh, :nswbands, :ncoreshellratio) both are calculated + ! Since other aerosols in CAM may use ext_sw rather than ext_sw_coreshell + ! Modified by Pengfei Yu + ! April.1, 2012 + + !--------------------------- for 5-D core-shell optical properties ---------------------------- + + ! Iterate over a range of relative humidities, since the particle may swell + ! with relative humidity which will change its optical properties. + do irh = 1, NMIE_RH + + do ikap = 1, nkap + + ! Determine the wet radius. + call getwetr(carma, igroup, mie_rh(irh), r(ibin), rwet, rho(ibin), rhopwet, rc, kappa=kap(ikap), temp=270._f) + rwetbin(irh) = rwet + + ! Calculate at each wavelength. + do iwave = 1, NWAVE + + ! For now just assume BC/OC constant 15% + ! rcore = r(ibin)*(0.15**(1./3)) + ! Using Mie code, consider core/shell ratio + do icsr = 1, ncsr + if (ncsr > 1) then + rcore = r(ibin)*(coreshellratio(icsr)**(1./3)) + else + rcore = 0.0_f + endif + + ! This is not in Yu (2015), but rather than using the refractive + ! index of H2SO4 for the shell, do a volume mix of water and H2SO4 + ! for the refractive index of the shell. + volwater = rwet**3._f - r(ibin)**3._f + volsulfate = r(ibin)**3._f * (1._f - coreshellratio(icsr)) + volshell = volwater + volsulfate + if (volshell > 0._f) then + refidxSH = (volwater / volshell) * refidxW(iwave) + (volsulfate / volshell) * refidxS(iwave, 1) + else + refidxSH = refidxS(iwave, 1) + end if + + ! Using Mie code, assume the particle is CORE-SHELL + ! By: Pengfei Yu + ! Mar.22, 2012 + + !write(*,*) 'before call mie-3D, icsr = ', icsr, ' ;iwave = ', iwave, ' ;irh = ', irh + !write(*,*) 'ibin = ', ibin, ' ;rcore = ', rcore, ' ;csratio = ', coreshellratio(icsr) + + do idb = 1, ndbr + + ! NOTE: This is not the best way to combine the dust and BC refractive indices + ! for the core. Volume mixing should be used for both the real and imaginary + ! parts, not just the imaginary. +! coreimagidx = dstbcratio(idb) * aimag(refidxB(iwave,1)) + (1._f - dstbcratio(idb)) * aimag(refidxD(iwave,1)) +! refidxC = cmplx((real(refidxD(iwave,1)) + real(refidxB(iwave,1))) / 2._f, coreimagidx) + refidxC = dstbcratio(idb) * refidxB(iwave,1) + (1._f - dstbcratio(idb)) * refidxD(iwave,1) + + call mie(carma, & + imiertn, & + rwet, & + wave(iwave), & + 0._f, & + 3.0_f, & + 0.0_f, & + 1.0_f, & + refidxSH, & + rcore, & + refidxC, & + Qext, & + Qsca, & + asym, & + rc) + if (rc < 0) call endrun('carma_CreateOpticsFile::mie failed.') + + ! Calculate the shortwave and longwave properties? + ! + ! NOTE: miess is in cgs units, but the optics file needs to be in mks + ! units, so perform the necessary conversions. + if (iwave <= nlwbands) then + + ! Longwave just needs absorption: abs_lw. + qabs_lw_coreshell(irh, iwave, icsr, idb, ikap) = (Qext - Qsca) ! absorption per particle + abs_lw_coreshell (irh, iwave, icsr, idb, ikap) = (Qext - Qsca) * PI * (rwet * 1e-2_f)**2 / (rmass(ibin) * 1e-3_f) + else + + ! Shortwave needs extinction, single scattering albedo and asymmetry factor: + ! ext_sw, qext_sw, ssa_sw and asm_sw. + qext_sw_coreshell(irh, iwave - nlwbands, icsr, idb, ikap) = Qext ! extinction per particle + ext_sw_coreshell (irh, iwave - nlwbands, icsr, idb, ikap) = Qext * PI * (rwet * 1e-2_f)**2 / (rmass(ibin) * 1e-3_f) + ssa_sw_coreshell (irh, iwave - nlwbands, icsr, idb, ikap) = Qsca / Qext + asm_sw_coreshell (irh, iwave - nlwbands, icsr, idb, ikap) = asym + end if + end do ! idb + end do ! icsr + end do ! iwave + end do ! ikap + end do ! irh + + call wrap_put_var_realx(fid, rwetvar, rwetbin(:)) + + ! Write out the longwave fields. + ret = nf90_put_var(fid, abs_lw_coreshell_var, abs_lw_coreshell (:, :, :, :, :)) + if (ret /= NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile_MixedYu: error writing varid =', abs_lw_coreshell_var + call handle_error(ret) + end if + + ret = nf90_put_var(fid, qabs_lw_coreshell_var, qabs_lw_coreshell(:, :, :, :, :)) + if (ret /= NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile_MixedYu: error writing varid =', qabs_lw_coreshell_var + call handle_error(ret) + end if + + ! Write out the shortwave fields. + ret = nf90_put_var(fid, ext_sw_coreshell_var, ext_sw_coreshell (:, :, :, :, :)) + if (ret /= NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile_MixedYu: error writing varid =', ext_sw_coreshell_var + call handle_error(ret) + end if + + ret = nf90_put_var(fid, qext_sw_coreshell_var, qext_sw_coreshell(:, :, :, :, :)) + if (ret /= NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile_MixedYu: error writing varid =', qext_sw_coreshell_var + call handle_error(ret) + end if + + ret = nf90_put_var(fid, ssa_sw_coreshell_var, ssa_sw_coreshell (:, :, :, :, :)) + if (ret /= NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile_MixedYu: error writing varid =', ssa_sw_coreshell_var + call handle_error(ret) + end if + + ret = nf90_put_var(fid, asm_sw_coreshell_var, asm_sw_coreshell (:, :, :, :, :)) + if (ret /= NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile_MixedYu: error writing varid =', asm_sw_coreshell_var + call handle_error(ret) + end if + + ! Close the file. + call wrap_close(fid) + end if + end do + + return + end subroutine CARMAMODEL_CreateOpticsFile_MixedYuH2o + + + !! This routine creates files containing optical properties for the pure sulfate group + !! following Yu et al. (2015). These optical properties are used by the RRTMG radiation + !! code to include the impact of CARMA particles in the radiative transfer + !! calculation. + subroutine CARMAMODEL_CreateOpticsFile_SulfateYu(carma, igroup, rc) + use radconstants, only : nswbands, nlwbands + use wrap_nf + use wetr, only : getwetr + + implicit none + + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(in) :: igroup !! group index + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Local variables + integer :: ibin, iwave, iwtp + integer :: irhswell + integer :: imiertn + integer :: ienconc + real(kind=f) :: rho(NBIN), rhopwet + real(kind=f) :: r(NBIN), rmass(NBIN), rlow(NBIN), rup(NBIN) + real(kind=f) :: wave(NWAVE) + complex(kind=f) :: refidx(NWAVE, NREFIDX) + character(len=CARMA_NAME_LEN) :: name + character(len=CARMA_SHORT_NAME_LEN) :: shortname + integer :: fid + integer :: rhdim, lwdim, swdim, wtpdim + integer :: rhvar, lwvar, swvar, wtp_var + integer :: rwetvar + integer :: abs_lw_wtp_var, qabs_lw_wtp_var + integer :: ext_sw_wtp_var, ssa_sw_wtp_var, asm_sw_wtp_var, qext_sw_wtp_var + integer :: omdim, andim, namedim + integer :: omvar, anvar, namevar + integer :: dimids(2) + integer :: denvar, slogvar, dryrvar, rminvar, rmaxvar, hygrovar, ntmvar + real(kind=f) :: abs_lw_wtp(NMIE_WTP, nlwbands) + real(kind=f) :: qabs_lw_wtp(NMIE_WTP, nlwbands) + real(kind=f) :: ext_sw_wtp(NMIE_WTP, nswbands) + real(kind=f) :: qext_sw_wtp(NMIE_WTP, nswbands) + real(kind=f) :: ssa_sw_wtp(NMIE_WTP, nswbands) + real(kind=f) :: asm_sw_wtp(NMIE_WTP, nswbands) + character(len=8) :: c_name ! constituent name + character(len=32) :: aer_name ! long enough for both aername and name + character(len=255) :: filepath + real(kind=f) :: rwet + real(kind=f) :: Qext + real(kind=f) :: Qsca + real(kind=f) :: asym + integer :: start_text(2), count_text(2) + integer :: sw_r_refidx_var, sw_i_refidx_var, lw_r_refidx_var, lw_i_refidx_var + integer :: cnsttype ! constituent type + integer :: maxbin ! last prognostic bin + integer :: LUNOPRT ! logical unit number for output + logical :: do_print ! do print output? + integer :: ret + + + ! Assume success. + rc = 0 + + ! Get the wavelength structure. + call CARMA_GET(carma, rc, wave=wave, do_print=do_print, LUNOPRT=LUNOPRT) + if (rc < 0) call endrun('carma_CreateOpticsFile::CARMA_Get failed.') + + ! Get the necessary group properties. + call CARMAGROUP_Get(carma, igroup, rc, name=name, shortname=shortname, r=r, & + rlow=rlow, rup=rup, rmass=rmass, irhswell=irhswell, & + ienconc=ienconc, cnsttype=cnsttype, maxbin=maxbin, imiertn=imiertn) + if (rc < 0) call endrun('carma_CreateOpticsFile::CARMAGROUP_Get failed.') + + ! Get the necessary element properties. + call CARMAELEMENT_Get(carma, ienconc, rc, rho=rho, refidx=refidx) + if (rc < 0) call endrun('carma_CreateOpticsFile::CARMAELEMENT_Get failed.') + + ! A file needs to be created for each bin. + do ibin = 1, NBIN + + ! Bins past maxbin are treated as diagnostic even if the group + ! is prognostic and thus are not advected in the paerent model. + if (ibin <= maxbin) then + + write(c_name, '(A, I2.2)') trim(shortname), ibin + + ! Construct the path to the file. Each model will have its own subdirectory + ! where the optical property files are stored. + filepath = trim(carma_model) // '_' // trim(c_name) // '_rrtmg.nc' + + if (do_print) write(LUNOPRT,*) 'Creating CARMA optics file ... ', trim(filepath) + + ! Create the file. + call wrap_create(filepath, NF90_CLOBBER, fid) + + ! Define the dimensions: rh, lwbands, swbands + call wrap_def_dim(fid, 'rh_idx', NMIE_RH, rhdim) + call wrap_def_dim(fid, 'lw_band', nlwbands, lwdim) + call wrap_def_dim(fid, 'sw_band', nswbands, swdim) + + call wrap_def_dim(fid, 'wgtpct', NMIE_WTP, wtpdim) + + dimids(1) = rhdim + call wrap_def_var(fid, 'rh', NF90_DOUBLE, 1, dimids(1), rhvar) + call wrap_def_var(fid, 'rwet',NF90_DOUBLE, 1, dimids(1), rwetvar) + + dimids(1) = lwdim + call wrap_def_var(fid, 'lw_band', NF90_DOUBLE, 1, dimids(1), lwvar) + + dimids(1) = swdim + call wrap_def_var(fid, 'sw_band', NF90_DOUBLE, 1, dimids(1), swvar) + + dimids(1) = wtpdim + call wrap_def_var(fid, 'wgtpct', NF90_DOUBLE, 1, dimids(1), wtp_var) + + call wrap_put_att_text(fid, rhvar, 'units', 'fraction') + call wrap_put_att_text(fid, rwetvar, 'units', 'cm') + call wrap_put_att_text(fid, lwvar, 'units', 'm') + call wrap_put_att_text(fid, swvar, 'units', 'm') + + call wrap_put_att_text(fid, wtp_var,'units', 'unitless') + call wrap_put_att_text(fid, wtp_var,'long_name', 'weight percent') + + call wrap_put_att_text(fid, rhvar, 'long_name', 'relative humidity') + call wrap_put_att_text(fid, rwetvar, 'long_name', 'wet radius') + call wrap_put_att_text(fid, lwvar, 'long_name', 'longwave bands') + call wrap_put_att_text(fid, swvar, 'long_name', 'shortwave bands') + + ! Define the variables: abs_lw, ext_sw, ssa_sw, asm_sw + ! Define 2-dimension (:nrh,:nswbands) LW optics properties: abs_lw, qabs_lw + dimids(1) = wtpdim + dimids(2) = lwdim + call wrap_def_var(fid, 'abs_lw_wtp', NF90_DOUBLE, 2, dimids(1:2), abs_lw_wtp_var) + call wrap_def_var(fid, 'qabs_lw_wtp',NF90_DOUBLE, 2, dimids(1:2), qabs_lw_wtp_var) + + call wrap_put_att_text(fid, abs_lw_wtp_var, 'units', 'meter^2 kilogram^-1') + call wrap_put_att_text(fid, qabs_lw_wtp_var,'units', '-') + + ! Define 2-dimension (:nrh,:nswbands) optics properties: ext_sw, qext_sw, ssa_sw, asm_sw + dimids(1) = wtpdim + dimids(2) = swdim + call wrap_def_var(fid, 'ext_sw_wtp', NF90_DOUBLE, 2, dimids(1:2), ext_sw_wtp_var) + call wrap_def_var(fid, 'qext_sw_wtp',NF90_DOUBLE, 2, dimids(1:2), qext_sw_wtp_var) + call wrap_def_var(fid, 'ssa_sw_wtp', NF90_DOUBLE, 2, dimids(1:2), ssa_sw_wtp_var) + call wrap_def_var(fid, 'asm_sw_wtp', NF90_DOUBLE, 2, dimids(1:2), asm_sw_wtp_var) + + call wrap_put_att_text(fid, ssa_sw_wtp_var, 'units', 'fraction') + call wrap_put_att_text(fid, qext_sw_wtp_var,'units', '-') + call wrap_put_att_text(fid, ext_sw_wtp_var, 'units', 'meter^2 kilogram^-1') + call wrap_put_att_text(fid, asm_sw_wtp_var, 'units', '-') + + ! Define the variables for the refractive indicies. + dimids(1) = swdim + call wrap_def_var(fid, 'refindex_real_aer_sw', NF90_DOUBLE, 1, dimids(1), sw_r_refidx_var) + call wrap_def_var(fid, 'refindex_im_aer_sw', NF90_DOUBLE, 1, dimids(1), sw_i_refidx_var) + + dimids(1) = lwdim + call wrap_def_var(fid, 'refindex_real_aer_lw', NF90_DOUBLE, 1, dimids(1), lw_r_refidx_var) + call wrap_def_var(fid, 'refindex_im_aer_lw', NF90_DOUBLE, 1, dimids(1), lw_i_refidx_var) + + call wrap_put_att_text(fid, sw_r_refidx_var, 'units', '-') + call wrap_put_att_text(fid, sw_i_refidx_var, 'units', '-') + call wrap_put_att_text(fid, lw_r_refidx_var, 'units', '-') + call wrap_put_att_text(fid, lw_i_refidx_var, 'units', '-') + + call wrap_put_att_text(fid, sw_r_refidx_var, 'long_name', 'real refractive index of aerosol - shortwave') + call wrap_put_att_text(fid, sw_i_refidx_var, 'long_name', 'imaginary refractive index of aerosol - shortwave') + call wrap_put_att_text(fid, lw_r_refidx_var, 'long_name', 'real refractive index of aerosol - longwave') + call wrap_put_att_text(fid, lw_i_refidx_var, 'long_name', 'imaginary refractive index of aerosol - longwave') + + + ! Define fields that define the aerosol properties. + call wrap_def_dim(fid, 'opticsmethod_len', 32, omdim) + dimids(1) = omdim + call wrap_def_var(fid, 'opticsmethod', NF90_CHAR, 1, dimids(1), omvar) + + call wrap_def_dim(fid, 'namelength', 20, andim) + dimids(1) = andim + call wrap_def_var(fid, 'aername', NF90_CHAR, 1, dimids(1), anvar) + + call wrap_def_dim(fid, 'name_len', 32, namedim) + dimids(1) = namedim + call wrap_def_var(fid, 'name', NF90_CHAR, 1, dimids, namevar) + + call wrap_def_var(fid, 'density', NF90_DOUBLE, 0, dimids(1), denvar) + call wrap_def_var(fid, 'sigma_logr', NF90_DOUBLE, 0, dimids(1), slogvar) + call wrap_def_var(fid, 'dryrad', NF90_DOUBLE, 0, dimids(1), dryrvar) + call wrap_def_var(fid, 'radmin_aer', NF90_DOUBLE, 0, dimids(1), rminvar) + call wrap_def_var(fid, 'radmax_aer', NF90_DOUBLE, 0, dimids(1), rmaxvar) + call wrap_def_var(fid, 'hygroscopicity', NF90_DOUBLE, 0, dimids(1), hygrovar) + call wrap_def_var(fid, 'num_to_mass_ratio', NF90_DOUBLE, 0, dimids(1), ntmvar) + + call wrap_put_att_text(fid, denvar, 'units', 'kg m^-3') + call wrap_put_att_text(fid, slogvar, 'units', '-') + call wrap_put_att_text(fid, dryrvar, 'units', 'm') + call wrap_put_att_text(fid, rminvar, 'units', 'm') + call wrap_put_att_text(fid, rmaxvar, 'units', 'm') + call wrap_put_att_text(fid, hygrovar, 'units', '-') + call wrap_put_att_text(fid, ntmvar, 'units', 'kg^-1') + + call wrap_put_att_text(fid, denvar, 'long_name', 'aerosol material density') + call wrap_put_att_text(fid, slogvar, 'long_name', 'geometric standard deviation of aerosol') + call wrap_put_att_text(fid, dryrvar, 'long_name', 'dry number mode radius of aerosol') + call wrap_put_att_text(fid, rminvar, 'long_name', 'minimum dry radius of aerosol for bin') + call wrap_put_att_text(fid, rmaxvar, 'long_name', 'maximum dry radius of aerosol for bin') + call wrap_put_att_text(fid, hygrovar, 'long_name', 'hygroscopicity of aerosol') + call wrap_put_att_text(fid, ntmvar, 'long_name', 'ratio of number to mass of aerosol') + + ! End the defintion phase of the netcdf file. + call wrap_enddef(fid) + + ! Write out the dimensions. + call wrap_put_var_realx(fid, rhvar, mie_rh(:)) + call wrap_put_var_realx(fid, lwvar, wave(:nlwbands) * 1e-2_f) + call wrap_put_var_realx(fid, swvar, wave(nlwbands+1:) * 1e-2_f) + + call wrap_put_var_realx(fid, wtp_var, mie_wtp(:)*100._f) + + ! Write out the refractive indicies. + call wrap_put_var_realx(fid, sw_r_refidx_var, real(refidx(nlwbands+1:, 1))) + call wrap_put_var_realx(fid, sw_i_refidx_var, aimag(refidx(nlwbands+1:, 1))) + call wrap_put_var_realx(fid, lw_r_refidx_var, real(refidx(:nlwbands, 1))) + call wrap_put_var_realx(fid, lw_i_refidx_var, aimag(refidx(:nlwbands, 1))) + + ! Pad the names out with spaces. + aer_name = ' ' + aer_name(1:len(trim(c_name))) = c_name + + start_text(1) = 1 + count_text(1) = 32 + call wrap_put_vara_text(fid, namevar, start_text, count_text, (/ aer_name /)) + count_text(1) = 20 + call wrap_put_vara_text(fid, anvar, start_text, count_text, (/ aer_name /)) + + count_text(1) = len('hygroscopic_wtp ') + call wrap_put_vara_text(fid, omvar, start_text, count_text, (/ 'hygroscopic_wtp ' /)) + + call wrap_put_var_realx(fid, denvar, (/ rho(ibin) * 1e-3_f / 1e-6_f /)) + call wrap_put_var_realx(fid, slogvar, (/ 0._f /)) + call wrap_put_var_realx(fid, dryrvar, (/ r(ibin) * 1e-2_f /)) + call wrap_put_var_realx(fid, rminvar, (/ rlow(ibin) * 1e-2_f /)) + call wrap_put_var_realx(fid, rmaxvar, (/ rup(ibin) * 1e-2_f /)) + call wrap_put_var_realx(fid, hygrovar, (/ 0.6_f /)) + call wrap_put_var_realx(fid, ntmvar, (/ 1._f / rmass(ibin) / 1e-3_f /)) + + ! For now, ext_sw(:nrh, :nswbands) and ext_sw_coreshell(:nrh, :nswbands, :ncoreshellratio) both are calculated + ! Since other aerosols in CAM may use ext_sw rather than ext_sw_coreshell + ! Modified by Pengfei Yu + ! April.1, 2012 + + ! calculate qext and ext for pure sulfate dependent on weight percent + ! ideally qext is based on (wgt,temp,wave), however Beyer et al. (1996) Figure 5 + ! shows sulfate density is roughly 0.006 g/cm3/k, I negelet temp dimension, assuming temp = 270 K + ! In code, sulfate density is precisely calculated to determine wet raidus + do iwtp = 1, NMIE_WTP + + ! NOTE: Weight percent is normal a result of the getwetr calculation. To build the + ! table based upon weight percent, we need to pass in the desired value and a + ! reference temperature. In that case, the RH is ignored. + call getwetr(carma, igroup, mie_rh(1), r(ibin), rwet, rho(ibin), rhopwet, rc, wgtpct=mie_wtp(iwtp)*100._f, temp=270._f) + if (rc < 0) call endrun('carma_CreateOpticsFile::wetr failed.') + + ! Calculate at each wavelength. + do iwave = 1, NWAVE + + ! Using Mie code, calculate the optical properties: extinction coefficient, + ! single scattering albedo and asymmetry factor. + ! Assume the particle is homogeneous (no core). + ! + ! NOTE: The refractive index for sulfate changes with RH/weight percent, which + ! is not reflected in this code. + call mie(carma, & + imiertn, & + rwet, & + wave(iwave), & + 0._f, & + 3.0_f, & + 0.0_f, & + 1.0_f, & + refidx(iwave, 1), & + 0.0_f, & + refidx(iwave, 1), & + Qext, & + Qsca, & + asym, & + rc) + if (rc < 0) call endrun('carma_CreateOpticsFile::mie failed.') + + ! Calculate the shortwave and longwave properties? + ! + ! NOTE: miess is in cgs units, but the optics file needs to be in mks + ! units, so perform the necessary conversions. + if (iwave <= nlwbands) then + + ! Longwave just needs absorption: abs_lw. + qabs_lw_wtp(iwtp, iwave) = (Qext - Qsca) ! absorption per particle + abs_lw_wtp (iwtp, iwave) = (Qext - Qsca) * PI * (rwet * 1e-2_f)**2 / (rmass(ibin) * 1e-3_f) + else + + ! Shortwave needs extinction, single scattering albedo and asymmetry factor: + ! ext_sw, ssa_sw and asm_sw. + qext_sw_wtp(iwtp, iwave - nlwbands) = Qext ! extinction per particle + ext_sw_wtp (iwtp, iwave - nlwbands) = Qext * PI * (rwet * 1e-2_f)**2 / (rmass(ibin) * 1e-3_f) + ssa_sw_wtp (iwtp, iwave - nlwbands) = Qsca / Qext + asm_sw_wtp (iwtp, iwave - nlwbands) = asym + end if + end do ! iwave + end do ! iwtp + + ! Write out the longwave fields. + ret = nf90_put_var(fid, abs_lw_wtp_var, abs_lw_wtp (:, :)) + if (ret /= NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile_SulfateYu: error writing varid =', fid, abs_lw_wtp_var + call handle_error(ret) + end if + + ret = nf90_put_var(fid, qabs_lw_wtp_var, qabs_lw_wtp(:, :)) + if (ret /= NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile_SulfateYu: error writing varid =', qabs_lw_wtp_var + call handle_error(ret) + end if + + ! Write out the shortwave fields. + ret = nf90_put_var(fid, ext_sw_wtp_var, ext_sw_wtp (:, :)) + if (ret /= NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile_SulfateYu: error writing varid =', ext_sw_wtp_var + call handle_error(ret) + end if + + ret = nf90_put_var(fid, qext_sw_wtp_var,qext_sw_wtp(:, :)) + if (ret /= NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile_SulfateYu: error writing varid =', qext_sw_wtp_var + call handle_error(ret) + end if + + ret = nf90_put_var(fid, ssa_sw_wtp_var, ssa_sw_wtp (:, :)) + if (ret /= NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile_SulfateYu: error writing varid =', ssa_sw_wtp_var + call handle_error(ret) + end if + + ret = nf90_put_var(fid, asm_sw_wtp_var, asm_sw_wtp (:, :)) + if (ret /= NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile_SulfateYu: error writing varid =', asm_sw_wtp_var + call handle_error(ret) + end if + + ! Close the file. + call wrap_close(fid) + end if + end do + + return + end subroutine CARMAMODEL_CreateOpticsFile_SulfateYu + + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! NOTE: This is just keeping track of the changes in the interstitial aerosol, + !! and does not keep track of the aerosol that flows out the top or bottom of the + !! model or that moves into cloudborne aerosol. + !! + !! NOTE: Output occurs a chunk at a time. + !! + !! @version January-2023 + !! @author Chuck Bardeen + subroutine CARMAMODEL_CalculateCloudborneDiagnostics(carma, state, pbuf, aerclddiag, rc) + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(out) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the total cloudborne aerosols, supports up to MAXCLDAERDIAG different values + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: ncols !! number of columns in the chunk + integer :: icol !! column index + integer :: ibin !! bin index + integer :: ienconc !! concentration element index + integer :: ncore !! number of cores + integer :: icorelem(NELEM) !! core element index + real(r8) :: mair(pcols,pver) !! Mass of air column (kg/m2) + real(r8) :: pureso4(pcols,pver) !! Burden pure sulfate (kg/m2) + real(r8) :: mixso4(pcols,pver) !! Burden mix sulfate (kg/m2) + real(r8) :: bdbc(pcols,pver) !! Burden BC sulfate (kg/m2) + real(r8) :: bddust(pcols,pver) !! Burden Dust sulfate (kg/m2) + real(r8) :: bdoc(pcols,pver) !! Burden OC sulfate (kg/m2) + real(r8) :: bdsalt(pcols,pver) !! Burden Salt sulfate (kg/m2) + real(r8) :: bdsoa1(pcols,pver) !! Burden SOA sulfate (kg/m2) + real(r8) :: bdsoa2(pcols,pver) !! Burden SOA sulfate (kg/m2) + real(r8) :: bdsoa3(pcols,pver) !! Burden SOA sulfate (kg/m2) + real(r8) :: bdsoa4(pcols,pver) !! Burden SOA sulfate (kg/m2) + real(r8) :: bdsoa5(pcols,pver) !! Burden SOA sulfate (kg/m2) + real(r8), pointer, dimension(:,:) :: mmr !! cloudbourne aerosol mmr (kg/kg) + character(len=16) :: shortname + character(len=16) :: binname + character(len=16) :: concname + integer :: mmr_ndx + integer :: i + + ! Default return code. + rc = RC_OK + + pureso4(:,:) = 0._r8 + mixso4(:,:) = 0._r8 + aerclddiag(:, :) = 0._r8 + bdbc(:, :) = 0._r8 + bddust(:, :) = 0._r8 + bdoc(:, :) = 0._r8 + bdsalt(:, :) = 0._r8 + bdsoa1(:, :) = 0._r8 + bdsoa2(:, :) = 0._r8 + bdsoa3(:, :) = 0._r8 + bdsoa4(:, :) = 0._r8 + bdsoa5(:, :) = 0._r8 + + ! Get the air mass in the column + ! + ! NOTE convert GRAV from cm/s2 to m/s2. + ncols = state%ncol + mair(:ncols,:) = state%pdel(:ncols,:) / (GRAV / 100._r8) + + ! For PRSUL, is just the tendency for the concentration element. + call CARMAGROUP_Get(carma, I_GRP_PRSUL, rc, ienconc=ienconc) + call CARMAELEMENT_Get(carma, ienconc, rc, shortname=shortname) + + do ibin = 1, nbin + + write(binname, '(A, I2.2)') "CLD"//trim(shortname), ibin + mmr_ndx = pbuf_get_index(binname) + call pbuf_get_field(pbuf, mmr_ndx, mmr) + + pureso4(:ncols,:) = pureso4(:ncols,:) + mmr(:ncols,:) * mair(:ncols,:) + end do + + ! For MXAER, it is the difference in mass between the concentration element + ! and the sum of the core masses. + ! + ! NOTE: Since this is using the CAM state variables and not he CARMA state + ! variables the concentration element is just the mass of the sulfate. + call CARMAGROUP_Get(carma, I_GRP_MXAER, rc, ienconc=ienconc, ncore=ncore, icorelem=icorelem) + call CARMAELEMENT_Get(carma, ienconc, rc, shortname=concname) + + do ibin = 1, nbin + + write(binname, '(A, I2.2)') "CLD"//trim(concname), ibin + mmr_ndx = pbuf_get_index(binname) + call pbuf_get_field(pbuf, mmr_ndx, mmr) + + mixso4(:ncols,:) = mixso4(:ncols,:) + mmr(:ncols,:) * mair(:ncols,:) + + do i = 1, ncore + call CARMAELEMENT_Get(carma, icorelem(i), rc, shortname=shortname) + + write(binname, '(A, I2.2)') "CLD"//trim(shortname), ibin + mmr_ndx = pbuf_get_index(binname) + call pbuf_get_field(pbuf, mmr_ndx, mmr) + + if (shortname .eq. "MXBC") then + bdbc(:ncols, :) = bdbc(:ncols, :) + mmr(:ncols,:) * mair(:ncols,:) + else if (shortname .eq. "MXDUST") then + bddust(:ncols, :) = bddust(:ncols, :) + mmr(:ncols,:) * mair(:ncols,:) + else if (shortname .eq. "MXOC") then + bdoc(:ncols, :) = bdoc(:ncols, :) + mmr(:ncols,:) * mair(:ncols,:) + else if (shortname .eq. "MXSALT") then + bdsalt(:ncols, :) = bdsalt(:ncols, :) + mmr(:ncols,:) * mair(:ncols,:) + else if (shortname .eq. "MXSOA1") then + bdsoa1(:ncols, :) = bdsoa1(:ncols, :) + mmr(:ncols,:) * mair(:ncols,:) + else if (shortname .eq. "MXSOA2") then + bdsoa2(:ncols, :) = bdsoa2(:ncols, :) + mmr(:ncols,:) * mair(:ncols,:) + else if (shortname .eq. "MXSOA3") then + bdsoa3(:ncols, :) = bdsoa3(:ncols, :) + mmr(:ncols,:) * mair(:ncols,:) + else if (shortname .eq. "MXSOA4") then + bdsoa4(:ncols, :) = bdsoa4(:ncols, :) + mmr(:ncols,:) * mair(:ncols,:) + else if (shortname .eq. "MXSOA5") then + bdsoa5(:ncols, :) = bdsoa5(:ncols, :) + mmr(:ncols,:) * mair(:ncols,:) + end if + end do + end do + + do icol = 1, ncols + aerclddiag(icol, 1) = sum(pureso4(icol,:)) + aerclddiag(icol, 2) = sum(mixso4(icol,:)) + aerclddiag(icol, 3) = sum(bdbc(icol,:)) + aerclddiag(icol, 4) = sum(bddust(icol,:)) + aerclddiag(icol, 5) = sum(bdoc(icol,:)) + aerclddiag(icol, 6) = sum(bdsalt(icol,:)) + aerclddiag(icol, 7) = sum(bdsoa1(icol,:)) + aerclddiag(icol, 8) = sum(bdsoa2(icol,:)) + aerclddiag(icol, 9) = sum(bdsoa3(icol,:)) + aerclddiag(icol,10) = sum(bdsoa4(icol,:)) + aerclddiag(icol,11) = sum(bdsoa5(icol,:)) + end do + + return + end subroutine CARMAMODEL_CalculateCloudborneDiagnostics + + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! NOTE: This is just keeping track of the changes in the interstitial aerosol, + !! and does not keep track of the aerosol that flows out the top or bottom of the + !! model or that moves into cloudborne aerosol. + !! + !! NOTE: Output occurs a chunk at a time. + !! + !! @version January-2023 + !! @author Chuck Bardeen + subroutine CARMAMODEL_OutputBudgetDiagnostics(carma, icnst4elem, icnst4gas, state, ptend, old_cflux, cflux, dt, pname, rc) + use cam_history, only: outfld + use constituents, only: pcnst, cnst_get_ind + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + integer, intent(in) :: icnst4gas(NGAS) !! constituent index for a carma gas + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + real(r8) :: old_cflux(pcols,pcnst) !! cam_in%clfux from before the timestep_tend + real(r8) :: cflux(pcols,pcnst) !! cam_in%clfux from after the timestep_tend + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: icol !! column index + integer :: ibin !! bin index + integer :: i + integer :: icnst !! constituent index + integer :: ienconc !! concentration element index + integer :: ncore !! number of cores + integer :: icorelem(NELEM) !! core element index + real(r8) :: mair(pver) !! Mass of air column (kg/m2) + real(r8) :: puretend(pcols) !! Tendency pure sulfate (kg/m2/s) + real(r8) :: mixtend(pcols) !! Tendency mix sulfate (kg/m2/s) + real(r8) :: bdprso4(pcols) !! Burden pure sulfate (kg/m2) + real(r8) :: bdmxso4(pcols) !! Burden mixed sulfate (kg/m2) + real(r8) :: cprflux(pcols) !! Surface Flux tendency, pure sulfate (kg/m2/s) + real(r8) :: cmxflux(pcols) !! Surface Flux tendency, mix sulfate (kg/m2/s) + real(r8) :: gastend(pcols) !! Tendency H2SO4 gas (kg/m2/s) + real(r8) :: so2tend(pcols) !! Tendency SO2 gas (kg/m2/s) + real(r8) :: h2so4(pcols) !! H2SO4 gas (kg/m2) + real(r8) :: so2(pcols) !! SO2 gas (kg/m2) + + + ! Default return code. + rc = RC_OK + + puretend(:) = 0._r8 + mixtend(:) = 0._r8 + gastend(:) = 0._r8 + so2tend(:) = 0._r8 + cprflux(:) = 0._r8 + cmxflux(:) = 0._r8 + + bdmxso4(:) = 0._r8 + bdprso4(:) = 0._r8 + h2so4(:) = 0._r8 + so2(:) = 0._r8 + + ! Add up the sulfate tendencies. + do icol = 1, state%ncol + + ! Get the air mass in the column + ! + ! NOTE convert GRAV from cm/s2 to m/s2. + mair(:) = state%pdel(icol,:) / (GRAV / 100._r8) + + do ibin = 1, nbin + + ! For PRSUL, is just the tendency for the concentration element. + call CARMAGROUP_Get(carma, I_GRP_PRSUL, rc, ienconc=ienconc) + icnst = icnst4elem(ienconc, ibin) + + if (ptend%lq(icnst)) then + puretend(icol) = puretend(icol) + sum(ptend%q(icol,:,icnst) * mair(:)) + end if + bdprso4(icol) = bdprso4(icol) + sum(state%q(icol,:,icnst) * mair(:)) + + cprflux = cprflux(icol) + (cflux(icol,icnst) - old_cflux(icol,icnst)) + + ! For MXAER, it is the difference in mass between the concentration element + ! and the sum of the core masses. + ! + ! NOTE: Since this is using the CAM state variables and not he CARMA state + ! variables the concentration element is just the mass of the sulfate. + call CARMAGROUP_Get(carma, I_GRP_MXAER, rc, ienconc=ienconc, ncore=ncore, icorelem=icorelem) + icnst = icnst4elem(ienconc, ibin) + + if (ptend%lq(icnst)) then + mixtend(icol) = mixtend(icol) + sum(ptend%q(icol, :, icnst) * mair(:)) + end if + + bdmxso4(icol) = bdmxso4(icol) + sum(state%q(icol,:,icnst) * mair(:)) + cmxflux(icol) = cmxflux(icol) + (cflux(icol,icnst) - old_cflux(icol,icnst)) + end do + + ! Calculate the H2SO4 change. + icnst = icnst4gas(I_GAS_H2SO4) + if (ptend%lq(icnst)) then + gastend(icol) = sum(ptend%q(icol,:,icnst) * mair(:)) + end if + ! Calculate the H2SO4 burden. + h2so4(icol) = sum(state%q(icol,:,icnst) * mair(:)) + + ! Also do SO2 + call cnst_get_ind("SO2", icnst) + if (ptend%lq(icnst)) then + so2tend(icol) = sum(ptend%q(icol,:,icnst) * mair(:)) + end if + ! Calculate the SO2 burden. + so2(icol) = sum(state%q(icol,:,icnst) * mair(:)) + end do + + if (carma_do_package_diags) then + ! Output the total sulfate and H2SO4 tendencies for this physics package. + call outfld("SO4PRTC_"//trim(pname), puretend(:), pcols, state%lchnk) + call outfld("SO4MXTC_"//trim(pname), mixtend(:), pcols, state%lchnk) + call outfld("H2SO4TC_"//trim(pname), gastend(:), pcols, state%lchnk) + call outfld("H2SO4BD_"//trim(pname), h2so4(:), pcols, state%lchnk) + call outfld("SO2BD_"//trim(pname), so2(:), pcols, state%lchnk) + call outfld("SO2TC_"//trim(pname), so2tend(:), pcols, state%lchnk) + call outfld("SO4PRSF_"//trim(pname), cprflux(:), pcols, state%lchnk) + call outfld("SO4MXSF_"//trim(pname), cmxflux(:), pcols, state%lchnk) + call outfld("SO4PRBD_"//trim(pname), bdprso4(:), pcols, state%lchnk) + call outfld("SO4MXBD_"//trim(pname), bdmxso4(:), pcols, state%lchnk) + endif + + return + end subroutine CARMAMODEL_OutputBudgetDiagnostics + + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! NOTE: This is just keeping track of the changes in the interstitial aerosol, + !! and does not keep track of the aerosol that flows out the top or bottom of the + !! model or that moves into cloudborne aerosol. + !! + !! NOTE: Output occurs a chunk at a time. + !! + !! @version January-2023 + !! @author Chuck Bardeen + subroutine CARMAMODEL_OutputCloudborneDiagnostics(carma, state, pbuf, dt, pname, oldaerclddiag, rc) + use cam_history, only: outfld + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + real(r8), intent(in ) :: oldaerclddiag(pcols,MAXCLDAERDIAG) !! the before timestep cloudborne aerosol diags + integer, intent(out) :: rc !! return code, negative indicates failure + + real(r8) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the after timestep cloudborne aerosol diags + + ! Default return code. + rc = RC_OK + + ! Get the current diagnostics for the cloudborne aerosols. + call CARMAMODEL_CalculateCloudborneDiagnostics(carma, state, pbuf, aerclddiag, rc) + + ! Output the total sulfate and H2SO4 tendencies for this physics package. + call outfld("SO4PRCLDTC_"//trim(pname), (aerclddiag(:,1) - oldaerclddiag(:,1)) / dt, pcols, state%lchnk) + call outfld("SO4MXCLDTC_"//trim(pname), (aerclddiag(:,2) - oldaerclddiag(:,2)) / dt, pcols, state%lchnk) + + ! To be similar to interstitial, where the burden is calculated from the + ! state before the tendencies are applied, report the old burden not the + ! current burden. + ! call outfld("SO4PRCLDBD_"//trim(pname), aerclddiag(:,1), pcols, state%lchnk) + ! call outfld("SO4MXCLDBD_"//trim(pname), aerclddiag(:,2), pcols, state%lchnk) + call outfld("SO4PRCLDBD_"//trim(pname), oldaerclddiag(:,1), pcols, state%lchnk) + call outfld("SO4MXCLDBD_"//trim(pname), oldaerclddiag(:,2), pcols, state%lchnk) + + return + end subroutine CARMAMODEL_OutputCloudborneDiagnostics + + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! NOTE: Output occurs a chunk at a time. + !! + !! @version January-2023 + !! @author Chuck Bardeen + subroutine CARMAMODEL_OutputDiagnostics(carma, icnst4elem, state, ptend, pbuf, cam_in, rc) + use cam_history, only: outfld + use constituents, only: cnst_get_ind + use camsrfexch, only: cam_in_t + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + type(cam_in_t), intent(in) :: cam_in !! surface inputs + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: icol !! column index + integer :: ibin !! bin index + real(r8), pointer, dimension(:,:) :: soacm1 !! aerosol tendency due to gas-aerosol exchange kg/kg/s + real(r8), pointer, dimension(:,:) :: soacm2 !! aerosol tendency due to gas-aerosol exchange kg/kg/s + real(r8), pointer, dimension(:,:) :: soacm3 !! aerosol tendency due to gas-aerosol exchange kg/kg/s + real(r8), pointer, dimension(:,:) :: soacm4 !! aerosol tendency due to gas-aerosol exchange kg/kg/s + real(r8), pointer, dimension(:,:) :: soacm5 !! aerosol tendency due to gas-aerosol exchange kg/kg/s + real(r8), pointer, dimension(:,:) :: soapt1 !! aerosol tendency due to no2 photolysis kg/kg/s + real(r8), pointer, dimension(:,:) :: soapt2 !! aerosol tendency due to no2 photolysis kg/kg/s + real(r8), pointer, dimension(:,:) :: soapt3 !! aerosol tendency due to no2 photolysis kg/kg/s + real(r8), pointer, dimension(:,:) :: soapt4 !! aerosol tendency due to no2 photolysis kg/kg/s + real(r8), pointer, dimension(:,:) :: soapt5 !! aerosol tendency due to no2 photolysis kg/kg/s + character(len=16) :: binname !! names bins + real(r8) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the before timestep cloudborne aerosol diags + integer :: i + integer :: icnst !! constituent index + integer :: ienconc !! concentration element index + integer :: ncore !! number of cores + integer :: icorelem(NELEM) !! core element index + real(r8) :: mair(pver) !! Mass of air column (kg/m2) + real(r8) :: pureso4(pcols) !! pure sulfate (kg/m2) + real(r8) :: mixso4(pcols) !! mix sulfate (kg/m2) + real(r8) :: cprflux(pcols) !! Surface Flux pure sulfate (kg/m2/s) + real(r8) :: cmxflux(pcols) !! Surface Flux mix sulfate (kg/m2/s) + real(r8) :: h2so4(pcols) !! H2SO4 gas (kg/m2) + real(r8) :: so2(pcols) !! SO2 gas (kg/m2) + real(r8) :: bdbc(pcols) !! Burden BC sulfate (kg/m2) + real(r8) :: bddust(pcols) !! Burden dust (kg/m2) + real(r8) :: bdoc(pcols) !! Burden OC sulfate (kg/m2) + real(r8) :: bdsalt(pcols) !! Burden SALT sulfate (kg/m2) + real(r8) :: bdsoa1(pcols) !! Burden SOA sulfate (kg/m2) + real(r8) :: bdsoa2(pcols) !! Burden SOA sulfate (kg/m2) + real(r8) :: bdsoa3(pcols) !! Burden SOA sulfate (kg/m2) + real(r8) :: bdsoa4(pcols) !! Burden SOA sulfate (kg/m2) + real(r8) :: bdsoa5(pcols) !! Burden SOA sulfate (kg/m2) + real(r8) :: pureso4mr(pcols,pver) !! Mixing ratio pure sulfate (kg/kg) + real(r8) :: mixso4mr(pcols,pver) !! Mixing ratio mix sulfate (kg/kg) + real(r8) :: bcmr(pcols,pver) !! Mixing ratio BC sulfate (kg/kg) + real(r8) :: dustmr(pcols,pver) !! Mixing ratio dust (kg/kg) + real(r8) :: ocmr(pcols,pver) !! Mixing ratio OC sulfate (kg/kg) + real(r8) :: saltmr(pcols,pver) !! Mixing ratio SALT sulfate (kg/kg) + real(r8) :: soamr(pcols,pver) !! Mixing ratio SOA sulfate (kg/kg) + character(len=16) :: shortname + + ! Default return code. + rc = RC_OK + + ! Provide diagnostics on the SOA tendencies that affect MXSOA. + do ibin = 1, NBIN + + write(binname, '(A, I2.2)') "MXSOA1", ibin + call pbuf_get_field(pbuf, ipbuf4soacm1(ibin), soacm1) + call outfld(trim(binname)//'CM', soacm1(:, :), pcols, state%lchnk) + call pbuf_get_field(pbuf, ipbuf4soapt1(ibin), soapt1) + call outfld(trim(binname)//'PT', soapt1(:, :), pcols, state%lchnk) + + write(binname, '(A, I2.2)') "MXSOA2", ibin + call pbuf_get_field(pbuf, ipbuf4soacm2(ibin), soacm2) + call outfld(trim(binname)//'CM', soacm2(:, :), pcols, state%lchnk) + call pbuf_get_field(pbuf, ipbuf4soapt2(ibin), soapt2) + call outfld(trim(binname)//'PT', soapt2(:, :), pcols, state%lchnk) + + write(binname, '(A, I2.2)') "MXSOA3", ibin + call pbuf_get_field(pbuf, ipbuf4soacm3(ibin), soacm3) + call outfld(trim(binname)//'CM', soacm3(:, :), pcols, state%lchnk) + call pbuf_get_field(pbuf, ipbuf4soapt3(ibin), soapt3) + call outfld(trim(binname)//'PT', soapt3(:, :), pcols, state%lchnk) + + write(binname, '(A, I2.2)') "MXSOA4", ibin + call pbuf_get_field(pbuf, ipbuf4soacm4(ibin), soacm4) + call outfld(trim(binname)//'CM', soacm4(:, :), pcols, state%lchnk) + call pbuf_get_field(pbuf, ipbuf4soapt4(ibin), soapt4) + call outfld(trim(binname)//'PT', soapt4(:, :), pcols, state%lchnk) + + write(binname, '(A, I2.2)') "MXSOA5", ibin + call pbuf_get_field(pbuf, ipbuf4soacm5(ibin), soacm5) + call outfld(trim(binname)//'CM', soacm5(:, :), pcols, state%lchnk) + call pbuf_get_field(pbuf, ipbuf4soapt5(ibin), soapt5) + call outfld(trim(binname)//'PT', soapt5(:, :), pcols, state%lchnk) + end do + + if (carma_do_budget_diags) then + ! Output the cloudborne SO4 burdens. + call CARMAMODEL_CalculateCloudborneDiagnostics(carma, state, pbuf, aerclddiag, rc) + call outfld("SO4PRCLDBD", aerclddiag(:,1), pcols, state%lchnk) + call outfld("SO4MXCLDBD", aerclddiag(:,2), pcols, state%lchnk) + call outfld("MXBCCLDBD", aerclddiag(:,3), pcols, state%lchnk) + call outfld("MXDUSTCLDBD", aerclddiag(:,4), pcols, state%lchnk) + call outfld("MXOCCLDBD", aerclddiag(:,5), pcols, state%lchnk) + call outfld("MXSALTCLDBD", aerclddiag(:,6), pcols, state%lchnk) + call outfld("MXSOA1CLDBD", aerclddiag(:,7), pcols, state%lchnk) + call outfld("MXSOA2CLDBD", aerclddiag(:,8), pcols, state%lchnk) + call outfld("MXSOA3CLDBD", aerclddiag(:,9), pcols, state%lchnk) + call outfld("MXSOA4CLDBD", aerclddiag(:,10), pcols, state%lchnk) + call outfld("MXSOA5CLDBD", aerclddiag(:,11), pcols, state%lchnk) + endif + + ! Output the interstitial SO4 burdens. + pureso4(:) = 0._r8 + mixso4(:) = 0._r8 + cprflux(:) = 0._r8 + cmxflux(:) = 0._r8 + h2so4(:) = 0._r8 + so2(:) = 0._r8 + bdbc(:) = 0._r8 + bddust(:) = 0._r8 + bdoc(:) = 0._r8 + bdsalt(:) = 0._r8 + bdsoa1(:) = 0._r8 + bdsoa2(:) = 0._r8 + bdsoa3(:) = 0._r8 + bdsoa4(:) = 0._r8 + bdsoa5(:) = 0._r8 + + ! Output the mixing ratio + pureso4mr(:,:) = 0._r8 + mixso4mr(:,:) = 0._r8 + bcmr(:,:) = 0._r8 + dustmr(:,:) = 0._r8 + ocmr(:,:) = 0._r8 + saltmr(:,:) = 0._r8 + soamr(:,:) = 0._r8 + + ! Add up the sulfate tendencies. + do icol = 1, state%ncol + + ! Get the air mass in the column + ! + ! NOTE convert GRAV from cm/s2 to m/s2. + mair(:) = state%pdel(icol,:) / (GRAV / 100._r8) + + do ibin = 1, nbin + + ! For PRSUL, is just the tendency for the concentration element. + call CARMAGROUP_Get(carma, I_GRP_PRSUL, rc, ienconc=ienconc) + icnst = icnst4elem(ienconc, ibin) + + pureso4mr(icol,:) = pureso4mr(icol,:) + state%q(icol,:,icnst) + pureso4(icol) = pureso4(icol) + sum(state%q(icol,:,icnst) * mair(:)) + + cprflux = cprflux + cam_in%cflx(icol,icnst) + + ! For MXAER, it is the difference in mass between the concentration element + ! and the sum of the core masses. + ! + ! NOTE: Since this is using the CAM state variables and not he CARMA state + ! variables the concentration element is just the mass of the sulfate. + call CARMAGROUP_Get(carma, I_GRP_MXAER, rc, ienconc=ienconc, ncore=ncore, icorelem=icorelem) + icnst = icnst4elem(ienconc, ibin) + + mixso4mr(icol,:) = mixso4mr(icol,:) + state%q(icol, :, icnst) + mixso4(icol) = mixso4(icol) + sum(state%q(icol, :, icnst) * mair(:)) + + cmxflux(icol) = cmxflux(icol) + cam_in%cflx(icol,icnst) + + do i = 1, ncore + icnst = icnst4elem(icorelem(i), ibin) + + call CARMAELEMENT_Get(carma, icorelem(i), rc, shortname=shortname) + if (shortname .eq. "MXBC") then + bcmr(icol,:) = bcmr(icol,:) + state%q(icol,:,icnst) + bdbc(icol) = bdbc(icol) + sum(state%q(icol,:,icnst) * mair(:)) + else if (shortname .eq. "MXDUST") then + dustmr(icol,:) = dustmr(icol,:) + state%q(icol,:,icnst) + bddust(icol) = bddust(icol) + sum(state%q(icol,:,icnst) * mair(:)) + else if (shortname .eq. "MXOC") then + ocmr(icol,:) = ocmr(icol,:) + state%q(icol,:,icnst) + bdoc(icol) = bdoc(icol) + sum(state%q(icol,:,icnst) * mair(:)) + else if (shortname .eq. "MXSALT") then + saltmr(icol,:) = saltmr(icol,:) + state%q(icol,:,icnst) + bdsalt(icol) = bdsalt(icol) + sum(state%q(icol,:,icnst) * mair(:)) + else if (shortname .eq. "MXSOA1") then + soamr(icol,:) = soamr(icol,:) + state%q(icol,:,icnst) + bdsoa1(icol) = bdsoa1(icol) + sum(state%q(icol,:,icnst) * mair(:)) + else if (shortname .eq. "MXSOA2") then + soamr(icol,:) = soamr(icol,:) + state%q(icol,:,icnst) + bdsoa2(icol) = bdsoa2(icol) + sum(state%q(icol,:,icnst) * mair(:)) + else if (shortname .eq. "MXSOA3") then + soamr(icol,:) = soamr(icol,:) + state%q(icol,:,icnst) + bdsoa3(icol) = bdsoa3(icol) + sum(state%q(icol,:,icnst) * mair(:)) + else if (shortname .eq. "MXSOA4") then + soamr(icol,:) = soamr(icol,:) + state%q(icol,:,icnst) + bdsoa4(icol) = bdsoa4(icol) + sum(state%q(icol,:,icnst) * mair(:)) + else if (shortname .eq. "MXSOA5") then + soamr(icol,:) = soamr(icol,:) + state%q(icol,:,icnst) + bdsoa5(icol) = bdsoa5(icol) + sum(state%q(icol,:,icnst) * mair(:)) + end if + + end do + end do + + ! Calculate the H2SO4 burden. + call cnst_get_ind("H2SO4", icnst) + h2so4(icol) = sum(state%q(icol,:,icnst) * mair(:)) + + ! Calculate the SO2 burden. + call cnst_get_ind("SO2", icnst) + so2(icol) = sum(state%q(icol,:,icnst) * mair(:)) + end do + + if (carma_do_budget_diags) then + ! Output the total aerosol and gas burdens and the aerosol fluxes. + call outfld("SO4PRBD", pureso4(:), pcols, state%lchnk) + call outfld("SO4MXBD", mixso4(:), pcols, state%lchnk) + call outfld("SO4PRSF", cprflux(:), pcols, state%lchnk) + call outfld("SO4MXSF", cmxflux(:), pcols, state%lchnk) + call outfld("H2SO4BD", h2so4(:), pcols, state%lchnk) + call outfld("SO2BD", so2(:), pcols, state%lchnk) + call outfld("MXBCBD", bdbc(:), pcols, state%lchnk) + call outfld("MXDUSTBD", bddust(:), pcols, state%lchnk) + call outfld("MXOCBD", bdoc(:), pcols, state%lchnk) + call outfld("MXSALTBD", bdsalt(:), pcols, state%lchnk) + call outfld("MXSOA1BD", bdsoa1(:), pcols, state%lchnk) + call outfld("MXSOA2BD", bdsoa2(:), pcols, state%lchnk) + call outfld("MXSOA3BD", bdsoa3(:), pcols, state%lchnk) + call outfld("MXSOA4BD", bdsoa4(:), pcols, state%lchnk) + call outfld("MXSOA5BD", bdsoa5(:), pcols, state%lchnk) + endif + + ! Output the total aerosol mixing ratio + call outfld("SO4PRMR", pureso4mr(:,:), pcols, state%lchnk) + call outfld("MXSO4MR", mixso4mr(:,:), pcols, state%lchnk) + call outfld("MXBCMR", bcmr(:,:), pcols, state%lchnk) + call outfld("MXDUSTMR", dustmr(:,:), pcols, state%lchnk) + call outfld("MXOCMR", ocmr(:,:), pcols, state%lchnk) + call outfld("MXSALTMR", saltmr(:,:), pcols, state%lchnk) + call outfld("MXSOAMR", soamr(:,:), pcols, state%lchnk) + + return + end subroutine CARMAMODEL_OutputDiagnostics + + + + !! Called after wet deposition has been performed. Allows the specific model to add + !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. + !! + !! @version July-2011 + !! @author Chuck Bardeen + subroutine CARMAMODEL_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) + use camsrfexch, only: cam_out_t + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ielem !! element index + integer, intent(in) :: ibin !! bin index + real(r8), intent(in) :: sflx(pcols) !! surface flux (kg/m2/s) + type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models + type(physics_state), intent(in) :: state !! physics state variables + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: icol + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_WetDeposition + + + !! Calculates the emissions for CARMA sea salt aerosol particles. + !! + !! @author Tianyi Fan, Chuck Bardeen, Pengfei Yu + !! @version Dec-2010 + !! originally calculate sea salt flux in EmitParticle, Pengfei Yu make + !! it a separate subroutine since multiple aerosol types need salt flux + !! e.g. sea salt, sea salt sulfate, marine organics + subroutine CARMAMODEL_SaltFlux(carma, ibin, state, r, dr, rmass, cam_in, SaltFlux, rc) + use ppgrid, only: pcols + use physics_types, only: physics_state + use camsrfexch, only: cam_in_t + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: ibin !! bin index + type(physics_state), intent(in) :: state !! physics state + real(r8), intent(in) :: r !! bin center (cm) + real(r8), intent(in) :: dr !! bin width (cm) + real(r8), intent(in) :: rmass !! bin mass (g) + type(cam_in_t), intent(in) :: cam_in !! surface inputs + real(r8), intent(out) :: SaltFlux(pcols) !! constituent surface flux (kg/m^2/s) + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: ncol ! number of columns in chunk + integer :: icol ! column index + + + ! -------- local variables added for sea salt model ------------ + real(r8) :: rdrycm, rdry ! dry radius [cm], [um] + real(r8) :: r80cm, r80 ! wet radius at relatige humidity of 80% [cm] + real(r8) :: ncflx ! dF/dr [#/m2/s/um] + real(r8) :: Monahan, Clarke, Smith ! dF/dr [#/m2/s/um] + real(r8) :: A_para, B_para, sita_para ! A, B, and sita parameters in Gong + real(r8) :: B_mona ! the parameter used in Monahan + real(r8) :: W_Caff ! Correction factor in Caffrey + real(r8) :: u14, ustar_smith, cd_smith ! 14m wind velocity, friction velocity, and drag coefficient as desired by Andreas source function + real(r8) :: wcap ! whitecap coverage + real(r8) :: fref ! correction factor suggested by Hoppe2005 + real(r8), parameter :: xkar = 0.4_r8 ! Von Karman constant + real(r8) :: u10in ! 10 meter wind speed use in the emission rate + + ! ------------------------------------------------------------------------------------------------ + ! -- Martensson source function. Coefficients for the parameterization of Ak(c4-c0) and Bk(d4-d0) + ! ------------------------------------------------------------------------------------------------- + real(r8), parameter :: c41 = -2.576e35_r8 + real(r8), parameter :: c42 = -2.452e33_r8 + real(r8), parameter :: c43 = 1.085e29_r8 + real(r8), parameter :: c31 = 5.932e28_r8 + real(r8), parameter :: c32 = 2.404e27_r8 + real(r8), parameter :: c33 = -9.841e23_r8 + real(r8), parameter :: c21 = -2.867e21_r8 + real(r8), parameter :: c22 = -8.148e20_r8 + real(r8), parameter :: c23 = 3.132e18_r8 + real(r8), parameter :: c11 = -3.003e13_r8 + real(r8), parameter :: c12 = 1.183e14_r8 + real(r8), parameter :: c13 = -4.165e12_r8 + real(r8), parameter :: c01 = -2.881e6_r8 + real(r8), parameter :: c02 = -6.743e6_r8 + real(r8), parameter :: c03 = 2.181e6_r8 + real(r8), parameter :: d41 = 7.188e37_r8 + real(r8), parameter :: d42 = 7.368e35_r8 + real(r8), parameter :: d43 = -2.859e31_r8 + real(r8), parameter :: d31 =-1.616e31_r8 + real(r8), parameter :: d32 =-7.310e29_r8 + real(r8), parameter :: d33 = 2.601e26_r8 + real(r8), parameter :: d21 = 6.791e23_r8 + real(r8), parameter :: d22 = 2.528e23_r8 + real(r8), parameter :: d23 =-8.297e20_r8 + real(r8), parameter :: d11 = 1.829e16_r8 + real(r8), parameter :: d12 =-3.787e16_r8 + real(r8), parameter :: d13 = 1.105e15_r8 + real(r8), parameter :: d01 = 7.609e8_r8 + real(r8), parameter :: d02 = 2.279e9_r8 + real(r8), parameter :: d03 =-5.800e8_r8 + + ! ------------------------------------------------------------ + ! ---- Clarke Source Function. Coefficients for Ai ------- + ! ------------------------------------------------------------ + real(r8), parameter :: beta01 =-5.001e3_r8 + real(r8), parameter :: beta11 = 0.808e6_r8 + real(r8), parameter :: beta21 =-1.980e7_r8 + real(r8), parameter :: beta31 = 2.188e8_r8 + real(r8), parameter :: beta41 =-1.144e9_r8 + real(r8), parameter :: beta51 = 2.290e9_r8 + real(r8), parameter :: beta02 = 3.854e3_r8 + real(r8), parameter :: beta12 = 1.168e4_r8 + real(r8), parameter :: beta22 =-6.572e4_r8 + real(r8), parameter :: beta32 = 1.003e5_r8 + real(r8), parameter :: beta42 =-6.407e4_r8 + real(r8), parameter :: beta52 = 1.493e4_r8 + real(r8), parameter :: beta03 = 4.498e2_r8 + real(r8), parameter :: beta13 = 0.839e3_r8 + real(r8), parameter :: beta23 =-5.394e2_r8 + real(r8), parameter :: beta33 = 1.218e2_r8 + real(r8), parameter :: beta43 =-1.213e1_r8 + real(r8), parameter :: beta53 = 4.514e-1_r8 + + ! --------------------------------------------- + ! coefficient A1, A2 in Andreas's Source funcion + ! --------------------------------------------- + real(r8) ::A1A92 + real(r8) ::A2A92 + + ! --------------------------------------------- + ! coefficient in Smith's Source funcion + ! --------------------------------------------- + real(r8), parameter :: f1 = 3.1_r8 + real(r8), parameter :: f2 = 3.3_r8 + real(r8), parameter :: r1 = 2.1_r8 + real(r8), parameter :: r2 = 9.2_r8 + real(r8), parameter :: delta = 10._r8 + + ! -------------------------------------------------------------------- + ! ---- constants in calculating the particle wet radius [Gerber, 1985] + ! -------------------------------------------------------------------- + real(r8), parameter :: c1 = 0.7674_r8 ! . + real(r8), parameter :: c2 = 3.079_r8 ! . + real(r8), parameter :: c3 = 2.573e-11_r8 ! . + real(r8), parameter :: c4 = -1.424_r8 ! constants in calculating the particle wet radius + + ! Default return code. + rc = RC_OK + + ncol = state%ncol + + ! Add any surface flux here. + SaltFlux(:ncol) = 0.0_r8 + + ! Are we configured for one of the known emission schemes? + if( carma_seasalt_emis .ne. "Gong" .and. & + carma_seasalt_emis .ne. "Martensson" .and. & + carma_seasalt_emis .ne. "Clarke" .and. & + carma_seasalt_emis .ne. "Andreas" .and. & + carma_seasalt_emis .ne. "Caffrey" .and. & + carma_seasalt_emis .ne. "CMS" .and. & + carma_seasalt_emis .ne. "NONE" .and. & + carma_seasalt_emis .ne. "CONST" ) then + + call endrun('carma_EmitParticle:: Invalid sea salt emission scheme.') + end if + + !********************************** + ! wet sea salt radius at RH = 80% + !********************************** + r80cm = (c1 * (r) ** c2 / (c3 * r ** c4 - log10(0.8_r8)) + (r)**3) ** (1._r8/3._r8) ! [cm] + rdrycm = r ! [cm] + r80 = r80cm *1.e4_r8 ! [um] + rdry = rdrycm*1.e4_r8 ! [um] + + do icol = 1,ncol + + ! Only generate sea salt over the ocean. + if (cam_in%ocnfrac(icol) > 0._r8) then + + !********************************** + ! WIND for seasalt production + !********************************** + call CARMAMODEL_SurfaceWind_salt(icol, cam_in, u10in, rc) + + ! Add any surface flux here. + ncflx = 0.0_r8 + Monahan = 0.0_r8 + Clarke = 0.0_r8 + Smith = 0.0_r8 + + !********************************** + ! Whitecap Coverage + !********************************** + wcap = 3.84e-6_r8 * u10in ** 3.41_r8 ! in percent, ie., 75%, wcap = 0.75 + + !**************************************** + ! Hoppel correction factor + ! Smith drag coefficients and etc + !**************************************** + if (u10in .le. 10._r8) then + cd_smith = 1.14e-3_r8 + else + cd_smith = (0.49_r8 + 0.065_r8 * u10in) * 1.e-3_r8 + end if + + ! ustar_smith = cd_smith **0.5_r8 * u10in + ! + ! We don't have vg yet, since that is calculated by CARMA. That will require + ! a different interface for the emissions, storing vg in the physics buffer, + ! and/or doing some duplicate calculations for vg assuming 80% RH. + ! fref = (delta/state%zm(icol, pver))**(vg(icol, ibin, igelem(i))/(xkar*ustar_smith)) + fref = 1.0_r8 + + !********************************** + ! Source Functions + !********************************** + if (carma_seasalt_emis .eq. 'NONE') then + ncflx = 0._r8 + end if + + if (carma_seasalt_emis .eq. 'CONST') then + ncflx = 1.e-5_r8 + end if + + !-------Gong source function------ + if (carma_seasalt_emis == "Gong") then + sita_para = 30 + A_para = - 4.7_r8 * (1+ sita_para * r80) ** (- 0.017_r8 * r80** (-1.44_r8)) + B_para = (0.433_r8 - log10(r80)) / 0.433_r8 + ncflx = 1.373_r8* u10in ** 3.41_r8 * r80 ** A_para * (1._r8 + 0.057_r8 * r80**3.45_r8) * 10._r8 ** (1.607_r8 * exp(- B_para **2)) + ! if (do_print) write(LUNOPRT, *) "Gong: ncflx = ", ncflx, ", u10n = ", u10in + end if + + !------Martensson source function----- + if (carma_seasalt_emis == "Martensson") then + if (rdry .le. 0.0725_r8) then + ncflx = (Ak1(rdry*1.0e-6_r8)* (25._r8+273._r8) + Bk1(rdry*1.0e-6_r8)) * wcap ! dF/dlogr [#/s/m2] + ncflx = ncflx / (2.30258509_r8 * rdry) ! dF/dr [#/s/m2/um] + elseif (rdry .gt. 0.0725_r8 .and. rdry .le. 0.2095_r8) then + ncflx = (Ak2(rdry*1.0e-6_r8)* (25._r8+273._r8) + Bk2(rdry*1.0e-6_r8)) * wcap ! dF/dlogr [#/s/m2] + ncflx = ncflx / (2.30258509_r8 * rdry) ! dF/dr [#/s/m2/um] + elseif (rdry .gt. 0.2095_r8 .and. rdry .le. 1.4_r8) then + ncflx = (Ak3(rdry*1.0e-6_r8)* (25._r8+273._r8) + Bk3(rdry*1.0e-6_r8)) * wcap ! dF/dlogr [#/s/m2] + ncflx = ncflx / (2.30258509_r8 * rdry) ! dF/dr [#/s/m2/um] + else + ncflx = 0._r8 + end if + end if + + !-------Clarke source function------- + if (carma_seasalt_emis == "Clarke")then + if (rdry .lt. 0.066_r8) then + ncflx = A1(rdry) * 1.e4_r8 * wcap ! dF/dlogr [#/s/m2] + ncflx = ncflx / (2.30258509_r8 * rdry) ! dF/dr [#/s/m2/um] + elseif (rdry .ge. 0.066_r8 .and. rdry .lt. 0.6_r8) then + ncflx = A2(rdry) * 1.e4_r8 * wcap ! dF/dlogr [#/s/m2] + ncflx = ncflx / (2.30258509_r8 * rdry) ! dF/dr [#/s/m2/um] + elseif (rdry .ge. 0.6_r8 .and. rdry .lt. 4.0_r8) then + ncflx = A3(rdry) * 1.e4_r8 * wcap ! dF/dlogr [#/s/m2] + ncflx= ncflx / (2.30258509_r8 * rdry) ! dF/dr [#/s/m2/um] + else + ncflx = 0._r8 + end if + end if + + !-----------Caffrey source function------------ + if (carma_seasalt_emis == "Caffrey") then + + !Monahan + B_mona = (0.38_r8 - log10(r80)) / 0.65_r8 + Monahan = 1.373_r8 * (u10in**3.41_r8) * r80**(-3._r8) * (1._r8 + 0.057_r8 *r80**1.05_r8) * 10._r8 ** (1.19_r8 * exp(-1._r8 * B_mona**2)) ! dF/dr + + !Smith + u14 = u10in * (1._r8 + cd_smith**0.5_r8 / xkar * log(14._r8 / 10._r8)) ! 14 meter wind + A1A92 = 10._r8 ** (0.0676_r8 * u14 + 2.430_r8) + A2A92 = 10._r8 ** (0.9590_r8 * u14**0.5_r8 - 1.476_r8) + Smith = A1A92*exp(-f1 *(log(r80/r1))**2) + A2A92*exp(-f2 * (log(r80/r2))**2) ! dF/dr [#/m2/s/um] + + !Caffrey based on Monahan and Smith + W_Caff = 1.136_r8 **(-1._r8 * rdry ** (-0.855_r8))*(1._r8 + 0.2_r8/rdry) + if (rdry .lt. 0.15_r8) then + ncflx = Monahan + else + if (u10in .le. 9._r8) then + ncflx = Monahan + else + if(Monahan .ge. Smith) then + ncflx = Monahan + else + ncflx = Smith + end if + end if + end if + + ncflx = ncflx * W_Caff + + !%%%%%%%%%%%%%%%%%%%%%%%%% + ! Apply Hoppel correction + !%%%%%%%%%%%%%%%%%%%%%%%%% + ncflx = ncflx * fref + end if + + !--------CMS (Clarke, Monahan, and Smith source function)------- + if (carma_seasalt_emis == "CMS") then + + !Clarke + if (rdry .lt. 0.066_r8) then + Clarke = A1(rdry) * 1.e4_r8 * wcap ! dF/dlogr [#/s/m2] + Clarke = Clarke / (2.30258509_r8 * rdry) ! dF/dr [#/s/m2/um] + elseif ((rdry .ge. 0.066_r8) .and. (rdry .lt. 0.6_r8)) then + Clarke = A2(rdry) * 1.e4_r8 * wcap ! dF/dlogr [#/s/m2] + Clarke = Clarke / (2.30258509_r8 * rdry) ! dF/dr [#/s/m2/um] + elseif ((rdry .ge. 0.6_r8) .and. (rdry .lt. 4.0_r8)) then + Clarke = A3(rdry) * 1.e4_r8 * wcap ! dF/dlogr [#/s/m2] + Clarke= Clarke / (2.30258509_r8 * rdry) ! dF/dr [#/s/m2/um] + end if + + !Monahan + B_Mona = (0.38_r8 - log10(r80)) / 0.65_r8 + Monahan = 1.373_r8 * u10in ** 3.41_r8 * r80 ** (-3._r8) * (1._r8 + 0.057_r8 * r80**1.05_r8) * 10._r8 ** (1.19_r8 * exp(- B_Mona **2)) + + !Smith + u14 = u10in * (1._r8 + cd_smith**0.5_r8 / xkar*log(14._r8 / 10._r8)) ! 14 meter wind + A1A92 = 10._r8 ** (0.0676_r8 * u14 + 2.430_r8) + A2A92 = 10._r8 ** (0.9590_r8 * u14**0.5_r8 - 1.476_r8) + Smith = A1A92*exp(-f1 *(log(r80 / r1))**2) + A2A92*exp(-f2 * (log(r80 / r2))**2) ! dF/dr [#/m2/s/um] + + !%%%%%%%%%%%%%%%%%%%%%%%%% + ! CMS1 or CMS2 + !%%%%%%%%%%%%%%%%%%%%%%%%% + ! if (rdry .lt. 0.1_r8) then ! originally cut at 0.1 um + ! ***CMS1***** + if (rdry .lt. 1._r8) then ! cut at 1.0 um + ! ***CMS2***** + ! if (rdry .lt. 2._r8) then ! cut at 2.0 um + ncflx = Clarke + else + if (u10in .lt. 9._r8) then + ncflx = Monahan + else + if (Monahan .gt. Smith) then + ncflx = Monahan + else + ncflx = Smith + end if + end if + end if + + !%%%%%%%%%%%%%%%%%%%%%%%%% + ! Apply Hoppel correction + !%%%%%%%%%%%%%%%%%%%%%%%%% + ncflx = ncflx * fref + end if + + ! convert ncflx [#/m^2/s/um] to surfaceFlx [kg/m^2/s] + SaltFlux(icol) = ncflx * dr * rmass * 10._r8 ! *1e4[um/cm] * 1.e-3[kg/g] + + ! if (do_print) write(LUNOPRT, *) "ibin = ", ibin, ", igroup = ", igroup + ! if (do_print) write(LUNOPRT, *) "dr = ", dr, ", rmass = ", rmass + ! if (do_print) write(LUNOPRT, *) "ncflx = " , ncflx, ", SaltFlux = ", SaltFlux(icol) + + ! weighted by the ocean fraction + SaltFlux(icol) = SaltFlux(icol) * cam_in%ocnfrac(icol) + end if + end do + + contains + + ! Coefficient Ak in Martensson's source functions + pure real(r8) function Ak1(rpdry) + real(r8),intent(in) :: rpdry + Ak1 = c41*(2._r8*rpdry)**4 + c31*(2._r8*rpdry) ** 3 + c21*(2._r8*rpdry)**2 + c11*(2._r8*rpdry)+ c01 + end function Ak1 + + pure real(r8) function Ak2(rpdry) + real(r8),intent(in) :: rpdry + Ak2 = c42*(2._r8*rpdry)**4 + c32*(2._r8*rpdry) ** 3 + c22*(2._r8*rpdry)**2 + c12*(2._r8*rpdry)+ c02 + end function Ak2 + + pure real(r8) function Ak3(rpdry) + real(r8),intent(in) :: rpdry + Ak3 = c43*(2._r8*rpdry)**4 + c33*(2._r8*rpdry) ** 3 + c23*(2._r8*rpdry)**2 + c13*(2._r8*rpdry)+ c03 + end function Ak3 + + ! Coefficient Bk in Martensson's source functions + pure real(r8) function Bk1(rpdry) + real(r8),intent(in) :: rpdry + Bk1= d41*(2._r8*rpdry)**4 + d31*(2._r8*rpdry) ** 3 + d21*(2._r8*rpdry)**2 + d11*(2._r8*rpdry)+ d01 + end function Bk1 + + pure real(r8) function Bk2(rpdry) + real(r8),intent(in) :: rpdry + Bk2 = d42*(2._r8*rpdry)**4 + d32*(2._r8*rpdry) ** 3 + d22*(2._r8*rpdry)**2 + d12*(2._r8*rpdry)+ d02 + end function Bk2 + + pure real(r8) function Bk3(rpdry) + real(r8),intent(in) :: rpdry + Bk3 = d43*(2._r8*rpdry)**4 + d33*(2._r8*rpdry) ** 3 + d23*(2._r8*rpdry)**2 + d13*(2._r8*rpdry)+ d03 + end function Bk3 + + ! Coefficient Ak in Clarkes's source function + pure real(r8) function A1(rpdry) + real(r8),intent(in) :: rpdry + A1 = beta01 + beta11*(2._r8*rpdry) + beta21*(2._r8*rpdry)**2 + beta31*(2._r8*rpdry)**3 & + + beta41*(2._r8*rpdry)**4 + beta51*(2._r8*rpdry)**5 + end function A1 + + pure real(r8) function A2(rpdry) + real(r8),intent(in) :: rpdry + A2 = beta02 + beta12*(2._r8*rpdry) + beta22*(2._r8*rpdry)**2 + beta32*(2._r8*rpdry)**3 & + + beta42*(2._r8*rpdry)**4 + beta52*(2._r8*rpdry)**5 + end function A2 + + pure real(r8) function A3(rpdry) + real(r8),intent(in) :: rpdry + A3 = beta03 + beta13*(2._r8*rpdry) + beta23*(2._r8*rpdry)**2 + beta33*(2._r8*rpdry)**3 & + + beta43*(2._r8*rpdry)**4 + beta53*(2._r8*rpdry)**5 + end function A3 + + end subroutine CARMAMODEL_SaltFlux + + + !! Calculate the sea surface wind with a Weibull distribution. + !! + !! @author Tianyi Fan + !! @version August-2010 + subroutine CARMAMODEL_SurfaceWind_salt(icol, cam_in, u10in, rc) + use camsrfexch, only: cam_in_t + + ! in and out field + integer, intent(in) :: icol !! column index + type(cam_in_t), intent(in) :: cam_in !! surface inputs + real(r8), intent(out) :: u10in !! the 10m wind speed put into the source function + integer, intent(out) :: rc !! return code, negative indicates failure + + ! local variables + real(r8) :: uWB341 ! the nth mean wind with integration using Weibull Distribution(integrate from threshold wind velocity) + + rc = RC_OK + + uWB341 = 0._r8 + + ! calc. the Weibull wind distribution + u10in = cam_in%u10(icol) + + call CARMAMODEL_WeibullWind(u10in, uth_salt, 3.41_r8, uWB341) + + u10in = uWB341 ** (1._r8 / 3.41_r8) + +! if (do_print) write(LUNOPRT, *) 'CARMA_SurfaceWind: icol ',icol, ', u10 =', cam_in%u10(icol), ', u10in =', u10in + + return + end subroutine CARMAMODEL_SurfaceWind_salt + + + + !! Determines the mass fraction for the clay (submicron) bins based upon + !! Tegen and Lacis [1996]. The total fraction for all clay bins should + !! add up to 1. + !! + !! NOTE: WOuld it be better to interpolate this into the bins rather than + !! assigning all CARMA bins within a Tegen & Lacis bin the same value? + !! + !! NOTE: Should any mass go to bins smaller than the smallest one used by + !! Tegen and Lacis? + !! + !! @version July-2012 + !! @author Lin Su, Pengfei Yu, Chuck Bardeen + subroutine CARMAMODEL_ClayMassFraction(carma, igroup, rdust, rc) + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: igroup !! the carma group index + real(r8), intent(in) :: rdust(NBIN) !! radius assuming entire particle is dust + integer, intent(inout) :: rc !! return code, negative indicates failure + + ! Bins and mass fraction from Tegen and Lacis. + integer, parameter :: NBIN_TEGEN = 4 + real(r8) :: tl_rmin(NBIN_TEGEN) = (/ 1.e-5_r8, 1.8e-5_r8, 3.e-5_r8, 6.e-5_r8 /) + real(r8) :: tl_rmax(NBIN_TEGEN) = (/ 1.8e-5_r8, 3.e-5_r8, 6.e-5_r8, 1.e-4_r8 /) + real(r8) :: tl_mf(NBIN_TEGEN) = (/ 0.009_r8, 0.081_r8, 0.234_r8, 0.676_r8 /) + + ! Local Variables + integer, parameter :: IBELOW = 1 + integer, parameter :: IABOVE = 6 + integer :: tl_count(NBIN_TEGEN+2) ! count number in Tegen and Lacis ranges + integer :: ind_up(NBIN_TEGEN+2) + integer :: ind_low(NBIN_TEGEN+2) + integer :: j ! local index number + integer :: ibin ! carma bin index + + ! Default return code. + rc = RC_OK + + ! Figure out how many of the CARMA bins are in each of the Tegen and Lacis + ! ranges. + tl_count(:) = 0 + + do ibin = 1, NBIN + + ! Smaller than the range. + if (rdust(ibin) < tl_rmin(1)) then + tl_count(IBELOW) = tl_count(IBELOW) + 1 + end if + + ! In the range + do j = 1, NBIN_TEGEN + if (rdust(ibin) < tl_rmax(j) .and. rdust(ibin) >= tl_rmin(j)) then + tl_count(j+1) = tl_count(j+1) + 1 + end if + end do + + ! Bigger than the range. + if (rdust(ibin) >= tl_rmax(NBIN_TEGEN)) then + tl_count(IABOVE) = tl_count(IABOVE) + 1 + end if + end do + + ! Determine where the boundaries are between the TEGEN bins and + ! the CARMA bin structure. + ind_up(:) = 0 + ind_low(:) = 0 + ind_up (IBELOW) = tl_count(IBELOW) + ind_low(IBELOW) = min(1, tl_count(IBELOW)) + + do j = 1, 5 + ind_up (j+1) = ind_up(j) + tl_count(j+1) + ind_low(j+1) = ind_up(j) + min(tl_count(j+1), 1) + end do + + ! No mass to bins smaller than the smallest size. + clay_mf(:) = 0._r8 + + ! NOTE: This won't work right if the dust bins are coarser than + ! the Tegen and Lacis bins. In this case mass fraction would need + ! to be combined from the Tegen & Lacis bins into a CARMA bin. + do j = 1, NBIN_TEGEN + if (tl_count(j+1) > 0) then + clay_mf(ind_low(j+1):ind_up(j+1)) = tl_mf(j) / tl_count(j+1) + end if + end do + + clay_mf(ind_low(IABOVE):) = 1._r8 + + return + end subroutine CARMAMODEL_ClayMassFraction + + + !! Calculate the sea surface wind with a Weibull distribution. + !! + !! NOTE: This should be combined with a similar routine in the sea salt + !! model, and any differences should be control by parameters into this + !! routine (and perhaps namelist variables). + !! + !! @author Lin Su, Pengfei Yu, Chuck Bardeen + !! @version July-2012 + subroutine CARMAMODEL_SurfaceWind(carma, icol, ielem, igroup, ibin, cam_in, uv10, wwd, uth, rc) + use camsrfexch, only: cam_in_t + + ! in and out field + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icol !! column index + integer, intent(in) :: ielem !! element index + integer, intent(in) :: igroup !! group index + integer, intent(in) :: ibin !! bin index + type(cam_in_t), intent(in) :: cam_in !! surface inputs + real(r8), intent(out) :: uv10 !! the 10m wind speed (m/s) + real(r8), intent(out) :: wwd !! the 10m wind speed with Weibull applied (m/s) + real(r8), intent(out) :: uth !! the 10m wind threshold (m/s) + integer, intent(inout) :: rc !! return code, negative indicates failure + + real(r8), parameter :: vk = 0.4_r8 ! von Karman constant + real(r8) :: rmass(NBIN) ! CARMA bin mass (g) + real(r8) :: r ! CARMA bin center (cm) + real(r8) :: rhop(NBIN) ! CARMA partile element density (g/cm3) + real(r8) :: uthfact ! + real(r8), parameter :: rhoa = 1.25e-3_r8 ! Air density at surface + + rc = RC_OK + + ! Get the 10 meter wind speed + uv10 = cam_in%u10(icol) + + ! Calculate the threshold wind speed of each bin [Marticorena and Bergametti,1995] + ! note that in cgs units --> m/s + call CARMAGROUP_GET(carma, igroup, rc, rmass=rmass) + if (RC < RC_ERROR) return + + ! Define particle # concentration element index for current group + call CARMAELEMENT_Get(carma, ielem, rc, rho=rhop) + if (RC < RC_ERROR) return + + ! Calculate the radius assuming that all the mass will be emitted as this + ! element. + r = (3._r8 * rmass(ibin) / 4._r8 / PI / rhop(ibin))**(1._r8 / 3._r8) + + if (cam_in%soilw(icol) >= 0._r8 .AND. cam_in%soilw(icol) < 0.5_r8) then + + ! Prevent small values of soilw from driving uthfact negative, but allow + ! for dust emissions even when soilw is 0. + uthfact = 1.2_r8 + 0.2_r8*log10(max(0.001_r8, cam_in%soilw(icol))) + + if (r > 2.825e-5_r8) then ! r(4) = 2.825e-5 cm + uth = uthfact * 1.e-2_r8 * 0.13_r8 * sqrt(rhop(ibin)*GRAV*r*2._r8/rhoa) & + * sqrt(1._r8 + .006_r8/rhop(ibin)/GRAV/(r*2._r8)**2.5_r8) & + / sqrt(1.928_r8*(1331._r8*(r*2._r8)**1.56_r8 + .38_r8)**.092_r8 - 1._r8) + else + uth = uthfact*1.e-2_r8* 0.13_r8 * sqrt(rhop(ibin)*GRAV*(.75e-4_r8)*2._r8/rhoa) & + * sqrt(1._r8 + .006_r8/rhop(ibin)/GRAV/((.75e-4_r8)*2._r8)**2.5_r8) & + / sqrt(1.928_r8*(1331._r8*((.75e-4_r8)*2._r8)**1.56_r8 + .38_r8)**.092_r8 - 1._r8) + endif + else + uth = uv10 + endif + + ! Use Weibull with Lansing's estimate for shape. + call CARMAMODEL_WeibullWind(uv10, uth, 2._r8, wwd) + + ! Set the threshold to the weibull wind value if sol moisture >= 0.5, + ! to turn off emissions. + if (cam_in%soilw(icol) >= 0.5_r8) then + uth = sqrt(wwd) + end if + + return + end subroutine CARMAMODEL_SurfaceWind + + + !! Read in the dust source (soil) erodibility factor from a NETCDF file. In this + !! processes, the data is regridded from the source size to the size needed by the + !! model. + !! + !! NOTE: This is currently doing 2-D interpolation, but it really should be doing + !! regridding. + !! + !! @author Pengfei Yu + !! @version July-2012 + +!! st +!! could use /components/cam/src/chemistry/aerosol/soil_erod_mod.F90 here insted of this routine? + subroutine CARMAMODEL_ReadSoilErosionFactor(rc) + use ppgrid, only: begchunk, endchunk, pcols + use ioFileMod, only: getfil + use interpolate_data, only: lininterp_init, lininterp, interp_type, lininterp_finish + use phys_grid, only: get_rlon_all_p, get_rlat_all_p, get_ncols_p + use wrap_nf + + integer, intent(out) :: rc !! return code, negative indicates failure + + ! local variables + integer :: idvar, f_nlon, f_nlat, idlat, idlon + integer :: fid, fid_lon, fid_lat + real(r8), allocatable, dimension(:,:) :: ero_factor + character(len=256) :: ero_file + real(r8), allocatable, dimension(:) :: ero_lat ! latitude dimension + real(r8), allocatable, dimension(:) :: ero_lon ! latitude dimension + type (interp_type) :: lat_wght, lon_wght + real(r8) :: lat(pcols) ! latitude index + real(r8) :: lon(pcols) ! longitude index + integer :: i + integer :: lchnk ! chunk identifier + integer :: ncol ! number of columns in chunk + + real(r8), parameter :: zero=0_r8, twopi=2_r8*pi, degs2rads = pi/180._r8 + + rc = RC_OK + + ! Open the netcdf file (read only) + call getfil(carma_soilerosion_file, ero_file, 0) + call wrap_open(ero_file, 0, fid) + + ! Get file dimensions + call wrap_inq_dimid(fid, 'plon', fid_lon) + call wrap_inq_dimid(fid, 'plat', fid_lat) + call wrap_inq_dimlen(fid, fid_lon, f_nlon) + call wrap_inq_dimlen(fid, fid_lat, f_nlat) + + allocate(ero_lat(f_nlat)) + allocate(ero_lon(f_nlon)) + allocate(ero_factor (f_nlon, f_nlat)) + allocate(soil_factor(pcols, begchunk:endchunk)) + + ! Read in the tables. + call wrap_inq_varid(fid, 'new_source', idvar) + i = nf90_get_var (fid, idvar, ero_factor) + if (i/=NF90_NOERR) then + write(iulog,*)'CARMA_ReadSoilErosionFactor: error reading varid =', idvar + call handle_error (i) + end if + call wrap_inq_varid(fid, 'plat', idlat) + call wrap_get_var_realx(fid, idlat, ero_lat) + call wrap_inq_varid(fid, 'plon', idlon) + call wrap_get_var_realx(fid, idlon, ero_lon) + + ero_lat(:) = ero_lat(:)*degs2rads + ero_lon(:) = ero_lon(:)*degs2rads + + ! Close the file. + call wrap_close(fid) + + do lchnk=begchunk, endchunk + ncol = get_ncols_p(lchnk) + + call get_rlat_all_p(lchnk, pcols, lat) + call get_rlon_all_p(lchnk, pcols, lon) + + call lininterp_init(ero_lon, f_nlon, lon, ncol, 2, lon_wght, zero, twopi) + call lininterp_init(ero_lat, f_nlat, lat, ncol, 1, lat_wght) + + call lininterp(ero_factor, f_nlon, f_nlat, soil_factor(1:ncol,lchnk), ncol, lon_wght, lat_wght) + + call lininterp_finish(lon_wght) + call lininterp_finish(lat_wght) + end do + + deallocate(ero_lat) + deallocate(ero_lon) + deallocate(ero_factor) + + end subroutine CARMAMODEL_ReadSoilErosionFactor + + !! Calculate the nth mean of u using Weibull wind distribution + !! considering the threshold wind velocity. This algorithm + !! integrates from uth to infinite (u^n P(u)du ) + !! + !! @author Tianyi Fan + !! @version August-2010 + subroutine CARMAMODEL_WeibullWind(u, uth, n, uwb, wbk) + use shr_spfn_mod, only: gamma => shr_spfn_gamma, igamma => shr_spfn_igamma + + real(r8), intent(in) :: u ! mean wind speed + real(r8), intent(in) :: uth ! threshold velocity + real(r8), intent(in) :: n ! the rank of u in the integration + real(r8), intent(out) :: uwb ! the Weibull distribution + real(r8), intent(in), optional :: wbk ! the shape parameter + + ! local variable + real(r8) :: k ! the shape parameter in Weibull distribution + real(r8) :: c ! the scale parameter in Weibull distribution + + if (present(wbk)) then + k = wbk + else + k = 0.94_r8*u**0.5_r8 ! follow Grini and Zender, 2004JGR + ! k = 2.5_r8 ! Lansing's estimate + end if + + ! If u is 0, then k can be 0, which makes a lot of this undefined. + ! Just return 0. in this case. + if (u < 0.35_r8) then + uwb = 0._r8 + else + c = u * (gamma(1._r8 + 1._r8 / k))**(-1._r8) + uwb = c**n * igamma(n / k + 1._r8, (uth / c)**k) + end if + + end subroutine CARMAMODEL_WeibullWind + + !! Read BC data from three components: + !! 1. GAINS anthropogenic; 2. Ship Emission; 3. GFEDv3; 4. Aircraft + !! GAINS unit: kt/year; 2D; lon:-180-180 + !! Ship Emission unit: kg/m2/s; 3D (month,lat,lon); lon:0-360 + !! GFEDv3 unit: g/m2/month; 3D (month,lat,lon); lon:-180-180 + !! + !! @author Pengfei Yu + !! @version May-2013 + subroutine CARMAMODEL_BCOCRead(rc) + use pmgrid, only: plat, plon + use ioFileMod, only: getfil + use cam_pio_utils, only: cam_pio_openfile + use interpolate_data, only : lininterp_init, lininterp, interp_type, lininterp_finish + use pio, only : file_desc_t, var_desc_t, & + pio_inq_dimid, pio_inq_varid, & + pio_get_var, pio_nowrite, pio_inq_dimlen, & + pio_inq_dimlen, pio_closefile + use dycore, only: dycore_is + + integer, intent(out) :: rc !! return code, negative indicates failure + + ! local variables + integer :: f_nlon, f_nlat, f_ntime + integer :: fid_lon, fid_lat, fid_time + real(r8), allocatable, dimension(:,:) :: BC_f2d, BC2d, OC_f2d, OC2d + real(r8), allocatable, dimension(:,:,:) :: BC_f3d, BC3d, OC_f3d, OC3d +! + character(len=256) :: BC_GAINS_file + character(len=256) :: OC_GAINS_file + character(len=256) :: BC_GFEDv3_file + character(len=256) :: OC_GFEDv3_file + character(len=256) :: BC_ship_file + character(len=256) :: OC_ship_file +! + real(r8), allocatable, dimension(:,:,:) :: BC_anthro_GAINS + real(r8), allocatable, dimension(:,:,:) :: OC_anthro_GAINS + real(r8), allocatable, dimension(:,:,:) :: BC_GFEDv3 + real(r8), allocatable, dimension(:,:,:) :: OC_GFEDv3 + real(r8), allocatable, dimension(:,:,:) :: BC_ship_GAINS + real(r8), allocatable, dimension(:,:,:) :: OC_ship_GAINS +! + real(r8), allocatable, dimension(:) :: BC_lat, OC_lat ! latitude dimension + real(r8), allocatable, dimension(:) :: BC_lon, OC_lon ! latitude dimension + type (interp_type) :: wgt1, wgt2 + real(r8) :: lat(plat), lon(plon) + integer :: i, itime + real(r8) :: rearth, gridarea + integer :: nmonth + real(r8) :: tempor(plon,plat) + real(r8), allocatable, dimension(:,:,:) :: tempor3d + real(r8), allocatable, dimension(:,:) :: tempor2d + real(r8), allocatable, dimension(:) :: tempor1d + integer :: mid_idx + real(r8), allocatable, dimension(:,:) :: BC_dom_f2d, OC_dom_f2d + real(r8), allocatable, dimension(:,:,:) :: BC_dom_f3d, OC_dom_f3d + real(r8), allocatable, dimension(:,:,:) :: BC_awb_f3d, OC_awb_f3d + real(r8), allocatable, dimension(:,:) :: BC2d_dom, OC2d_dom + real(r8), allocatable, dimension(:) :: facH, facL + integer :: ind_15N, ind_45N, ierr + type(file_desc_t) :: fid + type(var_desc_t) :: idvar, idlat, idlon, idvar_dom, idvar_awb + + real(r8) :: nlats + + rc = RC_OK + + if(dycore_is('UNSTRUCTURED') ) then + call endrun('CARMAMODEL_BCOCRead: Yu2015 emissions not implemented for unstructured grids' ) + end if + + ! get model lat and lon + nlats = plat-1 ! gnu compiler workaround + do i = 1, plat + lat(i) = 180._r8/(nlats)*(i-1)-90._r8 + end do + do i = 1, plon + lon(i) = 360._r8/plon*(i-1) + end do + +! + nmonth = 12 + + if(carma_BCOCemissions == 'Yu2015')then + ! allocate BCnew and OCnew, unit is #/cm2/s + allocate(BCnew(plat, plon, nmonth)) + allocate(OCnew(plat, plon, nmonth)) + BCnew = -huge(1._r8) + OCnew = -huge(1._r8) + endif + +! monthly fraction of domestic emission + allocate(facH(nmonth)) + allocate(facL(nmonth)) + facH = (/0.18_r8,0.14_r8,0.13_r8,0.08_r8,0.04_r8,0.02_r8,0.01_r8,& + 0.02_r8,0.03_r8,0.07_r8,0.11_r8,0.17_r8/) + facL = (/0.17_r8,0.14_r8,0.11_r8,0.06_r8,0.04_r8,0.04_r8,0.04_r8,& + 0.04_r8,0.04_r8,0.06_r8,0.10_r8,0.15_r8/) + +! find index for 15N and 45N + do i = 1, plat + if (lat(i) .gt. 15._r8) then + ind_15N = i + exit + endif + end do +! + do i = 1, plat + if (lat(i) .gt. 45._r8) then + ind_45N = i + exit + endif + end do + + ! Part 1a: BC anthropogenic from GAINS + ! ------------------------------------------------- + ! Open the netcdf file (read only) + call getfil(BC_GAINS_filename, BC_GAINS_file, 0) + call cam_pio_openfile( fid, BC_GAINS_file, PIO_NOWRITE) + + ! Get file dimensions + ierr = pio_inq_dimid(fid, 'time', fid_time) + ierr = pio_inq_dimid(fid, 'lon', fid_lon) + ierr = pio_inq_dimid(fid, 'lat', fid_lat) + ierr = pio_inq_dimlen(fid, fid_time,f_ntime) + ierr = pio_inq_dimlen(fid, fid_lon, f_nlon) + ierr = pio_inq_dimlen(fid, fid_lat, f_nlat) + + allocate(BC_lat(f_nlat)) + allocate(BC_lon(f_nlon)) + allocate(BC_f3d(f_nlon, f_nlat, f_ntime)) + allocate(BC_f2d(f_nlon, f_nlat)) + allocate(BC_dom_f2d(f_nlon, f_nlat)) + allocate(BC_dom_f3d(f_nlon, f_nlat, f_ntime)) + allocate(BC_awb_f3d(f_nlon, f_nlat, f_ntime)) + allocate(BC2d (plon, plat)) + allocate(BC2d_dom (plon, plat)) + allocate(BC_anthro_GAINS(nmonth, plat, plon)) + + ! Read in the tables. + ierr = pio_inq_varid(fid, 'emis_all', idvar) + ierr = pio_get_var(fid, idvar, BC_f3d ) + ierr = pio_inq_varid(fid, 'emis_dom', idvar_dom) + ierr = pio_get_var(fid, idvar, BC_dom_f3d ) + ierr = pio_inq_varid(fid, 'emis_awb', idvar_awb) + ierr = pio_get_var(fid, idvar, BC_awb_f3d ) + ierr = pio_inq_varid(fid, 'lat', idlat) + ierr = pio_get_var(fid, idlat, BC_lat ) + ierr = pio_inq_varid(fid, 'lon ', idlon) + ierr = pio_get_var(fid, idlon, BC_lon ) + + ! Close the file. + call pio_closefile(fid) + ! get emission excluding domestic and agriculture waste buring + BC_f2d = BC_f3d(:,:,1) - BC_dom_f3d(:,:,1) - BC_awb_f3d(:,:,1) + BC_dom_f2d = BC_dom_f3d(:,:,1) + + ! make sure file longitude range from 0-360 + if (BC_lon(1) < -160._r8) then + allocate(tempor2d(f_nlon, f_nlat)) + allocate(tempor1d(f_nlon)) + mid_idx = floor(f_nlon/2._r8) + ! emission excluding dom + tempor2d(1:mid_idx,:f_nlat) = BC_f2d(mid_idx+1:f_nlon,:f_nlat) + tempor1d(1:mid_idx) = BC_lon(mid_idx+1:f_nlon) + tempor2d(mid_idx+1:f_nlon,:f_nlat) = BC_f2d(1:mid_idx,:f_nlat) + tempor1d(mid_idx+1:f_nlon) = BC_lon(1:mid_idx)+360._r8 + BC_f2d = tempor2d + ! dom emission + tempor2d(1:mid_idx,:f_nlat) = BC_dom_f2d(mid_idx+1:f_nlon,:f_nlat) + tempor2d(mid_idx+1:f_nlon,:f_nlat) = BC_dom_f2d(1:mid_idx,:f_nlat) + BC_dom_f2d = tempor2d + ! + BC_lon = tempor1d + deallocate(tempor2d) + deallocate(tempor1d) + else + BC_lon = BC_lon + endif + + ! Convert kt/year ----> #/cm2/s + rearth = 6.371e6_r8 ! m + do i = 1, f_nlat + gridarea = 2.0_r8*3.14159_r8*rearth/f_nlat * & + 2.0_r8*3.14159_r8*rearth/f_nlon*cos(BC_lat(i)/180._r8*3.14159_r8) + ! + BC_f2d(:f_nlon,i) = BC_f2d(:f_nlon,i)/365._r8/86400._r8*1.e9_r8/ & ! g/s + 12._r8*6.02e23_r8/gridarea*1.e-4_r8 ! #/cm2/s + ! + BC_dom_f2d(:f_nlon,i) = BC_dom_f2d(:f_nlon,i)/365._r8/86400._r8*1.e9_r8/ & ! g/s + 12._r8*6.02e23_r8/gridarea*1.e-4_r8 ! #/cm2/s + end do + + call lininterp_init(BC_lat, f_nlat, lat, plat, 1, wgt1) + call lininterp_init(BC_lon, f_nlon, lon, plon, 1, wgt2) + call lininterp(BC_f2d, f_nlon, f_nlat, BC2d, plon, plat, wgt2, wgt1) + call lininterp_finish(wgt1) + call lininterp_finish(wgt2) + + call lininterp_init(BC_lat, f_nlat, lat, plat, 1, wgt1) + call lininterp_init(BC_lon, f_nlon, lon, plon, 1, wgt2) + call lininterp(BC_dom_f2d, f_nlon, f_nlat, BC2d_dom, plon, plat, wgt2, wgt1) + call lininterp_finish(wgt1) + call lininterp_finish(wgt2) + + ! To implement Monthly data for dom emssion + ! methods from Stohl et al., 2013 + ! facH works for high latitudes: 45-90N + ! facL works for low latitudes: 15-45N + ! below 15N, no seasonal variation + ! + do itime = 1, nmonth + ! 45N-90N + BC2d(:plon, ind_45N:plat) = BC2d(:plon, ind_45N:plat) + & + BC2d_dom(:plon, ind_45N:plat)*facH(itime)*12._r8 + ! 15N-45N + BC2d(:plon, ind_15N:ind_45N-1) = BC2d(:plon, ind_15N:ind_45N-1) + & + BC2d_dom(:plon, ind_15N:ind_45N-1)*facL(itime)*12._r8 + ! 90S-15N + BC2d(:plon, 1:ind_15N-1) = BC2d(:plon, 1:ind_15N-1) + & + BC2d_dom(:plon, 1:ind_15N-1) + + BC_anthro_GAINS(itime, :plat, :plon) = transpose(BC2d(:plon, :plat)) + end do + + deallocate(BC_lat) + deallocate(BC_lon) + deallocate(BC_f2d) + deallocate(BC_f3d) + deallocate(BC_dom_f2d) + deallocate(BC_dom_f3d) + deallocate(BC_awb_f3d) + deallocate(BC2d) + deallocate(BC2d_dom) + + ! Part 1b: OC anthropogenic from GAINS + ! ------------------------------------------------- + ! Open the netcdf file (read only) + call getfil(OC_GAINS_filename, OC_GAINS_file, 0) + call cam_pio_openfile(fid, trim(OC_GAINS_file), PIO_NOWRITE) + + ! Get file dimensions + ierr = pio_inq_dimid(fid, 'time', fid_time) + ierr = pio_inq_dimid(fid, 'lon', fid_lon) + ierr = pio_inq_dimid(fid, 'lat', fid_lat) + ierr = pio_inq_dimlen(fid, fid_time,f_ntime) + ierr = pio_inq_dimlen(fid, fid_lon, f_nlon) + ierr = pio_inq_dimlen(fid, fid_lat, f_nlat) + + allocate(OC_lat(f_nlat)) + allocate(OC_lon(f_nlon)) + allocate(OC_f2d(f_nlon, f_nlat)) + allocate(OC_f3d(f_nlon, f_nlat, f_ntime)) + allocate(OC_dom_f2d(f_nlon, f_nlat)) + allocate(OC_dom_f3d(f_nlon, f_nlat, f_ntime)) + allocate(OC_awb_f3d(f_nlon, f_nlat, f_ntime)) + allocate(OC2d (plon, plat)) + allocate(OC2d_dom (plon, plat)) + allocate(OC_anthro_GAINS(nmonth, plat, plon)) + + ! Read in the tables. + ierr = pio_inq_varid(fid, 'emis_all', idvar) + ierr = pio_get_var(fid, idvar, OC_f3d ) + ierr = pio_inq_varid(fid, 'emis_dom', idvar_dom) + ierr = pio_get_var(fid, idvar, OC_dom_f3d ) + ierr = pio_inq_varid(fid, 'emis_awb', idvar_awb) + ierr = pio_get_var(fid, idvar, OC_awb_f3d ) + ierr = pio_inq_varid(fid, 'lat', idlat) + ierr = pio_get_var(fid, idlat, OC_lat ) + ierr = pio_inq_varid(fid, 'lon ', idlon) + ierr = pio_get_var(fid, idlon, OC_lon ) + + ! Close the file. + call pio_closefile(fid) + + ! get emission excluding domestic and agriculture waste burning + OC_f2d(:,:) = OC_f3d(:,:,1) - OC_dom_f3d(:,:,1) - OC_awb_f3d(:,:,1) + OC_dom_f2d = OC_dom_f3d(:,:,1) + + ! make sure file longitude range from -180-180 to 0-360 + if (OC_lon(1) < -160._r8) then + allocate(tempor2d(f_nlon, f_nlat)) + allocate(tempor1d(f_nlon)) + mid_idx = floor(f_nlon/2._r8) + ! emission excluding dom + tempor2d(1:mid_idx,:f_nlat) = OC_f2d(mid_idx+1:f_nlon,:f_nlat) + tempor1d(1:mid_idx) = OC_lon(mid_idx+1:f_nlon) + tempor2d(mid_idx+1:f_nlon,:f_nlat) = OC_f2d(1:mid_idx,:f_nlat) + tempor1d(mid_idx+1:f_nlon) = OC_lon(1:mid_idx)+360._r8 + OC_f2d = tempor2d + ! dom emission + tempor2d(1:mid_idx,:f_nlat) = OC_dom_f2d(mid_idx+1:f_nlon,:f_nlat) + tempor2d(mid_idx+1:f_nlon,:f_nlat) = OC_dom_f2d(1:mid_idx,:f_nlat) + OC_dom_f2d = tempor2d + ! + OC_lon = tempor1d + deallocate(tempor2d) + deallocate(tempor1d) + else + OC_lon = OC_lon + endif + + ! Convert kt/year ----> #/cm2/s + rearth = 6.371e6_r8 ! m + do i = 1, f_nlat + gridarea = 2.0_r8*3.14159_r8*rearth/f_nlat * & + 2.0_r8*3.14159_r8*rearth/f_nlon*cos(OC_lat(i)/180._r8*3.14159_r8) + ! + OC_f2d(:f_nlon,i) = OC_f2d(:f_nlon,i)/365._r8/86400._r8*1.e9_r8/ & ! g/s + 12._r8*6.02e23_r8/gridarea*1.e-4_r8 ! #/cm2/s + ! + OC_dom_f2d(:f_nlon,i) = OC_dom_f2d(:f_nlon,i)/365._r8/86400._r8*1.e9_r8/ & ! g/s + 12._r8*6.02e23_r8/gridarea*1.e-4_r8 ! #/cm2/s + end do + + call lininterp_init(OC_lat, f_nlat, lat, plat, 1, wgt1) + call lininterp_init(OC_lon, f_nlon, lon, plon, 1, wgt2) + call lininterp(OC_f2d, f_nlon, f_nlat, OC2d, plon, plat, wgt2, wgt1) + call lininterp_finish(wgt1) + call lininterp_finish(wgt2) + + call lininterp_init(OC_lat, f_nlat, lat, plat, 1, wgt1) + call lininterp_init(OC_lon, f_nlon, lon, plon, 1, wgt2) + call lininterp(OC_dom_f2d, f_nlon, f_nlat, OC2d_dom, plon, plat, wgt2, wgt1) + call lininterp_finish(wgt1) + call lininterp_finish(wgt2) + + ! To implement Monthly data for dom emssion + ! methods from Stohl et al., 2013 + ! facH works for high latitudes: 45-90N + ! facL works for low latitudes: 15-45N + ! below 15N, no seasonal variation + ! + do itime = 1, nmonth + ! 45N-90N + OC2d(:plon, ind_45N:plat) = OC2d(:plon, ind_45N:plat) + & + OC2d_dom(:plon, ind_45N:plat)*facH(itime)*12._r8 + ! 15N-45N + OC2d(:plon, ind_15N:ind_45N-1) = OC2d(:plon, ind_15N:ind_45N-1) + & + OC2d_dom(:plon, ind_15N:ind_45N-1)*facL(itime)*12._r8 + ! 90S-15N + OC2d(:plon, 1:ind_15N-1) = OC2d(:plon, 1:ind_15N-1) + & + OC2d_dom(:plon, 1:ind_15N-1) + + OC_anthro_GAINS(itime, :plat, :plon) = transpose(OC2d(:plon, :plat)) + end do + + deallocate(OC_lat) + deallocate(OC_lon) + deallocate(OC_f2d) + deallocate(OC_f3d) + deallocate(OC_dom_f2d) + deallocate(OC_dom_f3d) + deallocate(OC_awb_f3d) + deallocate(OC2d) + deallocate(OC2d_dom) + + ! Part 2a: BC ship + ! ------------------------------------------------- + ! Open the netcdf file (read only) + call getfil(BC_ship_filename, BC_ship_file, 0) + call cam_pio_openfile(fid, trim(BC_ship_file), PIO_NOWRITE) + !call wrap_open(BC_ship_file, 0, fid) + + ! Get file dimensions + ierr = pio_inq_dimid(fid, 'lon', fid_lon) + ierr = pio_inq_dimid(fid, 'lat', fid_lat) + ierr = pio_inq_dimlen(fid, fid_lon, f_nlon) + ierr = pio_inq_dimlen(fid, fid_lat, f_nlat) + + allocate(BC_lat(f_nlat)) + allocate(BC_lon(f_nlon)) + allocate(BC_f3d(f_nlon, f_nlat, nmonth)) + allocate(BC3d (plon, plat, nmonth)) + allocate(BC_ship_GAINS(nmonth, plat, plon)) + + ! Read in the tables. + ierr = pio_inq_varid(fid, 'emiss_shp', idvar) + ierr = pio_get_var(fid, idvar, BC_f3d ) + ierr = pio_inq_varid(fid, 'lat', idlat) + ierr = pio_get_var(fid, idlat, BC_lat ) + ierr = pio_inq_varid(fid, 'lon ', idlon) + ierr = pio_get_var(fid, idlon, BC_lon ) + + ! Close the file. + call pio_closefile(fid) + + ! make sure file longitude range from -180-180 to 0-360 + if (BC_lon(1) < -160._r8) then + allocate(tempor3d(f_nlon, f_nlat, nmonth)) + allocate(tempor1d(f_nlon)) + mid_idx = floor(f_nlon/2._r8) + tempor3d(1:mid_idx,:f_nlat,:nmonth) = BC_f3d(mid_idx+1:f_nlon,:f_nlat,:nmonth) + tempor1d(1:mid_idx) = BC_lon(mid_idx+1:f_nlon) + tempor3d(mid_idx+1:f_nlon,:f_nlat,:nmonth) = BC_f3d(1:mid_idx,:f_nlat,:nmonth) + tempor1d(mid_idx+1:f_nlon) = BC_lon(1:mid_idx)+360._r8 + BC_f3d = tempor3d + BC_lon = tempor1d + deallocate(tempor3d) + deallocate(tempor1d) + else + BC_lon = BC_lon + endif + + ! convert unit from kg/m2/s to #/cm2/s + BC_f3d = BC_f3d*1.e3_r8/1.e4_r8/12._r8*6.02e23_r8 + + call lininterp_init(BC_lat, f_nlat, lat, plat, 1, wgt1) + call lininterp_init(BC_lon, f_nlon, lon, plon, 1, wgt2) + do itime = 1, nmonth + call lininterp(BC_f3d(:,:,itime), f_nlon, f_nlat, tempor(:,:), plon, plat, wgt2, wgt1) + BC3d(:,:,itime) = tempor(:,:) + end do + call lininterp_finish(wgt1) + call lininterp_finish(wgt2) + + do itime = 1, nmonth + BC_ship_GAINS(itime, :plat, :plon) = transpose(BC3d(:plon, :plat, itime)) + end do + + deallocate(BC_lat) + deallocate(BC_lon) + deallocate(BC_f3d) + deallocate(BC3d) + + ! Part 2b: OC Ship + ! ------------------------------------------------- + ! Open the netcdf file (read only) + call getfil(OC_ship_filename, OC_ship_file, 0) + call cam_pio_openfile(fid, trim(OC_ship_file), PIO_NOWRITE) + + ! Get file dimensions + ierr = pio_inq_dimid(fid, 'lon', fid_lon) + ierr = pio_inq_dimid(fid, 'lat', fid_lat) + ierr = pio_inq_dimlen(fid, fid_lon, f_nlon) + ierr = pio_inq_dimlen(fid, fid_lat, f_nlat) + + allocate(OC_lat(f_nlat)) + allocate(OC_lon(f_nlon)) + allocate(OC_f3d(f_nlon, f_nlat, nmonth)) + allocate(OC3d (plon, plat, nmonth)) + allocate(OC_ship_GAINS(nmonth, plat, plon)) + + ! Read in the tables. + ierr = pio_inq_varid(fid, 'emiss_shp', idvar) + ierr = pio_get_var(fid, idvar, OC_f3d ) + ierr = pio_inq_varid(fid, 'lat', idlat) + ierr = pio_get_var(fid, idlat, OC_lat ) + ierr = pio_inq_varid(fid, 'lon ', idlon) + ierr = pio_get_var(fid, idlon, OC_lon ) + + ! Close the file. + call pio_closefile(fid) + + ! make sure file longitude range from -180-180 to 0-360 + if (OC_lon(1) < -160._r8) then + allocate(tempor3d(f_nlon, f_nlat, nmonth)) + allocate(tempor1d(f_nlon)) + mid_idx = floor(f_nlon/2._r8) + tempor3d(1:mid_idx,:f_nlat,:nmonth) = OC_f3d(mid_idx+1:f_nlon,:f_nlat,:nmonth) + tempor1d(1:mid_idx) = OC_lon(mid_idx+1:f_nlon) + tempor3d(mid_idx+1:f_nlon,:f_nlat,:nmonth) = OC_f3d(1:mid_idx,:f_nlat,:nmonth) + tempor1d(mid_idx+1:f_nlon) = OC_lon(1:mid_idx)+360._r8 + OC_f3d = tempor3d + OC_lon = tempor1d + deallocate(tempor3d) + deallocate(tempor1d) + else + OC_lon = OC_lon + endif + + ! convert unit from kg/m2/s to #/cm2/s + OC_f3d = OC_f3d*1.e3_r8/1.e4_r8/12._r8*6.02e23_r8 + + call lininterp_init(OC_lat, f_nlat, lat, plat, 1, wgt1) + call lininterp_init(OC_lon, f_nlon, lon, plon, 1, wgt2) + do itime = 1, nmonth + call lininterp(OC_f3d(:,:,itime), f_nlon, f_nlat, tempor(:,:), plon, plat, wgt2, wgt1) + OC3d(:,:,itime) = tempor(:,:) + end do + call lininterp_finish(wgt1) + call lininterp_finish(wgt2) + + do itime = 1, nmonth + OC_ship_GAINS(itime, :plat, :plon) = transpose(OC3d(:plon, :plat, itime)) + end do + + deallocate(OC_lat) + deallocate(OC_lon) + deallocate(OC_f3d) + deallocate(OC3d) + + ! Part 3a: BC GFEDv3 + ! ------------------------------------------------- + ! Open the netcdf file (read only) + call getfil(BC_GFEDv3_filename, BC_GFEDv3_file, 0) + call cam_pio_openfile(fid, trim(BC_GFEDv3_file), PIO_NOWRITE) + + ! Get file dimensions + ierr = pio_inq_dimid(fid, 'lon', fid_lon) + ierr = pio_inq_dimid(fid, 'lat', fid_lat) + ierr = pio_inq_dimlen(fid, fid_lon, f_nlon) + ierr = pio_inq_dimlen(fid, fid_lat, f_nlat) + + allocate(BC_lat(f_nlat)) + allocate(BC_lon(f_nlon)) + allocate(BC_f3d(f_nlon, f_nlat, nmonth)) + allocate(tempor3d(f_nlon, f_nlat, nmonth)) + allocate(BC3d (plon, plat, nmonth)) + allocate(BC_GFEDv3(nmonth, plat, plon)) + + ! Read in the tables. + BC_f3d = 0._r8 + ierr = pio_inq_varid(fid, 'emis', idvar) + ierr = pio_get_var(fid, idvar, tempor3d ) + !call wrap_inq_varid(fid, 'emis', idvar) + !call wrap_get_var_realx(fid, idvar, tempor3d) + BC_f3d = BC_f3d + tempor3d + ! excluding non-real values + where (BC_f3d(:,:,:) .ge. 1.e10_r8) + BC_f3d(:,:,:) = 1.e-30_r8 + end where + + ierr = pio_inq_varid(fid, 'lat', idlat) + ierr = pio_get_var(fid, idlat, BC_lat ) + ierr = pio_inq_varid(fid, 'lon ', idlon) + ierr = pio_get_var(fid, idlon, BC_lon ) + + ! Close the file. + call pio_closefile(fid) + + ! make sure file longitude range from -180-180 to 0-360 + if (BC_lon(1) < -160._r8) then + allocate(tempor1d(f_nlon)) + mid_idx = floor(f_nlon/2._r8) + tempor3d(1:mid_idx,:f_nlat,:nmonth) = BC_f3d(mid_idx+1:f_nlon,:f_nlat,:nmonth) + tempor1d(1:mid_idx) = BC_lon(mid_idx+1:f_nlon) + tempor3d(mid_idx+1:f_nlon,:f_nlat,:nmonth) = BC_f3d(1:mid_idx,:f_nlat,:nmonth) + tempor1d(mid_idx+1:f_nlon) = BC_lon(1:mid_idx)+360._r8 + BC_f3d = tempor3d + BC_lon = tempor1d + deallocate(tempor1d) + else + BC_lon = BC_lon + endif + + ! convert unit from g/m2/month to #/cm2/s + BC_f3d = BC_f3d/1.e4_r8/30._r8/86400._r8/12._r8*6.02e23_r8 + + call lininterp_init(BC_lat, f_nlat, lat, plat, 1, wgt1) + call lininterp_init(BC_lon, f_nlon, lon, plon, 1, wgt2) + do itime = 1, nmonth + call lininterp(BC_f3d(:,:,itime), f_nlon, f_nlat, tempor(:,:), plon, plat, wgt2, wgt1) + BC3d(:,:,itime) = tempor(:,:) + end do + call lininterp_finish(wgt1) + call lininterp_finish(wgt2) + + do itime = 1, nmonth + BC_GFEDv3(itime, :plat, :plon) = transpose(BC3d(:plon, :plat, itime)) + end do + + deallocate(BC_lat) + deallocate(BC_lon) + deallocate(BC_f3d) + deallocate(BC3d) + deallocate(tempor3d) + + ! Part 3b: OC GFEDv3 + ! ------------------------------------------------- + ! Open the netcdf file (read only) + call getfil(OC_GFEDv3_filename, OC_GFEDv3_file, 0) + call cam_pio_openfile(fid, trim(OC_GFEDv3_file), PIO_NOWRITE) + + ! Get file dimensions + ierr = pio_inq_dimid(fid, 'lon', fid_lon) + ierr = pio_inq_dimid(fid, 'lat', fid_lat) + ierr = pio_inq_dimlen(fid, fid_lon, f_nlon) + ierr = pio_inq_dimlen(fid, fid_lat, f_nlat) + + ! write(carma%f_LUNOPRT,*) '' + ! write(carma%f_LUNOPRT,*) 'f_lon = ', f_nlon + ! write(carma%f_LUNOPRT,*) 'f_lat = ', f_nlat + ! write(carma%f_LUNOPRT,*) '' + + allocate(OC_lat(f_nlat)) + allocate(OC_lon(f_nlon)) + allocate(OC_f3d(f_nlon, f_nlat, nmonth)) + allocate(tempor3d(f_nlon, f_nlat, nmonth)) + allocate(OC3d (plon, plat, nmonth)) + allocate(OC_GFEDv3(nmonth, plat, plon)) + + ! Read in the tables. + OC_f3d = 0._r8 + ierr = pio_inq_varid(fid, 'emis', idvar) + ierr = pio_get_var(fid, idvar, tempor3d ) + !call wrap_inq_varid(fid, 'emis', idvar) + !call wrap_get_var_realx(fid, idvar, tempor3d) + OC_f3d = OC_f3d + tempor3d + ! excluding non-real values + where (OC_f3d(:,:,:) .ge. 1.e10_r8) + OC_f3d(:,:,:) = 1.e-30_r8 + end where + + ierr = pio_inq_varid(fid, 'lat', idlat) + ierr = pio_get_var(fid, idlat, OC_lat ) + ierr = pio_inq_varid(fid, 'lon ', idlon) + ierr = pio_get_var(fid, idlon, OC_lon ) + + ! Close the file. + call pio_closefile(fid) + + ! make sure file longitude range from -180-180 to 0-360 + if (OC_lon(1) < -160._r8) then + allocate(tempor1d(f_nlon)) + mid_idx = floor(f_nlon/2._r8) + tempor3d(1:mid_idx,:f_nlat,:nmonth) = OC_f3d(mid_idx+1:f_nlon,:f_nlat,:nmonth) + tempor1d(1:mid_idx) = OC_lon(mid_idx+1:f_nlon) + tempor3d(mid_idx+1:f_nlon,:f_nlat,:nmonth) = OC_f3d(1:mid_idx,:f_nlat,:nmonth) + tempor1d(mid_idx+1:f_nlon) = OC_lon(1:mid_idx)+360._r8 + OC_f3d = tempor3d + OC_lon = tempor1d + deallocate(tempor1d) + else + OC_lon = OC_lon + endif + call lininterp_init(OC_lat, f_nlat, lat, plat, 1, wgt1) + call lininterp_init(OC_lon, f_nlon, lon, plon, 1, wgt2) + do itime = 1, nmonth + call lininterp(OC_f3d(:,:,itime), f_nlon, f_nlat, tempor(:,:), plon, plat, wgt2, wgt1) + OC3d(:,:,itime) = tempor(:,:) + end do + call lininterp_finish(wgt1) + call lininterp_finish(wgt2) + + do itime = 1, nmonth + OC_GFEDv3(itime, :plat, :plon) = transpose(OC3d(:plon, :plat, itime)) + end do + + deallocate(OC_lat) + deallocate(OC_lon) + deallocate(OC_f3d) + deallocate(OC3d) + deallocate(tempor3d) + +! Sum + do itime = 1, nmonth + BCnew(:plat, :plon, itime) = BC_anthro_GAINS(itime, :plat, :plon) + & + BC_ship_GAINS(itime, :plat, :plon) + BC_GFEDv3(itime, :plat, :plon) +! + OCnew(:plat, :plon, itime) = OC_anthro_GAINS(itime, :plat, :plon) + & + OC_ship_GAINS(itime, :plat, :plon) + OC_GFEDv3(itime, :plat, :plon) + end do +! + deallocate(BC_anthro_GAINS) + deallocate(OC_anthro_GAINS) + deallocate(BC_ship_GAINS) + deallocate(OC_ship_GAINS) + deallocate(BC_GFEDv3) + deallocate(OC_GFEDv3) + deallocate(facH) + deallocate(facL) +! + return + end subroutine CARMAMODEL_BCOCRead + +end module carma_model_mod From bcee335b82ab1180ed1f9fc32519a1a345821c1e Mon Sep 17 00:00:00 2001 From: Francis Vitt <fvitt@ucar.edu> Date: Thu, 12 Dec 2024 09:04:38 -0700 Subject: [PATCH 02/24] update carma models to be consistent with carma_base_tag brnach -- mostly r8 and cleanup modified: src/physics/carma/cam/carma_precision_mod.F90 modified: src/physics/carma/models/bc_strat/carma_model_mod.F90 modified: src/physics/carma/models/cirrus/carma_model_mod.F90 modified: src/physics/carma/models/cirrus/growevapl.F90 modified: src/physics/carma/models/cirrus_dust/carma_mod.F90 modified: src/physics/carma/models/cirrus_dust/carma_model_mod.F90 modified: src/physics/carma/models/cirrus_dust/growevapl.F90 modified: src/physics/carma/models/dust/carma_model_mod.F90 modified: src/physics/carma/models/meteor_impact/carma_model_flags_mod.F90 modified: src/physics/carma/models/meteor_impact/carma_model_mod.F90 modified: src/physics/carma/models/meteor_smoke/carma_model_mod.F90 modified: src/physics/carma/models/mixed_sulfate/carma_model_mod.F90 modified: src/physics/carma/models/pmc/carma_model_mod.F90 modified: src/physics/carma/models/pmc_sulfate/carma_model_mod.F90 modified: src/physics/carma/models/sea_salt/carma_model_mod.F90 modified: src/physics/carma/models/sulfate/carma_model_mod.F90 modified: src/physics/carma/models/test_detrain/carma_model_mod.F90 modified: src/physics/carma/models/test_growth/carma_model_mod.F90 modified: src/physics/carma/models/test_passive/carma_model_mod.F90 modified: src/physics/carma/models/test_radiative/carma_model_mod.F90 modified: src/physics/carma/models/test_swelling/carma_model_mod.F90 modified: src/physics/carma/models/test_tracers/carma_model_mod.F90 modified: src/physics/carma/models/test_tracers2/carma_model_mod.F90 modified: src/physics/carma/models/tholin/carma_model_mod.F90 modified: test/system/TR8.sh --- src/physics/carma/cam/carma_precision_mod.F90 | 2 +- .../carma/models/bc_strat/carma_model_mod.F90 | 2 +- .../carma/models/cirrus/carma_model_mod.F90 | 10 +++++----- src/physics/carma/models/cirrus/growevapl.F90 | 2 +- .../carma/models/cirrus_dust/carma_mod.F90 | 2 +- .../models/cirrus_dust/carma_model_mod.F90 | 14 ++++++------- .../carma/models/cirrus_dust/growevapl.F90 | 2 +- .../carma/models/dust/carma_model_mod.F90 | 6 +++--- .../meteor_impact/carma_model_flags_mod.F90 | 20 +++++++++---------- .../models/meteor_impact/carma_model_mod.F90 | 10 +++++----- .../models/meteor_smoke/carma_model_mod.F90 | 8 ++++---- .../models/mixed_sulfate/carma_model_mod.F90 | 8 ++++---- .../carma/models/pmc/carma_model_mod.F90 | 10 +++++----- .../models/pmc_sulfate/carma_model_mod.F90 | 10 +++++----- .../carma/models/sea_salt/carma_model_mod.F90 | 8 ++++---- .../carma/models/sulfate/carma_model_mod.F90 | 2 +- .../models/test_detrain/carma_model_mod.F90 | 2 +- .../models/test_growth/carma_model_mod.F90 | 2 +- .../models/test_passive/carma_model_mod.F90 | 2 +- .../models/test_radiative/carma_model_mod.F90 | 2 +- .../models/test_swelling/carma_model_mod.F90 | 2 +- .../models/test_tracers/carma_model_mod.F90 | 2 +- .../models/test_tracers2/carma_model_mod.F90 | 2 +- .../carma/models/tholin/carma_model_mod.F90 | 8 ++++---- test/system/TR8.sh | 4 ++++ 25 files changed, 73 insertions(+), 69 deletions(-) diff --git a/src/physics/carma/cam/carma_precision_mod.F90 b/src/physics/carma/cam/carma_precision_mod.F90 index db76f798c6..ae22471312 100644 --- a/src/physics/carma/cam/carma_precision_mod.F90 +++ b/src/physics/carma/cam/carma_precision_mod.F90 @@ -35,4 +35,4 @@ module carma_precision_mod !! Define smallest possible number such that ONE + ALMOST_ZERO > ONE real(kind=f), parameter :: ALMOST_ZERO = epsilon( ONE ) real(kind=f), parameter :: ALMOST_ONE = ONE - ALMOST_ZERO -end module +end module carma_precision_mod diff --git a/src/physics/carma/models/bc_strat/carma_model_mod.F90 b/src/physics/carma/models/bc_strat/carma_model_mod.F90 index 42dc276a01..e4a933dd67 100644 --- a/src/physics/carma/models/bc_strat/carma_model_mod.F90 +++ b/src/physics/carma/models/bc_strat/carma_model_mod.F90 @@ -417,4 +417,4 @@ subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) return end subroutine CARMA_WetDeposition -end module +end module carma_model_mod diff --git a/src/physics/carma/models/cirrus/carma_model_mod.F90 b/src/physics/carma/models/cirrus/carma_model_mod.F90 index 446a17cdd8..b751221964 100644 --- a/src/physics/carma/models/cirrus/carma_model_mod.F90 +++ b/src/physics/carma/models/cirrus/carma_model_mod.F90 @@ -315,7 +315,7 @@ subroutine CARMA_DefineModel(carma, rc) ! Read in the tables. call wrap_inq_varid(fid, 'wavelength', wave_vid) call wrap_get_var_realx(fid, wave_vid, warren_wave) - warren_wave = warren_wave * 1e-4 ! um -> cm + warren_wave = warren_wave * 1e-4_r8 ! um -> cm call wrap_inq_varid(fid, 'm_real', real_vid) call wrap_get_var_realx(fid, real_vid, warren_real) @@ -1344,7 +1344,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) ! Now integrate the snow distribution. We know the snow amount, but need an effective radius ! to determine the snow number. sub_d = 2._f * (r(NBIN) + (dr(NBIN) / 2._f)) * shapeFactor - sub_dd = (snow_max_d * 1e-4 - sub_d) / NINTS_SNOW + sub_dd = (snow_max_d * 1e-4_r8 - sub_d) / NINTS_SNOW sub_d = sub_d + sub_dd / 2._f remainder = 0._f @@ -1361,7 +1361,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) ! m = aD^2.1 ! ! NOTE: This needs to match the density assumption made in the detrained ice bins. - remainder = remainder + nsnow / lambda * 4.22e-3_f * (sub_d**2.1) + remainder = remainder + nsnow / lambda * 4.22e-3_f * (sub_d**2.1_r8) sub_d = sub_d + sub_dd end do @@ -1374,7 +1374,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) ! Now integrate the snow distribution. We know the snow amount, but need an effective radius ! to determine the snow number. snow_d = 2._f * ((r(NBIN) + dr(NBIN) / 2._f)) - sub_dd = (snow_max_d * 1e-4 - snow_d) / NINTS_SNOW + sub_dd = (snow_max_d * 1e-4_r8 - snow_d) / NINTS_SNOW sub_d = snow_d + (sub_dd / 2._f) snow_r3 = 0._f @@ -2064,4 +2064,4 @@ subroutine CARMA_CheckMassAndEnergy(carma, cstate, madeSnow, name, state, & return end subroutine CARMA_CheckMassAndEnergy -end module +end module carma_model_mod diff --git a/src/physics/carma/models/cirrus/growevapl.F90 b/src/physics/carma/models/cirrus/growevapl.F90 index e1020eb802..c6659bdbb4 100644 --- a/src/physics/carma/models/cirrus/growevapl.F90 +++ b/src/physics/carma/models/cirrus/growevapl.F90 @@ -216,7 +216,7 @@ subroutine growevapl(carma, cstate, iz, rc) if( x .lt. 1._f )then growlg(ibin,igroup) = dmdt(ibin)/pc(iz,ibin,iepart) & - * ( ar(ibin) - 0.5*dela(ibin)*x + & + * ( ar(ibin) - 0.5_r8*dela(ibin)*x + & (x/2._f - x**2/3._f)*a6(ibin) ) else growlg(ibin,igroup) = dmdt(ibin) / dm(ibin,igroup) diff --git a/src/physics/carma/models/cirrus_dust/carma_mod.F90 b/src/physics/carma/models/cirrus_dust/carma_mod.F90 index ab89065690..f6ac6945ae 100644 --- a/src/physics/carma/models/cirrus_dust/carma_mod.F90 +++ b/src/physics/carma/models/cirrus_dust/carma_mod.F90 @@ -1475,4 +1475,4 @@ subroutine CARMA_Get(carma, rc, LUNOPRT, NBIN, NELEM, NGAS, NGROUP, NSOLUTE, NWA return end subroutine CARMA_Get -end module +end module carma_mod diff --git a/src/physics/carma/models/cirrus_dust/carma_model_mod.F90 b/src/physics/carma/models/cirrus_dust/carma_model_mod.F90 index 036e1ea977..0ff512539e 100644 --- a/src/physics/carma/models/cirrus_dust/carma_model_mod.F90 +++ b/src/physics/carma/models/cirrus_dust/carma_model_mod.F90 @@ -335,7 +335,7 @@ subroutine CARMA_DefineModel(carma, rc) ! Read in the tables. call wrap_inq_varid(fid, 'wavelength', wave_vid) call wrap_get_var_realx(fid, wave_vid, warren_wave) - warren_wave = warren_wave * 1e-4 ! um -> cm + warren_wave = warren_wave * 1e-4_r8 ! um -> cm call wrap_inq_varid(fid, 'm_real', real_vid) call wrap_get_var_realx(fid, real_vid, warren_real) @@ -1386,7 +1386,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) ! Now integrate the snow distribution. We know the snow amount, but need an effective radius ! to determine the snow number. sub_d = 2._f * (r(NBIN) + (dr(NBIN) / 2._f)) * shapeFactor - sub_dd = (snow_max_d * 1e-4 - sub_d) / NINTS_SNOW + sub_dd = (snow_max_d * 1e-4_r8 - sub_d) / NINTS_SNOW sub_d = sub_d + sub_dd / 2._f remainder = 0._f @@ -1403,7 +1403,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) ! m = aD^2.1 ! ! NOTE: This needs to match the density assumption made in the detrained ice bins. - remainder = remainder + nsnow / lambda * 4.22e-3_f * (sub_d**2.1) + remainder = remainder + nsnow / lambda * 4.22e-3_f * (sub_d**2.1_r8) sub_d = sub_d + sub_dd end do @@ -1416,7 +1416,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) ! Now integrate the snow distribution. We know the snow amount, but need an effective radius ! to determine the snow number. snow_d = 2._f * ((r(NBIN) + dr(NBIN) / 2._f)) - sub_dd = (snow_max_d * 1e-4 - snow_d) / NINTS_SNOW + sub_dd = (snow_max_d * 1e-4_r8 - snow_d) / NINTS_SNOW sub_d = snow_d + (sub_dd / 2._f) snow_r3 = 0._f @@ -2570,7 +2570,7 @@ subroutine CARMA_SurfaceWind(carma, state, icol, ilat, ilon, ielem, igroup, ibin * sqrt(1._r8 + .006_r8/rhop(ibin)/GRAV/(r(ibin)*2._r8)**2.5_r8) & / sqrt(1.928_r8*(1331._r8*(r(ibin)*2._r8)**1.56_r8 + .38_r8)**.092_r8 - 1._r8) else - uth = uthfact*1.e-2_r8* 0.13_r8 * sqrt(rhop(ibin)*GRAV*(.75e-4_r8)*2./rhoa) & + uth = uthfact*1.e-2_r8* 0.13_r8 * sqrt(rhop(ibin)*GRAV*(.75e-4_r8)*2._r8/rhoa) & * sqrt(1._r8 + .006_r8/rhop(ibin)/GRAV/((.75e-4_r8)*2._r8)**2.5_r8) & / sqrt(1.928_r8*(1331._r8*((.75e-4_r8)*2._r8)**1.56_r8 + .38_r8)**.092_r8 - 1._r8) endif @@ -2703,7 +2703,7 @@ subroutine WeibullWind(u, uth, n, uwb, wbk) if (present(wbk)) then k = wbk else - k = 0.94*u**0.5_r8 ! follow Grini and Zender, 2004JGR + k = 0.94_r8*u**0.5_r8 ! follow Grini and Zender, 2004JGR ! k = 2.5_r8 ! Lansing's estimate end if @@ -2718,4 +2718,4 @@ subroutine WeibullWind(u, uth, n, uwb, wbk) end subroutine WeibullWind -end module +end module carma_model_mod diff --git a/src/physics/carma/models/cirrus_dust/growevapl.F90 b/src/physics/carma/models/cirrus_dust/growevapl.F90 index e1020eb802..c6659bdbb4 100644 --- a/src/physics/carma/models/cirrus_dust/growevapl.F90 +++ b/src/physics/carma/models/cirrus_dust/growevapl.F90 @@ -216,7 +216,7 @@ subroutine growevapl(carma, cstate, iz, rc) if( x .lt. 1._f )then growlg(ibin,igroup) = dmdt(ibin)/pc(iz,ibin,iepart) & - * ( ar(ibin) - 0.5*dela(ibin)*x + & + * ( ar(ibin) - 0.5_r8*dela(ibin)*x + & (x/2._f - x**2/3._f)*a6(ibin) ) else growlg(ibin,igroup) = dmdt(ibin) / dm(ibin,igroup) diff --git a/src/physics/carma/models/dust/carma_model_mod.F90 b/src/physics/carma/models/dust/carma_model_mod.F90 index ae1b11bd3c..09c96b2bf0 100644 --- a/src/physics/carma/models/dust/carma_model_mod.F90 +++ b/src/physics/carma/models/dust/carma_model_mod.F90 @@ -717,7 +717,7 @@ subroutine CARMAMODEL_SurfaceWind(carma, state, icol, ielem, igroup, ibin, cam_i * sqrt(1._r8 + .006_r8/rhop(ibin)/GRAV/(r(ibin)*2._r8)**2.5_r8) & / sqrt(1.928_r8*(1331._r8*(r(ibin)*2._r8)**1.56_r8 + .38_r8)**.092_r8 - 1._r8) else - uth = uthfact*1.e-2_r8* 0.13_r8 * sqrt(rhop(ibin)*GRAV*(.75e-4_r8)*2./rhoa) & + uth = uthfact*1.e-2_r8* 0.13_r8 * sqrt(rhop(ibin)*GRAV*(.75e-4_r8)*2._r8/rhoa) & * sqrt(1._r8 + .006_r8/rhop(ibin)/GRAV/((.75e-4_r8)*2._r8)**2.5_r8) & / sqrt(1.928_r8*(1331._r8*((.75e-4_r8)*2._r8)**1.56_r8 + .38_r8)**.092_r8 - 1._r8) endif @@ -853,7 +853,7 @@ subroutine WeibullWind(u, uth, n, uwb, wbk) if (present(wbk)) then k = wbk else - k = 0.94*u**0.5_r8 ! follow Grini and Zender, 2004JGR + k = 0.94_r8*u**0.5_r8 ! follow Grini and Zender, 2004JGR ! k = 2.5_r8 ! Lansing's estimate end if @@ -956,4 +956,4 @@ subroutine CARMAMODEL_OutputDiagnostics(carma, icnst4elem, state, ptend, pbuf, c return end subroutine CARMAMODEL_OutputDiagnostics -end module +end module carma_model_mod diff --git a/src/physics/carma/models/meteor_impact/carma_model_flags_mod.F90 b/src/physics/carma/models/meteor_impact/carma_model_flags_mod.F90 index 360ddb9499..efe43af66d 100644 --- a/src/physics/carma/models/meteor_impact/carma_model_flags_mod.F90 +++ b/src/physics/carma/models/meteor_impact/carma_model_flags_mod.F90 @@ -24,16 +24,16 @@ module carma_model_flags_mod ! ! Create a public definition of any new namelist variables that you wish to have, ! and default them to an inital value. - real(r8), public :: carma_emis_dust = 0._r8 !! Total dust emission for the event (kg) - real(r8), public :: carma_emis_soot = 0._r8 !! Total soot emission for the event (kg) - integer, public :: carma_emis_startdate = 1 !! start year and day of year (yyyyddd) - integer, public :: carma_emis_stopdate = 1 !! stop year and day of year (yyyyddd) - integer, public :: carma_emis_starttime = 0 !! start time of day (s) - integer, public :: carma_emis_stoptime = 0 !! stop time of day (s) - real(r8), public :: carma_emis_minlat = -90. !! minimum latitude - real(r8), public :: carma_emis_maxlat = 90. !! maximum latitude - real(r8), public :: carma_emis_minlon = 0. !! minimum longitude - real(r8), public :: carma_emis_maxlon = 360. !! maximum longitude + real(r8), public :: carma_emis_dust = 0._r8 !! Total dust emission for the event (kg) + real(r8), public :: carma_emis_soot = 0._r8 !! Total soot emission for the event (kg) + integer, public :: carma_emis_startdate = 1 !! start year and day of year (yyyyddd) + integer, public :: carma_emis_stopdate = 1 !! stop year and day of year (yyyyddd) + integer, public :: carma_emis_starttime = 0 !! start time of day (s) + integer, public :: carma_emis_stoptime = 0 !! stop time of day (s) + real(r8), public :: carma_emis_minlat = -90._r8 !! minimum latitude + real(r8), public :: carma_emis_maxlat = 90._r8 !! maximum latitude + real(r8), public :: carma_emis_minlon = 0._r8 !! minimum longitude + real(r8), public :: carma_emis_maxlon = 360._r8 !! maximum longitude logical, public :: carma_fractal_soot = .false. !! fractal Soot contains diff --git a/src/physics/carma/models/meteor_impact/carma_model_mod.F90 b/src/physics/carma/models/meteor_impact/carma_model_mod.F90 index 59bee3ca7e..ecc131f0cf 100755 --- a/src/physics/carma/models/meteor_impact/carma_model_mod.F90 +++ b/src/physics/carma/models/meteor_impact/carma_model_mod.F90 @@ -602,10 +602,10 @@ subroutine CARMAMODEL_InitializeModel(carma, lq_carma, pbuf2d, rc) ! NOTE: The dust distribution has not been specified yet, but it should be different ! from the soot. - real(kind=f), parameter :: rm_dust = 0.11 ! dust mean radius (um) - real(kind=f), parameter :: sigma_dust = 1.6 ! dust variance - real(kind=f), parameter :: rm_soot = 0.11 ! soot mean radius (um) - real(kind=f), parameter :: sigma_soot = 1.6 ! soot variance + real(kind=f), parameter :: rm_dust = 0.11_r8 ! dust mean radius (um) + real(kind=f), parameter :: sigma_dust = 1.6_r8 ! dust variance + real(kind=f), parameter :: rm_soot = 0.11_r8 ! soot mean radius (um) + real(kind=f), parameter :: sigma_soot = 1.6_r8 ! soot variance integer :: i real(kind=f) :: r(NBIN) @@ -986,4 +986,4 @@ subroutine CARMAMODEL_OutputDiagnostics(carma, icnst4elem, state, ptend, pbuf, c return end subroutine CARMAMODEL_OutputDiagnostics -end module +end module carma_model_mod diff --git a/src/physics/carma/models/meteor_smoke/carma_model_mod.F90 b/src/physics/carma/models/meteor_smoke/carma_model_mod.F90 index 97d0a65a44..4ec2910f44 100644 --- a/src/physics/carma/models/meteor_smoke/carma_model_mod.F90 +++ b/src/physics/carma/models/meteor_smoke/carma_model_mod.F90 @@ -445,7 +445,7 @@ subroutine CARMAMODEL_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, end if end do - if (abs((state%lat(icol) / DEG2RAD) - 90.0) <= 0.00001_r8) then + if (abs((state%lat(icol) / DEG2RAD) - 90.0_r8) <= 0.00001_r8) then rfScale(icol) = carma_escale_grf(carma_escale_nLats, doy) end if @@ -576,7 +576,7 @@ subroutine CARMAMODEL_InitializeModel(carma, lq_carma, pbuf2d, rc) carma_emis_ilev_max = carma_emis_nLevs do ilev = 1, carma_emis_nLevs - if (carma_emis_rate(ilev) <= 0.0) then + if (carma_emis_rate(ilev) <= 0.0_r8) then carma_emis_ilev_min = ilev + 1 else exit @@ -584,7 +584,7 @@ subroutine CARMAMODEL_InitializeModel(carma, lq_carma, pbuf2d, rc) end do do ilev = carma_emis_nLevs, 1, -1 - if (carma_emis_rate(ilev) <= 0.0) then + if (carma_emis_rate(ilev) <= 0.0_r8) then carma_emis_ilev_max = ilev - 1 else exit @@ -931,4 +931,4 @@ subroutine CARMAMODEL_OutputDiagnostics(carma, icnst4elem, state, ptend, pbuf, c return end subroutine CARMAMODEL_OutputDiagnostics -end module +end module carma_model_mod diff --git a/src/physics/carma/models/mixed_sulfate/carma_model_mod.F90 b/src/physics/carma/models/mixed_sulfate/carma_model_mod.F90 index edec758519..5f21fbf4d9 100644 --- a/src/physics/carma/models/mixed_sulfate/carma_model_mod.F90 +++ b/src/physics/carma/models/mixed_sulfate/carma_model_mod.F90 @@ -518,7 +518,7 @@ subroutine CARMAMODEL_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, end if end do - if (abs((state%lat(icol) / DEG2RAD) - 90.0) <= 0.00001_r8) then + if (abs((state%lat(icol) / DEG2RAD) - 90.0_r8) <= 0.00001_r8) then rfScale(icol) = carma_escale_grf(carma_escale_nLats, doy) end if @@ -655,7 +655,7 @@ subroutine CARMAMODEL_InitializeModel(carma, lq_carma, pbuf2d, rc) carma_emis_ilev_max = carma_emis_nLevs do ilev = 1, carma_emis_nLevs - if (carma_emis_rate(ilev) <= 0.0) then + if (carma_emis_rate(ilev) <= 0.0_r8) then carma_emis_ilev_min = ilev + 1 else exit @@ -663,7 +663,7 @@ subroutine CARMAMODEL_InitializeModel(carma, lq_carma, pbuf2d, rc) end do do ilev = carma_emis_nLevs, 1, -1 - if (carma_emis_rate(ilev) <= 0.0) then + if (carma_emis_rate(ilev) <= 0.0_r8) then carma_emis_ilev_max = ilev - 1 else exit @@ -1010,4 +1010,4 @@ subroutine CARMAMODEL_OutputDiagnostics(carma, icnst4elem, state, ptend, pbuf, c return end subroutine CARMAMODEL_OutputDiagnostics -end module +end module carma_model_mod diff --git a/src/physics/carma/models/pmc/carma_model_mod.F90 b/src/physics/carma/models/pmc/carma_model_mod.F90 index 77fd4efccf..41ac20fffe 100644 --- a/src/physics/carma/models/pmc/carma_model_mod.F90 +++ b/src/physics/carma/models/pmc/carma_model_mod.F90 @@ -212,7 +212,7 @@ subroutine CARMAMODEL_DefineModel(carma, rc) ! Read in the tables. call wrap_inq_varid(fid, 'wavelength', wave_vid) call wrap_get_var_realx(fid, wave_vid, warren_wave) - warren_wave = warren_wave * 1e-4 ! um -> cm + warren_wave = warren_wave * 1e-4_r8 ! um -> cm call wrap_inq_varid(fid, 'm_real', real_vid) call wrap_get_var_realx(fid, real_vid, warren_real) @@ -562,7 +562,7 @@ subroutine CARMAMODEL_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, end if end do - if (abs((state%lat(icol) / DEG2RAD) - 90.0) <= 0.00001_r8) then + if (abs((state%lat(icol) / DEG2RAD) - 90.0_r8) <= 0.00001_r8) then rfScale(icol) = carma_escale_grf(carma_escale_nLats, doy) end if @@ -693,7 +693,7 @@ subroutine CARMAMODEL_InitializeModel(carma, lq_carma, pbuf2d, rc) carma_emis_ilev_max = carma_emis_nLevs do ilev = 1, carma_emis_nLevs - if (carma_emis_rate(ilev) <= 0.0) then + if (carma_emis_rate(ilev) <= 0.0_r8) then carma_emis_ilev_min = ilev + 1 else exit @@ -701,7 +701,7 @@ subroutine CARMAMODEL_InitializeModel(carma, lq_carma, pbuf2d, rc) end do do ilev = carma_emis_nLevs, 1, -1 - if (carma_emis_rate(ilev) <= 0.0) then + if (carma_emis_rate(ilev) <= 0.0_r8) then carma_emis_ilev_max = ilev - 1 else exit @@ -1048,4 +1048,4 @@ subroutine CARMAMODEL_OutputDiagnostics(carma, icnst4elem, state, ptend, pbuf, c return end subroutine CARMAMODEL_OutputDiagnostics -end module +end module carma_model_mod diff --git a/src/physics/carma/models/pmc_sulfate/carma_model_mod.F90 b/src/physics/carma/models/pmc_sulfate/carma_model_mod.F90 index 4a9e08d5be..166bb66f3d 100644 --- a/src/physics/carma/models/pmc_sulfate/carma_model_mod.F90 +++ b/src/physics/carma/models/pmc_sulfate/carma_model_mod.F90 @@ -223,7 +223,7 @@ subroutine CARMA_DefineModel(carma, rc) ! Read in the tables. call wrap_inq_varid(fid, 'wavelength', wave_vid) call wrap_get_var_realx(fid, wave_vid, warren_wave) - warren_wave = warren_wave * 1e-4 ! um -> cm + warren_wave = warren_wave * 1e-4_r8 ! um -> cm call wrap_inq_varid(fid, 'm_real', real_vid) call wrap_get_var_realx(fid, real_vid, warren_real) @@ -617,7 +617,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend end if end do - if (abs((state%lat(icol) / DEG2RAD) - 90.0) <= 0.00001_r8) then + if (abs((state%lat(icol) / DEG2RAD) - 90.0_r8) <= 0.00001_r8) then rfScale(icol) = carma_escale_grf(carma_escale_nLats, doy) end if @@ -753,7 +753,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) carma_emis_ilev_max = carma_emis_nLevs do ilev = 1, carma_emis_nLevs - if (carma_emis_rate(ilev) <= 0.0) then + if (carma_emis_rate(ilev) <= 0.0_r8) then carma_emis_ilev_min = ilev + 1 else exit @@ -761,7 +761,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) end do do ilev = carma_emis_nLevs, 1, -1 - if (carma_emis_rate(ilev) <= 0.0) then + if (carma_emis_rate(ilev) <= 0.0_r8) then carma_emis_ilev_max = ilev - 1 else exit @@ -953,4 +953,4 @@ subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) return end subroutine CARMA_WetDeposition -end module +end module carma_model_mod diff --git a/src/physics/carma/models/sea_salt/carma_model_mod.F90 b/src/physics/carma/models/sea_salt/carma_model_mod.F90 index 784192c29f..0f1aa889dd 100644 --- a/src/physics/carma/models/sea_salt/carma_model_mod.F90 +++ b/src/physics/carma/models/sea_salt/carma_model_mod.F90 @@ -449,7 +449,7 @@ subroutine CARMAMODEL_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, !********************************** ! wet sea salt radius at RH = 80% !********************************** - r80cm = (c1 * (r(ibin)) ** c2 / (c3 * r(ibin) ** c4 - log10(0.8)) + (r(ibin))**3) ** (1./3.) ! [cm] + r80cm = (c1 * (r(ibin)) ** c2 / (c3 * r(ibin) ** c4 - log10(0.8_r8)) + (r(ibin))**3) ** (1._r8/3._r8) ! [cm] rdrycm = r(ibin) ! [cm] r80 = r80cm *1.e4_r8 ! [um] rdry = rdrycm*1.e4_r8 ! [um] @@ -552,7 +552,7 @@ subroutine CARMAMODEL_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, !Monahan B_mona = (0.38_r8 - log10(r80)) / 0.65_r8 Monahan = 1.373_r8 * (u10in**3.41_r8) * r80**(-3._r8) * & - (1._r8 + 0.057 *r80**1.05_r8) * 10._r8 ** (1.19_r8 * exp(-1. * B_mona**2)) ! dF/dr + (1._r8 + 0.057_r8 *r80**1.05_r8) * 10._r8 ** (1.19_r8 * exp(-1._r8 * B_mona**2)) ! dF/dr !Smith u14 = u10in * (1._r8 + cd_smith**0.5_r8 / xkar * log(14._r8 / 10._r8)) ! 14 meter wind @@ -846,7 +846,7 @@ subroutine WeibullWind(u, uth, n, uwb, wbk) if (present(wbk)) then k = wbk else - k = 0.94*u**0.5_r8 ! follow Grini and Zender, 2004JGR + k = 0.94_r8*u**0.5_r8 ! follow Grini and Zender, 2004JGR ! k = 2.5_r8 ! Lansing's estimate end if @@ -976,4 +976,4 @@ subroutine CARMAMODEL_OutputDiagnostics(carma, icnst4elem, state, ptend, pbuf, c return end subroutine CARMAMODEL_OutputDiagnostics -end module +end module carma_model_mod diff --git a/src/physics/carma/models/sulfate/carma_model_mod.F90 b/src/physics/carma/models/sulfate/carma_model_mod.F90 index c0b38871ee..c19e013891 100644 --- a/src/physics/carma/models/sulfate/carma_model_mod.F90 +++ b/src/physics/carma/models/sulfate/carma_model_mod.F90 @@ -589,4 +589,4 @@ subroutine CARMAMODEL_OutputDiagnostics(carma, icnst4elem, state, ptend, pbuf, c return end subroutine CARMAMODEL_OutputDiagnostics -end module +end module carma_model_mod diff --git a/src/physics/carma/models/test_detrain/carma_model_mod.F90 b/src/physics/carma/models/test_detrain/carma_model_mod.F90 index 16e6cb431f..fde34f8b20 100644 --- a/src/physics/carma/models/test_detrain/carma_model_mod.F90 +++ b/src/physics/carma/models/test_detrain/carma_model_mod.F90 @@ -472,4 +472,4 @@ subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) return end subroutine CARMA_WetDeposition -end module +end module carma_model_mod diff --git a/src/physics/carma/models/test_growth/carma_model_mod.F90 b/src/physics/carma/models/test_growth/carma_model_mod.F90 index 1713fa1312..5b4a2b6ac7 100644 --- a/src/physics/carma/models/test_growth/carma_model_mod.F90 +++ b/src/physics/carma/models/test_growth/carma_model_mod.F90 @@ -609,4 +609,4 @@ subroutine CARMAMODEL_OutputDiagnostics(carma, icnst4elem, state, ptend, pbuf, c return end subroutine CARMAMODEL_OutputDiagnostics -end module +end module carma_model_mod diff --git a/src/physics/carma/models/test_passive/carma_model_mod.F90 b/src/physics/carma/models/test_passive/carma_model_mod.F90 index 95fa8d38ce..150f1d8a5f 100644 --- a/src/physics/carma/models/test_passive/carma_model_mod.F90 +++ b/src/physics/carma/models/test_passive/carma_model_mod.F90 @@ -529,4 +529,4 @@ subroutine CARMAMODEL_OutputDiagnostics(carma, icnst4elem, state, ptend, pbuf, c return end subroutine CARMAMODEL_OutputDiagnostics -end module +end module carma_model_mod diff --git a/src/physics/carma/models/test_radiative/carma_model_mod.F90 b/src/physics/carma/models/test_radiative/carma_model_mod.F90 index 2822327d56..d1b248df5a 100644 --- a/src/physics/carma/models/test_radiative/carma_model_mod.F90 +++ b/src/physics/carma/models/test_radiative/carma_model_mod.F90 @@ -536,4 +536,4 @@ subroutine CARMAMODEL_OutputDiagnostics(carma, icnst4elem, state, ptend, pbuf, c return end subroutine CARMAMODEL_OutputDiagnostics -end module +end module carma_model_mod diff --git a/src/physics/carma/models/test_swelling/carma_model_mod.F90 b/src/physics/carma/models/test_swelling/carma_model_mod.F90 index 0918106af0..4e98bb5cd1 100644 --- a/src/physics/carma/models/test_swelling/carma_model_mod.F90 +++ b/src/physics/carma/models/test_swelling/carma_model_mod.F90 @@ -538,4 +538,4 @@ subroutine CARMAMODEL_OutputDiagnostics(carma, icnst4elem, state, ptend, pbuf, c return end subroutine CARMAMODEL_OutputDiagnostics -end module +end module carma_model_mod diff --git a/src/physics/carma/models/test_tracers/carma_model_mod.F90 b/src/physics/carma/models/test_tracers/carma_model_mod.F90 index f585b22921..40aa2b911c 100644 --- a/src/physics/carma/models/test_tracers/carma_model_mod.F90 +++ b/src/physics/carma/models/test_tracers/carma_model_mod.F90 @@ -720,4 +720,4 @@ subroutine CARMAMODEL_OutputDiagnostics(carma, icnst4elem, state, ptend, pbuf, c return end subroutine CARMAMODEL_OutputDiagnostics -end module +end module carma_model_mod diff --git a/src/physics/carma/models/test_tracers2/carma_model_mod.F90 b/src/physics/carma/models/test_tracers2/carma_model_mod.F90 index 9eaf4d6cb7..d6a74c4d12 100644 --- a/src/physics/carma/models/test_tracers2/carma_model_mod.F90 +++ b/src/physics/carma/models/test_tracers2/carma_model_mod.F90 @@ -728,4 +728,4 @@ subroutine CARMAMODEL_OutputDiagnostics(carma, icnst4elem, state, ptend, pbuf, c return end subroutine CARMAMODEL_OutputDiagnostics -end module +end module carma_model_mod diff --git a/src/physics/carma/models/tholin/carma_model_mod.F90 b/src/physics/carma/models/tholin/carma_model_mod.F90 index 460971db9d..ac5216f130 100755 --- a/src/physics/carma/models/tholin/carma_model_mod.F90 +++ b/src/physics/carma/models/tholin/carma_model_mod.F90 @@ -102,7 +102,7 @@ subroutine CARMA_DefineModel(carma, rc) integer, intent(out) :: rc !! return code, negative indicates failure ! Local variables - real(kind=f) :: RHO_THOLIN = 0.64 ! density of tholin particles (g/cm) + real(kind=f) :: RHO_THOLIN = 0.64_f ! density of tholin particles (g/cm) real(kind=f), parameter :: tholin_rmin = 1.e-7_f ! dust minimum radius (cm) real(kind=f), parameter :: tholin_vmrat = 2.5_f ! dust volume ratio @@ -509,7 +509,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) carma_emis_ilev_max = carma_emis_nLevs do ilev = 1, carma_emis_nLevs - if (carma_emis_rate(ilev) <= 0.0) then + if (carma_emis_rate(ilev) <= 0.0_r8) then carma_emis_ilev_min = ilev + 1 else exit @@ -517,7 +517,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) end do do ilev = carma_emis_nLevs, 1, -1 - if (carma_emis_rate(ilev) <= 0.0) then + if (carma_emis_rate(ilev) <= 0.0_r8) then carma_emis_ilev_max = ilev - 1 else exit @@ -639,4 +639,4 @@ subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) return end subroutine CARMA_WetDeposition -end module +end module carma_model_mod diff --git a/test/system/TR8.sh b/test/system/TR8.sh index cbdb400463..22ec597f5d 100755 --- a/test/system/TR8.sh +++ b/test/system/TR8.sh @@ -10,6 +10,8 @@ ruby $ADDREALKIND_EXE -r r8 -l 1 -d $CAM_ROOT/components/cam/src/physics/cam rc=$? ruby $ADDREALKIND_EXE -r r8 -l 1 -d $CAM_ROOT/components/cam/src/physics/camrt rc=`expr $? + $rc` +ruby $ADDREALKIND_EXE -r r8 -l 1 -d $CAM_ROOT/components/cam/src/physics/carma +rc=`expr $? + $rc` ruby $ADDREALKIND_EXE -r r8 -l 1 -d $CAM_ROOT/components/cam/src/physics/rrtmg -s aer_src rc=`expr $? + $rc` ruby $ADDREALKIND_EXE -r r8 -l 1 -d $CAM_ROOT/components/cam/src/physics/rrtmgp -s data,ext @@ -27,6 +29,8 @@ ruby $ADDREALKIND_EXE -r r8 -l 1 -d $CAM_ROOT/src/physics/cam rc=$? ruby $ADDREALKIND_EXE -r r8 -l 1 -d $CAM_ROOT/src/physics/camrt rc=`expr $? + $rc` +ruby $ADDREALKIND_EXE -r r8 -l 1 -d $CAM_ROOT/src/physics/carma +rc=$? ruby $ADDREALKIND_EXE -r r8 -l 1 -d $CAM_ROOT/src/physics/rrtmg -s aer_src rc=`expr $? + $rc` ruby $ADDREALKIND_EXE -r r8 -l 1 -d $CAM_ROOT/src/physics/rrtmgp -s data,ext From 7b87c3a9f50e3efed42df97c25a50dcc0126d807 Mon Sep 17 00:00:00 2001 From: Francis Vitt <fvitt@ucar.edu> Date: Thu, 12 Dec 2024 09:43:55 -0700 Subject: [PATCH 03/24] updates to carma regression tests modified: cime_config/testdefs/testlist_cam.xml --- cime_config/testdefs/testlist_cam.xml | 120 ++++++++++++++++++++++++-- 1 file changed, 113 insertions(+), 7 deletions(-) diff --git a/cime_config/testdefs/testlist_cam.xml b/cime_config/testdefs/testlist_cam.xml index c95f004d25..d4fc9d40a8 100644 --- a/cime_config/testdefs/testlist_cam.xml +++ b/cime_config/testdefs/testlist_cam.xml @@ -582,6 +582,15 @@ <test compset="F2000climo" grid="f10_f10_mg37" name="ERS_D_Ln9" testmods="cam/carma_dust"> <machines> <machine name="izumi" compiler="nag" category="carma"/> + <machine name="izumi" compiler="gnu" category="carma"/> + </machines> + <options> + <option name="comment" >CARMA dust test</option> + <option name="wallclock">00:30:00</option> + </options> + </test> + <test compset="F2000climo" grid="f19_f19_mg17" name="ERS_D_Ln9" testmods="cam/carma_dust"> + <machines> <machine name="derecho" compiler="intel" category="carma"/> </machines> <options> @@ -602,7 +611,16 @@ <test compset="QPC5" grid="f10_f10_mg37" name="ERC_D_Ln9" testmods="cam/carma_sea_salt"> <machines> <machine name="izumi" compiler="nag" category="carma"/> + <machine name="izumi" compiler="gnu" category="carma"/> <machine name="izumi" compiler="nag" category="aux_cam"/> + </machines> + <options> + <option name="comment" >CARMA sea salt test</option> + <option name="wallclock">00:30:00</option> + </options> + </test> + <test compset="QPC5" grid="f45_f45_mg37" name="ERC_D_Ln9" testmods="cam/carma_sea_salt"> + <machines> <machine name="derecho" compiler="intel" category="carma"/> </machines> <options> @@ -614,7 +632,15 @@ <test compset="QPWmaC6" grid="f10_f10_mg37" name="ERS_D_Ln9" testmods="cam/carma_meteor_smoke"> <machines> <machine name="izumi" compiler="nag" category="carma"/> - <machine name="derecho" compiler="intel" category="carma"/> + </machines> + <options> + <option name="comment" >CARMA test of aerosol from meteor smoke</option> + <option name="wallclock">00:30:00</option> + </options> + </test> + <test compset="QPWmaC6" grid="f45_f45_mg37" name="ERS_D_Ln9" testmods="cam/carma_meteor_smoke"> + <machines> + <machine name="izumi" compiler="nag" category="carma"/> </machines> <options> <option name="comment" >CARMA test of aerosol from meteor smoke</option> @@ -625,6 +651,15 @@ <test compset="QPWmaC6" grid="f10_f10_mg37" name="ERS_D_Ln9" testmods="cam/carma_meteor_impact"> <machines> <machine name="izumi" compiler="nag" category="carma"/> + <machine name="izumi" compiler="gnu" category="carma"/> + </machines> + <options> + <option name="comment" >CARMA test of aerosols from meteor impact</option> + <option name="wallclock">00:30:00</option> + </options> + </test> + <test compset="QPWmaC6" grid="f45_f45_mg37" name="ERS_D_Ln9" testmods="cam/carma_meteor_impact"> + <machines> <machine name="derecho" compiler="intel" category="carma"/> </machines> <options> @@ -636,6 +671,15 @@ <test compset="QPWmaC6" grid="f10_f10_mg37" name="ERS_D_Ln9" testmods="cam/carma_pmc"> <machines> <machine name="izumi" compiler="nag" category="carma"/> + <machine name="izumi" compiler="gnu" category="carma"/> + </machines> + <options> + <option name="comment" >CARMA Test of Polar Mesospheric Clouds (pmc)</option> + <option name="wallclock">00:30:00</option> + </options> + </test> + <test compset="QPWmaC6" grid="f45_f45_mg37" name="ERS_D_Ln9" testmods="cam/carma_pmc"> + <machines> <machine name="derecho" compiler="intel" category="carma"/> </machines> <options> @@ -647,6 +691,14 @@ <test compset="QPC5" grid="f10_f10_mg37" name="ERS_D_Ln9" testmods="cam/carma_test_radiative"> <machines> <machine name="izumi" compiler="nag" category="carma"/> + </machines> + <options> + <option name="comment" >CARMA radiation test</option> + <option name="wallclock">00:30:00</option> + </options> + </test> + <test compset="QPC5" grid="f45_f45_mg37" name="ERS_D_Ln9" testmods="cam/carma_test_radiative"> + <machines> <machine name="derecho" compiler="intel" category="carma"/> </machines> <options> @@ -655,9 +707,17 @@ </options> </test> <!-- carma test_tracers --> - <test compset="QPC5" grid="f10_f10_mg37" name="ERS_D_Ln9" testmods="cam/carma_test_tracers"> + <test compset="QPC5" grid="f10_f10_mg37" name="ERC_D_Ln9" testmods="cam/carma_test_tracers"> <machines> <machine name="izumi" compiler="nag" category="carma"/> + </machines> + <options> + <option name="comment" >CARMA tracers test</option> + <option name="wallclock">00:30:00</option> + </options> + </test> + <test compset="QPC5" grid="f45_f45_mg37" name="ERC_D_Ln9" testmods="cam/carma_test_tracers"> + <machines> <machine name="derecho" compiler="intel" category="carma"/> </machines> <options> @@ -669,6 +729,14 @@ <test compset="QPC5" grid="f10_f10_mg37" name="ERC_D_Ln9" testmods="cam/carma_test_tracers2"> <machines> <machine name="izumi" compiler="nag" category="carma"/> + </machines> + <options> + <option name="comment" >CARMA tracers2 test</option> + <option name="wallclock">00:30:00</option> + </options> + </test> + <test compset="QPC5" grid="f45_f45_mg37" name="ERC_D_Ln9" testmods="cam/carma_test_tracers2"> + <machines> <machine name="derecho" compiler="intel" category="carma"/> </machines> <options> @@ -680,6 +748,14 @@ <test compset="QPC5" grid="f10_f10_mg37" name="ERC_D_Ln9" testmods="cam/carma_test_passive"> <machines> <machine name="izumi" compiler="nag" category="carma"/> + </machines> + <options> + <option name="comment" >CARMA passive test</option> + <option name="wallclock">00:30:00</option> + </options> + </test> + <test compset="QPC5" grid="f45_f45_mg37" name="ERC_D_Ln9" testmods="cam/carma_test_passive"> + <machines> <machine name="derecho" compiler="intel" category="carma"/> </machines> <options> @@ -691,6 +767,15 @@ <test compset="QPC5" grid="f10_f10_mg37" name="ERC_D_Ln9" testmods="cam/carma_test_swelling"> <machines> <machine name="izumi" compiler="nag" category="carma"/> + <machine name="izumi" compiler="gnu" category="carma"/> + </machines> + <options> + <option name="comment" >CARMA particle swelling test</option> + <option name="wallclock">00:30:00</option> + </options> + </test> + <test compset="QPC5" grid="f45_f45_mg37" name="ERC_D_Ln9" testmods="cam/carma_test_swelling"> + <machines> <machine name="derecho" compiler="intel" category="carma"/> </machines> <options> @@ -738,6 +823,14 @@ <test compset="FW4ma2000" grid="f10_f10_mg37" name="SMS_D_Ln9" testmods="cam/carma_sulfate"> <machines> <machine name="izumi" compiler="nag" category="carma"/> + </machines> + <options> + <option name="comment" >CARMA pure sulfate test</option> + <option name="wallclock">00:30:00</option> + </options> + </test> + <test compset="FW4ma2000" grid="f45_f45_mg37" name="SMS_D_Ln9" testmods="cam/carma_sulfate"> + <machines> <machine name="derecho" compiler="intel" category="carma"/> </machines> <options> @@ -749,6 +842,14 @@ <test compset="FW4ma2000" grid="f10_f10_mg37" name="ERS_D_Ln9" testmods="cam/carma_mixed_sulfate"> <machines> <machine name="izumi" compiler="nag" category="carma"/> + </machines> + <options> + <option name="comment" >CARMA mixed sulfate test</option> + <option name="wallclock">00:30:00</option> + </options> + </test> + <test compset="FW4ma2000" grid="f45_f45_mg37" name="ERS_D_Ln9" testmods="cam/carma_mixed_sulfate"> + <machines> <machine name="derecho" compiler="intel" category="carma"/> </machines> <options> @@ -757,28 +858,28 @@ </options> </test> <!-- carma test_growth --> - <test compset="QPC5" grid="f10_f10_mg37" name="ERC_D_Ln9" testmods="cam/carma_test_growth"> + <test compset="QPC5" grid="f10_f10_mg37" name="ERS_D_Ln9" testmods="cam/carma_test_growth"> <machines> <machine name="izumi" compiler="nag" category="carma"/> - <machine name="derecho" compiler="intel" category="carma"/> </machines> <options> <option name="comment" >CARMA particle growth test</option> <option name="wallclock">00:30:00</option> </options> </test> - <test compset="F2000climo" grid="ne5pg3_ne5pg3_mg37" name="ERC_D_Ln9" testmods="cam/carma_dust"> + <test compset="QPC5" grid="f45_f45_mg37" name="ERS_D_Ln9" testmods="cam/carma_test_growth"> <machines> - <machine name="izumi" compiler="nag" category="carma"/> + <machine name="derecho" compiler="intel" category="carma"/> </machines> <options> - <option name="comment" >Low-res unstructured grid CARMA dust test</option> + <option name="comment" >CARMA particle growth test</option> <option name="wallclock">00:30:00</option> </options> </test> <test compset="QPC5" grid="ne5_ne5_mg37" name="SMS_D_Ln9" testmods="cam/carma_sea_salt"> <machines> <machine name="izumi" compiler="nag" category="carma"/> + <machine name="izumi" compiler="gnu" category="carma"/> <machine name="derecho" compiler="intel" category="carma"/> </machines> <options> @@ -799,6 +900,7 @@ <test compset="QPC5" grid="ne5_ne5_mg37" name="SMS_D_Ln9" testmods="cam/carma_test_passive"> <machines> <machine name="izumi" compiler="nag" category="carma"/> + <machine name="izumi" compiler="gnu" category="carma"/> <machine name="derecho" compiler="intel" category="carma"/> </machines> <options> @@ -809,6 +911,7 @@ <test compset="QPC5" grid="ne5_ne5_mg37" name="SMS_D_Ln9" testmods="cam/carma_test_swelling"> <machines> <machine name="izumi" compiler="nag" category="carma"/> + <machine name="izumi" compiler="gnu" category="carma"/> <machine name="derecho" compiler="intel" category="carma"/> </machines> <options> @@ -829,6 +932,7 @@ <test compset="QPC5" grid="ne5_ne5_mg37" name="SMS_D_Ln9" testmods="cam/carma_test_radiative"> <machines> <machine name="izumi" compiler="nag" category="carma"/> + <machine name="izumi" compiler="gnu" category="carma"/> <machine name="derecho" compiler="intel" category="carma"/> </machines> <options> @@ -839,6 +943,7 @@ <test compset="QPC5" grid="ne5_ne5_mg37" name="ERC_D_Ln9" testmods="cam/carma_test_tracers"> <machines> <machine name="izumi" compiler="nag" category="carma"/> + <machine name="izumi" compiler="gnu" category="carma"/> <machine name="derecho" compiler="intel" category="carma"/> </machines> <options> @@ -859,6 +964,7 @@ <test compset="QPWmaC6" grid="ne5pg3_ne5pg3_mg37" name="SMS_D_Ln9" testmods="cam/carma_meteor_smoke"> <machines> <machine name="izumi" compiler="nag" category="carma"/> + <machine name="izumi" compiler="gnu" category="carma"/> <machine name="derecho" compiler="intel" category="carma"/> </machines> <options> From 69fa095b9c5693896d1c46752186ba2611bc8a03 Mon Sep 17 00:00:00 2001 From: Francis Vitt <fvitt@ucar.edu> Date: Thu, 12 Dec 2024 16:44:21 -0700 Subject: [PATCH 04/24] revert a few changes modified: src/physics/cam/ndrop.F90 modified: src/physics/cam/nucleate_ice.F90 modified: src/physics/cam/physics_types.F90 --- src/physics/cam/ndrop.F90 | 2 +- src/physics/cam/nucleate_ice.F90 | 22 ++++++++-------------- src/physics/cam/physics_types.F90 | 6 +++--- 3 files changed, 12 insertions(+), 18 deletions(-) diff --git a/src/physics/cam/ndrop.F90 b/src/physics/cam/ndrop.F90 index 7b9e4e8d19..9eea87d218 100644 --- a/src/physics/cam/ndrop.F90 +++ b/src/physics/cam/ndrop.F90 @@ -105,7 +105,7 @@ subroutine ndrop_init(aero_props) do m = 1, aero_props%nbins() - do l = 0, aero_props%nspecies(m) + do l = 0, aero_props%nmasses(m) mm = aero_props%indexer(m,l) diff --git a/src/physics/cam/nucleate_ice.F90 b/src/physics/cam/nucleate_ice.F90 index 42db39a083..ac7268c068 100644 --- a/src/physics/cam/nucleate_ice.F90 +++ b/src/physics/cam/nucleate_ice.F90 @@ -226,11 +226,9 @@ subroutine nucleati( & if ( ((tc.le.0.0_r8).and.(tc.ge.-37.0_r8).and.(qc.lt.1.e-12_r8)).or.(tc.le.-37.0_r8)) then - if ( (soot_num+dst_num) > 0._r8) then - A = -1.4938_r8 * log(soot_num+dst_num) + 12.884_r8 - B = -10.41_r8 * log(soot_num+dst_num) - 67.69_r8 - regm = A * log(wbar1) + B - end if + A = -1.4938_r8 * log(soot_num+dst_num) + 12.884_r8 + B = -10.41_r8 * log(soot_num+dst_num) - 67.69_r8 + regm = A * log(wbar1) + B ! heterogeneous nucleation only if (tc .gt. regm .or. so4_num < 1.0e-10_r8) then @@ -262,11 +260,8 @@ subroutine nucleati( & nihf = 0._r8 n1 = niimm + nidep - if ( (soot_num+dst_num) > 0._r8) then - osoot_num = soot_num * (niimm + nidep) / (soot_num + dst_num) - odst_num = dst_num * (niimm + nidep) / (soot_num + dst_num) - end if - + osoot_num = soot_num * (niimm + nidep) / (soot_num + dst_num) + odst_num = dst_num * (niimm + nidep) / (soot_num + dst_num) endif ! homogeneous nucleation only @@ -327,10 +322,8 @@ subroutine nucleati( & oso4_num = nihf endif - if ( (soot_num+dst_num) > 0._r8) then - osoot_num = soot_num * (niimm + nidep) / (soot_num + dst_num) - odst_num = dst_num * (niimm + nidep) / (soot_num + dst_num) - end if + osoot_num = soot_num * (niimm + nidep) / (soot_num + dst_num) + odst_num = dst_num * (niimm + nidep) / (soot_num + dst_num) nihf = nihf * fhom * ((regm - tc) / 5._r8)**2 oso4_num = oso4_num * fhom * ((regm - tc) / 5._r8)**2 @@ -589,3 +582,4 @@ subroutine frachom(Tmean,RHimean,detaT,fhom) end subroutine frachom end module nucleate_ice + diff --git a/src/physics/cam/physics_types.F90 b/src/physics/cam/physics_types.F90 index 534f87c95f..3228c27105 100644 --- a/src/physics/cam/physics_types.F90 +++ b/src/physics/cam/physics_types.F90 @@ -223,7 +223,7 @@ subroutine physics_update(state, ptend, dt, tend) real(r8), intent(in) :: dt ! time step type(physics_tend ), intent(inout), optional :: tend ! Physics tendencies over timestep - ! tend is usually only needed by calls from physpkg. + ! tend is usually only needed by calls from physpkg. ! !---------------------------Local storage------------------------------- integer :: k,m ! column,level,constituent indices @@ -1267,10 +1267,10 @@ subroutine physics_dme_adjust(state, tend, qini, liqini, iceini, dt) ! if (.not.(dycore_is('MPAS') .or. dycore_is('SE'))) then do k = 1, pver - + ! adjusment factor is just change in water vapor fdq(:ncol) = 1._r8 + state%q(:ncol,k,1) - qini(:ncol,k) - + ! adjust constituents to conserve mass in each layer do m = 1, pcnst state%q(:ncol,k,m) = state%q(:ncol,k,m) / fdq(:ncol) From 57651798d52de21265758c3c1e558a5c838f0fca Mon Sep 17 00:00:00 2001 From: Francis Vitt <fvitt@ucar.edu> Date: Mon, 16 Dec 2024 15:43:43 -0700 Subject: [PATCH 05/24] add missing r8 real kind specifiers modified: src/chemistry/aerosol/carma_aerosol_properties_mod.F90 modified: src/chemistry/carma_aero/carma_aero_gasaerexch.F90 modified: src/physics/carma/cam/carma_intr.F90 modified: src/physics/carma/models/trop_strat_soa1/carma_model_mod.F90 modified: src/physics/carma/models/trop_strat_soa5/carma_model_mod.F90 --- src/chemistry/aerosol/carma_aerosol_properties_mod.F90 | 2 +- src/chemistry/carma_aero/carma_aero_gasaerexch.F90 | 2 +- src/physics/carma/cam/carma_intr.F90 | 4 ++-- .../carma/models/trop_strat_soa1/carma_model_mod.F90 | 10 +++++----- .../carma/models/trop_strat_soa5/carma_model_mod.F90 | 10 +++++----- 5 files changed, 14 insertions(+), 14 deletions(-) diff --git a/src/chemistry/aerosol/carma_aerosol_properties_mod.F90 b/src/chemistry/aerosol/carma_aerosol_properties_mod.F90 index ebf50759bc..57d513d48b 100644 --- a/src/chemistry/aerosol/carma_aerosol_properties_mod.F90 +++ b/src/chemistry/aerosol/carma_aerosol_properties_mod.F90 @@ -716,7 +716,7 @@ function scav_diam(self, bin_ndx) result(diam) end do ! specdens kg/m3 to g/cm3, convert from radius to diameter - diam = 2._r8*((0.75*mass / pi / (1.0e-3_r8*rho))**onethird) + diam = 2._r8*((0.75_r8*mass / pi / (1.0e-3_r8*rho))**onethird) end function scav_diam diff --git a/src/chemistry/carma_aero/carma_aero_gasaerexch.F90 b/src/chemistry/carma_aero/carma_aero_gasaerexch.F90 index e78b9f9406..ed8cf30859 100644 --- a/src/chemistry/carma_aero/carma_aero_gasaerexch.F90 +++ b/src/chemistry/carma_aero/carma_aero_gasaerexch.F90 @@ -777,7 +777,7 @@ subroutine gas_aer_uptkrates( ncol, loffset, & gasspeed = 1.470e1_r8 * sqrt(t(i,k)) ! freepathx2 = 2 * (h2so4 mean free path) (m) freepathx2 = 6.0_r8*gasdiffus/gasspeed - dp = wetr(i,k,n) * 1.e-2 ! meters + dp = wetr(i,k,n) * 1.e-2_r8 ! meters const = tworootpi * num_bin(i,k,n) * 2.0_r8 * dp ! gas_conden_rate(Dp) = const * gasdiffus * F(Kn,ac) ! knudsen number diff --git a/src/physics/carma/cam/carma_intr.F90 b/src/physics/carma/cam/carma_intr.F90 index 47af8ff6fc..72ca0b5f87 100644 --- a/src/physics/carma/cam/carma_intr.F90 +++ b/src/physics/carma/cam/carma_intr.F90 @@ -3951,8 +3951,8 @@ subroutine carma_get_wet_radius(state, igroup, ibin, rwet, rhopwet, rc) end do ! Convert rwet and rhopwet to mks units - rwet(:ncol,:) = rwet(:ncol,:) * 1.e-2 ! cm --> m - rhopwet(:ncol,:) = rhopwet(:ncol,:) * 1.e3 ! g/cm3 --> kg/m3 + rwet(:ncol,:) = rwet(:ncol,:) * 1.e-2_r8 ! cm --> m + rhopwet(:ncol,:) = rhopwet(:ncol,:) * 1.e3_r8 ! g/cm3 --> kg/m3 if (rc/=RC_OK) then call endrun('carma_get_wet_radius ERROR8: rc = ',rc) diff --git a/src/physics/carma/models/trop_strat_soa1/carma_model_mod.F90 b/src/physics/carma/models/trop_strat_soa1/carma_model_mod.F90 index ad8967f688..50d9981ff4 100644 --- a/src/physics/carma/models/trop_strat_soa1/carma_model_mod.F90 +++ b/src/physics/carma/models/trop_strat_soa1/carma_model_mod.F90 @@ -235,7 +235,7 @@ module carma_model_mod 3.74323598e-08_f, 1.63841034e-09_f, 2.49434956e-09_f, 1.52413800e-08_f, & 3.35000010e-08_f, 3.43825518e-02_f /) - + real(r8), parameter :: onethird = 1._r8/3._r8 contains @@ -1657,11 +1657,11 @@ subroutine CARMAMODEL_CreateOpticsFile_MixedYu(carma, igroup, rc) do iwave = 1, NWAVE ! For now just assume BC/OC constant 15% - ! rcore = r(ibin)*(0.15**(1./3)) + ! rcore = r(ibin)*(0.15**onethird) ! Using Mie code, consider core/shell ratio do icsr = 1, ncsr if (ncsr > 1) then - rcore = r(ibin)*(coreshellratio(icsr)**(1./3)) + rcore = r(ibin)*(coreshellratio(icsr)**onethird) else rcore = 0.0_f endif @@ -2109,11 +2109,11 @@ subroutine CARMAMODEL_CreateOpticsFile_MixedYuH2o(carma, igroup, rc) do iwave = 1, NWAVE ! For now just assume BC/OC constant 15% - ! rcore = r(ibin)*(0.15**(1./3)) + ! rcore = r(ibin)*(0.15**onethird) ! Using Mie code, consider core/shell ratio do icsr = 1, ncsr if (ncsr > 1) then - rcore = r(ibin)*(coreshellratio(icsr)**(1./3)) + rcore = r(ibin)*(coreshellratio(icsr)**onethird) else rcore = 0.0_f endif diff --git a/src/physics/carma/models/trop_strat_soa5/carma_model_mod.F90 b/src/physics/carma/models/trop_strat_soa5/carma_model_mod.F90 index ec657f70a5..7bbd8f9907 100644 --- a/src/physics/carma/models/trop_strat_soa5/carma_model_mod.F90 +++ b/src/physics/carma/models/trop_strat_soa5/carma_model_mod.F90 @@ -255,7 +255,7 @@ module carma_model_mod 3.74323598e-08_f, 1.63841034e-09_f, 2.49434956e-09_f, 1.52413800e-08_f, & 3.35000010e-08_f, 3.43825518e-02_f /) - + real(r8), parameter :: onethird = 1._r8/3._r8 contains @@ -1859,11 +1859,11 @@ subroutine CARMAMODEL_CreateOpticsFile_MixedYu(carma, igroup, rc) do iwave = 1, NWAVE ! For now just assume BC/OC constant 15% - ! rcore = r(ibin)*(0.15**(1./3)) + ! rcore = r(ibin)*(0.15**onethird) ! Using Mie code, consider core/shell ratio do icsr = 1, ncsr if (ncsr > 1) then - rcore = r(ibin)*(coreshellratio(icsr)**(1./3)) + rcore = r(ibin)*(coreshellratio(icsr)**onethird) else rcore = 0.0_f endif @@ -2311,11 +2311,11 @@ subroutine CARMAMODEL_CreateOpticsFile_MixedYuH2o(carma, igroup, rc) do iwave = 1, NWAVE ! For now just assume BC/OC constant 15% - ! rcore = r(ibin)*(0.15**(1./3)) + ! rcore = r(ibin)*(0.15**onethird) ! Using Mie code, consider core/shell ratio do icsr = 1, ncsr if (ncsr > 1) then - rcore = r(ibin)*(coreshellratio(icsr)**(1./3)) + rcore = r(ibin)*(coreshellratio(icsr)**onethird) else rcore = 0.0_f endif From 4ebb0c8173ee5f35b63d0ab8505c2356c92856b4 Mon Sep 17 00:00:00 2001 From: Francis Vitt <fvitt@ucar.edu> Date: Mon, 16 Dec 2024 16:18:09 -0700 Subject: [PATCH 06/24] corrections for chem none and prescribed bulk aero and emis namelist settings modified: bld/build-namelist modified: src/physics/cam/nucleate_ice_cam.F90 --- bld/build-namelist | 9 +++-- src/physics/cam/nucleate_ice_cam.F90 | 54 ++++++++++++++-------------- 2 files changed, 35 insertions(+), 28 deletions(-) diff --git a/bld/build-namelist b/bld/build-namelist index 4760f3629d..258b54f048 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -2493,7 +2493,7 @@ if ($phys =~ /cam6/ or $phys =~ /cam7/) { } } } - if ($chem !~ /geoschem/) { + if (($chem !~ /geoschem/) and ($chem ne 'none')) { add_default($nl, 'srf_emis_specifier', 'val'=>$val); unless (defined $nl->get_value('srf_emis_type')) { add_default($nl, 'srf_emis_type', 'val'=>'CYCLICAL'); @@ -2515,6 +2515,11 @@ if ($phys =~ /cam6/ or $phys =~ /cam7/) { } # air craft emissions if ($chem !~ /trop_mam/ and $chem !~ /ghg_mam/ and $chem !~ /waccm_sc/) { + if ($chem !~ /_noaer/) { + %species = (%species, + 'bc_a4_ar_ext_file' => 'bc_a4', + 'num_a4_ar_ext_file' => 'num_a4' ); + } %species = (%species, 'no2_ar_ext_file' => 'NO2', 'so2_ar_ext_file' => 'SO2' ); @@ -2564,7 +2569,7 @@ if ($phys =~ /cam6/ or $phys =~ /cam7/) { $first = 0; } } - if ($chem !~ /geoschem/) { + if (($chem !~ /geoschem/) and ($chem ne 'none')) { add_default($nl, 'ext_frc_specifier', 'val'=>$val); unless (defined $nl->get_value('ext_frc_type')) { add_default($nl, 'ext_frc_type', 'val'=>"'CYCLICAL'"); diff --git a/src/physics/cam/nucleate_ice_cam.F90 b/src/physics/cam/nucleate_ice_cam.F90 index 7d26ca83a5..ac5b9c8929 100644 --- a/src/physics/cam/nucleate_ice_cam.F90 +++ b/src/physics/cam/nucleate_ice_cam.F90 @@ -485,17 +485,19 @@ subroutine nucleate_ice_cam_calc( & qi => state%q(:,:,cldice_idx) ni => state%q(:,:,numice_idx) pmid => state%pmid - nbins = aero_props%nbins() - nmaxspc = maxval(aero_props%nspecies()) - allocate(size_wght(ncol,pver,nbins,nmaxspc)) - allocate(amb_num_bins(ncol,pver,nbins)) + if (present(aero_props)) then + nbins = aero_props%nbins() + nmaxspc = maxval(aero_props%nspecies()) - do k = 1, pver - do i = 1, ncol - rho(i,k) = pmid(i,k)/(rair*t(i,k)) - end do - end do + allocate(size_wght(ncol,pver,nbins,nmaxspc)) + allocate(amb_num_bins(ncol,pver,nbins)) + else + nbins = 0 + nmaxspc = 0 + endif + + rho(:ncol,:) = pmid(:ncol,:)/(rair*t(:ncol,:)) if (clim_modal_carma) then @@ -618,6 +620,17 @@ subroutine nucleate_ice_cam_calc( & call aero_state%nuclice_get_numdens( aero_props, use_preexisting_ice, ncol, pver, rho, & dust_num_col, sulf_num_col, soot_num_col, sulf_num_tot_col ) + do m = 1, aero_props%nbins() + call aero_state%get_ambient_num(m, amb_num) + amb_num_bins(:ncol,:,m) = amb_num(:ncol,:) + do l = 1, aero_props%nspecies(m) + call aero_props%species_type(m, l, spectype) + call aero_state%icenuc_size_wght( m, ncol, pver, spectype, use_preexisting_ice, size_wght(:,:,m,l)) + + !size_wght(:ncol,:,m,l) = wght(:ncol,:) + end do + end do + else ! for bulk model dust_num_col(:ncol,:) = naer2(:ncol,:,idxdst1)/25._r8 * per_cm3 & ! #/cm3 @@ -628,21 +641,6 @@ subroutine nucleate_ice_cam_calc( & soot_num_col(:ncol,:) = naer2(:ncol,:,idxbcphi)/25._r8 * per_cm3 endif - do m = 1, aero_props%nbins() - call aero_state%get_ambient_num(m, amb_num) - amb_num_bins(:ncol,:,m) = amb_num(:ncol,:) - end do - - do m = 1, aero_props%nbins() - do l = 1, aero_props%nspecies(m) - call aero_props%species_type(m, l, spectype) - call aero_state%icenuc_size_wght( m, ncol, pver, spectype, use_preexisting_ice, size_wght(:,:,m,l)) - - !size_wght(:ncol,:,m,l) = wght(:ncol,:) - end do - end do - - kloop: do k = top_lev, pver iloop: do i = 1, ncol @@ -926,8 +924,12 @@ subroutine nucleate_ice_cam_calc( & call outfld('INFreIN ',INFreIN, pcols,lchnk) end if - deallocate(size_wght) - deallocate(amb_num_bins) + if (allocated(size_wght)) then + deallocate(size_wght) + end if + if (allocated(amb_num_bins)) then + deallocate(amb_num_bins) + end if end subroutine nucleate_ice_cam_calc From 03de1a4d90311362e6b04d1eed96106023c7d432 Mon Sep 17 00:00:00 2001 From: Francis Vitt <fvitt@ucar.edu> Date: Tue, 17 Dec 2024 10:29:53 -0700 Subject: [PATCH 07/24] fix spcam -- constistent setsox interfacing modified: src/chemistry/aerosol/mo_setsox.F90 modified: src/chemistry/bulk_aero/aero_model.F90 modified: src/chemistry/bulk_aero/sox_cldaero_mod.F90 modified: src/chemistry/carma_aero/aero_model.F90 modified: src/chemistry/carma_aero/sox_cldaero_mod.F90 modified: src/chemistry/modal_aero/aero_model.F90 modified: src/chemistry/modal_aero/sox_cldaero_mod.F90 modified: src/physics/spcam/ecpp/ecpp_modal_cloudchem.F90 modified: src/physics/spcam/ecpp/module_ecpp_ppdriver2.F90 modified: src/physics/spcam/ecpp/module_ecpp_td2clm.F90 --- src/chemistry/aerosol/mo_setsox.F90 | 13 +-- src/chemistry/bulk_aero/aero_model.F90 | 1 - src/chemistry/bulk_aero/sox_cldaero_mod.F90 | 8 +- src/chemistry/carma_aero/aero_model.F90 | 1 - src/chemistry/carma_aero/sox_cldaero_mod.F90 | 12 +- src/chemistry/modal_aero/aero_model.F90 | 1 - src/chemistry/modal_aero/sox_cldaero_mod.F90 | 13 +-- .../spcam/ecpp/ecpp_modal_cloudchem.F90 | 105 +++++++++--------- .../spcam/ecpp/module_ecpp_ppdriver2.F90 | 2 +- src/physics/spcam/ecpp/module_ecpp_td2clm.F90 | 14 ++- 10 files changed, 81 insertions(+), 89 deletions(-) diff --git a/src/chemistry/aerosol/mo_setsox.F90 b/src/chemistry/aerosol/mo_setsox.F90 index 057bbb00ba..0c0f990583 100644 --- a/src/chemistry/aerosol/mo_setsox.F90 +++ b/src/chemistry/aerosol/mo_setsox.F90 @@ -2,8 +2,7 @@ module mo_setsox use shr_kind_mod, only : r8 => shr_kind_r8 use cam_logfile, only : iulog - use physics_buffer,only: physics_buffer_desc, pbuf_get_index, pbuf_add_field, dtype_r8 - use physics_types, only: physics_state + use physics_types,only : physics_state implicit none @@ -134,7 +133,6 @@ end subroutine sox_inti !----------------------------------------------------------------------- !----------------------------------------------------------------------- subroutine setsox( state, & - pbuf, & ncol, & lchnk, & loffset,& @@ -187,6 +185,7 @@ subroutine setsox( state, & !----------------------------------------------------------------------- ! ... Dummy arguments !----------------------------------------------------------------------- + type(physics_state), intent(in) :: state ! Physics state variables integer, intent(in) :: ncol ! num of columns in chunk integer, intent(in) :: lchnk ! chunk id integer, intent(in) :: loffset ! offset of chem tracers in the advected tracers array @@ -212,10 +211,6 @@ subroutine setsox( state, & real(r8), intent(out), optional :: aqso4_h2o2_3d(:, :) ! 3D SO4 aqueous phase chemistry due to H2O2 (kg/m2) real(r8), intent(out), optional :: aqso4_o3_3d(:, :) ! 3D SO4 aqueous phase chemistry due to O3 (kg/m2) - type(physics_state), intent(in) :: state ! Physics state variables - - type(physics_buffer_desc), pointer :: pbuf(:) - !----------------------------------------------------------------------- ! ... Local variables ! @@ -864,8 +859,8 @@ subroutine setsox( state, & end do col_loop1 end do ver_loop1 - call sox_cldaero_update( state, & - pbuf, ncol, lchnk, loffset, dtime, mbar, pdel, press, tfld, cldnum, cldfrc, cfact, cldconc%xlwc, & + call sox_cldaero_update( & + state, ncol, lchnk, loffset, dtime, mbar, pdel, press, tfld, cldnum, cldfrc, cfact, cldconc%xlwc, & xdelso4hp, xh2so4, xso4, xso4_init, nh3g, hno3g, xnh3, xhno3, xnh4c, xno3c, xmsa, xso2, xh2o2, qcw, qin, & aqso4, aqh2so4, aqso4_h2o2, aqso4_o3, aqso4_h2o2_3d=aqso4_h2o2_3d, aqso4_o3_3d=aqso4_o3_3d ) diff --git a/src/chemistry/bulk_aero/aero_model.F90 b/src/chemistry/bulk_aero/aero_model.F90 index 015a4746a8..51779bd1b4 100644 --- a/src/chemistry/bulk_aero/aero_model.F90 +++ b/src/chemistry/bulk_aero/aero_model.F90 @@ -1067,7 +1067,6 @@ subroutine aero_model_gasaerexch( state, loffset, ncol, lchnk, troplev, delt, re if( has_sox ) then call setsox( state, & - pbuf, & ncol, & lchnk, & loffset, & diff --git a/src/chemistry/bulk_aero/sox_cldaero_mod.F90 b/src/chemistry/bulk_aero/sox_cldaero_mod.F90 index 461b645189..0c5a7cc923 100644 --- a/src/chemistry/bulk_aero/sox_cldaero_mod.F90 +++ b/src/chemistry/bulk_aero/sox_cldaero_mod.F90 @@ -8,7 +8,6 @@ module sox_cldaero_mod use ppgrid, only : pcols, pver use mo_chem_utls, only : get_spc_ndx use cldaero_mod, only : cldaero_conc_t, cldaero_allocate, cldaero_deallocate - use physics_buffer, only : physics_buffer_desc implicit none private @@ -61,16 +60,15 @@ end function sox_cldaero_create_obj !---------------------------------------------------------------------------------- ! Update the mixing ratios !---------------------------------------------------------------------------------- - subroutine sox_cldaero_update( state, & - pbuf, ncol, lchnk, loffset, dtime, mbar, pdel, press, tfld, cldnum, cldfrc, cfact, xlwc, & + subroutine sox_cldaero_update( & + state, ncol, lchnk, loffset, dtime, mbar, pdel, press, tfld, cldnum, cldfrc, cfact, xlwc, & delso4_hprxn, xh2so4, xso4, xso4_init, nh3g, hno3g, xnh3, xhno3, xnh4c, xno3c, xmsa, xso2, xh2o2, qcw, qin, & aqso4, aqh2so4, aqso4_h2o2, aqso4_o3, aqso4_h2o2_3d, aqso4_o3_3d ) use physics_types, only: physics_state ! args - type(physics_state), intent(in) :: state ! Physics state variables - type(physics_buffer_desc), pointer :: pbuf(:) + type(physics_state), intent(in) :: state ! Physics state variables integer, intent(in) :: ncol integer, intent(in) :: lchnk ! chunk id integer, intent(in) :: loffset diff --git a/src/chemistry/carma_aero/aero_model.F90 b/src/chemistry/carma_aero/aero_model.F90 index fa8959c6bc..9da34eb645 100644 --- a/src/chemistry/carma_aero/aero_model.F90 +++ b/src/chemistry/carma_aero/aero_model.F90 @@ -767,7 +767,6 @@ subroutine aero_model_gasaerexch( state, loffset, ncol, lchnk, troplev, delt, re if( has_sox ) then call setsox( state, & - pbuf, & ncol, & lchnk, & loffset, & diff --git a/src/chemistry/carma_aero/sox_cldaero_mod.F90 b/src/chemistry/carma_aero/sox_cldaero_mod.F90 index 385e121424..41aed5c036 100644 --- a/src/chemistry/carma_aero/sox_cldaero_mod.F90 +++ b/src/chemistry/carma_aero/sox_cldaero_mod.F90 @@ -3,7 +3,6 @@ !---------------------------------------------------------------------------------- module sox_cldaero_mod - use physics_buffer, only : physics_buffer_desc, pbuf_get_index, pbuf_get_field, dtype_r8 use shr_kind_mod, only : r8 => shr_kind_r8 use cam_abortutils, only : endrun use ppgrid, only : pcols, pver @@ -19,7 +18,6 @@ module sox_cldaero_mod use cldaero_mod, only : cldaero_uptakerate use chem_mods, only : gas_pcnst use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_info_by_bin, rad_cnst_get_bin_props_by_idx -use spmd_utils, only: masterproc implicit none private @@ -168,19 +166,19 @@ end function sox_cldaero_create_obj !---------------------------------------------------------------------------------- ! Update the mixing ratios !---------------------------------------------------------------------------------- - subroutine sox_cldaero_update( state, & - pbuf, ncol, lchnk, loffset, dtime, mbar, pdel, press, tfld, cldnum, cldfrc, cfact, xlwc, & + subroutine sox_cldaero_update( & + state, ncol, lchnk, loffset, dtime, mbar, pdel, press, tfld, cldnum, cldfrc, cfact, xlwc, & delso4_hprxn, xh2so4, xso4, xso4_init, nh3g, hno3g, xnh3, xhno3, xnh4c, xno3c, xmsa, xso2, xh2o2, qcw, qin, & aqso4, aqh2so4, aqso4_h2o2, aqso4_o3, aqso4_h2o2_3d, aqso4_o3_3d) use aerosol_properties_mod, only: aero_name_len - use physics_types, only: physics_state + use physics_types, only: physics_state use carma_intr, only: carma_get_group_by_name, carma_get_dry_radius ! args - type(physics_state), intent(in) :: state ! Physics state variables - type(physics_buffer_desc), pointer :: pbuf(:) + type(physics_state), intent(in) :: state ! Physics state variables + integer, intent(in) :: ncol integer, intent(in) :: lchnk ! chunk id integer, intent(in) :: loffset diff --git a/src/chemistry/modal_aero/aero_model.F90 b/src/chemistry/modal_aero/aero_model.F90 index 3d240285ad..843c596b35 100644 --- a/src/chemistry/modal_aero/aero_model.F90 +++ b/src/chemistry/modal_aero/aero_model.F90 @@ -1063,7 +1063,6 @@ subroutine aero_model_gasaerexch( state, loffset, ncol, lchnk, troplev, delt, re if( has_sox ) then call setsox( state, & - pbuf, & ncol, & lchnk, & loffset, & diff --git a/src/chemistry/modal_aero/sox_cldaero_mod.F90 b/src/chemistry/modal_aero/sox_cldaero_mod.F90 index 351af01aa5..42cb7c51f6 100644 --- a/src/chemistry/modal_aero/sox_cldaero_mod.F90 +++ b/src/chemistry/modal_aero/sox_cldaero_mod.F90 @@ -16,7 +16,6 @@ module sox_cldaero_mod use phys_control, only : phys_getopts, cam_chempkg_is use cldaero_mod, only : cldaero_uptakerate use chem_mods, only : gas_pcnst - use physics_buffer, only : physics_buffer_desc implicit none private @@ -152,17 +151,17 @@ end function sox_cldaero_create_obj !---------------------------------------------------------------------------------- ! Update the mixing ratios !---------------------------------------------------------------------------------- - subroutine sox_cldaero_update( state, & - pbuf, ncol, lchnk, loffset, dtime, mbar, pdel, press, tfld, cldnum, cldfrc, cfact, xlwc, & + subroutine sox_cldaero_update( & + state, ncol, lchnk, loffset, dtime, mbar, pdel, press, tfld, cldnum, cldfrc, cfact, xlwc, & delso4_hprxn, xh2so4, xso4, xso4_init, nh3g, hno3g, xnh3, xhno3, xnh4c, xno3c, xmsa, xso2, xh2o2, qcw, qin, & aqso4, aqh2so4, aqso4_h2o2, aqso4_o3, aqso4_h2o2_3d, aqso4_o3_3d) - use physics_types, only: physics_state + use physics_types, only: physics_state ! args - type(physics_state), intent(in) :: state ! Physics state variables - type(physics_buffer_desc), pointer :: pbuf(:) + type(physics_state), intent(in) :: state ! Physics state variables + integer, intent(in) :: ncol integer, intent(in) :: lchnk ! chunk id integer, intent(in) :: loffset @@ -236,7 +235,7 @@ subroutine sox_cldaero_update( state, & ! Avoid double counting in-cloud sulfur oxidation when running with ! GEOS-Chem. If running with GEOS-Chem then sulfur oxidation - ! is performed internally to GEOS-Chem. Here, we just return to the + ! is performed internally to GEOS-Chem. Here, we just return to the ! parent routine and thus we do not apply tendencies calculated by MAM. if ( cam_chempkg_is('geoschem_mam4') ) return diff --git a/src/physics/spcam/ecpp/ecpp_modal_cloudchem.F90 b/src/physics/spcam/ecpp/ecpp_modal_cloudchem.F90 index 66ff95b967..35d5bb5b67 100644 --- a/src/physics/spcam/ecpp/ecpp_modal_cloudchem.F90 +++ b/src/physics/spcam/ecpp/ecpp_modal_cloudchem.F90 @@ -1,15 +1,16 @@ module ecpp_modal_cloudchem !----------------------------------------------------------------- -! Module interface for cloud chemistry used in the ECPP treatment +! Module interface for cloud chemistry used in the ECPP treatment ! in the MMF model -! Adopted the similar one used in the ECPP +! Adopted the similar one used in the ECPP ! for the WRF-chem model written by Dick Easter ! ! Minghuai Wang, 2009-11 !------------------------------------------------------------------ use shr_kind_mod, only: r8 => shr_kind_r8 use cam_abortutils, only: endrun + use physics_types, only: physics_state implicit none @@ -19,8 +20,8 @@ module ecpp_modal_cloudchem !----------------------------------------------------------------------- -subroutine parampollu_tdx_cldchem( & - ktau, dtstep, ktau_pp, itstep_sub, dtstep_sub, & +subroutine parampollu_tdx_cldchem( state, & + ktau, dtstep, ktau_pp, itstep_sub, dtstep_sub, & itstep_hybrid, & idiagaa_ecpp, ldiagaa_ecpp, & tcen_bar, pcen_bar, rhocen_bar, dzcen, & @@ -54,7 +55,7 @@ subroutine parampollu_tdx_cldchem( & ! ! In the beginning of the subroutine, the vertical coordinate (from bottom to top in ECPP) ! is converted into the one used in CAM: from the top to the bottom. And at the end of the -! subroutine, the vertical coordinate is converted back. +! subroutine, the vertical coordinate is converted back. ! !----------------------------------------------------------------------- @@ -86,6 +87,7 @@ subroutine parampollu_tdx_cldchem( & use module_ecpp_util, only: ecpp_error_fatal, ecpp_message ! arguments + type(physics_state), intent(in) :: state ! Physics state variables integer, intent(in) :: & ktau, ktau_pp, itstep_sub, & it, jt, kts, ktebnd, ktecen, & @@ -137,7 +139,7 @@ subroutine parampollu_tdx_cldchem( & del_cldchem3d ! 3D change from aqueous chemistry real(r8), intent(inout), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2, 1:num_chem_ecpp ) :: & - del_rename3d ! 3D change from modal merging + del_rename3d ! 3D change from modal merging real(r8), intent(inout) :: aqso4_h2o2, & ! SO4 aqueous phase chemistry due to H2O2 (kg/m2) aqso4_o3 ! SO4 aqueous phase chemistry due to O3 (kg/m2) @@ -166,7 +168,7 @@ subroutine parampollu_tdx_cldchem( & ! local variables - + integer :: icc, iccpp, iccpp1, iccpp2, ipp integer :: jcls integer :: k, kk, l, km @@ -216,7 +218,7 @@ subroutine parampollu_tdx_cldchem( & real(r8) :: vmr_full(pcols, pver, gas_pcnst) real(r8), allocatable :: qsrflx_full(:, :,:), qqcwsrflx_full(:, :,:) - integer :: nsrflx + integer :: nsrflx integer :: nstep integer :: jsrflx_rename integer :: latndx_full(pcols, pver) @@ -237,10 +239,10 @@ subroutine parampollu_tdx_cldchem( & nsrflx = 2 jsrflx_rename = 2 nstep = get_nstep() - + ! -! load arrays for interfacing with cloud chemistry subroutine +! load arrays for interfacing with cloud chemistry subroutine ! ! use the wrfchem "i" index for the ecpp icc & ipp sub-class indices ! use the wrfchem "j" index for the ecpp jcls class index @@ -263,15 +265,15 @@ subroutine parampollu_tdx_cldchem( & allocate ( chem_tmpc( 1:4,kts:ktecen,1:ncls_use,1:num_chem_ecpp) ) allocate ( mmr(kts:ktecen,1:gas_pcnst) ) - allocate ( vmr(kts:ktecen,1:gas_pcnst) ) - allocate ( mmrcw(kts:ktecen,1:gas_pcnst) ) - allocate ( vmrcw(kts:ktecen,1:gas_pcnst) ) + allocate ( vmr(kts:ktecen,1:gas_pcnst) ) + allocate ( mmrcw(kts:ktecen,1:gas_pcnst) ) + allocate ( vmrcw(kts:ktecen,1:gas_pcnst) ) allocate ( vmr_sv1(kts:ktecen,1:gas_pcnst) ) allocate ( vmrcw_sv1(kts:ktecen,1:gas_pcnst) ) allocate ( mbar(kts:ktecen) ) allocate ( cldnum(1,kts:ktecen) ) - allocate ( vmr_3d(1,kts:ktecen,1:gas_pcnst) ) - allocate ( vmrcw_3d(1,kts:ktecen,1:gas_pcnst) ) + allocate ( vmr_3d(1,kts:ktecen,1:gas_pcnst) ) + allocate ( vmrcw_3d(1,kts:ktecen,1:gas_pcnst) ) allocate ( mmr_3d(1, kts:ktecen,1:gas_pcnst) ) allocate ( mmrcw_3d(1, kts:ktecen, 1:gas_pcnst) ) allocate ( mbar_3d(1, kts:ktecen) ) @@ -306,7 +308,7 @@ subroutine parampollu_tdx_cldchem( & chem_tmpc(:,:,:,:) = chem_tmpa(:,:,:,:) ! -! prepare fields for aqueous chemistry at CAM. +! prepare fields for aqueous chemistry at CAM. do kk = kts, ktecen k = min( kk, ktecen ) ! @@ -349,7 +351,7 @@ subroutine parampollu_tdx_cldchem( & end if if (icc == 2) then - if(tmpa > afrac_cut_0p5) then + if(tmpa > afrac_cut_0p5) then cldfra_tmp(iccpp,k,jcls) = 1.0_r8 end if end if @@ -367,8 +369,8 @@ subroutine parampollu_tdx_cldchem( & if (cldchem_onoff_ecpp > 0) then do jcls = 1, ncls_use - do icc = 2, 2 ! In clear sky, cloud chemistry and renaming are not called. - do ipp = 1, 2 + do icc = 2, 2 ! In clear sky, cloud chemistry and renaming are not called. + do ipp = 1, 2 iccpp = 2*(icc-1) + ipp ncol = 1 @@ -383,16 +385,16 @@ subroutine parampollu_tdx_cldchem( & lnumcw = numptr_aer(im, in, cw_phase) do k=kts, ktecen km=ktecen-k+1 - cldnum(1,k) = cldnum(1,k)+chem_tmpb(iccpp,km,jcls,lnumcw) + cldnum(1,k) = cldnum(1,k)+chem_tmpb(iccpp,km,jcls,lnumcw) end do end do end do - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- ! ... map incoming concentrations to working array ! Vertical coordinate is from bottom to top in the ECPP for chem_tempb, ! so convert it to from top to the bottom for aqueous chemistry at CAM. - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- mmr(:, :) = 0.0_r8 mmrcw(:, :) = 0.0_r8 do m = 1,pcnst @@ -406,16 +408,16 @@ subroutine parampollu_tdx_cldchem( & end if end do - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- ! ... Set atmosphere mean mass - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- mmr_3d(1, :, :) = mmr(:, :) call set_mean_mass( ncol, mmr_3d, mbar_3d ) mbar(:) = mbar_3d(1, :) - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- ! ... Xform from mmr to vmr - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- vmr_3d(1, :, :) = vmr(:, :) mmr_3d(1, :, :) = mmr(:, :) mmrcw_3d(1, :, :) = mmrcw(:, :) @@ -429,14 +431,14 @@ subroutine parampollu_tdx_cldchem( & vmr(:,:) = vmr_3d(1,:,:) vmrcw(:,:) = vmrcw_3d(1,:,:) - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- ! ... Set the "invariants" - !----------------------------------------------------------------------- - h2ovmr_full(:, :) = 0.0_r8 ! h2ommr is not used in CAM aqueous chemistry, so set it to zero here. + !----------------------------------------------------------------------- + h2ovmr_full(:, :) = 0.0_r8 ! h2ommr is not used in CAM aqueous chemistry, so set it to zero here. do kk = kts, ktecen k = min( kk, ktecen) - t_full(:, k) = t_tmp(iccpp, k,jcls) - pmid_full(:, k) = p_tmp(iccpp, k, jcls) + t_full(:, k) = t_tmp(iccpp, k,jcls) + pmid_full(:, k) = p_tmp(iccpp, k, jcls) do n=1, gas_pcnst vmr_full(:, k, n) = vmr(k, n) end do @@ -446,7 +448,8 @@ subroutine parampollu_tdx_cldchem( & !-------------------------------------------------------------------------- ! ... Aqueous chemistry !-------------------------------------------------------------------------- - call setsox( ncol, & ! ncol + call setsox( state, & ! phys state + ncol, & ! ncol jt, & ! lchnk imozart-1,& ! loffset dt_tmp, & ! dtime @@ -472,7 +475,7 @@ subroutine parampollu_tdx_cldchem( & !----------------------------------------------------------------------- ! ... Xform from vmr to mmr - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- vmr(:,:) = vmr_3d(1,:,:) vmrcw(:,:) = vmrcw_3d(1,:,:) call vmr2mmr( vmr, mmr_3d, mbar, ncol ) @@ -480,11 +483,11 @@ subroutine parampollu_tdx_cldchem( & mmr(:, :) = mmr_3d(1, :, :) mmrcw(:, :) = mmrcw_3d(1, :, :) - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- ! ... Form the tendencies - ! Vertical coordinate is from top to bottom in the aqueous chemistry at CAM, + ! Vertical coordinate is from top to bottom in the aqueous chemistry at CAM, ! so convert it to from bottom to the top in the ECPP for chem_tmpb. - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- do m = 1,pcnst n = map2chm(m) if( n > 0 ) then @@ -506,7 +509,7 @@ subroutine parampollu_tdx_cldchem( & if (tmpa > afrac_cut_0p5) then aqso4_h2o2 = aqso4_h2o2+tmpa * aqso4_h2o2_3dtmp(1, km)*dt_tmp aqso4_o3 = aqso4_o3 + tmpa * aqso4_o3_3dtmp(1, km)*dt_tmp - end if + end if ! ! xphlwc_tmp is defined in CAM( top to bottom), and xphlwc3d is defined in ECPP (bottom to top) xphlwc3d(k,icc,jcls,ipp) = xphlwc3d(k,icc,jcls,ipp) + xphlwc_tmp(1,km) * tmpa @@ -521,8 +524,8 @@ subroutine parampollu_tdx_cldchem( & k = min( kk, ktecen) pdel_full(:, k) = p_tmp(iccpp, k, jcls) end do - latndx_full(:,:) = 1 - lonndx_full(:,:) = 1 + latndx_full(:,:) = 1 + lonndx_full(:,:) = 1 qsrflx_full(:,:,:) = 0.0_r8 qqcwsrflx_full(:,:,:) = 0.0_r8 dotendrn(:) = .false. @@ -544,23 +547,23 @@ subroutine parampollu_tdx_cldchem( & dqqcwdt, dqqcwdt_other, & is_dorename_atik, dorename_atik, & jsrflx_rename, nsrflx, & - qsrflx_full, qqcwsrflx_full ) + qsrflx_full, qqcwsrflx_full ) vmr = vmr + dqdt * dt_tmp vmrcw = vmrcw + dqqcwdt * dt_tmp !----------------------------------------------------------------------- ! ... Xform from vmr to mmr - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- call vmr2mmr( vmr, mmr_3d, mbar, ncol ) call vmr2mmr( vmrcw, mmrcw_3d, mbar, ncol ) mmr(:, :) = mmr_3d(1, :, :) mmrcw(:, :) = mmrcw_3d(1, :, :) - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- ! ... Form the tendencies - ! Vertical coordinate is from top to bottom in the aqueous chemistry at CAM, + ! Vertical coordinate is from top to bottom in the aqueous chemistry at CAM, ! so convert it to from bottom to the top in the ECPP for chem_tmpb. - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- do m = 1,pcnst n = map2chm(m) if( n > 0 ) then @@ -599,7 +602,7 @@ subroutine parampollu_tdx_cldchem( & tmpq = (chem_tmpb(iccpp,k,jcls,l) - chem_tmpa(iccpp,k,jcls,l)) tmpy = tmpy + tmpa*tmpq del_cldchem3d(k,icc,jcls,ipp,l)=del_cldchem3d(k,icc,jcls,ipp,l)+tmpa*tmpq - else + else del_cldchem3d(k,icc,jcls,ipp,l)=del_cldchem3d(k,icc,jcls,ipp,l)+0.0_r8 end if @@ -621,13 +624,13 @@ subroutine parampollu_tdx_cldchem( & end do ! k del_chem_clm_cldchem(l) = del_chem_clm_cldchem(l) + tmpx - if(rename_onoff_ecpp > 0 ) & + if(rename_onoff_ecpp > 0 ) & del_chem_clm_rename(l) = del_chem_clm_rename(l) + tmpx2 end do ! l - end if ! (cldchem_onoff_ecpp > 0) + end if ! (cldchem_onoff_ecpp > 0) - if ((cldchem_onoff_ecpp > 0)) then + if ((cldchem_onoff_ecpp > 0)) then do l = p1st, num_chem_ecpp do k = kts, ktecen @@ -639,7 +642,7 @@ subroutine parampollu_tdx_cldchem( & iccpp1 = 2*(icc-1) + 1 iccpp2 = 2*(icc-1) + 2 - + if(rename_onoff_ecpp > 0 ) then if ((tmpa1 > afrac_cut_0p5) .and. (tmpa2 > afrac_cut_0p5)) then tmpb1 = max( 0.0_r8, min( 1.0_r8, (tmpa1/(tmpa1+tmpa2)) ) ) @@ -678,14 +681,14 @@ subroutine parampollu_tdx_cldchem( & end do ! k end do ! l - end if ! ((cldchem_onoff_ecpp > 0)) + end if ! ((cldchem_onoff_ecpp > 0)) deallocate ( p_tmp, t_tmp, rho_tmp, alt_tmp, & cldfra_tmp, & qlsink_tmp, & precr_tmp, precs_tmp, precg_tmp, preci_tmp ) - deallocate ( chem_tmpa, chem_tmpb, chem_tmpc) + deallocate ( chem_tmpa, chem_tmpb, chem_tmpc) deallocate ( mmr, mmrcw, vmr, vmrcw, vmr_sv1, vmrcw_sv1, & mbar, cldnum, mmr_3d, mmrcw_3d, mbar_3d, & qsrflx_full, qqcwsrflx_full) diff --git a/src/physics/spcam/ecpp/module_ecpp_ppdriver2.F90 b/src/physics/spcam/ecpp/module_ecpp_ppdriver2.F90 index 4e2a52f86a..1d33c8a3eb 100644 --- a/src/physics/spcam/ecpp/module_ecpp_ppdriver2.F90 +++ b/src/physics/spcam/ecpp/module_ecpp_ppdriver2.F90 @@ -1151,7 +1151,7 @@ subroutine parampollu_driver2( aero_props, & if (lun60 > 0) write(lun60,93010) & 'calling parampollu_td240clm - i=', i ! write (0, *) i, lchnk, 'before parampollu_td240clm', nstep - call parampollu_td240clm( aero_props, & + call parampollu_td240clm( state, aero_props, & nstep, dtstep, nstep_pp, dtstep_pp, & idiagaa_ecpp, ldiagaa_ecpp, & tcen_bar, pcen_bar, rhocen_bar, dzcen, & diff --git a/src/physics/spcam/ecpp/module_ecpp_td2clm.F90 b/src/physics/spcam/ecpp/module_ecpp_td2clm.F90 index e8d65d06e8..51ce329a5c 100644 --- a/src/physics/spcam/ecpp/module_ecpp_td2clm.F90 +++ b/src/physics/spcam/ecpp/module_ecpp_td2clm.F90 @@ -9,6 +9,7 @@ module module_ecpp_td2clm use shr_kind_mod, only : r8 => shr_kind_r8 use modal_aerosol_properties_mod, only: modal_aerosol_properties + use physics_types, only: physics_state implicit none @@ -25,7 +26,7 @@ module module_ecpp_td2clm !----------------------------------------------------------------------- !----------------------------------------------------------------------- - subroutine parampollu_td240clm( aero_props, & + subroutine parampollu_td240clm( state, aero_props, & ktau, dtstep, ktau_pp_in, dtstep_pp, & idiagaa_ecpp, ldiagaa_ecpp, & tcen_bar, pcen_bar, rhocen_bar, dzcen, & @@ -87,6 +88,7 @@ subroutine parampollu_td240clm( aero_props, & use cam_abortutils, only: endrun ! arguments + type(physics_state), intent(in) :: state ! Physics state variables type(modal_aerosol_properties), intent(in) :: aero_props integer, intent(in) :: & ktau, ktau_pp_in, & @@ -485,7 +487,7 @@ subroutine parampollu_td240clm( aero_props, & ! ardz_cen_old(:,:,:) = ardz_cen_new(:,:,:) - call parampollu_tdx_main_integ( aero_props, & + call parampollu_tdx_main_integ( state, aero_props, & ktau, dtstep, ktau_pp, dtstep_pp, & itstep_hybrid, ntstep_hybrid, & idiagaa_ecpp, ldiagaa_ecpp, & @@ -686,9 +688,8 @@ subroutine parampollu_td240clm( aero_props, & end subroutine parampollu_td240clm - !----------------------------------------------------------------------- - subroutine parampollu_tdx_main_integ( aero_props, & + subroutine parampollu_tdx_main_integ( state, aero_props, & ktau, dtstep, ktau_pp, dtstep_pp, & itstep_hybrid, ntstep_hybrid, & idiagaa_ecpp, ldiagaa_ecpp, & @@ -748,6 +749,7 @@ subroutine parampollu_tdx_main_integ( aero_props, & use module_ecpp_util, only: ecpp_error_fatal, ecpp_message ! arguments + type(physics_state), intent(in) :: state ! Physics state variables type(modal_aerosol_properties), intent(in) :: aero_props integer, intent(in) :: & ktau, ktau_pp, & @@ -1606,8 +1608,8 @@ subroutine parampollu_tdx_main_integ( aero_props, & ! calculate cloud chemistry changes to chem_sub over one time sub-step call t_startf('ecpp_cldchem') - call parampollu_tdx_cldchem( & - ktau, dtstep, ktau_pp, itstep_sub, dtstep_sub, & + call parampollu_tdx_cldchem( state, & + ktau, dtstep, ktau_pp, itstep_sub, dtstep_sub, & itstep_hybrid, & idiagaa_ecpp, ldiagaa_ecpp, & tcen_bar, pcen_bar, rhocen_bar, dzcen, & From f3f5c67b6c3136692ffc10a763afb1faf3f4f56d Mon Sep 17 00:00:00 2001 From: Francis Vitt <fvitt@ucar.edu> Date: Tue, 17 Dec 2024 11:43:51 -0700 Subject: [PATCH 08/24] fix geoschem modified: src/chemistry/geoschem/chemistry.F90 --- src/chemistry/geoschem/chemistry.F90 | 31 ++++++++++++++-------------- 1 file changed, 16 insertions(+), 15 deletions(-) diff --git a/src/chemistry/geoschem/chemistry.F90 b/src/chemistry/geoschem/chemistry.F90 index fbb99e4b8f..ff6316d349 100644 --- a/src/chemistry/geoschem/chemistry.F90 +++ b/src/chemistry/geoschem/chemistry.F90 @@ -22,7 +22,7 @@ module chemistry #if defined( MODAL_AERO ) use modal_aero_data, only : ntot_amode #endif - + ! GEOS-Chem derived types USE DiagList_Mod, ONLY : DgnList ! Diagnostics list object use GeosChem_History_Mod, ONLY : HistoryConfigObj ! History diagnostic object @@ -515,11 +515,11 @@ subroutine chem_register CALL cnst_get_ind('Q', cQ, abort=.True.) CALL cnst_get_ind('H2O', cH2O, abort=.True.) CALL cnst_get_ind('H2SO4', cH2SO4, abort=.True.) - + !------------------------------------------------------------ ! Get mapping between dry deposition species and species set !------------------------------------------------------------ - + nIgnored = 0 if (debug .and. masterproc) write(iulog,'(a,i4,a)') 'chem_register: looping over gas dry deposition list with ', nddvels, ' species' @@ -831,7 +831,7 @@ subroutine chem_readnl(nlfile) ! Now go through the KPP mechanism and add any species not ! implemented by the tracer list in geoschem_config.yml !---------------------------------------------------------- - + IF ( nSpec > nSlsMax ) THEN CALL ENDRUN('chem_readnl: too many species - increase nSlsmax') ENDIF @@ -1022,7 +1022,7 @@ subroutine chem_init(phys_state, pbuf2d) use Time_Mod, only : Accept_External_Date_Time use Ucx_Mod, only : Init_Ucx use Unitconv_Mod, only : MOLES_SPECIES_PER_MOLES_DRY_AIR - use Vdiff_Mod, only : Max_PblHt_For_Vdiff + use Vdiff_Mod, only : Max_PblHt_For_Vdiff TYPE(physics_state), INTENT(IN ) :: phys_state(BEGCHUNK:ENDCHUNK) TYPE(physics_buffer_desc), POINTER, INTENT(INOUT) :: pbuf2d(:,:) @@ -1143,7 +1143,7 @@ subroutine chem_init(phys_state, pbuf2d) ! on State_Grid(BEGCHUNK). ! To go around this, we define all of GEOS-Chem arrays with ! size PCOLS x PVER, which is the largest possible number of - ! grid cells. + ! grid cells. CALL Init_State_Grid( Input_Opt = Input_Opt, & State_Grid = maxGrid, & RC = RC ) @@ -1484,7 +1484,7 @@ subroutine chem_init(phys_state, pbuf2d) ! Init_Drydep ! Thibaud M. Fritz - 04 Mar 2020 !---------------------------------------------------------- - + ALLOCATE(map2GC_dryDep(nddvels), STAT=IERR) IF ( IERR .NE. 0 ) CALL ENDRUN('Failed to allocate map2GC_dryDep') @@ -1754,7 +1754,7 @@ subroutine chem_timestep_init(phys_state, pbuf2d) use mo_flbc, only : flbc_chk use mo_ghg_chem, only : ghg_chem_timestep_init use physics_buffer, only : physics_buffer_desc - + TYPE(physics_state), INTENT(IN):: phys_state(begchunk:endchunk) TYPE(physics_buffer_desc), POINTER :: pbuf2d(:,:) @@ -2019,7 +2019,7 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) REAL(r8) :: mmr_tend(state%NCOL,PVER,gas_pcnst) REAL(r8) :: wk_out(state%NCOL) LOGICAL :: Found - + CHARACTER(LEN=shr_kind_cl) :: tagName REAL(r8), PARAMETER :: zlnd = 0.01_r8 ! Roughness length for soil [m] @@ -2364,7 +2364,7 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ENDDO ! Deal with secondary organic aerosols (SOAs). This mapping is using the - ! complex SOA option in GEOS-Chem. + ! complex SOA option in GEOS-Chem. ! MAM uses five volatility bins spanning saturation concentrations from 0.01 ! to 100 ug/m3 (logarithmically). The complex SOA option has four volatility ! bins that 0.1 to 100 ug/m3. We lump the lowest two bins in CESM2 to the @@ -3692,7 +3692,7 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ! Compute the surface flux for the non-local mixing, ! (which means getting emissions & drydep from HEMCO) ! and store it in State_Chm%Surface_Flux - ! + ! ! For CESM-GC, Surface_Flux will be equal to the opposite of the ! dry deposition flux since emissions are loaded externally ! ( SurfaceFlux = eflx - dflx = - dflx ) @@ -3739,10 +3739,10 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ! Get the species ID from the drydep ID N = State_Chm(BEGCHUNK)%Map_DryDep(ND) IF ( N <= 0 ) CYCLE - + M = map2GCinv(N) IF ( M <= 0 ) CYCLE - + cam_in%cflx(1:nY,M) = cam_in%cflx(1:nY,M) & + State_Chm(LCHNK)%SurfaceFlux(1,1:nY,N) ENDDO @@ -3763,7 +3763,7 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) new_units = KG_SPECIES_PER_M2, & previous_units = previous_units, & RC = RC ) - + IF ( RC /= GC_SUCCESS ) THEN ErrMsg = 'Error encountered in "Convert_Spc_Units"!' @@ -4088,7 +4088,8 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) call t_stopf('GEOSChem_MAM_Interfacing') call t_startf('GEOSChem_MAM_GasAerExch') - call aero_model_gasaerexch( loffset = iFirstCnst - 1, & + call aero_model_gasaerexch( state, & + loffset = iFirstCnst - 1, & ncol = NCOL, & lchnk = LCHNK, & troplev = Trop_Lev(:), & From 2efd269252108fa5949978fa4eff0e5ec57443bc Mon Sep 17 00:00:00 2001 From: Francis Vitt <fvitt@ucar.edu> Date: Tue, 17 Dec 2024 11:54:31 -0700 Subject: [PATCH 09/24] default namelist fixes; revert nucleate ice change for carma modified: bld/build-namelist modified: bld/namelist_files/namelist_defaults_cam.xml modified: src/physics/cam/nucleate_ice.F90 --- bld/build-namelist | 2 +- bld/namelist_files/namelist_defaults_cam.xml | 3 --- src/physics/cam/nucleate_ice.F90 | 22 +++++++++++++------- 3 files changed, 15 insertions(+), 12 deletions(-) diff --git a/bld/build-namelist b/bld/build-namelist index 258b54f048..7a5ec905eb 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -2285,7 +2285,7 @@ if ($chem eq 'trop_mam3') { if ($phys =~ /cam6/ or $phys =~ /cam7/) { # OASISS (ocean) DMS emissions - if (!$aqua_mode and !$scam) { + if (!$aqua_mode and !$scam and chem_has_species($cfg, 'DMS')) { my $rel_filepath = get_default_value('dms_ocn_emis_file'); my $abs_filepath = set_abs_filepath($rel_filepath, $inputdata_rootdir); my $val = quote_string("DMS -> ". $abs_filepath); diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index ab4a8e28f8..5c9187be4f 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -2994,9 +2994,6 @@ <fv_nsplit hgrid="0.9x1.25" waccm_phys="1">16</fv_nsplit> <fv_nsplit hgrid="0.47x0.63" waccmx="1">32</fv_nsplit> -<fv_nspltvrm hgrid="1.9x2.5" waccm_phys="1" aquaplanet="1">4</fv_nspltvrm> -<fv_nspltrac hgrid="1.9x2.5" waccm_phys="1" aquaplanet="1">4</fv_nspltrac> - <fv_del2coef >3.e+5</fv_del2coef> <fv_filtcw >0</fv_filtcw> diff --git a/src/physics/cam/nucleate_ice.F90 b/src/physics/cam/nucleate_ice.F90 index ac7268c068..42db39a083 100644 --- a/src/physics/cam/nucleate_ice.F90 +++ b/src/physics/cam/nucleate_ice.F90 @@ -226,9 +226,11 @@ subroutine nucleati( & if ( ((tc.le.0.0_r8).and.(tc.ge.-37.0_r8).and.(qc.lt.1.e-12_r8)).or.(tc.le.-37.0_r8)) then - A = -1.4938_r8 * log(soot_num+dst_num) + 12.884_r8 - B = -10.41_r8 * log(soot_num+dst_num) - 67.69_r8 - regm = A * log(wbar1) + B + if ( (soot_num+dst_num) > 0._r8) then + A = -1.4938_r8 * log(soot_num+dst_num) + 12.884_r8 + B = -10.41_r8 * log(soot_num+dst_num) - 67.69_r8 + regm = A * log(wbar1) + B + end if ! heterogeneous nucleation only if (tc .gt. regm .or. so4_num < 1.0e-10_r8) then @@ -260,8 +262,11 @@ subroutine nucleati( & nihf = 0._r8 n1 = niimm + nidep - osoot_num = soot_num * (niimm + nidep) / (soot_num + dst_num) - odst_num = dst_num * (niimm + nidep) / (soot_num + dst_num) + if ( (soot_num+dst_num) > 0._r8) then + osoot_num = soot_num * (niimm + nidep) / (soot_num + dst_num) + odst_num = dst_num * (niimm + nidep) / (soot_num + dst_num) + end if + endif ! homogeneous nucleation only @@ -322,8 +327,10 @@ subroutine nucleati( & oso4_num = nihf endif - osoot_num = soot_num * (niimm + nidep) / (soot_num + dst_num) - odst_num = dst_num * (niimm + nidep) / (soot_num + dst_num) + if ( (soot_num+dst_num) > 0._r8) then + osoot_num = soot_num * (niimm + nidep) / (soot_num + dst_num) + odst_num = dst_num * (niimm + nidep) / (soot_num + dst_num) + end if nihf = nihf * fhom * ((regm - tc) / 5._r8)**2 oso4_num = oso4_num * fhom * ((regm - tc) / 5._r8)**2 @@ -582,4 +589,3 @@ subroutine frachom(Tmean,RHimean,detaT,fhom) end subroutine frachom end module nucleate_ice - From 273095779071fd5e0b05c64109152966a121c60d Mon Sep 17 00:00:00 2001 From: Francis Vitt <fvitt@ucar.edu> Date: Wed, 8 Jan 2025 18:53:20 -0700 Subject: [PATCH 10/24] revert surface area changes in chemistry modified: src/chemistry/mozart/mo_usrrxt.F90 --- src/chemistry/mozart/mo_usrrxt.F90 | 38 +++++++++++++----------------- 1 file changed, 17 insertions(+), 21 deletions(-) diff --git a/src/chemistry/mozart/mo_usrrxt.F90 b/src/chemistry/mozart/mo_usrrxt.F90 index 124c779f1f..177d3dd04e 100644 --- a/src/chemistry/mozart/mo_usrrxt.F90 +++ b/src/chemistry/mozart/mo_usrrxt.F90 @@ -782,12 +782,12 @@ subroutine usrrxt( state, rxt, temp, tempi, tempe, invariants, h2ovmr, & end if if (ntot_amode>0) then - allocate(sfc_array(pcols,pver,ntot_amode), dm_array(pcols,pver,ntot_amode) ) + allocate(sfc_array(pcols,pver,ntot_amode), dm_array(pcols,pver,ntot_amode) ) else if (nbins>0) then - allocate(sfc_array(pcols,pver,nbins), dm_array(pcols,pver,nbins) ) + allocate(sfc_array(pcols,pver,nbins), dm_array(pcols,pver,nbins) ) else - allocate(sfc_array(pcols,pver,5), dm_array(pcols,pver,5) ) - end if + allocate(sfc_array(pcols,pver,5), dm_array(pcols,pver,5) ) + endif sfc_array(:,:,:) = 0._r8 dm_array(:,:,:) = 0._r8 @@ -795,18 +795,17 @@ subroutine usrrxt( state, rxt, temp, tempi, tempe, invariants, h2ovmr, & reff_trop(:,:) = 0._r8 if( usr_NO2_aer_ndx > 0 .or. usr_NO3_aer_ndx > 0 .or. usr_N2O5_aer_ndx > 0 .or. usr_HO2_aer_ndx > 0 ) then -! CGB, put back in for old CARMA sulfate model. + ! sad_trop should be set outside of usrrxt ?? - if( carma_hetchem_feedback ) then + if( carma_hetchem_feedback ) then sad_trop(:ncol,:pver)=strato_sad(:ncol,:pver) -! call endrun(subname // ':: ERROR carma_hetchem_feedback namelist variable is obsolete') - else + else - call aero_model_surfarea( & - state, mmr, rm1, relhum, pmid, temp, strato_sad, sulfate, m, tropchemlev, dlat, & - het1_ndx, pbuf, ncol, sfc_array, dm_array, sad_trop, reff_trop ) + call aero_model_surfarea( & + state, mmr, rm1, relhum, pmid, temp, strato_sad, sulfate, m, tropchemlev, dlat, & + het1_ndx, pbuf, ncol, sfc_array, dm_array, sad_trop, reff_trop ) - endif + endif endif level_loop : do k = 1,pver @@ -2009,16 +2008,13 @@ subroutine usrrxt( state, rxt, temp, tempi, tempe, invariants, h2ovmr, & ! ... estimate sulfate particles surface area (cm2/cm3) in each grid !------------------------------------------------------------------------- if ( carma_hetchem_feedback ) then -! CGB - put it back for old CARMA sulfate model -! call endrun(subname // ':: ERROR carma_hetchem_feedback namelist variable is obsolete') sur(:ncol) = strato_sad(:ncol,k) -! else -! sur(:) = sulfate(:,k)*m(:,k)/avo*wso4 & ! xform mixing ratio to g/cm3 -! / amas & ! xform g/cm3 to num particles/cm3 -! * fare & ! xform num particles/cm3 to cm2/cm3 -! * xr(:)*xr(:) ! humidity factor + else + sur(:) = sulfate(:,k)*m(:,k)/avo*wso4 & ! xform mixing ratio to g/cm3 + / amas & ! xform g/cm3 to num particles/cm3 + * fare & ! xform num particles/cm3 to cm2/cm3 + * xr(:)*xr(:) ! humidity factor endif - sur(:ncol) = sad_trop(:ncol,k) !----------------------------------------------------------------- ! ... compute the "aerosol" reaction rates !----------------------------------------------------------------- @@ -2048,7 +2044,7 @@ subroutine usrrxt( state, rxt, temp, tempi, tempe, invariants, h2ovmr, & !----------------------------------------------------------------- if( usr_CO_OH_b_ndx > 0 .and. usr_CO_OH_ndx < 0 ) then usr_CO_OH_ndx = usr_CO_OH_b_ndx - end if + end if if( usr_CO_OH_ndx > 0 ) then if( usr_COhc_OH_ndx > 0 ) then rxt(:ncol,:,usr_COhc_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) From de7307a6a888c33b7b6a6f1b4d7f1beacc8ad52b Mon Sep 17 00:00:00 2001 From: Francis Vitt <fvitt@ucar.edu> Date: Tue, 21 Jan 2025 07:34:51 -0700 Subject: [PATCH 11/24] improve namelist opt doc modified: bld/namelist_files/namelist_definition.xml --- .gitmodules | 2 +- bld/namelist_files/namelist_definition.xml | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/.gitmodules b/.gitmodules index b6547fa7a1..cd36a45d2a 100644 --- a/.gitmodules +++ b/.gitmodules @@ -7,7 +7,7 @@ [submodule "carma"] path = src/physics/carma/base - url = https://github.com/ESCOMP/CARMA_base.git + url = https://github.com/ESCOMP/CARMA_base.git fxrequired = AlwaysRequired fxtag = carma4_09 fxDONOTUSEurl = https://github.com/ESCOMP/CARMA_base.git diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 7365dca6ec..481d72d998 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -4647,8 +4647,8 @@ Default: NONE <entry id="carma_diags_file" type="integer" category="carma" group="carma_nl" valid_values="" > -When > 0, indicates the history file to be used by default for -diagnostic output. A value of 1 indicated the h0 file. +When > 0, indicates the history file to be used by default for diagnostic output. +A value of 1 indicates the h0 file. When 0 no diagnostics are output. Default: 0 </entry> From 88fd3791850e871525349323f97d89ea80cd7c4f Mon Sep 17 00:00:00 2001 From: Francis Vitt <fvitt@ucar.edu> Date: Tue, 21 Jan 2025 07:53:20 -0700 Subject: [PATCH 12/24] update ABMN comment modified: bld/build-namelist --- bld/build-namelist | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/bld/build-namelist b/bld/build-namelist index 2a2251137e..d2f8d17209 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -5069,11 +5069,11 @@ sub check_input_files { } } } - # Look for values that begin with 'X:name:name2' where X is one of [AMN] + # Look for values that begin with 'X:name:name2' where X is one of [ABMN] # Extract name and filename elsif ($spec =~ m/^\s*[ABMN]:(\w+) # name of species preceded by optional whitespace and X: - : # : separator - (\S+) # name2 + : # : separator + (\S+) # name2 /xo) { my $name = $1; my $name2 = $2; From aae8a6f5e80551bedc3a748483234845f175c1de Mon Sep 17 00:00:00 2001 From: Francis Vitt <fvitt@ucar.edu> Date: Tue, 21 Jan 2025 17:24:41 -0700 Subject: [PATCH 13/24] encapsulate the carma diags in an object for cleaner interface with physics new file: src/physics/cam/carma_diags_mod.F90 modified: src/physics/cam/physpkg.F90 --- src/physics/cam/carma_diags_mod.F90 | 124 ++++++++++++++++++++++++++++ src/physics/cam/physpkg.F90 | 111 +++++++++++-------------- 2 files changed, 171 insertions(+), 64 deletions(-) create mode 100644 src/physics/cam/carma_diags_mod.F90 diff --git a/src/physics/cam/carma_diags_mod.F90 b/src/physics/cam/carma_diags_mod.F90 new file mode 100644 index 0000000000..c53a48b5d9 --- /dev/null +++ b/src/physics/cam/carma_diags_mod.F90 @@ -0,0 +1,124 @@ +!-------------------------------------------------------------------------------- +! CARMA diagnostics data object +!-------------------------------------------------------------------------------- +module carma_diags_mod + use shr_kind_mod, only: r8 => shr_kind_r8 + use constituents, only: pcnst + use ppgrid, only: pcols + use carma_intr, only: MAXCLDAERDIAG, carma_calculate_cloudborne_diagnostics, carma_output_budget_diagnostics, & + carma_output_cloudborne_diagnostics + use carma_flags_mod, only: carma_do_package_diags + + use camsrfexch, only: cam_in_t + use physics_types, only: physics_state, physics_ptend + use physics_buffer, only: physics_buffer_desc + + implicit none + + private + + public :: carma_diags_t + + !------------------------------------------------------------------------------ + ! CARMA diags object + !------------------------------------------------------------------------------ + type :: carma_diags_t + private + + ! CARMA diagnostics + real(r8), allocatable :: aerclddiag(:,:) ! the cloudborne aerosol diags snapshot + real(r8), allocatable :: old_cflux(:,:) ! cam_in%clfux from before the timestep_tend + + contains + + procedure :: update + procedure :: output + + final :: destructor + end type carma_diags_t + + interface carma_diags_t + procedure :: constructor + end interface carma_diags_t + + +contains + + !------------------------------------------------------------------------------ + ! object constructor allocates memory + !------------------------------------------------------------------------------ + function constructor() result(newobj) + + type(carma_diags_t), pointer :: newobj + + integer :: ierr + + if (carma_do_package_diags) then + allocate(newobj,stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + else + nullify(newobj) + return + end if + + allocate(newobj%aerclddiag(pcols,MAXCLDAERDIAG)) + allocate(newobj%old_cflux(pcols,pcnst)) + + end function constructor + + !------------------------------------------------------------------------------ + ! update the arrays + !------------------------------------------------------------------------------ + subroutine update(self, cam_in, state, pbuf) + class(carma_diags_t), intent(inout) :: self + + type(cam_in_t), intent(in) :: cam_in + type(physics_state), intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + + if (.not.carma_do_package_diags) return + + self%old_cflux = cam_in%cflx + call carma_calculate_cloudborne_diagnostics(state, pbuf, self%aerclddiag) + + end subroutine update + + !------------------------------------------------------------------------------ + ! output the carma bugdets to cam history + !------------------------------------------------------------------------------ + subroutine output(self, state, ptend, cam_in, label, dt, pbuf) + class(carma_diags_t), intent(in) :: self + + type(physics_state), intent(in) :: state + type(physics_ptend), intent(in) :: ptend + type(cam_in_t), intent(in) :: cam_in + character(len=*), intent(in) :: label + real(r8), intent(in) :: dt + type(physics_buffer_desc), pointer :: pbuf(:) + + if (.not.carma_do_package_diags) return + + call carma_output_budget_diagnostics(state, ptend, self%old_cflux, cam_in%cflx, dt, label) + call carma_output_cloudborne_diagnostics(state, pbuf, label, dt, self%aerclddiag) + + end subroutine output + + !------------------------------------------------------------------------------ + ! free up memory + !------------------------------------------------------------------------------ + subroutine destructor(self) + type(carma_diags_t), intent(inout) :: self + + if (allocated(self%aerclddiag)) then + deallocate(self%aerclddiag) + end if + if (allocated(self%old_cflux)) then + deallocate(self%old_cflux) + end if + + end subroutine destructor + +end module carma_diags_mod diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90 index 293e78fa89..e570eac3cd 100644 --- a/src/physics/cam/physpkg.F90 +++ b/src/physics/cam/physpkg.F90 @@ -38,6 +38,8 @@ module physpkg use modal_aero_calcsize, only: modal_aero_calcsize_sub use modal_aero_wateruptake, only: modal_aero_wateruptake_init, modal_aero_wateruptake_dr, modal_aero_wateruptake_reg + use carma_diags_mod, only: carma_diags_t + implicit none private save @@ -1390,16 +1392,14 @@ subroutine tphysac (ztodt, cam_in, & use constituents, only: cnst_get_ind use physics_types, only: physics_state, physics_tend, physics_ptend, physics_update, & physics_dme_adjust, set_dry_to_wet, physics_state_check, & - dyn_te_idx, physics_ptend_init + dyn_te_idx use waccmx_phys_intr, only: waccmx_phys_mspd_tend ! WACCM-X major diffusion use waccmx_phys_intr, only: waccmx_phys_ion_elec_temp_tend ! WACCM-X use aoa_tracers, only: aoa_tracers_timestep_tend use physconst, only: rhoh2o, latvap,latice use dyn_tests_utils, only: vc_dycore use aero_model, only: aero_model_drydep - use carma_intr, only: carma_emission_tend, carma_timestep_tend, carma_output_budget_diagnostics, & - carma_output_cloudborne_diagnostics, carma_calculate_cloudborne_diagnostics, & - MAXCLDAERDIAG + use carma_intr, only: carma_emission_tend, carma_timestep_tend use carma_flags_mod, only: carma_do_aerosol, carma_do_emission use check_energy, only: tot_energy_phys use check_energy, only: check_tracers_data, check_tracers_init, check_tracers_chng @@ -1481,10 +1481,9 @@ subroutine tphysac (ztodt, cam_in, & real(r8), pointer, dimension(:,:) :: dvcore real(r8), pointer, dimension(:,:) :: ast ! relative humidity cloud fraction - ! CARMA diagnostics - real(r8) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the cloudborne aerosol diags snapshot - real(r8) :: old_cflux(pcols,pcnst) !! cam_in%clfux from before the timestep_tend - logical :: lq_none(pcnst) !! Used to initialize null ptend for chem_emissions + ! For aerosol budget diagnostics + type(carma_diags_t), pointer :: carma_diags_obj + carma_diags_obj => carma_diags_t() !----------------------------------------------------------------------- lchnk = state%lchnk @@ -1533,10 +1532,6 @@ subroutine tphysac (ztodt, cam_in, & + (cam_out%precsc(i) + cam_out%precsl(i))*latice*rhoh2o end do - ! Add a diagnostic term for the aerosol emissions coupled from the surface. - lq_none(:) = .false. - call physics_ptend_init(ptend,state%psetcols, 'surf_emissions', lq=lq_none) - ! emissions of aerosols and gas-phase chemistry constituents at surface if (trim(cam_take_snapshot_before) == "chem_emissions") then @@ -1544,15 +1539,11 @@ subroutine tphysac (ztodt, cam_in, & fh2o, surfric, obklen, flx_heat) end if - old_cflux = cam_in%cflx - call carma_calculate_cloudborne_diagnostics(state, pbuf, aerclddiag) + call carma_diags_obj%update(cam_in, state, pbuf) call chem_emissions( state, cam_in, pbuf ) - lq_none(:) = .false. - call physics_ptend_init(ptend,state%psetcols, 'chem_emissions', lq=lq_none) - call carma_output_budget_diagnostics(state, ptend, old_cflux, cam_in%cflx, ztodt, "CHEMEMIS") - call carma_output_cloudborne_diagnostics(state, pbuf, "CHEMEMIS", ztodt, aerclddiag) + call carma_diags_obj%output(state, ptend, cam_in, "CHEMEMIS", ztodt, pbuf) if (trim(cam_take_snapshot_after) == "chem_emissions") then call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf,& @@ -1561,11 +1552,9 @@ subroutine tphysac (ztodt, cam_in, & if (carma_do_emission) then ! carma emissions - old_cflux = cam_in%cflx - call carma_calculate_cloudborne_diagnostics(state, pbuf, aerclddiag) + call carma_diags_obj%update(cam_in, state, pbuf) call carma_emission_tend(state, ptend, cam_in, ztodt, pbuf) - call carma_output_budget_diagnostics(state, ptend, old_cflux, cam_in%cflx, ztodt, "CREMIS") - call carma_output_cloudborne_diagnostics(state, pbuf, "CREMIS", ztodt, aerclddiag) + call carma_diags_obj%output(state, ptend, cam_in, "CREMIS", ztodt, pbuf) call physics_update(state, ptend, ztodt, tend) end if @@ -1636,8 +1625,7 @@ subroutine tphysac (ztodt, cam_in, & fh2o, surfric, obklen, flx_heat) end if - old_cflux = cam_in%cflx - call carma_calculate_cloudborne_diagnostics(state, pbuf, aerclddiag) + call carma_diags_obj%update(cam_in, state, pbuf) call chem_timestep_tend(state, ptend, cam_in, cam_out, ztodt, & pbuf, fh2o=fh2o) @@ -1647,8 +1635,9 @@ subroutine tphysac (ztodt, cam_in, & (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then call cam_snapshot_ptend_outfld(ptend, lchnk) end if - call carma_output_budget_diagnostics(state, ptend, old_cflux, cam_in%cflx, ztodt, "CHEM") - call carma_output_cloudborne_diagnostics(state, pbuf, "CHEM", ztodt, aerclddiag) + + call carma_diags_obj%output(state, ptend, cam_in, "CHEM", ztodt, pbuf) + call physics_update(state, ptend, ztodt, tend) if (trim(cam_take_snapshot_after) == "chem_timestep_tend") then @@ -1673,8 +1662,7 @@ subroutine tphysac (ztodt, cam_in, & fh2o, surfric, obklen, flx_heat) end if - old_cflux = cam_in%cflx - call carma_calculate_cloudborne_diagnostics(state, pbuf, aerclddiag) + call carma_diags_obj%update(cam_in, state, pbuf) call vertical_diffusion_tend (ztodt ,state , cam_in, & surfric ,obklen ,ptend ,ast ,pbuf ) @@ -1696,8 +1684,9 @@ subroutine tphysac (ztodt, cam_in, & if ( ptend%lv ) then call outfld( 'VTEND_VDIFF', ptend%v, pcols, lchnk) end if - call carma_output_budget_diagnostics(state, ptend, old_cflux, cam_in%cflx, ztodt, "VDIF") - call carma_output_cloudborne_diagnostics(state, pbuf, "VDIF", ztodt, aerclddiag) + + call carma_diags_obj%output(state, ptend, cam_in, "VDIF", ztodt, pbuf) + call physics_update(state, ptend, ztodt, tend) if (trim(cam_take_snapshot_after) == "vertical_diffusion_section") then @@ -1738,16 +1727,14 @@ subroutine tphysac (ztodt, cam_in, & fh2o, surfric, obklen, flx_heat) end if - old_cflux = cam_in%cflx - call carma_calculate_cloudborne_diagnostics(state, pbuf, aerclddiag) + call carma_diags_obj%update(cam_in, state, pbuf) call aero_model_drydep( state, pbuf, obklen, surfric, cam_in, ztodt, cam_out, ptend ) if ( (trim(cam_take_snapshot_after) == "aero_model_drydep") .and. & (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then call cam_snapshot_ptend_outfld(ptend, lchnk) end if - call carma_output_budget_diagnostics(state, ptend, old_cflux, cam_in%cflx, ztodt, "DRYDEPA") - call carma_output_cloudborne_diagnostics(state, pbuf, "DRYDEPA", ztodt, aerclddiag) + call carma_diags_obj%output(state, ptend, cam_in, "DRYDEPA", ztodt, pbuf) call physics_update(state, ptend, ztodt, tend) if (trim(cam_take_snapshot_after) == "aero_model_drydep") then @@ -1766,11 +1753,9 @@ subroutine tphysac (ztodt, cam_in, & ! can be added to for CARMA aerosols. if (carma_do_aerosol) then call t_startf('carma_timestep_tend') - old_cflux = cam_in%cflx - call carma_calculate_cloudborne_diagnostics(state, pbuf, aerclddiag) + call carma_diags_obj%update(cam_in, state, pbuf) call carma_timestep_tend(state, cam_in, cam_out, ptend, ztodt, pbuf, obklen=obklen, ustar=surfric) - call carma_output_budget_diagnostics(state, ptend, old_cflux, cam_in%cflx, ztodt, "CRTEND") - call carma_output_cloudborne_diagnostics(state, pbuf, "CRTEND", ztodt, aerclddiag) + call carma_diags_obj%output(state, ptend, cam_in, "CRTEND", ztodt, pbuf) call physics_update(state, ptend, ztodt, tend) call check_energy_cam_chng(state, tend, "carma_tend", nstep, ztodt, zero, zero, zero, zero) @@ -2042,6 +2027,12 @@ subroutine tphysac (ztodt, cam_in, & call clybry_fam_set( ncol, lchnk, map2chm, state%q, pbuf ) + ! clean CARMA diagnostics object + if (associated(carma_diags_obj)) then + deallocate(carma_diags_obj) + nullify(carma_diags_obj) + end if + end subroutine tphysac subroutine tphysbc (ztodt, state, & @@ -2105,9 +2096,7 @@ subroutine tphysbc (ztodt, state, & use dycore, only: dycore_is use aero_model, only: aero_model_wetdep use aero_wetdep_cam, only: wetdep_lq - use carma_intr, only: carma_wetdep_tend, carma_timestep_tend, carma_output_budget_diagnostics, & - carma_output_cloudborne_diagnostics, carma_calculate_cloudborne_diagnostics, & - MAXCLDAERDIAG + use carma_intr, only: carma_wetdep_tend, carma_timestep_tend use carma_flags_mod, only: carma_do_detrain, carma_do_cldice, carma_do_cldliq, carma_do_wetdep use radiation, only: radiation_tend use cloud_diagnostics, only: cloud_diagnostics_calc @@ -2239,9 +2228,9 @@ subroutine tphysbc (ztodt, state, & real(r8) :: zero_tracers(pcols,pcnst) ! For aerosol budget diagnostics - character(len=16) :: pname !! package name - real(r8) :: aerclddiag(pcols, MAXCLDAERDIAG) !! the cloudborne aerosol diags snapshot - real(r8) :: old_cflux(pcols,pcnst) !! cam_in%clfux from before the timestep_tend + character(len=16) :: pname !! package name + type(carma_diags_t), pointer :: carma_diags_obj + carma_diags_obj => carma_diags_t() !----------------------------------------------------------------------- @@ -2524,12 +2513,10 @@ subroutine tphysbc (ztodt, state, & call t_startf('carma_timestep_tend') if (carma_do_cldice .or. carma_do_cldliq) then - old_cflux = cam_in%cflx - call carma_calculate_cloudborne_diagnostics(state, pbuf, aerclddiag) + call carma_diags_obj%update(cam_in, state, pbuf) call carma_timestep_tend(state, cam_in, cam_out, ptend, ztodt, pbuf, dlf=dlf, rliq=rliq, & prec_str=prec_str, snow_str=snow_str, prec_sed=prec_sed_carma, snow_sed=snow_sed_carma) - call carma_output_budget_diagnostics(state, ptend, old_cflux, cam_in%cflx, ztodt, "CRTEND") - call carma_output_cloudborne_diagnostics(state, pbuf, "CRTEND", ztodt, aerclddiag) + call carma_diags_obj%output(state, ptend, cam_in, "CRTEND", ztodt, pbuf) call physics_update(state, ptend, ztodt, tend) ! Before the detrainment, the reserved condensate is all liquid, but if CARMA is doing @@ -2656,10 +2643,6 @@ subroutine tphysbc (ztodt, state, & flx_cnd(:ncol) = -1._r8*rliq(:ncol) flx_heat(:ncol) = cam_in%shf(:ncol) + det_s(:ncol) - ! These need to be reported before the scaling as they are based - ! on the substep size not ztodt. - write(pname, '(A, I2.2)') "CLUBB", macmic_it - ! Unfortunately, physics_update does not know what time period ! "tend" is supposed to cover, and therefore can't update it ! with substeps correctly. For now, work around this by scaling @@ -2718,8 +2701,7 @@ subroutine tphysbc (ztodt, state, & flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) end if - old_cflux = cam_in%cflx - call carma_calculate_cloudborne_diagnostics(state, pbuf, aerclddiag) + call carma_diags_obj%update(cam_in, state, pbuf) call t_startf('microp_aero_run') call microp_aero_run(state, ptend_aero, cld_macmic_ztodt, pbuf) @@ -2804,8 +2786,7 @@ subroutine tphysbc (ztodt, state, & ! These need to be reported before the scaling as they are based ! on the substep size not ztodt. write(pname, '(A, I2.2)') "MICROP", macmic_it - call carma_output_budget_diagnostics(state, ptend, old_cflux, cam_in%cflx, ztodt/cld_macmic_num_steps, pname) - call carma_output_cloudborne_diagnostics(state, pbuf, pname, ztodt/cld_macmic_num_steps, aerclddiag) + call carma_diags_obj%output(state, ptend, cam_in, pname, ztodt/cld_macmic_num_steps, pbuf) ! Have to scale and apply for full timestep to get tend right ! (see above note for macrophysics). @@ -2891,16 +2872,14 @@ subroutine tphysbc (ztodt, state, & flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) end if - old_cflux = cam_in%cflx - call carma_calculate_cloudborne_diagnostics(state, pbuf, aerclddiag) + call carma_diags_obj%update(cam_in, state, pbuf) call aero_model_wetdep( state, ztodt, dlf, cam_out, ptend, pbuf) if ( (trim(cam_take_snapshot_after) == "aero_model_wetdep") .and. & (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then call cam_snapshot_ptend_outfld(ptend, lchnk) end if - call carma_output_budget_diagnostics(state, ptend, old_cflux, cam_in%cflx, ztodt, "WETDEPA") - call carma_output_cloudborne_diagnostics(state, pbuf, "WETDEPA", ztodt, aerclddiag) + call carma_diags_obj%output(state, ptend, cam_in, "WETDEPA", ztodt, pbuf) call physics_update(state, ptend, ztodt, tend) if (trim(cam_take_snapshot_after) == "aero_model_wetdep") then @@ -2915,11 +2894,9 @@ subroutine tphysbc (ztodt, state, & ! fields have already been set for CAM aerosols and cam_out can be added ! to for CARMA aerosols. call t_startf ('carma_wetdep_tend') - old_cflux = cam_in%cflx - call carma_calculate_cloudborne_diagnostics(state, pbuf, aerclddiag) + call carma_diags_obj%update(cam_in, state, pbuf) call carma_wetdep_tend(state, ptend, ztodt, pbuf, dlf, cam_out) - call carma_output_budget_diagnostics(state, ptend, old_cflux, cam_in%cflx, ztodt, "WETDEPC") - call carma_output_cloudborne_diagnostics(state, pbuf, "WETDEPC", ztodt, aerclddiag) + call carma_diags_obj%output(state, ptend, cam_in, "WETDEPC", ztodt, pbuf) call physics_update(state, ptend, ztodt, tend) call t_stopf ('carma_wetdep_tend') end if @@ -3005,6 +2982,12 @@ subroutine tphysbc (ztodt, state, & call diag_export(cam_out) call t_stopf('diag_export') + ! clean CARMA diagnostics object + if (associated(carma_diags_obj)) then + deallocate(carma_diags_obj) + nullify(carma_diags_obj) + end if + end subroutine tphysbc subroutine phys_timestep_init(phys_state, cam_in, cam_out, pbuf2d) From dc7f9362f557508e13321c32081b1aba92ebad70 Mon Sep 17 00:00:00 2001 From: Francis Vitt <fvitt@ucar.edu> Date: Wed, 22 Jan 2025 08:24:03 -0700 Subject: [PATCH 14/24] fix not associated pointer issue modified: src/physics/cam/carma_diags_mod.F90 modified: src/physics/cam/physpkg.F90 --- src/physics/cam/carma_diags_mod.F90 | 23 ++++++++++++++--------- src/physics/cam/physpkg.F90 | 11 +++++++++-- 2 files changed, 23 insertions(+), 11 deletions(-) diff --git a/src/physics/cam/carma_diags_mod.F90 b/src/physics/cam/carma_diags_mod.F90 index c53a48b5d9..0146b1c860 100644 --- a/src/physics/cam/carma_diags_mod.F90 +++ b/src/physics/cam/carma_diags_mod.F90 @@ -53,19 +53,24 @@ function constructor() result(newobj) integer :: ierr - if (carma_do_package_diags) then - allocate(newobj,stat=ierr) - if( ierr /= 0 ) then - nullify(newobj) - return - end if - else + allocate(newobj,stat=ierr) + if( ierr /= 0 ) then nullify(newobj) return end if - allocate(newobj%aerclddiag(pcols,MAXCLDAERDIAG)) - allocate(newobj%old_cflux(pcols,pcnst)) + if (.not.carma_do_package_diags) return + + allocate(newobj%aerclddiag(pcols,MAXCLDAERDIAG),stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + allocate(newobj%old_cflux(pcols,pcnst),stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if end function constructor diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90 index e570eac3cd..63b9bbc828 100644 --- a/src/physics/cam/physpkg.F90 +++ b/src/physics/cam/physpkg.F90 @@ -1483,9 +1483,13 @@ subroutine tphysac (ztodt, cam_in, & ! For aerosol budget diagnostics type(carma_diags_t), pointer :: carma_diags_obj - carma_diags_obj => carma_diags_t() !----------------------------------------------------------------------- + carma_diags_obj => carma_diags_t() + if (.not.associated(carma_diags_obj)) then + call endrun('tphysac: carma_diags_obj allocation failed') + end if + lchnk = state%lchnk ncol = state%ncol @@ -2230,9 +2234,12 @@ subroutine tphysbc (ztodt, state, & ! For aerosol budget diagnostics character(len=16) :: pname !! package name type(carma_diags_t), pointer :: carma_diags_obj - carma_diags_obj => carma_diags_t() !----------------------------------------------------------------------- + carma_diags_obj => carma_diags_t() + if (.not.associated(carma_diags_obj)) then + call endrun('tphysbc: carma_diags_obj allocation failed') + end if call t_startf('bc_init') From 9a8204e320aa4029d72c05e973be1afb782b5a7c Mon Sep 17 00:00:00 2001 From: Francis Vitt <fvitt@ucar.edu> Date: Tue, 25 Feb 2025 10:35:10 -0700 Subject: [PATCH 15/24] add allocate error checking and update a comment modified: src/chemistry/aerosol/carma_aerosol_properties_mod.F90 --- .../aerosol/carma_aerosol_properties_mod.F90 | 24 ++++++++++++++----- 1 file changed, 18 insertions(+), 6 deletions(-) diff --git a/src/chemistry/aerosol/carma_aerosol_properties_mod.F90 b/src/chemistry/aerosol/carma_aerosol_properties_mod.F90 index 57d513d48b..222ea38c34 100644 --- a/src/chemistry/aerosol/carma_aerosol_properties_mod.F90 +++ b/src/chemistry/aerosol/carma_aerosol_properties_mod.F90 @@ -118,7 +118,7 @@ function constructor() result(newobj) nmasses(m) = nspecies(m) end do - alogsig(:) = log(2._r8) !!!! ???? IS THIS RIGHT ???? !!! + alogsig(:) = log(2._r8) f1 = 1._r8 f2 = 1._r8 @@ -142,9 +142,21 @@ function constructor() result(newobj) ibl = -1 - allocate(imx_num_bl(nbins)) - allocate(imx_mmr_bl(nbins)) - allocate(imx_bl(nbins)) + allocate(imx_num_bl(nbins),stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + allocate(imx_mmr_bl(nbins),stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + allocate(imx_bl(nbins),stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if imx = 0 imx_mmr = 0 @@ -170,10 +182,10 @@ function constructor() result(newobj) else spectype = 'other' end if + ! identification is required for pure and mixed aerosols, mixed aeroosols are moved to ! larger bin, pure aerosols are moved to mixed sulfate - if (index(bin_name,'MXAER')>0 .and. index(bin_name_l,'MXAER')>0) then ! for mixed aerosols ! find larger bin @@ -196,7 +208,7 @@ function constructor() result(newobj) end if ! MXAER if (index(bin_name,'PRSUL')>0 .and. index(bin_name_l,'PRSUL')>0) then - ! assuming PRSULF and MXSULF have the same number of bins + ! pure sulfate bins if (trim(spectype) == 'sulfate') then ipr = ipr +1 ibl(ii) = imx_bl(ipr) From 0d4ee72b97aca66b1e3678251235a9ea854b5d61 Mon Sep 17 00:00:00 2001 From: Francis Vitt <fvitt@ucar.edu> Date: Wed, 26 Feb 2025 10:15:59 -0700 Subject: [PATCH 16/24] some clean up and misc minor corrections modified: bld/namelist_files/namelist_definition.xml modified: src/chemistry/aerosol/hygrocoreshell_aerosol_optics_mod.F90 modified: src/chemistry/aerosol/hygrowghtpct_aerosol_optics_mod.F90 modified: src/chemistry/carma_aero/aero_model.F90 modified: src/chemistry/carma_aero/sox_cldaero_mod.F90 --- bld/namelist_files/namelist_definition.xml | 8 +- .../hygrocoreshell_aerosol_optics_mod.F90 | 5 +- .../hygrowghtpct_aerosol_optics_mod.F90 | 1 - src/chemistry/carma_aero/aero_model.F90 | 703 +----------------- src/chemistry/carma_aero/sox_cldaero_mod.F90 | 64 +- 5 files changed, 46 insertions(+), 735 deletions(-) diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 481d72d998..7c5ed4960f 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -4967,7 +4967,7 @@ for the trop_strat CARMA model. Valid options are: Yu2015 -- method used in Yu et. al, 2015 - Specified -- {{ hilight }}emissions_specifier{{ closehilight }} method which places emissons in physcis buffer + Specified -- {{ hilight }}emissions_specifier{{ closehilight }} method which places emissions in physcis buffer Default: Yu2015 </entry> @@ -4979,7 +4979,7 @@ for the trop_strat CARMA model. Valid options are: - Specified -- {{ hilight }}elev_emis_specifier{{ closehilight }} method which places emissons in physcis buffer + Specified -- {{ hilight }}elev_emis_specifier{{ closehilight }} method which places emissions in physcis buffer Default: NONE </entry> @@ -4990,10 +4990,10 @@ List of full pathnames of surface emission datasets. Elevated emission data added to physcis buffer read from a set of netcdf file. Each tracer species emissions is read from its own file as directed by the -namelist variable {{ hilight }}elve_emis_specifier{{ closehilight }}. The +namelist variable {{ hilight }}elev_emis_specifier{{ closehilight }}. The {{ hilight }}emissions_specifier{{ closehilight }} variable tells the model which species have emissions and the file path for the corresponding species. -That is, the {{ hilight }}elve_emis_specifier{{ closehilight }} variable is +That is, the {{ hilight }}elev_emis_specifier{{ closehilight }} variable is set something like: elev_emis_specifier = 'SO4 -> /path/emis.SO4.nc', diff --git a/src/chemistry/aerosol/hygrocoreshell_aerosol_optics_mod.F90 b/src/chemistry/aerosol/hygrocoreshell_aerosol_optics_mod.F90 index 8871312117..3e78f5a8c9 100644 --- a/src/chemistry/aerosol/hygrocoreshell_aerosol_optics_mod.F90 +++ b/src/chemistry/aerosol/hygrocoreshell_aerosol_optics_mod.F90 @@ -201,8 +201,8 @@ subroutine sw_props(self, ncol, ilev, iwav, pext, pabs, palb, pasm) integer, intent(in) :: iwav ! wave length index real(r8),intent(out) :: pext(ncol) ! parameterized specific extinction (m2/kg) real(r8),intent(out) :: pabs(ncol) ! parameterized specific absorption (m2/kg) - real(r8),intent(out) :: palb(ncol) ! parameterized asymmetry factor - real(r8),intent(out) :: pasm(ncol) ! parameterized single scattering albedo + real(r8),intent(out) :: palb(ncol) ! parameterized single scattering albedo + real(r8),intent(out) :: pasm(ncol) ! parameterized asymmetry factor integer :: icol @@ -228,7 +228,6 @@ subroutine sw_props(self, ncol, ilev, iwav, pext, pabs, palb, pasm) pabs(icol) = min(pext(icol),pabs(icol)) palb(icol) = 1._r8-pabs(icol)/max(pext(icol),1.e-40_r8) - palb(icol) = 1._r8-pabs(icol)/max(pext(icol),1.e-40_r8) end do diff --git a/src/chemistry/aerosol/hygrowghtpct_aerosol_optics_mod.F90 b/src/chemistry/aerosol/hygrowghtpct_aerosol_optics_mod.F90 index ebe84c1a56..7153e13986 100644 --- a/src/chemistry/aerosol/hygrowghtpct_aerosol_optics_mod.F90 +++ b/src/chemistry/aerosol/hygrowghtpct_aerosol_optics_mod.F90 @@ -135,7 +135,6 @@ subroutine sw_props(self, ncol, ilev, iwav, pext, pabs, palb, pasm) pabs(icol) = min(pext(icol),pabs(icol)) palb(icol) = 1._r8-pabs(icol)/max(pext(icol),1.e-40_r8) - palb(icol) = 1._r8-pabs(icol)/max(pext(icol),1.e-40_r8) end do diff --git a/src/chemistry/carma_aero/aero_model.F90 b/src/chemistry/carma_aero/aero_model.F90 index 9da34eb645..d27865a093 100644 --- a/src/chemistry/carma_aero/aero_model.F90 +++ b/src/chemistry/carma_aero/aero_model.F90 @@ -26,7 +26,7 @@ module aero_model use carma_aerosol_properties_mod, only: carma_aerosol_properties use carma_intr, only: carma_get_group_by_name, carma_get_dry_radius, carma_get_wet_radius, carma_get_bin_rmass - use carma_intr, only: carma_get_total_mmr, carma_get_sad + use carma_intr, only: carma_get_sad use aerosol_properties_mod, only: aero_name_len @@ -47,28 +47,18 @@ module aero_model character(len=32), allocatable :: fieldname(:) ! names for interstitial output fields character(len=32), allocatable :: fieldname_cw(:) ! names for cloud_borne output fields - ! number of modes - integer :: pblh_idx = 0 - integer :: wetdens_ap_idx = 0 - integer :: fracis_idx = 0 integer :: prain_idx = 0 integer :: rprddp_idx = 0 integer :: rprdsh_idx = 0 integer :: nevapr_shcu_idx = 0 integer :: nevapr_dpcu_idx = 0 - - integer :: sulfeq_idx = -1 - integer :: nh3_ndx = 0 integer :: nh4_ndx = 0 integer :: h2so4_ndx = 0 ! variables for table lookup of aerosol impaction/interception scavenging rates integer, parameter :: nimptblgrow_mind=-7, nimptblgrow_maxd=12 - real(r8) :: dlndg_nimptblgrow - real(r8),allocatable :: scavimptblnum(:,:) - real(r8),allocatable :: scavimptblvol(:,:) ! description of bin aerosols @@ -98,7 +88,6 @@ module aero_model real(r8) :: sol_facti_cloud_borne = 1._r8 real(r8) :: sol_factb_interstitial = 0.1_r8 real(r8) :: sol_factic_interstitial = 0.4_r8 - real(r8) :: seasalt_emis_scale logical :: convproc_do_aer @@ -123,9 +112,6 @@ subroutine aero_model_readnl(nlfile) character(len=*), parameter :: subname = 'aero_model_readnl' ! Namelist variables - !st character(len=16) :: aer_wetdep_list(pcnst) = ' ' - !st character(len=16) :: aer_drydep_list(pcnst) = ' ' - namelist /aerosol_nl/ sol_facti_cloud_borne, sol_factb_interstitial, sol_factic_interstitial !----------------------------------------------------------------------------- @@ -147,14 +133,9 @@ subroutine aero_model_readnl(nlfile) #ifdef SPMD ! Broadcast namelist variables - !st call mpibcast(aer_wetdep_list, len(aer_wetdep_list(1))*pcnst, mpichar, 0, mpicom) - !st call mpibcast(aer_drydep_list, len(aer_drydep_list(1))*pcnst, mpichar, 0, mpicom) call mpibcast(sol_facti_cloud_borne, 1, mpir8, 0, mpicom) call mpibcast(sol_factb_interstitial, 1, mpir8, 0, mpicom) call mpibcast(sol_factic_interstitial, 1, mpir8, 0, mpicom) - !st call mpibcast(modal_strat_sulfate, 1, mpilog, 0, mpicom) - !st call mpibcast(seasalt_emis_scale, 1, mpir8, 0, mpicom) - !st call mpibcast(modal_accum_coarse_exch, 1, mpilog, 0, mpicom) #endif call aero_wetdep_readnl(nlfile) @@ -169,17 +150,15 @@ subroutine aero_model_register() integer :: m, l, i integer :: nsoa_vbs - character(len=32) :: spectype character(len=32) :: num_name character(len=32) :: num_name_cw character(len=32) :: spec_name_cw - character(len=32) :: soag_name - character(len=32) :: soa_name - integer :: idx + integer :: idx, ierr call rad_cnst_get_info( 0, nbins=nbins) - allocate( nspec(nbins) ) + allocate( nspec(nbins), stat=ierr ) + if (ierr/=0) call endrun('aero_model_register: allocate error') ! add pbuf fields for interstitial (cloud borne) aerosols in CARMA do m = 1, nbins @@ -216,20 +195,9 @@ subroutine aero_model_init( pbuf2d ) use mo_chem_utls, only: get_inv_ndx use cam_history, only: addfld, add_default, horiz_only use mo_chem_utls, only: get_rxt_ndx, get_spc_ndx - !st use modal_aero_data, only: cnst_name_cw - !st use modal_aero_data, only: modal_aero_data_init - !st use dust_model, only: dust_init, dust_names, dust_active, dust_nbin, dust_nnum - !st use seasalt_model, only: seasalt_init, seasalt_names, seasalt_active,seasalt_nbin - !st use drydep_mod, only: inidrydep use aero_wetdep_cam, only: aero_wetdep_init use mo_setsox, only: sox_inti - - !st use modal_aero_calcsize, only: modal_aero_calcsize_init - !st use modal_aero_coag, only: modal_aero_coag_init - !st use modal_aero_deposition, only: modal_aero_deposition_init use carma_aero_gasaerexch, only: carma_aero_gasaerexch_init - !st use modal_aero_newnuc, only: modal_aero_newnuc_init - !st use modal_aero_rename, only: modal_aero_rename_init use time_manager, only: is_first_step use constituents, only: cnst_set_convtran2 @@ -241,28 +209,20 @@ subroutine aero_model_init( pbuf2d ) ! local vars character(len=*), parameter :: subrname = 'aero_model_init' - integer :: m, n, id, ii, mm - integer :: lptr = -1 + integer :: m, n, ii, mm integer :: idxtmp = -1 - character(len=20) :: dummy logical :: history_aerosol ! Output MAM or SECT aerosol tendencies - logical :: history_chemistry, history_cesm_forcing, history_dust + logical :: history_chemistry, history_cesm_forcing integer :: l - character(len=6) :: test_name - character(len=64) :: errmes character(len=2) :: unit_basename ! Units 'kg' or '1' - integer :: errcode - !st character(len=fieldname_len) :: field_name - - character(len=32) :: spectype character(len=32) :: num_name character(len=32) :: num_name_cw character(len=32) :: spec_name_cw - integer :: idx + integer :: idx, ierr real(r8) :: nanval aero_props => carma_aerosol_properties() @@ -297,51 +257,19 @@ subroutine aero_model_init( pbuf2d ) nh3_ndx = get_spc_ndx('NH3') nh4_ndx = get_spc_ndx('NH4') - - fracis_idx = pbuf_get_index('FRACIS') prain_idx = pbuf_get_index('PRAIN') rprddp_idx = pbuf_get_index('RPRDDP') rprdsh_idx = pbuf_get_index('RPRDSH') nevapr_shcu_idx = pbuf_get_index('NEVAPR_SHCU') nevapr_dpcu_idx = pbuf_get_index('NEVAPR_DPCU') - !st sulfeq_idx = pbuf_get_index('MAMH2SO4EQ',errcode) - !st not sure if this is needed call phys_getopts(history_aerosol_out = history_aerosol, & history_chemistry_out=history_chemistry, & history_cesm_forcing_out=history_cesm_forcing, & convproc_do_aer_out = convproc_do_aer) -!!$ call carma_aero_bcscavcoef_init(pbuf2d) - - !st call modal_aero_rename_init( modal_accum_coarse_exch ) - ! calcsize call must follow rename call - !st call modal_aero_calcsize_init( pbuf2d ) call carma_aero_gasaerexch_init - ! coag call must follow gasaerexch call - !st call modal_aero_coag_init - !st call modal_aero_newnuc_init - - ! call modal_aero_deposition_init only if the user has not specified - ! prescribed aerosol deposition fluxes - !st if (.not.aerodep_flx_prescribed()) then - !st call modal_aero_deposition_init - !stendif - - - !st all CARMA species are deposited, therefore the following is not used - !st nwetdep = 0 - !st ndrydep = 0 - - !st count_species: do m = 1,pcnst - !st if ( len_trim(wetdep_list(m)) /= 0 ) then - !st nwetdep = nwetdep+1 - !st endif - !st if ( len_trim(drydep_list(m)) /= 0 ) then - !st ndrydep = ndrydep+1 - !st endif - !st enddo count_species ! add plus one to include number, total mmr and nspec nspec_max = maxval(nspec) @@ -357,7 +285,8 @@ subroutine aero_model_init( pbuf2d ) bin_cnst_lq(nbins,nspec_max), & bin_cnst_idx(nbins,nspec_max), & fieldname_cw(ncnst_tot), & - fieldname(ncnst_tot) ) + fieldname(ncnst_tot), stat=ierr ) + if (ierr/=0) call endrun(subrname//' : allocate error') ii = 0 do m = 1, nbins @@ -609,7 +538,6 @@ subroutine aero_model_gasaerexch( state, loffset, ncol, lchnk, troplev, delt, re real(r8) :: del_h2so4_aeruptk(ncol,pver) - !st real(r8), pointer :: dgnum(:,:,:), dgnumwet(:,:,:), wetdens(:,:,:) real(r8), pointer :: pblh(:) ! pbl height (m) real(r8), dimension(ncol) :: wrk @@ -618,8 +546,6 @@ subroutine aero_model_gasaerexch( state, loffset, ncol, lchnk, troplev, delt, re real(r8) :: dvmrdt(ncol,pver,gas_pcnst) real(r8) :: delta_so4mass(ncol,pver,ncnst_tot) real(r8) :: wetr_n(pcols,pver,nbins) ! wet radius from CARMA for different bin - !st real(r8) :: vmrcw(ncol,pver,gas_pcnst) ! cloud-borne aerosol (vmr) - !st vmrcw is going only through CARMA aerosols (ncnst_tot) real(r8) :: vmrcw(ncol,pver,ncnst_tot) ! cloud-borne aerosol (vmr) real(r8) :: mmrcw(ncol,pver,ncnst_tot) ! cloud-borne aerosol (mmr) real(r8) :: raervmr(ncol,pver,ncnst_tot) ! cloud-borne aerosol (vmr) @@ -642,10 +568,9 @@ subroutine aero_model_gasaerexch( state, loffset, ncol, lchnk, troplev, delt, re real(r8) :: old_total_number character(len=32) :: spectype - logical :: is_spcam_m2005 character(len=aero_name_len) :: bin_name, shortname - integer :: igroup, ibin, rc, nchr + integer :: igroup, ibin, rc, nchr, ierr character(len=*), parameter :: subname = 'aero_model_gasaerexch' ! @@ -655,14 +580,7 @@ subroutine aero_model_gasaerexch( state, loffset, ncol, lchnk, troplev, delt, re nh3_beg = vmr(1:ncol,:,nh3_ndx) end if ! - is_spcam_m2005 = cam_physpkg_is('spcam_m2005') - - !st call pbuf_get_field(pbuf, dgnum_idx, dgnum) - !st call pbuf_get_field(pbuf, dgnumwet_idx, dgnumwet ) - !st call pbuf_get_field(pbuf, wetdens_ap_idx, wetdens ) - !st call pbuf_get_field(pbuf, pblh_idx, pblh) - - ! do gas-aerosol exchange (h2so4, msa, nh3 condensation) +! do gas-aerosol exchange (h2so4, msa, nh3 condensation) nstep = get_nstep() @@ -681,13 +599,13 @@ subroutine aero_model_gasaerexch( state, loffset, ncol, lchnk, troplev, delt, re ! Aerosol processes ... ! allocate( & - rmass(nbins), & - raer(ncnst_tot), & - qqcw(ncnst_tot) ) + rmass(nbins), & + raer(ncnst_tot), & + qqcw(ncnst_tot), stat=ierr ) + if (ierr /= 0) call endrun(subname//': allocate error') mw_carma(:) = 0.0_r8 do m = 1, nbins ! main loop over aerosol bins - !st can we move this part to init??? ! dryr is the dry bin radius ! wetr is the dry bin radius ! Note: taken here from CARMA pbuf field which may be not any more consistent with changed fields after carma was applied @@ -748,22 +666,16 @@ subroutine aero_model_gasaerexch( state, loffset, ncol, lchnk, troplev, delt, re mmrcw(:ncol,:,mm) = qqcw(mm)%fld(:ncol,:) vmrcw(:ncol,:,mm) = qqcw(mm)%fld(:ncol,:) raervmr(:ncol,:,mm) = raer(mm)%fld(:ncol,:) - !write(iulog,*) 'qqcw(mm)%fld) ', qqcw(mm)%fld(:ncol,:) end do end do - !write(iulog,*) 'vmrcw(:,:,1) start', maxval(vmrcw(:ncol,:,1) ) - !write(iulog,*) 'mm start vmrcw, raervmr' ! qqcw2vrm is different from what is done in MAM, here we pass in the fields set by the qqcw and raer pointer ! for all the CARMA aerosols, species, mmr, and number, vmrcw (kg/kg) -> vmr call mmr2vmr_carma ( lchnk, vmrcw, mbar, mw_carma, ncol, loffset, rmass ) - !write(iulog,*) 'vmrcw(:,:,1) mmr', maxval(vmrcw(:,:,1)) - if (.not. is_spcam_m2005) then ! regular CAM - dvmrdt(:ncol,:,:) = vmr(:ncol,:,:) ! all adveced species no aerosols - dvmrcwdt(:ncol,:,:) = vmrcw(:ncol,:,:) ! cloud borne carma aerosol species + dvmrdt(:ncol,:,:) = vmr(:ncol,:,:) ! all adveced species no aerosols + dvmrcwdt(:ncol,:,:) = vmrcw(:ncol,:,:) ! cloud borne carma aerosol species ! aqueous chemistry ... - ! write(iulog,*) 'start has_sox' if( has_sox ) then call setsox( state, & @@ -789,7 +701,6 @@ subroutine aero_model_gasaerexch( state, loffset, ncol, lchnk, troplev, delt, re aqso4_o3 & ) - !write(iulog,*) 'done with has_sox' do n = 1, nbins do l = 1, nspec(n) ! not for total mass or number mm = bin_idx(n, l) @@ -817,15 +728,6 @@ subroutine aero_model_gasaerexch( state, loffset, ncol, lchnk, troplev, delt, re call outfld( name, wrk(:ncol), ncol, lchnk ) enddo - else if (is_spcam_m2005) then ! SPCAM ECPP -! when ECPP is used, aqueous chemistry is done in ECPP, -! and not updated here. -! Minghuai Wang, 2010-02 (Minghuai.Wang@pnl.gov) - - dvmrdt = 0.0_r8 - dvmrcwdt = 0.0_r8 - endif - ! do gas-aerosol exchange (h2so4, msa, nh3 condensation) if (h2so4_ndx > 0) then @@ -834,18 +736,8 @@ subroutine aero_model_gasaerexch( state, loffset, ncol, lchnk, troplev, delt, re del_h2so4_aeruptk(:,:) = 0.0_r8 endif - - !call t_startf('modal_gas-aer_exchng') - - !if ( sulfeq_idx>0 ) then - ! call pbuf_get_field( pbuf, sulfeq_idx, sulfeq ) - !else - ! nullify( sulfeq ) - !endif - !write(iulog,*) 'start carma_aero_gasaerexch_sub' ! need to transform raer to raervmr from CARMA, routine requires vmr, note number wil not be changed here call mmr2vmr_carma ( lchnk, raervmr, mbar, mw_carma, ncol, loffset, rmass) - !write(iulog,*) 'mm start raervmr done' call carma_aero_gasaerexch_sub( state, & pbuf, lchnk, ncol, nstep, & @@ -855,13 +747,6 @@ subroutine aero_model_gasaerexch( state, loffset, ncol, lchnk, troplev, delt, re vmr, raervmr, & wetr_n ) - !if (h2so4_ndx > 0) then - ! del_h2so4_aeruptk(1:ncol,:) = vmr(1:ncol,:,h2so4_ndx) - del_h2so4_aeruptk(1:ncol,:) - !endif - - !call t_stopf('modal_gas-aer_exchng') - - ! note vmr2qqcw does not change qqcw pointer (different than in MAM) call vmr2mmr_carma ( lchnk, vmrcw, mbar, mw_carma, ncol, loffset, rmass ) @@ -891,7 +776,6 @@ subroutine aero_model_gasaerexch( state, loffset, ncol, lchnk, troplev, delt, re end do end do - ! Is the loop here needed? do m = 1, nbins do l = 1, nspec(m) ! for sulfate only mm = bin_idx(m, l) @@ -941,9 +825,8 @@ subroutine surf_area_dens( state, pbuf, ncol, mmr, beglev, endlev, sad, reff, sf ! local vars real(r8) :: reffaer(pcols,pver) ! bulk effective radius in cm - real(r8), pointer, dimension(:,:) :: cmass,tmass ! carma element chemical and total mass real(r8) :: sad_bin(pcols,pver,nbins) - integer :: err, icol, ilev, ibin, ispec !!, reff_pbf_ndx + integer :: icol, ilev, ibin, ispec !!, reff_pbf_ndx real(r8) :: chm_mass, tot_mass character(len=32) :: spectype real(r8) :: wetr(pcols,pver) ! CARMA bin wet radius in cm @@ -1032,536 +915,12 @@ subroutine surf_area_dens( state, pbuf, ncol, mmr, beglev, endlev, sad, reff, sf end subroutine surf_area_dens -!!$ !=============================================================================== -!!$ !=============================================================================== -!!$ subroutine carma_aero_bcscavcoef_init ( pbuf2d ) -!!$ !----------------------------------------------------------------------- -!!$ ! -!!$ ! Purpose: -!!$ ! Computes lookup table for aerosol impaction/interception scavenging rates -!!$ ! -!!$ ! Authors: R. Easter -!!$ ! Simone Tilmes Nov 2021 -!!$ ! added modifications for bin model, assuming sigma = 1. -!!$ ! -!!$ !----------------------------------------------------------------------- -!!$ -!!$ use shr_kind_mod, only: r8 => shr_kind_r8 -!!$ use cam_abortutils, only: endrun -!!$ use mo_constants, only: pi -!!$ use ppgrid, only: begchunk -!!$ -!!$ implicit none -!!$ -!!$ type(physics_buffer_desc), pointer :: pbuf2d(:,:) -!!$ -!!$ ! local variables -!!$ integer nnfit_maxd -!!$ parameter (nnfit_maxd=27) -!!$ -!!$ integer m, i, l, jgrow, jdens, jpress, jtemp, nnfit -!!$ integer lunerr -!!$ -!!$ character(len=32) :: bin_name -!!$ character(len=32) :: spectype -!!$ -!!$ real(r8) dg0, dg0_cgs, press, dg0_base, & -!!$ rhodryaero, rhowetaero, rhowetaero_cgs, rmserr, & -!!$ scavratenum, scavratevol, sigmag, & -!!$ temp, wetdiaratio, wetvolratio -!!$ real(r8) :: specdens -!!$ real(r8) aafitnum(1), xxfitnum(1,nnfit_maxd), yyfitnum(nnfit_maxd) -!!$ real(r8) aafitvol(1), xxfitvol(1,nnfit_maxd), yyfitvol(nnfit_maxd) -!!$ -!!$ -!!$ allocate(scavimptblnum(nimptblgrow_mind:nimptblgrow_maxd, nbins)) -!!$ allocate(scavimptblvol(nimptblgrow_mind:nimptblgrow_maxd, nbins)) -!!$ -!!$ lunerr = iulog -!!$ dlndg_nimptblgrow = log( 1.25_r8 ) -!!$ -!!$ ! bin model: main loop over aerosol bins -!!$ -!!$ modeloop: do m = 1, nbins -!!$ !write(*,*) 'mloop start ',m -!!$ ! r(m) is the dry bin radius -!!$ ! taken here from CARMA pbuf field -!!$ ! get bin info -!!$ call rad_cnst_get_info_by_bin(0, m, bin_name=bin_name) -!!$ -!!$ ! for setting up the lookup table, use the dry density of the first -!!$ ! get specdens from sulfate (check) -!!$ do l = 1, nspec(m) -!!$ call aero_props%species_type(m,l, spectype) -!!$ if (trim(spectype) == 'sulfate') then -!!$ call aero_props%get(m,l,density=rhodryaero) -!!$ end if -!!$ end do -!!$ -!!$ dg0_base = 2._r8 * aero_props%scav_radius(m) -!!$ -!!$ !sigmag = sigmag_amode(mode) -!!$ !dg0_base = dcen_sect(m,n)*exp( -1.5*((log(sigmag))**2) ) -!!$ ! for bin approach sigma assumed to be 1., dg0_base equal dry radius -!!$ sigmag = 1._r8 -!!$ -!!$ -!!$ !st rhodryaero = specdens_amode(1,mode) -!!$ -!!$ growloop: do jgrow = nimptblgrow_mind, nimptblgrow_maxd -!!$ -!!$ wetdiaratio = exp( jgrow*dlndg_nimptblgrow ) -!!$ !dg0 = dgnum_amode(mode)*wetdiaratio -!!$ dg0 = dg0_base*wetdiaratio -!!$ !st write(*,*) 'm,l,dg0 ',m,l,dg0 -!!$ -!!$ wetvolratio = exp( jgrow*dlndg_nimptblgrow*3._r8 ) -!!$ rhowetaero = 1.0_r8 + (rhodryaero-1.0_r8)/wetvolratio -!!$ rhowetaero = min( rhowetaero, rhodryaero ) -!!$ -!!$ ! -!!$ ! compute impaction scavenging rates at 1 temp-press pair and save -!!$ ! -!!$ nnfit = 0 -!!$ -!!$ temp = 273.16_r8 -!!$ press = 0.75e6_r8 ! dynes/cm2 -!!$ rhowetaero = rhodryaero -!!$ -!!$ ! CARMA dry radius is in cm -!!$ !dg0_cgs = dg0*1.0e2_r8 ! m to cm -!!$ dg0_cgs = dg0 ! CARMA radius / diameter is already in cm -!!$ -!!$ rhowetaero_cgs = rhowetaero*1.0e-3_r8 ! kg/m3 to g/cm3 -!!$ -!!$ -!!$ call calc_1_impact_rate( & -!!$ dg0_cgs, sigmag, rhowetaero_cgs, temp, press, & -!!$ scavratenum, scavratevol, lunerr ) -!!$ -!!$ -!!$ nnfit = nnfit + 1 -!!$ if (nnfit > nnfit_maxd) then -!!$ write(lunerr,9110) -!!$ call endrun() -!!$ end if -!!$9110 format( '*** subr. carma_aero_bcscavcoef_init -- nnfit too big' ) -!!$ -!!$ xxfitnum(1,nnfit) = 1._r8 -!!$ yyfitnum(nnfit) = log( scavratenum ) -!!$ -!!$ xxfitvol(1,nnfit) = 1._r8 -!!$ yyfitvol(nnfit) = log( scavratevol ) -!!$ -!!$ ! -!!$ ! skip mlinfit stuff because scav table no longer has dependencies on -!!$ ! air temp, air press, and particle wet density -!!$ ! just load the log( scavrate--- ) values -!!$ ! -!!$ !! -!!$ !! do linear regression -!!$ !! log(scavrate) = a1 + a2*log(wetdens) -!!$ !! -!!$ ! call mlinft( xxfitnum, yyfitnum, aafitnum, nnfit, 1, 1, rmserr ) -!!$ ! call mlinft( xxfitvol, yyfitvol, aafitvol, nnfit, 1, 1, rmserr ) -!!$ ! -!!$ ! scavimptblnum(jgrow,mode) = aafitnum(1) -!!$ ! scavimptblvol(jgrow,mode) = aafitvol(1) -!!$ -!!$ !depends on both bins and different species -!!$ scavimptblnum(jgrow,m) = yyfitnum(1) -!!$ scavimptblvol(jgrow,m) = yyfitvol(1) -!!$ -!!$ enddo growloop -!!$ enddo modeloop -!!$ -!!$ return -!!$ end subroutine carma_aero_bcscavcoef_init -!!$ -!!$ !=============================================================================== -!!$ !=============================================================================== -!!$ -!!$ -!!$ !=============================================================================== -!!$ subroutine carma_aero_bcscavcoef_get( m, ncol, isprx, wetr, dryr, scavcoefnum, scavcoefvol, pbuf ) -!!$ ! need to go through both bins and species -!!$ ! need dry radius and wet radius -!!$ -!!$ !----------------------------------------------------------------------- -!!$ -!!$ use mo_constants, only: pi -!!$ -!!$ implicit none -!!$ -!!$ integer,intent(in) :: m, ncol -!!$ logical,intent(in):: isprx(pcols,pver) -!!$ ! wet radius per bin dgn_awet -> wetr -!!$ real(r8), intent(in) :: dryr(pcols,pver) -!!$ real(r8), intent(in) :: wetr(pcols,pver) -!!$ real(r8), intent(out) :: scavcoefnum(pcols,pver), scavcoefvol(pcols,pver) -!!$ type(physics_buffer_desc), pointer :: pbuf(:) -!!$ -!!$ integer i, k, jgrow, l -!!$ real(r8) dumdgratio, xgrow, dumfhi, dumflo, scavimpvol, scavimpnum, dg0_base, specdens, rhodryaero -!!$ -!!$ character(len=32) :: spectype -!!$ character(len=aero_name_len) :: bin_name, shortname -!!$ integer :: igroup, ibin, rc, nchr -!!$ -!!$ real(r8), allocatable :: rmass(:) ! CARMA rmass -!!$ character(len=*), parameter :: subname = 'carma_aero_bcscavcoef_get' -!!$ -!!$ allocate ( rmass(nbins) ) -!!$ ! bin model: main loop over aerosol bins -!!$ -!!$ ! get bin info -!!$ call rad_cnst_get_info_by_bin(0, m, bin_name=bin_name) -!!$ -!!$ nchr = len_trim(bin_name)-2 -!!$ shortname = bin_name(:nchr) -!!$ -!!$ call carma_get_group_by_name(shortname, igroup, rc) -!!$ -!!$ read(bin_name(nchr+1:),*) ibin -!!$ -!!$ call carma_get_bin_rmass(igroup, ibin, rmass(m), rc) -!!$ if (rc/=0) then -!!$ call endrun(subname//': ERROR in carma_get_bin_rmass') -!!$ end if -!!$ -!!$ ! get rmass and specdens for sulfate -!!$ do l = 1, nspec(m) -!!$ call rad_cnst_get_bin_props_by_idx(0, m, l,spectype=spectype, density_aer=specdens) -!!$ -!!$ ! chemical component of the aerosol type (which currently will be so4) -!!$ ! For CARMA, rmass per bin stays the same, while dry radius varies when the particle density varies -!!$ ! rmass = 4/3 * Pi * density * dry radius -!!$ ! We assume a fixed specie density -!!$ if (trim(spectype) == 'sulfate') then -!!$ rhodryaero = specdens -!!$ end if -!!$ end do -!!$ dg0_base = 2._r8 * (0.75_r8*rmass(m) / pi / (1.0e-3_r8*rhodryaero)) **(0.33_r8) ! specdens kg/m3 to g/cm3, convert from radiust to diameter -!!$ !rg0_base = (0.75_r8*rmass(m) / pi / (1.0e-3_r8*specdens)) **(0.33_r8) ! specdens kg/m3 to g/cm3 -!!$ -!!$ do k = 1, pver -!!$ do i = 1, ncol -!!$ -!!$ ! do only if no precip -!!$ if ( isprx(i,k) .and. dryr(i,k).gt.0._r8) then -!!$ ! -!!$ ! interpolate table values using log of (actual-wet-size)/(base-dry-size) -!!$ -!!$ ! dumdgratio = dgn_awet(i,k,m)/dgnum_amode(m) -!!$ ! dgnum_amode(m) is the rg0_base radius. -!!$ -!!$ dumdgratio = wetr(i,k)/dg0_base -!!$ -!!$ if ((dumdgratio >= 0.99_r8) .and. (dumdgratio <= 1.01_r8)) then -!!$ scavimpvol = scavimptblvol(0,m) -!!$ scavimpnum = scavimptblnum(0,m) -!!$ else -!!$ xgrow = log( dumdgratio ) / dlndg_nimptblgrow -!!$ jgrow = int( xgrow ) -!!$ if (xgrow < 0._r8) jgrow = jgrow - 1 -!!$ if (jgrow < nimptblgrow_mind) then -!!$ jgrow = nimptblgrow_mind -!!$ xgrow = jgrow -!!$ else -!!$ jgrow = min( jgrow, nimptblgrow_maxd-1 ) -!!$ end if -!!$ -!!$ dumfhi = xgrow - jgrow -!!$ dumflo = 1._r8 - dumfhi -!!$ -!!$ scavimpvol = dumflo*scavimptblvol(jgrow,m) + & -!!$ dumfhi*scavimptblvol(jgrow+1,m) -!!$ scavimpnum = dumflo*scavimptblnum(jgrow,m) + & -!!$ dumfhi*scavimptblnum(jgrow+1,m) -!!$ -!!$ end if -!!$ -!!$ ! impaction scavenging removal amount for volume -!!$ scavcoefvol(i,k) = exp( scavimpvol ) -!!$ ! impaction scavenging removal amount to number -!!$ scavcoefnum(i,k) = exp( scavimpnum ) -!!$ -!!$ ! scavcoef = impaction scav rate (1/h) for precip = 1 mm/h -!!$ ! scavcoef = impaction scav rate (1/s) for precip = pfx_inrain -!!$ ! (scavcoef/3600) = impaction scav rate (1/s) for precip = 1 mm/h -!!$ ! (pfx_inrain*3600) = in-rain-area precip rate (mm/h) -!!$ ! impactrate = (scavcoef/3600) * (pfx_inrain*3600) -!!$ else -!!$ scavcoefvol(i,k) = 0._r8 -!!$ scavcoefnum(i,k) = 0._r8 -!!$ end if -!!$ -!!$ end do -!!$ end do -!!$ -!!$ return -!!$ end subroutine carma_aero_bcscavcoef_get - - !=============================================================================== - subroutine calc_1_impact_rate( & - dg0, sigmag, rhoaero, temp, press, & - scavratenum, scavratevol, lunerr ) - ! - ! routine computes a single impaction scavenging rate - ! for precipitation rate of 1 mm/h - ! - ! dg0 = geometric mean diameter of aerosol number size distrib. (for CARMA it is the dry radius) (cm) - ! sigmag = geometric standard deviation of size distrib. - ! rhoaero = density of aerosol particles (g/cm^3) - ! temp = temperature (K) - ! press = pressure (dyne/cm^2) - ! scavratenum = number scavenging rate (1/h) - ! scavratevol = volume or mass scavenging rate (1/h) - ! lunerr = logical unit for error message - ! - use shr_kind_mod, only: r8 => shr_kind_r8 - use mo_constants, only: boltz_cgs, pi, rhowater => rhoh2o_cgs, & - gravity => gravity_cgs, rgas => rgas_cgs - - implicit none - - ! subr. parameters - integer lunerr - real(r8) dg0, sigmag, rhoaero, temp, press, scavratenum, scavratevol - - ! local variables - integer nrainsvmax - parameter (nrainsvmax=50) - real(r8) rrainsv(nrainsvmax), xnumrainsv(nrainsvmax),& - vfallrainsv(nrainsvmax) - - integer naerosvmax - parameter (naerosvmax=51) - real(r8) aaerosv(naerosvmax), & - ynumaerosv(naerosvmax), yvolaerosv(naerosvmax) - - integer i, ja, jr, na, nr - real(r8) a, aerodiffus, aeromass, ag0, airdynvisc, airkinvisc - real(r8) anumsum, avolsum, cair, chi - real(r8) d, dr, dum, dumfuchs, dx - real(r8) ebrown, eimpact, eintercept, etotal, freepath - real(r8) precip, precipmmhr, precipsum - real(r8) r, rainsweepout, reynolds, rhi, rhoair, rlo, rnumsum - real(r8) scavsumnum, scavsumnumbb - real(r8) scavsumvol, scavsumvolbb - real(r8) schmidt, sqrtreynolds, sstar, stokes, sx - real(r8) taurelax, vfall, vfallstp - real(r8) x, xg0, xg3, xhi, xlo, xmuwaterair - - - rlo = .005_r8 - rhi = .250_r8 - dr = 0.005_r8 - nr = 1 + nint( (rhi-rlo)/dr ) - if (nr > nrainsvmax) then - write(lunerr,9110) - call endrun() - end if - -9110 format( '*** subr. calc_1_impact_rate -- nr > nrainsvmax' ) - - precipmmhr = 1.0_r8 - precip = precipmmhr/36000._r8 - -! if dg0 the diameter, than ag0 equals the radius - ag0 = dg0/2._r8 - if (sigmag.ne.1._r8) then - sx = log( sigmag ) - xg0 = log( ag0 ) - xg3 = xg0 + 3._r8*sx*sx - - xlo = xg3 - 4._r8*sx - xhi = xg3 + 4._r8*sx - dx = 0.2_r8*sx - - dx = max( 0.2_r8*sx, 0.01_r8 ) - xlo = xg3 - max( 4._r8*sx, 2._r8*dx ) - xhi = xg3 + max( 4._r8*sx, 2._r8*dx ) - - na = 1 + nint( (xhi-xlo)/dx ) - if (na > naerosvmax) then - write(lunerr,9120) - call endrun() - end if - else - na = 1 - a = ag0 - end if - -9120 format( '*** subr. calc_1_impact_rate -- na > naerosvmax' ) - - ! air molar density - cair = press/(rgas*temp) - ! air mass density - rhoair = 28.966_r8*cair - ! molecular freepath - freepath = 2.8052e-10_r8/cair - ! air dynamic viscosity - airdynvisc = 1.8325e-4_r8 * (416.16_r8/(temp+120._r8)) * & - ((temp/296.16_r8)**1.5_r8) - ! air kinemaic viscosity - airkinvisc = airdynvisc/rhoair - ! ratio of water viscosity to air viscosity (from Slinn) - xmuwaterair = 60.0_r8 - - ! - ! compute rain drop number concentrations - ! rrainsv = raindrop radius (cm) - ! xnumrainsv = raindrop number concentration (#/cm^3) - ! (number in the bin, not number density) - ! vfallrainsv = fall velocity (cm/s) - ! - precipsum = 0._r8 - do i = 1, nr - r = rlo + (i-1)*dr - rrainsv(i) = r - xnumrainsv(i) = exp( -r/2.7e-2_r8 ) - - d = 2._r8*r - if (d <= 0.007_r8) then - vfallstp = 2.88e5_r8 * d**2._r8 - else if (d <= 0.025_r8) then - vfallstp = 2.8008e4_r8 * d**1.528_r8 - else if (d <= 0.1_r8) then - vfallstp = 4104.9_r8 * d**1.008_r8 - else if (d <= 0.25_r8) then - vfallstp = 1812.1_r8 * d**0.638_r8 - else - vfallstp = 1069.8_r8 * d**0.235_r8 - end if - - vfall = vfallstp * sqrt(1.204e-3_r8/rhoair) - vfallrainsv(i) = vfall - precipsum = precipsum + vfall*(r**3)*xnumrainsv(i) - end do - precipsum = precipsum*pi*1.333333_r8 - - rnumsum = 0._r8 - do i = 1, nr - xnumrainsv(i) = xnumrainsv(i)*(precip/precipsum) - rnumsum = rnumsum + xnumrainsv(i) - end do - - ! - ! compute aerosol concentrations - ! aaerosv = particle radius (cm) - ! fnumaerosv = fraction of total number in the bin (--) - ! fvolaerosv = fraction of total volume in the bin (--) - ! - - - anumsum = 0._r8 - avolsum = 0._r8 - ynumaerosv(:) = 1._r8 - yvolaerosv(:) = 1._r8 - aaerosv(:) = a - if (na.ne.1) then - do i = 1, na - x = xlo + (i-1)*dx - a = exp( x ) - aaerosv(i) = a - dum = (x - xg0)/sx - ynumaerosv(i) = exp( -0.5_r8*dum*dum ) - yvolaerosv(i) = ynumaerosv(i)*1.3333_r8*pi*a*a*a - anumsum = anumsum + ynumaerosv(i) - avolsum = avolsum + yvolaerosv(i) - end do - - do i = 1, na - ynumaerosv(i) = ynumaerosv(i)/anumsum - yvolaerosv(i) = yvolaerosv(i)/avolsum - end do - end if - - - ! - ! compute scavenging - ! - scavsumnum = 0._r8 - scavsumvol = 0._r8 - ! - ! outer loop for rain drop radius - ! - jr_loop: do jr = 1, nr - - r = rrainsv(jr) - vfall = vfallrainsv(jr) - - reynolds = r * vfall / airkinvisc - sqrtreynolds = sqrt( reynolds ) - - ! - ! inner loop for aerosol particle radius - ! - scavsumnumbb = 0._r8 - scavsumvolbb = 0._r8 - - ja_loop: do ja = 1, na - - a = aaerosv(ja) - - chi = a/r - - dum = freepath/a - dumfuchs = 1._r8 + 1.246_r8*dum + 0.42_r8*dum*exp(-0.87_r8/dum) - taurelax = 2._r8*rhoaero*a*a*dumfuchs/(9._r8*rhoair*airkinvisc) - - - aeromass = 4._r8*pi*a*a*a*rhoaero/3._r8 - aerodiffus = boltz_cgs*temp*taurelax/aeromass - - schmidt = airkinvisc/aerodiffus - stokes = vfall*taurelax/r - - ebrown = 4._r8*(1._r8 + 0.4_r8*sqrtreynolds*(schmidt**0.3333333_r8)) / & - (reynolds*schmidt) - - dum = (1._r8 + 2._r8*xmuwaterair*chi) / & - (1._r8 + xmuwaterair/sqrtreynolds) - eintercept = 4._r8*chi*(chi + dum) - - dum = log( 1._r8 + reynolds ) - sstar = (1.2_r8 + dum/12._r8) / (1._r8 + dum) - eimpact = 0._r8 - if (stokes > sstar) then - dum = stokes - sstar - eimpact = (dum/(dum+0.6666667_r8)) ** 1.5_r8 - end if - - etotal = ebrown + eintercept + eimpact - etotal = min( etotal, 1.0_r8 ) - - rainsweepout = xnumrainsv(jr)*4._r8*pi*r*r*vfall - - scavsumnumbb = scavsumnumbb + rainsweepout*etotal*ynumaerosv(ja) - scavsumvolbb = scavsumvolbb + rainsweepout*etotal*yvolaerosv(ja) - - enddo ja_loop - - scavsumnum = scavsumnum + scavsumnumbb - scavsumvol = scavsumvol + scavsumvolbb - - enddo jr_loop - - scavratenum = scavsumnum*3600._r8 - scavratevol = scavsumvol*3600._r8 - - return - end subroutine calc_1_impact_rate - !============================================================================= subroutine mmr2vmr_carma(lchnk, vmr, mbar, mw_carma, ncol, im, rmass) !----------------------------------------------------------------- ! ... Xfrom from mass to volume mixing ratio !----------------------------------------------------------------- - !st use chem_mods, only : adv_mass, gas_pcnst - implicit none !----------------------------------------------------------------- @@ -1572,7 +931,6 @@ subroutine mmr2vmr_carma(lchnk, vmr, mbar, mw_carma, ncol, im, rmass) real(r8), intent(in) :: rmass(nbins) real(r8), intent(in) :: mw_carma(ncnst_tot) real(r8), intent(inout) :: vmr(ncol,pver,ncnst_tot) - real(r8) :: vmr_total(ncol,pver) !----------------------------------------------------------------- ! ... Local variables @@ -1580,18 +938,16 @@ subroutine mmr2vmr_carma(lchnk, vmr, mbar, mw_carma, ncol, im, rmass) integer :: k, m, mm, l do m = 1, nbins - vmr_total(:ncol,:) = 0._r8 do l = 1, nspec(m) ! for each species, not total mmr or number, information of mw are missing - mm = bin_idx(m, l) - do k=1,pver - vmr(:ncol,k,mm) = mbar(:ncol,k) * vmr(:ncol,k,mm) / mw_carma(mm) - end do - vmr_total(:ncol,:) = vmr_total(:ncol,:) + vmr(:ncol,:,mm) + mm = bin_idx(m, l) + do k=1,pver + vmr(:ncol,k,mm) = mbar(:ncol,k) * vmr(:ncol,k,mm) / mw_carma(mm) + end do end do end do end subroutine mmr2vmr_carma - !============================================================================= + !============================================================================= !============================================================================= subroutine vmr2mmr_carma ( lchnk, vmr, mbar, mw_carma, ncol, im, rmass ) @@ -1609,7 +965,6 @@ subroutine vmr2mmr_carma ( lchnk, vmr, mbar, mw_carma, ncol, im, rmass ) real(r8), intent(in) :: rmass(nbins) real(r8), intent(inout) :: vmr(ncol,pver,ncnst_tot) real(r8), intent(in) :: mw_carma(ncnst_tot) - real(r8) :: vmr_total(ncol,pver) !----------------------------------------------------------------- ! ... Local variables @@ -1619,16 +974,14 @@ subroutine vmr2mmr_carma ( lchnk, vmr, mbar, mw_carma, ncol, im, rmass ) ! ... The non-group species !----------------------------------------------------------------- do m = 1, nbins - vmr_total(:ncol,:) = 0._r8 do l = 1, nspec(m) ! for each species, not total mmr or number, information of mw are missing - mm = bin_idx(m, l) - do k=1,pver - vmr(:ncol,k,mm) = mw_carma(mm) * vmr(:ncol,k,mm) / mbar(:ncol,k) - end do - vmr_total(:ncol,:) = vmr_total(:ncol,:) + vmr(:ncol,:,mm) + mm = bin_idx(m, l) + do k=1,pver + vmr(:ncol,k,mm) = mw_carma(mm) * vmr(:ncol,k,mm) / mbar(:ncol,k) + end do end do end do - end subroutine vmr2mmr_carma + end subroutine vmr2mmr_carma end module aero_model diff --git a/src/chemistry/carma_aero/sox_cldaero_mod.F90 b/src/chemistry/carma_aero/sox_cldaero_mod.F90 index 41aed5c036..198561e0da 100644 --- a/src/chemistry/carma_aero/sox_cldaero_mod.F90 +++ b/src/chemistry/carma_aero/sox_cldaero_mod.F90 @@ -9,9 +9,6 @@ module sox_cldaero_mod use mo_chem_utls, only : get_spc_ndx use cldaero_mod, only : cldaero_conc_t, cldaero_allocate, cldaero_deallocate use cam_logfile, only : iulog - !st use modal_aero_data, only : ntot_amode, modeptr_accum, lptr_so4_cw_amode, lptr_msa_cw_amode - !st use modal_aero_data, only : numptrcw_amode, lptr_nh4_cw_amode - !st use modal_aero_data, only : cnst_name_cw, specmw_so4_amode use chem_mods, only : adv_mass use physconst, only : gravit use phys_control, only : phys_getopts @@ -47,7 +44,7 @@ module sox_cldaero_mod subroutine sox_cldaero_init - integer :: l, m, mm, ii + integer :: l, m, ii logical :: history_aerosol ! Output the MAM aerosol tendencies id_msa = get_spc_ndx( 'MSA' ) @@ -67,7 +64,7 @@ subroutine sox_cldaero_init ! ! get info about the modal aerosols - ! get nbins + ! get nbins call rad_cnst_get_info( 0, nbins=nbins) @@ -114,13 +111,12 @@ function sox_cldaero_create_obj(cldfrc, qcw, lwc, cfact, ncol, loffset) result( integer, intent(in) :: loffset real(r8) :: so4mmr(pcols,pver) - real(r8) :: nitmmr(pcols,pver) type(cldaero_conc_t), pointer :: conc_obj character(len=32) :: spectype - integer :: l,n,m + integer :: l,m integer :: i,k,mm ! local indexing for bins @@ -225,22 +221,19 @@ subroutine sox_cldaero_update( & real(r8) :: dryr_n(nbins,ncol,pver) ! CARMA dry radius in cm real(r8) :: dqdt_aqso4(ncol,pver,ncnst_tot), & dqdt_aqh2so4(ncol,pver,ncnst_tot), & - dqdt_aqhprxn(ncol,pver), dqdt_aqo3rxn(ncol,pver), & - sflx(1:ncol) + dqdt_aqhprxn(ncol,pver), dqdt_aqo3rxn(ncol,pver) - real(r8) :: faqgain_msa(nbins), faqgain_so4(nbins) + real(r8) :: faqgain_so4(nbins) real(r8) :: wt_mass(nbins) real(r8) :: delso4_o3rxn, & dso4dt_aqrxn, dso4dt_hprxn, & - dso4dt_gasuptk, dmsadt_gasuptk, & - dmsadt_gasuptk_tomsa, dmsadt_gasuptk_toso4, & + dso4dt_gasuptk, dmsadt_gasuptk_toso4, & dqdt_aq, dqdt_wr, dqdt - real(r8) :: fwetrem, sumf, uptkrate - real(r8) :: delnh3, delnh4 + real(r8) :: fwetrem, uptkrate - integer :: l, n, m, mm + integer :: l, n, mm integer :: ntot_msa_c integer :: i,k @@ -296,17 +289,11 @@ subroutine sox_cldaero_update( & lev_loop: do k = 1,pver col_loop: do i = 1,ncol cloud: if (cldfrc(i,k) >= 1.0e-5_r8) then - xl = xlwc(i,k) ! / cldfrc(i,k) + xl = xlwc(i,k) - IF (XL .ge. 1.e-8_r8) THEN !! WHEN CLOUD IS PRESENTED + if (xl .ge. 1.e-8_r8) then !! when cloud is present delso4_o3rxn = xso4(i,k) - xso4_init(i,k) - !write(iulog,*) 'delso4_o3rxn ', delso4_o3rxn - - !st if (id_nh3>0) then - !st delnh3 = nh3g(i,k) - xnh3(i,k) - !st delnh4 = - delnh3 - !st endif ! the factors are proportional to the activated particle MR for each ! bin, which is the MR of cloud drops "associated with" the mode @@ -333,27 +320,14 @@ subroutine sox_cldaero_update( & end if end do - ! at this point (sumf <= 0.0) only when all the faqgain_msa are zero uptkrate = cldaero_uptakerate( xl, cldnum(i,k), cfact(i,k), cldfrc(i,k), tfld(i,k), press(i,k) ) ! average uptake rate over dtime uptkrate = (1.0_r8 - exp(-min(100._r8,dtime*uptkrate))) / dtime - ! dso4dt_gasuptk = so4_c tendency from h2so4 gas uptake (mol/mol/s) - ! dmsadt_gasuptk = msa_c tendency from msa gas uptake (mol/mol/s) dso4dt_gasuptk = xh2so4(i,k) * uptkrate - !if (id_msa > 0) then - ! dmsadt_gasuptk = xmsa(i,k) * uptkrate - !else - ! dmsadt_gasuptk = 0.0_r8 - !end if -! + ! if no modes have msa aerosol, then "rename" scavenged msa gas to so4 dmsadt_gasuptk_toso4 = 0.0_r8 - !st dmsadt_gasuptk_tomsa = dmsadt_gasuptk - !st if (ntot_msa_c == 0) then - !st dmsadt_gasuptk_tomsa = 0.0_r8 - !st dmsadt_gasuptk_toso4 = dmsadt_gasuptk - !st end if !----------------------------------------------------------------------- ! now compute TMR tendencies @@ -400,13 +374,7 @@ subroutine sox_cldaero_update( & ! Need to multiply both these parts by cldfrc ! h2so4 (g) & msa (g) - - !H2SO4 not updated in Pengfei's model - !st TEST with H2SO4 uptake qin(i,k,id_h2so4) = qin(i,k,id_h2so4) - dso4dt_gasuptk * dtime * cldfrc(i,k) - !qin(i,k,id_h2so4) = MAX( qin(i,k,id_h2so4), small_value ) - - !st if (id_msa > 0) qin(i,k,id_msa) = qin(i,k,id_msa) - dmsadt_gasuptk * dtime * cldfrc(i,k) ! so2 -- the first order loss rate for so2 is frso2_c*clwlrat(i,k) ! fwetrem = max( 0.0_r8, (1.0_r8-exp(-min(100._r8,dtime*frso2_c*clwlrat(i,k)))) ) @@ -430,19 +398,11 @@ subroutine sox_cldaero_update( & qin(i,k,id_h2o2) = qin(i,k,id_h2o2) + dqdt * dtime qin(i,k,id_h2o2) = MAX( qin(i,k,id_h2o2), small_value ) - ! NH3 - !st if (id_nh3>0) then - !st dqdt_aq = delnh3/dtime*cldfrc(i,k) - !st dqdt = dqdt_aq - !st qin(i,k,id_nh3) = qin(i,k,id_nh3) + dqdt * dtime - !st endif - ! for SO4 from H2O2/O3 budgets dqdt_aqhprxn(i,k) = dso4dt_hprxn*cldfrc(i,k) dqdt_aqo3rxn(i,k) = (dso4dt_aqrxn - dso4dt_hprxn)*cldfrc(i,k) - - ENDIF !! WHEN CLOUD IS PRESENTED + endif !! when cloud is present endif cloud enddo col_loop enddo lev_loop From 3aa7109b57e80a4d183b48ef17d0faca272f90ed Mon Sep 17 00:00:00 2001 From: Francis Vitt <fvitt@ucar.edu> Date: Thu, 27 Feb 2025 14:11:32 -0700 Subject: [PATCH 17/24] some to dry rad and vol calcs modified: src/chemistry/aerosol/carma_aerosol_state_mod.F90 modified: src/chemistry/carma_aero/sox_cldaero_mod.F90 --- src/chemistry/aerosol/carma_aerosol_state_mod.F90 | 10 ++++++---- src/chemistry/carma_aero/sox_cldaero_mod.F90 | 2 -- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/src/chemistry/aerosol/carma_aerosol_state_mod.F90 b/src/chemistry/aerosol/carma_aerosol_state_mod.F90 index d036254446..2545c5c73b 100644 --- a/src/chemistry/aerosol/carma_aerosol_state_mod.F90 +++ b/src/chemistry/aerosol/carma_aerosol_state_mod.F90 @@ -302,7 +302,7 @@ subroutine icenuc_size_wght_arr(self, bin_ndx, ncol, nlev, species_type, use_pre do k = 1,nlev do i = 1,ncol - diamdry = rdry(i,k) * 2.e4_r8 * 1.e6_r8 ! diameter in microns (from radius in m) + diamdry = rdry(i,k) * 2._r8 * 1.e6_r8 ! diameter in microns (from radius in m) if (diamdry >= 0.1_r8) then ! size threashold wght(i,k) = 1._r8 end if @@ -466,8 +466,9 @@ function dry_volume(self, aero_props, list_idx, bin_idx, ncol, nlev) result(vol) real(r8) :: vol(ncol,nlev) ! m3/kg - real(r8) :: raddry(pcols,pver) !! dry radius (m) - real(r8) :: rhodry(pcols,pver) !! dry density (kg/m3) + real(r8) :: raddry(pcols,pver) ! dry radius (m) + real(r8) :: rhodry(pcols,pver) ! dry density (kg/m3) + real(r8) :: nmr(pcols,pver) ! number mixing ratio (#/kg) character(len=aero_name_len) :: bin_name, shortname integer :: igroup, ibin, rc, nchr @@ -484,8 +485,9 @@ function dry_volume(self, aero_props, list_idx, bin_idx, ncol, nlev) result(vol) vol = 0._r8 call carma_get_dry_radius(self%state, igroup, ibin, raddry, rhodry, rc) + call carma_get_number(self%state, igroup, ibin, nmr, rc) - vol(:ncol,:) = four_thirds_pi * (raddry(:ncol,:)**3) ! ???? units = m3/kg ???? + vol(:ncol,:) = four_thirds_pi * (raddry(:ncol,:)**3) * nmr(:ncol,:) ! units = m3/kg end function dry_volume diff --git a/src/chemistry/carma_aero/sox_cldaero_mod.F90 b/src/chemistry/carma_aero/sox_cldaero_mod.F90 index 198561e0da..474e594f2c 100644 --- a/src/chemistry/carma_aero/sox_cldaero_mod.F90 +++ b/src/chemistry/carma_aero/sox_cldaero_mod.F90 @@ -383,7 +383,6 @@ subroutine sox_cldaero_update( & dqdt_wr = -fwetrem*xso2(i,k)/dtime*cldfrc(i,k) dqdt_aq = -dso4dt_aqrxn*cldfrc(i,k) dqdt = dqdt_aq + dqdt_wr - dqdt = dqdt_aq qin(i,k,id_so2) = qin(i,k,id_so2) + dqdt * dtime qin(i,k,id_so2) = MAX( qin(i,k,id_so2), small_value ) @@ -394,7 +393,6 @@ subroutine sox_cldaero_update( & dqdt_wr = -fwetrem*xh2o2(i,k)/dtime*cldfrc(i,k) dqdt_aq = -dso4dt_hprxn*cldfrc(i,k) dqdt = dqdt_aq + dqdt_wr - dqdt = dqdt_aq qin(i,k,id_h2o2) = qin(i,k,id_h2o2) + dqdt * dtime qin(i,k,id_h2o2) = MAX( qin(i,k,id_h2o2), small_value ) From 3b7f79ae256bcac7bcc2630f631df90cb869eab2 Mon Sep 17 00:00:00 2001 From: Francis Vitt <fvitt@ucar.edu> Date: Thu, 27 Feb 2025 15:18:00 -0700 Subject: [PATCH 18/24] minor clean up modified: src/chemistry/carma_aero/aero_model.F90 --- src/chemistry/carma_aero/aero_model.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/src/chemistry/carma_aero/aero_model.F90 b/src/chemistry/carma_aero/aero_model.F90 index d27865a093..b50e1e8934 100644 --- a/src/chemistry/carma_aero/aero_model.F90 +++ b/src/chemistry/carma_aero/aero_model.F90 @@ -271,7 +271,6 @@ subroutine aero_model_init( pbuf2d ) call carma_aero_gasaerexch_init - ! add plus one to include number, total mmr and nspec nspec_max = maxval(nspec) ncnst_tot = nspec(1) From 54472eec9708e81fb380e00f8ea4d31159a27c68 Mon Sep 17 00:00:00 2001 From: Francis Vitt <fvitt@ucar.edu> Date: Fri, 28 Feb 2025 11:34:44 -0700 Subject: [PATCH 19/24] more corrections modified: src/chemistry/aerosol/carma_aerosol_state_mod.F90 --- src/chemistry/aerosol/carma_aerosol_state_mod.F90 | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/src/chemistry/aerosol/carma_aerosol_state_mod.F90 b/src/chemistry/aerosol/carma_aerosol_state_mod.F90 index 2545c5c73b..b0e82b2170 100644 --- a/src/chemistry/aerosol/carma_aerosol_state_mod.F90 +++ b/src/chemistry/aerosol/carma_aerosol_state_mod.F90 @@ -384,7 +384,7 @@ function hetfrz_size_wght(self, bin_ndx, ncol, nlev) result(wght) do k = 1,nlev do i = 1,ncol - diamdry = rdry(i,k) * 2.e4_r8 * 1.e6_r8 ! diameter in microns (from radius in m) + diamdry = rdry(i,k) * 2._r8 * 1.e6_r8 ! diameter in microns (from radius in m) if (diamdry >= 0.1_r8) then ! size threashold wght(i,k) = 1._r8 end if @@ -506,8 +506,9 @@ function wet_volume(self, aero_props, list_idx, bin_idx, ncol, nlev) result(vol) real(r8) :: vol(ncol,nlev) ! m3/kg - real(r8) :: radwet(pcols,pver) !! wet radius (m) - real(r8) :: rhowet(pcols,pver) !! wet density (kg/m3) + real(r8) :: radwet(pcols,pver) ! wet radius (m) + real(r8) :: rhowet(pcols,pver) ! wet density (kg/m3) + real(r8) :: nmr(pcols,pver) ! number mixing ratio (#/kg) character(len=aero_name_len) :: bin_name, shortname integer :: igroup, ibin, rc, nchr @@ -524,8 +525,9 @@ function wet_volume(self, aero_props, list_idx, bin_idx, ncol, nlev) result(vol) vol = 0._r8 call carma_get_wet_radius(self%state, igroup, ibin, radwet, rhowet, rc) + call carma_get_number(self%state, igroup, ibin, nmr, rc) - vol(:ncol,:) = four_thirds_pi * (radwet(:ncol,:)**3) ! ???? units = m3/kg ???? + vol(:ncol,:) = four_thirds_pi * (radwet(:ncol,:)**3) * nmr(:ncol,:) ! units = m3/kg end function wet_volume From 81a3ddb7e1467bd4384f5e5cb3b1fd77ea738d28 Mon Sep 17 00:00:00 2001 From: Francis Vitt <fvitt@ucar.edu> Date: Sun, 2 Mar 2025 11:16:29 -0700 Subject: [PATCH 20/24] Fix prescribed BAM modified: src/physics/cam/microp_aero.F90 modified: src/physics/cam/ndrop_bam.F90 --- src/physics/cam/microp_aero.F90 | 4 ++-- src/physics/cam/ndrop_bam.F90 | 26 ++++++++++---------------- 2 files changed, 12 insertions(+), 18 deletions(-) diff --git a/src/physics/cam/microp_aero.F90 b/src/physics/cam/microp_aero.F90 index 265969bbb6..d14d4d5967 100644 --- a/src/physics/cam/microp_aero.F90 +++ b/src/physics/cam/microp_aero.F90 @@ -317,7 +317,7 @@ subroutine microp_aero_init(phys_state,pbuf2d) call endrun(routine//': ERROR required mode-species type not found') end if - else + else if (.not.clim_carma_aero) then ! Props needed for BAM number concentration calcs. @@ -865,7 +865,7 @@ subroutine microp_aero_run ( & !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc !bulk aerosol ccn concentration (modal does it in ndrop, from dropmixnuc) - if (.not. clim_modal_aero) then + if ((.not. clim_modal_aero) .and. (.not.clim_carma_aero)) then ! ccn concentration as diagnostic call ndrop_bam_ccn(lchnk, ncol, maerosol, naer2) diff --git a/src/physics/cam/ndrop_bam.F90 b/src/physics/cam/ndrop_bam.F90 index e074e937aa..01ab3b5856 100644 --- a/src/physics/cam/ndrop_bam.F90 +++ b/src/physics/cam/ndrop_bam.F90 @@ -73,10 +73,10 @@ subroutine ndrop_bam_init use phys_control, only: phys_getopts - !----------------------------------------------------------------------- - ! + !----------------------------------------------------------------------- + ! ! Initialize constants for droplet activation by bulk aerosols - ! + ! !----------------------------------------------------------------------- integer :: l, m, iaer @@ -91,8 +91,6 @@ subroutine ndrop_bam_init ! by using routines from the rad_constituents module. call rad_cnst_get_info(0, naero=naer_all) - if (.not. naer_all>0) return - allocate( & aername(naer_all), & dryrad_aer(naer_all), & @@ -174,7 +172,7 @@ subroutine ndrop_bam_init ! Skip aerosols that don't have a dispersion defined. if (dispersion_aer(m) == 0._r8) cycle - + alogsig(m) = log(dispersion_aer(m)) exp45logsig(m) = exp(4.5_r8*alogsig(m)*alogsig(m)) argfactor(m) = 2._r8/(3._r8*sqrt(2._r8)*alogsig(m)) @@ -268,11 +266,7 @@ subroutine ndrop_bam_run( & integer :: m !------------------------------------------------------------------------------- - nact = 0._r8 - - if (.not. naer_all>0) return maxmodes = naer_all - allocate( & volc(maxmodes), & eta(maxmodes), & @@ -286,6 +280,8 @@ subroutine ndrop_bam_run( & call endrun('ndrop_bam_run') endif + nact = 0._r8 + if (nmode .eq. 1 .and. na(1) .lt. 1.e-20_r8) return if (wbar .le. 0._r8) return @@ -320,7 +316,7 @@ subroutine ndrop_bam_run( & smc(m) = smcrit(m) ! only for prescribed size dist if (hygro_aer(m) > 1.e-10_r8) then ! loop only if variable size dist - smc(m) = 2._r8*aten*sqrt(aten/(27._r8*hygro_aer(m)*amcubeloc(m))) + smc(m) = 2._r8*aten*sqrt(aten/(27._r8*hygro_aer(m)*amcubeloc(m))) else smc(m) = 100._r8 endif @@ -392,8 +388,6 @@ subroutine ndrop_bam_ccn(lchnk, ncol, maerosol, naer2) real(r8) :: ccn(pcols,pver,psat) ! number conc of aerosols activated at supersat !------------------------------------------------------------------------------- - if (.not. naer_all>0) return - ccn(:ncol,:,:) = 0._r8 do k = top_lev, pver @@ -403,7 +397,7 @@ subroutine ndrop_bam_ccn(lchnk, ncol, maerosol, naer2) if (m == idxsul) then ! Lohmann treatment for sulfate has variable size distribution do i = 1, ncol - if (naer2(i,k,m) > 0._r8) then + if (naer2(i,k,m) > 0._r8) then amcubesulfate(i) = amcubefactor(m)*maerosol(i,k,m)/(naer2(i,k,m)) smcritsulfate(i) = smcritfactor(m)/sqrt(amcubesulfate(i)) else @@ -495,9 +489,9 @@ subroutine maxsat(zeta, eta, nmode, smc, smax) sum=1.e20_r8 endif enddo - + smax=1._r8/sqrt(sum) - + end subroutine maxsat !=============================================================================== From 22ab1e77b73ed86aeeeca5407afff087d5b42926 Mon Sep 17 00:00:00 2001 From: Francis Vitt <fvitt@ucar.edu> Date: Sun, 2 Mar 2025 17:29:53 -0700 Subject: [PATCH 21/24] namelist defs merge correction --- bld/namelist_files/namelist_definition.xml | 22 --- doc/ChangeLog | 216 +++++++++++++++++++++ 2 files changed, 216 insertions(+), 22 deletions(-) diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 210e6e6601..f3ab7859f4 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -5006,28 +5006,6 @@ Dust erosion factor file. Default: set by build-namelist. </entry> -<!-- Ozone: Data (original CAM version) --> - -<entry id="bndtvo" type="char*256" input_pathname="abs" category="o3_data_cam" - group="cam3_ozone_data_nl" valid_values="" > -Full pathname of time-variant ozone mixing ratio boundary dataset. -Default: set by build-namelist. -</entry> - -<entry id="cam3_ozone_data_on" type="logical" category="o3_data_cam" - group="cam3_ozone_data_nl" valid_values="" > -Add CAM3 prescribed ozone to the physics buffer. -Default: FALSE -</entry> - -<entry id="ozncyc" type="logical" category="o3_data_cam" - group="cam3_ozone_data_nl" valid_values="" > -Flag for yearly cycling of ozone data. If set to FALSE, a multi-year -dataset is assumed, otherwise a single-year dataset is assumed, and ozone -will be cycled over the 12 monthly averages in the file. -Default: TRUE -</entry> - <!-- Performance Tuning and Profiling --> <entry id="papi_ctr1_str" type="char*16" category="performance" diff --git a/doc/ChangeLog b/doc/ChangeLog index 534b278928..79d3fb58b0 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,5 +1,221 @@ =============================================================== +Tag name: +Originator(s): fvitt, tilmes +Date: +One-line Summary: +Github PR URL: + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + + Added namlist options: + . carma_do_coremasscheck + . carma_do_cloudborne + . carma_do_budget_diags + . carma_do_package_diags + . carma_diags_packages + . carma_debug_packages + . carma_diags_file + . carma_dustemisfactor + . carma_BCOCemissions + . carma_SO4elevemis + . elev_emis_specifier + . elev_emis_type + . elev_emis_cycle_yr + . elev_emis_fixed_ymd + . elev_emis_fixed_tod + . BC_GAINS_filename + . OC_GAINS_filename + . BC_ship_filename + . OC_ship_filename + . BC_GFEDv3_filename + . OC_GFEDv3_filename + . Chlorophy11_file + . history_carma_srf_flx + . bin_defs + . emissions_specifier + . emissions_type + . emissions_cycle_yr + . emissions_fixed_ymd + . emissions_fixed_tod + + Removed + . carma_reftfile + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all files eliminated: + +List all files added and what they do: +A bld/namelist_files/use_cases/carma_trop_strat_cam6.xml +A bld/namelist_files/use_cases/carma_trop_strat_hist_cam6.xml +A bld/namelist_files/use_cases/carma_trop_strat_nudged_cam6.xml +A bld/namelist_files/use_cases/carma_trop_strat_sd_cam6.xml +A bld/namelist_files/use_cases/carma_waccm_ma_hist_cam6.xml +A bld/namelist_files/use_cases/carma_waccm_ma_nudged_cam6.xml +A cime_config/testdefs/testmods_dirs/cam/carma_elvemis_outfrq9s/shell_commands +A cime_config/testdefs/testmods_dirs/cam/carma_elvemis_outfrq9s/user_nl_cam +A cime_config/testdefs/testmods_dirs/cam/carma_elvemis_outfrq9s/user_nl_clm +A src/chemistry/aerosol/carma_aerosol_properties_mod.F90 +A src/chemistry/aerosol/carma_aerosol_state_mod.F90 +A src/chemistry/aerosol/hygrocoreshell_aerosol_optics_mod.F90 +A src/chemistry/aerosol/hygrowghtpct_aerosol_optics_mod.F90 +A src/chemistry/carma_aero/aero_model.F90 +A src/chemistry/carma_aero/carma_aero_gasaerexch.F90 +A src/chemistry/carma_aero/dust_model.F90 +A src/chemistry/carma_aero/seasalt_model.F90 +A src/chemistry/carma_aero/sox_cldaero_mod.F90 + +A src/physics/carma/models/trop_strat_soa1/carma_model_flags_mod.F90 +A src/physics/carma/models/trop_strat_soa1/carma_model_mod.F90 +A src/physics/carma/models/trop_strat_soa5/carma_model_flags_mod.F90 +A src/physics/carma/models/trop_strat_soa5/carma_model_mod.F90 + +A src/physics/cam/carma_diags_mod.F90 + +A src/chemistry/pp_trop_strat_noaero/chem_mech.doc +A src/chemistry/pp_trop_strat_noaero/chem_mech.in +A src/chemistry/pp_trop_strat_noaero/chem_mods.F90 +A src/chemistry/pp_trop_strat_noaero/m_rxt_id.F90 +A src/chemistry/pp_trop_strat_noaero/m_spc_id.F90 +A src/chemistry/pp_trop_strat_noaero/mo_adjrxt.F90 +A src/chemistry/pp_trop_strat_noaero/mo_exp_sol.F90 +A src/chemistry/pp_trop_strat_noaero/mo_imp_sol.F90 +A src/chemistry/pp_trop_strat_noaero/mo_indprd.F90 +A src/chemistry/pp_trop_strat_noaero/mo_lin_matrix.F90 +A src/chemistry/pp_trop_strat_noaero/mo_lu_factor.F90 +A src/chemistry/pp_trop_strat_noaero/mo_lu_solve.F90 +A src/chemistry/pp_trop_strat_noaero/mo_nln_matrix.F90 +A src/chemistry/pp_trop_strat_noaero/mo_phtadj.F90 +A src/chemistry/pp_trop_strat_noaero/mo_prod_loss.F90 +A src/chemistry/pp_trop_strat_noaero/mo_rxt_rates_conv.F90 +A src/chemistry/pp_trop_strat_noaero/mo_setrxt.F90 +A src/chemistry/pp_trop_strat_noaero/mo_sim_dat.F90 +A src/chemistry/pp_waccm_ma_noaero/chem_mech.doc +A src/chemistry/pp_waccm_ma_noaero/chem_mech.in +A src/chemistry/pp_waccm_ma_noaero/chem_mods.F90 +A src/chemistry/pp_waccm_ma_noaero/m_rxt_id.F90 +A src/chemistry/pp_waccm_ma_noaero/m_spc_id.F90 +A src/chemistry/pp_waccm_ma_noaero/mo_adjrxt.F90 +A src/chemistry/pp_waccm_ma_noaero/mo_exp_sol.F90 +A src/chemistry/pp_waccm_ma_noaero/mo_imp_sol.F90 +A src/chemistry/pp_waccm_ma_noaero/mo_indprd.F90 +A src/chemistry/pp_waccm_ma_noaero/mo_lin_matrix.F90 +A src/chemistry/pp_waccm_ma_noaero/mo_lu_factor.F90 +A src/chemistry/pp_waccm_ma_noaero/mo_lu_solve.F90 +A src/chemistry/pp_waccm_ma_noaero/mo_nln_matrix.F90 +A src/chemistry/pp_waccm_ma_noaero/mo_phtadj.F90 +A src/chemistry/pp_waccm_ma_noaero/mo_prod_loss.F90 +A src/chemistry/pp_waccm_ma_noaero/mo_rxt_rates_conv.F90 +A src/chemistry/pp_waccm_ma_noaero/mo_setrxt.F90 +A src/chemistry/pp_waccm_ma_noaero/mo_sim_dat.F90 +A src/chemistry/utils/elevated_emissions_mod.F90 +A src/chemistry/utils/surface_emissions_mod.F90 + +List all existing files that have been modified, and describe the changes: + +M bld/build-namelist +M bld/config_files/definition.xml +M bld/configure + - changes for new trop_strat_soa1 and trop_strat_soa5 carma aerosol models + +M bld/namelist_files/namelist_defaults_cam.xml + - defaults for new trop_strat_soa1 and trop_strat_soa5 carma aerosol models + +M bld/namelist_files/namelist_definition.xml + - new namelist options listed above + - remove obsolete carma_reftfile namelist option + +M cime_config/config_component.xml +M cime_config/config_compsets.xml +M cime_config/config_pes.xml +M cime_config/testdefs/testmods_dirs/cam/carma_meteor_smoke/user_nl_cam +M src/chemistry/aerosol/aero_deposition_cam.F90 +M src/chemistry/aerosol/aero_wetdep_cam.F90 +M src/chemistry/aerosol/aerosol_state_mod.F90 +M src/chemistry/aerosol/mo_setsox.F90 +M src/chemistry/aerosol/modal_aerosol_state_mod.F90 +M src/chemistry/bulk_aero/aero_model.F90 +M src/chemistry/bulk_aero/sox_cldaero_mod.F90 +M src/chemistry/geoschem/chemistry.F90 +M src/chemistry/modal_aero/aero_model.F90 +M src/chemistry/modal_aero/sox_cldaero_mod.F90 +M src/chemistry/mozart/chemistry.F90 +M src/chemistry/mozart/mo_gas_phase_chemdr.F90 +M src/chemistry/mozart/mo_photo.F90 +M src/chemistry/mozart/mo_usrrxt.F90 +M src/control/cam_history.F90 +M src/control/runtime_opts.F90 +M src/physics/cam/aer_rad_props.F90 +M src/physics/cam/aerosol_optics_cam.F90 +M src/physics/cam/carma_intr.F90 +M src/physics/cam/carma_model_flags_mod.F90 +M src/physics/cam/clubb_intr.F90 +M src/physics/cam/constituents.F90 +M src/physics/cam/micro_pumas_cam.F90 +M src/physics/cam/microp_aero.F90 +M src/physics/cam/nucleate_ice.F90 +M src/physics/cam/nucleate_ice_cam.F90 +M src/physics/cam/phys_control.F90 +M src/physics/cam/phys_prop.F90 +M src/physics/cam/physpkg.F90 +M src/physics/cam/rad_constituents.F90 +M src/physics/cam/restart_physics.F90 +M src/physics/cam/vertical_diffusion.F90 +M src/physics/cam7/micro_pumas_cam.F90 +M src/physics/cam7/physpkg.F90 +M src/physics/carma/cam/carma_intr.F90 + + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + +derecho/nvhpc/aux_cam: + +izumi/nag/aux_cam: + +izumi/gnu/aux_cam: + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + Tag name: cam6_4_072 Originator(s): sjsprecious Date: 28 February 2025 From 25264dd36adc8b4ce390ee6a8a8afb444d91842d Mon Sep 17 00:00:00 2001 From: Francis Vitt <fvitt@ucar.edu> Date: Sun, 2 Mar 2025 18:45:20 -0700 Subject: [PATCH 22/24] ChangeLog draft --- .../cam/carma_meteor_smoke/user_nl_cam | 1 + doc/ChangeLog | 122 ++++++++++++++++-- 2 files changed, 113 insertions(+), 10 deletions(-) diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_meteor_smoke/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/carma_meteor_smoke/user_nl_cam index 50c3262a40..2a81a976e2 100644 --- a/cime_config/testdefs/testmods_dirs/cam/carma_meteor_smoke/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/carma_meteor_smoke/user_nl_cam @@ -7,3 +7,4 @@ history_carma=.true. carma_do_fixedinit=.false. solar_data_type='FIXED' solar_data_ymd=20000101 + diff --git a/doc/ChangeLog b/doc/ChangeLog index 79d3fb58b0..cd84a4d83c 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,14 +1,20 @@ =============================================================== -Tag name: +Tag name: cam6_4_073 Originator(s): fvitt, tilmes Date: -One-line Summary: -Github PR URL: +One-line Summary: New CARMA trop_strat aerosol models +Github PR URL: https://github.com/ESCOMP/CAM/pull/1210 Purpose of changes (include the issue number and title text for each relevant GitHub issue): -Describe any changes made to build system: + Introduce CARMA trop_strat_soa1 and trop_strat_soa5 sectional aerosol models which can be used + as alternatives to the modal aerosol aerosol representation in CAM physics. + + Issue #495 -- Merging CARMA aerosol model for troposphere and stratosphere (trop_strat) + into the CESM development version + +Describe any changes made to build system: N/A Describe any changes made to the namelist: @@ -46,13 +52,13 @@ Describe any changes made to the namelist: Removed . carma_reftfile -List any changes to the defaults for the boundary datasets: +List any changes to the defaults for the boundary datasets: N/A -Describe any substantial timing or memory changes: +Describe any substantial timing or memory changes: none -Code reviewed by: +Code reviewed by: jimmielin, cacraigucar -List all files eliminated: +List all files eliminated: N/A List all files added and what they do: A bld/namelist_files/use_cases/carma_trop_strat_cam6.xml @@ -61,25 +67,36 @@ A bld/namelist_files/use_cases/carma_trop_strat_nudged_cam6.xml A bld/namelist_files/use_cases/carma_trop_strat_sd_cam6.xml A bld/namelist_files/use_cases/carma_waccm_ma_hist_cam6.xml A bld/namelist_files/use_cases/carma_waccm_ma_nudged_cam6.xml + - new build-namelist use cases for carma trop_strat models + A cime_config/testdefs/testmods_dirs/cam/carma_elvemis_outfrq9s/shell_commands A cime_config/testdefs/testmods_dirs/cam/carma_elvemis_outfrq9s/user_nl_cam A cime_config/testdefs/testmods_dirs/cam/carma_elvemis_outfrq9s/user_nl_clm + - for new CARMA trop_strat tests + A src/chemistry/aerosol/carma_aerosol_properties_mod.F90 A src/chemistry/aerosol/carma_aerosol_state_mod.F90 + - for new CARMA trop_strat models + A src/chemistry/aerosol/hygrocoreshell_aerosol_optics_mod.F90 A src/chemistry/aerosol/hygrowghtpct_aerosol_optics_mod.F90 + - for new CARMA trop_strat models + A src/chemistry/carma_aero/aero_model.F90 A src/chemistry/carma_aero/carma_aero_gasaerexch.F90 A src/chemistry/carma_aero/dust_model.F90 A src/chemistry/carma_aero/seasalt_model.F90 A src/chemistry/carma_aero/sox_cldaero_mod.F90 + - for new CARMA trop_strat models A src/physics/carma/models/trop_strat_soa1/carma_model_flags_mod.F90 A src/physics/carma/models/trop_strat_soa1/carma_model_mod.F90 A src/physics/carma/models/trop_strat_soa5/carma_model_flags_mod.F90 A src/physics/carma/models/trop_strat_soa5/carma_model_mod.F90 + - for new CARMA trop_strat models A src/physics/cam/carma_diags_mod.F90 + - data object for carma aerosols budgets A src/chemistry/pp_trop_strat_noaero/chem_mech.doc A src/chemistry/pp_trop_strat_noaero/chem_mech.in @@ -99,6 +116,8 @@ A src/chemistry/pp_trop_strat_noaero/mo_prod_loss.F90 A src/chemistry/pp_trop_strat_noaero/mo_rxt_rates_conv.F90 A src/chemistry/pp_trop_strat_noaero/mo_setrxt.F90 A src/chemistry/pp_trop_strat_noaero/mo_sim_dat.F90 + - added for carma trop_strat_soa5 model + A src/chemistry/pp_waccm_ma_noaero/chem_mech.doc A src/chemistry/pp_waccm_ma_noaero/chem_mech.in A src/chemistry/pp_waccm_ma_noaero/chem_mods.F90 @@ -117,8 +136,11 @@ A src/chemistry/pp_waccm_ma_noaero/mo_prod_loss.F90 A src/chemistry/pp_waccm_ma_noaero/mo_rxt_rates_conv.F90 A src/chemistry/pp_waccm_ma_noaero/mo_setrxt.F90 A src/chemistry/pp_waccm_ma_noaero/mo_sim_dat.F90 + - added for carma trop_strat_soa1 model + A src/chemistry/utils/elevated_emissions_mod.F90 A src/chemistry/utils/surface_emissions_mod.F90 + - add emissions to pbuf to be used by carma trop_strat models List all existing files that have been modified, and describe the changes: @@ -136,44 +158,124 @@ M bld/namelist_files/namelist_definition.xml M cime_config/config_component.xml M cime_config/config_compsets.xml + - new compsets for caram trop_strat models + . QPCARMATS + . QPCARMAWM + . FCARMA2000climo + . FCARMAHIST + . FCARMAnudged + . FCARMASD + . FWmaCARMAHIST + . FWmaCARMAnudged + + M cime_config/config_pes.xml -M cime_config/testdefs/testmods_dirs/cam/carma_meteor_smoke/user_nl_cam + - default derecho PE layouts for CARMA compsets + M src/chemistry/aerosol/aero_deposition_cam.F90 + - loop end at props%nspecies + M src/chemistry/aerosol/aero_wetdep_cam.F90 + - add caram_aero_props and carma_aero_state objects + - loop end at props%nspecies + M src/chemistry/aerosol/aerosol_state_mod.F90 + - add wgtpct interface H2SO4/H2O + M src/chemistry/aerosol/mo_setsox.F90 + - state needed for carma trop_strat models + M src/chemistry/aerosol/modal_aerosol_state_mod.F90 + - wgtpct interface added + M src/chemistry/bulk_aero/aero_model.F90 + - invoke dust_readnl + - pass state to setsox interface + M src/chemistry/bulk_aero/sox_cldaero_mod.F90 + - add state to interface + M src/chemistry/geoschem/chemistry.F90 + - pass state to setsox interface + M src/chemistry/modal_aero/aero_model.F90 + - invoke dust_readnl + - pass state to setsox interface + M src/chemistry/modal_aero/sox_cldaero_mod.F90 + - add state to interface + M src/chemistry/mozart/chemistry.F90 + - add ndropmixed flag to registered constituents + - dust_readnl moved to aero_model + M src/chemistry/mozart/mo_gas_phase_chemdr.F90 + - JNO2 added to pbuf + - state passed to userrxt + M src/chemistry/mozart/mo_photo.F90 + - restrict debug write to masterproc + M src/chemistry/mozart/mo_usrrxt.F90 + - state passed to aero_model_surfarea + M src/control/cam_history.F90 + - increase hash size for carma history fields + M src/control/runtime_opts.F90 + - invoke surface_emissions_readnl and elevated_emissions_readnl + M src/physics/cam/aer_rad_props.F90 + - changes for carma bins + M src/physics/cam/aerosol_optics_cam.F90 + - changes for carma aerosol optics + M src/physics/cam/carma_intr.F90 M src/physics/cam/carma_model_flags_mod.F90 + - changes for carma trop_strat models + M src/physics/cam/clubb_intr.F90 + - use ndropmixed constituent attribute to turn off transport of aerosols + M src/physics/cam/constituents.F90 + - add ndropmixed constituent attribute + M src/physics/cam/micro_pumas_cam.F90 + - use ndropmixed constituent attribute to turn off transport of droplet number + M src/physics/cam/microp_aero.F90 M src/physics/cam/nucleate_ice.F90 M src/physics/cam/nucleate_ice_cam.F90 + - add caram_aero_props and carma_aero_state objects + M src/physics/cam/phys_control.F90 + - add history_carma_srf_flx flag + M src/physics/cam/phys_prop.F90 + - changes for carma aerosol optics + M src/physics/cam/physpkg.F90 + - invoke surface_emissions and elevated_emissions routines + - invoke carma aerosol budget routines + M src/physics/cam/rad_constituents.F90 + - parse carma bin_defs namelist settings + M src/physics/cam/restart_physics.F90 + - invoke carma restart + M src/physics/cam/vertical_diffusion.F90 + - use ndropmixed constituent attribute to turn off transport of aerosols + M src/physics/cam7/micro_pumas_cam.F90 + - use ndropmixed constituent attribute to turn off transport of droplet number + M src/physics/cam7/physpkg.F90 -M src/physics/carma/cam/carma_intr.F90 + - invoke surface_emissions and elevated_emissions routines +M src/physics/carma/cam/carma_intr.F90 + - changes for carma trop_strat models If there were any failures reported from running test_driver.sh on any test From fc461da37972b58e846388351629065c2333878e Mon Sep 17 00:00:00 2001 From: Francis Vitt <fvitt@ucar.edu> Date: Mon, 3 Mar 2025 06:58:06 -0700 Subject: [PATCH 23/24] ChangeLog update --- doc/ChangeLog | 39 +++++++++++---------------------------- 1 file changed, 11 insertions(+), 28 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index cd84a4d83c..a99e465445 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -2,7 +2,7 @@ Tag name: cam6_4_073 Originator(s): fvitt, tilmes -Date: +Date: 3 Mar 2025 One-line Summary: New CARMA trop_strat aerosol models Github PR URL: https://github.com/ESCOMP/CAM/pull/1210 @@ -168,7 +168,6 @@ M cime_config/config_compsets.xml . FWmaCARMAHIST . FWmaCARMAnudged - M cime_config/config_pes.xml - default derecho PE layouts for CARMA compsets @@ -277,43 +276,27 @@ M src/physics/cam7/physpkg.F90 M src/physics/carma/cam/carma_intr.F90 - changes for carma trop_strat models - If there were any failures reported from running test_driver.sh on any test platform, and checkin with these failures has been OK'd by the gatekeeper, then copy the lines from the td.*.status files for the failed tests to the appropriate machine below. All failed tests must be justified. derecho/intel/aux_cam: + FAIL ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s COMPARE_base_rest + FAIL SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d BASELINE /glade/campaign/cesm/community/amwg/cam_baselines/cam6_4_072_intel: DIFF + - pre-existing failures due to HEMCO not having reproducible results (issues #1018 and #856) -derecho/nvhpc/aux_cam: - -izumi/nag/aux_cam: - -izumi/gnu/aux_cam: - -CAM tag used for the baseline comparison tests if different than previous -tag: - -Summarize any changes to answers, i.e., -- what code configurations: -- what platforms/compilers: -- nature of change (roundoff; larger than roundoff but same climate; new - climate): + FAIL SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie SETUP + FAIL SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s SETUP + - pre-existing failures due to build-namelist error requiring CLM/CTSM external update -If bitwise differences were observed, how did you show they were no worse -than roundoff? +derecho/nvhpc/aux_cam: All PASS -If this tag changes climate describe the run(s) done to evaluate the new -climate in enough detail that it(they) could be reproduced, i.e., -- source tag (all code used must be in the repository): -- platform/compilers: -- configure commandline: -- build-namelist command (or complete namelist): -- MSS location of output: +izumi/nag/aux_cam: All PASS -MSS location of control simulations used to validate new climate: +izumi/gnu/aux_cam: All PASS -URL for AMWG diagnostics output used to validate new climate: +Summarize any changes to answers: bit-for-bit unchanged =============================================================== =============================================================== From 4ab2858eacf14ac0d59323986da9b33a7fe5ef74 Mon Sep 17 00:00:00 2001 From: Francis Vitt <fvitt@ucar.edu> Date: Wed, 5 Mar 2025 15:19:52 -0700 Subject: [PATCH 24/24] update ChangeLog --- doc/ChangeLog | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index a99e465445..7854c5356e 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -2,7 +2,7 @@ Tag name: cam6_4_073 Originator(s): fvitt, tilmes -Date: 3 Mar 2025 +Date: 5 Mar 2025 One-line Summary: New CARMA trop_strat aerosol models Github PR URL: https://github.com/ESCOMP/CAM/pull/1210