diff --git a/bld/build-namelist b/bld/build-namelist index 665b5767da..bf07ef630e 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -1545,6 +1545,68 @@ 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 @@ -1591,7 +1653,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 ( !($nl->get_value('modal_strat_sulfate') =~ /$TRUE/io) ) { # if no prognostic stratospheric aerosols + if ( !($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'); @@ -2222,10 +2285,10 @@ 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) { + 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); @@ -2243,37 +2306,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) @@ -2430,7 +2496,7 @@ if (($chem =~ /_mam4/ or $chem =~ /_mam5/) and ($phys =~ /cam6/ or $phys =~ /cam } } } - 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'); @@ -2439,20 +2505,25 @@ 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, + if ($chem !~ /_noaer/) { + %species = (%species, 'bc_a4_ar_ext_file' => 'bc_a4', - 'num_a4_ar_ext_file' => 'num_a4', + 'num_a4_ar_ext_file' => 'num_a4' ); + } + %species = (%species, 'no2_ar_ext_file' => 'NO2', 'so2_ar_ext_file' => 'SO2' ); } elsif ($chem =~ /ghg_mam/) { @@ -2463,8 +2534,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/) { @@ -2501,7 +2572,7 @@ if (($chem =~ /_mam4/ or $chem =~ /_mam5/) and ($phys =~ /cam6/ or $phys =~ /cam $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'"); @@ -2526,7 +2597,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 +'" @@ -3310,7 +3381,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.'); @@ -3577,6 +3648,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; @@ -4927,7 +5002,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) { @@ -4987,11 +5062,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*[AMN]:(\w+) # name of species preceded by optional whitespace and X: - : # : separator - (\S+) # name2 + elsif ($spec =~ m/^\s*[ABMN]:(\w+) # name of species preceded by optional whitespace and X: + : # : separator + (\S+) # name2 /xo) { my $name = $1; my $name2 = $2; @@ -5022,9 +5097,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 c3af153035..56ac87827e 100644 --- a/bld/config_files/definition.xml +++ b/bld/config_files/definition.xml @@ -91,16 +91,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). - + 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) - - 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 + + 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 Prognostic mozart species packages: list of any subset of the following: DST,SSLT,SO4,GHG,OC,BC,CARBON16 @@ -187,7 +189,7 @@ Total number of advected test tracers. Switch on (off) age of air tracers: 0=off, 1=on. - + Maximum number of constituents that are radiatively active or in any one diagnostic list. diff --git a/bld/configure b/bld/configure index 4577a906aa..ce55ff0ad3 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 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 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 Comma separated list of CLUBB options to turn on/off. By default they are all off. @@ -1393,6 +1393,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; +} #----------------------------------------------------------------------------------------------- @@ -2070,8 +2076,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 b84e2b6cf2..1e73ab93de 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -72,6 +72,16 @@ atm/cam/inic/fv/cami_0000-01-01_4x5_L30_c090108.nc atm/cam/inic/fv/cami_0000-01-01_10x15_L30_c081013.nc +atm/cam/inic/fv/carma_trop_strat_2000_10x15_spinup01.cam.i.0002-01-01-00000_c211027.nc +atm/cam/inic/fv/aqua_carma_trop_strat_10x15_spinup01.cam.i.0002-01-01-00000_c211027.nc + +atm/cam/inic/fv/QPCARMATS_f19_carmats4038_spinup01_0002-01-01_c241029.nc + +atm/waccm/ic/aqua_carma_waccm_0002-01-01_10x15_L70_c220325.nc +atm/waccm/ic/FWmaCARMAHIST_f19_carmats038_spinupl03.cam.i.1980-01-01_c241025.nc +atm/cam/inic/fv/aqua_carma_waccm_0002-01-01_1.9x2.5_L70_c220809.nc +atm/waccm/ic/FWmaCARMAHIST_f09_spinup01.cam.i.1980-01-01-00000_c220128.nc + atm/cam/inic/fv/f.e22.FC2010climo.f09_f09_mg17.cam6_2_022.001.cam.i.0016-01-01-00000_c200610.nc atm/cam/inic/fv/f.e22.FC2010climo.f09_f09_mg17.cam6_2_022.001.cam.i.0016-01-01-00000_c200610.nc atm/cam/inic/fv/f.e22.FC2010climo.f09_f09_mg17.cam6_2_022.001.cam.i.0016-01-01-00000_c200610.nc @@ -579,6 +589,8 @@ atm/waccm/emis/smoke_grf_frentzke.nc atm/cam/physprops/mice_warren2008.nc atm/cam/dst/soil_erosion_factor_1x1_c120907.nc +atm/cam/dst/soil_erosion_factor_1x1_c120907.nc +atm/cam/dst/soil_erosion_factor_1x1_c120907.nc atm/cam/dst/soil_erosion_factor_1x1_c120907.nc atm/waccm/emis/early_earth_haze.nc @@ -768,6 +780,8 @@ 0.5D0 0.5D0 0.5D0 +0.5D0 +0.5D0 0.0625D0 @@ -802,6 +816,8 @@ 2.d0 2.d0 2.d0 +2.D0 +2.D0 .true. .false. .false. @@ -809,6 +825,8 @@ .false. .false. .false. +.false. +.false. .false. .true. .true. @@ -816,6 +834,8 @@ .true. .true. .true. +.true. +.true. .true. .false. .false. @@ -824,6 +844,8 @@ .false. .false. .false. +.false. +.false. .true. @@ -1026,6 +1048,11 @@ atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_SOAGx1.5_biogenic_surface_1750-2015_0.9x1.25_c20170322.nc atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_SOAGx1.5_bb_surface_1750-2015_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_bc_a4_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_bc_a4_bb_surface_2000climo_0.9x1.25_c20170322.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_pom_a4_anthro_surface_2000climo_0.9x1.25_c20170608.nc +atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_pom_a4_bb_surface_2000climo_0.9x1.25_c20170322.nc + atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_BENZENE_anthro_surface_1750-2015_0.9x1.25_c20170608.nc atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_BENZENE_bb_surface_1750-2015_0.9x1.25_c20170322.nc atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_BIGALK_anthro_surface_1750-2015_0.9x1.25_c20170608.nc @@ -3549,4 +3576,545 @@ atm/cam/geoschem/emis/ExtData/CHEM_INPUTS/FAST_JX/v2024-05/ atm/cam/geoschem/emis/ExtData/CHEM_INPUTS/CLOUD_J/v2023-05/ +atm/cam/chem/carma/data/ETP_base_CLE_V5_BC_2010.nc +atm/cam/chem/carma/data/ETP_base_CLE_V5_OC_2010.nc +atm/cam/chem/carma/data/IPCC_BC_ships_2010_0.5x0.5.nc +atm/cam/chem/carma/data/IPCC_OC_ships_2010_0.5x0.5.nc +atm/cam/chem/carma/data/GFEDv3_BC_2010.nc +atm/cam/chem/carma/data/GFEDv3_OC_2010.nc + + + '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' + + + + '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' + + + + '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' + + + + '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' + + diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 38f643253d..f3ab7859f4 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -4434,6 +4434,13 @@ allowed per substep. Default: 0. + +Flag indicating that do coremasscheck after certain subroutines +and abort the model if the check not pass. +Default: FALSE + + Flag indicating that the CARMA model is an aerosol model, and @@ -4464,6 +4471,14 @@ carma_do_incloud is true. Default: FALSE + +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 + + Flag indicating whether the coagulation process is enabled for @@ -4527,6 +4542,41 @@ CARMA particles. Default: FALSE + +Flag indicating that model specific budget diagnostics should be +generated. +Default: FALSE + + + +Flag indicating that model specific budget diagnostics should be +generated per physics package for the packages listed in +carma_diag_packages. +Default: FALSE + + + +List of physics packages for which diagnostic output is desired. +Default: NONE + + + +List of physics packages for which debug output from the local carma +state checker is desired. +Default: NONE + + + +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 + + Flag indicating that CARMA sulfate mass mixing ratio will be used @@ -4630,14 +4680,6 @@ first guess when condensational growth requires substepping. Default: 1 - -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 - - Accommodation coefficient for coagulation. @@ -4819,6 +4861,13 @@ the dust model. Default: set by build-namelist. + +CARMA dust emissions scaling factor +Default: 0.5e-9_r8 + + + @@ -4834,6 +4883,129 @@ Specifies the name of the sea salt emission parameterization. Default: Gong + + +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 emissions in physcis buffer + +Default: Yu2015 + + + +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 emissions in physcis buffer + +Default: NONE + + + +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 }}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 }}elev_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. + + + +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' + + + +The cycle year of the elevated emissions data +if {{ hilight }}elev_emis_type{{ closehilight }} is 'CYCLICAL'. +Format: YYYY +Default: 0 + + + +The date at which the elevated emissions are fixed +if {{ hilight }}elev_emis_type{{ closehilight }} is 'FIXED'. +Format: YYYYMMDD +Default: 0 + + + +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 + + + +BC GAINS file. +Default: set by build-namelist. + + + +OC GAINS file. +Default: set by build-namelist. + + + +BC ship file. +Default: set by build-namelist. + + + +OC ship file. +Default: set by build-namelist. + + + +BC GFEDv3 file. +Default: set by build-namelist. + + + +OC GFEDv3 file. +Default: set by build-namelist. + + + +Dust erosion factor file. +Default: set by build-namelist. + + Switch for diagnostics specific to the current CARMA model. -Default: .true. +Default: .false. + + + +Switch for diagnostics specific to the current CARMA model. +Default: .false. + +Definitions for the aerosol bins that may be used in the rad_climate and +rad_diag_* variables. +Default: set by build-namelist + + A list of the radiatively active species, i.e., species that affect the @@ -7089,6 +7274,60 @@ cycle over a given year, or be fixed to a given date. Default: set by build-namelist. + +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. + + + +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' + + + +The cycle year of the surface emissions data +if {{ hilight }}emissions_type{{ closehilight }} is 'CYCLICAL'. +Format: YYYY +Default: 0 + + + +The date at which the surface emissions are fixed +if {{ hilight }}emissions_type{{ closehilight }} is 'FIXED'. +Format: YYYYMMDD +Default: 0 + + + +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 + 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 @@ + + + +atm/cam/inic/fv/FCARMAnudged_f19_carmats3128_spinup01.cam.i.1991-01-01_c241023.nc +atm/cam/inic/fv/QPCARMATS_f19_carmats4038_spinup01_0002-01-01_c241029.nc +atm/cam/inic/fv/FCARMA2000climo_f09_carmats4038_spinup01_0002-01-01_c241029.nc + +4.5D0 + + +atm/cam/solar/SolarForcing1995-2005avg_c160929.nc +20000101 +FIXED + + +atm/waccm/lb/LBC_17500116-20150116_CMIP6_0p5degLat_c180905.nc + + +0.4D-9 +0.5D-9 + + +.true. +.true. +.false. +0.25D0 + + +.false. +.false. +.false. +.false. +.false. +.true. + + + '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' + + + + +CYCLICAL +2000 + + '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', + + +CYCLICAL +2000 + + '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', + + +2000 + + 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 @@ + + + +atm/cam/inic/fv/FCARMAnudged_f19_carmats3128_spinup01.cam.i.1991-01-01_c241023.nc +atm/cam/inic/fv/FCARMA2000climo_f09_carmats4038_spinup01_0002-01-01_c241029.nc + +4.5D0 + + +atm/cam/solar/SolarForcingCMIP6_18491230-23000102_c20200615.nc + + +INTERP_MISSING_MONTHS + + +INTERP_MISSING_MONTHS + + +SERIAL +atm/waccm/lb/LBC_17500116-20150116_CMIP6_0p5degLat_c180905.nc + + +0.4D-9 +0.5D-9 + + +.true. +.true. +.false. +0.25D0 + + +.false. +.false. +.false. +.false. +.false. +.true. + + + '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' + + +1850-2000 + + 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 @@ + + + +atm/cam/inic/fv/FCARMAnudged_f19_carmats3128_spinup01.cam.i.1991-01-01_c241023.nc +atm/cam/inic/fv/FCARMA2000climo_f09_carmats4038_spinup01_0002-01-01_c241029.nc + +4.5D0 + + +atm/cam/solar/SolarForcingCMIP6_18491230-23000102_c20200615.nc + + +INTERP_MISSING_MONTHS + + +INTERP_MISSING_MONTHS + + +.FALSE. +atm/cam/chem/ocnexch/SSS_recooked_0-360_c171120.nc + 'DMS -> $INPUTDATA_ROOT/atm/cam/chem/ocnexch/Csw_DMS_Lana2011_f09f09_1750_2100_20200717a.nc' +SERIAL + + +SERIAL +atm/waccm/lb/LBC_17500116-20150116_CMIP6_0p5degLat_c180905.nc + + +0.4D-9 +0.5D-9 + + +.true. +.true. +.false. +0.25D0 + + +.false. +.false. +.false. +.false. +.false. +.true. + + + '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' + + + + +.true. +'atm/cam/met/nudging/MERRA2_fv19_32L/' +'atm/cam/met/nudging/MERRA2_fv09_32L/' +'atm/cam/met/nudging/MERRA2_ne30_32L/' +'atm/cam/met/nudging/MERRA2_ne30pg3_32L/' +'atm/cam/met/nudging/MERRA2_ne0CONUS30x8_L32/' +'%y/MERRA2_fv19.cam2.i.%y-%m-%d-%s.nc' +'%y/MERRA2_fv09.cam2.i.%y-%m-%d-%s.nc' +'%y/MERRA2_ne30np4_L32.cam2.i.%y-%m-%d-%s.nc' +'%y/MERRA2_ne30pg3_L32.cam2.i.%y-%m-%d-%s.nc' +'%y/MERRA2_ne0CONUS30x8_L32.cam2.i.%y-%m-%d-%s.nc' +0 +0 +8 +48 +384 +1 +0.25 +1 +0.25 +1 +0.25 +0 +0.00 +0 +0.00 +1990 +2013 +1 +1 +2020 +12 +31 +0.0 +37. +9999. +56. +1. +5. +180. +264. +9999. +94. +1. +5. +.false. +.true. +33. +0.001 +0. +0.1 +.false. + +1850-2000 + + 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 @@ + + + +atm/cam/inic/fv/CARMA_1.9x2.5_L56_c210226.nc +atm/cam/inic/fv/CARMA_0.9x1.25_L56_c210226.nc + +4.5D0 + +50. +60. +50. +.true. + +1980/MERRA2_0.9x1.25_19800101.nc +atm/cam/met/MERRA2/0.9x1.25 +atm/cam/met/MERRA2/0.9x1.25/filenames_1975-2017_c190125.txt + +1980/MERRA2_1.9x2.5_19800101.nc +atm/cam/met/MERRA2/1.9x2.5 +atm/cam/met/MERRA2/1.9x2.5/filenames_list_c180824 + +0.84 + +atm/cam/met/MERRA2/0.9x1.25/fv_0.9x1.25_nc3000_Nsw042_Nrs008_Co060_Fi001_ZR_sgh30_24km_GRNL_MERRA2_c171218.nc +atm/cam/met/MERRA2/1.9x2.5/fv_1.9x2.5_nc3000_Nsw084_Nrs016_Co120_Fi001_ZR_GRNL_MERRA2_c190617.nc + + +atm/cam/solar/SolarForcingCMIP6_18491230-23000102_c20200615.nc + + +INTERP_MISSING_MONTHS + + +INTERP_MISSING_MONTHS + + +SERIAL +atm/waccm/lb/LBC_17500116-20150116_CMIP6_0p5degLat_c180905.nc + + +0.4D-9 +0.5D-9 + + +.true. +.true. +.false. +0.25D0 + + +.false. +.false. +.false. +.false. +.false. +.true. + + + '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' + + +1850-2000 + + 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 @@ + + + +atm/waccm/ic/FWmaCARMAHIST_f09_spinup01.cam.i.1980-01-01-00000_c220128.nc + + +atm/cam/solar/SolarForcingCMIP6_18491230-23000102_c20200615.nc + + +INTERP_MISSING_MONTHS + + +INTERP_MISSING_MONTHS + + +SERIAL +atm/waccm/lb/LBC_17500116-20150116_CMIP6_0p5degLat_c180905.nc + + +0.4D-9 +0.5D-9 + + +.false. +.false. +.false. +.false. +.false. +.true. + + + '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' + + +1850-2000 + + 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 @@ + + + +atm/waccm/ic/FWmaCARMAHIST_f09_spinup01.cam.i.1980-01-01-00000_c220128.nc + + +atm/cam/solar/SolarForcingCMIP6_18491230-23000102_c20200615.nc + + +INTERP_MISSING_MONTHS + + +INTERP_MISSING_MONTHS + + +.FALSE. +atm/cam/chem/ocnexch/SSS_recooked_0-360_c171120.nc + 'DMS -> $INPUTDATA_ROOT/atm/cam/chem/ocnexch/Csw_DMS_Lana2011_f09f09_1750_2100_20200717a.nc' +SERIAL + + +SERIAL +atm/waccm/lb/LBC_17500116-20150116_CMIP6_0p5degLat_c180905.nc + + +0.4D-9 +0.5D-9 + + +.false. +.false. +.false. +.false. +.false. +.true. + + + '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' + + + + +.true. +'atm/cam/met/nudging/MERRA2_fv19_70L/' +'atm/cam/met/nudging/MERRA2_fv09_70L/' +'%y/MERRA2_fv19.cam2.i.%y-%m-%d-%s.nc' +'%y/MERRA2_fv09.cam2.i.%y-%m-%d-%s.nc' +0 +0 +8 +48 +1 +0.25 +1 +0.25 +1 +0.25 +0 +0.00 +0 +0.00 +1990 +2013 +1 +1 +2020 +12 +31 +0.0 +37. +9999. +56. +1. +5. +180. +264. +9999. +94. +1. +5. +.false. +.true. +71. +0.001 +22. +1.0 +.false. + +1850-2000 + + diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index d0bdf4cafc..ec64343f7b 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -9,7 +9,7 @@ =============== --> CAM cam7 physics: - CAM cam6 physics: + CAM cam6 physics: CAM cam5 physics: CAM cam4 physics: CAM simplified and non-versioned physics : @@ -133,6 +133,8 @@ -chem geoschem_mam4 -chem trop_mam7 + -chem trop_strat_noaero -carma trop_strat_soa5 + -chem waccm_ma_noaero -carma trop_strat_soa1 -chem trop_strat_mam5_vbsext -chem trop_strat_mam5_ts2 -chem trop_strat_mam5_ts4 @@ -143,7 +145,7 @@ - -age_of_air_trcs + -age_of_air_trcs -chem waccm_ma -chem waccm_ma_mam5 -chem waccm_mad_mam5 @@ -160,6 +162,7 @@ -offline_dyn -nlev 56 -nlev 56 + -nlev 56 -nlev 88 -nlev 145 -nlev 58 -model_top lt @@ -235,6 +238,7 @@ waccm_ma_2000_cam6 waccm_sc_2000_cam6 2000_trop_strat_vbs_cam6 + carma_trop_strat_cam6 2000_geoschem waccmx_ma_2000_cam6 @@ -273,6 +277,10 @@ hist_trop_strat_t4s_cam7 1850_trop_strat_t4s_cam7 hist_trop_strat_nudged_cam6 + carma_trop_strat_hist_cam6 + carma_trop_strat_nudged_cam6 + carma_waccm_ma_hist_cam6 + carma_waccm_ma_nudged_cam6 hist_trop_strat_vbsext_cam6 hist_trop_strat_vbsfire_cam6 hist_geoschem @@ -303,6 +311,7 @@ sd_waccm_ma_cam4 sd_trop_strat_vbs_cam6 sd_trop_strat2_cam6 + carma_trop_strat_sd_cam6 sd_cam6 held_suarez_1994 diff --git a/cime_config/config_compsets.xml b/cime_config/config_compsets.xml index 91301d47dc..87edf876be 100644 --- a/cime_config/config_compsets.xml +++ b/cime_config/config_compsets.xml @@ -358,6 +358,42 @@ 2000_CAM60%GEOSCHEM%HEMCO_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV + + FCARMA2000climo + 2000_CAM60%CARMATS_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV + + + + QPCARMATS + 2000_CAM60%CARMATS_SLND_SICE_DOCN%AQP3_SROF_SGLC_SWAV + + + QPCARMAWM + 2000_CAM60%CARMAWM_SLND_SICE_DOCN%AQP3_SROF_SGLC_SWAV + + + + FCARMAHIST + HIST_CAM60%CARMATS_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV + + + FCARMAnudged + HIST_CAM60%CARMATS%NUDG_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV + + + FCARMASD + HIST_CAM60%CARMATS%SDYN_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV + + + + FWmaCARMAHIST + HIST_CAM60%CARMAWM_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV + + + FWmaCARMAnudged + HIST_CAM60%CARMAWM%NUDG_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV + + FC2010climo 2010_CAM60%CT1S_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV @@ -619,9 +655,11 @@ 1995-01-01 1995-01-01 2005-01-01 + 2010-01-01 + 1990-01-01 2005-01-01 2010-01-01 - 1980-01-01 + 1980-01-01 2000-01-01 2000-01-01 2010-01-01 diff --git a/cime_config/config_pes.xml b/cime_config/config_pes.xml index 2650843bfe..bb35e71d3a 100644 --- a/cime_config/config_pes.xml +++ b/cime_config/config_pes.xml @@ -833,7 +833,7 @@ 0 - + none -4 @@ -1418,7 +1418,7 @@ - + none -8 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/doc/ChangeLog b/doc/ChangeLog index 534b278928..7854c5356e 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,5 +1,306 @@ =============================================================== +Tag name: cam6_4_073 +Originator(s): fvitt, tilmes +Date: 5 Mar 2025 +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): + + 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: + + 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: N/A + +Describe any substantial timing or memory changes: none + +Code reviewed by: jimmielin, cacraigucar + +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 +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 + - 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 +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 + - 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 +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 + - 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: + +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 + - new compsets for caram trop_strat models + . QPCARMATS + . QPCARMAWM + . FCARMA2000climo + . FCARMAHIST + . FCARMAnudged + . FCARMASD + . FWmaCARMAHIST + . FWmaCARMAnudged + +M cime_config/config_pes.xml + - 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 + - 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 +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) + + 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 + +derecho/nvhpc/aux_cam: All PASS + +izumi/nag/aux_cam: All PASS + +izumi/gnu/aux_cam: All PASS + +Summarize any changes to answers: bit-for-bit unchanged + +=============================================================== +=============================================================== + Tag name: cam6_4_072 Originator(s): sjsprecious Date: 28 February 2025 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..222ea38c34 --- /dev/null +++ b/src/chemistry/aerosol/carma_aerosol_properties_mod.F90 @@ -0,0 +1,879 @@ +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) + 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),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 + 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 (m0 .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 + ! pure sulfate 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_r8*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..b0e82b2170 --- /dev/null +++ b/src/chemistry/aerosol/carma_aerosol_state_mod.F90 @@ -0,0 +1,595 @@ +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._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._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) + real(r8) :: nmr(pcols,pver) ! number mixing ratio (#/kg) + + 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) + call carma_get_number(self%state, igroup, ibin, nmr, rc) + + vol(:ncol,:) = four_thirds_pi * (raddry(:ncol,:)**3) * nmr(:ncol,:) ! 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) + real(r8) :: nmr(pcols,pver) ! number mixing ratio (#/kg) + + 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) + call carma_get_number(self%state, igroup, ibin, nmr, rc) + + vol(:ncol,:) = four_thirds_pi * (radwet(:ncol,:)**3) * nmr(:ncol,:) ! 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..3e78f5a8c9 --- /dev/null +++ b/src/chemistry/aerosol/hygrocoreshell_aerosol_optics_mod.F90 @@ -0,0 +1,291 @@ +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 single scattering albedo + real(r8),intent(out) :: pasm(ncol) ! parameterized asymmetry factor + + 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) + + 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..7153e13986 --- /dev/null +++ b/src/chemistry/aerosol/hygrowghtpct_aerosol_optics_mod.F90 @@ -0,0 +1,187 @@ +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) + + 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..0c0f990583 100644 --- a/src/chemistry/aerosol/mo_setsox.F90 +++ b/src/chemistry/aerosol/mo_setsox.F90 @@ -1,14 +1,15 @@ - -module MO_SETSOX +module mo_setsox use shr_kind_mod, only : r8 => shr_kind_r8 use cam_logfile, only : iulog + 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 +20,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 +114,25 @@ 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, & ncol, & lchnk, & loffset,& @@ -155,7 +158,7 @@ subroutine SETSOX( & aqso4_o3_3d & ) - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- ! ... Compute heterogeneous reactions of SOX ! ! (0) using initial PH to calculate PH @@ -168,7 +171,7 @@ subroutine SETSOX( & ! (b) PARTIONING ! (c) REACTION rates ! (d) PREDICTION - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- ! use ppgrid, only : pcols, pver use chem_mods, only : gas_pcnst, nfs @@ -179,11 +182,10 @@ subroutine SETSOX( & use cldaero_mod, only : cldaero_conc_t ! - implicit none - ! - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- ! ... 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 @@ -209,12 +211,11 @@ 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) - - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- ! ... 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 +250,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 +304,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 +365,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 +587,7 @@ subroutine SETSOX( & xph(i,k) = 10.0_r8**(-yph) converged = .true. exit - else + else ! do another iteration converged = .false. end if @@ -615,7 +616,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 +638,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 +676,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 +693,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 +756,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 +765,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 +778,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 +826,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 +840,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) @@ -859,10 +860,10 @@ subroutine SETSOX( & 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 ) - + 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 ) + xphlwc(:,:) = 0._r8 do k = 1, pver do i = 1, ncol @@ -874,6 +875,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..51779bd1b4 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,7 @@ subroutine aero_model_gasaerexch( loffset, ncol, lchnk, troplev, delt, reaction_ ! aqueous chemistry ... if( has_sox ) then - call setsox( & + call setsox( state, & 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..0c5a7cc923 100644 --- a/src/chemistry/bulk_aero/sox_cldaero_mod.F90 +++ b/src/chemistry/bulk_aero/sox_cldaero_mod.F90 @@ -22,7 +22,7 @@ module sox_cldaero_mod real(r8), parameter :: small_value = 1.e-20_r8 contains - + !---------------------------------------------------------------------------------- !---------------------------------------------------------------------------------- @@ -32,10 +32,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 !---------------------------------------------------------------------------------- @@ -61,12 +61,14 @@ 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, & + 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 ) - - ! args - + use physics_types, only: physics_state + + ! args + + type(physics_state), intent(in) :: state ! Physics state variables integer, intent(in) :: ncol integer, intent(in) :: lchnk ! chunk id integer, intent(in) :: loffset @@ -74,7 +76,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 +108,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 +122,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..b50e1e8934 --- /dev/null +++ b/src/chemistry/carma_aero/aero_model.F90 @@ -0,0 +1,986 @@ +!=============================================================================== +! 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_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 + + 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 :: 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 + + + ! 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 + + 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 + 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 + 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) +#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) :: num_name + character(len=32) :: num_name_cw + character(len=32) :: spec_name_cw + + integer :: idx, ierr + + call rad_cnst_get_info( 0, nbins=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 + 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 + use aero_wetdep_cam, only: aero_wetdep_init + use mo_setsox, only: sox_inti + use carma_aero_gasaerexch, only: carma_aero_gasaerexch_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, ii, mm + integer :: idxtmp = -1 + + logical :: history_aerosol ! Output MAM or SECT aerosol tendencies + logical :: history_chemistry, history_cesm_forcing + + integer :: l + + character(len=2) :: unit_basename ! Units 'kg' or '1' + character(len=32) :: num_name + character(len=32) :: num_name_cw + character(len=32) :: spec_name_cw + + integer :: idx, ierr + 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') + + 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_gasaerexch_init + + 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), stat=ierr ) + if (ierr/=0) call endrun(subrname//' : allocate error') + + 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) + + 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 + 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 + + character(len=aero_name_len) :: bin_name, shortname + integer :: igroup, ibin, rc, nchr, ierr + character(len=*), parameter :: subname = 'aero_model_gasaerexch' + +! +! ... initialize nh3 +! + if ( nh3_ndx > 0 ) then + nh3_beg = vmr(1:ncol,:,nh3_ndx) + end if +! +! 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), stat=ierr ) + if (ierr /= 0) call endrun(subname//': allocate error') + + mw_carma(:) = 0.0_r8 + do m = 1, nbins ! main loop over aerosol bins + ! 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,:) + end do + end do + + ! 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 ) + + dvmrdt(:ncol,:,:) = vmr(:ncol,:,:) ! all adveced species no aerosols + dvmrcwdt(:ncol,:,:) = vmrcw(:ncol,:,:) ! cloud borne carma aerosol species + ! aqueous chemistry ... + + if( has_sox ) then + call setsox( state, & + ncol, & + lchnk, & + loffset, & + delt, & + pmid, & + pdel, & + tfld, & + mbar, & + cwat, & + cldfr, & + cldnum, & + airdens, & + invariants, & + vmrcw, & + vmr, & + xphlwc, & + aqso4, & + aqh2so4, & + aqso4_h2o2, & + aqso4_o3 & + ) + + 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 + +! 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 + + ! 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) + + call carma_aero_gasaerexch_sub( state, & + pbuf, lchnk, ncol, nstep, & + loffset, delt, mbar , & + tfld, pmid, pdel, & + qh2o, troplev, & + vmr, raervmr, & + wetr_n ) + + ! 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 + + 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) :: sad_bin(pcols,pver,nbins) + 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 + 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 mmr2vmr_carma(lchnk, vmr, mbar, mw_carma, ncol, im, rmass) + !----------------------------------------------------------------- + ! ... Xfrom from mass to volume 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(in) :: mw_carma(ncnst_tot) + real(r8), intent(inout) :: vmr(ncol,pver,ncnst_tot) + + !----------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------- + integer :: k, m, mm, l + + do m = 1, nbins + 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 + 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) + + !----------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------- + integer :: k, m, mm, l + !----------------------------------------------------------------- + ! ... The non-group species + !----------------------------------------------------------------- + do m = 1, nbins + 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 + 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..ed8cf30859 --- /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_r8 ! 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..474e594f2c --- /dev/null +++ b/src/chemistry/carma_aero/sox_cldaero_mod.F90 @@ -0,0 +1,484 @@ +!---------------------------------------------------------------------------------- +! CARMA implementation +!---------------------------------------------------------------------------------- +module sox_cldaero_mod + + 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 + 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 + + 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, 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) + + type(cldaero_conc_t), pointer :: conc_obj + + character(len=32) :: spectype + + integer :: l,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, 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 + + 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) + + real(r8) :: faqgain_so4(nbins) + real(r8) :: wt_mass(nbins) + + real(r8) :: delso4_o3rxn, & + dso4dt_aqrxn, dso4dt_hprxn, & + dso4dt_gasuptk, dmsadt_gasuptk_toso4, & + dqdt_aq, dqdt_wr, dqdt + + real(r8) :: fwetrem, uptkrate + + integer :: l, n, 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) + + if (xl .ge. 1.e-8_r8) then !! when cloud is present + + delso4_o3rxn = xso4(i,k) - xso4_init(i,k) + + ! 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 + + 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 = xh2so4(i,k) * uptkrate + + ! if no modes have msa aerosol, then "rename" scavenged msa gas to so4 + dmsadt_gasuptk_toso4 = 0.0_r8 + + !----------------------------------------------------------------------- + ! 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) + qin(i,k,id_h2so4) = qin(i,k,id_h2so4) - dso4dt_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 + 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 + 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 ) + + ! 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 present + 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/geoschem/chemistry.F90 b/src/chemistry/geoschem/chemistry.F90 index e46bda2c4e..12cc865572 100644 --- a/src/chemistry/geoschem/chemistry.F90 +++ b/src/chemistry/geoschem/chemistry.F90 @@ -4091,7 +4091,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(:), & diff --git a/src/chemistry/modal_aero/aero_model.F90 b/src/chemistry/modal_aero/aero_model.F90 index d75730c2ff..593f1c83f5 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 @@ -1050,7 +1059,7 @@ subroutine aero_model_gasaerexch( loffset, ncol, lchnk, troplev, delt, reaction_ ! aqueous chemistry ... if( has_sox ) then - call setsox( & + call setsox( state, & 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..42cb7c51f6 100644 --- a/src/chemistry/modal_aero/sox_cldaero_mod.F90 +++ b/src/chemistry/modal_aero/sox_cldaero_mod.F90 @@ -54,13 +54,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 +97,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 +118,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 +126,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 +137,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 @@ -152,11 +152,15 @@ 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, & + 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) - ! args + use physics_types, only: physics_state + + ! args + + type(physics_state), intent(in) :: state ! Physics state variables integer, intent(in) :: ncol integer, intent(in) :: lchnk ! chunk id @@ -165,7 +169,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(:,:) @@ -231,7 +235,7 @@ subroutine sox_cldaero_update( & ! 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 @@ -484,7 +488,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 6527b0ccc1..bc706c647e 100644 --- a/src/chemistry/mozart/chemistry.F90 +++ b/src/chemistry/mozart/chemistry.F90 @@ -189,6 +189,7 @@ subroutine chem_register logical :: cam_outfld character(len=128) :: mixtype character(len=128) :: molectype + logical :: ndropmixed integer :: islvd !----------------------------------------------------------------------- @@ -240,11 +241,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 @@ -298,7 +304,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 @@ -336,7 +343,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 @@ -545,7 +551,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) @@ -641,7 +646,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 @@ -677,9 +681,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 ) @@ -1260,7 +1261,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..177d3dd04e 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,13 +770,21 @@ 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) ) + 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 @@ -791,7 +802,7 @@ subroutine usrrxt( rxt, temp, tempi, tempe, invariants, h2ovmr, & else call aero_model_surfarea( & - mmr, rm1, relhum, pmid, temp, strato_sad, sulfate, m, tropchemlev, dlat, & + 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 @@ -2000,8 +2011,8 @@ subroutine usrrxt( rxt, temp, tempi, tempe, invariants, h2ovmr, & 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 + / amas & ! xform g/cm3 to num particles/cm3 + * fare & ! xform num particles/cm3 to cm2/cm3 * xr(:)*xr(:) ! humidity factor endif !----------------------------------------------------------------- @@ -2020,7 +2031,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) ) @@ -2033,7 +2044,7 @@ subroutine usrrxt( 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) 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 81659ec12a..5957ac7252 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 f7bc2a40ff..6a2300611d 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 use atm_stream_ndep, only: stream_ndep_readnl !---------------------------Arguments----------------------------------- @@ -206,6 +208,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) call stream_ndep_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_diags_mod.F90 b/src/physics/cam/carma_diags_mod.F90 new file mode 100644 index 0000000000..0146b1c860 --- /dev/null +++ b/src/physics/cam/carma_diags_mod.F90 @@ -0,0 +1,129 @@ +!-------------------------------------------------------------------------------- +! 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 + + allocate(newobj,stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + + 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 + + !------------------------------------------------------------------------------ + ! 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/carma_intr.F90 b/src/physics/cam/carma_intr.F90 index b555aaf68a..5acb25e0ea 100644 --- a/src/physics/cam/carma_intr.F90 +++ b/src/physics/cam/carma_intr.F90 @@ -41,8 +41,36 @@ module carma_intr ! 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 @@ -149,6 +177,46 @@ subroutine carma_init_cnst(name, latvals, lonvals, mask, q) return end subroutine carma_init_cnst + 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 @@ -185,4 +253,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/carma_model_flags_mod.F90 b/src/physics/cam/carma_model_flags_mod.F90 index 6cf268e133..e3dc609b54 100644 --- a/src/physics/cam/carma_model_flags_mod.F90 +++ b/src/physics/cam/carma_model_flags_mod.F90 @@ -5,7 +5,7 @@ !! a CARMA model wishes to have its own namelist, then this file needs to be copied !! from physics/cam to physics/model/ and the code needed to read in the !! namelist values added there. This file will take the place of the one in -!! physics/cam. +!! physics/cam. !! !! It needs to be in its own file to resolve some circular dependencies. !! @@ -18,7 +18,7 @@ module carma_model_flags_mod ! Flags for integration with CAM Microphysics public carma_model_readnl ! read the carma model namelist - + ! Namelist flags ! @@ -26,7 +26,6 @@ module carma_model_flags_mod ! and default them to an inital value. logical, public :: carma_flag = .false. ! If .true. then turn on CARMA microphysics in CAM 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 contains @@ -36,50 +35,22 @@ module carma_model_flags_mod !! @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_flag, & -! carma_maxretries, & -! carma_conmax, & -! carma_reftfile - -! 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_flag, 1 ,mpilog, 0,mpicom) -! call mpibcast (carma_maxretries, 1 ,mpiint, 0,mpicom) -! call mpibcast (carma_conmax, 1 ,mpir8, 0,mpicom) -! call mpibcast (carma_reftfile, len(carma_reftfile), mpichar, 0, mpicom) -#endif - + end subroutine carma_model_readnl end module carma_model_flags_mod diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index ccd655d2ab..d45655f31b 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,7 +25,7 @@ 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 atmos_phys_pbl_utils,only: calc_friction_velocity, calc_kinematic_heat_flux, calc_ideal_gas_rrho, & calc_kinematic_water_vapor_flux, calc_kinematic_buoyancy_flux, calc_obukhov_length use ref_pres, only: top_lev => trop_cloud_top_lev @@ -359,7 +359,6 @@ module clubb_intr 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. @@ -1532,8 +1531,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) @@ -1549,29 +1547,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 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 d5f98c9813..3ce1a46f95 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', sampled_on_subcycle=.true.) call addfld ('RBFREQ', horiz_only, 'A', 'Frequency', 'Potential rainbow frequency', sampled_on_subcycle=.true.) call addfld( 'rbSZA', horiz_only, 'I', 'degrees', 'solar zenith angle', sampled_on_subcycle=.true.) - + ! History variables for CAM5 microphysics call addfld ('MPDT', (/ 'lev' /), 'A', 'W/kg', 'Heating tendency - Morrison microphysics', sampled_on_subcycle=.true.) call addfld ('MPDQ', (/ 'lev' /), 'A', 'kg/kg/s', 'Q tendency - Morrison microphysics', sampled_on_subcycle=.true.) @@ -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 38079466af..d14d4d5967 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 @@ -308,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. @@ -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 @@ -841,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) @@ -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/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 3edd3f616a..774456311e 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. @@ -470,6 +470,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,9 +485,20 @@ subroutine nucleate_ice_cam_calc( & ni => state%q(:,:,numice_idx) pmid => state%pmid + if (present(aero_props)) then + nbins = aero_props%nbins() + nmaxspc = maxval(aero_props%nspecies()) + + 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_aero) then + if (clim_modal_carma) then call physics_ptend_init(ptend, state%psetcols, 'nucleatei', lq=lq) @@ -593,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') @@ -603,6 +618,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 if (idxdst1 > 0 .and. idxdst2 > 0 .and. idxdst3 > 0 .and. idxdst4 > 0) then @@ -662,7 +688,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 @@ -673,10 +699,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 @@ -685,7 +708,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 @@ -756,7 +780,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 @@ -858,7 +882,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) @@ -904,6 +928,13 @@ subroutine nucleate_ice_cam_calc( & call outfld('INFreIN ',INFreIN, pcols,lchnk) end if + 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 !================================================================================================ diff --git a/src/physics/cam/phys_control.F90 b/src/physics/cam/phys_control.F90 index 0ad08646ce..6819c05fcb 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. @@ -132,7 +133,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, & @@ -179,6 +181,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) @@ -311,7 +314,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, state_debug_checks_out, cld_macmic_num_steps_out, & @@ -345,6 +348,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 @@ -387,6 +391,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/physpkg.F90 b/src/physics/cam/physpkg.F90 index 577b45df58..83744a4532 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 @@ -158,6 +160,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----------------------------- ! @@ -268,6 +272,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() @@ -769,6 +776,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 @@ -851,6 +860,8 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) ! initialize carma call carma_init(pbuf2d) + call surface_emissions_init(pbuf2d) + call elevated_emissions_init(pbuf2d) ! Prognostic chemistry. call chem_init(phys_state,pbuf2d) @@ -1448,7 +1459,15 @@ subroutine tphysac (ztodt, cam_in, & real(r8), pointer, dimension(:,:) :: dvcore real(r8), pointer, dimension(:,:) :: ast ! relative humidity cloud fraction + ! For aerosol budget diagnostics + type(carma_diags_t), pointer :: carma_diags_obj + !----------------------------------------------------------------------- + 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 @@ -1501,7 +1520,13 @@ subroutine tphysac (ztodt, cam_in, & call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,& fh2o, surfric, obklen, flx_heat) end if + + call carma_diags_obj%update(cam_in, state, pbuf) + call chem_emissions( state, cam_in, pbuf ) + + 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,& fh2o, surfric, obklen, flx_heat) @@ -1509,7 +1534,9 @@ subroutine tphysac (ztodt, cam_in, & if (carma_do_emission) then ! carma emissions - call carma_emission_tend (state, ptend, cam_in, ztodt, pbuf) + call carma_diags_obj%update(cam_in, state, pbuf) + call carma_emission_tend(state, ptend, cam_in, ztodt, pbuf) + call carma_diags_obj%output(state, ptend, cam_in, "CREMIS", ztodt, pbuf) call physics_update(state, ptend, ztodt, tend) end if @@ -1580,6 +1607,8 @@ subroutine tphysac (ztodt, cam_in, & fh2o, surfric, obklen, flx_heat) end if + call carma_diags_obj%update(cam_in, state, pbuf) + call chem_timestep_tend(state, ptend, cam_in, cam_out, ztodt, & pbuf, fh2o=fh2o) @@ -1588,6 +1617,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_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 @@ -1612,6 +1644,8 @@ subroutine tphysac (ztodt, cam_in, & fh2o, surfric, obklen, flx_heat) end if + call carma_diags_obj%update(cam_in, state, pbuf) + call vertical_diffusion_tend (ztodt ,state , cam_in, & surfric ,obklen ,ptend ,ast ,pbuf ) @@ -1632,6 +1666,9 @@ subroutine tphysac (ztodt, cam_in, & if ( ptend%lv ) then call outfld( 'VTEND_VDIFF', ptend%v, pcols, lchnk) end if + + 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 @@ -1672,11 +1709,14 @@ subroutine tphysac (ztodt, cam_in, & fh2o, surfric, obklen, flx_heat) end if + 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_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 @@ -1695,7 +1735,9 @@ subroutine tphysac (ztodt, cam_in, & ! can be added to for CARMA aerosols. if (carma_do_aerosol) then call t_startf('carma_timestep_tend') + 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_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) @@ -1967,6 +2009,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 + ! output these here -- after updates by chem_timestep_tend or export_fields within the current time step if (associated(cam_out%nhx_nitrogen_flx)) then call outfld('a2x_NHXDEP', cam_out%nhx_nitrogen_flx, pcols, lchnk) @@ -2060,6 +2108,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 @@ -2167,7 +2217,15 @@ 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 + type(carma_diags_t), pointer :: carma_diags_obj + !----------------------------------------------------------------------- + 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') @@ -2288,6 +2346,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 @@ -2397,6 +2459,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) @@ -2440,8 +2504,10 @@ subroutine tphysbc (ztodt, state, & call t_startf('carma_timestep_tend') if (carma_do_cldice .or. carma_do_cldliq) then + 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_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 @@ -2626,6 +2692,8 @@ subroutine tphysbc (ztodt, state, & flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) end if + 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) call t_stopf('microp_aero_run') @@ -2706,6 +2774,11 @@ 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_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). call physics_ptend_scale(ptend, 1._r8/cld_macmic_num_steps, ncol) @@ -2790,11 +2863,14 @@ subroutine tphysbc (ztodt, state, & flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) end if + 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_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 @@ -2809,7 +2885,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') + call carma_diags_obj%update(cam_in, state, pbuf) call carma_wetdep_tend(state, ptend, ztodt, pbuf, dlf, cam_out) + 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 @@ -2895,6 +2973,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) @@ -2932,6 +3016,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 @@ -2952,6 +3038,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 d44f952559..1cf0f0dab1 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 ) ) @@ -724,7 +679,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 atmos_phys_pbl_utils, only: calc_virtual_temperature, calc_ideal_gas_rrho, calc_friction_velocity, & calc_kinematic_heat_flux, calc_kinematic_water_vapor_flux, calc_kinematic_buoyancy_flux, & @@ -1260,17 +1215,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 5d76f36be5..d713790c2d 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 ffcd05293e..a90f310a39 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() @@ -770,6 +775,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 @@ -854,6 +861,8 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) ! initialize carma call carma_init(pbuf2d) + call surface_emissions_init(pbuf2d) + call elevated_emissions_init(pbuf2d) ! Prognostic chemistry. call chem_init(phys_state,pbuf2d) @@ -2539,6 +2548,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 @@ -2752,6 +2763,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 @@ -2952,6 +2967,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 @@ -2972,6 +2989,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/cam/carma_intr.F90 b/src/physics/carma/cam/carma_intr.F90 index 89f7f415d6..509a04e9d0 100644 --- a/src/physics/carma/cam/carma_intr.F90 +++ b/src/physics/carma/cam/carma_intr.F90 @@ -11,9 +11,10 @@ module carma_intr use carma_precision_mod, only: f use carma_enums_mod, only: I_OPTICS_FIXED, I_OPTICS_MIXED_CORESHELL, I_OPTICS_MIXED_VOLUME, & - I_OPTICS_MIXED_MAXWELL, I_OPTICS_SULFATE, I_CNSTTYPE_PROGNOSTIC, I_HYBRID + I_OPTICS_MIXED_MAXWELL, I_OPTICS_SULFATE, I_CNSTTYPE_PROGNOSTIC, I_HYBRID, RC_OK, RC_ERROR, & + I_WTPCT_H2SO4, I_PETTERS use carma_constants_mod, only : GRAV, REARTH, WTMOL_AIR, WTMOL_H2O, R_AIR, CP, RKAPPA, NWAVE, & - CARMA_NAME_LEN, CARMA_SHORT_NAME_LEN, PI, CAM_FILL, RGAS, RM2CGS, RAD2DEG, CLDFRC_INCLOUD + CARMA_NAME_LEN, CARMA_SHORT_NAME_LEN, PI, CAM_FILL, RGAS, RM2CGS, RAD2DEG, CLDFRC_INCLOUD, MAXCLDAERDIAG use carma_types_mod, only : carma_type, carmastate_type use carma_flags_mod, only : carma_flag, carma_do_fixedinit, carma_model, carma_do_wetdep, carma_do_emission, & carma_do_pheat, carma_do_substep, carma_do_thermo, carma_do_cldice, carma_diags_file, & @@ -21,12 +22,13 @@ module carma_intr carma_rhcrit, carma_rad_feedback, carma_minsubsteps, carma_maxsubsteps, carma_gstickl, carma_gsticki, & carma_maxretries, carma_dt_threshold, carma_ds_threshold, carma_do_vtran, carma_do_vdiff, carma_do_pheatatm, & carma_do_partialinit, carma_do_optics, carma_do_incloud, carma_do_explised, carma_do_drydep, carma_do_detrain, & - carma_do_coremasscheck, carma_do_coag, carma_do_clearsky, carma_do_cldliq, carma_do_aerosol, carma_dgc_threshold - + carma_do_coremasscheck, carma_do_coag, carma_do_clearsky, carma_do_cldliq, carma_do_aerosol, carma_dgc_threshold, & + carma_diags_packages, carma_ndiagpkgs use carma_model_mod, only : NGAS, NBIN, NELEM, NGROUP, NMIE_WTP, NREFIDX, MIE_RH, NMIE_RH, NSOLUTE use carma_model_mod, only : mie_rh, mie_wtp, is_convtran1, CARMAMODEL_DiagnoseBulk, CARMAMODEL_DiagnoseBins, & CARMAMODEL_Detrain, CARMAMODEL_OutputDiagnostics, CARMAMODEL_CreateOpticsFile, CARMAMODEL_WetDeposition, & - CARMAMODEL_EmitParticle, CARMAMODEL_InitializeParticle, CARMAMODEL_DefineModel, CARMAMODEL_InitializeModel + CARMAMODEL_EmitParticle, CARMAMODEL_InitializeParticle, CARMAMODEL_DefineModel, CARMAMODEL_InitializeModel, & + CARMAMODEL_OutputBudgetDiagnostics, CARMAMODEL_OutputCloudborneDiagnostics, CARMAMODEL_CalculateCloudborneDiagnostics use carmaelement_mod, only : CARMAELEMENT_Get use carmagas_mod, only : CARMAGAS_Get use carmagroup_mod, only : CARMAGROUP_Get @@ -48,6 +50,7 @@ module carma_intr pbuf_get_index, pbuf_get_field, dtype_r8, pbuf_set_field use pio, only: var_desc_t use radconstants, only: nlwbands, nswbands + use wv_sat_methods, only: wv_sat_qsat_water implicit none @@ -70,11 +73,42 @@ module carma_intr ! 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 @@ -124,7 +158,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 @@ -219,6 +253,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. @@ -355,6 +390,8 @@ 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 ! needs to be its own constiuent in CAM. @@ -393,7 +430,8 @@ 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 if end do @@ -545,6 +583,7 @@ subroutine carma_init(pbuf2d) 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)) @@ -552,8 +591,7 @@ subroutine carma_init(pbuf2d) ! Initialize the return code. rc = 0 - call phys_getopts(history_carma_out=history_carma) - history_carma_srf_flx = .false. + 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. @@ -1671,6 +1709,106 @@ 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. !! @@ -2250,7 +2388,6 @@ end subroutine CARMA_CreateOpticsFile !! 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 @@ -2594,7 +2731,6 @@ end subroutine CARMA_CreateOpticsFile_Fixed !! 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 @@ -3117,4 +3253,862 @@ subroutine CARMA_restart_read(File) 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_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) + 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/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/ 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..50d9981ff4 --- /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 /) + + real(r8), parameter :: onethird = 1._r8/3._r8 + +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**onethird) + ! Using Mie code, consider core/shell ratio + do icsr = 1, ncsr + if (ncsr > 1) then + rcore = r(ibin)*(coreshellratio(icsr)**onethird) + 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**onethird) + ! Using Mie code, consider core/shell ratio + do icsr = 1, ncsr + if (ncsr > 1) then + rcore = r(ibin)*(coreshellratio(icsr)**onethird) + 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/ 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..7bbd8f9907 --- /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 /) + + real(r8), parameter :: onethird = 1._r8/3._r8 + +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**onethird) + ! Using Mie code, consider core/shell ratio + do icsr = 1, ncsr + if (ncsr > 1) then + rcore = r(ibin)*(coreshellratio(icsr)**onethird) + 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**onethird) + ! Using Mie code, consider core/shell ratio + do icsr = 1, ncsr + if (ncsr > 1) then + rcore = r(ibin)*(coreshellratio(icsr)**onethird) + 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